Index: web/openacs/UPGRADING.txt =================================================================== RCS file: /usr/local/cvsroot/web/openacs/UPGRADING.txt,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/UPGRADING.txt 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,28 @@ + +OpenACS Upgrading Instructions +by Ben Adida (ben@mit.edu) +============================== + + +From v3.2.2 to v3.2.4 +--------------------- + +- Replace the code (almost every file has been tweaked for security fixes) +- Run the data model upgrade script as follows, assuming that your OpenACS root is /web/openacs +and your database name is "openacs-db" + + psql -f /web/openacs/www/doc/sql/upgrade-openacs-3.2.2-3.2.4.sql openacs-db + +- If you want OpenACS full text searching to work on bboards, you will need: + + - PL/TCL. If you didn't install this with Postgres, simply get the Postgres source + and reconfigure with "./configure --with-tcl" You can then simply copy the file src/pl/tcl/pltcl.so + to /lib (POSTGRES_HOME is usually /usr/local/pgsql). + + - Enable PL/TCL for your database: + createlang pltcl openacs-db + + - Load up the additional piece of data model: + psql -f /web/openacs/www/doc/sql/rank-for-search.sql openacs-db + + Index: web/openacs/readme.txt =================================================================== RCS file: /usr/local/cvsroot/web/openacs/readme.txt,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/readme.txt 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,32 @@ +This is the ArsDigita Community System, described in +http://photo.net/wtr/thebook/community.html + +Copyright (C) 1995-99 Philip Greenspun and ArsDigita, LLC + +Parts of this code are also +Copyright (C) 1999-2000 the OpenACS team + +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. + +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. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +-------------- + +This is OpenACS 3.2.4, and corresponds to ACS/Oracle 3.2.3 with additional security fixes. + +Installation instructions are at http://www.openacs.org/doc/openacs +and also in this tar file at www/doc/openacs + +The version history is at www/doc/version-history.html + +Please report all bugs and feature requests to http://www.openacs.org/sdm Index: web/openacs/bin/aolserver-errors.pl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/bin/aolserver-errors.pl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/bin/aolserver-errors.pl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,181 @@ +#! /usr/bin/perl + +# aolserver-errors.pl +# +# prints out the errors from an AOLserver error log +# +# dvr@arsdigita.com, 11/27/99 +# +# USAGE: +# +# aolserver-errors -b +# +# print all errors found in the last of +# the error log. +# +# aolserver-errors -m +# +# print all errors logged in the last +# minutes +# +# +# If called with no options, it will default to +# +# aolserver-errors -200000b +# +# +############################################################# +# +# Modification History: +# +# 1/1/2000 -- Removed reliance on the POSIX module and got the +# parameter working correctly. +# +# 1/15/2000 -- replaced all calls to 'tail` with seek() calls +# to improve portability. This also allows us to compile this script +# with perlcc to create a single binary that should work under +# a chroot'ed server. +# +# 2/01/2000 -- fixed a bug that caused trouble the first of every +# month. (Now the problem happens only on the first of each year) + +$num_args = scalar @ARGV; + +# the number of bytes to read from the end of the file when +# we're trying to find all errors in the last N minutes. +$bite_size = 200000; + +# The default size for the -b parameter +$default_num_bytes = 200000; + +%month_num = ('Jan', '00', + 'Feb', '01', + 'Mar', '02', + 'Apr', '03', + 'May', '04', + 'Jun', '05', + 'Jul', '06', + 'Aug', '07', + 'Sep', '08', + 'Oct', '09', + 'Nov', '10', + 'Dec', '11'); + +foreach $arg_num (0 .. ($num_args - 2)) { + $arg = $ARGV[$arg_num]; + + if ($arg =~ /\-([0-9]+)([A-Za-z])/) { + ($number, $type) = ($1, lc($2)); + + if ($type eq 'b') { + $num_bytes = $number; + } elsif ($type eq 'm') { + $num_minutes = $number; + } else { + die "Bad option: $arg\n"; + } + } else { + die "Bad option: $arg\n"; + } +} + +$log_file = $ARGV[-1]; + +open LOG, "< $log_file"; + +if ($num_minutes) { + $start_time = sprintf "%02d%02d%02d%02d", (localtime(time - (60*$num_minutes)))[4,3,2,1]; + + seek LOG, -$bite_size, 2; + + while (1) { + while () { + if (/^\[([0-9]+)\/([A-Za-z]+)\/([0-9]+):([0-9]+):([0-9]+)/) { + my($day, $month_name, $year, $hour, $minute) = ($1, $2, $3, $4, $5); + + $log_time = $month_num{$month_name} . $day . $hour . $minute; + + if ($log_time lt $start_time) { + + # We've gone too far back. Advance until we find + # an error that's on or past $start_time + + $last_position = tell LOG; + + while () { + if (/^\[([0-9]+)\/([A-Za-z]+)\/([0-9]+):([0-9]+):([0-9]+)/) { + my($day, $month_name, $year, $hour, $minute) = ($1, $2, $3, $4, $5); + + $log_time = $month_num{$month_name} . $day . $hour . $minute; + + if ($start_time le $log_time) { + $starting_point = $last_position; + last; + } + } + $last_position = tell LOG; + } + # Either we've found the line we want or have reached + # the end of the file. If it's the second case, we + # need to set the starting point to the end of the file. + $starting_point = $last_position unless $starting_point; + } + # We only need to get one time stamp + last; + } + } + + last if defined $starting_point; + + seek LOG, -$bite_size, 1; + + $position = tell LOG; + + if ($position < $bite_size) { + # then we need to read the entire file + $starting_point = 0; + last; + } + } +} + +if (defined $starting_point) { + seek LOG, $starting_point, 0; +} else { + $num_bytes = $default_num_bytes unless $num_bytes; + seek LOG, -$num_bytes, 2; +} + +$in_error = 0; +$in_following_notice = 0; + +while () { + if (/^\[(.*?)\]\[(.*?)\][^ ]? (.*)/) { + ($time, undef, $message) = ($1, $2, $3); + + unless ($first_log_time) { + ($first_log_time) = ($time =~ /^([^ ]+)/); + print "Errors since $first_log_time\n"; + } + + if ($message =~ /^Error/) { + print "\n[$time]\n $message\n"; + $in_error = 1; + $in_following_notice = 0; + } elsif ($message =~ /^Notice/) { + if ($in_error == 1) { + $in_following_notice = 1; + } else { + $in_following_notice = 0; + } + $in_error = 0; + print " $message\n" if $in_following_notice; + } else { + $in_error = 0; + $in_following_notice = 0; + } + } else { + print " $_" if ($in_error or $in_following_notice); + } +} +close LOG; Index: web/openacs/bin/queue-message.pl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/bin/queue-message.pl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/bin/queue-message.pl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,118 @@ +#!/usr/bin/perl +# +# Respond to incoming mail message on STDIN +# +# hqm@ai.mit.edu +# +# modified for posgres by +# Steven Caranci +# caranci@eecg.toronto.edu +# +# This script does the following: +# +sub usage () { + print ' + usage: queue_message.pl db_datasrc db_user db_passwd destaddr + + Inserts the data from stdin into a queue table. + + Assumes the following table and sequence are defined in the db: + + create table incoming_email_queue ( + id int4 not null, + destaddr varchar(256), + content text, -- the entire raw message content + -- including all headers + arrival_time datetime + ); + + create sequence incoming_email_queue_sequence; + +'; +} + +use Pg; + +################################################################ +# Global Definitions + +# max string size we allow in db. Truncate any message content beyond this +#$MAX_MSGSIZE = 400000; +# is limit of text type 1 block? +# assume so for now. also assume 8k block. +$MAX_MSGSIZE = 8000; + +$db_datasrc = shift; +$db_user = shift; +$db_passwd = shift; +$destaddr = shift; + +# we don't support hosts/ports other than the default (localhost/5432). +# we probably should. + +$DEBUG = 1; +$debug_logfile = "/tmp/mailhandler-log.txt"; # + +if (!defined $db_datasrc) { + $db_datasrc = 'dbi:Oracle:'; +} + +if (!defined $db_user) { + usage(); + die("You must pass a db user in the command line"); +} + +if (!defined $db_passwd) { + usage(); + die("You must pass a db passwd in the command line"); +} + + + +################################################################# +## Snarf down incoming msg on STDIN +################################################################# + +while (<>) { + $content .= $_; +} + +# double the single quotes +$content =~ s/'/''/g; + +# limit content length +$content = substr($content,0,$MAX_MSGSIZE); + + +if ($DEBUG) { + open (LOG, ">>$debug_logfile"); + debug("================================================================\n"); + debug("Received content:\n$content\n"); +} + + +# Open the database connection. +$conn = Pg::connectdb("dbname=$db_datasrc user=$db_user password=$db_passwd"); + +if( $conn->status != PGRES_CONNECTION_OK ) { + $errorMessage = $conn->errorMessage; + debug( "errorMessage from Pg::connectdb: $errorMessage\n" ); + die "Couldn't connect to database:\n $errorMessage\n"; +} + +debug("Status: inserting into email queue\n"); +$sql = "INSERT INTO incoming_email_queue (id, destaddr, content, arrival_time) VALUES (nextval('incoming_email_queue_sequence'), '$destaddr', '$content', 'now')"; + +$result = $conn->exec($sql); + +if( ($ntuples = $result->cmdTuples) != 1 ) { + debug( "\nAck! ntuples != 1 (= $ntuples instead)\n" ); +} + +debug("[closing log]\n"); +if ($DEBUG) { close LOG; } + +sub debug () { + my ($msg) = @_; + print LOG $msg; +} Index: web/openacs/bin/restartserver.sh =================================================================== RCS file: /usr/local/cvsroot/web/openacs/bin/restartserver.sh,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/bin/restartserver.sh 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,7 @@ +#! /bin/sh + +# restart the aolserver. This scrip should be called from restart.tcl in the admin directory. The parameter is set +# under the restart section of the parameters file. +# james@jamesshannon.com + +$1/bin/nsd -K -i -c $2 Index: web/openacs/parameters/ad.ini =================================================================== RCS file: /usr/local/cvsroot/web/openacs/parameters/ad.ini,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/parameters/ad.ini 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,1116 @@ +; AOLserver reads these files when the server starts up and stores +; parameters in an in-memory hash table. So you have to restart the +; server if you want to test a change made to this file. + +[ns/server/yourservername/acs] +SystemName=yourdomain Network +; for legal pages, full corporate entity +PublisherName=Yourdomain Network, Inc. +; who signs the average user-visible pages +SystemOwner=webmaster@yourdomain.com +; URL to tell users to go to +SystemURL=http://yourdomain.com +; who signs the admin pages, e.g., a programmer who can fix/enhance them +AdminOwner=a-programmer@yourdomain.com +; are admin users allow to write SQL queries +; (only say yes if they are not likely to crash the server) +AllowAdminSQLQueries=0 +; stuff we want restricted to SSL (https) (filter patterns) +; note that this only takes effect if you have an SSL listener configured +; on your AOLserver +RestrictToSSL=/admin* +RestrictToSSL=/NS/Admin* +RestrictToSSL=/NS/Db* +; do we want to restrict the entire server to registered users +; (the content_sections facility probably could also accomplish this +; but not as simply) +RestrictEntireServerToRegisteredUsersP=0 +; Is this server being used as a staff server? +; (only used by /pvt/home.tcl and may become legacy) +StaffServerP=0 +HostAdministrator=somenerd@yourdomain.com +GraphicsSiteAvailableP=0 +; these work for text-only and graphics site +bgcolor=white +textcolor=black +; this is only for the graphics site +background=/graphics/bg.gif +; set ReadOnlyP=1 if you're going to wipe your Oracle installation +ReadOnlyP=0 +; do we expect this to be a site visited by people +; from all over the world (in which case we might ask for +; country rather than state) +InternationalP=1 +; is it even worth bothering asking for state and zip code? +SomeAmericanReadersP=1 +; do we allow a persistent cookie? +; we need this for pulling times out of the database and turning +; then into ns_times; this is for standard time (don't worry about +; daylight saving's time, we figure that out by calling ns_localtime) +; United States Eastern time is -5 +HoursDifferenceFromGMT=-5 +; what two characters do we use for salting ns_crypt +; (documented at aolserver.com; doesn't matter as long +; as you don't change this after going live) +CryptSalt=fb +; admin user interface may change depending on whether we expect +; 10, 100, 1000, or 100000 users; we have "small", "medium", "large" +; as possible values, consistent with Oracle config files +NumberOfUsers=medium +; clickthrough and referral admin report defaults +; change depending on whether +; this is a dev site or a 500,000 hit/day live site +; we have "small", "medium", "large" as possible values +; we think "medium" = site like photo.net (700,000 hits/day) +TrafficVolume=medium +; general comments default approval +; open means stuff goes live immediately +; wait means stuff waits for administrator to approve +; closed means only administrator can post +DefaultCommentApprovalPolicy=wait +; general links default approval +; open means stuff goes live immediately +; wait means stuff waits for administrator to approve +; closed means only administrator can post +DefaultLinkApprovalPolicy=open +; if set, update last visit cookie according to LastVisitUpdateInterval +; so that we can support reporting of who's online. This makes last visit +; times more accurate, but increases system load (because we're also +; updating the last_visit column in the users table) +WhosOnlineP=1 +WhosOnlineDecoration=100th Anniversary Boston Marathon (1996). +; how many seconds old a last visit cookie must be before we update it +LastVisitUpdateInterval=600 + +;stuff having to do with registration and login +NotifyAdminOfNewRegistrationsP=1 +; where to send those notes (defaults to SystemOwner) +;NewRegistrationEmailAddress=admin@yourdomain.com +; send confirmation email to user after registration +EmailRegistrationConfirmationToUserP=0 +; set this to 1 if user does not go live immediately +RegistrationRequiresApprovalP=0 +; set this to 1 if the user has to receive and email +; and come back to the site +RegistrationRequiresEmailVerificationP=0 +; have the system generate a random password instead of the user +RegistrationProvidesRandomPasswordP=0 +; Encypt Passwords in the database +EncryptPasswordsInDBP=0 +; Email users forgotten passwords +EmailForgottenPasswordP=1 +; If so, do you choose a random a password +; (if you use encrypted password, a random password will always be generated) +EmailRandomPasswordWhenForgottenP=0 +; if the admin changes the password, should it be mailed to the user +EmailChangedPasswordP=1 +AllowPersistentLoginP=1 +; if so, do we default to a persistent cookie? +PersistentLoginDefaultP=1 +; do we keep track of anonymous and logged-in browsers +; as to last_visit and second_to_last_visit +LastVisitCookiesEnabledP=1 +; how many seconds old must a last visit cookie be before +; we consider this a new visit +LastVisitExpiration=86400 +; how long will we associated hits from an individual ip +; as the same user. Hits within this interval will +; be considered the same session for session tracking. +LastVisitCacheUpdateInterval=600 +; what tables to stuff when user registers +;RequiredUserTable=users_demographics +;RequiredUserTable=users_contact +; do we want to set each cookie on more than one hostname +; (i.e., is your site a typical "foobar.com" and "www.foobar.com" case) +NeedCookieChainP=0 +CookieChainFirstHostName=yourdomain.com +CookieChainSecondHostName=www.yourdomain.com +; do we have legacy users for whom we created +; accounts from old bboard postings (keyed by email address)? +UsersTableContainsConvertedUsersP=0 +; Primarily for WimpyPoint, but may be useful to other modules +PathToACS=/web/yourservername +; Where is the global directory for such things as file-not-found +; error messages +GlobalURLStub=/global +; for how long can a be session inactive before it times out? (in seconds) +SessionTimeout=86400 +; how often should we reissue the session_id cookie (to prevent expiration) +; and update last_hit in the sessions table? +SessionCookieReissue=600 +; how long after the last hit should we save information in the SessionLifetime +; table? +SessionLifetime=176800 +; how many characters long are the tokens used for authentication? +TokenLength=32 +; how long to cache session information for? +SessionInfoCacheInterval=600 +; use the old login process where email and password are on separate pages? +SeparateEmailPasswordPagesP=0 +; log detailed information about security and sessions for which hosts? +; useful for troubleshooting; remove to log for none +; LogSecurityMinutia= +; if a user provides a Host header which isn't this, redirect the user to +; this particular host. e.g., if yourservername.com and www.yourservername.com +; point to the same IP, set this to 1 so cookies will be properly set. +ForceHostP=1 + +; stuff having to do with what and how we collect info from users +; upon registration and at various stages afterward +; (for legacy reasons, some of the stuff that should go here is +; actually in the main acs section above) +[ns/server/yourservername/acs/user-info] +SolicitPortraitP=1 +; Maximum portrait size in bytes. Leave empty for no limitation. +MaxPortraitBytes=200000 +; if you have ImageMagick configured, try to +; producte thumbnails? +ProduceThumbnailsAutomaticallyP=0 +AcceptablePortraitMIMETypes=image/gif image/jpeg + +; stuff having to do with the physical computer on which +; this ACS is running. Some scripts may adjust their behavior +; according to what operating system or perhaps the machine power +; (e.g., /admin/static/link-check.tcl will sleep for 1 second +; periodically on wimpy machines) +[ns/server/yourservername/acs/machine] +; probably best to consider any machine with only one CPU as wimpy +WimpyMachineP=1 + +; address information for a cluster of load-balanced servers (to enable +; distributed util_memoize_flushing, for instance). +[ns/server/acs-staging/acs/server-cluster] +; is clustering enabled? +ClusterEnabledP=0 +; which machines can issues requests (e.g., flushing) to the cluster? +;ClusterAuthorizedIP=209.67.242.* +; which servers are in the cluster? This server's IP may be included too +;ClusterPeerIP=209.67.242.171 +;ClusterPeerIP=209.67.242.172 +; log clustering events? +;EnableLoggingP=1 + +; stuff having to do with the ArsDigita Community System software +; itself, e.g., workarounds for bugs +[ns/server/yourservername/acs/acs] +LogCLOBdmlP=1 + +; stuff having to do with abstract urls (doc/abstract-url.html) +[ns/server/yourservername/acs/abstract-url] +; enable abstract url handling? +EnableAbstractURLsP=1 +; precedence for file extensions, e.g., "tcl,adp,html" means "serve +; a .tcl file if available, else an .adp file if available, else an +; .html file if available, else the first file available in alphabetical +; order". Comma-separated +ExtensionPrecedence=tcl,adp,html,jpg,gif + +; stuff having to do with user groups +[ns/server/yourservername/acs/ug] +CacheTimeout=600 +;this will be part of url where groups can access their webpages +;e.g. if GroupsDirectory=groups and group short name is travel at photo.net +;then group travel will have it's user pages accessible at photo.net/groups/travel +;note that this is not the same as the file system directory for the group system files +GroupsDirectory=groups +;this sets the part of url needed to access group admin pages +;when GroupsDirectory=groups and GroupsAdminDirectory=admin then group admin +;pages for group with short_name travel will be accessible at photo.net/groups/admin/travel +;note that this is not the same as the file system directory for the group admin pages +GroupsAdminDirectory=admin + +; general anti-spam stuff, useful system-wide +; esp. for IP address ranges that we don't like +; we want GLOB patterns to feed to [string match ..] +; and we want a policy decision about whether to pretend +; to be broken or be explicit that they've been banned +[ns/server/yourservername/acs/antispam] +FeignFailureP=1 +;IPglob=209.114.173.* +;IPglob=209.114.172.* +; to block out one single address +;IPglob=209.114.172.46 +; we don't allow users to submit HTML containing any of these tags +NaughtyTag=div +NaughtyTag=font + +; stuff having to do with the user's workspace +[ns/server/yourservername/acs/pvt] +; WorkspacePageDecoration= an image +; AlertPageDecoration=Alex in front of the Green Building. Massachusetts Institute of Technology + +[ns/server/yourservername/acs/content] +; do we serve the generated index.tcl page or something else +; from the file system? +; SpecialIndexPage=/index.html +; SiteMap=/site-map.html + +; stuff for dealing with static pages +[ns/server/yourservername/acs/static] +; this has to be a complete REGEXP with | for or's; \.html?$ will match .htm or .html +; \.html?$|\.adp$ will pull .adp pages into the table as well. +IncludeRegexp=\.html?$ +; URL stub to exclude, Tcl GLOB syntax, include leading / +; used by /admin/static/static-syncer-ns-set.tcl +ExcludePattern=/pvt/* +ExcludePattern=/global/* +ExcludePattern=/graphics/* +ExcludePattern=/admin/* + +[ns/server/yourservername/acs/bboard] +PartialUrlStub=/bboard/ +; SystemName=Yourdomain Network Discussion Forums (default) +; SystemOwner= something different (if desired) from SystemOwner above +; HostAdministrator=something different from system-wide +SenderEmail=bboard-robot@yourdomain.com +; IndexPageDecoration=Downtown Munich. +; ActivePageDecoration= +; do we offer users a full-text search box +ProvideLocalSearchP=1 +; do we use Oracle's Context option (only works if +; ProvideLocalSearchP=1) +UseContext=0 +; do we use standalone PLS search system +UsePLS=0 +; do we use AltaVista (only works if ProvideLocalSearchP=0 +; and if the site's content is exposed to AltaVista) +LinktoAltaVista=0 +; anything below this threshold is considered uninteresting +InterestLevelThreshold=4 +; can a user start a new bboard +UserCanAddTopicsP=0 +; link bboard permissions to AOLserver user; this is legacy +; code for ASME and probably doesn't work +UseNsPermAuthorizationP=0 +FileUploadingEnabledP=1 +; this path does *not* contain a trailing "/" +FilePath=/web/foobar/ +; Urgent messages +UrgentMessageEnabledP=0 +DaysConsideredUrgent=14 +; Enables per-thread email alerts. +EnableThreadEmailAlerts=1 + +[ns/server/yourservername/acs/news] +; open means stuff goes live immediately +; wait means stuff waits for administrator to approve +; closed means only administrator can post +ApprovalPolicy=wait +; how many days a story is live (by default) +DefaultStoryLife=30 +; When we display news items on a users workspace, what is the maximum +; number of items that we display? This lets us display the 10 most +; recent items easily w/out limiting the number of active stories +; Leave blank to display all +DefaultNumberOfStoriesToDisplay= +; SystemOwner= (defaults to site owner) +; do we allow users to comment on news +SolicitCommentsP=1 +CommentApprovalPolicy=wait +IndexPageDecoration=Nick Gittes and Alex. 1998. +ItemPageDecoration= + +[ns/server/yourservername/acs/calendar] +SystemName=Calendar +; open means stuff goes live immediately +; wait means stuff waits for administrator to approve +; closed means only administrator can post +ApprovalPolicy=wait +MaxEventsOnIndexPage=15 +; defaults for users, depends on type of service +DaysFromPostingToStart=30 +DaysFromStartToEnd=0 +; show an event a few days after it ends? +DaysFromEndToExpiration=3 +; how many days a story is live (by default) +; SystemOwner= (defaults to site owner) +SolicitCommentsP=1 +CommentApprovalPolicy=open +TitleExample=Ansel Adams show at Getty Center in Los Angeles, March 1-June 15 +; do we ask for country, state, city info? +EventsHaveLocationsP=1 + +; for the classified ad system +[ns/server/yourservername/acs/gc] +; SystemName= +; SystemOwner= (defaults to global system owner) +PartialUrlStub=/gc/ +ProvideLocalSearchP=1 +ProvideEmailAlerts=1 +; send a reminder to people to edit or delete their ads? +NagAdOwners=1 +HowManyRecentAdsToDisplay=5 +; How many bids an auction must collect to qualify as a "hot" auction. +HotAuctionThreshold=2 +; some stuff to deal with annoying photo.net abusers +; don't let people put the word "reduced" in subject line +DisallowReducedInSubject=1 +DisallowExclamationPointInSubject=1 +DisallowAllUppercase=1 +DisalloweBay=1 +IncludeBannerIdeasP=0 +; IndexPageDecorationTop=The open-air market in the Campo de Fiori (Rome) +; IndexPageDecorationSide=The open-air market in the Campo de Fiori (Rome) +; DomainTopDecorationTop=The open-air market in the Campo de Fiori (Rome) +; HotAuctionsDecoration=Money for beer. Times Square, 1995. +; PlaceAdDecoration=Rolls Royces. Getty Center underground garage. Los Angeles, California. +; PlaceAd2Decoration=Rolls Royces. Getty Center underground garage. Los Angeles, California. +; EditAd2Decoration= +; AddAlertDecoration=Boykin Spaniel in Harvard Yard. Cambridge, MA 1998. +SolicitCommentsP=1 +CommentApprovalPolicy=open + + +; have the system write PICS headers for naughty pages +; or directories +; if EnabledP is 1 you can have as many +; NaughtyPatterns as you like; these are fed to +; ns_register_filter +[ns/server/yourservername/acs/pics] +EnabledP=0 +NaughtyPattern=/nudebabes/* +NaughtyPattern=/doc/* +; a PICS header has to all be on one line anyway +Protocol={PICS-1.1 {headers PICS-Label}} +Label={(PICS-1.1 "http://www.rsac.org/ratingsv01.html" l gen true comment "RSACi North America Server" by "philg@mit.edu" for "http://photo.net/photo/christina/" on "1998.03.13T18:06-0800" r (n 4 s 0 v 0 l 0))} + +[ns/server/yourservername/acs/contest] +OfferIndexPageP=1 +ContestAdminOwner=contestprogrammer@yourdomain.com + +[ns/server/yourservername/acs/adserver] +; the location of the adserver .tcl pages in the file system (typically /adserver/) +; note the trailing slash; also note that this isn't where ads go +PartialUrlStub=/adserver/ +DefaultAd=/ads/scorecard.gif +DefaultTargetUrl=http://www.scorecard.org +DetailedPerUserLoggingP=0 + +; the Neighbor to Neighbor service (sort of like bboard; +; http://photo.net/photo/ is probably the best example of this in use ) + +[ns/server/yourservername/acs/neighbor] +; SystemName=Yourdomain Neighbor to Neighbor Service +; SystemOwner= something different (if desired) from SystemOwner above +; HostAdministrator=something different from system-wide +; if you're only going to run one little category, and +; for backward compatibility for photo.net +; this is a category_id referencing the n_to_n_primary_categories +; table +DefaultPrimaryCategory=1 +; if someone can't think of more than one; affects links from opc.tcl +OnlyOnePrimaryCategoryP=0 +; do we offer users a full-text search box +ProvideLocalSearchP=1 +; do we use Oracle's Context option (only works if +; ProvideLocalSearchP=1) +UseContext=0 +; do we use standalone PLS search system +UsePLS=0 +; do we use AltaVista (only works if ProvideLocalSearchP=0 +; and if the site's content is exposed to AltaVista) +LinktoAltaVista=0 +SolicitCommentsP=1 +CommentApprovalPolicy=wait +NReasonablePostings=100 + +; the clickthrough module (/tcl/ad-clickthrough.tcl) + +[ns/server/yourservername/acs/click] +; CustomREGEXP=/ct/philg(/.+)$ + + +; the referer module (/tcl/ad-referer.tcl) + +[ns/server/yourservername/acs/referer] +; domains to exclude from referer tracking +LocalDomain=yourdomain.com +LocalDomain=www.yourdomain.com +; if any of these are set, we require at least one to be true +; (if you don't set these, you'll get lots of referrals from random +; local files and "bookmarks"; trust us) +InclusionGLOB=http://* +InclusionGLOB=HTTP://* + + +; the data warehouse module + +[ns/server/yourservername/acs/dw] +DefaultTable=ad_hoc_query_view +; SystemName=yourdomain data warehouse + +; redirects, separate by vertical bar (we could just do +; FROM=TO but that's bad because sometimes we might want to +; redirect based on an = char, also we want to spec Inherit +; or JustOne (whether to do everything beginning with /foo +; or just "/foo" exactly) +; +; Another interesting option is Pattern=, which lets you say +; "redirect /~philg/whatevercomesnext to /philg/whatevercomesnext" +; (rather than just redirecting /~philg/* to a fixed location) +; + +; for the address book +[ns/server/yourservername/acs/addressbook] +SendBirthdayAlerts=1 + +[ns/server/yourservername/acs/comments] +; email notifications to author/ad_system_owner +EmailNewUnansweredQuestion=1 +EmailNewAlternativePerspective=1 +EmailNewRating=1 +EmailEditedUnansweredQuestion=1 +EmailEditedAlternativePerspective=1 +EmailEditedRating=1 + +[ns/server/yourservername/acs/general-comments] +; Whether or not we accept file uploads for general comments. +AcceptAttachmentsP=1 +; Maximum attachment size in bytes. Leave empty for no limitation. +MaxAttachmentSize=5000000 +AdminEditingOptionsInlineP=0 +; Images with widths less than this parameter will be displayed inline. +InlineImageMaxWidth=512 +; Use titles/one-lines for comments? +UseTitlesP=1 + +[ns/server/yourservername/acs/general-links] +; use link clickthroughs? +ClickthroughP=1 +; allow suggested links from /general-links/index.tcl? +AllowSuggestionsP=1 + +[ns/server/yourservername/acs/links] +; email notifications to author/ad_system_owner +EmailNewLink=1 +EmailEditedLink=1 +; use link clickthroughs? +GeneralLinksClickthroughP=1 + +[ns/server/yourservername/acs/redirect] +; Inherit=/from/|/to/ +; JustOne=/randomoldfileonthisbox.html|http://www.otherpersonsserver.com/ +; Pattern=/olddir/|/newdir/ +Pattern=/pvt/address-book|/address-book + +; for the /directory module wherein users get to look each other up +[ns/server/yourservername/acs/directory] +ProvideUserBrowsePageP=1 +UserBrowsePageLimitedToNotNullUrlP=1 +;IndexPageDecoration=Snowy Owl. +;BrowsePageDecoration=Orangutan. Audubon Zoo. New Orleans, Louisiana. +;SearchResultsDecoration= + +; for the module that bills members or figures out which are losers +[ns/server/yourservername/acs/member-value] +EnabledP=0 +UseRealMoneyP=0 +; currency should be a three-char code that CyberCash likes, e.g., "USD" +Currency=USD +; if true, check mv_monthly_rates +ChargeMonthlyP=0 +ClassifiedAdRate=0 +ClassifiedAdMistakeRate=5 +ClassifiedAdSpamRate=25 +QuestionRate=0 +; people who don't look in archives +QuestionDupeRate=5 +QuestionOffTopicRate=25 +AnswerRate=0 +; deleted because inaccurate +AnswerWrongRate=5 +AnswerMistakeRate=2 +; we might credit people for a good submission +CommentRate=-5 +CommentDupeRate=5 +CommentSpamRate=25 +LinkRate=0 +LinkDupeRate=5 +LinkSpamRate=25 +BillingInterval=month +; wait until next interval if accumulated charges are less +; than this amount +BillingMinimum=7.50 +; set this if you want notification of member value charges to go +; somewhere other than AdminOwner +; NotificationEmail= +; what amount of money do we consider moves a user into the +; "expensive" class (bad for the site) +ExpensiveThreshold=20 + +; for the Content Tagging Package +; (PG|R|X)LogP=1 logs the potentially offensive material +; (PG|R|X)BounceP=1 prevents the offensive material from being posted at all +; (PG|R|X)BowdlerizeP=1 replaces relevant words with BowdlerizationText +; Note that in generally, you can't bounce only PG and X, but not R, +; the scripts find the lowest allowed naughtiness to bounce or log. +[ns/server/yourservername/acs/content-tagging] +; email address to notify if something needs attention +; defaults to SystemOwner +; Administrator= +; log into naughty_events table +PGLogP=0 +RLogP=1 +XLogP=1 +; prevent this level of stuff from being posted at all +PGBounceP=0 +RBounceP=0 +XBounceP=1 +; send email to Administrator +PGNotifyP=0 +RNotifyP=0 +XNotifyP=1 +; bowdlerize text +PGBowdlerizeP=0 +RBowdlerizeP=1 +XBowdlerizeP=1 +BowdlerizationText=**** +; what do we mask off for unlogged-in users +DefaultContentMask=0 +CacheTimeout=600 +UserContentMaskCacheTimeout=600 + +; for the ACS Chat System +[ns/server/yourservername/acs/chat] +EnabledP=1 +; SystemName=Chat +; how long to cache the postings to a room (updates force a cache update +; so this theoretically could be 5 hours or whatever) +CacheTimeout=120 +; how long will a room's properties (e.g., private group, moderation) be cached +RoomPropertiesCacheTimeout=600 +UsersCanCreateRoomsP=0 +; set to 1 if you want most recent postings on top; this is the way that +; theglobe.com and other familiar chat systems do it (keeps users from +; having to scroll to see new msgs) +MostRecentOnTopP=1 +; do we want to offer users the option of sending private messages? +PrivateChatEnabledP=0 +; do we offer users a link to a chat room's history? +ExposeChatHistoryP=1 +; how many messages to display when users choose short medium or long +NShortMessages=25 +NMediumMessages=50 +NLongMessages=75 +; show a picture at the index page and in individual rooms? +DefaultDecoration=Mouth. +; how often the javascript version should refresh itself +JavaScriptRefreshInterval=5 + +[ns/server/yourservername/acs/mailing-list] +IndexPageDecoration=Mailboxes and a Dalmatian, in Cortina + +[ns/server/yourservername/acs/sidegraphics] +EnabledP=1 +/bboard/index.tcl=http://photo.net/photo/pcd0796/linderhof-front-door-23.2.jpg + + +[ns/server/yourservername/acs/glossary] +; open means stuff goes live immediately, user can edit own terms +; wait means stuff waits for administrator to approve, +; only administrator can edit +; closed means only administrator can post +ApprovalPolicy=closed + +[ns/server/yourservername/acs/robot-detection] +; the URL of the Web Robots DB text file +WebRobotsDB=http://info.webcrawler.com/mak/projects/robots/active/all.txt +; which URLs should ad_robot_filter check (uncomment to turn system on) +; FilterPattern=/members-only-stuff/*.html +; FilterPattern=/members-only-stuff/*.tcl +; the URL where robots should be sent +RedirectURL=/robot-heaven/ +; How frequently (in days) the robots table +; should be refreshed from the Web Robots DB +RefreshIntervalDays=30 + +; stuff for templates, multi-lingualism +[ns/server/yourservername/acs/style] +; where to find templates, typically /web/yourservername/templates +; (note lack of trailing slash, just like the pageroot) +; you can override it with this config param +; TemplateRoot= +; do we look for language-specific templates, e.g., foobar.en.adp? +; (and do we offer user interface to help user choose) +MultiLingualP=0 +; most publishers will want the language of Jesus Christ and the Bible +; to be the default (i.e., English ("en")), if only because there is so much +; embedded English UI in subsystems of the ACS +LanguageSiteDefault=en +; offer people a language choice without logging in? +LanguageCookieP=1 +; do we look for plain. and fancy. templates, e.g., foobar.plain.adp? +; (and do we offer user interface to allow user to choose) +PlainFancyP=1 +; most publishers will want "fancy" to be preferred (if available) +PlainFancySiteDefault=fancy +; offer people a graphics choice without logging in? +PlainFancyCookieP=1 + +; for the ticket tracking system +[ns/server/yourservername/acs/ticket] +; when sending a note to an admin or engineer about a trouble +; ticket, what reply-to: address to use +; note that this address must be set up through your mail transfer +; agent to run a email enqueueing script. +; See doc/ticket.html for more info on configuring the ticket system. +; (from /web/yourservername/bin/queue-message.pl) +TicketReplyEmail=support-ticket-robot@yourdomain.com +; The PicklistData specifies additional custom data fields you would like +; associated with tickets in the database. You can have up to five of these. +;PicklistData=hardware_model "Hardware Model" picklist_single_select data1 "" "1000 (Merced)" "2500 (Charles)" "5000 (Connecticut)" +;PicklistData=software_version "Software Version" picklist_single_select data2 "" "FooOS 1.0" "FooOS 1.0-EFT" "FooOS==OS 1.6" "FooOS 2.0" +; PicklistData=build "Build" text data4 25 +; if LinkTicketToUserGroupP = 1, each ticket is assigned to a user group +; a user must be in the group to see the ticket +LinkTicketToUserGroupP=0 +; If CustomerCanCreateNewTickets = 1, customers may create new tickets. +; (A "customer" is any user who is not in the ticket admin group) +CustomerCanCreateNewTickets=1 +; The menu of ticket severity choices +SeverityList=low medium serious critical showstopper + + +; to tell the email queue system where to dispatch +; all of this is based on tags supplied by the mail-transfer agent +[ns/server/yourservername/acs/email-queue] +; how often to check the queue for new messages +;QueueSweepInterval=300 +; what to do with a new message +; format is tag|tcl_proc_to_invoke +;DispatchPair=ticket-tracker|ticket_process_message + + +[ns/server/yourservername/acs/intranet] +IntranetName=yourdomain Network +IntranetEnabledP=0 +DisplayVacationsOnCalendar=1 +; the unit of measurement for entering salaries (month or year) +SalaryPeriodInput=year +; used to display salary +SalaryPeriodDisplay=year +; list of fee types +FeeTypes="setup" "monthly development" "monthly hosting" "hourly" "stock" +; Do we want to track hours? +TrackHours=1 +; what's the url stub? i.e. http://yourdomain.com +IntranetUrlStub=/intranet +; Group Types +IntranetGroupType=intranet +ProjectGroupShortName=project +OfficeGroupShortName=office +CustomerGroupShortName=customer +PartnerGroupShortName=partner +ProcedureGroupShortName=procedure +EmployeeGroupShortName=employee +AuthorizedUsersGroupShortName=authorized_users +; What color do we put in the header row of tables? +TableColorHeader=#e6e6e6 +; What color do we put in the odd numbered rows of tables? +TableColorOdd=#f4f4f4 +; What color do we put in the even numbered rows of tables? +TableColorEven=#ffffff +CommentApprovalPolicy=open +; If we want to include people who are delinquent with project +; reports in our status-report, what user_class_id do we use? +; Leave blank to skip this part of the status report +UserClassStatusReportID= + + +[ns/server/yourservername/acs/help] +; Root of the help directory hierarchy, relative to the PageRoot. +; Same as page root if not set. +; HelpPageRoot=/help + +[ns/server/yourservername/acs/fs] +SystemName=File Storage System +; optional, defaults to main site owner +; SystemOwner=fs-admin@yourdomain.com +DefaultPrivacyP=f +; do you want to maintain a public tree for site wide documents +PublicDocumentTreeP=1 +MaxNumberOfBytes=2000000 +HeaderColor=#cccccc +DatePicture=MM/DD/YY HH24:MI +FileInfoDisplayFontTag= +UseIntermediaP=0 +; Display mappings for file types. +; Format is pipe separated list of display string followed by +; MIME types. Types can use * and ? as wildcards. +; For anything not on the list, the default is to display +; the first portion of the MIME type, except in the case of +; application/, where the sub-type is displayed. +FileTypeMap=Image|image/* +FileTypeMap=Word Document|application/msword|application/rtf +FileTypeMap=Excel|application/msexcel +FileTypeMap=PowerPoint|*powerpoint +CommentApprovalPolicy=open + + +; for the ecommerce module +[ns/server/yourservername/acs/ecommerce] +; set to 1 if you're using the ecommerce module +EnabledP=0 +WeightUnits=lbs +Currency=USD +; this is used on the category browse page (and for subcategories/subsubcategories) +ProductsToDisplayPerPage=10 +; whether to allow user comments on products +ProductCommentsAllowP=1 +; whether user comments on products (if allowed) need approval before becoming live +ProductCommentsNeedApprovalP=1 +; whether the system should calculate additional product relationships +CalcProductRelationshipsP=0 +; whether users can see what user classes they are in +UserClassUserViewP=1 +; whether a user can request to be a member of a user class +UserClassAllowSelfPlacement=1 +; if a user requests to be in a user class, is approval required before that +; user becomes a member of the user class +UserClassApproveP=1 +; what percentage of an item's shipping cost should be refunded if an item is returned +ShippingRefundPercent=0 +; whether to allow express shipping +ExpressShippingP=1 +; whether to save credit card data (you have to save it if you're going to do manual billing) -- +; if you save it, then your users can reuse their credit card with one click +SaveCreditCardDataP=1 +; for thumbnails of products, specify either width or height (whichever is +; more important, and then the other will be determined based on the +; original image size, keeping aspect ratio constant) -- if both are +; specified, the width setting will take precedence, and if neither +; is specified, the thumbnail will be width=100 +ThumbnailWidth=100 +; ThumbnailHeight=100 +; stock status messages +; o = out of stock, q = ships quickly, +; m = ships moderately quickly, s = ships slowly +StockMessageO=Out of Stock +StockMessageQ=Usually Ships Within 24 Hours +StockMessageM=Usually Ships Within 2-3 Days +StockMessageS=Usually Ships Within 2-4 Weeks +StockMessageI=In Stock +; # of days an 'in_basket' order will remain in +; the system before a cron job expires it +CartDuration=30 +; whether customers will be able to place orders +; for items whose available_date has not yet come +AllowPreOrdersP=1 +; all outgoing email is sent from this address +CustomerServiceEmailAddress=service@yourdomain.com +; you may or may not wish to have the people recording +; shipments receive messages like "unable to authorize +; payment for shipment" -- depending on whether they +; they're in a position to do anything about the problem +; (e.g. abort shipment) +DisplayTransactionMessagesDuringFulfillmentP=1 +; whether to allow users to buy gift certificates +SellGiftCertificatesP=1 +; minimum gift certificate amount they can buy +; (this does not impose minimum amount for administrators +; giving users gift certificates) +MinGiftCertificateAmount=5 +; maximum gift certificate amount they can buy +MaxGiftCertificateAmount=300 +; number of months until user-purchased gift certificates +; expire +GiftCertificateMonths=12 +; **Everything above this is a publishing decision.** +; **Everything below this is a technical parameter.** +; domain of the site -- I know other modules have this, but they +; might not be installed and this is needed so that I can redirect +; the shopping cart to https +LocalDomain=yourdomain.com +; the directory that the ecommerce module is in +EcommerceDirectory=/web/yourservername/www/ecommerce/ +; web path to the directory that the ecommerce user files are in +EcommercePath=/ecommerce/ +; path to Product data directories (where product files like images are kept) +EcommerceDataDirectory=/web/yourservername/data/ecommerce/ +; This path goes on the end of the EcommerceDataDirectory +ProductDataDirectory=product/ +; Set to 1 if you have a comparison shopping service -- Note: support for +; multiple retailers does not work yet in Version 1.0 of the Ecommerce +; Module, so leave it as 0 +MultipleRetailersPerProductP=0 + +; for the ACS Bookmarks System +[ns/server/yourservername/acs/bm] +; optional, defaults to main site owner +SystemOwner=someguy@yourdomain.com +; main page title +SystemName=Bookmarks System +; text decoration for dead links +DeadDecoration= +; text decoration for folders +FolderDecoration= +; text decoration for bookmarks invisible to the public +HiddenDecoration= +; background color of folders +FolderBGColor=#f3f3f3 +; background color of files +BookmarkBGColor=#ffffff +; size of largest bookmarks file permissible to upload +MaxNumberOfBytes=2000000 + +[ns/server/yourservername/acs/curriculum] +EnabledP=0 +; does ad_footer put this in every dynamic page? +StickInFooterP=1 +; does ad_serve_html_page put this on every static page? +StickInStaticPagesP=1 +; on which URLs should the system look for/set cookies +FilterPattern=*.html +FilterPattern=*.tcl +BarFontTag= +HelpAnchorText=? +; stuff like a background color for the table cells, goes within a TD +CellExtraTags=bgcolor=#EEEEEE + +[ns/server/yourservername/acs/crm] +; how often to update the CRM states +UpdatePeriodHours=24 + +[ns/server/yourservername/acs/portals] +Administrator=portaladmin@yourdomain.com +AdministratorName=Portal Administrator +SystemName=yourdomain portals +; set to 1 if individual may create their own portals +AllowUserLevelPortals=1 +; set to 1 if super administrator can add or remove themselves and other super administrators +SuperAdminCanChangeSuperAdminP=0 +BodyTag= +FontTag= +; These standardize a prettier table than the browser default +BeginTable=
+EndTable=
+HeaderTD= +HeaderBGColor=#006600 +SubHeaderTD= +SubHeaderBGColor=#eeeedd +NormalTD= +; For portals with multiple pages, tabs link to the other pages, set this to 1 if you want each tab +; to be equal width instead of proportional to the name of the page +EqualWidthTabsP=0 +MainPublicURL=/portals/ +; number of seconds to memoize a portal page +CacheTimeout=100 +; browsers will decide the "optimal" column sizes unless you force column widths here: +;LeftSideWidth= +;RightSideWidth= +SpacerImage=/portals/spacer.gif +PortalExtension=.ptl + +[ns/server/yourservername/acs/press] +; maximum number of press items to display on the press coverage page +DisplayMax=10 +; number of days a press item remains active +ActiveDays=60 +; do we use clickthrough tracking from the press coverage page? +ClickthroughP = 1 + +[ns/server/yourservername/acs/monitoring] +; People to email for alerts +; PersontoNotify=nerd1@yourdomain.com +; PersontoNotify=nerd2@yourdomain.com +; location of the watchdog perl script +WatchDogParser=/web/yourservername/bin/aolserver-errors.pl +; watchdog frequency in minutes +WatchDogFrequency=15 + + + +[ns/server/yourservername/acs/site-wide-search] +; BounceQueriesTo=http://backup.photo.net +; BounceResultsTo=http://photo.net + +[ns/server/yourservername/acs/display] +;specify the maximum size of a logo +MaxLogoSize=500000 + +[ns/server/yourservername/acs/custom-sections] +;specify the maximum size of a binary file that can be uploaded for a content section +MaxBinaryFileSize=2000000 + +[ns/server/yourservername/acs/download] +; root directory of the downloadable files +DownloadRoot=/web/yourservername/download/ + +[ns/server/yourservername/acs/wp] +; Paths to use for serving styles and presentations. +StyleURL=/wp/style/ +PresentationURL=/wp/display/ +PresentationEditURL=/wp/display-edit/ +AttachURL=/wp/attach/ +SolicitCommentsP=1 +CommentApprovalPolicy=open +; Path to the unzip program to use for bulk image uploading. +PathToUnzip=/usr/bin/unzip +; Is bulk image uploading enabled? +AllowBulkUploadP=1 + +[ns/server/yourservername/acs/users] +; all user web content will be rooted under this directory. This +; directory will be the root of all the web content being published +; by the users of the system. +ContentRoot=/web/yourservername/users/ +; Maximum quota for a 'normal user' (a lesser mortal who is not the +; site wide administrator) of the site in mega-bytes. For example, a +; '20' corresponds to 20,971,520 bytes. Values need not be integer. +; Value is overridden for a particular user throught existence of +; entry in the users_special_quotas table. +NormalUserMaxQuota=5 +; Maximum quota for site wide administrators. Special quotas can be +; set by adding rows to the users_special_quotas table. This param +; will be used for a site wide administrator only when he/she doesnt +; have an entry in the users_special_quotas table. +PrivelegedUserMaxQuota=20 +; Space taken by a directory (in bytes). We need this so that a user +; cannot crash the system by creating millions of directories. This +; will ensure that a directory detracts from his/her quota. +DirectorySpaceRequirement=2048 +; This determines the default view for displaying files in home-page +; administration (maintenance) pages. There are two supported values +; for this: tree and normal. +DefaultView=normal +; This is the list of files that are served as index pages. If all +; of these files are nonexistant in a directory requested through +; the homepage content server (hp_serve), then the server generates +; a default (personalized) index page for the user. If more than one +; of these files exist in the requested directory, the filename +; which appears earliest in this list is given preference. If no +; filename is provided below then the server always generates index +; pages. In most systems, the index.html, index.htm, and Default.htm +; are the index filenames. In some systems home.html is also an +; index file but generally this is used whenever users want to give +; the world read/browse access to their web directories. In this +; regard, home.html should not be added to the candidacy list. +; Finally, it is obvious that if one of these files exist in the +; directory then the web-browser cannot obtain a lisitng of all the +; files in the directory. +IndexFilenameCandidacyList=index.html index.htm Default.htm +; what if a site gets really large and the primary purpose is giving +; members personal homepages (e.g., if an adopter of ACS decides to +; become "The GeoCities of Brazil")? How do we support this? First, +; users could decide to join user groups. Then the /users/ index +; page would show a summary of user groups whose members have +; personal pages. This requires no new data in Oracle. This is +; enabled with SubdivisionByGroupP=1 in the .ini file. Users with +; homepages and no group affiliation show up in "unaffiliated" (fun +; with OUTER JOIN). When SubdivisionByNeighborhoodP=1, we either +; keep a denormalized neighborhood_sortkey in the homepages table +; and flag the "homepages" that are actually neighborhood folders or +; have some separate tables holding categorization. (philg). +SubdivisionByNeighborhoodP=0 +; This parameter will determine whether we'll be showing appropriate +; options on the user's workspace or not. This will also determine +; whether this system offers homepages or not. In effect, this +; parameter determines whether the homepage facility is enabled or +; not. This does not effect the users administration pages, though. +HomepageEnabledP=1 + +[ns/server/yourservername/acs/spam] +; Pairs of {email_addr_pattern pseudo-mime-type} +EmailTypes={%@hotmail.com text/html} {%@aol.com text/aol-html} +DailySpamDirectory=/web/yourservername/spam +RemovalBlurb={-----\nSent through http://yourdomain.com\n\n} + +[ns/server/yourservername/acs/gp] +; can we give row-level permissions to groups as well? +GroupPermissionsP=1 +; do we want comment permissions? +CommentPermissionsP=1 +; do we want to show our user list to people editing permissions? +ShowUsersP=0 +; do we want to show a Finish button on the edit-page-permissions page? +ShowFinishButtonP=1 + +[ns/server/yourservername/acs/pdm] +; Flag to display the administration menu bar +MenuOnAdminPagesP=0 +; Flag to display the default menu bar on non-/admin pages +MenuOnUserPagesP=0 + +[ns/server/yourservername/acs/partner] +; what is the name of the default partner cookie? +CookieDefault=ad +; All the variables we want to collect (Any variables added here +; must still be manually added to the data model.) +; Each line of Variable= contains a pipe separated pair of +; name_of_column in ad_partner | what to display on the add/edit forms +Variable=partner_name|Partner Name +Variable=partner_cookie|Partner Cookie +Variable=default_font_face|Default Font Face +Variable=default_font_color|Default Font Color +Variable=title_font_face|Title Font Face +Variable=title_font_color|Title Font Color + +; The Software Development Manager (SDM) +[ns/server/yourservername/acs/sdm] +UrlStub=/sdm +SoftwareRoot=/web/yourservername/sdm-software +SdmVersion=0.4 +NotificationSenderEmail=robot@yourservername.com +SystemName=Software Development Manager +DefaultSeverity=medium +ListOfSeverities=low medium high critical + +; The Todo List Manager (todo) +[ns/server/yourservername/acs/todo] +UrlStub=/todo +SystemName=To-Do List Manager +Administrator=admin@yourservername.com + +; The Cybercash Stub +; This stub will replace the cc_send_to_server_21 proc +; and fake the cybercash action for testing purposes +; this necessitates cybercash-stub.sql in the data model +; directory, make sure to load it before you start. +[ns/server/yourservername/acs/ccstub] +EnabledP=0 + +;to be able to restart the aolserver from the admin page, +;INIFile must have the path and name of the config file. +;ie: /web/aolserver/yourservername.ini +;To disable, leave INIFile blank +[ns/server/yourservername/acs/restart] +INIFile= + +[ns/server/yourservername/acs/webmail] +;This module requires the aolserver module nsjava. +;See http://nsjava.sourceforge.net +WebmailEnabledP=0 +;Time interval for sceduling processing of the +;incoming mail queue. +ProcesssQueueInterval=60 +;Alias and queue directory. See .../doc/webmail.html +;for explanation of their purpose. +AliasDirectory=/home/nsadmin/qmail/alias +QueueDirectory=/home/nsadmin/qmail/queue/ + +[ns/server/yourservername/acs/chunks] +NewsCacheLength=7200 +MaxNews=3 +MaxNewsBodyLength=120 + +BboardCacheLength=7200 +MaxBboardThreads=5 +MaxMsgBodyLength=120 +CountOldMessages=10 + +EventsCacheLength=7200 +MaxEvents=5 +MaxEventBodyLength=120 + +ClassifiedsCacheLength=7200 +MaxAds=5 + +AuctionsCacheLength=7200 +MaxAuctions=5 +CountOldBids=10 + + +; Local Variables: +; eval: (auto-save-mode 0) +; End: + Index: web/openacs/parameters/ad.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/parameters/ad.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/parameters/ad.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,1454 @@ + # AOLserver reads these files when the server starts up and stores + # parameters in an in-memory hash table. So you have to restart the + # server if you want to test a change made to this file. + # + # Modified by roberto@brasileiro.net - May 2000 + # Assuming you have the following line in your AOLserver's nsd.tcl: + # set server "yourservername" + # where "yourservername" is how you are naming that server. + + +ns_section ns/server/${server}/acs + + ns_param SystemName "yourdomain Network" + + # for legal pages, full corporate entity + ns_param PublisherName "Yourdomain Network, Inc." + + # who signs the average user-visible pages + ns_param SystemOwner webmaster@yourdomain.com + + # URL to tell users to go to + ns_param SystemURL http://new.adida.net + + # who signs the admin pages, e.g., a programmer who can fix/enhance them + ns_param AdminOwner a-programmer@yourdomain.com + + # are admin users allow to write SQL queries + # (only say yes if they are not likely to crash the server) + ns_param AllowAdminSQLQueries 0 + + # stuff we want restricted to SSL (https) (filter patterns) + # note that this only takes effect if you have an SSL listener configured + # on your AOLserver + ns_param RestrictToSSL /admin* + ns_param RestrictToSSL /NS/Admin* + ns_param RestrictToSSL /NS/Db* + + # do we want to restrict the entire server to registered users + # (the content_sections facility probably could also accomplish this + # but not as simply) + ns_param RestrictEntireServerToRegisteredUsersP 0 + + # Is this server being used as a staff server? + # (only used by /pvt/home.tcl and may become legacy) + ns_param StaffServerP 0 + ns_param HostAdministrator somenerd@yourdomain.com + ns_param GraphicsSiteAvailableP 0 + + # these work for text-only and graphics site + ns_param bgcolor white + ns_param textcolor black + + # this is only for the graphics site + ns_param background /graphics/bg.gif + + # set ReadOnlyP=1 if you're going to wipe your Oracle installation + ns_param ReadOnlyP 0 + + # do we expect this to be a site visited by people + # from all over the world (in which case we might ask for + # country rather than state) + ns_param InternationalP 1 + + # is it even worth bothering asking for state and zip code? + ns_param SomeAmericanReadersP 1 + + # do we allow a persistent cookie? + # we need this for pulling times out of the database and turning + # then into ns_times; this is for standard time (don't worry about + # daylight saving's time, we figure that out by calling ns_localtime) + # United States Eastern time is -5 + ns_param HoursDifferenceFromGMT -5 + + # what two characters do we use for salting ns_crypt + # (documented at aolserver.com; doesn't matter as long + # as you don't change this after going live) + ns_param CryptSalt fb + + # admin user interface may change depending on whether we expect + # 10, 100, 1000, or 100000 users; we have "small", "medium", "large" + # as possible values, consistent with Oracle config files + ns_param NumberOfUsers medium + + # clickthrough and referral admin report defaults + # change depending on whether + # this is a dev site or a 500,000 hit/day live site + # we have "small", "medium", "large" as possible values + # we think "medium" = site like photo.net (700,000 hits/day) + ns_param TrafficVolume medium + + # general comments default approval + # open means stuff goes live immediately + # wait means stuff waits for administrator to approve + # closed means only administrator can post + ns_param DefaultCommentApprovalPolicy wait + + # general links default approval + # open means stuff goes live immediately + # wait means stuff waits for administrator to approve + # closed means only administrator can post + ns_param DefaultLinkApprovalPolicy open + + # if set, update last visit cookie according to LastVisitUpdateInterval + # so that we can support reporting of who's online. This makes last visit + # times more accurate, but increases system load (because we're also + # updating the last_visit column in the users table) + ns_param WhosOnlineP 1 + ns_param WhosOnlineDecoration "\"100th" + + # how many seconds old a last visit cookie must be before we update it + ns_param LastVisitUpdateInterval 600 + + #stuff having to do with registration and login + ns_param NotifyAdminOfNewRegistrationsP 1 + + # where to send those notes (defaults to SystemOwner) + #ns_param NewRegistrationEmailAddress admin@yourdomain.com + # send confirmation email to user after registration + ns_param EmailRegistrationConfirmationToUserP 0 + + # set this to 1 if user does not go live immediately + ns_param RegistrationRequiresApprovalP 0 + + # set this to 1 if the user has to receive and email + # and come back to the site + ns_param RegistrationRequiresEmailVerificationP 0 + + # have the system generate a random password instead of the user + ns_param RegistrationProvidesRandomPasswordP 0 + + # Encypt Passwords in the database + ns_param EncryptPasswordsInDBP 0 + + # Email users forgotten passwords + ns_param EmailForgottenPasswordP 1 + + # If so, do you choose a random a password + # (if you use encrypted password, a random password will always be generated) + ns_param EmailRandomPasswordWhenForgottenP 0 + + # if the admin changes the password, should it be mailed to the user + ns_param EmailChangedPasswordP 1 + ns_param AllowPersistentLoginP 1 + + # if so, do we default to a persistent cookie? + ns_param PersistentLoginDefaultP 1 + + # do we keep track of anonymous and logged-in browsers + # as to last_visit and second_to_last_visit + ns_param LastVisitCookiesEnabledP 1 + + # how many seconds old must a last visit cookie be before + # we consider this a new visit + ns_param LastVisitExpiration 86400 + + # how long will we associated hits from an individual ip + # as the same user. Hits within this interval will + # be considered the same session for session tracking. + ns_param LastVisitCacheUpdateInterval 600 + + # what tables to stuff when user registers + #ns_param RequiredUserTable users_preferences + #ns_param RequiredUserTable users_demographics + #ns_param RequiredUserTable users_contact + # do we want to set each cookie on more than one hostname + # (i.e., is your site a typical "foobar.com" and "www.foobar.com" case) + ns_param NeedCookieChainP 0 + ns_param CookieChainFirstHostName yourdomain.com + ns_param CookieChainSecondHostName www.yourdomain.com + + # do we have legacy users for whom we created + # accounts from old bboard postings (keyed by email address)? + ns_param UsersTableContainsConvertedUsersP 0 + + # Primarily for WimpyPoint, but may be useful to other modules + ns_param PathToACS /web/${server} + + # Where is the global directory for such things as file-not-found + # error messages + ns_param GlobalURLStub /global + + # for how long can a be session inactive before it times out? (in seconds) + ns_param SessionTimeout 86400 + + # how often should we reissue the session_id cookie (to prevent expiration) + # and update last_hit in the sessions table? + ns_param SessionCookieReissue 600 + + # how long after the last hit should we save information in the SessionLifetime + # table? + ns_param SessionLifetime 176800 + + # how many characters long are the tokens used for authentication? + ns_param TokenLength 32 + + # how long to cache session information for? + ns_param SessionInfoCacheInterval 600 + + # use the old login process where email and password are on separate pages? + ns_param SeparateEmailPasswordPagesP 0 + + # log detailed information about security and sessions for which hosts? + # useful for troubleshooting; remove to log for none + # ns_param LogSecurityMinutia "" + # if a user provides a Host header which isn't this, redirect the user to + # this particular host. e.g., if yourservername.com and www.yourservername.com + # point to the same IP, set this to 1 so cookies will be properly set. + ns_param ForceHostP 1 + + # stuff having to do with what and how we collect info from users + # upon registration and at various stages afterward + # (for legacy reasons, some of the stuff that should go here is + # actually in the main acs section above) + +ns_section ns/server/${server}/acs/user-info + + ns_param SolicitPortraitP 1 + + # Maximum portrait size in bytes. Leave empty for no limitation. + ns_param MaxPortraitBytes 200000 + + # if you have ImageMagick configured, try to + # producte thumbnails? + ns_param ProduceThumbnailsAutomaticallyP 0 + ns_param AcceptablePortraitMIMETypes "image/gif image/jpeg" + + # stuff having to do with the physical computer on which + # this ACS is running. Some scripts may adjust their behavior + # according to what operating system or perhaps the machine power + # (e.g., /admin/static/link-check.tcl will sleep for 1 second + # periodically on wimpy machines) + +ns_section ns/server/${server}/acs/machine + + # probably best to consider any machine with only one CPU as wimpy + ns_param WimpyMachineP 1 + + # address information for a cluster of load-balanced servers (to enable + # distributed util_memoize_flushing, for instance). + +ns_section ns/server/acs-staging/acs/server-cluster + + # is clustering enabled? + ns_param ClusterEnabledP 0 + + # which machines can issues requests (e.g., flushing) to the cluster? + #ns_param ClusterAuthorizedIP 209.67.242.* + # which servers are in the cluster? This server's IP may be included too + #ns_param ClusterPeerIP 209.67.242.171 + #ns_param ClusterPeerIP 209.67.242.172 + # log clustering events? + #ns_param EnableLoggingP 1 + + # stuff having to do with the ArsDigita Community System software + # itself, e.g., workarounds for bugs + +ns_section ns/server/${server}/acs/acs + + ns_param LogCLOBdmlP 1 + + # stuff having to do with abstract urls (doc/abstract-url.html) + +ns_section ns/server/${server}/acs/abstract-url + + # enable abstract url handling? + ns_param EnableAbstractURLsP 1 + + # precedence for file extensions, e.g., "tcl,adp,html" means "serve + # a .tcl file if available, else an .adp file if available, else an + # .html file if available, else the first file available in alphabetical + # order". Comma-separated + ns_param ExtensionPrecedence tcl,adp,html,jpg,gif + + # stuff having to do with user groups + +ns_section ns/server/${server}/acs/ug + + ns_param CacheTimeout 600 + + #this will be part of url where groups can access their webpages + #e.g. if GroupsDirectory=groups and group short name is travel at photo.net + #then group travel will have it's user pages accessible at photo.net/groups/travel + #note that this is not the same as the file system directory for the group system files + ns_param GroupsDirectory groups + + #this sets the part of url needed to access group admin pages + #when GroupsDirectory=groups and GroupsAdminDirectory=admin then group admin + #pages for group with short_name travel will be accessible at photo.net/groups/admin/travel + #note that this is not the same as the file system directory for the group admin pages + ns_param GroupsAdminDirectory admin + + # general anti-spam stuff, useful system-wide + # esp. for IP address ranges that we don't like + # we want GLOB patterns to feed to [string match ..] + # and we want a policy decision about whether to pretend + # to be broken or be explicit that they've been banned + +ns_section ns/server/${server}/acs/antispam + + ns_param FeignFailureP 1 + + #ns_param IPglob 209.114.173.* + #ns_param IPglob 209.114.172.* + # to block out one single address + #ns_param IPglob 209.114.172.46 + + # we don't allow users to submit HTML containing any of these tags + ns_param NaughtyTag div + ns_param NaughtyTag font + ns_param NaughtyTag script + + # stuff having to do with the user's workspace + +ns_section ns/server/${server}/acs/pvt + + # ns_param WorkspacePageDecoration " an image" + # ns_param AlertPageDecoration "\"Alex" + + +ns_section ns/server/${server}/acs/content + + # do we serve the generated index.tcl page or something else + # from the file system? + # ns_param SpecialIndexPage /index.html + # ns_param SiteMap /site-map.html + + # stuff for dealing with static pages + +ns_section ns/server/${server}/acs/static + + # this has to be a complete REGEXP with | for or's; \.html?$ will match .htm or .html + # \.html?$|\.adp$ will pull .adp pages into the table as well. + ns_param IncludeRegexp "\\.html?\$" + + # URL stub to exclude, Tcl GLOB syntax, include leading / + # used by /admin/static/static-syncer-ns-set.tcl + ns_param ExcludePattern /pvt/* + ns_param ExcludePattern /global/* + ns_param ExcludePattern /graphics/* + ns_param ExcludePattern /admin/* + + +ns_section ns/server/${server}/acs/bboard + + ns_param PartialUrlStub /bboard/ + + # ns_param SystemName "Yourdomain Network Discussion Forums (default)" + # ns_param SystemOwner " something different (if desired) from SystemOwner above" + # ns_param HostAdministrator "something different from system-wide" + ns_param SenderEmail bboard-robot@yourdomain.com + + # ns_param IndexPageDecoration "\"Downtown" + # ns_param ActivePageDecoration "" + # do we offer users a full-text search box + ns_param ProvideLocalSearchP 1 + + # do we use OpenACS search solution? + ns_param UseOpenACSSearch 0 + + # do we use Oracle's Context option (only works if + # ns_param ProvideLocalSearchP 1) + ns_param UseContext 0 + + # do we use standalone PLS search system + ns_param UsePLS 0 + + # do we use AltaVista (only works if ProvideLocalSearchP=0 + # and if the site's content is exposed to AltaVista) + ns_param LinktoAltaVista 0 + + # anything below this threshold is considered uninteresting + ns_param InterestLevelThreshold 4 + + # can a user start a new bboard + ns_param UserCanAddTopicsP 0 + + # link bboard permissions to AOLserver user; this is legacy + # code for ASME and probably doesn't work + ns_param UseNsPermAuthorizationP 0 + ns_param FileUploadingEnabledP 1 + + # this path does *not* contain a trailing "/" + ns_param FilePath /web/foobar/ + + # Urgent messages + ns_param UrgentMessageEnabledP 0 + ns_param DaysConsideredUrgent 14 + + # Enables per-thread email alerts. + ns_param EnableThreadEmailAlerts 1 + + +ns_section ns/server/${server}/acs/news + + # open means stuff goes live immediately + # wait means stuff waits for administrator to approve + # closed means only administrator can post + ns_param ApprovalPolicy wait + + # how many days a story is live (by default) + ns_param DefaultStoryLife 30 + + # When we display news items on a users workspace, what is the maximum + # number of items that we display? This lets us display the 10 most + # recent items easily w/out limiting the number of active stories + # Leave blank to display all + ns_param DefaultNumberOfStoriesToDisplay "" + + # ns_param SystemOwner " (defaults to site owner)" + # do we allow users to comment on news + ns_param SolicitCommentsP 1 + ns_param CommentApprovalPolicy wait + ns_param IndexPageDecoration "\"Nick" + ns_param ItemPageDecoration "" + + +ns_section ns/server/${server}/acs/calendar + + ns_param SystemName Calendar + + # open means stuff goes live immediately + # wait means stuff waits for administrator to approve + # closed means only administrator can post + ns_param ApprovalPolicy wait + ns_param MaxEventsOnIndexPage 15 + + # defaults for users, depends on type of service + ns_param DaysFromPostingToStart 30 + ns_param DaysFromStartToEnd 0 + + # show an event a few days after it ends? + ns_param DaysFromEndToExpiration 3 + + # how many days a story is live (by default) + # ns_param SystemOwner " (defaults to site owner)" + ns_param SolicitCommentsP 1 + ns_param CommentApprovalPolicy open + ns_param TitleExample "Ansel Adams show at Getty Center in Los Angeles, March 1-June 15" + + # do we ask for country, state, city info? + ns_param EventsHaveLocationsP 1 + + # for the classified ad system + +ns_section ns/server/${server}/acs/gc + + # ns_param SystemName "" + # ns_param SystemOwner " (defaults to global system owner)" + ns_param PartialUrlStub /gc/ + ns_param ProvideLocalSearchP 1 + ns_param ProvideEmailAlerts 1 + + # send a reminder to people to edit or delete their ads? + ns_param NagAdOwners 1 + ns_param HowManyRecentAdsToDisplay 5 + + # How many bids an auction must collect to qualify as a "hot" auction. + ns_param HotAuctionThreshold 2 + + # some stuff to deal with annoying photo.net abusers + # don't let people put the word "reduced" in subject line + ns_param DisallowReducedInSubject 1 + ns_param DisallowExclamationPointInSubject 1 + ns_param DisallowAllUppercase 1 + ns_param DisalloweBay 1 + ns_param IncludeBannerIdeasP 0 + + # ns_param IndexPageDecorationTop "\"The" + # ns_param IndexPageDecorationSide "\"The" + # ns_param DomainTopDecorationTop "\"The" + # ns_param HotAuctionsDecoration "\"Money" + # ns_param PlaceAdDecoration "\"Rolls" + # ns_param PlaceAd2Decoration "\"Rolls" + # ns_param EditAd2Decoration "" + # ns_param AddAlertDecoration "\"Boykin" + ns_param SolicitCommentsP 1 + ns_param CommentApprovalPolicy open + + + # have the system write PICS headers for naughty pages + # or directories + # if EnabledP is 1 you can have as many + # NaughtyPatterns as you like; these are fed to + # ns_register_filter + +ns_section ns/server/${server}/acs/pics + + ns_param EnabledP 0 + ns_param NaughtyPattern /nudebabes/* + ns_param NaughtyPattern /doc/* + + # a PICS header has to all be on one line anyway + ns_param Protocol "{PICS-1.1 {headers PICS-Label}}" + ns_param Label "{(PICS-1.1 \"http://www.rsac.org/ratingsv01.html\" l gen true comment \"RSACi North America Server\" by \"philg@mit.edu\" for \"http://photo.net/photo/christina/\" on \"1998.03.13T18:06-0800\" r (n 4 s 0 v 0 l 0))}" + + +ns_section ns/server/${server}/acs/contest + + ns_param OfferIndexPageP 1 + ns_param ContestAdminOwner contestprogrammer@yourdomain.com + + +ns_section ns/server/${server}/acs/adserver + + # the location of the adserver .tcl pages in the file system (typically /adserver/) + # note the trailing slash; also note that this isn't where ads go + ns_param PartialUrlStub /adserver/ + ns_param DefaultAd /ads/scorecard.gif + ns_param DefaultTargetUrl http://www.scorecard.org + ns_param DetailedPerUserLoggingP 0 + + # the Neighbor to Neighbor service (sort of like bboard; + # http://photo.net/photo/ is probably the best example of this in use ) + + +ns_section ns/server/${server}/acs/neighbor + + # ns_param SystemName "Yourdomain Neighbor to Neighbor Service" + # ns_param SystemOwner " something different (if desired) from SystemOwner above" + # ns_param HostAdministrator "something different from system-wide" + # if you're only going to run one little category, and + # for backward compatibility for photo.net + # this is a category_id referencing the n_to_n_primary_categories + # table + + ns_param DefaultPrimaryCategory 1 + + # if someone can't think of more than one; affects links from opc.tcl + ns_param OnlyOnePrimaryCategoryP 0 + + # do we offer users a full-text search box + ns_param ProvideLocalSearchP 1 + + # do we use Oracle's Context option (only works if + # ns_param ProvideLocalSearchP 1) + ns_param UseContext 0 + + # do we use standalone PLS search system + ns_param UsePLS 0 + + # do we use AltaVista (only works if ProvideLocalSearchP=0 + # and if the site's content is exposed to AltaVista) + ns_param LinktoAltaVista 0 + ns_param SolicitCommentsP 1 + ns_param CommentApprovalPolicy wait + ns_param NReasonablePostings 100 + + # the clickthrough module (/tcl/ad-clickthrough.tcl) + + +ns_section ns/server/${server}/acs/click + + # ns_param CustomREGEXP "/ct/philg(/.+)\$" + + + # the referer module (/tcl/ad-referer.tcl) + +ns_section ns/server/${server}/acs/referer + + # domains to exclude from referer tracking + ns_param LocalDomain yourdomain.com + ns_param LocalDomain www.yourdomain.com + + # if any of these are set, we require at least one to be true + # (if you don't set these, you'll get lots of referrals from random + # local files and "bookmarks"; trust us) + ns_param InclusionGLOB http://* + ns_param InclusionGLOB HTTP://* + + + # the data warehouse module + + +ns_section ns/server/${server}/acs/dw + + ns_param DefaultTable ad_hoc_query_view + + # ns_param SystemName "yourdomain data warehouse" + + # redirects, separate by vertical bar (we could just do + # ns_param FROM "TO but that's bad because sometimes we might want to" + # redirect based on an = char, also we want to spec Inherit + # or JustOne (whether to do everything beginning with /foo + # or just "/foo" exactly) + # + # Another interesting option is Pattern=, which lets you say + # "redirect /~philg/whatevercomesnext to /philg/whatevercomesnext" + # (rather than just redirecting /~philg/* to a fixed location) + # + + # for the address book + +ns_section ns/server/${server}/acs/addressbook + + ns_param SendBirthdayAlerts 1 + + +ns_section ns/server/${server}/acs/comments + + # email notifications to author/ad_system_owner + ns_param EmailNewUnansweredQuestion 1 + ns_param EmailNewAlternativePerspective 1 + ns_param EmailNewRating 1 + ns_param EmailEditedUnansweredQuestion 1 + ns_param EmailEditedAlternativePerspective 1 + ns_param EmailEditedRating 1 + + +ns_section ns/server/${server}/acs/general-comments + + # Whether or not we accept file uploads for general comments. + ns_param AcceptAttachmentsP 1 + + # Maximum attachment size in bytes. Leave empty for no limitation. + ns_param MaxAttachmentSize 5000000 + ns_param AdminEditingOptionsInlineP 0 + + # Images with widths less than this parameter will be displayed inline. + ns_param InlineImageMaxWidth 512 + + # Use titles/one-lines for comments? + ns_param UseTitlesP 1 + + +ns_section ns/server/${server}/acs/general-links + + # use link clickthroughs? + ns_param ClickthroughP 1 + + # allow suggested links from /general-links/index.tcl? + ns_param AllowSuggestionsP 1 + + +ns_section ns/server/${server}/acs/links + + # email notifications to author/ad_system_owner + ns_param EmailNewLink 1 + ns_param EmailEditedLink 1 + + # use link clickthroughs? + ns_param GeneralLinksClickthroughP 1 + + +ns_section ns/server/${server}/acs/redirect + + # ns_param Inherit /from/|/to/ + # ns_param JustOne /randomoldfileonthisbox.html|http://www.otherpersonsserver.com/ + # ns_param Pattern /olddir/|/newdir/ + ns_param Pattern /pvt/address-book|/address-book + + # for the /directory module wherein users get to look each other up + +ns_section ns/server/${server}/acs/directory + + ns_param ProvideUserBrowsePageP 1 + ns_param UserBrowsePageLimitedToNotNullUrlP 1 + + #ns_param IndexPageDecoration "\"Snowy" + #ns_param BrowsePageDecoration "\"Orangutan." + #ns_param SearchResultsDecoration "" + + # for the module that bills members or figures out which are losers + +ns_section ns/server/${server}/acs/member-value + + ns_param EnabledP 0 + ns_param UseRealMoneyP 0 + + # currency should be a three-char code that CyberCash likes, e.g., "USD" + ns_param Currency USD + + # if true, check mv_monthly_rates + ns_param ChargeMonthlyP 0 + ns_param ClassifiedAdRate 0 + ns_param ClassifiedAdMistakeRate 5 + ns_param ClassifiedAdSpamRate 25 + ns_param QuestionRate 0 + + # people who don't look in archives + ns_param QuestionDupeRate 5 + ns_param QuestionOffTopicRate 25 + ns_param AnswerRate 0 + + # deleted because inaccurate + ns_param AnswerWrongRate 5 + ns_param AnswerMistakeRate 2 + + # we might credit people for a good submission + ns_param CommentRate -5 + ns_param CommentDupeRate 5 + ns_param CommentSpamRate 25 + ns_param LinkRate 0 + ns_param LinkDupeRate 5 + ns_param LinkSpamRate 25 + ns_param BillingInterval month + + # wait until next interval if accumulated charges are less + # than this amount + ns_param BillingMinimum 7.50 + + # set this if you want notification of member value charges to go + # somewhere other than AdminOwner + # ns_param NotificationEmail "" + # what amount of money do we consider moves a user into the + # "expensive" class (bad for the site) + ns_param ExpensiveThreshold 20 + + # for the Content Tagging Package + # ns_param (PG|R|X)LogP "1 logs the potentially offensive material" + # ns_param (PG|R|X)BounceP "1 prevents the offensive material from being posted at all" + # ns_param (PG|R|X)BowdlerizeP "1 replaces relevant words with BowdlerizationText" + # Note that in generally, you can't bounce only PG and X, but not R, + # the scripts find the lowest allowed naughtiness to bounce or log. + +ns_section ns/server/${server}/acs/content-tagging + + # email address to notify if something needs attention + # defaults to SystemOwner + # ns_param Administrator "" + # log into naughty_events table + ns_param PGLogP 0 + ns_param RLogP 1 + ns_param XLogP 1 + + # prevent this level of stuff from being posted at all + ns_param PGBounceP 0 + ns_param RBounceP 0 + ns_param XBounceP 1 + + # send email to Administrator + ns_param PGNotifyP 0 + ns_param RNotifyP 0 + ns_param XNotifyP 1 + + # bowdlerize text + ns_param PGBowdlerizeP 0 + ns_param RBowdlerizeP 1 + ns_param XBowdlerizeP 1 + ns_param BowdlerizationText **** + + # what do we mask off for unlogged-in users + ns_param DefaultContentMask 0 + ns_param CacheTimeout 600 + ns_param UserContentMaskCacheTimeout 600 + + # for the ACS Chat System + +ns_section ns/server/${server}/acs/chat + + ns_param EnabledP 1 + # ns_param SystemName Chat + # how long to cache the postings to a room (updates force a cache update + # so this theoretically could be 5 hours or whatever) + ns_param CacheTimeout 120 + + # how long will a room's properties (e.g., private group, moderation) be cached + ns_param RoomPropertiesCacheTimeout 600 + ns_param UsersCanCreateRoomsP 0 + + # set to 1 if you want most recent postings on top; this is the way that + # theglobe.com and other familiar chat systems do it (keeps users from + # having to scroll to see new msgs) + ns_param MostRecentOnTopP 1 + + # do we want to offer users the option of sending private messages? + ns_param PrivateChatEnabledP 0 + + # do we offer users a link to a chat room's history? + ns_param ExposeChatHistoryP 1 + + # how many messages to display when users choose short medium or long + ns_param NShortMessages 25 + ns_param NMediumMessages 50 + ns_param NLongMessages 75 + + # show a picture at the index page and in individual rooms? + ns_param DefaultDecoration "\"Mouth.\"" + + # how often the javascript version should refresh itself + ns_param JavaScriptRefreshInterval 5 + + +ns_section ns/server/${server}/acs/mailing-list + + ns_param IndexPageDecoration "\"Mailboxes" + + +ns_section ns/server/${server}/acs/sidegraphics + + ns_param EnabledP 1 + ns_param /bboard/index.tcl http://photo.net/photo/pcd0796/linderhof-front-door-23.2.jpg + + + +ns_section ns/server/${server}/acs/glossary + + # open means stuff goes live immediately, user can edit own terms + # wait means stuff waits for administrator to approve, + # only administrator can edit + # closed means only administrator can post + ns_param ApprovalPolicy closed + + +ns_section ns/server/${server}/acs/robot-detection + + # the URL of the Web Robots DB text file + ns_param WebRobotsDB http://info.webcrawler.com/mak/projects/robots/active/all.txt + + # which URLs should ad_robot_filter check (uncomment to turn system on) + # ns_param FilterPattern /members-only-stuff/*.html + # ns_param FilterPattern /members-only-stuff/*.tcl + # the URL where robots should be sent + ns_param RedirectURL /robot-heaven/ + + # How frequently (in days) the robots table + # should be refreshed from the Web Robots DB + ns_param RefreshIntervalDays 30 + + # stuff for templates, multi-lingualism + +ns_section ns/server/${server}/acs/style + + # where to find templates, typically /web/${server}/templates + # (note lack of trailing slash, just like the pageroot) + # you can override it with this config param + # ns_param TemplateRoot "" + # do we look for language-specific templates, e.g., foobar.en.adp? + # (and do we offer user interface to help user choose) + ns_param MultiLingualP 0 + + # most publishers will want the language of Jesus Christ and the Bible + # to be the default (i.e., English ("en")), if only because there is so much + # embedded English UI in subsystems of the ACS + ns_param LanguageSiteDefault en + + # offer people a language choice without logging in? + ns_param LanguageCookieP 1 + + # do we look for plain. and fancy. templates, e.g., foobar.plain.adp? + # (and do we offer user interface to allow user to choose) + ns_param PlainFancyP 1 + + # most publishers will want "fancy" to be preferred (if available) + ns_param PlainFancySiteDefault fancy + + # offer people a graphics choice without logging in? + ns_param PlainFancyCookieP 1 + + # for the ticket tracking system + +ns_section ns/server/${server}/acs/ticket + + # when sending a note to an admin or engineer about a trouble + # ticket, what reply-to: address to use + # note that this address must be set up through your mail transfer + # agent to run a email enqueueing script. + # See doc/ticket.html for more info on configuring the ticket system. + # (from /web/${server}/bin/queue-message.pl) + ns_param TicketReplyEmail support-ticket-robot@yourdomain.com + + # The PicklistData specifies additional custom data fields you would like + # associated with tickets in the database. You can have up to five of these. + #ns_param PicklistData "hardware_model \"Hardware Model\" picklist_single_select data1 \"\" \"1000 (Merced)\" \"2500 (Charles)\" \"5000 (Connecticut)\"" + #ns_param PicklistData "software_version \"Software Version\" picklist_single_select data2 \"\" \"FooOS 1.0\" \"FooOS 1.0-EFT\" \"FooOS==OS 1.6\" \"FooOS 2.0\"" + # ns_param PicklistData "build \"Build\" text data4 25" + # if LinkTicketToUserGroupP = 1, each ticket is assigned to a user group + # a user must be in the group to see the ticket + ns_param LinkTicketToUserGroupP 0 + + # If CustomerCanCreateNewTickets = 1, customers may create new tickets. + # (A "customer" is any user who is not in the ticket admin group) + ns_param CustomerCanCreateNewTickets 1 + + # The menu of ticket severity choices + ns_param SeverityList "low medium serious critical showstopper" + + # can an issue creator administer the issue? + ns_param IssueCreatorAdminP 0 + + # do we implement the privacy feature? + ns_param PrivacyEnabledP 0 + + # to tell the email queue system where to dispatch + # all of this is based on tags supplied by the mail-transfer agent + +ns_section ns/server/${server}/acs/email-queue + + # how often to check the queue for new messages + #ns_param QueueSweepInterval 300 + # what to do with a new message + # format is tag|tcl_proc_to_invoke + #ns_param DispatchPair ticket-tracker|ticket_process_message + + + +ns_section ns/server/${server}/acs/intranet + + ns_param IntranetName "yourdomain Network" + ns_param IntranetEnabledP 0 + ns_param DisplayVacationsOnCalendar 1 + + # the unit of measurement for entering salaries (month or year) + ns_param SalaryPeriodInput year + + # used to display salary + ns_param SalaryPeriodDisplay year + + # list of fee types + ns_param FeeTypes "\"setup\" \"monthly development\" \"monthly hosting\" \"hourly\" \"stock\"" + + # Do we want to track hours? + ns_param TrackHours 1 + + # what's the url stub? i.e. http://yourdomain.com + ns_param IntranetUrlStub /intranet + + # Group Types + ns_param IntranetGroupType intranet + ns_param ProjectGroupShortName project + ns_param OfficeGroupShortName office + ns_param CustomerGroupShortName customer + ns_param PartnerGroupShortName partner + ns_param ProcedureGroupShortName procedure + ns_param EmployeeGroupShortName employee + ns_param AuthorizedUsersGroupShortName authorized_users + + # What color do we put in the header row of tables? + ns_param TableColorHeader #e6e6e6 + + # What color do we put in the odd numbered rows of tables? + ns_param TableColorOdd #f4f4f4 + + # What color do we put in the even numbered rows of tables? + ns_param TableColorEven #ffffff + ns_param CommentApprovalPolicy open + + # If we want to include people who are delinquent with project + # reports in our status-report, what user_class_id do we use? + # Leave blank to skip this part of the status report + ns_param UserClassStatusReportID "" + + + +ns_section ns/server/${server}/acs/help + + # Root of the help directory hierarchy, relative to the PageRoot. + # Same as page root if not set. + # ns_param HelpPageRoot /help + + +ns_section ns/server/${server}/acs/fs + + ns_param SystemName "File Storage System" + # optional, defaults to main site owner + # ns_param SystemOwner fs-admin@yourdomain.com + ns_param DefaultPrivacyP f + + # do you want to maintain a public tree for site wide documents + ns_param PublicDocumentTreeP 1 + ns_param MaxNumberOfBytes 2000000 + ns_param HeaderColor #cccccc + ns_param DatePicture "MM/DD/YY HH24:MI" + ns_param FileInfoDisplayFontTag "" + ns_param UseIntermediaP 0 + + # Display mappings for file types. + # Format is pipe separated list of display string followed by + # MIME types. Types can use * and ? as wildcards. + # For anything not on the list, the default is to display + # the first portion of the MIME type, except in the case of + # application/, where the sub-type is displayed. + ns_param FileTypeMap Image|image/* + ns_param FileTypeMap "Word Document|application/msword|application/rtf" + ns_param FileTypeMap Excel|application/msexcel + ns_param FileTypeMap PowerPoint|*powerpoint + ns_param CommentApprovalPolicy open + + + # for the ecommerce module + +ns_section ns/server/${server}/acs/ecommerce + + # set to 1 if you're using the ecommerce module + ns_param EnabledP 0 + ns_param WeightUnits lbs + ns_param Currency USD + + # this is used on the category browse page (and for subcategories/subsubcategories) + ns_param ProductsToDisplayPerPage 10 + + # whether to allow user comments on products + ns_param ProductCommentsAllowP 1 + + # whether user comments on products (if allowed) need approval before becoming live + ns_param ProductCommentsNeedApprovalP 1 + + # whether the system should calculate additional product relationships + ns_param CalcProductRelationshipsP 0 + + # whether users can see what user classes they are in + ns_param UserClassUserViewP 1 + + # whether a user can request to be a member of a user class + ns_param UserClassAllowSelfPlacement 1 + + # if a user requests to be in a user class, is approval required before that + # user becomes a member of the user class + ns_param UserClassApproveP 1 + + # what percentage of an item's shipping cost should be refunded if an item is returned + ns_param ShippingRefundPercent 0 + + # whether to allow express shipping + ns_param ExpressShippingP 1 + + # whether to save credit card data (you have to save it if you're going to do manual billing) -- + # if you save it, then your users can reuse their credit card with one click + ns_param SaveCreditCardDataP 1 + + # for thumbnails of products, specify either width or height (whichever is + # more important, and then the other will be determined based on the + # original image size, keeping aspect ratio constant) -- if both are + # specified, the width setting will take precedence, and if neither + # is specified, the thumbnail will be width=100 + ns_param ThumbnailWidth 100 + + # ns_param ThumbnailHeight 100 + # stock status messages + # o = out of stock, q = ships quickly, + # m = ships moderately quickly, s = ships slowly + ns_param StockMessageO "Out of Stock" + ns_param StockMessageQ "Usually Ships Within 24 Hours" + ns_param StockMessageM "Usually Ships Within 2-3 Days" + ns_param StockMessageS "Usually Ships Within 2-4 Weeks" + ns_param StockMessageI "In Stock" + + # # of days an 'in_basket' order will remain in + # the system before a cron job expires it + ns_param CartDuration 30 + + # whether customers will be able to place orders + # for items whose available_date has not yet come + ns_param AllowPreOrdersP 1 + + # all outgoing email is sent from this address + ns_param CustomerServiceEmailAddress service@yourdomain.com + + # you may or may not wish to have the people recording + # shipments receive messages like "unable to authorize + # payment for shipment" -- depending on whether they + # they're in a position to do anything about the problem + # (e.g. abort shipment) + ns_param DisplayTransactionMessagesDuringFulfillmentP 1 + + # whether to allow users to buy gift certificates + ns_param SellGiftCertificatesP 1 + + # minimum gift certificate amount they can buy + # (this does not impose minimum amount for administrators + # giving users gift certificates) + ns_param MinGiftCertificateAmount 5 + + # maximum gift certificate amount they can buy + ns_param MaxGiftCertificateAmount 300 + + # number of months until user-purchased gift certificates + # expire + ns_param GiftCertificateMonths 12 + + # **Everything above this is a publishing decision.** + # **Everything below this is a technical parameter.** + # domain of the site -- I know other modules have this, but they + # might not be installed and this is needed so that I can redirect + # the shopping cart to https + ns_param LocalDomain yourdomain.com + + # the directory that the ecommerce module is in + ns_param EcommerceDirectory /web/${server}/www/ecommerce/ + + # web path to the directory that the ecommerce user files are in + ns_param EcommercePath /ecommerce/ + + # path to Product data directories (where product files like images are kept) + ns_param EcommerceDataDirectory /web/${server}/data/ecommerce/ + + # This path goes on the end of the EcommerceDataDirectory + ns_param ProductDataDirectory product/ + + # Set to 1 if you have a comparison shopping service -- Note: support for + # multiple retailers does not work yet in Version 1.0 of the Ecommerce + # Module, so leave it as 0 + ns_param MultipleRetailersPerProductP 0 + + # for the ACS Bookmarks System + +ns_section ns/server/${server}/acs/bm + + # optional, defaults to main site owner + ns_param SystemOwner someguy@yourdomain.com + + # main page title + ns_param SystemName "Bookmarks System" + + # text decoration for dead links + ns_param DeadDecoration + + # text decoration for folders + ns_param FolderDecoration + + # text decoration for bookmarks invisible to the public + ns_param HiddenDecoration "" + + # background color of folders + ns_param FolderBGColor #f3f3f3 + + # background color of files + ns_param BookmarkBGColor #ffffff + + # size of largest bookmarks file permissible to upload + ns_param MaxNumberOfBytes 2000000 + + +ns_section ns/server/${server}/acs/curriculum + + ns_param EnabledP 0 + + # does ad_footer put this in every dynamic page? + ns_param StickInFooterP 1 + + # does ad_serve_html_page put this on every static page? + ns_param StickInStaticPagesP 1 + + # on which URLs should the system look for/set cookies + ns_param FilterPattern *.html + ns_param FilterPattern *.tcl + ns_param BarFontTag "" + ns_param HelpAnchorText "?" + + # stuff like a background color for the table cells, goes within a TD + ns_param CellExtraTags bgcolor=#EEEEEE + + +ns_section ns/server/${server}/acs/crm + + # how often to update the CRM states + ns_param UpdatePeriodHours 24 + + +ns_section ns/server/${server}/acs/portals + + ns_param Administrator portaladmin@yourdomain.com + ns_param AdministratorName "Portal Administrator" + ns_param SystemName "yourdomain portals" + + # set to 1 if individual may create their own portals + ns_param AllowUserLevelPortals 1 + + # set to 1 if super administrator can add or remove themselves and other super administrators + ns_param SuperAdminCanChangeSuperAdminP 0 + ns_param BodyTag "" + ns_param FontTag "" + + # These standardize a prettier table than the browser default + ns_param BeginTable "
" + ns_param EndTable
+ ns_param HeaderTD "" + ns_param HeaderBGColor #006600 + ns_param SubHeaderTD "" + ns_param SubHeaderBGColor #eeeedd + ns_param NormalTD "" + + # For portals with multiple pages, tabs link to the other pages, set this to 1 if you want each tab + # to be equal width instead of proportional to the name of the page + ns_param EqualWidthTabsP 0 + ns_param MainPublicURL /portals/ + + # number of seconds to memoize a portal page + ns_param CacheTimeout 100 + + # browsers will decide the "optimal" column sizes unless you force column widths here: + #ns_param LeftSideWidth "" + #ns_param RightSideWidth "" + ns_param SpacerImage /portals/spacer.gif + ns_param PortalExtension .ptl + + +ns_section ns/server/${server}/acs/press + + # maximum number of press items to display on the press coverage page + ns_param DisplayMax 10 + + # number of days a press item remains active + ns_param ActiveDays 60 + + # do we use clickthrough tracking from the press coverage page? + ns_param "ClickthroughP " " 1" + + +ns_section ns/server/${server}/acs/monitoring + + # People to email for alerts + # ns_param PersontoNotify nerd1@yourdomain.com + # ns_param PersontoNotify nerd2@yourdomain.com + # location of the watchdog perl script + ns_param WatchDogParser /web/${server}/bin/aolserver-errors.pl + + # watchdog frequency in minutes + ns_param WatchDogFrequency 15 + + +ns_section ns/server/${server}/acs/site-wide-search + + # ns_param BounceQueriesTo http://backup.photo.net + # ns_param BounceResultsTo http://photo.net + + +ns_section ns/server/${server}/acs/display + + #specify the maximum size of a logo + ns_param MaxLogoSize 500000 + + +ns_section ns/server/${server}/acs/custom-sections + + #specify the maximum size of a binary file that can be uploaded for a content section + ns_param MaxBinaryFileSize 2000000 + + +ns_section ns/server/${server}/acs/download + + # root directory of the downloadable files + ns_param DownloadRoot /web/${server}/download/ + + +ns_section ns/server/${server}/acs/wp + + # Paths to use for serving styles and presentations. + ns_param StyleURL /wp/style/ + ns_param PresentationURL /wp/display/ + ns_param PresentationEditURL /wp/display-edit/ + ns_param AttachURL /wp/attach/ + ns_param SolicitCommentsP 1 + ns_param CommentApprovalPolicy open + + # Path to the unzip program to use for bulk image uploading. + ns_param PathToUnzip /usr/bin/unzip + + # Is bulk image uploading enabled? + ns_param AllowBulkUploadP 1 + + +ns_section ns/server/${server}/acs/users + + # all user web content will be rooted under this directory. This + # directory will be the root of all the web content being published + # by the users of the system. + ns_param ContentRoot /web/${server}/users/ + + # Maximum quota for a 'normal user' (a lesser mortal who is not the + # site wide administrator) of the site in mega-bytes. For example, a + # '20' corresponds to 20,971,520 bytes. Values need not be integer. + # Value is overridden for a particular user throught existence of + # entry in the users_special_quotas table. + ns_param NormalUserMaxQuota 5 + + # Maximum quota for site wide administrators. Special quotas can be + # set by adding rows to the users_special_quotas table. This param + # will be used for a site wide administrator only when he/she doesnt + # have an entry in the users_special_quotas table. + ns_param PrivelegedUserMaxQuota 20 + + # Space taken by a directory (in bytes). We need this so that a user + # cannot crash the system by creating millions of directories. This + # will ensure that a directory detracts from his/her quota. + ns_param DirectorySpaceRequirement 2048 + + # This determines the default view for displaying files in home-page + # administration (maintenance) pages. There are two supported values + # for this: tree and normal. + ns_param DefaultView normal + + # This is the list of files that are served as index pages. If all + # of these files are nonexistant in a directory requested through + # the homepage content server (hp_serve), then the server generates + # a default (personalized) index page for the user. If more than one + # of these files exist in the requested directory, the filename + # which appears earliest in this list is given preference. If no + # filename is provided below then the server always generates index + # pages. In most systems, the index.html, index.htm, and Default.htm + # are the index filenames. In some systems home.html is also an + # index file but generally this is used whenever users want to give + # the world read/browse access to their web directories. In this + # regard, home.html should not be added to the candidacy list. + # Finally, it is obvious that if one of these files exist in the + # directory then the web-browser cannot obtain a lisitng of all the + # files in the directory. + ns_param IndexFilenameCandidacyList "index.html index.htm Default.htm" + + # what if a site gets really large and the primary purpose is giving + # members personal homepages (e.g., if an adopter of ACS decides to + # become "The GeoCities of Brazil")? How do we support this? First, + # users could decide to join user groups. Then the /users/ index + # page would show a summary of user groups whose members have + # personal pages. This requires no new data in Oracle. This is + # enabled with SubdivisionByGroupP=1 in the .ini file. Users with + # homepages and no group affiliation show up in "unaffiliated" (fun + # with OUTER JOIN). When SubdivisionByNeighborhoodP=1, we either + # keep a denormalized neighborhood_sortkey in the homepages table + # and flag the "homepages" that are actually neighborhood folders or + # have some separate tables holding categorization. (philg). + ns_param SubdivisionByNeighborhoodP 0 + + # This parameter will determine whether we'll be showing appropriate + # options on the user's workspace or not. This will also determine + # whether this system offers homepages or not. In effect, this + # parameter determines whether the homepage facility is enabled or + # not. This does not effect the users administration pages, though. + ns_param HomepageEnabledP 1 + + +ns_section ns/server/${server}/acs/spam + + # Pairs of {email_addr_pattern pseudo-mime-type} + ns_param EmailTypes "{%@hotmail.com text/html} {%@aol.com text/aol-html}" + ns_param DailySpamDirectory /web/${server}/spam + ns_param RemovalBlurb "{-----\\nSent through http://yourdomain.com\\n\\n}" + + +ns_section ns/server/${server}/acs/gp + + # can we give row-level permissions to groups as well? + ns_param GroupPermissionsP 1 + + # do we want comment permissions? + ns_param CommentPermissionsP 1 + + # do we want to show our user list to people editing permissions? + ns_param ShowUsersP 0 + + # do we want to show a Finish button on the edit-page-permissions page? + ns_param ShowFinishButtonP 1 + + +ns_section ns/server/${server}/acs/pdm + + # Flag to display the administration menu bar + ns_param MenuOnAdminPagesP 0 + + # Flag to display the default menu bar on non-/admin pages + ns_param MenuOnUserPagesP 0 + + +ns_section ns/server/${server}/acs/partner + + # what is the name of the default partner cookie? + ns_param CookieDefault ad + + # All the variables we want to collect (Any variables added here + # must still be manually added to the data model.) + # Each line of Variable= contains a pipe separated pair of + # name_of_column in ad_partner | what to display on the add/edit forms + ns_param Variable "partner_name|Partner Name" + ns_param Variable "partner_cookie|Partner Cookie" + ns_param Variable "default_font_face|Default Font Face" + ns_param Variable "default_font_color|Default Font Color" + ns_param Variable "title_font_face|Title Font Face" + ns_param Variable "title_font_color|Title Font Color" + + # The Software Development Manager (SDM) + +ns_section ns/server/${server}/acs/sdm + + ns_param UrlStub /sdm + ns_param SoftwareRoot /web/${server}/sdm-software + ns_param SdmVersion 0.4 + ns_param NotificationSenderEmail robot@yourservername.com + ns_param SystemName "Software Development Manager" + ns_param DefaultSeverity medium + ns_param ListOfSeverities "low medium high critical" + + # The Todo List Manager (todo) + +ns_section ns/server/${server}/acs/todo + + ns_param UrlStub /todo + ns_param SystemName "To-Do List Manager" + ns_param Administrator admin@yourservername.com + + # The Cybercash Stub + # This stub will replace the cc_send_to_server_21 proc + # and fake the cybercash action for testing purposes + # this necessitates cybercash-stub.sql in the data model + # directory, make sure to load it before you start. + +ns_section ns/server/${server}/acs/ccstub + + ns_param EnabledP 1 + + #to be able to restart the aolserver from the admin page, + #INIFile must have the path and name of the config file. + #ie: /web/aolserver/${server}.tcl + #To disable, leave INIFile blank + +ns_section ns/server/${server}/acs/restart + + ns_param INIFile "" + + +ns_section ns/server/${server}/acs/webmail + + # This module requires the aolserver module nsjava. + # See http://nsjava.sourceforge.net + ns_param WebmailEnabledP 0 + + # Time interval for scheduling processing of the + # incoming mail queue. + ns_param ProcesssQueueInterval 60 + + # Alias and queue directory. See .../doc/webmail.html + # for explanation of their purpose. + ns_param AliasDirectory "/home/nsadmin/qmail/alias" + ns_param QueueDirectory "/home/nsadmin/qmail/queue/" + + # Local Variables: + # eval: (auto-save-mode 0) + # End: + + + + + + + + + + + + + + + + + + + + + + + + + + + + Index: web/openacs/parameters/openacs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/parameters/openacs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/parameters/openacs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,1456 @@ + # AOLserver reads these files when the server starts up and stores + # parameters in an in-memory hash table. So you have to restart the + # server if you want to test a change made to this file. + # + # Modified by roberto@brasileiro.net - May 2000 + # Assuming you have the following line in your AOLserver's nsd.tcl: + # set server "yourservername" + # where "yourservername" is how you are naming that server. + + +ns_section ns/server/${server}/acs + + ns_param SystemName "OpenACS Community" + + # for legal pages, full corporate entity + ns_param PublisherName "OpenACS.org" + + # who signs the average user-visible pages + ns_param SystemOwner ben@mit.edu + + # URL to tell users to go to + ns_param SystemURL http://openacs.org + + # who signs the admin pages, e.g., a programmer who can fix/enhance them + ns_param AdminOwner ben@mit.edu + + # are admin users allow to write SQL queries + # (only say yes if they are not likely to crash the server) + ns_param AllowAdminSQLQueries 0 + + # stuff we want restricted to SSL (https) (filter patterns) + # note that this only takes effect if you have an SSL listener configured + # on your AOLserver + ns_param RestrictToSSL /admin* + ns_param RestrictToSSL /NS/Admin* + ns_param RestrictToSSL /NS/Db* + + # do we want to restrict the entire server to registered users + # (the content_sections facility probably could also accomplish this + # but not as simply) + ns_param RestrictEntireServerToRegisteredUsersP 0 + + # Is this server being used as a staff server? + # (only used by /pvt/home.tcl and may become legacy) + ns_param StaffServerP 0 + ns_param HostAdministrator ben@mit.edu + ns_param GraphicsSiteAvailableP 0 + + # these work for text-only and graphics site + ns_param bgcolor white + ns_param textcolor black + + # this is only for the graphics site + ns_param background /graphics/bg.gif + + # set ReadOnlyP=1 if you're going to wipe your Oracle installation + ns_param ReadOnlyP 0 + + # do we expect this to be a site visited by people + # from all over the world (in which case we might ask for + # country rather than state) + ns_param InternationalP 1 + + # is it even worth bothering asking for state and zip code? + ns_param SomeAmericanReadersP 1 + + # do we allow a persistent cookie? + # we need this for pulling times out of the database and turning + # then into ns_times; this is for standard time (don't worry about + # daylight saving's time, we figure that out by calling ns_localtime) + # United States Eastern time is -5 + ns_param HoursDifferenceFromGMT -5 + + # what two characters do we use for salting ns_crypt + # (documented at aolserver.com; doesn't matter as long + # as you don't change this after going live) + ns_param CryptSalt fb + + # admin user interface may change depending on whether we expect + # 10, 100, 1000, or 100000 users; we have "small", "medium", "large" + # as possible values, consistent with Oracle config files + ns_param NumberOfUsers medium + + # clickthrough and referral admin report defaults + # change depending on whether + # this is a dev site or a 500,000 hit/day live site + # we have "small", "medium", "large" as possible values + # we think "medium" = site like photo.net (700,000 hits/day) + ns_param TrafficVolume medium + + # general comments default approval + # open means stuff goes live immediately + # wait means stuff waits for administrator to approve + # closed means only administrator can post + ns_param DefaultCommentApprovalPolicy wait + + # general links default approval + # open means stuff goes live immediately + # wait means stuff waits for administrator to approve + # closed means only administrator can post + ns_param DefaultLinkApprovalPolicy open + + # if set, update last visit cookie according to LastVisitUpdateInterval + # so that we can support reporting of who's online. This makes last visit + # times more accurate, but increases system load (because we're also + # updating the last_visit column in the users table) + ns_param WhosOnlineP 1 + ns_param WhosOnlineDecoration "\"100th" + + # how many seconds old a last visit cookie must be before we update it + ns_param LastVisitUpdateInterval 600 + + #stuff having to do with registration and login + ns_param NotifyAdminOfNewRegistrationsP 1 + + # where to send those notes (defaults to SystemOwner) + #ns_param NewRegistrationEmailAddress admin@yourdomain.com + # send confirmation email to user after registration + ns_param EmailRegistrationConfirmationToUserP 0 + + # set this to 1 if user does not go live immediately + ns_param RegistrationRequiresApprovalP 0 + + # set this to 1 if the user has to receive and email + # and come back to the site + ns_param RegistrationRequiresEmailVerificationP 0 + + # have the system generate a random password instead of the user + ns_param RegistrationProvidesRandomPasswordP 0 + + # Encypt Passwords in the database + ns_param EncryptPasswordsInDBP 0 + + # Email users forgotten passwords + ns_param EmailForgottenPasswordP 1 + + # If so, do you choose a random a password + # (if you use encrypted password, a random password will always be generated) + ns_param EmailRandomPasswordWhenForgottenP 0 + + # if the admin changes the password, should it be mailed to the user + ns_param EmailChangedPasswordP 1 + ns_param AllowPersistentLoginP 1 + + # if so, do we default to a persistent cookie? + ns_param PersistentLoginDefaultP 1 + + # do we keep track of anonymous and logged-in browsers + # as to last_visit and second_to_last_visit + ns_param LastVisitCookiesEnabledP 1 + + # how many seconds old must a last visit cookie be before + # we consider this a new visit + ns_param LastVisitExpiration 86400 + + # how long will we associated hits from an individual ip + # as the same user. Hits within this interval will + # be considered the same session for session tracking. + ns_param LastVisitCacheUpdateInterval 600 + + # what tables to stuff when user registers + #ns_param RequiredUserTable users_preferences + #ns_param RequiredUserTable users_demographics + #ns_param RequiredUserTable users_contact + # do we want to set each cookie on more than one hostname + # (i.e., is your site a typical "foobar.com" and "www.foobar.com" case) + ns_param NeedCookieChainP 0 + ns_param CookieChainFirstHostName yourdomain.com + ns_param CookieChainSecondHostName www.yourdomain.com + + # do we have legacy users for whom we created + # accounts from old bboard postings (keyed by email address)? + ns_param UsersTableContainsConvertedUsersP 0 + + # Primarily for WimpyPoint, but may be useful to other modules + ns_param PathToACS /web/${server} + + # Where is the global directory for such things as file-not-found + # error messages + ns_param GlobalURLStub /global + + # for how long can a be session inactive before it times out? (in seconds) + ns_param SessionTimeout 86400 + + # how often should we reissue the session_id cookie (to prevent expiration) + # and update last_hit in the sessions table? + ns_param SessionCookieReissue 600 + + # how long after the last hit should we save information in the SessionLifetime + # table? + ns_param SessionLifetime 176800 + + # how many characters long are the tokens used for authentication? + ns_param TokenLength 32 + + # how long to cache session information for? + ns_param SessionInfoCacheInterval 600 + + # use the old login process where email and password are on separate pages? + ns_param SeparateEmailPasswordPagesP 0 + + # log detailed information about security and sessions for which hosts? + # useful for troubleshooting; remove to log for none + # ns_param LogSecurityMinutia "" + # if a user provides a Host header which isn't this, redirect the user to + # this particular host. e.g., if yourservername.com and www.yourservername.com + # point to the same IP, set this to 1 so cookies will be properly set. + ns_param ForceHostP 1 + + # stuff having to do with what and how we collect info from users + # upon registration and at various stages afterward + # (for legacy reasons, some of the stuff that should go here is + # actually in the main acs section above) + +ns_section ns/server/${server}/acs/user-info + + ns_param SolicitPortraitP 1 + + # Maximum portrait size in bytes. Leave empty for no limitation. + ns_param MaxPortraitBytes 200000 + + # if you have ImageMagick configured, try to + # producte thumbnails? + ns_param ProduceThumbnailsAutomaticallyP 0 + ns_param AcceptablePortraitMIMETypes "image/gif image/jpeg" + + # stuff having to do with the physical computer on which + # this ACS is running. Some scripts may adjust their behavior + # according to what operating system or perhaps the machine power + # (e.g., /admin/static/link-check.tcl will sleep for 1 second + # periodically on wimpy machines) + +ns_section ns/server/${server}/acs/machine + + # probably best to consider any machine with only one CPU as wimpy + ns_param WimpyMachineP 1 + + # address information for a cluster of load-balanced servers (to enable + # distributed util_memoize_flushing, for instance). + +ns_section ns/server/acs-staging/acs/server-cluster + + # is clustering enabled? + ns_param ClusterEnabledP 0 + + # which machines can issues requests (e.g., flushing) to the cluster? + #ns_param ClusterAuthorizedIP 209.67.242.* + # which servers are in the cluster? This server's IP may be included too + #ns_param ClusterPeerIP 209.67.242.171 + #ns_param ClusterPeerIP 209.67.242.172 + # log clustering events? + #ns_param EnableLoggingP 1 + + # stuff having to do with the ArsDigita Community System software + # itself, e.g., workarounds for bugs + +ns_section ns/server/${server}/acs/acs + + ns_param LogCLOBdmlP 1 + + # stuff having to do with abstract urls (doc/abstract-url.html) + +ns_section ns/server/${server}/acs/abstract-url + + # enable abstract url handling? + ns_param EnableAbstractURLsP 1 + + # precedence for file extensions, e.g., "tcl,adp,html" means "serve + # a .tcl file if available, else an .adp file if available, else an + # .html file if available, else the first file available in alphabetical + # order". Comma-separated + ns_param ExtensionPrecedence tcl,adp,html,jpg,gif + + # stuff having to do with user groups + +ns_section ns/server/${server}/acs/ug + + ns_param CacheTimeout 600 + + #this will be part of url where groups can access their webpages + #e.g. if GroupsDirectory=groups and group short name is travel at photo.net + #then group travel will have it's user pages accessible at photo.net/groups/travel + #note that this is not the same as the file system directory for the group system files + ns_param GroupsDirectory groups + + #this sets the part of url needed to access group admin pages + #when GroupsDirectory=groups and GroupsAdminDirectory=admin then group admin + #pages for group with short_name travel will be accessible at photo.net/groups/admin/travel + #note that this is not the same as the file system directory for the group admin pages + ns_param GroupsAdminDirectory admin + + # general anti-spam stuff, useful system-wide + # esp. for IP address ranges that we don't like + # we want GLOB patterns to feed to [string match ..] + # and we want a policy decision about whether to pretend + # to be broken or be explicit that they've been banned + +ns_section ns/server/${server}/acs/antispam + + ns_param FeignFailureP 1 + + #ns_param IPglob 209.114.173.* + #ns_param IPglob 209.114.172.* + # to block out one single address + #ns_param IPglob 209.114.172.46 + + # we don't allow users to submit HTML containing any of these tags + ns_param NaughtyTag div + ns_param NaughtyTag font + ns_param NaughtyTag script + + # stuff having to do with the user's workspace + +ns_section ns/server/${server}/acs/pvt + + # ns_param WorkspacePageDecoration " an image" + # ns_param AlertPageDecoration "\"Alex" + + +ns_section ns/server/${server}/acs/content + + # do we serve the generated index.tcl page or something else + # from the file system? + # ns_param SpecialIndexPage /index.html + # ns_param SiteMap /site-map.html + + # stuff for dealing with static pages + +ns_section ns/server/${server}/acs/static + + # this has to be a complete REGEXP with | for or's; \.html?$ will match .htm or .html + # \.html?$|\.adp$ will pull .adp pages into the table as well. + ns_param IncludeRegexp "\\.html?\$" + + # URL stub to exclude, Tcl GLOB syntax, include leading / + # used by /admin/static/static-syncer-ns-set.tcl + ns_param ExcludePattern /pvt/* + ns_param ExcludePattern /global/* + ns_param ExcludePattern /graphics/* + ns_param ExcludePattern /admin/* + + +ns_section ns/server/${server}/acs/bboard + + ns_param PartialUrlStub /bboard/ + + # ns_param SystemName "Yourdomain Network Discussion Forums (default)" + # ns_param SystemOwner " something different (if desired) from SystemOwner above" + # ns_param HostAdministrator "something different from system-wide" + ns_param SenderEmail bboard@openacs.org + + # ns_param IndexPageDecoration "\"Downtown" + # ns_param ActivePageDecoration "" + # do we offer users a full-text search box + ns_param ProvideLocalSearchP 0 + + # do we use OpenACS search solution? + ns_param UseOpenACSSearch 1 + + # do we use Oracle's Context option (only works if + # ns_param ProvideLocalSearchP 1) + ns_param UseContext 0 + + # do we use standalone PLS search system + ns_param UsePLS 0 + + # do we use AltaVista (only works if ProvideLocalSearchP=0 + # and if the site's content is exposed to AltaVista) + ns_param LinktoAltaVista 0 + + # anything below this threshold is considered uninteresting + ns_param InterestLevelThreshold 4 + + # can a user start a new bboard + ns_param UserCanAddTopicsP 0 + + # link bboard permissions to AOLserver user; this is legacy + # code for ASME and probably doesn't work + ns_param UseNsPermAuthorizationP 0 + ns_param FileUploadingEnabledP 0 + + # this path does *not* contain a trailing "/" + ns_param FilePath /web/foobar/ + + # Urgent messages + ns_param UrgentMessageEnabledP 0 + ns_param DaysConsideredUrgent 14 + + # Enables per-thread email alerts. + ns_param EnableThreadEmailAlerts 1 + + +ns_section ns/server/${server}/acs/news + + # open means stuff goes live immediately + # wait means stuff waits for administrator to approve + # closed means only administrator can post + ns_param ApprovalPolicy wait + + # how many days a story is live (by default) + ns_param DefaultStoryLife 30 + + # When we display news items on a users workspace, what is the maximum + # number of items that we display? This lets us display the 10 most + # recent items easily w/out limiting the number of active stories + # Leave blank to display all + ns_param DefaultNumberOfStoriesToDisplay "" + + # ns_param SystemOwner " (defaults to site owner)" + # do we allow users to comment on news + ns_param SolicitCommentsP 1 + ns_param CommentApprovalPolicy open + # ns_param IndexPageDecoration "\"Nick" + # ns_param ItemPageDecoration "" + + +ns_section ns/server/${server}/acs/calendar + + ns_param SystemName Calendar + + # open means stuff goes live immediately + # wait means stuff waits for administrator to approve + # closed means only administrator can post + ns_param ApprovalPolicy wait + ns_param MaxEventsOnIndexPage 15 + + # defaults for users, depends on type of service + ns_param DaysFromPostingToStart 30 + ns_param DaysFromStartToEnd 0 + + # show an event a few days after it ends? + ns_param DaysFromEndToExpiration 3 + + # how many days a story is live (by default) + # ns_param SystemOwner " (defaults to site owner)" + ns_param SolicitCommentsP 1 + ns_param CommentApprovalPolicy open + ns_param TitleExample "Ansel Adams show at Getty Center in Los Angeles, March 1-June 15" + + # do we ask for country, state, city info? + ns_param EventsHaveLocationsP 1 + + # for the classified ad system + +ns_section ns/server/${server}/acs/gc + + # ns_param SystemName "" + # ns_param SystemOwner " (defaults to global system owner)" + ns_param PartialUrlStub /gc/ + ns_param ProvideLocalSearchP 1 + ns_param ProvideEmailAlerts 1 + + # send a reminder to people to edit or delete their ads? + ns_param NagAdOwners 1 + ns_param HowManyRecentAdsToDisplay 5 + + # How many bids an auction must collect to qualify as a "hot" auction. + ns_param HotAuctionThreshold 2 + + # some stuff to deal with annoying photo.net abusers + # don't let people put the word "reduced" in subject line + ns_param DisallowReducedInSubject 1 + ns_param DisallowExclamationPointInSubject 1 + ns_param DisallowAllUppercase 1 + ns_param DisalloweBay 1 + ns_param IncludeBannerIdeasP 0 + + # ns_param IndexPageDecorationTop "\"The" + # ns_param IndexPageDecorationSide "\"The" + # ns_param DomainTopDecorationTop "\"The" + # ns_param HotAuctionsDecoration "\"Money" + # ns_param PlaceAdDecoration "\"Rolls" + # ns_param PlaceAd2Decoration "\"Rolls" + # ns_param EditAd2Decoration "" + # ns_param AddAlertDecoration "\"Boykin" + ns_param SolicitCommentsP 1 + ns_param CommentApprovalPolicy open + + + # have the system write PICS headers for naughty pages + # or directories + # if EnabledP is 1 you can have as many + # NaughtyPatterns as you like; these are fed to + # ns_register_filter + +ns_section ns/server/${server}/acs/pics + + ns_param EnabledP 0 + ns_param NaughtyPattern /nudebabes/* + ns_param NaughtyPattern /doc/* + + # a PICS header has to all be on one line anyway + ns_param Protocol "{PICS-1.1 {headers PICS-Label}}" + ns_param Label "{(PICS-1.1 \"http://www.rsac.org/ratingsv01.html\" l gen true comment \"RSACi North America Server\" by \"philg@mit.edu\" for \"http://photo.net/photo/christina/\" on \"1998.03.13T18:06-0800\" r (n 4 s 0 v 0 l 0))}" + + +ns_section ns/server/${server}/acs/contest + + ns_param OfferIndexPageP 1 + ns_param ContestAdminOwner contestprogrammer@yourdomain.com + + +ns_section ns/server/${server}/acs/adserver + + # the location of the adserver .tcl pages in the file system (typically /adserver/) + # note the trailing slash; also note that this isn't where ads go + ns_param PartialUrlStub /adserver/ + ns_param DefaultAd /ads/scorecard.gif + ns_param DefaultTargetUrl http://www.scorecard.org + ns_param DetailedPerUserLoggingP 0 + + # the Neighbor to Neighbor service (sort of like bboard; + # http://photo.net/photo/ is probably the best example of this in use ) + + +ns_section ns/server/${server}/acs/neighbor + + # ns_param SystemName "Yourdomain Neighbor to Neighbor Service" + # ns_param SystemOwner " something different (if desired) from SystemOwner above" + # ns_param HostAdministrator "something different from system-wide" + # if you're only going to run one little category, and + # for backward compatibility for photo.net + # this is a category_id referencing the n_to_n_primary_categories + # table + + ns_param DefaultPrimaryCategory 1 + + # if someone can't think of more than one; affects links from opc.tcl + ns_param OnlyOnePrimaryCategoryP 0 + + # do we offer users a full-text search box + ns_param ProvideLocalSearchP 1 + + # do we use Oracle's Context option (only works if + # ns_param ProvideLocalSearchP 1) + ns_param UseContext 0 + + # do we use standalone PLS search system + ns_param UsePLS 0 + + # do we use AltaVista (only works if ProvideLocalSearchP=0 + # and if the site's content is exposed to AltaVista) + ns_param LinktoAltaVista 0 + ns_param SolicitCommentsP 1 + ns_param CommentApprovalPolicy wait + ns_param NReasonablePostings 100 + + # the clickthrough module (/tcl/ad-clickthrough.tcl) + + +ns_section ns/server/${server}/acs/click + + # ns_param CustomREGEXP "/ct/philg(/.+)\$" + + + # the referer module (/tcl/ad-referer.tcl) + +ns_section ns/server/${server}/acs/referer + + # domains to exclude from referer tracking + ns_param LocalDomain openacs.org + ns_param LocalDomain www.openacs.org + ns_param LocalDomain new.openacs.org + + # if any of these are set, we require at least one to be true + # (if you don't set these, you'll get lots of referrals from random + # local files and "bookmarks"; trust us) + ns_param InclusionGLOB http://* + ns_param InclusionGLOB HTTP://* + + + # the data warehouse module + + +ns_section ns/server/${server}/acs/dw + + ns_param DefaultTable ad_hoc_query_view + + # ns_param SystemName "yourdomain data warehouse" + + # redirects, separate by vertical bar (we could just do + # ns_param FROM "TO but that's bad because sometimes we might want to" + # redirect based on an = char, also we want to spec Inherit + # or JustOne (whether to do everything beginning with /foo + # or just "/foo" exactly) + # + # Another interesting option is Pattern=, which lets you say + # "redirect /~philg/whatevercomesnext to /philg/whatevercomesnext" + # (rather than just redirecting /~philg/* to a fixed location) + # + + # for the address book + +ns_section ns/server/${server}/acs/addressbook + + ns_param SendBirthdayAlerts 1 + + +ns_section ns/server/${server}/acs/comments + + # email notifications to author/ad_system_owner + ns_param EmailNewUnansweredQuestion 1 + ns_param EmailNewAlternativePerspective 1 + ns_param EmailNewRating 1 + ns_param EmailEditedUnansweredQuestion 1 + ns_param EmailEditedAlternativePerspective 1 + ns_param EmailEditedRating 1 + + +ns_section ns/server/${server}/acs/general-comments + + # Whether or not we accept file uploads for general comments. + ns_param AcceptAttachmentsP 1 + + # Maximum attachment size in bytes. Leave empty for no limitation. + ns_param MaxAttachmentSize 5000000 + ns_param AdminEditingOptionsInlineP 0 + + # Images with widths less than this parameter will be displayed inline. + ns_param InlineImageMaxWidth 512 + + # Use titles/one-lines for comments? + ns_param UseTitlesP 1 + + +ns_section ns/server/${server}/acs/general-links + + # use link clickthroughs? + ns_param ClickthroughP 1 + + # allow suggested links from /general-links/index.tcl? + ns_param AllowSuggestionsP 1 + + +ns_section ns/server/${server}/acs/links + + # email notifications to author/ad_system_owner + ns_param EmailNewLink 1 + ns_param EmailEditedLink 1 + + # use link clickthroughs? + ns_param GeneralLinksClickthroughP 1 + + +ns_section ns/server/${server}/acs/redirect + + # ns_param Inherit /from/|/to/ + # ns_param JustOne /randomoldfileonthisbox.html|http://www.otherpersonsserver.com/ + # ns_param Pattern /olddir/|/newdir/ + ns_param Pattern /pvt/address-book|/address-book + ns_param JustOne /why-not-mysql.html|/philosophy/why-not-mysql.html + ns_param JustOne /what-is-openacs.adp|/about/what-is-openacs.adp + ns_param JustOne /team.adp|/about/team.adp + + # for the /directory module wherein users get to look each other up + +ns_section ns/server/${server}/acs/directory + + ns_param ProvideUserBrowsePageP 1 + ns_param UserBrowsePageLimitedToNotNullUrlP 1 + + #ns_param IndexPageDecoration "\"Snowy" + #ns_param BrowsePageDecoration "\"Orangutan." + #ns_param SearchResultsDecoration "" + + # for the module that bills members or figures out which are losers + +ns_section ns/server/${server}/acs/member-value + + ns_param EnabledP 0 + ns_param UseRealMoneyP 0 + + # currency should be a three-char code that CyberCash likes, e.g., "USD" + ns_param Currency USD + + # if true, check mv_monthly_rates + ns_param ChargeMonthlyP 0 + ns_param ClassifiedAdRate 0 + ns_param ClassifiedAdMistakeRate 5 + ns_param ClassifiedAdSpamRate 25 + ns_param QuestionRate 0 + + # people who don't look in archives + ns_param QuestionDupeRate 5 + ns_param QuestionOffTopicRate 25 + ns_param AnswerRate 0 + + # deleted because inaccurate + ns_param AnswerWrongRate 5 + ns_param AnswerMistakeRate 2 + + # we might credit people for a good submission + ns_param CommentRate -5 + ns_param CommentDupeRate 5 + ns_param CommentSpamRate 25 + ns_param LinkRate 0 + ns_param LinkDupeRate 5 + ns_param LinkSpamRate 25 + ns_param BillingInterval month + + # wait until next interval if accumulated charges are less + # than this amount + ns_param BillingMinimum 7.50 + + # set this if you want notification of member value charges to go + # somewhere other than AdminOwner + # ns_param NotificationEmail "" + # what amount of money do we consider moves a user into the + # "expensive" class (bad for the site) + ns_param ExpensiveThreshold 20 + + # for the Content Tagging Package + # ns_param (PG|R|X)LogP "1 logs the potentially offensive material" + # ns_param (PG|R|X)BounceP "1 prevents the offensive material from being posted at all" + # ns_param (PG|R|X)BowdlerizeP "1 replaces relevant words with BowdlerizationText" + # Note that in generally, you can't bounce only PG and X, but not R, + # the scripts find the lowest allowed naughtiness to bounce or log. + +ns_section ns/server/${server}/acs/content-tagging + + # email address to notify if something needs attention + # defaults to SystemOwner + # ns_param Administrator "" + # log into naughty_events table + ns_param PGLogP 0 + ns_param RLogP 1 + ns_param XLogP 1 + + # prevent this level of stuff from being posted at all + ns_param PGBounceP 0 + ns_param RBounceP 0 + ns_param XBounceP 1 + + # send email to Administrator + ns_param PGNotifyP 0 + ns_param RNotifyP 0 + ns_param XNotifyP 1 + + # bowdlerize text + ns_param PGBowdlerizeP 0 + ns_param RBowdlerizeP 1 + ns_param XBowdlerizeP 1 + ns_param BowdlerizationText **** + + # what do we mask off for unlogged-in users + ns_param DefaultContentMask 0 + ns_param CacheTimeout 600 + ns_param UserContentMaskCacheTimeout 600 + + # for the ACS Chat System + +ns_section ns/server/${server}/acs/chat + + ns_param EnabledP 1 + # ns_param SystemName Chat + # how long to cache the postings to a room (updates force a cache update + # so this theoretically could be 5 hours or whatever) + ns_param CacheTimeout 120 + + # how long will a room's properties (e.g., private group, moderation) be cached + ns_param RoomPropertiesCacheTimeout 600 + ns_param UsersCanCreateRoomsP 0 + + # set to 1 if you want most recent postings on top; this is the way that + # theglobe.com and other familiar chat systems do it (keeps users from + # having to scroll to see new msgs) + ns_param MostRecentOnTopP 1 + + # do we want to offer users the option of sending private messages? + ns_param PrivateChatEnabledP 0 + + # do we offer users a link to a chat room's history? + ns_param ExposeChatHistoryP 1 + + # how many messages to display when users choose short medium or long + ns_param NShortMessages 25 + ns_param NMediumMessages 50 + ns_param NLongMessages 75 + + # show a picture at the index page and in individual rooms? + ns_param DefaultDecoration "\"Mouth.\"" + + # how often the javascript version should refresh itself + ns_param JavaScriptRefreshInterval 5 + + +ns_section ns/server/${server}/acs/mailing-list + + ns_param IndexPageDecoration "\"Mailboxes" + + +ns_section ns/server/${server}/acs/sidegraphics + + ns_param EnabledP 1 + ns_param /bboard/index.tcl http://photo.net/photo/pcd0796/linderhof-front-door-23.2.jpg + + + +ns_section ns/server/${server}/acs/glossary + + # open means stuff goes live immediately, user can edit own terms + # wait means stuff waits for administrator to approve, + # only administrator can edit + # closed means only administrator can post + ns_param ApprovalPolicy closed + + +ns_section ns/server/${server}/acs/robot-detection + + # the URL of the Web Robots DB text file + ns_param WebRobotsDB http://info.webcrawler.com/mak/projects/robots/active/all.txt + + # which URLs should ad_robot_filter check (uncomment to turn system on) + # ns_param FilterPattern /members-only-stuff/*.html + # ns_param FilterPattern /members-only-stuff/*.tcl + # the URL where robots should be sent + ns_param RedirectURL /robot-heaven/ + + # How frequently (in days) the robots table + # should be refreshed from the Web Robots DB + ns_param RefreshIntervalDays 30 + + # stuff for templates, multi-lingualism + +ns_section ns/server/${server}/acs/style + + # where to find templates, typically /web/${server}/templates + # (note lack of trailing slash, just like the pageroot) + # you can override it with this config param + # ns_param TemplateRoot "" + # do we look for language-specific templates, e.g., foobar.en.adp? + # (and do we offer user interface to help user choose) + ns_param MultiLingualP 0 + + # most publishers will want the language of Jesus Christ and the Bible + # to be the default (i.e., English ("en")), if only because there is so much + # embedded English UI in subsystems of the ACS + ns_param LanguageSiteDefault en + + # offer people a language choice without logging in? + ns_param LanguageCookieP 1 + + # do we look for plain. and fancy. templates, e.g., foobar.plain.adp? + # (and do we offer user interface to allow user to choose) + ns_param PlainFancyP 1 + + # most publishers will want "fancy" to be preferred (if available) + ns_param PlainFancySiteDefault fancy + + # offer people a graphics choice without logging in? + ns_param PlainFancyCookieP 1 + + # for the ticket tracking system + +ns_section ns/server/${server}/acs/ticket + + # when sending a note to an admin or engineer about a trouble + # ticket, what reply-to: address to use + # note that this address must be set up through your mail transfer + # agent to run a email enqueueing script. + # See doc/ticket.html for more info on configuring the ticket system. + # (from /web/${server}/bin/queue-message.pl) + ns_param TicketReplyEmail support-ticket-robot@yourdomain.com + + # The PicklistData specifies additional custom data fields you would like + # associated with tickets in the database. You can have up to five of these. + #ns_param PicklistData "hardware_model \"Hardware Model\" picklist_single_select data1 \"\" \"1000 (Merced)\" \"2500 (Charles)\" \"5000 (Connecticut)\"" + #ns_param PicklistData "software_version \"Software Version\" picklist_single_select data2 \"\" \"FooOS 1.0\" \"FooOS 1.0-EFT\" \"FooOS==OS 1.6\" \"FooOS 2.0\"" + # ns_param PicklistData "build \"Build\" text data4 25" + # if LinkTicketToUserGroupP = 1, each ticket is assigned to a user group + # a user must be in the group to see the ticket + ns_param LinkTicketToUserGroupP 0 + + # If CustomerCanCreateNewTickets = 1, customers may create new tickets. + # (A "customer" is any user who is not in the ticket admin group) + ns_param CustomerCanCreateNewTickets 1 + + # The menu of ticket severity choices + ns_param SeverityList "low medium serious critical showstopper" + + # can an issue creator administer the issue? + ns_param IssueCreatorAdminP 0 + + + # to tell the email queue system where to dispatch + # all of this is based on tags supplied by the mail-transfer agent + +ns_section ns/server/${server}/acs/email-queue + + # how often to check the queue for new messages + #ns_param QueueSweepInterval 300 + # what to do with a new message + # format is tag|tcl_proc_to_invoke + #ns_param DispatchPair ticket-tracker|ticket_process_message + + + +ns_section ns/server/${server}/acs/intranet + + ns_param IntranetName "yourdomain Network" + ns_param IntranetEnabledP 0 + ns_param DisplayVacationsOnCalendar 1 + + # the unit of measurement for entering salaries (month or year) + ns_param SalaryPeriodInput year + + # used to display salary + ns_param SalaryPeriodDisplay year + + # list of fee types + ns_param FeeTypes "\"setup\" \"monthly development\" \"monthly hosting\" \"hourly\" \"stock\"" + + # Do we want to track hours? + ns_param TrackHours 1 + + # what's the url stub? i.e. http://yourdomain.com + ns_param IntranetUrlStub /intranet + + # Group Types + ns_param IntranetGroupType intranet + ns_param ProjectGroupShortName project + ns_param OfficeGroupShortName office + ns_param CustomerGroupShortName customer + ns_param PartnerGroupShortName partner + ns_param ProcedureGroupShortName procedure + ns_param EmployeeGroupShortName employee + ns_param AuthorizedUsersGroupShortName authorized_users + + # What color do we put in the header row of tables? + ns_param TableColorHeader #e6e6e6 + + # What color do we put in the odd numbered rows of tables? + ns_param TableColorOdd #f4f4f4 + + # What color do we put in the even numbered rows of tables? + ns_param TableColorEven #ffffff + ns_param CommentApprovalPolicy open + + # If we want to include people who are delinquent with project + # reports in our status-report, what user_class_id do we use? + # Leave blank to skip this part of the status report + ns_param UserClassStatusReportID "" + + + +ns_section ns/server/${server}/acs/help + + # Root of the help directory hierarchy, relative to the PageRoot. + # Same as page root if not set. + # ns_param HelpPageRoot /help + + +ns_section ns/server/${server}/acs/fs + + ns_param SystemName "File Storage System" + # optional, defaults to main site owner + # ns_param SystemOwner fs-admin@yourdomain.com + ns_param DefaultPrivacyP f + + # do you want to maintain a public tree for site wide documents + ns_param PublicDocumentTreeP 1 + ns_param MaxNumberOfBytes 2000000 + ns_param HeaderColor #cccccc + ns_param DatePicture "MM/DD/YY HH24:MI" + ns_param FileInfoDisplayFontTag "" + ns_param UseIntermediaP 0 + + # Display mappings for file types. + # Format is pipe separated list of display string followed by + # MIME types. Types can use * and ? as wildcards. + # For anything not on the list, the default is to display + # the first portion of the MIME type, except in the case of + # application/, where the sub-type is displayed. + ns_param FileTypeMap Image|image/* + ns_param FileTypeMap "Word Document|application/msword|application/rtf" + ns_param FileTypeMap Excel|application/msexcel + ns_param FileTypeMap PowerPoint|*powerpoint + ns_param CommentApprovalPolicy open + + + # for the ecommerce module + +ns_section ns/server/${server}/acs/ecommerce + + # set to 1 if you're using the ecommerce module + ns_param EnabledP 0 + ns_param WeightUnits lbs + ns_param Currency USD + + # this is used on the category browse page (and for subcategories/subsubcategories) + ns_param ProductsToDisplayPerPage 10 + + # whether to allow user comments on products + ns_param ProductCommentsAllowP 1 + + # whether user comments on products (if allowed) need approval before becoming live + ns_param ProductCommentsNeedApprovalP 1 + + # whether the system should calculate additional product relationships + ns_param CalcProductRelationshipsP 0 + + # whether users can see what user classes they are in + ns_param UserClassUserViewP 1 + + # whether a user can request to be a member of a user class + ns_param UserClassAllowSelfPlacement 1 + + # if a user requests to be in a user class, is approval required before that + # user becomes a member of the user class + ns_param UserClassApproveP 1 + + # what percentage of an item's shipping cost should be refunded if an item is returned + ns_param ShippingRefundPercent 0 + + # whether to allow express shipping + ns_param ExpressShippingP 1 + + # whether to save credit card data (you have to save it if you're going to do manual billing) -- + # if you save it, then your users can reuse their credit card with one click + ns_param SaveCreditCardDataP 1 + + # for thumbnails of products, specify either width or height (whichever is + # more important, and then the other will be determined based on the + # original image size, keeping aspect ratio constant) -- if both are + # specified, the width setting will take precedence, and if neither + # is specified, the thumbnail will be width=100 + ns_param ThumbnailWidth 100 + + # ns_param ThumbnailHeight 100 + # stock status messages + # o = out of stock, q = ships quickly, + # m = ships moderately quickly, s = ships slowly + ns_param StockMessageO "Out of Stock" + ns_param StockMessageQ "Usually Ships Within 24 Hours" + ns_param StockMessageM "Usually Ships Within 2-3 Days" + ns_param StockMessageS "Usually Ships Within 2-4 Weeks" + ns_param StockMessageI "In Stock" + + # # of days an 'in_basket' order will remain in + # the system before a cron job expires it + ns_param CartDuration 30 + + # whether customers will be able to place orders + # for items whose available_date has not yet come + ns_param AllowPreOrdersP 1 + + # all outgoing email is sent from this address + ns_param CustomerServiceEmailAddress service@yourdomain.com + + # you may or may not wish to have the people recording + # shipments receive messages like "unable to authorize + # payment for shipment" -- depending on whether they + # they're in a position to do anything about the problem + # (e.g. abort shipment) + ns_param DisplayTransactionMessagesDuringFulfillmentP 1 + + # whether to allow users to buy gift certificates + ns_param SellGiftCertificatesP 1 + + # minimum gift certificate amount they can buy + # (this does not impose minimum amount for administrators + # giving users gift certificates) + ns_param MinGiftCertificateAmount 5 + + # maximum gift certificate amount they can buy + ns_param MaxGiftCertificateAmount 300 + + # number of months until user-purchased gift certificates + # expire + ns_param GiftCertificateMonths 12 + + # **Everything above this is a publishing decision.** + # **Everything below this is a technical parameter.** + # domain of the site -- I know other modules have this, but they + # might not be installed and this is needed so that I can redirect + # the shopping cart to https + ns_param LocalDomain yourdomain.com + + # the directory that the ecommerce module is in + ns_param EcommerceDirectory /web/${server}/www/ecommerce/ + + # web path to the directory that the ecommerce user files are in + ns_param EcommercePath /ecommerce/ + + # path to Product data directories (where product files like images are kept) + ns_param EcommerceDataDirectory /web/${server}/data/ecommerce/ + + # This path goes on the end of the EcommerceDataDirectory + ns_param ProductDataDirectory product/ + + # Set to 1 if you have a comparison shopping service -- Note: support for + # multiple retailers does not work yet in Version 1.0 of the Ecommerce + # Module, so leave it as 0 + ns_param MultipleRetailersPerProductP 0 + + # for the ACS Bookmarks System + +ns_section ns/server/${server}/acs/bm + + # optional, defaults to main site owner + ns_param SystemOwner someguy@yourdomain.com + + # main page title + ns_param SystemName "Bookmarks System" + + # text decoration for dead links + ns_param DeadDecoration + + # text decoration for folders + ns_param FolderDecoration + + # text decoration for bookmarks invisible to the public + ns_param HiddenDecoration "" + + # background color of folders + ns_param FolderBGColor #f3f3f3 + + # background color of files + ns_param BookmarkBGColor #ffffff + + # size of largest bookmarks file permissible to upload + ns_param MaxNumberOfBytes 2000000 + + +ns_section ns/server/${server}/acs/curriculum + + ns_param EnabledP 0 + + # does ad_footer put this in every dynamic page? + ns_param StickInFooterP 1 + + # does ad_serve_html_page put this on every static page? + ns_param StickInStaticPagesP 1 + + # on which URLs should the system look for/set cookies + ns_param FilterPattern *.html + ns_param FilterPattern *.tcl + ns_param BarFontTag "" + ns_param HelpAnchorText "?" + + # stuff like a background color for the table cells, goes within a TD + ns_param CellExtraTags bgcolor=#EEEEEE + + +ns_section ns/server/${server}/acs/crm + + # how often to update the CRM states + ns_param UpdatePeriodHours 24 + + +ns_section ns/server/${server}/acs/portals + + ns_param Administrator portaladmin@yourdomain.com + ns_param AdministratorName "Portal Administrator" + ns_param SystemName "yourdomain portals" + + # set to 1 if individual may create their own portals + ns_param AllowUserLevelPortals 1 + + # set to 1 if super administrator can add or remove themselves and other super administrators + ns_param SuperAdminCanChangeSuperAdminP 0 + ns_param BodyTag "" + ns_param FontTag "" + + # These standardize a prettier table than the browser default + ns_param BeginTable "
" + ns_param EndTable
+ ns_param HeaderTD "" + ns_param HeaderBGColor #006600 + ns_param SubHeaderTD "" + ns_param SubHeaderBGColor #eeeedd + ns_param NormalTD "" + + # For portals with multiple pages, tabs link to the other pages, set this to 1 if you want each tab + # to be equal width instead of proportional to the name of the page + ns_param EqualWidthTabsP 0 + ns_param MainPublicURL /portals/ + + # number of seconds to memoize a portal page + ns_param CacheTimeout 100 + + # browsers will decide the "optimal" column sizes unless you force column widths here: + #ns_param LeftSideWidth "" + #ns_param RightSideWidth "" + ns_param SpacerImage /portals/spacer.gif + ns_param PortalExtension .ptl + + +ns_section ns/server/${server}/acs/press + + # maximum number of press items to display on the press coverage page + ns_param DisplayMax 10 + + # number of days a press item remains active + ns_param ActiveDays 60 + + # do we use clickthrough tracking from the press coverage page? + ns_param "ClickthroughP " " 1" + + +ns_section ns/server/${server}/acs/monitoring + + # People to email for alerts + # ns_param PersontoNotify nerd1@yourdomain.com + # ns_param PersontoNotify nerd2@yourdomain.com + # location of the watchdog perl script + ns_param WatchDogParser /web/${server}/bin/aolserver-errors.pl + + # watchdog frequency in minutes + ns_param WatchDogFrequency 15 + + +ns_section ns/server/${server}/acs/site-wide-search + + # ns_param BounceQueriesTo http://backup.photo.net + # ns_param BounceResultsTo http://photo.net + + +ns_section ns/server/${server}/acs/display + + #specify the maximum size of a logo + ns_param MaxLogoSize 500000 + + +ns_section ns/server/${server}/acs/custom-sections + + #specify the maximum size of a binary file that can be uploaded for a content section + ns_param MaxBinaryFileSize 2000000 + + +ns_section ns/server/${server}/acs/download + + # root directory of the downloadable files + ns_param DownloadRoot /web/${server}/download/ + + +ns_section ns/server/${server}/acs/wp + + # Paths to use for serving styles and presentations. + ns_param StyleURL /wp/style/ + ns_param PresentationURL /wp/display/ + ns_param PresentationEditURL /wp/display-edit/ + ns_param AttachURL /wp/attach/ + ns_param SolicitCommentsP 1 + ns_param CommentApprovalPolicy open + + # Path to the unzip program to use for bulk image uploading. + ns_param PathToUnzip /usr/bin/unzip + + # Is bulk image uploading enabled? + ns_param AllowBulkUploadP 1 + + +ns_section ns/server/${server}/acs/users + + # all user web content will be rooted under this directory. This + # directory will be the root of all the web content being published + # by the users of the system. + ns_param ContentRoot /web/${server}/users/ + + # Maximum quota for a 'normal user' (a lesser mortal who is not the + # site wide administrator) of the site in mega-bytes. For example, a + # '20' corresponds to 20,971,520 bytes. Values need not be integer. + # Value is overridden for a particular user throught existence of + # entry in the users_special_quotas table. + ns_param NormalUserMaxQuota 5 + + # Maximum quota for site wide administrators. Special quotas can be + # set by adding rows to the users_special_quotas table. This param + # will be used for a site wide administrator only when he/she doesnt + # have an entry in the users_special_quotas table. + ns_param PrivelegedUserMaxQuota 20 + + # Space taken by a directory (in bytes). We need this so that a user + # cannot crash the system by creating millions of directories. This + # will ensure that a directory detracts from his/her quota. + ns_param DirectorySpaceRequirement 2048 + + # This determines the default view for displaying files in home-page + # administration (maintenance) pages. There are two supported values + # for this: tree and normal. + ns_param DefaultView normal + + # This is the list of files that are served as index pages. If all + # of these files are nonexistant in a directory requested through + # the homepage content server (hp_serve), then the server generates + # a default (personalized) index page for the user. If more than one + # of these files exist in the requested directory, the filename + # which appears earliest in this list is given preference. If no + # filename is provided below then the server always generates index + # pages. In most systems, the index.html, index.htm, and Default.htm + # are the index filenames. In some systems home.html is also an + # index file but generally this is used whenever users want to give + # the world read/browse access to their web directories. In this + # regard, home.html should not be added to the candidacy list. + # Finally, it is obvious that if one of these files exist in the + # directory then the web-browser cannot obtain a lisitng of all the + # files in the directory. + ns_param IndexFilenameCandidacyList "index.html index.htm Default.htm" + + # what if a site gets really large and the primary purpose is giving + # members personal homepages (e.g., if an adopter of ACS decides to + # become "The GeoCities of Brazil")? How do we support this? First, + # users could decide to join user groups. Then the /users/ index + # page would show a summary of user groups whose members have + # personal pages. This requires no new data in Oracle. This is + # enabled with SubdivisionByGroupP=1 in the .ini file. Users with + # homepages and no group affiliation show up in "unaffiliated" (fun + # with OUTER JOIN). When SubdivisionByNeighborhoodP=1, we either + # keep a denormalized neighborhood_sortkey in the homepages table + # and flag the "homepages" that are actually neighborhood folders or + # have some separate tables holding categorization. (philg). + ns_param SubdivisionByNeighborhoodP 0 + + # This parameter will determine whether we'll be showing appropriate + # options on the user's workspace or not. This will also determine + # whether this system offers homepages or not. In effect, this + # parameter determines whether the homepage facility is enabled or + # not. This does not effect the users administration pages, though. + ns_param HomepageEnabledP 0 + + +ns_section ns/server/${server}/acs/spam + + # Pairs of {email_addr_pattern pseudo-mime-type} + ns_param EmailTypes "{%@hotmail.com text/html} {%@aol.com text/aol-html}" + ns_param DailySpamDirectory /web/${server}/spam + ns_param RemovalBlurb "{-----\\nSent through http://yourdomain.com\\n\\n}" + + +ns_section ns/server/${server}/acs/gp + + # can we give row-level permissions to groups as well? + ns_param GroupPermissionsP 1 + + # do we want comment permissions? + ns_param CommentPermissionsP 1 + + # do we want to show our user list to people editing permissions? + ns_param ShowUsersP 0 + + # do we want to show a Finish button on the edit-page-permissions page? + ns_param ShowFinishButtonP 1 + + +ns_section ns/server/${server}/acs/pdm + + # Flag to display the administration menu bar + ns_param MenuOnAdminPagesP 0 + + # Flag to display the default menu bar on non-/admin pages + ns_param MenuOnUserPagesP 0 + + +ns_section ns/server/${server}/acs/partner + + # what is the name of the default partner cookie? + ns_param CookieDefault ad + + # All the variables we want to collect (Any variables added here + # must still be manually added to the data model.) + # Each line of Variable= contains a pipe separated pair of + # name_of_column in ad_partner | what to display on the add/edit forms + ns_param Variable "partner_name|Partner Name" + ns_param Variable "partner_cookie|Partner Cookie" + ns_param Variable "default_font_face|Default Font Face" + ns_param Variable "default_font_color|Default Font Color" + ns_param Variable "title_font_face|Title Font Face" + ns_param Variable "title_font_color|Title Font Color" + + # The Software Development Manager (SDM) + +ns_section ns/server/${server}/acs/sdm + + ns_param UrlStub /sdm + ns_param SoftwareRoot /web/${server}/data/sdm-software + ns_param SdmVersion 0.4 + ns_param NotificationSenderEmail software@openacs.org + ns_param SystemName "Software Development Manager" + ns_param DefaultSeverity medium + ns_param ListOfSeverities "low medium high critical" + + # The Todo List Manager (todo) + +ns_section ns/server/${server}/acs/todo + + ns_param UrlStub /todo + ns_param SystemName "To-Do List Manager" + ns_param Administrator admin@yourservername.com + + # The Cybercash Stub + # This stub will replace the cc_send_to_server_21 proc + # and fake the cybercash action for testing purposes + # this necessitates cybercash-stub.sql in the data model + # directory, make sure to load it before you start. + +ns_section ns/server/${server}/acs/ccstub + + ns_param EnabledP 1 + + #to be able to restart the aolserver from the admin page, + #INIFile must have the path and name of the config file. + #ie: /web/aolserver/${server}.tcl + #To disable, leave INIFile blank + +ns_section ns/server/${server}/acs/restart + + ns_param INIFile "" + + +ns_section ns/server/${server}/acs/webmail + + # This module requires the aolserver module nsjava. + # See http://nsjava.sourceforge.net + ns_param WebmailEnabledP false + + # Time interval for scheduling processing of the + # incoming mail queue. + ns_param ProcesssQueueInterval 60 + + # Alias and queue directory. See .../doc/webmail.html + # for explanation of their purpose. + ns_param AliasDirectory "/home/nsadmin/qmail/alias" + ns_param QueueDirectory "/home/nsadmin/qmail/queue/" + + # Local Variables: + # eval: (auto-save-mode 0) + # End: + + + + + + + + + + + + + + + + + + + + + + + + + + + + Index: web/openacs/tcl/00-ad-preload.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/00-ad-preload.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/00-ad-preload.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,37 @@ +# 00-ad-preload.tcl,v 3.7 2000/02/29 04:14:05 jsc Exp +# Name: 00-ad-preload.tcl +# Author: Jon Salz +# Date: 24 Feb 2000 +# Description: Sources library files that need to be loaded before the rest. + +# Necessary to determine which ad-aolserver-*.tcl.preload to source. +proc util_aolserver_2_p {} { + if {[string index [ns_info version] 0] == "2"} { + return 1 + } else { + return 0 + } +} + +ns_log "Notice" "Sourcing files for preload..." + +if { [util_aolserver_2_p] } { + set file_to_preload "ad-aolserver-2.tcl.preload" + foreach file [list $file_to_preload ad-utilities.tcl.preload ad-defs.tcl.preload] { + ns_log Notice "preloading [ns_info tcllib]/$file" + source "[ns_info tcllib]/$file" + } +} else { + set file_to_preload "ad-aolserver-3.tcl.preload" + foreach file [list ad-utilities.tcl.preload ad-defs.tcl.preload $file_to_preload] { + ns_log Notice "preloading [ns_info tcllib]/$file" + source "[ns_info tcllib]/$file" + } +} + +# foreach file [list ad-utilities.tcl.preload ad-defs.tcl.preload $file_to_preload] { +# ns_log Notice "preloading [ns_info tcllib]/$file" +# source "[ns_info tcllib]/$file" +# } +ns_log "Notice" "Done preloading." + Index: web/openacs/tcl/ad-abstract-url.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-abstract-url.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-abstract-url.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,167 @@ +# /tcl/ad-abstract-url.tcl +# +# Provides support for abstract URL processing (see doc/abstract-url.html). +# +# Author: Jon Salz +# Date: 27 Feb 2000 +# +# ad-abstract-url.tcl,v 3.3.2.3 2000/04/11 08:26:46 ron Exp + +util_report_library_entry + +# we must take conn as an argument so that it is defined if we source +# a legacy .tcl script using $conn ; we also need the ignore arg +# so that AOLserver knows to put a valid conn ID into the var +proc_doc ad_handle_abstract_url {conn ignore} { +A registered procedure which searches through the file system for an appropriate +file to serve. The algorithm is as follows: + +
    +
  1. If the URL specifies a directory but doesn't have a trailing slash, +append a slash to the URL and redirect (just like AOLserver would). +
  2. If the URL specifies a directory and does have a trailing slash, +append "index" to the URL (so we'll search for an index.* file +in the filesystem). +
  3. If the file corresponding to the requested URL exists (probably because the +user provided the extension), just deliver the file. +
  4. Find a file in the file system with the provided URL as the root (i.e., +some file exists which is the URL plus some extension). Give precedence to +extensions specified in the ExtensionPrecedence parameter in the +abstract-url configuration section (in the order provided). +If such a file exists, deliver it. +
  5. The requested resource doesn't exist - return a 404 Not Found. +
+ +} { + global ad_conn + + # The URL, minus the scoping components. Right now this is the whole URL (since we + # don't handle scoping here). + set ad_conn(url) [ns_urldecode [ns_conn url]] + + set ad_conn(canonicalurl) $ad_conn(url) + set ad_conn(file) "" + + if { [lsearch -regexp [ns_conn urlv] {\.\.}] != -1 } { + # Don't serve anything containing two or more periods as a path element + ns_returnforbidden + return + } + + # Determine the path corresponding to the user's request (i.e., prepend the document root) + set path [ns_url2file $ad_conn(url)] + + if { [file isdirectory $path] } { + if { ![regexp {/$} $ad_conn(url)] } { + # Directory name with no trailing slash. Redirect to the same URL but with + # a trailing slash. + + set url "[ns_conn url]/" + if { [ns_conn query] != "" } { + append url "?[ns_conn query]" + } + ns_returnredirect $url + return + } else { + # Directory name with trailing slash. Search for an index.* file. + set dir_index 1 + set path "[string trimright $path /]/index" + set ad_conn(canonicalurl) "[string trimright $ad_conn(canonicalurl)]/index" + } + } + + if { ![file isfile $path] } { + # It doesn't exist - glob for the right file. + if { ![file isdirectory [file dirname $path]] } { + ns_returnnotfound + return + } + + set ad_conn(file) [ad_get_true_file_path $path] + + # Nothing at all found! 404 time. + if { ![string compare $ad_conn(file) ""] } { + if { [info exists dir_index] && [nsv_get ad_abstract_url directory_listing_p] } { + _ns_dirlist + return + } else { + ns_returnnotfound + return + } + } + + set ad_conn(canonicalurl) "[string trimright [file dirname $ad_conn(canonicalurl)] /]/[file tail $ad_conn(file)]" + } else { + set ad_conn(file) $path + } + + set extension [file extension $ad_conn(file)] + if { $extension == ".tcl" } { + # Tcl file - use source. + source $ad_conn(file) + } elseif { $extension == ".adp" } { + # ADP file - parse and return the ADP. + set adp [ns_adp_parse -file $ad_conn(file)] + set content_type [ns_set iget [ns_conn outputheaders] "content-type"] + if { $content_type == "" } { + set content_type "text/html" + } + ns_return 200 $content_type $adp + } elseif { $extension == ".html" || $extension == ".htm" } { + ad_serve_html_page $conn $ad_conn(canonicalurl) + } else { + # Some other random kind of find - return it. + ns_returnfile 200 [ns_guesstype $ad_conn(file)] $ad_conn(file) + } +} + +proc_doc ad_get_true_file_path { path } { Given a path in the filesystem, returns the file that would be served, trying all possible extensions. Returns an empty string if there's no file "$path.*" in the filesystem (even if the file $path itself does exist). } { + # Sub out funky characters in the pathname, so the user can't request + # http://www.arsdigita.com/*/index (causing a potentially expensive glob + # and bypassing registered procedures)! + regsub -all {[^0-9a-zA-Z_/.]} $path {\\&} path_glob + + # Grab a list of all available files with extensions. + set files [glob -nocomplain "$path_glob.*"] + + # Search for files in the order specified in ExtensionPrecedence. + set precedence [ad_parameter "ExtensionPrecedence" "abstract-url" "tcl"] + foreach extension [split [string trim $precedence] ","] { + if { [lsearch $files "$path.$extension"] != -1 } { + return "$path.$extension" + } + } + + # None of the extensions from ExtensionPrecedence were found - just pick + # the first in alphabetical order. + if { [llength $files] > 0 } { + set files [lsort $files] + return [lindex $files 0] + } + + # Nada! + return "" +} + +# Make sure ad_abstract_url array exists +nsv_set ad_abstract_url . "" + +if { ![nsv_exists ad_abstract_url registered] && \ + [ad_parameter "EnableAbstractURLsP" "abstract-url" 0] } { + nsv_set ad_abstract_url registered "t" + + set listings [ns_config "ns/server/[ns_info server]" "directorylisting" "none"] + if { [string compare $listings "fancy"] || [string compare $listings "simple"] } { + nsv_set ad_abstract_url directory_listing_p 1 + } else { + nsv_set ad_abstract_url directory_listing_p 0 + } + + foreach method { GET POST HEAD } { + ns_log "Notice" "Registering $method / for abstract URL processing" + ns_register_proc $method / ad_handle_abstract_url + } +} + +util_report_successful_library_load + Index: web/openacs/tcl/ad-admin.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-admin.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-admin.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,473 @@ +# ad-admin.tcl,v 3.2 2000/03/02 20:45:16 davis Exp +# ad-admin.tcl +# +# created by philg 11/18/98 +# +# procedures used only in admin pages (mostly the user class stuff) +# + +util_report_library_entry + +proc_doc ad_administrator_p {db {user_id ""}} {Returns 1 if the user is part of the site-wide administration group. 0 otherwise.} { + if [empty_string_p $user_id] { + set user_id [ad_verify_and_get_user_id $db] + } + + set ad_group_member_p [database_to_tcl_string $db "select ad_group_member_p($user_id, system_administrator_group_id()) from dual"] + + return [ad_decode $ad_group_member_p "t" 1 0] +} + +ns_share -init {set admin_administrator_filter_installed_p 0} admin_administrator_filter_installed_p + +if { !$admin_administrator_filter_installed_p } { + set admin_administrator_filter_installed_p 1 + ns_register_filter preauth GET "/admin/*" ad_restrict_to_administrator + ns_log Notice "/tcl/ad-admin.tcl is restricting URLs matching \"/admin/*\" to administrator" +} + +proc ad_restrict_to_administrator {conn args why} { + set db [ns_db gethandle subquery] + if { [ad_administrator_p $db] } { + ns_db releasehandle $db + return "filter_ok" + } else { + ns_db releasehandle $db + ad_return_error "You are not an administrator" "Sorry, but you must be logged on as a site wide administrator to talk to the admin pages. + +

+ +Visit /register/ to log in now. +" + # have AOLserver abort the thread + return "filter_return" + } +} + + +# the proc below was added June 27, 1999, inspired by Malte Sussdorff (sussdorff@sussdorff.de) +proc_doc ad_ssl_available_p {} "Returns 1 if this AOLserver has the SSL module installed." { + if { [ns_config ns/server/[ns_info server]/modules nsssl] != "" } { + return 1 + } else { + return 0 + } +} + +ns_share -init {set admin_ssl_filters_installed_p 0} admin_ssl_filters_installed_p + +if {!$admin_ssl_filters_installed_p && [ad_ssl_available_p]} { + set admin_ssl_filters_installed_p 1 + # we'd like to use ad_parameter_all_values_as_list here but can't because + # it isn't defined until ad-defs.tcl + set the_set [ns_configsection "ns/server/[ns_info server]/acs"] + set filter_patterns [list] + for {set i 0} {$i < [ns_set size $the_set]} {incr i} { + if { [ns_set key $the_set $i] == "RestrictToSSL" } { + lappend filter_patterns [ns_set value $the_set $i] + } + } + foreach pattern $filter_patterns { + ad_register_filter preauth GET $pattern ad_restrict_to_https + ns_log Notice "/tcl/ad-admin.tcl is restricting URLs matching \"$pattern\" to SSL" + } +} + +proc ad_restrict_to_https {conn args why} { +# if { [ns_conn driver] == "nsssl" } { + # we're happy; administrator is being safe and password + # can't be sniffed +# return "filter_ok" +# } else { + # ad_return_error "Please use HTTPS" "Sorry but you have to use HTTPS to talk to the admin pages." + # have AOLserver abort the thread + set secure_hostname [ns_config ns/server/[ns_info server]/module/nsssl Hostname] + ns_returnredirect "https://$secure_hostname[ns_conn url]" + return "filter_return" +# } +} + + + +proc_doc ad_approval_system_inuse_p {} "Returns 1 if the system is configured to use and approval system." { + if {[ad_parameter RegistrationRequiresEmailVerification] && [ad_parameter RegistrationRequiresApprovalP] } { + return 1 + } else { + return 0 + } +} + + +proc ad_user_class_parameters {} { + return [list category_id country_code usps_abbrev intranet_user_p group_id last_name_starts_with email_starts_with expensive user_state sex age_above_years age_below_years registration_during_month registration_before_days registration_after_days registration_after_date last_login_before_days last_login_after_days last_login_equals_days number_visits_below number_visits_above user_class_id sql_post_select crm_state curriculum_elements_completed] +} + +proc_doc ad_user_class_description {selection} "Takes an ns_set of key/value pairs and produces a human-readable description of the class of users specified." { + set db [ns_db gethandle subquery] + set clauses [list] + set pretty_description "" + # because we named our arg "selection", we can use this magic + # utility procedure to set everything as a local var + set_variables_after_query + + foreach criteria [ad_user_class_parameters] { + if { [info exists $criteria] && ![empty_string_p [set $criteria]] } { + switch $criteria { + "category_id" { + set pretty_category [database_to_tcl_string $db "select category from categories where category_id = $category_id"] + lappend clauses "said they were interested in $pretty_category" + } + "country_code" { + set pretty_country [database_to_tcl_string $db "select country_name from country_codes where iso = '$country_code'"] + lappend clauses "told us that they live in $pretty_country" + } + "usps_abbrev" { + set pretty_state [database_to_tcl_string $db "select state_name from states where usps_abbrev = '$usps_abbrev'"] + lappend clauses "told us that they live in $pretty_state" + } + "intranet_user_p" { + lappend clauses "are an employee" + } + "group_id" { + set group_name [database_to_tcl_string $db "select group_name from user_groups where group_id=$group_id"] + lappend clauses "are a member of $group_name" + } + "last_name_starts_with" { + lappend clauses "have a last name starting with $last_name_starts_with" + } + "email_starts_with" { + lappend clauses "have an email address starting with $email_starts_with" + } + "expensive" { + lappend clauses "have accumulated unpaid charges of more than [ad_parameter ExpensiveThreshold "member-value"]" + } + "user_state" { + lappend clauses "have user state of $user_state" + } + "sex" { + lappend clauses "are $sex." + } + "age_above_years" { + lappend clauses "is older than $age_above_years years" + } + "age_below_years" { + lappend clauses "is younger than $age_below_years years" + } + "registration_during_month" { + set pretty_during_month [database_to_tcl_string $db "select to_char(to_date('$registration_during_month','YYYYMM'),'FMMonth YYYY') from dual"] + lappend clauses "registered during $pretty_during_month" + } + "registration_before_days" { + lappend clauses "registered in the last $registration_before_days days" + } + "registration_after_days" { + lappend clauses "registered over $registration_after_days days ago" + } + "registration_after_date" { + lappend clauses "registered on or after $registration_after_date" + } + "last_login_before_days" { + lappend clauses "visited the site in the last $last_login_before_days days" + } + "last_login_after_days" { + lappend clauses "have not visited the site in the last $last_login_after_days days" + } + "last_login_equals_days" { + if { $last_login_equals_days == 1 } { + lappend clauses "visited the site exactly 1 day ago" + } else { + lappend clauses "visited the site exactly $last_login_equals_days days ago" + } + } + "number_of_visits_below" { + lappend clauses "have visited less than $number_visits_below times" + } + "number_of_visits_above" { + lappend clauses "have visited more than $number_visits_above times" + } + "user_class_id" { + set pretty_class_name [database_to_tcl_string $db "select name from user_classes where user_class_id = $user_class_id"] + lappend clauses "are in the user class $pretty_class_name" + } + "sql_post_select" { + lappend clauses "are returned by \"select users(*) from $sql_post_select" + } + "crm_state" { + lappend clauses "are in the customer state \"$crm_state\"" + } + "curriculum_elements_completed" { + if { $curriculum_elements_completed == 1 } { + lappend clauses "who have completed exactly $curriculum_elements_completed curriculum element" + } else { + lappend clauses "who have completed exactly $curriculum_elements_completed curriculum elements" + } + } + } + if { [info exists combine_method] && $combine_method == "or" } { + set pretty_description [join $clauses " or "] + } else { + set pretty_description [join $clauses " and "] + } + + } + } + ns_db releasehandle $db + return $pretty_description +} + + + +proc_doc ad_user_class_query {selection} "Takes an ns_set of key/value pairs and produces a query for the class of users specified (one user per row returned)." { + # we might need this + set where_clauses [list] + set join_clauses [list] + set group_clauses [list] + set having_clauses [list] + set tables [list users] + # because we named our arg "selection", we can use this magic + # utility procedure to set everything as a local var + set_variables_after_query + + # if we are using a user_class, just get the info + + if { [info exists count_only_p] && $count_only_p } { + set select_list "count(users.user_id)" + } else { + # Get all the non-LOB columns. + set user_columns [list] + set db [ns_db gethandle subquery] + foreach column [GetColumnNames $db "users"] { + if { $column != "portrait" && $column != "portrait_thumbnail" } { + lappend user_columns "users.$column" + } + } + ns_db releasehandle $db + set select_list [join $user_columns ", "] + } + if { [info exists include_contact_p] && $include_contact_p} { + append select_list ", user_contact_summary(users.user_id) as contact_summary" + } + if { [info exists include_demographics_p] && $include_demographics_p} { + append select_list ", user_demographics_summary(users.user_id) as demographics_summary" + } + + if { [info exists user_class_id] && ![empty_string_p $user_class_id] } { + set db [ns_db gethandle subquery] + set sql_post_select [database_to_tcl_string $db "select sql_post_select + from user_classes where user_class_id = $user_class_id"] + ns_db releasehandle $db + return "select $select_list $sql_post_select" + } + + if { [info exists sql_post_select] && ![empty_string_p $sql_post_select] } { + return "select $select_list $sql_post_select" + } + + foreach criteria [ad_user_class_parameters] { + if { [info exists $criteria] && ![empty_string_p [set $criteria]] } { + switch $criteria { + "category_id" { + if {[lsearch $tables "users_interests"] == -1 } { + lappend tables "users_interests" + lappend join_clauses "users.user_id = users_interests.user_id" + } + lappend where_clauses "users_interests.category_id = $category_id" + } + "country_code" { + if {[lsearch $tables "users_contact"] == -1 } { + lappend tables "users_contact" + lappend join_clauses "users.user_id = users_contact.user_id" + } + lappend where_clauses "users_contact.ha_country_code = '$country_code'" + } + "usps_abbrev" { + if {[lsearch $tables "users_contact"] == -1 } { + lappend tables "users_contact" + lappend join_clauses "users.user_id = users_contact.user_id" + } + lappend where_clauses "(users_contact.ha_state = '$usps_abbrev' and (users_contact.ha_country_code is null or users_contact.ha_country_code = 'us'))" + } + "intranet_user_p" { + if {$intranet_user_p == "t" && [lsearch $tables "intranet_users"] == -1 } { + lappend tables "im_employee_info" + lappend join_clauses "users.user_id = im_employee_info.user_id" + } + } + "group_id" { + #if {[lsearch $tables "users_group_map"] == -1 } { + #lappend tables "user_group_map" + #lappend join_clauses "users.user_id = user_group_map.user_id" + #} + #lappend where_clauses "user_group_map.group_id = $group_id" + lappend where_clauses "ad_group_member_p(users.user_id, $group_id) = 't'" + } + + "last_name_starts_with" { + lappend where_clauses "upper(users.last_name) like upper('[DoubleApos $last_name_starts_with]%')" + } + "email_starts_with" { + lappend where_clauses "upper(users.email) like upper('[DoubleApos $email_starts_with]%')" + } + "expensive" { + if { [info exists count_only_p] && $count_only_p } { + lappend where_clauses "[ad_parameter ExpensiveThreshold "member-value"] < (select sum(amount) from users_charges where users_charges.user_id = users.user_id)" + } else { + if {[lsearch $tables "user_charges"] == -1 } { + lappend tables "users_charges" + lappend join_clauses "users.user_id = users_charges.user_id" + } + # we are going to be selecting users.* in general, so + # we must group by all the columns in users (can't + # GROUP BY USERS.* in Oracle, sadly) + set db [ns_db gethandle subquery] + foreach column [GetColumnNames $db "users"] { + # can't group by a BLOB column. + if { $column != "portrait" && $column != "portrait_thumbnail" } { + lappend group_clauses "users.$column" + } + } + ns_db releasehandle $db + lappend having_clauses "sum(users_charges.amount) > [ad_parameter ExpensiveThreshold "member-value"]" + # only the ones where they haven't paid + lappend where_clauses "users_charges.order_id is null" + } + } + "user_state" { + lappend where_clauses "users.user_state = '$user_state'" + } + "sex" { + if {[lsearch $tables "users_demographics"] == -1 } { + lappend tables "users_demographics" + lappend join_clauses "users.user_id = users_demographics.user_id" + } + lappend where_clauses "users_demographics.sex = '$sex'" + } + "age_below_years" { + if {[lsearch $tables "users_demographics"] == -1 } { + lappend tables "users_demographics" + lappend join_clauses "users.user_id = users_demographics.user_id" + } + lappend where_clauses "age(sysdate(),users_demographics.birthdate) < '$age_below_years years'" + } + "age_above_years" { + if {[lsearch $tables "users_demographics"] == -1 } { + lappend tables "users_demographics" + lappend join_clauses "users.user_id = users_demographics.user_id" + } + lappend where_clauses "age(sysdate(),users_demographics.birthdate) > '$age_above_years years'" + } + "registration_during_month" { + lappend where_clauses "to_char(users.registration_date,'YYYYMM') = '$registration_during_month'" + } + "registration_before_days" { + lappend where_clauses "(users.registration_date is not null and sysdate()::date - users.registration_date::date < $registration_before_days)" + } + "registration_after_days" { + lappend where_clauses "(users.registration_date is not null and sysdate()::date - users.registration_date::date > $registration_after_days)" + } + "registration_after_date" { + lappend where_clauses "users.registration_date > '$registration_after_date'" + } + "last_login_before_days" { + lappend where_clauses "(users.last_visit is not null and sysdate()::date - users.last_visit::date < $last_login_before_days)" + } + "last_login_after_days" { + lappend where_clauses "(users.last_visit is not null and sysdate()::date - users.last_visit::date > $last_login_after_days)" + } + "last_login_equals_days" { + lappend where_clauses "(last_visit is not null and sysdate()::date-last_visit::date = $last_login_equals_days)" + } + "number_visits_below" { + lappend where_clauses "users.n_sessions < $number_visits_below" + } + "number_visits_above" { + lappend where_clauses "users.n_sessions > $number_visits_above" + } + "crm_state" { + lappend where_clauses "users.crm_state = '$crm_state'" + } + "curriculum_elements_completed" { + lappend where_clauses "$curriculum_elements_completed = (select count(*) from user_curriculum_map ucm where ucm.user_id = users.user_id and ucm.curriculum_element_id in (select curriculum_element_id from curriculum))" + } + } + } + } + #stuff related to the query itself + + if { [info exists combine_method] && $combine_method == "or" } { + set complete_where [join $where_clauses " or "] + } else { + set complete_where [join $where_clauses " and "] + } + + + if { [info exists include_accumulated_charges_p] && $include_accumulated_charges_p && (![info exists count_only_p] || !$count_only_p) } { + # we're looking for expensive users and not just counting them + append select_list ", sum(users_charges.amount) as accumulated_charges" + } + if { [llength $join_clauses] == 0 } { + set final_query "select $select_list + from [join $tables ", "]" + if ![empty_string_p $complete_where] { + append final_query "\nwhere $complete_where" + } + } else { + # we're joining at + set final_query "select $select_list + from [join $tables ", "] + where [join $join_clauses "\nand "]" + if ![empty_string_p $complete_where] { + append final_query "\n and ($complete_where)" + } + } + if { [llength $group_clauses] > 0 } { + append final_query "\ngroup by [join $group_clauses ", "]" + } + if { [llength $having_clauses] > 0 } { + append final_query "\nhaving [join $having_clauses " and "]" + } + return $final_query +} + + + +proc_doc ad_user_class_query_count_only {selection} "Takes an ns_set of key/value pairs and produces a query that will compute the number of users in the class specified." { + set new_set [ns_set copy $selection] + ns_set put $new_set count_only_p 1 + return [ad_user_class_query $new_set] +} + + +proc_doc ad_registration_finite_state_machine_admin_links {user_state user_id} "Returns the admininistation links to change the user's state in the user_state finite state machine." { + set user_finite_state_links [list] + switch $user_state { + "authorized" { + lappend user_finite_state_links "ban or delete" + } + "deleted" { + lappend user_finite_state_links "undelete" + lappend user_finite_state_links "ban" + } + "need_email_verification_and_admin_approv" { + lappend user_finite_state_links "approve" + lappend user_finite_state_links "reject" + } + "need_admin_approv" { + lappend user_finite_state_links "approve" + lappend user_finite_state_links "reject" + } + "need_email_verification" { + lappend user_finite_state_links "approve email" + lappend user_finite_state_links "reject" + } + "rejected" { + lappend user_finite_state_links "approve" + } + "banned" { + lappend user_finite_state_links "unban" + } + } + return $user_finite_state_links +} + +util_report_successful_library_load Index: web/openacs/tcl/ad-antispam.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-antispam.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-antispam.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,82 @@ +# ad-antispam.tcl,v 3.1 2000/02/09 11:01:47 davis Exp +# +# ad-antispam.tcl by philg@mit.edu on April 18, 1999 +# +# utilities to block out troublesome people +# + +util_report_library_entry + +proc_doc ad_spammer_ip_p {} "Calls ns_conn peeraddr and then tries to figure out if it matches the IP range of a known spammers." { + set glob_patterns [ad_parameter_all_values_as_list IPglob antispam] + set client_ip [ns_conn peeraddr] + foreach pattern $glob_patterns { + if [string match $pattern $client_ip] { + return 1 + } + } + # not a spammer as far as we know + return 0 +} + +proc_doc ad_pretend_to_be_broken {} "Returns some headers, then sleeps, then some more stuff, then sleeps, ..." { + ReturnHeaders + ns_sleep 1 + ns_write "[ad_header "Connecting to the database"] + +

Connecting to the database

+ +
+ +We're having a bit of trouble connecting to the relational database +that sits behind this service. Trying again... + +" + ns_sleep 10 + ns_write "failed.\n\n

Trying again ... " + ns_sleep 10 + ns_write "failed.\n\n

Trying once more ..." + ns_sleep 15 + ns_write "failed. + +

+ +Please try your request again in a few minutes. Our automated +monitors may have stabilized the server. + +[ad_footer] +" +} + +proc_doc ad_handle_spammers {} "Returns an appropriate page if we think it is a spammer, either pretending to be broken or explaining the ban (depending on the setting of FeignFailureP)." { + if ![ad_spammer_ip_p] { + # not a spammer + return + } else { + if [ad_parameter FeignFailureP antispam 0] { + ad_pretend_to_be_broken + } else { + # just tell the guy + ad_return_complaint 1 "

  • The computer that you're using has been blocked from photo.net (or perhaps a whole range of computers).\n" + } + # blow out of 2 levels (i.e., terminate the caller) + return -code return + } +} + +proc_doc ad_check_for_naughty_html {user_submitted_html} {Returns a human-readable explanation if the user has used any of the HTML tags marked as naughty in the antispam section of ad.ini, empty string otherwise} { + set tag_names [string tolower [ad_parameter_all_values_as_list NaughtyTag antispam]] + # look for a less than sign, zero or more spaces, then the tag + if { ! [empty_string_p $tag_names]} { + set the_regexp "< *([join $tag_names "\[ \n\t\r\f\]|"]\[ \n\t\r\f\])" + if [regexp $the_regexp [string tolower $user_submitted_html]] { + return "Because of abuse by spammmers, we can't accept submission of any HTML containing any of the following tags: [join $tag_names " "]" + } + } + # HTML was okay as far as we know + + return +} + +util_report_successful_library_load + Index: web/openacs/tcl/ad-aolserver-2.tcl.preload =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-aolserver-2.tcl.preload,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-aolserver-2.tcl.preload 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,44 @@ +# ad-aolserver-2.tcl.preload,v 3.3 2000/03/11 05:38:55 michael Exp +# File: ad-aolserver-2.tcl.preload +# Author: Jon Salz +# Date: 27 Feb 2000 +# Description: Contains procedures specific to AOLserver 2. + +proc ns_rand {range} { + return [randomRange $range] +} + +uplevel #0 { + proc nsv_set { array key value } { + return [ns_var set "$array,$key" $value] + } + + proc nsv_get { array key } { + return [ns_var get "$array,$key"] + } + + proc nsv_unset {array key } { + ns_var unset "$array,$key" + } + + proc nsv_exists { array key } { + return [ns_var exists "$array,$key"] + } + + proc nsv_array { option name } { + switch $option { + names { + set out [list] + foreach item [ns_var list] { + if { [regexp "^$name,(.+)\$" $item "" key] } { + lappend out $key + } + } + return $out + } + default { + error "Only nsv_array names is supported (not nsv_array $option)." + } + } + } +} Index: web/openacs/tcl/ad-aolserver-3.tcl.preload =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-aolserver-3.tcl.preload,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-aolserver-3.tcl.preload 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,763 @@ +# ad-aolserver-3.tcl.preload,v 3.1 2000/02/27 19:16:01 jsalz Exp +# File: ad-aolserver-3.tcl.preload +# Author: Jon Salz , from code by markd +# Date: 27 Feb 2000 +# Description: Contains procedures specific to AOLserver 3 (mostly recreating +# functionality dropped from AOLserver 2). + +# +# If name contains a space, then it is surrounded by double quotes. +# This is useful for names in SQL statements that may contain spaces. + +proc ns_dbquotename {name} { + if [regexp " " $name] { + return "\"$name\"" + } else { + return $name + } +} + +# ns_dbquotevalue: +# +# Prepares a value string for inclusion in an SQL statement. +# "" is translated into NULL. +# All values of any numeric type are left alone. +# All other values are surrounded by single quotes and any +# single quotes included in the value are escaped (ie. translated +# into 2 single quotes). + +proc ns_dbquotevalue {value {type text}} { + + if [string match $value ""] { + return "NULL" + } + + if {$type == "decimal" \ + || $type == "double" \ + || $type == "integer" \ + || $type == "int" \ + || $type == "real" \ + || $type == "smallint" \ + || $type == "bigint" \ + || $type == "bit" \ + || $type == "float" \ + || $type == "numeric" \ + || $type == "tinyint"} { + return $value + } + regsub -all "'" $value "''" value + return "'$value'" +} + + + +# -1 = Not there or value was "" +# 0 = NULL, set value to NULL. +# 1 = Got value, set value to it. + +proc ns_dbformvalue {formdata column type valuebyref} { + + upvar $valuebyref value + + if {[ns_set get $formdata ColValue.[ns_urlencode $column].NULL] == "t"} { + set value "" + return 0 + } + + set value [ns_set get $formdata ColValue.[ns_urlencode $column]] + + if [string match $value ""] { + switch $type { + + date { + set value [ns_buildsqldate \ + [ns_set get $formdata ColValue.[ns_urlencode $column].month] \ + [ns_set get $formdata ColValue.[ns_urlencode $column].day] \ + [ns_set get $formdata ColValue.[ns_urlencode $column].year]] + } + + time { + set value [ns_buildsqltime \ + [ns_set get $formdata ColValue.[ns_urlencode $column].time] \ + [ns_set get $formdata ColValue.[ns_urlencode $column].ampm]] + } + + datetime - + timestamp { + set value [ns_buildsqltimestamp \ + [ns_set get $formdata ColValue.[ns_urlencode $column].month] \ + [ns_set get $formdata ColValue.[ns_urlencode $column].day] \ + [ns_set get $formdata ColValue.[ns_urlencode $column].year] \ + [ns_set get $formdata ColValue.[ns_urlencode $column].time] \ + [ns_set get $formdata ColValue.[ns_urlencode $column].ampm]] + } + + default { + } + } + } + if [string match $value ""] { + return -1 + } else { + return 1 + } +} + +proc ns_dbformvalueput {htmlform column type value} { + + switch $type { + + date { + set retval [ns_formvalueput $htmlform ColValue.[ns_urlencode $column].NULL f] + set retval [ns_formvalueput $retval ColValue.[ns_urlencode $column].month \ + [ns_parsesqldate month $value]] + set retval [ns_formvalueput $retval ColValue.[ns_urlencode $column].day \ + [ns_parsesqldate day $value]] + set retval [ns_formvalueput $retval ColValue.[ns_urlencode $column].year \ + [ns_parsesqldate year $value]] + } + + time { + set retval [ns_formvalueput $htmlform ColValue.[ns_urlencode $column].NULL f] + set retval [ns_formvalueput $retval ColValue.[ns_urlencode $column].time \ + [ns_parsesqltime time $value]] + set retval [ns_formvalueput $retval ColValue.[ns_urlencode $column].ampm \ + [ns_parsesqltime ampm $value]] + + } + + datetime - + timestamp { + set retval [ns_formvalueput $htmlform ColValue.[ns_urlencode $column].NULL f] + set retval [ns_formvalueput $retval ColValue.[ns_urlencode $column].month \ + [ns_parsesqltimestamp month $value]] + set retval [ns_formvalueput $retval ColValue.[ns_urlencode $column].day \ + [ns_parsesqltimestamp day $value]] + set retval [ns_formvalueput $retval ColValue.[ns_urlencode $column].year \ + [ns_parsesqltimestamp year $value]] + set retval [ns_formvalueput $retval ColValue.[ns_urlencode $column].time \ + [ns_parsesqltimestamp time $value]] + set retval [ns_formvalueput $retval ColValue.[ns_urlencode $column].ampm \ + [ns_parsesqltimestamp ampm $value]] + + } + + default { + + set retval [ns_formvalueput $htmlform ColValue.[ns_urlencode $column] $value] + } + } + return $retval +} + +# Special thanks to Brian Tivol at Hearst New Media Center and MIT +# for providing the core of this code. + +proc ns_formvalueput {htmlpiece dataname datavalue} { + + set newhtml "" + + while {$htmlpiece != ""} { + if {[string index $htmlpiece 0] == "<"} { + regexp {<([^>]*)>(.*)} $htmlpiece m tag htmlpiece + set tag [string trim $tag] + set CAPTAG [string toupper $tag] + + switch -regexp $CAPTAG { + + {^INPUT} { + if {[regexp {TYPE=("IMAGE"|"SUBMIT"|"RESET"|IMAGE|SUBMIT|RESET)} $CAPTAG]} { + append newhtml <$tag> + + } elseif {[regexp {TYPE=("CHECKBOX"|CHECKBOX|"RADIO"|RADIO)} $CAPTAG]} { + + set name [ns_tagelement $tag NAME] + + if {$name == $dataname} { + + set value [ns_tagelement $tag VALUE] + + regsub -all -nocase { *CHECKED} $tag {} tag + + if {$value == $datavalue} { + append tag " CHECKED" + } + } + append newhtml <$tag> + + } else { + + ## If it's an INPUT TYPE that hasn't been covered + # (text, password, hidden, other (defaults to text)) + ## then we add/replace the VALUE tag + + set name [ns_tagelement $tag NAME] + + if {$name == $dataname} { + ns_tagelementset tag VALUE $datavalue + } + append newhtml <$tag> + } + } + + {^TEXTAREA} { + + ### + # Fill in the middle of this tag + ### + + set name [ns_tagelement $tag NAME] + + if {$name == $dataname} { + while {![regexp -nocase {^<( *)/TEXTAREA} $htmlpiece]} { + regexp {^.[^<]*(.*)} $htmlpiece m htmlpiece + } + append newhtml <$tag>$datavalue + } else { + append newhtml <$tag> + } + } + + {^SELECT} { + + ### Set flags so OPTION and /SELECT know what to look for: + # snam is the variable name, sflg is 1 if nothing's + ### been added, smul is 1 if it's MULTIPLE selection + + + if {[ns_tagelement $tag NAME] == $dataname} { + set inkeyselect 1 + set addoption 1 + } else { + set inkeyselect 0 + set addoption 0 + } + + append newhtml <$tag> + } + + {^OPTION} { + + ### + # Find the value for this + ### + + if {$inkeyselect} { + + regsub -all -nocase { *SELECTED} $tag {} tag + + set value [ns_tagelement $tag VALUE] + + regexp {^([^<]*)(.*)} $htmlpiece m txt htmlpiece + + if [string match "" $value] { + set value [string trim $txt] + } + + if {$value == $datavalue} { + append tag " SELECTED" + set addoption 0 + } + append newhtml <$tag>$txt + } else { + append newhtml <$tag> + } + } + + {^/SELECT} { + + ### + # Do we need to add to the end? + ### + + if {$inkeyselect && $addoption} { + append newhtml "
  • sorry, but we found no matching $search_items for this request. +Your query words were fed to Oracle ConText with instructions that +they had to appear near each other. This is a good way of achieving +high relevance for common queries such as \"Nikon zoom lens\". +

    +There are two basic ways in which we can expand your search: +

      +
    1. drop the proximity requirement +
    2. expand the search words to related terms (fuzzy) +
    +" + } else { + # user is already doing something special but still losing unfortunately + return "Sorry, but no matching $search_items for this query\n" + } + } + return +} + + +# determines if the search results are irrelevent and +# if the output should be aborted + +proc ad_context_end_output_p {counter the_score max_score} { + + if { ($counter > 25) && ($the_score < [expr 0.3 * $max_score] ) } { + # we've gotten more than 25 rows AND our relevance score + # is down to 30% of what the maximally relevant row was + return 1 + break + } + if { ($counter > 50) && ($the_score < [expr 0.5 * $max_score] ) } { + # take a tougher look + return 1 + break + } + if { ($counter > 100) && ($the_score < [expr 0.8 * $max_score] ) } { + # take a tougher look yet + return 1 + break + } + return 0 +} + Index: web/openacs/tcl/ad-general-comments.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-general-comments.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-general-comments.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,536 @@ +# ad-general-comments.tcl,v 3.1.4.1 2000/03/14 07:36:35 jkoontz Exp +# ad-general-comments.tcl +# +# procs for general comment system +# +# by teadams@arsdigita.com +# (cleaned up and broken by philg@mit.edu on September 5, 1999) + +# this used by www/general-comments/comment-add-3.tcl +# and analogous pages within some modules +proc_doc ad_general_comment_add {db comment_id on_which_table on_what_id one_line_item_desc content user_id ip_address approved_p {html_p "f"} {one_line ""} } "Inserts a comment into the general comment system" { + + ad_scope_error_check + + # let's limit this to 200 chars so we don't blow out our column + set complete_description '[DoubleApos [string range $one_line_item_desc 0 199]]' + set sql " + insert into general_comments + (comment_id, on_what_id, user_id, on_which_table, one_line_item_desc, content, ip_address, + comment_date, approved_p, html_p, one_line, [ad_scope_cols_sql]) + values + ($comment_id, $on_what_id, $user_id, '[DoubleApos $on_which_table]', $complete_description, + '[DoubleApos $content]', '[DoubleApos $ip_address]', sysdate(), '$approved_p', '$html_p', + [ns_dbquotevalue $one_line], [ad_scope_vals_sql])" + +# if [ad_parameter LogCLOBdmlP acs 0] { +# ns_log Notice "About to use $sql\n -- to put -- \n$content\n\n -- into the database -- \n" +# } + + ns_db dml $db $sql +} + +# this is used by www/general-comments/comment-edit-3.tcl +# and ought to be used by analogous pages within +# submodules +proc_doc ad_general_comment_update {db comment_id content ip_address {html_p "f"} {one_line ""}} "Updates a comment in the general comment system. Inserts a row into the audit table as well." { + + ns_db dml $db "begin transaction" + # insert into the audit table + + ns_db dml $db "insert into general_comments_audit +(comment_id, user_id, ip_address, audit_entry_time, modified_date, content, one_line) +select comment_id, user_id, ip_address, sysdate(), modified_date, content, one_line from general_comments where comment_id = $comment_id" + + set sql "update general_comments +set content = '[DoubleApos $content]', one_line = [ns_dbquotevalue $one_line], +html_p = '$html_p', +ip_address = '[DoubleApos $ip_address]' +where comment_id = $comment_id" + +# if [ad_parameter LogCLOBdmlP acs 0] { +# ns_log Notice "About to use $sql\n -- to update -- \n$content\n\n -- in the database -- \n" +# } + + ns_db dml $db $sql + + ns_db dml $db "end transaction" +} + + +proc_doc ad_general_comments_list { db on_what_id on_which_table item {module ""} {submodule ""} {return_url ""} {show_time {}} {solicit_more_p 1}} "Generates the list of comments for this item with the appropriate add/edit links for the general comments system." { + + + if [ad_parameter AdminEditingOptionsInlineP "general-comments" 0] { + # look to see if this person is an administrator + set administrator_p [ad_permission_p $db $module $submodule] + } else { + set administrator_p 0 + } + + # see if the comment system is inactivated for this module + if ![ad_parameter SolicitCommentsP $module 1] { + return "" + } + + set user_id [ad_get_user_id] + if [empty_string_p $return_url] { + set return_url [ns_conn url]?[export_ns_set_vars "url"] + } + set approved_clause "and general_comments.approved_p = 't'" + + set return_string "" + + set selection [ns_db select $db " + select general_comments.comment_id, content, comment_date, + first_names || ' ' || last_name as commenter_name, users.user_id as comment_user_id, + html_p as comment_html_p, client_file_name, file_type, original_width, original_height, + caption, one_line, + to_char(modified_date, 'Month DD, YYYY HH:MI AM') as pretty_modified_long, + to_char(modified_date, 'MM/DD/YY HH24:MI') as pretty_modified_time, + to_char(modified_date, 'MM/DD/YY') as pretty_modified_date + from general_comments, users + where on_what_id = $on_what_id + and on_which_table = '[DoubleApos $on_which_table]' $approved_clause + and general_comments.user_id = users.user_id + order by comment_date asc"] + + set first_iteration_p 1 + while {[ns_db getrow $db $selection]} { + set_variables_after_query + if $first_iteration_p { + append return_string "

    Comments

    \n" + set first_iteration_p 0 + } + switch $show_time { + modified_long { + set extra "on $pretty_modified_long" + } + modified_time { + set extra "($pretty_modified_time)" + } + modified_date { + set extra "($pretty_modified_date)" + } + default { + set extra {} + } + } + + append return_string "
    \n[format_general_comment $comment_id $client_file_name $file_type $original_width $original_height $caption $content $comment_html_p $one_line]" + + append return_string "

    -- $commenter_name $extra" + # if the user posted the comment, they are allowed to edit it + if {$user_id == $comment_user_id} { + append return_string " (edit your comment)" + } elseif { $administrator_p } { + append return_string " (edit)" + } + + append return_string "
    \n
    \n" + } + + if { !$first_iteration_p } { + append return_string "\n" + } + if { $solicit_more_p } { + append return_string " +
    + Add a comment +
    " + } + + return $return_string +} + + +proc_doc ad_general_comments_summary { db on_what_id on_which_table item} "Generates the line item list of comments made on this item." { + return [ad_general_comments_summary_sorted $db $on_what_id $on_which_table $item "" "" 1] +} + + +proc_doc ad_general_comments_summary_sorted { db on_what_id on_which_table item { number_to_display -1 } { url_for_more_items "" } {skip_sort 0 } } "Generates the line item list of comments made on this item. Sorts entries by comment_date and allows the user to specify the max entries to return (default is all). If you specify the max entries to return, and there are more, the link (you provide) is added to see them all. This link should basically be your return_url with a flag set so you know what your next call to this procedure will show all items." { + set user_id [ad_get_user_id] + + set approved_clause "and general_comments.approved_p = 't'" + + set return_url [ns_conn url]?[export_ns_set_vars "url"] + + # For backwards compatibility + if { $skip_sort } { + set sort_sql "" + } else { + set sort_sql "order by comment_date desc" + } + + set selection [ns_db select $db " + select general_comments.comment_id, content, to_char(comment_date,'YYYY-MM-DD HH24:MI:SS') as comment_date, + first_names || ' ' || last_name as commenter_name, users.user_id as comment_user_id, + html_p as comment_html_p, client_file_name, file_type, original_width, original_height, + caption, one_line + from general_comments, users + where on_what_id= $on_what_id + and on_which_table = '[DoubleApos $on_which_table]' $approved_clause + and general_comments.user_id = users.user_id $sort_sql"] + + set counter 0 + append return_string "
      " + while {[ns_db getrow $db $selection]} { + if { $number_to_display > 0 && $counter >= $number_to_display } { + if { ![empty_string_p $url_for_more_items] } { + append return_string "
    • (more)\n" + } + ns_db flush $db + break + } + set_variables_after_query + # if the user posted the comment, they are allowed to edit it + append return_string "
    • $one_line ($comment_date) by $commenter_name" + if { ![empty_string_p $client_file_name] } { + append return_string " Attachment: $client_file_name" + } + incr counter + } + + append return_string "
    " +} + + +# Helper procedure for above, to format one comment w/ appropriate +# attachment link. +proc format_general_comment { comment_id client_file_name file_type original_width original_height caption content comment_html_p {one_line ""}} { + set return_string "" + set return_url "[ns_conn url]?[export_ns_set_vars url]" + + if { ![empty_string_p $client_file_name] } { + # We have an attachment. + if { [string match "image/*" [string tolower $file_type]] } { + # It was an image. + if { ![empty_string_p $original_width] + && $original_width < [ad_parameter InlineImageMaxWidth "general-comments" 512] } { + # It's narrow enough to display inline. + append return_string "

    $caption


    \n[util_maybe_convert_to_html $content $comment_html_p]\n" + } else { + # Send to an image display page. + append return_string "[util_maybe_convert_to_html $content $comment_html_p]\n
    Image: $client_file_name" + } + } else { + # Send to raw file download. + append return_string "[util_maybe_convert_to_html $content $comment_html_p]\n
    Attachment: $client_file_name" + } + } else { + # No attachment + append return_string "

    $one_line

    +[util_maybe_convert_to_html $content $comment_html_p]\n" + } + return $return_string +} + +# ns_register'ed to +# /general-comments/attachment/[comment_id]/[file_name] Returns a +# MIME-typed attachment based on the comment_id. We use this so that +# the user's browser shows the filename the file was uploaded with +# when prompting to save instead of the name of a Tcl file (like +# "raw-file.tcl") +proc ad_general_comments_get_attachment { ignore } { + if { ![regexp {([^/]+)/([^/]+)$} [ns_conn url] match comment_id client_filename] } { + ad_return_error "Malformed Attachment Request" "Your request for a file attachment was malformed." + return + } + set db [ns_db gethandle subquery] + + # security fix (BMA, as spec'ed by aD) + validate_integer comment_id $comment_id + + set file_type [database_to_tcl_string $db "select file_type +from general_comments +where comment_id = $comment_id"] + + ReturnHeaders $file_type + + ns_ora write_blob $db "select attachment +from general_comments +where comment_id = $comment_id" + + ns_db releasehandle $db +} + +ns_register_proc GET /general-comments/attachment/* ad_general_comments_get_attachment + + +## Add general comments to the user contributions summary. +ns_share ad_user_contributions_summary_proc_list + +if { ![info exists ad_user_contributions_summary_proc_list] || [util_search_list_of_lists $ad_user_contributions_summary_proc_list "General Comments" 0] == -1 } { + lappend ad_user_contributions_summary_proc_list [list "General Comments" ad_general_comments_user_contributions 1] +} + + +proc_doc ad_general_comments_user_contributions {db user_id purpose} "Returns a list of priority, title, and an unordered list HTML fragment. All the general comments posted by a user." { + if { $purpose == "site_admin" } { + return [ad_general_comments_user_contributions_for_site_admin $db $user_id] + } else { + return [ad_general_comments_user_contributions_for_web_display $db $user_id] + } + +} + + +# need to go the helper route +proc ad_general_comments_user_contributions_for_site_admin {db user_id} { + set selection [ns_db select $db " + (select gc.*, tm.section_name, tm.module_key, tm.admin_url_stub, tm.group_admin_file, user_group_short_name_from_id(gc.group_id) as short_name, + case when gc.scope = 'public' then 1 + when gc.scope = 'group' then 2 + when gc.scope = 'user' then 3 + else 4 end as scope_ordering + from general_comments gc, table_acs_properties tm + where gc.user_id = $user_id + and gc.on_which_table = tm.table_name) union + (select gc.*, null as section_name, null as module_key, null as admin_url_stub, null as group_admin_file, user_group_short_name_from_id(gc.group_id) as short_name, + case when gc.scope = 'public' then 1 + when gc.scope = 'group' then 2 + when gc.scope = 'user' then 3 + else 4 end as scope_ordering + from general_comments gc + where gc.user_id = $user_id + and 0=(select count(*) from table_acs_properties where table_name=gc.on_which_table)) + order by gc.on_which_table, scope_ordering, gc.comment_date desc"] + + set return_url [ns_conn url] + + set the_comments "" + + set db_sub [ns_db gethandle subquery] + + set last_section_name "" + set last_group_id "" + + set section_item_counter 0 + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $section_name != $last_section_name } { + if ![empty_string_p $section_name] { + append the_comments "

    Comments within $section_name

    \n" + } else { + append the_comments "

    Comments on $on_which_table

    \n" + } + set last_section_name $section_name + + # for each section do initialization + set section_item_counter 0 + set last_group_id "" + } + + switch $scope { + public { + if { $section_item_counter == 0 } { + set admin_url $admin_url_stub + } + } + group { + if { $last_group_id!=$group_id } { + + set sub_selection [ns_db 0or1row $db_sub " + select section_key + from content_sections + where scope='group' and group_id=$group_id + and module_key='[DoubleApos $module_key]'"] + + if { [empty_string_p $sub_selection] } { + set admin_url $admin_url_stub + } else { + set_variables_after_subquery + set admin_url "[ug_admin_url]/[ad_urlencode $short_name]/[ad_urlencode $section_key]/${group_admin_file}" + } + } + } + } + + if { [empty_string_p $one_line_item_desc] } { + set best_item_description "$section_name ID#$on_what_id" + } else { + set best_item_description $one_line_item_desc + } + + append the_comments " +
  • [util_AnsiDatetoPrettyDate $comment_date] +
    + [format_general_comment $comment_id $client_file_name $file_type $original_width $original_height $caption $content $html_p] +

    -- ([util_AnsiDatetoPrettyDate $comment_date]) + on $best_item_description +
    +
    + \[ " + + if { $approved_p == "f" } { + append the_comments "approve \| " + } + append the_comments " + edit \| delete \] +
    + " + set last_group_id $group_id + incr section_item_counter + } + + ns_db releasehandle $db_sub + + if [empty_string_p $the_comments] { + return [list] + } else { + return [list 1 "General Comments" "
      \n\n$the_comments\n\n
    "] + } +} + +proc ad_general_comments_user_contributions_for_web_display {db user_id} { + set selection [ns_db select $db " + (select gc.*, tm.section_name, tm.module_key, tm.user_url_stub, tm.group_public_file, user_group_short_name_from_id(gc.group_id) as short_name, + case when gc.scope = 'public' then 1 + when gc.scope = 'group' then 2 + when gc.scope = 'user' then 3 + else 4 end as scope_ordering + from general_comments gc, table_acs_properties tm + where gc.user_id = $user_id + and gc.on_which_table = tm.table_name) union + (select gc.*, null as section_name, null as module_key, null as user_url_stub, null as group_public_file, user_group_short_name_from_id(gc.group_id) as short_name, + case when gc.scope = 'public' then 1 + when gc.scope = 'group' then 2 + when gc.scope = 'user' then 3 + else 4 end as scope_ordering + from general_comments gc + where gc.user_id = $user_id + and 0=(select count(*) from table_acs_properties where table_name=gc.on_which_table)) + order by gc.on_which_table, scope_ordering, gc.comment_date desc"] + + set the_comments "" + + set db_sub [ns_db gethandle subquery] + + set last_section_name "" + set last_group_id "" + set section_item_counter 0 + while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $section_name != $last_section_name } { + if ![empty_string_p $section_name] { + append the_comments "

    Comments within $section_name

    \n" + } else { + append the_comments "

    Comments on $on_which_table

    \n" + } + set last_section_name $section_name + + # for each section do initialization + set section_item_counter 0 + set last_group_id "" + } + + switch $scope { + public { + if { $section_item_counter==0 } { + set public_url $user_url_stub + } + } + group { + if { $last_group_id!=$group_id } { + + set sub_selection [ns_db 0or1row $db_sub " + select section_key + from content_sections + where scope='group' and group_id=$group_id + and module_key='[DoubleApos $module_key]'"] + + if { [empty_string_p $sub_selection] } { + set public_url $user_url_stub + } else { + set_variables_after_subquery + set public_url "[ug_url]/[ad_urlencode $short_name]/[ad_urlencode $section_key]/${group_public_file}" + } + } + } + } + + if { [empty_string_p $one_line_item_desc] } { + set best_item_description "$section_name ID#$on_what_id" + } else { + set best_item_description $one_line_item_desc + } + + append the_comments " +
  • [util_AnsiDatetoPrettyDate $comment_date] +
    + [format_general_comment $comment_id $client_file_name $file_type $original_width $original_height $caption $content $html_p] +

    -- ([util_AnsiDatetoPrettyDate $comment_date]) + on $best_item_description +
    + " + + } + + ns_db releasehandle $db_sub + + if [empty_string_p $the_comments] { + return [list] + } else { + return [list 1 "General Comments" "
      \n\n$the_comments\n\n
    "] + } +} + +proc_doc general_comments_admin_authorize { db comment_id } "given comment_id, this procedure will check whether the user has administration rights over this comment. if comment doesn't exist page is served to the user informing him that the comment doesn't exist. if successfull it will return user_id of the administrator." { + + set selection [ns_db 0or1row $db " + select scope, group_id + from general_comments + where comment_id=$comment_id"] + + if { [empty_string_p $selection] } { + # comment doesn't exist + uplevel { + ns_return 200 text/html " + [ad_scope_admin_header "Comment Doesn't Exist" $db] + [ad_scope_admin_page_title "Comment Doesn't Exist" $db] + [ad_scope_admin_context_bar "No Comment"] +
    +
    + Requested comment does not exist. +
    + [ad_scope_admin_footer] + " + } + return -code return + } + + # faq exists + set_variables_after_query + + switch $scope { + public { + set id 0 + } + group { + set id $group_id + } + } + + set authorization_status [ad_scope_authorization_status $db $scope admin group_admin none $id] + + set user_id [ad_verify_and_get_user_id] + + switch $authorization_status { + authorized { + return $user_id + } + not_authorized { + ad_return_warning "Not authorized" "You are not authorized to see this page" + return -code return + } + reg_required { + ad_redirect_for_registration + return -code return + } + } +} + + + Index: web/openacs/tcl/ad-general-links.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-general-links.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-general-links.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,336 @@ +# ad-general-links.tcl,v 3.1 2000/02/20 10:29:37 ron Exp +# +# ad-general-links.tcl +# +# procs for general links system +# +# joint effort by: +# bcassels@arsdigita.com +# tzumainn@arsdigita.com +# flattop@arsdigita.com +# . . . and the people who did general comments (since this code is stolen +# from that). +# + +# this used by www/general-links/link-add-3.tcl +# and analogous pages within some modules +proc_doc ad_general_link_add {db link_id url link_title link_description user_id ip_address approved_p} "Inserts a link into the general links system" { + + ns_db dml $db "insert into general_links +(link_id, url, link_title, link_description, creation_time, creation_user, creation_ip_address, approved_p, last_approval_change) +values +($link_id, '[DoubleApos $url]', '[DoubleApos $link_title]', '[DoubleApos $link_description]', sysdate(), $user_id, '$ip_address', '$approved_p', sysdate())" + +} + +proc_doc ad_general_link_map_add {db map_id link_id on_which_table on_what_id one_line_item_desc user_id ip_address approved_p } "Inserts a link between a general link and a table" { + + # let's limit this to 200 chars so we don't blow out our column + set complete_description '[DoubleApos [string range $one_line_item_desc 0 199]]' + + ns_db dml $db "insert into site_wide_link_map +(map_id, link_id, on_which_table, on_what_id, one_line_item_desc, creation_user, creation_time, creation_ip_address, approved_p) +values +($map_id, $link_id, '[DoubleApos $on_which_table]', $on_what_id, $complete_description, $user_id, sysdate(), '[DoubleApos $ip_address]', '$approved_p')" + +} + +# this is used by www/general-links/link-edit-3.tcl +# and ought to be used by analogous pages within +# submodules +proc_doc ad_general_link_update {db link_id url link_title link_description ip_address} "Updates a link in the general links system. No audit yet, though. . ." { + + ns_db dml $db "update general_links +set url = '[DoubleApos $url]', +link_title = '[DoubleApos $link_title]', +link_description = '[DoubleApos $link_description]', +creation_ip_address = '[DoubleApos $ip_address]' +where link_id = $link_id" + +} + +proc_doc ad_general_links_list { db on_what_id on_which_table item {module ""} {submodule ""} {return_url ""}} "Generates the list of links for this item with the appropriate add/edit links for the general links system." { + + set user_id [ad_get_user_id] + if [empty_string_p $return_url] { + set return_url [ns_conn url]?[export_ns_set_vars "url"] + } + set approved_clause "and slm.approved_p = 't' and gl.approved_p = 't'" + + set return_string "" + + set selection [ns_db select $db "select gl.link_id, gl.url, link_title, link_description, slm.map_id, slm.creation_time, first_names || ' ' || last_name as linker_name, u.user_id as link_user_id + from general_links gl, site_wide_link_map slm, users u + where gl.link_id = slm.link_id + and on_what_id = $on_what_id + and on_which_table = '[DoubleApos $on_which_table]' $approved_clause + and slm.creation_user = u.user_id"] + + set first_iteration_p 1 + while {[ns_db getrow $db $selection]} { + set_variables_after_query + if $first_iteration_p { + append return_string "

    Links

    \n" + set first_iteration_p 0 + } + + append return_string "
    \n[ad_general_link_format $link_id $url $link_title $link_description]" + + append return_string "

    -- $linker_name" + + if { !$first_iteration_p } { + append return_string "
    \n" + } + } + + append return_string " +
    + Add a link +
    + " +} + + +proc_doc ad_general_links_summary { db on_what_id on_which_table item} "Generates the line item list of links made on this item." { + set user_id [ad_get_user_id] + + set approved_clause "and slm.approved_p = 't' and gl.approved_p = 't'" + + set return_url [ns_conn url]?[export_ns_set_vars "url"] + + set selection [ns_db select $db "select gl.link_id, gl.url, link_title, link_description, slm.map_id, slm.creation_time, first_names || ' ' || last_name as linker_name, u.user_id as link_user_id + from general_links gl, site_wide_link_map slm, users u + where gl.link_id = slm.link_id + and on_what_id = $on_what_id + and on_which_table = '[DoubleApos $on_which_table]' $approved_clause + and slm.user_id = u.user_id"] + + append return_string "
      " + while {[ns_db getrow $db $selection]} { + set_variables_after_query + + if {[ad_parameter ClickthroughP general-links] == 1} { + set exact_link "/ct/ad_link_${link_id}?send_to=$url" + } else { + set exact_link "$url" + } + + append return_string "
    • $link_title ($creation_time) by $linker_name" + } + + append return_string "
    " +} + +# Helper procedure for above, to format one link. +proc_doc ad_general_link_format { link_id url link_title link_description } "Formats one link for consistent look in other procs/pages." { + + if {[ad_parameter ClickthroughP general-links] == 1} { + set exact_link "/ct/ad_link_${link_id}?send_to=$url" + } else { + set exact_link "$url" + } + + set return_string " + $link_title + " + if {![empty_string_p $link_description]} { + append return_string "

    $link_description" + } + return $return_string +} + +# procedure to display link rating html +proc_doc ad_general_link_format_rating {db link_id {rating_url ""}} "Form for entering rating." { + + set user_id [ad_get_user_id] + + set user_rating [database_to_tcl_string_or_null $db "select rating from general_link_user_ratings where user_id = $user_id and link_id = $link_id"] + + if {[empty_string_p $rating_url]} { + set rating_url "link-rate.tcl" + } + + set rating_html "

    + [export_form_vars link_id] + " + if {[empty_string_p $user_rating]} { + append rating_html " - you have not rated this link; would you like to?
    " + } else { + append rating_html " - you have given this link a rating of $user_rating; would you like to change this rating?" + } +} + +# procedure to display results of rating for a link +proc_doc ad_general_link_format_rating_result {db link_id} "Displays link's rating." { + + set selection [ns_db 0or1row $db " + select n_ratings, avg_rating + from general_links + where link_id = $link_id + "] + + if { [empty_string_p $selection] } { + set n_ratings 0 + set avg_rating 0 + } else { + set_variables_after_query + } + + + if { $n_ratings == 0 } { + return " + No ratings + " + } else { + return " + Average Rating: $avg_rating; Number of Ratings: $n_ratings + " + } + +} + + +################################################### +### I stole this proc from get-site-info.tcl in /admin/bookmarks +### - tzumain@arsdigita.com +################################################### +# this is a proc that should be in the arsdigita procs somewhere +proc get_http_status {url {use_get_p 0} {timeout 30}} { + if $use_get_p { + set http [ns_httpopen GET $url "" $timeout] + } else { + set http [ns_httpopen HEAD $url "" $timeout] + } + # philg changed these to close BOTH rfd and wfd + set rfd [lindex $http 0] + set wfd [lindex $http 1] + close $rfd + close $wfd + set headers [lindex $http 2] + set response [ns_set name $headers] + set status [lindex $response 1] + ns_set free $headers + return $status +} + + +### procedure to check a link and steal its meta tags, +### based on code from get-site-info.tcl in admin/bookmarks +proc_doc ad_general_link_check {db link_id} "checks a link and steals meta tags" { + + set url [database_to_tcl_string $db "select url from general_links where link_id = $link_id"] + + ns_db dml $db "begin transaction" + ns_db dml $db "update general_links set last_checked_date=sysdate() where link_id = $link_id" + + # strip off any trailing #foo section directives to browsers + set complete_url $url + regexp {^(.*/?[^/]+)\#[^/]+$} $complete_url match complete_url + if [catch { set response [get_http_status $complete_url 0] } errmsg ] { + # we got an error (probably a dead server) + ns_db dml $db "end transaction" + return $errmsg + } elseif {$response == 404 || $response == 405 || $response == 500 } { + # we should try again with a full GET + # because a lot of program-backed servers return 404 for HEAD + # when a GET works fine + if [catch { set response [get_http_status $complete_url 1] } errmsg] { + # probably the foreign server isn't responding + ns_db dml $db "end transaction" + return "server not responding" + } + } + + if { $response != 200 && $response != 302 } { + ns_db dml $db "end transaction" + return "error in reaching server" + } else { + if {![catch {ns_httpget $complete_url 3 1} url_content]} { + + set meta_description "" + set meta_keywords "" + + regexp -nocase {} $url_content match meta_description + regexp -nocase {} $url_content match meta_keywords + + # process and truncate outrageously long meta tags + + set QQmeta_description [DoubleApos $meta_description] + set QQmeta_keywords [DoubleApos $meta_keywords] + + if {[string length $QQmeta_keywords]>4000} { + set QQmeta_keywords "[string range $QQmeta_keywords 0 3996]..." + } + if {[string length $QQmeta_description]>4000} { + set QQmeta_description "[string range $QQmeta_description 0 3996]..." + } + } else { + return $url_content + } + } + + ns_db dml $db "update general_links + set meta_description = '$QQmeta_description', + meta_keywords = '$QQmeta_keywords', + last_live_date = sysdate() + where link_id = $link_id + " + + ns_db dml $db "end transaction" + + return 1 + +} + +proc_doc ad_general_link_get_title {url} "gets a link title from a url" { + + # strip off any trailing #foo section directives to browsers + set complete_url $url + regexp {^(.*/?[^/]+)\#[^/]+$} $complete_url match complete_url + if [catch { set response [get_http_status $complete_url 0] } errmsg ] { + # we got an error (probably a dead server) + return "" + } elseif {$response == 404 || $response == 405 || $response == 500 } { + # we should try again with a full GET + # because a lot of program-backed servers return 404 for HEAD + # when a GET works fine + if [catch { set response [get_http_status $complete_url 1] } errmsg] { + # probably the foreign server isn't responding + return "" + } + } + + if { $response != 200 && $response != 302 } { + return "" + } else { + if {![catch {ns_httpget $complete_url 3 1} url_content]} { + + set link_title "" + + regexp -nocase {(.*)</title} $url_content match link_title + + # process and truncate outrageously long titles + + if {[string length $link_title]>100} { + set link_title "[string range $link_title 0 96]..." + } + } else { + return "" + } + } + + return $link_title + +} \ No newline at end of file Index: web/openacs/tcl/ad-general-permissions.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-general-permissions.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-general-permissions.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,62 @@ +# ad-general-permissions.tcl,v 3.4.2.1 2000/03/24 01:55:50 michael Exp +# procs for gp (see /doc/general-permissions.html) +# richardl@arsdigita.com +# rewritten by michael@arsdigita.com, yon@arsdigita.com, 2000-02-25 + +util_report_library_entry + +proc_doc ad_user_has_permission_p {db user_id permission_type on_what_id on_which_table} {Returns true (1) if the specified user has the requested type of permission on the specified row in the specified table; otherwise, returns false (0).} { + return [database_to_tcl_string $db "select + (case when user_has_row_permission_p($user_id, '$permission_type', '$on_what_id', '$on_which_table') = 't' then 1 else 0 end) + from dual"] +} + +proc_doc ad_user_has_row_permission_p {db user_id permission_type on_what_id on_which_table} {<strong>Deprecated:</strong> use <code>ad_user_has_permission_p</code> instead.} { + return [ad_user_has_permission_p $db $user_id \ + $permission_type $on_what_id $on_which_table] +} + +proc_doc ad_require_permission {db user_id permission_type on_what_id on_which_table {return_url ""}} {If the user is not logged in and the specified type of permission has not been granted to all users, then redirect for registration. If the user is logged in but does not have the specified permission type on the specified database row, then redirects to <code>return_url</code> if supplied, or returns a "forbidden" error page.} { + + if { [string compare $user_id 0] == 0 } { + set all_users_have_permission_p [database_to_tcl_string $db "select + (case when all_users_permission_id('$permission_type', '$on_what_id', '$on_which_table') = 0 then 0 else 1 end) + from dual"] + + if { !$all_users_have_permission_p } { + ns_db releasehandle $db + ad_redirect_for_registration + return -code return + } + + } elseif { + ![ad_user_has_row_permission_p $db $user_id \ + $permission_type $on_what_id $on_which_table] + } { + ns_db releasehandle $db + + if { ![empty_string_p $return_url] } { + ns_returnredirect $return_url + } else { + ns_returnforbidden + } + + return -code return + } +} + +proc_doc ad_permission_count {db on_what_id on_which_table {permission_type ""}} {Returns the number of permissions granted on the specified row in the database (of the specified permission type, if supplied).} { + + set query "select count(*) +from general_permissions +where on_what_id = $on_what_id +and on_which_table = lower('$on_which_table')" + + if { ![empty_string_p $permission_type] } { + append query " and permission_type = '[DoubleApos $permission_type]'" + } + + return [database_to_tcl_string $db $query] +} + +util_report_successful_library_load Index: web/openacs/tcl/ad-geospatial.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-geospatial.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-geospatial.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,12 @@ +# ad-geospatial.tcl,v 3.0 2000/02/06 03:12:23 ron Exp +# created by philg@mit.edu on 11/19/98 +# stuff having to do with + +proc_doc ad_state_name_from_usps_abbrev {db usps_abbrev} "Takes a database connection and a USPS abbrevation and returns the full state name, e.g., MA in yields Massachusetts out" { + return [database_to_tcl_string_or_null $db "select state_name from states where usps_abbrev ='[DoubleApos $usps_abbrev]'" $usps_abbrev] +} + + +proc_doc ad_country_name_from_country_code {db country_code} {Returns "United States" from an argument of $db and "us"} { + return [database_to_tcl_string_or_null $db "select country_name from country_codes where iso='[DoubleApos $country_code]'" $country_code] +} Index: web/openacs/tcl/ad-glossary.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-glossary.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-glossary.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,50 @@ +# ad-glossary.tcl,v 3.0 2000/02/06 03:12:25 ron Exp +# ad-glossary.tcl +# philg@mit.edu had to write this on March 7, 1999 because Jin was too lazy + +# this allows authors to reference /gl/Internet for the definition of the +# term Internet + +ns_register_proc GET /gl glossary_direct_lookup + +proc glossary_direct_lookup {ignore} { + if { ![regexp {/gl/(.+)$} [ns_conn url] match term] } { + ad_return_error "Couldn't find the term" "References in the glossary system are supposed to look like +\"/gl/**term**\"." + } else { + # found the term in the URL, let's just run the code from /glossary/one.tcl + regsub -all {\+} $term " " term + set QQterm [DoubleApos $term] + ReturnHeaders + ns_write "[ad_header $term] + + <h2>$term</h2> + + [ad_context_bar_ws_or_index [list "index.tcl" Glossary] "One Term"] + + <hr> + + <i>$term</i>: + " + + set db [ns_db gethandle] + + set definition [database_to_tcl_string_or_null $db "select definition from glossary where term = '$QQterm'"] + + if { $definition == "" } { + # Try again, case insensitively. + + set definition [database_to_tcl_string_or_null $db "select definition from glossary where lower(term) = '[string tolower $QQterm]'"] + if { $definition == "" } { + set definition "Term not defined." + } + } + + ns_db releasehandle $db + + ns_write " + <blockquote>$definition</blockquote> + [ad_footer] + " + } +} Index: web/openacs/tcl/ad-graphing.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-graphing.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-graphing.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,205 @@ +# ad-graphing.tcl,v 3.0 2000/02/06 03:12:26 ron Exp +## Make sure you have the latest version of utilities.tcl running on +## your server, otherwise ad_proc doesn't exist + +ad_proc gr_sideways_bar_chart { {-legend "" -bar_color_list "" -display_values_p "f" -display_scale_p "t" -default_drilldown_url "" -non_percent_values_p "f" -min_left_column_width "1" -bar_height "15" -subcategory_spacing "7" -compare_non_percents_across_categories "f" -left_heading "" -right_heading "" -replace_null_subcategory_with_none_p "f"} subcategory_category_and_value_list } "Read <a href=\"http://software.arsdigita.com/www/doc/graphing.html\">http://software.arsdigita.com/www/doc/graphing.html</a>" { + + if { $bar_color_list == "" } { + set bar_color_list [list blue dark-green purple red black orange medium-blue] + } + + if { $non_percent_values_p == "t" } { + # If the values aren't percentages, I'll turn them into percentages just for the bar display. + + if { $compare_non_percents_across_categories == "f" } { + # The highest number in a category will correspond to a percentage of 75%, and the others will + # be relative to it. + + set prev_category "initial_condition" + set temp_values_list "" + foreach subcategory_category_and_value $subcategory_category_and_value_list { + set category [lindex $subcategory_category_and_value 1] + set values [lindex $subcategory_category_and_value 2] + if { $prev_category != "initial_condition" && $category != $prev_category } { + lappend just_categories_and_values_list [list $prev_category $temp_values_list] + set temp_values_list "" + } + set temp_values_list [concat $temp_values_list $values] + set prev_category $category + } + lappend just_categories_and_values_list [list $prev_category $temp_values_list] + + foreach category_values_map $just_categories_and_values_list { + + set values_list [gr_list_with_non_numeric_elements_replaced_by_zeroes [lindex $category_values_map 1]] + set sorted_values_list [lsort -real $values_list] + set max_value_for_this_category [lindex $sorted_values_list [expr [llength $sorted_values_list] -1 ] ] + set max_value([lindex $category_values_map 0]) "$max_value_for_this_category" + } + } else { + # The highest number in all categories will correspond to a percentage of 75%, and the others + # will be relative to it. + set temp_values_list "" + foreach subcategory_category_and_value $subcategory_category_and_value_list { + set values [lindex $subcategory_category_and_value 2] + set temp_values_list [concat $temp_values_list $values] + } + set values_list [gr_list_with_non_numeric_elements_replaced_by_zeroes $temp_values_list] + set sorted_values_list [lsort -real -decreasing $values_list] + set max_value_of_all_values [lindex $sorted_values_list 0] + } + } + + set to_return "" + + if { $legend != "" } { + set legend_counter 0 + append to_return "<table border=1 cellspacing=0 cellpadding=5><tr><td>" + foreach key $legend { + append to_return "<img width=15 height=15 src=\"/graphics/graphing-package/[lindex $bar_color_list [expr round(fmod($legend_counter,[llength $bar_color_list]))]]-dot.gif\">  [gr_font black 3]$key<br clear=all>" + incr legend_counter + } + append to_return "</td></tr></table><p>" + } + + append to_return "<table border=0 cellspacing=0 cellpadding=0>" + + if { [string compare $left_heading ""] != 0 || [string compare $right_heading ""] != 0 } { + append to_return "<tr><td>$left_heading</td><td></td><td>$right_heading</td></tr> + <tr><td><img width=1 height=5 src=\"/graphics/graphing-package/white-dot.gif\"></td><td></td><td></td></tr>\n" + } + + set prev_category "initial_condition" + + foreach subcategory_category_and_value $subcategory_category_and_value_list { + set subcategory [lindex $subcategory_category_and_value 0] + set category [lindex $subcategory_category_and_value 1] + set values [lindex $subcategory_category_and_value 2] + set drilldown_url [lindex $subcategory_category_and_value 3] + # values is a list + + if { $category != $prev_category } { + set prev_category $category + append to_return "<tr><td><img width=$min_left_column_width height=10 src=\"/graphics/graphing-package/white-dot.gif\"><br clear=all>[gr_font black 4][lindex $subcategory_category_and_value 1]</font></td>" + if { $display_scale_p == "t" } { + append to_return "<td align=right><img width=10 height=15 src=\"/graphics/graphing-package/scale-left.gif\"><br clear=all><img width=1 height=3 src=\"/graphics/graphing-package/white-dot.gif\"></td><td><img width=320 height=15 src=\"/graphics/graphing-package/scale-main.gif\"><br clear=all><img width=1 height=3 src=\"/graphics/graphing-package/white-dot.gif\"></td></tr>" + } else { + append to_return "<td><img width=10 height=15 src=\"/graphics/graphing-package/white-dot.gif\"></td><td> </td></tr>" + } + } + + if { $replace_null_subcategory_with_none_p == "t" } { + append to_return "<tr><td>[gr_font][gr_none_if_null $subcategory]</font></td><td width=10> </td><td>" + } else { + append to_return "<tr><td>[gr_font]$subcategory</font></td><td width=10> </td><td>" + } + + + # value_counter is to determine bar_color + set value_counter 0 + foreach value $values { + + if { $non_percent_values_p == "t" } { + if { $compare_non_percents_across_categories == "f" } { + if { $max_value($category) != 0 && ![regexp "\[^0-9.% \]" $value] && [string compare $value ""] != 0 } { + set bar_length [expr 75*$value/$max_value($category)] + } else { + set bar_length 0 + } + } else { + if { $max_value_of_all_values != 0 && ![regexp "\[^0-9.% \]" $value] && [string compare $value ""] != 0 } { + set bar_length [expr 75*$value/$max_value_of_all_values] + } else { + set bar_length 0 + } + } + } else { + set bar_length [gr_remove_percent $value] + } + + set bar_color [lindex $bar_color_list [expr round(fmod($value_counter,[llength $bar_color_list]))]] + + if { [regexp "\[^0-9.% \]" $value] || [string compare $value ""] == 0 } { + set img_width 1 + } elseif { $bar_length != 0 } { + set img_width [expr round(3 * $bar_length)] + } else { + set img_width 1 + } + append to_return "<img width=$img_width height=$bar_height src=\"/graphics/graphing-package/$bar_color-dot.gif\">" + + if { [empty_string_p $drilldown_url] } { + set drilldown_url [subst $default_drilldown_url] + } + if { ![empty_string_p $drilldown_url] } { + append to_return " [gr_font [hex_color $bar_color] 1]<a href=\"$drilldown_url\">$value</a></font>" + } else { + append to_return " [gr_font [hex_color $bar_color] 1]$value</font>" + } + + append to_return "<br clear=all>\n" + incr value_counter + } + + append to_return "<img width=1 height=$subcategory_spacing src=\"/graphics/graphing-package/white-dot.gif\"></td></tr>" + + + + } ; # end foreach subcategory_category_and_value $subcategory_category_and_value_list + + append to_return "</table>" + return $to_return +} + +proc hex_color {color} { + switch $color { + "red" {set hex_color "ff0000"} + "blue" {set hex_color "0000ff"} + "yellow" {set hex_color "ffff00"} + "black" {set hex_color "000000"} + "white" {set hex_color "ffffff"} + "dark-green" {set hex_color "009900"} + "aquamarine" {set hex_color "00ffff"} + "purple" {set hex_color "660099"} + "orange" {set hex_color "ff6600"} + "medium-blue" {set hex_color "0099ff"} + "magenta" {set hex_color "ff00ff"} + "muted-green" {set hex_color "669966"} + "muted-yellow" {set hex_color "999966"} + "muted-red" {set hex_color "996666"} + "muted-magenta" {set hex_color "996699"} + "muted-blue" {set hex_color "666699"} + "muted-aquamarine" {set hex_color "669999"} + } +} + + +proc gr_list_with_non_numeric_elements_replaced_by_zeroes { the_list } { + set new_list "" + foreach element $the_list { + if { [regexp "\[^0-9.% \]" $element] || [string compare $element ""] == 0 } { + lappend new_list 0 + } else { + lappend new_list $element + } + } + return $new_list +} + +proc gr_none_if_null { the_value } { + if { [string compare $the_value ""] == 0 } { + return "\[none\]" + } else { + return $the_value + } +} + +proc gr_remove_percent { the_value } { + regsub -all "%" $the_value "" new_value + return $new_value +} + +proc gr_font { {color black} {size 3} } { + return "<font face=arial size=$size color=$color>" +} + Index: web/openacs/tcl/ad-html.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-html.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-html.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,373 @@ +# ad-html.tcl,v 3.3 2000/02/25 08:30:34 mbryzek Exp +# /tcl/ad-html.tcl +# +# stuff for serving static .html pages +# (e.g., putting in comment links, etc.) + +# written by philg@mit.edu on 7/1/98 + +# significantly enhanced in December 1999 to modularize the comment and link +# stuff so that .adp pages could use them as well (philg) + +# any request for a static html file will go through this proc +# one good thing about doing things this way is that our site +# still looks static to AltaVista + +ns_register_proc GET /*.html ad_serve_html_page +ns_register_proc GET /*.htm ad_serve_html_page + +# this must stand for "do not disturb" +# if you put it into a static .html file, the +# following Tcl proc serves the page unmolested + +proc ad_dnd_tag {} { + return "<!--AD_DND-->" +} + +# these entire directories will have their .html +# files served intact + +proc_doc ad_space { {n 1} } "returns n spaces in html (uses nbsp)" { + set result "" + for {set i 0} {$i < $n} {incr i} { + append result " " + } + #append result " " + return $result +} + +proc ad_naked_html_patterns {} { + set glob_patterns [list] + lappend glob_patterns "/doc/*" + lappend glob_patterns "/admin/*" + lappend glob_patterns "/pages/*" + lappend glob_patterns "/ct*" + lappend glob_patterns "[ad_parameter GlobalURLStub "" "/global"]/*" + return $glob_patterns +} + + +proc_doc ad_serve_html_page {ignore {override_url {}}} {The procedure that actually serves all the HTML pages on an ACS. It looks first to see if the file is in one of the naked_html directories. If so, it simply returns the raw bytes. It then looks to see if the ad_dnd_tag ("do not disturb") comment pattern is present. Again, if so, it simply returns. Otherwise, the procedure tries to add comments and related links. If the database is busy, it will simply add links to comments and related links.} { + + ## Fix to make abstract_url work (BMA) + if {$override_url == ""} { + set url_stub [ns_conn url] + } else { + set url_stub $override_url + } + + set full_filename "[ns_info pageroot]$url_stub" + + foreach naked_pattern [ad_naked_html_patterns] { + if [string match $naked_pattern $url_stub] { + ns_returnfile 200 text/html $full_filename + return + } + } + + if { ![file exists $full_filename]} { + # check to see if the file exists + # if not, return a "file not found" message + set file_name_url "[ad_parameter GlobalURLStub "" "/global"]/file-not-found.html" + set full_path [ns_url2file $file_name_url] + if [file exists $full_path] { + ns_returnfile 404 text/html $full_path + } else { + ns_return 404 text/plain "File not found" + } + return + } + + set stream [open $full_filename r] + set whole_page [read $stream] + close $stream + + ## sometimes we don't want comments to come up + ## for a given page + if {[string first [ad_dnd_tag] $whole_page] != -1} { + ns_return 200 text/html $whole_page + return + } + + if { [regexp -nocase {(.*)</body>(.*)} $whole_page match pre_body post_body] } { + # there was a "close body" tag, let's try to insert a comment + # link at least + # before we do anything else, let's stream out what we can + ad_return_top_of_page [static_add_curriculum_bar_if_necessary $pre_body] + + if { [catch { set db [ns_db gethandle -timeout -1] } errmsg] || [empty_string_p $db] } { + # the non-blocking call to gethandle raised a Tcl error; this + # means a db conn isn't free right this moment, so let's just + # return the page with a link + ns_log Notice "DB handle wasn't available in ad_serve_html_page" + ns_write " +<hr width=300> +<center> +<a href=\"/comments/for-one-page.tcl?url_stub=[ns_urlencode $url_stub]\">View/Add Comments</a> | +<a href=\"/links/for-one-page.tcl?url_stub=[ns_urlencode $url_stub]\">Related Links</a> +</center> +</body>$post_body" + } else { + # we got a db connection + set moby_list [static_get_comments_and_links $db $url_stub $post_body] + # Release the DB handle + ns_db releasehandle $db + set comment_link_options_fragment [static_format_comments_and_links $moby_list] + # now decide what to do with the comments and links we're queried from the database + ns_write "$comment_link_options_fragment\n\n</body>$post_body" + } + } else { + # couldn't find a </body> tag + ns_return 200 text/html $whole_page + } +} + +# helper proc for sticking in curriculum bar when necessary + +proc_doc static_add_curriculum_bar_if_necessary {pre_body} "Returns the page, up to the close body tag, with a curriculum bar added if necessary" { + if { ![ad_parameter EnabledP curriculum 0] || ![ad_parameter StickInStaticPagesP curriculum 0] } { + return $pre_body + } + set curriculum_bar [curriculum_bar] + if [empty_string_p $curriculum_bar] { + # we are using the curriculum system but this user doesn't need a bar + return $pre_body + } + # let's look for a good place to stuff the bar + # rely on maximal matching in REGEXP + if { [regexp -nocase {(.*)<hr>(.*)} $pre_body match up_to_last_hr after_last_hr] } { + # we found at least one HR, let's make sure that it is indeed + # at the bottom of the page + if { [string length $up_to_last_hr] > [string length $after_last_hr] } { + # this is indeed probably the last + append pre_body_with_curriculum_bar $up_to_last_hr "\n<center>[curriculum_bar]</center>\n" "<HR>" $after_last_hr + } else { + # found an HR but probably it isn't the last one + append pre_body_with_curriculum_bar $pre_body "\n<center>[curriculum_bar]</center>\n" + } + } else { + append pre_body_with_curriculum_bar $pre_body "\n<center>[curriculum_bar]</center>\n" + } + return $pre_body_with_curriculum_bar +} + +# helper proc for coming back with options, info, etc. + +proc_doc static_get_comments_and_links {db url_stub {post_body ""}} "Returns a list of comment_bytes link_bytes options_list comment_option link_option or the empty string if this page isn't registered in the database" { + set user_id [ad_get_user_id] + set selection [ns_db 0or1row $db "select page_id,accept_comments_p,accept_links_p,inline_comments_p,inline_links_p from static_pages where url_stub = '[DoubleApos $url_stub]'"] + if { $selection == "" } { + # this page isn't registered in the database so we can't + # accept comments on it or anything + ns_log Notice "Someone grabbed $url_stub but we weren't able to offer a comment link because this page isn't registered in the db" + return "" + } else { + set_variables_after_query + set options_list [list] + set comment_bytes "" + if { $inline_comments_p == "t" } { + # we display comments in-line + set selection [ns_db select $db "select comments.comment_id, comments.page_id, comments.user_id as poster_user_id, users.first_names || ' ' || users.last_name as user_name, message, posting_time, html_p, client_file_name, file_type, original_width, original_height, caption + from static_pages sp, comments_not_deleted comments, users + where sp.page_id = comments.page_id + and comments.user_id = users.user_id + and comments.page_id = $page_id + and comments.comment_type = 'alternative_perspective' + order by posting_time"] + set at_least_one_comment_found_p 0 + while { [ns_db getrow $db $selection] } { + set_variables_after_query + set at_least_one_comment_found_p 1 + append comment_bytes "<blockquote> + [format_static_comment $comment_id $client_file_name $file_type $original_width $original_height $caption $message $html_p] + <br> + <br> + " + if { $user_id == $poster_user_id} { + # the user wrote the message, so let him/her edit it + append comment_bytes "-- <A HREF=\"/shared/community-member.tcl?user_id=$poster_user_id\">$user_name</a> (<A HREF=\"/comments/persistent-edit.tcl?comment_id=$comment_id\">edit your comment</a>)" + } else { + # the user did not write it, link to the community_member page + append comment_bytes "-- <A HREF=\"/shared/community-member.tcl?user_id=$poster_user_id\">$user_name</a>" + } + append comment_bytes ", [util_AnsiDatetoPrettyDate $posting_time]" + append comment_bytes "</blockquote>\n" + } + } + if { $accept_comments_p == "t" && $inline_comments_p == "t" } { + # we only display the option if we're inlining comments; + # we assume that if the comments aren't in line but are legal + # then the publisher has an explicit link + set comment_option "<a href=\"/comments/add.tcl?page_id=$page_id\">Add a comment</a>" + lappend options_list $comment_option + } else { + set comment_option "" + } + + # links + set link_bytes "" + if { $inline_links_p == "t" } { + set selection [ns_db select $db "select links.page_id, links.user_id as poster_user_id, users.first_names || ' ' || users.last_name as user_name, links.link_title, links.link_description, links.url + from static_pages sp, links, users + where sp.page_id = links.page_id + and users.user_id = links.user_id + and links.page_id = $page_id + and status = 'live' + order by posting_time"] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + append link_bytes "<li><a href=\"$url\">$link_title</a>- $link_description" + + if { $user_id == $poster_user_id} { + # the user added, so let him/her edit it + append link_bytes "  (<A HREF=\"/links/edit.tcl?page_id=$page_id&url=[ns_urlencode $url]\">edit/delete</a>)" + } else { + # the user did not add it, link to the community_member page + append link_bytes "   <font size=-1>(contributed by <A HREF=\"/shared/community-member.tcl?user_id=$poster_user_id\">$user_name</a>)</font>" + } + append link_bytes "\n<p>\n" + } + } + if { $accept_links_p == "t" && $inline_links_p == "t" } { + # we only display the option if we're inlining links; + # we assume that if the links aren't in line but are legal + # then the publisher has an explicit link + set link_option "<a href=\"/links/add.tcl?page_id=$page_id\">Add a link</a>" + lappend options_list $link_option + } else { + set link_option "" + } + } + return [list $comment_bytes $link_bytes $options_list $comment_option $link_option] +} + + +# helper proc for formatting comments, links, etc. + +proc_doc static_format_comments_and_links {moby_list} "Takes list of comment_bytes link_bytes options_list comment_option link_option and produces HTML fragment to stick at bottom of page." { + if [empty_string_p $moby_list] { + return "" + } + set comment_bytes [lindex $moby_list 0] + set link_bytes [lindex $moby_list 1] + set options_list [lindex $moby_list 2] + set comment_option [lindex $moby_list 3] + set link_option [lindex $moby_list 4] + if { [empty_string_p $comment_bytes] && [empty_string_p $link_bytes] } { + if { [llength $options_list] > 0 } { + set centered_options "<center>[join $options_list " | "]</center>" + } else { + set centered_options "" + } + return $centered_options + } elseif { ![empty_string_p $comment_bytes] && [empty_string_p $link_bytes] } { + # there are comments but no links + return "<center><h3>Reader's Comments</h3></center> + $comment_bytes + <center>[join $options_list " | "]</center>" + } elseif { [empty_string_p $comment_bytes] && ![empty_string_p $link_bytes] } { + # links but no comments + return "<center><h3>Related Links</h3></center> + <ul>$link_bytes</ul> + <center>[join $options_list " | "]</center>" + } else { + # comments and links + return "<center><h3>Reader's Comments</h3></center> + $comment_bytes + <center> + $comment_option + </center> + <center><h3>Related Links</h3></center> + <ul>$link_bytes</ul> + <center> + $link_option + </center>" + } +} + +# Helper procedure for formatting 'alternative_perspective' comments on static +# pages, which presents inline images or attachment links as appropriate. +# Taken from a similar procedure in ad-general-comments.tcl. +proc format_static_comment { comment_id client_file_name file_type original_width original_height caption content comment_html_p } { + set return_string "" + set return_url "[ns_conn url]?[export_ns_set_vars url]" + + if { ![empty_string_p $client_file_name] } { + # We have an attachment. + if { [string match "image/*" [string tolower $file_type]] } { + # It was an image. + if { ![empty_string_p $original_width] + && $original_width < [ad_parameter InlineImageMaxWidth "comments" 512] } { + # It's narrow enough to display inline. + append return_string "<center><img src=\"/comments/attachment/$comment_id/$client_file_name\" width=$original_width height=$original_height><p><i>$caption</i></center><br>\n[util_maybe_convert_to_html $content $comment_html_p]\n" + } else { + # Send to an image display page. + append return_string "[util_maybe_convert_to_html $content $comment_html_p]\n<br><i>Image: <a href=\"/comments/image-attachment.tcl?[export_url_vars comment_id return_url]\">$client_file_name</a></i>" + } + } else { + # Send to raw file download. + append return_string "[util_maybe_convert_to_html $content $comment_html_p]\n<br><i>Attachment: <a href=\"/comments/attachment/$comment_id/$client_file_name\">$client_file_name</a></i>" + } + } else { + # No attachment + append return_string "[util_maybe_convert_to_html $content $comment_html_p]\n" + } + return $return_string +} + + +proc_doc send_author_comment_p { comment_type action } "Returns email notification state type of html comment" { + + if { [string compare $action "add"] == 0 } { + + switch $comment_type { + "unanswered_question" { return [ad_parameter EmailNewUnansweredQuestion comments] } + "alternative_perspective" { return [ad_parameter EmailNewAlternativePerspective comments] } + "rating" { return [ad_parameter EmailNewRating comments] } + default { return 0 } + } + + } else { + + switch $comment_type { + "unanswered_question" { return [ad_parameter EmailEditedUnansweredQuestion comments] } + "alternative_perspective" { return [ad_parameter EmailEditedAlternativePerspective comments] } + "rating" { return [ad_parameter EmailEditedRating comments] } + default { return 0 } + } + } +} + + +# ns_register'ed to +# /comments/attachment/[comment_id]/[file_name] Returns a +# MIME-typed attachment based on the comment_id. We use this so that +# the user's browser shows the filename the file was uploaded with +# when prompting to save instead of the name of a Tcl file (like +# "raw-file.tcl") +# Stolen from ad-general-comments.tcl. + +proc ad_static_comments_get_attachment { ignore } { + if { ![regexp {([^/]+)/([^/]+)$} [ns_conn url] match comment_id client_filename] } { + ad_return_error "Malformed Attachment Request" "Your request for a file attachment was malformed." + return + } + set db [ns_db gethandle subquery] + + # security check (BMA, spec'ed by ad) + validate_integer page_id $page_id + + set file_type [database_to_tcl_string $db "select file_type +from comments +where comment_id = $comment_id"] + + ReturnHeaders $file_type + + ns_ora write_blob $db "select attachment +from comments +where comment_id = $comment_id" + + ns_db releasehandle $db +} + +ns_register_proc GET /comments/attachment/* ad_static_comments_get_attachment Index: web/openacs/tcl/ad-intermedia-text.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-intermedia-text.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-intermedia-text.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,65 @@ +# ad-intermedia-text.tcl,v 3.0 2000/02/06 03:12:28 ron Exp +# ad-intermedia-text.tcl +# +# procs useful system-wide in conjunction with Oracle's Intermedia full-text +# indexer (an Oracle 8.1.5 feature) +# +# by philg@mit.edu July 25, 1999 +# + +proc_doc ad_intermedia_text_searching_hints {} {Returns an HTML fragment explaining to end-users how to use Intermedia's bizarro query language; this is basically annotation duct-tape on top of interMedia's fundamental flaws (it should really work like PLS or AltaVista or whatever)} { + return { + +By default, Oracle interMedia uses exact phrase matching. Thus, the more +you type, the fewer hits you're likely to get. Here are some ways that +you can improve search relevance: + +<dl> +<dt><b>about()</b> + +<dd>This is Oracle's attempt to do concept queries, the way that +public Internet search engines do. In theory, you'll get the most +relevant documents first. In practice, we don't use this by default +because it seems to come up with too many wildly irrelevant hits. +Usage: <code>about(how do I take a picture of a newborn)</code> +or <code>about(newborn photography)</code> + +<dt><b>boolean operators</b> + +<dd>You can do standard AND and OR queries using the words "and" and "or". +Usage: +<ul> +<li><code>newborn and photography</code> +<li><code>newborn & photography</code> +<li><code>newborn or photography</code> +<li><code>newborn and photography and not about(flash)</code> +</ul> + +Note that <code>newborn photography</code> alone would be an exact +phrase search and wouldn't return documents unless these words +occurred right next to each other. + +<dt><b>special characters</b> + +<dd>Be careful with punctuation marks. For example, the question mark +is the fuzzy matching character (<code>?photography</code> will find words +that are spelled similarly to "photography", useless if the body of text +has many misspellings). The exclamation point is the soundex character +(<code>!Nikkon</code> should match "Nikon"). + +</dl> + } +} + + + +proc_doc ad_clean_query_for_intermedia {query_string} {Cleans up user input into a form suitable for feeding to interMedia. Tries to turn user input into a simple AND query.} { + # Replace all ConText search operators with space. + regsub -all {[,&]+} $query_string { } query_string + + # Replace all words that are ConText operators + regsub -all { (and|or) } $query_string { } query_string + + # Separate all words with "&" to get an AND query. + return [join $query_string "&"] +} Index: web/openacs/tcl/ad-last-visit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-last-visit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-last-visit.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,337 @@ +# ad-last-visit.tcl,v 3.1 2000/02/26 12:55:27 jsalz Exp +# ad-last-visit.tcl, created February 13, 1999 by philg@mit.edu +# (this is actually a modification of code from cognet.mit.edu, +# built in summer 1998) + +# substantially modified on March 26, 1999 to include session tracking + +# teadams - substantially modified on Sept 17 to not overcount non-cookied browsers + +# we adhere to the algorithm specified in +# http://photo.net/wtr/thebook/community.html + +# this file also handles the maintenance of last_visit and +# second_to_last_visit cookies + +# each of these is a number returned by [ns_time] (seconds +# since January 1, 1970). + +proc ad_update_last_visits {db user_id} { + ns_db dml $db "update users +set last_visit = sysdate(), + second_to_last_visit = last_visit, + n_sessions = n_sessions + 1 +where user_id = $user_id" +} + + +proc ad_update_last_visit {db user_id} { + ns_db dml $db "update users +set last_visit = sysdate() +where user_id = $user_id" +} + +proc ad_update_session_statistics {db repeat_p {session_p 1}} { + if $repeat_p { + if $session_p { + set update_sql "update session_statistics +set session_count = session_count + 1, +repeat_count = repeat_count + 1 +where entry_date = trunc(sysdate())" + set insert_sql "insert into session_statistics (session_count, repeat_count, entry_date) + values + (1,1,trunc(sysdate()))" + } else { + # The user came to the site with no cookies. + # We recorded a session, but no repeat session + # at this point. + + # The user subsequenty logged in. We now + # know that this is a repeat visit. + + set update_sql "update session_statistics +set repeat_count = repeat_count + 1 +where entry_date = trunc(sysdate())" + set insert_sql "insert into session_statistics (session_count, repeat_count, entry_date) + values + (0,1,trunc(sysdate()))" + } + } else { + # not a repeat user + set update_sql "update session_statistics +set session_count = session_count + 1 +where entry_date = trunc(sysdate())" + set insert_sql "insert into session_statistics (session_count, repeat_count, entry_date) +values +(1,0,trunc(sysdate()))" + } + ns_db dml $db $update_sql + + # POSTGRES + # set n_rows [ns_ora resultrows $db] + set n_rows [ns_pg ntuples $db] + if { $n_rows == 0 } { + # there wasn't already a row there + ns_db dml $db $insert_sql + } +} + +# returns the seconds since January 1, 1970 of the second_to_last_visit +# (from the cookie). If there is no cookie, return "" + +proc ad_second_to_last_visit_ut {} { + set headers [ns_conn headers] + set cookie [ns_set get $headers Cookie] + if { [regexp {second_to_last_visit=([^;]+)} $cookie match second_to_last_visit] } { + return $second_to_last_visit + } else { + return "" + } +} + +proc_doc ad_current_hours_difference_from_GMT {} "Looks at ad.ini file to see where server is located and also at last element of ns_localtime to see whether we're on daylight savings time or not" { + # [lindex [ns_localtime] 8] will be 1 if we're on daylight time, + # 0 otherwise + set daylight_adjustment [lindex [ns_localtime] 8] + return [expr [ad_parameter HoursDifferenceFromGMT] + $daylight_adjustment] +} + +ns_share -init {set ad_last_visits_filters_installed_p 0} ad_last_visits_filters_installed_p + +if { [ad_parameter LastVisitCookiesEnabledP "" 1] && !$ad_last_visits_filters_installed_p } { + # we only establish these filters if the system is enabled in ad.ini + set ad_last_visits_filters_installed_p 1 + # will maintain the last_visit and second_to_last_visits users columns + # we could have done just /* but that puts cookies on all the images + # and so forth; it is unfriendly to people who've linked to images + # in-line from other pages and it is unfriendly to those who have + # "warn about cookies" enabled + ad_register_filter preauth GET /*.html ad_maintain_last_visits + ad_register_filter preauth GET /*.htm ad_maintain_last_visits + ad_register_filter preauth GET /*.tcl ad_maintain_last_visits + ad_register_filter preauth GET /*.adp ad_maintain_last_visits + ad_register_filter preauth GET / ad_maintain_last_visits +} + +# we do all the work in a helper procedure so that we can wrap a catch around +# the whole thing (AOLserver 2.3.2 won't serve the page at all if there is a +# serious error with the filter) + +proc ad_maintain_last_visits_internal {} { + set headers [ns_conn headers] + set cookie [ns_set get $headers Cookie] + set user_id [ad_get_user_id] + # parse out the last_visit date from the cookie + if { [regexp {last_visit=([^;]+)} $cookie match last_visit] } { + # we have a last visit cookie already, but maybe it is old + # and needs refreshing + set expiration_seconds [ad_parameter LastVisitExpiration "" 86400] + + if { [ns_time] - $last_visit > $expiration_seconds } { + # let's consider this a new visit and update the cookie + ns_set put [ns_conn outputheaders] "Set-Cookie" "last_visit=[ns_time]; path=/; expires=Fri, 01-Jan-2010 01:00:00 GMT" + ns_set put [ns_conn outputheaders] "Set-Cookie" "second_to_last_visit=$last_visit; path=/; expires=Fri, 01-Jan-2010 01:00:00 GMT" + set db [ns_db gethandle -timeout -1] + # let's record this as a repeat user + ad_update_session_statistics $db 1 + # if the person is a registered user, update the users table + if { $user_id != 0 } { + ad_update_last_visits $db $user_id + } + ns_db releasehandle $db + } + } else { + + # no last_visit cookie + ns_share ad_last_visit_ip_cache + set ip_address [ns_conn peeraddr] + set ad_ip_last_visit_cache_seconds [ad_parameter LastVisitCacheUpdateInterval "" 600] + + if {![info exists ad_last_visit_ip_cache($ip_address)] || ([ns_time] - $ad_last_visit_ip_cache($ip_address)) > $ad_ip_last_visit_cache_seconds } { + # we haven't seen this IP, let's consider this a new + # sessions + ns_set put [ns_conn outputheaders] "Set-Cookie" "last_visit=[ns_time]; path=/; expires=Fri, 01-Jan-2010 01:00:00 GMT" + set ad_last_visit_ip_cache($ip_address) [ns_time] + } else { + # We've already seen this IP. + # Since there is no last visit cookie, we + # assume the attempt to cookie was unsuccessful + # on a previous hit + return + } + + set db [ns_db gethandle -timeout -1] + if { [empty_string_p $db] } { + return + } + + # let's record this as a new visit + if {$user_id == 0} { + ad_update_session_statistics $db 0 + } else { + # this is the very rare case where the user + # has a user_id cooke, but not a last visit cookie + # if the person is a user, update the last_visit dates in the database + ad_update_session_statistics $db 1 + ad_update_last_visits $db $user_id + # we use an explicit to_char here in case someone is + # using an older version of our Oracle driver (which had + # a bug in pulling through large numbers) + # the hard part of this is turning what Oracle gives us + # (local time) into universal time (GMT) + #set second_to_last_visit_ut [database_to_tcl_string $db "select to_char(86400*(second_to_last_visit - to_date('1970-01-01') - ([ad_current_hours_difference_from_GMT]/24)),'9999999999') +#from users +#where user_id = $user_id"] + +# DRB: the following simplified expression works in Postgres (the above mess didn't due to the lack of +# to_char() without a formatting parameter) + + set second_to_last_visit_ut [database_to_tcl_string $db "select date_part('epoch', second_to_last_visit - '[ad_current_hours_difference_from_GMT] hours'::reltime) +from users +where user_id = $user_id"] + if ![empty_string_p $second_to_last_visit_ut] { + ns_set put [ns_conn outputheaders] "Set-Cookie" "second_to_last_visit=$second_to_last_visit_ut; path=/; expires=Fri, 01-Jan-2010 01:00:00 GMT" + } + } + ns_db releasehandle $db + } +} + + +# Same as above, but updates last_visit more frequently, in order to support +# querying for who's online. + +# Think of last_visit as representing the actual time of the last +# visit (with some delay controlled by LastVisitExpiration, for +# efficiency) and second_to_last_visit as representing the last visit +# time for the previous "session". + +proc ad_maintain_last_visits_for_whosonline_internal {} { + + set headers [ns_conn headers] + set cookie [ns_set get $headers Cookie] + set user_id [ad_get_user_id] + + # Parse out the last_visit value from the cookie. + if { ![regexp {last_visit=([^;]+)} $cookie match last_visit] } { + set last_visit "" + } + + if { ![regexp {second_to_last_visit=([^;]+)} $cookie match second_to_last_visit] } { + set second_to_last_visit "" + } + + #ns_log Notice "ad_maintain_last_visits_internal working on user_id #$user_id whose cookie is \"$cookie\". We've got a last_visit of \"$last_visit\" and a second_to_last_visit of \"$second_to_last_visit\"." + + set now [ns_time] + set expiration_seconds [ad_parameter LastVisitExpiration "" 86400] + set update_seconds [ad_parameter LastVisitUpdateInterval "" 600] + set ad_ip_last_visit_cache_seconds [ad_parameter LastVisitCacheUpdateInterval "" 600] + + if { ![empty_string_p $last_visit] } { + if { ($now - $last_visit > $expiration_seconds) || \ + (![empty_string_p $second_to_last_visit] && (($now - $second_to_last_visit) > 4 * $expiration_seconds)) } { + # The last visit was long enough ago to consider + # this a new session OR the second to last visit was way old (four times as long as expiration) + + ns_set put [ns_conn outputheaders] "Set-Cookie" "last_visit=$now; path=/; expires=Fri, 01-Jan-2010 01:00:00 GMT" + ns_set put [ns_conn outputheaders] "Set-Cookie" "second_to_last_visit=$last_visit; path=/; expires=Fri, 01-Jan-2010 01:00:00 GMT" + + set db [ns_db gethandle -timeout -1] + if { ![empty_string_p $db] } { + # let's record this as a repeat user + ad_update_session_statistics $db 1 + + # if the person is a registered user, update the users table + if {$user_id != 0} { + ad_update_last_visits $db $user_id + } + + ns_db releasehandle $db + } + } elseif { $now - $last_visit > $update_seconds } { + # This counts as the same session; just update the last_visit + # cookie and database field. + ns_set put [ns_conn outputheaders] "Set-Cookie" "last_visit=$now; path=/; expires=Fri, 01-Jan-2010 01:00:00 GMT" + set db [ns_db gethandle -timeout -1] + if { ![empty_string_p $db] } { + # if the person is a registered user, update the users table + if {$user_id != 0} { + ad_update_last_visit $db $user_id + } + + ns_db releasehandle $db + } + } + # last visit was too recent to do anything about, don't do anything + } else { + # no last_visit cookie + + ns_share ad_last_visit_ip_cache + set ip_address [ns_conn peeraddr] + + if {![info exists ad_last_visit_ip_cache($ip_address)] || ([ns_time] - $ad_last_visit_ip_cache($ip_address)) > $ad_ip_last_visit_cache_seconds } { + # we haven't seen this IP, let's consider this a new + # session + ns_set put [ns_conn outputheaders] "Set-Cookie" "last_visit=[ns_time]; path=/; expires=Fri, 01-Jan-2010 01:00:00 GMT" + set ad_last_visit_ip_cache($ip_address) [ns_time] + set db [ns_db gethandle -timeout -1] + if { [empty_string_p $db] } { + return + } + } else { + # We've already seen this IP. + # Since there is no last visit cookie, we + # assume the attempt to cookie was unsuccessful + # on a previous hit + + return + } + + if {$user_id == 0} { + ad_update_session_statistics $db 0 + } else { + # this is the rare case where the user has a user_id + # cookie, but not a last visit cookie + ad_update_session_statistics $db 1 + # let's record this as a new user + # if the person is a user, update the last_visit dates in the database + ad_update_last_visits $db $user_id + # we use an explicit to_char here in case someone is + # using an older version of our Oracle driver (which had + # a bug in pulling through large numbers) + # the hard part of this is turning what Oracle gives us + # (local time) into universal time (GMT) + #set second_to_last_visit_ut [database_to_tcl_string $db "select to_char(86400*(second_to_last_visit - to_date('1970-01-01') - ([ad_current_hours_difference_from_GMT]/24)),'9999999999') +#from users +#where user_id = $user_id"] + + set second_to_last_visit_ut [database_to_tcl_string $db "select date_part('epoch', second_to_last_visit - '[ad_current_hours_difference_from_GMT] hours'::reltime) +from users +where user_id = $user_id"] + if ![empty_string_p $second_to_last_visit_ut] { + ns_set put [ns_conn outputheaders] "Set-Cookie" "second_to_last_visit=$second_to_last_visit_ut; path=/; expires=Fri, 01-Jan-2010 01:00:00 GMT" + } + } + ns_db releasehandle $db + } +} + +proc ad_maintain_last_visits {conn args why} { + set useragent [ns_set get [ns_conn headers] "User-Agent"] + if { [string match *aolserver* [string tolower $useragent]] } { + return filter_ok + } + if [catch { + if { [ad_parameter WhosOnlineP "" 0] } { + ad_maintain_last_visits_for_whosonline_internal + } else { + ad_maintain_last_visits_internal + } + } errmsg] { + ns_log Error "ad_maintain_last_visits filter got an error: $errmsg" + } + return filter_ok +} + + Index: web/openacs/tcl/ad-member-value.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-member-value.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-member-value.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,190 @@ +# ad-member-value.tcl,v 3.0 2000/02/06 03:12:31 ron Exp +# +# /tcl/ad-member-value.tcl +# +# by philg@mit.edu in July 1998 +# modified November 7, 1999 to include interface +# to the ad-user-contributions-summary.tcl system + +# anything having to do with billing members +# or tallying up their charges (pseudo or otherwise) + + +util_report_library_entry + +proc_doc mv_parameter {name {default ""}} "The correct way to get a parameter for the member value module. We want to make sure that we are abstracting away whether this is stored in the database or in the /parameters/ad.ini file." { + set server_name [ns_info server] + append config_path "ns/server/" $server_name "/acs/member-value" + set config_value [ns_config $config_path $name] + if ![empty_string_p $config_value] { + return $config_value + } else { + return $default + } +} + +proc_doc mv_create_user_charge {user_id admin_id charge_type charge_key amount {charge_comment ""}} "Build a user charge data structure (actually just a list)" { + return [list $user_id $admin_id $charge_type $charge_key $amount $charge_comment] +} + +proc_doc mv_user_charge_replace_comment {user_charge new_comment} "Takes a user charge data structure (actually just a list) and replaces the comment field (at the end); useful when there is a separate field for an admin to type an arbitrary comment." { + set user_id [lindex $user_charge 0] + set admin_id [lindex $user_charge 1] + set charge_type [lindex $user_charge 2] + set charge_key [lindex $user_charge 3] + set amount [lindex $user_charge 4] + return [list $user_id $admin_id $charge_type $charge_key $amount $new_comment] +} + +# the argument is +# [list user_id admin_id charge_type charge_key amount charge_comment] +# note that it doesn't contain the entry_date, which we'll +# add implicitly + +proc_doc mv_charge_user {db spec_list {notify_subject ""} {notify_body ""}} "Takes a spec in the form of \[list user_id admin_id charge_type charge_key amount charge_comment\] and adds a row to the users_charges table" { + # we double the apostrophes right here to avoid any trouble with SQL + set QQspec_list [DoubleApos $spec_list] + set user_id [lindex $QQspec_list 0] + set admin_id [lindex $QQspec_list 1] + set charge_type [lindex $QQspec_list 2] + set charge_key [lindex $QQspec_list 3] + set amount [lindex $QQspec_list 4] + set unquoted_charge_comment [lindex $spec_list 5] + ns_db dml $db "insert into users_charges +(user_id, admin_id, charge_type, charge_key, amount, charge_comment, entry_date) +values +($user_id, $admin_id, '$charge_type', '$charge_key', $amount, [ns_dbquotevalue $unquoted_charge_comment text], sysdate())" + if ![empty_string_p $notify_subject] { + # we're going to email this user and tell him that we charged him + # but we don't want an error in notification to cause this to fail + catch { mv_notify_user_of_new_charge $db $spec_list $notify_subject $notify_body } + } +} + +proc_doc mv_notify_user_of_new_charge {db spec_list notify_subject notify_body} "Helper proc for mv_charge_user; actually sends email." { + set user_id [lindex $spec_list 0] + set admin_id [lindex $spec_list 1] + set charge_type [lindex $spec_list 2] + set charge_key [lindex $spec_list 3] + set amount [lindex $spec_list 4] + set charge_comment [lindex $spec_list 5] + set user_email [database_to_tcl_string_or_null $db "select email from users_alertable where user_id = $user_id"] + set admin_email [database_to_tcl_string_or_null $db "select email from users where user_id = $admin_id"] + if { ![empty_string_p $user_email] && ![empty_string_p $admin_id] } { + set full_body "You've been assessed a charge by the [ad_system_name] community." + if [ad_parameter UseRealMoneyP "member-value"] { + append full_body "\n\nThis charge will be included in your next bill." + } else { + append full_body "\n\nWe don't use real money here but the charges are +designed to reflect the reality of the costs of your actions. +It is only possible to operate community Web services if +members conform to certain norms." + } + append full_body "\n\nHere's a summary of the charge: +[mv_describe_user_charge $spec_list]\n\n" + append full_body "More explanation:\n\n$notify_body" + ns_log Notice "mv_notify_user_of_new_charge sending email from $admin_email to $user_email" + ns_sendmail $user_email $admin_email $notify_subject $notify_body + } +} + +proc_doc mv_describe_user_charge {spec_list} "Takes a spec in the form of \[list user_id admin_id charge_type charge_key amount charge_comment\] and prints a readable description." { + set user_id [lindex $spec_list 0] + set admin_id [lindex $spec_list 1] + set charge_type [lindex $spec_list 2] + set charge_key [lindex $spec_list 3] + set amount [lindex $spec_list 4] + set charge_comment [lindex $spec_list 5] + set description "$charge_type: $amount; user ID $user_id (by administrator $admin_id)" + if ![empty_string_p $charge_comment] { + append description "; $charge_comment" + } + return $description +} + +# stuff for reporting + +proc mv_pretty_currency {currency} { + if { $currency == "USD" } { + return "$" + } elseif { $currency == "GBP" } { + return "£" + } else { + return $currency + } +} + +proc mv_pretty_amount {currency amount} { + if { $currency == "USD" } { + return "$[format "%0.2f" $amount]" + } elseif { $currency == "GBP" } { + return "£$amount" + } else { + return "$currency$amount" + } +} + +proc mv_pretty_user_charge {charge_type charge_key charge_comment} { + # pretty (and maybe hyperlinked) descriptions of a charge + switch $charge_type { + miscellaneous { set result "$charge_type: $charge_comment" } + default { set result "$charge_type: $charge_comment" } + } + return $result +} + +proc_doc mv_enabled_p {} "Just a shortcut for seeing if the member value module is enabled." { + return [ad_parameter EnabledP "member-value" 0] +} + +proc_doc mv_rate {which_rate} "A shortcut for getting a rate from the member-value section of the parameters file" { + return [ad_parameter $which_rate "member-value"] +} + + +################################################################## +# +# interface to the ad-user-contributions-summary.tcl system + +ns_share ad_user_contributions_summary_proc_list + +if { ![info exists ad_user_contributions_summary_proc_list] || [util_search_list_of_lists $ad_user_contributions_summary_proc_list "Member Value" 0] == -1 } { + lappend ad_user_contributions_summary_proc_list [list "Member Value" mv_user_contributions 0] +} + +proc_doc mv_user_contributions {db user_id purpose} {Returns empty list unless it is the site admin asking. Returns list items, one for each user charge} { + if { $purpose != "site_admin" } { + return [list] + } + set items "" + set selection [ns_db select $db "select + uc.entry_date, + uc.charge_type, + uc.currency, + uc.amount, + uc.charge_comment, + uc.admin_id, + u.first_names || ' ' || u.last_name as admin_name +from users_charges uc, users u +where uc.user_id = $user_id +and uc.admin_id = u.user_id +order by uc.entry_date desc"] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + append items "<li>$entry_date: $charge_type $currency $amount, +by <a href=\"/admin/member-value/charges-by-one-admin.tcl?admin_id=$admin_id\">$admin_name</a>" + if ![empty_string_p $charge_comment] { + append items " ($charge_comment)" + } + append items "\n" + } + if [empty_string_p $items] { + return [list] + } else { + return [list 0 "Member Value" "<ul>\n\n$items\n\n</ul>"] + } +} + + + +util_report_successful_library_load Index: web/openacs/tcl/ad-monitor.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-monitor.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-monitor.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,28 @@ +# ad-monitor.tcl,v 3.0 2000/02/06 03:12:32 ron Exp +# created by philg@mit.edu on 11/6/98 +# internal error monitors, beyond the static files in /SYSTEM +# that external monitors such as Uptime use + +# the overall goal here is that the ad_host_administrator gets +# notified if something is horribly wrong, but not more than once +# every 15 minutes + +# we store the last [ns_time] (seconds since 1970) notification time +# in ad_host_administrator_last_notified + +ns_share -init { set ad_host_administrator_last_notified 0 } ad_host_administrator_last_notified + +proc ad_notify_host_administrator {subject body {log_p 0}} { + ns_share ad_host_administrator_last_notified + if $log_p { + # usually the error will be in the error log anyway + ns_log Notice "ad_notify_host_administrator: $subject\n\n$body\n\n" + } + if { [ns_time] > [expr $ad_host_administrator_last_notified + 900] } { + # more than 15 minutes have elapsed since last note + set ad_host_administrator_last_notified [ns_time] + if [catch { ns_sendmail [ad_host_administrator] [ad_system_owner] $subject $body } errmsg] { + ns_log Error "failed sending email note to [ad_host_administrator]" + } + } +} Index: web/openacs/tcl/ad-navigation.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-navigation.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-navigation.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,797 @@ +# /tcl/ad-navigation.tcl +# +# created by philg 11/5/98, adapted originally from +# the Cognet server +# +# edited February 28, 1999 by philg to include support for a +# Yahoo-style navigation system (showing users where they are in a +# hierarchy) +# +# ad-navigation.tcl,v 3.2 2000/02/21 10:34:24 ron Exp +# ----------------------------------------------------------------------------- + +# the arguments are lists ( [list URL anchor]) +# except for the last one, which we expect to be just text +proc_doc ad_context_bar args "Returns a Yahoo-style hierarchical navbar, each arg should be a list of URL and description. The last arg should be a just plain description." { + set choices [list] + set index 0 + foreach arg $args { + incr index + if { $index == [llength $args] } { + lappend choices $arg + } else { + lappend choices "<a href=\"[lindex $arg 0]\">[lindex $arg 1]</a>" + } + } + return [join $choices " : "] +} + +# a context bar, rooted at the workspace + +proc_doc ad_context_bar_ws args "Returns a Yahoo-style hierarchical navbar, starting with a link to workspace." { + set choices [list "<a href=\"[ad_pvt_home]\">Your Workspace</a>"] + set index 0 + foreach arg $args { + incr index + if { $index == [llength $args] } { + lappend choices $arg + } else { + lappend choices "<a href=\"[lindex $arg 0]\">[lindex $arg 1]</a>" + } + } + return [join $choices " : "] +} + +# a context bar, rooted at the workspace or index, depending on whether +# user is logged in + +proc_doc ad_context_bar_ws_or_index args "Returns a Yahoo-style hierarchical navbar, starting with a link to either the workspace or /, depending on whether or not the user is logged in." { + if { [ad_get_user_id] == 0 } { + set choices [list "<a href=\"/\">[ad_system_name]</a>"] + } else { + set choices [list "<a href=\"[ad_pvt_home]\">Your Workspace</a>"] + } + set index 0 + foreach arg $args { + incr index + if { $index == [llength $args] } { + lappend choices $arg + } else { + lappend choices "<a href=\"[lindex $arg 0]\">[lindex $arg 1]</a>" + } + } + return [join $choices " : "] +} + +proc_doc ad_admin_context_bar args "Returns a Yahoo-style hierarchical navbar, starting with links to workspace and admin home. Suitable for use in pages underneath /admin." { + set choices [list "<a href=\"[ad_pvt_home]\">Your Workspace</a>" "<a href=\"/admin/\">Admin Home</a>"] + set index 0 + foreach arg $args { + incr index + if { $index == [llength $args] } { + lappend choices $arg + } else { + lappend choices "<a href=\"[lindex $arg 0]\">[lindex $arg 1]</a>" + } + } + return [join $choices " : "] +} + +proc_doc ad_navbar args "produces navigation bar. notice that navigation bar is different than context bar, which exploits a tree structure. navbar will just display a list of nicely formatted links." { + set counter 0 + foreach arg $args { + lappend link_list "<a href=\"[lindex $arg 0]\">[lindex $arg 1]</a>" + incr counter + } + if { $counter > 0 } { + return "\[[join $link_list " | "]\]" + } else { + return "" + } +} + +# -- Cognet stuff + +# an automatically maintained navigation system +# the can show the user links to a document one level +# up and/or links to other sections + +# directories that should not receive links to move up one level + +proc ad_no_uplevel_patterns {} { + set regexp_patterns [list] + lappend regexp_patterns "/pvt/home.tcl" + # tcl files in the root directory + lappend regexp_patterns "^/\[^/\]*\.tcl\$" + lappend regexp_patterns "/admin*" +} + +# list of the search sections that should appear in the the search block + +proc pretty_search_sections {} { + return {"All of Cognet" "Library" "HotScience" "Jobs" "The Forum" "Member Profiles" "Posters" "Almanac"} +} + +# list of search values for the search block -- These pair up to +# pretty_search_sections to make the search form and should also +# match the section variable that runs the menu + +proc search_sections {} { + return {"all" "library" "hotscience" "jobs" "forum" "member_profiles" "posters" "almanac"} +} + + +# list of menu items to be generated (in this order) + +proc menu_items {} { + return {"library" "hotscience" "jobs" "forum" "member_profiles" "seminar_manager" "your_workspace"} +} + + +# determines if java_script should be enabled + +proc java_script_capabilities {} { + set user_agent "" + set version 0 + set internet_explorer_p 0 + set netscape_p 0 + + # get the version + set user_agent [ns_set get [ns_conn headers] User-Agent] + regexp -nocase "mozilla/(\[^\.\ \]*)" $user_agent match version + + # IE browsers have MSIE and Mozilla in their user-agent header + set internet_explorer_p [regexp -nocase "msie" $user_agent match] + + # Netscape browser just have Mozilla in their user-agent header + if {$internet_explorer_p == 0} { + set netscape_p [regexp -nocase "mozilla" $user_agent match] + } + + set java_script_p 0 + + if { ($netscape_p && ($version >= 3)) || ($internet_explorer_p && ($version >= 4)) } { + set java_script_p 1 + } + + return $java_script_p +} + +# netscape3 browser has a different output + +proc netscape3_browser {} { + set user_agent "" + set version 0 + set internet_explorer_p 0 + set netscape_p 0 + + # get the version + set user_agent [ns_set get [ns_conn headers] User-Agent] + regexp -nocase "mozilla/(\[^\.\ \]*)" $user_agent match version + + # IE browsers have MSIE and Mozilla in their user-agent header + set internet_explorer_p [regexp -nocase "msie" $user_agent match] + + # Netscape browser just have Mozilla in their user-agent header + if {$internet_explorer_p == 0} { + set netscape_p [regexp -nocase "mozilla" $user_agent match] + } + + set netscape3_p 0 + + if { ($netscape_p && ($version == 3))} { + set netscape3_p 1 + } + + return $netscape3_p +} + + +proc bgcolor {} { + return "#FFFFFF" +} + +proc table_background_1 {} { + return "#CCCCCC" +} + +proc table_background_2 {} { + return "#606060" +} + +proc font_face_lower_left {} { + return "<FONT FACE=\"Helvetica, Ariel, Sans-Serif\">" +} + +# determines the title gif by section + +proc menu_title_gif {section} { + switch $section { + "almanac" {return "/graphics/academic_almanac_area.gif"} + "library" {return "/graphics/library_area.gif"} + "mitecs" {return "/graphics/mitecs_area.gif"} + "cjtcs" {return "/graphics/cjtcs_area.gif"} + "jocn" {return "/graphics/jocn_area.gif"} + "li" {return "/graphics/li_area.gif"} + "neco" {return "/graphics/neco_area.gif"} + "vide" {return "/graphics/vide_area.gif"} + "hotscience" {return "/graphics/hotscience_area.gif"} + "jobs" {return "/graphics/jobs_area.gif"} + "forum" {return "/graphics/forum_area.gif"} + "member_profiles" {return "/graphics/member_profiles_area.gif"} + "seminar_manager" {return "/graphics/seminar_manager_area.gif"} + "your_workspace" {return "/graphics/your_workspace_area.gif"} + "agent_glossary" {return "/graphics/agent_glossary_area.gif/"} + + "poster" { + set organization [ns_queryget organization] + switch [string tolower $organization] { + "cognitive neurosciences society" {return "/graphics/cns98_area.gif"} + "cuny conference on human sentence processing" {return "/graphics/cuny98_area.gif"} + "neural information processing systems foundation" {return "/graphics/nips10_area.gif"} + default {return "/graphics/poster_sessions_area.gif"} + } + } + "proceeding" { + set organization [ns_queryget organization] + switch [string tolower $organization] { + "cognitive neurosciences society" {return "/graphics/cns98_area.gif"} + "cuny conference on human sentence processing" {return "/graphics/cuny98_area.gif"} + "neural information processing systems foundation" {return "/graphics/nips10_area.gif"} + default {return "/graphics/proceedings_area.gif"} + } + } + + + default {return "/graphics/1x1_blue.gif"} + } +} + +# determines the menu highlight by section + +proc menu_highlight {section} { + switch $section { + "almanac" {return "library"} + "agent_glossary" {return "library"} + "mitecs" {return "library"} + "poster" {return "library"} + "proceeding" {return "library"} + "cjtcs" {return "library"} + "jocn" {return "library"} + "li" {return "library"} + "neco" {return "library"} + "vide" {return "library"} + default {return $section} + } +} + + +# determins the menu highlight by section + +proc menu_search_highlight {section} { + switch $section { + "almanac" {return "almanac"} + "mitecs" {return "library"} + "poster" {return "library"} + "proceeding" {return "library"} + "agent_glossary" {return "library"} + "cjtcs" {return "library"} + "jocn" {return "library"} + "li" {return "library"} + "neco" {return "library"} + "vide" {return "library"} + default {return $section} + } +} + +# determines the URL for the menu buttons + +proc menu_url {item} { + switch $item { + "library" {return "/library/index.tcl"} + "hotscience" {return "/hotscience/index.tcl"} + "jobs" {return "/gc/domain-top.tcl?domain=Job%20Listings"} + "forum" {return "/bboard/index.tcl"} + "member_profiles" {return "/profiles/index.tcl"} + "seminar_manager" {return "/lecture/index.tcl"} + "your_workspace" { + set user_id [ad_get_user_id] + if {$user_id == 0} { + return "/" + } else { + return "/pvt/home.tcl" + } + } + } +} + +# default search order to find an uplevel link +proc up_level_search_order {} { + return [list index.adp index.tcl index.html index.htm home.tcl ] +} + +# search order as determined by the section + +proc menu_section_uplevel_list {section} { + switch [string tolower $section] { + "agent_glossary" {return [list index.html]} + "almanac" { + set url [ns_conn url] + if {[string match *index.tcl $url]} { + return [list ../library/index.tcl] + } else { + return [list index.tcl] + } + } + "mitecs" { + return [list index.html] + } + + "jobs" { + return [list domain-top.tcl] + } + "poster" { + set url [ns_conn url] + if {[string match *index.tcl $url]} { + return [list ../library/index.tcl] + } else { + return [list index.tcl] + } + } + "proceeding" { + set url [ns_conn url] + if {[string match *index.tcl $url]} { + return [list ../library/index.tcl] + } else { + return [list index.tcl] + } + } + default {return [list index.tcl]} + } +} + + +proc menu_uplevel {section {uplevel_link ""}} { + if {$uplevel_link != ""} { + # if there was a uplevel link requested, honor it + return $uplevel_link + } else { + set urlroot [file dirname [ns_conn url]] + + if {[file tail [ns_conn url]] == [lindex [menu_section_uplevel_list $section] 0]} { + # if you are what is considered root for that directory, move up a directory + set urlroot [file dirname $urlroot] + set fileroot [ns_info pageroot]$urlroot + } else { + + #check at this level in the directory + + set fileroot [ns_info pageroot]$urlroot + + # see if we can find any files on the list for that section + + foreach filename [menu_section_uplevel_list $section] { + if {[file exists $fileroot/$filename]} { + return "[ns_conn location]$urlroot/$filename" + } + } + } + while {$urlroot != "" || $urlroot != "."} { + foreach filename [up_level_search_order] { + if {[file exists $fileroot/$filename]} { + return "[ns_conn location]$urlroot/$filename" + } + } + if {$urlroot == "/"} { + break + } else { + # move up a directory + set urlroot [file dirname $urlroot] + set fileroot [ns_info pageroot]$urlroot + } + } + return "none" + } +} + + + +# creates the generic javascript/nonjavascript +# select box for the submenu + +proc menu_submenu_select_list {items urls {highlight_url "" }} { + set return_string "" + set counter 0 + + append return_string "<form name=submenu ACTION=/redir.tcl> +<select name=\"url\" onchange=\"go_to_url(this.options\[this.selectedIndex\].value)\">" + + foreach item $items { + set url_stub [ns_conn url] + + # if the url matches the url you would redirect to, as determined + # either by highlight_url, or if highlight_url is not set, + # the current url then select it + if {$highlight_url != "" && $highlight_url == [lindex $urls $counter]} { + append return_string "<OPTION VALUE=\"[lindex $urls $counter]\" selected>$item" + } elseif {$highlight_url == "" && [string match *$url_stub* [lindex $urls $counter]]} { + append return_string "<OPTION VALUE=\"[lindex $urls $counter]\" selected>$item" + } else { + append return_string "<OPTION VALUE=\"[lindex $urls $counter]\">$item" + } + incr counter + } + + append return_string "</select><br> + <noscript><input type=\"Submit\" value=\"GO\"> + </noscript> + </form>\n" +} + + + + +# determines the subnavigation by section + +proc menu_subsection {section} { + switch $section { + "library" { + set url_stub [ns_conn url] + if [string match "/library/index.tcl" $url_stub] { + return "<TR><TD>[ad_promo_message "library"]</TD></TR>" + } else { + return "<TR><TD>[library_submenu]</TD></TR> +<TR><TD>[ad_promo_message "library"]</TD></TR>" + } + } + "mitecs" { + + set items [list "Subsections" "Introduction" "Author Index" "Topic Index" "AI/Computer Science" "Human Sciences" "Linguistics" "Neuroscience" "Philosophy" "Psychology"] + + set urls [list "/library/MITECS/index.html" "/library/MITECS/introduction_r.html" "/library/MITECS/author_index_r.html" "/library/MITECS/title_index_r.html" "/library/MITECS/aicomp_r.html" "/library/MITECS/culture_r.html" "/library/MITECS/linguistics_r.html" "/library/MITECS/neurobiol_r.html" "/library/MITECS/philosophy_r.html" "/library/MITECS/psychology_r.html"] + + return "<TR><TD bgcolor=\"[table_background_2]\" height=24><FONT color=\"[bgcolor]\" FACE=\"Arial, Helvetica, sans-serif\" SIZE=\"4\">MITECS</FONT></TD></TR> + <TR><TD> [font_face_lower_left] + <TR><TD> [menu_submenu_select_list $items $urls]</TD></TR> + <TR><TD>[ad_promo_message "mitecs"]</TD></TR>" + } + + "almanac" {return " + <TR><TD bgcolor=\"[table_background_2]\" height=24><FONT color=\"[bgcolor]\" FACE=\"Arial, Helvetica, sans-serif\" SIZE=\"4\">ALMANAC</FONT></TD></TR> + <TR><TD>[font_face_lower_left][ad_promo_message "almanac"]</TD></TR>" + } + + "poster" { + set url_stub [ns_conn url] + if [string match "/posters/index.tcl" $url_stub] { + return "<TR><TD bgcolor=\"[table_background_2]\" height=24><FONT color=\"[bgcolor]\" FACE=\"Arial, Helvetica, sans-serif\" SIZE=\"4\">LIBRARY</FONT></TD></TR> +<TR><TD>[library_submenu]</TD></TR> +<TR><TD>[font_face_lower_left][ad_promo_message "library"]</TD></TR>" + } else { + return "<TR><TD bgcolor=\"[table_background_2]\" height=24><FONT color=\"[bgcolor]\" FACE=\"Arial, Helvetica, sans-serif\" SIZE=\"4\">POSTER SESSIONS</FONT></TD></TR> +<TR><TD>[poster_submenu $section]</TD></TR> +<TR><TD>[font_face_lower_left][ad_promo_message "library"]</TD></TR>" + } + } + "proceeding" { + set url_stub [ns_conn url] + if [string match "/posters/index.tcl" $url_stub] { + return "<TR><TD bgcolor=\"[table_background_2]\" height=24><FONT color=\"[bgcolor]\" FACE=\"Arial, Helvetica, sans-serif\" SIZE=\"4\">LIBRARY</FONT></TD></TR> +<TR><TD>[library_submenu]</TD></TR> +<TR><TD>[font_face_lower_left][ad_promo_message "library"]</TD></TR>" + } else { + return "<TR><TD bgcolor=\"[table_background_2]\" height=24><FONT color=\"[bgcolor]\" FACE=\"Arial, Helvetica, sans-serif\" SIZE=\"4\">PROCEEDINGS</FONT></TD></TR> +<TR><TD>[poster_submenu $section]</TD></TR> +<TR><TD>[font_face_lower_left][ad_promo_message "library"]</TD></TR>" + } + } + + + "hotscience" {return " + <TR><TD> [font_face_lower_left][ad_promo_message "hotscience"]</TD></TR>" + } + "jobs" {return " + <TR><TD>[font_face_lower_left][gc_submenu "Job Listings"]<p>[ad_promo_message "jobs"]</TD></TR>" + } + "forum" {return " + <TR><TD>[font_face_lower_left][ad_promo_message "forum"]</TD></TR>"} + "member_profiles" {return " + <TR><TD>[font_face_lower_left][ad_promo_message "member_profiles"]</TD></TR>"} + "seminar_manager" {return " + <TR><TD> [font_face_lower_left][ad_promo_message "seminar_manager"]</TD></TR>"} + "your_workspace" {return " + <TR><TD>[font_face_lower_left][ad_promo_message "your_workspace"]</TD></TR>"} + "agent_glossary" {return " + <TR><TD>[font_face_lower_left][library_submenu] </TD></TR><TR><TD>[ad_promo_message "library"]</TD></TR>"} + "cjtcs" {return " + <TR><TD>[font_face_lower_left][ad_promo_message "cjtcs"]</TD></TR><TR><TD>[ad_promo_message "library"]</TD></TR>"} + "jflp" {return " + <TR><TD>[font_face_lower_left][ad_promo_message "jflp"]</TD></TR><TR><TD>[ad_promo_message "library"]</TD></TR>"} + "neco" {return " + <TR><TD>[font_face_lower_left][ad_promo_message "neco"]</TD></TR><TR><TD>[ad_promo_message "library"]</TD></TR>"} + "jocn" {return " + <TR><TD>[font_face_lower_left][ad_promo_message "jocn"]</TD></TR><TR><TD>[ad_promo_message "library"]</TD></TR>"} + "li" {return " + <TR><TD>[font_face_lower_left][ad_promo_message "li"]</TD></TR><TR><TD>[ad_promo_message "library"]</TD></TR>"} + default {return "<TR><TD>[font_face_lower_left] </TD></TR>" + } + } +} + +# determines the help link URL by section + +proc ad_help_link {section} { + switch [string tolower $section] { + "library" {return "/bboard/q-and-a-one-category.tcl?topic=[ns_urlencode "CogNet HELP"]&category=[ns_urlencode "Library"]"} + "cjtcs" {return "/bboard/q-and-a-one-category.tcl?topic=[ns_urlencode "CogNet HELP"]&category=[ns_urlencode "Library"]"} + "jocn" {return "/bboard/q-and-a-one-category.tcl?topic=[ns_urlencode "CogNet HELP"]&category=[ns_urlencode "Library"]"} + "li" {return "/bboard/q-and-a-one-category.tcl?topic=[ns_urlencode "CogNet HELP"]&category=[ns_urlencode "Library"]"} + "neco" {return "/bboard/q-and-a-one-category.tcl?topic=[ns_urlencode "CogNet HELP"]&category=[ns_urlencode "Library"]"} + "vide" {return "/bboard/q-and-a-one-category.tcl?topic=[ns_urlencode "CogNet HELP"]&category=[ns_urlencode "Library"]"} + "agent_glossary" {return "/bboard/q-and-a-one-category.tcl?topic=[ns_urlencode "CogNet HELP"]&category=[ns_urlencode "Library"]"} + "poster" {return "/bboard/q-and-a-one-category.tcl?topic=[ns_urlencode "CogNet HELP"]&category=[ns_urlencode "Library"]"} +\ "proceeding" {return "/bboard/q-and-a-one-category.tcl?topic=[ns_urlencode "CogNet HELP"]&category=[ns_urlencode "Library"]"} + "almanac" {return "/bboard/q-and-a-one-category.tcl?topic=[ns_urlencode "CogNet HELP"]&category=[ns_urlencode "Library"]"} + "mitecs" {return "/bboard/q-and-a-one-category.tcl?topic=[ns_urlencode "CogNet HELP"]&category=[ns_urlencode "MITECS"]"} + "hotscience" {return "/bboard/q-and-a-one-category.tcl?topic=[ns_urlencode "CogNet HELP"]&category=[ns_urlencode "HotScience"]"} + "jobs" {return "/bboard/q-and-a-one-category.tcl?topic=[ns_urlencode "CogNet HELP"]&category=[ns_urlencode "Jobs"]"} + "forum" {return "/bboard/q-and-a-one-category.tcl?topic=[ns_urlencode "CogNet HELP"]&category=[ns_urlencode "The Forum"]"} + "seminar_manager" {return "/bboard/q-and-a-one-category.tcl?topic=[ns_urlencode "CogNet HELP"]&category=[ns_urlencode "Seminar Manager"]"} + "your_workspace" {return "/bboard/q-and-a-one-category.tcl?topic=[ns_urlencode "CogNet HELP"]&category=[ns_urlencode "Your Workspace"]"} + "mitecs" {return "/bboard/q-and-a-one-category.tcl?topic=[ns_urlencode "CogNet HELP"]&category=[ns_urlencode "MITECS"]"} + "bibliographies" {return "/bboard/q-and-a-one-category.tcl?topic=[ns_urlencode "CogNet HELP"]&category=[ns_urlencode "Bibliographies"]"} + "member_profiles" {return "/bboard/q-and-a-one-category.tcl?topic=[ns_urlencode "CogNet HELP"]&category=[ns_urlencode "Member Profiles"]"} + default {return "/bboard/q-and-a.tcl?topic=[ns_urlencode "CogNet HELP"]"} + } +} + +# this incorporates HTML designed by Ben (not adida, some other guy) + +proc ad_menu_header {{section ""} {uplink ""}} { + + set section [string tolower $section] + + # if it is an excluded directory, just return + set url_stub [ns_conn url] + set full_filename "[ns_info pageroot]$url_stub" + + + foreach naked_pattern [ad_naked_html_patterns] { + if [string match $naked_pattern $url_stub] { + # want the global admins with no menu, but not the domain admin + return "" + } + } + + # title is the title for the title bar + # section is the highlight for the menu + + + set menu_items [menu_items] + set java_script_p [java_script_capabilities] + + # Ben has a different table structure for netscape 3 + set netscape3_p [netscape3_browser] + set return_string "" + + if { $java_script_p } { + append return_string " + <script language=\"JavaScript\"> + //<!-- + + go = new Image(); + go.src = \"/graphics/go.gif\"; + go_h = new Image(); + go_h.src = \"/graphics/go_h.gif\"; + + up_one_level = new Image(); + up_one_level.src = \"/graphics/36_up_one_level.gif\"; + up_one_level_h = new Image(); + up_one_level_h.src = \"/graphics/36_up_one_level_h.gif\"; + + back_to_top = new Image(); + back_to_top.src = \"/graphics/24_back_to_top.gif\"; + back_to_top_h = new Image(); + back_to_top_h.src = \"/graphics/24_back_to_top_h.gif\"; + + help = new Image(); + help.src = \"/graphics/help.gif\"; + help_h = new Image(); + help_h.src = \"/graphics/help_h.gif\"; + + rules = new Image(); + rules.src = \"/graphics/rules.gif\"; + rules_h = new Image(); + rules_h.src = \"/graphics/rules_h.gif\";" + + foreach item $menu_items { + if { $item == [menu_highlight $section] } { + #this means the item was selected, so there are different gifs + append return_string " + $item = new Image(); + $item.src = \"/graphics/[set item]_a.gif\"; + [set item]_h = new Image(); + [set item]_h.src = \"/graphics/[set item]_ah.gif\";" + } else { + append return_string " + $item = new Image(); + $item.src = \"/graphics/[set item].gif\"; + [set item]_h = new Image(); + [set item]_h.src = \"/graphics/[set item]_h.gif\";" + } + + } + + # javascipt enabled + append return_string " + + function hiLite(imgObjName) \{ + document \[imgObjName\].src = eval(imgObjName + \"_h\" + \".src\") + \} + + function unhiLite(imgObjName) \{ + document \[imgObjName\].src = eval(imgObjName + \".src\") + \} + + function go_to_url(url) \{ + if (url \!= \"\") \{ + self.location=url; + \} + return; + \} + // --> + </SCRIPT>" + } else { + + append return_string " + + <script language=\"JavaScript\"> + //<!-- + + function hiLite(imgObjName) \{ + \} + + function unhiLite(imgObjName) \{ + \} + + function go_to_url(url) \{ + \} + // --> + </SCRIPT>" + } + + # We divide up the screen into 4 areas top to bottom: + # + The top table which is the cognet logo and search stuff. + # + The next table down is the CogNet name and area name. + # + The next area is either 1 large table with 2 sub-tables, or two tables (NS 3.0). + # The left table is the navigation table and the right one is the content. + # + Finally, the bottom table holds the bottom navigation bar. + + + append return_string "[ad_body_tag]" + + + if {$netscape3_p} { + append return_string "<IMG src=\"/graphics/top_left_brand.gif\" width=124 height=87 border=0 align=left alt=\"Cognet\"> +<TABLE border=0 cellpadding=3 cellspacing=0>" + } else { + append return_string " +<TABLE border=0 cellpadding=0 cellspacing=0 height=87 width=\"100%\" cols=100> + <TR><TD width=124 align=center><IMG src=\"/graphics/top_left_brand.gif\" width=124 height=87 border=0 alt=\"Cognet\"></TD> + <TD colspan=99><TABLE border=0 cellpadding=3 cellspacing=0 width=\"100%\">" + } + + append return_string " + <TR><TD height=16></TD></TR> + <TR valign=bottom><TD bgcolor=\"[table_background_1]\" align=left><FONT FACE=\"Arial, Helvetica, sans-serif\" size=5>Search</FONT></TD></TR> + <TR bgcolor=\"[table_background_1]\"><TD align=left valign=center><FORM action=\"/search-direct.tcl\" method=GET name=SearchDirect> + <SELECT name=section> + [ad_generic_optionlist [pretty_search_sections] [search_sections] [menu_search_highlight $section]] + </SELECT>   + <INPUT type=text value=\"\" name=query_string>  " + + + if {$netscape3_p} { + append return_string "<INPUT TYPE=submit VALUE=go>   + </FORM></TD></TR> + </TABLE>" + } else { + append return_string "<A href=\"JavaScript: document.SearchDirect.submit();\" onMouseOver=\"hiLite('go')\" onMouseOut=\"unhiLite('go')\" alt=\"search\"><img name=\"go\" src=\"/graphics/go.gif\" border=0 width=32 height=24 align=top alt=\"go\"></A> + </FORM></TD></TR> + </TABLE></TD> + </TR> +</TABLE>" + } + + append return_string " +<TABLE bgcolor=\"#000066\" border=0 cellpadding=0 cellspacing=0 height=36 width=\"100%\"> + <TR><TD align=left><A HREF=\"/\"><IMG src=\"/graphics/cognet.gif\" width=200 height=36 align=left border=0></A><IMG SRC=\"[menu_title_gif $section]\" ALIGN=TOP WIDTH=\"222\" HEIGHT=\"36\" BORDER=\"0\" HSPACE=\"6\" alt=\"$section\"></TD>" + + set uplevel_string "<TD align=right><A href=\"[menu_uplevel $section $uplink]\" onMouseOver=\"hiLite(\'up_one_level\')\" onMouseOut=\"unhiLite(\'up_one_level\')\"><img name=\"up_one_level\" src=\"/graphics/36_up_one_level.gif\" border=0 width=120 height=36 \" alt=\"Up\"></A></TD></TR>" + + foreach url_pattern [ad_no_uplevel_patterns] { + if [regexp $url_pattern $url_stub match] { + set uplevel_string "" + } + } + + append return_string $uplevel_string + append return_string "</TABLE>" + + if {$netscape3_p} { + append return_string "<TABLE border=0 cellpadding=0 cellspacing=0 width=200 align=left>" + } else { + append return_string "<TABLE border=0 cellpadding=0 cellspacing=0 width=\"100%\" cols=100> + <TR valign=top><TD width=200 bgcolor=\"[table_background_1]\"> + <TABLE border=0 cellpadding=0 cellspacing=0 width=200>" + } + + +# Navigation Table + + foreach item $menu_items { + if { $item == [menu_highlight $section] } { + append return_string "<TR><TD valign=bottom height=25 width=200 bgcolor=\"#FFFFFF\"><A href=\"[menu_url $item]\" onMouseOver=\"hiLite('[set item]')\" onMouseOut=\"unhiLite('[set item]')\"><img name=\"[set item]\" src=\"/graphics/[set item]_a.gif\" border=0 width=200 height=25 alt=\"$item\"></A></TD></TR>" + } else { + append return_string "<TR><TD valign=bottom height=25 width=200 bgcolor=\"#FFFFFF\"><A href=\"[menu_url $item]\" onMouseOver=\"hiLite('[set item]')\" onMouseOut=\"unhiLite('[set item]')\"><img name=\"[set item]\" src=\"/graphics/[set item].gif\" border=0 width=200 height=25 alt=\"$item\"></A></TD></TR>" + } + } + + + append return_string " + <TR bgcolor=\"[table_background_1]\" valign=top align=left><TD width=200> + <TABLE border=0 cellpadding=4 cellspacing=0 width=200> + <!-- NAVIGATION BAR CONTENT GOES AFTER THIS START COMMENT USING TABLE Row and Data open and close tags --> + [menu_subsection $section] + <!-- NAVIGATION BAR CONTENT GOES BEFORE THIS END COMMENT --> + </TABLE></TD></TR> + </TABLE>" + + if {$netscape3_p} { + append return_string "<TABLE border=0 cellpadding=4 cellspacing=12>" + } else { + append return_string " + </TD><TD valign=top align=left colspan=99><TABLE border=0 cellpadding=4 cellspacing=12 width=\"100%\">" + } + append return_string "<TR><TD>" +} + +proc ad_menu_footer {{section ""}} { + + # if it is an excluded directory, just return + set url_stub [ns_conn url] + set full_filename "[ns_info pageroot]$url_stub" + + foreach naked_pattern [ad_naked_html_patterns] { + if [string match $naked_pattern $url_stub] { + return "" + } + } + + set netscape3_p 0 + + if {[netscape3_browser]} { + set netscape3_p 1 + } + + append return_string "</TD></TR></TABLE>" + + # close up the table + if {$netscape3_p != 1} { + append return_string "</TD></TR> + </TABLE>" + } + + # bottom bar + + append return_string " + <TABLE border=0 cellpadding=0 cellspacing=0 height=24 width=\"100%\"> + <TR bgcolor=\"#000066\"><TD align=left valign=bottom><A href=#top onMouseOver=\"hiLite('back_to_top')\" onMouseOut=\"unhiLite('back_to_top')\"><img name=\"back_to_top\" src=\"/graphics/24_back_to_top.gif\" border=0 width=200 height=24 alt=\"top\"></A></TD> + <TD align=right valign=bottom><A href=\"[ad_parameter GlobalURLStub "" "/global"]/rules.tcl\" onMouseOver=\"hiLite('rules')\" onMouseOut=\"unhiLite('rules')\"><img name=\"rules\" src=\"/graphics/rules.gif\" border=0 width=96 height=24 valign=bottom alt=\"rules\"></A><A href=\"[ad_help_link $section]\" onMouseOver=\"hiLite('help')\" onMouseOut=\"unhiLite('help')\"><img name=\"help\" src=\"/graphics/help.gif\" border=0 width=30 height=24 align=bottom alt=\"help\"></A></TD></TR> + </TABLE>" + return $return_string +} + + + + Index: web/openacs/tcl/ad-new-stuff.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-new-stuff.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-new-stuff.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,255 @@ +# ad-new-stuff.tcl,v 3.0.4.1 2000/04/11 16:19:39 carsten Exp +# +# ad-new-stuff.tcl +# +# by philg@mit.edu on July 4, 1999 +# (spending the holiday engaged in the typical American +# Revolutionary activity of Tcl programming, which drove +# out the effete British computer scientists) +# + +# the big idea here is to have a central facility to look at content +# posted by users across the entire site. This is useful for the site +# administrator (might want to delete stuff). This is useful for the +# surfing user (might want to click through to stuff). This is useful +# for generating email summaries. + +# one weird extra feature is that we have an argument to limit to new +# content posted by new users. This is an aid to moderators. Basically +# the idea is that new content posted by a person who has been a community +# member for a year is unlikely to require deletion. But new content +# posted by a brand new community member is very likely to require scrutiny +# since the new user may not have picked up on the rules and customs +# of the community. + +# (publishers who require approval before content goes live will want +# to see old users' contributions highlighted as well since these need +# to be approved quickly) + +# this system scales as modules are added to the ACS either by +# ArsDigita or publishers. The basic mechanism by which modules buy +# into this system is to lappend a data structure to the ns_share +# variable ad_new_stuff_module_list (a Tcl list) + +# each element of this list is itself a list. Here's the data +# structure for the sublist: +# module_name proc_name + +util_report_library_entry + +proc ad_new_stuff_sort_by_length {string1 string2} { + if { [string length $string1] < [string length $string2] } { + return -1 + } else { + return 1 + } +} + +proc_doc ad_new_stuff {db {since_when ""} {only_from_new_users_p "f"} {purpose "web_display"}} "Returns a string of new stuff on the site. SINCE_WHEN is an ANSI date. If ONLY_FROM_NEW_USERS_P is \"t\" then we only look at content posted by users in the USERS_NEW view. The PURPOSE argument can be \"web_display\" (intended for an ordinary user), \"site_admin\" (to help the owner of a site nuke stuff), or \"email_summary\" (in which case we get plain text back). These arguments are passed down to the procedures on the ns_share'd ad_new_stuff_module_list." { + # let's default the date if we didn't get one + if [empty_string_p $since_when] { + set since_when [database_to_tcl_string $db "select sysdate()-1 from dual"] + } + ns_share ad_new_stuff_module_list + set result_list [list] + foreach sublist $ad_new_stuff_module_list { + set module_name [lindex $sublist 0] + set module_proc [lindex $sublist 1] + set result_elt "" + if [catch { set subresult [eval "$module_proc $db $since_when $only_from_new_users_p $purpose"] } errmsg ] { + # got an error, let's continue to the next iteration + ns_log Warning "$module_proc, called from ad_new_stuff, returned an error:\n$errmsg" + continue + } + if ![empty_string_p $subresult] { + # we got something, let's write a headline + if { $purpose == "email_summary" } { + append result_elt "[string toupper $module_name]\n\n" + } else { + append result_elt "<h3>$module_name</h3>\n\n" + } + append result_elt "$subresult" + append result_elt "\n\n" + lappend result_list $result_elt + } + } + # we've got all the results, let's sort by size + set sorted_list [lsort -command ad_new_stuff_sort_by_length $result_list] + return [join $sorted_list ""] +} + +# now let's define new stuff procs for all the random parts of the +# system that don't have their own defs files or aren't properly +# considered modules + +ns_share ad_new_stuff_module_list + +if { ![info exists ad_new_stuff_module_list] || [util_search_list_of_lists $ad_new_stuff_module_list "Related Links" 0] == -1 } { + lappend ad_new_stuff_module_list [list "Related Links" ad_related_links_new_stuff] +} + + +proc_doc ad_related_links_new_stuff {db since_when only_from_new_users_p purpose} "Only produces a report for the site administrator; the assumption is that random users won't want to see out-of-context links" { + if { $purpose != "site_admin" } { + return "" + } + if { $only_from_new_users_p == "t" } { + set users_table "users_new" + } else { + set users_table "users" + } + set query "select links.link_title, links.link_description, links.url, links.status, posting_time, +ut.user_id, first_names || ' ' || last_name as name, links.url, sp.page_id, sp.page_title, sp.url_stub +from static_pages sp, links, $users_table ut +where sp.page_id (+) = links.page_id +and ut.user_id = links.user_id +and posting_time > '$since_when' +order by posting_time desc" + set result_items "" + set selection [ns_db select $db $query] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + append result_items "<li>[util_AnsiDatetoPrettyDate $posting_time]: +<a href=\"$url\">$link_title</a> " + if { $status != "live" } { + append result_items "(<font color=red>$status</font>)" + } + append result_items "- $link_description +<br> +-- +posted by <a href=\"/admin/users/one.tcl?user_id=$user_id\">$name</a> +on <a href=\"/admin/static/page-summary.tcl?page_id=$page_id\">$url_stub</a> +  +\[ +<a target=working href=\"/admin/links/edit.tcl?[export_url_vars url page_id]\">edit</a> | +<a target=working href=\"/admin/links/delete.tcl?[export_url_vars url page_id]\">delete</a> | +<a target=working href=\"/admin/links/blacklist.tcl?[export_url_vars url page_id]\">blacklist</a> +\] +<p> +" + } + if { ![empty_string_p $result_items] } { + return "<ul>\n\n$result_items\n</ul>\n" + } else { + return "" + } +} + +ns_share ad_new_stuff_module_list + +if { ![info exists ad_new_stuff_module_list] || [util_search_list_of_lists $ad_new_stuff_module_list "Comments on Static Pages" 0] == -1 } { + lappend ad_new_stuff_module_list [list "Comments on Static Pages" ad_comments_on_static_new_stuff] +} + + +proc_doc ad_comments_on_static_new_stuff {db since_when only_from_new_users_p purpose} "Produces a report for the site administrator and also a compressed version for random surfers and email summary recipients" { + if { $only_from_new_users_p == "t" } { + set users_table "users_new" + } else { + set users_table "users" + } + set n_bytes_to_show 750 + set query "select comments.comment_id, length(comments.message) as n_message_bytes, substr(comments.message,0,$n_bytes_to_show) as message_intro, comments.rating, comments.comment_type, posting_time, comments.originating_ip, users.user_id, first_names || ' ' || last_name as name, comments.page_id, sp.url_stub, sp.page_title, coalesce(sp.page_title,sp.url_stub) as page_title_anchor, client_file_name, html_p, file_type, original_width, original_height, caption +from static_pages sp, comments_not_deleted comments, $users_table users +where sp.page_id = comments.page_id +and users.user_id = comments.user_id +and posting_time > '$since_when' +order by comment_type, posting_time desc" + set result_items "" + set last_comment_type "" + set selection [ns_db select $db $query] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $n_message_bytes > $n_bytes_to_show } { + set ellipses " ..." + } else { + set ellipses "" + } + # truncation within Oracle might have left open HTML tags; let's close them + set message_intro_cleaned "[util_close_html_tags $message_intro]$ellipses" + switch $purpose { + web_display { + if { $comment_type == "alternative_perspective" } { + append result_items "<li>by <a href=\"/shared/community-member.tcl?[export_url_vars user_id]\">$name</a> +on <a href=\"$url_stub\">$page_title_anchor</a>: +<blockquote> +[format_static_comment $comment_id $client_file_name $file_type $original_width $original_height $caption $message_intro_cleaned $html_p] +</blockquote> +" + } + } + site_admin { + if { $comment_type != $last_comment_type } { + append result_items "<h4>$comment_type</h4>\n" + set last_comment_type $comment_type + } + append result_items "<li>[util_AnsiDatetoPrettyDate $posting_time]: " + if { ![empty_string_p $rating] } { + append result_items "$rating -- " + } + append result_items "[format_static_comment $comment_id $client_file_name $file_type $original_width $original_height $caption $message_intro_cleaned $html_p] +<br> +-- <a href=\"/admin/users/one.tcl?user_id=$user_id\">$name</a> +from $originating_ip +on <a href=\"/admin/static/page-summary.tcl?[export_url_vars page_id]\">$url_stub</a>" + if ![empty_string_p $page_title] { + append result_items " ($page_title) " + } + append result_items "    <a href=\"/admin/comments/persistent-edit.tcl?[export_url_vars comment_id]\" target=working>edit</a>     <a href=\"/admin/comments/delete.tcl?[export_url_vars comment_id page_id]\" target=working>delete</a> +<p> +" + } + email_summary { + if { $comment_type == "alternative_perspective" } { + # make sure to have space after URL so mail REGEXPs will offer users hyperlinks + append result_items "by $name on [ad_url]$url_stub : +[wrap_string [ns_striphtml $message_intro]]$ellipses + +----- +" + } + } + } + } + # we have the result_items or not + if { $purpose == "email_summary" } { + return $result_items + } elseif { ![empty_string_p $result_items] } { + return "<ul>\n\n$result_items\n</ul>\n" + } else { + return "" + } + +} + +ns_share ad_new_stuff_module_list + +if { ![info exists ad_new_stuff_module_list] || [util_search_list_of_lists $ad_new_stuff_module_list "Users" 0] == -1 } { + lappend ad_new_stuff_module_list [list "Users" ad_users_new_stuff] +} + + +proc_doc ad_users_new_stuff {db since_when only_from_new_users_p purpose} "Produces a report for the site administrator; nothing for random surfers and email summary recipients" { + if { $purpose != "site_admin" } { + return "" + } + set n_new [database_to_tcl_string $db "select count(*) from users where registration_date > '$since_when'"] + if { $n_new == 0 } { + return "" + } elseif { $n_new < 10 } { + # let's display the new users in-line + set result_items "" + set selection [ns_db select $db "select user_id, first_names, last_name, email from users where registration_date > '$since_when'"] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + append result_items "<li><a href=\"/admin/users/one.tcl?[export_url_vars user_id]\">$first_names $last_name</a> ($email)\n" + } + return "<ul>\n\n$result_items\n</ul>\n" + } else { + # lots of new users + return "<ul>\n<li><a href=\"/admin/users/action-choose.tcl?registration_after_date=[ns_urlencode $since_when]\">$n_new new users</a>\n</ul>\n" + } +} + +util_report_successful_library_load + Index: web/openacs/tcl/ad-partner-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-partner-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-partner-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,563 @@ +# +# /tcl/ad-partner.tcl +# +# system to manage site-wide templates with very little +# intrustion to the programmer or the tcl environment. +# Requires programmers to manage and make changes to the +# templates (as opposed to a content management system +# where the client can do the changes) +# +# created by mbryzek 12/1/99, adapted originally from +# guidestar.org +# +# ad-partner-defs.tcl,v 3.2.2.1 2000/03/18 01:19:22 tzumainn Exp +# + +util_report_library_entry + +# We need to tell AOLServer to set cookies for our partners +proc_doc ad_partner_initialize {} "Registers every url_stub from ad_partner_url as a url" { + + # if for some reason, we can't get a db handle, what cookies do we still + # need to register? + set list_of_cookies_to_register [list] + + if { [catch {set db [ns_db gethandle subquery]} err_msg] } { + ns_log Notice "ad-partner: Can't get db handle. Using list_of_cookies to register cookies" + } else { + set sub_selection [ns_db select $db "select distinct partner_cookie from ad_partner"] + + while { [ns_db getrow $db $sub_selection] } { + set_variables_after_subquery + if {[lsearch -exact $list_of_cookies_to_register $partner_cookie] == -1} { + lappend list_of_cookies_to_register $partner_cookie + } + } + + ns_db releasehandle $db + } + + foreach partner_cookie $list_of_cookies_to_register { + ns_register_proc GET /$partner_cookie/* ad_set_partner_cookie + ns_register_proc POST /$partner_cookie/* ad_set_partner_cookie + ns_log Notice "Registered partner cookie: $partner_cookie" + } + +} + +ad_schedule_proc -once t 2 ad_partner_initialize + +proc_doc ad_partner_from_cookie {} "Returns name of template or empty string from the ad_partner cookie " { + set headers [ns_conn headers] + set cookie [ns_set get $headers Cookie] + if { [regexp {ad_partner=([^;]+)} $cookie {} template_name] && ![empty_string_p $template_name] && [string compare $template_name "expired"] != 0 } { + return $template_name + } else { + return [ad_parameter CookieDefault partner] + } + +} + +proc_doc ad_get_partner_query {{var_list partner_id} {partner ""}} "Returns the selection from the gs_partner table for the current partner and url. Selection includes all vars in var_list (default is just partner_id)" { + if { [empty_string_p $partner] } { + set partner [ad_partner_from_cookie] + } + set url [ns_conn url] + # The partner site would be the phrase between the first and second slash + # Note that the first slash has been removed + set stub "/[lindex [split $url "/"] 1]" + set stub [string trim $stub] + set sql_vars "" + foreach var $var_list { + if { ![empty_string_p $sql_vars] } { + append sql_vars ", " + } + append sql_vars "partner.$var" + } + return "select $sql_vars + from ad_partner partner, ad_partner_url url + where partner.partner_id=url.partner_id + and url.url_stub='[DoubleApos $stub]' + and partner.partner_cookie='[DoubleApos [string trim $partner]]'" + +} + + +proc_doc ad_partner_get_stub {} "Returns the url stub for the ad_partner table. No trailing slash and final script name removed" { + set url [ns_conn url] + # remove the final slash and filename + regexp {(.*)/[^/]*$} $url {} stub + if { [info exists stub] && ![empty_string_p $stub] } { + return $stub + } + return "/" +} + + +proc_doc ad_partner_default_divider {} {Returns the default divider we use in strings that represent lists} { + return "\253" +} + +proc_doc ad_partner_memoize_one { sql_query var } {Wrapper for ad_partner_memoize_list_from_db that lets us easily memoize a query that returns one thing} { + return [lindex [ad_partner_memoize_list_from_db $sql_query [list $var]] 0] +} + +proc_doc ad_partner_memoize_list_from_db { sql_query var_list {divider ""} {also_memoize_as ""} } {Allows you to memoize database queries without having to grab a db handle first. If the query you specified is not in the cache, this proc grabs a db handle, and memoizes a list, separated by divider inside the cache, of the results. Your calling proc can then process this list as it normally. Each var in var_list is simply appended as a single element to the list that is eventually returned.} { + ns_share ad_partner_memoized_lists + + set str "" + if { [empty_string_p $divider] } { + # Users probably will never have this character (we hope) + set divider [ad_partner_default_divider] + } + + if { [info exists ad_partner_memoized_lists($sql_query)] } { + set str $ad_partner_memoized_lists($sql_query) + } else { + set db [ns_db gethandle subquery] + set selection [ns_db select $db $sql_query] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + foreach var $var_list { + if { ![empty_string_p $str] } { + append str $divider + } + append str [expr $$var] + } + } + ns_db releasehandle $db + set ad_partner_memoized_lists($sql_query) $str + } + if { ![empty_string_p $also_memoize_as] } { + set ad_partner_memoized_lists($also_memoize_as) $str + } + return [split $str $divider] +} + + +proc_doc ad_partner_shorten_url_stub {stub } {Pulls off the last directory in the specified stub (e.g. /volunteer/register --> /volunteer} { + if { [empty_string_p $stub] || [string compare $stub "/"] == 0 } { + return "" + } + set stub_pieces [split $stub "/"] + set length [llength $stub_pieces] + set new_stub "" + for { set i 0 } { $i < [expr $length - 1] } { incr i } { + if { ![empty_string_p [lindex $stub_pieces $i]] } { + append new_stub "/[lindex $stub_pieces $i]" + } + } + # ns_log Notice "Shortening $stub to $new_stub" + + # We must have started with a directory name (e.g. /volunteer) in which + # case / is the parent + if { [empty_string_p $new_stub] } { + return "/" + } + return $new_stub +} + + +proc_doc ad_partner_procs { table {partner ""} } {Returns all procs from $table for the current partner. Memoizes the procs so we don't hit the db constantly for each partner} { + if { [empty_string_p $partner] } { + set partner [ad_partner_from_cookie] + } + set stub [ad_partner_get_stub] + + set original_query "" + set query_list [list] + # Shorten the url stub until we find a hit or run out of url stubs! + # This is slow, but tcl is simpler and we memoize the result anyway + while { 1 } { + # ns_log Notice "Looking for procs that match stub: $stub" + set query "select procs.proc_name + from ad_partner partner, ad_partner_url url, $table procs + where partner.partner_id=url.partner_id + and procs.url_id=url.url_id + and url.url_stub='[DoubleApos $stub]' + and partner.partner_cookie='[DoubleApos [string trim $partner]]'" + if { [empty_string_p $original_query] } { + set original_query $query + } + # ns_log Notice "Memoizing $query" + set query_list [ad_partner_memoize_list_from_db $query [list proc_name]] + # ns_log Notice "QUERY LIST IS $query_list" + if { [llength $query_list] > 0 } { + break + } + set stub [ad_partner_shorten_url_stub $stub] + if { [empty_string_p $stub] } { + break; + } + } + + if { [string compare $original_query $query] != 0 } { + ad_partner_memoize_list_from_db $query [list proc_name] [ad_partner_default_divider] $original_query + } + + + # we check to be sure the current partner has some procedures + # registered for the requested url. If not, we use the templates + # for the default partner + if { [llength $query_list] == 0 } { + set default [ad_parameter CookieDefault partner] + if { (![empty_string_p $default]) && ([string compare $partner $default] != 0) } { + return [ad_partner_procs $table $default] + } + } + return $query_list +} + + +proc_doc ad_get_partner_procs { db table } {Returns all procs from $table for the current partner. Memoizes the procs so we don't hit the db constantly for each partner} { + return [ad_partner_procs $table] +} + +proc_doc ad_get_footer_procs { {db ""} } {Returns a list of all the footer procs to call for the curre +nt section} { + return [ad_partner_procs "ad_partner_footer_procs"] +} + +proc_doc ad_get_header_procs { {db ""} } {Returns a list of all the header procs to call for the curre +nt section} { + return [ad_partner_procs "ad_partner_header_procs"] +} + + +proc ad_partner_header { {cookie "" } } { + set proc_list [ad_partner_procs "ad_partner_header_procs" $cookie] + set header "" + foreach proc_name $proc_list { + append header [$proc_name] + } + return $header +} + +proc ad_get_partner_header { {db ""} } { + return [uplevel { ad_partner_header }] +} + +proc ad_partner_footer { {cookie "" } } { + set proc_list [ad_partner_procs "ad_partner_footer_procs" $cookie] + set footer "" + foreach proc_name $proc_list { + append footer [$proc_name] + } + return $footer +} + +proc ad_get_partner_footer { {db ""} } { + return [uplevel { ad_partner_footer }] +} + + + +proc_doc ad_partner_return_error { page_title {page_body ""} } {Like the normal ad_return_error except it uses partner headers and footers} { + ns_return 200 text/html [ad_partner_return_template] + return -code return +} + + +proc_doc ad_partner_var { var {db ""} {force 0} {cookie ""} } {Caches and returns the value of the specified var for the current partner.} { + if { [empty_string_p $cookie] } { + set cookie [ad_partner_from_cookie] + } + + ns_share ad_partner_cache + + set varname "${cookie}_$var" + + if { $force || ![info exists ad_partner_cache($varname)] } { + # ns_log Notice "GOING TO THE DATBASE FOR $cookie:$var" + + # var_list is a list of all the variables we want to grab from the database and + # cache for the lifetime of the current server process + set var_list [ad_partner_list_all_var_names] + + set sql "select [join $var_list ", "] + from ad_partner + where partner_cookie='[DoubleApos $cookie]'" + + if { [empty_string_p $db] } { + set db [ns_db gethandle subquery] + set sub_selection [ns_db 0or1row $db $sql] + if { [empty_string_p $sub_selection] } { + ns_db releasehandle $db + return "" + } + set_variables_after_subquery + ns_db releasehandle $db + } else { + set selection [ns_db 0or1row $db $sql] + if { [empty_string_p $selection] } { + return "" + } + set_variables_after_query + } + + foreach v $var_list { + set ad_partner_cache(${cookie}_$v) "[expr "$$v"]" + } + + # Make sure we got the desired value from the database + if { ![info exists ad_partner_cache($varname)] } { + ad_return_error "Cannot find $varname" "Missing or mistaken partner variable name" + return -code return + } + } + return $ad_partner_cache($varname) +} + + +proc_doc ad_partner_var_or_default { var } {Returns the specified variable for the current parter, unless it's the empty string in which case it returns the variable for the cobrandsitedefault} { + set value [ad_partner_var $var] + if { ![empty_string_p $value] } { + return $value + } + return [ad_partner_var $var "" 0 [ad_parameter CookieDefault partner]] +} + + +proc_doc ad_partner_default_font { {props ""} } {Returns an html font tag with the default font face and default font color filled in from the partner database. If props is nonempty, it is simply included in the font statement} { + + set face [ad_partner_var default_font_face] + set color [ad_partner_var default_font_color] + return [ad_partner_format_font $face $color $props] +} + + + +proc_doc ad_partner_title_font { {props ""} } {Returns an html font tag with the default font face and default font color filled in from the partner database. If props is nonempty, it is simply included in the font statement} { + set face [ad_partner_var title_font_face] + set color [ad_partner_var title_font_color] + return [ad_partner_format_font $face $color $props] +} + + +proc_doc ad_partner_format_font { face color props } {Returns a <font html tag based on the parameters passed, using only the non-empty ones} { + set html "" + if { ![empty_string_p $face] } { + append html " face=\"$face\"" + } + if { ![empty_string_p $color] } { + append html " color=\"$color\"" + } + if { ![empty_string_p $props] } { + append html " $props" + } + if { [empty_string_p $html] } { + return "" + } + return "<font$html>" +} + + +proc_doc ad_partner_url_with_query { { url "" } } {Returns the current url (or the one specified) with all queries correctly attached} { + if { [empty_string_p $url] } { + set url [ns_conn url] + } + set query [export_ns_set_vars url] + if { ![empty_string_p $query] } { + append url "?$query" + } + return $url +} + +### We have a couple procs that set up and remove cookies for partners + +proc_doc ad_set_partner_cookie { } "Sets a cookie based on the current url to create proper look-and-feel templates, redirecting to the normal guidestar page. If you specify a force_return_url, the cookie is set and the user is returned to that url." { + set current_cookie [ad_partner_from_cookie] + set url [ad_partner_url_with_query] + # Remove leading slash if any + regsub "^/" $url "" url + # The partner site would be the phrase between the first and second slash + set stub [lindex [split $url "/"] 0] + # Try the greedy regsub first + if {! [regsub "$stub/" $url "" return_url] } { + regsub "$stub" $url "" return_url + } + if { [empty_string_p $return_url] } { + set return_url / + } + ns_returnredirect "/cookie-chain.tcl?cookie_name=[ns_urlencode ad_partner]&cookie_value=[ns_urlencode $stub]&expire_state=s&final_page=[ns_urlencode $return_url]" + return -code return +} + + +proc_doc ad_partner_return_template {} {Adds the partner header and footer around the string page_body or page_content that is defined in the calling environment} { + uplevel { + return " +[ad_partner_header] +[value_if_exists page_body] +[value_if_exists page_content] +[ad_partner_footer] +" + } +} + + +proc ad_partner_upvar { var {levels 2} } { + incr levels + set return_value "" + for { set i 1 } { $i <= $levels } { incr i } { + catch { + upvar $i $var value + if { ![empty_string_p $value] } { + set return_value $value + return $return_value + } + } err_msg + } + return $return_value +} + +proc_doc ad_partner_list_all_var_names {} {Returns a list of just the variable names that we are collecting. This is good when doing inserts/updates.} { + set all_pairs [ad_partner_list_all_vars] + set var_names [list] + foreach pair $all_pairs { + lappend var_names [lindex $pair 0] + } + return $var_names +} + + +proc_doc ad_partner_list_all_vars {} {Returns a list of pairs. Each pair is <English text> <variable name> where variable_name is one of the variables in the ad_partner table. This is great for simple text fields} { + + # we could use ad_parameter_section (defined in ad-defs.tcl) + # but don't want to rely on it being defined already, so we get + # the .ini section directly + + set server_name [ns_info server] + set config_path "" + append config_path "ns/server/" $server_name "/acs/partner" + set ad_partner_vars [ns_configsection $config_path] + + ns_log Notice "/tcl/ad-partner.tcl has found [ns_set size $ad_partner_vars] variables (specified in $config_path)" + + set var_list [list] + # now we have an ns_set of all the specs + for {set i 0} {$i<[ns_set size $ad_partner_vars]} {incr i} { + set key [ns_set key $ad_partner_vars $i] + if { [string compare $key "Variable"] == 0 } { + set value [ns_set value $ad_partner_vars $i] + lappend var_list [split $value "|"] + } + } + + return $var_list + +} + +proc_doc ad_reset_partner_cookie { { return_url "/" } } "Resets ad_partner cookie and redirects to the specified url" { + ns_returnredirect "/cookie-chain.tcl?cookie_name=[ns_urlencode ad_partner]&final_page=[ns_urlencode $return_url]" + return -code return +} + + + +proc_doc ad_partner_verify_cookie { {redirect_if_not_logged_in 0 } } {Makes sure the user's appropriate cookie is set and if not, redirects to the same page to set the cookie. A special flag is set so we avoid an infinite loop when someone's cookies are off} { + # ns_log Notice "ad_partner_verify_cookie: starting" + set return_url "[ns_conn url]?c=1" + set query [export_ns_set_vars url] + if { ![empty_string_p $query] } { + append return_url "&$query" + } + set user_id [ad_get_user_id] + # ns_log Notice "USER ID: $user_id" + if { $user_id == 0 } { + # We wouldn't know how to set the cookie without a user id! + if { $redirect_if_not_logged_in } { + ns_returnredirect /register/index.tcl?[export_url_vars return_url] + return -code return + } else { + return + } + } + set partner_cookie [ad_partner_from_cookie] + # ns_log NOTICE "COOKIE: $partner_cookie" + if { [empty_string_p $partner_cookie] || \ + [string compare $partner_cookie [ad_parameter CookieDefault partner]] == 0 \ + || [string compare $partner_cookie "expired"] == 0 } { + set form_setid [ns_getform] + if { [empty_string_p $form_setid] } { + set c 0 + } else { + set c [ns_set get $form_setid c] + } + if { $c == 1 } { + ad_return_error "Your cookies are turned off" "You must turn on your cookies to use this site. Sorry for the inconvenience" + return -code return + } + set db [ns_db gethandle subquery] + set cookie [ad_partner_cookie_from_user_id $db $user_id] + ns_db releasehandle $db + ns_returnredirect "/$cookie$return_url" + return -code return + } +} + + +proc_doc ad_partner_group_id_from_cookie { { cookie "" } } {Returns the group id for the specified partner cookie or for the cookie in the user's cookies. Memoizes the result.} { + if { [empty_string_p $cookie] } { + set cookie [ad_partner_from_cookie] + } + return [lindex [ad_partner_memoize_list_from_db \ + "select group_id + from ad_partner + where partner_cookie='[DoubleApos $cookie]'" [list group_id]] 0] +} + + +proc_doc ad_partner_cookie_select { {sel ""} {name partner_cookie} } {Returns an html select box to select a cookie based on partner_name} { + set var_list [ad_partner_memoize_list_from_db \ + "select partner_cookie, partner_name + from ad_partner + order by lower(partner_name)" [list partner_cookie partner_name]] + set inner [list ""] + set outer [list "-- Please Select --"] + for { set i 0 } { $i < [llength $var_list] } { set i [expr $i + 2] } { + lappend inner [lindex $var_list $i] + lappend outer [lindex $var_list [expr $i + 1]] + } + return " +<select [export_form_value name]> +[ad_generic_option_list $outer $inner $sel] +</select> +" +} + + + +# Now we define some generic header and footer procedures +# that can be used to set-up the generic ArsDigita look and feel +proc_doc ad_partner_generic_header { {page_title ""} {extra_stuff_for_document_head ""} } {writes HEAD, TITLE, and BODY tags to start off pages in a consistent fashion} { + if { [empty_string_p $page_title] } { + # If we didn't get a title as an argument, look for it in the calling environment + set page_title [ad_partner_upvar page_title] + } + if { [empty_string_p $extra_stuff_for_document_head] } { + # look for it in the calling environment + set extra_stuff_for_document_head [ad_partner_upvar extra_stuff_for_document_head] + } + set context_bar [ad_partner_upvar context_bar] + set html " +[ad_header $page_title $extra_stuff_for_document_head] +[ad_partner_default_font] +<h2>$page_title</h2> +$context_bar +<hr> +" + return $html +} + +proc_doc ad_partner_generic_footer {} {Wrapper for ad_footer} { + set signatory [ad_partner_upvar signatory] + set suppress_curriculum_bar_p [ad_partner_upvar suppress_curriculum_bar_p] + if [empty_string_p $suppress_curriculum_bar_p] { + set suppress_curriculum_bar_p 0 + } + return "[ad_footer $signatory $suppress_curriculum_bar_p]</font>" +} + + +util_report_successful_library_load \ No newline at end of file Index: web/openacs/tcl/ad-pics.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-pics.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-pics.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,30 @@ +# ad-pics.tcl,v 3.1 2000/02/26 12:55:27 jsalz Exp +# ad-pics.tcl +# created by philg on 11/20/98 +# +# writes PICS headers on naughty site content +# (as spec'd in /web/yourdomain/parameters/ad.ini file, +# /acs/pics section) + +ns_share -init {set ad_pics_filters_installed_p 0} ad_pics_filters_installed_p + +if { !$ad_pics_filters_installed_p && [ad_parameter EnabledP pics 0]} { + # we haven't registered the filters and PICS is enabled + set ad_pics_filters_installed_p 1 + set pics_config_section [ad_parameter_section pics] + for {set i 0} {$i<[ns_set size $pics_config_section]} {incr i} { + if { [ns_set key $pics_config_section $i] == "NaughtyPattern" } { + set path_pattern [ns_set value $pics_config_section $i] + ns_log Notice "Adding the PICS header filter for \"$path_pattern\"" + ad_register_filter postauth GET $path_pattern ad_pics_filter + } + } +} + + +proc ad_pics_filter {conn args why} { + set headers [ns_conn outputheaders $conn] + ns_set update $headers Protocol [ad_parameter Protocol pics] + ns_set update $headers PICS-Label [ad_parameter Label pics] + return filter_ok +} Index: web/openacs/tcl/ad-read-only.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-read-only.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-read-only.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,34 @@ +# ad-read-only.tcl,v 3.0 2000/02/06 03:12:39 ron Exp +# This page is for making the system read-only for maintenance +# purposes (i.e., if you're building a new Oracle installation +# and don't want users putting in orders, comments, etc., that +# will be lost once you switch over to the new Oracle) + +# THIS PROC decides whether the data base is in +# read-only mode. + +proc ad_read_only_p {} { + # return 1 if you want the system to stop accepting user input + # look in /web/yourdomain/parameters/ad.ini or return 0 if not found + return [ad_parameter ReadOnlyP "" 0] +} + +# This proc is called to generate +# the error message that explains what's up. +proc ad_return_read_only_maintenance_message {} { + ns_return 200 text/html "[ad_header "System Maintenance"] + +<h2>We're Maintaining the Database</h2> +<hr> + +We're sorry, but anything that you add to our database right now would +be lost. We'll be finished maintaining the database and expect the +system to be back up and running + +<blockquote> +<strong>Monday, September 14th, 3:00 am (Eastern Time)</strong> +</blockquote> +<p> +[ad_footer] +" +} Index: web/openacs/tcl/ad-redirect.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-redirect.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-redirect.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,74 @@ +# ad-redirect.tcl,v 3.2 2000/03/11 02:15:52 michael Exp +# ad-redirect.tcl by philg@mit.edu January 23, 1999 + +# parse the redirect section in the ad.ini file +# and register redirects accordingly +# this is documented in /doc/redirect.html + +# we don't want to run this multiple times, so let's register an ns_share + +ns_share -init {set ad_redirects_installed_p 0} ad_redirects_installed_p + +if !$ad_redirects_installed_p { + # we haven't done this already + set ad_redirects_installed_p 1 + + # we could use ad_parameter_section (defined in ad-defs.tcl) + # but don't want to rely on it being defined already, so we get + # the .ini section directly + set server_name [ns_info server] + append config_path "ns/server/" $server_name "/acs/redirect" + set all_the_redirects [ns_configsection $config_path] + ns_log Notice "/tcl/ad-redirect.tcl has found [ns_set size $all_the_redirects] redirects specified in $config_path" + # now we have an ns_set of all the specs + for {set i 0} {$i<[ns_set size $all_the_redirects]} {incr i} { + set key [ns_set key $all_the_redirects $i] + set value [ns_set value $all_the_redirects $i] + set pair [split $value "|"] + set from [lindex $pair 0] + set to [lindex $pair 1] + if { $key == "Inherit" } { + ns_log Notice "/tcl/ad-redirect.tcl will send anything underneath \"$from\" to \"$to\"" + ns_register_proc GET $from ns_returnredirect $to + } elseif { $key == "JustOne" } { + ns_log Notice "/tcl/ad-redirect.tcl will send \"$from\" to \"$to\"" + ns_register_proc -noinherit GET $from ns_returnredirect $to + } elseif { $key == "Pattern" } { + ns_log Notice "/tcl/ad-redirect.tcl will reconstruct URLs that start with \"$from\" into URLs that start with \"$to\"" + # we have to supply from and to patterns to a helper proc + ns_register_proc GET $from ad_redirect_pattern $value + } elseif { $key == "PatternPost" } { + ns_log Notice "/tcl/ad-redirect.tcl will reconstruct forms posted to \"$from\" into URL GETs that start with \"$to\"" + # we have to supply from and to patterns to a helper proc + ns_register_proc POST $from ad_redirect_pattern $value + ns_register_proc GET $from ad_redirect_pattern $value + } else { + ns_log Error "/tcl/ad-redirect.tcl unable to do anything with $key=$value" + } + } +} + +proc_doc ad_string_replace_once {string pattern replacement} "Replace the first occurrence of PATTERN with REPLACEMENT; return unaltered STRING if PATTERN not found" { + set start [string first $pattern $string] + if { $start == -1 } { + return $string + } else { + set string_front [string range $string 0 [expr $start - 1]] + set string_end [string range $string [expr $start + [string length $pattern]] end] + append result $string_front $replacement $string_end + return $result + } +} + +proc_doc ad_redirect_pattern {from_and_to} "Target of redirects where a URL must be translated from starting with foo to starting with bar" { + set pair [split $from_and_to "|"] + set from [lindex $pair 0] + set to [lindex $pair 1] + set what_the_user_requested [ns_conn url] + # Added by branimir Jan 26, 2000: URL variables also need to be included: + if { !([ns_getform] == "") } { + set url_vars [export_entire_form_as_url_vars] + append what_the_user_requested ?$url_vars + } + ns_returnredirect [ad_string_replace_once $what_the_user_requested $from $to] +} Index: web/openacs/tcl/ad-referer.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-referer.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-referer.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,199 @@ +# ad-referer.tcl,v 3.1 2000/02/26 12:55:27 jsalz Exp + # ad-referer.tcl + +# we've misspelled "referrer" because it is misspelled in the HTTP +# standard + +# created by philg@mit.edu on 7/4/98 and teadams@mit.edu +# modified by teadams@mit.edu on 2/7/98 to exclude local urls like .jpg and .gif +# modified by philg@mit.edu on November 24, 1999 to handle concurrency problem +# (on first insert of the day) + +# checks to see if there is an external referer header +# then tries to get db conn +# then increments counter + +util_report_library_entry + +proc ad_referer_external_p {referer_header} { + set local_hostnames [ad_parameter_all_values_as_list LocalDomain referer] + foreach hostname $local_hostnames { + if { [string match [string tolower "*//$hostname*/*"] [string tolower $referer_header]]} { + # we found a match in between // and /; the match was done case-insensitive + # we also put in a wildcard in case the port number was included, e.g., + # "photo.net:80" "photo.net:443" + return 0 + } + } + # didn't match any of the local hostnames + return 1 +} + +proc ad_referer_include_p {referer_header} { + set inclusion_globs [ad_parameter_all_values_as_list InclusionGLOB referer] + if { [llength $inclusion_globs] == 0 } { + # there aren't any required inclusion patterns, so assume this is OK + return 1 + } else { + foreach glob_pattern $inclusion_globs { + if {[string match $glob_pattern $referer_header]} { + return 1 + } + } + # nothing matched + return 0 + } +} + +proc ad_track_referer_p { } { + if { [string match *.jpg [ns_conn url]] || [string match *.gif [ns_conn url]] } { + # we don't want to track referers to this url + return 0 + } else { + return 1 + } +} + +# on March 7, 1999 philg added the <= 250 characters clause because his +# error log was getting spammed a bit with weird long referers from sites +# such as www.askjeeves.com + +proc ad_referer_filter {conn args why} { + set referer [ns_set get [ns_conn headers] Referer] + if { ![empty_string_p $referer] && [ad_referer_external_p $referer] && [ad_referer_include_p $referer] && [ad_track_referer_p] && ([string length $referer] <= 250) } { + # we have an external header, and the local url + # we wish to track let's try to get a db conn + if { [catch { set db [ns_db gethandle -timeout -1 log] } errmsg] || [empty_string_p $db] } { + # the non-blocking call to gethandle raised a Tcl error; this + # means a db conn isn't free right this moment, so let's just + # return + return filter_ok + } else { + # we have $db + # let's try to figure out if we should log it straight + # or reduced down with a GLOB pattern + set selection [ns_db select $db "select * from referer_log_glob_patterns"] + set globbed_p 0 + set regexp_p 0 + while { [ns_db getrow $db $selection] } { + set_variables_after_query + if [string match $glob_pattern $referer] { + # we don't want to log under the raw string + set globbed_p 1 + if { $search_engine_name != "" && [regexp $search_engine_regexp $referer match query_string] } { + # this glob pattern is for a search engine AND + # we successfully REGEXP'd for the query string + set user_id [ad_get_user_id] + if { $user_id == 0 } { + set complete_user_id NULL + } else { + set complete_user_id $user_id + } + set regexp_p 1 + break + } else { + # we globbed but weren't a search engine + # or couldn't find the query-string, bust out of the loop + break + } + } + } + + if $globbed_p { + set foreign_url $canonical_foreign_url + } else { + set foreign_url $referer + } + + # if we found a match the regular expression + + if $regexp_p { + ns_db dml $db "insert into query_strings (query_date, query_string, search_engine_name, user_id) +values +(sysdate(),'[DoubleApos [ns_urldecode $query_string]]','[DoubleApos $search_engine_name]',$complete_user_id)" + } + + set update_sql "update referer_log set click_count = click_count + 1 +where local_url = '[DoubleApos [ns_conn url]]' +and foreign_url = '[string tolower [DoubleApos $foreign_url]]' +and trunc(entry_date) = trunc(sysdate())" + ns_db dml $db $update_sql + + # POSTGRES + # set n_rows [ns_ora resultrows $db] + set n_rows [ns_pg ntuples $db] + + if { $n_rows == 0 } { + # there wasn't already a row there; we want to insert a new row + # but we have to be careful because we're not inside a database + # transaction. It is possible another thread is simultaneously + # executing this logic and inserting an extra row. + set insert_sql "insert into referer_log (local_url, foreign_url, entry_date, click_count) +select '[DoubleApos [ns_conn url]]', '[string tolower [DoubleApos $foreign_url]]', trunc(sysdate()), 1 +from dual +where 0 = (select count(*) + from referer_log + where local_url = '[DoubleApos [ns_conn url]]' + and foreign_url = '[DoubleApos $foreign_url]' + and trunc(entry_date) = trunc(sysdate()))" + ns_db dml $db $insert_sql + } + ns_db releasehandle $db + } + } + # regardless of what happened above, return OK + return filter_ok +} + +ns_share -init { set ad_referer_filters_installed_p 0 } ad_referer_filters_installed_p + +if { !$ad_referer_filters_installed_p } { + set ad_referer_filters_installed_p 1 + ad_register_filter trace GET * ad_referer_filter +} + + +################################################################## +# +# interface to the ad-user-contributions-summary.tcl system +# +# (to report user searches to the site administrator only) +# + +ns_share ad_user_contributions_summary_proc_list + +if { ![info exists ad_user_contributions_summary_proc_list] || [util_search_list_of_lists $ad_user_contributions_summary_proc_list "Searches" 0] == -1 } { + lappend ad_user_contributions_summary_proc_list [list "Searches" searches_user_contributions 0] +} + +proc_doc searches_user_contributions {db user_id purpose} {Returns empty list if purpose is not "site_admin". Otherwise a triplet including all the searches typed on this site while this user was logged in or was referred in.} { + if { $purpose != "site_admin" } { + return [list] + } + set selection [ns_db select $db "select query_date, +coalesce(subsection, search_engine_name) as location, +case when n_results is null then '' else ' - ' || n_results || ' result(s)' end as n_results_string, query_string +from query_strings +where user_id = $user_id +order by query_date asc +"] + + set items "" + while {[ns_db getrow $db $selection]} { + set_variables_after_query + append items "<li>$query_date:</a> +<a href=\"/admin/searches/by-word.tcl?query_string=[ns_urlencode $query_string]\"><b>$query_string</b></a> +<a href=\"/admin/searches/by-location.tcl?location=[ns_urlencode $location]\">($location)</a> +$n_results_string +" + } + if [empty_string_p $items] { + return [list] + } else { + return [list 0 "Searches" "<ul>\n\n$items\n\n</ul>"] + } +} + + + +util_report_successful_library_load Index: web/openacs/tcl/ad-robot-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-robot-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-robot-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,181 @@ +# ad-robot-defs.tcl,v 3.1.2.1 2000/03/17 17:44:38 ron Exp +# +# robot-defs.tcl +# +# Created by michael@yoon.org, 05/27/1999 +# + +proc_doc ad_replicate_web_robots_db {db} {Replicates data from the Web Robots Database (http://info.webcrawler.com/mak/projects/robots/active.html) into a table in the ACS database. The data is published on the Web as a flat file, whose format is specified in http://info.webcrawler.com/mak/projects/robots/active/schema.txt. Basically, each non-blank line of the database corresponds to one field (name-value pair) of a record that defines the characteristics of a registered robot. Each record has a "robot-id" field as a unique identifier. (There are many fields in the schema, but, for now, the only ones we care about are: robot-id, robot-name, robot-details-url, and robot-useragent.)\n<p>Returns the number of rows replicated. May raise a Tcl error that should be caught by the caller.} { + set web_robots_db_url [ad_parameter WebRobotsDB robot-detection] + + set result [ns_geturl $web_robots_db_url headers] + set page [split $result "\n"] + + # A set in which to store the fields of a record as we + # process the file. + set robot [ns_set create] + + set robot_count 0 + foreach line $page { + # A "robot-id" line delimits a new record, so each + # time we encounter one, we need to write the prior + # record (if there is one) into the database. There + # is only case in which there will *not* be a prior + # record, i.e., for the very first record. + # + if [regexp "robot-id: *(.+)" $line match robot_id] { + set prior_robot_id [ns_set get $robot "robot_id"] + if ![empty_string_p $prior_robot_id] { + # As long as there is an actual value for + # "robot_useragent", load the record, i.e., + # update it if a record with the same + # robot_id already exists or insert it if + # one does not. (There's no point in keeping + # info about robots that we can't identify.) + # + if ![empty_string_p [ns_set get $robot "robot_useragent"]] { + if [robot_exists_p $db $prior_robot_id] { + ns_log Notice "Updating existing robot: $robot_id" + ns_db dml $db "update robots set robot_name = '[DoubleApos [ns_set get $robot "robot_name"]]', robot_details_url = '[DoubleApos [ns_set get $robot "robot_details_url"]]', robot_useragent = '[DoubleApos [ns_set get $robot "robot_useragent"]]' where robot_id = '[DoubleApos $prior_robot_id]'" + } else { + ns_log Notice "Inserting new robot: $robot_id" + ns_db dml $db "insert into robots(robot_id, robot_name, robot_details_url, robot_useragent) values('[DoubleApos $prior_robot_id]', '[DoubleApos [ns_set get $robot "robot_name"]]', '[DoubleApos [ns_set get $robot "robot_details_url"]]', '[DoubleApos [ns_set get $robot "robot_useragent"]]')" + } + + incr robot_count + } + + # Clear out the record so we can start anew. + # + ns_set delkey $robot "robot_id" + ns_set delkey $robot "robot_name" + ns_set delkey $robot "robot_details_url" + ns_set delkey $robot "robot_useragent" + } + ns_set put $robot "robot_id" [string trim $robot_id] + } + + if [regexp "robot-name: *(.+)" $line match robot_name] { + ns_set put $robot "robot_name" [string trim $robot_name] + } + + if [regexp "robot-details-url: *(.+)" $line match robot_details_url] { + ns_set put $robot "robot_details_url" [string trim $robot_details_url] + } + + if [regexp "robot-useragent: *(.+)" $line match robot_useragent] { + ns_set put $robot "robot_useragent" [string trim $robot_useragent] + } + } + + # Don't forget the last record. + # + if ![empty_string_p [ns_set get $robot "robot_useragent"]] { + if [robot_exists_p $db $prior_robot_id] { + ns_log Notice "Updating existing robot: $robot_id" + ns_db dml $db "update robots set robot_name = '[DoubleApos [ns_set get $robot "robot_name"]]', robot_details_url = '[DoubleApos [ns_set get $robot "robot_details_url"]]', robot_useragent = '[DoubleApos [ns_set get $robot "robot_useragent"]]', insertion_date = sysdate() where robot_id = '[DoubleApos $prior_robot_id]'" + } else { + ns_log Notice "Inserting new robot: $robot_id" + ns_db dml $db "insert into robots(robot_id, robot_name, robot_details_url, robot_useragent) values('[DoubleApos $prior_robot_id]', '[DoubleApos [ns_set get $robot "robot_name"]]', '[DoubleApos [ns_set get $robot "robot_details_url"]]', '[DoubleApos [ns_set get $robot "robot_useragent"]]')" + } + + incr robot_count + } + return $robot_count +} + +proc_doc ad_cache_robot_useragents {} {Caches "User-Agent" values for known robots} { + ns_share ad_robot_useragent_cache + set sub_db [ns_db gethandle subquery] + set sub_selection [ns_db select $sub_db "select robot_useragent from robots"] + while {[ns_db getrow $sub_db $sub_selection]} { + set_variables_after_subquery + set ad_robot_useragent_cache($robot_useragent) 1 + } + ns_db releasehandle $sub_db +} + +proc_doc robot_exists_p {db robot_id} {Returns true if a row already exists in the robots table with the specified "robot_id"} { + return [database_to_tcl_string $db "select count(*) from robots where robot_id = '[DoubleApos $robot_id]'"] +} + +proc_doc robot_p {useragent} {Returns true if the useragent is recognized as a search engine} { + ns_share ad_robot_useragent_cache + + # Memoize so we don't need to query the robots table for every single HTTP request. + util_memoize ad_cache_robot_useragents + + if {[info exists ad_robot_useragent_cache($useragent)]} { + return 1 + } else { + return 0 + } +} + +proc_doc ad_robot_filter {conn args why} {A filter to redirect any recognized robot to a specified page} { + set useragent [ns_set get [ns_conn headers] "User-Agent"] + + if [robot_p $useragent] { + set robot_redirect_url [ad_parameter RedirectURL robot-detection] + # Be sure to avoid an infinite loop of redirects. (Actually, browsers + # won't look infinitely; rather, they appear to abort after a URL + # redirects to itself.) + if { [string first $robot_redirect_url [ns_conn url]] != 0 } { + # requested URL does not start with robot redirect URL (usually a dir) + ns_log Notice "Robot being bounced by ad_robot_filter: User-Agent = $useragent" + ns_returnredirect $robot_redirect_url + set result "filter_return" + } else { + # we've got a robot but he is happily in robot heaven + set result "filter_ok" + } + } else { + set result "filter_ok" + } + + return $result +} + +proc_doc ad_update_robot_list {} {Will update the robots table if it is empty or if the number of days since it was last updated is greater than the number of days specified by the RefreshIntervalDays configuration parameter in the "robot-detection" section} { + set db [ns_db gethandle] + ns_db dml $db "begin transaction" + if [catch { + set robot_count [database_to_tcl_string $db "select count(*) from robots"] + if {$robot_count == 0} { + ns_log Notice "Replicating Web Robots DB, because robots table is empty" + ad_replicate_web_robots_db $db + } else { + set refresh_interval [ad_parameter RefreshIntervalDays robot-detection] + if {$refresh_interval == ""} { + set refresh_interval 30 ;# refresh every 30 days by default + } + + set days_old [database_to_tcl_string $db \ + "select sysdate() - max(case when modified_date is null then insertion_date else modified_date end) as n_days from robots"] + if {$days_old > $refresh_interval} { + ns_log Notice "Replicating Web Robots DB, because data in robots table has expired" + ad_replicate_web_robots_db $db + } else { + ns_log Notice "Not replicating Web Robots DB at this time, because data in the robots table has not expired" + } + } + } errmsg] { + ad_notify_host_administrator "Error encountered in ad_update_robot_list" $errmsg + return + } + ns_db dml $db "end transaction" +} + +# Check to see if the robots table needs to be updated +# when the server starts (5 seconds after to be precise). +ad_schedule_proc -once t 5 ad_update_robot_list + +# Install ad_robot_filter for all specified patterns +ns_share -init {set robot_filters_installed 0} robot_filters_installed +if {!$robot_filters_installed} { + set robot_filters_installed 1 + foreach filter_pattern [ad_parameter_all_values_as_list FilterPattern robot-detection] { + ns_log Notice "Installing robot filter for $filter_pattern" + ad_register_filter postauth GET $filter_pattern ad_robot_filter + } +} Index: web/openacs/tcl/ad-scope.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-scope.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-scope.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,864 @@ +# ad-scope.tcl +# +# tarik@arsdigita.com, December 1999 +# +# ad-scope.tcl,v 3.1.4.3 2000/03/17 18:15:01 aure Exp + +proc_doc ad_scope_sql { {table_name ""} } "if scope is not set in the topmost environment then public scope is assumed. if scope=group it assumes group_id is set in the topmost environment, if scope=user it assumes that user_id is set in topmost environment and if scope=table it assumes on_which_table and on_what_id are set in topmost environment. ad_scope_sql returns portion of sql query resolving scope. e.g. if scope=group this proc will return scope=group and group_id=<group_id>. to avoid naming conflicts you may specify a table name (or table alias name) of the table for which we are checking the scope. (e.g if table_name=news, then nnews.scope will be used instead of just scope)" { + if { [uplevel \#1 {info exists scope}] } { + upvar \#1 scope scope + } else { + set scope public + } + + if { [empty_string_p $table_name] } { + switch $scope { + public { + return "scope='public'" + } + + group { + upvar \#1 group_id group_id + return "scope='group' and group_id=$group_id" + } + + user { + upvar \#1 user_id user_id + return "scope='user' and user_id=$user_id" + } + table { + upvar \#1 on_which_table on_which_table + upvar \#1 on_what_id on_what_id + return "scope='table' and on_which_table='$on_which_table' and on_what_id=$on_what_id" + } + } + } else { + switch $scope { + public { + return "$table_name\.scope='public'" + } + + group { + upvar \#1 group_id group_id + return "$table_name\.scope='group' and $table_name\.group_id=$group_id" + } + + user { + upvar \#1 user_id user_id + return "$table_name\.scope='user' and $table_name\.user_id=$user_id" + } + table { + upvar \#1 on_which_table on_which_table + upvar \#1 on_what_id on_what_id + return "$table_name\.scope='table' and + $table_name\.on_which_table='$on_which_table' + and $table_name\.on_what_id=$on_what_id" + } + } + } +} + +proc_doc ad_scope_cols_sql {} "if scope is not set in the topmost environment then public scope is assumed. if scope=group it assumes group_id is set in the topmost environment, if scope=user it assumes that user_id is set in topmost environment and if scope=table it assumes on_which_table and on_what_id are set in topmost environment. ad_scope_sql returns columns that need to be updated in an insert statement. e.g. if scope=group this proc will return scope, group_id" { + if { [uplevel \#1 {info exists scope}] } { + upvar \#1 scope scope + } else { + set scope public + } + + uplevel \#1 { + switch $scope { + public { + return "scope" + } + + group { + return "scope, group_id" + } + + user { + return "scope, user_id" + } + table { + return "scope, on_which_table, on_what_id" + } + } + } + +} + +proc_doc ad_scope_vals_sql {} "if scope is not set in the topmost environment then public scope is assumed. if scope=group it assumes group_id is set in the topmost environment and if scope=user it assumes that user_id is set in topmost environment and if scope=table it assumes on_which_table and on_what_id are set in topmost environment. ad_scope_sql returns values that need to be inserted in an insert statement. e.g. if scope=group this proc will return '\$scope', \$group_id" { + if { [uplevel \#1 {info exists scope}] } { + upvar \#1 scope scope + } else { + set scope public + } + + uplevel \#1 { + switch $scope { + public { + return "'$scope'" + } + + group { + return "'$scope', $group_id" + } + + user { + return "'$scope', $user_id" + } + table { + return "'$scope', '$on_which_table', '$on_what_id'" + } + } + } +} + +proc_doc ad_scope_authorization_status { db scope public_permissions group_permissions user_permissions {id 0} } "this procedure will check whether the visitor has the right to view the page. if authorization fails, procedure returns not_authorized; if authorization suceeds, procedure will return authorized, and if user needs to be registered in order to view the page, procedure will return reg_required. public_permission gives permissions used for public scope: all, registered, admin (site-wide-administrator) and none (scope=public does not apply for this page, so nobody can see the page). group_permissions gives permission used for scope group: all (all users), registered (registered users only), group_member (group members only), group_admin (group administrators), admin (site wide administrators) and none (scope=group does not apply for this page, so nobody in the group can see the page). user_permissions gives permission used for scope user: all (all users), registered (registered users only) and user (only the user with user_id specified by the variable user_id_name has full privileges), and none (scope=user does not apply for this page, so page cannot be accessed for scope user). if scope=group, id is the group_id of the group against which, we are performing the authorization). if scope=user, id is the user_id of the user against whom, we are performing the authorization. if scope=public, id is irrelevant." { + + set visitor_id [ad_verify_and_get_user_id] + + switch $scope { + public { + switch $public_permissions { + all { + return authorized + } + registered { + return [ad_decode $visitor_id 0 reg_required authorized] + } + admin { + if { $visitor_id==0 } { + return reg_required + } + return [ad_decode [ad_administrator_p $db $visitor_id] 1 authorized not_authorized] + } + none { + return not_authorized + } + default { + return not_authorized + } + } + } + group { + switch $group_permissions { + all { + return authorized + } + registered { + return [ad_decode $visitor_id 0 reg_required authorized] + } + group_member { + if { $visitor_id==0 } { + return reg_required + } + return [ad_decode [ad_user_group_member $db $id $visitor_id] 1 authorized not_authorized] + } + group_admin { + if { $visitor_id==0 } { + return reg_required + } + return [ad_decode [ad_user_group_authorized_admin $visitor_id $id $db] 1 authorized not_authorized] + } + admin { + if { $visitor_id==0 } { + return reg_required + } + return [ad_decode [ad_administrator_p $db $visitor_id] 1 authorized not_authorized] + } + none { + return not_authorized + } + default { + return not_authorized + } + } + } + user { + switch $user_permissions { + all { + return authorized + } + registered { + return [ad_decode $visitor_id 0 reg_required authorized] + } + user { + if { $visitor_id==0 } { + return reg_required + } + return [ad_decode $id $visitor_id authorized not_authorized] + } + admin { + if { $visitor_id==0 } { + return reg_required + } + return [ad_decode [ad_administrator_p $db $visitor_id] 1 authorized not_authorized] + } + none { + return not_authorized + } + default { + return not_authorized + } + } + } + default { + return not_authorized + } + } +} + +proc_doc ad_scope_authorize { db scope public_permissions group_permissions user_permissions {group_id_name ""} {user_id_name ""} } "this procedure will check whether the visitor has the right to view the page. if authorization fails, procedure will returns not_authorized message to the user; if authorization suceeds, procedure will return user_id of the visitor if user is logged in or 0 otherwise. if user needs to be registered in order to view the page, procedure will automatically redirect the user. in the case, user is not authorized or he i s redirected, procedure will return from the topmost environment. public_permission gives permissions used for public scope: all, registered, admin (site-wide-administrator) and none (scope=public does not apply for this page, so nobody can see the page). group_permissions gives permission used for scope group: all (all users), registered (registered users only), group_member (group members only), group_admin (group administrators), admin (site wide administrators) and none (scope=group does not apply for this page, so nobody in the group can see the page). user_permissions gives permission used for scope user: all (all users), registered (registered users only) and user (only the user with user_id specified by the variable user_id_name has full privileges), and none (scope=user does not apply for this page, so page cannot be accessed for scope user). if group_id_name (name of the group_id variable against which, we are testing the authorization) is not provided and scope=group, procedure assumes that group_id is set in the topmost environment. if user_id_name (name of the user_id variable against which, we are testing the authorization) is not provided and scope=group, procedure assumes that user_id is set in the topmost environment." { + + # set the appropriated id for the ad_scope_authorization_status procedure + switch $scope { + public { + set id 0 + } + group { + if { [empty_string_p $group_id_name] } { + upvar \#1 group_id id + } else { + upvar \#1 group_id_name id + } + } + user { + if { [empty_string_p $user_id_name] } { + upvar \#1 user_id id + } else { + upvar \#1 user_id_name id + } + } + } + + set authorization_status [ad_scope_authorization_status $db $scope $public_permissions $group_permissions $user_permissions $id] + set user_id [ad_verify_and_get_user_id] + switch $authorization_status { + authorized { + return $user_id + } + not_authorized { + ad_return_warning "Not authorized" "You are not authorized to see this page" + return -code return + } + reg_required { + ad_redirect_for_registration + return -code return + } + } +} + +proc_doc ad_scope_administrator_p { db visitor_id } "if scope is not set in the topmost environment then public scope is assumed. if scope=group, it assumes that group_id is set in the topmost environment. if scope=user it assumes that user_id is set in topmost environment (this is user_id of the user who has permission to this page). this procedure will check whether the visitor has the administration rights over the page. if scope=public only site-wide administrator has the right to see the page. if scope=group only administrators of the groups specifed by the group_id are allowed to access the page. if scope=user, only user specified by user_id is allowed to view the page. procedure will return 1 if visitor with user_id equal to visitor_id has right to see the page, otherwide procedure will return 0." { + if { [uplevel \#1 {info exists scope}] } { + upvar \#1 scope scope + } else { + set scope public + } + + switch $scope { + public { + return [ad_administrator_p $visitor_id] + } + group { + upvar \#1 group_id group_id + return [ad_user_group_authorized_admin $visitor_id $group_id $db] + } + user { + upvar \#1 user_id user_id + if { $user_id==$visitor_id } { + return 1 + } else { + return 0 + } + } + } +} + +proc_doc ad_scope_error_check { {default_scope public} } "this procedure does scope error checking. if scope is not set in topmost environment, then the scope will be set to the value of default_scope. if scope=group this procedure will check whether group_id is provided and if not it will return error to the user. if scope=table and on_which_table or on_what_id are not provided this procedure will return error to the user. if everything went fine this procedure returns 1. if scope=group and the group_vars_set is not set in the topmost environment, then this procedure will set group_vars_set variables corresponding to the group_id. if scope=user and user_id is not provided, then user_id will be set to the user_id of the visitor if visitor is logged in, otherwise error will be returned to the user." { + + if { [uplevel \#1 {info exists scope}] } { + upvar \#1 scope scope + } else { + set scope $default_scope + # create scope in topmost environment and give it initial value of 0 + uplevel \#1 { set scope 0 } + upvar \#1 scope new_scope + # set scope in the topmost environment to the value of default_scope + set new_scope $default_scope + } + + switch $scope { + public { + return 1 + } + group { + if { ![uplevel \#1 {info exists group_id}] } { + ad_return_error "Error: group_id not supplied" \ + "<ul><li>group_id must be supplied in order to access this page.</ul>" + return -code return + } else { + upvar \#1 group_id group_id + + # in the case group_vars_set was not provided, put default values to this set + if { ![uplevel \#1 {info exists group_vars_set}] } { + + set db [ns_db gethandle subquery] + set selection [ns_db 1row $db " + select group_name, short_name, admin_email from user_groups where group_id=$group_id"] + set_variables_after_query + ns_db releasehandle $db + + uplevel \#1 { set group_vars_set [ns_set create] } + upvar \#1 group_vars_set group_vars_set + + ns_set put $group_vars_set group_id $group_id + ns_set put $group_vars_set group_short_name $short_name + ns_set put $group_vars_set group_name $group_name + ns_set put $group_vars_set group_admin_email $admin_email + ns_set put $group_vars_set group_public_url /[ad_parameter GroupsDirectory ug] + ns_set put $group_vars_set group_admin_url /[ad_parameter GroupsDirectory ug]/[ad_parameter GroupsAdminDirectory ug] + ns_set put $group_vars_set group_type_url_p 0 + ns_set put $group_vars_set group_context_bar_list [list] + ns_set put $group_vars_set group_navbar_list [list] + } + return 1 + } + } + user { + if { ![uplevel \#1 {info exists user_id}] } { + set user_id [ad_verify_and_get_user_id] + if { $user_id==0 } { + # user is not logged in and user_id was not set in the topmost environment, + # so redirect the user for registration + ad_redirect_for_registration + return -code return + } + uplevel \#1 { set user_id 0 } + upvar \#1 user_id user_id_temp + set user_id_temp $user_id + + return 1 + } + } + table { + if { ![uplevel \#1 {info exists on_which_table}] } { + ad_return_error "Error: on_which_table is not supplied" \ + "<ul><li>on_which_table must be supplied in order to access this page.</ul>" + return -code return + } elseif { ![uplevel \#1 {info exists on_what_id}] } { + ad_return_error "Error: on_what_id is not supplied" \ + "<ul><li>on_what_id must be supplied in order to access this page.</ul>" + } else { + return 1 + } + } + } +} + +proc_doc export_url_scope_vars { { args ""} } "assumes scope is set up in the topmost environment. if scope=group it assumes group_id is set in the topmost environment, if scope=user it assumes that user_id is set in topmost environment and if scope=table it assumes on_which_table and on_what_id are set in topmost environment. this procedure operates in the same manner as export_url_vars except that it automatically figures out and sets appropriate scope variables. (e.g. for scope=group_id, export_url_scope_vars return_url would return the following string scope=group&group_id=23&return_url=23" { + if { [empty_string_p $args] } { + set exported_url_vars "" + } else { + set url_vars [eval uplevel {"export_url_vars $args"}] + + if { [empty_string_p $url_vars] } { + set exported_url_vars "" + } else { + set exported_url_vars &$url_vars + } + + } + + if { [uplevel \#1 {string compare $scope public}]==0 } { + return "scope=public$exported_url_vars" + } + if { [uplevel \#1 {string compare $scope group}]==0 } { + upvar \#1 group_id group_id + return "scope=group&group_id=$group_id$exported_url_vars" + } + if { [uplevel \#1 {string compare $scope user}]==0 } { + upvar \#1 user_id user_id + return "scope=user&user_id=$user_id$exported_url_vars" + } + if { [uplevel \#1 {string compare $scope table}]==0 } { + upvar \#1 on_which_table on_which_table + upvar \#1 on_what_id on_what_id + return "scope=table&on_which_table=[ns_urlencode $on_which_table]&on_what_id=$on_what_id$exported_url_vars" + } +} + +proc_doc export_form_scope_vars { args } "assumes scope is set up in the topmost environment. if scope=group it assumes group_id is set in the topmost environment, if scope=user it assumes that user_id is set in topmost environment and if scope=table it assumes on_which_table and on_what_id are set in topmost environment. this procedure operates in the same manner as export_form_vars except that it automatically figures out and sets appropriate scope variables. (e.g. for scope=group_id, export_form_scope_vars return_url would return the following string <input type=hidden name=scope value=group> <input type=hidden name=group_id value=23> <input type=hidden name=return_url value=index.tcl>" { + + if { [empty_string_p $args] } { + set form_vars "" + } else { + set form_vars [eval uplevel {"export_form_vars $args"}] + } + + if { [uplevel \#1 {string compare $scope public}]==0 } { + return " + <input type=hidden name=scope value=public> + $form_vars + " + } + if { [uplevel \#1 {string compare $scope group}]==0 } { + upvar \#1 group_id group_id + return " + <input type=hidden name=scope value=group>\n + <input type=hidden name=group_id value=$group_id> + $form_vars + " + } + if { [uplevel \#1 {string compare $scope user}]==0 } { + upvar \#1 user_id user_id + return " + <input type=hidden name=scope value=user>\n + <input type=hidden name=user_id value=$user_id> + $form_vars + " + } + if { [uplevel \#1 {string compare $scope table}]==0 } { + upvar \#1 on_which_table on_which_table + upvar \#1 on_what_id on_what_id + return " + <input type=hidden name=scope value=table>\n + <input type=hidden name=on_which_table value=\"[philg_quote_double_quotes $on_which_table]\">\n + <input type=hidden name=on_what_id value=$on_what_id> + $form_vars + " + } +} + +proc_doc ad_scope_header { page_title db } "if scope is not set in the topmost environment then public scope is assumed. if scope is group, it assumes group_vars_set is set in the topmost environment. it returns appropriate scope header." { + + if { [uplevel \#1 {info exists scope}] } { + upvar \#1 scope scope + } else { + set scope public + } + switch $scope { + public { + return [ad_header $page_title] + } + group { + upvar \#1 group_vars_set group_vars_set + set group_id [ns_set get $group_vars_set group_id] + return [ug_header $page_title $db $group_id] + } + user { + # this may be later modified if we allow users to customize the display of their pages + return [ad_header $page_title] + } + } +} + +proc_doc ad_scope_footer {} "if scope is not set in the topmost environment then public scope is assumed. if scope is group, it assumes group_vars_set is set in the topmost environment. it returns appropriate scope admin footer." { + if { [uplevel \#1 {info exists scope}] } { + upvar \#1 scope scope + } else { + set scope public + } + + switch $scope { + public { + return [ad_footer] + } + group { + upvar \#1 group_vars_set group_vars_set + set group_admin_email [ns_set get $group_vars_set group_admin_email] + return [ug_footer $group_admin_email] + } + user { + # this may be later modified if we allow users to customize the display of their pages + return [ad_footer] + } + } +} + +proc_doc ad_scope_admin_header { page_title db } "if scope is not set in the topmost environment then public scope is assumed. if scope is group, it assumes group_vars_set is set in the topmost environment. it returns appropriate scope admin header" { + if { [uplevel \#1 {info exists scope}] } { + upvar \#1 scope scope + } else { + set scope public + } + + switch $scope { + public { + return [ad_header $page_title] + } + group { + upvar \#1 group_vars_set group_vars_set + set group_id [ns_set get $group_vars_set group_id] + return [ug_header $page_title $db $group_id] + } + user { + # this may be later modified if we allow users to customize the display of their pages + return [ad_header $page_title] + } + } +} + +proc_doc ad_scope_admin_footer {} "if scope is not set in the topmost environment then public scope is assumed. if scope is group, it assumes group_vars_set is set in the topmost environment. returns appropriate scope admin footer. because it is only the programmers who can fix the pages, we should always use ad_footer. we mantain this as separate function for consistency and possible future changes in display, in which case this function may return something else than ad_footer" { + return [ad_footer] +} + +proc_doc ad_scope_page_title { page_title db {show_logo_p 1} } "if scope is not set in the topmost environment then public scope is assumed. if scope is group, it assumes group_vars_set is set in the topmost environment. it returns properly formatted page title for the appropriate scope. depending on settings it may display the logo. if show_logo_p is 1, logo will be displayed (given that the logo is enabled for this page), else logo will not be displayed." { + if { [uplevel \#1 {info exists scope}] } { + upvar \#1 scope scope + } else { + set scope public + } + + switch $scope { + public { + return "<h2>$page_title</h2>" + } + group { + upvar \#1 group_vars_set group_vars_set + set group_id [ns_set get $group_vars_set group_id] + set group_name [ns_set get $group_vars_set group_name] + return [ug_page_title $page_title $db $group_id $group_name $show_logo_p] + } + user { + # this may be later modified if we allow users to customize the display of their pages + return "<h2>$page_title</h2>" + } + } +} + +proc_doc ad_scope_admin_page_title { page_title db} "if scope is not set in the topmost environment then public scope is assumed. if scope is group, it assumes group_vars_set is set in the topmost environment. it returns properly formatted admin page title for the appropriate scope." { + if { [uplevel \#1 {info exists scope}] } { + upvar \#1 scope scope + } else { + set scope public + } + + switch $scope { + public { + return "<h2>$page_title</h2>" + } + group { + upvar \#1 group_vars_set group_vars_set + set group_id [ns_set get $group_vars_set group_id] + set group_name [ns_set get $group_vars_set group_name] + return [ug_admin_page_title $page_title $db $group_id $group_name] + } + user { + # this may be later modified if we allow users to customize the display of their pages + return "<h2>$page_title</h2>" + } + } +} + +proc_doc ad_scope_page_top { window_title page_title {context_bar_title ""} } "ad_scope_page_top combines header, page title, context bar and horizontal line and generates a standard looking top of the page. window_title is the title that should appear in the browser window. page_title is the title that will be displayed on the page. context_bar_title is the title appearing as the last item in the context bar. if context_bar_title is empty or not provided then page_title will be used instead of context_bar_title. if scope is not set in the topmost environment then public scope is assumed. if scope=group, it assumes that group_vars_set is set in the topmost environment." { + set db [ns_db gethandle subquery] + + set return_val " + [ad_scope_header $window_title $db] + [ad_scope_page_title $page_title $db] + " + ns_db releasehandle $db + append return_val "[ad_scope_context_bar_ws_or_index [ad_decode $context_bar_title "" $page_title $context_bar_title]] + <hr> + " + + return $return_val +} + +proc_doc ad_scope_admin_page_top { window_title page_title {context_bar_title ""} } "ad_scope_admin_page_top combines admin header, admin page title, admin context bar and horizontal line and generates a standard looking admin top of the page. window_title is the title that should appear in the browser window. page_title is the title that will be displayed on the page. context_bar_title is the title appearing as the last item in the context bar. if context_bar_title is empty or not provided then page_title will be used instead of context_bar_title. if scope is not set in the topmost environment then public scope is assumed. if scope=group, it assumes that group_vars_set is set in the topmost environment." { + set db [ns_db gethandle subquery] + + set return_val " + [ad_scope_admin_header $window_title $db] + [ad_scope_admin_page_title $page_title $db] + " + ns_db releasehandle $db + append return_val "[ad_scope_admin_context_bar [ad_decode $context_bar_title "" $page_title $context_bar_title]] + <hr> + " + + return $return_val +} + +proc_doc ad_scope_return_complaint { exception_count exception_text db } "if scope is not set in the topmost environment then public scope is assumed. if scope=group, it assumes that group_vars_set is set in the topmost environment. returns a page complaining about the user's input (as opposed to an error in our software, for which ad_scope_return_error is more appropriate). it works the same way as ad_return_complaint, except that it uses appropriate scope display settings." { + if { [uplevel \#1 {info exists scope}] } { + upvar \#1 scope scope + } else { + set scope public + } + + switch $scope { + public { + return [ad_return_complaint $exception_count $exception_text] + } + group { + upvar \#1 group_vars_set group_vars_set + set group_id [ns_set get $group_vars_set group_id] + set group_name [ns_set get $group_vars_set group_name] + set group_admin_email [ns_set get $group_vars_set group_admin_email] + return [ug_return_complaint $exception_count $exception_text $db $group_id $group_name $group_admin_email] + } + user { + # this may be later modified if we allow users to customize the display of their pages + return [ad_return_complaint $exception_count $exception_text] + } + } +} + +proc_doc ad_scope_return_warning { title explanation db } "if scope is not set in the topmost environment then public scope is assumed. if scope=group, it assumes that group_vars_set is set in the topmost environment. returns warning message properly formatted for appropriate scope. this procedure is appropriate for messages like not authorized to access this page." { + if { [uplevel \#1 {info exists scope}] } { + upvar \#1 scope scope + } else { + set scope public + } + + switch $scope { + public { + return [ad_return_warning $title $explanation] + } + group { + upvar \#1 group_vars_set group_vars_set + set group_id [ns_set get $group_vars_set group_id] + set group_name [ns_set get $group_vars_set group_name] + set group_admin_email [ns_set get $group_vars_set group_admin_email] + return [ug_return_warning $title $explanation $db $group_id $group_name $group_admin_email] + } + user { + # this may be later modified if we allow users to customize the display of their pages + return [ad_return_warning $title $explanation] + } + } +} + +proc_doc ad_scope_return_error { title explanation db } "if scope is not set in the topmost environment then public scope is assumed. if scope=group, it assumes that group_vars_set is set in the topmost environment. this function should be used if we want to indicate an error to the user, which was produced by bug in our code. it returns error message properly formatted for appropriate scope." { + if { [uplevel \#1 {info exists scope}] } { + upvar \#1 scope scope + } else { + set scope public + } + + switch $scope { + public { + return [ad_return_error $title $explanation] + } + group { + upvar \#1 group_vars_set group_vars_set + set group_id [ns_set get $group_vars_set group_id] + set group_name [ns_set get $group_vars_set group_name] + set group_admin_email [ns_set get $group_vars_set group_admin_email] + return [ug_return_error $title $explanation $db $group_id $group_name $group_admin_email] + } + user { + # this may be later modified if we allow users to customize the display of their pages + return [ad_return_error $title $explanation] + } + } +} + +# the arguments are lists ( [list URL anchor]) +# except for the last one, which we expect to be just text +proc_doc ad_scope_context_bar args "if scope is not set in the topmost environment then public scope is assumed. if scope=group, it assumes that group_vars_set is set in the topmost environment. returns a Yahoo-style hierarchical contextbar for appropriate scope, each arg should be a list of URL and description. The last arg should be just a plain description." { + set choices [list] + set all_args [list] + + if { [uplevel \#1 {info exists scope}] } { + upvar \#1 scope scope + } else { + set scope public + } + + switch $scope { + public { + set all_args $args + } + group { + upvar \#1 group_vars_set group_vars_set + set group_context_bar_list [ns_set get $group_vars_set group_context_bar_list] + eval "lappend all_args $group_context_bar_list" + foreach arg $args { + lappend all_args $arg + } + } + user { + set all_args $args + # this may be later modified if we allow users to customize the display of their pages + } + } + + set index 0 + foreach arg $all_args { + incr index + if { $index == [llength $all_args] } { + lappend choices $arg + } else { + lappend choices "<a href=\"[lindex $arg 0]\">[lindex $arg 1]</a>" + } + } + return [join $choices " : "] +} + +# a context bar, rooted at the workspace +proc_doc ad_scope_context_bar_ws args "if scope is not set in the topmost environment then public scope is assumed. if scope=group, it assumes that group_context_bar_list are set in the topmost environment. returns a Yahoo-style hierarchical contextbar for appropriate scope, starting with a link to workspace." { + set choices [list "<a href=\"[ad_pvt_home]\">Your Workspace</a>"] + set all_args [list] + + if { [uplevel \#1 {info exists scope}] } { + upvar \#1 scope scope + } else { + set scope public + } + + switch $scope { + public { + set all_args $args + } + group { + upvar \#1 group_vars_set group_vars_set + set group_context_bar_list [ns_set get $group_vars_set group_context_bar_list] + eval "lappend all_args $group_context_bar_list" + foreach arg $args { + lappend all_args $arg + } + } + user { + # this may be later modified if we allow users to customize the display of their pages + set all_args $args + } + } + + set index 0 + foreach arg $all_args { + incr index + if { $index == [llength $all_args] } { + lappend choices $arg + } else { + lappend choices "<a href=\"[lindex $arg 0]\">[lindex $arg 1]</a>" + } + } + return [join $choices " : "] +} + +# a context bar, rooted at the workspace or index, depending on whether +# user is logged in +proc_doc ad_scope_context_bar_ws_or_index args "if scope is not set in the topmost environment then public scope is assumed. if scope=group, it assumes that group_context_bar_list are set in the topmost environment. returns a Yahoo-style hierarchical contextbar for appropriate scope, starting with a link to either the workspace or /, depending on whether or not the user is logged in." { + if { [ad_get_user_id] == 0 } { + set choices [list "<a href=\"/\">[ad_system_name]</a>"] + } else { + set choices [list "<a href=\"[ad_pvt_home]\">Your Workspace</a>"] + } + + set all_args [list] + + if { [uplevel \#1 {info exists scope}] } { + upvar \#1 scope scope + } else { + set scope public + } + + switch $scope { + public { + set all_args $args + } + group { + upvar \#1 group_vars_set group_vars_set + set group_context_bar_list [ns_set get $group_vars_set group_context_bar_list] + eval "lappend all_args $group_context_bar_list" + foreach arg $args { + lappend all_args $arg + } + } + user { + # this may be later modified if we allow users to customize the display of their pages + set all_args $args + } + } + + set index 0 + foreach arg $all_args { + incr index + if { $index == [llength $all_args] } { + lappend choices $arg + } else { + lappend choices "<a href=\"[lindex $arg 0]\">[lindex $arg 1]</a>" + } + } + return [join $choices " : "] +} + +proc_doc ad_scope_admin_context_bar args "if scope is not set in the topmost environment then public scope is assumed. if scope=group, it assumes that ug_admin_context_bar_list are set in the topmost environment. returns a Yahoo-style hierarchical contextbar for appropriate scope, starting with links to workspace and admin home. Suitable for use in pages underneath /admin." { + set choices [list "<a href=\"[ad_pvt_home]\">Your Workspace</a>" "<a href=\"/admin/\">Admin Home</a>"] + set all_args [list] + + if { [uplevel \#1 {info exists scope}] } { + upvar \#1 scope scope + } else { + set scope public + } + + switch $scope { + public { + set all_args $args + } + group { + upvar \#1 group_vars_set group_vars_set + set group_context_bar_list [ns_set get $group_vars_set group_context_bar_list] + eval "lappend all_args $group_context_bar_list" + foreach arg $args { + lappend all_args $arg + } + } + user { + # this may be later modified if we allow users to customize the display of their pages + set all_args $args + } + } + + set index 0 + foreach arg $all_args { + incr index + if { $index == [llength $all_args] } { + lappend choices $arg + } else { + lappend choices "<a href=\"[lindex $arg 0]\">[lindex $arg 1]</a>" + } + } + return [join $choices " : "] +} + + +# the arguments are lists ( [list URL anchor]) +# except for the last one, which we expect to be just text +proc_doc ad_scope_navbar args "if scope is not set in the topmost environment then public scope is assumed. if scope=group, it assumes that group_navbar_list is set in the topmost environment. produces navigation bar. notice that navigation bar is different than context bar, which exploits a tree structure. navbar will just display a list of nicely formatted links." { + if { [uplevel \#1 {info exists scope}] } { + upvar \#1 scope scope + } else { + set scope public + } + + set all_args [list] + switch $scope { + public { + set all_args $args + } + group { + upvar \#1 group_vars_set group_vars_set + set group_navbar_list [ns_set get $group_vars_set group_navbar_list] + + eval "lappend all_args $group_navbar_list" + foreach arg $args { + lappend all_args $arg + } + } + user { + set all_args $args + # this may be later modified if we allow users to customize the display of their pages + } + } + + return [eval "ad_navbar $all_args"] +} + + + + + Index: web/openacs/tcl/ad-security.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-security.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-security.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,872 @@ +# ad-security.tcl,v 3.10.2.3 2000/03/17 05:58:04 jsalz Exp +# File: ad-security.tcl +# Author: Jon Salz <jsalz@mit.edu> +# Date: 16 Feb 2000 +# Description: Provides methods for authorizing and identifying ACS users +# (both logged in and not) and tracking their sessions. + + +# Cookies: +# +# ad_browser_id := <browser_id> +# ad_session_id := <session_id>,<user_id>,<token>,<last_hit> +# ad_user_login := <user_id>,<password:hexified> +# ad_secure_token := <secure_token> + +util_report_library_entry + +proc_doc sec_hexify { data } { Formats a string as a series of hexadecimal digits, e.g., "ABC" becomes "313233". } { + set out "" + for { set i 0 } { $i < [string length $data] } { incr i } { + scan [string index $data $i] "%c" val + append out [format "%02X" $val] + } + return $out +} + +proc_doc sec_dehexify { data } { Turns a series of hexadecimal digits into a string, e.g., "313233" becomes "ABC". This is the inverse of sec_hexify. } { + set out "" + for { set i 0 } { $i < [string length $data] } { set i [expr { $i + 2 }] } { + scan [string range $data $i [expr { $i + 1 }]] "%x" val + append out [format "%c" $val] + } + return $out +} + +proc ad_crypt_salt {} { + return [ad_parameter CryptSalt "" "fb"] +} + +proc_doc sec_random_char {} { Returns a random character which can be used for a password or token. } { + return [string index "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz./" [ns_rand 64]] +} + +proc_doc sec_random_token {} { Generates a random token, using the TokenLength as the token length. } { + set token "" + set length [ad_parameter TokenLength "" 32] + for { set i 0 } { $i < $length } { incr i } { + append token [sec_random_char] + } + return $token +} + +proc_doc sec_session_timeout {} { Returns the timeout, in seconds, for sessions. } { + return [ad_parameter SessionTimeout "" 86400] +} + +proc_doc sec_session_cookie_reissue {} { Returns the period, in seconds, after which we should reissue the session_id cookie and update last_hit in the sessions table. } { + return [ad_parameter SessionCookieReissue "" 600 ] +} + +proc sec_sweep_sessions {} { + set db [ns_db gethandle log] + ns_db dml $db " + delete from sec_sessions + where [ns_time] - last_hit > [ad_parameter SessionLifetime "" 176800] + " + ns_db releasehandle $db +} + +nsv_set ad_security . "" +if { ![nsv_exists ad_security inited] } { + nsv_set ad_security inited 1 + + # Register the security filters (critical and high-priority). + ad_register_filter -critical t -priority 1 preauth * /* sec_read_security_info + ad_register_filter -critical t -priority 1 trace * /* ad_issue_deferred_dml + + # Schedule a procedure to sweep for sessions. + ad_schedule_proc -thread t [ad_parameter SessionSweepInterval "" 3600] sec_sweep_sessions +} + +proc_doc ad_issue_deferred_dml { conn args why } { Issue deferred DML statements registered by ad_defer_dml. } { + global ad_sec_deferred_dml + + if { [llength $ad_sec_deferred_dml] > 0 } { + set db [ns_db gethandle log] + foreach item $ad_sec_deferred_dml { + set sql [lindex $item 0] + set blobs [lindex $item 1] + if { [llength $blobs] == 0 } { + # No blobs; just perform a plain old DML. + ns_db dml $db $sql + } else { + # Has blobs; use clob_dml. + eval [concat [list ns_ora clob_dml $db $sql] $blobs] + } + } + ns_db releasehandle $db + } + + return "filter_ok" +} + +proc_doc ad_defer_dml { sql { blobs "" } } { Registers a DML call to be issued at connection close. Will use ns_ora clob_dml if blobs are provided, else ns_db dml. } { + global ad_sec_deferred_dml + lappend ad_sec_deferred_dml [list $sql $blobs] +} + +proc ad_dump_security_info { db } { + # Debugging procedure to dump a table with some important security information. + set out " +<table border=2 cellpadding=10><tr><td> + <table cellspacing=0 cellpadding=0> +" + + foreach var { ad_sec_validated ad_sec_browser_id ad_sec_session_id ad_sec_user_id } { + global $var + append out "<tr><th align=left>\$$var:</th><td>   </td><td>[set $var]</td></tr>\n" + } + + append out "<tr><th colspan=3><hr>Cookies:<br><br></th></tr>\n" + foreach cookie [split [ns_set iget [ns_conn headers] "Cookie"] "; "] { + if { [regexp {^([^=]+)=(.+)$} $cookie match name value] } { + append out "<tr><th align=left>$name:</th><td>   </td><td>$value</td></tr>\n" + } + } + + append out "<tr><th colspan=3><br><a href=\"/sec/clear-cookies.tcl\">Clear All</a> | <a href=\"/sec/clear-cookies.tcl?session_only=1\">Clear Session Only</a><hr>Setting Cookies:<br><br></th></tr>\n" + set headers [ns_conn outputheaders] + for { set i 0 } { $i < [ns_set size $headers] } { incr i } { + if { ![string compare [string tolower [ns_set key $headers $i]] "set-cookie"] } { + if { [regexp {^([^=]+)=(.+)$} [ns_set value $headers $i] match name value] } { + append out "<tr><th align=left>$name:</th><td>   </td><td>$value</td></tr>\n" + } + } + } + + append out "<tr><th colspan=3><hr>In database:<br><br></th></tr>\n" + + set selection [ns_db 0or1row $db "select * from sec_sessions where session_id = $ad_sec_session_id"] + if { $selection != "" } { + for { set i 0 } { $i < [ns_set size $selection] } { incr i } { + append out "<tr><th align=left>[ns_set key $selection $i]:</th> +<td>   </td><td>[ns_set value $selection $i]</td></tr> +" + } + } + + append out "<tr><th colspan=3><hr>Session properties:<br><br></th></tr>\n" + + set selection [ns_db select $db " + select module, property_name, property_value, secure_p + from sec_session_properties + where session_id = $ad_sec_session_id + order by module, property_name + "] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + append out "<tr><th align=left>${module}/$property_name" + if { $secure_p == "t" } { + append out " (secure)" + } + append out ":</td><td>   </td><td>$property_value</td></tr>\n" + } + + append out "<tr><th colspan=3><hr>Browser properties:<br><br></th></tr>\n" + + set selection [ns_db select $db " + select module, property_name, property_value, secure_p + from sec_browser_properties + where browser_id = $ad_sec_browser_id + order by module, property_name + "] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + append out "<tr><th align=left>${module}/$property_name" + if { $secure_p == "t" } { + append out " (secure)" + } + append out ":</td><td>   </td><td>$property_value</td></tr>\n" + } + + append out " + </table> +</td></tr></table> +" + + return $out +} + +ad_proc ad_user_login { + { -forever f } + db user_id +} { Logs the user in, forever (via the user_login cookie) if -forever is true. } { + global ad_sec_user_id + set ad_sec_user_id $user_id + + set user_id_for_update [ad_decode $user_id 0 "null" $user_id] + + sec_generate_session_id_cookie + ns_db dml $db " + update sec_sessions + set user_id = $user_id_for_update + where session_id = [ad_get_session_id] + " + util_memoize_flush "sec_get_session_info [ad_get_session_id]" + + if { $forever == "t" && $user_id != 0 } { + if { [ad_secure_conn_p] } { + set secure "t" + } else { + set secure "f" + } + set password [database_to_tcl_string $db "select password from users where user_id = $user_id"] + ad_set_cookie -expires never -secure $secure \ + "ad_user_login" "$user_id,[sec_hexify $password]" + } +} + +proc_doc ad_user_logout { db } { Logs the user out. } { + ad_user_login $db 0 +} + +proc_doc ad_check_password { db user_id password_from_form } { Returns 1 if the password is correct for the given user ID. } { + set selection [ns_db 0or1row $db " + select password + from users + where user_id = $user_id + and user_state='authorized' + "] + + if {$selection == ""} { + return 0 + } + + set_variables_after_query + + # If we are encrypting passwords in the database, convert so we can compare + if [ad_parameter EncryptPasswordsInDBP "" 0] { + set password_from_form [ns_crypt $password_from_form [ad_crypt_salt]] + } + + if { [string compare [string toupper $password_from_form] [string toupper $password]] } { + return 0 + } + + return 1 +} + +proc sec_log { str } { + set must_match [ad_parameter LogSecurityMinutia "" ""] + if { [string match $must_match [ns_conn peeraddr]] } { + ns_log "Notice" "SecurityMinutia \[[ns_conn peeraddr]\]: $str" + } +} + +proc_doc ad_assign_session_id { db } { Sets up the session, setting the global variables and issuing a cookie if necessary. } { + global ad_sec_browser_id + global ad_sec_validated + global ad_sec_session_id + global ad_sec_user_id + global ad_sec_token + + # Generate all the information we need to create the session. + set ad_sec_session_id [database_to_tcl_string $db "select sec_id_seq.nextval from dual"] + set ad_sec_token [sec_random_token] + sec_log "Generating new session_id $ad_sec_session_id." + + if { [ad_secure_conn_p] } { + # Secure session - generate the secure token. + set secure_token [sec_random_token] + sec_generate_secure_token_cookie $secure_token + } else { + set secure_token "" + } + + set ad_sec_user_id 0 + if { [regexp {^([0-9]+),([0-9a-fA-F]+)$} [ad_get_cookie "ad_user_login"] match user_id password] } { + if { [ad_parameter EncryptPasswordsInDBP "" 0] } { + set password [ns_crypt $password [ad_crypt_salt]] + } + + set selection [ns_db 0or1row $db " + select password + from users + where user_id = $user_id + and user_state = 'authorized' + "] + + if { [empty_string_p $selection] } { + # user_id does not exist in database, or is not in state authorized + + } else { + set correct_password [ns_set value $selection 0] + + set password_raw [sec_dehexify $password] + if { ![string compare [string toupper $correct_password] [string toupper $password_raw]] } { + set ad_sec_user_id $user_id + } + } + } + + if { $ad_sec_user_id == 0 } { + set insert_id "null" + } else { + set insert_id $ad_sec_user_id + } + + ns_db dml $db " + insert into sec_sessions(session_id, user_id, token, secure_token, browser_id, + last_ip, last_hit) + values($ad_sec_session_id, $insert_id, '$ad_sec_token', '$secure_token', $ad_sec_browser_id, + '[ns_conn peeraddr]', [ns_time]) + " + + if { [ad_secure_conn_p] } { + set ad_sec_validated "secure" + } else { + set ad_sec_validated "insecure" + } + + sec_generate_session_id_cookie + + # Update last_visit and second_to_last_visit + database_to_tcl_string $db "select sec_rotate_last_visit($ad_sec_browser_id, [ns_time])" +} + +proc_doc ad_conn { which } { Returns a property about the connection. Allowable values are: + +<ul> + <li><tt><b>canonicalurl</b></tt>: Returns a canonical URL for the request, containing all scoping information and the file's extension. + <li><tt><b>file</b></tt>: Returns the absolute path to the file delivered. + <li><tt><b>extension</b></tt>: Returns the extension of the file delivered. +</ul> + +Currently these properties become available only when a file is sourced by the abstract URL handler, +although this limitation will be removed in the next release as we extend the request processing +pipeline. + +} { + global ad_conn + switch $which { + url - file - canonicalurl { + if { [info exists ad_conn($which)] } { + return $ad_conn($which) + } else { + return "" + } + } + extension { + if { [info exists ad_conn(file)] } { + return [file extension $ad_conn(file)] + } else { + return "" + } + } + } + + error "ad_conn $which is invalid; should be canonicalurl, file, or extension" +} + +proc_doc sec_read_security_info { conn args why } { The security filter, initializing the session. } { + global ad_sec_validated + set ad_sec_validated "" + + global ad_sec_browser_id + set ad_sec_browser_id "" + global ad_sec_session_id + set ad_sec_session_id "" + global ad_sec_user_id + set ad_sec_user_id 0 + global ad_sec_token + set ad_sec_token "" + + global ad_sec_deferred_dml + set ad_sec_deferred_dml "" + + global ad_conn + if { [info exists ad_conn] } { + unset ad_conn + } + set ad_conn(.) "" + + # Don't bother doing *anything* for requests to /SYSTEM. + if { [lindex [ns_conn urlv] 0] == "SYSTEM" } { + return "filter_ok" + } + + # Force the URL to look like [ns_conn location], if desired... + if { [ad_parameter ForceHostP "" 1] } { + set host_header [ns_set iget [ns_conn headers] "Host"] + regexp {^([^:]*)} $host_header "" host_no_port + regexp {^https?://([^:]+)} [ns_conn location] "" desired_host_no_port + if { $host_header != "" && [string compare $host_no_port $desired_host_no_port] } { + sec_log "Host header is set to \"$host_header\"; forcing to \"[ns_conn location]\"" + set query [ns_conn query] + if { $query != "" } { + set query "?$query" + if { [ns_getform] != "" } { + set query "$query&[export_entire_form_as_url_vars]" + } + } elseif { [ns_getform] != "" } { + set query "?[export_entire_form_as_url_vars]" + } + ns_returnredirect "[ns_conn location][ns_conn url]$query" + return "filter_return" + } + } + + regexp {^([0-9]+)$} [ad_get_cookie "ad_browser_id"] match ad_sec_browser_id + regexp {^([0-9]+),([0-9]*),([^,]*),([0-9]+)$} \ + [ad_get_cookie "ad_session_id"] match ad_sec_session_id ad_sec_user_id ad_sec_token last_issue + + sec_log "sec_read_security_info: ad_browser_id=<<[ad_get_cookie "ad_browser_id"]>>; ad_session_id=<<[ad_get_cookie "ad_session_id"]>>" + + if { $ad_sec_browser_id == "" } { + set db [ns_db gethandle] + set ad_sec_browser_id [database_to_tcl_string $db "select sec_id_seq.nextval from dual"] + sec_log "Generating new browser_id $ad_sec_browser_id" + ad_set_cookie -expires never "ad_browser_id" $ad_sec_browser_id + } + + if { $ad_sec_session_id == "" || \ + $last_issue > [ns_time] + [sec_session_timeout] || \ + $last_issue + [sec_session_timeout] < [ns_time] } { + # No session or user ID yet (or last_issue is way in the future, or session is expired). + + if { ![info exists last_issue] } { + set last_issue "" + } + + if { ![info exists db] } { + set db [ns_db gethandle] + } + sec_log "Bad session: session ID was \"$ad_sec_session_id\"; last_issue was \"$last_issue\"; ns_time is [ns_time]; timeout is [sec_session_timeout]" + + ad_assign_session_id $db + } else { + # The session already exists. + + if { $last_issue + [sec_session_cookie_reissue] < [ns_time] } { + ad_defer_dml " + update sec_sessions + set last_hit = [ns_time] + where session_id = $ad_sec_session_id + " + util_memoize_flush "sec_get_session_info $ad_sec_session_id" + sec_generate_session_id_cookie + } + } + + if { [info exists db] } { + ns_db releasehandle $db + } + + if { [regexp {^/pvt/} [ns_conn url]] && [ad_verify_and_get_user_id] == 0 } { + ad_redirect_for_registration + return "filter_return" + } + + return "filter_ok" +} + +proc_doc sec_lookup_property { browser id module name } { Used as a helper procedure for util_memoize to look up a particular property from the database. Returns [list $property_value $secure_p]. } { + set kind [ad_decode $browser "t" "browser" "session"] + + set db [ns_db gethandle log] + set selection [ns_db 0or1row $db " + select property_value, secure_p + from sec_${kind}_properties + where ${kind}_id = '[DoubleApos $id]' + and module = '[DoubleApos $module]' + and property_name = '[DoubleApos $name]' + "] + if { $selection == "" } { + ns_db releasehandle $db + return "" + } + + set_variables_after_query + ns_db releasehandle $db + return [list $property_value $secure_p] +} + +ad_proc ad_get_client_property { + { + -cache t + -browser f + -cache_only f + } + module + name +} { Looks up a property for the current session, or for the browser. If $cache is true, will use the cached value if available. If $cache_only is true, will never incur a database hit (i.e., will only return a value if cached). If the property is secure, we must be on a validated session over SSL. } { + set id [ad_decode $browser "t" [ad_get_browser_id] [ad_get_session_id]] + + set cmd [list sec_lookup_property $browser $id $module $name] + + if { $cache_only == "t" && ![util_memoize_value_cached_p $cmd] } { + return "" + } + + if { $cache != "t" } { + util_memoize_flush $cmd + } + + set property [util_memoize $cmd [sec_session_timeout]] + if { $property == "" } { + return "" + } + set value [lindex $property 0] + set secure_p [lindex $property 1] + + global ad_sec_validated + if { $secure_p != "f" && $ad_sec_validated != "secure" } { + return "" + } + + return $value +} + +ad_proc ad_set_client_property { + { + -secure f + -browser f + -deferred f + -persistent t + } + module name value +} { Sets a client (session- or browser-level) property. If $persistent is true, the new value will be written through to the database. If $deferred is true, the database write will be delayed until connection close (although calls to ad_get_client_property will still return the correct value immediately). If $secure is true, the property will not be retrievable except via a validated, secure (HTTPS) connection. } { + global ad_sec_validated + if { $secure != "f" && $ad_sec_validated != "secure" } { + error "Unable to set secure property in insecure or invalid session" + } + + set kind [ad_decode $browser "t" "browser" "session"] + + if { $persistent == "t" } { + # Write to database - either defer, or write immediately. First delete the old + # value if any; then insert the new one. + + set dml " + delete from sec_${kind}_properties + where ${kind}_id = [ad_get_${kind}_id] + and module = '[DoubleApos $module]' + and property_name = '[DoubleApos $name]' + " + if { $deferred == "t" } { + ad_defer_dml $dml + } else { + set db [ns_db gethandle log] + ns_db dml $db "begin transaction" + ns_db dml $db $dml + } + +# set dml " +# insert into sec_${kind}_properties(${kind}_id, module, property_name, property_value, secure_p) +# values([ad_get_${kind}_id], '[DoubleApos $module]', '[DoubleApos $name]', '', '[DoubleApos $secure]') +# returning property_value into :1 +# " + set dml " + insert into sec_${kind}_properties(${kind}_id, module, property_name, property_value, secure_p) + values([ad_get_${kind}_id], '[DoubleApos $module]', '[DoubleApos $name]', '', '[DoubleApos $secure]') + " + if { $deferred == "t" } { + ad_defer_dml $dml [list $value] + } else { + #ns_ora clob_dml $db $dml $value + ns_log Debug "value = $value" + ns_db dml $db $dml + ns_db dml $db "end transaction" + ns_db releasehandle $db + } + } + + # Remember the new value, seeding the memoize cache with the proper value. + util_memoize_seed [list sec_lookup_property $browser [ad_get_session_id] $module $name] [list $value $secure] +} + +proc_doc ad_secure_conn_p {} { Returns true if the connection [ns_conn] is secure (HTTPS), or false otherwise. } { + return [regexp {^https:} [ns_conn location]] +} + +proc_doc sec_generate_secure_token_cookie { secure_token } { Sets the ad_secure_token cookie. } { + # Sanity check - make sure we're using HTTPS. + if { [ad_secure_conn_p] } { + ad_set_cookie -secure t "ad_secure_token" $secure_token + } +} + +proc_doc sec_generate_session_id_cookie {} { Sets the ad_session_id cookie based on global variables. } { + global ad_sec_session_id + global ad_sec_user_id + global ad_sec_token + ad_set_cookie -replace t -max_age [sec_session_timeout] \ + "ad_session_id" "$ad_sec_session_id,$ad_sec_user_id,$ad_sec_token,[ns_time]" +} + +proc_doc sec_get_session_info { session_id } { Returns information for a session, in the form [list $user_id $token $secure_token $last_ip $last_hit]. } { + set db [ns_db gethandle log] + + set sql " + select user_id, token, secure_token, + last_ip, last_hit from sec_sessions + where session_id = $session_id + " + + set selection [ns_db 0or1row $db $sql] + ns_db releasehandle $db + + if { $selection == "" } { + sec_log "No row in sec_sessions for session_id $session_id!" + return + } + + set_variables_after_query + return [list $user_id $token $secure_token $last_ip $last_hit] +} + +ad_proc ad_validate_security_info { + { -secure f } +} { Validates the security info for the current connection, including session and user ID. If -secure t is specified, requires that the security info be secure to be considered valid. } { + global ad_sec_validated + global ad_sec_browser_id + global ad_sec_session_id + global ad_sec_user_id + global ad_sec_token + + if { $ad_sec_validated == "secure" || ( $secure == "f" && $ad_sec_validated == "insecure" ) } { + return 1 + } + + set security_info [util_memoize "sec_get_session_info $ad_sec_session_id" \ + [ad_parameter "SessionInfoCacheInterval" "" 600]] + if { $security_info == "" } { + set db [ns_db gethandle log] + ad_assign_session_id $db + ns_db releasehandle $db + set security_info [util_memoize "sec_get_session_info $ad_sec_session_id" \ + [ad_parameter "SessionInfoCacheInterval" "" 600]] + } + + set user_id [lindex $security_info 0] + set token [lindex $security_info 1] + set secure_token [lindex $security_info 2] + set last_ip [lindex $security_info 3] + set last_hit [lindex $security_info 4] + + if { $user_id == "" } { + set user_id 0 + } + + # We don't compare $last_ip, since some proxies rotate IP addresses. Thanks to lars@pinds.com. + if { $last_hit + [sec_session_timeout] < [ns_time] || $user_id != $ad_sec_user_id } { + ns_log Notice "session has timed out" + return 0 + } + + # If the insecure token doesn't match, bail out. + if { [string compare $token $ad_sec_token] } { + ns_log Notice "bad token - $token - $ad_sec_token" + return 0 + } + + if { $secure == "f" } { + # Passed with flying colors (for insecure validation). + set ad_sec_validated "insecure" + } else { + if { ![ad_secure_conn_p] } { + # An insecure connection can't be securely validated. + return 0 + } + + if { [empty_string_p $secure_token] } { + # Secure token not yet assigned. Generate it; also regenerate insecure token. + + set ad_sec_token [sec_random_token] + set secure_token [sec_random_token] + + set db [ns_db gethandle log] + ns_db dml $db " + update sec_sessions + set token = '$ad_sec_token', secure_token = '$secure_token' + where session_id = $ad_sec_session_id + " + ns_db releasehandle $db + util_memoize_seed "sec_get_session_info $ad_sec_session_id" [list $user_id $ad_sec_token $secure_token $last_ip $last_hit] + + sec_generate_session_id_cookie + sec_generate_secure_token_cookie $secure_token + } elseif { [string compare [ad_get_cookie "ad_secure_token"] $secure_token] } { + # Secure token doesn't mack. Nice try, sucka. + return 0 + } + set ad_sec_validated "secure" + } + return 1 +} + +proc ad_verify_identity { conn args why } { + set user_id [ad_verify_and_get_user_id] + if {$user_id > 0} { + # password checked out + return filter_ok + } + ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode [ns_conn url]?[ns_conn query]]" + return filter_return +} + +proc_doc ad_get_user_id {} "Gets the user ID, without checking to see whether it is valid. This procedure shouldn't be used for any page where security is important." { + global ad_sec_user_id + return $ad_sec_user_id +} + +proc_doc ad_get_session_id {} "Gets the session ID, without checking to see whether it is valid. This procedure shouldn't be used for any page where security is important." { + global ad_sec_session_id + return $ad_sec_session_id +} + +proc_doc ad_get_browser_id {} "Gets the browser ID." { + global ad_sec_browser_id + return $ad_sec_browser_id +} + +ad_proc ad_verify_and_get_user_id { + { -secure f } + { db "" } +} "Returns the current user's ID, verifying its validity (or returning 0 if unable to do so)." { + if { ![ad_validate_security_info -secure $secure] } { + return 0 + } + return [ad_get_user_id] +} + +ad_proc ad_verify_and_get_session_id { + { -secure f } + { db "" } +} "Returns the current session's ID, verifying its validity (or returning 0 if unable to do so)." { + if { ![ad_validate_security_info -secure $secure] } { + return 0 + } + return [ad_get_session_id] +} + +# handling privacy + +proc_doc ad_privacy_threshold {} "Pages that are consider whether to display a user's name or email address should test to make sure that a user's priv_ from the database is less than or equal to what ad_privacy_threshold returns." { + set session_user_id [ad_get_user_id] + if {$session_user_id == 0} { + # viewer of this page isn't logged in, only show stuff + # that is extremely unprivate + set privacy_threshold 0 + } else { + set privacy_threshold 5 + } + return $privacy_threshold +} + + +proc_doc ad_redirect_for_registration {} "Redirects user to /register/index.tcl to require the user to register. When registration is complete, the user will be returned to the current location. All variables in ns_getform (both posts and gets) will be maintained." { + set form [ns_getform] + set url_args "" + + # note that there is no built-in function that will change + # posted variables to url variables, so we write our own + + if ![empty_string_p $form] { + set form_size [ns_set size $form] + set form_counter_i 0 + while { $form_counter_i<$form_size } { + if {[string compare $form_counter_i "0"] == 0} { + append url_args "?" + } else { + append url_args "&" + } + append url_args "[ns_set key $form $form_counter_i]=[ns_urlencode [ns_set value $form $form_counter_i]]" + incr form_counter_i + } + } + ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode [ns_conn url]$url_args]" + return +} + +proc_doc ad_maybe_redirect_for_registration {} "Checks to see if a user is logged in. If not, redirects to /register/index.tcl to require the user to register. When registration is complete, the user will return to the current location. All variables in ns_getform (both posts and gets) will be maintained. Note that this will return out of its caller so that the caller need not explicitly call \"return\". Returns the user id if login was succesful." { + set user_id [ad_verify_and_get_user_id] + if { $user_id != 0 } { + # user is in fact logged in, terminate + return $user_id + } + ad_redirect_for_registration + + # blow out of 2 levels + return -code return +} + +# bouncing people out of content_sections that are private +# we can't just run this in-line because the ns_db calls aren't defined while Private +# Tcl is being sourced + +proc ad_filter_restricted_content_sections {} { + # let's also bounce them out of private content sections + set db [ns_db gethandle] + set selection [ns_db select $db " + select section_url_stub + from content_sections + where scope='public' + and requires_registration_p = 't'"] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_log Notice "Going to filter out access to $section_url_stub, marked as requiring registration in the content_sections table" + ad_register_filter preauth HEAD "${section_url_stub}*" ad_verify_identity + ad_register_filter preauth GET "${section_url_stub}*" ad_verify_identity + ad_register_filter preauth POST "${section_url_stub}*" ad_verify_identity + } + ns_db releasehandle $db +} + +ad_schedule_proc -once t 5 ad_filter_restricted_content_sections + +# sort of the same idea as the above but for things like staff +# servers where the whole site may be restricted + +ns_share -init {set ad_restrict_entire_server_to_registered_users_registered_p 0} ad_restrict_entire_server_to_registered_users_registered_p + +if {[ad_parameter RestrictEntireServerToRegisteredUsersP "" 0] && !$ad_restrict_entire_server_to_registered_users_registered_p} { + # we don't want to keep registering filters every time the server is re-initialize + set ad_restrict_entire_server_to_registered_users_registered_p 1 + ns_log Notice "ad-security.tcl is registering ad_restrict_entire_server_to_registered_users to bounce unregistered users out of pretty much everything." + ad_register_filter preauth GET /* ad_restrict_entire_server_to_registered_users + ad_register_filter preauth POST /* ad_restrict_entire_server_to_registered_users + ad_register_filter preauth HEAD /* ad_restrict_entire_server_to_registered_users +} + +proc_doc ad_restrict_entire_server_to_registered_users {conn args why} "A preauth filter that will halt service of any page if the user is unregistered, except the site index page and stuff underneath /register" { + if {![string match "/index.tcl" [ns_conn url]] && ![string match "/" [ns_conn url]] && ![string match "/register/*" [ns_conn url]] && ![string match "/SYSTEM/*" [ns_conn url]] && ![string match "/cookie-chain*" [ns_conn url]] && ![string match "/user_please_login.tcl" [ns_conn url]]} { + # not one of the magic acceptable URLs + set user_id [ad_verify_and_get_user_id] + if {$user_id == 0} { + ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode [ns_conn url]?[ns_conn query]]" + return filter_return + } + } + return filter_ok +} + + +## generating a random string + +proc_doc ad_generate_random_string {{length 8}} "Generates a random string made of numbers and letters" { + set password "" + + set character_list [list a b c d e f g h i j k m n p q r s t u v w x y z A B C D E F G H I J K L M N P Q R S T U V W X Y Z 2 3 4 5 6 7 8 9] + + for {set random_string_counter 0} {$random_string_counter < $length} {incr random_string_counter } { + set chosen_index [randomRange [llength $character_list]] + append password [lindex $character_list $chosen_index] + } + return $password +} + + + +util_report_successful_library_load + + + + + + + + + + Index: web/openacs/tcl/ad-server-cluster.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-server-cluster.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-server-cluster.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,80 @@ +# ad-server-cluster.tcl,v 3.1 2000/03/07 16:49:18 jsalz Exp +# File: ad-server-cluster.tcl +# Author: Jon Salz <jsalz@mit.edu> +# Date: 7 Mar 2000 +# Description: Provides methods for communicating between load-balanced servers. + +util_report_library_entry + +proc_doc server_cluster_enabled_p {} { Returns true if clustering is enabled. } { + return [ad_parameter ClusterEnabledP server-cluster 0] +} + +proc_doc server_cluster_all_hosts {} { Returns a list of all hosts, possibly including this host, in the server cluster. } { + if { ![server_cluster_enabled_p] } { + return [list] + } + return [ad_parameter_all_values_as_list ClusterPeerIP server-cluster] +} + +proc_doc server_cluster_peer_hosts {} { Returns a list of all hosts, excluding this host, in the server cluster. } { + set peer_hosts [list] + set my_ip [ns_config ns/server/[ns_info server]/module/nssock Address] + + foreach host [server_cluster_all_hosts] { + if { $host != $my_ip } { + lappend peer_hosts $host + } + } + + return $peer_hosts +} + +proc_doc server_cluster_authorized_p { ip } { Can a request coming from $ip be a valid cluster request, i.e., matches some value in ClusterIPMask or is 127.0.0.1? } { + if { ![server_cluster_enabled_p] } { + return 0 + } + + if { $ip == "127.0.0.1" } { + return 1 + } + # lsearch -glob appears to crash AOLserver 2. Oh well. + foreach glob [ad_parameter_all_values_as_list ClusterAuthorizedIP server-cluster] { + if { [string match $glob $ip] } { + return 1 + } + } + return 0 +} + +proc server_cluster_do_httpget { url timeout } { + if { [catch { + set page [ns_httpget $url $timeout 0] + if { ![regexp -nocase successful $page] } { + ns_log "Error" "Clustering: ns_httpget $url returned unexpected value. Is /SYSTEM/flush-memoized-statement.tcl set up on this host?" + } + } error] } { + ns_log "Error" "Clustering: Unable to ns_httpget $url (with timeout $timeout): $error" + } +} + +proc_doc server_cluster_logging_p {} { Returns true if we're logging cluster requests. } { + return [ad_parameter EnableLoggingP server-cluster 0] +} + +ad_proc server_cluster_httpget_from_peers { + { -timeout 5 } + url +} { Schedules an HTTP GET request to be issued immediately to all peer hosts (using ad_schedule_proc -once t -thread t -debug t 0). } { + if { ![string match /* $url] } { + set url "/$url" + } + foreach host [server_cluster_peer_hosts] { + # Schedule the request. Don't actually issue the request in this thread, since + # (a) we want to parallelize the requests, and (b) we want this procedure to + # return immediately. + ad_schedule_proc -once t -thread t -debug t 0 server_cluster_do_httpget "http://$host$url" $timeout + } +} + +util_report_successful_library_load Index: web/openacs/tcl/ad-sidegraphics.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-sidegraphics.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-sidegraphics.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,51 @@ +# ad-sidegraphics.tcl,v 3.0 2000/02/06 03:12:46 ron Exp +# +# ad-sidegraphics.tcl +# +# created April 21, 1999 by philg@mit.edu +# + +proc_doc ad_image_size {graphics_url} "Returns Tcl list of WIDTH and HEIGHT of image, works for both JPEG and GIF. We need our own proc because AOLserver is stupid and has separate API calls for JPEG and GIF." { + # call ns_gifsize or ns_jpegsize, as appropriate + if [string match "http://*" [string tolower $graphics_url]] { + # this is a image on a foreign server, we won't be able to + # figure out its size + return "" + } + set what_aolserver_told_us "" + set full_filename "[ns_info pageroot]$graphics_url" + set guessed_type [ns_guesstype $full_filename] + if { $guessed_type == "image/jpeg" } { + catch { set what_aolserver_told_us [ns_jpegsize $full_filename] } + } elseif { $guessed_type == "image/gif" } { + catch { set what_aolserver_told_us [ns_gifsize $full_filename] } + } + return $what_aolserver_told_us +} + +proc_doc ad_decorate_side {} "IF side graphics are enabled AND a graphics URL is spec'd for the current THEN this returns an IMG ALIGN=RIGHT with width and height tags. Otherwise return empty string." { + # we use a GLOBAL variable (shared by procs in a thread) as opposed to + # an ns_share (shared by many threads) + global sidegraphic_displayed_p + if ![ad_parameter EnabledP sidegraphics 0] { + return "" + } + # let's see if this URL even has a side graphic + set graphic_url [ad_parameter [ns_conn url] sidegraphics] + if [empty_string_p $graphic_url] { + # no side graphic for this particular page + return "" + } + # OK, the system is enabled and we've got a side graphic for this URL + # we want to get WIDTH and HEIGHT tags + set width_height_list [util_memoize "ad_image_size $graphic_url" 900] + if ![empty_string_p $width_height_list] { + set width [lindex $width_height_list 0] + set height [lindex $width_height_list 1] + set extra_tags "width=$width height=$height hspace=10 vspace=10" + } else { + set extra_tags "" + } + set sidegraphic_displayed_p 1 + return "<img align=right $extra_tags hspace=20 src=\"$graphic_url\">" +} Index: web/openacs/tcl/ad-style.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-style.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-style.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,223 @@ +# /tcl/ad-style.tcl +# +# philg@mit.edu on June 30, 1999 +# +# ad-style.tcl,v 3.4.2.2 2000/03/18 01:19:49 ron Exp +# ----------------------------------------------------------------------------- + +# +# establishing site-wide style conventions and supporting +# +# documentation: /doc/style.html +# + +util_report_library_entry + +proc_doc ad_register_styletag {tagname tag_documentation proc_body} {Defines a new site-wide style, includes an ADP tag and a procedure for use by .tcl pages (starting with "ad_style_"). The supplied procedure body should reference $string and $tagset (the variables given in the AOLserver Tcl API docs for ns_register_adptag)} { + ns_share ad_styletag + ns_share ad_styletag_source_file + set generated_proc_name "ad_style_$tagname" + proc_doc $generated_proc_name {{string ""} {tagset ""}} "Proc generated by ad_register_styletag to support the $tagname ADP tag." $proc_body + # let's register the ADP tag now + ns_register_adptag $tagname "/$tagname" $generated_proc_name + set ad_styletag($tagname) $tag_documentation + set ad_styletag_source_file($tagname) [info script] +} + +proc ad_style_template_root_internal {} { + if ![empty_string_p [ad_parameter TemplateRoot "style"]] { + return [ad_parameter TemplateRoot "style"] + } + # we have to regsub to turn /web/yourservername/www into + # /web/yourservername/templates + set page_root [ns_info pageroot] + regsub {/www$} $page_root {/templates} template_root + return $template_root +} + +proc ad_style_template_root {} { + return [util_memoize "ad_style_template_root_internal"] +} + +# per /doc/style.html we standardize on "language_preference" +# and "prefer_text_only_p" as the names of the cookies +proc ad_style_language_from_cookie {} { + set headers [ns_conn headers] + set cookie [ns_set get $headers Cookie] + if { [regexp {language_preference=([^;]+)} $cookie {} language_preference] } { + return $language_preference + } else { + return "" + } +} + +proc ad_style_plain_fancy_from_cookie {} { + set headers [ns_conn headers] + set cookie [ns_set get $headers Cookie] + if { [regexp {prefer_text_only_p=([^;]+)} $cookie {} prefer_text_only_p] } { + if { $prefer_text_only_p == "t" } { + return "plain" + } else { + return "fancy" + } + return $language_preference + } else { + return "" + } +} + +proc_doc ad_style_user_preferences_from_db {user_id} "Returns a list of prefer_text_only_p and language_preference from the users_preferences table; probably you should call this within a util_memoize so that you aren't kicking the stuffing out of Oracle." { + set db [ns_db gethandle subquery] + set selection [ns_db 0or1row $db "select prefer_text_only_p, language_preference from users_preferences where user_id = $user_id"] + if { $selection != "" } { + set_variables_after_query + set result_list [list $prefer_text_only_p $language_preference] + } else { + set result_list [list "" ""] + } + ns_db releasehandle $db + return $result_list +} + +# takes list of raw filenames and returns a list of lists +# (each sublist is score then filename) +# we give a template scores as follows: +# 2000 for having the user's preferred language +# 1000 for having the site's default language +# 200 for having the user's default plain/fanciness +# 100 for having the site's default plain/fanciness +# subtract the length of the filename so that shorter ones have precedence +# (note that language outweighs graphical fanciness) +proc ad_style_score_templates {template_filename_list} { + # set defaults + set user_preferred_language "" + set user_preferred_plain_fancy "" + set site_default_language [ad_parameter LanguageSiteDefault style] + set site_default_plain_fancy [ad_parameter PlainFancySiteDefault style] + # let's figure out first whether or not this is a logged-in person + set user_id [ad_get_user_id] + if { $user_id == 0 } { + # not logged in, maybe cookied though + if [ad_parameter LanguageCookieP style] { + # let's at least look for a cookie + set user_preferred_language [ad_style_language_from_cookie] + } + if [ad_parameter PlainFancyCookieP style] { + set user_preferred_plain_fancy [ad_style_plain_fancy_from_cookie] + } + } else { + # this is a logged-in user, let's get this info from users_preferences + set preferences_list [util_memoize "ad_style_user_preferences_from_db $user_id" 900] + set prefer_text_only_p [lindex $preferences_list 0] + set language_preference [lindex $preferences_list 1] + # if the text_only_p column isn't null, set user preference + if { $prefer_text_only_p == "t" } { + set user_preferred_plain_fancy "plain" + } elseif { $prefer_text_only_p == "f" } { + set user_preferred_plain_fancy "fancy" + } + set user_preferred_language $language_preference + } + set result_list [list] + foreach filename $template_filename_list { + set score 0 + if { ![empty_string_p $user_preferred_language] && [string match "*.$user_preferred_language.*" $filename] } { + incr score 2000 + } + if { ![empty_string_p $site_default_language] && [string match "*.$site_default_language.*" $filename] } { + incr score 1000 + } + if { ![empty_string_p $user_preferred_plain_fancy] && [string match "*.$user_preferred_plain_fancy.*" $filename] } { + incr score 200 + } + if { ![empty_string_p $site_default_plain_fancy] && [string match "*.$site_default_plain_fancy.*" $filename] } { + incr score 100 + } + set score [expr $score - [string length $filename]] + lappend result_list [list $score $filename] + } + return $result_list +} + +proc ad_style_sort_by_score {l1 l2} { + if { [lindex $l1 0] < [lindex $l2 0] } { + return -1 + } elseif { [lindex $l1 0] == [lindex $l2 0] } { + return 0 + } else { + return 1 + } +} + + +proc_doc ad_return_template { { file_name "" } { cache_p 1 } } { Finds a template to source (looks at what templates are available, what the user prefers, and what the site defaults are), parses it in the caller's environment, and ns_return's the bytes to the user. file_name, if specified, overrides the base file name used to determine which template to use. cache_p, if specified, can disable or enable caching by altering the HTTP header.} { + set full_url [ns_conn url] + + if { [string index $full_url [expr [string length $full_url]-1]] == "/" } { + append full_url "index.tcl" + } + + set just_the_dir [file dirname $full_url] + + if [empty_string_p $file_name] { + set file_name [file rootname [file tail $full_url]] + } + set template_directory "[ad_style_template_root]$just_the_dir" + set glob_pattern "${template_directory}/${file_name}.*.adp" + ns_log Notice "GLOB pattern: $glob_pattern" + set available_templates [glob -nocomplain $glob_pattern] + + if { [llength $available_templates] == 0 } { + ad_return_error "No template available" "We can't find any template for presenting the output of this script. Sorry but you're a victim of our graphics ambition. Please complain to the site owner." + } else { + # we have at least one template available; we need to score + # them against user's criteria, then pick the highest scorer + set list_of_lists [ad_style_score_templates $available_templates] + set sorted_list [lsort -decreasing -command ad_style_sort_by_score $list_of_lists] + set top_scoring_template_filename [lindex [lindex $sorted_list 0] 1] + set fully_qualified_template_filename "$top_scoring_template_filename" + + if { $cache_p } { + # build the http header, with a no cache pragma if cache_p is 0 + set http_header "HTTP/1.0 200 OK +MIME-Version: 1.0 +Content-Type: text/html +Pragma: No-Cache + +" + eval "uplevel { ns_write \"$http_header\[ns_adp_parse -file \"$fully_qualified_template_filename\"\]\" }" + } else { + eval "uplevel { ns_return 200 text/html \[ns_adp_parse -file \"$fully_qualified_template_filename\"\] }" + } + } +} + + +# sample style tag +# You will get an error if you try to register +# a style tag more than once. + +ad_register_styletag footer "Standard ArsDigita footer." { + global sidegraphic_displayed_p + set signatory $string + if [empty_string_p $signatory] { + set signatory [ad_system_owner] + } + if { [info exists sidegraphic_displayed_p] && $sidegraphic_displayed_p } { + # we put in a BR CLEAR=RIGHT so that the signature will clear any side graphic + # from the ad-sidegraphic.tcl package + set extra_br "<br clear=right>" + } else { + set extra_br "" + } + return " +$extra_br +<hr> +<a href=\"mailto:$signatory\"><address>$signatory</address></a> +" +} + +util_report_successful_library_load + + + Index: web/openacs/tcl/ad-table-display.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-table-display.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-table-display.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,996 @@ +# ad-table-display.tcl,v 3.2 2000/02/22 22:03:49 richardl Exp +# This is the table, dimensional bar and sort tools. +# +# an example of their use can be found in /tools/ad-table-display-example.txt +# + + +# Dimensional selection bars. +# +proc_doc ad_dimensional {option_list {url {}} {options_set ""} {optionstype url}} { + Generate an option bar as in the ticket system; + <ul> + <li> option_list -- the structure with the option data provided + <li> url -- url target for select (if blank we set it to ns_conn url). + <li> options_set -- if not provided defaults to [ns_getform], for hilite of selected options. + <li> optionstype -- only url is used now, was thinking about extending + so we get radio buttons and a form since with a slow select updating one + thing at a time would be stupid. + </ul> + + <p> + option_list structure is + <pre> + { + {variable "Title" defaultvalue + { + {value "Text" {key clause}} + ... + } + } + ... + } + + an example: + + set dimensional_list { + {visited "Last Visit" 1w { + {never "Never" {where "last_visit is null"}} + {1m "Last Month" {where "last_visit + 30 > sysdate()"}} + {1w "Last Week" {where "last_visit + 7 > sysdate()"}} + {1d "Today" {where "last_visit > trunc(sysdate())"}} + }} + ..(more of the same).. + } + </pre> +} { + set html {} + + if {[empty_string_p $option_list]} { + return + } + + if {[empty_string_p $options_set]} { + set options_set [ns_getform] + } + + if {[empty_string_p $url]} { + set url [ns_conn url] + } + + append html "<table border=0 cellspacing=0 cellpadding=3 width=100%>\n<tr>\n" + + foreach option $option_list { + append html " <th bgcolor=\"#ECECEC\">[lindex $option 1]</th>\n" + } + append html "</tr>\n" + + append html "<tr>\n" + + foreach option $option_list { + append html " <td align=center>\[" + + # find out what the current option value is. + # check if a default is set otherwise the first value is used + set option_key [lindex $option 0] + set option_val {} + if { ! [empty_string_p $options_set]} { + set option_val [ns_set get $options_set $option_key] + } + if { [empty_string_p $option_val] } { + set option_val [lindex $option 2] + } + + set first_p 1 + foreach option_value [lindex $option 3] { + set thisoption [lindex $option_value 0] + if { $first_p } { + set first_p 0 + } else { + append html " | " + } + + if {[string compare $option_val $thisoption] == 0} { + append html "<strong>[lindex $option_value 1]</strong>" + } else { + append html "<a href=\"$url?[export_ns_set_vars "url" $option_key $options_set]&[ns_urlencode $option_key]=[ns_urlencode $thisoption]\">[lindex $option_value 1]</a>" + } + } + append html "\]</td>\n" + } + append html "</tr>\n</table>\n" +} + + +proc_doc ad_dimensional_sql {option_list {what "where"} {joiner "and"} {options_set ""}} { + see ad_dimensional for the format of option_list + <p> + Given what clause we are asking for and the joiner this returns + the sql fragment +} { + set out {} + + if {[empty_string_p $option_list]} { + return + } + + if {[empty_string_p $options_set]} { + set options_set [ns_getform] + } + + foreach option $option_list { + # find out what the current option value is. + # check if a default is set otherwise the first value is used + set option_key [lindex $option 0] + set option_val {} + # get the option from the form + if { ! [empty_string_p $options_set]} { + set option_val [ns_set get $options_set $option_key] + } + #otherwise get from default + if { [empty_string_p $option_val] } { + set option_val [lindex $option 2] + } + + foreach option_value [lindex $option 3] { + set thisoption [lindex $option_value 0] + if {[string compare $option_val $thisoption] == 0} { + set code [lindex $option_value 2] + if {![empty_string_p $code]} { + if {[string compare [lindex $code 0] $what] == 0} { + append out " $joiner [uplevel [list subst [lindex $code 1]]]" + } + } + } + } + } + + return $out +} + + +proc_doc ad_dimensional_set_variables {option_list {options_set ""}} { + set the variables defined in option_list from the form provided + (form defaults to ns_conn form) or to default value from option_list if + not in the form data. + <p> + You only really need to call this if you need the variables + (for example to pick which select statement and table to actually use) +} { + set out {} + + if {[empty_string_p $option_list]} { + return + } + + if {[empty_string_p $options_set]} { + set options_set [ns_getform] + } + + foreach option $option_list { + # find out what the current option value is. + # check if a default is set otherwise the first value is used + set option_key [lindex $option 0] + set option_val {} + # get the option from the form + if { ! [empty_string_p $options_set] && [ns_set find $options_set $option_key] != -1} { + uplevel [list set $option_key [ns_set get $options_set $option_key]] + } else { + uplevel [list set $option_key [lindex $option 2]] + } + } +} + + + +ad_proc ad_table { + { + -Torder_target_url {} + -Torderby {} + -Tmissing_text "<em>No data found.</em>" + -Tsuffix {} + -Tcolumns {} + -Taudit {} + -Trows_per_band 1 + -Tband_colors {{} {\"\#ececec\"}} + -Trows_per_page 0 + -Tmax_rows 0 + -Ttable_extra_html {} + -Theader_row_extra {bgcolor=\"\#f8f8f8\"} + -Ttable_break_html "<p>" + -Tpre_row_code {} + -Trow_code {\[subst \$Trow_default\]} + -Tpost_data_ns_sets {} + } + Tdb selection Tdatadef +} { + Note: all the variables in this function are named Tblah (except selection for + the obvious reasons) since otherwise we cannot safely call + set_variables_from_query since we could potentially have namespace collisions + <p> + build and return an html fragment given an active query and a data definition. + <ul> + <li> Tdb and selection -- variables for an active query + <li> Tdatadef -- the table declaration. + </ul> + + Datadef structure : + <pre> + { + {column_id "Column_Heading" order_clause display_info} + ... + } + </pre> + <ul> + <li> column_id -- what to set as orderby for sorting and also is + the default variable for the table cell. + + <li> the text for the heading to be wrapped in <<th>> and </th> tags. + I am not entirely happy that things are wrapped automatically since you might not + want plain old th tags but I also don;t want to add another field in the structure. + + <li> order_clause -- the order clause for the field. If null it defaults to + "column_id $order". It is also interpolated, with orderby and order + defined as variables so that: + <pre> + {upper(last_name) $order, upper(first_names) $order} + </pre> + would do the right thing. + <p> + the value "no_sort" should be used for columns which should not allow sorting. + + <li> display_info. If this is a null string you just default to generating + <td>column_id</td>. If it is a string in the lookup list + then special formatting is applied; this is l r c tf 01 for + align=left right center, Yes/No (from tf), + Yes/No from 0/1. + + <p> + if the display stuff is not any of the above then it is interpolated and the results + returned (w/o any <td> tags put in). + An example: + <pre> + set table_def { + {ffn "Full Name" + {upper(last_name) $order, upper(first_names) $order} + {<td><a href="/admin/users/one.tcl?user_id=$user_id">$first_names $last_name</a></td>}} + {email "e-Mail" {} {<td><a href="mailto:$email">$email</a>}} + {email_bouncing_p "e-Bouncing?" {} tf} + {user_state "State" {} {}} + {last_visit "Last Visit" {} r} + {actions "Actions" no_sort {<td> + <a href="/admin/users/basic-info-update.tcl?user_id=$user_id">Edit Info</a> | + <a href="/admin/users/password-update.tcl?user_id=$user_id">New Password</a> | + [ad_registration_finite_state_machine_admin_links $user_state $user_id]}} + } + </pre> + </ul> + +} { + set Tcount 0 + set Tband_count 0 + set Tpage_count 0 + set Tband_color 0 + set Tn_bands [llength $Tband_colors] + set Tform [ns_conn form] + + # get the current ordering information + set Torderbykey {::not_sorted::} + set Treverse {} + regexp {^([^*,]+)([*])?} $Torderby match Torderbykey Treverse + if {$Treverse == "*"} { + set Torder desc + } else { + set Torder asc + } + + # set up the target url for new sorts + if {[empty_string_p $Torder_target_url]} { + set Torder_target_url [ns_conn url] + } + set Texport "[uplevel [list export_ns_set_vars url [list orderby$Tsuffix]]]&" + if {$Texport == "&"} { + set Texport {} + } + set Tsort_url "$Torder_target_url?${Texport}orderby$Tsuffix=" + + + set Thtml {} + set Theader {} + + # build the list of columns to display... + set Tcolumn_list [ad_table_column_list $Tdatadef $Tcolumns] + + # generate the header code + # + append Theader "<table $Ttable_extra_html>\n" + if {[empty_string_p $Theader_row_extra]} { + append Theader "<tr>\n" + } else { + append Theader "<tr $Theader_row_extra>\n" + } + foreach Ti $Tcolumn_list { + set Tcol [lindex $Tdatadef $Ti] + if { ( [ns_set find $selection [lindex $Tcol 0]] < 0 + && [empty_string_p [lindex $Tcol 2]] ) + || [string compare [lindex $Tcol 2] no_sort] == 0 + } { + + # not either a column in the select or has sort code + # then just a plain text header so do not do sorty things + append Theader " <th>[lindex $Tcol 1]</th>\n" + } else { + if {[string compare [lindex $Tcol 0] $Torderbykey] == 0} { + if {$Torder == "desc"} { + set Tasord "^" + } else { + set Tasord "v" + } + } else { + set Tasord {} + } + append Theader " <th><a href=\"$Tsort_url[ns_urlencode [ad_new_sort_by [lindex $Tcol 0] $Torderby]]\">\n" + append Theader "[lindex $Tcol 1]</a> $Tasord</th>\n" + } + } + append Theader "</tr>\n" + + + # + # This has gotten kind of ugly. Here we are looping over the + # rows returned and then potentially a list of ns_sets which can + # be passed in (grrr. Richard Li needs for general protections stuff + # for "fake" public record which does not exist in DB). + # + + set Tpost_data 0 + + while { 1 } { + if {!$Tpost_data && [ns_db getrow $Tdb $selection]} { + # in all its evil majesty + set_variables_after_query + } else { + # move on to fake rows... + incr Tpost_data + } + + if { $Tpost_data && $Tpost_data <= [llength $Tpost_data_ns_sets] } { + # bind the Tpost_data_ns_sets row of the passed in data + set_variables_after_query_not_selection [lindex $Tpost_data_ns_sets [expr $Tpost_data - 1]] + } elseif { $Tpost_data } { + # past the end of the fake data drop out. + break + } + + if { $Tmax_rows && $Tcount >= $Tmax_rows } { + if { ! $Tpost_data } { + # we hit max count and had rows left to read... + ns_db flush $Tdb + } + break + } + + # deal with putting in the header if need + if { $Tcount == 0 } { + append Thtml "$Theader" + } elseif { $Tpage_count == 0 } { + append Thtml "</table>\n$Ttable_break_html\n$Theader" + } + + + # first check if we are in audit mode and if the audit columns have changed + set Tdisplay_changes_only 0 + if {![empty_string_p $Taudit] && $Tcount > 0} { + # check if the audit key columns changed + foreach Taudit_key $Taudit { + if {[string compare [set $Taudit_key] [set P$Taudit_key]] == 0} { + set Tdisplay_changes_only 1 + } + } + } + + # this is for breaking on sorted field etc. + append Thtml [subst $Tpre_row_code] + + if { ! $Tdisplay_changes_only } { + # in audit mode a record spans multiple rows. + incr Tcount + incr Tband_count + } + incr Tpage_count + + if { $Trows_per_page && $Tpage_count >= $Trows_per_page } { + set Tband_color 0 + set Tband_count 0 + set Tpage_count 0 + + } + + # generate the row band color + if { $Tn_bands } { + if { $Tband_count >= $Trows_per_band } { + set Tband_count 0 + set Tband_color [expr ($Tband_color + 1) % $Tn_bands ] + } + # do this check since we would like the ability to band with + # page background as well + if {[empty_string_p [lindex $Tband_colors $Tband_color]]} { + set Trow_default "<tr>\n" + } else { + set Trow_default "<tr bgcolor=[lindex $Tband_colors $Tband_color]>\n" + } + } else { + set Trow_default "<tr>\n" + } + + append Thtml [subst $Trow_code] + + foreach Ti $Tcolumn_list { + set Tcol [lindex $Tdatadef $Ti] + # If we got some special formatting code we handle it + # single characters r l c are special for alignment + set Tformat [lindex $Tcol 3] + set Tcolumn [lindex $Tcol 0] + switch $Tformat { + "" {set Tdisplay_field " <td>[set $Tcolumn]</td>\n"} + r {set Tdisplay_field " <td align=right>[set $Tcolumn]</td>\n"} + l {set Tdisplay_field " <td align=left>[set $Tcolumn]</td>\n"} + c {set Tdisplay_field " <td align=center>[set $Tcolumn]</td>\n"} + tf {set Tdisplay_field " <td align=center>[util_PrettyBoolean [set $Tcolumn]]</td>\n"} + 01 {set Tdisplay_field " <td align=center>[util_PrettyTclBoolean [set $Tcolumn]]</td>\n"} + bz {set Tdisplay_field " <td align=right> [blank_zero [set $Tcolumn]]</td>\n"} + default {set Tdisplay_field " [subst $Tformat]\n"} + } + + if { $Tdisplay_changes_only + && [string compare $Tdisplay_field $Tlast_display($Ti)] == 0} { + set Tdisplay_field {<td> </td>} + } else { + set Tlast_display($Ti) $Tdisplay_field + } + append Thtml $Tdisplay_field + } + + append Thtml "</tr>\n" + + # keep the last row around so we can do fancy things. + # so on next row we can say things like if $Pvar != $var not blank + if { $Tpost_data && $Tpost_data <= [llength $Tpost_data_ns_sets] } { + # bind the Tpost_data_ns_sets row of the passed in data + set_variables_after_query_not_selection [lindex $Tpost_data_ns_sets [expr $Tpost_data - 1]] P + } else { + set_variables_after_query_not_selection $selection P + } + } + + if { $Tcount > 0} { + append Thtml "</table>\n" + } else { + append Thtml $Tmissing_text + } + + return $Thtml +} + + +ad_proc ad_table_column_list { + { + -sortable all + } + datadef columns +} { + build a list of pointers into the list of column definitions + <p> + returns a list of indexes into the columns one per column it found + <p> + -sortable from t/f/all +} { + set column_list {} + if {[empty_string_p $columns]} { + for {set i 0} {$i < [llength $datadef]} {incr i} { + if {$sortable == "all" + || ($sortable == "t" && [lindex [lindex $datadef $i] 2] != "no_sort") + || ($sortable == "f" && [lindex [lindex $datadef $i] 2] == "no_sort") + } { + lappend column_list $i + } + } + } else { + set colnames {} + foreach col $datadef { + if {$sortable == "all" + || ($sortable == "t" && [lindex $col 2] != "no_sort") + || ($sortable == "f" && [lindex $col 2] == "no_sort") + } { + lappend colnames [lindex $col 0] + } else { + # placeholder for invalid column + lappend colnames "X+X" + } + } + foreach col $columns { + set i [lsearch $colnames $col] + if {$i > -1} { + lappend column_list $i + } + } + } + + return $column_list +} + + + + +proc_doc ad_sort_primary_key orderby { + return the primary (first) key of an order spec + used by +} { + if {[regexp {^([^*,]+)} $orderby match]} { + return $match + } + return $orderby +} + + + +proc_doc ad_table_same varname { + Called from inside ad_table. + + returns true if the variable has same value as + on the previous row. Always false for 1st row. + +} { + if { [uplevel set Tcount] + && [uplevel string compare \$$varname \$P$varname] == 0} { + return 1 + } else { + return 0 + } +} + +proc_doc ad_table_span {str {td_html "align=left"}} { + given string the function generates a row which spans the + whole table. +} { + return "<tr><td colspan=[uplevel llength \$Tcolumn_list] $td_html>$str</td></tr>" +} + + +proc_doc ad_table_form {datadef {type select} {return_url {}} {item_group {}} {item {}} {columns {}} {allowed {}}} { + builds a form for chosing the columns to display + <p> + columns is a list of the currently selected columns. + <p> + allowed is the list of all the displayable columns, if empty + all columns are allowed. +} { + # first build a map of all available columns + set sel_list [ad_table_column_list $datadef $allowed] + + # build the map of currently selected columns + set sel_columns [ad_table_column_list $datadef $columns] + + set max_columns [llength $sel_list] + set n_sel_columns [llength $sel_columns] + + set html {} + if {[string compare $item "CreateNewCustom"] == 0} { + set item {} + } + # now spit out the form fragment. + if {![empty_string_p $item]} { + append html "<h2>Editing <strong>$item</strong></h2>" + append html "<form method=get action=\"/tools/table-custom.tcl\">" + append html "<input type=submit value=\"Delete this view\">" + append html "<input type=hidden name=delete_the_view value=\"1\">" + append html "[export_form_vars item_group item]" + if {![empty_string_p $return_url]} { + append html "[export_form_vars return_url]" + } + append html "</form>" + } + + append html "<form method=get action=\"/tools/table-custom.tcl\">" + if {![empty_string_p $return_url]} { + append html "[export_form_vars return_url]" + } + if {[empty_string_p $item_group]} { + set item_group [ns_conn url] + } + + append html "[export_form_vars item_group]" + if {![empty_string_p $item]} { + set item_original $item + append html "[export_form_vars item_original]" + append html "<input type=submit value=\"Save changes\">" + } else { + append html "<input type=submit value=\"Save new view\">" + } + + append html "<table>" + append html "<tr><th>Name:</th><td><input type=text size=60 name=item [export_form_value item]></td></tr>" + if {![empty_string_p $item]} { + set item_original item + append html "[export_form_vars item_original]" + append html "<tr><td> </td><td><em>Editing the name will rename the view</em></td></tr>" + } + + if {[string compare $type select] == 0} { + # select table + set options "<option value=\"\">---" + foreach opt $sel_list { + append options " <option value=\"[lindex [lindex $datadef $opt] 0]\">[lindex [lindex $datadef $opt] 1]" + } + + for {set i 0} { $i < $max_columns} {incr i} { + if {$i < $n_sel_columns} { + set match [lindex [lindex $datadef [lindex $sel_columns $i]] 0] + regsub "(<option )(value=\"$match\">)" $options "\\1 selected \\2" out + } else { + set out $options + } + append html "<tr><th>[expr $i + 1]</th><td><select name=\"col\">$out</select></td></tr>\n" + } + } else { + # radio button table + append html "<tr><th>Col \#</th>" + foreach opt $sel_list { + append html "<th>[lindex [lindex $datadef $opt] 1]</th>" + } + append html "</tr>" + + foreach opt $sel_list { + append options "<td><input name=\"col_@@\" type=radio value=\"[lindex [lindex $datadef $opt] 0]\"></td>" + } + for {set i 0} { $i < $max_columns} {incr i} { + if {$i < $n_sel_columns} { + set match [lindex [lindex $datadef [lindex $sel_columns $i]] 0] + regsub "( type=radio )(value=\"$match\">)" $options "\\1 checked \\2" out + } else { + set out $options + } + regsub -all {@@} $out $i out + append html "<tr><th>[expr $i + 1]</th>$out</tr>\n" + } + } + append html "</table></form>" + + return $html +} + + + +proc_doc ad_table_sort_form {datadef {type select} {return_url {}} {item_group {}} {item {}} {sort_spec {}} {allowed {}}} { + builds a form for setting up custom sorts. + <p> + <ul> + <li> datadef is the table definition as in ad_table. + <li> type is select or radio (only select is implemented now) + <li> return_url is the return url passed through to the page that validates and saves the + sort customization. + <li> item_group is a string identifying the customization "ticket_tracker_main_sort" for example. + <li> item is the user entered identifier + <li> sort_spec is the sort specifier as in ad_new_sort_by + <li> allowed is the list of all the columns allowed, if empty all are allowed. + </ul> + <p> + An example from the ticket system: + <pre> + ad_table_sort_form $tabledef select $return_url ticket_tracker_main_sort $ticket_sort $orderby + </pre> +} { + # first build a map of all available columns + set sel_list [ad_table_column_list -sortable t $datadef $allowed] + + # build the map of currently selected columns + set full_column [split $sort_spec ","] + set sel_columns [list] + set direction [list] + foreach col $full_column { + regexp {([^*,]+)([*])?} $col match coln dirn + if {$dirn == "*"} { + set dirn desc + } else { + set dirn asc + } + lappend sel_columns $coln + lappend direction $dirn + } + + set max_columns 4 + set n_sel_columns [llength $sel_columns] + + set html {} + if {[string compare $item "CreateNewCustom"] == 0} { + set item {} + } + # now spit out the form fragment. + if {![empty_string_p $item]} { + append html "<h2>Editing <strong>$item</strong></h2>" + append html "<form method=get action=\"/tools/sort-custom.tcl\">" + append html "<input type=submit value=\"Delete this sort\">" + append html "<input type=hidden name=delete_the_sort value=\"1\">" + append html "[export_form_vars item_group item]" + if {![empty_string_p $return_url]} { + append html "[export_form_vars return_url]" + } + append html "</form>" + } + + append html "<form method=get action=\"/tools/sort-custom.tcl\">" + if {![empty_string_p $return_url]} { + append html "[export_form_vars return_url]" + } + if {[empty_string_p $item_group]} { + set item_group [ns_conn url] + } + + append html "[export_form_vars item_group]" + if {![empty_string_p $item]} { + set item_original $item + append html "[export_form_vars item_original]" + append html "<input type=submit value=\"Save changes\">" + } else { + append html "<input type=submit value=\"Save new sort\">" + } + + append html "<table>" + append html "<tr><th>Name:</th><td><input type=text size=60 name=item [export_form_value item]></td></tr>" + if {![empty_string_p $item]} { + set item_original item + append html "[export_form_vars item_original]" + append html "<tr><td> </td><td><em>Editing the name will rename the sort</em></td></tr>" + } + + set options "<option value=\"\">---" + foreach opt $sel_list { + append options " <option value=\"[lindex [lindex $datadef $opt] 0]\">[lindex [lindex $datadef $opt] 1]" + } + + for {set i 0} { $i < $max_columns} {incr i} { + if {$i < $n_sel_columns} { + set match [lindex $sel_columns $i] + regsub "(<option )(value=\"$match\">)" $options "\\1 selected \\2" out + } else { + set out $options + } + append html "<tr><th>[expr $i + 1]</th><td><select name=\"col\">$out</select>" + switch [lindex $direction $i] { + asc { + append html "<select name=\"dir\"><option value=\"asc\" selected>increasing<option value=\"desc\">decreasing</select>" + } + default { + append html "<select name=\"dir\"><option value=\"asc\">increasing<option value=\"desc\" selected>decreasing</select>" + + } + } + append html "\n</td></tr>\n" + } + append html "</table></form>" + + return $html +} + + + + + + +proc_doc ad_order_by_from_sort_spec {sort_by tabledef} { + Takes a sort_by spec, and translates it into into an "order by" clause + with each sort_by key dictated by the sort info in tabledef +} { + set order_by_clause {} + + foreach sort_key_spec [split $sort_by ","] { + if { [regexp {^([A-Za-z_]+)(\*?)$} $sort_key_spec match sort_key reverse] } { + # if there's a "*" after the key, we want to reverse the usual order + foreach order_spec $tabledef { + if { $sort_key == [lindex $order_spec 0] } { + + if { $reverse == "*" } { + set order "desc" + } else { + set order "asc" + } + + if { $order_by_clause == "" } { + append order_by_clause "\norder by " + } else { + append order_by_clause ", " + } + + # tack on the order by clause + if {![empty_string_p [lindex $order_spec 2]]} { + append order_by_clause "[subst [lindex $order_spec 2]]" + } else { + append order_by_clause "$sort_key $order" + } + break + } + } + } + } + return $order_by_clause +} + +proc_doc ad_new_sort_by {key keys} { + Makes a new sort_by string, sorting by "key". + + If the key is followed by "*", that indicates the ordering should + be reversed from the default ordering for that key. + + Old sort keys are retained, so the sort appears to be a little more stable. + That is, suppose two things are sorted into an order, and their values for a + different column are the same. If that different column is used as the primary + sort key to reorder, the things which have the same value for the newly-sorted + column will remain in the same relative order. +} { + if { $keys == "" } { + return $key + + } elseif { [regexp "^${key}(\\*?)," "$keys," match reverse] } { + # if this was already the first key, then reverse order + if { $reverse == "*" } { + regsub "\\*," "$keys," "," keys + } else { + regsub "," "$keys," "*," keys + } + regsub ",$" $keys "" keys + return $keys + } else { + regsub ",$key\\*?," "$keys," "," keys + regsub ",$" $keys "" keys + return "$key,$keys" + } +} + +proc_doc ad_same_page_link {variable value text {form ""}} { + Makes a link to this page, with a new value for "variable". +} { + if [empty_string_p $form] { + set form [ns_getform] + } + set url_vars [export_ns_set_vars url $variable $form] + return "<a href=\"[ns_conn url]?$variable=[ns_urlencode $value]$url_vars\">$text</a>" +} + + + + +proc_doc ad_reverse order { + returns the opposite sort order from the + one it is given. Mostly for columns whose natural + sort order is not the default. +} { + switch [string tolower $order] { + desc {return asc} + asc {return desc} + } + return $order +} + + + + +proc_doc ad_custom_load {db user_id item_group item item_type} { + load a persisted user customization as saved by + for example table-custom.tcl. +} { + util_dbq {item item_group item_type} + set selection [ns_db 0or1row $db "select value_type, value from user_custom + where user_id = $user_id and item_type = $DBQitem_type + and item_group = $DBQitem_group and item = $DBQitem"] + + if {![empty_string_p selection]} { + # should check value type in ns_set etc. and create the + # correct data type + if {[catch {eval set value "{[ns_set value $selection 1]}"} errmsg]} { + set value {} + } + } else { + set value {} + } + return $value +} + + +proc_doc ad_custom_list {db user_id item_group item_set item_type target_url custom_url {new_string "new view"}} { + Generates the html fragment for choosing, editing and creating + user customized data +} { + util_dbq {item_group item_type} + set items [database_to_tcl_list $db "select item from user_custom + where user_id = $user_id and item_type = $DBQitem_type + and item_group = $DBQitem_group"] + + set break {} + foreach item $items { + if {[string compare $item_set $item] == 0} { + append html "$break<strong>$item</strong> (<a href=\"$custom_url$item\">edit</a>)" + } else { + append html "$break<a href=\"$target_url$item\">$item</a>" + } + set break " | " + } + append html "$break (<a href=\"${custom_url}CreateNewCustom\">$new_string</a>)\n" + + return $html +} + + +proc_doc ad_custom_page_defaults defaults { + set the page defaults. If the form is + empty do a returnredirect with the defaults set +} { + set form [ns_getform] + if {[empty_string_p $form] + && ![empty_string_p $defaults]} { + # we did not get a form so set all the variables + # and redirect to set them + set redirect "[ns_conn url]?" + set pre {} + foreach kvp $defaults { + append redirect "$pre[lindex $kvp 0]=[ns_urlencode [lindex $kvp 1]]" + set pre {&} + } + ns_returnredirect $redirect + return -code return + } + + # we have a form so stuff in the ones we dont find. + # should think about how to support lists and ns_set persist too. + foreach kvp $defaults { + if {[ns_set find $form [lindex $kvp 0]] < 0} { + ns_set put $form [lindex $kvp 0] [lindex $kvp 1] + } + } +} + +proc_doc ad_custom_form {return_url item_group item} { + sets up the head of a form to feed to /tools/form-custom.tcl +} { + append html "<form method=get action=\"/tools/form-custom.tcl\">\n" + if {![empty_string_p $return_url]} { + append html "[export_form_vars return_url]\n" + } + if {[empty_string_p $item_group]} { + set item_group [ns_conn url] + } + set item_original $item + append html "[export_form_vars item_group item item_original]\n" + append html "<input type=submit value=\"Save settings\">" +} + + +proc_doc ad_dimensional_settings {define current} { + given a dimensional slider definition this routine returns a form to set the + defaults for the given slider. + + NB...this does not close either the table or the form... +} { + foreach opt $define { + append html "<tr><th align=left>[lindex $opt 1]</th><td>" + append html "<select name=[lindex $opt 0]>" + #append html "<option value=\"\">-- Unset --" + if {![empty_string_p $current] + && [ns_set find $current [lindex $opt 0]] > -1} { + set picked [ns_set get $current [lindex $opt 0]] + } else { + set picked [lindex $opt 2] + } + foreach val [lindex $opt 3] { + if {[string compare $picked [lindex $val 0]] == 0} { + append html "<option SELECTED value=\"[philg_quote_double_quotes [lindex $val 0]]\">[lindex $val 1]\n" + } else { + append html "<option value=\"[philg_quote_double_quotes [lindex $val 0]]\">[lindex $val 1]\n" + } + } + append html "</select></td></tr>\n" + } + return $html +} + + + Index: web/openacs/tcl/ad-user-content-map.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-user-content-map.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-user-content-map.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,91 @@ +# ad-user-content-map.tcl,v 3.1 2000/02/26 12:55:27 jsalz Exp +# ad-user-content-map.tcl +# +# by philg@mit.edu in anicent (1998) times +# +# enhanced on November 1, 1999 to participate in ad-user-contributions-summary.tcl +# system +# + +# this filter runs after thread has finished serving an HTML page to a +# user. It does the following + +# a. grabs a db conn if one is immediately available +# (does nothing if all the conns are in use) +# b. checks to see if there is a user_id cookie +# c. checks in db to see if user has already read this page +# d. if not, does a db insert + +util_report_library_entry + +proc ad_maintain_user_content_map {conn args why} { + # no security check, just look at header + set user_id [ad_get_user_id] + if { $user_id != 0 } { + # this is a registered user + if { [catch { set db [ns_db gethandle -timeout -1] } errmsg] || [empty_string_p $db] } { + # the non-blocking call to gethandle raised a Tcl error; this + # means a db conn isn't free right this moment, so let's just + # return + ns_log Notice "Db handle wasn't available in ad_maintain_user_content_map" + return filter_ok + } else { + # we have $db + # let's figure out which page_id corresponds to the URL + # we're looking at + set selection [ns_db 0or1row $db "select page_id from static_pages where url_stub = '[DoubleApos [ns_conn url]]'"] + # the row might not be in the database + if { ![empty_string_p $selection] && ![empty_string_p [ns_set get $selection page_id]] } { + set_variables_after_query + # we found the page, probably would be best to put the next + # couple of things into a PL/SQL proc + set n_rows [database_to_tcl_string $db "select count(*) from user_content_map where page_id = $page_id and user_id = $user_id"] + if { $n_rows == 0 } { + # we have a user_id, a page_id, and we know that + # this map is not yet recorded + ns_db dml $db "insert into user_content_map (user_id, page_id, view_time) values ($user_id, $page_id, sysdate())" + } + } + } + } + return filter_ok +} + + +ns_share -init { set ad_user_content_map_filters_installed_p 0 } ad_user_content_map_filters_installed_p + +if { !$ad_user_content_map_filters_installed_p } { + set ad_user_content_map_filters_installed_p 1 + ns_log Notice "ad-user-content-map.tcl registering ad_maintain_user_content_map as a trace filter on *.htm*" + ad_register_filter trace GET *.htm* ad_maintain_user_content_map +} + +ns_share ad_user_contributions_summary_proc_list + +if { ![info exists ad_user_contributions_summary_proc_list] || [util_search_list_of_lists $ad_user_contributions_summary_proc_list "Static pages viewed when logged in" 0] == -1 } { + lappend ad_user_contributions_summary_proc_list [list "Static pages viewed when logged in" ad_static_page_views_user_contributions 5] +} + +proc_doc ad_static_page_views_user_contributions {db user_id purpose} {Returns empty list if purpose is not "site_admin". Otherwise a triplet of all the static pages viewed while this user was logged in.} { + if { $purpose != "site_admin" } { + return [list] + } + set selection [ns_db select $db "select user_content_map.view_time, static_pages.page_id, static_pages.page_title, static_pages.url_stub +from user_content_map, static_pages +where user_content_map.page_id = static_pages.page_id +and user_content_map.user_id = $user_id +order by view_time asc"] + set items "" + while {[ns_db getrow $db $selection]} { + set_variables_after_query + append items "<li>[util_AnsiDatetoPrettyDate $view_time]: <A HREF=\"/admin/static/page-summary.tcl?page_id=$page_id\">$url_stub</a> ($page_title)\n" + } + if [empty_string_p $items] { + return [list] + } else { + return [list 5 "Static pages viewed when logged in" "<ul>\n\n$items\n\n</ul>"] + } +} + + +util_report_successful_library_load Index: web/openacs/tcl/ad-user-contributions-summary.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-user-contributions-summary.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-user-contributions-summary.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,207 @@ +# ad-user-contributions-summary.tcl,v 3.1 2000/02/20 17:04:39 davis Exp +# +# ad-user-contributions-summary.tcl +# +# by philg@mit.edu on October 31, 1999 +# (spending Halloween holiday engaged in the typically +# ghoulish activity of Tcl programming) +# + +# this is similar in spirit to what you see in ad-new-stuff.tcl + +# the big idea here is to have a modular way of each part of ACS +# reporting what User #47 has contributed to the community +# This is used by /admin/users/one.tcl and /shared/community-member.tcl + +# this system scales as modules are added to the ACS either by +# ArsDigita or publishers. The basic mechanism by which modules buy +# into this system is to lappend a data structure to the ns_share +# variable ad_user_contributions_summary_proc_list (a Tcl list) + +# each element of this list is itself a list. Here's the data +# structure for the sublist: +# module_name proc_name priority +# a priority of 0 is higher than a priority of 1 (expect +# values between 0 and 10); items of the same priority +# sort by which is shorter + +util_report_library_entry + +# assumes we're sorting a list of sublists, each of which +# has priority as its first element, a title as the second, +# and content as the third element + +proc ad_user_contributions_summary_sort {sublist1 sublist2} { + set priority1 [lindex $sublist1 0] + set priority2 [lindex $sublist2 0] + if { $priority1 < $priority2 } { + return -1 + } elseif { $priority1 > $priority2 } { + return 1 + } else { + # priorities are equal, let's sort by length + set string1 [lindex $sublist1 2] + set string2 [lindex $sublist2 2] + if { [string length $string1] < [string length $string2] } { + return -1 + } else { + return 1 + } + } +} + +proc_doc ad_summarize_user_contributions {db user_id {purpose "web_display"}} "Returns a string of a user's contributed stuff on the site. The PURPOSE argument can be \"web_display\" (intended for an ordinary user) or \"site_admin\" (to help the owner of a site nuke stuff). These arguments are passed down to the procedures on the ns_share'd ad_user_contributions_summary_proc_list." { + ns_share ad_user_contributions_summary_proc_list + set result_list [list] + foreach sublist $ad_user_contributions_summary_proc_list { + set module_name [lindex $sublist 0] + set module_proc [lindex $sublist 1] + # affects how we display the stuff + set priority [lindex $sublist 2] + + # Put here so I get a traceback when subquery not released JCD + #ns_log Notice "contibutions for $module_name via $module_proc" + #set dbx [ns_db gethandle subquery] + #ns_db releasehandle $dbx + + if [catch { set one_module_result [eval [list $module_proc $db $user_id $purpose]] } errmsg] { + ns_log Notice "ad_summarize_user_contributions got an error calling $module_proc: $errmsg" + # got an error, let's continue to the next iteration + continue + } + if { [llength $one_module_result] != 0 && ![empty_string_p [lindex $one_module_result 2]] } { + # we got back a triplet AND there was some actual content + lappend result_list $one_module_result + } + } + # we've got all the results, let's sort by priority and then size + set sorted_list [lsort -command ad_user_contributions_summary_sort $result_list] + set html_fragment "" + foreach result_elt $sorted_list { + set subsection_title [lindex $result_elt 1] + set subsection_contents [lindex $result_elt 2] + append html_fragment "<h3>$subsection_title</h3>\n\n$subsection_contents\n\n" + } + return $html_fragment +} + +# now let's define new stuff procs for all the random parts of the +# system that don't have their own defs files or aren't properly +# considered modules + +ns_share ad_user_contributions_summary_proc_list + +if { ![info exists ad_user_contributions_summary_proc_list] || [util_search_list_of_lists $ad_user_contributions_summary_proc_list "Related Links" 0] == -1 } { + lappend ad_user_contributions_summary_proc_list [list "Related Links" ad_related_links_user_contributions 1] +} + + +proc_doc ad_related_links_user_contributions {db user_id purpose} "Only produces a report for the site administrator; the assumption is that random users won't want to see out-of-context links" { + if { $purpose != "site_admin" } { + return [list] + } + set selection [ns_db select $db "select links.page_id, links.link_title, links.link_description, links.url, links.status, posting_time, page_title, url_stub +from links, static_pages sp +where links.page_id = sp.page_id +and links.user_id = $user_id +order by posting_time asc"] + set items "" + while { [ns_db getrow $db $selection] } { + set_variables_after_query + append items "<li>[util_AnsiDatetoPrettyDate $posting_time] +to +<a href=\"$url_stub\">$url_stub</a>: +<ul> +<li>Url: <a href=\"$url\">$url</a> ($link_title) +" + if ![empty_string_p $link_description] { + append items "<li>Description: $link_description\n" + } + append items "<li>Status: $status +<li>Actions:     <a href=\"/admin/links/edit.tcl?[export_url_vars url page_id]\">edit</a>     <a href=\"/admin/links/delete.tcl?[export_url_vars url page_id]\">delete</a> +</ul> +" + } + if [empty_string_p $items] { + return [list] + } else { + return [list 1 "Related Links" "<ul>\n\n$items\n\n</ul>"] + } +} + +if { ![info exists ad_user_contributions_summary_proc_list] || [util_search_list_of_lists $ad_user_contributions_summary_proc_list "Static Page Comments" 0] == -1 } { + lappend ad_user_contributions_summary_proc_list [list "Static Page Comments" ad_static_comments_user_contributions 1] +} + + +proc_doc ad_static_comments_user_contributions {db user_id purpose} "Returns a list of priority, title, and an unordered list HTML fragment. All the static comments posted by a user." { + if { $purpose == "site_admin" } { + return [ad_static_comments_user_contributions_for_site_admin $db $user_id] + } else { + return [ad_static_comments_user_contributions_for_web_display $db $user_id] + } + +} + + +# need to go the helper route +proc ad_static_comments_user_contributions_for_site_admin {db user_id} { + set selection [ns_db select $db "select comments.comment_id, comments.page_id, comments.message, comments.posting_time, comments.comment_type, comments.rating, page_title, url_stub +from static_pages sp, comments_not_deleted comments +where comments.page_id = sp.page_id +and comments.user_id = $user_id +order by posting_time asc"] + set items "" + while { [ns_db getrow $db $selection] } { + set_variables_after_query + append items "<li>[util_AnsiDatetoPrettyDate $posting_time]; $comment_type on <a href=\"$url_stub\">$url_stub</a>: + <blockquote> + " + if ![empty_string_p $rating] { + append items "Rating: $rating<br><br>\n\n" + } + append items " +$message +<br> +<br> +\[ <a href=\"/admin/comments/persistent-edit.tcl?[export_url_vars comment_id]\">edit</a>   |   <a href=\"/admin/comments/delete.tcl?[export_url_vars comment_id page_id]\">delete</a> \] +</blockquote>" + } + if [empty_string_p $items] { + return [list] + } else { + return [list 1 "Static Page Comments" "<ul>\n\n$items\n\n</ul>"] + } +} + +proc ad_static_comments_user_contributions_for_web_display {db user_id} { + set selection [ns_db select $db "select comments.page_id, comments.message, posting_time, case when page_title = null then url_stub else page_title end as page_title, url_stub +from static_pages sp, comments_not_deleted comments +where sp.page_id = comments.page_id +and comments.user_id = $user_id +and comments.comment_type = 'alternative_perspective' +order by posting_time asc"] + set comment_items "" + while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { [string length $message] > 1000 } { + set complete_message "[string range $message 0 1000]... " + } else { + set complete_message $message + } + append comment_items "<li>[util_AnsiDatetoPrettyDate $posting_time], on <a href=\"$url_stub\">$page_title</a>: +<blockquote> +$complete_message +</blockquote> +<p> +" + } + if [empty_string_p $comment_items] { + return [list] + } else { + return [list 1 "Static Page Comments" "<ul>\n\n$comment_items\n\n</ul>"] + } +} + + +util_report_successful_library_load Index: web/openacs/tcl/ad-user-groups.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-user-groups.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-user-groups.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,457 @@ +# ad-user-groups.tcl,v 3.3 2000/02/26 12:55:28 jsalz Exp +# created by philg@mit.edu 11/16/98 +# +# extensively modified by teadams@mit.edu and folded into +# ACS for version 1.4 to support the /doc/permission.html system +# +# procedures to support the grouping of users +# into arbitrary groups of arbitrary type +# (see /doc/sql/user-groups.sql) + +# modified by teadams@Mit.edu to use group_id cookie + +proc ad_user_group_helper_table_name {group_type} { + return "[string trim $group_type]_info" +} + +proc_doc ad_user_group_authorized_admin { user_id group_id db } { Returns 1 if the user has a role of administrator. 0 otherwise. } { + set n_rows [database_to_tcl_string $db "select count(*) from user_group_map where user_id = $user_id and group_id = $group_id and lower(role) = 'administrator'"] + if { $n_rows > 0 } { + return 1 + } else { + return 0 + } +} + +proc_doc ad_user_group_authorized_admin_or_site_admin { user_id group_id db } { Returns 1 if the user has a role of administrator for the specified group OR if the user is a site-wide administrator. 0 otherwise. } { + if [ad_administrator_p $db $user_id] { + return 0 + } else { + # user is not a site-wide admin, but they might be a group admin + set n_rows [database_to_tcl_string $db "select count(*) from user_group_map where user_id = $user_id and group_id = $group_id and lower(role) = 'administrator'"] + if { $n_rows > 0 } { + return 1 + } else { + return 0 + } + } +} + +proc_doc ad_user_group_member { db group_id {user_id ""} } { Returns 1 if user is a member of the group. 0 otherwise.} { + + if [empty_string_p $user_id] { + set user_id [ad_verify_and_get_user_id] + } + + set n_rows [database_to_tcl_string $db "select count(*) from user_group_map where user_id =$user_id and group_id = $group_id"] + if { $n_rows > 0 } { + return 1 + } else { + return 0 + } +} + +proc ad_user_group_member_cache_internal {group_id user_id} { + set db [ns_db gethandle subquery] + set value [ad_user_group_member $db $group_id $user_id] + ns_db releasehandle $db + return $value +} + +proc_doc ad_user_group_member_cache { group_id user_id } { Wraps util_memoize around ad_user_group_member. Gets its own db handle if necessary. Returns 1 if user is a member of the group. 0 otherwise.} { + return [util_memoize "ad_user_group_member_cache_internal $group_id $user_id" [ad_parameter CacheTimeout ug 600]] +} + +proc_doc ad_administration_group_member { db module {submodule ""} {user_id ""} } "Returns 1 is user is a member of the administration group. 0 otherwise." { + set group_id [ad_administration_group_id $db $module $submodule] + if {[empty_string_p $group_id]} { + return 0 + } else { + return [ad_user_group_member $db $group_id $user_id] + } +} + + +proc_doc ad_administration_group_add {db pretty_name module {submodule "" } {url ""} {multi_role_p "f"} {group_id ""}} "Creates an administration group. Returns: The group_id of the new group if it is created; The group_id of an old group if there was already a administration group for this module and submodule; 0 otherwise. Notice that unique short_name for group is genereted from pretty_name" { + + # PARAMETERS + # db: database handle + # pretty_name: pretty name of the group + # module: module this is created for, ie. 'classifieds' + # submodule: submodule this is created for, ie. 'equipment', 'jobs', 'wtr' + # url: url of the module administration page + # permission system: which type of permission system you would like to run (basic or advanced) + # group_id (optional): group id of the new group. One will be generated if it is not specified + + set extra_values [ns_set create extra_values] + ns_set put $extra_values module $module + ns_set put $extra_values submodule $submodule + ns_set put $extra_values url $url + + set group_id [ad_user_group_add $db "administration" $pretty_name "t" "f" "closed" $multi_role_p $extra_values $group_id] + + if { $group_id == 0} { + # see if this group is defined already + set selection [ns_db 0or1row $db "select group_id from administration_info where module='[DoubleApos $module]' and submodule='[DoubleApos $submodule]'"] + if [empty_string_p $selection] { + return 0 + } else { + set_variables_after_query + return $group_id + } + } + return $group_id +} + + +proc_doc ad_user_group_add {db group_type group_name {approved_p "t"} {existence_public_p "f"} {new_member_policy "closed"} {multi_role_p "f"} {extra_values ""} {group_id "" }} "Creates a new group. Returns: The groud_id of the group if created or it existed already (double click protection); 0 on failure." { + + # PARAMETERS + # db: database handle + # group_type: type of group + # group_name: pretty name + # approved_p (optional): is this an approved group? + # existence_public_p (optional): Is the existence of this group public? + # new_member_policy (optional): How can members join? (wait, closed, open) + # permission_system(optional): What type of permission system (basic, advanced) + # extra_values (optional): A ns_set containing + # extra values that should be stored for this + # group. These are items that will go in the [set group_type]_info + # tables. The keys of the ns_set contain the column names. The values + # contain the values. + # group_id (optional): Group_id. If this is null, one will be created + + + if [empty_string_p $group_id] { + set group_id [database_to_tcl_string $db "select user_group_sequence.nextval from dual"] + } + + ns_db dml $db "begin transaction" + + if [catch { + set short_name [database_to_tcl_string $db " + select short_name_from_group_name('[DoubleApos $group_name]') from dual"] + + ns_db dml $db " + insert into user_groups + (group_id, group_type, group_name, short_name, approved_p, existence_public_p, new_member_policy, multi_role_p, + creation_user, creation_ip_address, registration_date) + values ($group_id, '[DoubleApos $group_type]', '[DoubleApos $group_name]', '[DoubleApos $short_name]', + '$approved_p', '$existence_public_p', '[DoubleApos $new_member_policy]', '[DoubleApos $multi_role_p]', + [ad_get_user_id], '[DoubleApos [ns_conn peeraddr]]', sysdate())" + + } errmsg] { + ns_db dml $db "abort transaction" + ns_log Error "$errmsg in ad-user_groups.tcl - ad_user_group_add insertion into user groups" + + # see if this group is already defined + + set selection [ns_db 0or1row $db "select group_id from user_groups where group_id = $group_id"] + if [empty_string_p $selection] { + return 0 + } else { + set_variables_after_query + return $group_id + } + } + + # insert the extra values + if ![empty_string_p $extra_values] { + set extra_values_i 0 + lappend columns group_id + lappend values $group_id + + set extra_values_limit [ns_set size $extra_values] + while {$extra_values_i < $extra_values_limit} { + set key [ns_set key $extra_values $extra_values_i] + lappend columns $key + lappend values '[DoubleApos [ns_set get $extra_values $key]]' + incr extra_values_i + } + if [catch { + ns_db dml $db "insert into [set group_type]_info ([join $columns ","]) values ([join $values ","])" + } errmsg] { + # There was an error inserting the extra information (most likely to this is an administration group + # and the module and submodule are already there) + ns_db dml $db "abort transaction" + ns_log Error "$errmsg in ad-user_groups.tcl - ad_user_group_add extra values insertion" + return 0 + } + } + + ns_db dml $db "end transaction" + + return $group_id +} + +proc_doc ad_permission_p {db {module ""} {submodule ""} {action ""} {user_id ""} {group_id ""}} {For groups with basic administration: Returns 1 if user has a role of administrator or all; O otherwise. For groups with advanced administration: Returns 1 if user has authority for the action; 0 otherwise.} { + + if { ![empty_string_p $module] && ![empty_string_p $group_id] } { + error "specify either module or group_id, not both" + } + + # If no user_id was specified, then use the ID of the logged-in + # user. + # + if [empty_string_p $user_id] { + set user_id [ad_verify_and_get_user_id] + } + + # Identify the group. Either the group_id will be explicitly + # specified or we derive it from the module by querying to + # find out which group is the administration group for the + # module. If submodule is specified in addition to module, then + # find out which group is the administration group for the + # submodule. + # + if { [empty_string_p $group_id] } { + set group_id [ad_administration_group_id $db $module $submodule] + + # If we fail to find a corresponding group_id, return false. + # This probably should raise an error but I (Michael Y) don't + # want to risk breaking any more code right now. + # + if { [empty_string_p $group_id] } { + return 0 + } + } + + # Next, find out if the group use basic or advanced (a.k.a. + # multi-role) administration. + # + set multi_role_p [database_to_tcl_string $db "select multi_role_p from user_groups where group_id = $group_id"] + + if { $multi_role_p == "f" } { + # If administration is basic, then return true if the user has + # either the 'administrator' role or the 'all' role for the + # group. + # + set permission_p [database_to_tcl_string $db "select case when count(*)=0 then 0 else 1 end from user_group_map where user_id = $user_id and group_id = $group_id and role in ('administrator', 'all')"] + + } else { + # If administration is advanced, then check to see if the + # user is an administrator; if not, make sure that action + # was specified and then check to see if the user has a + # role that is authorized to perform the specified action. + # + set permission_p [database_to_tcl_string $db "select case when count(*)= 0 then 0 else 1 end from user_group_map where user_id = $user_id and group_id = $group_id and role = 'administrator'"] + + if { !$permission_p } { + if { [empty_string_p $action] } { + error "no action specified for group with multi-role administration (ID $group_id)" + } + + set permission_p [database_to_tcl_string $db "select case when count(*)=0 then 0 else 1 end from user_group_action_role_map where group_id = $group_id and action = '[DoubleApos $action]' and role in (select role from user_group_map where group_id = $group_id and user_id = $user_id)"] + } + } + + # If necessary, make a final check to see if the user is a + # site-wide administrator. + # + if { !$permission_p } { + set permission_p [ad_administrator_p $db $user_id] + } + + return $permission_p +} + +proc_doc ad_administration_group_id {db module {submodule ""}} "Given the module and submodule of an administration group, returns the group_id. Returns empty string if there isn't a group." { + if ![empty_string_p $submodule] { + set query "select group_id +from administration_info +where module = '[DoubleApos $module]' +and submodule = '[DoubleApos $submodule]'" + } else { + set query "select group_id +from administration_info +where module = '[DoubleApos $module]' +and submodule is null" + } + return [database_to_tcl_string_or_null $db $query] +} + +proc_doc ad_administration_group_user_add { db user_id role module submodule } "Adds a user to an administration group or updates his/her role. Returns: 1 on success; 0 on failure." { + set group_id [ad_administration_group_id $db $module $submodule] + if {[empty_string_p $group_id]} { + return 0 + } else { + return [ad_user_group_user_add $db $user_id $role $group_id] + } +} + +proc_doc ad_user_group_user_add { db user_id role group_id } {Maps the specified user to the specified group in the specified role; if the mapping already exists, does nothing.} { + + if [catch { + ns_db dml $db "insert into user_group_map(user_id, group_id, role, mapping_user, mapping_ip_address) +values ($user_id, $group_id, '[DoubleApos $role]',[ad_get_user_id],'[DoubleApos [ns_conn peeraddr]]')" } errmsg] { + + # if the insert failed for a reason other than the fact that the + # mapping already exists, then raise the error + # + if { + [database_to_tcl_string $db "select count(*) from + user_group_map + where user_id = $user_id and group_id = $group_id and role = '[DoubleApos $role]'"] == 0 + } { + error $errmsg + } + + return 1 +} +} + + +proc_doc ad_user_group_role_add {db group_id role} "Inserts a role into a user group." { + ns_db dml $db "insert into user_group_roles (group_id, role, creation_user, creation_ip_address) select $group_id, '[DoubleApos $role]', [ad_get_user_id], '[DoubleApos [ns_conn peeraddr]]' from dual where not exists (select role from user_group_roles where group_id = $group_id and role = '[DoubleApos $role]')" +} + + +proc_doc ad_administration_group_role_add { db module submodule role } "Inserts a role into an administration group." { + set group_id [ad_administration_group_id $db $module $submodule] + if {[empty_string_p $group_id]} { + return 0 + } else { + ad_user_group_role_add $db $group_id $role + return 1 + } +} + + +proc_doc ad_user_group_action_add {db group_id action} "Inserts a action into a user_group." { + ns_db dml $db "insert into user_group_actions (group_id, action, creation_user, creation_ip_address) select $group_id, '[DoubleApos $action]', [ad_get_user_id], '[DoubleApos [ns_conn peeraddr]]' from dual where not exists (select action from user_group_actions where group_id = $group_id and action = '[DoubleApos $action]')" +} + + +proc_doc ad_administration_group_action_add { db module submodule action } "Inserts an action into an administration group." { + set group_id [ad_administration_group_id $db $module $submodule] + if {[empty_string_p $group_id]} { + return 0 + } else { + ad_user_group_action_add $db $group_id $action + return 1 + } +} + + +proc_doc ad_user_group_action_role_map {db group_id action role} "Maps an action to a role a user group." { + ns_db dml $db "insert into user_group_action_role_map (group_id, role, action, creation_user, creation_ip_address) select $group_id, '[DoubleApos $role]', '[DoubleApos $action]', [ad_get_user_id], '[DoubleApos [ns_conn peeraddr]]' from dual where not exists (select role from user_group_action_role_map where group_id = $group_id and role = '[DoubleApos $role]' and action = '[DoubleApos $action]')" +} + + +proc_doc ad_administration_group_action_role_map { db module submodule action role } "Maps an action to a role in an administration group." { + set group_id [ad_administration_group_id $db $module $submodule] + if {[empty_string_p $group_id]} { + return 0 + } else { + ad_user_group_action_role_map $db $group_id $action $role + return 1 + } +} + +proc_doc ad_user_group_type_field_form_element { field_name column_type {default_value ""} } "Creates a HTML form fragment of a type appropriate for the type of data expected (e.g. radio buttons if the type is boolean). The column_type can be any of the following: integer, number, date, text (up to 4000 characters), text_short (up to 200 characters), boolean, and special (no form element will be provided)." { + if { $column_type == "integer" || $column_type == "number"} { + return "<input type=text name=\"$field_name\" value=\"[philg_quote_double_quotes $default_value]\" size=5>" + } elseif { $column_type == "date" } { + return [ad_dateentrywidget $field_name $default_value] + } elseif { $column_type == "text_short" } { + return "<input type=text name=\"$field_name\" value=\"[philg_quote_double_quotes $default_value]\" size=30 maxlength=200>" + } elseif { $column_type == "text" } { + return "<textarea wrap name=\"$field_name\" rows=4 cols=50>$default_value</textarea>" + } elseif { $column_type == "special" } { + return "Special field." + } else { + # it's boolean + set to_return "" + if { [string tolower $default_value] == "t" || [string tolower $default_value] == "y" || [string tolower $default_value] == "yes"} { + append to_return "<input type=radio name=\"$field_name\" value=t checked>Yes  " + } else { + append to_return "<input type=radio name=\"$field_name\" value=t>Yes  " + } + if { [string tolower $default_value] == "f" || [string tolower $default_value] == "n" || [string tolower $default_value] == "no"} { + append to_return "<input type=radio name=\"$field_name\" value=f checked>No" + } else { + append to_return "<input type=radio name=\"$field_name\" value=f>No" + } + return $to_return + } +} + +proc_doc ad_user_group_column_type_widget { {default ""} } "Returns an HTML form fragment containing all possible values of column_type" { + return "<select name=\"column_type\"> +<option value=\"boolean\" [ec_decode $default "boolean" "selected" ""]>Boolean (Yes or No) +<option value=\"integer\" [ec_decode $default "integer" "selected" ""]>Integer (Whole Number) +<option value=\"number\" [ec_decode $default "number" "selected" ""]>Number (e.g., 8.35) +<option value=\"date\" [ec_decode $default "date" "selected" ""]>Date +<option value=\"text_short\" [ec_decode $default "text_short" "selected" ""]>Short Text (up to 200 characters) +<option value=\"text\" [ec_decode $default "text" "selected" ""]>Long Text (up to 4000 characters) +<option value=\"special\" [ec_decode $default "boolean" "special" ""]>Special (no form element will be provided) +</select> (used for user interface) +" +} + +proc_doc ad_get_group_id {} "Returns the group_id cookie value. Returns 0 if the group_id cookie is missing, if the user is not logged in, or if the user is not a member of the group." { + # 1 verifies the user_id cookie + # 2 gets the group_id cookie + # 3 verifies that the user_id is mapped to group_id + + ns_share ad_group_map_cache + + set user_id [ad_verify_and_get_user_id] + if { $user_id == 0 } { + return 0 + } + set headers [ns_conn headers] + set cookie [ns_set get $headers Cookie] + if { [regexp {ad_group_id=([^;]+)} $cookie {} group_id] } { + if { [info exists ad_group_map_cache($user_id)] } { + # there exists a cached $user_id to $group_id mapping + if { [string compare $group_id $ad_group_map_cache($user_id)] == 0 } { + return $group_id + } + } + # we continue and hit db even if there was a cached group_id (but + # it didn't match) because the user might have just logged into + # a different group + + set db [ns_db gethandle subquery] + + if { + [database_to_tcl_string $db "select ad_group_member_p($user_id, $group_id) from dual"] == "t" + } { + set ad_group_map_cache($user_id) $group_id + ns_db releasehandle $db + return $group_id + } else { + ns_db releasehandle $db + # user is not in the group + return 0 + } + } else { + return 0 + } +} + + +proc_doc ad_get_group_info {} "Binds variables to user group properties. Assumes group_id and db are defined." { + # assumes that group_id and db are set + uplevel { + set selection [ns_db 0or1row $db "select user_groups.* +from user_groups +where user_groups.group_id = $group_id"] + if ![empty_string_p $selection] { + set_variables_after_query + # see if there is an _info table for this user_group type + set info_table_name [ad_user_group_helper_table_name $group_type] + + if [ns_table exists $db $info_table_name] { + set selection [ns_db 0or1row $db "select * from $info_table_name where group_id = $group_id"] + if ![empty_string_p $selection] { + set_variables_after_query + } + } + } + } +} + + + Index: web/openacs/tcl/ad-user.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-user.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-user.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,59 @@ +# ad-user.tcl,v 3.0 2000/02/06 03:12:53 ron Exp +# +# /tcl/ad-user.tcl +# +# by philg@mit.edu on October 31, 1999 +# +# definitions related to getting information about a user +# + +util_report_library_entry + +proc ad_user_contact_info_display_var_p {varname} { + set varname_exclusion_patterns [list "user_id" "m_address" "priv_*"] + foreach pattern $varname_exclusion_patterns { + if [string match $pattern $varname] { + return 0 + } + } + # didn't match a pattern; good to print out + return 1 +} + +proc_doc ad_user_contact_info {db user_id {user_class "public"}} {Returns an HTML fragment of an appropriate amount of contact info for a user, depending on the user's privacy settings and who is logged in } { + if [catch { set selection [ns_db 1row $db "select * from users_contact where user_id = $user_id"] } ] { + # probably this is an ACS where the table isn't defined + return "" + } else { + # table exists and this user has an entry + set_variables_after_query + set contact_items "" + for {set i 0} {$i<[ns_set size $selection]} {incr i} { + set varname [ns_set key $selection $i] + set varvalue [ns_set value $selection $i] + if { ![empty_string_p $varvalue] && [ad_user_contact_info_display_var_p $varname] } { + if { $user_class != "site_admin" } { + # let's look for a priv_ value + if { ![info exists "priv_$varname"] || [empty_string_p [set "priv_$varname"]] } { + # don't find a control, assume it is private + continue + } else { + # there is a privacy value + if { [set "priv_$varname"] > [ad_privacy_threshold] } { + # user wants more privacy than currently connected user warrants + continue + } + } + } + append contact_items "<li>$varname: $varvalue\n" + } + } + if ![empty_string_p $contact_items] { + return "<ul>\n\n$contact_items\n\n</ul>\n" + } else { + return "" + } + } +} + +util_report_successful_library_load Index: web/openacs/tcl/ad-utilities.tcl.preload =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-utilities.tcl.preload,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-utilities.tcl.preload 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,3619 @@ +# /tcl/ad-utilities.tcl.preload +# +# This file provides a variety of utilities (originally written by +# philg@mit.edu a long time ago) as well as some compatibility +# functions to handle differences between AOLserver 2.x and +# AOLserver 3.x. +# +# Author: ron@arsdigita.com, February 2000 +# +# ad-utilities.tcl.preload,v 3.13.2.3 2000/03/18 02:31:02 ron Exp + +# Let's define the nsv arrays out here, so we can call nsv_exists +# on their keys without checking to see if it already exists. +# we create the array by setting a bogus key. + +nsv_set proc_source_file . "" + +proc proc_doc {name args doc_string body} { + # let's define the procedure first + proc $name $args $body + nsv_set proc_doc $name $doc_string + # generate a log message for multiply defined scripts + if {[nsv_exists proc_source_file $name] + && [string compare [nsv_get proc_source_file $name] [info script]] != 0} { + ns_log Notice "Multiple definition of $name in [nsv_get proc_source_file $name] and [info script]" + } + nsv_set proc_source_file $name [info script] +} + +proc proc_source_file_full_path {proc_name} { + if ![nsv_exists proc_source_file $proc_name] { + return "" + } else { + set tentative_path [nsv_get proc_source_file $proc_name] + regsub -all {/\./} $tentative_path {/} result + return $result + } +} + +proc_doc util_report_library_entry {{extra_message ""}} "Should be called at beginning of private Tcl library files so that it is easy to see in the error log whether or not private Tcl library files contain errors." { + set tentative_path [info script] + regsub -all {/\./} $tentative_path {/} scrubbed_path + if { [string compare $extra_message ""] == 0 } { + set message "Loading $scrubbed_path" + } else { + set message "Loading $scrubbed_path; $extra_message" + } + ns_log Notice $message +} + +util_report_library_entry + + +# stuff to process the data that comes +# back from the users + +# if the form looked like +# <input type=text name=yow> and <input type=text name=bar> +# then after you run this function you'll have Tcl vars +# $foo and $bar set to whatever the user typed in the form + +# this uses the initially nauseating but ultimately delicious +# Tcl system function "uplevel" that lets a subroutine bash +# the environment and local vars of its caller. It ain't Common Lisp... + +## Security fix +## (patch code from aD) +## +# This is an ad-hoc check to make sure users aren't trying to pass in +# "naughty" form variables in an effort to hack the database by passing +# in SQL. It is called in all instances where a Tcl variable +# is set from a form variable. +proc check_for_form_variable_naughtiness { name value } { + if { [string compare $name user_id] == 0 } { + if { [string length $value] > 0 && ![regexp {^[0-9]+$} $value] } { + # user_id not null, and not an integer + error "The user_id value must be an integer!" + } + } + + # This plugs a potentially huge security hole -- michael@cleverly.com + if { [string match $name QQ*] } { + error "Form variables should never begin with QQ!" + } + + # another bug discovered by Michael Cleverly. + if { [string compare $name form_counter_i] == 0} { + error "DOS attack attempting to override the form counter" + } + + # extension of Michael Cleverly's above bug, fixed by ben@openforce + if { [string compare $name form_size] == 0} { + error "DOS attack attempting to override the form size" + } +} + +proc set_form_variables {{error_if_not_found_p 1}} { + if { $error_if_not_found_p == 1} { + uplevel { + if { [ns_getform] == "" } { + ns_returnerror 500 "Missing form data" + return + } + } + } else { + uplevel { + if { [ns_getform] == "" } { + # we're not supposed to barf at the user but we want to return + # from this subroutine anyway because otherwise we'd get an error + return + } + } + } + + # at this point we know that the form is legal + + uplevel { + set form [ns_getform] + set form_size [ns_set size $form] + set form_counter_i 0 + while {$form_counter_i<$form_size} { + set name [ns_set key $form $form_counter_i] + set value [ns_set value $form $form_counter_i] + check_for_form_variable_naughtiness $name $value + set $name $value + incr form_counter_i + } + } +} + +proc set_form_variables_string_trim_DoubleAposQQ {} { + uplevel { + set form [ns_getform] + if {$form == ""} { + ns_returnerror 500 "Missing form data" + return; + } + set form_size [ns_set size $form] + set form_counter_i 0 + while {$form_counter_i<$form_size} { + set QQ[ns_set key $form $form_counter_i] [DoubleApos [string trim [ns_set value $form $form_counter_i]]] + incr form_counter_i + } + } +} + +proc set_the_usual_form_variables {{error_if_not_found_p 1}} { + if { [ns_getform] == "" } { + if $error_if_not_found_p { + uplevel { + ns_returnerror 500 "Missing form data" + return + } + } else { + return + } + } + uplevel { + set form [ns_getform] + set form_size [ns_set size $form] + set form_counter_i 0 + while {$form_counter_i<$form_size} { + set name [ns_set key $form $form_counter_i] + set value [ns_set value $form $form_counter_i] + check_for_form_variable_naughtiness $name $value + set $name $value + set QQ[ns_set key $form $form_counter_i] [DoubleApos [string trim $value]] + incr form_counter_i + } + } +} + +proc set_form_variables_string_trim_DoubleApos {} { + uplevel { + set form [ns_getform] + if {$form == ""} { + ns_returnerror 500 "Missing form data" + return; + } + set form_size [ns_set size $form] + set form_counter_i 0 + while {$form_counter_i<$form_size} { + set name [ns_set key $form $form_counter_i] + set value [ns_set value $form $form_counter_i] + check_for_form_variable_naughtiness $name $value + set $name [DoubleApos [string trim $value]] + incr form_counter_i + } + } +} + +proc set_form_variables_string_trim {} { + uplevel { + set form [ns_getform] + if {$form == ""} { + ns_returnerror 500 "Missing form data" + return; + } + set form_size [ns_set size $form] + set form_counter_i 0 + while {$form_counter_i<$form_size} { + set name [ns_set key $form $form_counter_i] + set value [ns_set value $form $form_counter_i] + check_for_form_variable_naughtiness $name $value + set $name [string trim $value] + incr form_counter_i + } + } +} + +proc DoubleApos {string} { + regsub -all ' "$string" '' result + return $result +} + +# if the user types "O'Malley" and you try to insert that into an SQL +# database, you will lose big time because the single quote is magic +# in SQL and the insert has to look like 'O''Malley'. This function +# also trims white space off the ends of the user-typed data. + +# if the form looked like +# <input type=text name=yow> and <input type=text name=bar> +# then after you run this function you'll have Tcl vars +# $QQfoo and $QQbar set to whatever the user typed in the form +# plus an extra single quote in front of the user's single quotes +# and maybe some missing white space + +proc_doc ad_page_variables {variable_specs} { +<pre> +Current syntax: + +ad_page_variables {var_spec1 [varspec2] ... } + + This proc handles translating form inputs into Tcl variables, and checking + to see that the correct set of inputs was supplied. Note that this is mostly a + check on the proper programming of a set of pages. + +Here are the recognized var_specs: + +variable; means it's required +{variable default-value} + Optional, with default value. If the value is supplied but is null, and the + default-value is present, that value is used. +{variable -multiple-list} + The value of the Tcl variable will be a list containing all of the + values (in order) supplied for that form variable. Particularly useful + for collecting checkboxes or select multiples. + Note that if required or optional variables are specified more than once, the + first (leftmost) value is used, and the rest are ignored. +{variable -array} + This syntax supports the idiom of supplying multiple form variables of the + same name but ending with a "_[0-9]", e.g., foo_1, foo_2.... Each value will be + stored in the array variable variable with the index being whatever follows the + underscore. + +There is an optional third element in the var_spec. If it is "QQ", "qq", or +some variant, a variable named "QQvariable" will be created and given the +same value, but with single quotes escaped suitable for handing to SQL. + +Other elements of the var_spec are ignored, so a documentation string +describing the variable can be supplied. + +Note that the default value form will become the value form in a "set" + +Note that the default values are filled in from left to right, and can depend on +values of variables to their left: +ad_page_variables { + file + {start 0} + {end {[expr $start + 20]}} +} +</pre> +} { + set exception_list [list] + set form [ns_getform] + if { $form != "" } { + set form_size [ns_set size $form] + set form_counter_i 0 + + # first pass -- go through all the variables supplied in the form + while {$form_counter_i<$form_size} { + set variable [ns_set key $form $form_counter_i] + set value [ns_set value $form $form_counter_i] + check_for_form_variable_naughtiness $variable $value + set found "not" + # find the matching variable spec, if any + foreach variable_spec $variable_specs { + if { [llength $variable_spec] >= 2 } { + switch -- [lindex $variable_spec 1] { + -multiple-list { + if { [lindex $variable_spec 0] == $variable } { + # variable gets a list of all the values + upvar 1 $variable var + lappend var $value + set found "done" + break + } + } + -array { + set varname [lindex $variable_spec 0] + set pattern "($varname)_(.+)" + if { [regexp $pattern $variable match array index] } { + if { ![empty_string_p $array] } { + upvar 1 $array arr + set arr($index) [ns_set value $form $form_counter_i] + } + set found "done" + break + } + } + default { + if { [lindex $variable_spec 0] == $variable } { + set found "set" + break + } + } + } + } elseif { $variable_spec == $variable } { + set found "set" + break + } + } + if { $found == "set" } { + upvar 1 $variable var + if { ![info exists var] } { + # take the leftmost value, if there are multiple ones + set var [ns_set value $form $form_counter_i] + } + } + incr form_counter_i + } + } + + # now make a pass over each variable spec, making sure everything required is there + # and doing defaulting for unsupplied things that aren't required + foreach variable_spec $variable_specs { + set variable [lindex $variable_spec 0] + upvar 1 $variable var + + if { [llength $variable_spec] >= 2 } { + if { ![info exists var] } { + set default_value_or_flag [lindex $variable_spec 1] + + switch -- $default_value_or_flag { + -array { + # don't set anything + } + -multiple-list { + set var [list] + } + default { + # Needs to be set. + uplevel [list eval set $variable "\[subst [list $default_value_or_flag]\]"] + # This used to be: + # + # uplevel [list eval [list set $variable "$default_value_or_flag"]] + # + # But it wasn't properly performing substitutions. + } + } + } + + + } else { + if { ![info exists var] } { + lappend exception_list "\"$variable\" required but not supplied" + } + } + + # modified by rhs@mit.edu on 1/31/2000 + # to QQ everything by default (but not arrays) + if {[info exists var] && ![array exists var]} { + upvar QQ$variable QQvar + set QQvar [DoubleApos $var] + } + + } + + set n_exceptions [llength $exception_list] + # this is an error in the HTML form + if { $n_exceptions == 1 } { + ns_returnerror 500 [lindex $exception_list 0] + return -code return + } elseif { $n_exceptions > 1 } { + ns_returnerror 500 "<li>[join $exception_list "\n<li>"]\n" + return -code return + } +} + +# debugging kludges + +proc NsSettoTclString {set_id} { + set result "" + for {set i 0} {$i<[ns_set size $set_id]} {incr i} { + append result "[ns_set key $set_id $i] : [ns_set value $set_id $i]\n" + } + return $result +} + +proc get_referrer {} { + return [ns_set get [ns_conn headers] Referer] +} + +proc post_args_to_query_string {} { + set arg_form [ns_getform] + if {$arg_form!=""} { + set form_counter_i 0 + while {$form_counter_i<[ns_set size $arg_form]} { + append query_return "[ns_set key $arg_form $form_counter_i]=[ns_urlencode [ns_set value $arg_form $form_counter_i]]&" + incr form_counter_i + } + set query_return [string trim $query_return &] + } +} + +proc get_referrer_and_query_string {} { + if {[ns_conn method]!="GET"} { + set query_return [post_args_to_query_string] + return "[get_referrer]?${query_return}" + } else { + return [get_referrer] + } +} + +# a philg hack for getting all the values from a set of checkboxes +# returns 0 if none are checked, a Tcl list with the values otherwise +# terence change: specify default return if none checked +proc_doc util_GetCheckboxValues {form checkbox_name {default_return 0}} "For getting all the boxes from a set of checkboxes in a form. This procedure takes the complete ns_conn form and returns a list of checkbox values. It returns 0 if none are found (or some other default return value if specified)." { + + set i 0 + set size [ns_set size $form] + + while {$i<$size} { + + if { [ns_set key $form $i] == $checkbox_name} { + + # LIST_TO_RETURN will be created if it doesn't exist + + lappend list_to_return [ns_set value $form $i] + + } + incr i + } + + #if no list, you can specify a default return + #default default is 0 + + if { [info exists list_to_return] } { return $list_to_return } else {return $default_return} + +} + +# a legacy name that is deprecated +proc nmc_GetCheckboxValues {form checkbox_name {default_return 0}} { + return [util_GetCheckboxValues $form $checkbox_name $default_return] +} + + +## +# Database-related code +## + +proc nmc_GetNewIDNumber {id_name db} { + + ns_db dml $db "begin transaction;" + ns_db dml $db "update id_numbers set $id_name = $id_name + 1;" + set id_number [ns_set value\ + [ns_db 1row $db "select unique $id_name from id_numbers;"] 0] + ns_db dml $db "end transaction;" + + return $id_number + +} + + +# if you do a +# set selection [ns_db 1row $db "select foo,bar from my_table where key=37"] +# set_variables_after_query +# then you will find that the Tcl vars $foo and $bar are set to whatever +# the database returned. If you don't like these var names, you can say +# set selection [ns_db 1row $db "select count(*) as n_rows from my_table"] +# set_variables_after_query +# and you will find the Tcl var $n_rows set + +# You can also use this in a multi-row loop +# set selection [ns_db select $db "select *,upper(email) from mailing_list order by upper(email)"] +# while { [ns_db getrow $db $selection] } { +# set_variables_after_query +# ... your code here ... +# } +# then the appropriate vars will be set during your loop + +# +# CAVEAT NERDOR: you MUST use the variable name "selection" +# + +# +# we pick long names for the counter and limit vars +# because we don't want them to conflict with names of +# database columns or in parent programs +# + +proc set_variables_after_query {} { + uplevel { + set set_variables_after_query_i 0 + set set_variables_after_query_limit [ns_set size $selection] + while {$set_variables_after_query_i<$set_variables_after_query_limit} { + set [ns_set key $selection $set_variables_after_query_i] [ns_set value $selection $set_variables_after_query_i] + incr set_variables_after_query_i + } + } +} + +# as above, but you must use sub_selection + +proc set_variables_after_subquery {} { + uplevel { + set set_variables_after_query_i 0 + set set_variables_after_query_limit [ns_set size $sub_selection] + while {$set_variables_after_query_i<$set_variables_after_query_limit} { + set [ns_set key $sub_selection $set_variables_after_query_i] [ns_set value $sub_selection $set_variables_after_query_i] + incr set_variables_after_query_i + } + } +} + +#same as philg's but you can: +#1. specify the name of the "selection" variable +#2. append a prefix to all the named variables + +proc set_variables_after_query_not_selection {selection_variable {name_prefix ""}} { + set set_variables_after_query_i 0 + set set_variables_after_query_limit [ns_set size $selection_variable] + while {$set_variables_after_query_i<$set_variables_after_query_limit} { + # NB backslash squarebracket needed since mismatched {} would otherwise mess up value stmt. + uplevel " + set ${name_prefix}[ns_set key $selection_variable $set_variables_after_query_i] \[ns_set value $selection_variable $set_variables_after_query_i] + " + incr set_variables_after_query_i + } +} + +# takes a query like "select unique short_name from products where product_id = 45" +# and returns the result (only works when you are after a single row/column +# intersection) +proc database_to_tcl_string {db sql { no_prep 0 }} { + + if { $no_prep == 1 } { + set selection [ns_db 1row $db $sql] + } else { + set selection [ns_db 1row $db [db_sql_prep $sql]] + } + + return [ns_set value $selection 0] + +} + + +proc database_to_tcl_string_or_null {db sql {null_value ""}} { + set selection [ns_db 0or1row $db [db_sql_prep $sql]] + if { $selection != "" } { + return [ns_set value $selection 0] + } else { + # didn't get anything from the database + return $null_value + } +} + +#for commands like set full_name ["select first_name, last_name..."] + +proc database_cols_to_tcl_string {db sql} { + set string_to_return "" + set selection [ns_db 1row $db $sql] + set size [ns_set size $selection] + set i 0 + while {$i<$size} { + append string_to_return " [ns_set value $selection $i]" + incr i + } + return [string trim $string_to_return] +} + +proc_doc database_to_tcl_list {db sql} {takes a query like "select product_id from foobar" and returns all the ids as a Tcl list} { + set selection [ns_db select $db [db_sql_prep $sql]] + set list_to_return [list] + while {[ns_db getrow $db $selection]} { + lappend list_to_return [ns_set value $selection 0] + } + return $list_to_return +} + +proc_doc database_to_tcl_list_list {db sql} "Returns a list of Tcl lists, with each sublist containing the columns returned by the database; if no rows are returned by the database, returns the empty list (empty string in Tcl 7.x and 8.x)" { + set selection [ns_db select $db [db_sql_prep $sql]] + set list_to_return [list] + while {[ns_db getrow $db $selection]} { + set row_list "" + set size [ns_set size $selection] + set i 0 + while {$i<$size} { + lappend row_list [ns_set value $selection $i] + incr i + } + lappend list_to_return $row_list + } + return $list_to_return +} + +proc_doc database_1row_to_tcl_list {db sql} "Returns the column values from one row in the database as a Tcl list. If there isn't exactly one row from this query, throws an error." { + set selection [ns_db 1row $db $sql] + set list_to_return [list] + set size [ns_set size $selection] + set counter 0 + while {$counter<$size} { + lappend list_to_return [ns_set value $selection $counter] + incr counter + } + return $list_to_return +} + + +proc_doc ad_dbclick_check_dml { db table_name id_column_name generated_id return_url insert_sql } " +this proc is used for pages using double click protection. table_name is table_name for which we are checking whether the double click occured. id_column_name is the name of the id table column. generated_id is the generated id, which is supposed to have been generated on the previous page. return_url is url to which this procedure will return redirect in the case of successful insertion in the database. insert_sql is the sql insert statement. if data is ok this procedure will insert data into the database in a double click safe manner and will returnredirect to the page specified by return_url. if database insert fails, this procedure will return a sensible error message to the user." { + if [catch { + ns_db dml $db $insert_sql + } errmsg] { + # Oracle choked on the insert + + # detect double click + set selection [ns_db 0or1row $db " + select 1 + from $table_name + where $id_column_name='[DoubleApos $generated_id]'"] + + if { ![empty_string_p $selection] } { + # it's a double click, so just redirect the user to the index page + ns_returnredirect $return_url + return + } + + ns_log Error "[info script] choked. Oracle returned error: $errmsg" + + ad_return_error "Error in insert" " + We were unable to do your insert in the database. + Here is the error that was returned: + <p> + <blockquote> + <pre> + $errmsg + </pre> + </blockquote>" + return + } + + ns_returnredirect $return_url + return +} + +proc nmc_IllustraDatetoPrettyDate {sql_date} { + + regexp {(.*)-(.*)-(.*)$} $sql_date match year month day + + set allthemonths {January February March April May June July August September October November December} + + # we have to trim the leading zero because Tcl has such a + # brain damaged model of numbers and decided that "09-1" + # was "8.0" + + set trimmed_month [string trimleft $month 0] + set pretty_month [lindex $allthemonths [expr $trimmed_month - 1]] + + return "$pretty_month $day, $year" + +} + +proc util_IllustraDatetoPrettyDate {sql_date} { + + regexp {(.*)-(.*)-(.*)$} $sql_date match year month day + + set allthemonths {January February March April May June July August September October November December} + + # we have to trim the leading zero because Tcl has such a + # brain damaged model of numbers and decided that "09-1" + # was "8.0" + + set trimmed_month [string trimleft $month 0] + set pretty_month [lindex $allthemonths [expr $trimmed_month - 1]] + + return "$pretty_month $day, $year" + +} + +# this is the preferred one to use + +proc_doc util_AnsiDatetoPrettyDate {sql_date} "Converts 1998-09-05 to September 5, 1998" { + set sql_date [string range $sql_date 0 9] + + if ![regexp {(.*)-(.*)-(.*)$} $sql_date match year month day] { + return "" + } else { + set allthemonths {January February March April May June July August September October November December} + + # we have to trim the leading zero because Tcl has such a + # brain damaged model of numbers and decided that "09-1" + # was "8.0" + + set trimmed_month [string trimleft $month 0] + set pretty_month [lindex $allthemonths [expr $trimmed_month - 1]] + + set trimmed_day [string trimleft $day 0] + + return "$pretty_month $trimmed_day, $year" + } +} + +proc_doc util_AnsiTimestamptoPrettyTimestamp {sql_timestamp} "Converts 1998-09-05 10:00:00 to September 5, 1998 10:00" { + ## Add a hack for Postgres dates that include the timestamp + # DRB: the right number really is 9 "YYYY-MM-DD" + + set pretty_date [util_AnsiDatetoPrettyDate [string range $sql_timestamp 0 9]] + + return "$pretty_date [string range $sql_timestamp 10 end]" +} + +# from the new-utilities.tcl file + +proc remove_nulls_from_ns_set {old_set_id} { + + set new_set_id [ns_set new "no_nulls$old_set_id"] + + for {set i 0} {$i<[ns_set size $old_set_id]} {incr i} { + if { [ns_set value $old_set_id $i] != "" } { + + ns_set put $new_set_id [ns_set key $old_set_id $i] [ns_set value $old_set_id $i] + + } + + } + + return $new_set_id + +} + +proc merge_form_with_ns_set {form set_id} { + + for {set i 0} {$i<[ns_set size $set_id]} {incr i} { + set form [ns_formvalueput $form [ns_set key $set_id $i] [ns_set value $set_id $i]] + } + + return $form + +} + +proc merge_form_with_query {form db query} { + + set set_id [ns_db 0or1row $db $query] + + if { $set_id != "" } { + + for {set i 0} {$i<[ns_set size $set_id]} {incr i} { + set form [ns_formvalueput $form [ns_set key $set_id $i] [ns_set value $set_id $i]] + } + + } + + return $form + +} + + +proc bt_mergepiece {htmlpiece values} { + # HTMLPIECE is a form usually; VALUES is an ns_set + + # NEW VERSION DONE BY BEN ADIDA (ben@mit.edu) + # Last modification (ben@mit.edu) on Jan ?? 1998 + # added support for dates in the date_entry_widget. + # + # modification (ben@mit.edu) on Jan 12th, 1998 + # when the val of an option tag is "", things screwed up + # FIXED. + # + # This used to count the number of vars already introduced + # in the form (see remaining num_vars statements), so as + # to end early. However, for some unknown reason, this cut off a number + # of forms. So now, this processes every tag in the HTML form. + + set newhtml "" + + set html_piece_ben $htmlpiece + + set num_vars 0 + + for {set i 0} {$i<[ns_set size $values]} {incr i} { + if {[ns_set key $values $i] != ""} { + set database_values([ns_set key $values $i]) [philg_quote_double_quotes [ns_set value $values $i]] + incr num_vars + } + } + + set vv {[Vv][Aa][Ll][Uu][Ee]} ; # Sorta obvious + set nn {[Nn][Aa][Mm][Ee]} ; # This is too + set qq {"([^"]*)"} ; # Matches what's in quotes + set pp {([^ ]*)} ; # Matches a word (mind yer pp and qq) + + set slist {} + + set count 0 + + while {1} { + + incr count + set start_point [string first < $html_piece_ben] + if {$start_point==-1} { + append newhtml $html_piece_ben + break; + } + if {$start_point>0} { + append newhtml [string range $html_piece_ben 0 [expr $start_point - 1]] + } + set end_point [string first > $html_piece_ben] + if {$end_point==-1} break + incr start_point + incr end_point -1 + set tag [string range $html_piece_ben $start_point $end_point] + incr end_point 2 + set html_piece_ben [string range $html_piece_ben $end_point end] + set CAPTAG [string toupper $tag] + + set first_white [string first " " $CAPTAG] + set first_word [string range $CAPTAG 0 [expr $first_white - 1]] + + switch -regexp $CAPTAG { + + {^INPUT} { + if {[regexp {TYPE[ ]*=[ ]*("IMAGE"|"SUBMIT"|"RESET"|IMAGE|SUBMIT|RESET)} $CAPTAG]} { + + ### + # Ignore these + ### + + append newhtml <$tag> + + } elseif {[regexp {TYPE[ ]*=[ ]*("CHECKBOX"|CHECKBOX)} $CAPTAG]} { + # philg and jesse added optional whitespace 8/9/97 + ## If it's a CHECKBOX, we cycle through + # all the possible ns_set pair to see if it should + ## end up CHECKED or not. + + if {[regexp "$nn=$qq" $tag m nam]} {}\ + elseif {[regexp "$nn=$pp" $tag m nam]} {}\ + else {set nam ""} + + if {[regexp "$vv=$qq" $tag m val]} {}\ + elseif {[regexp "$vv=$pp" $tag m val]} {}\ + else {set val ""} + + regsub -all {[Cc][Hh][Ee][Cc][Kk][Ee][Dd]} $tag {} tag + + # support for multiple check boxes provided by michael cleverly + if {[info exists database_values($nam)]} { + if {[ns_set unique $values $nam]} { + if {$database_values($nam) == $val} { + append tag " checked" + incr num_vars -1 + } + } else { + for {set i [ns_set find $values $nam]} {$i < [ns_set size $values]} {incr i} { + if {[ns_set key $values $i] == $nam && [philg_quote_double_quotes [ns_set value $values $i]] == $val} { + append tag " checked" + incr num_vars -1 + break + } + } + } + } + + append newhtml <$tag> + + } elseif {[regexp {TYPE[ ]*=[ ]*("RADIO"|RADIO)} $CAPTAG]} { + + ## If it's a RADIO, we remove all the other + # choices beyond the first to keep from having + ## more than one CHECKED + + if {[regexp "$nn=$qq" $tag m nam]} {}\ + elseif {[regexp "$nn=$pp" $tag m nam]} {}\ + else {set nam ""} + + if {[regexp "$vv=$qq" $tag m val]} {}\ + elseif {[regexp "$vv=$pp" $tag m val]} {}\ + else {set val ""} + + #Modified by Ben Adida (ben@mit.edu) so that + # the checked tags are eliminated only if something + # is in the database. + + if {[info exists database_values($nam)]} { + regsub -all {[Cc][Hh][Ee][Cc][Kk][Ee][Dd]} $tag {} tag + if {$database_values($nam)==$val} { + append tag " checked" + incr num_vars -1 + } + } + + append newhtml <$tag> + + } else { + + ## If it's an INPUT TYPE that hasn't been covered + # (text, password, hidden, other (defaults to text)) + ## then we add/replace the VALUE tag + + if {[regexp "$nn=$qq" $tag m nam]} {}\ + elseif {[regexp "$nn=$pp" $tag m nam]} {}\ + else {set nam ""} + + set nam [ns_urldecode $nam] + + if {[info exists database_values($nam)]} { + regsub -all "$vv=$qq" $tag {} tag + regsub -all "$vv=$pp" $tag {} tag + append tag " value=\"$database_values($nam)\"" + incr num_vars -1 + } else { + if {[regexp {ColValue.([^.]*).([^ ]*)} $tag all nam type]} { + set nam [ns_urldecode $nam] + set typ "" + if {[string match $type "day"]} { + set typ "day" + } + if {[string match $type "year"]} { + set typ "year" + } + if {$typ != ""} { + if {[info exists database_values($nam)]} { + regsub -all "$vv=$qq" $tag {} tag + regsub -all "$vv=$pp" $tag {} tag + append tag " value=\"[ns_parsesqldate $typ $database_values($nam)]\"" + } + } + #append tag "><nam=$nam type=$type typ=$typ" + } + } + append newhtml <$tag> + } + } + + {^TEXTAREA} { + + ### + # Fill in the middle of this tag + ### + + if {[regexp "$nn=$qq" $tag m nam]} {}\ + elseif {[regexp "$nn=$pp" $tag m nam]} {}\ + else {set nam ""} + + if {[info exists database_values($nam)]} { + while {![regexp {^<( *)/[Tt][Ee][Xx][Tt][Aa][Rr][Ee][Aa]} $html_piece_ben]} { + regexp {^.[^<]*(.*)} $html_piece_ben m html_piece_ben + } + append newhtml <$tag>$database_values($nam) + incr num_vars -1 + } else { + append newhtml <$tag> + } + } + + {^SELECT} { + + ### + # Set the snam flag, and perhaps smul, too + ### + + set smul [regexp "MULTIPLE" $CAPTAG] + + set sflg 1 + + set select_date 0 + + if {[regexp "$nn=$qq" $tag m snam]} {}\ + elseif {[regexp "$nn=$pp" $tag m snam]} {}\ + else {set snam ""} + + set snam [ns_urldecode $snam] + + # In case it's a date + if {[regexp {ColValue.([^.]*).month} $snam all real_snam]} { + if {[info exists database_values($real_snam)]} { + set snam $real_snam + set select_date 1 + } + } + + lappend slist $snam + + append newhtml <$tag> + } + + {^OPTION} { + + ### + # Find the value for this + ### + + if {$snam != ""} { + + if {[lsearch -exact $slist $snam] != -1} {regsub -all {[Ss][Ee][Ll][Ee][Cc][Tt][Ee][Dd]} $tag {} tag} + + if {[regexp "$vv *= *$qq" $tag m opt]} {}\ + elseif {[regexp "$vv *= *$pp" $tag m opt]} {}\ + else { + if {[info exists opt]} { + unset opt + } } + # at this point we've figured out what the default from the form was + # and put it in $opt (if the default was spec'd inside the OPTION tag + # just in case it wasn't, we're going to look for it in the + # human-readable part + regexp {^([^<]*)(.*)} $html_piece_ben m txt html_piece_ben + if {![info exists opt]} { + set val [string trim $txt] + } else { + set val $opt + } + + if {[info exists database_values($snam)]} { + # If we're dealing with a date + if {$select_date == 1} { + set db_val [ns_parsesqldate month $database_values($snam)] + } else { + set db_val $database_values($snam) + } + + if { + ($smul || $sflg) && + [string match $db_val $val] + } then { + append tag " selected" + incr num_vars -1 + set sflg 0 + } + } + } + append newhtml <$tag>$txt + } + + {^/SELECT} { + + ### + # Do we need to add to the end? + ### + + set txt "" + + if {$snam != ""} { + if {[info exists database_values($snam)] && $sflg} { + append txt "<option selected>$database_values($snam)" + incr num_vars -1 + if {!$smul} {set snam ""} + } + } + + append newhtml $txt<$tag> + } + + {default} { + append newhtml <$tag> + } + } + + } + return $newhtml +} + + + +# database stuff + + +proc_doc GetColumnNames {db table} "returns a list with the column names of the table" { + #returns a list with the column names of the table + set size [ns_column count $db $table] + set i 0 + set column_names "" + while {$i<$size} { + lappend column_names [ns_column name $db $table $i] + incr i + } + return $column_names; +} + +proc util_GetNewIDNumber {id_name db} { + + ns_db dml $db "begin transaction;" + ns_db dml $db "update id_numbers set $id_name = $id_name + 1;" + set id_number [ns_set value\ + [ns_db 1row $db "select unique $id_name from id_numbers;"] 0] + ns_db dml $db "end transaction;" + + return $id_number + +} + +proc util_prepare_update {db table_name primary_key_name primary_key_value form} { + + set form_size [ns_set size $form] + set form_counter_i 0 + set column_list [GetColumnNames $db $table_name] + while {$form_counter_i<$form_size} { + + set form_var_name [ns_set key $form $form_counter_i] + set value [string trim [ns_set value $form $form_counter_i]] + if { ($form_var_name != $primary_key_name) && ([lsearch $column_list $form_var_name] != -1) } { + + set column_type [ns_column type $db $table_name $form_var_name] + + # we use the NaviServer built-in function quoted_value + # which is part of the nsdb tcl module (util.tcl) + + #Added this to allow dates and such to call things + #like "current_date"--this is kludgy and should be + #fleshed out + + if {[regexp {date|time} $column_type]&&[regexp -nocase {current} $value]} { + set quoted_value $value + } else { + set quoted_value [ns_dbquotevalue $value $column_type] + } + + lappend the_sets "$form_var_name = $quoted_value" + + + } + + incr form_counter_i + } + + set primary_key_type [ns_column type $db $table_name $primary_key_name] + + return "update $table_name\nset [join $the_sets ",\n"] \n where $primary_key_name = [ns_dbquotevalue $primary_key_value $primary_key_type]" + +} + +proc util_prepare_update_multi_key {db table_name primary_key_name_list primary_key_value_list form} { + + set form_size [ns_set size $form] + set form_counter_i 0 + while {$form_counter_i<$form_size} { + + set form_var_name [ns_set key $form $form_counter_i] + set value [string trim [ns_set value $form $form_counter_i]] + + if { [lsearch -exact $primary_key_name_list $form_var_name] == -1 } { + + # this is not one of the keys + + set column_type [ns_column type $db $table_name $form_var_name] + + # we use the NaviServer built-in function quoted_value + # which is part of the nsdb tcl module (util.tcl) + + set quoted_value [ns_dbquotevalue $value $column_type] + + lappend the_sets "$form_var_name = $quoted_value" + + + } + + incr form_counter_i + } + + for {set i 0} {$i<[llength $primary_key_name_list]} {incr i} { + + set this_key_name [lindex $primary_key_name_list $i] + set this_key_value [lindex $primary_key_value_list $i] + set this_key_type [ns_column type $db $table_name $this_key_name] + + lappend key_eqns "$this_key_name = [ns_dbquotevalue $this_key_value $this_key_type]" + + } + + return "update $table_name\nset [join $the_sets ",\n"] \n where [join $key_eqns " AND "]" + +} + +proc util_prepare_insert {db table_name primary_key_name primary_key_value form} { + + set form_size [ns_set size $form] + set form_counter_i 0 + while {$form_counter_i<$form_size} { + + set form_var_name [ns_set key $form $form_counter_i] + set value [string trim [ns_set value $form $form_counter_i]] + + if { $form_var_name != $primary_key_name } { + + set column_type [ns_column type $db $table_name $form_var_name] + + # we use the NaviServer built-in function quoted_value + # which is part of the nsdb tcl module (util.tcl) + + set quoted_value [ns_dbquotevalue $value $column_type] + + lappend the_names $form_var_name + lappend the_vals $quoted_value + + + } + + incr form_counter_i + } + + set primary_key_type [ns_column type $db $table_name $primary_key_name] + + return "insert into $table_name\n($primary_key_name,[join $the_names ","]) \n values ([ns_dbquotevalue $primary_key_value $primary_key_type],[join $the_vals ","])" + +} + +proc util_prepare_insert_string_trim {db table_name primary_key_name primary_key_value form} { + + set form_size [ns_set size $form] + set form_counter_i 0 + while {$form_counter_i<$form_size} { + + set form_var_name [ns_set key $form $form_counter_i] + set value [string trim [ns_set value $form $form_counter_i]] + + if { $form_var_name != $primary_key_name } { + + set column_type [ns_column type $db $table_name $form_var_name] + + # we use the NaviServer built-in function quoted_value + # which is part of the nsdb tcl module (util.tcl) + + set quoted_value [ns_dbquotevalue $value $column_type] + + lappend the_names $form_var_name + lappend the_vals $quoted_value + + + } + + incr form_counter_i + } + + set primary_key_type [ns_column type $db $table_name $primary_key_name] + + return "insert into $table_name\n($primary_key_name,[join $the_names ","]) \n values ([ns_dbquotevalue $primary_key_value $primary_key_type],[join $the_vals ","])" + +} + +proc util_prepare_insert_no_primary_key {db table_name form} { + + set form_size [ns_set size $form] + set form_counter_i 0 + while {$form_counter_i<$form_size} { + + set form_var_name [ns_set key $form $form_counter_i] + set value [string trim [ns_set value $form $form_counter_i]] + + set column_type [ns_column type $db $table_name $form_var_name] + + # we use the NaviServer built-in function quoted_value + # which is part of the nsdb tcl module (util.tcl) + + set quoted_value [ns_dbquotevalue $value $column_type] + + lappend the_names $form_var_name + lappend the_vals $quoted_value + + incr form_counter_i + } + + + return "insert into $table_name\n([join $the_names ","]) \n values ([join $the_vals ","])" + +} + +proc util_PrettySex {m_or_f { default "default" }} { + if { $m_or_f == "M" || $m_or_f == "m" } { + return "Male" + } elseif { $m_or_f == "F" || $m_or_f == "f" } { + return "Female" + } else { + # Note that we can't compare default to the empty string as in + # many cases, we are going want the default to be the empty + # string + if { [string compare $default "default"] == 0 } { + return "Unknown (\"$m_or_f\")" + } else { + return $default + } + } +} + +proc util_PrettySexManWoman {m_or_f { default "default"} } { + if { $m_or_f == "M" || $m_or_f == "m" } { + return "Man" + } elseif { $m_or_f == "F" || $m_or_f == "f" } { + return "Woman" + } else { + # Note that we can't compare default to the empty string as in + # many cases, we are going want the default to be the empty + # string + if { [string compare $default "default"] == 0 } { + return "Person of Unknown Sex" + } else { + return $default + } + } +} + +proc util_PrettyBoolean {t_or_f { default "default" } } { + if { $t_or_f == "t" || $t_or_f == "T" } { + return "Yes" + } elseif { $t_or_f == "f" || $t_or_f == "F" } { + return "No" + } else { + # Note that we can't compare default to the empty string as in + # many cases, we are going want the default to be the empty + # string + if { [string compare $default "default"] == 0 } { + return "Unknown (\"$t_or_f\")" + } else { + return $default + } + } +} + + +proc_doc util_PrettyTclBoolean {zero_or_one} "Turns a 1 (or anything else that makes a Tcl IF happy) into Yes; anything else into No" { + if $zero_or_one { + return "Yes" + } else { + return "No" + } +} + +# Pre-declare the cache arrays used in util_memoize. +nsv_set util_memoize_cache_value . "" +nsv_set util_memoize_cache_timestamp . "" + +proc_doc util_memoize {tcl_statement {oldest_acceptable_value_in_seconds ""}} "Returns the result of evaluating the Tcl statement argument and then remembers that value in a cache; the memory persists for the specified number of seconds (or until the server is restarted if the second argument is not supplied) or until someone calls util_memoize_flush with the same Tcl statement. Note that this procedure should be used with care because it calls the eval built-in procedure (and therefore an unscrupulous user could " { + + # we look up the statement in the cache to see if it has already + # been eval'd. The statement itself is the key + + if { ![nsv_exists util_memoize_cache_value $tcl_statement] || ( ![empty_string_p $oldest_acceptable_value_in_seconds] && ([expr [nsv_get util_memoize_cache_timestamp $tcl_statement] + $oldest_acceptable_value_in_seconds] < [ns_time]) )} { + + # not in the cache already OR the caller spec'd an expiration + # time and our cached value is too old + + set statement_value [eval $tcl_statement] + nsv_set util_memoize_cache_value $tcl_statement $statement_value + # store the time in seconds since 1970 + nsv_set util_memoize_cache_timestamp $tcl_statement [ns_time] + } + + return [nsv_get util_memoize_cache_value $tcl_statement] +} + +proc_doc util_memoize_seed {tcl_statement value {oldest_acceptable_value_in_seconds ""}} "Seeds the memoize catch with a particular value. If clustering is enabled, flushes cached values from peers in the cluster." { + server_cluster_httpget_from_peers "/SYSTEM/flush-memoized-statement.tcl?statement=[ns_urlencode $tcl_statement]" + nsv_set util_memoize_cache_value $tcl_statement $value + # store the time in seconds since 1970 + nsv_set util_memoize_cache_timestamp $tcl_statement [ns_time] +} + +# flush the cache + +proc_doc util_memoize_flush_local {tcl_statement} "Flush the cached value only on the local server. In general you will want to use util_memoize_flush instead of this!" { + if [nsv_exists util_memoize_cache_value $tcl_statement] { + nsv_unset util_memoize_cache_value $tcl_statement + } + if [nsv_exists util_memoize_cache_timestamp $tcl_statement] { + nsv_unset util_memoize_cache_timestamp $tcl_statement + } +} + +proc_doc util_memoize_flush {tcl_statement} "Flush the cached value (established with util_memoize associated with the argument). If clustering is enabled, flushes cached values from peers in the cluster." { + server_cluster_httpget_from_peers "/SYSTEM/flush-memoized-statement.tcl?statement=[ns_urlencode $tcl_statement]" + util_memoize_flush_local $tcl_statement +} + +proc_doc util_memoize_value_cached_p {tcl_statement {oldest_acceptable_value_in_seconds ""}} "Returns 1 if there is a cached value for this Tcl expression. If a second argument is supplied, only returns 1 if the cached value isn't too old." { + + # we look up the statement in the cache to see if it has already + # been eval'd. The statement itself is the key + + if { ![nsv_exists util_memoize_cache_value $tcl_statement] || ( ![empty_string_p $oldest_acceptable_value_in_seconds] && ([expr [nsv_get util_memoize_cache_timestamp $tcl_statement] + $oldest_acceptable_value_in_seconds] < [ns_time]) )} { + return 0 + } else { + return 1 + } +} + + +proc current_year {db} { + util_memoize "current_year_internal $db" +} + +proc current_year_internal {db} { + + database_to_tcl_string $db "return extract(year from current_date)" + +} + +proc philg_server_default_pool {} { + set server_name [ns_info server] + append config_path "ns\\server\\" $server_name "\\db" + set default_pool [ns_config $config_path DefaultPool] + return $default_pool +} + +# this is typically called like this... +# philg_urldecode_form_variable [ns_getform] +# and it is called for effect, not value +# we use it if we've urlencoded something for a hidden +# variable (e.g., to escape the string quotes) in a form + +proc philg_urldecode_form_variable {form variable_name} { + set old_value [ns_set get $form $variable_name] + set new_value [ns_urldecode $old_value] + # one has to delete the old value first, otherwise + # you just get two values for the same key in the ns_set + ns_set delkey $form $variable_name + ns_set put $form $variable_name $new_value +} + +proc util_convert_plaintext_to_html {raw_string} { + if { [regexp -nocase {<p>} $raw_string] || [regexp -nocase {<br>} $raw_string] } { + # user was already trying to do this as HTML + return $raw_string + } else { + # quote <, >, and & + set clean_for_html [ns_quotehtml $raw_string] + # turn CRLFCRLF into <P> + if { [regsub -all "\015\012\015\012" $clean_for_html "\n\n<p>\n\n" clean_for_html] == 0 } { + # try LFLF + if { [regsub -all "\012\012" $clean_for_html "\n\n<p><p>\n\n" clean_for_html] == 0 } { + # try CRCR + regsub -all "\015\015" $clean_for_html "\n\n<p><p>\n\n" clean_for_html + } + } + return $clean_for_html + } +} + +proc_doc util_maybe_convert_to_html {raw_string html_p} "very useful for info pulled from the news, neighbor, events subsystems." { + if { $html_p == "t" } { + return $raw_string + } else { + return [util_convert_plaintext_to_html $raw_string] + } +} + + +# turn " into " before using strings inside hidden vars +# patched on May 31, 1999 by philg to also quote >, <, and & +# fixed a bug in /bboard/confirm + +proc philg_quote_double_quotes {arg} { + # we have to do & first or we'll hose ourselves with the ones lower down + regsub -all & $arg \\&\; arg + regsub -all \" $arg \\"\; arg + regsub -all < $arg \\<\; arg + regsub -all > $arg \\>\; arg + return $arg +} + +# stuff that will let us do what ns_striphtml does but a little better + +proc_doc util_striphtml {html} {Returns a best-guess plain text version of an HTML fragment. Better than ns_striphtml because it doesn't replace & g t ; and & l t ; with empty string.} { + return [util_expand_entities [util_remove_html_tags $html]] +} + +proc util_remove_html_tags {html} { + regsub -all {<[^>]*>} $html {} html + return $html +} + +proc util_expand_entities {html} { + regsub -all {<} $html {<} html + regsub -all {>} $html {>} html + regsub -all {"} $html {"} html + regsub -all {&} $html {\&} html + return $html +} + +proc util_GetUserAgentHeader {} { + set header [ns_conn headers] + + # note that this MUST be case-insensitive search (iget) + # due to a NaviServer bug -- philg 2/1/96 + + set userag [ns_set iget $header "USER-AGENT"] + return $userag +} + +proc msie_p {} { + return [regexp -nocase {msie} [util_GetUserAgentHeader]] +} + +proc submit_button_if_msie_p {} { + if { [msie_p] } { + return "<input type=submit>" + } else { + return "" + } +} + +proc randomInit {seed} { + nsv_set rand ia 9301 + nsv_set rand ic 49297 + nsv_set rand im 233280 + nsv_set rand seed $seed +} + +# initialize the random number generator + +randomInit [ns_time] + +proc random {} { + nsv_set rand seed [expr ([nsv_get rand seed] * [nsv_get rand ia] + [nsv_get rand ic]) % [nsv_get rand im]] + return [expr [nsv_get rand seed]/double([nsv_get rand im])] +} + +proc randomRange {range} { + return [expr int([random] * $range)] +} + +proc capitalize {word} { + if {$word != ""} { + set newword "" + if [regexp {[^ ]* [^ ]*} $word] { + set words [split $word] + foreach part $words { + set newword "$newword [capitalize $part]" + } + } else { + regexp {^(.)(.*)$} $word match firstchar rest + set newword [string toupper $firstchar]$rest + } + return [string trim $newword] + } + return $word +} + +proc html_select_options {options {select_option ""}} { + #this is html to be placed into a select tag + set select_options "" + foreach option $options { + if { [lsearch $select_option $option] != -1 } { + append select_options "<option selected>$option\n" + } else { + append select_options "<option>$option\n" + } + } + return $select_options +} + +proc db_html_select_options {db query {select_option ""}} { + #this is html to be placed into a select tag + set select_options "" + set options [database_to_tcl_list $db $query] + foreach option $options { + if { [string compare $option $select_option] == 0 } { + append select_options "<option selected>$option\n" + } else { + append select_options "<option>$option\n" + } + } + return $select_options +} + +proc html_select_value_options {options {select_option ""} {value_index 0} {option_index 1}} { + #this is html to be placed into a select tag + #when value!=option, set the index of the return list + #from the db query. selected option must match value + + set select_options "" + foreach option $options { + if { [lsearch $select_option [lindex $option $value_index]] != -1 } { + append select_options "<option value=\"[philg_quote_double_quotes [lindex $option $value_index]]\" selected>[lindex $option $option_index]\n" + } else { + append select_options "<option value=\"[philg_quote_double_quotes [lindex $option $value_index]]\">[lindex $option $option_index]\n" + } + } + return $select_options +} + +proc db_html_select_value_options {db query {select_option ""} {value_index 0} {option_index 1}} { + #this is html to be placed into a select tag + #when value!=option, set the index of the return list + #from the db query. selected option must match value + + set select_options "" + set options [database_to_tcl_list_list $db $query] + foreach option $options { + if { [lsearch $select_option [lindex $option $value_index]] != -1 } { + append select_options "<option value=\"[philg_quote_double_quotes [lindex $option $value_index]]\" selected>[lindex $option $option_index]\n" + } else { + append select_options "<option value=\"[philg_quote_double_quotes [lindex $option $value_index]]\">[lindex $option $option_index]\n" + } + } + return $select_options +} + +# new philg kludges + +# produces a safe-for-browsers hidden variable, i.e., one where +# " has been replaced by " + +proc philg_hidden_input {name value} { + return "<input type=hidden name=\"$name\" value=\"[philg_quote_double_quotes $value]\">" +} + +# this REGEXP was very kindly contributed by Jeff Friedl, author of +# _Mastering Regular Expressions_ (O'Reilly 1997) +proc_doc philg_email_valid_p {query_email} "Returns 1 if an email address has more or less the correct form" { + return [regexp "^\[^@\t ]+@\[^@.\t]+(\\.\[^@.\n ]+)+$" $query_email] +} + +proc_doc philg_url_valid_p {query_url} "Returns 1 if a URL has more or less the correct form." { + return [regexp {http://.+} $query_url] +} + +# just checking it for format, not semantics + +proc philg_date_valid_p {query_date} { + return [regexp {[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]} $query_date] +} +# Return a string of hidden input fields for a form to pass along any +# of the parameters in args if they exist in the current environment. +# -- jsc@arsdigita.com + +# usage: [export_form_vars foo bar baz] + +proc export_form_vars args { + set hidden "" + foreach var $args { + upvar 1 $var value + if { [info exists value] } { + append hidden "<input type=hidden name=$var value=\"[philg_quote_double_quotes $value]\">\n" + } + } + return $hidden +} + +proc export_entire_form {} { + set hidden "" + set the_form [ns_getform] + for {set i 0} {$i<[ns_set size $the_form]} {incr i} { + set varname [ns_set key $the_form $i] + set varvalue [ns_set value $the_form $i] + append hidden "<input type=hidden name=\"$varname\" value=\"[philg_quote_double_quotes $varvalue]\">\n" + } + return $hidden +} + + +proc_doc export_ns_set_vars {{format "url"} {exclusion_list ""} {setid ""}} "Returns all the params in an ns_set with the exception of those in exclusion_list. If no setid is provide, ns_getform is used. If format = url, a url parameter string will be returned. If format = form, a block of hidden form fragments will be returned." { + + if [empty_string_p $setid] { + set setid [ns_getform] + } + + set return_list [list] + if ![empty_string_p $setid] { + set set_size [ns_set size $setid] + set set_counter_i 0 + while { $set_counter_i<$set_size } { + set name [ns_set key $setid $set_counter_i] + set value [ns_set value $setid $set_counter_i] + if {[lsearch $exclusion_list $name] == -1 && ![empty_string_p $name]} { + if {$format == "url"} { + lappend return_list "$name=[ns_urlencode $value]" + } else { + lappend return_list " name=$name value=\"[philg_quote_double_quotes $value]\"" + } + } + incr set_counter_i + } + } + if {$format == "url"} { + return [join $return_list "&"] + } else { + return "<input type=hidden [join $return_list ">\n <input type=hidden "] >" + } +} + + +# Return a URL parameter string passing along all the parameters +# given to it as arguments, if they exist in the current environment. +# -- jsc@arsdigita.com +proc_doc export_url_vars args "Returns a string of key=value pairs suitable for inclusion in a URL; you can pass it any number of variables as arguments. If any are defined in the caller's environment, they are included. See also export_entire_form_as_url_vars" { + set params {} + foreach var $args { + upvar 1 $var value + if { [info exists value] } { + lappend params "$var=[ns_urlencode $value]" + } + } + return [join $params "&"] +} + +proc_doc export_entire_form_as_url_vars {{vars_to_passthrough ""}} "Returns a URL parameter string of name-value pairs of all the form parameters passed to this page. If vars_to_passthrough is given, it should be a list of parameter names that will be the only ones passed through." { + set params [list] + set the_form [ns_getform] + for {set i 0} {$i<[ns_set size $the_form]} {incr i} { + set varname [ns_set key $the_form $i] + set varvalue [ns_set value $the_form $i] + if { $vars_to_passthrough == "" || ([lsearch -exact $vars_to_passthrough $varname] != -1) } { + lappend params "$varname=[ns_urlencode $varvalue]" + } + } + return [join $params "&"] +} + + +# we use this to shut off spam scheduling and such +# it asks the question "is this just a development server"? + +# we write DevelopmentServer=1 into the server portion of the .ini file + +# [ns/server/philg] +# DevelopmentServer=1 + + +proc philg_development_p {} { + set config_param [ns_config "ns/server/[ns_info server]" DevelopmentServer] + if { $config_param == 1 } { + return 1 + } else { + return 0 + } +} + +proc philg_keywords_match {keywords string_to_search} { + # turn keywords into space-separated things + # replace one or more commads with a space + regsub -all {,+} $keywords " " keywords_no_commas + set keyword_list [split $keywords_no_commas " "] + set found_p 0 + foreach word $keyword_list { + # turns out that "" is never found in a search, so we + # don't really have to special case $word == "" + if { $word != "" && [string first [string toupper $word] [string toupper $string_to_search]] != -1 } { + # found it! + set found_p 1 + } + } + return $found_p +} + +proc_doc philg_keywords_score {keywords string_to_search} "Takes space-separated keywords and returns 0 if none are found or a count of how many matched. If a keyword occurs twice then it is weighted 2." { + # turn keywords into space-separated things + # replace one or more commads with a space + regsub -all {,+} $keywords " " keywords_no_commas + set keyword_list [split $keywords_no_commas " "] + set score 0 + foreach word $keyword_list { + # turns out that "" is never found in a search, so we + # don't really have to special case $word == "" + if { $word != "" && [string first [string toupper $word] [string toupper $string_to_search]] != -1 } { + # found at least one! + if { [string first [string toupper $word] [string toupper $string_to_search]] == [string last [string toupper $word] [string toupper $string_to_search]] } { + # only one occurrence + incr score + } else { + # more than one, count as 2 (like AltaVista) + incr score 2 + } + } + } + return $score +} + +# usage: +# suppose the variable is called "expiration_date" +# put "[philg_dateentrywidget expiration_date]" in your form +# and it will expand into lots of weird generated var names +# put ns_dbformvalue [ns_getform] expiration_date date expiration_date +# and whatever the user typed will be set in $expiration_date + +proc philg_dateentrywidget {column {default_date "1940-11-03"}} { + ns_share NS + + set output "<SELECT name=ColValue.[ns_urlencode $column].month>\n" + for {set i 0} {$i < 12} {incr i} { + append output "<OPTION> [lindex $NS(months) $i]\n" + } + + append output \ +"</SELECT> <INPUT NAME=ColValue.[ns_urlencode $column].day\ +TYPE=text SIZE=3 MAXLENGTH=2> <INPUT NAME=ColValue.[ns_urlencode $column].year\ +TYPE=text SIZE=5 MAXLENGTH=4>" + + return [ns_dbformvalueput $output $column date $default_date] +} + +proc philg_dateentrywidget_default_to_today {column} { + set today [lindex [split [ns_localsqltimestamp] " "] 0] + return [philg_dateentrywidget $column $today] +} + +# Perform the dml statements in sql_list in a transaction. +# Aborts the transaction and returns an error message if +# an error occurred for any of the statements, otherwise +# returns null string. -jsc +proc do_dml_transactions {db sql_list} { + ns_db dml $db "begin transaction" + foreach stmt $sql_list { + if [catch {ns_db dml $db $stmt} errmsg] { + ns_db dml $db "abort transaction" + return $errmsg + } + } + ns_db dml $db "end transaction" + return "" +} + +# Perform body within a database transaction. +# Execute on_error if there was some error caught +# within body, with errmsg bound. +# This procedure will clobber errmsg in the caller. +# -jsc +proc with_transaction {db body on_error} { + upvar errmsg errmsg + global errorInfo errorCode + if [catch {ns_db dml $db "begin transaction" + uplevel $body + ns_db dml $db "end transaction"} errmsg] { + ns_log Notice "error: $errmsg" + ns_db dml $db "abort transaction" + set code [catch {uplevel $on_error} string] + # Return out of the caller appropriately. + if { $code == 1 } { + return -code error -errorinfo $errorInfo -errorcode $errorCode $string + } elseif { $code == 2 } { + return -code return $string + } elseif { $code == 3 } { + return -code break + } elseif { $code == 4 } { + return -code continue + } elseif { $code > 4 } { + return -code $code $string + } + } +} + +proc with_catch {error_var body on_error} { + upvar 1 $error_var $error_var + global errorInfo errorCode + if [catch { uplevel $body } $error_var] { + set code [catch {uplevel $on_error} string] + # Return out of the caller appropriately. + if { $code == 1 } { + return -code error -errorinfo $errorInfo -errorcode $errorCode $string + } elseif { $code == 2 } { + return -code return $string + } elseif { $code == 3 } { + return -code break + } elseif { $code == 4 } { + return -code continue + } elseif { $code > 4 } { + return -code $code $string + } + } +} + +proc_doc empty_string_p {query_string} "returns 1 if a string is empty; this is better than using == because it won't fail on long strings of numbers" { + if { [string compare $query_string ""] == 0 } { + return 1 + } else { + return 0 + } +} + +proc_doc string_contains_p {small_string big_string} {Returns 1 if the BIG_STRING contains the SMALL_STRING, 0 otherwise; syntactic sugar for string first != -1} { + if { [string first $small_string $big_string] == -1 } { + return 0 + } else { + return 1 + } +} + +# -- philg had this at Primehost + +# take a string and wrap it to 80 columns max this does not justify +# text, only insert line breaks + +proc_doc wrap_string {input {threshold 80}} "wraps a string to be no wider than 80 columns by inserting line breaks" { + set result_rows [list] + set start_of_line_index 0 + while 1 { + set this_line [string range $input $start_of_line_index [expr $start_of_line_index + $threshold - 1]] + if { $this_line == "" } { + return [join $result_rows "\n"] + } + set first_new_line_pos [string first "\n" $this_line] + if { $first_new_line_pos != -1 } { + # there is a newline + lappend result_rows [string range $input $start_of_line_index [expr $start_of_line_index + $first_new_line_pos - 1]] + set start_of_line_index [expr $start_of_line_index + $first_new_line_pos + 1] + continue + } + if { [expr $start_of_line_index + $threshold + 1] >= [string length $input] } { + # we're on the last line and it is < threshold so just return it + lappend result_rows $this_line + return [join $result_rows "\n"] + } + set last_space_pos [string last " " $this_line] + if { $last_space_pos == -1 } { + # no space found! Try the first space in the whole rest of the string + set $last_space_pos [string first " " [string range $input $start_of_line_index end]] + if { $last_space_pos == -1 } { + # didn't find any more spaces, append the whole thing as a line + lappend result_rows [string range $input $start_of_line_index end] + return [join $result_rows "\n"] + } + } + # OK, we have a last space pos of some sort + set real_index_of_space [expr $start_of_line_index + $last_space_pos] + lappend result_rows [string range $input $start_of_line_index [expr $real_index_of_space - 1]] + set start_of_line_index [expr $start_of_line_index + $last_space_pos + 1] + } +} + +proc remove_whitespace {input_string} { + if [regsub -all "\[\015\012\t \]" $input_string "" output_string] { + return $output_string + } else { + return $input_string + } +} + +proc util_just_the_digits {input_string} { + if [regsub -all {[^0-9]} $input_string "" output_string] { + return $output_string + } else { + return $input_string + } +} + +# sort of the opposite (for phone numbers, takes +# 6172538574 and turns it into "(617) 253-8574") + +proc philg_format_phone_number {just_the_digits} { + if { [string length $just_the_digits] != 10 } { + return $just_the_digits + } else { + return "([string range $just_the_digits 0 2]) [string range $just_the_digits 3 5]-[string range $just_the_digits 6 9]" + } +} + +# putting commas into numbers (thank you, Michael Bryzek) + +proc_doc util_commify_number { num } {Returns the number with commas inserted where appropriate. Number can be positive or negative and can have a decimal point. e.g. -1465.98 => -1,465.98} { + while { 1 } { + # Regular Expression taken from mastering regular expressions + # matches optional leading negative sign plus any + # other 3 digits, starting from end + if { ![regsub -- {^(-?[0-9]+)([0-9][0-9][0-9])} $num {\1,\2} num] } { + break + } + } + return $num +} + +# for limiting a string to 4000 characters because the Oracle SQL +# parser is so stupid and can only handle a string literal that long + +proc util_limit_to_4000_chars {input_string} { + return [string range $input_string 0 3999] +} + + +proc leap_year_p {year} { + expr ( $year % 4 == 0 ) && ( ( $year % 100 != 0 ) || ( $year % 400 == 0 ) ) +} + +proc_doc ad_proc args { + Use just like proc, but first argument must be a named argument description. + A named argument description is a list of flag/default value pairs: + {-arg1 arg1default -arg2 arg2default} + + By jsc@arsdigita.com + + Now supports default arguments and varargs ("args"). + Now supports the -prefix switch to have all argument variable names prefixed by a string, + e.g., + + ad_proc -prefix T my_proc { { -foo bar } arg1 arg2 } { + ns_write "foo is $Tfoo<br>\n" + ns_write "arg1 is $Targ1<br>\n" + ns_write "arg2 is $Targ2<br>\n" + } + + This is useful when you don't want set_variables_after_query hosing arguments (e.g., ad_table). +} { + if { [lindex $args 0] == "-prefix" } { + set prefix [lindex $args 1] + set args [lrange $args 2 end] + } else { + set prefix "" + } + + set proc_name [lindex $args 0] + set ad_args [lindex $args 1] + + nsv_set ad_proc_args $proc_name $ad_args + + generate_argument_parser $proc_name $ad_args $prefix + + # Four argument version indicates use of proc_doc instead of proc. + if { [llength $args] == 4 } { + set doc_string [lindex $args 2] + set body [lindex $args 3] + proc_doc $proc_name args $doc_string "arg_parser_for_$proc_name \$args\n$body" + } else { + set body [lindex $args 2] + proc $proc_name args "arg_parser_for_$proc_name \$args\n$body" + } +} + +# Helper function, acts like perl shift: +# Return value of first element and remove it from the list. +proc shift {list_name} { + upvar 1 $list_name list_to_shift + set first_arg_p 1 + set first_arg "" + set rest "" + + foreach element $list_to_shift { + if { $first_arg_p } { + set first_arg $element + set first_arg_p 0 + } else { + lappend rest $element + } + } + set list_to_shift $rest + return $first_arg +} + +# Helper function: If its argument does not start with "{", surround +# it with a pair of braces. +proc format_as_list {some_list} { + if { [string index $some_list 0] == "\{" } { + return $some_list + } else { + return "{$some_list}" + } +} + + +# Given the name of a procedure and an argument description, +# creates a procedure named arg_parser_for_{procedure_name} that +# takes an argument list, parses it according to the description, +# and sets the parameters in the argument list as variables in +# its caller's environment. Named values are set to the value they +# are called with, or to the default given in the argument description. +proc generate_argument_parser {proc_name argdesc prefix} { + # First argument is named argument description; others are + # regular arguments. + set named_args_desc [shift argdesc] + if { [lindex $argdesc end] == "args" } { + set argdesc [lrange $argdesc 0 [expr { [llength $argdesc] - 2 }]] + set vararg 1 + set too_many_arguments_clause "lappend extra_args \$arg ; continue" + } else { + set vararg 0 + set too_many_arguments_clause "error \"called \\\"$proc_name\\\" with too many arguments\"" + } + set rest "" + foreach arg $argdesc { + lappend rest [lindex $arg 0] + } + set named_arg_length [llength $named_args_desc] + + # Use the named argument description to generate two hunks of tcl, + # one for initially setting defaults for all the named arguments, + # and another one which will handle those arguments in a switch + # statement. + set flag_clauses "" + set defaults_setting_clauses "" + + for {set i 0} {$i < $named_arg_length} {incr i} { + set flag [lindex $named_args_desc $i] + set named_arg [string range $flag 1 end] + incr i + set flag_value [lindex $named_args_desc $i] + + append defaults_setting_clauses " + upvar 1 $prefix$named_arg $named_arg + set $named_arg \"$flag_value\" + " + + append flag_clauses " + $flag { + incr i + upvar 1 $prefix$named_arg $named_arg + set $named_arg \[lindex \$arglist \$i\] + continue + } +" + } + + set default_count 0 + foreach arg $argdesc { + if { [llength $arg] < 1 || [llength $arg] > 2 } { + error "Invalid argument declaration" + } + if { [llength $arg] == 2 } { + if { [lindex $arg 0] == "args" } { + error "\"args\" may not have any defaults" + } + incr default_count + append defaults_setting_clauses " + upvar 1 $prefix[lindex $arg 0] [lindex $arg 0] + set [lindex $arg 0] [list [lindex $arg 1]] + " + } else { + if { $arg != "args" && $default_count != 0 } { + error "Once a default is specified, all subsequent arguments must have defaults" + } + } + } + + if $vararg { + append defaults_setting_clauses " + upvar \"${prefix}args\" extra_args + set extra_args {} +" + } + + # Generate the Tcl for creating the argument parser procedure. + set evalstr "proc arg_parser_for_$proc_name arglist { + set regular_arg_names [format_as_list $rest] + set regular_arg_index 0 + set regular_arg_length \[llength \$regular_arg_names\] + set parsing_named_args_p 1 + +$defaults_setting_clauses + + set arg_length \[llength \$arglist\] + for {set i 0} {\$i < \$arg_length} {incr i} { + set arg \[lindex \$arglist \$i\] + + if \$parsing_named_args_p { + if { \[string index \$arg 0\] == \"-\" } { + switch -- \$arg { + \"--\" { + set parsing_named_args_p 0 + continue + } +$flag_clauses + default { + error \"Unrecognized argument \$arg\" + } + } + } else { + set parsing_named_args_p 0 + } + } + + if { !\$parsing_named_args_p } { + if { \$regular_arg_index == \$regular_arg_length } { + $too_many_arguments_clause + } + set regular_arg_name \[lindex \[lindex \$regular_arg_names \$regular_arg_index\] 0\] + incr regular_arg_index + upvar \"$prefix\$regular_arg_name\" \$regular_arg_name + set \$regular_arg_name \$arg + } + } + if { \$regular_arg_index < \$regular_arg_length - $default_count } { + error \"too few arguments given for \\\"$proc_name\\\": arg_index is \$regular_arg_index; length is \$regular_arg_length\" + } + } +" + eval $evalstr +} + +proc_doc util_search_list_of_lists {list_of_lists query_string {sublist_element_pos 0}} "Returns position of sublist that contains QUERY_STRING at SUBLIST_ELEMENT_POS." { + set sublist_index 0 + foreach sublist $list_of_lists { + set comparison_element [lindex $sublist $sublist_element_pos] + if { [string compare $query_string $comparison_element] == 0 } { + return $sublist_index + } + incr sublist_index + } + # didn't find it + return -1 +} + +# --- network stuff + +proc_doc util_get_http_status {url {use_get_p 1} {timeout 30}} "Returns the HTTP status code, e.g., 200 for a normal response or 500 for an error, of a URL. By default this uses the GET method instead of HEAD since not all servers will respond properly to a HEAD request even when the URL is perfectly valid. Note that this means AOLserver may be sucking down a lot of bits that it doesn't need." { + if $use_get_p { + set http [ns_httpopen GET $url "" $timeout] + } else { + set http [ns_httpopen HEAD $url "" $timeout] + } + # philg changed these to close BOTH rfd and wfd + set rfd [lindex $http 0] + set wfd [lindex $http 1] + close $rfd + close $wfd + set headers [lindex $http 2] + set response [ns_set name $headers] + set status [lindex $response 1] + ns_set free $headers + return $status +} + +proc_doc util_link_responding_p {url {list_of_bad_codes "404"}} "Returns 1 if the URL is responding (generally we think that anything other than 404 (not found) is okay)." { + if [catch { set status [util_get_http_status $url] } errmsg] { + # got an error; definitely not valid + return 0 + } else { + # we got the page but it might have been a 404 or something + if { [lsearch $list_of_bad_codes $status] != -1 } { + return 0 + } else { + return 1 + } + } +} + +# system by Tracy Adams (teadams@arsdigita.com) to permit AOLserver to POST +# to another Web server; sort of like ns_httpget + +proc_doc util_httpopen {method url {rqset ""} {timeout 30} {http_referer ""}} "Like ns_httpopen but works for POST as well; called by util_httppost" { + + if ![string match http://* $url] { + return -code error "Invalid url \"$url\": _httpopen only supports HTTP" + } + set url [split $url /] + set hp [split [lindex $url 2] :] + set host [lindex $hp 0] + set port [lindex $hp 1] + if [string match $port ""] {set port 80} + set uri /[join [lrange $url 3 end] /] + set fds [ns_sockopen -nonblock $host $port] + set rfd [lindex $fds 0] + set wfd [lindex $fds 1] + if [catch { + _http_puts $timeout $wfd "$method $uri HTTP/1.0\r" + if {$rqset != ""} { + for {set i 0} {$i < [ns_set size $rqset]} {incr i} { + _http_puts $timeout $wfd \ + "[ns_set key $rqset $i]: [ns_set value $rqset $i]\r" + } + } else { + _http_puts $timeout $wfd \ + "Accept: */*\r" + + _http_puts $timeout $wfd "User-Agent: Mozilla/1.01 \[en\] (Win95; I)\r" + _http_puts $timeout $wfd "Referer: $http_referer \r" + } + + } errMsg] { + global errorInfo + #close $wfd + #close $rfd + if [info exists rpset] {ns_set free $rpset} + return -1 + } + return [list $rfd $wfd ""] + +} + + +# httppost; give it a URL and a string with formvars, and it +# returns the page as a Tcl string +# formvars are the posted variables in the following form: +# arg1=value1&arg2=value2 + +# in the event of an error or timeout, -1 is returned + +proc_doc util_httppost {url formvars {timeout 30} {depth 0} {http_referer ""}} "Returns the result of POSTing to another Web server or -1 if there is an error or timeout. formvars should be in the form \"arg1=value1&arg2=value2\"" { + if [catch { + if {[incr depth] > 10} { + return -code error "util_httppost: Recursive redirection: $url" + } + set http [util_httpopen POST $url "" $timeout $http_referer] + set rfd [lindex $http 0] + set wfd [lindex $http 1] + + #headers necesary for a post and the form variables + + _http_puts $timeout $wfd "Content-type: application/x-www-form-urlencoded \r" + _http_puts $timeout $wfd "Content-length: [string length $formvars]\r" + _http_puts $timeout $wfd \r + _http_puts $timeout $wfd "$formvars\r" + flush $wfd + close $wfd + + set rpset [ns_set new [_http_gets $timeout $rfd]] + while 1 { + set line [_http_gets $timeout $rfd] + if ![string length $line] break + ns_parseheader $rpset $line + } + + + + set headers $rpset + set response [ns_set name $headers] + set status [lindex $response 1] + if {$status == 302} { + set location [ns_set iget $headers location] + if {$location != ""} { + ns_set free $headers + close $rfd + return [ns_httpget $location $timeout $depth] + } + } + set length [ns_set iget $headers content-length] + if [string match "" $length] {set length -1} + set err [catch { + while 1 { + set buf [_http_read $timeout $rfd $length] + append page $buf + if [string match "" $buf] break + if {$length > 0} { + incr length -[string length $buf] + if {$length <= 0} break + } + } + } errMsg] + ns_set free $headers + close $rfd + if $err { + global errorInfo + return -code error -errorinfo $errorInfo $errMsg + } + } errmgs ] {return -1} + return $page +} + + +proc_doc util_report_successful_library_load {{extra_message ""}} "Should be called at end of private Tcl library files so that it is easy to see in the error log whether or not private Tcl library files contain errors." { + set tentative_path [info script] + regsub -all {/\./} $tentative_path {/} scrubbed_path + if { [string compare $extra_message ""] == 0 } { + set message "Done... $scrubbed_path" + } else { + set message "Done... $scrubbed_path; $extra_message" + } + ns_log Notice $message +} + +proc_doc exists_and_not_null { varname } {Returns 1 if the variable name exists in the caller's environment and is not the empty string.} { + upvar 1 $varname var + return [expr { [info exists var] && ![empty_string_p $var] }] +} + + +proc_doc util_decode args { + like decode in sql + Takes the place of an if (or switch) statement -- convenient because it's + compact and you don't have to break out of an ns_write if you're in one. + args: same order as in sql: first the unknown value, then any number of + pairs denoting "if the unknown value is equal to first element of pair, + then return second element", then if the unknown value is not equal to any + of the first elements, return the last arg +} { + set args_length [llength $args] + set unknown_value [lindex $args 0] + + # we want to skip the first & last values of args + set counter 1 + while { $counter < [expr $args_length -2] } { + if { [string compare $unknown_value [lindex $args $counter]] == 0 } { + return [lindex $args [expr $counter + 1]] + } + set counter [expr $counter + 2] + } + return [lindex $args [expr $args_length -1]] +} + +proc_doc util_httpget {url {headers ""} {timeout 30} {depth 0}} "Just like ns_httpget, but first optional argument is an ns_set of headers to send during the fetch." { + if {[incr depth] > 10} { + return -code error "util_httpget: Recursive redirection: $url" + } + set http [ns_httpopen GET $url $headers $timeout] + set rfd [lindex $http 0] + close [lindex $http 1] + set headers [lindex $http 2] + set response [ns_set name $headers] + set status [lindex $response 1] + if {$status == 302} { + set location [ns_set iget $headers location] + if {$location != ""} { + ns_set free $headers + close $rfd + return [ns_httpget $location $timeout $depth] + } + } + set length [ns_set iget $headers content-length] + if [string match "" $length] {set length -1} + set err [catch { + while 1 { + set buf [_http_read $timeout $rfd $length] + append page $buf + if [string match "" $buf] break + if {$length > 0} { + incr length -[string length $buf] + if {$length <= 0} break + } + } + } errMsg] + ns_set free $headers + close $rfd + if $err { + global errorInfo + return -code error -errorinfo $errorInfo $errMsg + } + return $page +} + +# some procs to make it easier to deal with CSV files (reading and writing) +# added by philg@mit.edu on October 30, 1999 + +proc_doc util_escape_quotes_for_csv {string} "Returns its argument with double quote replaced by backslash double quote" { + regsub -all {"} $string {\"} result + return $result +} + +proc_doc set_csv_variables_after_query {} {You can call this after an ns_db getrow or ns_db 1row to set local Tcl variables to values from the database. You get $foo, $EQfoo (the same thing but with double quotes escaped), and $QEQQ (same thing as $EQfoo but with double quotes around the entire she-bang).} { + uplevel { + set set_variables_after_query_i 0 + set set_variables_after_query_limit [ns_set size $selection] + while {$set_variables_after_query_i<$set_variables_after_query_limit} { + set [ns_set key $selection $set_variables_after_query_i] [ns_set value $selection $set_variables_after_query_i] + set EQ[ns_set key $selection $set_variables_after_query_i] [util_escape_quotes_for_csv [string trim [ns_set value $selection $set_variables_after_query_i]]] + set QEQQ[ns_set key $selection $set_variables_after_query_i] "\"[util_escape_quotes_for_csv [string trim [ns_set value $selection $set_variables_after_query_i]]]\"" + incr set_variables_after_query_i + } + } +} + +#" + +proc_doc ad_page_variables {variable_specs} { +<pre> +Current syntax: + + ad_page_variables {var_spec1 [varspec2] ... } + + This proc handles translating form inputs into Tcl variables, and checking + to see that the correct set of inputs was supplied. Note that this is mostly a + check on the proper programming of a set of pages. + +Here are the recognized var_specs: + + variable ; means it's required and not null + {variable default-value} + Optional, with default value. If the value is supplied but is null, and the + default-value is present, that value is used. + {variable -multiple-list} + The value of the Tcl variable will be a list containing all of the + values (in order) supplied for that form variable. Particularly useful + for collecting checkboxes or select multiples. + Note that if required or optional variables are specified more than once, the + first (leftmost) value is used, and the rest are ignored. + {variable -array} + This syntax supports the idiom of supplying multiple form variables of the + same name but ending with a "_[0-9]", e.g., foo_1, foo_2.... Each value will be + stored in the array variable variable with the index being whatever follows the + underscore. + +There is an optional third element in the var_spec. If it is "QQ", "qq", or +some variant, a variable named "QQvariable" will be created and given the +same value, but with single quotes escaped suitable for handing to SQL. + +Other elements of the var_spec are ignored, so a documentation string +describing the variable can be supplied. + +Note that the default value form will become the value form in a "set" + +Note that the default values are filled in from left to right, and can depend on +values of variables to their left: +ad_page_variables { + file + {start 0} + {end {[expr $start + 20]}} +} +</pre> +} { + set exception_list [list] + set form [ns_getform] + if { $form != "" } { + set form_size [ns_set size $form] + set form_counter_i 0 + + # first pass -- go through all the variables supplied in the form + while {$form_counter_i<$form_size} { + set variable [ns_set key $form $form_counter_i] + set found "not" + # find the matching variable spec, if any + foreach variable_spec $variable_specs { + if { [llength $variable_spec] >= 2 } { + switch -- [lindex $variable_spec 1] { + -multiple-list { + if { [lindex $variable_spec 0] == $variable } { + # variable gets a list of all the values + upvar 1 $variable var + lappend var [ns_set value $form $form_counter_i] + set found "done" + break + } + } + -array { + set varname [lindex $variable_spec 0] + set pattern "($varname)_(.+)" + if { [regexp $pattern $variable match array index] } { + if { ![empty_string_p $array] } { + upvar 1 $array arr + set arr($index) [ns_set value $form $form_counter_i] + } + set found "done" + break + } + } + default { + if { [lindex $variable_spec 0] == $variable } { + set found "set" + break + } + } + } + } elseif { $variable_spec == $variable } { + set found "set" + break + } + } + if { $found == "set" } { + upvar 1 $variable var + if { ![info exists var] } { + # take the leftmost value, if there are multiple ones + set var [ns_set value $form $form_counter_i] + } + } + incr form_counter_i + } + } + + # now make a pass over each variable spec, making sure everything required is there + # and doing defaulting for unsupplied things that aren't required + foreach variable_spec $variable_specs { + set variable [lindex $variable_spec 0] + upvar 1 $variable var + + if { [llength $variable_spec] >= 2 } { + if { ![info exists var] } { + set default_value_or_flag [lindex $variable_spec 1] + + switch -- $default_value_or_flag { + -array { + # don't set anything + } + -multiple-list { + set var [list] + } + default { + # Needs to be set. + uplevel [list eval set $variable "\[subst [list $default_value_or_flag]\]"] + # This used to be: + # + # uplevel [list eval [list set $variable "$default_value_or_flag"]] + # + # But it wasn't properly performing substitutions. + } + } + } + + # no longer needed because we QQ everything by default now + # # if there is a QQ or qq or any variant after the var_spec, + # # make a "QQ" variable + # if { [regexp {^[Qq][Qq]$} [lindex $variable_spec 2]] && [info exists var] } { + # upvar QQ$variable QQvar + # set QQvar [DoubleApos $var] + # } + + } else { + if { ![info exists var] } { + lappend exception_list "\"$variable\" required but not supplied" + } + } + + # modified by rhs@mit.edu on 1/31/2000 + # to QQ everything by default (but not arrays) + if {[info exists var] && ![array exists var]} { + upvar QQ$variable QQvar + set QQvar [DoubleApos $var] + } + + } + + set n_exceptions [llength $exception_list] + # this is an error in the HTML form + if { $n_exceptions == 1 } { + ns_returnerror 500 [lindex $exception_list 0] + return -code return + } elseif { $n_exceptions > 1 } { + ns_returnerror 500 "<li>[join $exception_list "\n<li>"]\n" + return -code return + } +} + +proc_doc page_validation {args} { + This proc allows page arg, etc. validation. It accepts a bunch of + code blocks. Each one is executed, and any error signalled is + appended to the list of exceptions. + Note that you can customize the complaint page to match the design of your site, + by changing the proc called to do the complaining: + it's [ad_parameter ComplainProc "" ad_return_complaint] + + The division of labor between ad_page_variables and page_validation + is that ad_page_variables + handles programming errors, and does simple defaulting, so that the rest of + the Tcl code doesn't have to worry about testing [info exists ...] everywhere. + page_validation checks for errors in user input. For virtually all such tests, + there is no distinction between "unsupplied" and "null string input". + + Note that errors are signalled using the Tcl "error" function. This allows + nesting of procs which do the validation tests. In addition, validation + functions can return useful values, such as trimmed or otherwise munged + versions of the input. +} { + if { [info exists {%%exception_list}] } { + error "Something's wrong" + } + # have to put this in the caller's frame, so that sub_page_validation can see it + # that's because the "uplevel" used to evaluate the code blocks hides this frame + upvar {%%exception_list} {%%exception_list} + set {%%exception_list} [list] + foreach validation_block $args { + if { [catch {uplevel $validation_block} errmsg] } { + lappend {%%exception_list} $errmsg + } + } + set exception_list ${%%exception_list} + unset {%%exception_list} + set n_exceptions [llength $exception_list] + if { $n_exceptions != 0 } { + set complain_proc [ad_parameter ComplainProc "" ad_return_complaint] + if { $n_exceptions == 1 } { + $complain_proc $n_exceptions [lindex $exception_list 0] + } else { + $complain_proc $n_exceptions "<li>[join $exception_list "\n<li>"]\n" + } + return -code return + } +} + +proc_doc sub_page_validation {args} { + Use this inside a page_validation block which needs to check more than one thing. + Put this around each part that might signal an error. +} { + # to allow this to be at any level, we search up the stack for {%%exception_list} + set depth [info level] + for {set level 1} {$level <= $depth} {incr level} { + upvar $level {%%exception_list} {%%exception_list} + if { [info exists {%%exception_list}] } { + break + } + } + if { ![info exists {%%exception_list}] } { + error "sub_page_validation not inside page_validation" + } + foreach validation_block $args { + if { [catch {uplevel $validation_block} errmsg] } { + lappend {%%exception_list} $errmsg + } + } +} + +proc_doc validate_integer {field_name string} "Throws an error if the string isn't a decimal integer; otherwise strips any leading zeros (so this won't work for octals) and returns the result." { + if { ![regexp {^[0-9]+$} $string] } { + error "The entry for $field_name, \"$string\" is not an integer" + } + # trim leading zeros, so as not to confuse Tcl + set string [string trimleft $string "0"] + if { [empty_string_p $string] } { + # but not all of the zeros + return "0" + } + return $string +} + +proc_doc validate_integer_or_null {field_name string} "Throws an error if the string isn't a decimal integer; otherwise strips any leading zeros (so this won't work for octals) and returns the result. This also allows empty string" { + if { [empty_string_p $string] } { + return $string + } + return [validate_integer $field_name $string] +} + +proc_doc validate_decimal {field_name string} "Throws an error if the string isn't a decimal" { + # First check if it's a valid decimal + if { [regexp {^[0-9]*\.[0-9]*$} $string] } { + return $string + } + validate_integer $field_name $string +} + +proc_doc validate_decimal_or_null {field_name string} "Throws an error if the string isn't either a decimal, an integer, or null. If the string turns out to be an integer, it strips any leading zeros (so this won't work for octals) and returns the result. Otherwise it just returns the result." { + if { [empty_string_p $string] } { + return $string + } + return [validate_decimal $field_name $string] +} + +proc_doc validate_zip_code {field_name db zip_string country_code} "Given a string, signals an error if it's not a legal zip code" { + if { $country_code == "" || [string toupper $country_code] == "US" } { + if { [regexp {^[0-9][0-9][0-9][0-9][0-9](-[0-9][0-9][0-9][0-9])?$} $zip_string] } { + set zip_5 [string range $zip_string 0 4] + set selection [ns_db 0or1row $db "select 1 from dual where exists +(select 1 from zip_codes where zip_code like '$zip_5%')"] + if { $selection == "" } { + error "The entry for $field_name, \"$zip_string\" is not a recognized zip code" + } + } else { + error "The entry for $field_name, \"$zip_string\" does not look like a zip code" + } + } else { + if { $zip_string != "" } { + error "Zip code is not needed outside the US" + } + } + return $zip_string +} + +proc_doc validate_ad_dateentrywidget {field_name column form {allow_null 0}} { +} { + set col [ns_urlencode $column] + set day [ns_set get $form "ColValue.$col.day"] + ns_set update $form "ColValue.$col.day" [string trimleft $day "0"] + set month [ns_set get $form "ColValue.$col.month"] + set year [ns_set get $form "ColValue.$col.year"] + + # check that either all elements are blank + # date value is formated correctly for ns_dbformvalue + if { [empty_string_p "$day$month$year"] } { + if { $allow_null == 0 } { + error "$field_name must be supplied" + } else { + return "" + } + } elseif { ![empty_string_p $year] && [string length $year] != 4 } { + error "The year must contain 4 digits." + } elseif { [catch { ns_dbformvalue $form $column date date } errmsg ] } { + error "The entry for $field_name had a problem: $errmsg." + } + + return $date +} + + + +proc_doc util_WriteWithExtraOutputHeaders {headers_so_far {first_part_of_page ""}} "Takes in a string of headers to write to an HTTP connection, terminated by a newline. Checks \[ns_conn outputheaders\] and adds those headers if appropriate. Adds two newlines at the end and writes out to the connection. May optionally be used to write the first part of the page as well (saves a packet)" { + set set_headers_i 0 + set set_headers_limit [ns_set size [ns_conn outputheaders]] + while {$set_headers_i < $set_headers_limit} { + append headers_so_far "[ns_set key [ns_conn outputheaders] $set_headers_i]: [ns_set value [ns_conn outputheaders] $set_headers_i]\n" + incr set_headers_i + } + append entire_string_to_write $headers_so_far "\n" $first_part_of_page + ns_write $entire_string_to_write +} + + +# we use this when we want to send out just the headers +# and then do incremental ns_writes. This way the user +# doesn't have to wait like if you used a single ns_return + +proc ReturnHeaders {{content_type text/html}} { + set all_the_headers "HTTP/1.0 200 OK +MIME-Version: 1.0 +Content-Type: $content_type\n" + util_WriteWithExtraOutputHeaders $all_the_headers +} + + +# All the following ReturnHeaders versions are obsolete; +# just set [ns_conn outputheaders]. + +proc ReturnHeadersNoCache {{content_type text/html}} { + + ns_write "HTTP/1.0 200 OK +MIME-Version: 1.0 +Content-Type: $content_type +pragma: no-cache + +" + +} + + +proc ReturnHeadersWithCookie {cookie_content {content_type text/html}} { + + ns_write "HTTP/1.0 200 OK +MIME-Version: 1.0 +Content-Type: $content_type +Set-Cookie: $cookie_content + +" + +} + +proc ReturnHeadersWithCookieNoCache {cookie_content {content_type text/html}} { + + ns_write "HTTP/1.0 200 OK +MIME-Version: 1.0 +Content-Type: $content_type +Set-Cookie: $cookie_content +pragma: no-cache + +" + +} + + +proc_doc ad_return_top_of_page {first_part_of_page {content_type text/html}} "Returns HTTP headers plus the top of the user-ivisible page. Saves a TCP packet (and therefore some overhead) compared to using ReturnHeaders and an ns_write." { + set all_the_headers "HTTP/1.0 200 OK +MIME-Version: 1.0 +Content-Type: $content_type\n" + util_WriteWithExtraOutputHeaders $all_the_headers $first_part_of_page +} + + + +proc_doc apply {func arglist} { + Evaluates the first argument with ARGLIST as its arguments, in the + environment of its caller. Analogous to the Lisp function of the same name. +} { + set func_and_args [concat $func $arglist] + return [uplevel $func_and_args] +} + +proc_doc safe_eval args { + Version of eval that checks its arguments for brackets that may be +used to execute unsafe code. +} { + foreach arg $args { + if { [regexp {[\[;]} $arg] } { + return -code error "Unsafe argument to safe_eval: $arg" + } + } + return [apply uplevel $args] +} + +proc_doc lmap {list proc_name} {Applies proc_name to each item of the list, appending the result of each call to a new list that is the return value.} { + set lmap [list] + foreach item $list { + lappend lmap [safe_eval $proc_name $item] + } + return $lmap +} + +# if this hairy proc doesn't work, complain to davis@arsdigita.com +proc_doc util_close_html_tags {html_fragment {break_soft 0} {break_hard 0}} { + Given an HTML fragment, this procedure will close any tags that + have been left open. The optional arguments let you specify that + the fragment is to be truncated to a certain number of displayable + characters. After break_soft, it truncates and closes open tags unless + you're within non-breaking tags (e.g., Af). After break_hard displayable + characters, the procedure simply truncates and closes any open HTML tags + that might have resulted from the truncation. + <p> + Note that the internal syntax table dictates which tags are non-breaking. + The syntax table has codes: + <ul> + <li> nobr -- treat tag as nonbreaking. + <li> discard -- throws away everything until the corresponding close tag. + <li> remove -- nuke this tag and its closing tag but leave contents. + <li> close -- close this tag if left open. + </ul> +} { + set frag $html_fragment + + set syn(A) nobr + set syn(ADDRESS) nobr + set syn(NOBR) nobr + # + set syn(FORM) discard + set syn(TABLE) discard + # + set syn(BLINK) remove + # + set syn(FONT) close + set syn(B) close + set syn(BIG) close + set syn(I) close + set syn(S) close + set syn(SMALL) close + set syn(STRIKE) close + set syn(SUB) close + set syn(SUP) close + set syn(TT) close + set syn(U) close + set syn(ABBR) close + set syn(ACRONYM) close + set syn(CITE) close + set syn(CODE) close + set syn(DEL) close + set syn(DFN) close + set syn(EM) close + set syn(INS) close + set syn(KBD) close + set syn(SAMP) close + set syn(STRONG) close + set syn(VAR) close + set syn(DIR) close + set syn(DL) close + set syn(MENU) close + set syn(OL) close + set syn(UL) close + set syn(H1) close + set syn(H2) close + set syn(H3) close + set syn(H4) close + set syn(H5) close + set syn(H6) close + set syn(BDO) close + set syn(BLOCKQUOTE) close + set syn(CENTER) close + set syn(DIV) close + set syn(PRE) close + set syn(Q) close + set syn(SPAN) close + + set out {} + set out_len 0 + + # counts how deep we are nested in nonbreaking tags, tracks the nobr point + # and what the nobr string length would be + set nobr 0 + set nobr_out_point 0 + set nobr_tagptr 0 + set nobr_len 0 + + set discard 0 + + set tagptr -1 + + # first thing we do is chop off any trailing unclosed tag + # since when we substr blobs this sometimes happens + + # this should in theory cut any tags which have been cut open. + while {[regexp {(.*)<[^>]*$} $frag match frag]} {} + + while { "$frag" != "" } { + # here we attempt to cut the string into "pretag<TAG TAGBODY>posttag" + # and build the output list. + + if {![regexp "(\[^<]*)(<\[ \t]*(/?)(\[^ \t>]+)(\[^>]*)>)?(.*)" $frag match pretag fulltag close tag tagbody frag]} { + # should never get here since above will match anything. + # puts "NO MATCH: should never happen! frag=$frag" + append out $frag + set frag {} + } else { + # puts "\n\nmatch=$match\n pretag=$pretag\n fulltag=$fulltag\n close=$close\n tag=$tag\n tagbody=$tagbody\nfrag=$frag\n\n" + if { ! $discard } { + # figure out if we can break with the pretag chunk + if { $break_soft } { + if {! $nobr && [expr [string length $pretag] + $out_len] > $break_soft } { + # first chop pretag to the right length + set pretag [string range $pretag 0 [expr $break_soft - $out_len]] + # clip the last word + regsub "\[^ \t\n\r]*$" $pretag {} pretag + append out [string range $pretag 0 $break_soft] + break + } elseif { $nobr && [expr [string length $pretag] + $out_len] > $break_hard } { + # we are in a nonbreaking tag and are past the hard break + # so chop back to the point we got the nobr tag... + set tagptr $nobr_tagptr + if { $nobr_out_point > 0 } { + set out [string range $out 0 [expr $nobr_out_point - 1]] + } else { + # here maybe we should decide if we should keep the tag anyway + # if zero length result would be the result... + set out {} + } + break + } + } + + # tack on pretag + append out $pretag + incr out_len [string length $pretag] + } + + # now deal with the tag if we got one... + if { $tag == "" } { + # if the tag is empty we might have one of the bad matched that are not eating + # any of the string so check for them + if {[string length $match] == [string length $frag]} { + append out $frag + set frag {} + } + } else { + set tag [string toupper $tag] + if { ![info exists syn($tag)]} { + # if we don't have an entry in our syntax table just tack it on + # and hope for the best. + if { ! $discard } { + append out $fulltag + } + } else { + if { $close != "/" } { + # new tag + # "remove" tags are just ignored here + # discard tags + if { $discard } { + if { $syn($tag) == "discard" } { + incr discard + incr tagptr + set tagstack($tagptr) $tag + } + } else { + switch $syn($tag) { + nobr { + if { ! $nobr } { + set nobr_out_point [string length $out] + set nobr_tagptr $tagptr + set nobr_len $out_len + } + incr nobr + incr tagptr + set tagstack($tagptr) $tag + append out $fulltag + } + discard { + incr discard + incr tagptr + set tagstack($tagptr) $tag + } + close { + incr tagptr + set tagstack($tagptr) $tag + append out $fulltag + } + } + } + } else { + # we got a close tag + if { $discard } { + # if we are in discard mode only watch for + # closes to discarded tags + if { $syn($tag) == "discard"} { + if {$tagptr > -1} { + if { $tag != $tagstack($tagptr) } { + #puts "/$tag without $tag" + } else { + incr tagptr -1 + incr discard -1 + } + } + } + } else { + if { $syn($tag) != "remove"} { + # if tag is a remove tag we just ignore it... + if {$tagptr > -1} { + if {$tag != $tagstack($tagptr) } { + # puts "/$tag without $tag" + } else { + incr tagptr -1 + if { $syn($tag) == "nobr"} { + incr nobr -1 + } + append out $fulltag + } + } + } + } + } + } + } + } + } + + # on exit of the look either we parsed it all or we truncated. + # we should now walk the stack and close any open tags. + + for {set i $tagptr} { $i > -1 } {incr i -1} { + # append out "<!-- autoclose --> </$tagstack($i)>" + append out "</$tagstack($i)>" + } + + return $out +} + + +ad_proc util_dbq { + { + -null_is_null_p f + } + vars +} { + Given a list of variable names this routine + creates variables named DBQvariable_name which can be used in + sql insert and update statements. + <p> + If -null_is_null_p is t then we return the string "null" unquoted + so that "update foo set var = $DBQvar where ..." will do what we want + if we default var to "null". +} { + foreach var $vars { + upvar 1 $var val + if [info exists val] { + if { $null_is_null_p == "t" + && $val == {null} } { + uplevel [list set DBQ$var {null}] + } else { + uplevel [list set DBQ$var "'[DoubleApos [string trim $val]]'"] + } + } + } +} + +proc_doc ad_decode { args } "this procedure is analogus to sql decode procedure. first parameter is the value we want to decode. this parameter is followed by a list of pairs where first element in the pair is convert from value and second element is convert to value. last value is default value, which will be returned in the case convert from values matches the given value to be decoded" { + set num_args [llength $args] + set input_value [lindex $args 0] + + set counter 1 + + while { $counter < [expr $num_args - 2] } { + lappend from_list [lindex $args $counter] + incr counter + lappend to_list [lindex $args $counter] + incr counter + } + + set default_value [lindex $args $counter] + + if { $counter < 2 } { + return $default_value + } + + set index [lsearch -exact $from_list $input_value] + + if { $index < 0 } { + return $default_value + } else { + return [lindex $to_list $index] + } +} + +proc_doc ad_urlencode { string } "same as ad_urlencode except that dash and underscore are left unencoded." { + set encoded_string [ns_urlencode $string] + regsub -all {%2d} $encoded_string {-} encoded_string + regsub -all {%5f} $encoded_string {_} ad_encoded_string + return $ad_encoded_string +} + +ad_proc ad_get_cookie { + { -include_set_cookies t } + name { default "" } +} { "Returns the value of a cookie, or $default if none exists." } { + if { $include_set_cookies == "t" } { + set headers [ns_conn outputheaders] + for { set i 0 } { $i < [ns_set size $headers] } { incr i } { + if { ![string compare [string tolower [ns_set key $headers $i]] "set-cookie"] && \ + [regexp "^$name=(\[^;\]+)" [ns_set value $headers $i] "" "value"] } { + return $value + } + } + } + + set headers [ns_conn headers] + set cookie [ns_set iget $headers Cookie] + if { [regexp "$name=(\[^;\]+)" $cookie match value] } { + return $value + } + + return $default +} + +ad_proc ad_set_cookie { + { + -replace f + -secure f + -expires "" + -max_age "" + -domain "" + -path "/" + } + name value +} { Sets a cookie. } { + set headers [ns_conn outputheaders] + if { $replace != "f" } { + # Try to find an already-set cookie named $name. + for { set i 0 } { $i < [ns_set size $headers] } { incr i } { + if { ![string compare [string tolower [ns_set key $headers $i]] "set-cookie"] && \ + [regexp "^$name=" [ns_set value $headers $i]] } { + ns_set delete $headers $i + break + } + } + } + + set cookie "$name=$value" + + if { $path != "" } { + append cookie "; Path=$path" + } + + if { ![string compare [string tolower $expires] "never"] } { + append cookie "; Expires=Fri, 01-Jan-2010 01:00:00 GMT" + } elseif { $expires != "" } { + append cookie "; Expires=$expires" + } + + if { $max_age != "" } { + append cookie "; Max-Age=$max_age" + } + + if { $domain != "" } { + append cookie "; Domain=$domain" + } + + if { $secure != "f" } { + append cookie "; Secure" + } + + ns_set put $headers "Set-Cookie" $cookie +} + +# Helper procedure for sortable_table. +# column_list is a list of column names optionally followed by " desc". +# Returns a new list with sort_column as the first element, followed +# by the columns in column_list excluding any beginning with sort_column. +proc sortable_table_new_sort_order {column_list sort_column} { + set new_order [list $sort_column] + + # Relies on string representation of lists. [lindex "colname desc" 0] + # returns just "colname". + set just_the_sort_column [lindex $sort_column 0] + foreach col $column_list { + if { [lindex $col 0] != $just_the_sort_column } { + lappend new_order $col + } + } + return $new_order +} + + +proc_doc sortable_table {db select_string display_spec vars_to_export sort_var current_sort_order {table_length ""} {extra_table_parameters ""} {stripe_color_list ""} {max_results ""} {header_font_params ""} {row_font_params ""}} {Procedure to format a database query as a table that can be sorted by clicking on the headers. +Arguments are: +<ul> +<li>db: database handle +<li>select_string: SQL statement that selects all columns that will be displayed in the table. +<li>display_spec: a "display specification" that consists of a list of column specs. Column specs are lists with the following elements: +<ol> +<li>primary column name (name of column which determines sorting for this table column) +<li>header (header to display for this column) +<li>display string (optional; if provided, a string with variable references to column names that will be interpolated for each row) +<li>default sort order (optional; really used to say when something needs to sort "desc" by default instead of "asc")</li> +<li>column width (optional).</li> +</ol> +<li>vars_to_export: an ns_set of variables to re-export to the current page. Generally, [ns_conn form] +<li>sort_var: a variable name which stores the sorting information for this table. You can use different sort_vars for multiple sortable tables in the same page. +<li>current_sort_order: a list of column names that determine the current sorting order. Each element is either a column name that can be optionally followed by " desc" to specify descending order. Generally, just the current value of $sort_var. +<li>table_length (optional): where to insert table breaks. Leaving unspecified or empty specifies no table breaks. +<li>extra_table_parameters: Any extra parameters to go in the <table> tag +<li>stripe_color_list: a list of color specifications for table striping. If specified, should specify at least two, unless a single color is desired for every row. +<li>max_results (optional): Indicates to truncate table after so many results are retreived. +<li>header_font_params (optional): Sets the font attributes for the headers. +<li>row_font_params (optional): Sets the font attributes for any old row. +</ul>} { + # Run the SQL + set order_clause "" + if { ![empty_string_p $current_sort_order] } { + set order_clause " order by [join $current_sort_order ","]" + } + + set selection [ns_db select $db "$select_string$order_clause"] + + # Start generating the table HTML. + set table_start "<table $extra_table_parameters>\n" + set table_html "" + + set primary_sort_column [lindex $current_sort_order 0] + + # Put in the headers. + set headers "<tr>" + foreach col_desc $display_spec { + + # skip any blank columns + if { [llength $col_desc] < 1 } { continue } + + set primary_column_name [lindex $col_desc 0] + + # set the default sort order + set primary_column_sort "" + if { [llength $col_desc] > 3 } { + set primary_column_sort "[lindex $col_desc 3]" + } + + set column_header [lindex $col_desc 1] + + # Calculate the href for the header link. + set this_url [ns_conn url] + set exported_vars [export_ns_set_vars "url" $sort_var $vars_to_export] + if { ![empty_string_p $exported_vars] } { + append exported_vars "&" + } + + set just_the_sort_column [lindex $primary_sort_column 0] + set sort_icon "" + if { $primary_column_name == $just_the_sort_column } { + # This is the column that is being sorted on. Need to reverse + # the direction of the sort by appending or removing " desc". + + # Relies on the fact that indexing past the end of a list + # is not an error, just returns the empty string. + # We're treating a string as a list here, since we know that + # $primary_sort_column will be a plain column name, or a + # column name followed by " desc". + if { [lindex $primary_sort_column 1] == "desc" } { + append exported_vars "$sort_var=[ns_urlencode [sortable_table_new_sort_order $current_sort_order $just_the_sort_column]]" + set sort_icon "<img border=0 src=\"/graphics/up.gif\">" + } else { + append exported_vars "$sort_var=[ns_urlencode [sortable_table_new_sort_order $current_sort_order "$just_the_sort_column desc"]]" + set sort_icon "<img border=0 src=\"/graphics/down.gif\">" + } + } else { + # Clicked on some other column. + append exported_vars "$sort_var=[ns_urlencode [sortable_table_new_sort_order $current_sort_order "$primary_column_name $primary_column_sort"]]" + } + + if { [empty_string_p "[lindex $col_desc 4]"] } { + append headers "<th>" + } else { + append headers "<th width=\"[lindex $col_desc 4]\">" + } + + append headers "<a href=\"$this_url?$exported_vars\"><font face=\"helvetica,verdana,arial\" $header_font_params>$column_header</font>$sort_icon</th>" + + } + + append headers "</tr>\n" + + # Do the data rows. + set i 0 + set color_index 0 + set n_colors [llength $stripe_color_list] + set n_results 0 + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + # check to see if we have reached our max results limit + if { [exists_and_not_null max_results] } { + if { $n_results >= $max_results } { break } + incr n_results + } + + # Handle table breaks. + if { $i == 0 } { + append table_html "$table_start$headers" + } elseif { ![empty_string_p $table_length] } { + if { $i % $table_length == 0 } { + append table_html "</table>\n$table_start$headers" + set i 0 + } + } + + # Handle row striping. + if { ![empty_string_p $stripe_color_list] } { + append table_html "<tr bgcolor=\"[lindex $stripe_color_list $color_index]\">" + set color_index [expr ($color_index + 1) % $n_colors] + } else { + append table_html "<tr>" + } + + # Handle each display column. + foreach col_desc $display_spec { + + # skip any blank columns + if { [llength $col_desc] < 1 } { continue } + + set primary_column_name [lindex $col_desc 0] + set col_display [lindex $col_desc 2] + + if { [empty_string_p $col_display] } { + # Just use the sort column as the value. + set col_display "\$$primary_column_name" + } + + # Insert   for empty rows to avoid empty cells. + set value [subst $col_display] + if { [empty_string_p $value] } { + set value " " + } + + append table_html "<td><font face=\"helvetica,verdana,arial\" $row_font_params>$value</font></td>" + } + + append table_html "</tr>\n" + incr i + } + + ns_db flush $db + + if { ![empty_string_p $table_html] } { + append table_html "</table>" + } + + return $table_html +} + +proc ad_handle_filter { conn why } { + foreach f [nsv_get ad_filters "[ns_conn method],$why" ] { + if { [string match [lindex $f 3] [ns_conn url]] } { + set errno [catch { + set proc [lindex $f 4] + set args [lindex $f 5] + set debug [lindex $f 6] + set proc_args [info args $proc] + set proc_argcount [llength $proc_args] + if { [lindex $proc_args [expr { [llength $proc_args] - 2 }]] == "args" } { + set args [list $args] + } + set actual_argcount [llength $args] + + if { $debug == "t" } { + ns_log "Notice" "Executing filter $proc for [ns_conn method] [ns_conn url]..." + } + + if { $actual_argcount >= 3 || $proc_argcount - $actual_argcount == 2 } { + # Procedure has conn and why. + set result [eval $proc [concat [list $conn] $args [list $why]]] + } elseif { $proc_argcount - $actual_argcount == 1 } { + # Procedure has why. + set result [eval $proc [concat $args [list $why]]] + } else { + set result [eval $proc $args] + } + + if { $debug == "t" } { + ns_log "Notice" "Done executing filter $proc." + } + + if { $result == "filter_break" } { + set return "filter_break" + } elseif { $result == "filter_return" } { + set return "filter_return" + } elseif { $result != "filter_ok" } { + ns_log "Filter" "Invalid result \"$result\" from filter $proc: should be filter_ok, filter_break, or filter_return" + if { [lindex $f 7] == "t" } { + error "Critical filter $proc failed." + } + } + } errmsg] + if { $errno } { + ns_log "Error" "Filter $proc returned error #$errno: $errmsg" + if { [lindex $f 7] == "t" } { + error "Critical filter $proc failed." + } + } + } + if { [info exists return] } { + return $return + } + } + + return "filter_ok" +} + +# Make sure the ad_filters array exists +nsv_set ad_filters . "" + +ad_proc ad_register_filter { + { + -debug f + -priority 10000 + -critical f + } + kind method path proc args +} { Registers a filter (see ns_register_filter for syntax). Priority is an integer; lower numbers indicate higher priority. Use a method of "*" to register GET, POST, and HEAD filters. If a filter is not critical, page viewing will not abort if a filter fails. If debug is set to "t", all invocations of the filter will be ns_logged. } { + if { $method == "*" } { + # Shortcut to allow registering filter for all methods. + foreach method { GET POST HEAD } { + eval [concat [list ad_register_filter -debug $debug -priority $priority -critical $critical $kind $method $path $proc] $args] + } + return + } + + ns_mutex lock [nsv_get ad_filters mutex] + + # Append the filter to our list. + set filters [nsv_get ad_filters "$method,$kind"] + set filter_info [list $priority $kind $method $path $proc $args $debug $critical] + + set counter 0 + # Insert the filter in sorted order (lowest priority# first). + foreach f $filters { + if { ![string compare $f $filter_info] } { + ns_log "Notice" "$kind filter $proc already registered for $method $path" + ns_mutex unlock [nsv_get ad_filters mutex] + return + } + if { $priority < [lindex $f 0] } { + break + } + incr counter + } + ns_log "Notice" "Registering $kind filter $proc for $method $path with priority $priority" + set filters [linsert $filters $counter $filter_info] + nsv_set ad_filters "$method,$kind" $filters + + ns_mutex unlock [nsv_get ad_filters mutex] +} + +proc_doc ad_run_scheduled_proc { proc_info } { Runs a scheduled procedure and updates monitoring information in the shared variables. } { + # Grab information about the scheduled procedure. + set thread [lindex $proc_info 0] + set once [lindex $proc_info 1] + set interval [lindex $proc_info 2] + set proc [lindex $proc_info 3] + set args [lindex $proc_info 4] + set time [lindex $proc_info 5] + set count 0 + set debug [lindex $proc_info 7] + + ns_mutex lock [nsv_get ad_procs mutex] + set procs [nsv_get ad_procs .] + + # Find the entry in the shared variable. Splice it out. + for { set i 0 } { $i < [llength $procs] } { incr i } { + set other_proc_info [lindex $procs $i] + for { set j 0 } { $j < 5 } { incr j } { + if { [lindex $proc_info $j] != [lindex $other_proc_info $j] } { + break + } + } + if { $j == 5 } { + set count [lindex $other_proc_info 6] + set procs [lreplace $procs $i $i] + break + } + } + + if { $once == "f" } { + # The proc will run again - readd it to the shared variable (updating ns_time and + # incrementing the count). + lappend procs [list $thread $once $interval $proc $args [ns_time] [expr { $count + 1 }] $debug] + } + nsv_set ad_procs . $procs + + ns_mutex unlock [nsv_get ad_procs mutex] + + if { $debug == "t" } { + ns_log "Notice" "Running scheduled proc $proc..." + } + # Actually run the procedure. + eval [concat [list $proc] $args] + if { $debug == "t" } { + ns_log "Notice" "Done running scheduled proc $proc." + } +} + +ad_proc ad_schedule_proc { + { + -thread f + -once f + -debug t + } + interval + proc + args +} { Replacement for ns_schedule_proc, allowing us to track what's going on. Can be monitored via /admin/monitoring/schedule-procs.tcl. } { + # Protect the list of scheduled procs with a mutex. + ns_mutex lock [nsv_get ad_procs mutex] + set proc_info [list $thread $once $interval $proc $args [ns_time] 0 $debug] + + ns_log "Notice" "Scheduling proc $proc" + + # Add to the list of scheduled procedures, for monitoring. + set procs [nsv_get ad_procs .] + lappend procs $proc_info + nsv_set ad_procs . $procs + ns_mutex unlock [nsv_get ad_procs mutex] + + set my_args [list] + if { $thread == "t" } { + lappend my_args "-thread" + } + if { $once == "t" } { + lappend my_args "-once" + } + + # Schedule the wrapper procedure (ad_run_scheduled_proc). + eval [concat [list ns_schedule_proc] $my_args [list $interval ad_run_scheduled_proc [list $proc_info]]] +} + +if { ![nsv_exists ad_filters mutex] } { + nsv_set ad_filters mutex [ns_mutex create] + + foreach method { GET POST HEAD } { + foreach kind { preauth postauth trace } { + ns_log "Notice" "Setting up $kind filter for \"$method\" method" + nsv_set ad_filters "$method,$kind" "" + ns_register_filter $kind $method /* ad_handle_filter + } + } + + nsv_set ad_procs mutex [ns_mutex create] + nsv_set ad_procs . "" +} + +util_report_successful_library_load + Index: web/openacs/tcl/ad-widgets.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ad-widgets.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ad-widgets.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,454 @@ +# ad-widgets.tcl,v 3.1.4.1 2000/03/16 03:20:34 jsalz Exp +proc_doc state_widget {db {default ""} {select_name "usps_abbrev"}} "Returns a state selection box" { + + set widget_value "<select name=\"$select_name\">\n" + if { $default == "" } { + append widget_value "<option value=\"\" SELECTED>Choose a State</option>\n" + } + set selection [ns_db select $db "select * from states order by state_name"] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $default == $usps_abbrev } { + append widget_value "<option value=\"$usps_abbrev\" SELECTED>$state_name</option>\n" + } else { + append widget_value "<option value=\"$usps_abbrev\">$state_name</option>\n" + } + } + append widget_value "</select>\n" + return $widget_value +} + + +proc_doc country_widget {db {default ""} {select_name "country_code"} {size_subtag "size=4"}} "Returns a country selection box" { + + set widget_value "<select name=\"$select_name\" $size_subtag>\n" + if { $default == "" } { + if [ad_parameter SomeAmericanReadersP] { + append widget_value "<option value=\"\">Choose a Country</option> +<option value=\"us\" SELECTED>United States</option>\n" + } else { + append widget_value "<option value=\"\" SELECTED>Choose a Country</option>\n" + } + } + set selection [ns_db select $db "select country_name, iso from country_codes order by country_name"] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $default == $iso } { + append widget_value "<option value=\"$iso\" SELECTED>$country_name</option>\n" + } else { + append widget_value "<option value=\"$iso\">$country_name</option>\n" + } + } + append widget_value "</select>\n" + return $widget_value +} + + +# teadams - It is usually more approprate to use html_select_options or +# html_select_value_options. + +proc_doc ad_generic_optionlist {items values {default ""}} "Use this to build select form fragments. Given a list of items and a list of values, will return the option tags with default highlighted as appropriate." { + + # items is a list of the items you would like the user to select from + # values is a list of corresponding option values + # default is the value of the item to be selected + set count 0 + set return_string "" + foreach value $values { + if { [string compare $default $value] == 0 } { + append return_string "<option SELECTED value=\"$value\">[lindex $items $count]\n" + } else { + append return_string "<option value=\"$value\">[lindex $items $count]\n" + } + incr count + } + return $return_string +} + + +# use ad_integer_optionlist instead of day_list +proc day_list {} { + return {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31} +} + +proc_doc month_list {} "Returns list of month abbreviations" { + return {Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec} +} + + +proc_doc long_month_list {} "Returns list of months" { + return {January February March April May Jun July August September October November December} +} + +# use ad_integer_optionlist instead of month_value_list +proc month_value_list {} { + return {1 2 3 4 5 6 7 8 9 10 11 12} +} + +proc_doc future_years_list {{num_year 10}} "Returns a list containing the next num_year years in the future." { + set year [ns_fmttime [ns_time] %Y] + set counter 0 + while {$counter < $num_year } { + incr counter + lappend year_list $year + incr year + } + return $year_list +} + + +# produces the optionlist for a range of integers + +# if pad_to_two_p is 1, the option values will be +# padded to 2 digites with a leading 0 + +proc_doc ad_integer_optionlist {start_value end_value {default ""} { pad_to_two_p 0} } "Produces an optionlist for a range of integers from start_value to end_value. If default matches one of the options, it is selection. If pad_to_two_p is 1, the option values will be padded to 2 digites with a leading 0." { + # items is a list of the items you would like the user to select from + # values is a list of corresponding option values + # default is the value of the item to be selected + set count 0 + set return_string "" + + + for { set x $start_value } { $x <= $end_value } { incr x } { + + if { $pad_to_two_p && $x >= 0 && $x < 10 } { + set value "0$x" + } else { + set value $x + } + + if { $default == $value } { + append return_string "<option SELECTED value=\"$value\">$value\n" + } else { + append return_string "<option value=\"$value\">$value\n" + } + } + return $return_string +} + +## teadams - use db_html_select_options or db_html_select_value_options +## instead of ad_db_optionlist + +proc_doc ad_db_optionlist {db sql {default ""}} "Produces an optionlist using results from a database query. The first selected column should contain the optionlist items. The second selected column should contain the optionlist values." { + set retval "" + set selection [ns_db select $db $sql] + while { [ns_db getrow $db $selection] } { + set item [ns_set value $selection 0] + set value [ns_set value $selection 1] + if { $value == $default } { + append retval "<option SELECTED value=\"$value\">$item\n" + } else { + append retval "<option value=\"$value\">$item\n" + } + } + return $retval +} + + +proc_doc ad_dateentrywidget {column { value 0 } } "Returns form pieces for a date entry widget. A null date may be selected." { + ns_share NS + # if you would like the default to be null, call with value= "" + + if { $value == 0 } { + # no default, so use today + #set value [lindex [split [ns_localsqltimestamp] " "] 0] + set value [lindex [split [ns_localsqltimestamp] " "] 0] + } + + set date_parts [split $value "-"] + if { $value == "" } { + set month "" + set day "" + set year "" + } else { + # Postgres fix (BMA) + set value [string range $value 0 9] + set date_parts [split $value "-"] + set month [lindex $date_parts 1] + set year [lindex $date_parts 0] + set day [lindex $date_parts 2] + } + + set output "<SELECT name=ColValue.[ns_urlencode $column].month>\n" + append output "<OPTION>\n" + # take care of cases like 09 for month + regsub "^0" $month "" month + for {set i 0} {$i < 12} {incr i} { + if { $i == [expr $month - 1] } { + append output "<OPTION selected> [lindex $NS(months) $i]\n" + } else { + append output "<OPTION>[lindex $NS(months) $i]\n" + } + } + + append output \ +"</SELECT><INPUT NAME=ColValue.[ns_urlencode $column].day\ +TYPE=text SIZE=3 MAXLENGTH=2 value=\"$day\"> <INPUT NAME=ColValue.[ns_urlencode $column].year\ +TYPE=text SIZE=5 MAXLENGTH=4 value=\"$year\">" + + return $output +} + + +ad_proc ad_db_select_widget { + { + -size 0 + -multiple 0 + -default {} + -option_list {} + -blank_if_no_db 0 + -hidden_if_one_db 0 + } + db sql name +} { + given a db handle and sql this generates a select group. If there is only + one value it returns the text and a hidden variable setting that value. + The first selected column should contain the optionlist items. The + second selected column should contain the optionlist values. + <p> + option_list is a list in the same format (i.e. {{str val} {str2 val2}...}) + which is prepended to the list + <p> + if db is null then the list is constructed from option_list only. + <p> + if there is only one item the select is not generated and the value + is passed in hidden form variable. + <p> + if -multiple is given the a multi select is returned. + <p> + if -blank_if_no_db set then do not return a select widget unless + there are rows from the database +} { + set retval {} + set count 0 + set dbcount 0 + if {![empty_string_p $option_list]} { + foreach opt $option_list { + incr count + set item [lindex $opt 1] + set value [lindex $opt 0] + if { (!$multiple && [string compare $value $default] == 0) + || ($multiple && [lsearch -exact $default $value] > -1)} { + append retval "<option SELECTED value=\"$value\">$item\n" + } else { + append retval "<option value=\"$value\">$item\n" + } + } + } + + if { $blank_if_no_db} { + set count 0 + } + + if {! [empty_string_p $db]} { + set selection [ns_db select $db $sql] + while { [ns_db getrow $db $selection] } { + incr count + incr dbcount + set item [ns_set value $selection 0] + set value [ns_set value $selection 1] + if { (!$multiple && [string compare $value $default] == 0) + || ($multiple && [lsearch -exact $default $value] > -1)} { + append retval "<option SELECTED value=\"$value\">$item\n" + } else { + append retval "<option value=\"$value\">$item\n" + } + } + } + + if { $count == 0 } { + if {![empty_string_p $default]} { + return "<input type=hidden value=\"[philg_quote_double_quotes $default]\" name=$name>\n" + } else { + return {} + } + } elseif { $count == 1 || ($dbcount == 1 && $hidden_if_one_db) } { + return "$item<input type=hidden value=\"[philg_quote_double_quotes $value]\" name=$name>\n" + } else { + set select "<select name=$name" + if {$size != 0} { + append select " size=$size" + } + if {$multiple} { + append select " multiple" + } + return "$select>\n$retval</select>" + } +} + + + +proc_doc currency_widget {db {default ""} {select_name "currency_code"} {size_subtag "size=4"}} "Returns a currency selection box" { + + set widget_value "<select name=\"$select_name\" $size_subtag>\n" + if { $default == "" } { + if [ad_parameter SomeAmericanReadersP] { + append widget_value "<option value=\"\">Currency</option> +<option value=\"USD\" SELECTED>United States Dollar</option>\n" + } else { + append widget_value "<option value=\"\" SELECTED>Currency</option>\n" + } + } + set selection [ns_db select $db "select currency_name, iso + from currency_codes + where supported_p='t' + order by currency_name"] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $default == $iso } { + append widget_value "<option value=\"$iso\" SELECTED>$currency_name</option>\n" + } else { + append widget_value "<option value=\"$iso\">$currency_name</option>\n" + } + } + append widget_value "</select>\n" + return $widget_value +} + + +proc_doc ad_html_colors {} "Returns an array of HTML colors and names." { + return { + { Black 0 0 0 } + { Silver 192 192 192 } + { Gray 128 128 128 } + { White 255 255 255 } + { Maroon 128 0 0 } + { Red 255 0 0 } + { Purple 128 0 128 } + { Fuchsia 255 0 255 } + { Green 0 128 0 } + { Lime 0 255 0 } + { Olive 128 128 0 } + { Yellow 255 255 0 } + { Navy 0 0 128 } + { Blue 0 0 255 } + { Teal 0 128 128 } + { Aqua 0 255 255 } + } +} + +proc_doc ad_color_widget_js {} "Returns JavaScript code necessary to use color widgets." { + return { + +var adHexTupletValues = '0123456789ABCDEF'; + +function adHexTuplet(val) { + return adHexTupletValues.charAt(Math.floor(val / 16)) + adHexTupletValues.charAt(Math.floor(val % 16)); +} + +function adUpdateColorText(field) { + var form = document.forms[0]; + var element = form[field + ".list"]; + var rgb = element.options[element.selectedIndex].value; + var r,g,b; + if (rgb == "" || rgb == "none" || rgb == "custom") { + r = g = b = ""; + } else { + var components = rgb.split(","); + r = components[0]; + g = components[1]; + b = components[2]; + } + form[field + ".c1"].value = r; + form[field + ".c2"].value = g; + form[field + ".c3"].value = b; + + document['color_' + field].src = '/shared/1pixel.tcl?r=' + r + '&g=' + g + '&b=' + b; +} + +function adUpdateColorList(field) { + var form = document.forms[0]; + var element = form[field + ".list"]; + + var c1 = form[field + ".c1"].value; + var c2 = form[field + ".c2"].value; + var c3 = form[field + ".c3"].value; + if (c1 != parseInt(c1) || c2 != parseInt(c2) || c3 != parseInt(c3) || + c1 < 0 || c2 < 0 || c3 < 0 || c1 > 255 || c2 > 255 || c3 > 255) { + element.selectedIndex = 1; + document['color_' + field].src = '/shared/1pixel.tcl?r=255&g=255&b=255'; + return; + } + + document['color_' + field].src = '/shared/1pixel.tcl?r=' + c1 + '&g=' + c2 + '&b=' + c3; + + var rgb = parseInt(form[field + ".c1"].value) + "," + parseInt(form[field + ".c2"].value) + "," + parseInt(form[field + ".c3"].value); + var found = 0; + for (var i = 0; i < element.length; ++i) + if (element.options[i].value == rgb) { + element.selectedIndex = i; + found = 1; + break; + } + if (!found) + element.selectedIndex = 0; +} + + } +} + +proc_doc ad_color_widget { name default { use_js 0 } } "Returns a color selection widget, optionally using JavaScript. Default is a string of the form '0,192,255'." { + set out "<table cellspacing=0 cellpadding=0><tr><td><select name=$name.list" + if { $use_js != 0 } { + append out " onChange=\"adUpdateColorText('$name')\"" + } + append out ">\n" + + set items [list "custom:" "none"] + set values [list "custom" ""] + + foreach color [ad_html_colors] { + lappend items [lindex $color 0] + lappend values "[lindex $color 1],[lindex $color 2],[lindex $color 3]" + } + + append out "[ad_generic_optionlist $items $values $default]</select>\n" + + if { ![regexp {^([0-9]+),([0-9]+),([0-9]+)$} $default all c1 c2 c3] } { + set c1 "" + set c2 "" + set c3 "" + } + + foreach component { c1 c2 c3 } { + append out " <input name=$name.$component size=3 value=\"[set $component]\"" + if { $use_js } { + append out " onChange=\"adUpdateColorList('$name')\"" + } + append out ">" + } + + if { $use_js == 1 } { + if { $c1 == "" } { + set c1 255 + set c2 255 + set c3 255 + } + append out "</td><td>  <img name=color_$name src=\"/shared/1pixel.tcl?r=$c1&g=$c2&b=$c3\" width=26 height=26 border=1>" + } + append out "</td></tr></table>\n" + return $out +} + +proc_doc ad_process_color_widgets args { Sets variables corresponding to the color widgets named in $args. } { + foreach field $args { + upvar $field var + set var [ns_queryget "$field.list"] + if { $var == "custom" } { + set var "[ns_queryget "$field.c1"],[ns_queryget "$field.c2"],[ns_queryget "$field.c3"]" + } + if { ![regexp {^([0-9]+),([0-9]+),([0-9]+)$} $var "" r g b] || $r > 255 || $g > 255 || $b > 255 } { + set var "" + } + } +} + +proc_doc ad_color_to_hex { triplet } { Converts a string of the form 0,192,255 to a string of the form #00C0FF. } { + if { [regexp {^([0-9]+),([0-9]+),([0-9]+)$} $triplet all r g b] } { + return "#[format "%02x%02x%02x" $r $g $b]" + } else { + return "" + } +} + Index: web/openacs/tcl/address-book-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/address-book-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/address-book-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,222 @@ +# address-book-defs.tcl,v 3.0 2000/02/06 03:12:56 ron Exp +proc address_book_url { } { + return "/address-book/" +} + +proc_doc address_book_authorized {scope db {group_id 0}} "If scope=0, return 1 if the user is authorized; 0 otherwise. Otherwise, returns 1. This function will expand as we expand the permissions in the address book" { + # user should be in the group + if {$scope=="group" && ![ad_user_group_member $db $group_id]} { + return 0 + } else { + return 1 + } +} + +proc_doc address_book_name { db } "assumes scope is set in the callers environment. if scope=group it assumes group_id is set in the callers environment, if scope=user it assumes that user_id is set in callers environment. For scope=group, returns the name of the group if the user is authorized. For scope=user, returns the person's name. For scope=public, returns the site name. For scope=table it returns an empty string." { + upvar scope scope + + switch $scope { + "public" { + return [ad_system_name] + } + "group" { + upvar group_id group_id + return [database_to_tcl_string $db "select group_name from user_groups where group_id = $group_id"] + } + "user" { + upvar user_id user_id + return [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id = [ad_get_user_id]"] + } + "table" { + return "" + } + } +} + +proc_doc address_book_record_display { selection {contact_info_only "f"} } "Displays address in a plain text manner. Wrap the output in address_book_display_as_html for display on web site." { + + set_variables_after_query + set to_return "$first_names $last_name" + foreach column [list email email2] { + if { [string compare [set $column] ""] != 0 } { + append to_return "<br><a href=mailto:[set $column]>[set $column]</a>" + } + + } + foreach column [list line1 line2] { + if { [string compare [set $column] ""] != 0 } { + append to_return "<br>[set $column]" + } + } + + if { [string compare $city ""] != 0 } { + append to_return "<br>$city, $usps_abbrev $zip_code" + } + if { [string compare $country ""] != 0 && [string compare $country "USA"] != 0 } { + append to_return "<br>$country" + } + if { [string compare $phone_home ""] != 0 } { + append to_return "<br>$phone_home (home)" + } + if { [string compare $phone_work ""] != 0 } { + append to_return "<br>$phone_work (work)" + } + if { [string compare $phone_cell ""] != 0 } { + append to_return "<br>$phone_cell (cell)" + } + if { [string compare $phone_other ""] != 0 } { + append to_return "<br>$phone_other (other)" + } + if { [string compare $birthmonth ""] != 0 && $contact_info_only == "f" } { + append to_return "<br>birthday $birthmonth/$birthday" + } + if { [string compare $birthyear ""] != 0 && $contact_info_only == "f" } { + append to_return "/$birthyear" + } + if { [string compare $notes ""] != 0 && $contact_info_only == "f" } { + append to_return "<br>\[$notes\]" + } + + return $to_return +} + +proc address_book_birthday_widget { {birthmonth ""} {birthday ""} {birthyear ""} } { + set to_return "Month <select name=birthmonth>\n<option value=\"\">\n" + set monthlist [list "01" "02" "03" "04" "05" "06" "07" "08" "09" "10" "11" "12"] + set daylist [list "01" "02" "03" "04" "05" "06" "07" "08" "09" "10" "11" "12" "13" "14" "15" "16" "17" "18" "19" "20" "21" "22" "23" "24" "25" "26" "27" "28" "29" "30" "31"] + foreach month $monthlist { + if { $month == $birthmonth } { + append to_return "<option value\"$month\" selected>$month\n" + } else { + append to_return "<option value\"$month\">$month\n" + } + } + append to_return "</select><br>Day <select name=birthday>\n<option value=\"\">\n" + foreach day $daylist { + if { $day == $birthday } { + append to_return "<option value\"$day\" selected>$day\n" + } else { + append to_return "<option value\"$day\">$day\n" + } + } + append to_return "</select><br>Year <input type=text name=birthyear size=4 value=\"$birthyear\">" + return $to_return +} + + +# Changes a few things to their HTML equivalents. +proc address_book_display_as_html { text_to_display } { + regsub -all "\\&" $text_to_display "\\&" html_text + regsub -all "\>" $html_text "\\>" html_text + regsub -all "\<" $html_text "\\<" html_text + regsub -all "\n" $html_text "<br>\n" html_text + regsub -all "\r\n" $html_text "<br>\n" html_text + return $html_text +} + +# takes care of leap years (since Feb 28 might not exist in the given_year) +proc address_book_birthday_in_given_year { birthday birthmonth given_year } { + if { $birthday == "29" && $birthmonth=="02" } { + if { [leap_year_p $given_year] } { + return "$given_year-02-29" + } else { + return "$given_year-03-01" + } + } else { + return "$given_year-$birthmonth-$birthday" + } + +} + +proc address_book_zero_if_null { input_string } { + if { [string compare $input_string ""] == 0 } { + return 0 + } else { + return $input_string + } +} + +# scheduled +proc address_book_mail_reminders { } { + + ns_log Notice "address_book_mail_reminders starting" + + set dblist [ns_db gethandle [philg_server_default_pool] 2] + set db [lindex $dblist 0] + set db2 [lindex $dblist 1] + + set today [database_to_tcl_string $db "select sysdate() from dual"] + set this_year [database_to_tcl_string $db "select to_char(sysdate(),'YYYY') from dual"] + + set selection [ns_db select $db "select a.oid, a.user_id, a.first_names, a.last_name, a.birthmonth, a.birthday, a.days_in_advance_to_remind, a.date_last_reminded, a.days_in_advance_to_remind_2, a.date_last_reminded_2 +from address_book a, users_alertable +where a.user_id=users_alertable.user_id +and a.birthmonth is not null +and a.birthday is not null +and (a.days_in_advance_to_remind is not null or a.days_in_advance_to_remind_2 is not null)"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + set birthday_this_year [address_book_birthday_in_given_year $birthday $birthmonth $this_year] + + if { [database_to_tcl_string $db2 "select case when sysdate() >= '$birthday_this_year'::date then 1 else 0 end"] } { + # then the birthday has already occurred this year + set next_birthday [address_book_birthday_in_given_year $birthday $birthmonth [expr $this_year + 1] ] + } else { + set next_birthday $birthday_this_year + } + + ns_log Notice "The first query: select 1 from dual where to_date('$next_birthday','YYYY-MM-DD')-sysdate() <= $days_in_advance_to_remind and (to_date('$next_birthday','YYYY-MM-DD') - to_date('$date_last_reminded','YYYY-MM-DD') >= $days_in_advance_to_remind or '$date_last_reminded' is null)" + + if { ($days_in_advance_to_remind != "" && [address_book_zero_if_null [database_to_tcl_string_or_null $db2 "select 1 from dual where to_date('$next_birthday','YYYY-MM-DD')-sysdate() <= $days_in_advance_to_remind and (to_date('$next_birthday','YYYY-MM-DD') - to_date('$date_last_reminded','YYYY-MM-DD') > $days_in_advance_to_remind or '$date_last_reminded' is null)"]] ) || ($days_in_advance_to_remind_2 != "" && [address_book_zero_if_null [database_to_tcl_string_or_null $db2 "select 1 from dual where to_date('$next_birthday','YYYY-MM-DD')-sysdate() <= $days_in_advance_to_remind_2 and (to_date('$next_birthday','YYYY-MM-DD') - to_date('$date_last_reminded','YYYY-MM-DD') > $days_in_advance_to_remind_2 or '$date_last_reminded' is null)"]] ) } { + + # then a reminder is due! + + set user_email [database_to_tcl_string $db2 "select email from users where user_id=$user_id"] + + set pretty_next_birthday [database_to_tcl_string $db2 "select to_char(to_date('$next_birthday','YYYY-MM-DD'),'Day, Month DD') from dual"] + # I don't know why Oracle pads the above with extra spaces + regsub -all " ( )+" $pretty_next_birthday " " pretty_next_birthday + regsub -all " ," $pretty_next_birthday "," pretty_next_birthday + + set email_body "This is an automatic reminder that $first_names $last_name's birthday is on +$pretty_next_birthday. + +Here is the information you have about them in your address book: + +[address_book_record_display $oid "f"] + +To update your address book, go to: +[address_book_url] +" + + ns_sendmail $user_email [ad_system_owner] "Birthday reminder: $first_names $last_name" $email_body + + ns_db dml $db2 "update address_book set date_last_reminded=sysdate() where oid='[DoubleApos $oid]'" +} +} + ns_log Notice "address_book_mail_reminders ending" +} + + +ns_share -init {set address_book_procs_scheduled_p 0} address_book_procs_scheduled_p + +if { !$address_book_procs_scheduled_p && [ad_parameter SendBirthdayAlerts addressbook] } { + set address_book_procs_scheduled_p 1 + + # scheduled to run every 12 hrs (twice a day in case one time fails) + +# ns_schedule_daily -thread 11 35 address_book_mail_reminders + ns_schedule_daily 04 00 address_book_mail_reminders + ns_log Notice "address_book_mail_reminders scheduled for 4:00am" + +# ns_schedule_daily -thread 23 35 address_book_mail_reminders + ns_schedule_daily 16 00 address_book_mail_reminders + ns_log Notice "address_book_mail_reminders scheduled for 4:00pm" + +} else { + ns_log Notice "address_book_mail_reminders not scheduled" +} + + Index: web/openacs/tcl/adserver-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/adserver-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/adserver-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,63 @@ +# adserver-defs.tcl,v 3.0 2000/02/06 03:12:57 ron Exp +# definitions for the ad server; adserver_get_ad_html is called by +# .tcl, .adp, or .html pages (by filters, presumably) +# to generate ad IMGs (linked to HREFs) + +proc adserver_get_ad_html {group_key {extra_img_tags ""}} { + set adserver_stub [ad_parameter PartialUrlStub adserver] + set db [ns_db gethandle subquery ] + + # right now, all we can really do is pick the ad in the specified + # group with the least exposure so far + set selection [ns_db select $db "(select display_count, map.adv_key, track_clickthru_p, target_url +from adv_group_map map, advs_todays_log log, advs +where group_key='$group_key' +and map.adv_key = advs.adv_key +and map.adv_key = log.adv_key) union +(select 0 as display_count, map.adv_key, track_clickthru_p, target_url +from adv_group_map map, advs where +group_key='$group_key' +and map.adv_key= advs.adv_key +and 0=(select count(*) from advs_todays_log where adv_key=map.adv_key)) +order by display_count"] + + # we only want the first row + if [ns_db getrow $db $selection] { + # we got one row + set_variables_after_query + # normally we generate the images through a call to adimg.tcl wrapped in an adhref.tcl + # href. If track_clickthru_p is false, just spew out the html contained in target_url + # forget about it. This is how we deal with doubleclick and their ilk. + if {$track_clickthru_p == "t"} { + return "<a href=\"${adserver_stub}adhref.tcl?adv_key=$adv_key\"><img src=\"${adserver_stub}adimg.tcl?adv_key=$adv_key\" $extra_img_tags></a>" + } else { + # update the impressions since this won't get called through adimg.tcl + + ns_db dml $db "update adv_log +set display_count = display_count + 1 +where adv_key='$adv_key' +and entry_date = trunc(sysdate())" + + # POSTGRES + # set n_rows [ns_ora resultrows $db] + set n_rows [ns_pg ntuples $db] + + if { $n_rows == 0 } { + ns_db dml $db "insert into adv_log +(adv_key, entry_date, display_count) +values +('$adv_key', trunc(sysdate()), 1)" + } + + regsub -all {\$timestamp} $target_url [ns_time] cache_safe_target + ns_db releasehandle $db + return $cache_safe_target + } + } else { + # couldn't even find one row + ns_log Notice "[ns_conn url] asked for an ad in the $group_key group but there aren't any" + ns_db releasehandle $db + return "" + } +} + Index: web/openacs/tcl/bboard-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/bboard-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/bboard-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,1457 @@ +# bboard-defs.tcl,v 3.2 2000/02/25 14:36:30 michael Exp +# +# bboard-defs.tcl +# +# by philg@mit.edu originally sometime in the mid-1990s (1996?) +# + +util_report_library_entry + + +# Tcl procedures definitions for the discussion forum system, +# generally parked in /bboard + +proc bboard_partial_url_stub {} { + return [ad_parameter PartialUrlStub bboard] +} + +proc bboard_hardwired_url_stub {} { + return "[ad_url][bboard_partial_url_stub]" +} + + +proc bboard_system_url {} { + return "[ad_url][bboard_partial_url_stub]" +} + +proc bboard_system_name {} { + set custom_name [ad_parameter SystemName bboard] + if ![empty_string_p $custom_name] { + return $custom_name + } else { + return "[ad_parameter SystemName] Discussion Forums" + } +} + +proc_doc bboard_file_uploading_enabled_p {} "We use this to determine whether or not any file uploading is possible. Then we check bboard_topics for info on a specific forum." { + return [ad_parameter FileUploadingEnabledP bboard 0] +} + +# The path where we store the images. Note that +# this path does *not* contain a trailing "/" +proc bboard_file_path {} { + return [ad_parameter FilePath bboard] +} + +proc bboard_generate_upload_filename {msg_id upload_id client_filename} { + # Get the suffix + set suffix [file extension $client_filename] + append filename $msg_id "-" $upload_id $suffix + return $filename +} + +# an email address; the discussion forums might +# be owned by someone other than the rest of the system + +proc bboard_system_owner {} { + set custom_owner [ad_parameter SystemOwner bboard] + if ![empty_string_p $custom_owner] { + return $custom_owner + } else { + return [ad_system_owner] + } +} + +# an email address + +proc bboard_host_administrator {} { + set custom_host_admin [ad_parameter HostAdministrator bboard] + if ![empty_string_p $custom_host_admin] { + return $custom_host_admin + } else { + return [ad_host_administrator] + } +} + +# Who to send email as. Will receive lots of error messages for bad +# user email addresses. +proc bboard_sender_email {} { + return [ad_parameter SenderEmail bboard] +} + +# change this to return 0 if there is no PLS Blade; 1 if there is. + +proc bboard_pls_blade_installed_p {} { + return [ad_parameter UsePLS bboard] +} + +proc bboard_openacs_search_installed_p {} { + return [ad_parameter UseOpenACSSearch bboard] +} + +# for the interest level system; anything below this threshold +# is considered uninteresting + +proc bboard_interest_level_threshold {} { + return [ad_parameter InterestLevelThreshold bboard] +} + +# change this to return 0 if random users can't add topics + +proc bboard_users_can_add_topics_p {} { + return [ad_parameter UserCanAddTopicsP bboard] +} + +proc bboard_raw_backlink {topic_id topic presentation_type {include_hostname_p 1}} { + if { $presentation_type == "threads" } { + set raw_backlink "main-frame.tcl?[export_url_vars topic_id topic]" + } elseif { $presentation_type == "usgeospatial" } { + set raw_backlink "usgeospatial.tcl?[export_url_vars topic_id topic]" + } else { + set raw_backlink "q-and-a.tcl?[export_url_vars topic_id topic]" + } + if $include_hostname_p { + return "[bboard_hardwired_url_stub]$raw_backlink" + } else { + return $raw_backlink + } +} + +proc bboard_msg_url { presentation_type msg_id topic_id {topic ""}} { + if { $presentation_type == "q_and_a" } { + return "q-and-a-fetch-msg.tcl?[export_url_vars msg_id topic_id topic]" + } elseif { $presentation_type == "ed_com" } { + return "ed-com-msg.tcl?[export_url_vars msg_id topic_id topic]" + } elseif { $presentation_type == "usgeospatial" } { + return "usgeospatial-fetch-msg.tcl?[export_url_vars msg_id topic_id topic]" + } else { + # this is a frames (bleah) board + return "main-frame.tcl?[export_url_vars topic_id topic]&feature_msg_id=$msg_id&start_msg_id=$msg_id" + } +} + +proc bboard_complete_backlink {topic_id topic presentation_type {include_partial_url_stub 0}} { + if $include_partial_url_stub { + set directory_stub [bboard_partial_url_stub] + } else { + set directory_stub "" + } + if { $presentation_type == "ed_com" } { + set complete_backlink "<a href=\"${directory_stub}q-and-a.tcl?[export_url_vars topic_id topic]\">$topic forum</a>" + } elseif { $presentation_type == "usgeospatial"} { + set complete_backlink "<a href=\"${directory_stub}usgeospatial.tcl?[export_url_vars topic_id topic]\">$topic forum</a>" + } elseif { $presentation_type == "threads"} { + set complete_backlink "<a href=\"${directory_stub}main-frame.tcl?[export_url_vars topic_id topic]\">$topic</a>" + } else { + set complete_backlink "<a href=\"${directory_stub}q-and-a.tcl?[export_url_vars topic_id topic]\">$topic Q&A forum</a>" + + } + return $complete_backlink +} + +proc bboard_header {title} { + # return [openacs_header $title] + + return "<html> +<head> +<title>$title + + +" +} + +proc bboard_footer {} { +# return [openacs_footer] + + uplevel { + global sidegraphic_displayed_p + if [info exists maintainer_email] { + # we're looking at a particular forum + set signature_address $maintainer_email + } else { + set signature_address [bboard_system_owner] + } + if { [info exists sidegraphic_displayed_p] && $sidegraphic_displayed_p } { + # we put in a BR CLEAR=RIGHT so that the signature will clear any side graphic + # from the ad-sidegraphic.tcl package + set extra_br "
    " + } else { + set extra_br "" + } + return " +$extra_br +
    +
    $signature_address
     + + +" + } +} + +# Verify that the user is authorized to see this topic. +# +# Assumes topic_id or topic is set to some value +# Returns -1 if user is not authorized to view the page +# Returns 1 on if user is OK to view the page +# +# +proc bboard_get_topic_info { } { + uplevel { + + if {[exists_and_not_null topic_id]} { + validate_integer "topic_id" $topic_id + } + + if {!([info exists topic_id] && ![catch {set selection [ns_db 1row $db "select t.*, u.email as maintainer_email, u.first_names || ' ' || u.last_name as maintainer_name, primary_maintainer_id +from bboard_topics t, users u +where topic_id=$topic_id +and t.primary_maintainer_id = u.user_id"]} errmsg]) + && !([info exists topic] && ![catch {set selection [ns_db 1row $db "select t.*, u.email as maintainer_email, u.first_names || ' ' || u.last_name as maintainer_name, primary_maintainer_id +from bboard_topics t, users u +where topic = '[DoubleApos $topic]' +and t.primary_maintainer_id = u.user_id"]} errmsg]) } { + ns_log Notice "bboard-error: $errmsg" + bboard_return_cannot_find_topic_page + return -1 + } + set_variables_after_query + set user_id [ad_verify_and_get_user_id] + # Check read-access of this topic + if {[string compare $read_access "any"] == 0} { + # Any user can view this topic + return 1 + } elseif {[string compare $read_access "public"] == 0} { + # "public" means user must be logged in to read this topic + if {$user_id == 0} { + ns_returnredirect /register.tcl?return_url=[ns_urlencode "[bboard_hardwired_url_stub]admin-home.tcl?[export_url_vars topic_id]"] + return -1 + } else { + return 1 + } + } elseif {[string compare $read_access "group"] == 0} { + # "group" means the user must belong to one of the topic's groups. + # ACS 3.1.1 patch + if {[ad_permission_p $db $bboard $topic_id "" $user_id]} { + ns_db flush $db + return 1 + } else { + # Well, the user isn't in any of the topic's groups. But.. + # If they are site admin group member, let's let them in anyway. + # default to group is private (read_access = group) + if {[ad_administration_group_member $db "site_wide" "" $user_id]} { + # user is site admin, let them look at the bboard + return 1 + } else { + ns_return 200 text/html "[bboard_header "Unauthorized"] +

    Unauthorized

    +
    + + You are either not logged into [ad_system_name] + or not authorized to view the $topic forum. + + [bboard_footer]" + return -1 + } + } + } + } +} + + + +# Verify if current user is allowed to view this topic. +# Returns 0 if user is not authorized, and sends appropriate error message page +# or redirect to client. +proc bboard_user_has_view_authorization {} { + uplevel { + set user_id [ad_verify_and_get_user_id] + # Check to see if read access on this topic matches with user's group memberships + + set read_access [database_to_tcl_string $db "select read_access from bboard_topics where topic_id = $topic_id"] + # Anyone can read + } + ## +++ NOT FINISHED YET +++ +} + + + + +# +++ THIS MUST BE DEAD CODE, it refers to bboard_topics.user_password, which looks +# like it has not existed for awhile -- hqm [9/16/1999] +proc bboard_topic_user_password_p_internal {db topic} { + set selection [ns_db 0or1row $db "select distinct user_password from bboard_topics where topic = '[DoubleApos $topic]'"] + if { $selection == "" } { + # couldn't find the topic, they'll err out high up the chain + return 0 + } else { + set user_password [ns_set value $selection 0] + if { $user_password == "" } { + return 0 + } else { + return 1 + } + } +} + +# ++++++++++++++++ + +proc bboard_compute_cookie_name {topic {admin 0}} { + # strip out everything that wouldn't go well in the headers + regsub -all { } $topic {_} first_try + regsub -all {=} $first_try {_} second_try + regsub -all {;} $second_try {_} third_try + # we need to set it up so that the regular cookie is + # not a substring of the admin cookie (otherwise + # our caveman cookie checking code gets confused when + # the administrator tries to post) + if { $admin == 1 } { + return "Admin$third_try" + } else { + return "User$third_try" + } +} + +proc bboard_compute_cookie {topic {admin 0}} { + # this will only use the first 8 chars of the topic, but that's OK + if { $admin == 1 } { + set key "a$topic" + } else { + set key $topic + } + set day_of_month [lindex [ns_localtime] 3] + set salt $day_of_month + set raw_result [ns_crypt $key $salt] + set minus_salt [string range $raw_result 2 [string length $raw_result]] + # strip out chars that won't work on header line + regsub -all {=} $minus_salt "" first_try + regsub -all {;} $first_try "" second_try + regsub -all { } $second_try "" third_try + return $third_try +} + +proc bboard_check_cookie {topic {admin 0}} { + set headers [ns_conn headers] + set cookie [ns_set get $headers Cookie] + # we look for the cookie name corresponding to this topic + # we can't do the obvious thing and use regexp because + # users can include things like "?" in their topic names + # and those are magic Tcl regexp chars + set cookie_name [bboard_compute_cookie_name $topic $admin] + set pos [string last $cookie_name $cookie] + if { $pos == -1 } { + # there wasn't a cookie header or it didn't contain a relevant + # name + return 0 + } else { + # strip off the cookie name + set rest_of_cookie [string range $cookie [expr $pos + [string length $cookie_name]] [string length $cookie]] + if { [regexp {[ ]*=[ ]*([^; ]+).*} $rest_of_cookie match just_the_value] } { + set what_we_would_like_to_see [bboard_compute_cookie $topic $admin] + if { $just_the_value == $what_we_would_like_to_see } { +# ns_log Notice "Cookie matched! : $cookie" + # we found a legit value + return 1 + } else { + # we got the value out but it didn't work (maybe because it + # was too old) + ns_log Notice "Cookie was too old : $cookie (we wanted $what_we_would_like_to_see but got $just_the_value); rest_of_cookie: $rest_of_cookie " + return 0 + } + } else { + ns_log Notice "Found a cookie but couldn't get the value out: $cookie" + return 0 + } + } +} + +# useful for sending email to people telling them where to come back + +proc bboard_url_stub {} { + regexp {(.*/)[^/]*$} [ns_conn url] match just_the_dir + + append url_stub [ns_conn location] $just_the_dir + + return $url_stub + +} + +# for subject listings + +proc bboard_compute_msg_level { sort_key } { + + set period_pos [string first "." $sort_key] + + if { $period_pos == -1 } { + + # no period, primary level + + return 0 + + } else { + + set n_more_levels [expr ([string length $sort_key] - ($period_pos + 1))/2] + + return $n_more_levels + + } + + +} + +proc bboard_db_gethandle {} { + if [catch {set db [ns_db gethandle]} errmsg] { + # something wrong with the NaviServer/db connection + ad_notify_host_administrator "please fix [ns_conn location]" "please fix [ns_conn location] so that it can talk to Oracle + +Thanks, + +The Ghost of the AOLserver + +Note: this message was automatically sent by a Tcl CATCH statement running +inside [ns_conn location]. Specific error message is +$errmsg +" + return "" + } else { + return $db + } +} + +proc bboard_return_cannot_find_topic_page {} { + set_form_variables + if { [info exists topic] } { + set topic_blurb $topic + } else { + set topic_blurb "No Topic Variable Supplied" + } + ns_return 200 text/html "[bboard_header "Cannot Find Topic"] + +

    Cannot Find Topic

    +
    + +This page was called with a topic variable of \"$topic_blurb\". There is no +bboard in the database with that topic name. Either you have been +manually adjusting the URL (perhaps by cutting and pasting) or something +is seriously wrong with the [bboard_system_name] system. + +

    + +You can probably find the page that you need by starting from the +[bboard_system_name] home page. + +

    +[bboard_system_owner] + +" +} + +proc bboard_return_error_page {} { + ns_return 500 text/html " + +Server is Having Trouble + + + +

    Server is Having Trouble

    +
    + +Our server can't connect to the relational database right now. This +is presumably because of a system administration problem. You can send the administrator +email at [bboard_host_administrator] and ask him/her to fix +[ns_conn location] because you value this service. + +
    +[bboard_system_owner] + +" +} + +# all the stuff for email notifications have to go here + +proc bboard_spam_daily {} { + bboard_spam "daily" +} + +proc bboard_spam_monthu {} { + bboard_spam "Monday/Thursday" +} + +proc bboard_spam_weekly {} { + bboard_spam "weekly" +} + +# we must check or each TclInit will cause these to be scheduled again! + +ns_share -init {set bboard_spam_scheduled 0} bboard_spam_scheduled + + +if { !$bboard_spam_scheduled && ![philg_development_p]} { + + set bboard_spam_scheduled 1 + + ns_log Notice "Scheduling bboard spam with ns_schedule..." + # we schedule this at 3:30 am with the THREAD option + # because it isn't going to return any time soon + # **** actually we take out the thread option because + # Doug McKee says it might not work + ns_schedule_daily 3 30 bboard_spam_daily + + # we schedule this at 4:30 am twice because + # the AOLServer API isn't powerful enough to + # say "monday AND thursday" + ns_schedule_weekly 1 4 30 bboard_spam_monthu + ns_schedule_weekly 4 4 30 bboard_spam_monthu + + # we schedule this at 5:30 am on Sunday + ns_schedule_weekly 0 5 30 bboard_spam_weekly + +} else { + ns_log Notice "bboard spam already scheduled, doing nothing" +} + +proc ugly_frequency {pretty_frequency} { + if { $pretty_frequency == "Monday/Thursday" } { + return "monthu" + } else { + return $pretty_frequency + } +} + +proc bboard_spam {frequency} { + set ugly_frequency [ugly_frequency $frequency] + # ***** subquery was [philg_server_default_pool] + set db_pools [ns_db gethandle subquery 2] + set db [lindex $db_pools 0] + set db_sub [lindex $db_pools 1] + # we could just update bboard_email_alerts_updates + # right now but we don't because we might get interrupted + set start_time [database_to_tcl_string $db "select to_char(sysdate(),'YYYY-MM-DD HH24:MI:SS') from dual"] + ns_log Notice "Started doing $frequency bboard email alerts at $start_time" + + # we want the OID to give the user the option to instantly disable the alert + set selection [ns_db select $db "select bea.*,bea.oid as rowid, users_alertable.email, bboard_topics.topic +from bboard_email_alerts bea, users_alertable, bboard_topics +where valid_p <> 'f' +and bea.user_id = users_alertable.user_id +and bboard_topics.topic_id = bea.topic_id +and frequency = '$frequency'"] + set mail_counter 0 + + # extra mail headers (for RFC 2369-style headers below) + set extraheaders [ns_set create extraheaders] + + while {[ns_db getrow $db $selection]} { + # this is the outer loop where each row is an alert for one email address + set_variables_after_query + ns_log Notice "checking $rowid alert for $email ... ($topic,$keywords)" + set msg_body "" + if { $keywords != "" && [bboard_pls_blade_installed_p] == 0 } { + # this is trouble, the user spec'd keywords but the PLS blade + # isn't installed, so we'll have to do this very stupidly + set keyword_list [split $keywords " "] + set keyword_clauses [list] + foreach keyword $keyword_list { + lappend keyword_clauses "message like '%[DoubleApos $keyword]%'" + } + if { [llength $keyword_clauses] == 0 } { + set final_keyword_clause "" + } else { + set final_keyword_clause "and ([join $keyword_clauses " OR "])" + } + set sql "select * from bboard +where topic_id = $topic_id +$final_keyword_clause +and posting_time > (select distinct $ugly_frequency from bboard_email_alerts_updates) +order by posting_time" + } elseif { $keywords == "" } { + # user wants everything + set sql "select bboard.*, first_names || ' ' || last_name as name, +email from bboard, users +where topic_id = $topic_id +and posting_time > (select distinct $ugly_frequency from bboard_email_alerts_updates) +and users.user_id = bboard.user_id +order by posting_time" + } else { + # user spec'd keywords + regsub -all {,+} $keywords " " keywords + set sql "select bboard.* , first_names || ' ' || last_name as name, +email from bboard, users +where topic_id = $topic_id +and bboard.user_id = users.user_id +and posting_time > (select distinct $ugly_frequency from bboard_email_alerts_updates) +and bboard_contains(email, first_names || last_name, one_line, message,'[DoubleApos $keywords]') > 0 +order by posting_time" + } + # at this point, SQL is set or we've skipped to the next loop iteration + if [catch {set sub_selection [ns_db select $db_sub $sql]} errmsg] { + # probably ConText coughed up an error + ns_log Notice "error trying to send an alert: $errmsg" + # just to the next loop iteration (i.e., the next alert) + continue + } + while {[ns_db getrow $db_sub $sub_selection]} { + # this is the inner loop where each row is a bboard posting + set from_email [ns_set get $sub_selection email] + set from_name [ns_set get $sub_selection name] + set one_line [ns_set get $sub_selection one_line] + set message [ns_set get $sub_selection message] + set posting_time [ns_set get $sub_selection posting_time] + append msg_body "From: $from_name <$from_email> +Subject: $one_line +Date: $posting_time + +[ns_striphtml $message] + +-------------- +" + + } + if { $msg_body != "" } { + # we have something to send + set sub_selection [ns_db 1row $db_sub "select first_names || ' ' || last_name as maintainer_name, email as maintainer_email, presentation_type +from bboard_topics, users +where topic_id = $topic_id and +bboard_topics.primary_maintainer_id = users.user_id"] + set_variables_after_subquery + append msg_body " +The maintainer email is $maintainer_email. +This message was sent because you asked the [bboard_system_name] system +to alert you via email of new postings in the $topic forum, +to which you can return at + +[bboard_raw_backlink $topic_id $topic $presentation_type] + +If you are annoyed by this message then just enter the following URL +into a browser and you'll disable the alert that generated this mail: + +[bboard_hardwired_url_stub]alert-disable.tcl?rowid=$rowid + +" + # MAC: extra RFC 2369-style header fields + ns_set update $extraheaders List-Unsubscribe "<[bboard_hardwired_url_stub]alert-distable.tcl?rowid=$rowid>" + ns_set update $extraheaders List-Post "<[bboard_raw_backlink $topic_id $topic $presentation_type]>" + ns_set update $extraheaders List-Archive "<[bboard_raw_backlink $topic_id $topic $presentation_type]>" + ns_set update $extraheaders List-Owner "" + + # we don't want a bad email address terminating the program + if [catch { ns_sendmail $email $maintainer_email "$topic forum $frequency summary" $msg_body $extraheaders} errmsg] { + # failed + ns_log Notice "Failed to send bboard alert to $email: $errmsg" + } else { + # succeeded + ns_log Notice "Send bboard alert to $email." + incr mail_counter + } + } + } + # we've finished looping through the alerts + ns_db dml $db "update bboard_email_alerts_updates +set $ugly_frequency = '$start_time'::datetime, +$ugly_frequency\_total = $ugly_frequency\_total + $mail_counter" + set stop_time [ns_localsqltimestamp] + ns_log Notice "Finished doing $frequency bboard email alerts at $stop_time" + +} + +### +# Helper functions for insert-msg.tcl +# + + +proc increment_char_digit {old_char} { + + # get ASCII decimal code for a character + scan $old_char "%c" code + + if { $code == 57 } { + + # skip from 9 to A + + set new_code 65 + set carry 0 + + } elseif { $code == 90 } { + + # skip from Z to a + + set new_code 97 + set carry 0 + + } elseif { $code == 122 } { + + set new_code 48 + set carry 1 + + } else { + + set new_code [expr $code + 1] + set carry 0 + + } + + return [list [format "%c" $new_code] $carry] + +} + +# takes 000000 and gives back 000001 + +proc increment_six_char_digits {old_six_digits {index 5}} { + + set char [string index $old_six_digits $index] + + set digit_result [increment_char_digit $char] + set new_digit [lindex $digit_result 0] + set carry [lindex $digit_result 1] + + if { $carry == 0 } { + + append new_id [string range $old_six_digits 0 [expr $index - 1]] $new_digit [string range $old_six_digits [expr $index + 1] 5] + + return $new_id + + } elseif { $index == 0 } { + + # we've got a carry out of our add to the most significant digit + + error "Tried to increment $old_six_digits but have run out of room" + + } else { + + # we've got a carry out but we're not at the end of our rope + + append intermediate_result [string range $old_six_digits 0 [expr $index - 1]] $new_digit [string range $old_six_digits [expr $index + 1] 5] + + # we recurse and decrement the index so we're working + # on a more significant digit + + return [increment_six_char_digits $intermediate_result [expr $index - 1]] + + } +} + +proc increment_two_char_digits {last_two_chars} { + + set msd [string index $last_two_chars 0] + set lsd [string index $last_two_chars 1] + + set lsd_result [increment_char_digit $lsd] + set new_lsd [lindex $lsd_result 0] + set carry [lindex $lsd_result 1] + + if { $carry == 0 } { + + set new_msd $msd + + } else { + + set msd_result [increment_char_digit $msd] + set new_msd [lindex $msd_result 0] + set msd_carry [lindex $msd_result 1] + + if { $msd_carry != 0 } { + + error "Tried to increment $last_two_chars but have run out of room" + + } + + } + + return "$new_msd$new_lsd" + +} + +proc new_sort_key_form {old_sort_key} { + + if { [string first "." $old_sort_key] == -1 } { + + # no period found, so old sort key is just "00z3A7", a msg_id + + # form for next level is "." + + return "$old_sort_key.\__" + + } else { + + # period found, so old sort key is of form "317.CCDDKK" + + return "$old_sort_key\__" + + } + +} + +proc new_sort_key {refers_to_key last_key} { + + if { $last_key == "" } { + + # this is the first message that refers to the previous one, so we + # just add ".00" or "00" + + if { [string first "." $refers_to_key] == -1 } { + + # no period found, so refers_to_key is just "00007Z", a msg_id + # (i.e., the thing we're referring to is top level) + + append new_key $refers_to_key ".00" + + } else { + + # period found, so last_key is of form "00007Z.CCDDKK" + + append new_key $refers_to_key "00" + + } + + return $new_key + + } else { + + # we're not the first response to $refers_to + # last key cannot be just a msg id, but must have two chars at the end + # 00 through zz + + regexp {(.*)(..)$} $last_key match front_part last_two_chars + + return "$front_part[increment_two_char_digits $last_two_chars]" + + } + + +} + +proc bboard_convert_plaintext_to_html {raw_string} { + if { [regexp -nocase {

    } $raw_string] || [regexp -nocase {
    } $raw_string] } { + # user was already trying to do this as HTML + return $raw_string + } else { + regsub -all "\015\012\015\012" $raw_string "\n\n

    \n\n" plus_para_tags + return $plus_para_tags + } + +} + +# recursive procedure that keeps building a list of people to whom +# notifications have been sent (so that duplicates aren't sent to +# people who appear in the same thread twice) + +proc notify_if_requested {db new_msg_id notify_msg_id from subject_line body already_notified} { + + set selection [ns_db 1row $db "select email,refers_to,notify + from bboard, users + where bboard.user_id = users.user_id + and msg_id = '$notify_msg_id'"] + + set_variables_after_query + + if { $notify == "t" && [lsearch -exact $already_notified $email] == -1 } { + # user asked to be notified and he has not already been for this posting + + set shut_up_url "[bboard_url_stub]shut-up.tcl?msg_id=$notify_msg_id" + + # we use a Tcl Catch system function + # in case some loser typed in "dogbreath 78 @ aol.com" + # that would cause ns_sendmail to barf up an error + # this way the recursion proceeds even with one bad email address + # in the chain + + if ![catch { ns_sendmail $email $from $subject_line "$body + +------------- + +If you are no longer interested in this thread, simply go to the +following URL and you will no longer get these notifications: + +$shut_up_url + +------------- + +Note: this message was sent by a robot. + +" + } errmsg] { + # no error + ns_write "

  • sent a note to $email, to whose message you are responding.\n" + } + + # mark this address as having already been notified + + lappend already_notified $email + + } + + if { $refers_to != "" } { + + # recurse with all the same args except NOTIFY_MSG_ID + + notify_if_requested $db $new_msg_id $refers_to $from $subject_line $body $already_notified + + } + +} + +# for flaming postings + +proc bboard_pretend_to_be_broken {full_anchor maintainer_email} { + ReturnHeaders + + ns_write " + +Inserting Message + + + +

    Inserting Message

    + +into the $full_anchor + +
    + +You would think that this operation would be quick and fast, +especially given that the author of this software holds himself out as +an expert in the book Database Backed Web +Sites. And indeed this operation was quick and fast when +the forum was lightly used. But now with thousands of users and +20,000 old messages in the forum, the limitations of the relational +database management system underneath are beginning to show. + +

    + +All of the photo.net collaboration services use the Illustra RDBMS. +This system has kind of a pure university egghead flavor to it and +this means that by default nobody can read from a table while anyone +is writing to it. Nor can anyone write a new row (message) into a +table while anyone is reading from it. + +

    + +I'm currently porting all of my stuff to a monster HP Unix box at MIT +running the Oracle RDBMS, a system inspired more by the needs of +enormous banks and insurance companies than by university professors +trying to impress their colleagues. In Oracle, readers never have to +wait for writers or vice versa. Given that there are sometimes as +many as 100 simultaneous users grabbing stuff from photo.net, this is +likely to be a much better system. Sadly, though, I haven't finished +porting all of my code to Oracle (because I'm combining the port with the +construction of Version 0.1 of +my grand scheme for reforming the way Web publishing is done). + +

    + +Since we're still running off Illustra, you'll very likely have to +wait for awhile and/or get the dreaded \"deadlock\" error message. If +you get the latter, just leave your browser window sitting for three +minutes and then hit the Reload button to resubmit your posting. + +

    + +OK, after all of that blather, we're going to try the insert now... + +

    + +" + ns_sleep 60 + + ns_write "

    Ouch!!

    + + +Here was the bad news from the database: +
    +
+XS1002:Deadlock: transaction aborted, all commands ignored until end transaction
+
+
    + +If you see \"deadlock\" above, remember that you can resubmit your +posting in a few minutes and it will probably work fine (when the +server gets totally wedged, I have another AOLserver process beat it +over the head with a (Unix) tire iron; this takes 3 minutes from the time of first wedge). + +
    + +
    $maintainer_email
     + + +" + + +} + +proc bboard_compute_categories_with_count {topic_id} { + set db [ns_db gethandle subquery] + set selection [ns_db select $db "select category, count(*) as n_threads +from bboard +where refers_to is null +and topic_id = $topic_id +and category is not null +and category <> 'Don''t Know' +group by category +order by 1"] + set result "" + while {[ns_db getrow $db $selection]} { + set_variables_after_query + append result "
  • $category ($n_threads)\n" + } + ns_db releasehandle $db + return $result +} + +# for admin pages + +proc dependent_sort_key_form {old_sort_key} { + if { [string first "." $old_sort_key] == -1 } { + # no period found, so old sort key is just "00z3A7", a msg_id + # form for dependents is "." + return "$old_sort_key.%" + } else { + # period found, so old sort key is of form "317.CCDDKK" + # we demand at least two chars after the old key ("__") + # plus zero or more ("%") + return "$old_sort_key\__%" + } +} + +proc bboard_delete_messages_and_subtrees_where {db where_clause} { + set sort_keys [database_to_tcl_list $db "select sort_key +from bboard +where $where_clause"] + foreach sort_key $sort_keys { + # this should kill off an individual message or a whole + # subtree if there are dependents + ns_db dml $db "delete from bboard where sort_key like '${sort_key}%'" + } +} + + +# Verify that user is an admin for a group which is associated with topic_id. +# Returns 1 if true, 0 otherwise. +proc bboard_user_is_admin_for_topic {db user_id topic_id} { + return [expr [database_to_tcl_string $db "select count(*) +from bboard_topics +where primary_maintainer_id = $user_id +and topic_id = $topic_id"] || [ad_administration_group_member $db "bboard" $topic_id $user_id]] +} + +# Verify if a user is allowed to view this topic. +# Return 1 if allowed, 0 otherwise. +# +# The topic is viewable if: +# - The read_access is 'any' or 'public'. +# OR +# - The read_access is 'group' and the user is a member of +# one of the groups that the topic belongs to. +# +proc bboard_user_can_view_topic_p {db user_id topic_id} { + set read_access [database_to_tcl_string $db "select read_access from bboard_topics where topic_id = $topic_id"] + if {[string compare $read_access "any"] == 0 || [string compare $read_access "public"] == 0} { + return 1 + } else { + set selection [ns_db 0or1row $db "select user_id from user_group_map + where user_id = $user_id + and group_id in (select group_id from bboard_topic_group_map where topic_id = $topic_id)"] + if { [empty_string_p $selection] } { + return 0 + } else { + return 1 + } + } +} + +## +# Is the current user an authorized admin for this topic? +# assumes $db and $topic_id are defined +# returns -1 on auth failure +proc bboard_admin_authorization {} { + uplevel { + set user_id [ad_verify_and_get_user_id] + + if {$user_id == 0} { + + ns_returnredirect /register.tcl?return_url=[ns_urlencode "[bboard_hardwired_url_stub]admin-home.tcl?[export_url_vars topic_id]"] + return -1 + } + + # Check to see if user is an admin in the topic's group. + + if { [bboard_user_is_admin_for_topic $db $user_id $topic_id]== 0 } { + + ns_return 200 text/html "[bboard_header "Unauthorized"] + +

    Unauthorized

    +
    + + You are either not logged into [ad_system_name] + or not authorized to administer the $topic forum. + + [bboard_footer]" + return -1 + } else { + return 1 + } + } +} + +# Check if the user has any admin role in any group. +# This is used to screen users who want to create a new topic. +# assumes db is bound +proc bboard_check_any_admin_role {} { + uplevel { + set user_id [ad_verify_and_get_user_id] + + if {$user_id == 0} { + + ns_returnredirect /register.tcl?return_url=[ns_urlencode "[bboard_hardwired_url_stub]admin-home.tcl?[export_url_vars topic_id]"] + return + } + + # Check to see if user is an admin in the topic's group. + + set n_rows [database_to_tcl_string $db "select count(user_id) + from user_group_map ugm + where ugm.user_id = $user_id + and ugm.role = 'administrator'"] + if { $n_rows <= 0 } { + ns_return 200 text/html "[bboard_header "Unauthorized"] + +

    Unauthorized

    +
    + + You are either not logged into [ad_system_name] + or not authorized to administer the $topic forum. + + [bboard_footer]" + return -1 + } + } +} + + + + + + +# stuff just for usgeospatial + +proc usgeo_n_spaces {n} { + set result "" + for { set i 0} {$i < $n} {incr i} { + append result " " + } + return $result +} + +proc bboard_usgeospatial_about_link {db msg_id} { + set selection [ns_db 0or1row $db "select one_line, zip_code, bboard.fips_county_code, bboard.usps_abbrev, bboard.epa_region, users.user_id as poster_id, users.first_names || ' ' || users.last_name as name, bboard.tri_id, facility, fips_county_name, rel_search_st.state_name +from bboard, users, rel_search_fac, rel_search_co, rel_search_st +where bboard.user_id = users.user_id +and bboard.tri_id = rel_search_fac.tri_id(+) +and bboard.fips_county_code = rel_search_co.fips_county_code(+) +and bboard.usps_abbrev = rel_search_st.state +and msg_id = '$msg_id'"] + set_variables_after_query + if { ![empty_string_p $tri_id] && ![empty_string_p $facility] } { + # we have a facility + set about_text $facility + } elseif { ![empty_string_p $zip_code] } { + set about_text "Zip Code $zip_code" + } elseif { ![empty_string_p $fips_county_code] } { + set about_text "$fips_county_name County" + } elseif { ![empty_string_p $usps_abbrev] } { + set about_text "$state_name" + } + set about_link "$one_line (about $about_text)" + return $about_link +} + + +# on the main page, we list out the forums grouped my +# their moderation policy. This procedure gives the order +# to search for + +proc bboard_moderation_policy_order {} { + return " \"\" featured moderated unmoderated private" +} + +# give the title heading for a given moderation policy + +proc bboard_moderation_title {moderation_policy} { + switch [string tolower $moderation_policy] { + "featured" {return "Featured Forums"} + "moderated" {return "[ad_system_name] Moderated Forums"} + "unmoderated" {return "Unmoderated Forums"} + "private" {return "Private Forums"} + default { return "" } + } +} + + +proc bboard_private_error {topic name email} { + ReturnHeaders + ns_write " + [bboard_header "Private discussion group"] +

    $topic

    +is a private discussion group in [bboard_system_name] +
    +

    +You are not permitted to enter this topic because +it is private. Please contact $name if you would like join. +[bboard_footer]" + return +} + +# This procedure is used to delete uploaded files. +# It is usually called using ns_atclose so that this is +# executed after the database information has been updated +# To make sure that the transaction has successfully happened, +# we check that the files to delete are no longer in the database + +# ** note that this used to take an actual list but we're always +# calling it in an ns_atclose so the list gets expanded + +proc bboard_delete_uploaded_files args { + # Tcl is too stupid to allow N args unless you call them "args" + set list_of_files $args + ns_log Error "bboard_delete_uploaded_files asked to delete +[join $list_of_files "\n"] +\n +" + # Let's not do more work than we need to do. + if {[llength $list_of_files] == 0} { + return + } + + # let's double check to make sure that none are in the database + set db [ns_db gethandle subquery] + set count [database_to_tcl_string $db "select count(*) +from bboard_uploaded_files +where filename_stub IN ('[join [DoubleApos $list_of_files] "','"]')"] + + # If any file is still there, don't do anything + if {$count > 0} { + ns_log Error "bboard_delete_uploaded_files asked to delete +[join $list_of_files "\n"] +but at least one was still on record in the bboard_uploaded_files table." + return + } + + foreach file $list_of_files { + set full_path "[bboard_file_path]$file" + ns_log Notice "bboard_delete_uploaded_files removing $full_path" + ns_unlink $full_path + } + ns_db releasehandle $db +} + +################################################################## +# +# interface to the ad-new-stuff.tcl system + +ns_share ad_new_stuff_module_list + +if { ![info exists ad_new_stuff_module_list] || [lsearch -glob $ad_new_stuff_module_list "Bboard*"] == -1 } { + lappend ad_new_stuff_module_list [list "Bboard" bboard_new_stuff] +} + +proc bboard_new_stuff {db since_when only_from_new_users_p purpose} { + if { $only_from_new_users_p == "t" } { + set query "select bt.topic, bt.presentation_type, count(*) as n_messages +from bboard, bboard_topics bt, users_new +where posting_time > '$since_when' +and bboard.user_id = users_new.user_id +and bboard.topic_id = bt.topic_id +group by bt.topic, bt.presentation_type" + } else { + set query "select bt.topic_id, bt.topic, bt.presentation_type, count(*) as n_messages +from bboard, bboard_topics bt +where posting_time > '$since_when' +and bboard.topic_id = bt.topic_id +group by bt.topic_id, bt.topic, bt.presentation_type" + } + set result_items "" + set selection [ns_db select $db $query] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + switch $purpose { + web_display { + append result_items "

  • [bboard_complete_backlink $topic_id $topic $presentation_type 1] ($n_messages new messages)\n" } + site_admin { + append result_items "
  • [bboard_complete_backlink $topic_id $topic $presentation_type 1] ($n_messages new messages)\n\n" + } + email_summary { + append result_items "$topic forum : $n_messages new messages + -- [bboard_raw_backlink $topic_id $topic $presentation_type 1] +" + } + } + } + # we have the result_items or not + if { $purpose == "email_summary" } { + return $result_items + } elseif { ![empty_string_p $result_items] } { + return "
      \n\n$result_items\n
    \n" + } else { + return "" + } +} + +################################################################## +# +# interface to the ad-user-contributions-summary.tcl system + +ns_share ad_user_contributions_summary_proc_list + +if { ![info exists ad_user_contributions_summary_proc_list] || [util_search_list_of_lists $ad_user_contributions_summary_proc_list "/bboard postings" 0] == -1 } { + lappend ad_user_contributions_summary_proc_list [list "/bboard postings" bboard_user_contributions 0] +} + +proc_doc bboard_user_contributions {db user_id purpose} {Returns list items, one for each bboard posting} { + if { $purpose == "site_admin" } { + set restriction_clause "" + } else { + set restriction_clause "\nand (bboard_topics.read_access in ('any', 'public'))\n" + } + set selection [ns_db select $db "select one_line, msg_id, posting_time, sort_key, bboard_topics.topic, presentation_type +from bboard, bboard_topics +where bboard.user_id = $user_id +and bboard.topic_id = bboard_topics.topic_id $restriction_clause +order by posting_time asc"] + + set bboard_items "" + while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { [string first "." $sort_key] == -1 } { + # there is no period in the sort key so this is the start of a thread + set thread_start_msg_id $sort_key + } else { + # strip off the stuff before the period + regexp {(.*)\..*} $sort_key match thread_start_msg_id + } + append bboard_items "
  • [util_AnsiDatetoPrettyDate $posting_time]: $one_line\n" + } + if [empty_string_p $bboard_items] { + return [list] + } else { + return [list 0 "/bboard postings" "
      \n\n$bboard_items\n\n
    "] + } +} + +# stuff added for Sharenet (urgent messages) +# modified by Branimir (bd) to comply with Henry's topic_id stuff + +proc_doc bboard_urgent_message_items {db {archived_p "f"} {show_min 0} {show_max 50000} {skip_first 0}} "Returns a string of
  • with hyperlinks to the current bboard items that are marked urgent." { + + if {$archived_p == "t"} { + set archived_qual "and sign(bboard.posting_time + [ad_parameter DaysConsideredUrgent bboard] - sysdate()) < 1" + set sort_key "posting_time desc" + } else { + set archived_qual "" + #set sort_key "urgent_sign desc, answered_p asc, posting_time desc" + set sort_key "urgent_sign desc, posting_time desc" + + } + +# (bd Nov 1999) Note to the usage of NVL function on two places below: +# I wanted to get rid of the annoying Oracle error message +# in the log file "Warning of a NULL column in an aggregate function" + + set selection [ns_db select $db "select bboard.msg_id, +bboard.one_line, sort_key, bboard.topic_id, bboard_topics.topic, bboard_topics.presentation_type, +users.email, users.first_names || ' ' || last_name as name, users.user_id, +bboard.posting_time, sign(bboard.posting_time + [ad_parameter DaysConsideredUrgent bboard] - sysdate()) as urgent_sign, +max(coalesce(bboard_new_answers_helper.posting_time, '0001-01-01')) as last_response, +sign(count(coalesce(bboard_new_answers_helper.root_msg_id,0))) as answered_p +from bboard, bboard_new_answers_helper, bboard_topics, users +where bboard.user_id = users.user_id +and bboard_new_answers_helper.root_msg_id(+) = bboard.msg_id +and bboard_topics.topic_id = bboard.topic_id +and (bboard_topics.read_access in ('any', 'public')) +and bboard.urgent_p = 't' +$archived_qual +group by bboard.msg_id, bboard.one_line, bboard.topic_id, +bboard_topics.topic, bboard_topics.presentation_type, sort_key, users.user_id, users.first_names || ' ' || last_name, email, bboard.posting_time +order by $sort_key"] + + # Siemens wants to display, at a minimum, the last 3 urgent + + set urgent_items "" + set count 0 + while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { [string first "." $sort_key] == -1 } { + # there is no period in the sort key so this is the start of a thread + set thread_start_msg_id $sort_key + } else { + # strip off the stuff before the period + regexp {(.*)\..*} $sort_key match thread_start_msg_id + } + if {$count < $show_max && ($urgent_sign == 1 || $archived_p == "t" || $count < $show_min)} { + if {$count >= $skip_first} { + append urgent_items "
  • $one_line ($name on $posting_time in $topic" + if {"$last_response" != "0001-01-01"} { + append urgent_items ", last response on $last_response" + } + append urgent_items ")\n" + } + } else { + break + } + incr count + } + return $urgent_items +} + + +proc bboard_one_line_suffix {selection subject_line_suffix} { + # subject_line_suffix is a list containig any combination of keywords: + # {name email date}. It controls what information is displayed after the + # usual one line subject. + set posting_time [ns_set get $selection posting_time] + set urgent_p [ns_set get $selection urgent_p] + set num_responses [ns_set get $selection num_responses] + set topic_id [ns_set get $selection topic_id] + set msg_id [ns_set get $selection msg_id] + # Date of last response: + set last_response [ns_set get $selection last_response] + # Author of the current message: + set poster_id [ns_set get $selection poster_id] + set name [ns_set get $selection name] + set email [ns_set get $selection email] + # The User who is viewing this: + upvar user_id user_id + set suffix "" + foreach column $subject_line_suffix { + if { $column == "name" && $name != "" } { + append suffix " by $name" + } + if { $column == "email" && $email != "" } { + append suffix " ($email)" + } + if { $column == "date" && [info exists posting_time] && $posting_time != "" } { + append suffix " ($posting_time)" + } + } + if { [ad_parameter UrgentMessageEnabledP "bboard" 0] && [info exists urgent_p] && $urgent_p == "t" } { + append suffix " urgent! " + if { $poster_id == $user_id } { + append suffix " Make unurgent " + } + } + return $suffix +} + + +# security fix (BMA, as spec'ed by aD) +ad_proc bboard_validate_msg_id { {} msg_id } { + Validates that this is a legitimate message ID. + Throws an error if invalid, returns msg_id if valid. +} { + if { ![regexp {^[0-9a-zA-Z]+$} $msg_id]} { + error "Invalid msg_id specified" + } elseif {[string length $msg_id] > 6} { + error "Message ID too long" + } + return $msg_id +} + +util_report_successful_library_load Index: web/openacs/tcl/bookmarks-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/bookmarks-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/bookmarks-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,254 @@ +# bookmarks-defs.tcl,v 3.1 2000/03/07 06:06:57 aure Exp +# bookmarks-defs.tcl +# +# by aure@arsdigita.com and dh@arsdigita.com, July 1999 +# +# procedures for the bookmarks system +# documented at /doc/bookmarks.html + +util_report_library_entry + + +proc bm_system_owner {} { + return [ad_parameter SystemOwner bm [ad_system_owner]] +} + +proc bm_footer {} { + return [ad_footer [bm_system_owner]] +} + +proc_doc bm_folder_selection {db owner_id bookmark_id } { Creates an option list of all the folders a selected object may move to - the resulting $edit_form_option" +} + +proc_doc bm_set_hidden_p {db owner_id } {This procedure insures that the 'hidden_p' column in the 'bm_list' table is consistant with the privacy of the folder structure (ie a bookmark inside a private folder or in a folder in a private folder etc is considered to be hidden_p=t) } { + + # get the bad parents + set sql_get_bad " + select bookmark_id + from bm_list + where owner_id = $owner_id + and private_p = 't'" + + set bad_parents [database_to_tcl_list $db $sql_get_bad] + set bad_parents [join $bad_parents ","] + + # this could be trouble if the bad_parents list is too long + if { ![empty_string_p $bad_parents] } { + # get all the 'bookmark_id's which should be public + set sql_get_new_public " + select bookmark_id + from bm_list + where owner_id = $owner_id + and private_p <> 't' + connect by prior bookmark_id = parent_id + and parent_id not in ($bad_parents) + start with parent_id is NULL" + + set not_hidden_list [database_to_tcl_list $db $sql_get_new_public] + + + # set _all_ 'bookmark_id's hidden_p='t' then set the 'bookmarks_id's in not_hidden_list to hidden_p='f' + ns_db dml $db " + update bm_list + set hidden_p = 't' + where owner_id = $owner_id " + foreach bookmark_id $not_hidden_list { + ns_db dml $db " + update bm_list + set hidden_p = 'f' + where bookmark_id = $bookmark_id + and owner_id = $owner_id" + } + } else { + ns_db dml $db " + update bm_list + set hidden_p = 'f' + where owner_id = $owner_id" + } +} + +proc_doc bm_set_in_closed_p {db owner_id } {This procedure insures that the 'in_closed_p' column in the 'bm_list' table is consistant with the open/closed of the folder structure (ie a bookmark inside a closed folder or in a folder in a closed folder etc is considered to be in_closed_p=t) } { + ns_db dml $db "begin transaction" + + # Set all files to be open. + ns_db dml $db "update bm_list set in_closed_p = 'f' where owner_id = $owner_id" + + # Set as in_closed_p those bookmarks which have any parent as closed. + ns_db dml $db "update bm_list set in_closed_p = 't' + where bookmark_id in (select bookmark_id from bm_list + where owner_id = $owner_id + connect by prior bookmark_id = parent_id + start with parent_id in (select bookmark_id from bm_list where owner_id = $owner_id and folder_p = 't' and closed_p = 't'))" + + ns_db dml $db "end transaction" +} + +# you need to register this (rather than using a .tcl page) +# so that people can view exported bookmarks, +# click "Save As" and be supplied with the correct filename by default + +ns_register_proc GET /bookmarks/bookmark.htm bm_export_to_netscape + +proc_doc bm_export_to_netscape {} {Outputs a set of bookmarks in the standard Netscape bookmark.htm format} { + + set user_id [ad_verify_and_get_user_id] + + # redirect some one who hasn't logged on to the server front page + if { $user_id == 0} { + ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode [ns_conn url]]" + } + set db [ns_db gethandle subquery] + + set sql_query " + select first_names||' '||last_name as name + from users + where user_id=$user_id" + set name [database_to_tcl_string $db $sql_query] + + set sql_query " + select bookmark_id, bm_list.url_id, + local_title, creation_date, parent_id + parent_id, complete_url, folder_p, + parent_sort_key||local_sort_key as sort_key + from bm_list, bm_urls + where owner_id=$user_id + and bm_list.url_id=bm_urls.url_id(+) + order by sort_key" + + set selection [ns_db select $db $sql_query] + + set folder_list 0 + + while {[ns_db getrow $db $selection]} { + set_variables_after_query + + set previous_parent_id [lindex $folder_list [expr [llength $folder_list]-1]] + + if {$parent_id!=$previous_parent_id} { + + set parent_location [lsearch -exact $folder_list $parent_id] + + if {$parent_location==-1} { + lappend folder_list $parent_id + append bookmark_html "

    \n\n" + } else { + set drop [expr [llength $folder_list]-$parent_location] + set folder_list [lrange $folder_list 0 $parent_location] + for {set i 1} {$i<$drop} {incr i} { + append bookmark_html "

    \n\n" + } + } + } + + if {$folder_p=="t"} { + append bookmark_html "

    $local_title

    \n\n" + } else { + append bookmark_html "
    $local_title\n\n" + } + + } + + set html " + + + +Bookmarks for $name + +

    Bookmarks for $name

    + + +

    + +$bookmark_html + +

    +" + + ns_db releasehandle $db + ns_return 200 text/html $html + +} + + +proc_doc bm_host_url {complete_url} {Takes a URL and returns the host portion of it (i.e., http://hostname.com/), which always contains a trailing slash. Returns empty string if complete_url wasn't parseable.} { + if { [regexp {([^:\"]+://[^/]+)} $complete_url host_url] } { + return "$host_url/" + } else { + return "" + } +} + +################################################################## +# +# interface to the ad-user-contributions-summary.tcl system + +ns_share ad_user_contributions_summary_proc_list + +if { ![info exists ad_user_contributions_summary_proc_list] || [util_search_list_of_lists $ad_user_contributions_summary_proc_list "Bookmarks" 0] == -1 } { + lappend ad_user_contributions_summary_proc_list [list "Bookmarks" bm_user_contributions 0] +} + +proc_doc bm_user_contributions {db user_id purpose} {For site admin only, returns statistics and a link to a details page} { + if { $purpose != "site_admin" } { + return [list] + } + set n_total [database_to_tcl_string $db "select count(*) as n_total +from bm_list +where owner_id = $user_id"] + if { $n_total == 0 } { + return [list] + } else { + return [list 0 "Bookmarks" "

    \n"] + } +} + +util_report_successful_library_load Index: web/openacs/tcl/bulkmail-base64.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/bulkmail-base64.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/bulkmail-base64.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,95 @@ +# Copyright 1995-8 Sun Microsystems Laboratories All rights reserved. +# Copyright 1995 Xerox Corporation All rights reserved. +# License is granted to copy, to use, and to make and to use derivative +# works for any purpose, provided that the copyright notice and this +# license notice is included in all copies and any derivatives works and +# in all related documentation. Xerox and Sun grant no other licenses +# expressed or implied and the licensee acknowledges that Xerox and Sun +# have no liability for licensee's use or for any derivative works made +# by licensee. The Xerox and Sun names shall not be used in any +# advertising or the like without their written permission. +# This software is provided AS IS. + +# XEROX CORPORATION AND SUN MICROSYSTEMS DISCLAIM AND LICENSEE +# AGREES THAT ALL WARRANTIES, EXPRESS OR IMPLIED, INCLUDING WITHOUT LIMITATION +# THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +# NOTWITHSTANDING ANY OTHER PROVISION CONTAINED HEREIN, ANY LIABILITY FOR DAMAGES +# RESULTING FROM THE SOFTWARE OR ITS USE IS EXPRESSLY DISCLAIMED, INCLUDING +# CONSEQUENTIAL OR ANY OTHER INDIRECT DAMAGES, WHETHER ARISING IN CONTRACT, TORT +# (INCLUDING NEGLIGENCE) OR STRICT LIABILITY, EVEN IF XEROX CORPORATION OR +# SUN MICROSYSTEMS IS ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. + + +# The enclosed code is derived from base64.tcl, which is part of the exmh +# distribution, covered by the copyrights and license above. + + +util_report_library_entry + +# share globals for base64 encoding, so we don't do it everytime. +ns_share bulkmail_base64 bulkmail_base64_en +set i 0 +foreach char {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z \ + a b c d e f g h i j k l m n o p q r s t u v w x y z \ + 0 1 2 3 4 5 6 7 8 9 + /} { + set bulkmail_base64($char) $i + set bulkmail_base64_en($i) $char + incr i +} + + +proc_doc bulkmail_base64_encode { string } "Encode a string in base64" { + + ns_share bulkmail_base64_en + + set result {} + set state 0 + set length 0 + foreach {c} [split $string {}] { + scan $c %c x + switch [incr state] { + 1 { append result $bulkmail_base64_en([expr {($x >>2) & 0x3F}]) } + 2 { append result $bulkmail_base64_en([expr {(($old << 4) & 0x30) | (($x >> 4) & 0xF)}]) } + 3 { append result $bulkmail_base64_en([expr {(($old << 2) & 0x3C) | (($x >> 6) & 0x3)}]) + append result $bulkmail_base64_en([expr {($x & 0x3F)}]) + set state 0} + } + set old $x + incr length + if {$length >= 72} { + append result \n + set length 0 + } + } + set x 0 + switch $state { + 0 { # OK } + 1 { append result $bulkmail_base64_en([expr {(($old << 4) & 0x30)}])== } + 2 { append result $bulkmail_base64_en([expr {(($old << 2) & 0x3C)}])= } + } + return $result +} + +proc_doc bulkmail_base64_decode { string } "Decode a base64-encoded string" { + ns_share bulkmail_base64 + + set output {} + set group 0 + set j 18 + foreach char [split $string {}] { + if [string compare $char "="] { + set bits $bulkmail_base64($char) + set group [expr {$group | ($bits << $j)}] + } + + if {[incr j -6] < 0} { + scan [format %06x $group]] %2x%2x%2x a b c + append output [format %c%c%c $a $b $c] + set group 0 + set j 18 + } + } + return $output +} + +util_report_successful_library_load \ No newline at end of file Index: web/openacs/tcl/bulkmail-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/bulkmail-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/bulkmail-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,231 @@ +# +# bulkmail-defs.tcl +# + +# by gregh@arsdigita.com in October 1999 + +util_report_library_entry + +proc bulkmail_default_mailerthreads {} { + return 50 +} + +proc bulkmail_default_smtpport {} { + # Get the default smtp port (ripped from ns_sendmail) + set smtpport [ns_config ns/parameters smtpport] + if [string match "" $smtpport] { + set smtpport 25 + } +} + +proc bulkmail_default_bulkmailhost {} { + + # Get the default smarthost (ripped from ns_sendmail) + set smtp [ns_config ns/parameters smtphost] + if [string match "" $smtp] { + set smtp [ns_config ns/parameters mailhost] + } + if [string match "" $smtp] { + set smtp localhost + } + + set smtpport [bulkmail_default_smtpport] + + return "$smtp:$smtpport" +} + +proc bulkmail_default_queue_threshold {} { + return 50 +} + +proc bulkmail_default_acceptable_message_lossage {} { + return 5 +} + +proc bulkmail_default_acceptable_host_failures {} { + return 2 +} + +proc bulkmail_default_bounce_threshold {} { + return 3 +} + +proc bulkmail_max_mailerthreads {} { + return [ad_parameter MailerThreads bulkmail [bulkmail_default_mailerthreads]] +} + +proc bulkmail_parse_host {host} { + set parsed_host [split $host ":"] + + + # If length is 1, we didn't have an attached port. Default to 25. + if { [llength $parsed_host] == 1 } { + lappend parsed_host ":" [bulkmail_default_smtpport] + } + + return $parsed_host +} + + +proc bulkmail_get_hostlist {} { + set hostlist [list] + set host_params [ad_parameter_all_values_as_list BulkmailHost bulkmail] + + if { [llength $host_params] == 0 } { + set host_params [bulkmail_default_bulkmailhost] + } + + foreach host $host_params { + lappend hostlist [bulkmail_parse_host $host] + } + + return $hostlist +} + +proc bulkmail_smtp_hostname {mailhost} { + return [lindex $mailhost 0] +} + +proc bulkmail_smtp_port {mailhost} { + return [lindex $mailhost 1] +} + +proc bulkmail_queue_threshold {} { + return [ad_parameter BulkmailQueueThreshhold bulkmail [bulkmail_default_queue_threshold]] +} + +proc bulkmail_acceptable_message_lossage {} { + return [ad_parameter BulkmailAcceptableMessageLossage bulkmail [bulkmail_default_acceptable_message_lossage]] +} + +proc bulkmail_acceptable_host_failures {} { + return [ad_parameter BulkmailAcceptableHostFailures bulkmail [bulkmail_default_acceptable_host_failures]] +} + +proc bulkmail_bounce_threshold {} { + return [ad_parameter BulkmailBounceThreshold bulkmail [bulkmail_default_bounce_threshold]] +} + +proc bulkmail_bounce_dir {} { + return [ad_parameter BulkmailBounceDir bulkmail] +# return "/web/gregh-dev/mail/bounce" +} + +proc bulkmail_message_bulkmail_id { message } { + return [lindex $message 0] +} + +proc bulkmail_message_user_id { message } { + return [lindex $message 1] +} + +proc bulkmail_message_sender { message } { + return [lindex $message 2] +} + +proc bulkmail_message_from { message } { + return [lindex $message 3] +} + +proc bulkmail_message_tolist { message } { + return [lindex $message 4] +} + +proc bulkmail_message_bcclist { message } { + return [lindex $message 5] +} + +proc bulkmail_message_body { message } { + return [lindex $message 6] +} + +proc bulkmail_reply_address { key_code } { + return "[subst [ad_parameter BulkmailReplyAddress bulkmail]]" +} + +proc bulkmail_sender_address { key_code } { + return "[subst [ad_parameter BulkmailSenderAddress bulkmail]]" +} + +if { [ad_parameter BulkmailActiveP bulkmail] == 1 } { + + # Set of all of the active instances. The key is the bulkmail_id, the + # value is the description passed to bulkmail_begin. + ns_share -init { set bulkmail_instances [ns_set create -persist bulkmail_instances] } bulkmail_instances + + # Set of the instances that have completed (bulkmail_end completed.) + # key is the bulkmail_id, and the value is the number of messages sent. + ns_share -init { set bulkmail_finished_instances [ns_set create -persist bulkmail_finished_instances] } bulkmail_finished_instances + + # This is the initial mail queue. This will be repeatedly reset as + # mailer threads are spawned to send mail. + ns_share -init { set bulkmail_message_queue [list] } bulkmail_message_queue + + # List of the hosts we can use to send mail through. + ns_share -init { set bulkmail_hosts [bulkmail_get_hostlist] } bulkmail_hosts + + # Set of bulkmail hosts that have failed. key is the hostname, value is + # the number of failures + ns_share -init { set bulkmail_failed_hosts [ns_set create -persist bulkmail_failed_hosts] } bulkmail_failed_hosts + + # The index of of bulkmail_hosts to use as the current host + ns_share -init { set bulkmail_current_host 0 } bulkmail_current_host + + # Set of mutexes used to control access to message counts on individual + # instances. + ns_share -init { set bulkmail_instance_mutexes [ns_set create -persist bulkmail_instance_mutexes] } bulkmail_instance_mutexes + + # Share the db_flush_queue + ns_share -init { set bulkmail_db_flush_queue [list] } bulkmail_db_flush_queue + + # Share the count of threads spawned + ns_share -init { set bulkmail_threads_spawned 0 } bulkmail_threads_spawned + + # Share the count of threads completed + ns_share -init { set bulkmail_threads_completed 0 } bulkmail_threads_completed + + # Share the semaphore we use to track our threadcount + ns_share -init { set bulkmail_threads_sema [ns_sema create [bulkmail_max_mailerthreads]] } bulkmail_threads_sema + + # Share the mutex we use for access to the instances ns_set + ns_share -init { set bulkmail_instances_mutex [ns_mutex create] } bulkmail_instances_mutex + + # Share the mutex used to share bulkmail_hosts + ns_share -init { set bulkmail_hosts_mutex [ns_mutex create] } bulkmail_hosts_mutex + + # Share the mutex we use for access to the instance mutexes ns_set + ns_share -init { set bulkmail_instance_mutexes_mutex [ns_mutex create] } bulkmail_instance_mutexes_mutex + + # Share the mutex we use for access to the finished instances ns_set + ns_share -init { set bulkmail_finished_instances_mutex [ns_mutex create] } bulkmail_finished_instances_mutex + + # Share the mutex we use for access to the db flush queue + ns_share -init { set bulkmail_db_flush_queue_mutex [ns_mutex create] } bulkmail_db_flush_queue_mutex + + # Share the mutex we use for access to the spawned count + ns_share -init { set bulkmail_threads_spawned_mutex [ns_mutex create] } bulkmail_threads_spawned_mutex + + # Share the mutex we use for access to the completed thread count + ns_share -init { set bulkmail_threads_completed_mutex [ns_mutex create] } bulkmail_threads_completed_mutex + + # Share the mutex we use for access to the message queue + ns_share -init { set bulkmail_message_queue_mutex [ns_mutex create] } bulkmail_message_queue_mutex + + # Share the mutex for handling the current host index + ns_share -init {set bulkmail_current_host_mutex [ns_mutex create] } bulkmail_current_host_mutex + + # the mutex for handling failed hosts + ns_share -init { set bulkmail_failed_hosts_mutex [ns_mutex create] } bulkmail_failed_hosts_mutex + + # Share the mutex and event for the db_flush_wait stuff + ns_share -init { set bulkmail_db_flush_wait_event_mutex [ns_mutex create] } bulkmail_db_flush_wait_event_mutex + + ns_share -init { set bulkmail_db_flush_wait_event [ns_event create] } bulkmail_db_flush_wait_event + + ns_share -init { set bulkmail_instance_finished_event_mutex [ns_mutex create] } bulkmail_instance_finished_event_mutex + + ns_share -init { set bulkmail_instance_finished_event [ns_event create] } bulkmail_instance_finished_event + +} + +util_report_successful_library_load Index: web/openacs/tcl/bulkmail-sendmail.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/bulkmail-sendmail.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/bulkmail-sendmail.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,286 @@ +# bulkmail_sendmail.tcl +# +# Lots hacked from sendmail.tcl +# not useful as a general purpose mailer. + +util_report_library_entry + +proc bulkmail_header_exists_p {header_name headers} { + if { [empty_string_p $headers] || ([ns_set ifind $headers $header_name] == -1) } { + return 0 + } + + return 1 +} + +proc bulkmail_smtp_send {wfp string timeout} { + if {[lindex [ns_sockselect -timeout $timeout {} $wfp {}] 1] == ""} { + error "Timeout writing to SMTP host" + } + puts $wfp $string\r + flush $wfp +} + + +proc bulkmail_smtp_recv {rfp check timeout} { + while (1) { + if {[lindex [ns_sockselect -timeout $timeout $rfp {} {}] 0] == ""} { + error "Timeout reading from SMTP host" + } + set line [gets $rfp] + set code [string range $line 0 2] + if ![string match $check $code] { + error "Expected a $check status line; got:\n$line" + } + if ![string match "-" [string range $line 3 3]] { + break; + } + } +} + +proc bulkmail_smtp_read {rfp timeout} { + while (1) { + if {[lindex [ns_sockselect -timeout $timeout $rfp {} {}] 0] == ""} { + error "Timeout reading from SMTP host" + } + set line [gets $rfp] + return $line + } +} + +proc bulkmail_smtp_open {mailhost timeout} { + set hostname [bulkmail_smtp_hostname $mailhost] + set port [bulkmail_smtp_port $mailhost] + + ## Open the connection + set sock [ns_sockopen $hostname $port] + set rfp [lindex $sock 0] + set wfp [lindex $sock 1] + + if { [catch { + bulkmail_smtp_recv $rfp 220 $timeout + bulkmail_smtp_send $wfp "HELO AOLserver [ns_info hostname]" $timeout + bulkmail_smtp_recv $rfp 250 $timeout + + } errMsg ] } { + ## Error, close and report + close $rfp + close $wfp + return -code error $errMsg + } + + return $sock +} + +proc bulkmail_smtp_close {rfp wfp {timeout 60}} { + if { [catch { + bulkmail_smtp_send $wfp QUIT $timeout + bulkmail_smtp_recv $rfp 221 $timeout + } errMsg ] } { + ## Error, close and report + close $rfp + close $wfp + return -code error $errMsg + } + + ## Close the connection + close $rfp + close $wfp +} + +proc bulkmail_smtp_reset {rfp wfp {timeout 60}} { + if { [catch { + bulkmail_smtp_send $wfp RSET $timeout + bulkmail_smtp_recv $rfp 250 $timeout + } errMsg ] } { + ## Error, close and report + close $rfp + close $wfp + return -code error $errMsg + } + +} + +proc bulkmail_build_message { bulkmail_id user_id sender from to subject body {headers {}} {bcc {}}} { + + ## Takes comma-separated values in the "to" parm + ## Multiple To and BCC addresses are handled appropriately. + ## Original ns_sendmail functionality is preserved. + + ## Cut out carriage returns + regsub -all "\n" $to "" to + regsub -all "\r" $to "" to + regsub -all "\n" $bcc "" bcc + regsub -all "\r" $bcc "" bcc + + ## Split to into a proper list + set tolist_in [split $to ","] + set bcclist_in [split $bcc ","] + + ## Extract "from" email address + if [regexp {.*<(.*)>} $from ig address] { + set from $address + } + + set tolist [list] + foreach toaddr $tolist_in { + if [regexp {.*<(.*)>} $toaddr ig address] { + set toaddr $address + } + lappend tolist "[string trim $toaddr]" + } + + set bcclist [list] + if ![string match "" $bcclist_in] { + foreach bccaddr $bcclist_in { + if [regexp {.*<(.*)>} $bccaddr ig address] { + set bccaddr $address + } + lappend bcclist "[string trim $bccaddr]" + } + } + + ## Put the tolist in the headers + set rfcto [join $tolist ", "] + + + set msg "" + + if [empty_string_p $headers] { + set headers [ns_set create] + } + + if ![bulkmail_header_exists_p "From" $headers] { + ns_set put $headers "From" $from + } + + if ![bulkmail_header_exists_p "To" $headers] { + ns_set put $headers "To" $to + } + + if ![bulkmail_header_exists_p "Subject" $headers] { + ns_set put $headers "Subject" $subject + } + + if ![bulkmail_header_exists_p "Date" $headers] { + ns_set put $headers "Date" [ns_httptime [ns_time]] + } + + ## Insert headers + if ![string match "" $headers] { + set size [ns_set size $headers] + for {set i 0} {$i < $size} {incr i} { + append msg "[ns_set key $headers $i]: [ns_set value $headers $i]\n" + } + } + + + append msg "\n$body" + + + ## Terminate body with a solitary period + foreach line [split $msg "\n"] { + regsub {^[.]} $line ".." quoted_line + append data $quoted_line + append data "\r\n" + } + append data . + + return [list $bulkmail_id $user_id $sender $from $tolist $bcclist $data] +} + +proc bulkmail_sendmail { messages mailhost } { + + ns_share bulkmail_threads_sema + + set timeout [ns_config ns/parameters smtptimeout] + if [string match "" $timeout] { + set timeout 60 + } + + bulkmail_reset_hosts_if_needed + + if { [catch { + set sock [bulkmail_smtp_open $mailhost $timeout] + } errMsg ] } { + bulkmail_record_failed_host $mailhost + ns_sema release $bulkmail_threads_sema + + # We're going to need to try again + ns_thread begindetached "bulkmail_sendmail {$messages} {[bulkmail_get_current_host]}" + return + } + set rfp [lindex $sock 0] + set wfp [lindex $sock 1] + + set flush_queue [list] + set counter 0 + foreach message $messages { + set bulkmail_id [bulkmail_message_bulkmail_id $message] + set user_id [bulkmail_message_user_id $message] + set sender [bulkmail_message_sender $message] + set from [bulkmail_message_from $message] + set tolist [bulkmail_message_tolist $message] + set bcclist [bulkmail_message_bcclist $message] + set body [bulkmail_message_body $message] + + + _bulkmail_sendmail $rfp $wfp $timeout $tolist $bcclist $sender $body + lappend flush_queue [list $bulkmail_id $user_id [bulkmail_ansi_current_time]] +# bulkmail_record_sent_message $bulkmail_id $user_id [bulkmail_ansi_current_time] + if { [llength $flush_queue] >= [bulkmail_acceptable_message_lossage] } { + bulkmail_record_sent_messages $flush_queue + set flush_queue [list] + } + + bulkmail_smtp_reset $rfp $wfp $timeout + } + + if { [llength $flush_queue] > 0 } { + bulkmail_record_sent_messages $flush_queue + } + + bulkmail_smtp_close $rfp $wfp $timeout + ns_sema release $bulkmail_threads_sema + bulkmail_decrement_threadcount + ns_log Notice "Threads active: [bulkmail_current_threadcount]" +} + + +proc _bulkmail_sendmail {rfp wfp timeout tolist bcclist \ + sender data } { + + + + ## Perform the SMTP conversation + if { [catch { + bulkmail_smtp_send $wfp "MAIL FROM:<$sender>" $timeout + bulkmail_smtp_recv $rfp 250 $timeout + + ## Loop through To list via multiple RCPT TO lines + foreach toto $tolist { + bulkmail_smtp_send $wfp "RCPT TO:<$toto>" $timeout + bulkmail_smtp_recv $rfp 250 $timeout + } + + ## Loop through BCC list via multiple RCPT TO lines + ## A BCC should never, ever appear in the header. Ever. Not even. + foreach bccto $bcclist { + bulkmail_smtp_send $wfp "RCPT TO:<$bccto>" $timeout + bulkmail_smtp_recv $rfp 250 $timeout + } + + bulkmail_smtp_send $wfp DATA $timeout + bulkmail_smtp_recv $rfp 354 $timeout + bulkmail_smtp_send $wfp $data $timeout + bulkmail_smtp_recv $rfp 250 $timeout + } errMsg ] } { + ## Error, close and report + close $rfp + close $wfp + return -code error $errMsg + } + +} + +util_report_successful_library_load Index: web/openacs/tcl/bulkmail-utils.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/bulkmail-utils.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/bulkmail-utils.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,671 @@ +util_report_library_entry + +proc_doc bulkmail_simple_checksum { string } "Computes a trivial checksum for a string. The checksum is the sum of the ascii values for each character of the string. + +Note that we're not trying to bolt things down. We're trying to keep the lazy,malicious attacker at bay. Someone who really wanted to come after us would figure out anything we could reasonably do here." { + + set string_chars [split $string {}] + + set total 0 + foreach char $string_chars { + scan $char "%c" value + incr total $value + } + return $total +} + +proc_doc bulkmail_key_code { bulkmail_id user_id } "Creates a bulkmail key code, which is of the format ABC" { + append output $bulkmail_id "A" $user_id "B" [ns_time] + + # For good measure, we'll calculate the checksum after making the letters + # lowercase. This could confuse the stupid attacker who's trying to + # figure out what that number is. Not much else. We have to be sure + # to do this when decoding, too. + append output "C" [bulkmail_simple_checksum [string tolower $output]] + + return $output +} + +proc_doc bulkmail_decode_key_code { key_code } "Given a key code, returns a list of the user_id and bulkmail_id. Returns an empty list of there was an error." { + set code_pieces [split $key_code "C"] + + if { [llength $code_pieces] == 0 } { + return [list] + } + + # First piece is the bulkmail_idAuser_idBns_time + set user_content [lindex $code_pieces 0] + + # Second piece is the simple checksum + set checksum [lindex $code_pieces 1] + + + # Compare the checksum to the checksum of the user_content. Be careful + # to lower the string case. + if { [bulkmail_simple_checksum [string tolower $user_content]] != $checksum } { + return [list] + } + + if { ![regexp -nocase {([0-9]+)A([0-9]+)B([0-9]+)} $user_content match bulkmail_id user_id time] } { + return [list] + } + + return "$bulkmail_id $user_id $time" +} + +proc_doc bulkmail_ansi_current_time {} "Returns the current server time in ANSI format" { + return [ns_fmttime [ns_time] "%Y-%m-%d %T"] +} + +proc_doc bulkmail_begin { db user_id { description "" } } "Initializes a new bulkmail instance. Returns a bulkmail_id." { + ns_share bulkmail_instances_mutex + ns_share bulkmail_instance_mutexes_mutex + ns_share bulkmail_instances + ns_share bulkmail_instance_mutexes + + ns_mutex lock $bulkmail_instances_mutex + if { [catch { + set bulkmail_id [database_to_tcl_string $db "select bulkmail_id_sequence.nextval from dual"] + ns_db dml $db "insert into bulkmail_instances (bulkmail_id, creation_date, creation_user, description) values ($bulkmail_id, sysdate, $user_id, '[DoubleApos $description]')" + + ns_set put $bulkmail_instances $bulkmail_id [list 0 0] + } errmsg] } { + ns_log Notice "Error creating bulkmail instance: $errmsg" + } + ns_mutex unlock $bulkmail_instances_mutex + + ns_mutex lock $bulkmail_instance_mutexes_mutex + if { [catch { + ns_set put $bulkmail_instance_mutexes $bulkmail_id [ns_mutex create] + } errmsg] } { + ns_log Error "Error creating instance mutex: $errmsg\n" + } + ns_mutex unlock $bulkmail_instance_mutexes_mutex + + return $bulkmail_id +} + +proc_doc bulkmail_end { db bulkmail_id } "Finalizes the info regarding the instance in bulkmail_instances" { + ns_share bulkmail_db_flush_wait_event_mutex + ns_share bulkmail_db_flush_wait_event + ns_share bulkmail_instances_mutex + ns_share bulkmail_instances + ns_share bulkmail_finished_instances_mutex + ns_share bulkmail_finished_instances + ns_share bulkmail_instance_finished_event_mutex + ns_share bulkmail_instance_finished_event + ns_share bulkmail_message_queue_mutex + + # Spit out any lingering messages in the message queue. If we have + # anything still queued up, this will start them sending + ns_mutex lock $bulkmail_message_queue_mutex + catch { + bulkmail_process_message_queue + } + ns_mutex unlock $bulkmail_message_queue_mutex + + # Wait until all of our messages have been sent. + while (1) { + # a bulkmail_instance_finished_event is triggered when all of an + # instance's queued messages have been sent. Let's wait 10 seconds + # on the event. If it times out, we'll check to see if our instance + # is finished, in case we missed the event (Thanks, Henry!) + ns_event wait $bulkmail_instance_finished_event $bulkmail_instance_finished_event_mutex 10 + + # Check to see if the instance we're waiting on is one that finished. + ns_mutex lock $bulkmail_finished_instances_mutex + if { [catch { + set n_sent [ns_set get $bulkmail_finished_instances $bulkmail_id] + } errmsg] } { + ns_log Error "Error getting n_sent: $errmsg\n" + } + ns_log Notice "bulkmail_id: $bulkmail_id, n_sent: $n_sent\n" + ns_mutex unlock $bulkmail_finished_instances_mutex + + # It was us, so let's finish up + if ![empty_string_p $n_sent] { + # Remove this instance from the list of finished instances + ns_mutex lock $bulkmail_finished_instances_mutex + catch { + ns_set delkey $bulkmail_finished_instances $bulkmail_id + } + ns_mutex unlock $bulkmail_finished_instances_mutex + + # We want to wait until the db_flush_wait proc is done flushing + # (the mutex for the wait event is unlocked) before we try + # telling it to flush. We'll do this by trying to lock the + # mutex. + ns_mutex lock $bulkmail_db_flush_wait_event_mutex + ns_mutex unlock $bulkmail_db_flush_wait_event_mutex + + # Now trigger it. + ns_event set $bulkmail_db_flush_wait_event + + # Remove this instance from bulkmail_instances + # This is placed far down, because it's called in + # bulkmail_db_flush_wait (so we need to make sure we don't + # call it until all our guys have made it.) + ns_mutex lock $bulkmail_instances_mutex + catch { + ns_set delkey $bulkmail_instances $bulkmail_id + } + ns_mutex unlock $bulkmail_instances_mutex + + # Wahoo! We're all clear kid! + break + } + } + + # Once everything is done, let's finalize the data + # It should have already been done by the db_flush proc, but just in + # case, let's set it here. + ns_db dml $db "update bulkmail_instances set end_date = sysdate where bulkmail_id = $bulkmail_id" + +} + +proc_doc bulkmail_register_thread { thread_id } "Register a thread in the thread_queue" { + ns_share bulkmail_thread_queue_mutex + ns_share bulkmail_thread_queue + + ns_mutex lock $bulkmail_thread_queue_mutex + + catch { + lappend bulkmail_thread_queue $thread_id + } + + ns_mutex unlock $bulkmail_thread_queue_mutex +} + +proc_doc bulkmail_queue_message { message } "Handle the queuing of a message" { + ns_share bulkmail_message_queue_mutex + ns_share bulkmail_message_queue + ns_share bulkmail_threads_sema + + ns_mutex lock $bulkmail_message_queue_mutex + + # Following the example in the docs, let's wrap all activities in + # a catch so an error won't leave things locked + if { [catch { + lappend bulkmail_message_queue $message + + # Check to see if we've reached our threshold + if { [llength $bulkmail_message_queue] >= [bulkmail_queue_threshold] } { + # If we have, we want to process the queue + bulkmail_process_message_queue + + } + } errmsg] } { + ns_log Notice "Caught error: $errmsg" + } + ns_mutex unlock $bulkmail_message_queue_mutex + + bulkmail_record_queued_message [bulkmail_message_bulkmail_id $message] + +} + +# Danger lurks here. +# This is for INTERNAL use only. The call to this proc must be done +# only with a valid lock on bulkmail_message_queue_mutex +# This spawns a new mailer thread to go pound a server +proc bulkmail_process_message_queue {} { + ns_share bulkmail_threads_sema + ns_share bulkmail_message_queue + + # Wait for a thread to become available + ns_sema wait $bulkmail_threads_sema + + # Spawn a thread to go send these messages + ns_thread begindetached "bulkmail_sendmail {$bulkmail_message_queue} {[bulkmail_get_current_host]}" + set bulkmail_message_queue [list] + + bulkmail_increment_threadcount +} + +proc_doc bulkmail_send {bulkmail_id user_id to from subject body {key_code ""} {extraheaders {}} {bcc {}}} "Add a message to the bulkmail queue" { + + if [empty_string_p $extraheaders] { + set extraheaders [ns_set create extraheaders] + } + + # We want to make it possible for a custom key_code to be used + if [empty_string_p $key_code] { + set key_code [bulkmail_key_code $bulkmail_id $user_id] + } + + # We want to build our own reply-to + ns_set idelkey $extraheaders "reply-to" + set reply [bulkmail_reply_address $key_code] + ns_set put $extraheaders "Reply-To" $reply + + # We also need to get the envelope sender + set sender [bulkmail_sender_address $key_code] + + set message [bulkmail_build_message $bulkmail_id $user_id $sender $from $to $subject $body $extraheaders $bcc] + + bulkmail_queue_message $message +} + +proc_doc bulkmail_record_sent_message { bulkmail_id user_id sent_date } "Record a sent message in the db_flush_queue and in the instance counts" { + ns_share bulkmail_db_flush_queue_mutex + ns_share bulkmail_db_flush_queue + ns_share bulkmail_db_flush_wait_event + ns_share bulkmail_instance_mutexes + ns_share bulkmail_instances_mutex + ns_share bulkmail_instances + ns_share bulkmail_finished_instances_mutex + ns_share bulkmail_finished_instances + ns_share bulkmail_instance_finished_event + + ns_mutex lock $bulkmail_db_flush_queue_mutex + catch { + lappend bulkmail_db_flush_queue [list $bulkmail_id $user_id $sent_date] + } + ns_mutex unlock $bulkmail_db_flush_queue_mutex + + # tell the waiting thread that it's time to do its thing + ns_event set $bulkmail_db_flush_wait_event + + # Next, let's take care of registering this in our instance message count + set instance_mutex [ns_set get $bulkmail_instance_mutexes $bulkmail_id] + + ns_mutex lock $instance_mutex + catch { + ns_mutex lock $bulkmail_instances_mutex + catch { + set instance_stats [ns_set get $bulkmail_instances $bulkmail_id] + } + ns_mutex unlock $bulkmail_instances_mutex + + # instance_stats is a two-item list: queued sent + set queued_count [lindex $instance_stats 0] + set sent_count [lindex $instance_stats 1] + incr sent_count + ns_mutex lock $bulkmail_instances_mutex + catch { + ns_set delkey $bulkmail_instances $bulkmail_id + ns_set put $bulkmail_instances $bulkmail_id [list $queued_count $sent_count] + } + ns_mutex unlock $bulkmail_instances_mutex + } + ns_mutex unlock $instance_mutex + + if { $queued_count == $sent_count } { + ns_mutex lock $bulkmail_finished_instances_mutex + catch { + ns_set put $bulkmail_finished_instances $bulkmail_id $sent_count + } + ns_mutex unlock $bulkmail_finished_instances_mutex + ns_event set $bulkmail_instance_finished_event + } +} + +proc_doc bulkmail_record_sent_messages { sent_messages } "Record sent messages in the db_flush_queue and in the instance counts" { + ns_share bulkmail_db_flush_queue_mutex + ns_share bulkmail_db_flush_queue + ns_share bulkmail_db_flush_wait_event + ns_share bulkmail_instance_mutexes + ns_share bulkmail_instances_mutex + ns_share bulkmail_instances + ns_share bulkmail_finished_instances_mutex + ns_share bulkmail_finished_instances + ns_share bulkmail_instance_finished_event + + ns_mutex lock $bulkmail_db_flush_queue_mutex + catch { + lappend bulkmail_db_flush_queue $sent_messages + } + ns_mutex unlock $bulkmail_db_flush_queue_mutex + + # tell the waiting thread that it's time to do its thing + ns_event set $bulkmail_db_flush_wait_event + + # Next, let's take care of registering this in our instance message count + + foreach message $sent_messages { + set bulkmail_id [lindex $message 0] + set instance_mutex [ns_set get $bulkmail_instance_mutexes $bulkmail_id] + + ns_mutex lock $instance_mutex + catch { + ns_mutex lock $bulkmail_instances_mutex + catch { + set instance_stats [ns_set get $bulkmail_instances $bulkmail_id] + } + ns_mutex unlock $bulkmail_instances_mutex + + # instance_stats is a two-item list: queued sent + set queued_count [lindex $instance_stats 0] + set sent_count [lindex $instance_stats 1] + incr sent_count + ns_mutex lock $bulkmail_instances_mutex + catch { + ns_set delkey $bulkmail_instances $bulkmail_id + ns_set put $bulkmail_instances $bulkmail_id [list $queued_count $sent_count] + } + ns_mutex unlock $bulkmail_instances_mutex + } + ns_mutex unlock $instance_mutex + + if { $queued_count == $sent_count } { + ns_mutex lock $bulkmail_finished_instances_mutex + catch { + ns_set put $bulkmail_finished_instances $bulkmail_id $sent_count + } + ns_mutex unlock $bulkmail_finished_instances_mutex + ns_event set $bulkmail_instance_finished_event + } + } +} + +proc_doc bulkmail_record_queued_message { bulkmail_id } "Record a queued message in the instance message count" { + ns_share bulkmail_instance_mutexes + ns_share bulkmail_instances_mutex + ns_share bulkmail_instances + + set instance_mutex [ns_set get $bulkmail_instance_mutexes $bulkmail_id] + + ns_mutex lock $instance_mutex + catch { + ns_mutex lock $bulkmail_instances_mutex + catch { + set instance_stats [ns_set get $bulkmail_instances $bulkmail_id] + } + ns_mutex unlock $bulkmail_instances_mutex + + # instance_stats is a two-item list: queued sent + set queued_count [lindex $instance_stats 0] + set sent_count [lindex $instance_stats 1] + incr queued_count + ns_mutex lock $bulkmail_instances_mutex + catch { + ns_set delkey $bulkmail_instances $bulkmail_id + ns_set put $bulkmail_instances $bulkmail_id [list $queued_count $sent_count] + } + ns_mutex unlock $bulkmail_instances_mutex + } + ns_mutex unlock $instance_mutex + +} + +proc_doc bulkmail_increment_threadcount {} "Increment the number of in-use threads. This is actually a different variable than the completed threads variable, so that we won't block." { + + ns_share bulkmail_threads_spawned_mutex + ns_share bulkmail_threads_spawned + + ns_mutex lock $bulkmail_threads_spawned_mutex + catch { + incr bulkmail_threads_spawned + } + ns_mutex unlock $bulkmail_threads_spawned_mutex +} + +proc_doc bulkmail_decrement_threadcount {} "Decrement the count of in-use threads. Used only for reporting matters. We've already allowed a new thread to begin. In actuality, we're incrementing the number completed, which will prevent us from blocking on a single shared value for the count. It also allows us better reporting capabilities." { + + ns_share bulkmail_threads_completed_mutex + ns_share bulkmail_threads_completed + + ns_mutex lock $bulkmail_threads_completed_mutex + catch { + incr bulkmail_threads_completed + } + ns_mutex unlock $bulkmail_threads_completed_mutex +} + +proc_doc bulkmail_current_threadcount {} "Return the number of mailer threads current active. This is the difference between bulkmail_threads_spawned and bulkmail_threads_completed." { + ns_share bulkmail_threads_completed + ns_share bulkmail_threads_spawned + + return [expr $bulkmail_threads_spawned - $bulkmail_threads_completed] +} + +proc_doc bulkmail_db_flush_wait {} "Run forever, waiting to flush message info to the db" { + ns_share bulkmail_db_flush_wait_event + ns_share bulkmail_db_flush_wait_event_mutex + ns_share bulkmail_db_flush_queue + ns_share bulkmail_db_flush_queue_mutex + ns_share bulkmail_instances_mutex + ns_share bulkmail_instances + + # Loop forever, waiting for events requesting the flush of the queue. + # TODO: probably want to have something trigger this to stop. Maybe + # put a timeout on the wait, and have a check of a shared variable. + while (1) { + if { [catch { + + # 2 second timeout + ns_event wait $bulkmail_db_flush_wait_event $bulkmail_db_flush_wait_event_mutex 2 + + ns_mutex lock $bulkmail_db_flush_queue_mutex + catch { + set flush_queue $bulkmail_db_flush_queue + set bulkmail_db_flush_queue [list] + } + ns_mutex unlock $bulkmail_db_flush_queue_mutex + + if { [llength $flush_queue] > 0 } { + set db [ns_db gethandle] + ns_db dml $db "begin transaction" + foreach flushed_messages $flush_queue { + foreach flush_entry $flushed_messages { + set bulkmail_id [lindex $flush_entry 0] + set user_id [lindex $flush_entry 1] + set sent_date [lindex $flush_entry 2] + ns_db dml $db "insert into bulkmail_log (bulkmail_id, user_id, sent_date) values ($bulkmail_id, $user_id, to_date('$sent_date', 'YYYY-MM-DD HH24:MI:SS'))" + + } + + # Even though we're only reading, others may be writing or deleting + # our entry for update. So, we need to lock this. + ns_mutex lock $bulkmail_instances_mutex + catch { + set instance_stats [ns_set get $bulkmail_instances $bulkmail_id] + # instance_stats is a two-item list: queued sent + set queued_count [lindex $instance_stats 0] + set sent_count [lindex $instance_stats 1] + } + ns_mutex unlock $bulkmail_instances_mutex + + # We need to check if sent_count is empty. This might occur + # if bulkmail_end finished up before db_flush_wait. + if ![empty_string_p $sent_count] { + ns_db dml $db "update bulkmail_instances set n_sent = $sent_count where bulkmail_id = $bulkmail_id" + } + + } + ns_db dml $db "end transaction" + ns_db releasehandle $db + } + + + } errmsg] } { + ns_log Notice "Caught error: $errmsg in bulkmail_db_flush_wait" + if { [info exists db] && ![empty_string_p $db] && [ns_db connected $db]} { + ns_db releasehandle $db + } + + } + # Unlock the event's mutex + ns_mutex unlock $bulkmail_db_flush_wait_event_mutex + } +} + + + +proc_doc bulkmail_get_current_host {} "Retrieves the smtp host to use and increments the index." { + ns_share bulkmail_hosts_mutex + ns_share bulkmail_hosts + ns_share bulkmail_current_host_mutex + ns_share bulkmail_current_host + + ns_mutex lock $bulkmail_hosts_mutex + catch { + set current_host [lindex $bulkmail_hosts $bulkmail_current_host] + if {[llength $bulkmail_hosts] == 0} { + ns_log Error "bulkmail_get_current_host: bulkmail_hosts is an empty list" + spam_set_email_sending_p 0 + } + } + + ns_mutex unlock $bulkmail_hosts_mutex + + ns_mutex lock $bulkmail_current_host_mutex + catch { + incr bulkmail_current_host + if { $bulkmail_current_host >= [llength $bulkmail_hosts] } { + set bulkmail_current_host 0 + } + } + ns_mutex unlock $bulkmail_current_host_mutex + + return $current_host +} + +# A quick hack to reset the hosts list if it is empty from too many failures -- hqm +# This is probably the wrong place to put this code, we need +# to better review where the loop is happening. +proc_doc bulkmail_reset_hosts_if_needed {} {Hack to reset bulkmail hosts if list is empty} { + ns_share bulkmail_failed_hosts_mutex + ns_share bulkmail_failed_hosts + ns_share bulkmail_hosts_mutex + ns_share bulkmail_hosts + ns_share bulkmail_current_host + + if {[llength $bulkmail_hosts] == 0} { + ns_log Error "bulkmail_reset_hosts_if_needed: bulkmail_hosts is an empty list! Resetting host and failed_hosts list and sleeping 10 mins" + + catch { + ns_mutex lock $bulkmail_hosts_mutex + set bulkmail_hosts [bulkmail_get_hostlist] + } + ns_mutex unlock $bulkmail_hosts_mutex + + catch { + ns_mutex lock $bulkmail_failed_hosts_mutex + set bulkmail_failed_hosts [ns_set create -persist bulkmail_failed_hosts] + } + ns_mutex unlock $bulkmail_failed_hosts_mutex + + set bulkmail_current_host 0 + ns_sleep 600 + } +} + +proc_doc bulkmail_record_failed_host { host } "Records a host as failed. If host has reached the acceptable failures threshhold, we delete it from the list of hosts." { + ns_share bulkmail_failed_hosts_mutex + ns_share bulkmail_failed_hosts + ns_share bulkmail_hosts_mutex + ns_share bulkmail_hosts + ns_share bulkmail_current_host + + ns_log Notice "Processing failed host: $host" + bulkmail_reset_hosts_if_needed + + ns_mutex lock $bulkmail_failed_hosts_mutex + catch { + set n_failures [ns_set get $bulkmail_failed_hosts $host] + if { [empty_string_p $n_failures] } { + set n_failures 0 + } + incr n_failures + ns_set delkey $bulkmail_failed_hosts $host + ns_set put $bulkmail_failed_hosts $host $n_failures + } + ns_mutex unlock $bulkmail_failed_hosts_mutex + + if { $n_failures > [bulkmail_acceptable_host_failures] } { + ns_mutex lock $bulkmail_hosts_mutex + catch { + set list_index [lsearch -exact $bulkmail_hosts $host] + + # Check to see if we found this host (the index >= 0) + if { $list_index >= 0 } { + set bulkmail_hosts [lreplace $bulkmail_hosts $list_index $list_index] + } + } + ns_mutex unlock $bulkmail_hosts_mutex + ns_log Notice "Removed failed host: $host" + } +} + +proc_doc bulkmail_sweep_bounce_queue {} "Sweeps the bounce queue, handling bounced messages." { + + ns_log Notice "Sweeping bounce queue" + + set threshold [bulkmail_bounce_threshold] + set bounce_dir [bulkmail_bounce_dir] + set file_pattern "$bounce_dir/*" + + ns_log Notice "$bounce_dir\n$file_pattern" + + set db [ns_db gethandle] + + set n_bounces 0 + foreach file [glob -nocomplain $file_pattern] { + ns_log Notice "Current file: $file" + # file_name is file - bounce_dir + a slash (consumed by the zero-index) + set file_name [string range $file [expr [string length $bounce_dir] + 1] end] + set key_code [string toupper [lindex [split $file_name "@"] 0]] + + ns_log Notice "key_code: $key_code" + set details [bulkmail_decode_key_code $key_code] + + ns_log Notice "file_name: $file_name\nDetails: $details" + + # See if we have garbage + if { [llength $details] < 3 } { + # We can trash this file; it shouldn't be here + ns_unlink -nocomplain $file + continue + } + + set bulkmail_id [lindex $details 0] + set user_id [lindex $details 1] + if {[catch { + ns_db dml $db "insert into bulkmail_bounces (bulkmail_id, user_id) values ($bulkmail_id, $user_id)" + } errmsg] } { + ns_log Notice "Error on bulkmail_bounce insert. key_code: $key_code\ndetails: $details\n$errmsg" + } else { + ns_unlink -nocomplain "$file" + incr n_bounces + + } + } + + if { $n_bounces > 0 } { + set rows_affected [ns_ora exec_plsql $db "declare + counter number; + uid number; + cursor BOUNCING_IDS is + select user_id from bulkmail_bounces where active_p = 't' group by user_id having count(user_id) > 2 ; + one_row BOUNCING_IDS%ROWTYPE; + begin + --:counter := counter; + counter := 0; + for one_row in BOUNCING_IDS + loop + uid := one_row.user_id; + update users set email_bouncing_p = 't' where user_id = uid; + update bulkmail_bounces set active_p = 'f' where user_id = uid; + commit; + counter := counter + 1; + end loop; + :counter := counter; + end; + "] + ns_log Notice "bulkmail bounce sweeper found $rows_affected bouncing ids." + } + + ns_db releasehandle $db + ns_log Notice "Done sweeping bounce queue" +} + + +if { [ad_parameter BulkmailActiveP bulkmail 0] == 1 } { + + # start up the db_flush_wait proc + ns_thread begindetached "bulkmail_db_flush_wait" + ns_schedule_daily -thread 3 30 bulkmail_sweep_bounce_queue + +} + +util_report_successful_library_load Index: web/openacs/tcl/calendar-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/calendar-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/calendar-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,107 @@ +# calendar-defs.tcl,v 3.0 2000/02/06 03:13:01 ron Exp +# calendar-defs.tcl +# +# by philg@mit.edu late 1998 +# +# for the /calendar system documented at /doc/calendar.html + +proc calendar_system_owner {} { + return [ad_parameter SystemOwner calendar [ad_system_owner]] +} + +proc calendar_footer {} { + return [ad_footer [calendar_system_owner]] +} + + +################################################################## +# +# interface to the ad-user-contributions-summary.tcl system + +ns_share ad_user_contributions_summary_proc_list + +if { ![info exists ad_user_contributions_summary_proc_list] || [util_search_list_of_lists $ad_user_contributions_summary_proc_list "/calendar postings" 0] == -1 } { + lappend ad_user_contributions_summary_proc_list [list "Calendar Postings" calendar_user_contributions 0] +} + +proc_doc calendar_user_contributions {db user_id purpose} {Returns list items, one for each calendar posting} { + if { $purpose == "site_admin" } { + set restriction_clause "" + } else { + set restriction_clause "\nand c.approved_p = 't'" + } + set db_sub [ns_db gethandle subquery] + + set selection [ns_db select $db " + select c.calendar_id, c.title, c.approved_p, c.start_date, cc.scope, cc.group_id, user_group_name_from_id(cc.group_id) as group_name, user_group_short_name_from_id(cc.group_id) as short_name, + case when cc.scope = 'public' then 1 + when cc.scope = 'group' then 2 + when cc.scope = 'user' then 3 + else 4 end as scope_ordering + from calendar c, calendar_categories cc + where c.creation_user = $user_id $restriction_clause + and c.category_id= cc.category_id + order by scope_ordering, cc.group_id, c.start_date"] + + set items "" + set last_group_id "" + set item_counter 0 + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + switch $scope { + public { + if { $item_counter==0 } { + append items "

    Public Calendar Postings

    " + set root_url "/calendar" + set admin_root_url "/calendar/admin" + } + } + group { + if { $last_group_id!=$group_id } { + append items "

    $group_name Calendar Postings

    " + + set sub_selection [ns_db 0or1row $db_sub " + select section_key + from content_sections + where scope='group' and group_id=$group_id + and module_key='calendar'"] + + if { [empty_string_p $selection] } { + set root_url "/calendar" + set admin_root_url "/calendar/admin" + } else { + set_variables_after_subquery + set root_url "[ug_url]/[ad_urlencode $short_name]/[ad_urlencode $section_key]" + set admin_root_url "[ug_admin_url]/[ad_urlencode $short_name]/[ad_urlencode $section_key]" + + } + } + } + } + + if { $purpose == "site_admin" } { + append items "
  • [util_AnsiDatetoPrettyDate $start_date]: $title\n" + if { $approved_p == "f" } { + append items "  not approved" + } + } else { + append items "
  • [util_AnsiDatetoPrettyDate $start_date]: $title\n" + } + + set last_group_id $group_id + incr item_counter + } + + ns_db releasehandle $db_sub + + if [empty_string_p $items] { + return [list] + } else { + return [list 0 "Calendar Postings" "
      \n\n$items\n\n
    "] + } +} + + + + Index: web/openacs/tcl/cassandracle-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/cassandracle-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/cassandracle-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,158 @@ +# cassandracle-defs.tcl,v 3.1 2000/02/20 10:27:06 ron Exp + +proc cassandracle_header { page_title } { + return [ad_header $page_title] +} + +proc cassandracle_footer {} { + return [ad_footer] +} + +proc cassandracle_format_data_type_column {column_data} { + + # the column_data argument must be a Tcl list + # whose elements are the data_type, data_scale, data_precision, + # and data_length values as obtained from Oracle's data + # dictionary view DBA_TAB_COLUMNS + + # create a list of column names + set column_names [list data_type data_scale data_precision data_length] + + # create a variable for each member of the list and + # set its value to the corresponding data dictionary value + set i 0 + foreach column_name $column_names { + set $column_name [lindex $column_data $i] + incr i + } + + # the default is to return only the data_type value + # (ignoring scale, precision, etc.). But for some + # datatypes, we do additional procesing of length, + # scale, or precision + # + # I do various nested ifs, each of which + # returns a formatted data string + + + # NUMBER --------------------------------------------- + + if {$data_type=="NUMBER"} { + + # if there is no data_scale, + # then must be a float + if {$data_scale==""} { + return "NUMBER" + } + + # all integers have data_scale of zero + if {$data_scale=="0"} { + + # normal integers have no value for + # precision, so we should not confuse + # the user with precision + if {$data_precision==""} { + return "INTEGER" + } + + # but we should return the precision + # for non-standard integers which have it + if {!$data_precision==""} { + return "NUMBER($data_precision)" + } + + } + + # not an integer, and not a float, + # so return precision and scale + + return "NUMBER(${data_precision},${data_scale})" + + } + + # character types ----------------------------------------- + # + # Native Oracle includes the just first four, but the reamining are + # suported via mapping. We just export what is in dba_tab_columns + # along with the length, after a regular expression check for CHAR + # + # CHAR + # NCHAR + # NVARCHAR2 + # VARCHAR2 + # -------- + # VARCHAR + # CHARACTER + # CHARACTER VARYING + # CHAR VARYING + # NATIONAL CHARACTER + # NATIONAL CHAR + # NATIONAL CHARACTER VARYING + # NATIONAL CHAR VARYING + # NCHAR VARYING + # LONG VARCHAR + + + if {[regexp "CHAR" $data_type]} { + # trying to keep Tcl from thinking I have an array + set ret_val "$data_type" + append ret_val "(" + append ret_val $data_length + append ret_val ")" + return $ret_val + } + + + # ------------------------------------------------- + # not a NUMBER, nor *CHAR*, so we just return datatype + # this misses the following ANSI and DB2 types that + # could probably use precision and scale output + # + # NUMERIC(p,s) + # DECIMAL(p,s) + # FLOAT(b) + + + return $data_type +} + + + + +proc book_link_to_amazon {isbn {click_ref "photonetA"}} { + return "http://www.amazon.com/exec/obidos/ISBN=${isbn}/${click_ref}/ " +} + +proc annotated_archive_reference {page_number} { + return "
    Source: +Oracle SQL & PL/SQL Annotated Archives +by Kevin Loney and Rachel Carmichael, page $page_number. + +
    +" +} + + +proc db_query_to_vars {db query {name_prefix ""} args} { + set selection [ns_db 0or1row $db $query] + if {$selection==""} { + return + } + set i 0 + set limit [ns_set size $selection] + while {$i<$limit} { + set command "set ${name_prefix}[ns_set key $selection $i] {[ns_set value $selection $i]}" + uplevel $command + foreach function $args { + set next_command "set ${name_prefix}[ns_set key $selection $i] \[$function \$${name_prefix}[ns_set key $selection $i]\]" + uplevel $next_command + } + incr i + } +} + + +proc cassandracle_gethandle {} { + return [ns_db gethandle] +} + Index: web/openacs/tcl/chat-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/chat-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/chat-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,724 @@ +# chat-defs.tcl,v 3.0.4.1 2000/03/24 02:22:21 aure Exp +# ad-chat.tcl +# originally by aure@arsdigita.com, May 1999 +# (heavily edited by jsc@arsdigita.com and philg@mit.edu) + + +util_report_library_entry + +proc_doc chat_system_name {} {Returns the Chat system name for presentation} { + return [ad_parameter SystemName chat "Chat"] +} + +proc chat_room_group_id_internal {chat_room_id} { + set db [ns_db gethandle] + set group_id [database_to_tcl_string_or_null $db "select group_id from chat_rooms where chat_room_id = $chat_room_id"] + ns_db releasehandle $db + return $group_id +} + +proc_doc chat_room_group_id {chat_room_id} {If a private chat room, returns the ID of the group that can enter. If the chat room is public, returns empty string. Memoized for speed} { + # throw an error if the argument isn't an integer (security since + # the memoize will do an eval) + validate_integer "chat_room_id" $chat_room_id + return [util_memoize "chat_room_group_id_internal $chat_room_id" [ad_parameter RoomPropertiesCacheTimeout chat 600]] +} + + +# philg traced the query for max chat_msg_id and found that it hits the +# index (this is important because the JavaScript client calls this like +# crazy) +# Execution Plan +# ---------------------------------------------------------- +# 0 SELECT STATEMENT Optimizer=CHOOSE +# 1 0 SORT (AGGREGATE) +# 2 1 TABLE ACCESS (BY INDEX ROWID) OF 'CHAT_MSGS' +# 3 2 INDEX (RANGE SCAN) OF 'CHAT_MSGS_BY_ROOM_DATE' (NON-UNIQUE) + +proc_doc chat_last_post {chat_room_id} {Returns chat_msg_id of most recent post in a room; used by JavaScript client to figure out whether an update to the main window is needed} { + set db [ns_db gethandle] + set last_chat_msg_id [database_to_tcl_string $db "select max(chat_msg_id) +from chat_msgs +where chat_room_id = $chat_room_id +and approved_p='t'"] + ns_db releasehandle $db + return $last_chat_msg_id +} + +proc_doc chat_get_personal_posts {chatter_id} {Returns HTML fragment of all person-to-person messages between currently connected user and user CHATTER_ID} { + + set user_id [ad_verify_and_get_user_id] + set db [ns_db gethandle] + + set order "" + if {[ad_parameter MostRecentOnTopP chat]} { + set order "desc" + } + + set chat_rows "" + + set selection [ns_db select $db "select to_char(creation_date,'HH24:MI:SS') as time, + coalesce(msg_bowdlerized, msg) as filtered_msg, first_names, creation_user +from chat_msgs, users +where chat_msgs.creation_user = users.user_id + and ((creation_user = $chatter_id and recipient_user = $user_id) + or (creation_user = $user_id and recipient_user = $chatter_id)) +order by creation_date $order"] + + while { [ns_db getrow $db $selection]} { + set_variables_after_query + + set filtered_msg [link_urls [ns_quotehtml $filtered_msg]] + + append chat_rows "$first_names ($time) $filtered_msg\n
    \n" + + } + ns_db releasehandle $db + return $chat_rows +} + + +proc_doc chat_last_personal_post {chatter_id} {Returns a Tcl list of the time and user id of the last personal message between currently connected user and argument-specified user} { + set user_id [ad_verify_and_get_user_id] + set db [ns_db gethandle] + + set selection [ns_db select $db "select to_char(creation_date,'HH24:MI:SS') as time, creation_user +from chat_msgs +where (creation_user = $chatter_id + and recipient_user = $user_id) + or (creation_user = $user_id + and recipient_user = $chatter_id) +order by creation_date desc"] + + ns_db getrow $db $selection + set_variables_after_query + + ns_db flush $db + ns_db releasehandle $db + regsub -all ":" $time "" time + return [list $time $creation_user] +} + + +proc_doc chat_get_posts {db chat_room_id number_of_posts} {Returns a Tcl list. The first element is 1 or 0, depending on whether or not there are more postings than requested (1 if there are more_p). The second element is the last NUMBER_OF_POSTS messages in a chat room, as an HTML fragment, separated by BR tags} { + + set reverse_p 0 + if {[ad_parameter MostRecentOnTopP chat]} { + set reverse_p 1 + } + + # we keep the query the same regardless of the order because in fact + # we're going to be flushing the db connection; we only want the most + # most recent N rows so we have to start at the top to hit the index and + # not suck 9000 old rows out of the db + set selection [ns_db select $db "select to_char(creation_date, 'HH24:MI:SS') as time, + coalesce(msg_bowdlerized, msg) as filtered_msg, first_names, last_name, creation_user, system_note_p +from chat_msgs, users +where chat_msgs.creation_user = users.user_id + and chat_room_id = $chat_room_id + and chat_msgs.approved_p = 't' +order by creation_date desc"] + + set counter 0 + set chat_rows "" + + while { [ns_db getrow $db $selection] } { + if { $counter >= $number_of_posts } { + # flush out the db connection and throw away the rest of the rows + ns_db flush $db + # return and tell the caller that there were more + return [list 1 $chat_rows] + } + set_variables_after_query + incr counter + + set filtered_msg [link_urls [ns_quotehtml $filtered_msg]] + + if { $system_note_p == "t" } { + set row "$first_names $last_name($time) $filtered_msg
    \n" + } else { + set row "$first_names $last_name ($time) $filtered_msg
    \n" + } + + if { $reverse_p } { + append chat_rows $row + } else { + set chat_rows "$row$chat_rows" + } + } + # we got everything in the table but there aren't more to be had + return [list 0 $chat_rows] +} + + +proc_doc chat_get_posts_to_moderate {chat_room_id} {Returns HTML fragment of chat posts awaiting moderator approval.} { + + set user_id [ad_verify_and_get_user_id] + set db [ns_db gethandle] + + set order "" + if {[ad_parameter MostRecentOnTopP chat]} { + set order "desc" + } + + set chat_rows "

    Accept / Reject / Decide Later
    " + set ids "" + + set selection [ns_db select $db "select to_char(creation_date,'HH24:MI:SS') as time, + chat_msg_id, msg_bowdlerized, msg, content_tag, first_names, creation_user +from chat_msgs, users +where chat_msgs.creation_user = users.user_id + and chat_room_id = $chat_room_id + and chat_msgs.approved_p = 'f' +order by creation_date $order"] + + while { [ns_db getrow $db $selection]} { + set_variables_after_query + + set filtered_msg [ns_quotehtml $msg] + + if { ![empty_string_p $msg_bowdlerized] } { + set msg_bowdlerized "([ns_quotehtml $msg_bowdlerized])" + } + + set rating "G" + if { $content_tag & 1 } { + set rating "PG" + } + if { $content_tag & 2 } { + set rating "R" + } + if { $content_tag & 4 } { + set rating "X" + } + + lappend ids $chat_msg_id + + append chat_rows " + + +($rating) $first_names ($time) $filtered_msg $msg_bowdlerized
    \n" + } + + ns_db releasehandle $db + append chat_rows "[export_form_vars ids chat_room_id]
    " + + if {[empty_string_p $ids]} { + return "" + } else { + return $chat_rows + } +} + + +proc_doc link_urls {str} {Replace what appear to be URLs with links.} { + # URL courtesy of Zach Beane, somewhat modified. If you can do better, + # let me know -jsc@arsdigita.com + + set url_re {(http|ftp)://[-A-Za-z0-9]+(\.[-A-Za-z0-9]+)+(:[0-9]+)?(/[-^A-Za-z0-9_~\#/]*)?([./][-^A-Za-z0-9_~\#?=%+/]+)*} + regsub -all $url_re $str {\0} str + + # Try to get "www.photo.net" linked properly (without re-linking + # any of the URLs we just linked). + + set url_re_no_http {([^/])(www\.[-A-Za-z0-9]+(\.[-A-Za-z0-9]+)+(:[0-9]+)?(/[-^A-Za-z0-9_~\#/]*)?([./][-^A-Za-z0-9_~\#?=%+/]+)*)} + regsub -all $url_re_no_http $str {\1\2} str + + return $str +} + +proc_doc chat_post_message {db msg user_id chat_room_id} {Post message to the chat room} { + set selection [ns_db 1row $db "select group_id, moderated_p +from chat_rooms +where chat_room_id = $chat_room_id"] + + set_variables_after_query + + set client_ip_address [ns_conn peeraddr] + + if { $moderated_p == "t" } { + set approved_p f + } else { + set approved_p t + } + + if {[empty_string_p $group_id] || [ad_user_group_member $db $group_id $user_id] && ![empty_string_p $msg] } { + + ns_db dml $db "insert into chat_msgs + (chat_msg_id, msg, msg_bowdlerized, content_tag, creation_date, creation_user, creation_ip_address, chat_room_id, approved_p) + values + (nextval('chat_msg_id_sequence'), '$msg', [db_postgres_null_sql [bowdlerize_text $msg]], '[tag_content $msg]', sysdate(), $user_id, '$client_ip_address',$chat_room_id, '$approved_p') + " + + if { $approved_p == "t" } { + util_memoize_flush "chat_entire_page $chat_room_id short" + util_memoize_flush "chat_entire_page $chat_room_id medium" + util_memoize_flush "chat_entire_page $chat_room_id long" + util_memoize_flush "chat_js_entire_page $chat_room_id" + } + } + + return +} + +proc_doc chat_post_system_note {db msg user_id chat_room_id} {Post message to the chat room marked as a system note} { + set selection [ns_db 0or1row $db "select group_id, moderated_p +from chat_rooms +where chat_room_id = $chat_room_id"] + + if { $selection == "" } { + return + } + set_variables_after_query + set client_ip_address [ns_conn peeraddr] + + if {[empty_string_p $group_id] || [ad_user_group_member $db $group_id $user_id]} { + + if {![empty_string_p $msg]} { + ns_db dml $db "insert into chat_msgs + (chat_msg_id, msg, msg_bowdlerized, content_tag, creation_date, creation_user, creation_ip_address, chat_room_id, approved_p, system_note_p) + values + (nextval('chat_msg_id_sequence'), '$msg', [db_postgres_null_sql [bowdlerize_text $msg]], '[tag_content $msg]', sysdate(), $user_id, '$client_ip_address',$chat_room_id, 't', 't') + " + } + + util_memoize_flush "chat_entire_page $chat_room_id short" + util_memoize_flush "chat_entire_page $chat_room_id medium" + util_memoize_flush "chat_entire_page $chat_room_id long" + util_memoize_flush "chat_js_entire_page $chat_room_id" + } +} + +proc_doc chat_post_personal_message {db msg user_id chatter_id} {Post a personal message from USER_ID to CHATTER_ID} { + + set client_ip_address [ns_conn peeraddr] + + set bowdlerized_msg [bowdlerize_text $msg] + if {[string compare $msg $bowdlerized_msg]} { + set bowdlerized_msg "" + } + + if {![empty_string_p $msg]} { + ns_db dml $db "insert into chat_msgs + (chat_msg_id, msg, msg_bowdlerized, content_tag, creation_date, creation_user, creation_ip_address, recipient_user) + values + (nextval('chat_msg_id_sequence'), '$msg', '$bowdlerized_msg', '[tag_content $msg]', sysdate(), $user_id, '$client_ip_address',$chatter_id)" + } + return +} + +proc chat_js_entire_page { chat_room_id } { + set last_post_id [chat_last_post $chat_room_id] + + set db [ns_db gethandle] + + set whole_page " + +" + + if {[ad_parameter MostRecentOnTopP chat]} { + append whole_page "" + } + + append whole_page "[lindex [chat_get_posts $db $chat_room_id 25] 1]" + + if {![ad_parameter MostRecentOnTopP chat]} { + append whole_page "" + } + + ns_db releasehandle $db + + return $whole_page +} + + +proc chat_entire_page { chat_room_id n_rows } { + # n_rows has three possible values, "short", "medium", "long" + + # Get room info + set db [ns_db gethandle] + + set selection [ns_db 0or1row $db "select pretty_name, moderated_p + from chat_rooms + where chat_room_id = $chat_room_id"] + + if { $selection == "" } { + ad_scope_return_error "Room deleted" "We couldn't find the chat room you tried to enter. It was probably deleted by the site administrator." $db + return + } + + set_variables_after_query + + if { ![empty_string_p $moderated_p] && $moderated_p == "t" } { + set button_text "submit message to moderator" + } else { + set button_text "post message" + } + + set html " + [ad_scope_header "$pretty_name" $db] + + " + upvar \#1 scope scope + + if { $scope=="public" } { + append html " + [ad_decorate_top "

    $pretty_name

    + [ad_context_bar [list "exit-room.tcl?[export_url_vars chat_room_id]&newlocation=/pvt/home.tcl" "Your Workspace"] [list "exit-room.tcl?[export_url_vars chat_room_id]&newlocation=index.tcl" [chat_system_name]] "One Room"] + " [ad_parameter DefaultDecoration chat]] + " + } else { + append html " + [ad_scope_page_title $pretty_name $db] + [ad_scope_context_bar_ws_or_index [list "exit-room.tcl?[export_url_vars chat_room_id]&newlocation=index.tcl" [chat_system_name]] "One Room"] + " + } + + append html " +
    + " + set formhtml "
    + Chat: + + [export_form_vars chat_room_id n_rows] +

    +

    + " + + if {[ad_parameter MostRecentOnTopP chat]} { + append html $formhtml + set formhtml "" + } + + # find the people who've posted in the last 10 minutes + set selection [ns_db select $db "select user_id as chatter_id, first_names, last_name from users where user_id in +(select user_id +from chat_msgs, users +where chat_msgs.creation_user = users.user_id + and chat_room_id = $chat_room_id + and age(sysdate(), creation_date) < '10 minutes'::reltime + and chat_msgs.approved_p = 't') +order by upper(last_name)"] + + set chatters [list] + + set private_chat_enabled_p [ad_parameter PrivateChatEnabledP chat 1] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + if { $private_chat_enabled_p } { + lappend chatters "$first_names $last_name (private chat)" + } else { + lappend chatters "$first_names $last_name" + } + } + + set refresh_list [list "Refresh"] + + switch -- $n_rows { + "short" { + set posts [chat_get_posts $db $chat_room_id [ad_parameter NShortMessages chat 25]] + set more_posts_p [lindex $posts 0] + set chat_rows [lindex $posts 1] + if { $more_posts_p } { + lappend refresh_list "More Messages" + } + } + + "medium" { + set posts [chat_get_posts $db $chat_room_id [ad_parameter NMediumMessages chat 50]] + set more_posts_p [lindex $posts 0] + set chat_rows [lindex $posts 1] + lappend refresh_list "Fewer Messages" + if { $more_posts_p } { + lappend refresh_list "More Messages" + } + } + "long" { + set chat_rows [lindex [chat_get_posts $db $chat_room_id [ad_parameter NLongMessages chat 75]] 1] + lappend refresh_list "Fewer Messages" + } + } + + ns_db releasehandle $db + + if { [ad_parameter ExposeChatHistoryP chat 1] } { + set history_link "
  • View old messages
    " + } else { + set history_link "" + } + + return "$html +
    + \[ [join $refresh_list " | "] \] +
    + +
      + $chat_rows +
    + + $formhtml +

    + +

    + +

    + + Chatters who posted messages within the last ten minutes: +

      + [join $chatters ", "] +
    + + [ad_scope_footer] + " + +} + + +proc_doc chat_history {chat_room_id} {Builds page for /chat/history.tcl; chat posts by date} { + set db [ns_db gethandle] + set selection [ns_db 0or1row $db "select pretty_name + from chat_rooms + where chat_room_id = $chat_room_id"] + + if { $selection == "" } { + return " + [ad_scope_header "Room Deleted" $db] + [ad_scope_page_title "Room deleted" $db] + + We couldn't find chat room $chat_room_id. It was probably deleted by the + site administrator." + } + set_variables_after_query + set whole_page " + [ad_scope_header "$pretty_name history" $db] + [ad_scope_page_title "$pretty_name history" $db] + [ad_scope_context_bar_ws_or_index [list "index.tcl" [chat_system_name]] [list "chat.tcl?[export_url_vars chat_room_id]" "One Room"] "History"] + +
    + +
      + + " + set selection [ns_db select $db "select trunc(creation_date) as the_date, count(*) as n_msgs + from chat_msgs + where chat_room_id = $chat_room_id + and approved_p = 't' + and system_note_p <> 't' + group by trunc(creation_date) + order by trunc(creation_date) desc"] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + append whole_page "
    • [util_AnsiDatetoPrettyDate $the_date]: $n_msgs\n" + } + append whole_page " +
    + + [ad_scope_footer ] + " + ns_db releasehandle $db + return $whole_page +} + + +################################################################## +# +# interface to the ad-new-stuff.tcl system + +ns_share ad_new_stuff_module_list + +if { ![info exists ad_new_stuff_module_list] || [lsearch -glob $ad_new_stuff_module_list "[chat_system_name]*"] == -1 } { + lappend ad_new_stuff_module_list [list [chat_system_name] chat_new_stuff] +} + +proc chat_new_stuff {db since_when only_from_new_users_p purpose} { + if { $only_from_new_users_p == "t" } { + set query "select cr.chat_room_id, cr.pretty_name, count(*) as n_messages +from chat_msgs cm, chat_rooms cr, users_new u +where cm.chat_room_id = cr.chat_room_id +and cm.creation_date > '$since_when' +and cm.creation_user = u.user_id +and [ad_scope_sql cr] +group by cr.chat_room_id, cr.pretty_name" + } else { + set query "select cr.chat_room_id, cr.pretty_name, count(*) as n_messages +from chat_msgs cm, chat_rooms cr +where cm.chat_room_id = cr.chat_room_id +and cm.creation_date > '$since_when' +and [ad_scope_sql cr] +group by cr.chat_room_id, cr.pretty_name" + } + set result_items "" + set selection [ns_db select $db $query] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + switch $purpose { + web_display { + append result_items "
  • $pretty_name ($n_messages new messages)\n" } + site_admin { + append result_items "
  • $pretty_name ($n_messages new messages)\n" + } + email_summary { + append result_items "$pretty_name chat room : $n_messages new messages + -- [ad_url]/chat/history.tcl?[export_url_vars chat_room_id] +" + } + } + } + # we have the result_items or not + if { $purpose == "email_summary" } { + return $result_items + } elseif { ![empty_string_p $result_items] } { + return "
      \n\n$result_items\n
    \n" + } else { + return "" + } +} + + +# Add chat to user contributions summary. + +ns_share ad_user_contributions_summary_proc_list + +if { ![info exists ad_user_contributions_summary_proc_list] || [util_search_list_of_lists $ad_user_contributions_summary_proc_list "Chat" 0] == -1 } { + lappend ad_user_contributions_summary_proc_list [list "Chat" ad_chat_user_contributions 1] +} + + +proc_doc ad_chat_user_contributions {db user_id purpose} "Returns a list of priority, title, and an unordered list HTML fragment. All the chat messages posted by a user." { + if { $purpose == "site_admin" } { + + set n_msgs [database_to_tcl_string $db " + select count(*) + from chat_msgs + where creation_user = $user_id + and system_note_p = 'f'"] + + if { $n_msgs == 0 } { + return [list] + } + if { $n_msgs > 100 } { + return [list 1 "Chat" "More than 100 chat messages. View here."] + } + + set selection [ns_db select $db " + select cr.pretty_name, cr.scope, cr.group_id, cm.msg, u.first_names || ' ' || u.last_name as recipient, user_group_name_from_id(cr.group_id) as group_name, user_group_short_name_from_id(cr.group_id) as short_name, + case when cr.scope = 'public' then 1 + when cr.scope = 'group' then 2 + when cr.scope = 'user' then 3 + else 4 end as scope_ordering + from chat_rooms cr, chat_msgs cm, users u + where cm.creation_user = $user_id + and cm.chat_room_id = cr.chat_room_id + and cm.recipient_user = u.user_id + and cm.system_note_p = 'f' + order by scope_ordering, cr.pretty_name, u.first_names, u.last_name, cm.creation_date desc"] + + set items "" + set last_chat_room "" + set last_recipient " " + set item_counter 0 + set last_group_id "" + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + switch $scope { + public { + if { $item_counter==0 } { + append items " +

    Public Chat Rooms

      " + } + } + group { + if { $last_group_id!=$group_id } { + append items " +

    $group_name Chat Rooms

      " + } + } + } + + if { ![empty_string_p $pretty_name] && $last_chat_room != $pretty_name } { + append items "Messages in $pretty_name

      \n" + set last_chat_room $pretty_name + } + if { ![empty_string_p $recipient] && $recipient != $last_recipient } { + append items "

    Messages to $recipient

      \n" + set last_recipient $recipient + } + + append items "
    • $msg\n" + + set last_group_id $group_id + incr item_counter + } + + return [list 1 "Chat" "
          \n$items\n
      "] + + } else { + return [list] + } +} + +# a chat specific context bar, rooted at the workspace or index, depending on whether +# user is logged in +proc_doc chat_scope_context_bar_ws_or_index {chat_room_id args} "assumes scope is set in the callers environment. if scope=group, it assumes that group_context_bar_list are set in the callers environment. returns a Yahoo-style hierarchical contextbar for appropriate scope, starting with a link to either the workspace or /, depending on whether or not the user is logged in. Makes sure that everytime a link on the context bar is clicked, it is noted that the user has left the room" { + if { [ad_get_user_id] == 0 } { + set choices [list "[ad_system_name]"] + } else { + set choices [list "Your Workspace"] + } + + set all_args [list] + + upvar \#1 scope scope + + switch $scope { + public { + set all_args $args + } + group { + upvar \#1 group_vars_set group_vars_set + set group_context_bar_list [ns_set get $group_vars_set group_context_bar_list] + eval "lappend all_args $group_context_bar_list" + foreach arg $args { + lappend all_args $arg + } + } + user { + # this may be later modified if we allow users to customize the display of their pages + set all_args $args + } + } + + set index 0 + foreach arg $all_args { + incr index + if { $index == [llength $all_args] } { + lappend choices $arg + } else { + lappend choices "[lindex $arg 1]" + } + } + return [join $choices " : "] +} + +util_report_successful_library_load + Index: web/openacs/tcl/chunks.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/chunks.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/chunks.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,236 @@ +util_report_library_entry + + + +proc reiterate_through_chunk {db which_chunk template} { + set return_html "" + switch $which_chunk { + news { + set news [most_recent_news $db] + for {set i 0} {$i < [llength $news]} {incr i} { + set item [lindex $news $i] + set news_item_id [lindex $item 0] + set title [lindex $item 1] + set release_date [lindex $item 2] + set body [lindex $item 3] + set news_link "/news/item.tcl?scope=public&news_item_id=$news_item_id" + set pretty_release_date [util_AnsiDatetoPrettyDate $release_date] + append return_html [subst $template] + } + } + threads { + set bboard [most_active_threads $db] + for {set i 0} {$i < [llength $bboard]} {incr i} { + set article [lindex $bboard $i] + set msg_id [lindex $article 0] + set count [lindex $article 1] + set topic [lindex $article 2] + set one_line [lindex $article 3] + set body [lindex $article 4] + set msg_link "/bboard/q-and-a-fetch-msg.tcl?msg_id=$msg_id" + append return_html [subst $template] + } + } + calendar { + set events [current_calendar_events $db] + for {set i 0} {$i < [llength $events]} {incr i} { + set event [lindex $events $i] + set calendar_id [lindex $event 0] + set category [lindex $event 1] + set title [lindex $event 2] + set body [lindex $event 3] + set start_date [lindex $event 5] + set end_date [lindex $event 6] + set calendar_link "/calendar/item.tcl?scope=public&calendar_id=$calendar_id" + set pretty_start_date [util_AnsiDatetoPrettyDate $start_date] + set pretty_end_date [util_AnsiDatetoPrettyDate $end_date] + append return_html [subst $template] + } + } + recent_classifieds { + set classifieds [most_recent_classifieds $db] + for {set i 0} {$i < [llength $events]} {incr i} { + set ad [lindex $classifieds $i] + set classified_ad_id [lindex $ad 0] + set domain [lindex $ad 1] + set one_line [lindex $ad 2] + set posted [lindex $ad 3] + set manufacturer [lindex $ad 4] + set classified_ad_link "/gc/view-one.tcl?classified_ad_id=$classified_ad_id" + set pretty_posted [util_AnsiDatetoPrettyDate $posted] + append return_html [subst $template] + } + } + active_auctions { + set auctions [most_active_classified_auctions $db] + for {set i 0} {$i < [llength $auctions]} {incr i} { + set ad [lindex $auctions $i] + set classified_ad_id [lindex $ad 0] + set domain [lindex $ad 1] + set one_line [lindex $ad 2] + set posted [lindex $ad 3] + set manufacturer [lindex $ad 4] + set count [lindex $ad 5] + set classified_ad_link "/gc/view-one.tcl?classified_ad_id=$classified_ad_id" + set pretty_posted [util_AnsiDatetoPrettyDate $posted] + append return_html [subst $template] + } + } + } + return $return_html +} + + +proc most_recent_news {db} { + set MemoizeTime [ad_parameter NewsCacheLength chunks 7200] + return [util_memoize "most_recent_news_internal $db" $MemoizeTime] + +} + + +proc most_recent_news_internal {db} { + #returns a list of lists. the child lists will contain the news_id, title, release_date, body, + #and whether or not it's in html, in that order + set news_items [list] + set MaxItems [ad_parameter MaxNews chunks 3] + set MaxLength [ad_parameter MaxNewsBodyLength chunks 120] + set selection [ns_db select $db "SELECT news_item_id, title, body, html_p, release_date FROM news_items WHERE [db_sysdate] BETWEEN release_date AND expiration_date AND approval_state = 'approved' ORDER BY release_date DESC, creation_date DESC"] + + set CurItems 0 + while { [ns_db getrow $db $selection] } { + set_variables_after_query + set article [list $news_item_id $title $release_date] + lappend article [string trim [string range $body 0 [expr [string first " " [string range $body $MaxLength end]] + [expr $MaxLength - 1]]]] + lappend article $html_p + lappend news_items $article + incr CurItems + if { $CurItems >= $MaxItems } { + ns_db flush $db + break + } + } + + return $news_items +} + +proc most_active_threads {db} { + set MemoizeTime [ad_parameter BBoardCacheLength chunks 7200] + return [util_memoize "most_active_threads_internal $db" $MemoizeTime] +} + +proc most_active_threads_internal {db} { + #returns a list of lists. the child lists will contain the root_msg_id, total number of messages under that root, + #the topic, the subject, and the first x characters of the body of the root msg in that order + set db2 [ns_db gethandle subquery] + set threads [list] + set MaxThreads [ad_parameter MaxBboardThreads chunks 5] + set MaxLength [ad_parameter MaxMsgBodyLength chunks 120] + set MessageAge [ad_parameter CountOldMessages chunks 10] + set selection [ns_db select $db "SELECT root_msg_id, count(*) as count from bboard WHERE posting_time >= ([db_sysdate] - $MessageAge)::datetime GROUP BY root_msg_id"] + + set CurThreads 0 + while { [ns_db getrow $db $selection] } { + set_variables_after_query + set sub_selection [ns_db 0or1row $db2 "SELECT topic, one_line, message as body FROM bboard, bboard_topics WHERE bboard.topic_id = bboard_topics.topic_id AND msg_id = '$root_msg_id'"] + set_variables_after_subquery + set TruncBody [string trim [string range $body 0 [expr [string first " " [string range $body $MaxLength end]] + [expr $MaxLength - 1]]]] + set message [list $root_msg_id $count $topic $one_line $TruncBody] + lappend threads $message + incr CurThreads + if { $CurThreads >= $MaxThreads } { + ns_db flush $db + break + } + } + ns_db releasehandle $db2 + return $threads +} + + +proc current_calendar_events {db} { + set MemoizeTime [ad_parameter EventsCacheLength 7200] + return [util_memoize "current_calendar_events_internal $db" $MemoizeTime] +} + +proc current_calendar_events_internal {db} { + #returns a list of lists. the child lists will contain calendar_id, category, title, body, + #whether the body is in html, start date, end date - in that order. + set calendar [list] + set MaxEvents [ad_parameter MaxEvents chunks 5] + set MaxLength [ad_parameter MaxEventBodyLength chunks 120] + set selection [ns_db select $db "SELECT calendar_id, category, title, body, html_p, start_date, end_date FROM calendar, calendar_categories WHERE calendar.category_id = calendar_categories.category_id AND approved_p = 't' AND [db_sysdate] <= end_date ORDER BY start_date, creation_date"] + + set CurEvents 0 + while { [ns_db getrow $db $selection] } { + set_variables_after_query + set TruncBody [string trim [string range $body 0 [expr [string first " " [string range $body $MaxLength end]] + [expr $MaxLength - 1]]]] + set event [list $calendar_id $category $title $TruncBody $html_p $start_date $end_date] + lappend calendar $event + incr CurEvents + if { $CurEvents >= $MaxEvents } { + ns_db flush $db + break + } + } + return $calendar +} + +proc most_recent_classifieds {db} { + set MemoizeTime [ad_parameter ClassifiedsCacheLength 7200] + return [util_memoize "most_recent_classifieds_internal $db" $MemoizeTime] +} + +proc most_active_classified_auctions {db} { + set MemoizeTime [ad_parameter AuctionsCacheLength 7200] + return [util_memoize "most_active_classified_auctions_internal $db" $MemoizeTime] +} + + +proc most_recent_classifieds_internal {db} { + #returns a list of lists. the child lists will contain classified_ad_id, domain, one_line, posted, and + #manufacturer(which seems to store price) - in that order + set classifieds [list] + set MaxAds [ad_parameter MaxAds chunks 5] + set selection [ns_db select $db "SELECT classified_ad_id, one_line, manufacturer, posted, domain from classified_ads, ad_domains where classified_ads.domain_id = ad_domains.domain_id AND (sysdate() <= expires or expires is null) order by posted desc"] + + set CurAds 0 + while { [ns_db getrow $db $selection] } { + set_variables_after_query + set ad [list $classified_ad_id $domain $one_line $posted $manufacturer] + lappend classifieds $ad + incr CurAds + if { $CurAds >= $MaxAds } { + ns_db flush $db + break + } + } + return $classifieds +} + +proc most_active_classified_auctions_internal {db} { + #returns a list of lists. the child lists will contain classified_ad_id, domain, one_line, posted, + #manufacturer(which seems to store price), and number of recent bids - in that order + set db2 [ns_db gethandle subquery] + set auctions [list] + set MaxAuctions [ad_parameter MaxAuctions chunks 5] + set BidAge [ad_parameter CountOldBids chunks 10] + set selection [ns_db select $db "SELECT ca.classified_ad_id, count(*) as count FROM classified_ads ca, classified_auction_bids cab WHERE ca.classified_ad_id = cab.classified_ad_id AND bid_time >= ([db_sysdate] - $BidAge)::datetime GROUP BY ca.classified_ad_id ORDER BY count DESC"] + + set CurAuctions 0 + while { [ns_db getrow $db $selection] } { + set_variables_after_query + set sub_selection [ns_db 0or1row $db2 "SELECT domain, one_line, posted, manufacturer FROM classified_ads ca, ad_domains ad WHERE ca.domain_id = ad.domain_id AND classified_ad_id = $classified_ad_id"] + set_variables_after_subquery + set ad [list $classified_ad_id $domain $one_line $posted $manufacturer $count] + lappend auctions $ad + incr CurAuctions + if { $CurAuctions >= $MaxAuctions } { + ns_db flush $db + break + } + } + ns_db releasehandle $db2 + return $auctions +} + +util_report_successful_library_load Index: web/openacs/tcl/contest-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/contest-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/contest-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,10 @@ +# contest-defs.tcl,v 3.0 2000/02/06 03:13:05 ron Exp +proc ad_contest_admin_footer {} { + set owner [ad_parameter ContestAdminOwner contest [ad_admin_owner]] + return "
      +
      $owner
       + +" +} + + Index: web/openacs/tcl/crm-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/crm-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/crm-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,58 @@ +# crm-defs.tcl,v 3.1 2000/02/26 12:55:28 jsalz Exp +# +# /tcl/crm-defs.tcl +# +# by jsc@arsdigita.com in October 1999 +# +# definitions related to the CRM (customer relationship management) module +# + +util_report_library_entry + +proc_doc crm_run_state_machine {} {Updates all the users' crm_state information.} { + set dbs [ns_db gethandle subquery 2] + set db [lindex $dbs 0] + set sub_db [lindex $dbs 1] + + ns_log Notice "Starting CRM update" + + set now [database_to_tcl_string $db "select to_char(sysdate(), 'YYYYMMDDHH24MISS') from dual"] + + # Sleep for a second, so that we don't inadvertently step on our toes below. + ns_sleep 1 + + set selection [ns_db select $db "select state_name, next_state, transition_condition +from crm_state_transitions +order by triggering_order"] + + with_transaction $sub_db { + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + ns_db dml $sub_db "update users +set crm_state = '$next_state', crm_state_entered_date = sysdate() +where crm_state = '$state_name' +and crm_state_entered_date < to_date('$now', 'YYYYMMDDHH24MISS') +and ($transition_condition)" + } + } { + ns_log Bug "CRM update failed: $errmsg" + } + + + ns_db releasehandle $db + ns_db releasehandle $sub_db + ns_log Notice "CRM update done" +} + +ns_share -init {set crm_update_scheduled 0} crm_update_scheduled + +if { !$crm_update_scheduled && ![philg_development_p] } { + set crm_update_scheduled 1 + ns_log Notice "Scheduling crm update with ns_schedule..." + ad_schedule_proc -thread t [expr 3600 * [ad_parameter UpdatePeriodHours crm 24]] crm_run_state_machine +} else { + ns_log Notice "crm update already scheduled" +} + +util_report_successful_library_load Index: web/openacs/tcl/curriculum.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/curriculum.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/curriculum.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,281 @@ +# curriculum.tcl,v 3.1 2000/02/26 12:55:28 jsalz Exp +# +# curriculum.tcl +# +# by philg@mit.edu on September 25, 1999 +# +# documented in /doc/curriculum.html +# + +util_report_library_entry + +proc_doc curriculum_get_output_cookie {} {Returns the value of the CurriculumProgress cookie that will be written to the client, or empty string if none is in the outputheaders ns_set} { + if [empty_string_p [ns_conn outputheaders]] { + return "" + } + set set_id [ns_conn outputheaders] + for {set i 0} {$i<[ns_set size $set_id]} {incr i} { + if { [string compare [ns_set key $set_id $i] "Set-Cookie"] == 0 } { + # it is a Set-Cookie header + if { [regexp {CurriculumProgress=([^;]+)} [ns_set value $set_id $i] {} curriculum_progress] } { + # it IS for the CurriculumProgress cookie + return $curriculum_progress + } + } + } + # if we got here, means we didn't find anything + return "" +} + +proc_doc curriculum_bar {} {Returns a string containing the HTML for a curriculum bar. Assumes the system is enabled but checks to see if this particular user should get one.} { + # check cookie to make sure this person isn't finished + set cookie [ns_set get [ns_conn headers] Cookie] + if { [regexp {CurriculumProgress=([^;]+)} $cookie {} input_cookie] } { + # we have a cookie + if { [string compare $input_cookie "finished"] == 0 } { + # user has completed curriculum, don't bother showing the bar + return "" + } else { + # compare what the user has seen to what is in the full curriculum + # to put in checkboxes; we check the output headers first and then + # the input headers, in case there is going to be a newer value + set output_cookie [curriculum_get_output_cookie] + if { [empty_string_p $output_cookie] } { + return [curriculum_bar_internal $input_cookie] + } else { + return [curriculum_bar_internal $output_cookie] + } + } + } else { + # no cookie; this person is either brand new or their browser is rejecting cookies + # let's not uglify all their pages with a bar that they can't use + return "" + } +} + +proc curriculum_bar_internal {cookie_value} { + # cookie_value will either be "finished" or a Tcl list of integers + set the_big_list [util_memoize "curriculum_bar_all_db_rows"] + set table_elements [list] + foreach sublist $the_big_list { + set curriculum_element_id [lindex $sublist 0] + set url [lindex $sublist 1] + set very_very_short_name [lindex $sublist 2] + if { [lsearch -exact $cookie_value $curriculum_element_id] == -1 } { + # user hasn't completed this part of the curriculum + set checkbox_url "/graphics/unchecked.gif" + } else { + set checkbox_url "/graphics/checked.gif" + } + if ![empty_string_p [ad_parameter BarFontTag curriculum]] { + set complete_name "[ad_parameter BarFontTag curriculum]$very_very_short_name      " + } else { + set complete_name $very_very_short_name + } + lappend table_elements "$complete_name +
      +
      + +
      +" + } + if { [llength $table_elements] == 0 } { + # publisher hasn't established a curriculum + return "" + } else { + # let's tack a help link at the end + lappend table_elements "\n[ad_parameter HelpAnchorText curriculum "?"]" + return "\n[join $table_elements "\n"]\n
      \n" + } +} + +# this is designed to be called within a memoization proc +proc curriculum_bar_all_db_rows {} { + set db [ns_db gethandle subquery] + set the_big_list [database_to_tcl_list_list $db "select curriculum_element_id, url, very_very_short_name +from curriculum +order by element_index"] + ns_db releasehandle $db + return $the_big_list +} + + +proc_doc curriculum_progress_cookie_value {{old_value ""} {new_element ""}} {If not args are supplied, returns the initial value for the CurriculumProgress cookie. If an old value and new element are supplied, returns an appropriate new cookie value."} { + if { [empty_string_p $old_value] && [empty_string_p $new_element] } { + return "start" + } elseif { $old_value == "start" } { + return [list $new_element] + } elseif { $old_value == "finished" } { + # if you're finished, adding a new element doesn't change that! + return "finished" + } else { + set tentative_result [lappend old_value $new_element] + if { [llength [util_memoize "curriculum_bar_all_db_rows"]] == [llength $tentative_result] } { + return "finished" + } else { + return $tentative_result + } + } +} + +proc_doc curriculum_sync {} {Looks at input cookie and looks in database. Returns a new cookie to write to the browser. Returns empty string if a new cookie isn't necessary. Inserts rows into the database if necessary. Assumes that there is a user logged in.} { + set user_id [ad_get_user_id] + set cookie [ns_set get [ns_conn headers] Cookie] + if ![regexp {CurriculumProgress=([^;]+)} $cookie {} input_cookie] { + # we had no cookie + set input_cookie [list] + } + # initialize + set new_cookie $input_cookie + set new_cookie_necessary_p 0 + set db [ns_db gethandle] + set elts_from_database [database_to_tcl_list $db "select curriculum_element_id from user_curriculum_map where user_id = $user_id"] + foreach dbelt $elts_from_database { + if { [lsearch $input_cookie $dbelt] == -1 } { + set new_cookie_necessary_p 1 + set new_cookie [curriculum_progress_cookie_value $new_cookie $dbelt] + } + } + foreach cookie_elt $input_cookie { + if { [lsearch $elts_from_database $cookie_elt] == -1 && ![regexp {[A-z]} $cookie_elt] } { + # cookie contains no alphabet chars + set dupe_free_insert_sql "insert into user_curriculum_map (user_id, curriculum_element_id, completion_date) +select $user_id, $cookie_elt, sysdate() +from dual +where not exists (select 1 from user_curriculum_map + where user_id = $user_id + and curriculum_element_id = $cookie_elt)" + if [catch { ns_db dml $db $dupe_free_insert_sql } errmsg] { + # we got an error, probably because there is garbage in the user's + # cookie and/or the publisher has deleted one of the curriculum elements + ns_log Notice "curriculum_sync got an error from the database. The user's cookie coming in was \"$cookie\". Here's what the RDBMS had to say:\n\n$errmsg" + } + } + } + ns_db releasehandle $db + if { $new_cookie_necessary_p && ($new_cookie != $input_cookie) } { + return $new_cookie + } else { + return "" + } +} + + +# this will be called before *.html and *.tcl pages, in general +proc curriculum_filter {conn args why} { + # we don't want an error in the script to interrupt page service + if [catch { curriculum_filter_internal $args $why } errmsg] { + ns_log Error "curriculum_filter_internal coughed up $errmsg" + } + return "filter_ok" +} + +proc curriculum_filter_internal {args why} { + set cookie [ns_set get [ns_conn headers] Cookie] + if { [regexp {CurriculumProgress=([^;]+)} $cookie {} input_cookie] } { + # we have a cookie + if { [string compare $input_cookie "finished"] == 0 } { + # user has completed curriculum, don't bother doing anything else + } else { + # see what the user is looking at right now and compare + # to curriculum to consider adding to cookie + set the_big_list [util_memoize "curriculum_bar_all_db_rows"] + set table_elements [list] + foreach sublist $the_big_list { + set curriculum_element_id [lindex $sublist 0] + set url [lindex $sublist 1] + if { [ns_conn url] == $url } { + # see if this element isn't already in user's cookie + if { [lsearch $input_cookie $curriculum_element_id] == -1 } { + set new_cookie_value [curriculum_progress_cookie_value $input_cookie $curriculum_element_id] + ns_set put [ns_conn outputheaders] "Set-Cookie" "CurriculumProgress=$new_cookie_value; path=/; expires=Fri, 01-Jan-2010 01:00:00 GMT" + # if the user is logged in, we'll also want to record + # the additional element in the database + set user_id [ad_get_user_id] + if { $user_id != 0 } { + set db [ns_db gethandle subquery] + # insert but only if there isn't a row already there + ns_db dml $db "insert into user_curriculum_map (user_id, curriculum_element_id, completion_date) +select $user_id, $curriculum_element_id, sysdate() +from dual +where not exists (select 1 from user_curriculum_map + where user_id = $user_id + and curriculum_element_id = $curriculum_element_id)" + ns_db releasehandle $db + } + } + } + } + } + } else { + # no cookie + ns_set put [ns_conn outputheaders] "Set-Cookie" "CurriculumProgress=[curriculum_progress_cookie_value]; path=/; expires=Fri, 01-Jan-2010 01:00:00 GMT" + } +} + +ns_share -init {set curriculum_filters_installed_p 0} curriculum_filters_installed_p +if { [ad_parameter EnabledP curriculum 0] && !$curriculum_filters_installed_p} { + set curriculum_filters_installed_p 1 + foreach filter_pattern [ad_parameter_all_values_as_list FilterPattern curriculum] { + ns_log Notice "Installing curriculum filter for $filter_pattern" + ad_register_filter postauth GET $filter_pattern curriculum_filter + } +} + +################################################################## +# +# interface to the ad-user-contributions-summary.tcl system + +ns_share ad_user_contributions_summary_proc_list + +if { [ad_parameter EnabledP curriculum 0] && ![info exists ad_user_contributions_summary_proc_list] || [util_search_list_of_lists $ad_user_contributions_summary_proc_list "Curriculum Progress" 0] == -1 } { + lappend ad_user_contributions_summary_proc_list [list "Curriculum Progress" curriculum_user_contributions 0] +} + +proc_doc curriculum_user_contributions {db user_id purpose} {Returns list items, one for each curriculum posting} { + if { $purpose != "site_admin" } { + # we don't show user tracking data to other users! + return [list] + } + # we have to figure out whether this person is + # (a) finished + # (b) hasn't started, or + # (c) in between + # this query will pull the curriculum out in order that hte + # user viewed the stuff, with the unviewed rows at the end + set selection [ns_db select $db "(select url, one_line_description, completion_date +from curriculum, user_curriculum_map ucm +where curriculum.curriculum_element_id= ucm.curriculum_element_id +and user_id= $user_id) +union +(select url, one_line_description, NULL as completion_date +from curriculum +where 0=(select count(*) from user_curriculum_map where curriculum_element_id=curriculum.curriculum_element_id)) +order by completion_date asc"] + set found_uncompleted_element_p 0 + set found_completed_element_p 0 + while { [ns_db getrow $db $selection] } { + set_variables_after_query + if ![empty_string_p $completion_date] { + set found_completed_element_p 1 + append items "
    • [util_AnsiDatetoPrettyDate $completion_date]: $one_line_description\n" + } else { + set found_uncompleted_element_p 1 + append items "
    • not completed: $one_line_description\n" + } + } + if [empty_string_p $items] { + return [list] + } elseif { !$found_uncompleted_element_p && $found_completed_element_p } { + # we have done them all + return [list 0 "Curriculum Progress" "
      • completed curriculum
      "] + } elseif { $found_uncompleted_element_p && !$found_completed_element_p } { + # we haven't done any! + return [list 0 "Curriculum Progress" "
      • hasn't started curriculum
      "] + } else { + return [list 0 "Curriculum Progress" "
        \n\n$items\n\n
      "] + } +} + +util_report_successful_library_load + Index: web/openacs/tcl/cybercash-stub.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/cybercash-stub.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/cybercash-stub.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,131 @@ + +# +# This is a cybercash stub that simulates the cybercash system for testing purposes +# +# written by Ben Adida (ben@adida.net) + +# Schedule enabling of the stub at a later point +# so that ad_parameter can load first. +# ns_schedule_proc -once 1 ccstub_enable_stub + +# This enables the stub by registering the proc +# cc_send_to_server_21 if the parameter in the .ini +# file says to do so + +if {[ad_parameter EnabledP ccstub]} { + ns_log Notice "Cybercash stub enabled" + proc cc_send_to_server_21 {command in_data out_data} { + stub_cc_send_to_server_21 $command $in_data $out_data + } +} + + +# The actual cybercash stub +# This is very simplistic for now and doesn't ever simulate +# cybercash failures. Eventually, it should. +proc stub_cc_send_to_server_21 {command in_data out_data} { + set db [ns_db gethandle subquery] + + set_variables_after_query_not_selection $in_data + set order_id [ns_set get $in_data order-id] + set card_number [ns_set get $in_data card-number] + set card_exp [ns_set get $in_data card-exp] + + switch $command { + mauthonly { + regexp {([a-zA-Z]+) ([0-9]+)} $amount all currency amount_num + + ns_db dml $db "insert into cybercash_stub_transactions + (order_id, card_number, card_exp, currency, amount_auth) + values + ('$order_id', '$card_number', '$card_exp', '$currency', $amount_num)" + + # Return full success with AVS + ns_set put $out_data MStatus success + ns_set put $out_data "avs-code" A + ns_set put $out_data "amount" $amount_num + } + + postauth { + regexp {([a-zA-Z]+) ([0-9]+)} $amount all currency amount_num + + # A restrictive update statement to ensure that we're marking + # an order that exists and hasn't been marked yet. + # We also check the currency to make sure it still matches, + # and that we're marking only as much as we reserved. + ns_db dml $db "update cybercash_stub_transactions + set postauth_p='t', amount_mark=$amount_num where order_id='$order_id' and postauth_p='f' + and currency='$currency' and amount_auth <= $amount_num" + + # Success if there was one row updated (or more than one, + # but that won't happen because of the primary key restriction on order_id + set success [ns_pg ntuples $db] + + # Send the success back + if {$success} { + ns_set put $out_data MStatus success + } else { + ns_set put $out_data MStatus failure + ns_set put $out_data MErrMsg "No row updated. This means you're doing something wrong." + } + } + + return { + regexp {([a-zA-Z]+) ([0-9]+)} $amount all currency amount_num + + # A restrictive update statement to ensure that we're returning + # an order that exists and has been marked. + # We also can't refund more than was marked. + ns_db dml $db "update cybercash_stub_transactions + set return_p='t', amount_refund= $amount_num where postauth_p='t' and return_p='f' + and currency='$currency' and amount_mark <= $amount_num" + + # Success if there was one row updated (or more than one, + # but that won't happen because of the primary key restriction on order_id + set success [ns_pg ntuples $db] + + # Send the success back + if {$success} { + ns_set put $out_data MStatus success + } else { + ns_set put $out_data MStatus failure + ns_set put $out_data MErrMsg "No row updated. This means you're doing something wrong." + } + } + + void { + # Not sure what to do here + } + + retry { + # This should never happen with this stub + # as long as the query option works well + } + + query { + set check 0 + + switch ${txn-type} { + auth { + set check [database_to_tcl_string $db "select count(*) from cybercash_stub_transactions where order_id='$order_id'"] + } + + marked { + set check [database_to_tcl_string $db "select count(*) from cybercash_stub_transactions where order_id='$order_id' and postauth_p='t'"] + } + + settled { + set check [database_to_tcl_string $db "select count(*) from cybercash_stub_transactions where order_id='$order_id' and postauth_p='t'"] + } + } + + if {$check} { + ns_set put $out_data MStatus success + } else { + ns_set put $out_data MStatus failure + } + } + } + + ns_db releasehandle $db +} \ No newline at end of file Index: web/openacs/tcl/data-pipeline-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/data-pipeline-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/data-pipeline-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,713 @@ +# +# /tcl/data-pipeline.tcl +# +# Data Pipeline - abstraction layer to dynamically generate +# sql queries based on properly named html form elements. +# +# created by dvr 9/1/1999, to handle data processing for huge +# forms on guidestar.org +# rewritten by oumi 2/1/2000 as a module with added capabilities +# including clob support +# +# data-pipeline-defs.tcl,v 3.1 2000/03/11 03:45:20 michael Exp +# + +util_report_library_entry + +ad_proc dp_process {{-db "" -db_op "update_or_insert" -form_index "" -where_clause ""}} {Does database updates/inserts of all the fields passed from the previous form that start with dp$form_index.} { + + set release_db 0 + if { [empty_string_p $db] } { + set release_db 1 + set db [ns_db gethandle subquery] + } + + dp_read_form_variables + # Like set_the_usual_for_variables, will return an error + # if there is no input unless called with an argument of 0. + # + # Reads the form data in an ns_set called dp_form + + dp_read_checkboxes "_cv" "f" + # Fills in unchecked boxes to update the data in the tables + + set error_list [dp_check_var_input $form_index] + set num_errors [lindex $error_list 0] + # iterates through all form variables and checks if the + # value matches the datatype (which is determined by looking + # at the fourth part of the variable name) + + if { $num_errors > 0 } { + ad_return_complaint $num_errors [lindex $error_list 1] + return -code return + } + + # ns_log Notice "\n\nform_index $form_index" + + set dp_sql_structs [dp_build_sql_structs $form_index] + # create an ns_set where the key is the name of the table + # and the value is a dp_sql_struct + + # Used to store results for each table + set ora_results [ns_set create] + + # At this point, see what tables you have information for, + # add any other variables that need to go into the table, + # and do the updates + + if {![empty_string_p $dp_sql_structs]} { + + set size [ns_set size $dp_sql_structs] + for { set i 0 } { $i < $size } { incr i } { + set table_name [ns_set key $dp_sql_structs $i] + set sql_struct [ns_set value $dp_sql_structs $i] + set result [dp_sql_struct_execute \ + $db $sql_struct $table_name $db_op $where_clause] + + ns_set put $ora_results $table_name $result + } + } + + if { $release_db } { + ns_db releasehandle $db + } + + return $ora_results +} + +proc_doc dp_set_form_variables_after_query {{form_index ""} {table_name ""}} {Copy variables from the ns_set $selection into the ns_set $dp_form with the proper naming conventions for the data pipeline. Caller must have $selection (just as for [set_variables_after_query])} { + upvar selection selection + upvar dp_form dp_form + + if {![info exists selection] || [empty_string_p $selection]} { + return "" + } + + if {![info exists dp_form] || [empty_string_p dp_form]} { + set dp_form [ns_set new] + } + + set form_size [ns_set size $selection] + set form_ctr 0 + while {$form_ctr<$form_size} { + ns_set put $dp_form\ + "dp$form_index.$table_name.[ns_set key $selection $form_ctr]"\ + [ns_set value $selection $form_ctr] + incr form_ctr + } + + return $dp_form +} + +proc_doc dp_read_form_variables {{error_if_not_found_p 1}} {Reads the set from ns_getform info dp_form} { + if { [ns_getform] == "" } { + if $error_if_not_found_p { + uplevel { + ns_returnerror 500 "Missing form data" + return + } + } else { + return + } + } + uplevel { + set dp_form [ns_getform] + } +} + + +proc_doc dp_var_value {varname} { get the value of $varname one way or another: 1) if dp_form exists, it uses those values to fill the form fields. 2) if dp_form is missing, it looks for dp_select, which should be an ns_set from a [ns_db select] } { + upvar dp_form dp_form + + if [info exists dp_form] { + if {[ns_set find $dp_form $varname] != -1} { + return [ns_set get $dp_form $varname] + } else { + # strip off the data type and look for it again in dp_form. + set varname_no_data_type [join [lrange [split $varname .] 0 2] "."] + return [ns_set get $dp_form $varname_no_data_type] + } + } else { + upvar dp_select dp_select + if [info exists dp_select] { + if [empty_string_p $dp_select] { + return "" + } + set colname [lindex [split $varname .] 2] + return [ns_set get $dp_select $colname] + } else { + # give up + return + } + } +} + +proc_doc dp_export_form_value {varname} {Looks in dp_form and dp_select for the value for $varname and returns VALUE='$value' for use in an HTML form.} { + + upvar dp_form dp_form + upvar dp_select dp_select + + set value [dp_var_value $varname] + if ![empty_string_p $value] { + return "VALUE='[philg_quote_double_quotes [dp_format_var_for_display $varname $value]]'" + } else { + return + } +} + +proc_doc dp_export_form_name_value {varname} {Looks in dp_form and dp_select for the value for $varname and returns NAME='$var' VALUE='$var' for use in an HTML form.} { + + upvar dp_form dp_form + upvar dp_select dp_select + + set value [dp_var_value $varname] + if ![empty_string_p $value] { + return "NAME=\"$varname\" VALUE=\"[philg_quote_double_quotes [dp_format_var_for_display $varname $value]]\"" + } else { + return "NAME=\"$varname\"" + } +} + + +proc_doc dp_select_yn {varname} {Create a pulldown menu with the options Yes and No for $varname. Will use dp_select to set the default value} { + upvar dp_select dp_select + return "" +} + +proc_doc dp_optionlist {varname items values} {Similar to ad_generic_optionlist, except it uses dp_select to get the current value of varname} { + upvar dp_select dp_select + + set default_value [dp_var_value $varname] + + ad_generic_optionlist $items $values $default_value +} + + + +proc_doc dp_list_all_vars {} {Lists all the variables in dp_form} { + upvar dp_form dp_form + + if [empty_string_p $dp_form] { + return + } else { + set size [ns_set size $dp_form] + for {set i 0} {$i < $size} {incr i} { + lappend dp_vars [ns_set key $dp_form $i] + } + if [info exists dp_vars] { + return $dp_packed_vars + } else { + return + } + } +} + +proc_doc dp_list_packed_vars {{form_index ""} } {Lists all the variables in the dp_form that start with dp$form_index.*} { + upvar dp_form dp_form + + if {![info exists dp_form] || [empty_string_p $dp_form]} { + return + } else { + set size [ns_set size $dp_form] + for {set i 0} {$i < $size} {incr i} { + if [string match dp${form_index}.* \ + [ns_set key $dp_form $i]] { + lappend dp_packed_vars [ns_set key $dp_form $i] + } + } + if [info exists dp_packed_vars] { + return $dp_packed_vars + } else { + return + } + } +} + +proc_doc dp_formvalue {name} {Returns the value that goes with key $name in dp_form} { + upvar dp_form dp_form + + if [info exists dp_form] { + return [ns_set get $dp_form $name] + } +} + + +proc_doc dp_variable_type {varname} {Returns the datatype for $varname (really only reads the fourth part of th variable name)} { + return [lindex [split $varname .] 3] +} + +proc_doc dp_check_var {name value} {Checks the value of $name against the type of data that we expect to find. Returns null if the $name looks ok; returns an error otherwise.} { + + set type [dp_variable_type $name] + switch -exact $type { + phone { + ## It's hard to catch all the cases for phone numbers. We just make sure there + ## are at least 10 characters + if { ![empty_string_p $value] && [string length $value] < 10 } { + return "$value doesn't look like a valid phone number - please make sure that you entered in an area code" + }} + email { + ## Email address must be of the form yyy@xxx.zzz + if { ![empty_string_p $value] && ![philg_email_valid_p $value] } { + return "The email address that you typed, $value, doesn't look right to us. Examples of valid email addresses are +
        +
      • Alice1234@aol.com +
      • joe_smith@hp.com +
      • pierre@inria.fr +
      +" + }} + expr { + ## expressions are a potential security hole IF we allow people to + ## put in arbitrary strings. We limit expressions to 1 word (i.e. no + ## spaces). + set temp $value + regsub {^[ ]*} $temp "" temp + regsub {[ ]*$} $temp "" temp + if { [regexp -- { } $temp] } { + return "'$value' isn't a valid expression. Expressions can only be a single word." + }} + year { + if [regexp -- {[^0-9]} $value] { + return "'$value' isn't a valid year" + } elseif { [string length $value] != 4 } { + return "A year must be a four-digit number (you entered '$value')" + }} + int { + if [regexp -- {[^0-9]} $value] { + return "'$value' isn't an integer" + }} + money { + regsub -all {,} $value {} value + if {![empty_string_p $value] && [catch {expr $value * 2}]} { + return "'$value' isn't a real number" + }} + date { + # We have to rearrange the ascii date format for the ns_buildsqldate function + set ymd [split $value {-}] + if { [catch { ns_buildsqldate [string trimleft [lindex $ymd 1] "0"] [lindex $ymd 2] [lindex $ymd 0] }] } { + return "'$value' is not in the proper date format (YYYY-MM-DD)" + + } } + } +} + + +proc_doc dp_format_var_for_display {name value} {Formats the value of $name for the type of data that we are expecting. If there is no formatting to do, returns $value. Otherwise, returns a formatted $value.} { + + set type [dp_variable_type $name] + switch -exact $type { + money { + return [util_commify_number $value] + } + } + return $value +} + + +proc_doc dp_check_var_input { {form_index ""} } {Takes the list of variables from dp_list_all_form_vars and runs each through dp_check_var. Returns a list of [error_count, error_message]. error_message is null if there are no errors.} { + + upvar dp_form dp_form + + set exception_count 0 + + foreach var [dp_list_packed_vars $form_index] { + set value [ns_set get $dp_form $var] + set problem_with_input [dp_check_var $var $value] + if ![empty_string_p $problem_with_input] { + incr exception_count + append exception_text "
    • $problem_with_input"; + } + } + + if { $exception_count > 0 } { + return [list $exception_count $exception_text] + } + return [list 0 ""] + +} + + +proc_doc dp_add_one_col_to_sql_struct {sql_struct col_name col_value {data_type text}} {Returns a little sql bit useful for update (e.g., last_name='O''Grady'), where the value is escaped based on the data type.} { + + dp_sql_struct_add_col_name $sql_struct $col_name + + switch -exact $data_type { + year { + dp_sql_struct_add_col_val $sql_struct "to_date('$col_value','YYYY')" + } + money { + if [empty_string_p $col_value] { + dp_sql_struct_add_col_val $sql_struct "null" + } else { + # take out any commas + regsub -all {,} $col_value {} col_value + dp_sql_struct_add_col_val $sql_struct "$col_value" + }} + int { + if [empty_string_p $col_value] { + dp_sql_struct_add_col_val $sql_struct "null" + } else { + dp_sql_struct_add_col_val $sql_struct "$col_value" + }} + expr { + if [empty_string_p $col_value] { + dp_sql_struct_add_col_val $sql_struct "null" + } else { + dp_sql_struct_add_col_val $sql_struct "$col_value" + }} + clob { + if {[empty_string_p $col_value]} { + dp_sql_struct_add_col_val $sql_struct "null" + } elseif {[string length $col_value]<4000} { + dp_sql_struct_add_col_val $sql_struct "[db_null_sql [DoubleApos $col_value]]" + } else { + dp_sql_struct_add_col_val $sql_struct "empty_clob()" + dp_sql_struct_set_tcl_proc $sql_struct "ns_ora clob_dml" + dp_sql_struct_add_returning_col $sql_struct $col_name + dp_sql_struct_add_tcl_extra_arg $sql_struct \{$col_value\} + } + + } + default { + dp_sql_struct_add_col_val $sql_struct "[db_null_sql [DoubleApos $col_value]]" + } + + } +} + +proc_doc dp_build_sql_structs {{form_index ""}} { + Upvars to get the $dp_form ns_set, and builds a bunch of dp_sql_structs + that will perform the SQL necessary to process all the dp_form variables + prefixed by "dp$form_index". The return value is an + ns_set where key is table name and value is a dp_sql_struct. + + Arguments: + form_index - The only items in the $dp_form ns_set that get processed + are the ones whose keys are of the form + "dp_form$form_index.*" +} { + + upvar dp_form dp_form + + set dp_sql_structs [ns_set new] + foreach var [dp_list_packed_vars $form_index] { + set varname_parts [split $var .] + + set table_name [lindex $varname_parts 1] + set col_name [lindex $varname_parts 2] + set datatype [lindex $varname_parts 3] + + if {![info exists table_sql_struct.$table_name]} { + set table_sql_struct.$table_name [dp_sql_struct_new] + ns_set put $dp_sql_structs $table_name \ + [set table_sql_struct.$table_name] + set found_some_p 1 + } + + dp_add_one_col_to_sql_struct [set table_sql_struct.$table_name] $col_name [dp_formvalue $var] $datatype + + } + + if [info exists found_some_p] { + return $dp_sql_structs + } else { + return + } +} + +proc_doc dp_sql_struct_execute {db sql_struct table_name db_op {where_clause ""}} { + Given a dp_sql_struct and a database operation (db_opp), performs the + SQL. Currently, db_op is one of [ update | insert | update_or_insert ] +} { + switch -exact $db_op { + update { + return [dp_sql_struct_do_update \ + $db $sql_struct $table_name $where_clause] + } + insert { + return [dp_sql_struct_do_insert \ + $db $sql_struct $table_name] + } + update_or_insert { + return [dp_sql_struct_do_update_or_insert \ + $db $sql_struct $table_name $where_clause] + } + } +} + +# The next few procs make use of the dp_sql_struct abstract data type (defined +# further below). They take a dp_sql_struct and execute the proper SQL +# statement represented by it. + +# Given a dp_sql_struct, generate and perform the sql update +proc dp_sql_struct_do_update {db sql_struct table_name {where_clause ""}} { + + set full_where_clause "" + if {![empty_string_p $where_clause]} { + set full_where_clause "where $where_clause" + } + + + set col_names [dp_sql_struct_get_col_names $sql_struct] + set col_vals [dp_sql_struct_get_col_vals $sql_struct] + set name_equals_value_string "" + set i 0 + foreach col $col_names { + if {$i>0} { + append name_equals_value_string ",\n\t" + } + append name_equals_value_string "$col=[lindex $col_vals $i]" + incr i + } + + # WORKAROUND for oracle driver bug (see below). Because + # [ns_ora resultrows ...] won't work after [ns_ora clob_dml ...], + # we pre-count how many rows match the where clause. Then, + # if the [ns_ora resultrows ...] call fails, we'll use the + # pre-counted $n_rows instead. This may not be accurate if the + # state of the database changes between the pre-count and update. + set n_rows [database_to_tcl_string $db " + select count(1) from $table_name $full_where_clause + "] + + set sql [dp_sql_struct_make_sql_update_statement $sql_struct $table_name $where_clause] + set tcl_proc [dp_sql_struct_get_tcl_proc $sql_struct] + set extra_args [join [dp_sql_struct_get_tcl_extra_args $sql_struct] " "] + + eval "$tcl_proc \$db \$sql $extra_args" + +# Oumi (Jan. 11, 2000) . . . +# THERE SEEMS TO BE A BUG IN THE ORACLE DRIVER. ns_ora resultrows WON'T +# WORK IF THE LAST DML STATEMENT WAS VIA ns_ora clob_dml (or blob_dml). +# I think the problem is in line 2875 of ora8.c version 1.0.3 -- there is +# a flush_handle( dbh ) that always executes for clob_dml/blob_dml, +# clearing out dbh->connection->statement + + if {[catch { + set this_ora_result [ns_ora resultrows $db] + } error_message]} { + # error_message will say 'no active statement' after executing + # a clob_dml. We won't check the error_message though. If + # the [ns_ora resultrows $db] call failed, then just use the + # pre-counted $n_rows. + set this_ora_result $n_rows + } + + return $this_ora_result +} + +# Given a dp_sql_struct, try a SQL update. If no rows are updated, then +# try an insert. +proc_doc dp_sql_struct_do_update_or_insert {db sql_struct table_name {where_clause ""}} {} { + + set ora_result [dp_sql_struct_do_update \ + $db $sql_struct $table_name $where_clause] + + if {$ora_result == 0} { + return [dp_sql_struct_do_insert $db $sql_struct $table_name] + } +} + +# Given a dp_sql_struct, perform a SQL insert +proc_doc dp_sql_struct_do_insert {db sql_struct table_name} {} { + + set sql [dp_sql_struct_make_sql_insert_statement $sql_struct $table_name] + set tcl_proc [dp_sql_struct_get_tcl_proc $sql_struct] + set extra_args [join [dp_sql_struct_get_tcl_extra_args $sql_struct] " "] + + eval "$tcl_proc \$db \$sql $extra_args" + + return +} + +proc_doc dp_insert_checkbox {name values {on_value t} {hidden_field_name _cv} } "Inserts a checkbox and marks it if necessary (the value is on or Y). Also inserts a hidden field to record an uncheck in the box if necessary. Note that the name _cv stands for _check_vars, but is abbreviated so as to not hit the limit in the size of a get too easily." { + if { ![empty_string_p $values] } { + for {set i 0} {$i<[ns_set size $values]} {incr i} { + if {[ns_set key $values $i] == $name} { + set value [philg_quote_double_quotes [ns_set value $values $i]] + break; + } + } + } + + set str " + +" + return $str +} + +proc_doc dp_read_checkboxes {{hidden_field_name _cv} {off_value N}} "Reads all checkboxes in the form and sets their value to either Y or N. Note that this function looks for a hidden field named hidden_field_name to get a list of all marked and unmarked checkboxes. This should be used in conjunction with dp_insert_checkbox that sets up the hidden fields automatically." { + + upvar dp_form dp_form + + set size [ns_set size $dp_form] + set i 0 + + while {$i<$size} { + if { [ns_set key $dp_form $i] == $hidden_field_name} { + # list_of_vars will be created if it doesn't exist + lappend list_of_vars [ns_set value $dp_form $i] + } + incr i + } + + if { ![info exists list_of_vars] || [empty_string_p $list_of_vars] } { + return + } + + foreach cb_var $list_of_vars { + set val [ns_set get $dp_form $cb_var] + if {[empty_string_p $val]} { + ns_set put $dp_form $cb_var $off_value + } + } + return +} + + +##### All the "dp_sql_struct_*" procs define an abstract data type +##### This data structure is used for representing a Tcl statement that +##### executes a sql/dml statement. The structure stores column names, +##### +##### The structure is an ns_set that looks like: +##### Key Value +##### ---------------------- +##### col_names - a list of column names +##### col_vals - a list of column values. Each val in col_vals +##### belongs to each column in col_names respectively +##### returning_cols - list of column names for the returning clause +##### tcl_proc - tcl code to process sql; default is "ns_db dml" +##### tcl_extra_args - list of extra args to tcl statement (used for clobs) +##### +##### col_names, col_vals, and returning_cols are used informing the actual +##### sql statement. The Tcl used to execute the sql is of the form: +##### $db + +# Create a dp_sql_struct +proc dp_sql_struct_new {} { + set sql_struct [ns_set new] + dp_sql_struct_set_tcl_proc $sql_struct "ns_db dml" + return $sql_struct +} + +# Retreive "col_vals" element of the dp_sql_struct +proc dp_sql_struct_get_col_vals {sql_struct} { + return [ns_set get $sql_struct col_vals] +} + +# Add a column value to the "col_vals" element of the dp_sql_struct +proc dp_sql_struct_add_col_val {sql_struct val} { + set l [dp_sql_struct_get_col_vals $sql_struct] + lappend l $val + ns_set update $sql_struct col_vals $l +} + +# Retreive "col_names" element of the dp_sql_struct +proc dp_sql_struct_get_col_names {sql_struct} { + return [ns_set get $sql_struct col_names] +} + +# Add a column name to the "col_names" element of the dp_sql_struct +proc dp_sql_struct_add_col_name {sql_struct col} { + set l [dp_sql_struct_get_col_names $sql_struct] + lappend l $col + ns_set update $sql_struct col_names $l +} + +# Retreive "returning_cols" element of the dp_sql_struct +proc dp_sql_struct_get_returning_cols {sql_struct} { + return [ns_set get $sql_struct returning_cols] +} + +# Add a column name to the "returning_cols" element of the dp_sql_struct +proc dp_sql_struct_add_returning_col {sql_struct col_name} { + set l [dp_sql_struct_get_returning_cols $sql_struct] + lappend l $col_name + ns_set update $sql_struct returning_cols $l +} + +# Retreive "tcl_proc" element of the dp_sql_struct +proc dp_sql_struct_get_tcl_proc {sql_struct} { + return [ns_set get $sql_struct tcl_proc] +} + +# Set the "tcl_proc" element of the dp_sql_struct +proc dp_sql_struct_set_tcl_proc {sql_struct tcl_proc} { + ns_set update $sql_struct tcl_proc $tcl_proc +} + +# Retreive "tcl_extra_args" element of the dp_sql_struct +proc dp_sql_struct_get_tcl_extra_args {sql_struct} { + return [ns_set get $sql_struct tcl_extra_args] +} + +# Add an argument to the "tcl_extra_args" element of the dp_sql_struct +proc dp_sql_struct_add_tcl_extra_arg {sql_struct tcl_extra_args} { + set l [dp_sql_struct_get_tcl_extra_args $sql_struct] + lappend l $tcl_extra_args + ns_set update $sql_struct tcl_extra_args $l +} + +# Given a dp_sql_struct, form a SQL "returning" clause (e.g., +# "returning my_clob_1,my_clob_2 into :1,:2" +proc dp_sql_struct_make_returning_clause {sql_struct} { + set returning_clause "" + + set returning_cols [dp_sql_struct_get_returning_cols $sql_struct] + set i 0 + foreach col $returning_cols { + incr i + lappend bind_num_list ":$i" + } + if {$i > 0} { + set returning_clause "returning [join $returning_cols ","] into [join $bind_num_list ","]" + } + + return $returning_clause +} + +# Given a dp_sql_struct, form a SQL update statement +proc dp_sql_struct_make_sql_update_statement {sql_struct table_name where_clause} { + if {![empty_string_p $where_clause]} { + set where_clause "where $where_clause" + } + set col_names [dp_sql_struct_get_col_names $sql_struct] + set col_vals [dp_sql_struct_get_col_vals $sql_struct] + set name_equals_value_string "" + set i 0 + foreach col $col_names { + if {$i>0} { + append name_equals_value_string ",\n\t" + } + append name_equals_value_string "$col=[lindex $col_vals $i]" + incr i + } + + + return " + update $table_name set + $name_equals_value_string + $where_clause [dp_sql_struct_make_returning_clause $sql_struct]" +} + +# Given a dp_sql_struct, form a SQL insert statement +proc dp_sql_struct_make_sql_insert_statement {sql_struct table_name} { + return " + insert into $table_name ( + [join [dp_sql_struct_get_col_names $sql_struct] ","] + ) values ( + [join [dp_sql_struct_get_col_vals $sql_struct] ","] + ) [dp_sql_struct_make_returning_clause $sql_struct] + " +} + +####### END OF PROCS THAT DEFINE THE dp_sql_struct ABSTRACT DATA TYPE ######## + +util_report_successful_library_load Index: web/openacs/tcl/display-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/display-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/display-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,79 @@ +# display-defs.tcl,v 3.0 2000/02/06 03:13:09 ron Exp +# File: /tcl/css-defs.tcl +# Date: 12/27/99 +# Author: Tarik Alatovic +# Email: tarik@arsdigita.com +# +# Purpose: utility functions used for css module + +proc_doc css_generate_complete_css { db } "assumes scope is set in the callers enironment. if scope=user it assumes user_id is set in callers environment and if scope=group it assumes that group_id is set in callers environment. it returns generate css string from the css_complete table matching the provided scope" { + + upvar scope scope + + if { $scope=="group" } { + upvar group_id group_id + } + if { $scope=="user" } { + upvar user_id user_id + } + + set selection [ns_db select $db " + select selector, property, value + from css_complete + where [ad_scope_sql]"] + + set_variables_after_query + + set counter 0 + set last_selector "" + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + if { [string compare $selector $last_selector]!=0 } { + if { $counter > 0 } { + append css " \}\n" + } + append css "$selector \{ " + } else { + append css "; " + } + + append css "$property: $value" + + incr counter + set last_selector $selector + } + + if { $counter > 0 } { + append css " \}" + } else { + # no css values supplied + set css "" + } + + return $css +} + + +proc_doc css_html_color_name_p { font_name } "returns 1 if font_name is one of the html defined font names and returns 0 otherwise" { + if { [lsearch -exact { white silver gray maroon green navy purple olive teal black red lime blue magenta yellow cyan} $font_name] != -1 } { + return 1 + } else { + return 0 + } +} + +# this procedure takes a list of variable names and returns list of existing variable values +proc css_list_existing args { + set num_args [llength $args] + + set result_list [list] + for {set i 0} {$i < $num_args} {incr i} { + set element [lindex $args $i] + if { [eval uplevel {info exists $element}] } { + upvar $element temp_var + lappend result_list $temp_var + } + } + return $result_list +} Index: web/openacs/tcl/download-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/download-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/download-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,406 @@ +# /tcl/download-defs.tcl +# +# Date: Wed Jan 5 11:32:17 EST 2000 +# Location: 42��22'N 71��03'W +# Author: Usman Y. Mobin (mobin@mit.edu) +# Purpose: download module private tcl +# +# download-defs.tcl,v 3.6.2.1 2000/04/12 09:03:47 ron Exp +# ----------------------------------------------------------------------------- + +util_report_library_entry + +# This will register the procedure download_serve to serve all +# requested files starting with /download/files + +ns_register_proc GET /download/files/* download_serve +ns_register_proc POST /download/files/* download_serve + +proc download_serve { conn context } { + + set_the_usual_form_variables + + set url_stub [ns_conn url] + # This regexp will try to match our filename based on the convention + # /download/files// + # ::= + # ::= | + # ::= 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 + # ::= + + + if {[regexp {/download/files/([0-9]+)/(.*)} $url_stub match version_id pseudo_filename]} { + # we have a valid match + + set db [ns_db gethandle] + + download_version_authorize $db $version_id + + # This query will extract the directory name from the database + # where the requested file is kept. + set selection [ns_db 1row $db " + select directory_name as directory, + scope as file_scope, + group_id as gid, + download_id as did + from downloads + where download_id = (select download_id + from download_versions + where version_id = $version_id)"] + + set_variables_after_query + + if {![info exists directory] || [empty_string_p $directory]} { + # if directory is null then the above query gave no results + # which implies through a chain of reasoning that $version_id is + # not a valid version_id + ad_return_error \ + "Error in obtaining directory" \ + "There was an error in obtaining the directory name for the requested download" + # And we also log the error + ns_log Error "/tcl/download.tcl: Function download_serve + failed to determine the directory of the requested + download." + # And since we have nothing else better to do, we'll return + return + } + + if {$file_scope == "public"} { + set full_filename "[ad_parameter DownloadRoot download]$directory/$version_id.file" + } else { + # scope is group + # download_authorize $db $did + set full_filename "[ad_parameter DownloadRoot download]groups/$gid/$directory/$version_id.file" + } + + ns_db releasehandle $db + + # Now we need to log who downloaded what + # First, we need to get the user_id + set user_id [ad_verify_and_get_user_id] + + set new_user_id [ad_decode $user_id 0 "" $user_id] + + # This line will return the file with its guessed mimetype + + ns_log Notice "FILE TYPE: [ns_guesstype $pseudo_filename]" + ns_log Notice "FULL FILENAME: $full_filename" + ns_returnfile 200 [ns_guesstype $pseudo_filename] $full_filename + + # And now, we need to get the IP address of the user + set user_ip [ns_conn peeraddr] + + set db [ns_db gethandle] + + if { [database_to_tcl_string $db "select count(*) + from download_log where log_id = $new_log_id"] == 0 } { + # user did not double click + # so update the log table by inserting the log entry for + # this particular download. + + if [catch {ns_db dml $db " + insert into download_log + (log_id, version_id, user_id, entry_date, ip_address, download_reasons) + values + ($new_log_id, $version_id, '$new_user_id', [db_sysdate], '$user_ip', '$QQdownload_reasons')" } errmsg] { + # the entry is already in the log - so do nothing + ns_log Error "download_log insert choked: $errmsg" + } + } + + # And finally, we're done with the database (duh) + ns_db releasehandle $db + + # And we're also done with serving this file. + return + + } else { + # regexp didn't match => not a valid filename + # Since we can't do anything useful here, let's just + # throw an error for fun + ad_return_error "Invalid Filename" "The filename requested does not exist." + # And log the error also + ns_log Error "/tcl/download-defs.tcl: Function download_serve failed to map the url to a valid filename" + return + } + +} + +proc_doc download_admin_authorize { db download_id } "given +download_id, this procedure will check whether the user has +administration rights over this download. if download doesn't exist +page is served to the user informing him that the download doesn't +exist. if successfull it will return user_id of the administrator." { + + set selection [ns_db 0or1row $db " + select scope, group_id, download_id + from downloads + where download_id=$download_id"] + + if { [empty_string_p $selection] } { + uplevel { + ns_return 200 text/html " + [ad_scope_admin_header "Download Doesn't Exist" $db] + [ad_scope_admin_page_title "Download Doesn't Exist" $db] + [ad_scope_admin_context_bar "No Download"] +
      +
      + Requested download does not exist. +
      + [ad_scope_admin_footer] + " + } + return -code return + } + + set_variables_after_query + + switch $scope { + public { + set id 0 + } + group { + set id $group_id + } + } + + set authorization_status [ad_scope_authorization_status $db $scope admin group_admin none $id] + + set user_id [ad_verify_and_get_user_id] + + switch $authorization_status { + authorized { + return $user_id + } + not_authorized { + ad_return_warning "Not authorized" "You are not authorized to see this page" + return -code return + } + reg_required { + ad_redirect_for_registration + return -code return + } + } +} + + +proc_doc download_authorize { db download_id } "given download_id, +this procedure will check whether the user has display rights over +this download. if download doesn't exist page is served to the user +informing him that the download doesn't exist. if successfull it will +return user_id of the administrator." { + + # deprecated + + set selection [ns_db 0or1row $db " + select scope, group_id, download_id + from downloads + where download_id=$download_id"] + + if { [empty_string_p $selection] } { + uplevel { + ns_return 200 text/html " + [ad_scope_admin_header "Download Doesn't Exist" $db] + [ad_scope_admin_page_title "Download Doesn't Exist" $db] + [ad_scope_admin_context_bar "No Download"] +
      +
      + Requested download does not exist. +
      + [ad_scope_admin_footer] + " + } + return -code return + } + + set_variables_after_query + + switch $scope { + public { + set id 0 + } + group { + set id $group_id + } + } + + set authorization_status [ad_scope_authorization_status $db $scope registered group_member none $id] + + set user_id [ad_verify_and_get_user_id] + + switch $authorization_status { + authorized { + return $user_id + } + not_authorized { + ad_return_warning "Not authorized" "You are not authorized to see this page" + return -code return + } + reg_required { + ad_redirect_for_registration + return -code return + } + } +} + + +proc_doc download_version_admin_authorize { db version_id } "given +version_id, this procedure will check whether the user has +administration rights over this download. if download doesn't exist +page is served to the user informing him that the download doesn't +exist. if successfull it will return user_id of administrator." { + + set selection [ns_db 0or1row $db "select download_id + from download_versions + where version_id = $version_id "] + + if { [empty_string_p $selection] } { + ad_scope_return_complaint 1 "Download Version Doesn't Exist" $db + return -code return + } + + set_variables_after_query + + return [download_admin_authorize $db $download_id] + +} + +proc_doc download_version_authorize { db version_id } "given +version_id, this procedure will check whether the user has visibility +rights over this download. if download doesn't exist page is served to +the user informing him that the download doesn't exist. if successfull +it will return user_id of the user" { + + set selection [ns_db 0or1row $db "select download_id + from download_versions + where version_id = $version_id "] + + if { [empty_string_p $selection] } { + ad_scope_return_complaint 1 "Download Version Doesn't Exist" $db + return -code return + } + + set_variables_after_query + + set user_id [ad_verify_and_get_user_id] + + set user_authorization_status [database_to_tcl_string $db " + select download_authorized_p($version_id, $user_id) from dual"] + + switch $user_authorization_status { + authorized { + return $user_id + } + not_authorized { + ad_return_warning "Not authorized" "You are not authorized to see this page" + return -code return + } + reg_required { + ad_redirect_for_registration + return -code return + } + } + +} + +proc_doc download_mkdir {dirname} "Ensures that \$dirname exists. Won't cause +an error if the directory is already there. Better than the stardard +mkdir because it will make all the directories leading up to +\$dirname" { + set dir_list [split $dirname /] + set needed_dir "" + foreach dir $dir_list { + if [empty_string_p $dir] { + continue + } + append needed_dir "/$dir" + if ![file exists $needed_dir] { + ns_mkdir $needed_dir + } + } +} + +# this procedure deletes the download version file from file storge +# and related data from the database + +proc download_version_delete {db version_id} { + + download_version_admin_authorize $db $version_id + + set selection [ns_db 0or1row $db " + select download_id, + pseudo_filename + from download_versions + where version_id = $version_id "] + + if { [empty_string_p $selection] } { + ad_scope_return_complaint 1 "Download version doesn't exist" $db + return -code return + } + + set_variables_after_query + + set selection [ns_db 1row $db " + select directory_name, + scope as file_scope, + group_id as gid + from downloads + where download_id = $download_id"] + + set_variables_after_query + + if {$file_scope == "public"} { + set full_filename "[ad_parameter DownloadRoot download]$directory_name/$version_id.file" + set notes_filename "[ad_parameter DownloadRoot download]$directory_name/$version_id.notes" + } else { + # scope is group + # download_authorize $db $did + set full_filename "[ad_parameter DownloadRoot download]groups/$gid/$directory_name/$version_id.file]" + set notes_filename "[ad_parameter DownloadRoot download]groups/$gid/$directory_name/$version_id.notes" + } + + set aol_version [ns_info version] + + if { $aol_version < 3.0 } { + set file_delete_command "exec /bin/rm" + } else { + set file_delete_command "file delete" + } + + if [catch {eval $file_delete_command $full_filename} errmsg] { + ad_scope_return_complaint 1 " +
    • File $full_filename could not be deleted because of the following error: +
      $errmsg
      " $db + return + } else { + + eval $file_delete_command $notes_filename + + ns_db dml $db "begin transaction" + ns_db dml $db "delete from download_log where version_id = $version_id" + ns_db dml $db "delete from download_rules where version_id = $version_id" + ns_db dml $db "delete from download_versions where version_id = $version_id" + ns_db dml $db "end transaction" + } +} + +proc_doc download_date_form_check { form date_name } "checks that date_name is a valid date. Returns a list of date_name exception_count, exception_text. Sets date_name to a YYYY-MM-DD format." { + + set encoded_date [ns_urlencode $date_name] + + ns_set update $form "ColValue.$encoded_date.day" [string trimleft [ns_set get $form ColValue.$encoded_date.day] "0"] + + # check that either all elements are blank or date is formated + # correctly for ns_dbformvalue + if { [empty_string_p [ns_set get $form ColValue.$encoded_date.day]] && + [empty_string_p [ns_set get $form ColValue.$encoded_date.year]] && + [empty_string_p [ns_set get $form ColValue.$encoded_date.month]] } { + return [list "" 0 ""] + } elseif { [catch { ns_dbformvalue $form $date_name date $date_name} errmsg ] } { + return [list "" 1 "
    • The date or time was specified in the wrong format. The date should be in the format Month DD YYYY.\n"] + } elseif { ![empty_string_p [ns_set get $form ColValue.$encoded_date.year]] && [string length [ns_set get $form ColValue.$encoded_date.year]] != 4 } { + return [list "" 1 "
    • The year needs to contain 4 digits.\n"] + } + return [list [set $date_name] 0 ""] +} + +util_report_successful_library_load Index: web/openacs/tcl/ecommerce-credit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ecommerce-credit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ecommerce-credit.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,702 @@ +# ecommerce-credit.tcl,v 3.1 2000/02/08 05:59:16 eveander Exp +## Procedures related to credit card transactions for the ecommerce module +## Started April, 1999 by Eve Andersson (eveander@arsdigita.com) +## Other ecommerce procedures can be found in ecommerce-*.tcl + +# If transaction_id is null, it tries to do an auth for the entire +# order; otherwise it tries to do an auth for the tranaction_amount. +# You can leave order_id blank if you're using a transaction_id +# (useful for gift certificates). +proc ec_creditcard_authorization { db order_id {transaction_id ""} } { + + # Gets info it needs from database. + # Calls ec_talk_to_cybercash to authorize card (which in turn writes a line + # to the ec_cybercash_log table). + # Outputs one of the following strings, corresponding to the level of + # authorization: + # (a) failed_authorization + # (b) authorized_plus_avs + # (c) authorized_minus_avs + # (d) no_recommendation + # (e) invalid_input + # Case (d) occurs when CyberCash gives an error that is unrelated to + # the credit card used, such as timeout or failure-q-or-cancel. + # Case (e) occurs when there are no orders with the given order_id + # or with no billing_zip_code. This case shouldn't + # happen, since this proc is called from a tcl script with known + # order_id, and billing_zip_code shouldn't be null. + + if { [empty_string_p $transaction_id] } { + set total_amount [database_to_tcl_string $db "select ec_order_cost($order_id) from dual"] + set creditcard_id [database_to_tcl_string $db "select creditcard_id from ec_orders where order_id=$order_id"] + set youth [database_to_tcl_string $db "select case when sysdate()-confirmed_date Either your credit card type or your credit card number is incorrect (they don't match)." + } + if { [string length $creditcard_number] != 16 } { + incr exception_count + append exception_text "
    • Your credit card number doesn't have the right number of digits." + } + } elseif {[string index $creditcard_number 0] == 4} { + if {[info exists creditcard_type] && ![empty_string_p $creditcard_type] && [string compare $creditcard_type "v"] != 0 } { + incr exception_count + append exception_text "
    • Either your credit card type or your credit card number is incorrect (they don't match)." + } + if { [string length $creditcard_number] != 16 } { + incr exception_count + append exception_text "
    • Your credit card number doesn't have the right number of digits." + } + } elseif {[string index $creditcard_number 0] == 3} { + if {[info exists creditcard_type] && ![empty_string_p $creditcard_type] && [string compare $creditcard_type "a"] != 0 } { + incr exception_count + append exception_text "
    • Either your credit card type or your credit card number is incorrect (they don't match)." + } + if { [string length $creditcard_number] != 15 } { + incr exception_count + append exception_text "
    • Your credit card number doesn't have the right number of digits." + } + } else { + if {[info exists creditcard_type] && ![empty_string_p $creditcard_type]} { + incr exception_count + append exception_text "
    • Sorry, the credit card number you input is not a Mastercard, Visa, or American Express card number." + } + } + + # only if there haven't been any problems so far should we do LUHN-10 error + # checking which the customer is less likely to understand + if { $exception_count == 0 } { + set vallas_creditcard_type [ec_decode [ec_creditcard_validation $creditcard_number] "MasterCard" "m" "VISA" "v" "American Express" "a" "other"] + if { $vallas_creditcard_type != $creditcard_type } { + incr exception_count + append exception_text "
    • There's something wrong with the credit card number you entered. Please check whether you have any transposed digits, missing digits, or similar errors." + } + } + return [list $exception_count $exception_text] +} + + + + + + +# This procedure, originally called valCC, by Horace Vallas was +# found at http://www.hav.com/valCC/nph-src.htm?valCC.nws +# (with an HTML demo at https://enterprise.neosoft.com/secureforms/hav/default.htm). +# It has been left unchanged except for the name. -- eveander@arsdigita.com + +# H.V.'s comments: + +# This is a demo NeoWebScript by Horace Vallas - 3-7-97 according to some info +# I found on the web that was attibuted to ICVERIFY by Hal Stiles hstiles@beachnet.com +# http://www.beachnet.com/~hstiles/cardtype.html +# +# You are welcome to use it; however, I make no warranty whatsoever about the +# accuracy or usefullness of this script. By using this script, you are agreeing that +# I am not responsible for any damage, of any kind whatsoever, to you or to any of +# your customers, clients, partners, friends, relatives, children born or unborne, +# pets, invisible friends, etc. etc. etc. +#=============================================================== + +# The valCC proc can be used to validate a credit card number as +# being legally formed. +# +# input is the entered card number +# return is the type of card (if validated) +# or "- unknown-" if it is an unknown or invalid number +# +# The validation applied (last known date 3/96) is the so called +# LUHN Formula (Mod 10) for Validation of Primary Account Number +# Validation criteria are: +# +# 1. number prefix +# 2. number of digits +# 3. mod10 (for all but enRoute which uses only 1 & 2) +# +# ... according to the following list of criteria requirements: +# +# Card Type Prefix Length Check-Digit Algoritm +# +# MC 51 - 55 16 mod 10 +# +# VISA 4 13, 16 mod 10 +# +# AMX 34, 37 15 mod 10 +# +# Diners Club / 300 - 305, 36, 38 14 mod 10 +# Carte Blanche +# +# Discover 6011 16 mod 10 +# +# enRoute 2014, 2149 16 - any - +# +# JCB 3 16 mod 10 +# JCB 2131, 1800 15 mod 10 +# + +# Original name: valCC +proc ec_creditcard_validation {numIn} { + regsub -all { } $numIn {} entered_number + set num [split $entered_number {}] ; # a list form of the number + set numLen [llength $num] ; # the number of digits in the entered number + set type "-unknown-" + + # first determine the type of card: MC, VISA, AMX, etc. + # i.e. test prefix and then number of digits + + switch -glob [string range $entered_number 0 3] { + + "51??" - "52??" - "53??" - "54??" - "55??" + {if {$numLen == 16} {set type "MasterCard"}} + "4???" + {if {$numLen == 13 || $numLen == 16} {set type "VISA"}} + "34??" - "37??" + {if {$numLen == 15} {set type "American Express"}} + "300?" - "301?" - "302?" - "303?" - "304?" - "305?" - "36??" - "38??" + {if {$numLen == 14} {set type "Diner's Club / Carte Blanche"}} + "6011" + {if {$numLen == 16} {set type "Discover"}} + "2014" - "2149" + {if {$numLen == 15} {set type "enRoute"}; return $type ; # early exit for enRoute} + "3???" + {if {$numLen == 16} {set type "JCB"}} + "2131" - "1800" + {if {$numLen == 15} {set type "JCB"}} + default + {set type "-unknown-"} + } + if {$type == "-unknown-"} { + return $type} ; #early exit if we already know it is bad + + # if prefix and number of digits are ok, + # then apply the mod10 check + + set sum 0 ; # initialize the running sum + + # sum every digit starting with the RIGHT-MOST digit + # on alternate digits (starting with the NEXT-TO-THE-RIGHT-MOST digit) + # sum all digits in the result of TWO TIMES the alternate digit + # RATHER than the original digit itself + + if {[catch { ; # CATCH this summing loop in case there are non-digit values in the user supplied string + for {set i [expr $numLen - 1]} {$i >= 0} {} { + incr sum [lindex $num $i] + if {[incr i -1] >= 0} { + foreach adigit [split [expr 2 * [lindex $num $i]] {}] {incr sum $adigit} + incr i -1 + } + } + }] != 0} { + return "-unknown-" + } + + # emulate a mod 10 (base 10) on the calculated number. + # if there is any remainder, then the number IS NOT VALID + # so reset type to -unknown- + + set lsum [split $sum {}] + if {[lindex $lsum [expr [llength $lsum] - 1]]} {set type "-unknown-"} + + return $type +} \ No newline at end of file Index: web/openacs/tcl/ecommerce-customer-service.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ecommerce-customer-service.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ecommerce-customer-service.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,142 @@ +# ecommerce-customer-service.tcl,v 3.1 2000/03/07 03:42:07 eveander Exp +## Customer service procedures for the ecommerce module +## Started April, 1999 by Eve Andersson (eveander@arsdigita.com) +## Other ecommerce procedures can be found in ecommerce-*.tcl + +proc ec_customer_service_email_address { user_identification_id issue_id } { +# return "service-$user_identification_id-$issue_id@[ad_parameter LocalDomain ecommerce]" + # For now this has to just return the default outgoing email address, until + # qmail is set up to accept incoming email and stuff it into the database + # correctly based on the email address (generated by the commented-out line + # above). + return [ad_parameter CustomerServiceEmailAddress ecommerce] +} + +proc ec_customer_service_signature {} { + return "Customer Service +[ad_parameter CustomerServiceEmailAddress ecommerce] +[ec_insecure_url] +" +} + +# Creates an issue, interaction, and action and closes the issue. +# Either user_id or user_identification_id should be non-null. +# Often ec_customer_service_simple_issue is called from another +# procedure within a transaction, so you will not want to begin/end +# a transaction within ec_customer_service_simple_issue. In these +# cases, leave begin_new_transaction_p as "f". + +proc ec_customer_service_simple_issue { db customer_service_rep interaction_originator interaction_type interaction_headers order_id issue_type_list action_details {user_id ""} {user_identification_id ""} {begin_new_transaction_p "f"} {gift_certificate_id ""} } { + + if { $begin_new_transaction_p == "t" } { + ns_db dml $db "begin transaction" + } + + if { ![empty_string_p $user_id] } { + set selection [ns_db select $db "select user_identification_id from ec_user_identification where user_id=$user_id"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_db flush $db + break + } + + if { [empty_string_p $user_identification_id] } { + # no previous customer service interaction with this user, so + # insert them into ec_user_identification + set user_identification_id [db_sequence_nextval $db ec_user_ident_id_sequence] + ns_db dml $db "insert into ec_user_identification (user_identification_id, user_id) values ($user_identification_id, $user_id)" + } + } + + # now we have a non-null user_identification_id to use in the issue/interaction + + set interaction_id [db_sequence_nextval $db ec_interaction_id_sequence] + + ns_db dml $db "insert into ec_customer_serv_interactions + (interaction_id, customer_service_rep, user_identification_id, interaction_date, interaction_originator, interaction_type, interaction_headers) + values + ($interaction_id, [db_null_sql $customer_service_rep], $user_identification_id, sysdate(), '[DoubleApos $interaction_originator]', '[DoubleApos $interaction_type]', '[DoubleApos $interaction_headers]') + " + + set issue_id [db_sequence_nextval $db ec_issue_id_sequence] + ns_db dml $db "insert into ec_customer_service_issues + (issue_id, user_identification_id, order_id, open_date, close_date, closed_by, gift_certificate_id) + values + ($issue_id, $user_identification_id, [ns_dbquotevalue $order_id], sysdate(), sysdate(), [db_null_sql $customer_service_rep], [ns_dbquotevalue $gift_certificate_id]) + " + + foreach issue_type $issue_type_list { + ns_db dml $db "insert into ec_cs_issue_type_map (issue_id, issue_type) values ($issue_id, '[DoubleApos $issue_type]')" + } + + set action_id [db_sequence_nextval $db ec_action_id_sequence] + ns_db dml $db "insert into ec_customer_service_actions + (action_id, issue_id, interaction_id, action_details) + values + ($action_id, $issue_id, $interaction_id, '[DoubleApos $action_details]') + " + + if { $begin_new_transaction_p == "t" } { + ns_db dml $db "end transaction" + } + + # since the interaction and action are done with, the important things to return are + # the user_identification_id and the issue_id + return [list $user_identification_id $issue_id] +} + + +# either user_id or user_identification_id should be non-empty +proc ec_all_cs_issues_by_one_user { db {user_id ""} {user_identification_id ""} } { + set to_return "
        " + + if { ![empty_string_p $user_id] } { + set selection [ns_db select $db "(select i.issue_id, i.open_date, i.close_date, m.issue_type + from ec_customer_service_issues i, ec_cs_issue_type_map m, ec_user_identification id + where i.issue_id=m.issue_id + and i.user_identification_id=id.user_identification_id + and id.user_id=$user_id) union (select i.issue_id, i.open_date, i.close_date, NULL as issue_type + from ec_customer_service_issues i, ec_user_identification id + where 0=(select count(*) from ec_cs_issue_type_map where issue_id=i.issue_id) + and i.user_identification_id=id.user_identification_id + and id.user_id=$user_id) + order by i.issue_id"] + } else { + set selection [ns_db select $db "(select i.issue_id, i.open_date, i.close_date, m.issue_type + from ec_customer_service_issues i, ec_cs_issue_type_map m + where i.issue_id=m.issue_id + and i.user_identification_id=$user_identification_id) union + (select i.issue_id, i.open_date, i.close_date, m.issue_type + from ec_customer_service_issues i + where 0=(select count(*) from ec_cs_issue_type_map where issue_id=i.issue_id) + and i.user_identification_id=$user_identification_id) + order by i.issue_id"] + } + + set old_issue_id "" + set issue_type_list [list] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $issue_id != $old_issue_id } { + if { [llength $issue_type_list] > 0 } { + append to_return " ([join $issue_type_list ", "])" + set issue_type_list [list] + } + append to_return "
      • $issue_id: opened [util_AnsiDatetoPrettyDate $open_date]" + if { ![empty_string_p $close_date] } { + append to_return ", closed [util_AnsiDatetoPrettyDate $close_date]" + } + } + if { ![empty_string_p $issue_type] } { + lappend issue_type_list $issue_type + } + set old_issue_id $issue_id + } + if { [llength $issue_type_list] > 0 } { + append to_return " ([join $issue_type_list ", "])" + } + + append to_return "
      " + return $to_return +} Index: web/openacs/tcl/ecommerce-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ecommerce-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ecommerce-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,1176 @@ +# ecommerce-defs.tcl,v 3.5.2.2 2000/03/16 04:02:21 eveander Exp +## Definitions for the ecommerce module +## Started April, 1999 by Eve Andersson (eveander@arsdigita.com) +## Other ecommerce procedures can be found in ecommerce-*.tcl + +proc ec_system_name {} { + return "[ad_parameter SystemName] Store" +} + +proc ec_header_image {} { + return "[ec_system_name]" +} + +proc ec_system_owner {} { + return [ad_system_owner] +} + +# current_location can be "Shopping Cart", "Your Account", "Home", or +# any category_id +proc ec_footer { db {current_location ""} {category_id ""} {search_text ""} } { + set to_return "
      +
      +[ec_search_widget $db $category_id $search_text] " + if { [string compare $current_location "Shopping Cart"] == 0 } { + append to_return "Shopping Cart" + } else { + append to_return "Shopping Cart" + } + append to_return " | " + if { [string compare $current_location "Your Account"] == 0 } { + append to_return "Your Account" + } else { + append to_return "Your Account" + } + append to_return " | " + if { [string compare $current_location "Home"] == 0 } { + append to_return "Home" + } else { + append to_return "Home" + } + append to_return "
      + [ad_site_home_link] +
      + " + return $to_return +} + +# For administrators +proc ec_shipping_cost_summary { base_shipping_cost default_shipping_per_item weight_shipping_cost add_exp_base_shipping_cost add_exp_amount_per_item add_exp_amount_by_weight } { + + set currency [ad_parameter Currency ecommerce] + + if { ([empty_string_p $base_shipping_cost] || $base_shipping_cost == 0) && ([empty_string_p $default_shipping_per_item] || $default_shipping_per_item == 0) && ([empty_string_p $weight_shipping_cost] || $weight_shipping_cost == 0) && ([empty_string_p $add_exp_base_shipping_cost] || $add_exp_base_shipping_cost == 0) && ([empty_string_p $add_exp_amount_per_item] || $add_exp_amount_per_item == 0) && ([empty_string_p $add_exp_amount_by_weight] || $add_exp_amount_by_weight == 0) } { + return "The customers are not charged for shipping beyond what is specified for each product individually." + } + + if { [empty_string_p $base_shipping_cost] || $base_shipping_cost == 0 } { + set shipping_summary "For each order, there is no base cost. However, " + } else { + set shipping_summary "For each order, there is a base cost of [ec_pretty_price $base_shipping_cost $currency]. On top of that, " + } + + if { ([empty_string_p $weight_shipping_cost] || $weight_shipping_cost == 0) && ([empty_string_p $default_shipping_per_item] || $default_shipping_per_item == 0) } { + append shipping_summary "the per-item cost is set using the amount in the \"Shipping Price\" field of each item (or \"Shipping Price - Additional\", if more than one of the same product is ordered). " + } elseif { [empty_string_p $weight_shipping_cost] || $weight_shipping_cost == 0 } { + append shipping_summary "the per-item cost is [ec_pretty_price $default_shipping_per_item $currency], unless the \"Shipping Price\" has been set for that product (or \"Shipping Price - Additional\", if more than one of the same product is ordered). " + } else { + append shipping_summary "the per-item-cost is equal to [ec_pretty_price $weight_shipping_cost $currency] times its weight in [ad_parameter WeightUnits ecommerce], unless the \"Shipping Price\" has been set for that product (or \"Shipping Price - Additional\", if more than one of the same product is ordered). " + } + + if { ([empty_string_p $add_exp_base_shipping_cost] || $add_exp_base_shipping_cost == 0) && ([empty_string_p $add_exp_amount_per_item] || $add_exp_amount_per_item == 0) && ([empty_string_p $add_exp_amount_by_weight] || $add_exp_amount_by_weight == 0) } { + set express_part_of_shipping_summary "There are no additional charges for express shipping. " + } else { + if { ![empty_string_p $add_exp_base_shipping_cost] && $add_exp_base_shipping_cost != 0 } { + set express_part_of_shipping_summary "An additional amount of [ec_pretty_price $add_exp_base_shipping_cost $currency] is added to the base cost for Regular Shipping. " + } + if { ![empty_string_p $add_exp_amount_per_item] && $add_exp_amount_per_item != 0 } { + append express_part_of_shipping_summary "An additional amount of [ec_pretty_price $add_exp_amount_per_item $currency] is added for each item, on top of the amount charged for Regular Shipping. " + } + if { ![empty_string_p $add_exp_amount_by_weight] && $add_exp_amount_by_weight != 0 } { + append express_part_of_shipping_summary "An additional amount of [ec_pretty_price $add_exp_amount_by_weight $currency] times the weight in [ad_parameter WeightUnits ecommerce] of each item is added, on top of the amount charged for Regular Shipping. " + } + } + +return "Regular (Non-Express) Shipping: +

      +

      +$shipping_summary +
      +

      +Express Shipping: +

      +

      +$express_part_of_shipping_summary +
      +" +} + + +# for one product, displays the sub/sub/category info in a table. +proc_doc ec_category_subcategory_and_subsubcategory_display { db category_list subcategory_list subsubcategory_list } "Returns an HTML table of category, subcategory, and subsubcategory information" { + + if { [empty_string_p $category_list] } { + return "None Defined" + } + + set to_return "\n" + foreach category_id $category_list { + append to_return "\n" + set tr_done 1 + + if { ![empty_string_p $subcategory_list] } { + set relevant_subcategory_list [database_to_tcl_list $db "select subcategory_id from ec_subcategories where category_id=$category_id and subcategory_id in ([join $subcategory_list ","]) order by subcategory_name"] + } else { + set relevant_subcategory_list [list] + } + + + if { [llength $relevant_subcategory_list] == 0 } { + append to_return "\n" + } else { + append to_return "" + + foreach subcategory_id $relevant_subcategory_list { + + if { $tr_done } { + set tr_done 0 + } else { + append to_return "\n" + } + + append to_return "" + + } ; # end foreach subcategory_id + + } ; # end of case where relevant_subcategory_list is non-empty + + } ; # end foreach category_id + append to_return "
      [ec_space_to_nbsp [database_to_tcl_string $db "select category_name from ec_categories where category_id=$category_id"]][ec_space_to_nbsp [database_to_tcl_string $db "select category_name from ec_categories where category_id=$category_id"]]
       -- [ec_space_to_nbsp [database_to_tcl_string $db "select subcategory_name from ec_subcategories where subcategory_id=$subcategory_id"]]" + + if { ![empty_string_p $subsubcategory_list] } { + set relevant_subsubcategory_name_list [database_to_tcl_list $db "select subsubcategory_name from ec_subsubcategories where subcategory_id=$subcategory_id and subsubcategory_id in ([join $subsubcategory_list ","]) order by subsubcategory_name"] + } else { + set relevant_subsubcategory_name_list [list] + } + + foreach subsubcategory_name $relevant_subsubcategory_name_list { + append to_return " -- [ec_space_to_nbsp $subsubcategory_name]
      \n" + } + + + append to_return "
      \n" + return $to_return +} + + + +proc ec_product_name_internal {product_id} { + set db [ns_db gethandle subquery] + set value [database_to_tcl_string_or_null $db "select product_name from ec_products where product_id = $product_id"] + ns_db releasehandle $db + return $value +} + +proc_doc ec_product_name {product_id {value_if_not_found ""}} "Returns product name from product_id, memoized for efficiency" { + # throw an error if this isn't an integer (don't want security risk of user-entered + # data being eval'd) + validate_integer "product_id" $product_id + set tentative_name [util_memoize "ec_product_name_internal $product_id" 3600] + if [empty_string_p $tentative_name] { + return $value_if_not_found + } else { + return $tentative_name + } +} + + +# given a category_id, subcategory_id, and subsubcategory_id +# (can be null), displays the full categorization, e.g. +# category_name: subcategory_name: subsubcategory_name. +# If you have a subcategory_id but not a category_id, this +# will look up the category_id to find the category_name. +proc ec_full_categorization_display { db {category_id ""} {subcategory_id ""} {subsubcategory_id ""} } { + if { [empty_string_p $category_id] && [empty_string_p $subcategory_id] && [empty_string_p $subsubcategory_id] } { + return "" + } elseif { ![empty_string_p $subsubcategory_id] } { + if { [empty_string_p $subcategory_id] } { + set subcategory_id [database_to_tcl_string $db "select subcategory_id from ec_subsubcategories where subsubcategory_id=$subsubcategory_id"] + } + if { [empty_string_p $category_id] } { + set category_id [database_to_tcl_string $db "select category_id from ec_subcategories where subcategory_id=$subcategory_id"] + } + return "[database_to_tcl_string $db "select category_name from ec_categories where category_id=$category_id"]: [database_to_tcl_string $db "select subcategory_name from ec_subcategories where subcategory_id=$subcategory_id"]: [database_to_tcl_string $db "select subsubcategory_name from ec_subsubcategories where subsubcategory_id=$subsubcategory_id"]" + } elseif { ![empty_string_p $subcategory_id] } { + if { [empty_string_p $category_id] } { + set category_id [database_to_tcl_string $db "select category_id from ec_categories where subcategory_id=$subcategory_id"] + } + return "[database_to_tcl_string $db "select category_name from ec_categories where category_id=$category_id"]: [database_to_tcl_string $db "select subcategory_name from ec_subcategories where subcategory_id=$subcategory_id"]" + } else { + return "[database_to_tcl_string $db "select category_name from ec_categories where category_id=$category_id"]" + } +} + +# returns a link for the user to add him/herself to the mailing list for whatever category/ +# subcategory/subsubcategory a product is in. +# If the product is multiply categorized, this will just use the first categorization that +# Oracle finds for this product. +proc ec_mailing_list_link_for_a_product { db product_id } { + set category_id "" + set subcategory_id "" + set subsubcategory_id "" + + set selection [ns_db select $db "select category_id from ec_category_product_map where product_id=$product_id"] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_db flush $db + break + } + + if { ![empty_string_p $category_id] } { + set selection [ns_db select $db "select s.subcategory_id + from ec_subcategory_product_map m, ec_subcategories s + where m.subcategory_id=s.subcategory_id + and s.category_id=$category_id + and m.product_id=$product_id"] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_db flush $db + break + } + + if { ![empty_string_p $subcategory_id] } { + set selection [ns_db select $db "select ss.subsubcategory_id + from ec_subsubcategory_product_map m, ec_subsubcategories ss + where m.subsubcategory_id=ss.subsubcategory_id + and ss.subcategory_id=$subcategory_id + and m.product_id=$product_id"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_db flush $db + break + } + } + } + + return "Add yourself to the [ec_full_categorization_display $db $category_id $subcategory_id $subsubcategory_id] mailing list!" +} + +proc ec_space_to_nbsp { the_string } { + regsub -all " " $the_string "\\ " new_string + return $new_string +} + +# Given a product's rating, if the star gifs exist, it will +# print out the appropriate # (to the nearest half); otherwise +# it will just say what the rating is (to the nearest half). +# The stars should be in the subdirectory /graphics of the ecommerce +# user pages and they should be named star-full.gif, star-empty.gif, +# star-half.gif +proc ec_display_rating { rating } { + set double_ave_rating [expr $rating * 2] + set double_rounded_rating [expr round($double_ave_rating)] + set rating_to_nearest_half [expr double($double_rounded_rating)/2] + + # see if images exist + set full_dirname "[ad_parameter EcommerceDirectory ecommerce]graphics" + regexp {/www(.*)} $full_dirname match web_directory + + set n_full_stars [expr floor($rating_to_nearest_half)] + if { $n_full_stars == $rating_to_nearest_half } { + set n_half_stars 0 + } else { + set n_half_stars 1 + } + set n_empty_stars [expr 5 - $n_full_stars - $n_half_stars] + + if { [file exists "$full_dirname/star-full.gif"] && + [file exists "$full_dirname/star-empty.gif"] && + [file exists "$full_dirname/star-half.gif"] } { + set full_star_gif_size [ns_gifsize "$full_dirname/star-full.gif"] + set half_star_gif_size [ns_gifsize "$full_dirname/star-half.gif"] + set empty_star_gif_size [ns_gifsize "$full_dirname/star-empty.gif"] + + set rating_to_print "" + for { set counter 0 } { $counter < $n_full_stars } { incr counter } { + append rating_to_print "\"Star\"" + } + for { set counter 0 } { $counter < $n_half_stars } { incr counter } { + append rating_to_print "\"Half" + } + for { set counter 0 } { $counter < $n_empty_stars } { incr counter } { + append rating_to_print "\"Empty" + } + } else { + # the graphics don't exist + set rating_to_print "" + for { set counter 0 } { $counter < $n_full_stars } { incr counter } { + append rating_to_print "*" + } + for { set counter 0 } { $counter < $n_half_stars } { incr counter } { + append rating_to_print "½" + } + append rating_to_print "" + for { set counter 0 } { $counter < $n_empty_stars } { incr counter } { + append rating_to_print "*" + } + append rating_to_print "" + } + return $rating_to_print +} + +proc ec_product_links_if_they_exist { db product_id } { + set to_return "

      + We think you may also be interested in: +

        + " + set selection [ns_db select $db "select p.product_id, p.product_name from ec_products_displayable p, ec_product_links l where l.product_a=$product_id and l.product_b=p.product_id"] + set link_counter 0 + while { [ns_db getrow $db $selection] } { + incr link_counter + set_variables_after_query + append to_return "
      • $product_name\n" + } + if { $link_counter == 0 } { + return "" + } else { + return "$to_return
      \n

      \n" + } +} + +proc ec_professional_reviews_if_they_exist { db product_id } { + set selection [ns_db select $db "select publication, author_name, review_date, review from ec_product_reviews where product_id=$product_id and display_p='t'"] + + set product_reviews "" + while { [ns_db getrow $db $selection] } { + if { [empty_string_p $product_reviews] } { + append product_reviews "Professional Reviews\n

      \n" + } + set_variables_after_query + append product_reviews "$review
      \n -- [ec_product_review_summary $author_name $publication $review_date]

      \n" + } + if { ![empty_string_p $product_reviews] } { + return "

      + $product_reviews + " + } else { + return "" + } +} + +# this won't show anything if ProductCommentsAllowP=0 +proc ec_customer_comments { db product_id {comments_sort_by ""} {prev_page_url ""} {prev_args_list ""} } { + + if { [ad_parameter ProductCommentsAllowP ecommerce] == 0 } { + return "" + } + + set end_of_comment_query "" + set sort_blurb "" + + if { [ad_parameter ProductCommentsNeedApprovalP ecommerce] == 1 } { + append end_of_comment_query "and c.approved_p='t'" + } else { + append end_of_comment_query "and (c.approved_p='t' or c.approved_p is null)\n" + } + + if { $comments_sort_by == "rating" } { + append end_of_comment_query "\norder by c.rating desc" + append sort_blurb "sorted by rating | sort by date" + } else { + append end_of_comment_query "\norder by c.last_modified desc" + append sort_blurb "sorted by date | sort by rating" + } + + set to_return "
      + [ad_system_name] Member Reviews: + " + + set comments_to_print "" + set selection [ns_db select $db "select c.one_line_summary, c.rating, c.user_comment, to_char(c.last_modified,'Day Month DD, YYYY') as last_modified_pretty, u.email, u.user_id +from ec_product_comments c, users u +where c.user_id = u.user_id +and c.product_id = $product_id +$end_of_comment_query"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + append comments_to_print "$email rated this product [ec_display_rating $rating] on $last_modified_pretty and wrote:
      + $one_line_summary
      + $user_comment +

      + " + } + + if { ![empty_string_p $comments_to_print] } { + append to_return "average customer review [ec_display_rating [database_to_tcl_string $db "select avg(rating) from ec_product_comments where product_id=$product_id and approved_p='t'"]]
      + Number of reviews: [database_to_tcl_string $db "select count(*) from ec_product_comments where product_id=$product_id and (approved_p='t' [ec_decode [ad_parameter ProductCommentsNeedApprovalP ecommerce] "0" "or approved_p is null" ""])"] ($sort_blurb) + +

      + + $comments_to_print + +

      + + Write your own review! + " + } else { + append to_return "

      \nBe the first to review this product!\n" + } + +} + +proc ec_add_to_cart_link { db product_id {add_to_cart_button_text "Add to Cart"} {preorder_button_text "Pre-order This Now!"} {form_action "shopping-cart-add.tcl"} {order_id ""} } { + set selection [ns_db 1row $db "select case when sysdate()>available_date then 1 else 0 end as available_p, color_list, size_list, style_list from ec_products where product_id=$product_id"] + + set_variables_after_query + + if { ![empty_string_p $color_list] } { + set color_widget "Color: \n
      \n" + } else { + set color_widget [philg_hidden_input color_choice ""] + } + + if { ![empty_string_p $size_list] } { + set size_widget "Size: \n
      \n" + } else { + set size_widget [philg_hidden_input size_choice ""] + } + + if { ![empty_string_p $style_list] } { + set style_widget "Style: \n
      \n" + } else { + set style_widget [philg_hidden_input style_choice ""] + } + + if { $available_p } { + return "

      + [export_form_vars product_id] + [ec_decode $order_id "" "" [export_form_vars order_id]] + $color_widget $size_widget $style_widget + +
      + " + } else { + set available_date [database_to_tcl_string $db "select to_char(available_date,'Month DD, YYYY') available_date from ec_products where product_id=$product_id"] + if { [ad_parameter AllowPreOrdersP ecommerce] } { + return "
      + [export_form_vars product_id] + [ec_decode $order_id "" "" [export_form_vars order_id]] + $color_widget $size_widget $style_widget + (Available $available_date) +
      + " + } else { + return "This item cannot yet be ordered.
      (Available $available_date)" + } + } +} + +# current_location can be "Shopping Cart", "Your Account", "Home", or +# any category_id +proc ec_navbar {db {current_location ""}} { + set top_links " + + + + +
      [ec_header_image] + " + if { [string compare $current_location "Shopping Cart"] == 0 } { + append top_links "Shopping Cart" + } else { + append top_links "Shopping Cart" + } + append top_links " | " + if { [string compare $current_location "Your Account"] == 0 } { + append top_links "Your Account" + } else { + append top_links "Your Account" + } + append top_links " | " + if { [string compare $current_location "Home"] == 0 } { + append top_links "Home" + } else { + append top_links "Home" + } + append top_links "
      + " + set linked_category_list [list] + set selection [ns_db select $db "select category_id, category_name from ec_categories order by sort_key"] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { [string compare $category_id $current_location] != 0 } { + lappend linked_category_list "$category_name" + } else { + lappend linked_category_list "$category_name" + } + } + return "$top_links +
      +
      [join $linked_category_list " | "]
      +
      + " +} + +# for_customer, as opposed to one for the admins +# if show_item_detail_p is "t", then the user will see the tracking number, etc. +proc ec_order_summary_for_customer { db order_id user_id {show_item_detail_p "f"} } { + # display : + # email address + # shipping address (w/phone #) + # credit card info + # items + # total cost + + # we need a subquery database handle for the price of the item + set db_sub [ns_db gethandle subquery] + + # little security check + set correct_user_id [database_to_tcl_string $db "select user_id as correct_user_id from ec_orders where order_id=$order_id"] + + if { [string compare $user_id $correct_user_id] != 0 } { + ns_db releasehandle $db_sub + return "Invalid Order ID" + } + + set confirmed_date [database_to_tcl_string $db "select confirmed_date from ec_orders where order_id=$order_id"] + + set email [database_to_tcl_string_or_null $db "select email from users, ec_orders where users.user_id=ec_orders.user_id and order_id=$order_id"] + + set selection [ns_db 1row $db "(select line1, line2, city, usps_abbrev, zip_code, country_code, full_state_name, attn, phone, phone_time from ec_orders, ec_addresses where ec_orders.shipping_address=ec_addresses.address_id and order_id=$order_id) union (select null as line1, null as line2, null as city, null as usps_abbrev, null as zip_code, null as country_code, null as full_state_name, null as attn, null as phone, null as phone_time from ec_orders where order_id=$order_id and shipping_address is null)"] + set_variables_after_query + + set address [ec_pretty_mailing_address_from_args $db $line1 $line2 $city $usps_abbrev $zip_code $country_code $full_state_name $attn $phone $phone_time] + + set creditcard_id [database_to_tcl_string $db "select creditcard_id from ec_orders where order_id=$order_id"] + if { ![empty_string_p $creditcard_id] } { + set creditcard_summary [ec_creditcard_summary $db $creditcard_id] + } else { + set creditcard_summary "" + } + + set selection [ns_db select $db "select p.product_name, p.one_line_description, p.product_id, i.price_name, i.price_charged, i.color_choice, i.size_choice, i.style_choice, count(*) as quantity + from ec_items i, ec_products p + where i.product_id=p.product_id + and i.order_id=$order_id + group by p.product_name, p.one_line_description, p.product_id, i.price_name, i.price_charged, i.color_choice, i.size_choice, i.style_choice"] + + set items_ul "" + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + set option_list [list] + if { ![empty_string_p $color_choice] } { + lappend option_list "Color: $color_choice" + } + if { ![empty_string_p $size_choice] } { + lappend option_list "Size: $size_choice" + } + if { ![empty_string_p $style_choice] } { + lappend option_list "Style: $style_choice" + } + set options [join $option_list ", "] + if { ![empty_string_p $options] } { + set options "$options; " + } + + append items_ul "
    • Quantity $quantity: $product_name; $options$price_name: [ec_pretty_price $price_charged [ad_parameter Currency ecommerce]]\n" + if { $show_item_detail_p == "t" } { + append items_ul "
      + [ec_shipment_summary $db_sub $product_id $color_choice $size_choice $style_choice $price_charged $price_name $order_id] + " + } + } + + set shipping_method "[ec_decode [database_to_tcl_string $db "select shipping_method from ec_orders where order_id=$order_id"] "standard" "Standard Shipping" "express" "Express Shipping" "Unknown Shipping Method"]" + + set price_summary [ec_formatted_price_shipping_gift_certificate_and_tax_in_an_order $db $order_id] + + set to_return "
      +"
+    if { ![empty_string_p $confirmed_date] } {
+	append to_return "Order date:\n[util_AnsiDatetoPrettyDate $confirmed_date]\n\n"
+    }
+
+    append to_return "E-mail address:
+$email
+
+Ship to:
+$address
+[ec_decode $creditcard_summary "" "" "
+Credit card:
+$creditcard_summary
+"]
+Items:
+
      + +
        +$items_ul +
      + +
      +Ship via: $shipping_method
+
+$price_summary
+
      +" + +ns_db releasehandle $db_sub +return $to_return +} + +# Eve deleted the procedure ec_gift_certificate_summary_for_customer +# because there's no need to encapsulate something if: +# (a) it's only used once, and +# (b) it's extremely simple + + +proc ec_item_summary_in_confirmed_order { db order_id {ul_p "f"}} { + set selection [ns_db select $db "select p.product_name, p.one_line_description, p.product_id, i.price_charged, i.price_name, i.color_choice, i.size_choice, i.style_choice, count(*) as quantity + from ec_items i, ec_products p + where i.product_id=p.product_id + and i.order_id=$order_id + group by p.product_name, p.one_line_description, p.product_id, i.price_charged, i.price_name, i.color_choice, i.size_choice, i.style_choice"] + + set item_list [list] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + ## PG 6.x hack (BMA) + if {$product_id == ""} { + continue + } + + set option_list [list] + if { ![empty_string_p $color_choice] } { + lappend option_list "Color: $color_choice" + } + if { ![empty_string_p $size_choice] } { + lappend option_list "Size: $size_choice" + } + if { ![empty_string_p $style_choice] } { + lappend option_list "Style: $style_choice" + } + set options [join $option_list ", "] + if { ![empty_string_p $options] } { + set options "$options; " + } + + lappend item_list "Quantity $quantity: $product_name; $options$price_name: [ec_pretty_price $price_charged]" + } + if { $ul_p == "f" } { + return [join $item_list "\n"] + } else { + return "
        +
      • [join $item_list "\n
      • "] +
      " + } +} + +proc ec_item_summary_for_admins { db order_id } { + set selection [ns_db select $db "select p.product_name, p.one_line_description, p.product_id, i.price_charged, i.price_name, i.color_choice, i.size_choice, i.style_choice, count(*) as quantity +from ec_items i, ec_products p +where i.product_id=p.product_id +and i.order_id=$order_id +group by p.product_name, p.one_line_description, p.product_id, i.price_charged, i.price_name, i.color_choice, i.size_choice, i.style_choice"] + + set item_list [list] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + ## Pgsql 6.x hack (BMA) + if {$product_id == ""} { + continue + } + + set option_list [list] + if { ![empty_string_p $color_choice] } { + lappend option_list "Color: $color_choice" + } + if { ![empty_string_p $size_choice] } { + lappend option_list "Size: $size_choice" + } + if { ![empty_string_p $style_choice] } { + lappend option_list "Style: $style_choice" + } + set options [join $option_list ", "] + if { ![empty_string_p $options] } { + set options "$options; " + } + + lappend item_list "Quantity $quantity: $product_name; $options$price_name: [ec_pretty_price $price_charged]" + + } + if { $ul_p == "f" } { + return [join $item_list "\n"] + } else { + return "
        +
      • [join $item_list "\n
      • "] +
      " + } +} + +# produced a HTML form fragment for administrators to check off items that are fulfilled or received back +proc ec_items_for_fulfillment_or_return { db order_id {for_fulfillment_p "t"} } { + + if { $for_fulfillment_p == "t" } { + set item_view "ec_items_shippable" + } else { + set item_view "ec_items_refundable" + } + + set n_items [database_to_tcl_string $db "select count(*) from $item_view where order_id=$order_id"] + + if { $n_items > 1 } { + set selection [ns_db select $db "select i.item_id, i.color_choice, i.size_choice, i.style_choice, p.product_name, p.one_line_description, p.product_id, i.price_charged, i.price_name + from $item_view i, ec_products p + where i.product_id=p.product_id + and i.order_id=$order_id + "] + + set item_list [list] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + set option_list [list] + if { ![empty_string_p $color_choice] } { + lappend option_list "Color: $color_choice" + } + if { ![empty_string_p $size_choice] } { + lappend option_list "Size: $size_choice" + } + if { ![empty_string_p $style_choice] } { + lappend option_list "Style: $style_choice" + } + set options [join $option_list ", "] + if { ![empty_string_p $options] } { + set options "$options; " + } + + lappend item_list " $product_name; $options$price_name: [ec_pretty_price $price_charged]
      " + } + + return " All items + +

      + [join $item_list "\n"] + " + + } else { + set selection [ns_db 1row $db "select i.item_id, i.color_choice, i.size_choice, i.style_choice, p.product_name, p.one_line_description, p.product_id, i.price_charged, i.price_name + from $item_view i, ec_products p + where i.product_id=p.product_id + and i.order_id=$order_id + "] + + set_variables_after_query + + set option_list [list] + if { ![empty_string_p $color_choice] } { + lappend option_list "Color: $color_choice" + } + if { ![empty_string_p $size_choice] } { + lappend option_list "Size: $size_choice" + } + if { ![empty_string_p $style_choice] } { + lappend option_list "Style: $style_choice" + } + set options [join $option_list ", "] + if { ![empty_string_p $options] } { + set options "$options; " + } + + return " $product_name; $options$price_name: [ec_pretty_price $price_charged]" + } +} + +proc ec_price_line {db product_id user_id {offer_code "" } {order_confirmed_p "f"} } { + set lowest_price_and_price_name [ec_lowest_price_and_price_name_for_an_item $db $product_id $user_id $offer_code] + return "[lindex $lowest_price_and_price_name 1]: [ec_pretty_price [lindex $lowest_price_and_price_name 0] [ad_parameter Currency ecommerce]]" +} + + +proc_doc ec_product_review_summary {author_name publication review_date} "Returns a one-line user-readable summary of a product review" { + set result_list [list] + if ![empty_string_p $author_name] { + lappend result_list $author_name + } + if ![empty_string_p $publication] { + lappend result_list "$publication" + } + if ![empty_string_p $review_date] { + lappend result_list [util_AnsiDatetoPrettyDate $review_date] + } + return [join $result_list ", "] +} + +proc ec_order_summary_for_admin { order_id first_names last_name confirmed_date order_state user_id} { + set to_return "$order_id : $first_names $last_name\n" + if [info exists confirmed_date] { + append to_return " on [util_AnsiDatetoPrettyDate $confirmed_date] " + } + if { $order_state == "confirmed" || $order_state == "authorized_plus_avs" || $order_state == "authorized_minus_avs" || $order_state == "partially_fulfilled" } { + # this is awaiting authorization + # or needs to be fulfilled, so highlight the order state + append to_return "($order_state)\n" + } else { + append to_return "($order_state)\n" + } +} + +proc ec_all_orders_by_one_user { db user_id } { + set selection [ns_db select $db "select o.order_id, o.confirmed_date, o.order_state +from ec_orders o +where o.user_id=$user_id +order by o.order_id"] + + set to_return "

        \n" + while { [ns_db getrow $db $selection] } { + set_variables_after_query + append to_return "
      • $order_id : \n" + if {[info exists confirmed_date] && ![empty_string_p $confirmed_date] } { + append to_return " on [util_AnsiDatetoPrettyDate $confirmed_date] " + } + if { ($order_state == "confirmed" || [regexp {authorized} $order_state]) } { + # this is awaiting authorization + # or needs to be fulfilled, so highlight the order state + append to_return "($order_state)\n" + } else { + append to_return "($order_state)\n" + } + } + append to_return "
      \n" + return $to_return +} + + +proc ec_display_product_purchase_combinations { db product_id } { + # we don't want to return anything if either no purchase combinations + # have been calculated or if no other products have been bought by + # people who bought this product + set selection [ns_db 0or1row $db "select * from ec_product_purchase_comb where product_id=$product_id"] + if { [empty_string_p $selection] } { + return "" + } + set_variables_after_query + if { [empty_string_p $product_0] } { + return "" + } + set to_return "

      + People who bought [database_to_tcl_string $db "select product_name from ec_products where product_id=$product_id"] also bought: + +

      + " + + return $to_return +} + + +proc ec_formatted_price_shipping_gift_certificate_and_tax_in_an_order {db order_id} { + + set price_shipping_gift_certificate_and_tax [ec_price_shipping_gift_certificate_and_tax_in_an_order $db $order_id] + + set price [lindex $price_shipping_gift_certificate_and_tax 0] + set shipping [lindex $price_shipping_gift_certificate_and_tax 1] + set gift_certificate [lindex $price_shipping_gift_certificate_and_tax 2] + set tax [lindex $price_shipping_gift_certificate_and_tax 3] + + set currency [ad_parameter Currency ecommerce] + set price_summary_line_1_list [list "Item(s) Subtotal:" [ec_pretty_price $price $currency]] + set price_summary_line_2_list [list "Shipping & Handling:" [ec_pretty_price $shipping $currency]] + set price_summary_line_3_list [list "" "-------"] + set price_summary_line_4_list [list "Subtotal:" [ec_pretty_price [expr $price + $shipping] $currency]] + if { $gift_certificate > 0 } { + set price_summary_line_5_list [list "Tax:" [ec_pretty_price $tax $currency]] + set price_summary_line_6_list [list "" "-------"] + set price_summary_line_7_list [list "TOTAL:" [ec_pretty_price [expr $price + $shipping + $tax] $currency]] + set price_summary_line_8_list [list "Gift Certificate:" "-[ec_pretty_price $gift_certificate $currency]"] + set price_summary_line_9_list [list "" "-------"] + set price_summary_line_10_list [list "Balance due:" [ec_pretty_price [expr $price + $shipping + $tax - $gift_certificate] $currency]] + set n_lines 10 + } else { + set price_summary_line_5_list [list "Tax:" [ec_pretty_price $tax $currency]] + set price_summary_line_6_list [list "" "-------"] + set price_summary_line_7_list [list "TOTAL:" [ec_pretty_price [expr $price + $shipping + $tax] $currency]] + set n_lines 7 + } + + set price_summary "" + for {set ps_counter 1} {$ps_counter <= $n_lines} {incr ps_counter} { + set line_length 45 + set n_spaces [expr $line_length - [string length [lindex [set price_summary_line_${ps_counter}_list] 0]] - [string length [lindex [set price_summary_line_${ps_counter}_list] 1]] ] + set actual_spaces "" + for {set lame_counter 0} {$lame_counter < $n_spaces} {incr lame_counter} { + append actual_spaces " " + } + append price_summary "[lindex [set price_summary_line_${ps_counter}_list] 0]$actual_spaces[lindex [set price_summary_line_${ps_counter}_list] 1]\n" + } + return $price_summary +} + + +# says how the items with a given product_id, color, size, style, price_charged, +# and price_name in a given order shipped; the reason we put in all these parameters +# is that item summaries group items in this manner +proc ec_shipment_summary { db product_id color_choice size_choice style_choice price_charged price_name order_id } { + + set selection [ns_db select $db "select s.shipment_date, s.carrier, s.tracking_number, s.shipment_id, count(*) as n_items + from ec_items i, ec_shipments s + where i.shipment_id=s.shipment_id + and i.product_id=$product_id + and i.color_choice [ec_decode $color_choice "" "is null" "= '[DoubleApos $color_choice]'"] + and i.size_choice [ec_decode $size_choice "" "is null" "= '[DoubleApos $size_choice]'"] + and i.style_choice [ec_decode $style_choice "" "is null" "= '[DoubleApos $style_choice]'"] + and i.price_charged [ec_decode $price_charged "" "is null" "= [ns_dbquotevalue $price_charged]"] + and i.price_name [ec_decode $price_name "" "is null" "= '[DoubleApos $price_name]'"] + and i.order_id=$order_id + group by s.shipment_date, s.carrier, s.tracking_number, s.shipment_id + "] + set shipment_list [list] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + ## PGsql hack for group by (BMA) + if {$shipment_id == ""} { + continue + } + + if { ![empty_string_p $shipment_date] } { + set to_append_to_shipment_list "      $n_items shipped on [util_AnsiDatetoPrettyDate $shipment_date]" + if { ![empty_string_p $carrier] } { + append to_append_to_shipment_list " via $carrier" + } + if { ![empty_string_p $tracking_number] } { + if { ([string tolower $carrier] == "fedex" || [string range [string tolower $carrier] 0 2] == "ups") } { + append to_append_to_shipment_list " (track)" + } else { + append to_append_to_shipment_list " (tracking # $tracking_number)" + } + } + lappend shipment_list $to_append_to_shipment_list + } + } + return "[join $shipment_list "
      "]" +} + +proc_doc ec_return_product_file { } "Returns a file for the product in the calling url." { + + # Get file_path from url + set url [ns_conn url] + # security fix + regexp {/product-file/([^/]+/[^/]+/[^/]+)$} $url match file_path + # take any ..'s out of file_path + regsub -all {\.\.} $file_path "" file_path + set full_path "[ad_parameter EcommerceDataDirectory ecommerce][ad_parameter ProductDataDirectory ecommerce]$file_path" + + ns_returnfile 200 [ns_guesstype $full_path] $full_path +} + +ns_register_proc GET /product-file/* ec_return_product_file + + + +# Returns HTML and JavaScript for a selection widget and a button +# which will insert canned responses into a text area. +# Takes a database handle, the name associated with a form, +# and the name of the textarea to insert into. + +proc ec_canned_response_selector { db form_name textarea_name } { + set selection [ns_db select $db "select response_id, one_line, response_text +from ec_canned_responses +order by one_line"] + + set selector_text "" + } elseif { $column_type == "date" } { + return [ad_dateentrywidget $field_name $default_value] + } elseif { $column_type == "varchar(200)" } { + return "" + } elseif { $column_type == "varchar(4000)" } { + return "" + } else { + # it's boolean + set to_return "" + if { [string tolower $default_value] == "t" || [string tolower $default_value] == "y" || [string tolower $default_value] == "yes"} { + append to_return "Yes  " + } else { + append to_return "Yes  " + } + if { [string tolower $default_value] == "f" || [string tolower $default_value] == "n" || [string tolower $default_value] == "no"} { + append to_return "No" + } else { + append to_return "No" + } + return $to_return + } +} + +# the_value should just be a number (no percent sign) +proc ec_percent_to_decimal { the_value } { + if { [empty_string_p $the_value] } { + return "" + } else { + return [expr double($the_value)/100] + } +} + +# the value returned is just a number (no percent sign) +proc ec_decimal_to_percent { the_decimal_number } { + if { [empty_string_p $the_decimal_number] } { + return "" + } else { + return [expr $the_decimal_number * 100] + } +} + +proc ec_message_if_null { the_value } { + if { [empty_string_p $the_value] } { + return "None Defined" + } else { + return $the_value + } +} + + +# stolen from guide for engineers and scientists, I think +proc ec_choose_n_random {choices_list n_to_choose chosen_list} { + if { $n_to_choose == 0 } { return $chosen_list } else { + set chosen_index [randomRange [llength $choices_list]] + set new_chosen_list [lappend chosen_list [lindex $choices_list $chosen_index]] + set new_n_to_choose [expr $n_to_choose - 1] + set new_choices_list [lreplace $choices_list $chosen_index $chosen_index] + return [ec_choose_n_random $new_choices_list $new_n_to_choose $new_chosen_list] + } +} + +proc ec_generate_random_string { {string_length 10} } { + # leave out characters that might be confusing like l and 1, O and 0, etc. + set choices "ABCDEFGHIJKLMNPQRSTUVWXYZabcdefghijmnopqrstuvwxyz23456789" + set choices_length [string length $choices] + set random_string "" + for {set i 0} {$i < $string_length} {incr i} { + set chosen_index [randomRange $choices_length] + append random_string [string index $choices $chosen_index] + } + return $random_string +} + +proc ec_PrettyBoolean {t_or_f} { + if { $t_or_f == "t" || $t_or_f == "T" } { + return "Yes" + } elseif { $t_or_f == "f" || $t_or_f == "F" } { + return "No" + } else { + return "" + } +} + + +proc ec_display_as_html { text_to_display } { + regsub -all "\\&" $text_to_display "\\&" html_text + regsub -all "\>" $html_text "\\>" html_text + regsub -all "\<" $html_text "\\<" html_text + regsub -all "\n" $html_text "
      \n" html_text + # get rid of stupid ^M's + regsub -all "\r" $html_text "" html_text + return $html_text +} + +# This looks at dirname to see if the thumbnail is there and if +# so returns an html fragment that links to the bigger version +# of the picture (or to product.tcl if link_to_product_p is "t"). +# Otherwise it returns the empty string. + +proc ec_linked_thumbnail_if_it_exists { dirname {border_p "t"} {link_to_product_p "f"} } { + + set linked_thumbnail "" + + if { $border_p == "f" } { + set border_part_of_img_tag " border=0 " + } else { + set border_part_of_img_tag "" + } + + # see if there's an image file (and thumbnail) + + # Get the directory where dirname is stored + regsub -all {[a-zA-Z]} $dirname "" product_id + set subdirectory [ec_product_file_directory $product_id] + set file_path "$subdirectory/$dirname" + set product_data_directory "[ad_parameter EcommerceDataDirectory ecommerce][ad_parameter ProductDataDirectory ecommerce]" + + set full_dirname "$product_data_directory$file_path" + + if { [file exists "$full_dirname/product-thumbnail.jpg"] } { + set thumbnail_size [ns_jpegsize "$full_dirname/product-thumbnail.jpg"] + + if { $link_to_product_p == "f" } { + # try to link to a product.jpg or product.gif + + if { [file exists "$full_dirname/product.jpg"] } { + set linked_thumbnail "" + } elseif { [file exists "$full_dirname/product.gif"] } { + set linked_thumbnail "" + } + } else { + set linked_thumbnail "" + } + } + + return $linked_thumbnail +} + +proc ec_best_price { db product_id } { + return [database_to_tcl_string $db "select min(price) from ec_offers where product_id=$product_id"] +} + +proc ec_savings { db product_id } { + set retailprice [database_to_tcl_string_or_null $db "select retailprice from ec_custom_product_field_values where product_id=$product_id"] + set bestprice [database_to_tcl_string $db "select min(price) from ec_offers where product_id=$product_id"] + if { ![empty_string_p $retailprice] && ![empty_string_p $bestprice] } { + set savings [expr $retailprice - $bestprice] + } else { + set savings "" + } + return $savings +} + +proc_doc ec_date_with_time_stripped { the_date } "Removes the time part of the date stamp (useful when using util_AnsiDatetoPrettyDate)" { + if { [regexp {[^\ ]+} $the_date stripped_date ] } { + return $stripped_date + } else { + # if the date isn't formatted like YYYY-MM-DD HH:MI:SS, then just return what we got in + return $the_date + } +} + +proc_doc ec_user_audit_info { } "Returns User ID, IP Address, and date for audit trails" { + return [list $user_id [ns_conn peeraddr] sysdate()] +} + +proc ec_get_user_session_id {} { + set headers [ns_conn headers] + set cookie [ns_set get $headers Cookie] + # grab the user_session_id from the cookie + if { [regexp {user_session_id=([^;]+)} $cookie match user_session_id] } { + return $user_session_id + } else { + return 0 + } +} + +proc_doc ec_pretty_creditcard_type { creditcard_type } "Returns the credit card type based on the one-or-two-letter code for that type." { + if { $creditcard_type == "a" || $creditcard_type == "ax"} { + return "American Express" + } elseif { $creditcard_type == "v" || $creditcard_type == "vs"} { + return "Visa" + } elseif { $creditcard_type == "m" || $creditcard_type == "mc"} { + return "MasterCard" + } else { + return "Unknown" + } +} + +# like decode in sql +# Takes the place of an if (or switch) statement -- convenient because it's compact and +# you don't have to break out of an ns_write if you're in one. +# args: same order as in sql: first the unknown value, then any number of pairs denoting +# "if the unknown value is equal to first element of pair, then return second element", then +# if the unknown value is not equal to any of the first elements, return the last arg +proc ec_decode args { + set args_length [llength $args] + set unknown_value [lindex $args 0] + + # we want to skip the first & last values of args + set counter 1 + while { $counter < [expr $args_length -2] } { + if { [string compare $unknown_value [lindex $args $counter]] == 0 } { + return [lindex $args [expr $counter + 1]] + } + set counter [expr $counter + 2] + } + return [lindex $args [expr $args_length -1]] +} + +proc_doc ec_last_second_in_the_day { the_date } "Returns the last second of the given day's date. Input date should be in format YYYY-MM-DD HH24:MI:SS or YYYY-MM-DD." { + regexp {^(....)-(..)-(..)} $the_date garbage year month day + return "$year-$month-$day 23:59:59" +} + +proc ec_user_identification_summary { db user_identification_id {link_to_new_window_p "f"} } { + if { $link_to_new_window_p == "t" } { + set target_tag "target=user_window" + } else { + set target_tag "" + } + set selection [ns_db 0or1row $db "select * from ec_user_identification where user_identification_id=$user_identification_id"] + if { $selection == "" } { + return "" + } + set_variables_after_query + if { ![empty_string_p $user_id] } { + set user_name [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id=$user_id"] + return "Registered user: $user_name." + } + + set name_part_to_return "" + if { ![empty_string_p $first_names] && ![empty_string_p $last_name] } { + set name_part_to_return "Name: $first_names $last_name. " + } elseif { ![empty_string_p $first_names] } { + set name_part_to_return "First name: $first_names. " + } elseif { ![empty_string_p $last_name] } { + set name_part_to_return "Last name: $last_name. " + } + + set email_part_to_return "" + if { ![empty_string_p $email] } { + set email_part_to_return "Email: $email. " + } + + set postal_code_part_to_return "" + if { ![empty_string_p $postal_code] } { + set postal_code_part_to_return "Zip code: $postal_code. " + } + + set other_id_info_part_to_return "" + if { ![empty_string_p $other_id_info] } { + set other_id_info_part_to_return "Other identifying info: $other_id_info" + } + + set link_part_to_return " (user info)" + + return "$name_part_to_return $email_part_to_return $postal_code_part_to_return $other_id_info_part_to_return $link_part_to_return" +} + +proc ec_export_entire_form_except args { + # exports entire form except the variables specified in args + set hidden "" + set the_form [ns_getform] + for {set i 0} {$i<[ns_set size $the_form]} {incr i} { + set varname [ns_set key $the_form $i] + if { [lsearch -exact $args $varname] == -1 } { + set varvalue [ns_set value $the_form $i] + append hidden "\n" + } + } + return $hidden +} + + +# ugly_date should be in the format YYYY-MM-DD HH24:MI:SS +proc ec_formatted_full_date { ugly_date } { + return "[util_AnsiDatetoPrettyDate [lindex [split $ugly_date " "] 0]] [lindex [split $ugly_date " "] 1]" +} + +# ugly_date shoud be in the format YYYY-MM-DD HH24:MI:SS or just YYYY-MM-DD +proc ec_formatted_date { ugly_date } { + set split_date [split $ugly_date " "] + if { [llength $split_date] == 1 } { + return [util_AnsiDatetoPrettyDate $ugly_date] + } else { + return [ec_formatted_full_date $ugly_date] + } +} + + +proc ec_location_based_on_zip_code { db zip_code } { + set selection [ns_db select $db "select state_code, city_name, county_name from zip_codes where zip_code='$zip_code'"] + + set city_list [list] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + lappend city_list "$city_name, $county_name County, $state_code" + } + + return "[join $city_list " or "]" +} + +proc ec_pretty_mailing_address_from_args { db line1 line2 city usps_abbrev zip_code country_code full_state_name attn phone phone_time } { + set lines [list $attn] + if [empty_string_p $line2] { + lappend lines $line1 + } elseif [empty_string_p $line1] { + lappend lines $line2 + } else { + lappend lines $line1 + lappend lines $line2 + } + + if { ![empty_string_p $country_code] && $country_code != "us" } { + lappend lines "$city, $full_state_name $zip_code" + + lappend lines [ad_country_name_from_country_code $db $country_code] + } else { + lappend lines "$city, $usps_abbrev $zip_code" + } + + lappend lines "$phone ([ec_decode $phone_time "D" "day" "E" "evening" ""])" + + return [join $lines "\n"] +} + +proc ec_pretty_mailing_address_from_ec_addresses { db address_id } { + if { [empty_string_p $address_id] } { + return "" + } + set selection [ns_db 0or1row $db "select line1, line2, city, usps_abbrev, zip_code, country_code, full_state_name, attn, phone, phone_time from ec_addresses where address_id=$address_id"] + if { [empty_string_p $selection] } { + return "" + } + set_variables_after_query + return [ec_pretty_mailing_address_from_args $db $line1 $line2 $city $usps_abbrev $zip_code $country_code $full_state_name $attn $phone $phone_time] +} + +proc ec_creditcard_summary { db creditcard_id } { + set selection [ns_db 0or1row $db "select creditcard_type, creditcard_last_four, creditcard_expire, billing_zip_code from ec_creditcards where creditcard_id=$creditcard_id"] + if { [empty_string_p $selection] } { + return "" + } + set_variables_after_query + + return "[ec_pretty_creditcard_type $creditcard_type]\nxxxxxxxxxxxx$creditcard_last_four\nexp: $creditcard_expire\nzip: $billing_zip_code" +} + +proc ec_elements_of_list_a_that_arent_in_list_b { list_a list_b } { + set list_to_return [list] + foreach list_a_element $list_a { + if { [lsearch -exact $list_b $list_a_element] == -1 } { + lappend list_to_return $list_a_element + } + } + return $list_to_return +} + +proc ec_first_element_of_list_a_that_isnt_in_list_b { list_a list_b } { + foreach list_a_element $list_a { + if { [lsearch -exact $list_b $list_a_element] == -1 } { + return $list_a_element + } + } + return "" +} + + +# Gets the start and end date when the dates are supplied by ec_report_date_range_widget; +# if they're not supplied, it makes the first of this month be the start date and today +# be the end date. +# This proc uses uplevel and assumes the existence of db. +# If the date is supplied incorrectly or not supplied at all, it just returns the default +# dates (above), unless return_date_error_p (in the calling environment) is "t", in which case +# it returns 0 +proc ec_report_get_start_date_and_end_date { } { + uplevel { + + # get rid of leading zeroes in ColValue.start%5fdate.day and + # ColValue.end%5fdate.day because it can't interpret 08 and + # 09 (It thinks they're octal numbers) + + if { [info exists "ColValue.start%5fdate.day"] } { + set "ColValue.start%5fdate.day" [string trimleft [set "ColValue.start%5fdate.day"] "0"] + set "ColValue.end%5fdate.day" [string trimleft [set "ColValue.end%5fdate.day"] "0"] + ns_set update $form "ColValue.start%5fdate.day" [set ColValue.start%5fdate.day] + ns_set update $form "ColValue.end%5fdate.day" [set ColValue.end%5fdate.day] + } + + + set current_year [ns_fmttime [ns_time] "%Y"] + set current_month [ns_fmttime [ns_time] "%m"] + set current_date [ns_fmttime [ns_time] "%d"] + + # it there's no time connected to the date, just the date argument to ns_dbformvalue, + # otherwise use the datetime argument + if [catch { ns_dbformvalue [ns_conn form] start_date date start_date} errmsg ] { + if { ![info exists return_date_error_p] || $return_date_error_p == "f" } { + set start_date "$current_year-$current_month-01" + } else { + set start_date "0" + } + } + if [catch { ns_dbformvalue [ns_conn form] end_date date end_date} errmsg ] { + if { ![info exists return_date_error_p] || $return_date_error_p == "f" } { + set end_date "$current_year-$current_month-$current_date" + } else { + set end_date "0" + } + } + + if { [string compare $start_date ""] == 0 } { + if { ![info exists return_date_error_p] || $return_date_error_p == "f" } { + set start_date "$current_year-$current_month-01" + } else { + set start_date "0" + } + } + if { [string compare $end_date ""] == 0 } { + if { ![info exists return_date_error_p] || $return_date_error_p == "f" } { + set end_date "$current_year-$current_month-$current_date" + } else { + set end_date "0" + } + } + } +} + +# returns the status of the order for the customer +proc ec_order_status { db order_id } { + # we have to look at individual items + set n_shipped_items 0 + set n_received_back_items 0 + set n_total_items 0 + set selection [ns_db select $db "select item_state, count(*) as n_items + from ec_items + where order_id=$order_id + group by item_state"] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + ## Pgsql 6.x hack for group by (BMA) + if {$item_state == ""} { + continue + } + + if { $item_state == "shipped" || $item_state == "arrived" } { + set n_shipped_items [expr $n_shipped_items + $n_items] + } elseif { $item_state == "received_back" } { + set n_received_back_items $n_items + } + set n_total_items [expr $n_total_items + $n_items] + } + # Possible combinations: + # returned | shipped | blank | order status + # ---------|---------|-------|------------- + # all 0 0 All Items Returned + # 0 all 0 All Items Shipped + # 0 0 all In Progress + # some some some Some Items Returned + # some some 0 Some Items Returned + # 0 some some Partial Shipment Made + # some 0 some Some Items Returned + + if { $n_shipped_items == $n_total_items } { + return "All Items Shipped" + } elseif { $n_received_back_items == $n_total_items } { + return "All Items Returned" + } elseif { $n_shipped_items == 0 && $n_received_back_items == 0 } { + return "In Progress" + } elseif { $n_received_back_items > 0 } { + return "Some Items Returned" + } elseif { $n_shipped_items > 0 } { + return "Partial Shipment Made" + } else { + return "Unknown" + } +} + +# returns the status of the gift certificate for the customer +proc ec_gift_certificate_status { db gift_certificate_id } { + + set selection [ns_db 1row $db "select + gift_certificate_state, user_id + from ec_gift_certificates + where gift_certificate_id=$gift_certificate_id"] + + set_variables_after_query + + if { $gift_certificate_state == "confirmed" } { + return "Not Yet Authorized" + } + + if { $gift_certificate_state == "failed_authorization" } { + return "Failed Authorization" + } + + if { $gift_certificate_state == "authorized_plus_avs" || $gift_certificate_state == "authorized_minus_avs" } { + if { [empty_string_p $user_id] } { + return "Authorized (not yet claimed)" + } else { + return "Claimed by Recipient" + } + } + + if { $gift_certificate_state == "void" } { + return "Void" + } + + return "Unknown" +} + +# returns a if a>=b or b if b>a +proc ec_max { a b } { + if { $a >= $b } { + return $a + } else { + return $b + } +} + +proc ec_min { a b } { + if { $a >= $b } { + return $b + } else { + return $a + } +} + +proc_doc ec_product_file_directory { product_id } "Returns the directory that that the product files are located under the ecommerce product data directory. This is the two lowest order digits of the product_id." { + set id_length [string length $product_id] + + if { $id_length == 1 } { + # zero pad the product_id + return "0$product_id" + } else { + # return the lowest two digits + return [string range $product_id [expr $id_length - 2] [expr $id_length - 1]] + } +} + +proc_doc ec_assert_directory {dir_path} "Checks that directory exists, if not creates it" { + if { [file exists $dir_path] } { + # Everything okay + return 1 + } else { + ns_mkdir $dir_path + return 1 + } +} + +proc_doc ec_leading_zeros {the_integer n_desired_digits} "Adds leading zeros to an integer to give it the desired number of digits" { + return [format "%0${n_desired_digits}d" $the_integer] +} + +proc_doc ec_leading_nbsp {the_integer n_desired_digits} "Adds leading nbsps to an integer to give it the desired number of digits" { + set n_digits_to_add [expr $n_desired_digits - [string length $the_integer]] + if {$n_digits_to_add <= 0} { + return $the_integer + } else { + return [ec_leading_zeros "  $the_integer" $n_desired_digits] + } +} Index: web/openacs/tcl/ecommerce-widgets.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ecommerce-widgets.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ecommerce-widgets.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,722 @@ +# ecommerce-widgets.tcl,v 3.1 2000/03/07 03:33:26 eveander Exp +## Definitions for the ecommerce module +## Started April, 1999 by Eve Andersson (eveander@arsdigita.com) +## Other ecommerce procedures can be found in ecommerce-*.tcl + +# creates an ecommerce search widget, using the specified category id +# and search text if necessary +proc ec_search_widget { db {category_id ""} {search_text ""} } { + return "
      +Search: [ec_only_category_widget $db "f" $category_id] + +
      +" +} + + +# default is a list of all the items you want selected +proc ec_only_category_widget { db {multiple_p "f"} {default ""} } { + if { $multiple_p == "f" } { + set select_tag "\n" + } + set selection [ns_db select $db "select category_id, category_name from ec_categories order by category_name"] + set to_return "" + set category_counter 0 + while {[ns_db getrow $db $selection]} { + if { $category_counter == 0} { + append to_return $select_tag + } + incr category_counter + set_variables_after_query + if { [lsearch -exact $default $category_id] != -1 || [lsearch -exact $default $category_name] != -1 } { + append to_return "
    • no email address was found for user_id = $mail_to_id: name = $failed_name" + + } else { + if { $add_removal_instructions_p } { + append message [im_removal_instructions $mail_to_id] + } + ns_sendmail $email $from_address $subject $message + ns_db dml $db "update spam_history set n_sent = n_sent + 1 where spam_id = $spam_id" + append sent_html "
    • $email...\n" + } + } + set n_sent [database_to_tcl_string $db "select n_sent from spam_history where spam_id = $spam_id"] + ns_db dml $db "update spam_history set status = 'sent' where spam_id = $spam_id" + append html "
      Email was sent $n_sent email addresses.

      If any of these addresses are bogus you will recieve a bounced email in your box

        $sent_html
      " + if { $failure_count > 0 } { + append html "They databased did not have email addresses or the user has requested that spam be blocked in the following $failure_count cases: +
        $failure_html
      " + } + return $html +} + +proc im_name_in_mailto {db user_id} { + if { $user_id > 0 } { + set selection [ns_db 1row $db "select first_names || ' ' || last_name as name, email + from users + where user_id=$user_id"] + + set_variables_after_query + set mail_to "$name" + } else { + set mail_to "Unassigned" + } + return $mail_to +} + +proc im_name_paren_email {db user_id} { + if { $user_id > 0 } { + set selection [ns_db 1row $db "select first_names || ' ' || last_name as name, email + from users + where user_id=$user_id"] + + set_variables_after_query + set text "$name: $email" + } else { + set text "Unassigned" + } + return $text +} + +proc im_db_html_select_value_options_plus_hidden {db query list_name {select_option ""} {value_index 0} {label_index 1}} { + #this is html to be placed into a select tag + #when value!=option, set the index of the return list + #from the db query. selected option must match value + #it also sends a hidden variable with all the values + #designed to be availavle for spamming a list of user ids from the next page. + + set select_options "" + set values_list "" + set options [database_to_tcl_list_list $db $query] + foreach option $options { + set one_label [lindex $option $label_index] + set one_value [lindex $option $value_index] + if { [lsearch $select_option $one_value] != -1 } { + append select_options "
    • Late project report: $group_name" + } else { + append return_string "$group_name: + [im_url]/projects/report-add.tcl?[export_url_vars group_id] + +" + } + + } + return $return_string +} + + + +proc_doc im_slider { field_name pairs } {Takes in the name of the field in the current menu bar and a list where the ith item is the name of the form element and the i+1st element is the actual text to display. Returns an html string of the properly formatted slider bar} { + set default [ad_partner_upvar $field_name 1] + set url [ns_conn url] + set query_args [export_ns_set_vars url $field_name] + if { [empty_string_p $query_args] } { + append url "?" + } else { + append url "?$query_args&" + } + set menu_items [list] + for { set i 0 } { $i < [llength $pairs] } { set i [expr $i + 2] } { + set value [lindex $pairs $i] + set text [lindex $pairs [expr $i + 1]] + if { [string compare $value $default] == 0 } { + lappend menu_items "$text\n" + } else { + lappend menu_items "$text\n" + } + } + return [join $menu_items " | "] +} + + +proc_doc im_format_number { num {tag ""} } {Pads the specified number with the specified tag} { + regsub {\.$} $num "" num + return "$tag${num}." +} + + +proc_doc im_verify_form_variables required_vars {The standard way to verify arguments. Takes a list of pairs where the first element of the pair is the variable name and the second element of the pair is the message to display when the variable isn't defined.} { + set err_str "" + foreach pair $required_vars { + if { [catch { + upvar [lindex $pair 0] value + if { [empty_string_p $value] } { + append err_str "
    • [lindex $pair 1]\n" + } + } err_msg] } { + # This means the variable is not defined - the upvar failed + append err_str "
    • [lindex $pair 1]\n" + } + } + return $err_str +} + +proc_doc im_customer_select { db select_name { default "" } { status "" } } {Returns an html select box named $select_name and defaulted to $default with a list of all the customers in the system. If status is specified, we limit the select box to customers that match that status.} { +# set sql "select ug.group_name, ug.group_id +# from user_groups ug, im_customers c +# where ug.parent_group_id=[im_customer_group_id] +# and ug.group_id = c.group_id(+)" + if { ![empty_string_p $status] } { + + + set sql "select ug.group_name, ug.group_id + from user_groups ug, im_customers c + where ug.parent_group_id=[im_customer_group_id] + and ug.group_id = c.group_id + and customer_status_id = (select customer_status_id + from im_customer_status + where customer_status='[DoubleApos $status]') + union + select ug.group_name, ug.group_id + from user_groups ug, im_customers c + where ug.parent_group_id=[im_customer_group_id] + and not exists (select 1 from im_customers + where group_id = ug.group_id) + and customer_status_id = (select customer_status_id + from im_customer_status + where customer_status='[DoubleApos $status]') + order by lower(group_name)" + + } else { + + set sql "select ug.group_name, ug.group_id + from user_groups ug, im_customers c + where ug.parent_group_id=[im_customer_group_id] + and ug.group_id = c.group_id + union + select ug.group_name, ug.group_id + from user_groups ug + where ug.parent_group_id=[im_customer_group_id] + and not exists (select 1 from im_customers + where group_id = ug.group_id) + order by lower(group_name)" + } + + return [im_selection_to_select_box $db $sql $select_name $default] +} + +proc_doc im_partner_status_select { db select_name { default "" } } {Returns an html select box named $select_name and defaulted to $default with a list of all the partner statuses in the system} { + set sql "select partner_status, partner_status_id + from im_partner_status + order by display_order, lower(partner_status)" + return [im_selection_to_select_box $db $sql $select_name $default] +} + +proc_doc im_partner_type_select { db select_name { default "" } } {Returns an html select box named $select_name and defaulted to $default with a list of all the project_types in the system} { + set sql "select partner_type, partner_type_id + from im_partner_types + order by display_order, lower(partner_type)" + return [im_selection_to_select_box $db $sql $select_name $default] +} + + +proc_doc im_project_type_select { db select_name { default "" } } {Returns an html select box named $select_name and defaulted to $default with a list of all the project_types in the system} { + set sql "select project_type, project_type_id + from im_project_types + order by display_order, lower(project_type)" + return [im_selection_to_select_box $db $sql $select_name $default] +} + +proc_doc im_project_status_select { db select_name { default "" } } {Returns an html select box named $select_name and defaulted to $default with a list of all the project_types in the system} { + set sql "select project_status, project_status_id + from im_project_status + order by display_order, lower(project_status)" + return [im_selection_to_select_box $db $sql $select_name $default] +} + +proc_doc im_project_parent_select { db select_name { default "" } {current_group_id ""} { status "" } } {Returns an html select box named $select_name and defaulted to $default with a list of all the eligible projects for parents} { + if { [empty_string_p $current_group_id] } { + set limit_group_sql "" + } else { + set limit_group_sql " and p.group_id != $current_group_id" + } + set status_sql "" + if { ![empty_string_p $status] } { + set status_sql "and p.project_status_id=(select project_status_id from im_project_status where project_status='[DoubleApos $status]')" + } +# set sql "select group_name, g.group_id +# from user_groups g, im_projects p +# where p.parent_id is null +# and g.group_id=p.group_id(+) $limit_group_sql $status_sql +# order by lower(g.group_name)" + + + set sql "select group_name, g.group_id + from user_groups g, im_projects p + where p.parent_id is null + and g.group_id = p.group_id + $limit_group_sql $status_sql + union + select group_name, g.group_id + from user_groups g, im_projects p + where p.parent_id is null + and not exists (select 1 from im_projects + where group_id = g.group_id) + $limit_group_sql $status_sql + order by lower(g.group_name) + " + + return [im_selection_to_select_box $db $sql $select_name $default] +} + +proc_doc im_selection_to_select_box { db sql select_name { default "" } } {Expects selection to have a column named id and another named name. Runs through the selection and return a select bar named select_name, defaulted to $default } { + return " + +" +} + + +proc_doc im_user_select { db select_name { default "" } } {Returns an html select box named $select_name and defaulted to $default with a list of all the available project_leads in the system} { + + # We need a "distinct" because there can be more than one + # mapping between a user and a group, one for each role. + # + set sql "select distinct u.last_name || ', ' || u.first_names as name, u.user_id, u.last_name, u.first_names, +lower(u.last_name) as llast_name, +lower(u.first_names) as lfirst_names +from users_active u, user_group_map ugm +where u.user_id = ugm.user_id +and ugm.group_id = [im_employee_group_id] +order by llast_name, lfirst_names" + return [im_selection_to_select_box $db $sql $select_name $default] +} + + +proc_doc im_group_id_from_parameter { parameter } {Returns the group_id for the group with the GroupShortName specified in the server .ini file for $parameter. That is, we look up the specified parameter in the intranet module of the parameters file, and use that short_name to find a group id. Memoizes the result} { + set short_name [ad_parameter $parameter intranet] + if { [empty_string_p $short_name] } { + uplevel { + ad_return_error "Missing parameter" "Parameter not defined in the intranet section of your server's parameters file" + return -code return + } + } + + return [util_memoize "im_group_id_from_parameter_helper $short_name"] +} + +proc_doc im_group_id_from_parameter_helper { short_name } {Returns the group_id for the user_group with the specified $short_name. If no such group exists, returns the empty string.} { + set db [ns_db gethandle subquery] + set group_id [database_to_tcl_string_or_null $db \ + "select group_id + from user_groups + where short_name='[DoubleApos $short_name]'"] + ns_db releasehandle $db + return $group_id +} + + +proc_doc im_maybe_prepend_http { query_url } {Prepends http to query_url unless it already starts with http://} { + set query_url [string tolower [string trim $query_url]] + if { [empty_string_p $query_url] || [string compare $query_url "http://"] == 0 } { + return "" + } + if { [regexp {^http://.+} $query_url] } { + return $query_url + } + return "http://$query_url" +} + +proc_doc im_table_with_title { title body } {Returns a two row table with background colors} { + return " + + + + + + + +
      [ad_partner_default_font "size=-1"]$title
      [ad_partner_default_font "size=-1"]$body
      +" +} + + +proc_doc im_customer_status_select { db select_name { default "" } } {Returns an html select box named $select_name and defaulted to $default with a list of all the customer status_types in the system} { + set sql "select customer_status, customer_status_id + from im_customer_status + order by display_order, lower(customer_status)" + return [im_selection_to_select_box $db $sql $select_name $default] +} + + +proc_doc im_users_in_group { db group_id current_user_id { description "" } { add_admin_links 0 } { return_url "" } { limit_to_users_in_group_id "" } { dont_allow_users_in_group_id "" } { link_type "" } } {Returns an html formatted list of all the users in the specified group. Includes links to add people, add/remove yourself, and spam (if add_admin_links is 1). If limit_to_users_in_group_id is set, we only display users in both group_id and the specified group_id (in limit_to_users_in_group_id)} { + set html "" + if { [empty_string_p $limit_to_users_in_group_id] } { + set limit_to_group_id_sql "" + } else { + set limit_to_group_id_sql "and exists (select 1 + from user_group_map map2, user_groups ug + where map2.group_id = ug.group_id + and map2.user_id = users.user_id + and (map2.group_id = $limit_to_users_in_group_id + or ug.parent_group_id = $limit_to_users_in_group_id))" + } + if { [empty_string_p $dont_allow_users_in_group_id] } { + set dont_allow_sql "" + } else { + set dont_allow_sql "and not exists (select 1 + from user_group_map map2, user_groups ug + where map2.group_id = ug.group_id + and map2.user_id = users.user_id + and (map2.group_id = $dont_allow_users_in_group_id + or ug.parent_group_id = $dont_allow_users_in_group_id))" + } + + # We need a "distinct" because there can be more than one + # mapping between a user and a group, one for each role. + # + set sql_post_select "from users, user_group_map map +where map.user_id = users.user_id +and map.group_id = $group_id +$limit_to_group_id_sql $dont_allow_sql +order by lower(users.last_name)" + + set sql_query "select distinct + users.user_id, users.email, users.first_names || ' ' || users.last_name as name, users.last_name, lower(users.last_name) as lower_users_last_name +$sql_post_select" + + set selection [ns_db select $db $sql_query] + + set found 0 + set count 0 + while { [ns_db getrow $db $selection] } { + incr count + set_variables_after_query + if { $current_user_id == $user_id } { + set found 1 + } + if { $link_type == "email_only" } { + append html "
    • $name\n" + } else { + append html "
    • $name" + } + if { $add_admin_links } { + append html " (remove)" + } + append html "\n" + } + + if { [empty_string_p $html] } { + set html "
    • none\n" + } + + if { $add_admin_links } { + if { $current_user_id > 0 } { + append html "

      Add a person" + if { $found } { + append html "
      Remove yourself" + } else { + # We might not want to offer this user the chance to add him/herself (based on the + # group_id set by limit_to_users_in_group_id + if { [empty_string_p $dont_allow_users_in_group_id] } { + set offer_link 1 + } else { + set offer_link [database_to_tcl_string $db \ + "select (case when (case when count(*) = 0 then 0 else 1 end) = 1 then 0 else 1 end) + from user_group_map ugm, user_groups ug + where ugm.group_id = ug.group_id + and ugm.user_id=$current_user_id + and (ugm.group_id=$dont_allow_users_in_group_id + or ug.parent_group_id=$dont_allow_users_in_group_id)"] + } + if { $offer_link } { + append html "
      Add yourself" + } + } + if { $count > 0 } { + # set sql_post_select [im_reduce_spaces $sql_post_select] + set group_id_list "${group_id},$limit_to_users_in_group_id" + append html "
      Spam people" + } + } + } + return $html +} + + +proc_doc im_format_address { street_1 street_2 city state zip } {Generates a two line address with appropriate punctuation. } { + set items [list] + set street "" + if { ![empty_string_p $street_1] } { + append street $street_1 + } + if { ![empty_string_p $street_2] } { + if { ![empty_string_p $street] } { + append street "
      \n" + } + append street $street_2 + } + if { ![empty_string_p $street] } { + lappend items $street + } + set line_2 "" + if { ![empty_string_p $state] } { + set line_2 $state + } + if { ![empty_string_p $zip] } { + append line_2 " $zip" + } + if { ![empty_string_p $city] } { + if { [empty_string_p $line_2] } { + set line_2 $city + } else { + set line_2 "$city, $line_2" + } + } + if { ![empty_string_p $line_2] } { + lappend items $line_2 + } + + if { [llength $items] == 0 } { + return "" + } elseif { [llength $items] == 1 } { + set value [lindex $items 0] + } else { + set value [join $items "
      "] + } + return $value +} + +proc_doc im_can_user_administer_group { db { group_id "" } { user_id ""} } {An intranet user can administer a given group if thery are a site-wide intranet user, a general site-wide administrator, or if they belong to the specified user group} { + if { [empty_string_p $user_id] } { + set user_id [ad_get_user_id] + } + if { $user_id == 0 } { + return 0 + } + set site_wide_or_intranet_user [im_is_user_site_wide_or_intranet_admin $db $user_id] + + if { $site_wide_or_intranet_user } { + return 1 + } + + # Else, if the user is in the group with any role, s/he can administer that group + return [database_to_tcl_string $db \ + "select (case when count(*) = 0 then 0 else 1 end) + from user_group_map + where user_id=$user_id + and group_id=$group_id"] + + +} + +proc_doc im_is_user_site_wide_or_intranet_admin { db { user_id "" } } { Returns 1 if a user is a site-wide administrator or a member of the intranet administrative group } { + if { [empty_string_p $user_id] } { + set user_id [ad_get_user_id] + } + if { $user_id == 0 } { + return 0 + } + if { [ad_administration_group_member $db [ad_parameter IntranetGroupType intranet] "" $user_id] } { + # Site-Wide Intranet Administrator + return 1 + } elseif { [ad_permission_p $db site_wide] } { + # Site-Wide Administrator + return 1 + } + return 0 +} + + +proc_doc im_user_is_authorized_p { db user_id } {Returns 1 if a the user is authorized for the system. 0 Otherwise} { + # Else, if the user is in the group with any role, s/he can administer that group + return [database_to_tcl_string $db \ + "select case when ad_group_member_p($user_id, [im_authorized_users_group_id]) = 't' then 1 else 0 end"] + +} + + +proc_doc im_project_group_id {} {Returns the groud_id for projects} { + return [im_group_id_from_parameter ProjectGroupShortName] +} + +proc_doc im_employee_group_id {} {Returns the groud_id for employees} { + return [im_group_id_from_parameter EmployeeGroupShortName] +} + +proc_doc im_customer_group_id {} {Returns the groud_id for customers} { + return [im_group_id_from_parameter CustomerGroupShortName] +} + +proc_doc im_partner_group_id {} {Returns the groud_id for partners} { + return [im_group_id_from_parameter PartnerGroupShortName] +} + +proc_doc im_office_group_id {} {Returns the groud_id for offices} { + return [im_group_id_from_parameter OfficeGroupShortName] +} + +proc_doc im_authorized_users_group_id {} {Returns the groud_id for offices} { + return [im_group_id_from_parameter AuthorizedUsersGroupShortName] + +} + +ad_proc im_burn_rate_blurb { {-db "" } } {Counts the number of employees with payroll information and returns "The company has $num_employees employees and a monthly payroll of $payroll"} { + set release_db 0 + if { [empty_string_p $db] } { + set release_db 1 + set db [ns_db gethandle subquery] + } + + # We use "exists" instead of a join because there can be more + # than one mapping between a user and a group, one for each role, + # + set selection [ns_db 1row $db "select count(u.user_id) as num_employees, +to_char(sum(im_employee_salary(user_id)),'999G999G999G999') as payroll, +sum(case when im_employee_salary(user_id) is NULL then 1 else 0 end) as num_missing +from users u +where exists (select 1 + from user_group_map ugm + where ugm.user_id = u.user_id + and ugm.group_id = [im_employee_group_id])"] + + set_variables_after_query + + if { $release_db } { + ns_db releasehandle $db + } + +# if { !($num_employees2 > 0) } { set num_employees2 0 } + +# set num_employees [expr $num_employees + $num_employees2] +# set num_missing [expr $num_missing + $num_employees2] + + if { $num_employees == 0 } { + return "" + } + set html "The company has $num_employees [util_decode $num_employees 1 employee employees]" + if { ![empty_string_p $payroll] } { + append html " and a monthly payroll of \$$payroll" + } + if { $num_missing > 0 } { + append html " ($num_missing missing info)" + } + append html "." + return $html +} + + +proc im_salary_period_input {} { + return [ad_parameter SalaryPeriodInput intranet] +} + +proc im_salary_period_display {} { + return [ad_parameter SalaryPeriodDisplay intranet] +} + + +proc_doc im_display_salary {salary salary_period} {Formats salary for nice display} { + + set display_pref [im_salary_period_display] + + switch $salary_period { + month { + if {$display_pref == "month"} { + return "[format %6.2f $salary] per month" + } elseif {$display_pref == "year"} { + return "\$[format %6.2f [expr $salary * 12]] per year" + } else { + return "\$[format %6.2f $salary] per $salary_period" + } + } + year { + if {$display_pref == "month"} { + return "[format %6.2f [expr $salary/12]] per month" + } elseif {$display_pref == "year"} { + return "\$[format %6.2f $salary] per year" + } else { + return "\$[format %6.2f $salary] per $salary_period" + } + } + default { + return "\$[format %6.2f $salary] per $salary_period" + } + } +} + +proc im_url {} { + return "[ad_parameter SystemURL][im_url_stub]" +} + +proc im_url_stub {} { + return [ad_parameter IntranetUrlStub intranet] +} + +proc im_enabled_p {} { + return [ad_parameter IntranetEnabledP intranet 0] +} + + +# teadams on December 10th, 1999 +# modified ad-new-stuff.tcl to work for the status reports +# I tried to extend ad_new_stuff to do so, but it got too hairy. +proc_doc im_status_report {db {coverage ""} {report_date "f"} {purpose "web_display"} {ns_share_list "im_status_report_section_list"} } "Returns a string of new stuff on the site. COVERAGE and REPORT_DATS are ANSI date. The PURPOSE argument can be \"web_display\" (intended for an ordinary user), \"site_admin\" (to help the owner of a site nuke stuff), or \"email_summary\" (in which case we get plain text back). These arguments are passed down to the procedures on the ns_share'd ns_share_list." { + # let's default the date if we didn't get one + + if [empty_string_p $coverage] { + set since_when [database_to_tcl_string $db "select to_char(sysdate(),'YYYY-MM-DD') from dual"] + } + if [empty_string_p $report_date] { + set report_date [database_to_tcl_string $db "select to_char(sysdate(),'YYYY-MM-DD') from dual"] + } + ns_share $ns_share_list + set result_list [list] + + # module_name_proc_history will ensure that we do not have duplicates in the + # status report, even if the same procedure is registered twice + # with ns_share_list + set module_name_proc_history [list] + + foreach sublist [set $ns_share_list] { + + set module_name [lindex $sublist 0] + set module_proc [lindex $sublist 1] + + if { [lsearch -exact $module_name_proc_history "${module_name}_$module_proc"] > -1 } { + # This is a duplicate call to the same procedure! Skip it + continue + } + + set result_elt "" + + set subresult [eval "$module_proc $db $coverage $report_date $purpose"] + + if ![empty_string_p $subresult] { + # we got something, let's write a headline + if { $purpose == "email_summary" } { + append result_elt "[string toupper $module_name]\n\n" + } else { + append result_elt "

      $module_name

      \n\n" + } + append result_elt $subresult + append result_elt "\n\n" + lappend result_list $result_elt + } + } + + return [join $result_list ""] +} + +proc_doc im_reduce_spaces { string } {Replaces all consecutive spaces with one} { + regsub -all {[ ]+} $string " " string + return $string +} + +proc_doc hours_sum_for_user { db user_id { on_which_table "" } { on_what_id "" } { number_days "" } } {Returns the total number of hours the specified user logged for whatever else is included in the arg list} { + set criteria [list "user_id=$user_id"] + if { ![empty_string_p $on_which_table] } { + lappend criteria "on_which_table='[DoubleApos $on_which_table]'" + } + if { ![empty_string_p $on_what_id] } { + lappend criteria "on_what_id = $on_what_id" + } + if { ![empty_string_p $number_days] } { + lappend criteria "day >= (sysdate() - 7)::datetime" + } + set where_clause [join $criteria "\n and "] + set num [database_to_tcl_string $db \ + "select sum(hours) from im_hours where $where_clause"] + return [util_decode $num "" 0 $num] +} + +proc_doc hours_sum { db on_which_table on_what_id {number_days ""} } {Returns the total hours registered for the specified table and id } { + if { [empty_string_p $number_days] } { + set days_back_sql "" + } else { + set days_back_sql " and day >= sysdate() - $number_days" + } + set num [database_to_tcl_string $db \ + "select sum(hours) + from im_hours + where on_what_id=$on_what_id + and on_which_table='[DoubleApos $on_which_table]'$days_back_sql"] + return [util_decode $num "" 0 $num] +} + + +proc_doc im_random_employee_blurb { db } "Returns a random employee's photograph and a little bio" { + + # We need a "distinct" because there can be more than one + # mapping between a user and a group, one for each role. + # + set users_with_photos_list [database_to_tcl_list $db \ + "select distinct u.user_id + from users_active u, user_group_map ugm + where u.user_id = ugm.user_id + and ugm.group_id = [im_employee_group_id] + and u.portrait_client_file_name is not null + and u.user_id != [ad_get_user_id]"] + + if { [llength $users_with_photos_list] == 0 } { + return "" + } + + # get the lucky user + set random_num [randomRange [expr [llength $users_with_photos_list] -1] ] + set portrait_user_id [lindex $users_with_photos_list $random_num] + + # Since a user should be mapped to one and only one office, we + # can join with user_group_map. + # + set sql "select u.first_names || ' ' || u.last_name as name, + u.bio, info.skills, + ug.group_name as office, ug.group_id as office_id + from users u, im_employee_info info, user_groups ug, + user_group_map ugm + where u.user_id = info.user_id + and u.user_id = ugm.user_id + and ug.group_id = ugm.group_id + and ug.parent_group_id = [im_office_group_id] + and u.user_id = $portrait_user_id + union + select u.first_names || ' ' || u.last_name as name, + u.bio, info.skills, + ug.group_name as office, ug.group_id as office_id + from users u, im_employee_info info, user_groups ug, + user_group_map ugm + where u.user_id = info.user_id + and not exists (select 1 from user_group_map + where user_id = u.user_id) + and ug.group_id = ugm.group_id + and ug.parent_group_id = [im_office_group_id] + and u.user_id = $portrait_user_id + limit 1" + + set selection [ns_db 0or1row $db $sql] + + if { [empty_string_p $selection] } { + return "" + } + + set_variables_after_query + + # **** this should really be smart and look for the actual thumbnail + # but it isn't and just has the browser smash it down to a fixed width + + return " + +

      +Name: $name +
      Office: $office +[util_decode $bio "" "" "
      Biography: $bio"] +[util_decode $skills "" "" "
      Special skills: $skills"] +" + +} + + +proc_doc im_restricted_access {} {Returns an access denied message and blows out 2 levels} { + ad_return_error "Access denied" "You must be an employee of [ad_parameter SystemName] to see this page" + return -code return +} + +proc_doc im_allow_authorized_or_admin_only { db group_id current_user_id } {Returns an error message if the specified user is not able to administer the specified group or the user is not a site-wide/intranet administrator} { + + set user_admin_p [im_can_user_administer_group $db $group_id $current_user_id] + + if { ! $user_admin_p } { + # We let all authorized users have full administrative control + set user_admin_p [im_user_is_authorized_p $db $current_user_id] + } + + if { $user_admin_p == 0 } { + im_restricted_access + return + } +} + + +ad_proc im_groups_url {{-db "" -section "" -group_id "" -short_name ""}} {Sets up the proper url for the /groups stuff in acs} { + if { [empty_string_p $group_id] && [empty_string_p $short_name] } { + ad_return_error "Missing group_id and short_name" "We need either the short name or the group id to set up the url for the /groups directory" + } + if { [empty_string_p $short_name] } { + if { [empty_string_p $db] } { + set db [ns_db gethandle subquery] + set release_db 1 + } else { + set release_db 0 + } + set short_name [database_to_tcl_string $db \ + "select short_name from user_groups where group_id=$group_id"] + if { $release_db } { + ns_db releasehandle $db + } + } + if { ![empty_string_p $section] } { + set section "/$section" + } + return "/groups/[ad_urlencode $short_name]$section" +} + +proc_doc im_customer_group_id_from_user {} {Sets group_id and short_name in the calling environment of the first customer_id this proc finds for the logged in user} { + uplevel { + set local_user_id [ad_get_user_id] + # set local_db [ns_db gethandle subquery] + set selection [ns_db 0or1row $db \ + "select g.group_id, g.short_name + from user_groups g, user_group_map ugm + where g.group_id=ugm.group_id + and g.parent_group_id=[im_customer_group_id] + and ugm.user_id=$local_user_id + and rownum<2"] + if { [empty_string_p $selection] } { + set group_id "" + set short_name "" + } else { + set_variables_after_query + } + # ns_db releasehandle $local_db + } +} + + +proc_doc im_user_information { db user_id } { +Returns an html string of all the intranet applicable information for one +user. This information can be used in the shared community member page, for +example, to give intranet users a better understanding of what other people +are doing in the site. +} { + + set caller_id [ad_get_user_id] + + set return_url [ad_partner_url_with_query] + + # we need a backup copy + set user_id_copy $user_id + + # If we're looking at our own entry, we can modify some information + if {$caller_id == $user_id} { + set looking_at_self_p 1 + } else { + set looking_at_self_p 0 + } + + # can the user make administrative changes to this page + set user_admin_p [im_is_user_site_wide_or_intranet_admin $db $caller_id] + + # is this user an employee? + set user_employee_p [database_to_tcl_string $db \ + "select case when ad_group_member_p ( $user_id, [im_employee_group_id] ) = 'f' then 0 else 1 end from dual"] + + +# set sql "select u.*, uc.*, info.*, +# ((sysdate - info.first_experience)/365) as years_experience +# from users u, users_contact uc, im_employee_info info +# where u.user_id = $user_id +# and u.user_id = uc.user_id(+) +# and u.user_id = info.user_id(+)" + + set sql "select u.*, uc.*, info.*, + trunc(date_part('day',(sysdate() - info.first_experience::timestamp))/365) as years_experience + from users u, users_contact uc, im_employee_info_view info + where u.user_id = $user_id + and u.user_id = uc.user_id + and u.user_id = info.user_id + union + select u.*, uc.*, info.*, + trunc(date_part('day',sysdate() - info.first_experience::timestamp)/365) as years_experience + from users u, users_contact_null uc, im_employee_info_view info + where u.user_id = $user_id + and not exists (select 1 from users_contact + where user_id = u.user_id) + and u.user_id = info.user_id + union + select u.*, uc.*, info.*, + 0 as years_experience + from users u, users_contact uc, im_employee_info_null info + where u.user_id = $user_id + and u.user_id = uc.user_id + and not exists (select 1 from im_employee_info + where user_id = u.user_id) + union + select u.*, uc.*, info.*, + 0 as years_experience + from users u, users_contact_null uc, im_employee_info_null info + where u.user_id = $user_id + and not exists (select 1 from users_contact + where user_id = u.user_id) + and not exists (select 1 from im_employee_info + where user_id = u.user_id)" + + + set selection [ns_db 0or1row $db $sql] + + if [empty_string_p $selection] { + ad_return_error "Error" "User doesn't exist" + return -code return + } + set_variables_after_query + + # just in case user_id was set to null in the last query + set user_id $user_id_copy + + set selection [ns_db select $db \ + "select ug.group_name, ug.group_id + from user_groups ug + where ad_group_member_p ( $user_id, ug.group_id ) = 't' + and ug.parent_group_id=[im_office_group_id]"] + + set offices "" + set number_offices 0 + while { [ns_db getrow $db $selection] } { + set_variables_after_query + incr number_offices + if { ![empty_string_p $offices] } { + append offices ", " + } + append offices " $group_name\n" + } + + set page_content "

        \n" + + if [exists_and_not_null job_title] { + append page_content "
      • Job title: $job_title\n" + } + + if { $number_offices == 0 } { + if { $user_admin_p } { + append page_content "
      • Office: Add [util_decode $looking_at_self_p 1 yourself "this user"] to an office\n" + } + + } elseif { $user_employee_p } { + append page_content "
      • [util_decode $number_offices 1 Office Offices]: $offices\n" + } + + if [exists_and_not_null years_experience] { + append page_content "
      • Job experience: [format %3.1f $years_experience] years\n" + } + + if { [exists_and_not_null portrait_upload_date] } { + if { $looking_at_self_p } { + append page_content "

      • Portrait\n" + } else { + append page_content "

      • Portrait\n" + } + } elseif { $looking_at_self_p } { + append page_content "

      • Show everyone else at [ad_system_name] how great looking you are: upload a portrait" + } + + append page_content "

        " + + if [exists_and_not_null email] { + append page_content "

      • Email: $email\n"; + } + if [exists_and_not_null url] { + append page_content "
      • Homepage: [im_maybe_prepend_http $url]\n"; + } + if [exists_and_not_null aim_screen_name] { + append page_content "
      • AIM name: $aim_screen_name\n"; + } + if [exists_and_not_null icq_number] { + append page_content "
      • ICQ number: $icq_number\n"; + } + if [exists_and_not_null work_phone] { + append page_content "
      • Work phone: $work_phone\n"; + } + if [exists_and_not_null home_phone] { + append page_content "
      • Home phone: $home_phone\n"; + } + if [exists_and_not_null cell_phone] { + append page_content "
      • Cell phone: $cell_phone\n"; + } + + + set address [im_format_address [value_if_exists ha_line1] [value_if_exists ha_line2] [value_if_exists ha_city] [value_if_exists ha_state] [value_if_exists ha_postal_code]] + + if { ![empty_string_p $address] } { + append page_content " +

        + + + + +
        Home address: $address
        + + " + } + + if [exists_and_not_null skills] { + append page_content "

        Special skills: $skills\n"; + } + + if [exists_and_not_null educational_history] { + append page_content "

        Degrees/Schools: $educational_history\n"; + } + + if [exists_and_not_null last_degree_completed] { + append page_content "

        Last Degree Completed: $last_degree_completed\n"; + } + + if [exists_and_not_null bio] { + append page_content "

        Biography: $bio\n"; + } + + if [exists_and_not_null note] { + append page_content "

        Other information: $note\n"; + } + + if {$looking_at_self_p} { + append page_content "

        (edit)\n" + } + + + + append page_content " +

        Current projects:

          \n" + + set projects_html "" + + +# set sql "select user_group_name_from_id(group_id) as project_name, +# group_id as project_id, level +# from im_projects p +# where ad_group_member_p ( $user_id, p.group_id ) = 't' +# connect by prior group_id=parent_id +# start with parent_id is null" + + set sql "select user_group_name_from_id(group_id) as project_name, + group_id as project_id, level + from im_projects_view p + where ad_group_member_p ( $user_id, p.group_id ) = 't' + order by connect_by_key" + + set selection [ns_db select $db $sql] + + set projects_html "" + set current_level 1 + while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $level > $current_level } { + append projects_html "
            \n" + incr current_level + } elseif { $level < $current_level } { + append projects_html "
          \n" + set current_level [expr $current_level - 1] + } + append projects_html "
        • $project_name\n" + } + if { [exists_and_not_null level] && $level <= $current_level } { + append projects_html "
        \n" + } + if { [empty_string_p $projects_html] } { + set projects_html "
      • None\n" + } + + append page_content " + $projects_html +
      + " + + set selection [ns_db select $db "select to_char(start_date, 'Mon DD, YYYY') as start_date, to_char(end_date,'Mon DD, YYYY') as end_date, contact_info, initcap(vacation_type) as vacation_type, vacation_id, + description from user_vacations where user_id = $user_id + and (start_date >= to_date(sysdate(),'YYYY-MM-DD') or + (start_date <= to_date(sysdate(),'YYYY-MM-DD') and end_date >= to_date(sysdate(),'YYYY-MM-DD'))) + order by start_date asc"] + + set office_absences "" + while {[ns_db getrow $db $selection]} { + set_variables_after_query + if { [empty_string_p $vacation_type] } { + set vacation_type "Vacation" + } + append office_absences "
    • $vacation_type: $start_date - $end_date,
      $description
      + Contact info: $contact_info" + + if { $looking_at_self_p || $user_admin_p } { + append office_absences "
      edit" + } + } + + if { ![empty_string_p $office_absences] } { + append page_content " +

      + Office Absences: +

        + $office_absences +
      + " + } + + if { [ad_parameter TrackHours intranet 0] && [im_user_is_employee_p $db $user_id] } { + append page_content " +

      View this person's work log +

    + " + } + + # don't sign it with the publisher's email address! + append page_content "\n" + return $page_content +} + + + + +proc_doc im_yes_no_table { yes_action no_action { var_list [list] } { yes_button " Yes " } {no_button " No "} } "Returns a 2 column table with 2 actions - one for yes and one for no. All the variables in var_list are exported into the to forms. If you want to change the text of either the yes or no button, you can ser yes_button or no_button respectively." { + set hidden_vars "" + foreach varname $var_list { + if { [eval uplevel {info exists $varname}] } { + upvar $varname value + if { ![empty_string_p $value] } { + append hidden_vars "\n" + } + } + } + return " + + + + + +
    + $hidden_vars + +
    +
    + $hidden_vars + +
    +
    +" +} + + +proc_doc im_spam_multi_group_exists_clause { group_id_list } { + returns a portion of an sql where clause that begins + with " and exists..." and includes all the groups in the + comma separated list of group ids (group_id_list) +} { + set criteria [list] + foreach group_id [split $group_id_list ","] { + lappend criteria "(select 1 from user_group_map ugm where u.user_id=ugm.user_id and ugm.group_id='$group_id')" + } + if { [llength $criteria] > 0 } { + return " and exists [join $criteria " and exists "] " + } else { + return "" + } +} + +proc_doc im_spam_number_users { db group_id_list } { + Returns the number of users that belong to all the groups in + the comma separated list of group ids (group_id_list) +} { + set ugm_clause [im_spam_multi_group_exists_clause $group_id_list] + return [database_to_tcl_string $db \ + "select count(distinct u.user_id) + from users_active u, user_group_map ugm + where u.user_id=ugm.user_id $ugm_clause"] +} + + + +util_report_successful_library_load Index: web/openacs/tcl/keepalive-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/keepalive-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/keepalive-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1 @@ +ns_share -init {set keepalive_monitor_list [list] } keepalive_monitor_list \ No newline at end of file Index: web/openacs/tcl/neighbor-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/neighbor-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/neighbor-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,207 @@ +# neighbor-defs.tcl,v 3.0.4.1 2000/03/16 18:18:17 bcameros Exp +# +# neighbor-defs.tcl +# +# by philg@mit.edu in 1996 or so +# +# modified November 1, 1999 by philg to interface to +# ad-user-contributions-summary.tcl system + +# definitions for the neighbor-to-neighbor service (like a discussion +# forum but more layers of structure and intended for long-term +# storage of stories ) + +util_report_library_entry + +proc neighbor_db_gethandle {} { + if [catch {set db [ns_db gethandle]} errmsg] { + # something wrong with the NaviServer/db connection + ad_notify_host_administrator "please fix [ns_conn location]" "please fix the neighbor to neighbor service +at [ns_conn location] so that it can connect to the database + +Thanks, + +The Ghost of the NaviServer + +Note: this message was automatically sent by a Tcl CATCH statement running +inside [ns_conn location] +" + return "" + } else { + return $db + } +} + +proc neighbor_header {title} { + return [ad_header $title] +} + +proc neighbor_footer {{signatory ""}} { + return [ad_footer $signatory] +} + +proc neighbor_system_name {} { + set custom_name [ad_parameter SystemName neighbor] + if ![empty_string_p $custom_name] { + return $custom_name + } else { + return "[ad_parameter SystemName] Neighbor to Neighbor" + } +} + +proc neighbor_uplink {} { + if [ad_parameter OnlyOnePrimaryCategoryP neighbor 0] { + return [ad_site_home_link] + } else { + return "[neighbor_system_name]" + } +} + +proc neighbor_home_link {category_id primary_category} { + if { [ad_parameter OnlyOnePrimaryCategoryP neighbor 0] && ![empty_string_p [ad_parameter DefaultPrimaryCategory neighbor]] } { + return "[neighbor_system_name]" + } else { + return "$primary_category" + } +} + +proc neighbor_system_owner {} { + set custom_owner [ad_parameter SystemOwner neighbor] + if ![empty_string_p $custom_owner] { + return $custom_owner + } else { + return [ad_system_owner] + } +} + +# for opc.tcl + +proc_doc neighbor_summary_items_approved {category_id} "returns list of Tcl lists; each list contains a subcategory ID, subcategory_1 name and a count; we expect this to be memoized" { + set db [ns_db gethandle subquery] + set selection [ns_db select $db "select sc.subcategory_id, sc.subcategory_1, count(n.neighbor_to_neighbor_id) as count +from neighbor_to_neighbor n, n_to_n_subcategories sc +where n.category_id = $category_id +and n.subcategory_id = sc.subcategory_id +and n.approved_p='t' +group by sc.subcategory_id, sc.subcategory_1 +order by sc.subcategory_1"] + set return_list [list] + while {[ns_db getrow $db $selection]} { + set_variables_after_query + lappend return_list [list $subcategory_id $subcategory_1 $count] + } + ns_db releasehandle $db + return $return_list +} + + +################################################################## +# +# interface to the ad-new-stuff.tcl system + +ns_share ad_new_stuff_module_list + +if { ![info exists ad_new_stuff_module_list] || [util_search_list_of_lists $ad_new_stuff_module_list [neighbor_system_name] 0] == -1 } { + lappend ad_new_stuff_module_list [list [neighbor_system_name] neighbor_new_stuff] +} + +proc neighbor_new_stuff {db since_when only_from_new_users_p purpose} { + if { $only_from_new_users_p == "t" } { + set users_table "users_new" + } else { + set users_table "users" + } + set query "select nn.neighbor_to_neighbor_id, nn.about, nn.title, ut.first_names, ut.last_name, ut.email +from neighbor_to_neighbor nn, $users_table ut +where posted > '$since_when' +and nn.poster_user_id = ut.user_id +order by posted desc" + set result_items "" + set selection [ns_db select $db $query] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + switch $purpose { + web_display { + append result_items "
  • $about : $title -- $first_names $last_name \n" } + site_admin { + append result_items "
  • $about : $title -- $first_names $last_name ($email) \n" + } + email_summary { + append result_items "A story about $about from $first_names $last_name titled +\"$title\" + -- [ad_url]/neighbor/view-one.tcl?[export_url_vars neighbor_to_neighbor_id] + +" + } + } + } + # we have the result_items or not + if { $purpose == "email_summary" } { + return $result_items + } elseif { ![empty_string_p $result_items] } { + return "
      \n\n$result_items\n
    \n" + } else { + return "" + } +} + + +################################################################## +# +# interface to the ad-user-contributions-summary.tcl system + +ns_share ad_user_contributions_summary_proc_list + +if { ![info exists ad_user_contributions_summary_proc_list] || [util_search_list_of_lists $ad_user_contributions_summary_proc_list "Neighbor to Neighbor" 0] == -1 } { + lappend ad_user_contributions_summary_proc_list [list "Neighbor to Neighbor" neighbor_user_contributions 0] +} + +proc_doc neighbor_user_contributions {db user_id purpose} {Returns list items, one for each posting} { + if { $purpose == "site_admin" } { + set target_url "/admin/neighbor/view-one.tcl" + set restriction_clause "" + } else { + set target_url "/neighbor/view-one.tcl" + set restriction_clause "\nand neighbor_to_neighbor.approved_p = 't'" + } + set selection [ns_db select $db "select neighbor_to_neighbor_id, about, title, approved_p, to_char(posted,'Month dd, yyyy') as posted +from neighbor_to_neighbor +where poster_user_id = $user_id $restriction_clause +order by neighbor_to_neighbor_id"] + + set neighbor_items "" + while {[ns_db getrow $db $selection]} { + set_variables_after_query + append neighbor_items "
  • $posted: $about : $title\n" + if { $approved_p == "f" } { + append neighbor_items "unapproved\n" + } + } + if [empty_string_p $neighbor_items] { + return [list] + } else { + return [list 1 "Neighbor to Neighbor" "
      \n\n$neighbor_items\n\n
    "] + } +} + + +### legacy redirects + +# ns_register_proc GET /classified/NtoNPostNewStage1 ns_returnredirect http://db.photo.net/neighbor/ +# ns_register_proc POST /classified/NtoNPostNewStage2 ns_returnredirect http://db.photo.net/neighbor/ +# ns_register_proc POST /classified/EnterUpdateNtoN ns_returnredirect http://db.photo.net/neighbor/ +# ns_register_proc GET /classified/WelcomeToPhotoNetNeighbor_To_Neighbor ns_returnredirect http://db.photo.net/neighbor/ +# ns_register_proc GET /classified/NtoN ns_returnredirect http://db.photo.net/neighbor/ +# ns_register_proc GET /classified/ViewNtoNByDate ns_returnredirect http://db.photo.net/neighbor/ +# ns_register_proc GET /classified/ViewNtoNByAbout ns_returnredirect http://db.photo.net/neighbor/ +# ns_register_proc GET /classified/ViewNtoNInOneCategory ns_returnredirect http://db.photo.net/neighbor/ +# ns_register_proc POST /classified/ViewNtoNInOneCategory ns_returnredirect http://db.photo.net/neighbor/ +# ns_register_proc GET /classified/ViewOneNtoN ns_returnredirect http://db.photo.net/neighbor/ +# ns_register_proc GET /classified/NtoNSearchForm ns_returnredirect http://db.photo.net/neighbor/ +# ns_register_proc POST /classified/ViewNtoNFullTextSearch ns_returnredirect http://db.photo.net/neighbor/ + +# ns_register_proc POST /classified/ModifyNtoNFirstMenu ns_returnredirect http://db.photo.net/neighbor/ +# ns_register_proc GET /classified/ModifyNtoNChallenge ns_returnredirect http://db.photo.net/neighbor/ +# ns_register_proc POST /classified/ModifyNtoNPostChallenge ns_returnredirect http://db.photo.net/neighbor/ + +util_report_successful_library_load Index: web/openacs/tcl/new-ticket-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/new-ticket-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/new-ticket-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,1877 @@ +# Ticket tracker definitions + +# ticket-defs.tcl by hqm@arsdigita.com June 1999 + +# util_report_library_entry + +################################################################ +# Reference to "customer" in various functions refer to any user who is not in +# the ticket admin group. This is based on a "customer support" +# model for the usage of ticket tracker. + +proc ticket_url_stub {} { + return "/new-ticket" +} + +proc ticket_admin_url_stub {} { + ns_log Notice "page [ns_conn url] has a ticket_admin_url_stub call" + return [ticket_url_stub] +} + +proc ticket_header {title} { + return [ad_header $title] +} + +proc ticket_footer {} { + return [ad_footer] +} + +proc ticket_getdbhandle {} { + return [ns_db gethandle main] +} + +proc ticket_system_name {} { + return "[ad_system_name] Ticket Tracker" +} + +proc ticket_reply_email_addr {} { + return [ad_parameter TicketReplyEmail "ticket"] +} + +proc ticket_issue_author_is_interested_p {} { + return [ad_parameter TicketAuthorIsInterestedP "ticket" 1] +} + +proc ticket_help_header {title} { + return "[ad_header $title] +

    $title

    +Return to Ticket +
    +" +} + + +# Customers are allowed to create new tickets in the system? +# Defaults to yes. +proc ticket_customers_can_create_new_tickets {} { + if {[string compare [ad_parameter CustomerCanCreateNewTickets "ticket"] "0"] == 0} { + return 0 + } else { + return 1 + } +} + +# returns 1 if current user is in admin group for ticket module +proc ticket_user_admin_p {db {user_id {}}} { + if {$user_id == ""} { + set user_id [ad_verify_and_get_user_id] + } + return [ad_administration_group_member $db ticket "" $user_id] +} + +# return the GID of the ticket admin group +proc ticket_admin_group {db} { + return [ad_administration_group_id $db "ticket" ""] +} + +# A proc to tell if a user is assigned to a particular project +proc ticket_user_can_see_project_p {user_id project_id {db {}}} { + if {$db == ""} { + set db [ns_db gethandle subquery] + } + + if {[database_to_tcl_string $db "select ticket_user_can_see_project_p($user_id, $project_id) from dual"] == "t"} { + return 1 + } else { + return 0 + } +} + +proc ticket_user_can_edit_project_p {user_id project_id {db {}}} { + if {$db == ""} { + set db [ns_db gethandle subquery] + } + + if {![ticket_user_can_see_project_p $user_id $project_id $db]} { + return 0 + } + + if {![ad_permission_p $db "" "" "edit_project" $user_id [team_project_group_id $project_id $db]]} { + return 0 + } + + return 1 +} + +proc ticket_user_can_see_issues_p {user_id msg_ids {db {}}} { + if {$db == ""} { + set db [ns_db gethandle subquery] + } + + if {[database_to_tcl_string $db "select count(*) from ticket_issues where ticket_user_can_see_project_p($user_id, project_id)='f' and msg_id in ([join $msg_ids ","])"] > 0} { + return 0 + } else { + return 1 + } +} + +proc ticket_user_can_edit_issues_p {user_id msg_ids {db {}}} { + if {$db == ""} { + set db [ns_db gethandle subquery] + } + + set list_of_projects [database_to_tcl_list $db "select project_id from ticket_issues where msg_id in ([join $msg_ids ","])"] + + foreach project_id $list_of_projects { + if {![ticket_user_can_edit_project_p $user_id $project_id $db]} { + return 0 + } + } + + return 1 +} + +proc ticket_user_can_admin_project_p {user_id project_id {db {}}} { + if {$db == ""} { + set db [ns_db gethandle subquery] + } + + set check [ad_administration_group_member $db "bits" "" $user_id] + + if {$check} { + return 1 + } + + return [ad_user_group_authorized_admin $user_id [team_project_group_id $project_id $db] $db] +} + +proc ticket_user_can_admin_issues_p {user_id msg_ids {db {}}} { + if {$db == ""} { + set db [ns_db gethandle subquery] + } + + set list_of_projects [database_to_tcl_list $db "select project_id from ticket_issues where msg_id in ([join $msg_ids ","])"] + + foreach project_id $list_of_projects { + if {![ticket_user_can_admin_project_p $user_id $project_id $db]} { + return 0 + } + } + + return 1 +} + +# users are allowed to close issues that they create +proc ticket_user_can_close_issue_p {user_id msg_id {db {}}} { + if {$db == ""} { + set db [ns_db gethandle subquery] + } + + if { [database_to_tcl_string $db "select ticket_user_can_close_issue_p($user_id, $msg_id)" ] == "f" } { + return 0 + } else { + return 1 + } +} + +# Other permissions +proc ticket_user_can_add_issues {user_id project_id {db {}}} { + # for now, same thing. + return [ticket_user_can_see_project_p $user_id $project_id $db] +} + +# A proc to reject someone +proc ticket_deny_access {} { + ad_return_error "Access Denied" "You cannot access this page" +} + +# FILTER turned off (ben@mit.edu) +ns_share -init {set ad_ticket_filters_installed 1} ad_ticket_filters_installed + +if {!$ad_ticket_filters_installed} { + set ad_ticket_filters_installed 1 + # ns_register_filter preauth HEAD /new-ticket/admin/* ticket_security_checks_admin + ns_register_filter preauth HEAD /new-ticket/* ticket_security_checks + # ns_register_filter preauth GET /new-ticket/admin/* ticket_security_checks_admin + ns_register_filter preauth GET /new-ticket/* ticket_security_checks + # ns_register_filter preauth POST /new-ticket/admin/* ticket_security_checks_admin + ns_register_filter preauth POST /new-ticket/* ticket_security_checks +} + + +# Check for the user cookie, redirect if not found. +proc ticket_security_checks {args why} { + uplevel { + set user_id [ad_verify_and_get_user_id] + if {$user_id == 0} { + ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode [ns_conn url]?[ns_conn query]]" + return filter_return + } + + set project_id [ns_queryget project_id] + set msg_id [ns_queryget msg_id] + + if {$project_id != ""} { + if {[string match "[ticket_admin_url_stub]*" [ns_conn url]]} { + return filter_ok + } + + if {[ticket_user_can_edit_project_p $user_id $project_id]} { + regsub "[ticket_url_stub]/" [ns_conn url] "" new_url + ns_returnredirect "[ticket_admin_url_stub]/$new_url?[ns_conn query]" + return filter_return + } + } + + if {$msg_id != ""} { + if {[string match "[ticket_admin_url_stub]*" [ns_conn url]]} { + return filter_ok + } + + if {[ticket_user_can_edit_issues_p $user_id [list $msg_id]]} { + regsub "[ticket_url_stub]/" [ns_conn url] "" new_url + ns_returnredirect "[ticket_admin_url_stub]/$new_url?[ns_conn query]" + return filter_return + } + } + + return filter_ok + } +} + + +# Checks if user is logged in, AND is a member of the ticket admin group +proc ticket_security_checks_admin {args why} { + set user_id [ad_verify_and_get_user_id] + if {$user_id == 0} { + ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode [ns_conn url]?[ns_conn query]]" + return filter_return + } + + set db [ns_db gethandle subquery] + + if {![ticket_user_admin_p $db]} { + ad_return_error "Access Denied" "Your account does not have access to this page." + return filter_return + } + + ns_db releasehandle $db + + return filter_ok +} + +# return id of the default admin user (system admin) +proc default_ticket_admin_user {db} { + set admins [database_to_tcl_list $db "select ugm.user_id + from user_group_map ugm + where ugm.group_id = [ticket_admin_group $db]"] + return [lindex $admins 0] +} + +# The id of the project in which unprivileged user's tickets are created. +proc get_default_customer_project_id {db} { + return [get_project_named $db "Tech Support" 1] +} + +# A single project is designated where RMA tickets get put +proc get_project_named {db title {create 0}} { + set id_list [database_to_tcl_list $db "select project_id from ticket_projects where lower(title) = '[string tolower $title]'"] + if {[llength $id_list] < 1} { + if {$create} { + set new_id [database_to_tcl_string $db "select ticket_project_id_sequence.nextval from dual"] + ns_db dml $db "insert into ticket_projects (project_id, customer_id, title, start_date) VALUES ($new_id, [default_ticket_admin_user $db], '$title', sysdate())" + set id_list [list $new_id] + } else { + error "get_project_named: Could not find project named $title" + } + } + return [lindex $id_list 0] +} + +proc ticket_picklist_field_names {} { + set names {} + foreach entry [ticket_picklist_data] { + lappend names [lindex $entry 0] + } + return $names +} + +# returns the field name of a picklist entry +proc ticket_picklist_entry_field_name {entry} { + return [lindex $entry 0] +} + +# returns the field name of a picklist entry +proc ticket_picklist_entry_pretty_name {entry} { + return [lindex $entry 1] +} + +proc ticket_picklist_entry_column_name {entry} { + return [lindex $entry 3] +} + + +# Get the meta-data for a field_name: +# returns an entry from the picklist data list as defined above. +proc ticket_picklist_field_info {field_name} { + foreach entry [ticket_picklist_data] { + set fn [lindex $entry 0] + if {$field_name == $fn} { + return $entry + } + } + return {} +} + + +# Returns the HTML needed to input a picklist value +proc ticket_picklist_html_fragment { field_name {default_value ""} } { + set entry [ticket_picklist_field_info $field_name] + set widget_type [lindex $entry 2] + set pretty_name [lindex $entry 1] + set optional [lindex $entry 4] + switch $widget_type { + "picklist_single_select" { + return "$pretty_name[picklist_html_select_list $field_name $default_value]" + } + "text" { + return "$pretty_name" + } + default { + return "Cannot find widget type meta-data for field $field_name !" + } + } +} + +proc picklist_html_select_list { field { default_value ""} } { + append result "\n" + return $result +} + +################################################################ +# Ticket types list + +proc ticket_types {} { + return { + "Defect" "Enhancement Request" "Issue" + } +} + +proc ticket_date_format {} { + return "'Month dd, yyyy'" +} + +proc ticket_status_types {} { +return {"open" "need clarification" "development" "deferred" "cannot reproduce"} +} + +proc ticket_status_user_types {} { + return {"open" "need clarification" "development" "fixed waiting approval"} +} + +proc ticket_status_admin_types {} { + return {"deferred" "closed"} +} + +proc ticket_severity_types {} { + return [ad_parameter SeverityList "ticket"] +} + +proc_doc severity_decode_list {} "produce a sort order on severity types for SQL query" { + set i 0 + foreach item [ticket_severity_types] { + append str ",'$item',$i" + incr i + } + return $str +} + +# returns the default value of ticket_isseus.public_p for the ticket type. +proc ticket_default_visibility { ticket_type } { + switch $ticket_type { + "Ticket" { return "t" } + "Service Ticket" { return "t" } + "Bug" { return "f" } + "Feature Request" { return "t" } + default { return "t" } + } +} + + + +# If any_p is 1, include a blank "any" item in the menu. +proc ticket_html_select_ticket_type { { default_value "Ticket"} {any_p 0} } { + if {$any_p} { + set types [concat {""} [ticket_types]] + } else { + set types [ticket_types] + } + foreach item $types { + if { $default_value == $item } { + append result "\n" + } else { + append result "\n" + } + } + return $result +} + +proc ticket_type_html_for_select_menu {} { + foreach item [ticket_types] { + append result "\n" + } + return $result +} + + +proc ticket_project_select_menu { db } { + set selection [ns_db select $db "select * from ticket_projects order by title asc"] + set result "" + while { [ns_db getrow $db $selection] } { + set_variables_after_query + append result "\n" + } + return $result +} + + + + +# Do user1 and user2 share a common group? + +proc common_group_p { db user1 user2 } { + set selection [ns_db select $db "select group_id from users, user_group_map ug + where ug.user_id = $user1 and users.user_id = $user1 + intersect + select group_id from users, user_group_map ug + where ug.user_id = $user2 and users.user_id = $user2" ] + + set hits 0 + while { [ns_db getrow $db $selection] } { + set hits 1 + ns_db flush $db + break + } + + return $hits + +} + +proc ticket_notification_checkbox { var val desc} { + if {[string compare $val "t"] == 0} { + return " $desc" + } else { + return " $desc" + } +} + + +################################################################ + +proc ticket_get_group_id {db user_id} { + set groups [database_to_tcl_list $db "select group_id from user_group_map where user_id =$user_id"] + return [lindex $groups 0] +} + +################################################################ + +## Ticket search utilities + +# date entry widget that allows nulls + +proc ticket_dateentrywidget_with_nulls {column { value 0 } } { + ns_share NS + + if { $value == 0 } { + # no default, so use today + set value [lindex [split [ns_localsqltimestamp] " "] 0] + } + + set date_parts [split $value "-"] + if { $value == "" } { + set month "" + set day "" + set year "" + } else { + set date_parts [split $value "-"] + set month [lindex $date_parts 1] + set year [lindex $date_parts 0] + set day [lindex $date_parts 2] + } + + set output " + + " + + return $output +} + +proc_doc ticket_search_fragments {} "Returns the standard seach form for tickets." { + uplevel { +return " + + + + + + + + + + +
    Query String: + + + + + +
    Ticket Title: + + + + + +
    Creator First Name (or Email): +Last Name:
    Assigned To (First Name or Email): +Last Name:
    Closed By (First Name or Email): +Last Name:
    Contact Name:
    Contact Info:
    Ticket ID#:
    + + + + + + +
    Ticket Type:Ticket Status:Project:Priority:
    +
    + + + + + + + + + + + + + +
    Creation Date: + + + + + + + + + +
    After: [ticket_dateentrywidget_with_nulls creation_start [export_var creation_start]] Month-dd-yyyy
    Before: [ticket_dateentrywidget_with_nulls creation_end [export_var creation_end]] Month-dd-yyyy
    +
    Modification Date: + + + + + + + + + +
    After: [ticket_dateentrywidget_with_nulls modification_start [export_var modification_start]] Month-dd-yyyy
    Before: [ticket_dateentrywidget_with_nulls modification_end [export_var modification_end]] Month-dd-yyyy
    +
    Close Date: + + + + + + + + + +
    After: [ticket_dateentrywidget_with_nulls close_start [export_var close_start]] Month-dd-yyyy
    Before: [ticket_dateentrywidget_with_nulls close_end [export_var close_end]] Month-dd-yyyy
    +
    +" + } +} + +proc_doc ticket_search_combine_and_build_error_list {} "For use with the ticket search. Combines date form fields and builds error list (exception_count, exception_text) for processing a search form." { + uplevel { + + if [catch { ns_dbformvalue [ns_conn form] creation_start date creation_start} errmsg ] { + incr exception_count + append exception_text "
  • Invalid date for beginning creation date." + } + + if [catch { ns_dbformvalue [ns_conn form] creation_end date creation_end} errmsg ] { + incr exception_count + append exception_text "
  • Invalid date for ending creation date." + } + + if [catch { ns_dbformvalue [ns_conn form] modification_start date modification_start} errmsg ] { + incr exception_count + append exception_text "
  • Invalid date for beginning modification date." + } + + if [catch { ns_dbformvalue [ns_conn form] modification_end date modification_end} errmsg ] { + incr exception_count + append exception_text "
  • Invalid date for ending modification date." + } + + if [catch { ns_dbformvalue [ns_conn form] close_start date close_start} errmsg ] { + incr exception_count + append exception_text "
  • Invalid date for beginning close date." + } + + if [catch { ns_dbformvalue [ns_conn form] close_end date close_end} errmsg ] { + incr exception_count + append exception_text "
  • Invalid date for ending close date." + } + } +} + +proc_doc ticket_search_build_where_clause_and_description {} "For use with ticket search. Build search_clause_list (where clauses), search_description_items (search criteria in English)." { + uplevel { + + set search_description_items [list] + set search_clause_list [list] + + # build a simple boolean expression + set text_query "" + set text_query_explanation "" + + + if { [info exists query_string_1] && ![empty_string_p $query_string_1] } { + append text_query "upper(substr(indexed_stuff,0,4000)) like upper('%$QQquery_string_1%')" + append text_query_explanation "Ticket contains \"$query_string_1\"" + } + + if { [info exists conjunct_1] && [info exists conjunct_2] && ![empty_string_p $conjunct_1] && ![empty_string_p $query_string_2] } { + if { $conjunct_1 == "and" } { + append text_query "and upper(substr(indexed_stuff,0,4000)) like upper('%$QQquery_string_2%')" + append text_query_explanation "and \"$query_string_2\"" + } elseif { $conjunct_1 == "or" } { + append text_query "or upper(substr(indexed_stuff,0,4000)) like upper('%$QQquery_string_2%')" + append text_query_explanation "or \"$query_string_2\"" + } elseif { $conjunct_1 == "and_not" } { + append text_query "and upper(substr(indexed_stuff,0,4000)) not like upper('%$QQquery_string_2%')" + append text_query_explanation "and not \"$query_string_2\"" + } + } + + if { [info exists conjunct_2] && [info exists query_string_3] && ![empty_string_p $conjunct_2] && ![empty_string_p $query_string_3] } { + if { $conjunct_2 == "and" } { + append text_query "and upper(substr(indexed_stuff,0,4000)) like upper('%$QQquery_string_3%')" + append text_query_explanation "and \"$query_string_3\"" + } elseif { $conjunct_2 == "or" } { + append text_query "or upper(substr(indexed_stuff,0,4000)) like upper('%$QQquery_string_3%')" + append text_query_explanation "or \"$query_string_3\"" + } elseif { $conjunct_2 == "and_not" } { + append text_query "and upper(substr(indexed_stuff,0,4000)) not like upper('%$QQquery_string_3%')" + append text_query_explanation "and not \"$query_string_3\"" + } + } + + + + if {![empty_string_p $text_query]} { + lappend search_clause_list "( $text_query )" + lappend search_description_items $text_query_explanation + } + + + # build a simple boolean expression for title query + set text_query "" + set text_query_explanation "" + + if { [info exists title_string_1] && ![empty_string_p $title_string_1] } { + append text_query "upper(one_line) like upper('%$QQtitle_string_1%')" + append text_query_explanation "Ticket title contains \"$title_string_1\"" + } + + if { [info exists title_conjunct_1] && [info exists title_string_2] && ![empty_string_p $title_conjunct_1] && ![empty_string_p $title_string_2] } { + if { $title_conjunct_1 == "and" } { + append text_query "and upper(one_line) like upper('%$QQtitle_string_2%')" + append text_query_explanation "and \"$title_string_2\"" + } elseif { $title_conjunct_1 == "or" } { + append text_query "or upper(one_line) like upper('%$QQtitle_string_2%')" + append text_query_explanation "or \"$title_string_2\"" + } elseif { $title_conjunct_1 == "and_not" } { + append text_query "and upper(one_line) not like upper('%$QQtitle_string_2%')" + append text_query_explanation "and not \"$title_string_2\"" + } + } + + if { [info exists title_conjunct_2] && [info exists title_string_3] && ![empty_string_p $title_conjunct_2] && ![empty_string_p $title_string_3] } { + if { $title_conjunct_2 == "and" } { + append text_query "and upper(one_line) like upper('%$QQtitle_string_3%')" + append text_query_explanation "and \"$title_string_3\"" + } elseif { $title_conjunct_2 == "or" } { + append text_query "or upper(one_line) like upper('%$QQtitle_string_3%')" + append text_query_explanation "or \"$title_string_3\"" + } elseif { $title_conjunct_2 == "and_not" } { + append text_query "and upper(one_line) not like upper('%$QQtitle_string_3%')" + append text_query_explanation "and not \"$title_string_3\"" + } + } + + if {![empty_string_p $text_query]} { + lappend search_clause_list "( $text_query )" + lappend search_description_items $text_query_explanation + } + + + # search by creator first name + if { [info exists creator_fname] && ![empty_string_p $creator_fname] } { + lappend search_clause_list "(lower(users.email) like '[string tolower [DoubleApos $creator_fname]]%' or lower(users.first_names) like '[string tolower [DoubleApos $creator_fname]]%')" + lappend search_description_items "Creator first name or email starts with \"$creator_fname\"" + } + + # search by creator last name + if { [info exists creator_lname] && ![empty_string_p $creator_lname] } { lappend search_clause_list "(lower(users.last_name) like '[string tolower [DoubleApos $creator_lname]]%')" + lappend search_description_items "Creator last name starts with \"$creator_lname\"" + } + + # search by closer first name + if { [info exists closer_fname] && ![empty_string_p $closer_fname] } { + lappend search_clause_list "(lower(closer.email) like '[string tolower [DoubleApos $closer_fname]]%' or lower(closer.first_names) like '[string tolower [DoubleApos $closer_fname]]%')" + lappend search_description_items "Closer first name or email starts with \"$closer_fname\"" + } + + # search by closer last name + if { [info exists closer_lname] && ![empty_string_p $closer_lname] } { lappend search_clause_list "(lower(closer.last_name) like '[string tolower [DoubleApos $closer_lname]]%')" + lappend search_description_items "Closer last name starts with \"$closer_lname\"" + } + + # search by assignee first name + if { [info exists assigned_fname] && ![empty_string_p $assigned_fname] } { + lappend search_description_items "Assigned first name or email starts with \"$assigned_fname\"" + } + + # search by assignee last name + if { [info exists assigned_lname] && ![empty_string_p $assigned_lname] } { + lappend search_description_items "Assigned last name starts with \"$assigned_lname\"" + } + + + if { [info exists contact_name] && ![empty_string_p $contact_name] } { + lappend search_clause_list "(lower(contact_name) like '%[string tolower [DoubleApos $contact_name]]%')" + lappend search_description_items "Contact name contains \"$contact_name\"" + } + + if { [info exists contact_info] && ![empty_string_p $contact_info] } { lappend search_clause_list "(lower(contact_info1) like '%[string tolower [DoubleApos $contact_info]]%')" + lappend search_description_items "Contact info contains \"$contact_info\"" + } + + # ticket id + if { [info exists ticket_id] && ![empty_string_p $ticket_id] } { + lappend search_clause_list "msg_id = $ticket_id" + lappend search_description_items "Ticket # equals \"'[DoubleApos $ticket_id]'\"" + } + + # ticket type + if { [info exists ticket_type] && ![empty_string_p $ticket_type]} { + set ticket_types [util_GetCheckboxValues [ns_getform] ticket_type] + if {$ticket_types != 0} { + foreach _tt $ticket_types { + lappend ticket_type_list "ticket_type = '[DoubleApos $_tt]'" + } + lappend search_clause_list "([join $ticket_type_list { or }])" + lappend search_description_items "Ticket type is one of [join $ticket_types {, }]" + } + } + + # ticket status + if { [info exists status] && ![empty_string_p $status]} { + set ticket_states [util_GetCheckboxValues [ns_getform] status] + if {$ticket_states != 0} { + foreach _tt $ticket_states { + lappend ticket_status_list "status = '[DoubleApos $_tt]'" + } + lappend search_clause_list "([join $ticket_status_list { or }])" + lappend search_description_items "Ticket status is one of [join $ticket_states {, }]" + } + } + + # project id + if { [info exists project_id] && ![empty_string_p $project_id]} { + set project_id_list [util_GetCheckboxValues [ns_getform] project_id] + if {$project_id_list != 0} { + foreach _tt $project_id_list { + lappend ticket_project_id_list "ticket_issues.project_id = '[DoubleApos $_tt]'" + } + lappend search_clause_list "([join $ticket_project_id_list { or }])" + lappend search_description_items "Ticket project_id is one of [join $project_id_list {, }]" + } + } + + # priority + if { [info exists priority] && ![empty_string_p $priority]} { + set priorities [util_GetCheckboxValues [ns_getform] priority] + if {$priorities != 0} { + foreach _tt $priorities { + lappend ticket_priority_list "ticket_issues.priority = '[DoubleApos $_tt]'" + } + lappend search_clause_list "([join $ticket_priority_list { or }])" + lappend search_description_items "Ticket priority is one of [join $priorities {, }]" + } + } + + # Creation date + if { [info exists creation_start ] && ![empty_string_p $creation_start] } { + lappend search_clause_list "posting_time >= '$creation_start'" + lappend search_description_items "Creation date after \"$creation_start\"" + } + + if { [info exists creation_end ] && ![empty_string_p $creation_end] } { + lappend search_clause_list "posting_time <= '$creation_end'" + lappend search_description_items "Creation date before \"$creation_end\"" + } + + # Modification date + if { [info exists modification_start ] && ![empty_string_p $modification_start] } { + lappend search_clause_list "modification_time >= '$modification_start'" + lappend search_description_items "Modification date after \"$modification_start\"" + } + + if { [info exists modification_end ] && ![empty_string_p $modification_end] } { + lappend search_clause_list "modification_time <= '$modification_end'" + lappend search_description_items "Modification date before \"$modification_end\"" + } + + # Close date + if { [info exists close_start ] && ![empty_string_p $close_start] } { + lappend search_clause_list "close_date >= '$close_start'" + lappend search_description_items "Close date after \"$close_start\"" + } + + if { [info exists close_end ] && ![empty_string_p $close_end] } { + lappend search_clause_list "close_date <= '$close_end'" + lappend search_description_items "Close date before \"$close_end\"" + } + } +} + +################################################################ + +################################################################ +# Send notification email +# +# Send email, with message regarding a ticket, to interested parties. +# This includes any users assigned to the ticket, as well as +# optionally the ticket author. + +proc send_ticket_change_notification {db msg_id message user_id notify_creator_p} { + + set ticket_email [ticket_reply_email_addr] + set extra_headers [ns_set create] + ns_set update $extra_headers "Reply-to" $ticket_email + + set selection [ns_db 1row $db "select one_line, title, ticket_issues.project_id, notify_p + from ticket_issues, ticket_projects + where ticket_issues.project_id = ticket_projects.project_id + and msg_id = $msg_id"] + set_variables_after_query + + + set selection [ns_db 1row $db "select + first_names || ' ' || last_name as poster_name, + email as poster_email from users + where user_id=$user_id"] + set_variables_after_query + + set selection [ns_db select $db "select + email as notify_email + from users, ticket_assignments + where project_id = $project_id + and users.user_id = ticket_assignments.user_id + and active_p = 't'"] + + set url "[ad_system_url][ticket_url_stub]" + + set msg_subject "New response to $one_line in project $title (TR#$msg_id)" + set msg_content "Submitted By: $poster_name +Description: $message + +Please use the URL below to manage this issue: + +$url/issue-view.tcl?msg_id=$msg_id + +" + + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_sendmail $notify_email $poster_email $msg_subject $msg_content $extra_headers + } + # find the email address of the creator of the ticket + if {$notify_creator_p == "t"} { + set selection [ns_db 1row $db "select + users.email as creator_email from users, ticket_issues + where users.user_id=ticket_issues.user_id + and msg_id = $msg_id"] + set_variables_after_query + ns_sendmail $creator_email $poster_email $msg_subject $msg_content $extra_headers + } +} + +proc min { n1 n2 } { + if {$n1 < $n2} { + return $n1 + } else { + return $n2 + } +} +################################################################ + + + +# util for sorting by fields in ticket listing +proc toggle_order {field order_by} { + if {[string compare "$field" $order_by] == 0} { + return "$field+desc" + } else { + return "$field" + } +} + +proc ticket_order_by_field {field pretty_field extra_stuff order_by url} { + + set img_html "" + + if {[string compare $order_by "$field"] == 0} { + set img_html " " + } + + if {[string compare $order_by "$field desc"] == 0} { + set img_html " " + } + + return "$img_html $pretty_field" +} + + +# Format an integer as a blank if it is zero (to clean up large tables) +proc blank_zero {n} { + if {$n == 0} { + return "" + } else { + return $n + } +} + +################################################3333 +# +# picklist stuff + +proc ticket_picklist_data {} { + return [ad_parameter_all_values_as_list PicklistData ticket] +} + + +# Util for displaying controls on ticket personal home page +# +# Displays a list of vars with a single one removed +# + +proc ticket_control_vars {varname toggle_val vars msg {url ""}} { + if {[empty_string_p $url]} { + set url "index.tcl" + } + # Create a list of $vars with $var removed + set lpos [lsearch $vars $varname] + set _ctrl_vars [lreplace $vars $lpos $lpos] + upvar $varname var + + if { [info exists var] && $var == $toggle_val } { + return "$msg" + } else { + return "$msg\n" + } + +} + + +################################################3333 +# +# Set a daemon to nag users who have open tickets which are +# past their deadlines + +proc notify_overdue_tickets {} { + # days between notifcations + set nag_period 7 + # We do *not* want bounced messages going to the ticket handler script + set maintainer_email [ad_system_owner] + set url "[ad_url][ticket_url_stub]" + + + set db_pools [ns_db gethandle subquery 2] + set db [lindex $db_pools 0] + set db2 [lindex $db_pools 1] + + set notified_msg_ids {} + + # loop over each user who has any assigned tickets, + # finding all past-deadline tickets + set selection [ns_db select $db "select distinct ua.user_id, ua.email + from users_alertable ua, ticket_issue_assignments, users_preferences + where ticket_issue_assignments.user_id = ua.user_id + and ua.user_id = users_preferences.user_id + and users_preferences.dont_spam_me_p = 'f' + and ticket_issue_assignments.active_p = 't'"] + + if {[empty_string_p $selection]} { + return + } + + while { [ns_db getrow $db $selection] } { + # For each user, find all past-due tickets, and make a summary message + set msgs "" + set_variables_after_query + + set sub_selection [ns_db select $db2 "select + ti.msg_id, ti.one_line as summary, + to_char(ti.modification_time, 'MM/DD/YY') as modification, + to_char(ti.posting_time, 'MM/DD/YY') as creation, + to_char(ti.deadline, 'MM/DD/YY') as deadline + from ticket_issues ti, ticket_issue_assignments ta + where + ti.msg_id = ta.msg_id + and ta.user_id = $user_id + and ta.active_p = 't' + and close_date is null + and (last_notification is null or (sysdate() - last_notification) > 7) + and deadline is not null and deadline < sysdate()"] + + while { [ns_db getrow $db2 $sub_selection] } { + set_variables_after_subquery + append msgs "Issue #$msg_id $summary\ndeadline was $deadline, created $creation, last modified $modification\n$url/issue-view.tcl?msg_id=$msg_id\n\n" + lappend notified_msg_ids $msg_id + } + + if {$msgs != ""} { + set msgbody "The following issues assigned to you are still open and past their deadline:" + append msgbody "\n\n$msgs" + + set extra_headers [ns_set create] + ns_set update $extra_headers "Reply-to" $maintainer_email + ns_sendmail $email $maintainer_email \ + "Notification: Past due issues assigned to you" \ + $msgbody $extra_headers + ns_log Notice "sending ticket deadline alert email to $user_id $email" + + } + } + # update timestamp for these messages as having been notified + if {[llength $notified_msg_ids] > 0} { + ns_db dml $db "update ticket_issues set last_notification = sysdate() where msg_id in ([join $notified_msg_ids {,}])" + } + +} + +################################################################ +# Scan for messages past deadline, and send alerts, once per day +# +# Notifications will only be sent once a week (as specified above) +# for a given ticket and user, but the queue is scanned daily for +# past-deadline tickets. + +ns_share -init {set overdue_ticket_alerts_installed 0} overdue_ticket_alerts_installed + +if {!$overdue_ticket_alerts_installed} { + set overdue_ticket_alerts_installed 1 + ns_log Notice "Scheduling notify_overdue_tickets" + ns_schedule_daily -thread 3 30 notify_overdue_tickets +} + +################################################################ +# Email queue handler + +# We depend on there being a default system user, in case we cannot +# deduce the user_id from the incoming email message. +# +# We also use (or create) a project named "incoming" to exist so we can +# place new issues there. +# + + +proc ticket_process_message {db message} { + # We do *not* want bounced messages going to the ticket handler script + set maintainer_email [ad_system_owner] + + # "medium" priority + set default_priority 2 + + # extract the headers + set from_addr "" + set date "" + set subject "" + set msgbody "" + set msg_id "" + set reply_to "" + + # We want to grab headers for + # Date: Thu, 11 Mar 1999 01:42:24 -0500 + # From: Henry Minsky + # Subject: Re: test message + + set parsed_msg [parse_email_message $message] + + set msgbody [ns_set iget $parsed_msg "message_body"] + set from_header [ns_set iget $parsed_msg "from"] + set subject_header [ns_set iget $parsed_msg "subject"] + set date_header [ns_set iget $parsed_msg "date"] + set reply_to [ns_set iget $parsed_msg "reply-to"] + + # look for address of form "From: foo@bar.com + if {![regexp -nocase "(\[A-Za-z0-9._/%&!-\]+@\[A-Za-z0-9.-\]+)" $from_header from_line from_addr]} { + regexp -nocase "(\[^<\]*)<(\[A-Za-z0-9._/%&!-\]+@\[A-Za-z0-9.-\]+)" $from_header from_line from_name from_addr + } + + if {[empty_string_p $from_addr]} { + ns_log Notice "process_ticket_message could not parse from_addr from incoming message header: |$from_header| message=|$message|" + return + } + set subject $subject_header + set subject_line "Subject: $subject_header" + + # Try to parse out a message id of the form "(TR#XXX)" + regexp {TR#([0-9]*)} $subject_header match msg_id + set date_line "Date: $date_header" + + + # Make a cleaner looking mail message, just reconstruct a couple of the headers + append msgtext "From: $from_header\n" + if {![empty_string_p $reply_to]} { + append msgtext "Reply-to: $reply_to\n" + } + append msgtext "$subject_line\n" + append msgtext "$date_line\n" + append msgtext "\n$msgbody" + + # We try to look up a user, based on their email address + + set user_id [database_to_tcl_string_or_null $db "select user_id from users where lower(email) = '[string tolower $from_addr]'"] + + # We need to have some default user_id we can use as the author of a ticket + # if we can't guess the user id from the email message. + # Here we try to find a "system" user: + if {[empty_string_p $user_id]} { + set user_id [default_ticket_admin_user $db] + ns_log Notice "Could not find registered user $from_addr, using user_id=$user_id" + } + + if {[empty_string_p $user_id]} { + ns_sendmail [ad_system_owner] [ticket_reply_email_addr] "Could not find a good user id to use." "Could not deduce user id from email address, and could not find a default system user\n$msgbody" + return + } + + # Try to find a group associated with this user, to tag the + # ticket with. + set group_id_list [database_to_tcl_list $db "select umap.group_id + from user_group_map umap, user_groups ug + where umap.user_id = $user_id + and ug.group_id = umap.group_id"] + + # we'll take the first group we find + set group_id [lindex $group_id_list 0] + + set url "[ad_url][ticket_url_stub]" + + # If msg_id is empty, then assume user is posting a new ticket. + # Otherwise try to add this as a response to the existing ticket. + + set new_msg_p 0 + + if {[empty_string_p $msg_id]} { + # We are creating a new ticket + set new_msg_p 1 + + # Get or create the project named "incoming", to hold the new ticket + set default_project_id [get_default_incoming_email_project_id $db] + + set message_in_html "
    [clean_up_html $msgtext]
    " + set indexed_stuff "$subject $msgtext $from_addr" + + # Create a new ticket + set new_id [database_to_tcl_string $db "select ticket_issue_id_sequence.nextval from dual"] + + ns_log Notice "creating new ticket id $new_id for message $message_in_html" + + ns_ora clob_dml $db "insert into ticket_issues + (msg_id,project_id,user_id,group_id,status, ticket_type, severity, one_line,message,indexed_stuff,posting_time,priority, notify_p, deadline) + values ($new_id,$default_project_id,$user_id,'$group_id','open', 'Ticket', 'normal','[DoubleApos $subject]','[DoubleApos $message_in_html]',empty_clob(),sysdate(),$default_priority,'t', '') + returning message, indexed_stuff into :1, :2" $message_in_html $indexed_stuff + } else { + set selection [ns_db 0or1row $db "select one_line, title, ticket_issues.project_id, notify_p + from ticket_issues, ticket_projects + where ticket_issues.project_id = ticket_projects.project_id + and msg_id = $msg_id"] + if {[empty_string_p $selection]} { + set new_msg_p 1 + } else { + set_variables_after_query + set message_in_html "
    \n[clean_up_html $msgtext]\n
    " + ns_log Notice "adding response for msg_id $msg_id: $message_in_html" + set new_response_id [database_to_tcl_string $db "select ticket_response_id_sequence.nextval from dual"] + ns_ora clob_dml $db "insert into ticket_issue_responses (response_id,response_to,user_id,message,posting_time) values ($new_response_id,$msg_id,$user_id,empty_clob(),sysdate) returning message into :1" $message_in_html + ns_db dml $db "begin ticket_update_for_response($new_response_id); end;" + } + } + + # If this is a new ticket, send email to the originator with a URL + # containing the new ticket number, so they can follow changes from the web, + # and send notification to project members who are signed up for notification. + # + # else this is a followup, so notify assigned project members that a + # followup has come in to an existing ticket. + + if {$new_msg_p} { + set extra_headers [ns_set create] + ns_set update $extra_headers "Reply-to" [ticket_reply_email_addr] + ns_sendmail $from_addr $maintainer_email "$subject (TR\#$new_id)" "Submitted By: $from_addr + Thank you for entering a new ticket. + Description: $msgtext + + Please use $url/issue-view.tcl?msg_id=$new_id to manage this issue." $extra_headers + } else { + if { $notify_p == "t" } { + set extra_headers [ns_set create] + ns_set update $extra_headers "Reply-to" [ticket_reply_email_addr] + + set selection [ns_db 1row $db "select first_names || '' || last_name as poster_name, + email as poster_email from users + where user_id=$user_id"] + set_variables_after_query + + set selection [ns_db select $db "select + email as notify_email + from users, ticket_assignments + where project_id = $project_id + and users.user_id = ticket_assignments.user_id + and active_p = 't'"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_sendmail $notify_email $maintainer_email "New response to $one_line in project $title (TR\#$msg_id)" "Submitted By: $from_addr + Description: $msgtext + + Please use $url/issue-view.tcl?msg_id=$msg_id to manage this issue." $extra_headers + } + } + } +} + + +# Try to find or create a project named "Incoming", in which to create new +# issues which are not responses to an existing ticket. +proc get_default_incoming_email_project_id {db} { + return [get_project_named $db "Incoming" 1] +} + + +# Attempt to find a default system user - looks for the user_id of the +# system maintainer +# returned by [ad_system_owner] +proc find_default_system_user {db} { + set user_id "" + set selection [ns_db select $db "select user_id from users where email = '[ad_system_owner]'"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + } + return $user_id +} + + +################################################################## +# +# interface to the ad-new-stuff.tcl system + +ns_share ad_new_stuff_module_list + +if { ![info exists ad_new_stuff_module_list] || [util_search_list_of_lists $ad_new_stuff_module_list [ticket_system_name] 0] == -1 } { + lappend ad_new_stuff_module_list [list [ticket_system_name] ticket_new_stuff] +} + + +proc_doc ticket_new_stuff {db since_when only_from_new_users_p purpose} "Only produces a report for the site administrator; the assumption is that random users won't want to see trouble tickets" { + if { $purpose != "site_admin" } { + return "" + } + if { $only_from_new_users_p == "t" } { + set users_table "users_new" + } else { + set users_table "users" + } + set query "select ti.msg_id, ti.one_line, ut.email +from ticket_issues ti, $users_table ut +where posting_time > '$since_when' +and ti.user_id = ut.user_id +" + set result_items "" + set selection [ns_db select $db $query] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + append result_items "
  • $one_line (from $email)" + } + if { ![empty_string_p $result_items] } { + return "
      \n\n$result_items\n
    \n" + } else { + return "" + } +} + +# Update the last_modified field on a ticket. This must be done +# before other things are modified in a ticket, because the +# audit trail trigger in PL/SQL looks at the last_modified_by +# field in order to know to whom to attribute changes in other +# ticket fields to. +proc update_last_modified_info {db msg_id} { + # get current user's email, to export as the "last modified by" value + ns_db dml $db "update ticket_issues set last_modified_by = [ad_get_user_id] where msg_id = $msg_id" +} + +### +### Added utilities by ben@openforce.net +### +proc ticket_summary_display {} { + uplevel { + set return_html "" + + set last_priority "starting" + + set count 0 + + append return_html " + + " + + if {[info exists display_project_p]} { + if {$display_project_p} { + append return_html " + " + } + } + + append return_html " + + + " + + append return_html "" + + if { $view_status == "closed" } { + append return_html "" + } + + # Extra fields + if {[info exists custom_fields]} { + foreach custom_field $custom_fields { + append return_html "" + } + } + + append return_html "" + + append return_html "\n" + + set last_project_title "" + + set selection [ns_db select $db $query] + set last_msg_id "" + set msg_ids {} + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + set cols {} + + set last_msg_id $msg_id + lappend msg_ids $msg_id + + lappend cols "$msg_id" + + if {[info exists project_id] && [info exists display_project_p] && $display_project_p} { + lappend cols "$project_title" + } + + if { [string compare $status "fixed waiting approval"] == 0 } { + lappend cols "(w approv)" + } elseif { [string compare $status "need clarification"] == 0 } { + lappend cols "nd clar" + } else { + lappend cols $status + } + lappend cols "$severity" + + if {[info exists ticket_assignees]} { + lappend cols "$ticket_assignees" + } else { + lappend cols "" + } + + if {$pastdue > 0 && $close_date_pretty == ""} { + lappend cols "$deadline_pretty" + } else { + lappend cols "$deadline_pretty" + } + + if { $view_status == "closed" } { + lappend cols "$close_date_pretty" + } + + # Loop through the custom field values + if {[info exists custom_fields]} { + foreach custom_field $custom_fields { + lappend cols [set field_[lindex $custom_field 0]] + } + } + + lappend cols "[clean_up_html $one_line]" + + + incr count + if {($count % 2) == 0} { + set bgcolor "bgcolor=\#ECECEC" + } else { + set bgcolor "" + } + + append return_html "" + foreach col $cols { + append return_html "\n" + } + append return_html "" + } + + if { $count == 0 } { + append return_html "" + } + + append return_html "
    [ticket_order_by_field ticket_issues.msg_id "ID#" [eval export_url_vars $ctrlvars] $order_by $this_url][ticket_order_by_field project_name "Project" [eval export_url_vars $ctrlvars] $order_by $this_url][ticket_order_by_field status "Status" [eval export_url_vars $ctrlvars] $order_by $this_url][ticket_order_by_field severity "Severity" [eval export_url_vars $ctrlvars] $order_by $this_url][ticket_order_by_field ticket_assignees "Assigned" [eval export_url_vars $ctrlvars] $order_by $this_url][ticket_order_by_field deadline "Deadline" [eval export_url_vars $ctrlvars] $order_by $this_url][ticket_order_by_field close_date "Closed" [eval export_url_vars $ctrlvars] $order_by $this_url][ticket_order_by_field field_[lindex $custom_field 0] [lindex $custom_field 2] [eval export_url_vars $ctrlvars] $order_by $this_url][ticket_order_by_field one_line "Subject" [eval export_url_vars $ctrlvars] $order_by $this_url]
    $col 
    -- No issues --
    \n

    " + + return $return_html + } +} + + +## A function for notifying a user +proc ticket_notify_user {db user_id msg_id assigned_p} { + set from_user_id [ad_get_user_id] + + # No need to notify yourself + if {$from_user_id == $user_id} { + return + } + + set from_email [database_to_tcl_string $db "select email from users where user_id=$from_user_id"] + + set selection [ns_db 1row $db "select one_line, deadline from ticket_issues where msg_id=$msg_id"] + set_variables_after_query + + set selection [ns_db 1row $db "select email from users where user_id=$user_id"] + set_variables_after_query + + if {$assigned_p} { + set assign_message "You ($email) have been assigned by $from_email to" + set subject "Assignment" + } else { + set assign_message "You ($email) have been DEassigned by $from_email to " + set subject "Deassignment" + } + + set whole_message "$assign_message issue #$msg_id: $one_line. + + This issue's deadline is [util_AnsiDatetoPrettyDate $deadline]. + Please visit [ad_url][ticket_url_stub]/issue-view.tcl?[export_url_vars msg_id]. + " + + # Send the email + ns_sendmail $email "$from_email" $subject $whole_message "" "$from_email" +} + +# A util to show menus of projects +proc ticket_project_select {name project_id {db {}}} { + if {$db == ""} { + set db [ns_db gethandle subquery] + } + + if {$project_id == ""} { + set list_of_projects [database_to_tcl_list_list $db "select project_id, project_full_name(project_id) as title from ticket_projects where ticket_user_can_see_project_p([ad_get_user_id], project_id)='t'"] + } else { + set list_of_projects [database_to_tcl_list_list $db "select project_id, project_full_name(project_id) as title from ticket_projects connect by parent_project_id= prior project_id start with project_id=(select project_id from ticket_projects where parent_project_id is NULL and parent_project_p(project_id, '$project_id')='t')"] + } + + set select_html "\n" + + return $select_html +} + +## +## Stuff to deal with releases +proc ticket_release_select {project_id name {selected_release_id ""} {db {}}} { + if {$db == ""} { + set db [ns_db gethandle subquery] + } + + set select_html "\n" + + return $select_html +} + +## +## Utility for builds +## + +proc project_generate_filename {project_id release_id filename} { + # get the suffix + set extension [file extension $filename] + + set new_filename "${project_id}-${release_id}-build$extension" + + return $new_filename +} + +proc project_build_path {} { + return "[ad_parameter PathToACS]/data/bits/builds" +} + +proc project_ticket_attachments_path {} { + return "[ad_parameter PathToACS]/data/bits/tickets" +} + +proc ticket_filename_generate {msg_id full_path} { + if {![file exists [project_ticket_attachments_path]]} { + ns_log Error "the ticket attachment path is not set up correctly. You need to create the directory [project_ticket_attachments_path]" + return -code error + } + + # msg_id + if {![file exists [project_ticket_attachments_path]/$msg_id]} { + ns_mkdir [project_ticket_attachments_path]/$msg_id + } + + # Do basic safety checking + regsub -all {\.\.} $full_path {} new_path + + set last_forward_slash [string last "/" $new_path] + set last_back_slash [string last "\\" $new_path] + + if {$last_forward_slash == -1 && $last_back_slash == -1} { + set final_path $new_path + } + + if {$last_forward_slash > $last_back_slash} { + set final_path [string range $new_path [expr "$last_forward_slash + 1"] end] + } else { + set final_path [string range $new_path [expr "$last_back_slash + 1"] end] + } + + return /${msg_id}/$final_path +} + +## Severity ordering +proc ticket_severity_decode_sql {} { + + #QUICK postgres hack + return "severity" + + set list_of_severities [ticket_severity_types] + + set index 1 + + append decode_sql "" + + foreach severity $list_of_severities { + append decode_sql "case when severity='$severity' then $index else " + append end_sql " end" + incr index + } + + append decode_sql " $index $end_sql" + + return $decode_sql +} + +## +## Custom Fields (ben@mit.edu) +## +proc ticket_custom_field_types {} { + return [list text url select] +} + +proc ticket_custom_field_varname {name} { + return "custom_field_$name" +} + +proc ticket_util_prepend_http {str} { + if {[string range $str 0 6] == "http://"} { + return $str + } else { + return "http://$str" + } +} + +proc ticket_custom_field_get_project_fields {project_id} { + set db [ns_db gethandle subquery] + + set return_stuff [database_to_tcl_list_list $db "select field_id, field_name from ticket_projects_fields where project_id=$project_id"] + + ns_db releasehandle $db + + return $return_stuff +} + +proc ticket_custom_field_display_field {type value} { + switch $type { + url { + return "$value" + } + date { + return "[util_AnsiDatetoPrettyDate $value]" + } + default { + return $value + } + } +} + +proc ticket_custom_field_entry_form {type name possible_vals {val ""}} { + set name [ticket_custom_field_varname $name] + + switch $type { + date { + return "[philg_dateentrywidget $name $val]" + } + url { + if {$val != ""} { + set extra_stuff "(go to url)" + } else { + set extra_stuff "" + } + + return " $extra_stuff" + } + select { + return "[make_html_select $name [split $possible_vals "|"] $val]" + } + default { + return "" + } + } +} + +proc ticket_privacy_enabled_p {} { + return [ad_parameter PrivacyEnabledP ticket 0] +} + +# The filters at the top of the page +proc ticket_filter_bar {db user_id project_id url {display_numbers_p 1}} { + set filter_vars {view_assignment view_status view_created view_type order_by project_id} + + upvar view_assignment view_assignment + upvar view_status view_status + upvar view_created view_created + upvar view_type view_type + + set view_assignment [ns_queryget view_assignment user] + set view_status [ns_queryget view_status open] + set view_created [ns_queryget view_created all] + set view_type [ns_queryget view_type all] + + upvar assignment_filter assignment_filter + upvar order_by order_by + upvar status_filter status_filter + upvar date_filter date_filter + upvar issue_table issue_table + + set order_by [ns_queryget order_by ticket_issues.msg_id] + if {[string match "project*" $order_by]} { + set order_by "project_title" + } + + switch $view_assignment { + "user" { + set assignment_filter "and (exists (select msg_id from ticket_issue_assignments + where ticket_issue_assignments.msg_id = ticket_issues.msg_id + and ticket_issue_assignments.user_id = $user_id)) " + } + + "all" { set assignment_filter "" } + + "unassigned" { + set assignment_filter "and (not exists (select msg_id from ticket_issue_assignments + where ticket_issue_assignments.msg_id= ticket_issues.msg_id))" + } + } + + switch $view_status { + "open" { + set status_filter "and ((status <> 'closed') and (status <> 'deferred') and (status <> 'fixed waiting approval')) " + } + "deferred" { + set status_filter "and ((status <> 'closed') or (status = 'deferred')) " + } + "closed" { + set status_filter "" + set closed 1 + set view_closed 1 + } + } + + switch $view_created { + "last_24" { set date_filter "and (posting_time > (sysdate() - '1 day'::reltime))" } + "last_week" { set date_filter "and (posting_time > (sysdate() - '7 days'::reltime)) " } + "last_month" { set date_filter "and (posting_time > (sysdate() - '30 days'::reltime)) " } + "all" { set date_filter "" } + } + + switch $view_type { + "all" { set issue_table "ticket_issues" } + "defects" { set issue_table "ticket_defects" } + "enhancements" { set issue_table "ticket_enhancements" } + "issues" { set issue_table "ticket_issues_issues" } + } + + append page " + + + + + " + + + #### Assignment flags + # Show assigned to you + append page "\n\n
    Ticket TypeTicket AssignmentStatusCreation Time
    \[" + + # Issue type filter + append page [ticket_control_vars view_type all $filter_vars "ALL" "$url"] + append page " | " + append page [ticket_control_vars view_type defects $filter_vars "Defects" "$url"] + append page " | " + append page [ticket_control_vars view_type enhancements $filter_vars "Enhancements" "$url"] + append page " | " + append page [ticket_control_vars view_type issues $filter_vars "Issues" "$url"] + + append page "\]\[" + + append page [ticket_control_vars view_assignment user $filter_vars "mine" "$url"] + append page " | " + # Show all tickets + append page [ticket_control_vars view_assignment all $filter_vars "everyone's" "$url"] + + # Depending on project_id + if {![empty_string_p $project_id]} { + set unassigned_count [database_to_tcl_string $db "select count(*) from $issue_table where project_id=$project_id and ticket_n_assigned(msg_id)=0 $status_filter $date_filter"] + } else { + set unassigned_count [database_to_tcl_string $db "select count(*) from $issue_table where ticket_user_can_see_project_p($user_id, project_id)='t' and ticket_n_assigned(msg_id)=0 $status_filter $date_filter"] + } + + append page " | " + + if {$display_numbers_p} { + if {$unassigned_count > 0} { + append page [ticket_control_vars view_assignment unassigned $filter_vars "unassigned ($unassigned_count)" "$url"] + } else { + append page [ticket_control_vars view_assignment unassigned $filter_vars "unassigned (0)" "$url"] + } + } else { + append page [ticket_control_vars view_assignment unassigned $filter_vars "unassigned" "$url"] + } + + #### Status flags + append page "\]\[" + + # Show open issues + append page [ticket_control_vars view_status open $filter_vars "active" "$url"] + append page " | " + # Show deferred issues + append page [ticket_control_vars view_status deferred $filter_vars "+deferred" "$url"] + append page " | " + # Show closed issues + append page [ticket_control_vars view_status closed $filter_vars "+closed" "$url"] + + #### Creation time filter + append page "\]\[" + + append page [ticket_control_vars view_created last_24 $filter_vars "last 24 hrs" "$url"] + append page " | " + append page [ticket_control_vars view_created last_week $filter_vars "last week" "$url"] + append page " | " + append page [ticket_control_vars view_created last_month $filter_vars "last month" "$url"] + append page " | " + append page [ticket_control_vars view_created all $filter_vars "all" "$url"] + + append page "\]

    " + + return $page +} + +proc ticket_notification_class {db} { + return [database_to_tcl_string $db "select ticket_notification_class_id()"] +} + +util_report_successful_library_load + + + Index: web/openacs/tcl/news-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/news-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/news-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,384 @@ +# +# /tcl/news-defs.tcl +# +# this exist for the /news module, which doesn't really need any +# procs except for to interface with ad-new-stuff.tcl +# +# Author: philg@mit.edu July 4, 1999 jkoontz@arsdigita.com March 8, 1999 +# +# news-defs.tcl,v 3.2.2.2 2000/04/11 16:02:01 carsten Exp + +util_report_library_entry + +proc_doc news_newsgroup_id_list { db user_id group_id } { Returns the list of newsgroup_ids for the +appropriate news items for this user and group. If the user_id exists (i.e. non zero) then the list includes the registered_users. If group_id is set, then the newsgroup for the group is added (if it exists). } { + + # Build the newsgroup clause + set scope_clause_list [list "scope = 'all_users'"] + + if { $user_id != 0 } { + lappend scope_clause_list "scope = 'registered_users'" + } + + if { $group_id > 0 } { + lappend scope_clause_list "(scope = 'group' and group_id = $group_id)" + } else { + lappend scope_clause_list "scope = 'public'" + } + + return [database_to_tcl_list $db "select newsgroup_id from newsgroups where [join $scope_clause_list " or "]"] +} + +ns_share ad_new_stuff_module_list + +if { ![info exists ad_new_stuff_module_list] || [lsearch -glob $ad_new_stuff_module_list "News*"] == -1 } { + lappend ad_new_stuff_module_list [list "News" news_new_stuff] +} + +# added two additional arguments and a parameter to this proc +# - include_comments_p - if set to 0, we skip the comments regardless of the type. This +# is good for adding news to user workspaces +# - DefaultNumberOfStoriesToDisplay .ini Parameter: Specified the maximum number of stories +# to display. An active site can have a lot of news in a month! Use this parameter to +# say "Only display the 10 most recent news items" +# - include_date_p: Prepends the news item with it's release date +# brucek: added group_id argument to filter group-specific news +# how_many to override the ini parameter + +proc news_new_stuff {db since_when only_from_new_users_p purpose { include_date_p 0 } { include_comments_p 1 } { group_id 0 } { how_many 0 }} { + + # Get the user_id for finding which newsgroups this user can see. + set user_id [ad_get_user_id] + + if { $only_from_new_users_p == "t" } { + set users_table "users_new" + } else { + set users_table "users" + } + # What is the maximum number of rows to return? + # the how_many proc argument has precedence over the value in the ini file + if { $how_many > 0 } { + set max_stories_to_display $how_many + } else { + set max_stories_to_display [ad_parameter DefaultNumberOfStoriesToDisplay news -1] + } + + # Create a clause for returning the postings for relavent groups + set newsgroup_clause "(newsgroup_id = [join [news_newsgroup_id_list $db $user_id $group_id] " or newsgroup_id = "])" + + + if { $purpose == "site_admin" } { + set query "select news.title, news.news_item_id, news.approval_state, + expired_p(news.expiration_date) as expired_p, + to_char(news.release_date,'Mon DD, YYYY') as release_date_pretty +from news_items news, $users_table ut +where creation_date > '$since_when' +and $newsgroup_clause +and news.creation_user = ut.user_id +order by creation_date desc" + } else { + # only showed the approved and released stuff + set query "select news.title, news.news_item_id, news.approval_state, + expired_p(news.expiration_date) as expired_p, + to_char(news.release_date,'Mon DD, YYYY') as release_date_pretty + from news_items news, $users_table ut + where creation_date > '$since_when' +and $newsgroup_clause +and news.approval_state = 'approved' +and release_date < sysdate() +and news.creation_user = ut.user_id +order by release_date desc, creation_date desc" + } + set result_items "" + set selection [ns_db select $db $query] + set counter 0 + while { [ns_db getrow $db $selection] } { + set_variables_after_query + switch $purpose { + web_display { + append result_items "

  • [util_decode $include_date_p 1 "$release_date_pretty: " ""]$title\n" } + site_admin { + append result_items "
  • [util_decode $include_date_p 1 "$release_date_pretty: " ""]$title" + if { ![string match $approval_state "approved"] } { + append result_items "  not approved" + } + append result_items "\n" + } + email_summary { + append result_items "[util_decode $include_date_p 1 "$release_date_pretty: " ""]$title + -- [ad_url]/news/item.tcl?news_item_id=$news_item_id +" + } + } + incr counter + if { $max_stories_to_display > 0 && $counter >= $max_stories_to_display } { + ns_db flush $db + break + } + } + if { ! $include_comments_p } { + return $result_items + } + # we have the result_items or not + if { $purpose == "email_summary" } { + set tentative_result $result_items + } elseif { ![empty_string_p $result_items] } { + set tentative_result $result_items + } else { + set tentative_result "" + } + # now let's move into the comments on news territory (we don't do + # this in a separate new-stuff proc because we want to keep it + # together with the new news) + if { $purpose == "email_summary" } { + # the email followers aren't going to be interested in comments + return $tentative_result + } + if { $purpose == "site_admin" } { + set where_clause_for_approval "" + } else { + set where_clause_for_approval "and gc.approved_p = 't'" + } + set comment_query " +select + gc.comment_id, + gc.on_which_table, + gc.html_p as comment_html_p, + substr(gc.content,0,100) as content_intro, + gc.on_what_id, + users.user_id as comment_user_id, + gc.comment_date, + first_names || ' ' || last_name as commenter_name, + gc.approved_p, + news.title, + news.news_item_id +from general_comments gc, $users_table users, news_items news +where users.user_id = gc.user_id +and gc.on_which_table = 'news_items' +and gc.on_what_id = news.news_item_id +$where_clause_for_approval +and comment_date > '$since_when' +order by gc.comment_date desc" + + set result_items "" + set selection [ns_db select $db $comment_query] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + if { $comment_html_p == "t" } { + regsub {<[^>]*$} $content_intro "" content_intro + } + + switch $purpose { + web_display { + append result_items "
  • comment from $commenter_name on $title: +
    +$content_intro ... +
    +" + } + site_admin { + append result_items "
  • comment from $commenter_name on $title: +
    +$content_intro ... +
    +" + } + } + } + if ![empty_string_p $result_items] { + append tentative_result "\n

    comments on news items

    \n\n$result_items" + } + if ![empty_string_p $tentative_result] { + return "
      \n\n$tentative_result\n
    " + } else { + return "" + } +} + +################################################################## +# +# interface to the ad-user-contributions-summary.tcl system + +ns_share ad_user_contributions_summary_proc_list + +if { ![info exists ad_user_contributions_summary_proc_list] || [util_search_list_of_lists $ad_user_contributions_summary_proc_list "/news postings" 0] == -1 } { + lappend ad_user_contributions_summary_proc_list [list "/news postings" news_user_contributions 0] +} + +proc_doc news_user_contributions {db user_id purpose} {Returns list items, one for each news posting} { + if { $purpose == "site_admin" } { + set restriction_clause "" + } else { + set restriction_clause "\nand n.approval_state = 'approved'" + } + + set selection [ns_db select $db " + select n.news_item_id, n.title, n.approval_state, n.release_date, ng.scope, + ng.group_id, user_group_name_from_id(ng.group_id) as group_name, user_group_short_name_from_id(ng.group_id) as short_name, + case when ng.scope = 'public' then 1 + when ng.scope = 'registered_users' then 1 + when ng.scope = 'all_users' then 1 + when ng.scope = 'group' then 4 + else 5 end as scope_ordering + from news_items n, newsgroups ng + where n.creation_user = $user_id $restriction_clause + and n.newsgroup_id = ng.newsgroup_id + order by scope_ordering, ng.group_id, n.release_date"] + + set db_sub [ns_db gethandle subquery] + + set items "" + set last_group_id "" + set item_counter 0 + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + switch $scope { + public { + if { $item_counter==0 } { + append items "

    Public News Postings

    " + set root_url "/news" + set admin_root_url "/news/admin" + } + } + group { + if { $last_group_id!=$group_id } { + append items "

    $group_name News Postings

    " + + set sub_selection [ns_db 0or1row $db_sub " + select section_key + from content_sections + where scope='group' and group_id=$group_id + and module_key='news'"] + + if { [empty_string_p $selection] } { + set root_url "/news" + set admin_root_url "/news/admin" + } else { + set_variables_after_subquery + set root_url "[ug_url]/[ad_urlencode $short_name]/[ad_urlencode $section_key]" + set admin_root_url "[ug_admin_url]/[ad_urlencode $short_name]/[ad_urlencode $section_key]" + } + } + } + } + + if { $purpose == "site_admin" } { + append items "
  • [util_AnsiDatetoPrettyDate $release_date]: $title\n" + if { ![string match $approval_state "approved"] } { + append items "  not approved" + } + } else { + append items "
  • [util_AnsiDatetoPrettyDate $release_date]: $title\n" + } + set last_group_id $group_id + incr item_counter + } + + ns_db releasehandle $db_sub + + if [empty_string_p $items] { + return [list] + } else { + return [list 0 "News Postings" "
      \n\n$items\n\n
    "] + } + +} + +proc_doc news_admin_authorize { db news_item_id } "given news_item_id, this procedure will check whether the user can administer this news item (e.g. for scope=group, this proc will check whether the user is group administrator). if news doesn't exist page is served to the user informing him that the news item doesn't exist. if successfull it will return user_id of the administrator." { + set selection [ns_db 0or1row $db " + select news_item_id, scope, group_id + from news_items, newsgroups + where news_item_id=$news_item_id + and news_items.newsgroup_id = newsgroups.newsgroup_id"] + + if { [empty_string_p $selection] } { + # faq doesn't exist + uplevel { + ns_return 200 text/html " + [ad_scope_admin_header "News Item Does not Exist" $db] + [ad_scope_admin_page_title "News Item Does not Exist" $db] + [ad_scope_admin_context_bar [list index.tcl?[export_url_scope_vars] "News Admin"] "No News Item"] +
    +
    + Requested News Item does not exist. +
    + [ad_scope_admin_footer] + " + } + return -code return + } + + # faq exists + set_variables_after_query + + set id 0 + switch $scope { + public { + set id 0 + } + group { + set id $group_id + } + } + + set authorization_status [ad_scope_authorization_status $db $scope admin group_admin none $id] + + set user_id [ad_verify_and_get_user_id] + + switch $authorization_status { + authorized { + return $user_id + } + not_authorized { + ad_return_warning "Not authorized" "You are not authorized to see this page" + return -code return + } + reg_required { + ad_redirect_for_registration + return -code return + } + } +} + +proc_doc news_item_comments { db news_item_id } "Displays the comments for this newsgroups items with a link to toggle the approval status." { + + set return_string "" + + set selection [ns_db select $db " + select comment_id, content, comment_date, + first_names || ' ' || last_name as commenter_name, + users.user_id as comment_user_id, html_p as comment_html_p, + general_comments.approved_p as comment_approved_p + from general_comments, users + where on_what_id= $news_item_id + and on_which_table = 'news_items' + and general_comments.user_id = users.user_id"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + append return_string "$commenter_name" + + # print out the approval status if we are using the approval system + if { [ad_parameter CommentApprovalPolicy news] != "open"} { + if {$comment_approved_p == "t" } { + append return_string " -- Revoke approval" + } else { + append return_string " -- Approve" + } + } + + append return_string "
    \n[util_maybe_convert_to_html $content $comment_html_p]
    " + + } + + if { [empty_string_p $return_string] } { + return "" + } else { + return "

    Comments

    \n
      $return_string
    \n" + } +} + +util_report_successful_library_load Index: web/openacs/tcl/notification-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/notification-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/notification-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,143 @@ + +# A system for generalizing Notifications +# Ben Adida (ben@mit.edu) + +proc notification_system_name {} { + return "Notification" +} + +proc notification_url_stub {} { + return "/notification" +} + +proc notification_sender_email {} { + return "notification@adida.net" +} + +proc notification_header {title} { + return [ad_header $title] +} + +proc notification_footer {} { + return [ad_footer] +} + +proc notification_list_of_prefs {} { + return [list none instant hourly daily weekly] +} + +proc notification_user_is_interested_p {user_id class_id item_id {db {}}} { + check_db_var + + set check [database_to_tcl_string $db "select count(*) from user_notification_interest_map where notification_class_id=$class_id and user_id=$user_id and item_id=$item_id"] + + cleanup_db_var + + return $check +} + +proc notification_set_user_interest {user_id class_id item_id {db {}}} { + check_db_var + + # This user might already have expressed interest + catch {ns_db dml $db "insert into user_notification_interest_map (notification_class_id, user_id, item_id) values ($class_id, $user_id, $item_id)"} errmsg + + cleanup_db_var +} + +proc notification_remove_user_interest {user_id class_id item_id {db {}}} { + check_db_var + + ns_db dml $db "delete from user_notification_interest_map where notification_class_id=$class_id and user_id=$user_id and item_id=$item_id" + + cleanup_db_var +} + +proc notification_notify_users {class_id item_id message {db {}}} { + check_db_var + + # Call PL/SQL + database_to_tcl_string $db "select user_add_notification($class_id, $item_id, '[DoubleApos $message]')" + + cleanup_db_var +} + + +proc notification_send_one_email {to from subject body} { + ns_sendmail $to $from $subject "$body + +---------------------------------------------------------------------------------- +This email is being sent to you by [notification_system_name] +at [ad_url], because you +requested updates on bugs and features. + +If you would like to change your notification status, please visit: +[ad_url][notification_url_stub]/prefs.tcl +" +} + +## Scheduled Procs for notification +proc user_send_notifications {notification_interval} { + set db [ns_db gethandle subquery] + + ns_db dml $db "begin transaction" + + # Lock the table + ns_db dml $db "lock table user_notifications" + + # Select all the notifications for this particular interval + set data_to_send [database_to_tcl_list_list $db " + select users.user_id, email, notification_content, notification_class + from user_notifications, user_notification_prefs, users, user_notification_classes where + user_notification_classes.notification_class_id= user_notification_prefs.notification_class_id and + user_notification_prefs.notification_class_id= user_notifications.notification_class_id and + users.user_id= user_notifications.user_id and + user_notifications.user_id= user_notification_prefs.user_id + and (notification_content is not null and notification_content != '') + and notification_pref= '$notification_interval'"] + + # Close the transaction + ns_db dml $db "end transaction" + + ns_db releasehandle $db + + # Send out the emails! + foreach email $data_to_send { + notification_send_one_email [lindex $email 1] [notification_sender_email] "[lindex $email 3] Update" [lindex $email 2] + } + + set db [ns_db gethandle subquery] + + # Clear things out + ns_db dml $db " + update user_notifications set notification_content='' + where user_id in + (select user_id from user_notification_prefs + where notification_pref='$notification_interval')" + + ns_db releasehandle $db +} + +proc user_remove_notifications {interval} { + set db [ns_db gethandle subquery] + + ns_db dml $db "update user_notifications set notification_content='' where user_id in (select user_id from user_notification_prefs where notification_pref='$interval')" + + ns_db releasehandle $db +} + +ns_share -init {set user_notification_scheduled_p 0} user_notification_scheduled_p + +if {!$user_notification_scheduled_p} { + set user_notification_scheduled_p 1 + + for {set i 0} {$i<24} {incr i} { + ns_schedule_daily -thread $i 0 user_send_notifications hourly + } + + ns_schedule_daily -thread 23 15 user_send_notifications daily + + ns_schedule_weekly -thread 0 23 30 user_send_notifications weekly + + ns_schedule_daily -thread 0 30 user_remove_notifications none +} Index: web/openacs/tcl/openacs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/openacs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/openacs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,33 @@ + +proc openacs_header {title} { + return "$title + + + +
    + +
    +" +} + +proc openacs_footer {} { + return " +
    +
    [ad_system_owner]
    +
    +
    +" +} + +proc openacs_menu {} { + return " +
    +home | +software | +documentation | +forums | +philosophy | +team | +OpenACS 4.x
    +" +} \ No newline at end of file Index: web/openacs/tcl/oracle.tcl.off =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/oracle.tcl.off,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/oracle.tcl.off 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,74 @@ + +proc db_name {} { + return "oracle" +} + +proc db_postgres {} { + return "" +} + +proc db_oracle {} { + return "oracle" +} + +proc db_sysdate {} { + return "sysdate" +} + +proc db_resultrows {db} { + return [ns_ora resultrows $db] +} + +proc db_sequence_nextval_sql {sequence_name} { + return "${sequence_name}.nextval" +} + +proc db_sequence_nextval {db sequence_name} { + return [database_to_tcl_string $db "select [db_sequence_nextval_sql $sequence_name] from dual"] +} + +# This performs some simple operations on the SQL +# statement to convert it to the proper SQL syntax. +# Useful mostly for automatic DB porting of simple things. +proc db_sql_prep {sql} { + + # Take care of sequences + # regsub -all "(\[^ \]*)\\.nextval" $sql "nextval('\\1')" sql + + # Take care of sysdate calls + # regsub -all "sysdate(\[^\(_\])" $sql "sysdate\(\)\\1" sql + + return $sql +} + +## Recreate the ns_table command for now +# proc ns_table3 {command db data} { +# if {$command == "exists"} { +# # MAJOR HACK CHANGE THIS SOON +# # TODO: ben@adida.net +# return 1 +# } +# } + +# Nulls +proc db_null_sql {str} { + return [db_postgres_null_sql $str] +} + +proc db_postgres_null_sql {str} { + if {$str == ""} { + return "NULL" + } else { + return "'$str'" + } +} + +# Nulls +proc db_postgres_doubleapos_null_sql {str} { + if {$str == ""} { + return "NULL" + } else { + return "'[DoubleApos $str]'" + } +} + Index: web/openacs/tcl/photonet-styles.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/photonet-styles.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/photonet-styles.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,21 @@ +# photonet-styles.tcl,v 3.0 2000/02/06 03:13:52 ron Exp +# +# photonet-styles.tcl +# +# by philg@mit.edu on September 5, 1999 +# +# styles used site-wide by http://photo.net +# also useful as a demonstration of how the /doc/style.html +# stuff gets used in practice + +# the following style will be available in ADP pages as +# and in Tcl pages as [ad_style_bodynote "what you want to note"] + +ad_register_styletag bodynote "A note that goes inline on a page; generally presented smaller and in a sans serif font." { + return "
    + +$string + +
    +" +} Index: web/openacs/tcl/poll-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/poll-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/poll-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,179 @@ +# poll-defs.tcl,v 3.0 2000/02/06 03:13:53 ron Exp +# poll-defs.tcl -- definitions for the opinion polling module + +# by markd@arsdigita.com, September 1999 + +util_report_library_entry + + + +# returns a list of info about the poll: +# name, description, start_date, end_date, require_registration_p, active_p +# handy for memoization. + +proc poll_info_internal { poll_id } { + + set db [ns_db gethandle subquery] + + set info [database_1row_to_tcl_list $db " +select name, description, start_date, end_date, require_registration_p, + poll_is_active_p(start_date, end_date) as active_p + from polls + where poll_id = $poll_id +"] + + ns_db releasehandle $db + + return $info + +} ;# poll_info_internal + + + + +# returns a list of poll labels: +# label 1, choice id 1, label 2, choice id 2 +# handy for memoization, and handy for passing the result to poll_display + +proc poll_labels_internal { poll_id } { + set db [ns_db gethandle subquery] + + set selection [ns_db select $db " +select choice_id, label + from poll_choices + where poll_id = $poll_id + order by sort_order +"] + + set choices [list] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + lappend choices $label + lappend choices $choice_id + } + + ns_db releasehandle $db + + return $choices + +} ;# poll_labels_internal + + + +# display the polls on the front page. +# the 'polls' argument should be a tcl list of the form +# poll-link req_registration_p poll-link req_registration_p ... + +ad_proc poll_front_page { { -item_start "
  • " -item_end "" -style_start "" -style_end "" -require_registration_start "" -require_registration_end "" -require_registration_text "(registration required)" -no_polls "There are no currently active polls" } polls } "" { + + set result "" + + set user_id [ad_get_user_id] + + set length [llength $polls] + + if { $length == 0 } { + append result "$item_start $no_polls" + } + + for { set i 0 } { $i < $length } { incr i 2 } { + set item [lindex $polls $i] + set require_registration_p [lindex $polls [expr $i + 1]] + + append result "$item_start $style_start $item $style_end $item_end" + + if { $require_registration_p == "t" && $user_id == 0 } { + # this poll requires registration and the user isn't logged in + append result "$require_registration_start $require_registration_text $require_registration_end" + } + append result "\n" + } + + return $result + +} ;# poll_front_page + + + +# choices is a list of the form +# choice_label choice_id choice_label choice_id ... + +ad_proc poll_display { { -item_start "
    " -item_end "" -style_start "" -style_end "" -no_choices "No Choices Specified" } choices } "" { + + set result "" + + set length [llength $choices] + + if { $length == 0 } { + append result "$item_start $no_choices" + } + + for { set i 0 } { $i < $length } { incr i 2 } { + set label [lindex $choices $i] + set choice_id [lindex $choices [expr $i + 1]] + + append result "$item_start $style_start $label $style_end $item_end\n" + } + + return $result + +} ;# poll_display + + + +ad_proc poll_results { { -bar_color "blue" -display_values_p "t" -display_scale_p "t" -bar_height "15" } results } "" { + + if { [llength $results] != 0 } { + + set result [gr_sideways_bar_chart -bar_color_list [list $bar_color] -display_values_p $display_values_p -display_scale_p $display_scale_p -bar_height $bar_height $results] + + } else { + set result "" + } + + return $result + +} ;# poll_results + + +################################################################## +# +# interface to the ad-user-contributions-summary.tcl system + +ns_share ad_user_contributions_summary_proc_list + +if { ![info exists ad_user_contributions_summary_proc_list] || [util_search_list_of_lists $ad_user_contributions_summary_proc_list "Poll Choices" 0] == -1 } { + lappend ad_user_contributions_summary_proc_list [list "Poll Choices" poll_user_contributions 0] +} + +proc_doc poll_user_contributions {db user_id purpose} {Returns list items, one for each answer; returns empty list for non-site-admin.} { + if { $purpose != "site_admin" } { + return [list] + } + set selection [ns_db select $db "select + polls.poll_id, + polls.name as poll_name, + pc.label as choice_name, + puc.choice_date +from polls, poll_choices pc, poll_user_choices puc +where puc.user_id = $user_id +and puc.choice_id = pc.choice_id +and puc.poll_id = polls.poll_id +order by choice_date asc"] + + set items "" + while { [ns_db getrow $db $selection] } { + set_variables_after_query + append items "
  • [util_AnsiDatetoPrettyDate $choice_date]: $poll_name; $choice_name\n" + } + if [empty_string_p $items] { + return [list] + } else { + return [list 0 "Poll Choices" "
      \n\n$items\n\n
    "] + } +} + + +util_report_successful_library_load + Index: web/openacs/tcl/portals-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/portals-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/portals-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,445 @@ +# portals-defs.tcl,v 3.2.2.1 2000/04/11 09:52:11 carsten Exp +# +# portals-defs.tcl +# +# by aure@arsdigita.com, September 1999 +# + +ns_register_proc GET /portals/*[ad_parameter PortalExtension portals .ptl] portal_display + +proc_doc portal_footer {db id group_name page_number type} {Generate footer for portal pages.} { + + # Get generic display information + portal_display_info + + # Find out the number of pages this portal has + set total_pages [database_to_tcl_string $db " + select count(*) from portal_pages where ${type}_id=$id"] + + if { $type == "group" } { + # names and emails of the managers of this portal group; + # we need the "distinct" because a user can be mapped more + # than once to a group (one mapping per role) + # + set administrator_query "select distinct u.first_names||' '||u.last_name as admin_name, u.email as admin_email + from users u, user_group_map map + where u.user_id = map.user_id + and map.group_id = $id" + + set selection [ns_db select $db $administrator_query] + + set administrator_list [list] + while {[ns_db getrow $db $selection]} { + set_variables_after_query + lappend administrator_list "$admin_name" + } + set extra_footer_text "The content of this portal page is managed by: [join $administrator_list ", "]" + regsub -all -- " " [string tolower $group_name] {-} link_name + } else { + set link_name "user$id" + set extra_footer_text "Personalize this portal." + } + + set page_name [database_to_tcl_string_or_null $db " + select page_name from portal_pages + where page_number = $page_number + and ${type}_id = $id"] + + + # while the following may not seem very readable, it is important that there are no + # extra spaces in this table + set footer_html " + + + + + + +
    [string toupper "$system_name : $group_name"] + +
    \n" + + # set up the page tabs only if there is more than one page + if {$total_pages > 1} { + + # if we want equal size tabs, regsub a width restriction into the td + if {[ad_parameter EqualWidthTabsP portals]} { + regsub { $page_name\n" + } else { + append footer_html " + $subheader_td
    $page_name\n" + } + } + } + + append footer_html " +
    +
    +
    + $font_tag

    + $extra_footer_text +

    + If you encounter any bugs or have suggestions that are not content-related, email [ad_parameter AdministratorName portals [ad_system_owner]]. + + +" + + return $footer_html +} + + +proc_doc portal_header {db id group_name page_number type} {Generate header for portal pages.} { + + # Get generic display information + portal_display_info + + # Find out the number of pages this portal has + set total_pages [database_to_tcl_string $db " + select count(*) from portal_pages where ${type}_id=$id"] + + set page_name [database_to_tcl_string_or_null $db " + select page_name from portal_pages + where page_number=$page_number and ${type}_id=$id"] + + + # while the following may not seem very readable, it is important that there are no + # extra spaces in this table + set header_html " + + + +
    [string toupper "$system_name : $group_name"] + +
    \n" + + # set up the page tabs only if there is more than one page + if {$total_pages > 1} { + + if {$type == "group"} { + # convert group_name to a URL friendly string + regsub -all -- " " [string tolower $group_name] {-} link_name + } else { + set link_name "user$id" + } + # if we want equal size tabs, regsub a width restriction into the td + if {[ad_parameter EqualWidthTabsP portals]} { + regsub { $page_name\n" + } else { + append header_html " + $subheader_td
    $page_name\n" + } + } + } + append header_html " +
    +
    +
    \n" + + return $header_html +} + + +proc portal_display_page {id page_number type} { + + # Get generic display information + portal_display_info + + set left_side_width [ad_parameter LeftSideWidth portals] + set right_side_width [ad_parameter RightSideWidth portals] + + if ![empty_string_p $left_side_width] { + set left_side_width "width=$left_side_width" + } + if ![empty_string_p $right_side_width] { + set left_side_width "width=$right_side_width" + } + + set table_spacer "
    " + + set db [ns_db gethandle] + + if {$type == "group" } { + set main_name [database_to_tcl_string $db " + select upper(group_name) from user_groups where group_id=$id"] + set nottype "user" + } else { + set main_name [database_to_tcl_string $db " + select upper(first_names||' '||last_name) from users where user_id=$id"] + set nottype "group" + } + + set page_name [database_to_tcl_string_or_null $db " + select page_name from portal_pages where page_number=$page_number and ${type}_id=$id"] + + + set main_title "$main_name : $page_name" + + # Get the table_id for each table that will appear on this page + + set table_select " + select page_side, table_name, adp + from portal_table_page_map map, portal_pages p_p, portal_tables p_t + where map.page_id = p_p.page_id + and p_t.table_id = map.table_id + and ${type}_id = $id + and ${nottype}_id is null + and page_number = $page_number + order by page_side, sort_key" + + set table_list [database_to_tcl_list_list $db $table_select] + + set l_side_html "" + set r_side_html "" + + set header [portal_header $db $id $main_name $page_number $type] + set footer [portal_footer $db $id $main_name $page_number $type] + + # we're done with $db, let's leave it around in case any of the + # page elements need to use it + + foreach table_triplet $table_list { + set page_side [lindex $table_triplet 0] + set table_name [lindex $table_triplet 1] + set adp [lindex $table_triplet 2] + + # we have to evaluate the adp now; at this point we have to + # worry about security **** (the .adp could contain an exec or + # destructive database action; of course only authorized portal + # admins get to change the code but still). We also have to + # worry about programming mistakes and don't want a little bug + # in one section to make an entire portal unavailable + if [catch { set parsed_adp [ns_adp_parse -string $adp] } errmsg] { + ns_log Error "portal_display_page tried to evaluate\n\n$adp\n\nand got hit with\n\n$errmsg\n" + # go to the next loop iteration + continue + } + + # replace any s or s in an embedded table with one has the normal font tag + # after it so that this text also will conform to the portal standard font + regsub -nocase -all {(]*>)} $parsed_adp {\1 font_tag} table_innards + regsub -nocase -all {(]*>)} $table_innards {\1 font_tag} table_innards + regsub -nocase -all {font_tag} $table_innards $font_tag table_innards + + # let's ADP parse evaluate the table_name, again watching for errors + if [catch { set parsed_table_name [ns_adp_parse -string $table_name] } errmsg] { + ns_log Error "portal_display_page tried to evaluate\n\n$table_name\n\nand got hit with\n\n$errmsg\n" + # go to the next loop iteration + continue + } + + set html_table " + $begin_table + + $header_td [string toupper $parsed_table_name] + + + $normal_td$table_innards + + $end_table" + + # Place the HTML table we have just finished creating on either the left or right side of the page + # by appending the left_side_html or right_side_html string. + + append ${page_side}_side_html "$html_table $table_spacer" + + + } + + # we're done evaluating all the elements of a page + ns_db releasehandle $db + + return " + + $main_title + + $body_tag + + + + + + + + + + + + +
    $header
    $l_side_html$r_side_html
    $footer
    " + +} + +proc_doc portal_display {} {Registered procedure that uses the URL to determine what page to show} { + + set full_url [ns_conn url] + set portal_extension [ad_parameter PortalExtension portals .ptl] + + if [regexp "/portals/user(.*)-(\[0-9\]+)$portal_extension" $full_url match user_id page_number] { + ad_maybe_redirect_for_registration + # memoize a user page for a short time, first check to make sure we're not evaling + # anything naughty + validate_integer "user_id" $user_id + validate_integer "page_number" $page_number + ns_return 200 text/html [util_memoize "portal_display_page $user_id $page_number user" 10] + } elseif [regexp "/portals/(.*)-(\[0-9\]+)$portal_extension" $full_url match group_name page_number] { + regsub -all -- {-} $group_name { } group_name + set group_name [string toupper $group_name] + set db [ns_db gethandle] + + set group_id [database_to_tcl_string_or_null $db " + select group_id + from user_groups where upper(group_name)='[DoubleApos $group_name]'"] + if { [empty_string_p $group_id] } { + # If the group does not exist, we redirect to the + # portal list. + + ns_returnredirect [ad_parameter MainPublicURL portals] + } else { + ns_db releasehandle $db + validate_integer "group_id" $group_id + validate_integer "page_number" $page_number + ns_return 200 text/html [util_memoize "portal_display_page $group_id $page_number group" [ad_parameter CacheTimeout portals 600]] + } + } else { + ns_returnredirect [ad_parameter MainPublicURL portals] + } + +} + + +proc_doc portal_check_administrator_maybe_redirect {db user_id {group_id ""} {redirect_location ""}} {} { + + ad_maybe_redirect_for_registration + + # set up the where clause - a blank group_id results in a more restrictive group check + if ![empty_string_p $group_id] { + set group_restriction "and (map.group_id = $group_id or group_name= 'Super Administrators')" + } else { + set group_restriction "and group_name= 'Super Administrators'" + } + if {[empty_string_p $redirect_location]} { + # Added by Branimir, Jan 26, 2000, we also need to put URL variables into return_url + set what_the_user_requested [ns_conn url] + if { !([ns_getform] == "") } { + set url_vars [export_entire_form_as_url_vars] + append what_the_user_requested ?$url_vars + } + set redirect_location "/register/index.tcl?return_url=[ns_urlencode $what_the_user_requested]" + } + + set count [database_to_tcl_string $db " + select count(*) + from user_group_map map, user_groups ug + where map.user_id = $user_id + and map.group_id = ug.group_id + and ug.group_type = 'portal_group' + and role='administrator' + $group_restriction"] + + if {$count == 0 } { + ns_returnredirect $redirect_location + return -code return + } + return +} + +proc_doc portal_group_name {db group_id} {Quite simply gets the group_name for a group_id.} { + return [database_to_tcl_string_or_null $db "select group_name from user_groups where group_id = $group_id"] +} + + + +proc portal_system_owner {} { + return [ad_parameter SystemOwner portals [ad_system_owner]] +} + +proc portal_admin_footer {} { + return "

    +
    [portal_system_owner]
     + +" +} + +proc portal_admin_header {title} { + # Get generic display information + portal_display_info + + return " + + + $title + + $body_tag +

    $title

    " +} + + +proc_doc portal_display_info {} { uplevels all the system specific display information for the portals system} { + uplevel { + set system_name [ad_parameter SystemName portals] + set body_tag [ad_parameter BodyTag portals] + set begin_table [ad_parameter BeginTable portals] + set end_table [ad_parameter EndTable portals] + set font_tag [ad_parameter FontTag portals] + set header_td [ad_parameter HeaderTD portals] + set subheader_td [ad_parameter SubHeaderTD portals] + set normal_td [ad_parameter NormalTD portals] + set header_bg [ad_parameter HeaderBGColor portals] + } +} + + +proc_doc portal_adp_parse {adp db} { returns a parsed adp string - done here so variables in the adp don't conflict with variables in the main page (except for $db, which we make sure is always a valid connection from the main pool). Also modifies any s or s in an embedded table (adp) to have a standard font tag after it so that this text also will conform to the portal standard font.} { + + portal_display_info + + regsub -nocase -all {(]*>)} [ns_adp_parse -string $adp] {\1 font_tag} shown_adp + regsub -nocase -all {(]*>)} $shown_adp {\1 font_tag} shown_adp + regsub -nocase -all {font_tag} $shown_adp $font_tag shown_adp + + return "$shown_adp" +} + + + + + + + + Index: web/openacs/tcl/postgres.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/postgres.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/postgres.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,79 @@ + +proc db_name {} { + return "postgres" +} + +proc db_postgres {} { + return "postgres" +} + +proc db_sysdate {} { + return "sysdate()" +} + +proc db_resultrows {db} { + return [ns_pg ntuples $db] +} + +proc db_sequence_nextval_sql {sequence_name} { + return "nextval('$sequence_name')" +} + +proc db_sequence_nextval {db sequence_name} { + return [database_to_tcl_string $db "select [db_sequence_nextval_sql $sequence_name]"] +} + +# This performs some simple operations on the SQL +# statement to convert it to the proper SQL syntax. +# Useful mostly for automatic DB porting of simple things. +proc db_sql_prep {sql} { + + # Take care of sequences + regsub -all "(\[^ \]*)\\.nextval" $sql "nextval('\\1')" sql + + # Take care of sysdate calls + regsub -all "sysdate(\[^\(_\])" $sql "sysdate\(\)\\1" sql + + return $sql +} + +## Recreate the ns_table command for now +proc ns_table3 {command db data} { + if {$command == "exists"} { + # MAJOR HACK CHANGE THIS SOON + # TODO: ben@adida.net + return 1 + } +} +# Nulls +proc db_null_sql {str} { + return [db_postgres_null_sql $str] +} + +proc db_postgres_null_sql {str} { + if {$str == ""} { + return "NULL" + } else { + return "'$str'" + } +} + +# Nulls +proc db_postgres_doubleapos_null_sql {str} { + if {$str == ""} { + return "NULL" + } else { + return "'[DoubleApos $str]'" + } +} + +proc database_lob_to_tcl_string { db lob_id } { + ns_log Debug "tcl: lob_id = $lob_id" + set tmpfile [ns_mktemp "/tmp/.wm_blob_selectgXXXXXX"] + ns_pg blob_select_file $db $lob_id $tmpfile + set fis [open $tmpfile r] + set str [read $fis] + close $fis + ns_unlink -nocomplain $tmpfile + return $str +} Index: web/openacs/tcl/presentation.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/presentation.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/presentation.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,7 @@ +proc html_section_title {title} { + return " + + + +
    $title
    " +} \ No newline at end of file Index: web/openacs/tcl/press-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/press-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/press-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,301 @@ +# /tcl/press-defs.tcl +# +# Definitions for the press module +# +# Author: ron@arsdigita.com, December 1999 +# +# press-defs.tcl,v 3.0.4.2 2000/03/16 20:57:02 ron Exp +# ----------------------------------------------------------------------------- + +util_report_library_entry + +# Wrappers for the press module parameters to supply default values in +# case the site administrator leaves them out of the ACS ini file + +proc_doc press_active_days {} {returns the maximum number of days that +a press release will remain active on /press/} { + return [ad_parameter ActiveDays press 60] +} + +proc_doc press_display_max {} {returns the maximum number of press +releases to display on /press/} { + return [ad_parameter DisplayMax press 20] +} + +# Everything that's not a proc_doc is a private utility function for +# the press module + +# Sample data for previews, forms, etc. + +proc_doc press_coverage_samples {} {sets sample press coverage variables +(sample_publication_name, etc.) in the stack frame of the caller} { + uplevel 1 { + set sample_publication_name "Time" + set sample_publication_link "http://time.com/" + set sample_publication_date "January 1, 2100" + set sample_publication_date_desc "January issue" + set sample_article_title "Time's Person of the Year" + set sample_article_link "http://www.pathfinder.com/time/poy/" + set sample_article_pages "pp 50-52" + set sample_abstract \ + "Welcome, Jeff Bezos, to TIME's Person of the Year + club. As befits a new-era entrepreneur, at 35 you are + the fourth youngest individual ever, preceded by + 25-year-old Charles Lindbergh in 1927; Queen + Elizabeth II, who made the list in 1952 at age 26; and + Martin Luther King Jr., who was 34 when he was + selected in 1963. A pioneer, royalty and a + revolutionary--noble company for the man who is, + unquestionably, king of cybercommerce." + } +} + +# Build and optionally initialize an input form element + +proc press_entry_widget {name varname size {help ""} } { + upvar $varname value + + if {[info exists value] && ![empty_string_p $value]} { + set value_clause "value=\"$value\"" + } else { + set value_clause "" + } + + return " + + $name: + + $help + " +} + +# Build a scope selection menu. This gives the option of making press +# coverage public or restricted to members of a certain user group. +# The only groups offered are those for which the user is a member. + +proc press_scope_widget {db {default_group ""}} { + + # Available groups are specific to each user + + set user_id [ad_verify_and_get_user_id] + + # For group-only administrators just offer the groups for which + # they have administrative priviledges + + if {[ad_administrator_p $db $user_id] } { + set restrictions "" + } else { + set restrictions " + and group_id in + (select group_id + from user_group_map + where user_group_map.user_id = $user_id + and lower(user_group_map.role) = 'administrator')" + } + + # Get the list of available user groups for this user + + set selection [ns_db select $db " + select group_id, group_name + from user_groups + where group_type <> 'administration' + $restrictions + order by group_name"] + + if {[empty_string_p $default_group]} { + set scope_items "
  • $manufacturer $model (from $email)" + } + if { ![empty_string_p $result_items] } { + return "
      \n\n$result_items\n
    \n" + } else { + return "" + } +} + +util_report_successful_library_load Index: web/openacs/tcl/sdm-colorization.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/sdm-colorization.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/sdm-colorization.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,105 @@ + +proc sdm_sourcecode_colorize {filename contents} { + set extension [file extension $filename] + + ns_log Notice $extension + + if {[info commands sdm_sourcecode_colorize_$extension] != ""} { + return [sdm_sourcecode_colorize_$extension $contents] + } else { + return $contents + } +} + +proc sdm_sourcecode_colorize_.java {contents} { + # colorize comments + set newcontents "" + + while {1} { + set start_comment [string first "/*" $contents] + set end_comment [string first "*/" $contents] + + if {$start_comment == -1} { + break + } + + if {$end_comment == -1} { + break + } + + append newcontents [string range $contents 0 [expr $start_comment - 1]] + append newcontents "" + append newcontents [string range $contents $start_comment [expr $end_comment + 1]] + append newcontents "" + set contents [string range $contents [expr $end_comment + 2] end] + } + + append newcontents $contents + + # regsub -all {(//[^\n]+)\n} $newcontents "&\n" newcontents2 + + return $newcontents +} + + +proc sdm_sourcecode_colorize_.c {contents} { + # colorize comments + set newcontents "" + + while {1} { + set start_comment [string first "/*" $contents] + set end_comment [string first "*/" $contents] + + if {$start_comment == -1} { + break + } + + if {$end_comment == -1} { + break + } + + append newcontents [string range $contents 0 [expr $start_comment - 1]] + append newcontents "" + append newcontents [string range $contents $start_comment [expr $end_comment + 1]] + append newcontents "" + set contents [string range $contents [expr $end_comment + 2] end] + } + + append newcontents $contents + + # regsub -all {(//[^\n]+)\n} $newcontents "&\n" newcontents2 + + return $newcontents +} + + +proc sdm_sourcecode_colorize_.h {contents} { + # colorize comments + set newcontents "" + + while {1} { + set start_comment [string first "/*" $contents] + set end_comment [string first "*/" $contents] + + if {$start_comment == -1} { + break + } + + if {$end_comment == -1} { + break + } + + append newcontents [string range $contents 0 [expr $start_comment - 1]] + append newcontents "" + append newcontents [string range $contents $start_comment [expr $end_comment + 1]] + append newcontents "" + set contents [string range $contents [expr $end_comment + 2] end] + } + + append newcontents $contents + + # regsub -all {(//[^\n]+)\n} $newcontents "&\n" newcontents2 + + return $newcontents +} + Index: web/openacs/tcl/sdm-cvs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/sdm-cvs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/sdm-cvs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,316 @@ +## +## Code to integrate CVS interaction +## within the SDM +## +## ben@mit.edu + +proc cvs_dir {} { + return "/web/acstest/sdm-cvs" +} + +proc cvs_executable {} { + return "/usr/bin/cvs" +} + +proc cvs {path {hostname ""} {username ""} {password ""}} { + return "[cvs_executable] -d $path" +} + +proc cvs_checkout {package_name path {release_version ""} {hostname ""} {username ""} {password ""}} { + if {$release_version == ""} { + set release_cvs "-A -d" + } else { + set release_cvs "-d -r $release_version" + } + + if {[catch {eval "exec [cvs $path $hostname $username $password] checkout $package_name"} errmsg]} { + ns_log Notice "cvserror: $errmsg" + } + + if {[catch {eval "exec [cvs $path $hostname $username $password] update $release_cvs $package_name"} errmsg]} { + ns_log Notice "cvserror: $errmsg" + } +} + +proc cvs_commit {package_name path commit_msg {hostname ""} {username ""} {password ""}} { + if {[catch {eval "exec [cvs $path $hostname $username $password] commit -m \"$commit_msg\""} errmsg]} { + ns_log Notice "cvserror: $errmsg" + } +} + +proc cvs_tag_to_cli {tag} { + if {$tag == ""} { + return "-A" + } else { + return "-r $tag" + } +} + +proc cvs_checkout_to_string {file_name cvsroot tag} { + + if {[catch {eval "exec [cvs $cvsroot] checkout [cvs_tag_to_cli $tag] -p $file_name"} errmsg]} { + set stuff $errmsg + } else { + return "" + } + + set start [string first "==================================================================" $stuff] + set end [string first "\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*" [string range $stuff [expr $start + 1] end]] + if {$end > -1} { + set end [expr $start + $end] + } + + incr start -1 + + ns_log Notice "start= $start; end= $end" + + set file_contents [string range $stuff 0 $start] + append file_contents [string range $stuff [expr "$end + 15"] end] + + return $file_contents +} + +## History Abstraction + +proc cvs_history_create {revision date author comments} { + return [list $revision $date $author $comments] +} + +proc cvs_history_get_revision {hist} { + return [lindex $hist 0] +} + +proc cvs_history_get_date {hist} { + return [lindex $hist 1] +} + +proc cvs_history_get_author {hist} { + return [lindex $hist 2] +} + +proc cvs_history_get_comments {hist} { + return [lindex $hist 3] +} + +proc cvs_get_cvsroot {package_id db} { + set selection [ns_db 0or1row $db "select cvs_path from cvs_package_data where package_id=$package_id"] + + if {$selection == ""} { + return "" + } + + set_variables_after_query + + return $cvs_path +} + + +# Returns a list of history items +proc cvs_file_get_history {dir file_name cvsroot} { + set list_of_history [list] + + # Get the CVS history + cd $dir + if {[catch {set stuff [eval "exec [cvs $cvsroot] log $file_name"]} errmsg]} { + ns_log Notice "error: $errmsg" + return "" + } else { + } + + set start_index 0 + + while {1} { + if {$start_index < 0} { + break + } + + set blob_start $start_index + set blob_end [string first "----------------------------" [string range $stuff $blob_start end]] + if {$blob_end > -1} { + set blob_end [expr $blob_start + $blob_end] + } + + ns_log Notice "$blob_start - $blob_end" + + if {$blob_end == -1} { + set blob_end [string first "============" [string range $stuff $blob_start end]] + if {$blob_end > -1} { + set blob_end [expr $blob_start + $blob_end] + } + + set start_index -1 + } else { + set start_index [expr "$blob_end + 28"] + } + + set blob [string range $stuff $blob_start [expr "$blob_end - 1"]] + + ns_log Notice "one blob: $blob" + + if {![regexp {revision ([0-9\.]*)} $blob all revision]} { + continue + } + + if {![regexp {date: ([^;]*);} $blob all date]} { + continue + } + + if {![regexp {author: ([^;]*);} $blob all author]} { + continue + } + + # Find the comments, this SUCKS! CVS does not provide nicely parsable stuff. + set last_colon [string last ":" $blob] + set start_comment [string first "\n" [string range $blob $last_colon end]] + + ns_log Notice "last_colon: $last_colon, $start_comment" + set comments [string range $blob [expr $last_colon + $start_comment] end] + ns_log Notice "comment: $comments" + + lappend list_of_history [cvs_history_create $revision $date $author $comments] + } + + return $list_of_history +} + + +proc cvs_util_split_by_lines {content} { + return [split $content "\n"] +} + +proc cvs_util_line_range {split_file start_line end_line} { + set return_stuff "" + + set start [expr "$start_line - 1"] + set end [expr "$end_line - 1"] + + for {set counter $start} {$counter <= $end} {incr counter} { + append return_stuff [lindex $split_file $counter] "\n" + } + + return $return_stuff +} + +proc cvs_file_diff {dir file_name cvsroot old_release new_release} { + + # Get the CVS diff + cd $dir + if {[catch {eval "exec [cvs $cvsroot] diff -r $old_release -r $new_release $file_name"} errmsg]} { + set stuff $errmsg + # ns_log Notice "$stuff" + } else { + return "" + } + + # Get the latest version of the file for full diff + set latest_version [cvs_checkout_to_string $file_name $cvsroot $new_release] + + # Split by lines + set split_latest [cvs_util_split_by_lines $latest_version] + + set start_of_diff [string first "diff -r" $stuff] + set start_of_useful_stuff [expr "[string first "\n" [string range $stuff $start_of_diff end]] + 1 + $start_of_diff"] + set useful_diff [string range $stuff $start_of_useful_stuff end] + + # Now create the diff info + set line_counter 1 + set diff_content [list] + set split_diff [cvs_util_split_by_lines $useful_diff] + set current_section "" + + foreach split_line $split_diff { + # If we're at the beginning/end of a section + if {[regexp {^([0-9,]*)([adc])([0-9,]*)$} $split_line all old_lines action new_lines]} { + + # Wrap up the previous section + if {$current_section != ""} { + lappend diff_content [cvs_process_one_section $current_section $current_action] + + set current_section "" + } + + # In case there are multiple lines + if {![regexp {([0-9]*),([0-9]*)} $new_lines all new_lines_start new_lines_end]} { + set new_lines_start $new_lines + set new_lines_end $new_lines + } + + # Add a section to the diff we skipped some stuff + if {$new_lines_start > $line_counter} { + lappend diff_content [list "nochange" [cvs_util_line_range $split_latest [expr "$line_counter + 1"] [expr "$new_lines_start - 1"]]] + } + + set line_counter $new_lines_end + + set current_action $action + continue + } + + # This is just another line, add it to the section + ns_log Notice "one CVS diff line: $split_line" + set first_two [string range $split_line 0 1] + if {$first_two == "< " || $first_two == "> "} { + append current_section [string range $split_line 2 end] "\n" + } else { + if {$first_two == "\\ " || $first_two == "--"} { + append current_section $split_line "\n" + } + } + + } + + # Plop the last section down + if {$current_section != ""} { + lappend diff_content [cvs_process_one_section $current_section $current_action] + } + + # Add the end if necessary + if {$line_counter < [llength $split_latest]} { + lappend diff_content [list "nochange" [cvs_util_line_range $split_latest [expr "$line_counter + 1"] [llength $split_latest]]] + } + + return $diff_content +} + + +proc cvs_process_one_section {current_section current_action} { + if {$current_action == "c"} { + # split the stuff along the "---" + set split_location [string first "\n---\n" $current_section] + + # add the stuff + return [list "change" "[string range $current_section 0 $split_location]\n" [string range $current_section [expr "$split_location + 5"] end]] + } + + if {$current_action == "a"} { + return [list "add" $current_section] + } + + if {$current_action == "d"} { + return [list "delete" $current_section] + } +} + +# annotate a file +# this will return a list of lines, where each line is a list of attributes and the content +proc cvs_file_annotate {dir file_name cvsroot} { + cd $dir + if {[catch {eval "exec [cvs $cvsroot] annotate $file_name"} errmsg]} { + set stuff $errmsg + } else { + return "" + } + + set lines [split $stuff "\n"] + set processed_lines [list] + + foreach line $lines { + if {![regexp {(\d*\.\d*) *\(([^ ]*) *([^\)]*)\):(.*)} $line all version user date code_line]} { + continue + } + + lappend processed_lines [list [list $version $user $date] $code_line] + } + + return $processed_lines +} \ No newline at end of file Index: web/openacs/tcl/sdm-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/sdm-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/sdm-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,694 @@ + +proc sdm_url_stub {} { + return [ad_parameter UrlStub sdm] +} + +proc sdm_software_root {} { + return [ad_parameter SoftwareRoot sdm] +} + +proc sdm_version {} { + return [ad_parameter SdmVersion sdm] +} + +proc sdm_notification_sender_email {} { + return [ad_parameter NotificationSenderEmail sdm] +} + +# FOR NAVIGATION + +proc sdm_home_context_bar_item {} { + return [list [sdm_url_stub] "SDM"] +} + +proc sdm_module_context_bar_item {module_id module_name} { + return [list [sdm_url_stub]/one-module.tcl?[export_url_vars module_id] $module_name] +} + +proc sdm_package_context_bar_item {package_id package_name} { + return [list [sdm_url_stub]/one-package.tcl?[export_url_vars package_id] $package_name] +} + +proc sdm_release_context_bar_item {release_id release_name} { + return [list [sdm_url_stub]/one-release.tcl?[export_url_vars release_id] $release_name] +} + +proc sdm_package_release_context_bar_item {release_id release_name} { + return [list [sdm_url_stub]/one-package-release.tcl?[export_url_vars release_id] $release_name] +} + +# other stuff + +proc sdm_header {title} { + set user_id [ad_verify_and_get_user_id] + + set return_url [ns_conn url]?[ns_conn query] + if {$user_id == 0} { + set extra_stuff " + + + + +
    SDM v[sdm_version]
    log in
    " + } else { + set db [ns_db gethandle subquery] + set email [database_to_tcl_string $db "select email from users where user_id=$user_id"] + ns_db releasehandle $db + set extra_stuff " + + + + +
    SDM v[sdm_version]
    $email
    + Prefs | log out +
    " + } + return "[ad_header $title]$extra_stuff" +} + +proc sdm_footer {} { + return "[ad_footer]" +} + +proc sdm_system_name {} { + return [ad_parameter SystemName sdm] +} + +proc sdm_default_severity {} { + return [ad_parameter DefaultSeverity sdm] +} + +proc sdm_list_of_baf_types {} { + return [list bug feature] +} + +proc sdm_list_of_severities {} { + return [ad_parameter ListOfSeverities sdm] +} + +proc sdm_list_of_notification_prefs {} { + return [list none hourly daily weekly] +} + +proc sdm_closed_baf_status_id {} { + set db [ns_db gethandle subquery] + set return_val [database_to_tcl_string $db "select baf_status_id from baf_status where baf_status='closed'"] + ns_db releasehandle $db + return $return_val +} + +proc sdm_reopened_baf_status_id {} { + set db [ns_db gethandle subquery] + set return_val [database_to_tcl_string $db "select baf_status_id from baf_status where baf_status='reopened'"] + ns_db releasehandle $db + return $return_val +} + +ns_share -init {set ad_sdm_security_filters_installed 0} ad_sdm_security_filters_installed + +if {!$ad_sdm_security_filters_installed} { + set ad_sdm_security_filters_installed 1 + # Bounce people out of the /sdm/pvt directory if they're not logged in + ns_register_filter preauth GET /sdm/pvt/* ad_verify_identity + ns_register_filter preauth POST /sdm/pvt/* ad_verify_identity +} + +# The following procedures just call their PL/SQL equivalents. +# An extra layer of abstraction is added: +# - in case we stop doing this in PL/SQL +# - so that the programmer is discouraged from performing deadlock-risky +# queries cause Oracle 8.0.5 sucks so bad. + +proc sdm_check_admin {} { + set user_id [ad_verify_and_get_user_id] + + ## HACK TO LET BEN SEE EVERYTHING FOR NOW + if {$user_id == 4} { + return 1 + } else { + return 0 + } +} + +proc sdm_user_can_add_packages {db user_id} { + return [ad_administrator_p $db $user_id] +} + +proc user_can_see_package_p {db user_id package_id} { + if {[sdm_check_admin]} { + return 1 + } + + if {[database_to_tcl_string $db "select user_can_see_package_p($user_id, $package_id) from dual"]== "t"} { + return 1 + } else { + return 0 + } +} + +proc user_can_see_module_p {db user_id module_id} { + if {[sdm_check_admin]} { + return 1 + } + + if {[database_to_tcl_string $db "select user_can_see_module_p($user_id, $module_id) from dual"]== "t"} { + return 1 + } else { + return 0 + } +} + +proc user_can_edit_package_p {db user_id package_id} { + if {[sdm_check_admin]} { + return 1 + } + + if {[database_to_tcl_string $db "select user_can_edit_package_p($user_id, $package_id) from dual"]== "t"} { + return 1 + } else { + return 0 + } +} + +proc user_can_edit_module_p {db user_id module_id} { + if {[sdm_check_admin]} { + return 1 + } + + if {[database_to_tcl_string $db "select user_can_edit_module_p($user_id, $module_id) from dual"]== "t"} { + return 1 + } else { + return 0 + } +} + +proc user_can_edit_baf_p {db user_id baf_id} { + if {[database_to_tcl_string $db "select user_can_edit_baf_p($user_id, $baf_id) from dual"] == "t"} { + return 1 + } else { + return 0 + } +} + +# Return an error if access problem +proc sdm_return_access_complaint {} { + ns_return 500 text/html "[sdm_header "Access Violation"] +

    Access Violation

    +

    + You are not allowed to view this information, either because you are not logged on, or if you are, because this information is private and you are not authorized. +

    + [sdm_footer] +" +} + +# This expects a SQL query which will select user_id, first_names, last_name, +# and email +proc make_user_select_html {db sql_query {name user_id}} { + set selection [ns_db select $db $sql_query] + + set return_html "" + + return $return_html +} + +# +# Simple user information management +## +proc set_simple_user_information {db} { + uplevel { + set user_id [ad_verify_and_get_user_id] + + set user_logged_on_p 0 + + if {$user_id > 0} { + set selection [ns_db 1row $db "select first_names, last_name, email from users where user_id=$user_id"] + set_variables_after_query + set user_logged_on_p 1 + } + } +} + +# +# Simple user information management +## +proc set_simple_module_information {db module_id} { + uplevel { + set selection [ns_db 0or1row $db "select module_name, packages.package_id as package_id, package_name, packages.private_p as package_private_p, modules.private_p as module_private_p from modules,packages where modules.module_id=$module_id and modules.package_id=packages.package_id"] + + if {$selection != ""} { + set_variables_after_query + } + } +} + +# +# Simple user information management +## +proc set_simple_package_information {db package_id} { + uplevel { + set selection [ns_db 1row $db "select package_name, private_p as package_private_p from packages where package_id=$package_id"] + set_variables_after_query + } +} + + +## +## Location of software +proc sdm_software_check_dir {package_id release_id {module_id ""}} { + # This will create the right directory + if {[catch {ns_mkdir "[sdm_software_root]/package_$package_id"} errmsg]} {} + if {[catch {ns_mkdir "[sdm_software_root]/package_$package_id/release_$release_id"} errmsg]} {} + + if {$module_id != ""} { + if {[catch {ns_mkdir "[sdm_software_root]/package_$package_id/release_$release_id/module_$module_id"} errmsg]} {} + } +} + +proc sdm_software_dir {package_id release_id {module_id ""}} { + if {$module_id != ""} { + return "[sdm_software_root]/package_$package_id/release_$release_id/module_$module_id" + } else { + return "[sdm_software_root]/package_$package_id/release_$release_id" + } +} + +proc sdm_release_filename {release_id original_filename} { + return "$original_filename" +} + +proc sdm_cleanup_filename {filename} { + set last_forward_slash [string last "/" $filename] + set last_back_slash [string last "\\" $filename] + + if {$last_forward_slash > $last_back_slash} { + set last_slash $last_forward_slash + } else { + set last_slash $last_back_slash + } + + return [string range $filename [expr $last_slash + 1] end] +} + +## We look for download requests of the following type: +## /sdm/download/3/2/12/filename +## where 3 is the package id, 2 is the module id, 12 is the release id, +## and filename is the original uploaded filename. + +ns_register_proc GET /sdm/download/* sdm_download_release +ns_register_proc GET /sdm/download-package/* sdm_download_package_release + +proc sdm_code_license {} { + set file [open "/web/aol-dev/www/license.html" r] + set contents [read $file] + close $file + + return $contents +} + +proc sdm_download_package_release {ignore} { + set url_stub [ns_conn url] + + if {![regexp {/sdm/download-package/([^/]*)/([^/]*)/([^/]*)} $url_stub all package_id release_id filename]} { + ns_return 500 text/html "Bad URL" + return + } + + set db [ns_db gethandle] + + set_simple_user_information $db + + if {![user_can_see_package_p $db $user_id $package_id]} { + sdm_return_access_complaint + return + } + + set_simple_package_information $db $package_id + + set filename_stub [database_to_tcl_string $db "select release_filename from package_releases where package_id=$package_id and release_id=$release_id"] + + ns_db releasehandle $db + + ns_returnfile 200 [ns_guesstype $filename_stub] [sdm_software_dir $package_id $release_id]/$filename_stub + + set ip_address [ns_conn peeraddr] + + set db [ns_db gethandle] + + ns_db dml $db "insert into package_release_downloads (package_id, release_id, download_date, ip_address) VALUES ($package_id, $release_id, sysdate(), '$ip_address')" + + ns_db releasehandle $db + + ns_returnredirect "/sdm/download-thank-you.tcl?[export_url_vars package_id release_id]" +} + + +## +## The CVS abstraction +## + +proc sdm_load_package {package_id dir {release_id ""}} { + set db [ns_db gethandle subquery] + set selection [ns_db 1row $db "select package_name, cvs_path, cvs_server, cvs_username, cvs_password from packages_with_cvs_data where package_id=$package_id"] + set_variables_after_query + + if {$release_id != ""} { + set selection [ns_db 1row $db "select release_name(major_version,minor_version,patch_version,beta_version) as release_name from package_releases where package_id=$package_id and release_id=$release_id"] + set_variables_after_query + + regsub -all "\." $release_name "-" release_name + set release_name "v$release_name" + } else { + set release_name "" + } + + cd $dir + cvs_checkout $package_name $cvs_path $release_name $cvs_server $cvs_username $cvs_password + + return $package_name +} + +proc sdm_load_source_package {package_id {release_id ""}} { + set dir_name [sdm_load_package $package_id [sdm_source_root] $release_id] + return $dir_name +} + +proc sdm_load_download_package {package_id release_id} { + sdm_software_check_dir $package_id $release_id + set absolute_dir [sdm_software_dir $package_id $release_id] + set code_dir [sdm_load_package $package_id $absolute_dir $release_id] + + set relative_filename [tar_and_gz $absolute_dir $code_dir] + set release_filename [sdm_release_filename $release_id $relative_filename] + + exec mv $absolute_dir/$relative_filename $absolute_dir/$release_filename + + return $release_filename +} + +## Tar and GZ +## This returns the name of the one file that is the +## tar'ed and gz'ed file. +proc tar_and_gz {absolute_dir code_dir} { + cd $absolute_dir + + if {[catch {exec /usr/local/bin/tar cf $absolute_dir/${code_dir}.tar $code_dir} errmsg]} { + } + + if {[catch {exec /usr/local/bin/gzip $absolute_dir/${code_dir}.tar} errmsg]} { + } + + return ${code_dir}.tar.gz +} + + +## +## Bug Rating +## + +proc sdm_user_has_rated_baf_p {user_id baf_id {db {}}} { + if {$user_id == ""} { + return 0 + } + + check_db_var + + set check [database_to_tcl_string $db "select count(*) from baf_ratings where user_id=$user_id and baf_id=$baf_id"] + + cleanup_db_var + + if {$check > 0} { + return 1 + } else { + return 0 + } +} + +proc sdm_rate_baf {user_id baf_id rating {db {}}} { + check_db_var + + if {[catch { + ns_db dml $db "insert into baf_ratings (user_id, baf_id, rating, rating_date) + values ($user_id, $baf_id, $rating, sysdate())" + + cleanup_db_var + } errmsg]} { + return 0 + } else { + return 1 + } +} + +proc sdm_baf_rating {baf_id {db {}}} { + check_db_var + + set rating [database_to_tcl_string $db "select avg(rating) from baf_ratings where baf_id=$baf_id"] + + cleanup_db_var + + return $rating +} + +## Interest Mapping + +proc sdm_baf_n_interested_users {baf_id {db {}}} { + check_db_var + + set n_interested [database_to_tcl_string $db "select count(*) from user_baf_interest_map where baf_id=$baf_id"] + + cleanup_db_var + + return $n_interested +} + +proc sdm_baf_user_is_interested_p {baf_id user_id {db {}}} { + check_db_var + + set check [database_to_tcl_string $db "select count(*) from user_baf_interest_map where baf_id= $baf_id and user_id=$user_id"] + + cleanup_db_var + + return $check +} + +proc sdm_baf_user_is_interested {baf_id user_id {db {}}} { + check_db_var + + ns_db dml $db "insert into user_baf_interest_map (user_id, baf_id) values ($user_id, $baf_id)" + + cleanup_db_var +} + + +proc sdm_baf_user_is_not_interested {baf_id user_id {db {}}} { + check_db_var + + ns_db dml $db "delete from user_baf_interest_map where user_id=$user_id and baf_id=$baf_id" + + cleanup_db_var +} + +## Package interests + +proc sdm_package_n_interested_users {package_id {db {}}} { + check_db_var + + set n_interested [database_to_tcl_string $db "select count(*) from user_package_interest_map where package_id=$package_id"] + + cleanup_db_var + + return $n_interested +} + +proc sdm_package_user_is_interested_p {package_id user_id {db {}}} { + check_db_var + + set check [database_to_tcl_string $db "select count(*) from user_package_interest_map where package_id= $package_id and user_id=$user_id"] + + cleanup_db_var + + return $check +} + +proc sdm_package_user_is_interested {package_id user_id {db {}}} { + check_db_var + + ns_db dml $db "insert into user_package_interest_map (user_id, package_id) values ($user_id, $package_id)" + + cleanup_db_var +} + + +proc sdm_package_user_is_not_interested {package_id user_id {db {}}} { + check_db_var + + ns_db dml $db "delete from user_package_interest_map where user_id=$user_id and package_id=$package_id" + + cleanup_db_var +} + + +## Notification Code + +proc sdm_notify_users_baf {baf_id notification {db {}}} { + check_db_var + + # Call the Pl/SQL + database_to_tcl_string $db "select baf_edit_notification($baf_id, '[DoubleApos $notification]')" + + cleanup_db_var +} + +proc sdm_notify_users_package {package_id notification {db {}}} { + check_db_var + + # Call the PL/SQL + database_to_tcl_string $db "select package_edit_notification($package_id, '[DoubleApos $notification]')" + + cleanup_db_var +} + +proc sdm_send_one_email {to from subject body} { + ns_sendmail $to $from $subject "$body + +---------------------------------------------------------------------------------- +This email is being sent to you by [sdm_system_name] +at [ad_url], because you +requested updates on bugs and features. + +If you would like to change your notification status, please visit: +[ad_url][sdm_url_stub]/pvt/prefs.tcl +" +} + +## Scheduled Procs for notification +proc sdm_send_notifications {notification_interval} { + set db [ns_db gethandle subquery] + + ns_db dml $db "begin transaction" + + # Lock the table + ns_db dml $db "lock table sdm_notifications" + + # Select the BAF notifications + set data_to_send [database_to_tcl_list_list $db " + select users.user_id, email, baf_notifications + from sdm_notifications, sdm_notification_prefs, users where + users.user_id= sdm_notifications.user_id and + sdm_notifications.user_id= sdm_notification_prefs.user_id + and (baf_notifications is not null and baf_notifications != '') + and baf_pref='$notification_interval'"] + + # Clear things out + ns_db dml $db " + update sdm_notifications set baf_notifications='' + where user_id in + (select user_id from sdm_notification_prefs + where baf_pref='$notification_interval')" + + # Close the transaction + ns_db dml $db "end transaction" + + ns_db releasehandle $db + + # Send out the emails! + foreach email $data_to_send { + sdm_send_one_email [lindex $email 1] [sdm_notification_sender_email] "Bug/Feature Update" [lindex $email 2] + } + + # now the package + set db [ns_db gethandle subquery] + + ns_db dml $db "begin transaction" + + # Lock the table + ns_db dml $db "lock table sdm_notifications" + + # Select the PACKAGE notifications + set data_to_send [database_to_tcl_list_list $db " + select users.user_id, email, package_notifications + from sdm_notifications, sdm_notification_prefs, users where + users.user_id= sdm_notifications.user_id and + sdm_notifications.user_id= sdm_notification_prefs.user_id + and (package_notifications is not null and package_notifications != '') + and package_pref='$notification_interval'"] + + # Clear things out + ns_db dml $db " + update sdm_notifications set package_notifications='' + where user_id in + (select user_id from sdm_notification_prefs + where package_pref='$notification_interval')" + + # Close the transaction + ns_db dml $db "end transaction" + + ns_db releasehandle $db + + # Send out the emails! + foreach email $data_to_send { + sdm_send_one_email [lindex $email 1] [sdm_notification_sender_email] "Package Update" [lindex $email 2] + } +} + +proc sdm_remove_notifications {interval} { + set db [ns_db gethandle subquery] + + ns_db dml $db "update sdm_notifications set baf_notifications='' where user_id in (select user_id from sdm_notification_prefs where baf_pref='$interval')" + + ns_db dml $db "update sdm_notifications set package_notifications='' where user_id in (select user_id from sdm_notification_prefs where package_pref='$interval')" + + ns_db releasehandle $db +} + +ns_share -init {set sdm_notification_scheduled_p 0} sdm_notification_scheduled_p + +if {!$sdm_notification_scheduled_p} { + set sdm_notification_scheduled_p 1 + + for {set i 0} {$i<24} {incr i} { + ns_schedule_daily -thread $i 0 sdm_send_notifications hourly + } + + ns_schedule_daily -thread 23 15 sdm_send_notifications daily + + ns_schedule_weekly -thread 0 23 30 sdm_send_notifications weekly + + ns_schedule_daily -thread 0 30 sdm_remove_notifications none +} + +proc sdm_util_strip_leading_slash {stuff} { + if {[string range $stuff 0 0] == "/"} { + return [string range $stuff 1 end] + } else { + return $stuff + } +} + +# Managing Patches +# for source code +proc sdm_patch_file_path {} { + return "[ad_parameter PathToACS]/data/sdm-patches" +} + +proc sdm_one_package_patch_file_path {package_id} { + set path [sdm_patch_file_path]/$package_id + + # make sure the directory exists + if {![file exists $path]} { + ns_mkdir $path + } + + return $path +} + +proc sdm_one_patch_file_full_path {package_id patch_id filename} { + return [sdm_one_package_patch_file_path $package_id]/${patch_id}-${filename} +} \ No newline at end of file Index: web/openacs/tcl/sdm-source.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/sdm-source.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/sdm-source.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,268 @@ + +# +# This contains defs for doing source code repository online +# We're building an abstraction layer so that we're not +# forever dependent on CVS +# + +# The "source code entry" abstraction +# so we can easily tell what is a directory, a file, etc.. + +proc sdm_sourcecode_make_entry {type path name} { + return [list $type $path $name] +} + +proc sdm_sourcecode_entry_type {entry} { + return [lindex $entry 0] +} + +proc sdm_sourcecode_entry_path {entry} { + return [lindex $entry 1] +} + +proc sdm_sourcecode_entry_name {entry} { + return [lindex $entry 2] +} + +proc sdm_sourcecode_entry_fullpath {entry} { + return [sdm_sourcecode_entry_path $entry]/[sdm_sourcecode_entry_name $entry] +} + +# Displaying an entry as HTML +proc sdm_sourcecode_entry_html {entry} { + return "([sdm_sourcecode_entry_type $entry]) - [sdm_sourcecode_entry_path $entry]/[sdm_sourcecode_entry_name $entry]" +} + +# +# Utility files +# + +proc sdm_sourcecode_package_has_repository_p {db package_id} { + return [database_to_tcl_string $db "select count(*) from package_repositories where package_id=$package_id"] +} + +proc set_simple_repository_information {db package_id} { + uplevel { + set selection [ns_db 1row $db "select repository_name, file_glob_patterns from package_repositories where package_id=$package_id"] + set_variables_after_query + } +} + +proc sdm_sourcecode_create_repository {name} { + ns_mkdir [sdm_source_root]/$name +} + +proc sdm_sourcecode_edit_repository {old_name new_name} { + if {$old_name != $new_name} { + exec mv [sdm_source_root]/$old_name [sdm_source_root]/$new_name + } +} + +## +## Source code tree abstraction +## + +proc sdm_sourcecode_cvs {} { + return "/usr/local/bin/cvs" +} + +proc sdm_source_root {} { + return "[ad_parameter PathToACS]/data/sdm-source" +} + +proc sdm_check_safe {name} { + if {[string first "../" $name] != -1} { + # NOT SAFE! + return 0 + } else { + return 1 + } +} + +proc sdm_sourcecode_list_entries {entry {glob_patterns {}}} { + if {[string compare [sdm_sourcecode_entry_type $entry] DIRECTORY] != 0} { + return [list $entry] + } + + set relpath [sdm_sourcecode_entry_path $entry]/[sdm_sourcecode_entry_name $entry] + set path [sdm_source_root]/$relpath + + if {![file exists $path]} { + return "" + } + + if {![file isdirectory $path]} { + return "" + } + + # Get the list of files + cd $path + + set ls_return [exec ls -l] + + set ls_return_by_line [split $ls_return "\n"] + + set list_of_entries [list] + + set glob_pattern_list [split $glob_patterns " "] + + foreach line $ls_return_by_line { + if {[regexp {[^ ]+ +[^ ]+.+ +([^ ]+)} $line all filename]} { + if {[file isdirectory $path/$filename]} { + set type DIRECTORY + } else { + set match_flag 0 + foreach glob_pattern $glob_pattern_list { + if {[string match $glob_pattern $filename]} { + set match_flag 1 + break + } + } + + if {!$match_flag} { + continue + } + + set type FILE + } + + lappend list_of_entries [sdm_sourcecode_make_entry $type $relpath $filename] + } + } + + return $list_of_entries + +} + +# +# + +proc sdm_sourcecode_entry_safe {entry repository} { + if {![sdm_check_safe [sdm_sourcecode_entry_path $entry]]} { + return 0 + } + + if {![sdm_check_safe [sdm_sourcecode_entry_name $entry]]} { + return 0 + } + + set whole_path [sdm_sourcecode_entry_path $entry]/[sdm_sourcecode_entry_name $entry] + + if {![regexp "^/$repository/.*" $whole_path all]} { + if {![regexp "^/$repository\$" $whole_path all]} { + return 0 + } + } + + return 1 +} + +proc sdm_sourcecode_entry_has_parent {entry} { + set path [sdm_sourcecode_entry_path $entry]/[sdm_sourcecode_entry_name $entry] + + if {[regexp {^/[^/]+$} $path all]} { + return 0 + } else { + return 1 + } +} + +proc sdm_sourcecode_entry_parent_entry {entry} { + if {![sdm_sourcecode_entry_has_parent $entry]} { + return $entry + } + + set path [sdm_sourcecode_entry_path $entry] + + if {[regexp {^(.*)/([^/]+)} $path all newpath newname]} { + return [sdm_sourcecode_make_entry DIRECTORY $newpath $newname] + } else { + ns_log Notice "path: $path" + return "" + } +} + +proc sdm_sourcecode_entry_link {package_id entry} { + set name [sdm_sourcecode_entry_name $entry] + if {[string tolower [file extension $name]] == ".html"} { + return "view contents" + } else { + return "" + } +} + +proc sdm_sourcecode_entry_processed_contents {package_id entry cvsroot} { + set link [sdm_sourcecode_entry_link $package_id $entry] + + if {![empty_string_p $link]} { + return $link + } + + set raw_contents [ns_quotehtml [sdm_sourcecode_entry_get_contents $entry $cvsroot]] + + set colorized_contents [sdm_sourcecode_colorize [sdm_sourcecode_entry_name $entry] $raw_contents] + set colorized_contents_with_line_numbers [sdm_sourcecode_add_lines_numbers $colorized_contents] + + return "

    +$colorized_contents_with_line_numbers
+
    +
    +" +} + +proc sdm_sourcecode_entry_get_contents {entry cvsroot {tag ""}} { + if {[sdm_sourcecode_entry_type $entry] != "FILE"} { + return "" + } + + # set fullpath [sdm_source_root]/[sdm_sourcecode_entry_fullpath $entry] + + # set filestream [open $fullpath "r"] + # set contents [read $filestream] + + set contents [cvs_checkout_to_string [sdm_sourcecode_entry_fullpath $entry] $cvsroot $tag] + + return $contents +} + + +proc sdm_sourcecode_add_lines_numbers {contents {count 0}} { + set newcontents "" + + set lines [split $contents "\n"] + + set spaces " " + + foreach line $lines { + incr count + + # Do a cute thing to pad the line number + append newcontents [string range $spaces [string length $count] end] + + append newcontents "$count | $line\n" + } + + return $newcontents +} + +## More utilities + +# Expects a tar'ed and gzipped file. +proc sdm_sourcecode_load_from_file {db package_id file_path} { + set repository_name [database_to_tcl_string $db "select repository_name from package_repositories where package_id=$package_id"] + + # Remove everything from source directory + cd [sdm_source_root] + if {[catch {exec /bin/rm -rf $repository_name} errmsg]} {} + if {[catch {ns_mkdir [sdm_source_root]/$repository_name} errmsg]} {} + + # Copy the file + ns_cp $file_path [sdm_source_root]/$repository_name/release.tar.gz + + # CD, Gunzip, Untar + cd [sdm_source_root]/$repository_name + if {[catch {exec /usr/local/bin/gunzip release.tar.gz} errmsg]} {} + if {[catch {exec /usr/local/bin/tar xf release.tar} errmsg]} {} +} + + Index: web/openacs/tcl/sdm-todo-plugin.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/sdm-todo-plugin.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/sdm-todo-plugin.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,93 @@ +## +## This implements the SDM to todo link +## +## ben@adida.net + +ns_schedule_proc -once 1 sdm_todoplugin_register + +# The proc to register the SDM todo plugin +proc sdm_todoplugin_register {} { + set data [ns_set new -persist sdm_todoplugin_data] + ns_set put $data GET_PERSONAL_CATEGORIES sdm_todoplugin_get_personal_categories + ns_set put $data GET_OTHER_CATEGORIES sdm_todoplugin_get_other_categories + ns_set put $data ITEM_CHANGE_ALLOWED_P 0 + ns_set put $data MARK_COMPLETED_ALLOWED_P 1 + ns_set put $data MARK_COMPLETED sdm_todoplugin_mark_completed + ns_set put $data ONE_ITEM_URL [sdm_url_stub]/one-baf.tcl + ns_set put $data ONE_ITEM_ID_KEY baf_id + ns_set put $data ITEM_LIST_SQL sdm_todoplugin_item_list_sql + + # actually register + todo_plugin_register SDM $data +} + +# Getting the personal categories +proc sdm_todoplugin_get_personal_categories {db user_id} { + set categories [database_to_tcl_list_list $db " + select package_id, package_name from packages where package_id in + (select package_id from bugs_and_features where completion is null and baf_id in + (select baf_id from baf_assignments where user_id=$user_id))"] + + return $categories +} + +# Getting other categories +proc sdm_todoplugin_get_other_categories {db user_id} { + return [list] +} + +# When an item is done +# This just redirects to the right location +# and returns a flag saying that no more information should be returned +proc sdm_todoplugin_mark_completed {db user_id todo_id {completion_date {}}} { + ns_returnredirect [sdm_url_stub]/pvt/baf-close.tcl?baf_id=$todo_id + + # A boolean of true means everything has been done and the + # calling page should do nothing more. + return 1 +} + + +# This should return the SQL +# to select the stuff out of the database +proc sdm_todoplugin_item_list_sql {db user_id category_id date_predicates date_prettifier n_days_to_show_completed_items completion_status order_by} { + + set due_date "sdm_baf_due_date(bafs.baf_id)" + + set list_of_predicates [list] + + if {$date_predicates != ""} { + lappend list_of_predicates [subst $date_predicates] + } + + if {$category_id != ""} { + lappend list_of_predicates "packages.package_id= $category_id" + } + + if {$completion_status == "open"} { + lappend list_of_predicates "completion is null" + } + + if {$completion_status == "closed"} { + lappend list_of_predicates "completion is not null" + } + + lappend list_of_predicates "packages.package_id= bafs.package_id" + lappend list_of_predicates "baf_assignments.baf_id= bafs.baf_id" + lappend list_of_predicates "baf_assignments.user_id= $user_id" + + set sql " + select + 'SDM' as plugin, packages.package_id as category_id, packages.package_name as category, + round(6-baf_rating(bafs.baf_id)/2) as priority, ${date_prettifier}($due_date) as due_date, + todo_interval_min($due_date) as raw_due_date, + ''::varchar as assigned_by, + bafs.baf_id as todo_id, baf_type::text || ': '::text || bafs.description::text as item_details, sdm_completion_date(bafs.baf_id) as completion_date + from + bugs_and_features bafs, packages, baf_assignments + where + [join $list_of_predicates " and "]" + + return $sql +} + \ No newline at end of file Index: web/openacs/tcl/sdm-upload.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/sdm-upload.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/sdm-upload.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,86 @@ +# +# This is concerned with actually uploading files to the +# source code repository. +# + +proc sdm_sourcecode_check_archive {filepath original_filename repository} { + # get the extension + set extension [file extension $original_filename] + + # find the procedure to handle the right extension + if {[info commands sdm_sourcecode_list_archive_$extension] == ""} { + return 0 + } + + set list_of_files [sdm_sourcecode_list_archive_$extension $filepath] + + foreach file $list_of_files { + ns_log Notice "file: $file" + if {![sdm_check_safe $file]} { + return 0 + } + + if {![regexp "^$repository/.*" $file all]} { + return 0 + } + } + + return 1 +} + + +# Actually unpack source code + +proc sdm_sourcecode_unpack_archive {filepath original_filename repository} { + # get the extension + set extension [file extension $original_filename] + + # find the procedure to handle the right extension + if {[info commands sdm_sourcecode_list_archive_$extension] == ""} { + return 0 + } + + sdm_sourcecode_unpack_archive_$extension $filepath +} + + +# Tar-specific files +proc sdm_sourcecode_list_archive_.tar {filepath} { + set list_txt [exec tar tf $filepath] + + return [split $list_txt "\n"] +} + +proc sdm_sourcecode_unpack_archive_.tar {filepath} { + cd [sdm_source_root] + + exec tar xf $filepath +} + +# Zip-specific files +proc sdm_sourcecode_list_archive_.zip {filepath} { + set list_txt [exec /usr/local/bin/unzip -l $filepath] + + set line_list [split $list_txt "\n"] + + set return_list [list] + + # Get the filename out of the complicated + # zip file output + foreach line $line_list { + if {[regexp {.* +([^ ]+)} $line all filename]} { + lappend return_list $filename + // ns_log Notice "got a file in zip: $filename" + } + } + + return $return_list +} + +proc sdm_sourcecode_unpack_archive_.zip {filepath} { + cd [sdm_source_root] + + exec unzip $filepath +} + + \ No newline at end of file Index: web/openacs/tcl/site-wide-search-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/site-wide-search-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/site-wide-search-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,106 @@ +# site-wide-search-defs.tcl,v 3.0 2000/02/06 03:14:02 ron Exp +# +# /tcl/site-wide-search-defs.tcl +# +# by jsc@arsdigita.com, late 1999 +# + +util_report_library_entry + +proc_doc ad_search_results_cutoff { nth_row current_score max_score } { + Returns 1 to indicate that a search result should be cut off, based on + a heuristic measure of current relevance vs. number of rows + already returned. +} { + if { ($nth_row > 25) && ($current_score < [expr 0.3 * $max_score] ) } { + # we've gotten more than 25 rows AND our relevance score + # is down to 30% of what the maximally relevant row was + return 1 + } + if { ($nth_row > 50) && ($current_score < [expr 0.5 * $max_score] ) } { + # take a tougher look + return 1 + } + if { ($nth_row > 100) && ($current_score < [expr 0.8 * $max_score] ) } { + # take a tougher look yet + return 1 + } + return 0 +} + +proc ad_site_wide_search_widget {db {query_string ""} {sections_list ""} {prompt "Search entire site"}} { + set selection [ns_db select $db "select section_name, table_name +from table_acs_properties +where table_name in ('bboard', 'static_pages', 'comments') +order by section_name"] + + set widget "" + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + if { [lsearch -exact $sections_list $table_name] >= 0 } { + set checked " checked" + } else { + set checked "" + } + append widget " $section_name  " + } + + append widget "
    \n" + + if { [empty_string_p $query_string] } { + append widget "Search for: " + } else { + append widget "Search for: " + } + return $widget +} + +proc_doc ad_search_display_preference {} { + Returns "by_section" or "one_list" to indicate user's display preference + for site wide search. Preference is stored in a cookie, or defaults to + "by_section". +} { + return "by_section" +} + +# Helper function for ad_search_qbe_get_themes. +proc ad_search_qbe_get_themes_helper { table_name primary_key } { + set db [ns_db gethandle subquery] + + ns_db dml $db "begin transaction" + + ns_db dml $db "begin ctx_doc.themes('SWS_CTX_INDEX', ctx_doc.pkencode('$table_name', '$primary_key'), 'SWS_RESULT_TABLE', 1); end;" + + set selection [ns_db select $db "select theme +from sws_result_table +order by weight desc"] + + set count 0 + set themes [list] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + lappend themes $theme + incr count + if { $count == 5 } { + ns_db flush $db + break + } + } + + ns_db dml $db "delete from sws_result_table" + ns_db dml $db "end transaction" + return $themes +} + +proc_doc ad_search_qbe_get_themes { table_name primary_key } { + Return a list of themes associated with the document in the site wide index + referenced by table_name and primary_key. +} { + return [util_memoize "ad_search_qbe_get_themes_helper $table_name $primary_key"] +} + +util_report_successful_library_load Index: web/openacs/tcl/spam-daemon.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/spam-daemon.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/spam-daemon.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,568 @@ +# spam-daemon.tcl +# +# hqm@arsdigita.com +# +# Run a scheduled procedure to locate and send any spam messages which are +# queued for a given date. +# +# This runs a routine to pick up files from the filesystem as specified by the daily_spam_files +# table. +# +# +# It also attempts to resume any incomplete spam-sending jobs upon server restart. + +################################################ + +util_report_library_entry + +################ +# Enable spam daemon to sweep the dropzone for spam files that are ready to send + +ns_share -init {set spam_enable_daemon_p [ad_parameter "SpamDaemonEnabled" "spam" 1]} spam_enable_daemon_p + +proc_doc spam_set_daemon_active {val} "Enable/disable daemon which scans dropzone" { + ns_share spam_enable_daemon_p + set spam_enable_daemon_p $val +} + +proc_doc spam_daemon_active_p {} "return state of Enable/disable dropzone scan daemon flag" { + ns_share spam_enable_daemon_p + return $spam_enable_daemon_p +} + + +################ +# enable outgoing spam mailer +ns_share -init {set spam_email_sending_enabled_p 1} spam_email_sending_enabled_p + +proc_doc spam_set_email_sending {val} "Enable/disable email sending of spam" { + ns_share spam_email_sending_enabled_p + set spam_email_sending_enabled_p $val +} + +proc_doc spam_email_sending_p {} "return state of Enable/disable spam email flag" { + ns_share spam_email_sending_enabled_p + return $spam_email_sending_enabled_p +} + + +################ +# Switch to use bulk mailer instead of ns_sendmail +ns_share -init {set use_bulkmail_p 0} use_bulkmail_p + +proc_doc spam_set_use_bulkmail_p {val} "Enable/disable use of bulk mailer for sending of spam" { + ns_share use_bulkmail_p + set use_bulkmail_p $val +} + +proc_doc spam_use_bulkmail_p {} "return state of use_bulkmail_p spam email flag" { + ns_share use_bulkmail_p + return $use_bulkmail_p +} + + + +# +# This procedure is called daily by a scheduled proc to send any spam +# messages which are in the spam_history table that are at or +# past their target send dates + +proc send_scheduled_spam_messages {} { + # +++ temporarily, we'll just use ns_sendmail until gregh's qmail API is set up + # ns_sendmail is not guaranteed to do anything reasonable with envelopes, so + # it is not obvious where bounced mail will come back to, + # so until we get the new email transport running, watch out! + + ns_log Notice "running scheduled spam sending daemon" + + ns_share spam_email_sending_enabled_p + ns_share use_bulkmail_p + # how often we update the n_sent field of the spam record + set logging_frequency 20 + + if {$spam_email_sending_enabled_p == 0} { + ns_log Notice "spam daemon is disabled via the spam_email_sending_enabled_p flag" + return + } + + set db_pools [ns_db gethandle main 2] + set db [lindex $db_pools 0] + set db2 [lindex $db_pools 1] + + # Check for files deposited by users as specified in the daily_spam_files table + if {[spam_daemon_active_p]} { + check_spam_drop_zone $db $db2 + } + + # We loop pulling spams out of the spam_history table that + # are ready to send. But we must be careful about concurrency race conditions + # because the process of sending a spam can take many hours, and the spam + # sender daemon gets run every hour or so, and the web server could easily get restarted + # in the middle of this operation. + while { 1 } { + + ns_log Notice "send_scheduled_spam_messages: checking spam_history queue" + + ns_db dml $db "begin transaction" + + # Get a list of all spams which have current or past-due deadlines,and + # which have not already been processed. + set selection [ns_db select $db "select spam_id, creation_user, from_address, body_plain, body_html, body_aol, title, user_class_query, user_class_description, send_date, status, last_user_id_sent, template_p from spam_history + where send_date::date <= [db_sysdate] + and (status = 'unsent' or status = 'interrupted') + order by send_date + for update"] + + # If no more spams are pending, we can quit for now + if {[ns_db getrow $db $selection] == 0} { + ns_db dml $db "end transaction" + ns_db releasehandle $db + ns_db releasehandle $db2 + return + } + + set_variables_after_query + ns_db flush $db + + ns_log Notice "send_scheduled_spam_messages: got spam_id=$spam_id, from_address=$from_address, title=$title" + + # If the spam daemon was interrutped while sending, we can resume at the last + # user_id sent to. + if { [string compare $status "interrupted"] == 0 && ![empty_string_p $last_user_id_sent] } { + set resume_sending_clause " and users.user_id > $last_user_id_sent " + } else { + set resume_sending_clause " " + } + + # Mark this spam as being processed. Let's try to be very careful not to send + # mail to any user more than once. + ns_db dml $db "update spam_history set status = 'sending', begin_send_time = [db_sysdate] where spam_id = $spam_id" + ns_log Notice "spam_daemon: sending spam_id $spam_id '$user_class_description'" + + ns_db dml $db "end transaction" + + # These hold any extra mail headers we want to send with each message. + # Headers for HTML mail + set msg_html_headers [ns_set create] + ns_set update $msg_html_headers "Mime-Version" "1.0" + ns_set update $msg_html_headers "Content-Type" "multipart/alternative; boundary=\"[spam_mime_boundary]\"" + + + # Headers for AOL mail + set msg_aol_headers [ns_set create] + ns_set update $msg_aol_headers "Content-type" "text/html; charset=\"iso-8859-1\"" + + # Headers for plain text mail + set msg_plain_headers [ns_set create] + + ################ + # For each spam, get the list of interested users, and send mail. + + # standard query but make sure that we don't send to dont_spam_me_p or + # deleted_p users + regsub -nocase "^select" $user_class_query "select email_type, " user_class_query_plus_email_type + set query "$user_class_query_plus_email_type + $resume_sending_clause + order by users.user_id" + + # NOTE: there is a magic (kludge) here to access user_preferences for each user: + # The users_spammable view + # now contains a join with users_preferences.*, so that the users_preference.email_type + # can be selected. + + ns_log Notice "spam user class query: $query" + + if {$use_bulkmail_p == 1} { + set bulkmail_id [bulkmail_begin $db $creation_user "spam_id $spam_id"] + } + + set selection [ns_db select $db $query] + # query sets user_id for each interested user + + # more accurate flow rate if we set this as the start time, because above query takes + # a couple minutes sometimes + ns_db dml $db2 "update spam_history set begin_send_time = [db_sysdate] where spam_id = $spam_id" + + set send_count 0 + + #Get site-wide removal blurb + set txt_removal_blurb [ad_removal_blurb "" "txt"] + set html_removal_blurb [ad_removal_blurb "" "htm"] + set aol_removal_blurb [ad_removal_blurb "" "aol"] + + # Make a quoted printable encoding of the content plus removal blurb + regsub -all "\r" $body_html "" full_html_msg + append full_html_msg $html_removal_blurb + set qp_body_html [spam_encode_quoted_printable $full_html_msg] + + regsub -all "\r" $body_plain "" body_plain_full + append body_plain_full $txt_removal_blurb + + while { [ns_db getrow $db $selection] } { + + set_variables_after_query + + # remove spaces from email address (since user registration doesn't currently do this) + # since these are almost certainly bogus + regsub -all " " $email "" email_stripped + set email $email_stripped + + # + # If the HTML or AOL spam message text is null, revert to sending plain text to everyone + if { [empty_string_p $email_type] } { + set email_type "text/plain" + } elseif { [string compare $email_type "text/html"] == 0 && [empty_string_p $body_html] } { + set email_type "text/plain" + } elseif { [string compare $email_type "text/aol-html"] == 0 && [empty_string_p $body_aol] } { + set email_type "text/plain" + } + + switch $email_type { + "text/html" { + set extra_headers [ns_set copy $msg_html_headers] + # The '--' strings really matter here. + # The MIME boundary delimiter is a '--' sequence, but it is hard to tell when + # looking at code which has a mime boundary starting with '---...' + set message_body_template "--[spam_mime_boundary] +Content-Type: text/plain; charset=\"us-ascii\" +Content-Transfer-Encoding: 7bit + +$body_plain_full + +--[spam_mime_boundary] +Content-Type: text/html; charset=\"iso-8859-1\" +Content-Transfer-Encoding: quoted-printable +Content-Base: [spam_content_base] + +$qp_body_html +--[spam_mime_boundary]-- +" + } + "text/aol-html" { + set extra_headers [ns_set copy $msg_aol_headers] + set message_body_template "$body_aol\n$aol_removal_blurb" + } + default { + set extra_headers [ns_set copy $msg_plain_headers] + set message_body_template "$body_plain\n$txt_removal_blurb" + } + } + + if {[string match $template_p "t"]} { + if {[catch { + set message_body [subst $message_body_template] + set title [subst $title] + } errmsg]} { + ns_log Error "Tcl evaluator error in subst call for spam_id $spam_id: $errmsg\nAborting the sending of this spam." + break + } + } else { + set message_body $message_body_template + } + + ns_log Notice "Sending spam to $email, \"$title\"" + + if {$spam_email_sending_enabled_p == 0} { + ns_log Notice "** spam disabled: spam to $user_id, $email, \"$title\"" + ns_db releasehandle $db + ns_db releasehandle $db2 + return + } else { + if {$use_bulkmail_p == 1} { + # The sender address is overwritten automatically by the bulkmailer + bulkmail_send $bulkmail_id $user_id $email $from_address $title $message_body {} $extra_headers + } else { + ns_sendmail $email $from_address $title $message_body $extra_headers + } + } + + # we log this every N sends, to keep the overhead down + incr send_count + if {[expr $send_count % $logging_frequency] == 0} { + ns_db dml $db2 "update spam_history + set last_user_id_sent = $user_id, + n_sent = n_sent + $logging_frequency where spam_id = $spam_id" + } + } + + if {$use_bulkmail_p == 1} { + bulkmail_end $db $bulkmail_id + } + ns_db dml $db2 "update spam_history set + n_sent = n_sent + [expr $send_count % $logging_frequency] where spam_id = $spam_id" + + ns_db dml $db "update spam_history set status = 'sent', finish_send_time = [db_sysdate] where spam_id = $spam_id" + ns_log Notice "moving spam_id $spam_id to \"sent\" state" + } + + ns_db releasehandle $db + ns_db releasehandle $db2 +} + + + + +################################################################ +# Load up table of default email types from config .ini file + +proc config_default_email_types {} { + set db [ns_db gethandle] + ns_db dml $db "delete from default_email_types" + set email_types [ad_parameter EmailTypes "spam"] + ns_log Notice "email_types = $email_types" + foreach entry $email_types { + set pattern [lindex $entry 0] + set mime_type [lindex $entry 1] + ns_db dml $db "insert into default_email_types (pattern, mail_type) values ('[DoubleApos $pattern]', '[DoubleApos $mime_type]')" + } + ns_db releasehandle $db +} + +ad_schedule_proc -once t 5 config_default_email_types + + +# Any spam which is in the "sending" state when the server is restarted was +# clearly interrupted in the middle of a send job. So we move it to the 'interrupted' +# state (which is effectively just another name for the 'unsent' state). The +# next thread which calls send_scheduled_spam_messages will then grab the +# lock on it (so to speak), by moving it to the sending state, and start +# resume emails at the last user_id which was sent to. +# + +proc flag_interrupted_spams {} { + set db [ns_db gethandle] + set selection [ns_db select $db "select * from spam_history where status = 'sending'"] + ns_log Notice "Checking for spam jobs which were left in the 'sending' state" + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_log Notice "moving spam $spam_id, $creation_date '$title' to interrupted state" + } + ns_db dml $db "update spam_history set status = 'interrupted' where status = 'sending'" + ns_db releasehandle $db +} + + +set spam_server_restarted_delay 10 +if {[spam_daemon_active_p]} { + ad_schedule_proc -once t $spam_server_restarted_delay flag_interrupted_spams +} + + +################################################################ +# Scan for messages past deadline, once per hour, and send them if needed. +# +# The flag_interrupted_spams routine above must be run exactly ONCE at server +# restart time, before send_scheduled_spam_messages is run. This allows the +# system to move any spams jobs that were interrupted into the "interrupted" state, +# where they can be resumed by a thread running the spam daemon. +# +# + +ns_share -init {set spam_daemon_installed 0} spam_daemon_installed + +if {!($spam_daemon_installed) && [spam_daemon_active_p] } { + set spam_daemon_installed 1 + ns_log Notice "Scheduling spam sender daemon" + set interval [ad_parameter QueueSweepInterval "spam" [expr 1800 + $spam_server_restarted_delay]] + ad_schedule_proc -thread t $interval send_scheduled_spam_messages +} + +proc spam_file_location {filename} { + set page_root [ns_info pageroot] + regsub {/www$} $page_root {/spam} spam_root + return "[ad_parameter "DailySpamDirectory" "spam" $spam_root]/$filename" +} + +proc read_file_as_string {pathname} { + if { ![file exists $pathname] || ![file readable $pathname] } { + return "" + } + set fd [open $pathname] + set buf [read $fd] + close $fd + return $buf +} + + +proc get_spam_from_filesystem {filename} { + set fname [spam_file_location $filename] + return [read_file_as_string $fname] +} + + +################################################################ + +# Look for a set of files with names specfied from the daily_spam_files table +# +# For example, file_prefix=daily looks for the file "daily[-MM-DD-YYYY]" as the indicator +# that the spam is ready to go. The date is optional. If there is no dated file, +# the plain file prefix name will be used at the content source file. +# +# It will also look for aux files "daily-html[-MM-DD-YYYY]" and "daily-aol[-MM-DD-YYYY]" +# and if they exist, their content will be sent to users with those email type preferences. +# +# If no AOL file is found, but there is an HTML file, the HTML file's content will be used for the AOL +# content. +# +# Bug: There is thus a race condition, if the +# content file is only partially written when the daemon probes for it. +# A solution would be to use another dummy file whose existence indicates the +# other spam files are complete and ready. Make sure to at least write the +# HTML and AOL files first, to close the race condition window a little. +# +# Note: if you omit the date from a filename, the same file will be picked up and +# sent once per day. This usually is not what you want. +# + +proc check_spam_drop_zone {db db2} { + set date [database_to_tcl_string $db "select to_char([db_sysdate],'MM-DD-YYYY') from dual"] + set pretty_date [database_to_tcl_string $db "select to_char([db_sysdate],'MM/DD/YYYY') from dual"] + + # outer loop - iterate over daily_spam_files table looking for descriptors of + # files in the drop zone. + set selection [ns_db select $db "select file_prefix, from_address, subject, target_user_class_id, template_p, user_class_description, period + from daily_spam_files"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + # This should be improved to use date functions to pick nth day of week, month, or year, + # so people can schedule a spam every Monday or on the 10th of each month + switch $period { + daily { set period_days 1 } + weekly { set period_days 7 } + monthly { set period_days 30 } + yearly { set period_days 365 } + } + + # Check if a spam has already been queued for this file prefix and today's date or period + set already_queued [database_to_tcl_string $db2 "select count(spam_id) from spam_history + where pathname = '[set file_prefix]' + and ([db_sysdate]::date - send_date::date) < $period_days + "] + + if { $already_queued > 0 } { + continue + } else { + + # See if file prefix with date exists. If so, then look for other + # files with date appended. + + set dropfile_path [spam_file_location $file_prefix] + + ns_log Notice "checking for dropfile with and without date suffix: [set dropfile_path]-[set date]" + if { [file readable "[set dropfile_path]-[set date]"] } { + set date_suffix "-$date" + } else { + set date_suffix "" + } + + if { ![file readable "[set dropfile_path][set date_suffix]"] } { + ns_log Notice "Daily spam for \"$file_prefix\" could not be sent - no dropfile found at [set dropfile_path]\[[set date_suffix]\]" + } else { + + # get the contents of files, and insert into queue + # Check for file name which includes date + set dropfile_path_plain "[set dropfile_path]$date_suffix" + set dropfile_path_html "[set dropfile_path]-html$date_suffix" + set dropfile_path_aol "[set dropfile_path]-aol$date_suffix" + + set file_plain [read_file_as_string $dropfile_path_plain] + set file_html [read_file_as_string $dropfile_path_html] + set file_aol [read_file_as_string $dropfile_path_aol] + + # Set other spam params + if {[empty_string_p $from_address]} { + set from_address [spam_system_default_from_address] + } + + regsub -all "%%DATE%%" $subject $pretty_date subject_x + set system_user 1 + + # generate SQL query from user_class_id + set set_args [ns_set create] + ns_set update $set_args "user_class_id" $target_user_class_id + set query [ad_user_class_query $set_args] + regsub {from users} $query {from users_spammable users} query + + ns_db dml $db2 "insert into spam_history + (spam_id, template_p, from_address, title, body_plain, body_html, body_aol, user_class_description, user_class_query, send_date, creation_date, creation_user, status, creation_ip_address,pathname) + values + ([db_sequence_nextval_sql spam_id_sequence], '$template_p', '[DoubleApos $from_address]', '[DoubleApos $subject_x]', '[DoubleApos $file_plain]', '[DoubleApos $file_html]', '[DoubleApos $file_aol]', '[DoubleApos $user_class_description]', [ns_dbquotevalue $query], [db_sysdate], [db_sysdate], $system_user, 'unsent', '0.0.0.0', [ns_dbquotevalue $file_prefix])" + + + ns_log Notice "Daily spam queued for \"$file_prefix\" from $dropfile_path_plain" + } + } + } +} + + +# returns a string containing of html form inputs fields for adding user to spam groups +proc spam_subscriptions_form_html { db newsletter_category_name user_id } { + set query "select user_groups.group_id, newsletter_info.short_description, user_groups.group_name, user_group_map.user_id as member_p + from user_groups, user_group_map, newsletter_info + where upper(group_type) = upper('newsletter') + and user_group_map.user_id(+) = $user_id + and user_group_map.group_id(+) = user_groups.group_id + and newsletter_info.group_id = user_groups.group_id + and newsletter_info.category = '[DoubleApos $newsletter_category_name]' + order by group_name" + + set result "" + + set selection [ns_db select $db $query] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + if {[empty_string_p $member_p]} { + set checked "" + } else { + set checked "checked" + } + append result "$group_name$short_description\n" + } + + return $result +} + + +proc spam_guess_email_type_preference {db user_id} { + return [database_to_tcl_string "select guess_user_email_type($user_id) from dual"] +} + + + + +# Produces an html form fragment giving a user the default choice of newsletters to sign +# up for. Uses the .ini parameter spam/DefaultNewsletterGroups, a list of group id numbers +# of the newsletter groups we use as the default choices for new users. +proc spam_default_newsletter_signup_html {db {checked "checked"}} { + set default_newsletter_groups [ad_parameter "DefaultNewsletterGroups" "spam"] + set html_fragment "" + if {[llength $default_newsletter_groups] > 0} { + set selection [ns_db select $db "select user_groups.group_id, group_name, + short_description, long_description, category + from user_groups, newsletter_info + where user_groups.group_id in ($default_newsletter_groups) + and user_groups.group_id = newsletter_info.group_id"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + # get the info associated with each newsletter group + append html_fragment " $group_name
         $short_description
    " + } + + } + return $html_fragment +} + + +proc_doc spam_sanitize_filename {filename} "Remove any pathname metachars from a filename, allow only a very clean set of characters" { + regsub -all {[^A-aZ-z0-9._-]} $filename "_" file_clean + regsub -all {[.]+} $file_clean "." file_clean_1 + return $file_clean_1 +} + + +util_report_successful_library_load Index: web/openacs/tcl/spam-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/spam-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/spam-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,185 @@ +util_report_library_entry + + +proc_doc ad_removal_blurb {{subsection "" } {filetype "txt"}} "Gets the +standard site-wide or subsection-specific removal blurb, for attaching +to outgoing email. txt=plain, htm=html mail, aol = aol mail" { +# return [ad_removal_blurb_internal $subsection $filetype] +# Memoize will fail miserably if subsection is an empty string (or filetype, for that matter) +# unless we do this nasty Tcl magic. -- hqm + return [util_memoize "ad_removal_blurb_internal {$subsection} {$filetype}"] +} + +proc_doc ad_removal_blurb_internal {subsection filetype} "For use by ad_removal_blurb" { + set default_blurb "------- Removal instructions ------ +[ad_url]/pvt/home.tcl" + + + if {[lsearch {txt aol htm} $filetype] < 0} { + ad_return_error "error in input to ad_removal_blurb" " + filetype should be in {txt aol htm}" + return + } + if {![empty_string_p subsection]} { + set fd [ad_parameter RemovalBlurbStub $subsection] + if {[empty_string_p $fd]} { + ns_log notice "$subsection has no RemovalBlurb parameter" + set fd [ad_parameter RemovalBlurbStub] + } + } else { + set fd [ad_parameter RemovalBlurbStub] + } + + if {[empty_string_p $fd]} { + ns_log warning "System has no RemovalBlurbStub set" + return $default_blurb + } + + set blurb [subst [read_file_as_string "$fd.$filetype"]] + if {[empty_string_p $blurb] && ![string compare $filetype "aol"]} { + # if .aol file not defined, default to .htm + set filetype "htm" + set blurb [subst [read_file_as_string "$fd.$filetype"]] + } + + if {[empty_string_p $blurb] && ![string compare $filetype "htm"]} { + # if .htm file not defined, default to .txt + set filetype "txt" + set blurb [subst [read_file_as_string "$fd.$filetype"]] + } + if {[empty_string_p $blurb]} { + set blurb $default_blurb + ns_log error "RemovalBlurbStub parameter specified a bad filename" + } + return $blurb +} + + + + +proc spam_system_default_from_address {} { + return [ad_parameter "SpamRobotFromAddress" "spam" "email-notification@arsdigita.com"] +} + + +# Really, this should make sure to generate a boundary string that +# does not appear in the content. +++ +proc spam_mime_boundary {} { + return "__NextPart_000_00A0_01BF7A3C.09877D80" +} + +# return MIME content html base url +proc spam_content_base {} { + return [ad_parameter "SpamMIMEContentBase" "spam" [ad_url]] +} + +# return MIME content html location url +proc spam_content_location {} { + return [ad_parameter "SpamMIMEContentLocation" "spam" [ad_url]] +} + + +# Quoted printable MIME content encoder +# +# hqm@arsdigita.com +# +# See RFC 1521 for spec of quoted printable encoding + +# Build a table of encodings of chars to quoted printable +ns_share spam_quoted_printable_en spam_quoted_printable_en + +for {set i 0} {$i < 256} {incr i} { + if {(($i >= 33) && ($i <= 60)) || (($i >= 62) && ($i <= 126)) || ($i == 9) || ($i == 32)} { + set spam_quoted_printable_en($i) [format "%c" $i] + } else { + set spam_quoted_printable_en($i) [format "=%X%X" [expr (($i >> 4) & 0xF)] [expr ($i & 0xF)]] + } +} + +# Encoder: +# Remove ctrl-m's +# pass chars 33 - 60, 62-126 literally, as well as space 32 and tab 9 +# encode others as =XX hex +# replace LF with CRLF, (but if line ends with tab or space, encode last char as =XX) +# make soft breaks (end with "=") every 75 chars +# +proc_doc spam_encode_quoted_printable {msg} {Returns a MIME quoted-printable RFC1521 encoded string} { + ns_share spam_quoted_printable_en + + set result {} + regsub -all "\r" $msg "" msg_stripped + set length 0 + set strlen [string length $msg_stripped] + for {set i 0} {$i < $strlen} {incr i} { + set c [string range $msg_stripped $i $i] + set c2 [string range $msg_stripped [expr $i + 1] [expr $i + 1]] + scan $c "%c" x + scan $c2 "%c" x2 + # if c is a SPACE or TAB, and next char is LF, encode C as QP + if {(($x == 32) || ($x == 9)) && ($x2 == 10)} { + set qp [format "=%X%X" [expr (($x >> 4) & 0xF)] [expr ($x & 0xF)]] + incr length [string length $qp] + append result $qp + } elseif {$x == 10} { + # hard line break (ASCII 10) requires conversion to MIME CRLF + append result "\r\n" + set length 0 + } else { + set qp $spam_quoted_printable_en($x) + incr length [string length $qp] + append result $qp + } + + # Make soft line break at 75 characters. + if {$length > 72} { + append result "=\n" + set length 0 + } + } + return $result +} + + +# Preserve user supplied newlines, but try to wrap text at 80 cols otherwise. +# If a token is longer than the line length threshold, then don't break it +# but put it on its own line (this is how we deal with long URL strings to +# keep them from being mangled. + +proc spam_wrap_text {input {threshold 80}} { + regsub -all "\r" $input "" text + set result [wrap_string $text 80] + return $result +} + + +util_report_successful_library_load + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Index: web/openacs/tcl/sql-book-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/sql-book-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/sql-book-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,116 @@ +# sql-book-defs.tcl,v 1.5.4.1 2000/02/03 09:17:47 ron Exp +# definitions for philg's SQL book (http://photo.net/sql/ ) + +# we don't want to link directly to Oracle docs because + +# 1) these will change over time as new versions of Oracle are released +# 2) we might or might not get permissions to keep Oracle docs on our server +# 3) Oracle might put its docs on its own Web server and keep them stable + +# usage: we assign a token to every concept, e.g., "create_table" and then +# link to /sql/ref/create_table which will redirect to the appropriate spot + +util_report_library_entry + +ns_register_proc GET /sql/ref/ sql_redirect + +proc sql_redirect {ignore} { + if { ![regexp {/sql/ref/(.+)$} [ns_conn url] match token] } { + # we couldn't find the token + ad_return_error "Reference Error" "A SQL reference is supposed to look like +
    
+[ns_conn location]/sql/ref/***token***
+
    + +This request looked like +
    
+[ns_conn request]
+
    +[ad_footer]" + return + } + # we have a token, now let's look it up + set destination [sql_redirect_lookup_token $token] + if [empty_string_p $destination] { + ad_return_error "Token Lookup Failure" "We couldn't find \"$token\" in our little database of reference materials. Sorry." + } else { + ns_returnredirect $destination + } +} + +proc sql_redirect_lookup_token {token} { + set token_db(create_materialized_view) "http://oradoc.photo.net/ora81/DOC/server.815/a67779/ch4f.htm#24503" + set token_db(concepts) "http://oradoc.photo.net/ora81/DOC/server.815/a67781/toc.htm" + set token_db(utilities) "http://oradoc.photo.net/ora81/DOC/server.815/a67792/toc.htm" + set token_db(net8) "http://oradoc.photo.net/ora81/DOC/network.815/a67440/toc.htm" + set token_db(copycommand) "http://oradoc.photo.net/ora81/DOC/server.815/a66736/ch63.htm#307" + set token_db(export) "http://oradoc.photo.net/ora81/DOC/server.815/a67792/ch01.htm#2531" + set token_db(import) "http://oradoc.photo.net/ora81/DOC/server.815/a67792/ch02.htm#34966" + set token_db(jobs) "http://oradoc.photo.net/ora81/DOC/server.815/a67772/jobq.htm#750" + set token_db(oraclelanguages) "http://oradoc.photo.net/ora81/DOC/server.815/a67789/appa.htm#956235" + set token_db(intermediatext) "http://oradoc.photo.net/ora81/DOC/inter.815/a67843/toc.htm" + set token_db(connectby) "http://oradoc.photo.net/ora81/DOC/server.815/a67779/ch4l.htm#13496" + set token_db(plsql) "http://oradoc.photo.net/ora81/DOC/server.815/a67842/toc.htm" + set token_db(using_procedures_and_packages) "http://oradoc.photo.net/ora81/DOC/server.815/a68003/01_10pck.htm#562" + set token_db(java_stored_procedures) "http://oradoc.photo.net/ora81/DOC/java.815/a64686/toc.htm" + set token_db(addmonths) "http://oradoc.photo.net/ora81/DOC/server.815/a67779/function.htm#1025480" + set token_db(createsequence) "http://oradoc.photo.net/ora81/DOC/server.815/a67779/ch4g.htm#3055" + set token_db(usingsequences) "http://oradoc.photo.net/ora81/DOC/server.815/a67779/ch2.htm#27457" + set token_db(transactions) "http://oradoc.photo.net/ora81/DOC/server.815/a67781/c15trans.htm#222" + set token_db(dbms_lob) "http://oradoc.photo.net/ora81/DOC/server.815/a68001/dbms_lob.htm#998100" + set token_db(concepts_date_datatype) "http://oradoc.photo.net/ora81/DOC/server.815/a67781/c10datyp.htm#796" + set token_db(using_date_datatype) "http://oradoc.photo.net/ora81/DOC/server.815/a68003/01_04blt.htm#426706" + set token_db(date_functions) "http://oradoc.photo.net/ora81/DOC/server.815/a67779/function.htm#1024474" + set token_db(date_format) "http://oradoc.photo.net/ora81/DOC/server.815/a67779/ch2.htm#34926" + set token_db(create_index) "http://oradoc.photo.net/ora81/DOC/server.815/a67779/ch4f.htm#39410" + set token_db(composite_indices) "http://oradoc.photo.net/ora81/DOC/server.815/a67775/ch6_acce.htm#2174" + set token_db(rollup) "http://oradoc.photo.net/ora81/DOC/server.815/a68003/rollup_c.htm#31838" + set token_db(limits) "http://oradoc.photo.net/ora81/DOC/server.815/a67790/ch4.htm#4762" + + if [info exists token_db($token)] { + return $token_db($token) + } else { + return "" + } +} + +# let's add stuff for diary here also + +ns_register_adptag "diary_header" "/diary_header" diary_header + +proc diary_title {} { + return "Diary of a Startup" +} + +proc diary_header {page_title tagset} { + return " + + +$page_title + + + +

    $page_title

    + +part of [diary_title] +by Philip Greenspun + +
    +" +} + +ns_register_adptag "diary_footer" "/diary_footer" diary_footer + +proc diary_footer {} { + return " +
    +Return to Table of Contents +
    +
    +
    philg@mit.edu
    + + +" +} + +util_report_successful_library_load Index: web/openacs/tcl/survey-simple-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/survey-simple-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/survey-simple-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,298 @@ +# +# /tcl/survey-simple-defs.tcl +# +# by philg@mit.edu on February 9, 2000 +# modified by teadams@mit.edu on February 28, 2000 +# +# + +util_report_library_entry + +ns_share -init {set ad_survsimp_filters_installed_p 0} ad_survsimp_filters_installed_p + +if {!$ad_survsimp_filters_installed_p} { + set ad_survsimp_filters_installed_p 1 + ad_register_filter preauth HEAD /survsimp/admin/* survsimp_security_checks_admin + ad_register_filter preauth HEAD /survsimp/* survsimp_security_checks + ad_register_filter preauth GET /survsimp/admin/* survsimp_security_checks_admin + ad_register_filter preauth GET /survsimp/* survsimp_security_checks + ad_register_filter preauth POST /survsimp/admin/* survsimp_security_checks_admin + ad_register_filter preauth POST /survsimp/* survsimp_security_checks +} + + +# we don't want anyone filling out surveys unless they are +# registered +proc survsimp_security_checks {args why} { + if { [ad_verify_and_get_user_id] == 0 } { + ad_redirect_for_registration + # tells AOLserver to abort the thread + return filter_return + } else { + # this is a verified authorized user + return filter_ok + } +} + + +# Checks if user is logged in, AND is a member of the survsimp admin group +proc survsimp_security_checks_admin {args why} { + set user_id [ad_verify_and_get_user_id] + if { $user_id == 0 } { + ad_redirect_for_registration + # tells AOLserver to abort the thread + return filter_return + } + + set db [ns_db gethandle subquery] + + if {![ad_administration_group_member $db survsimp "" $user_id]} { + ns_db releasehandle $db + ad_return_error "Access Denied" "Your account does not have access to this page." + return filter_return + } + + ns_db releasehandle $db + + return filter_ok +} + + +proc_doc survsimp_question_display { db question_id } "Returns a string of HTML to display for a question, suitable for embedding in a form. The form variable is of the form \"response_to_question_\$question_id." { + set element_name "response_to_question_$question_id" + + set selection [ns_db 1row $db "select * from survsimp_questions where question_id = $question_id"] + set_variables_after_query + + set html $question_text + if { $presentation_alignment == "below" } { + append html "
    " + } else { + append html " " + } + + + set user_value "" + switch -- $presentation_type { + "textbox" { + if { ![empty_string_p $user_value] } { + append html $user_value + } else { + append html "" + } + } + "textarea" { + append html "" + } + "date" { + append html "[ad_dateentrywidget $element_name $user_value]" + } + "select" { + if { $abstract_data_type == "boolean" } { + append html " +" + } else { + append html "" + } + } + + "radio" { + if { $abstract_data_type == "boolean" } { + set choices [list " True" \ + " False"] + } else { + set choices [list] + set selection [ns_db select $db "select choice_id, label +from survsimp_question_choices +where question_id = $question_id +order by sort_order"] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $user_value == $choice_id } { + lappend choices " $label" + } else { + lappend choices " $label" + } + } + } + if { $presentation_alignment == "beside" } { + append html [join $choices " "] + } else { + append html "
    \n[join $choices "
    \n"]\n
    " + } + } + "checkbox" { + + set choices [list] + set selection [ns_db select $db "select * from survsimp_question_choices +where question_id = $question_id +order by sort_order"] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + if { [info exists selected_choices($choice_id)] } { + lappend choices " $label" + } else { + lappend choices " $label" + } + } + if { $presentation_alignment == "beside" } { + append html [join $choices " "] + } else { + append html "
    \n[join $choices "
    \n"]\n
    " + } + } + } + return $html +} + + + +proc_doc survsimp_answer_summary_display {db response_id {html_p 1} {category_id_list ""}} "Returns a string with the questions and answers. If html_p =t, the format will be html. Otherwise, it will be text. If a list of category_ids is provided, the questions will be limited to that set of categories." { + + set return_string "" + + if [empty_string_p $category_id_list] { + set selection [ns_db select $db "select * +from survsimp_questions, survsimp_question_responses +where survsimp_question_responses.response_id = $response_id +and survsimp_questions.question_id = survsimp_question_responses.question_id +and survsimp_questions.active_p = 't' +order by sort_key"] + } else { + set selection [ns_db select $db "select survsimp_questions.*, +survsimp_question_responses.* +from survsimp_questions, survsimp_question_responses, site_wide_category_map +where survsimp_question_responses.response_id = $response_id +and survsimp_questions.question_id = survsimp_question_responses.question_id +and survsimp_questions.active_p = 't' +and site_wide_category_map.on_which_table='survsimp_questions' +and site_wide_category_map.on_what_id = survsimp_questions.question_id +and site_wide_category_map.category_id in ([join $category_id_list " , "]) +order by sort_key"] + } + + set db2 [ns_db gethandle subquery] + set question_id_previous "" + + while {[ns_db getrow $db $selection]} { + set_variables_after_query + if {$question_id == $question_id_previous} { + continue + } + + if $html_p { + append return_string "$question_text +
    " + } else { + append return_string "$question_text: " + } + append return_string "$clob_answer $number_answer $varchar_answer $date_answer" + + if {$choice_id != 0 && ![empty_string_p $choice_id] && $question_id != $question_id_previous} { + set label_list [database_to_tcl_list $db2 "select label + from survsimp_question_choices, survsimp_question_responses +where survsimp_question_responses.question_id = $question_id +and survsimp_question_responses.response_id = $response_id +and survsimp_question_choices.choice_id = survsimp_question_responses.choice_id"] + append return_string "[join $label_list ", "]" + } + + if ![empty_string_p $boolean_answer] { + append return_string "[ad_decode $boolean_answer "t" "True" "False"]" + + } + + if $html_p { + append return_string "
    +

    " + } else { + append return_string "\n\n" + } + + set question_id_previous $question_id + } + ns_db releasehandle $db2 + return "$return_string" +} + + + + +proc_doc survsimp_survey_admin_check { db user_id survey_id } { Returns 1 if user is allowed to administer a survey or is a site administrator, 0 otherwise. } { + if { ![ad_administrator_p $db $user_id] && [database_to_tcl_string $db " + select creation_user + from survsimp_surveys + where survey_id = $survey_id"] != $user_id } { + ad_return_error "Permission Denied" "You do not have permission to administer this survey." + return -code return + } +} + +# For site administrator new stuff page. +proc_doc ad_survsimp_new_stuff { db since_when only_from_new_users_p purpose } "Produces a report of the new surveys created for the site administrator." { + if { $purpose != "site_admin" } { + return "" + } + if { $only_from_new_users_p == "t" } { + set users_table "users_new" + } else { + set users_table "users" + } + + set new_survey_items "" + set selection [ns_db select $db "select survey_id, name, description, u.user_id, first_names || ' ' || last_name as creator_name, creation_date +from survsimp_surveys s, $users_table u +where s.creation_user = u.user_id + and creation_date> '$since_when' +order by creation_date desc"] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + append new_survey_items "

  • $name ($description) created by $creator_name on $creation_date\n" + } + if { ![empty_string_p $new_survey_items] } { + return "
      \n\n$new_survey_items\n
    \n" + } else { + return "" + } +} + +ns_share ad_new_stuff_module_list + +if { ![info exists ad_new_stuff_module_list] || [util_search_list_of_lists $ad_new_stuff_module_list "Surveys" 0] == -1 } { + lappend ad_new_stuff_module_list [list "Surveys" ad_survsimp_new_stuff] +} + + +proc_doc survsimp_survey_short_name_to_id {short_name} "Returns the id of the survey +given the short name" { + # we use the subquery pool so it is easy + # to Memoize this function (we are not passing it an + # arbitrary db handle) + set db [ns_db gethandle subquery] + set survey_id [database_to_tcl_string_or_null $db "select survey_id from + survsimp_surveys where lower(short_name) = '[string tolower [DoubleApos $short_name]]'"] + ns_db releasehandle $db + return $survey_id +} + +util_report_successful_library_load Index: web/openacs/tcl/teaching-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/teaching-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/teaching-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,84 @@ +# teaching-defs.tcl,v 1.5.4.1 2000/02/03 09:17:48 ron Exp +# random procedures for the psets and other stuff underneath +# http://photo.net/teaching/ + +util_report_library_entry + +proc teaching_footer {} { + return "
    +Maintainer: teadams@mit.edu + + +" +} + +# definitions for the Tcl manual + +ns_register_adptag "codeexample" "/codeexample" tcl_adp_codeexample + +proc tcl_adp_codeexample {string tagset} { + return "
    +
    ${string}
     +
    +" +} + +proc tcl_title {} { + return "Tcl for Web Nerds" +} + +proc tcl_authors {} { + return " +Hal Abelson, +Philip Greenspun, +and +Lydia Sandon +" +} + +proc tcl_header {chapter_title} { + return " + + +$chapter_title + + + + +

    $chapter_title

    + +part of [tcl_title] +by [tcl_authors] + +
    +" +} + +proc tcl_footer {} { + set db [ns_db gethandle subquery] + set comments_and_links [static_format_comments_and_links [static_get_comments_and_links $db [ns_conn url]]] + ns_db releasehandle $db + return " +
    +Return to Table of Contents +
    +
    +
    lsandon@mit.edu
    + +$comments_and_links + + + +" +} + +# we encapsulate this because we may want to cookie out the +# user and redirect him or her to different versions of the language +# depending on which he or she is using; for the moment +# let's just refer people out to 7.5 +proc tcl_man_page_reference {command_name} { + set scriptics_url "http://www.scriptics.com/man/tcl7.5/TclCmd/$command_name.n.html" + return "$scriptics_url" +} + +util_report_successful_library_load Index: web/openacs/tcl/team-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/team-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/team-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,191 @@ + +## +## Team Definitions +## + +proc check_db_var {} { + uplevel { + if {$db == ""} { + set db [ns_db gethandle subquery] + set this_is_a_subquery 1 + } + } +} + +proc cleanup_db_var {} { + uplevel { + if {[info exists this_is_a_subquery]} { + ns_db releasehandle $db + } + } +} + +proc team_header {title} { + return [ad_header $title] +} + +proc team_footer {} { + return [ad_footer] +} + +proc team_url_stub {} { + return "/team" +} + +proc team_system_name {} { + return "Team Management" +} + +proc team_user_group_type {} { + return "team" +} + +proc team_roles {} { + return {external internal} +} + +proc team_actions {} { + return {view_project edit_project fix_issue close_issue} +} + +proc team_permissions {} { + return {{view_project external} {view_project internal} {edit_project internal} {fix_issue internal}} +} + +# Find a project's team +proc team_project_group_id {project_id {db {}}} { + check_db_var + + return [database_to_tcl_string_or_null $db "select team_id from ticket_project_teams where project_id=$project_id"] +} + +# Find a team by name +proc team_get_user_group_id {team_name {db {}}} { + check_db_var + + set user_group_id [database_to_tcl_string_or_null $db "select user_group_id from user_groups where group_type='[team_user_group_type]' and lower(group_name)=lower('[DoubleApos $team_name]')"] + + return $user_group_id +} + +# Create a new team +proc team_new {team_name {db {}}} { + check_db_var + + set team_id [ad_user_group_add $db [team_user_group_type] [DoubleApos $team_name] "t" "f" "wait" "t"] + + # Add the roles we want + foreach role [team_roles] { + ad_user_group_role_add $db $team_id $role + } + + # Add the actions + foreach action [team_actions] { + ad_user_group_action_add $db $team_id $action + } + + # Add the matching + foreach permission [team_permissions] { + ad_user_group_action_role_map $db $team_id [lindex $permission 0] [lindex $permission 1] + } + + return $team_id +} + +# Add a user to a team +proc team_add_user {team_id user_id role {db {}}} { + check_db_var + + # Special case if the person is already a member of the group + if {[ad_user_group_member $db $team_id $user_id]} { + team_user_change_role $team_id $user_id $role $db + return + } + + ad_user_group_user_add $db $user_id $role $team_id + + set team_name [database_to_tcl_string $db "select group_name from user_groups where group_id=$team_id"] + set full_name [database_to_tcl_string $db "select email from users where user_id=$user_id"] + + # Add a todo list for that person + set new_list_id [todo_list_add $user_id "$team_name tasks" $db] + + # Enable access to that list for that group + todo_list_allow_user_group $new_list_id $team_id $db +} + +proc team_user_change_role {team_id user_id new_role {db {}}} { + check_db_var + + # Blech, hack it baby, change the role directly in the table. + # First delete all the mappings, then readd it. + ns_db dml $db "delete from user_group_map where group_id=$team_id and user_id=$user_id" + ad_user_group_user_add $db $user_id $new_role $team_id +} + +proc team_remove_user {team_id user_id {db {}}} { + check_db_var + + ns_db dml $db "begin transaction" + + # Delete the mapping + ns_db dml $db "delete from user_group_map where group_id=$team_id and user_id=$user_id" + + set list_id [database_to_tcl_string $db "select todo_lists.list_id as list_id from todo_lists, todo_list_user_group_map where user_id=$user_id and user_group_id=$team_id and todo_lists.list_id= todo_list_user_group_map.list_id"] + + # Delete the todo items + ns_db dml $db "delete from todo_items where list_id=$list_id" + + # Delete the mapping + ns_db dml $db "delete from todo_list_user_group_map where list_id=$list_id" + + # Delete the todo list + ns_db dml $db "delete from todo_lists where list_id=$list_id" + + ns_db dml $db "end transaction" +} + +# Check if a user is a member of a team +proc team_user_is_member_p {team_id user_id {db {}}} { + check_db_var + + return [ad_user_group_member $db $team_id $user_id] +} + +# Check if this is a team admin +proc team_user_is_admin_p {team_id user_id {db {}}} { + check_db_var + + return [ad_user_group_authorized_admin $user_id $team_id $db] +} + +# Adding a user to a project +# returns a list of user_id, todo_list_id +# where the todo_list_id is the list_id of the shared todo_list +proc team_add_user_by_email {db team_id email role} { + set email [string trim $email] + set QQemail [DoubleApos $email] + set project_name [database_to_tcl_string $db "select title from ticket_projects where project_id=(select project_id from ticket_project_teams where team_id=$team_id)"] + + # Check if there's a user_id + set email_user_id [database_to_tcl_string_or_null $db "select user_id from users where upper(email)=upper('$QQemail')"] + + # Create user if necessary + if {$email_user_id == ""} { + set email_user_id [database_to_tcl_string $db "select user_id_sequence.nextval from dual"] + ns_db dml $db "insert into users (user_id, first_names, last_name, email, converted_p, password, user_state) VALUES ($email_user_id, '$QQemail', '$QQemail', '$QQemail', 't', '$QQemail', 'authorized')" + + foreach table_name [ad_parameter_all_values_as_list RequiredUserTable] { + if {[database_to_tcl_string $db "select count(*) from $table_name where user_id=$email_user_id"] == 0} { + ns_db dml $db "insert into $table_name (user_id) values ($email_user_id)" + } + } + + } else { + # user exists + } + + team_add_user $team_id $email_user_id $role $db +} + + Index: web/openacs/tcl/threads-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/threads-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/threads-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,43 @@ +# +# The Threads Module (ben@adida.net) +# + +proc threads_header {title} { + return [ad_header $title] +} + +proc threads_footer {} { + return [ad_footer] +} + +proc threads_url_stub {} { + return "/threads" +} + +proc threads_system_name {} { + return "Threads" +} + +proc threads_top_level_link {} { + return [list [threads_url_stub] [threads_system_name]] +} + +proc threads_list_of_priorities {} { + return [list 1 2 3 4 5 6 7 8 9] +} + +proc threads_list_of_states {} { + return [list active blocked suspended] +} + +proc threads_user_can_see_thread_p {db user_id thread_id} { + if {[database_to_tcl_string $db "select user_can_see_thread_p($user_id, $thread_id)"] == "t"} { + return 1 + } else { + return 0 + } +} + +proc threads_deny_access {} { + ad_return_error "Not allowed" +} \ No newline at end of file Index: web/openacs/tcl/ticket-defs.tcl-old =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ticket-defs.tcl-old,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ticket-defs.tcl-old 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,1245 @@ +# Ticket tracker definitions + +# ticket-defs.tcl by hqm@arsdigita.com June 1999 + +util_report_library_entry + +################################################################ +# Reference to "customer" in various functions refer to any user who is not in +# the ticket admin group. This is based on a "customer support" +# model for the usage of ticket tracker. + + +proc ticket_getdbhandle {} { + return [ns_db gethandle main] +} + +proc ticket_system_name {} { + return "[ad_system_name] Ticket Tracker" +} + +proc ticket_reply_email_addr {} { + return [ad_parameter TicketReplyEmail "ticket"] +} + + +# Customers are allowed to create new tickets in the system? +# Defaults to yes. +proc ticket_customers_can_create_new_tickets {} { + if {[string compare [ad_parameter CustomerCanCreateNewTickets "ticket"] "0"] == 0} { + return 0 + } else { + return 1 + } +} + +# returns 1 if current user is in admin group for ticket module +proc ticket_user_admin_p {db} { + set user_id [ad_verify_and_get_user_id] + return [ad_administration_group_member $db ticket "" $user_id] +} + +# return the GID of the ticket admin group +proc ticket_admin_group {db} { + return [ad_administration_group_id $db "ticket" ""] +} + +ns_share -init {set ad_ticket_filters_installed 0} ad_ticket_filters_installed + +if {!$ad_ticket_filters_installed} { + set ad_ticket_filters_installed 1 + ns_register_filter preauth HEAD /ticket/admin/* ticket_security_checks_admin + ns_register_filter preauth HEAD /ticket/* ticket_security_checks + ns_register_filter preauth GET /ticket/admin/* ticket_security_checks_admin + ns_register_filter preauth GET /ticket/* ticket_security_checks + ns_register_filter preauth POST /ticket/admin/* ticket_security_checks_admin + ns_register_filter preauth POST /ticket/* ticket_security_checks +} + + +# Check for the user cookie, redirect if not found. +proc ticket_security_checks {args why} { + uplevel { + set user_id [ad_verify_and_get_user_id] + if {$user_id == 0} { + ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode [ns_conn url]?[ns_conn query]]" + return filter_return + } + return filter_ok + } +} + + +# Checks if user is logged in, AND is a member of the ticket admin group +proc ticket_security_checks_admin {args why} { + set user_id [ad_verify_and_get_user_id] + if {$user_id == 0} { + ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode [ns_conn url]?[ns_conn query]]" + return filter_return + } + + set db [ns_db gethandle subquery] + + if {![ticket_user_admin_p $db]} { + ad_return_error "Access Denied" "Your account does not have access to this page." + return filter_return + } + + ns_db releasehandle $db + + return filter_ok +} + +# return id of the default admin user (system admin) +proc default_ticket_admin_user {db} { + set admins [database_to_tcl_list $db "select ugm.user_id + from user_group_map ugm + where ugm.group_id = [ticket_admin_group $db]"] + return [lindex $admins 0] +} + +# The id of the project in which unprivileged user's tickets are created. +proc get_default_customer_project_id {db} { + return [get_project_named $db "Tech Support" 1] +} + +# A single project is designated where RMA tickets get put +proc get_project_named {db title {create 0}} { + set id_list [database_to_tcl_list $db "select project_id from ticket_projects where lower(title) = '[string tolower $title]'"] + if {[llength $id_list] < 1} { + if {$create} { + set new_id [database_to_tcl_string $db "select ticket_project_id_sequence.nextval from dual"] + ns_db dml $db "insert into ticket_projects (project_id, customer_id, title, start_date) VALUES ($new_id, [default_ticket_admin_user $db], '$title', sysdate())" + set id_list [list $new_id] + } else { + error "get_project_named: Could not find project named $title" + } + } + return [lindex $id_list 0] +} + +proc ticket_picklist_field_names {} { + set names {} + foreach entry [ticket_picklist_data] { + lappend names [lindex $entry 0] + } + return $names +} + +# returns the field name of a picklist entry +proc ticket_picklist_entry_field_name {entry} { + return [lindex $entry 0] +} + +# returns the field name of a picklist entry +proc ticket_picklist_entry_pretty_name {entry} { + return [lindex $entry 1] +} + +proc ticket_picklist_entry_column_name {entry} { + return [lindex $entry 3] +} + + +# Get the meta-data for a field_name: +# returns an entry from the picklist data list as defined above. +proc ticket_picklist_field_info {field_name} { + foreach entry [ticket_picklist_data] { + set fn [lindex $entry 0] + if {$field_name == $fn} { + return $entry + } + } + return {} +} + + +# Returns the HTML needed to input a picklist value +proc ticket_picklist_html_fragment { field_name {default_value ""} } { + set entry [ticket_picklist_field_info $field_name] + set widget_type [lindex $entry 2] + set pretty_name [lindex $entry 1] + set optional [lindex $entry 4] + switch $widget_type { + "picklist_single_select" { + return "$pretty_name[picklist_html_select_list $field_name $default_value]" + } + "text" { + return "$pretty_name" + } + default { + return "Cannot find widget type meta-data for field $field_name !" + } + } +} + +proc picklist_html_select_list { field { default_value ""} } { + append result "\n" + return $result +} + +################################################################ +# Ticket types list + +proc ticket_types {} { + return { + "Defect" "Enhancement Request" + } +} + +proc ticket_date_format {} { + return "'Month dd, yyyy'" +} + +proc ticket_status_types {} { +return {"open" "waiting assignment" "need clarification" "development" "fixed waiting approval" "deferred" "closed" "reopened"} +} + +proc ticket_severity_types {} { + return [ad_parameter SeverityList "ticket"] +} + +proc_doc severity_decode_list {} "produce a sort order on severity types for SQL query" { + set i 0 + foreach item [ticket_severity_types] { + append str ",'$item',$i" + incr i + } + return $str +} + +# returns the default value of ticket_isseus.public_p for the ticket type. +proc ticket_default_visibility { ticket_type } { + switch $ticket_type { + "Ticket" { return "t" } + "Service Ticket" { return "t" } + "Bug" { return "f" } + "Feature Request" { return "t" } + default { return "t" } + } +} + + + +# If any_p is 1, include a blank "any" item in the menu. +proc ticket_html_select_ticket_type { { default_value "Ticket"} {any_p 0} } { + if {$any_p} { + set types [concat {""} [ticket_types]] + } else { + set types [ticket_types] + } + foreach item $types { + if { $default_value == $item } { + append result "\n" + } else { + append result "\n" + } + } + return $result +} + +proc ticket_type_html_for_select_menu {} { + foreach item [ticket_types] { + append result "\n" + } + return $result +} + + +proc ticket_project_select_menu { db } { + set selection [ns_db select $db "select * from ticket_projects order by title asc"] + set result "" + while { [ns_db getrow $db $selection] } { + set_variables_after_query + append result "\n" + } + return $result +} + + + + +# Do user1 and user2 share a common group? + +proc common_group_p { db user1 user2 } { + set selection [ns_db select $db "select group_id from users, user_group_map ug + where ug.user_id = $user1 and users.user_id = $user1 + intersect + select group_id from users, user_group_map ug + where ug.user_id = $user2 and users.user_id = $user2" ] + + set hits 0 + while { [ns_db getrow $db $selection] } { + set hits 1 + ns_db flush $db + break + } + + return $hits + +} + +proc ticket_notification_checkbox { var val desc} { + if {[string compare $val "t"] == 0} { + return " $desc" + } else { + return " $desc" + } +} + + +################################################################ + +proc ticket_get_group_id {db user_id} { + set groups [database_to_tcl_list $db "select group_id from user_group_map where user_id =$user_id"] + return [lindex $groups 0] +} + +################################################################ + +## Ticket search utilities + +# date entry widget that allows nulls + +proc ticket_dateentrywidget_with_nulls {column { value 0 } } { + ns_share NS + + if { $value == 0 } { + # no default, so use today + set value [lindex [split [ns_localsqltimestamp] " "] 0] + } + + set date_parts [split $value "-"] + if { $value == "" } { + set month "" + set day "" + set year "" + } else { + set date_parts [split $value "-"] + set month [lindex $date_parts 1] + set year [lindex $date_parts 0] + set day [lindex $date_parts 2] + } + + set output " + + " + + return $output +} + + +proc_doc ticket_search_fragments {} "Returns the standard seach form for tickets." { + uplevel { +return " + + + + + + + + + + +
    Query String: + + + + + +
    Ticket Title: + + + + + +
    Creator First Name (or Email): +Last Name:
    Assigned To (First Name or Email): +Last Name:
    Closed By (First Name or Email): +Last Name:
    Contact Name:
    Contact Info:
    Ticket ID#:
    + + + + + + + + +
    Ticket Type:Ticket Status:Project:Priority:Severity:
    + + +
    + + + + + + + + + + + + + +
    Creation Date: + + + + + + + + + +
    Greater than or equal to: [ticket_dateentrywidget_with_nulls creation_start [export_var creation_start]] Month-dd-yyyy
    Less than or equal to: [ticket_dateentrywidget_with_nulls creation_end [export_var creation_end]] Month-dd-yyyy
    +
    Modification Date: + + + + + + + + + +
    Greater than or equal to: [ticket_dateentrywidget_with_nulls modification_start [export_var modification_start]] Month-dd-yyyy
    Less than or equal to: [ticket_dateentrywidget_with_nulls modification_end [export_var modification_end]] Month-dd-yyyy
    +
    Close Date: + + + + + + + + + +
    Greater than or equal to: [ticket_dateentrywidget_with_nulls close_start [export_var close_start]] Month-dd-yyyy
    Less than or equal to: [ticket_dateentrywidget_with_nulls close_end [export_var close_end]] Month-dd-yyyy
    +
    +" + } +} + +proc_doc ticket_search_combine_and_build_error_list {} "For use with the ticket search. Combines date form fields and builds error list (exception_count, exception_text) for processing a search form." { + uplevel { + + if [catch { ns_dbformvalue [ns_conn form] creation_start date creation_start} errmsg ] { + incr exception_count + append exception_text "
  • Invalid date for beginning creation date." + } + + if [catch { ns_dbformvalue [ns_conn form] creation_end date creation_end} errmsg ] { + incr exception_count + append exception_text "
  • Invalid date for ending creation date." + } + + if [catch { ns_dbformvalue [ns_conn form] modification_start date modification_start} errmsg ] { + incr exception_count + append exception_text "
  • Invalid date for beginning modification date." + } + + if [catch { ns_dbformvalue [ns_conn form] modification_end date modification_end} errmsg ] { + incr exception_count + append exception_text "
  • Invalid date for ending modification date." + } + + if [catch { ns_dbformvalue [ns_conn form] close_start date close_start} errmsg ] { + incr exception_count + append exception_text "
  • Invalid date for beginning close date." + } + + if [catch { ns_dbformvalue [ns_conn form] close_end date close_end} errmsg ] { + incr exception_count + append exception_text "
  • Invalid date for ending close date." + } + } +} + +proc_doc ticket_search_build_where_clause_and_description {} "For use with ticket search. Build search_clause_list (where clauses), search_description_items (search criteria in English)." { + uplevel { + + set search_description_items [list] + set search_clause_list [list] + + # build a simple boolean expression + set text_query "" + set text_query_explanation "" + + + if { [info exists query_string_1] && ![empty_string_p $query_string_1] } { + append text_query "upper(dbms_lob.substr(indexed_stuff,4000)) like upper('%$QQquery_string_1%')" + append text_query_explanation "Ticket contains \"$query_string_1\"" + } + + if { [info exists conjunct_1] && [info exists conjunct_2] && ![empty_string_p $conjunct_1] && ![empty_string_p $query_string_2] } { + if { $conjunct_1 == "and" } { + append text_query "and upper(dbms_lob.substr(indexed_stuff,4000)) like upper('%$QQquery_string_2%')" + append text_query_explanation "and \"$query_string_2\"" + } elseif { $conjunct_1 == "or" } { + append text_query "or upper(dbms_lob.substr(indexed_stuff,4000)) like upper('%$QQquery_string_2%')" + append text_query_explanation "or \"$query_string_2\"" + } elseif { $conjunct_1 == "and_not" } { + append text_query "and upper(dbms_lob.substr(indexed_stuff,4000)) not like upper('%$QQquery_string_2%')" + append text_query_explanation "and not \"$query_string_2\"" + } + } + + if { [info exists conjunct_2] && [info exists query_string_3] && ![empty_string_p $conjunct_2] && ![empty_string_p $query_string_3] } { + if { $conjunct_2 == "and" } { + append text_query "and upper(dbms_lob.substr(indexed_stuff,4000)) like upper('%$QQquery_string_3%')" + append text_query_explanation "and \"$query_string_3\"" + } elseif { $conjunct_2 == "or" } { + append text_query "or upper(dbms_lob.substr(indexed_stuff,4000)) like upper('%$QQquery_string_3%')" + append text_query_explanation "or \"$query_string_3\"" + } elseif { $conjunct_2 == "and_not" } { + append text_query "and upper(dbms_lob.substr(indexed_stuff,4000)) not like upper('%$QQquery_string_3%')" + append text_query_explanation "and not \"$query_string_3\"" + } + } + + + + if {![empty_string_p $text_query]} { + lappend search_clause_list "( $text_query )" + lappend search_description_items $text_query_explanation + } + + + # build a simple boolean expression for title query + set text_query "" + set text_query_explanation "" + + if { [info exists title_string_1] && ![empty_string_p $title_string_1] } { + append text_query "upper(one_line) like upper('%$QQtitle_string_1%')" + append text_query_explanation "Ticket title contains \"$title_string_1\"" + } + + if { [info exists title_conjunct_1] && [info exists title_string_2] && ![empty_string_p $title_conjunct_1] && ![empty_string_p $title_string_2] } { + if { $title_conjunct_1 == "and" } { + append text_query "and upper(one_line) like upper('%$QQtitle_string_2%')" + append text_query_explanation "and \"$title_string_2\"" + } elseif { $title_conjunct_1 == "or" } { + append text_query "or upper(one_line) like upper('%$QQtitle_string_2%')" + append text_query_explanation "or \"$title_string_2\"" + } elseif { $title_conjunct_1 == "and_not" } { + append text_query "and upper(one_line) not like upper('%$QQtitle_string_2%')" + append text_query_explanation "and not \"$title_string_2\"" + } + } + + if { [info exists title_conjunct_2] && [info exists title_string_3] && ![empty_string_p $title_conjunct_2] && ![empty_string_p $title_string_3] } { + if { $title_conjunct_2 == "and" } { + append text_query "and upper(one_line) like upper('%$QQtitle_string_3%')" + append text_query_explanation "and \"$title_string_3\"" + } elseif { $title_conjunct_2 == "or" } { + append text_query "or upper(one_line) like upper('%$QQtitle_string_3%')" + append text_query_explanation "or \"$title_string_3\"" + } elseif { $title_conjunct_2 == "and_not" } { + append text_query "and upper(one_line) not like upper('%$QQtitle_string_3%')" + append text_query_explanation "and not \"$title_string_3\"" + } + } + + if {![empty_string_p $text_query]} { + lappend search_clause_list "( $text_query )" + lappend search_description_items $text_query_explanation + } + + + # search by creator first name + if { [info exists creator_fname] && ![empty_string_p $creator_fname] } { + lappend search_clause_list "(lower(users.email) like '[string tolower [DoubleApos $creator_fname]]%' or lower(users.first_names) like '[string tolower [DoubleApos $creator_fname]]%')" + lappend search_description_items "Creator first name or email starts with \"$creator_fname\"" + } + + # search by creator last name + if { [info exists creator_lname] && ![empty_string_p $creator_lname] } { + lappend search_clause_list "(lower(users.last_name) like '[string tolower [DoubleApos $creator_lname]]%')" + lappend search_description_items "Creator last name starts with \"$creator_lname\"" + } + + # search by closer first name + if { [info exists closer_fname] && ![empty_string_p $closer_fname] } { + lappend search_clause_list "(lower(closer.email) like '[string tolower [DoubleApos $closer_fname]]%' or lower(closer.first_names) like '[string tolower [DoubleApos $closer_fname]]%')" + lappend search_description_items "Closer first name or email starts with \"$closer_fname\"" + } + + # search by closer last name + if { [info exists closer_lname] && ![empty_string_p $closer_lname] } { lappend search_clause_list "(lower(closer.last_name) like '[string tolower [DoubleApos $closer_lname]]%')" + lappend search_description_items "Closer last name starts with \"$closer_lname\"" + } + + # search by assignee first name + if { [info exists assigned_fname] && ![empty_string_p $assigned_fname] } { + lappend search_description_items "Assigned first name or email starts with \"$assigned_fname\"" + } + + # search by assignee last name + if { [info exists assigned_lname] && ![empty_string_p $assigned_lname] } { + lappend search_description_items "Assigned last name starts with \"$assigned_lname\"" + } + + + if { [info exists contact_name] && ![empty_string_p $contact_name] } { + lappend search_clause_list "(lower(contact_name) like '%[string tolower [DoubleApos $contact_name]]%')" + lappend search_description_items "Contact name contains \"$contact_name\"" + } + + if { [info exists contact_info] && ![empty_string_p $contact_info] } { lappend search_clause_list "(lower(contact_info1) like '%[string tolower [DoubleApos $contact_info]]%')" + lappend search_description_items "Contact info contains \"$contact_info\"" + } + + # ticket id + if { [info exists ticket_id] && ![empty_string_p $ticket_id] } { + lappend search_clause_list "msg_id = $ticket_id" + lappend search_description_items "Ticket # equals \"'[DoubleApos $ticket_id]'\"" + } + + # ticket type + if { [info exists ticket_type] && ![empty_string_p $ticket_type]} { + set ticket_types [util_GetCheckboxValues [ns_getform] ticket_type] + if {$ticket_types != 0} { + foreach _tt $ticket_types { + lappend ticket_type_list "ticket_type = '[DoubleApos $_tt]'" + } + lappend search_clause_list "([join $ticket_type_list { or }])" + lappend search_description_items "Ticket type is one of [join $ticket_types {, }]" + } + } + + # ticket status + if { [info exists status] && ![empty_string_p $status]} { + set ticket_states [util_GetCheckboxValues [ns_getform] status] + if {$ticket_states != 0} { + foreach _tt $ticket_states { + lappend ticket_status_list "status = '[DoubleApos $_tt]'" + } + lappend search_clause_list "([join $ticket_status_list { or }])" + lappend search_description_items "Ticket status is one of [join $ticket_states {, }]" + } + } + + # project id + if { [info exists project_id] && ![empty_string_p $project_id]} { + set project_id_list [util_GetCheckboxValues [ns_getform] project_id] + if {$project_id_list != 0} { + foreach _tt $project_id_list { + lappend ticket_project_id_list "ticket_issues.project_id = '[DoubleApos $_tt]'" + } + lappend search_clause_list "([join $ticket_project_id_list { or }])" + lappend search_description_items "Ticket project_id is one of [join $project_id_list {, }]" + } + } + + # priority + if { [info exists priority] && ![empty_string_p $priority]} { + set priorities [util_GetCheckboxValues [ns_getform] priority] + if {$priorities != 0} { + foreach _tt $priorities { + lappend ticket_priority_list "ticket_issues.priority = '[DoubleApos $_tt]'" + } + lappend search_clause_list "([join $ticket_priority_list { or }])" + lappend search_description_items "Ticket priority is one of [join $priorities {, }]" + } + } + + # severity + if { [info exists severity] && ![empty_string_p $severity]} { + set severity_list [util_GetCheckboxValues [ns_getform] severity] + if {$severity_list != 0} { + foreach _tt $severity_list { + lappend ticket_severity_list "ticket_issues.severity = '[DoubleApos $_tt]'" + } + lappend search_clause_list "([join $ticket_severity_list { or }])" + lappend search_description_items "Ticket severity is one of [join $severity_list {, }]" + } + } + + + + # Creation date + if { [info exists creation_start ] && ![empty_string_p $creation_start] } { + lappend search_clause_list "trunc(posting_time) >= '$creation_start'" + lappend search_description_items "Creation date after \"$creation_start\"" + } + + if { [info exists creation_end ] && ![empty_string_p $creation_end] } { + lappend search_clause_list "trunc(posting_time) <= '$creation_end'" + lappend search_description_items "Creation date before \"$creation_end\"" + } + + # Modification date + if { [info exists modification_start ] && ![empty_string_p $modification_start] } { + lappend search_clause_list "trunc(modification_time) >= '$modification_start'" + lappend search_description_items "Modification date after \"$modification_start\"" + } + + if { [info exists modification_end ] && ![empty_string_p $modification_end] } { + lappend search_clause_list "trunc(modification_time) <= '$modification_end'" + lappend search_description_items "Modification date before \"$modification_end\"" + } + + # Close date + if { [info exists close_start ] && ![empty_string_p $close_start] } { + lappend search_clause_list "trunc(close_date) >= '$close_start'" + lappend search_description_items "Close date after \"$close_start\"" + } + + if { [info exists close_end ] && ![empty_string_p $close_end] } { + lappend search_clause_list "trunc(close_date) <= '$close_end'" + lappend search_description_items "Close date before \"$close_end\"" + } + } +} + +################################################################ + +################################################################ +# Send notification email +# +# Send email, with message regarding a ticket, to interested parties. +# This includes any users assigned to the ticket, as well as +# optionally the ticket author. + +proc send_ticket_change_notification {db msg_id message user_id notify_creator_p} { + + set ticket_email [ticket_reply_email_addr] + set extra_headers [ns_set create] + ns_set update $extra_headers "Reply-to" $ticket_email + + set selection [ns_db 1row $db "select one_line, title, ticket_issues.project_id, notify_p + from ticket_issues, ticket_projects + where ticket_issues.project_id = ticket_projects.project_id + and msg_id = $msg_id"] + set_variables_after_query + + + set selection [ns_db 1row $db "select + first_names || ' ' || last_name as poster_name, + email as poster_email from users + where user_id=$user_id"] + set_variables_after_query + + set selection [ns_db select $db "select + email as notify_email + from users, ticket_assignments + where project_id = $project_id + and users.user_id = ticket_assignments.user_id + and active_p = 't'"] + +# set url "[ns_conn location]/ticket" +# cant use ns_conn in scheduled proc! JCD + set url "[ad_url]/ticket" + + set msg_subject "New response to $one_line in project $title (TR#$msg_id)" + set msg_content "Submitted By: $poster_name +Description: $message + +Please use the URL below to manage this issue: + +$url/issue-view.tcl?msg_id=$msg_id + +" + + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_sendmail $notify_email $poster_email $msg_subject $msg_content $extra_headers + } + # find the email address of the creator of the ticket + if {$notify_creator_p == "t"} { + set selection [ns_db 1row $db "select + users.email as creator_email from users, ticket_issues + where users.user_id=ticket_issues.user_id + and msg_id = $msg_id"] + set_variables_after_query + ns_sendmail $creator_email $poster_email $msg_subject $msg_content $extra_headers + } +} + +proc min { n1 n2 } { + if {$n1 < $n2} { + return $n1 + } else { + return $n2 + } +} +################################################################ + + + +# util for sorting by fields in ticket listing +proc toggle_order {field order_by} { + if [string match "*desc" $order_by] { + return $field + } else { + return "$field+desc" + } +} + + +# Format an integer as a blank if it is zero (to clean up large tables) +proc blank_zero {n} { + if {$n == 0} { + return "" + } else { + return $n + } +} + +################################################3333 +# +# picklist stuff + +# default to returning a single custom data field for the "software build" +proc ticket_picklist_data {} { + set val [ad_parameter_all_values_as_list PicklistData ticket] + if { [empty_string_p $val] || [llength $val] == 0 } { + return {{build "Build" text data4 25}} + } else { + return $val + } +} + +# Util for displaying controls on ticket personal home page +# +# Displays a list of vars with a single one removed +# + +proc ticket_control_vars {varname toggle_val vars msg {url ""}} { + if {[empty_string_p $url]} { + set url "index.tcl" + } + # Create a list of $vars with $var removed + set lpos [lsearch $vars $varname] + set _ctrl_vars [lreplace $vars $lpos $lpos] + upvar $varname var + + if { [info exists var] && $var == $toggle_val } { + return "$msg" + } else { + return "$msg\n" + } + +} + + +################################################3333 +# +# Set a daemon to nag users who have open tickets which are +# past their deadlines + +proc notify_overdue_tickets {} { + # days between notifcations + set nag_period 7 + # We do *not* want bounced messages going to the ticket handler script + set maintainer_email [ad_system_owner] + set url "[ad_url]/ticket" + + + set db_pools [ns_db gethandle subquery 2] + set db [lindex $db_pools 0] + set db2 [lindex $db_pools 1] + + set notified_msg_ids {} + + # loop over each user who has any assigned tickets, + # finding all past-deadline tickets + set selection [ns_db select $db "select distinct ua.user_id, ua.email + from users_alertable ua, ticket_issue_assignments, users_preferences + where ticket_issue_assignments.user_id = ua.user_id + and ua.user_id = users_preferences.user_id + and users_preferences.dont_spam_me_p = 'f' + and ticket_issue_assignments.active_p = 't'"] + + if {[empty_string_p $selection]} { + return + } + + while { [ns_db getrow $db $selection] } { + # For each user, find all past-due tickets, and make a summary message + set msgs "" + set_variables_after_query + + set sub_selection [ns_db select $db2 "select + ti.msg_id, ti.one_line as summary, + to_char(ti.modification_time, 'mm/dd/yy') as modification, + to_char(ti.posting_time, 'mm/dd/yy') as creation, + to_char(ti.deadline, 'mm/dd/yy') as deadline + from ticket_issues ti, ticket_issue_assignments ta + where + ti.msg_id = ta.msg_id + and ta.user_id = $user_id + and ta.active_p = 't' + and close_date is null + and (last_notification is null or (sysdate() - last_notification) > 7) + and deadline is not null and deadline < sysdate()"] + + while { [ns_db getrow $db2 $sub_selection] } { + set_variables_after_subquery + append msgs "Issue #$msg_id $summary\ndeadline was $deadline, created $creation, last modified $modification\n$url/issue-view.tcl?msg_id=$msg_id\n\n" + lappend notified_msg_ids $msg_id + } + + if {$msgs != ""} { + set msgbody "The following issues assigned to you are still open and past their deadline:" + append msgbody "\n\n$msgs" + + set extra_headers [ns_set create] + ns_set update $extra_headers "Reply-to" $maintainer_email + ns_sendmail $email $maintainer_email \ + "Notification: Past due issues assigned to you" \ + $msgbody $extra_headers + ns_log Notice "sending ticket deadline alert email to $user_id $email" + + } + } + # update timestamp for these messages as having been notified + if {[llength $notified_msg_ids] > 0} { + ns_db dml $db "update ticket_issues set last_notification = sysdate() where msg_id in ([join $notified_msg_ids {,}])" + } + +} + +################################################################ +# Scan for messages past deadline, and send alerts, once per day +# +# Notifications will only be sent once a week (as specified above) +# for a given ticket and user, but the queue is scanned daily for +# past-deadline tickets. + +ns_share -init {set overdue_ticket_alerts_installed 0} overdue_ticket_alerts_installed + +if {!$overdue_ticket_alerts_installed} { + set overdue_ticket_alerts_installed 1 + ns_log Notice "Scheduling notify_overdue_tickets" + ns_schedule_daily -thread 3 30 notify_overdue_tickets +} + +################################################################ +# Email queue handler + +# We depend on there being a default system user, in case we cannot +# deduce the user_id from the incoming email message. +# +# We also use (or create) a project named "incoming" to exist so we can +# place new issues there. +# + + +proc ticket_process_message {db message} { + # We do *not* want bounced messages going to the ticket handler script + set maintainer_email [ad_system_owner] + + # "medium" priority + set default_priority 2 + + # extract the headers + set from_addr "" + set date "" + set subject "" + set msgbody "" + set msg_id "" + set reply_to "" + + # We want to grab headers for + # Date: Thu, 11 Mar 1999 01:42:24 -0500 + # From: Henry Minsky + # Subject: Re: test message + + set parsed_msg [parse_email_message $message] + + set msgbody [ns_set iget $parsed_msg "message_body"] + set from_header [ns_set iget $parsed_msg "from"] + set subject_header [ns_set iget $parsed_msg "subject"] + set date_header [ns_set iget $parsed_msg "date"] + set reply_to [ns_set iget $parsed_msg "reply-to"] + + # look for address of form "From: foo@bar.com + if {![regexp -nocase "(\[A-Za-z0-9._/%&!-\]+@\[A-Za-z0-9.-\]+)" $from_header from_line from_addr]} { + regexp -nocase "(\[^<\]*)<(\[A-Za-z0-9._/%&!-\]+@\[A-Za-z0-9.-\]+)" $from_header from_line from_name from_addr + } + + if {[empty_string_p $from_addr]} { + ns_log Notice "process_ticket_message could not parse from_addr from incoming message header: |$from_header| message=|$message|" + return + } + set subject $subject_header + set subject_line "Subject: $subject_header" + + # Try to parse out a message id of the form "(TR#XXX)" + regexp {TR#([0-9]*)} $subject_header match msg_id + set date_line "Date: $date_header" + + + # Make a cleaner looking mail message, just reconstruct a couple of the headers + append msgtext "From: $from_header\n" + if {![empty_string_p $reply_to]} { + append msgtext "Reply-to: $reply_to\n" + } + append msgtext "$subject_line\n" + append msgtext "$date_line\n" + append msgtext "\n$msgbody" + + # We try to look up a user, based on their email address + + set user_id [database_to_tcl_string_or_null $db "select user_id from users where lower(email) = '[string tolower $from_addr]'"] + + # We need to have some default user_id we can use as the author of a ticket + # if we can't guess the user id from the email message. + # Here we try to find a "system" user: + if {[empty_string_p $user_id]} { + set user_id [default_ticket_admin_user $db] + ns_log Notice "Could not find registered user $from_addr, using user_id=$user_id" + } + + if {[empty_string_p $user_id]} { + ns_sendmail [ad_system_owner] [ticket_reply_email_addr] "Could not find a good user id to use." "Could not deduce user id from email address, and could not find a default system user\n$msgbody" + return + } + + # Try to find a group associated with this user, to tag the + # ticket with. + set group_id_list [database_to_tcl_list $db "select umap.group_id + from user_group_map umap, user_groups ug + where umap.user_id = $user_id + and ug.group_id = umap.group_id"] + + # we'll take the first group we find + set group_id [lindex $group_id_list 0] + + set url "[ad_url]/ticket" + + # If msg_id is empty, then assume user is posting a new ticket. + # Otherwise try to add this as a response to the existing ticket. + + set new_msg_p 0 + + if {[empty_string_p $msg_id]} { + # We are creating a new ticket + set new_msg_p 1 + + # Get or create the project named "incoming", to hold the new ticket + set default_project_id [get_default_incoming_email_project_id $db] + + set message_in_html "
    [clean_up_html $msgtext]
    " + set indexed_stuff "$subject $msgtext $from_addr" + + # Create a new ticket + set new_id [database_to_tcl_string $db "select ticket_issue_id_sequence.nextval from dual"] + + ns_log Notice "creating new ticket id $new_id for message $message_in_html" + + ns_ora clob_dml $db "insert into ticket_issues + (msg_id,project_id,user_id,group_id,status, ticket_type, severity, one_line,message,indexed_stuff,posting_time,priority, notify_p, deadline) + values ($new_id,$default_project_id,$user_id,'$group_id','open', 'Ticket', 'normal','[DoubleApos $subject]',empty_clob(),empty_clob(),sysdate(),$default_priority,'t', '') + returning message, indexed_stuff into :1, :2" $message_in_html $indexed_stuff + } else { + set selection [ns_db 0or1row $db "select one_line, title, ticket_issues.project_id, notify_p + from ticket_issues, ticket_projects + where ticket_issues.project_id = ticket_projects.project_id + and msg_id = $msg_id"] + if {[empty_string_p $selection]} { + set new_msg_p 1 + } else { + set_variables_after_query + set message_in_html "
    \n[clean_up_html $msgtext]\n
    " + ns_log Notice "adding response for msg_id $msg_id: $message_in_html" + set new_response_id [database_to_tcl_string $db "select ticket_response_id_sequence.nextval from dual"] + ns_ora clob_dml $db "insert into ticket_issue_responses (response_id,response_to,user_id,message,posting_time) values ($new_response_id,$msg_id,$user_id,empty_clob(),sysdate()) returning message into :1" $message_in_html + ns_db dml $db "begin ticket_update_for_response($new_response_id); end;" + } + } + + # If this is a new ticket, send email to the originator with a URL + # containing the new ticket number, so they can follow changes from the web, + # and send notification to project members who are signed up for notification. + # + # else this is a followup, so notify assigned project members that a + # followup has come in to an existing ticket. + + if {$new_msg_p} { + set extra_headers [ns_set create] + ns_set update $extra_headers "Reply-to" [ticket_reply_email_addr] + ns_sendmail $from_addr $maintainer_email "$subject (TR\#$new_id)" "Submitted By: $from_addr + Thank you for entering a new ticket. + Description: $msgtext + + Please use $url/issue-view.tcl?msg_id=$new_id to manage this issue." $extra_headers + } else { + if { $notify_p == "t" } { + set extra_headers [ns_set create] + ns_set update $extra_headers "Reply-to" [ticket_reply_email_addr] + + set selection [ns_db 1row $db "select first_names || '' || last_name as poster_name, + email as poster_email from users + where user_id=$user_id"] + set_variables_after_query + + set selection [ns_db select $db "select + email as notify_email + from users, ticket_assignments + where project_id = $project_id + and users.user_id = ticket_assignments.user_id + and active_p = 't'"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_sendmail $notify_email $maintainer_email "New response to $one_line in project $title (TR\#$msg_id)" "Submitted By: $from_addr + Description: $msgtext + + Please use $url/issue-view.tcl?msg_id=$msg_id to manage this issue." $extra_headers + } + } + } +} + + +# Try to find or create a project named "Incoming", in which to create new +# issues which are not responses to an existing ticket. +proc get_default_incoming_email_project_id {db} { + return [get_project_named $db "Incoming" 1] +} + + +# Attempt to find a default system user - looks for the user_id of the +# system maintainer +# returned by [ad_system_owner] +proc find_default_system_user {db} { + set user_id "" + set selection [ns_db select $db "select user_id from users where email = '[ad_system_owner]'"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + } + return $user_id +} + +# Update the last_modified field on a ticket. This must be done +# before other things are modified in a ticket, because the +# audit trail trigger in PL/SQL looks at the last_modified_by +# field in order to know to whom to attribute changes in other +# ticket fields to. +proc update_last_modified_info {db msg_id} { + # get current user's email, to export as the "last modified by" value + set email [database_to_tcl_string $db "select email from users where user_id=[ad_get_user_id]"] + ns_db dml $db "update ticket_issues set last_modified_by = '[DoubleApos $email]' where msg_id = $msg_id" +} + + +################################################################## +# +# interface to the ad-new-stuff.tcl system + +ns_share ad_new_stuff_module_list + +if { ![info exists ad_new_stuff_module_list] || [util_search_list_of_lists $ad_new_stuff_module_list [ticket_system_name] 0] == -1 } { + lappend ad_new_stuff_module_list [list [ticket_system_name] ticket_new_stuff] +} + + +proc_doc ticket_new_stuff {db since_when only_from_new_users_p purpose} "Only produces a report for the site administrator; the assumption is that random users won't want to see trouble tickets" { + if { $purpose != "site_admin" } { + return "" + } + if { $only_from_new_users_p == "t" } { + set users_table "users_new" + } else { + set users_table "users" + } + set query "select ti.msg_id, ti.one_line, ut.email +from ticket_issues ti, $users_table ut +where posting_time > '$since_when' +and ti.user_id = ut.user_id +" + set result_items "" + set selection [ns_db select $db $query] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + append result_items "
  • $one_line (from $email)" + } + if { ![empty_string_p $result_items] } { + return "
      \n\n$result_items\n
    \n" + } else { + return "" + } +} + +################################################################## +# +# interface to the ad-user-contributions-summary.tcl system + +ns_share ad_user_contributions_summary_proc_list + +if { ![info exists ad_user_contributions_summary_proc_list] || [util_search_list_of_lists $ad_user_contributions_summary_proc_list [ticket_system_name] 0] == -1 } { + lappend ad_user_contributions_summary_proc_list [list [ticket_system_name] ticket_user_contributions 0] +} + +proc_doc ticket_user_contributions {db user_id purpose} {Returns list items, one for each bboard posting} { + if { $purpose != "site_admin" } { + return [list] + } + set selection [ns_db 0or1row $db "select + count(tia.msg_id) as total, + sum(case when status = 'closed' then 1 else 0 end) as closed, + sum(case when status = 'closed' then 0 + when status = 'deferred' then 0 + when status = NULL then 0 else 1 end) as open, + sum(case when status = 'deferred' then 1 else 0 end) as deferred, + max(modification_time) as lastmod, + min(posting_time) as oldest, + sum(ticket_one_if_high_priority(priority, status)) as high_pri, + sum(ticket_one_if_blocker(severity, status)) as blocker +from ticket_issues ti, ticket_issue_assignments tia +where tia.user_id = $user_id +and ti.msg_id = tia.msg_id"] + if { [empty_string_p $selection] } { + return [list] + } + set_variables_after_query + if { $total == 0 } { + return [list] + } + set items "
  • Total tickets: $total ($closed closed; $open open; $deferred deferred) +
  • Last modification: [util_AnsiDatetoPrettyDate $lastmod] +
  • Oldest: [util_AnsiDatetoPrettyDate $oldest] +

    +Details: view the tickets\n" + return [list 0 [ticket_system_name] "

      \n\n$items\n\n
    "] +} + + +util_report_successful_library_load + Index: web/openacs/tcl/ticket-todo-plugin.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/ticket-todo-plugin.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/ticket-todo-plugin.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,102 @@ +## +## This implements the Ticket to todo link +## +## ben@adida.net + +ns_schedule_proc -once 1 ticket_todoplugin_register + +# The proc to register the Ticket todo plugin +proc ticket_todoplugin_register {} { + set data [ns_set new -persist ticket_todoplugin_data] + ns_set put $data GET_PERSONAL_CATEGORIES ticket_todoplugin_get_personal_categories + ns_set put $data GET_OTHER_CATEGORIES ticket_todoplugin_get_other_categories + ns_set put $data ITEM_CHANGE_ALLOWED_P 0 + ns_set put $data MARK_COMPLETED_ALLOWED_P 1 + ns_set put $data MARK_COMPLETED ticket_todoplugin_mark_completed + ns_set put $data MARK_UNCOMPLETED ticket_todoplugin_mark_uncompleted + ns_set put $data ONE_ITEM_URL [ticket_url_stub]/issue-view.tcl + ns_set put $data ONE_ITEM_ID_KEY msg_id + ns_set put $data ITEM_LIST_SQL ticket_todoplugin_item_list_sql + + # actually register + todo_plugin_register Ticket $data +} + +# Getting the personal categories +proc ticket_todoplugin_get_personal_categories {db user_id} { + set categories [database_to_tcl_list_list $db " + select project_id, title from ticket_projects where ticket_user_can_see_project_p($user_id, project_id)='t'"] + + return $categories +} + +# Getting other categories +proc ticket_todoplugin_get_other_categories {db user_id} { + return [list] +} + +# When an item is done +# This just redirects to the right location +# and returns a flag saying that no more information should be returned +proc ticket_todoplugin_mark_completed {db user_id todo_id {completion_date {}}} { + ns_returnredirect [ticket_url_stub]/issue-fix.tcl?msg_id=$todo_id + + # A boolean of true means everything has been done and the + # calling page should do nothing more. + return 1 +} + +proc ticket_todoplugin_mark_uncompleted {db user_id todo_id {completion_date {}}} { + + ns_db dml $db "update ticket_issues set status='open', fixed_release_id=NULL, fix_date=NULL where msg_id=$todo_id and ticket_user_can_edit_project_p($user_id, project_id)='t'" + + # A boolean of true means everything has been done and the + # calling page should do nothing more. + return 0 +} + + +# This should return the SQL +# to select the stuff out of the database +proc ticket_todoplugin_item_list_sql {db user_id category_id date_predicates date_prettifier n_days_to_show_completed_items completion_status order_by} { + + set due_date "deadline" + + set list_of_predicates [list] + + if {$date_predicates != ""} { + lappend list_of_predicates [subst $date_predicates] + } + + if {$category_id != ""} { + lappend list_of_predicates "ticket_projects.project_id=$category_id" + } + + if {$completion_status == "open"} { + lappend list_of_predicates "fix_date is null" + } + + if {$completion_status == "closed"} { + lappend list_of_predicates "fix_date is not null" + } + + lappend list_of_predicates "ticket_projects.project_id= ticket_issues.project_id" + lappend list_of_predicates "ticket_issues.msg_id= ticket_issue_assignments.msg_id" + lappend list_of_predicates "ticket_issue_assignments.user_id= $user_id" + lappend list_of_predicates "ticket_issues.close_date is null" + + set sql " + select + 'Ticket' as plugin, ticket_projects.project_id as category_id, ticket_projects.title as category, + 1 as priority, ${date_prettifier}($due_date) as due_date, todo_interval_min($due_date) as raw_due_date, + ''::varchar as assigned_by, + ticket_issues.msg_id as todo_id, ticket_issues.one_line as item_details, ticket_issues.fix_date as completion_date + from + ticket_issues, ticket_issue_assignments, ticket_projects + where + [join $list_of_predicates " and "]" + + return $sql +} + + Index: web/openacs/tcl/todo-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/todo-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/todo-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,499 @@ + +proc todo_system_name {} { + return [ad_parameter SystemName todo] +} + +proc todo_url_stub {} { + return [ad_parameter UrlStub todo] +} + +proc todo_administrator {} { + return [ad_parameter Administrator todo] +} + +proc todo_header {title} { + set return_url [ns_conn url]?[ns_conn query] + + set return_string "[ad_header $title]" + + # Check if items to delete + set db [ns_db gethandle subquery] + set count_check [database_to_tcl_string $db "select count(*) from deleted_todo_items where [ad_get_user_id]=(select user_id from todo_lists where list_id=deleted_todo_items.list_id)"] + ns_db releasehandle $db + + if {$count_check > 0} { + set extra_right_link "deleted items
    [help_link]" + } else { + set extra_right_link "[help_link]" + } + + + if {[ns_conn url] != "/todo/preferences.tcl"} { + append return_string " + + +
    edit preferences
    +$extra_right_link
    " + } + + return $return_string +} + +proc_doc todo_help_header { title } { Returns a help header for Todo. } { + return "[ad_header $title] +

    $title

    +Return to Todo +
    +" +} + +proc todo_footer {} { + return "[ad_footer]" +} + +# +# Simple user information management +## +proc set_simple_user_information {db} { + uplevel { + set user_id [ad_verify_and_get_user_id] + + set user_logged_on_p 0 + + if {$user_id > 0} { + set selection [ns_db 1row $db "select first_names, last_name, email from users where user_id=$user_id"] + set_variables_after_query + set user_logged_on_p 1 + } + } +} + + +ns_share -init {set ad_todo_security_filters_installed 0} ad_todo_security_filters_installed + +if {!$ad_todo_security_filters_installed} { + set ad_todo_security_filters_installed 1 + # Bounce people out of the /sdm/pvt directory if they're not logged in + ns_register_filter preauth GET /todo/* ad_verify_identity + ns_register_filter preauth POST /todo/* ad_verify_identity +} + + +proc user_can_access_list_p {db user_id list_id} { + set check [database_to_tcl_string $db "select user_can_access_list_p($user_id,$list_id) from dual"] + + if {$check == "t"} { + return 1 + } else { + return 0 + } +} + +proc todo_return_access_complaint {} { + ns_return 500 text/html "[todo_header "Access Violation"] +

    Access Violation

    +

    + You are not allowed to view this information, either because you are not logged on, or if you are, because this information is private and you are not authorized. +

    + [todo_footer] +" +} + +proc todo_set_user_preferences {db user_id} { + uplevel { + set selection [ns_db 0or1row $db "select old_item_expire, COALESCE(time_offset,0) as time_offset, COALESCE(personal_midnight,0) as personal_midnight, sort_by, notification_interval, separate_completed_items_p from todo_user_preferences where user_id=$user_id"] + + if {$selection == "" } { + ns_db dml $db "insert into todo_user_preferences (user_id) VALUES ($user_id)" + todo_set_user_preferences $db $user_id + } + + set_variables_after_query + + # Why was this here? (BMA) + # set sort_by [subst $sort_by] + } +} + +proc todo_daily_sweep {} { + set db [ns_db gethandle] + + # The -0.01 is for slight inconsistencies in times that the proc runs + set user_ids [database_to_tcl_list $db "select user_id from todo_user_preferences where notification_interval>0 and (sysdate()>=(last_notification+notification_interval-0.01) or last_notification is NULL)"] + + foreach user_id $user_ids { + ns_log Notice "doing email for user_id $user_id" + + set notification_interval [database_to_tcl_string $db "select notification_interval from todo_user_preferences where user_id=$user_id"] + + set selection [ns_db select $db "select list_name, item_id, first_names as assigned_by_first_names, todo_lists.list_id as list_id, completion_date, pretty_relative_date(todo_items.due_date, 0) as pretty_relative_due_date, todo_days_from_pretty(pretty_relative_date(todo_items.due_date,0)) as n_days, substr(item_details,0,60) as short_item_details, item_details, priority from todo_items, todo_lists, users where todo_items.assigned_by=users.user_id(+) and todo_items.list_id= todo_lists.list_id and (same_day_p(todo_items.due_date,sysdate(), 0)='t' or todo_items.due_date<(sysdate()+$notification_interval)) and todo_lists.user_id=$user_id and (completion_date is NULL)"] + + set things_to_do_text "" + + while {[ns_db getrow $db $selection]} { + set_variables_after_query + + append things_to_do_text "- ($priority) $pretty_relative_due_date, for $list_name: $item_details\n" + } + + set email [database_to_tcl_string $db "select email from users where user_id=$user_id"] + + if {[catch { + if {[string length $things_to_do_text] > 0} { + ns_log Notice "sending the email" + ns_sendmail "$email" "ben@openforce.net" "Things to do" " + In the next $notification_interval day(s), you have the following things to do +\n +$things_to_do_text +\n\n +-ToDo Manager" +} +} errmsg]} { + ns_log Notice "error: $errmsg" +} else { + ns_db dml $db "update todo_user_preferences set last_notification=sysdate() where user_id=$user_id" +} +} + +ns_db releasehandle $db + +} + + + +## A procedure to output things consistently +## for list of todos +proc todo_one_item_form {submit_tag} { + set db [ns_db gethandle subquery] + + set list_of_dates [database_to_tcl_list_list $db "select days,pretty_date from relative_date_pretty_text where days>=0 or days is NULL order by days"] + + set string " + +[make_html_select priority {1 2 3 4 5}] +[make_html_select n_days $list_of_dates] + + + +" + +ns_db releasehandle $db + +return $string + +} + +# The list of headers for the front page +proc todo_delete_list_of_headers {} { + return { + {priority Priority} + {list_name List} + {short_details Details} + {deletion_date {Deletion Date}} + } +} + +proc todo_general_list_of_headers {} { + return { + {priority Priority} + {list_name List} + {item_details Details} + {assigned_by_first_names {Assigned by}} + } +} + +proc todo_general_plugin_list_of_headers {} { + return { + {priority Priority} + {category Category} + {item_details Details} + {assigned_by {Assigned by}} + } +} + +# List of specific stuff +proc todo_specific_list_of_headers {} { + return { + {priority Priority} + {pretty_relative_due_date {Due Date}} + {item_details Details} + {assigned_by_first_names {Assigned by}} + } +} + +proc todo_plugin_list_of_headers {} { + return { + {priority Priority} + {due_date {Due Date}} + {item_details Details} + {assigned_by {Assigned By}} + } +} + +## The table headers +proc todo_list_html_header {list_of_headers} { + set return_html "\n" + foreach header $list_of_headers { + append return_html "[lindex $header 1]" + } + append return_html "Actions\n" + + return $return_html +} + + +# The tabs for open or closed items +proc todo_openclosed_tabs {view_open_items} { + if {$view_open_items == ""} { + return "" + } + + set current_url [ns_conn url]?[export_ns_set_vars url view_open_items [ns_getform]] + + set return_html "" + + if {$view_open_items == "f"} { + append return_html "" + } else { + append return_html "" + } + + append return_html "
    OpenClosedOpenClosed
    " + + return $return_html +} + +# The list_of_headers is a list of list +# with first the sql name, second the pretty name. +proc todo_list_html {db sql current_url list_of_headers {extra_rows {}} {item_id_to_edit {}} {view_open_items ""}} { + + if {[string first "?" $current_url] == -1} { + set current_url "$current_url?" + } + + set return_url "$current_url" + + ## Build the header stuff + # + set return_header "" + set always_header "" + + if {$view_open_items != ""} { + append always_header "" + if {$view_open_items == "t"} { + regsub " todo_items " $sql " open_todo_items todo_items " sql + + append always_header "" + } else { + regsub " todo_items " $sql " closed_todo_items todo_items " sql + + append always_header "" + } + append always_header "
    OpenClosedOpenClosed
    \n" + } else { + # Fix so we only see the undeleted ones + regsub " todo_items " $sql " viewable_todo_items todo_items " sql + } + + append return_header "\n\n" + foreach header $list_of_headers { + append return_header "" + } + append return_header "\n" + + set return_string "" + + ## Do the query + # + set selection [ns_db select $db $sql] + + while {[ns_db getrow $db $selection]} { + set_variables_after_query + + if {$item_id_to_edit == $item_id} { + append return_string " + [export_form_vars item_id return_url] + [bt_mergepiece [todo_one_item_form "edit"] $selection] + \n" + continue + } + + set one_row "\n" + + # In case it's completed + if {$completion_date == ""} { + set pre_item "" + set post_item "" + set actions_html "" + } else { + set pre_item "" + set post_item "" + set return_url $current_url + set actions_html "" + } + + # If item is deleted, totally change the action + if {[info exists deletion_date] && $deletion_date!=""} { + set return_url $current_url + set actions_html "" + } + + foreach header $list_of_headers { + # Special case for list name + if {[lindex $header 0] == "list_name"} { + append one_row "" + continue + } + + # Special case for item details + if {[lindex $header 0] == "item_details"} { + if {[string length $item_details] > 100} { + append one_row "" + continue + } + } + + if {[lindex $header 0] == "priority"} { + append one_row "" + continue + } + + append one_row "" + } + + append one_row "$actions_html\n" + + append return_string $one_row + } + + if {$item_id_to_edit == ""} { + append return_string "$extra_rows" + } + + if {$return_string == ""} { + return "$always_header\n no items" + } else { + set return_string "$always_header\n $return_header\n$return_string" + } + + append return_string "
    [lindex $header 1]Actions
    edit undelete$pre_item$list_name$post_item$pre_item [string range $item_details 0 100]... (more) $post_item$pre_item($priority)$post_item$pre_item[set [lindex $header 0]]$post_item
    " + + if {$item_id_to_edit != ""} { + append return_string "cancel edit\n" + } + + return $return_string +} + + +# A procedure to send email if necessary +proc todo_email {db item_id event} { + set assigner_user_id [database_to_tcl_string $db "select assigned_by from todo_items where item_id=$item_id"] + set assignee_user_id [database_to_tcl_string $db "select user_id from todo_lists where list_id= (select list_id from todo_items where item_id=$item_id)"] + + # No notification if you did something yourself + + if {$assigner_user_id == ""} { + return + } + if {$assignee_user_id == $assigner_user_id} { + return + } + + set selection [ns_db 1row $db "select item_details as details, due_date from todo_items where item_id= $item_id"] + set_variables_after_query + + # Here we want to set the + # from_email, from_first_names, from_last_name + # to_email, to_first_names, to_last_name + if {$event == "assigned"} { + set from_user_id $assigner_user_id + set to_user_id $assignee_user_id + + set subject "new todo item" + set action "has assigned you" + } + + if {$event == "completed"} { + set from_user_id $assignee_user_id + set to_user_id $assigner_user_id + + set subject "item you assigned is completed" + set action "has completed" + } + + if {$event == "uncompleted"} { + set from_user_id $assignee_user_id + set to_user_id $assigner_user_id + + set subject "item you assigned is NO LONGER completed" + set action "has NOT completed" + } + + set selection [ns_db 1row $db "select email as from_email, first_names as from_first_names, last_name as from_last_name from users where user_id=$from_user_id"] + set_variables_after_query + + set selection [ns_db 1row $db "select email as to_email, first_names as to_first_names, last_name as to_last_name from users where user_id=$to_user_id"] + set_variables_after_query + + # Send the email + if {[catch { + ns_sendmail $to_email $from_email "$subject" " +$from_first_names $from_last_name $action item #$item_id: + +$details +" +} errmsg]} { + ns_log Warning "Email could not be sent in the todo manager because: $errmsg" +} +} + + +## A proc to get the view_open_items var +proc todo_view_open_items {separate_completed_items_p} { + if {$separate_completed_items_p == "f"} { + return "" + } + + set view_open_items [ns_queryget "view_open_items"] + + if {$view_open_items == ""} { + set view_open_items "t" + } + + return $view_open_items +} + +# +# A procedure to really delete old deleted items. +# +proc todo_delete_old_items {} { + set db [ns_db gethandle subquery] + + ns_db dml $db "delete from deleted_todo_items where (deletion_date+ timespan_days(2)) + [export_form_vars todo_id return_url plugin] + [bt_mergepiece [todo_one_item_form "edit"] $selection] + \n" + continue + } + + set one_row "\n" + + set actions_html "    " + # In case it's completed + if {$completion_date == ""} { + set pre_item "" + set post_item "" + if {$mark_completed_allowed_p} { + append actions_html "" + } + if {$item_change_allowed_p} { + append actions_html "edit" + } + } else { + set pre_item "" + set post_item "" + if {$mark_completed_allowed_p} { + append actions_html "" + } + if {$item_change_allowed_p} { + set return_url $current_url + append actions_html "" + } + } + + append actions_html "" + + # Go through the headers + foreach header $list_of_headers { + # Special case for list name + if {[lindex $header 0] == "list_name"} { + append one_row "$pre_item$list_name$post_item" + continue + } + + # Special case for item details + if {[lindex $header 0] == "item_details"} { + if {[string length $item_details] > 100} { + append one_row "$pre_item (details) [string range $item_details 0 100]... (more) $post_item" + continue + } else { + append one_row "$pre_item (details) $item_details $post_item" + continue + } + } + + if {[lindex $header 0] == "priority"} { + append one_row "$pre_item($priority)$post_item" + continue + } + + if {[lindex $header 0] == "category"} { + append one_row "$pre_item$category$post_item" + continue + } + + append one_row "$pre_item[set [lindex $header 0]]$post_item" + } + + append one_row "$actions_html\n" + + append return_html $one_row + } + + if {$allow_adding && [todo_get_plugin_value $plugin ITEM_ADD_ALLOWED_P]!="" && [todo_get_plugin_value $plugin ITEM_ADD_ALLOWED_P]} { + append return_html "

    [export_form_vars plugin category_id][todo_one_item_form "add"]
    " + } + + return $return_html +} + Index: web/openacs/tcl/todo-todo-plugin.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/todo-todo-plugin.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/todo-todo-plugin.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,208 @@ +## +## This is where things get crazy recursive: the todo module as a plugin to itself. +## This will help to standardize things tremendously +## +## written by Ben Adida (ben@adida.net) + +ns_schedule_proc -once 1 todo_todoplugin_register + +# The proc to register the TODO todo plugin +proc todo_todoplugin_register {} { + set data [ns_set new -persist todo_todoplugin_data] + ns_set put $data GET_PERSONAL_CATEGORIES todo_todoplugin_get_personal_categories + ns_set put $data GET_OTHER_CATEGORIES todo_todoplugin_get_other_categories + ns_set put $data ITEM_CHANGE_ALLOWED_P 1 + ns_set put $data ITEM_CHANGE todo_todoplugin_item_change + ns_set put $data MARK_COMPLETED_ALLOWED_P 1 + ns_set put $data MARK_COMPLETED todo_todoplugin_mark_completed + ns_set put $data MARK_UNCOMPLETED todo_todoplugin_mark_uncompleted + ns_set put $data ONE_ITEM_URL [todo_url_stub]/one-item.tcl + ns_set put $data ONE_ITEM_ID_KEY item_id + ns_set put $data ITEM_LIST_SQL todo_todoplugin_item_list_sql + ns_set put $data CATEGORY_FOOTER_HTML todo_todoplugin_category_footer_html + ns_set put $data ITEM_ADD_ALLOWED_P 1 + ns_set put $data ITEM_ADD todo_todoplugin_item_add + ns_set put $data ITEM_DELETE todo_todoplugin_item_delete + + # actually register + todo_plugin_register "todo" $data +} + +# Getting the personal categories +proc todo_todoplugin_get_personal_categories {db user_id} { + set categories [database_to_tcl_list_list $db " + select todo_lists.list_id, todo_lists.list_name from todo_lists where user_id= $user_id"] + + return $categories +} + +# Getting other categories +proc todo_todoplugin_get_other_categories {db user_id} { + set categories [database_to_tcl_list_list $db " + select todo_lists.list_id, case when last_name=email then ' ' || email || ' - ' || todo_lists.list_name else last_name || ', ' || first_names || ' - ' || todo_lists.list_name end as list_name from todo_lists, users where todo_lists.user_id!= $user_id and todo_lists.user_id= users.user_id and user_can_access_list_p($user_id, list_id)='t' + order by list_name + "] + + return $categories +} + +# When an item is changed +# Do the edit +proc todo_todoplugin_item_change {db user_id todo_id new_date new_priority new_item_details} { + ns_db dml $db "update todo_items set + priority= $new_priority, + due_date= $new_date, + item_details= '[DoubleApos $new_item_details]' + where + item_id= $todo_id + and user_can_access_list_p($user_id, list_id)='t'" + + # If we return 0, the calling page will keep going, which is what we want + return 0 +} + + +# When an item is done +# This does the right thing +proc todo_todoplugin_mark_completed {db user_id todo_id {completion_date {}}} { + ns_db dml $db "update todo_items set completion_date=sysdate() where item_id=$todo_id and user_can_access_list_p($user_id, list_id)='t'" + + todo_email $db $todo_id "completed" + + # We're done, and we let the proc do the redirect + return 0 +} + +proc todo_todoplugin_mark_uncompleted {db user_id todo_id {completion_date {}}} { + ns_db dml $db "update todo_items set completion_date=NULL where item_id=$todo_id and user_can_access_list_p($user_id, list_id)='t'" + + todo_email $db $todo_id "uncompleted" + + # We're done, and we let the proc do the redirect + return 0 +} + + +# This should return the SQL +# to select the stuff out of the database +proc todo_todoplugin_item_list_sql {db user_id category_id date_predicates date_prettifier n_days_to_show_completed_items completion_status order_by} { + + set due_date "todo_items.due_date" + + set list_of_predicates [list] + + if {$date_predicates != ""} { + # We substitue var names + lappend list_of_predicates [subst $date_predicates] + } + + # If we have no specified list here, we only show the ones owned + # by the user, otherwise it could get very messy (BMA) + if {$category_id != ""} { + lappend list_of_predicates "todo_lists.list_id=$category_id" + lappend list_of_predicates "user_can_access_list_p($user_id, todo_lists.list_id)='t'" + } else { + lappend list_of_predicates "todo_lists.user_id= $user_id" + } + + if {$completion_status == "open"} { + lappend list_of_predicates "todo_items.completion_date is null" + } else { + lappend list_of_predicates "(todo_items.completion_date is null OR todo_items.completion_date + timespan_days($n_days_to_show_completed_items) >= sysdate())" + } + + + if {$completion_status == "closed"} { + lappend list_of_predicates "todo_items.completion_date is not null" + } + + lappend list_of_predicates "todo_items.list_id= todo_lists.list_id" + lappend list_of_predicates "todo_items.deletion_date is null" + + set sql " + select + 'todo' as plugin, todo_lists.list_id as category_id, todo_lists.list_name as category, + priority, ${date_prettifier}(todo_items.due_date) as due_date, todo_interval_min(todo_items.due_date) as raw_due_date, + user_full_name(todo_items.assigned_by) as assigned_by, + todo_items.item_id as todo_id, item_details, completion_date + from + todo_lists, todo_items + where + [join $list_of_predicates " and "] + $order_by" + + return $sql +} + +proc todo_todoplugin_category_footer_html {db user_id category_id} { + set return_html "" + + set list_id $category_id + + append return_html "

    + You can also add a detailed item.

    " + + # ownership check + set check [database_to_tcl_string $db "select count(*) from todo_lists where user_id=$user_id and list_id=$list_id"] + + if {$check} { + append return_html "

    + Collaboration: +

      +
    • Add a collaborator. +

      + " + + set selection [ns_db select $db "select user_id, first_names, last_name from users where user_id in (select user_id from todo_list_user_map where list_id=$list_id)"] + + while {[ns_db getrow $db $selection]} { + set_variables_after_query + + append return_html "

    • \[ remove \] $first_names $last_name\n" + } + + append return_html "

      " + + set selection [ns_db select $db "select group_name, group_id from user_groups where group_id in (select user_group_id from todo_list_user_group_map where list_id=$list_id)"] + + while {[ns_db getrow $db $selection]} { + set_variables_after_query + + append return_html "

    • Group: $group_name\n" + } + + append return_html "
    +

    + You may choose to delete this list.

    + " + } else { + set selection [ns_db 1row $db "select first_names, last_name, email from users where user_id=(select user_id from todo_lists where list_id=$list_id)"] + set_variables_after_query + + append return_html "

    This list belongs to $first_names $last_name ($email).

    " + } + + return $return_html +} + +# Adding something +proc todo_todoplugin_item_add {db user_id category_id due_date priority item_details} { + + set todo_id [database_to_tcl_string $db "select nextval('todo_item_id_sequence')"] + + if {[database_to_tcl_string $db "select user_can_access_list_p($user_id, $category_id)"] == "t"} { + ns_db dml $db "insert into todo_items (list_id, item_id, creation_date, due_date, priority, item_details, assigned_by) values ($category_id, $todo_id, sysdate(), $due_date, $priority, '[DoubleApos $item_details]', $user_id)" + } + + todo_email $db $todo_id "assigned" + + # return false to ensure that the redirect happens + return 0 +} + +# Removing something +proc todo_todoplugin_item_delete {db user_id category_id todo_id} { + ns_db dml $db "update todo_items set deletion_date=sysdate() where item_id=$todo_id and user_can_access_list_p($user_id, $category_id)='t' and list_id=$category_id" + + return 0 +} \ No newline at end of file Index: web/openacs/tcl/user-group-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/user-group-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/user-group-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,1169 @@ +# user-group-defs.tcl,v 3.3.2.2 2000/03/16 23:01:43 jsalz Exp +# File: /tcl/user-groups-defs.tcl +# Date: 12/19/99 +# Author: Tarik Alatovic +# Email: tarik@arsdigita.com +# +# Purpose: User group related functions + +proc_doc ug_url {} "returns groups url directory: /[ad_parameter GroupsDirectory ug]" { + return /[ad_parameter GroupsDirectory ug] +} + +proc_doc ug_admin_url {} "returns groups admin url directory: /[ad_parameter GroupsDirectory ug]/[ad_parameter GroupsAdminDirectory ug]" { + return /[ad_parameter GroupsDirectory ug]/[ad_parameter GroupsAdminDirectory ug] +} + +proc_doc ug_parse_url { url_string } "this procedure takes url in the form /A/B/C and returns tcl list +whose members are A, B and C. if the last element of this tcl list is /, then this / will be added as the +last element in the list (e.g. /A/B/C/ will have elements A, B, C and /). if url_string is empty, +procedure will return an empty list +" { + set url_list [list] + + set url_string_length [string length $url_string] + if { $url_string_length == 0 } { + return $url_list + } + + set last_url_char [string range $url_string [expr $url_string_length - 1] [expr $url_string_length - 1]] + + if { [string compare $last_url_char /]==0 } { + set include_final_slash_p 1 + set url_without_initial_and_final_slash [string range $url_string 1 [expr $url_string_length - 2]] + } else { + set include_final_slash_p 0 + set url_without_initial_and_final_slash [string range $url_string 1 [expr $url_string_length - 1]] + } + + set url_list [split $url_without_initial_and_final_slash /] + if { $include_final_slash_p } { + lappend url_list / + } + + return $url_list +} + +proc_doc url_from_list { url_list } "given url list as described in ug_parse_url this procedure puts back the url from the list. thus, if list contains elements A, B and C, this procedure will return A/B/C. if list contains elements A, B, C and / than this procedure will return A/B/C/" { + set url_list_length [llength $url_list] + + if { $url_list_length < 1 } { + return "" + } + + set first_url_element [lindex $url_list 0] + if { [string compare $first_url_element /]==0 } { + return "/" + } + + set last_url_element [lindex $url_list [expr $url_list_length - 1]] + if { [string compare $last_url_element /]==0 } { + return "[join [lrange $url_list 0 [expr $url_list_length - 2]] /]/" + } else { + return "[join [lrange $url_list 0 [expr $url_list_length - 1]] /]" + } +} + +ns_share -init { set ug_initialization_done 0 } ug_initialization_done + +if { !$ug_initialization_done } { + set ug_initialization_done 1 + ad_schedule_proc -once t 1 ug_init_serve_group_pages +} + +# initialize ug_serve_group_pages +proc ug_init_serve_group_pages {} { + set db [ns_db gethandle] + + ns_register_proc GET [ug_url] ug_serve_group_pages + ns_register_proc POST [ug_url] ug_serve_group_pages + + set selection [ns_db select $db " + select '/' || group_type as group_type_url from user_group_types + where has_virtual_directory_p='t'"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_register_proc GET $group_type_url ug_serve_group_pages + ns_register_proc POST $group_type_url ug_serve_group_pages + } + + ns_db releasehandle $db +} + +proc ug_source { info } { + set action [lindex $info 0] + set predicate [lindex $info 1] + + if { $action == "redirect" } { + ns_returnredirect $predicate + } else { + set file $predicate + set extension [file extension $file] + if { $extension == ".tcl" } { + # Tcl file - use source. + uplevel [list source $file] + } elseif { $extension == ".adp" } { + # ADP file - parse and return the ADP. + set adp [ns_adp_parse -file $file] + set content_type [ns_set iget [ns_conn outputheaders] "content-type"] + if { $content_type == "" } { + set content_type "text/html" + } + uplevel [list ns_return 200 $content_type $adp] + } else { + # Some other random kind of find - return it. + ns_returnfile 200 [ns_guesstype $file] $file + } + } +} + +proc ug_file_to_source { dir name } { + set path [ns_url2file "$dir/$name"] + if { [file isdirectory $path] } { + if { ![regexp {/$} $path] } { + # Directory name with no trailing slash. Redirect to the same URL but with + # a trailing slash. + + set url "[ns_conn url]/" + if { [ns_conn query] != "" } { + append url "?[ns_conn query]" + } + return [list redirect $url] + } else { + # Directory name with trailing slash. Search for an index.* file. + append path "index" + } + } + + if { ![file isfile $path] } { + # It doesn't exist - glob for the right file. + if { ![file isdirectory [file dirname $path]] } { + return "" + } + + # Sub out funky characters in the pathname, so the user can't request + # http://www.arsdigita.com/*/index (causing a potentially expensive glob + # and bypassing registered procedures)! + regsub -all {[^0-9a-zA-Z_/.]} $path {\\&} path_glob + + # Grab a list of all available files with extensions. + set files [glob -nocomplain "$path_glob.*"] + + # Search for files in the order specified in ExtensionPrecedence. + set precedence [ad_parameter "ExtensionPrecedence" "abstract-url" "tcl"] + foreach extension [split [string trim $precedence] ","] { + if { [lsearch $files "$path.$extension"] != -1 } { + return [list file "$path.$extension"] + } + } + + # None of the extensions from ExtensionPrecedence were found - just pick + # the first in alphabetical order. + if { ![info exists ad_conn(file)] && [llength $files] > 0 } { + set files [lsort $files] + return [list file [lindex $files 0]] + } + + return "" + } + + return [list file $path] +} + +proc ug_serve_group_pages { conn context } { + set url_stub [ns_conn url] + set url_list [ug_parse_url $url_stub] + set url_list_length [llength $url_list] + + ns_log Notice "URL: $url_list" + + if { $url_list_length < 1 } { + # this should never happen, so return an error to indicate that something went wrong + ad_return_error "Error in serving group pages" "Error in serving group pages. If the problem persists, please contact the system administrator." + ns_log Error "/tcl/user-group-defs.tcl: function ug_serve_group_pages: got url_list_length less than 1" + return + } + + set db [ns_db gethandle] + + set url_first_element [lindex $url_list 0] + + if { [string compare $url_first_element [ad_parameter GroupsDirectory ug]]== 0 } { + # we are serving /groups directory, so set the appropriate directories where files are located + set groups_public_dir /groups + set groups_admin_dir /groups/admin + set group_public_dir /groups/group + set group_admin_dir /groups/admin/group + + set group_public_root_url /[ad_parameter GroupsDirectory ug] + set group_admin_root_url /[ad_parameter GroupsDirectory ug]/[ad_parameter GroupsAdminDirectory ug] + + # this flag indicates that page was accessed through generic /groups pages as opposed to /$group_type pages + set group_type_url_p 0 + + # just initialize group_type, group_type_pretty_name and group_type_pretty_plural to empty string + set group_type "" + set group_type_pretty_name "" + set group_type_pretty_plural "" + + } else { + # let's check if we are dealing with one of the group type virtual directories + set selection [ns_db 0or1row $db " + select group_type, pretty_name as group_type_pretty_name, pretty_plural as group_type_pretty_plural, + group_type_public_directory, group_type_admin_directory, group_public_directory, group_admin_directory + from user_group_types + where has_virtual_directory_p='t' + and group_type='[DoubleApos $url_first_element]'"] + + if { [empty_string_p $selection] } { + # this should never happen since this procedure is called only with url's + # registered with ns_register_proc to handle group type directories + ad_return_error "Error in serving group pages" "Error in serving group pages. If the problem persists, please contact the system administrator." + ns_log Error "/tcl/user-group-defs.tcl: function ug_serve_group_pages: first element in url_list is not \[ad_parameter GroupsDirectory ug\]" + return + } + + set_variables_after_query + + set groups_public_dir [ad_decode $group_type_public_directory "" /groups $group_type_public_directory] + set groups_admin_dir [ad_decode $group_type_admin_directory "" /groups/admin $group_type_admin_directory] + set group_public_dir [ad_decode $group_public_directory "" /groups/group $group_public_directory] + set group_admin_dir [ad_decode $group_admin_directory "" /groups/admin/group $group_admin_directory] + + set group_public_root_url /[ad_urlencode $group_type] + set group_admin_root_url /[ad_urlencode $group_type]/[ad_parameter GroupsAdminDirectory ug] + + # this flag indicates that page was accessed through /$group_type pages as opposed to generic /groups pages + set group_type_url_p 1 + } + + if { $url_list_length==1 } { + # this means that url is /groups or /$group_type + # than just redirect url to the directory /groups/ or /$group_type/ + # note that this is necessary in order to establish the correct default directory + ns_returnredirect "$url_stub/" + return + } + + set url_second_element [lindex $url_list 1] + + if { [string compare $url_second_element /]==0 } { + # this is groups public directory, so serve the appropriate groups index page + ns_db releasehandle $db + util_unset_local_vars groups_public_dir group_type_url_p group_type group_type_pretty_name group_type_pretty_plural group_public_root_url group_admin_root_url + source [ns_info pageroot]$groups_public_dir/index.tcl + return + } + + if { [string compare $url_second_element [ad_parameter GroupsAdminDirectory ug]]==0 } { + #these are /groups/admin pages + if { $url_list_length==2 } { + # this is to set correct default directory + ns_returnredirect "$url_stub/" + return + } + + # THIS PORTION OF THIS PROC SERVES THE ADMIN PAGES + + if { $url_list_length < 3 } { + # this should never happen, so return an error to indicate that something went wrong + ad_return_error "Error" "Error in serving group pages. If the problem persists, please contact the system administrator." + ns_log Error "/tcl/user-group-defs.tcl: function ug_serve_admin_group_pages: got url_list_length less than 3" + return + } + + set url_third_element [lindex $url_list 2] + + if { [string compare $url_third_element /]==0 } { + # this is /groups/admin/ so serve the groups admin index page + ns_db releasehandle $db + util_unset_local_vars groups_admin_dir group_type_url_p group_type group_type_pretty_name group_type_pretty_plural group_public_root_url group_admin_root_url + source [ns_info pageroot]$groups_admin_dir/index.tcl + return + } + + # appending groups listing page link to the context bar list + lappend group_context_bar_list [list "$group_admin_root_url/" "Groups Admin"] + + set file_to_source [ug_file_to_source $groups_admin_dir $url_third_element] + if { $file_to_source != "" } { + ns_db releasehandle $db + util_unset_local_vars file_to_source groups_admin_dir url_third_element group_type_url_p group_type group_type_pretty_name group_type_pretty_plural group_public_root_url group_admin_root_url + ug_source $file_to_source + return + } + +# cd [ns_info pageroot]$groups_admin_dir +# set groups_admin_system_file_list [glob *.tcl] + +# if { [lsearch -exact $groups_admin_system_file_list $url_third_element]!=-1 } { +# ns_db releasehandle $db +# util_unset_local_vars groups_admin_dir url_third_element group_type_url_p group_type group_type_pretty_name group_type_pretty_plural group_public_root_url group_admin_root_url +# source [ns_info pageroot]$groups_admin_dir/$url_third_element +# return +# } + + set selection [ns_db 0or1row $db " + select group_id, short_name, admin_email, group_name + from user_groups + where short_name='[DoubleApos $url_third_element]' + "] + + if { [empty_string_p $selection] } { + ug_page_does_not_exist [url_from_list [lrange $url_list 2 [expr $url_list_length - 1]]] $group_admin_root_url/ "Go to groups administration main page" + return + } + + # we found a match for short name; go ahead and get the variables from the query + set_variables_after_query + + # all scope related variables are stored in this set and passed down to the module files + # elements of group_vars_set are group_id, group_short_name, group_name, group_admin_email, + # group_public_root_url, group_admin_root_url, group_context_bar_list and group_navbar_list + set group_vars_set [ns_set create] + + ns_set put $group_vars_set group_id $group_id + ns_set put $group_vars_set group_short_name $short_name + ns_set put $group_vars_set group_name $group_name + ns_set put $group_vars_set group_admin_email $admin_email + ns_set put $group_vars_set group_public_url $group_public_root_url/[ad_urlencode $short_name] + ns_set put $group_vars_set group_admin_url $group_admin_root_url/[ad_urlencode $short_name] + ns_set put $group_vars_set group_public_root_url $group_public_root_url + ns_set put $group_vars_set group_admin_root_url $group_admin_root_url + ns_set put $group_vars_set group_type_url_p $group_type_url_p + ns_set put $group_vars_set group_context_bar_list $group_context_bar_list + ns_set put $group_vars_set group_navbar_list [list] + + set scope group + + if { $url_list_length==3 } { + # this means that url is $group_admin_root_url/short_name + # than just redirect url to the directory $group_admin_root_url/short_name/ + # note that this is necessary in order to establish the correct default directory + ns_returnredirect "$url_stub/" + return + } + + set url_fourth_element [lindex $url_list 3] + + if { [string compare $url_fourth_element /]==0 } { + # this is /groups/admin/short_name/ so serve the admin index page of that group + ns_db releasehandle $db + util_unset_local_vars group_admin_dir scope group_id group_vars_set + source [ns_info pageroot]$group_admin_dir/index.tcl + return + } + + # appending groups listing page link to the context bar list + lappend group_context_bar_list [list "$group_admin_root_url/[ad_urlencode $short_name]/" "One Group Admin"] + ns_set update $group_vars_set group_context_bar_list $group_context_bar_list + + set file_to_source [ug_file_to_source $group_admin_dir $url_fourth_element] + if { $file_to_source != "" } { + ns_db releasehandle $db + util_unset_local_vars file_to_source group_admin_dir url_fourth_element scope group_id group_vars_set + ug_source $file_to_source + return + } + +# cd [ns_info pageroot]$group_admin_dir +# set group_admin_system_file_list [glob *.tcl] + +# if { [lsearch -exact $group_admin_system_file_list $url_fourth_element]!=-1 } { +# ns_db releasehandle $db +# util_unset_local_vars group_admin_dir url_fourth_element scope group_id group_vars_set +# source [ns_info pageroot]$group_admin_dir/$url_fourth_element +# return +# } + + # in the query below, notice that we only have content section administration for + # sections of section_type admin, system and custom + set selection [ns_db 0or1row $db " + select section_type, section_key, module_key + from content_sections + where scope='group' and group_id=$group_id + and (section_type='admin' or section_type='system' or section_type='custom') + and section_key='[DoubleApos $url_fourth_element]' + "] + + if { [empty_string_p $selection] } { + ug_group_page_does_not_exist $db $group_id $group_name $admin_email \ + [url_from_list [lrange $url_list 3 [expr $url_list_length - 1]]] \ + $group_admin_root_url/[ad_urlencode $short_name]/ "Go to $group_name main administration page" + return + } + + # we found a match for group section short name; go ahead and get the variables from the query + set_variables_after_query + + if { $url_list_length==4 } { + # this means that url is $group_admin_root_url/short_name/section_key + # than just redirect url to the directory $group_admin_root_url/short_name/section_key/ + # note that this is necessary in order to establish the correct default directory + ns_returnredirect "$url_stub/" + return + } + + set url_fifth_element [lindex $url_list 4] + + if { ([string compare $section_type admin]==0) || ([string compare $section_type system]==0) } { + set admin_dir [database_to_tcl_string $db " + select admin_directory from acs_modules where module_key='[DoubleApos $module_key]'"] + } else { + # this is the case when section_type=custom + set admin_dir [database_to_tcl_string $db " + select admin_directory from acs_modules where module_key='custom-sections'"] + } + + if { [string compare $url_fifth_element /]==0 } { + # this is /groups/admin/short_name/section_key/ so serve the admin index page of that section + # if it exists (otherwise announce that page does not exist) + cd [ns_info pageroot]$admin_dir + if { [file exists index.tcl] } { + ns_db releasehandle $db + util_unset_local_vars admin_dir scope group_id group_vars_set + source [ns_info pageroot]$admin_dir/index.tcl + return + } + + # index.tcl does not exist for this admin directory, so return page does not exist message + ug_group_page_does_not_exist $db $group_id $group_name $admin_email \ + [url_from_list [lrange $url_list 3 [expr $url_list_length - 1]]] \ + $group_admin_root_url/[ad_urlencode $short_name]/ "Go to $group_name main administration page" + return + } + + set file_to_source [ug_file_to_source $admin_dir $url_fifth_element] + if { $file_to_source != "" } { + ns_db releasehandle $db + util_unset_local_vars file_to_source admin_dir url_fifth_element scope group_id group_vars_set + ug_source $file_to_source + return + } + +# cd [ns_info pageroot]$admin_dir +# set admin_section_file_list [glob *.tcl] + +# if { [lsearch -exact $admin_section_file_list $url_fifth_element]!=-1 } { +# ns_db releasehandle $db +# util_unset_local_vars admin_dir url_fifth_element scope group_id group_vars_set +# source [ns_info pageroot]$admin_dir/$url_fifth_element +# return +# } + + # reaching this point code means that requested page does not exist + + ug_group_page_does_not_exist $db $group_id $group_name $admin_email \ + [url_from_list [lrange $url_list 3 [expr $url_list_length - 1]]] \ + $group_admin_root_url/[ad_urlencode $short_name]/ "Go to $group_name main administration page" + return + + # END OF CODE SERVING ADMIN PAGES + } + + # appending groups listing page link to the context bar list + if { [string compare $url_first_element [ad_parameter GroupsDirectory ug]]== 0 } { + lappend group_context_bar_list [list "$group_public_root_url/" Groups] + } else { + lappend group_context_bar_list [list "$group_public_root_url/" $group_type_pretty_plural] + } + + set file_to_source [ug_file_to_source $groups_public_dir $url_second_element] + if { $file_to_source != "" } { + ns_db releasehandle $db + util_unset_local_vars file_to_source groups_public_dir url_second_element group_type_url_p group_type group_type_pretty_name group_type_pretty_plural group_public_root_url group_admin_root_url group_vars_set + ug_source $file_to_source + return + } + +# cd [ns_info pageroot]$groups_public_dir +# set groups_system_file_list [glob *.tcl] + +# if { [lsearch -exact $groups_system_file_list $url_second_element]!=-1 } { +# ns_db releasehandle $db +# util_unset_local_vars groups_public_dir url_second_element group_type_url_p group_type group_type_pretty_name group_type_pretty_plural group_public_root_url group_admin_root_url +# source [ns_info pageroot]$groups_public_dir/$url_second_element +# return +# } + + set selection [ns_db 0or1row $db " + select group_id, short_name, group_name, admin_email + from user_groups + where short_name='[DoubleApos $url_second_element]' + "] + + if { [empty_string_p $selection] } { + ug_page_does_not_exist [url_from_list [lrange $url_list 1 [expr $url_list_length - 1]]] $group_public_root_url/ "Go to groups main page" + return + } + + # we found a match for short name; go ahead and get the variables from the query + set_variables_after_query + + # all scope related variables are stored in this set and passed down to the module files + # elements of group_vars_set are group_id, group_short_name, group_name, group_admin_email, + # group_public_root_url, group_admin_root_url, group_public_url, group_admin_url, + # group_context_bar_list and group_navbar_list + set group_vars_set [ns_set create] + + ns_set put $group_vars_set group_id $group_id + ns_set put $group_vars_set group_short_name $short_name + ns_set put $group_vars_set group_name $group_name + ns_set put $group_vars_set group_admin_email $admin_email + ns_set put $group_vars_set group_public_url $group_public_root_url/[ad_urlencode $short_name] + ns_set put $group_vars_set group_admin_url $group_admin_root_url/[ad_urlencode $short_name] + ns_set put $group_vars_set group_public_root_url $group_public_root_url + ns_set put $group_vars_set group_admin_root_url $group_admin_root_url + ns_set put $group_vars_set group_type_url_p $group_type_url_p + ns_set put $group_vars_set group_context_bar_list $group_context_bar_list + ns_set put $group_vars_set group_navbar_list [list] + + set scope group + + if { $url_list_length==2 } { + # this means that url is $group_public_root_url/short_name + # than just redirect url to the directory $group_public_root_url/short_name/ + # note that this is necessary in order to establish the correct default directory + ns_returnredirect "$url_stub/" + return + } + + set url_third_element [lindex $url_list 2] + + if { [string compare $url_third_element /]==0 } { + # this is /groups/short_name/ so serve the index page of that group + ns_db releasehandle $db + util_unset_local_vars group_public_dir scope group_id group_vars_set + source [ns_info pageroot]$group_public_dir/index.tcl + return + } + + # appending group index page link to the context bar list + if { [string compare $url_first_element [ad_parameter GroupsDirectory ug]]== 0 } { + lappend group_context_bar_list [list "$group_public_root_url/[ad_urlencode $short_name]/" "One Group"] + } else { + lappend group_context_bar_list [list "$group_public_root_url/[ad_urlencode $short_name]/" "One $group_type_pretty_name"] + } + ns_set update $group_vars_set group_context_bar_list $group_context_bar_list + + set file_to_source [ug_file_to_source $group_public_dir $url_third_element] + if { $file_to_source != "" } { + ns_db releasehandle $db + util_unset_local_vars file_to_source group_public_dir url_third_element scope group_id group_vars_set + ug_source $file_to_source + return + } + +# cd [ns_info pageroot]$group_public_dir +# set group_system_file_list [glob *.tcl] + +# if { [lsearch -exact $group_system_file_list $url_third_element]!=-1 } { +# ns_db releasehandle $db +# util_unset_local_vars group_public_dir url_third_element scope group_id group_vars_set +# source [ns_info pageroot]$group_public_dir/$url_third_element +# return +# } + + set selection [ns_db 0or1row $db " + select section_id, scope, section_type, section_pretty_name, section_key, + section_url_stub, module_key, requires_registration_p, visibility + from content_sections + where scope='group' and group_id=$group_id + and section_key='[DoubleApos $url_third_element]' + and section_type!='admin' + and enabled_p='t' + "] + + if { [empty_string_p $selection] } { + ug_group_page_does_not_exist $db $group_id $group_name $admin_email \ + [url_from_list [lrange $url_list 2 [expr $url_list_length - 1]]] \ + $group_public_root_url/[ad_urlencode $short_name]/ "Go to $group_name main page" + return + } + + # we found a match for group section short name; go ahead and get the variables from the query + set_variables_after_query + + # if section is custom or static, let's see if the user is allowed to see that section + # this is determined using requires_registration_p and visibility + if { $section_type=="static" || $section_type=="custom" } { + if { $visibility=="private" } { + ad_scope_authorize $db group none group_member none + } else { + if { $requires_registration_p=="t" } { + ad_scope_authorize $db group none registered none + } + } + } + + if { $url_list_length==3 } { + # this means that url is $group_public_root_url/short_name/section_key + # than just redirect url to the directory $group_public_root_url/short_name/section_key/ + # note that this is necessary in order to establish the correct default directory + ns_returnredirect "$url_stub/" + return + } + + set url_fourth_element [lindex $url_list 3] + + if { [string compare $section_type system]==0 || [string compare $section_type custom]==0 } { + if { [string compare $section_type custom]==0 } { + set module_key "custom-sections" + } + set public_dir [database_to_tcl_string $db " + select public_directory from acs_modules where module_key='[DoubleApos $module_key]'"] + } + + # let's figure out the navigation bars + set selection [ns_db select $db " + select cs.section_key as to_section_key, + cs.section_pretty_name as to_section_pretty_name + from content_section_links csl, content_sections cs + where csl.from_section_id=$section_id + and csl.to_section_id=cs.section_id + order by cs.section_key"] + + set group_navbar_list [list] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + lappend group_navbar_list \ + [list "$group_public_root_url/[ad_urlencode $short_name]/[ad_urlencode $to_section_key]/" $to_section_pretty_name] + } + ns_set update $group_vars_set group_navbar_list $group_navbar_list + + + if { [string compare $url_fourth_element /]==0 } { + # this is /groups/short_name/section_key/ + + # it this is the system section serve the index page of that section if it exists + # (otherwise announce that page does not exist) + if { [string compare $section_type system]==0 } { + cd [ns_info pageroot]$public_dir + if { [file exists index.tcl] } { + ns_db releasehandle $db + util_unset_local_vars public_dir scope group_id group_vars_set + source [ns_info pageroot]$public_dir/index.tcl + return + } + + # index.tcl does not exist for this system section, so return page does not exist message + ug_group_page_does_not_exist $db $group_id $group_name $admin_email \ + [url_from_list [lrange $url_list 2 [expr $url_list_length - 1]]] \ + $group_public_root_url/[ad_urlencode $short_name]/ "Go to $group_name main page" + return + } + + if { [string compare $section_type custom]==0 } { + # serve custom section index page + ns_db releasehandle $db + util_unset_local_vars public_dir scope group_id group_vars_set section_id section_key + source [ns_info pageroot]$public_dir/index.tcl + return + } + + if { [string compare $section_type static]==0 } { + # this is just a static page + # if the page is adp, tcl, htm or html page than just parse it and display the content + # otherwise redirect to the url_stub (this way we can kind of handle url directories and + # images being used as content sections) + + set file_extension [file extension $section_url_stub] + if { [empty_string_p $file_extension] } { + ns_returnredirect $section_url_stub + return + } + + if { [string compare $file_extension .tcl]==0 } { + ns_db releasehandle $db + util_unset_local_vars section_url_stub scope group_id group_vars_set + source [ns_info pageroot]$section_url_stub + return + } + if { [string compare $file_extension .adp]==0 } { + ns_db releasehandle $db + ns_adp_parse -file [ns_info pageroot]$section_url_stub + return + } + + if { ([string compare $file_extension .htm]==0) || \ + ([string compare $file_extension .html]==0) } { + set html_page [ns_httpget [ad_parameter SystemURL]$section_url_stub] + ns_return 200 text/html $html_page + return + } + + # unrecognized extension, could be image or something else, so just redirect to that url location + ns_returnredirect $section_url_stub + return + } + } + + # static sections cannot have files associated with them, so for sections of section_type static, reaching this point + # in code means that requested page does not exist + if { [string compare $section_type static]==0 } { + ug_group_page_does_not_exist $db $group_id $group_name $admin_email \ + [url_from_list [lrange $url_list 2 [expr $url_list_length - 1]]] \ + $group_public_root_url/[ad_urlencode $short_name]/ "Go to $group_name main page" + return + } + + # appending group section index page link to the context bar list + if { [string compare $section_type custom]==0 } { + lappend group_context_bar_list [list "$group_public_root_url/[ad_urlencode $short_name]/[ad_urlencode $section_key]/" $section_pretty_name] + ns_set update $group_vars_set group_context_bar_list $group_context_bar_list + } + + # now we still have to deal with the sytem section and custom sections assocated files + + if { [string compare $section_type system]==0 } { + set file_to_source [ug_file_to_source $public_dir $url_fourth_element] + if { $file_to_source != "" } { + ns_db releasehandle $db + util_unset_local_vars file_to_source group_public_dir scope group_id group_vars_set + ug_source $file_to_source + return + } + +# cd [ns_info pageroot]$public_dir +# set section_file_list [glob *.tcl] + +# if { [lsearch -exact $section_file_list $url_fourth_element]!=-1 } { +# ns_db releasehandle $db +# util_unset_local_vars public_dir url_fourth_element scope group_id group_vars_set +# source [ns_info pageroot]$public_dir/$url_fourth_element +# return +# } + } + + set selection [ns_db 0or1row $db " + select content_file_id, file_type + from content_files + where section_id=$section_id + and file_name='[DoubleApos $url_fourth_element]'"] + + if { [empty_string_p $selection] } { + # unrecognized file, so return the page not exists + ug_group_page_does_not_exist $db $group_id $group_name $admin_email \ + [url_from_list [lrange $url_list 2 [expr $url_list_length - 1]]] \ + $group_public_root_url/[ad_urlencode $short_name]/ "Go to $group_name main page" + return + } + + set_variables_after_query + # so, we have identified the file, go ahead and serve the file + ns_db releasehandle $db + if { [string compare $file_type "text/html"]==0 } { + util_unset_local_vars scope group_id group_vars_set content_file_id + source [ns_info pageroot]/custom-sections/file/index.tcl + } else { + util_unset_local_vars scope group_id group_vars_set content_file_id + source [ns_info pageroot]/custom-sections/file/get-binary-file.tcl + } + return +} + +proc_doc ug_page_does_not_exist { page_name link_target link_name } "this procedures return message to the user that a page does not exist. it uses ad_header and ad_footer. user is redirected to appropriate page with name link_name and link target link_target" { + + set page_title "Page does not exist" + + ns_return 200 text/html " + [ad_header $page_title] +

    $page_title

    +
    + +
    +

    Page $page_name does not exist.

    +

    $link_name

    +
    + + [ad_footer] + " +} + +proc_doc ug_group_page_does_not_exist { db group_id group_name group_admin_email page_name link_target link_name } "this procedures return message to the user that a page does not exist. the page display is customized for group pages and uses ug_header and ug_footer. user is redirected to appropriate page with name link_name and link target link_target" { + + set page_title "Page does not exist" + + ns_return 200 text/html " + [ug_header $page_title $db $group_id] + [ug_page_title $page_title $db $group_id $group_name] +
    + +
    +

    Page $page_name does not exist.

    +

    $link_name

    +
    + + [ug_footer $group_admin_email] + " +} + +proc_doc ug_header { page_title db group_id } "Header for group user pages. It needs group id in order to get the groups cascaded style sheet information." { + + set selection [ns_db 0or1row $db " + select 1 from content_sections where scope='group' and group_id=$group_id and module_key='display'"] + set css_enabled_p [ad_decode $selection "" 0 1] + + set scope group + + if { $css_enabled_p } { + return " + + + $page_title + + + + " + } else { + return [ad_header $page_title] + } +} + +proc_doc ug_footer { admin_email } " +Signs pages with group administrator email. Group administrator is person who administer groups content. " { + append result " +
    + " + + if { ![empty_string_p $admin_email] } { + append result " +
    $admin_email
     + " + } else { + append result " +
    [ad_system_owner]
     + " + } + + append result " + + + " + + return $result +} + +proc_doc ug_admin_header { page_title db group_id } "Header for group admin pages. Neeeds group id in order to get the groups cascaded style sheet information." { + + set selection [ns_db 0or1row $db " + select 1 from content_sections where scope='group' and group_id=$group_id and module_key='display'"] + set css_enabled_p [ad_decode $selection "" 0 1] + + set scope group + + if { $css_enabled_p } { + return " + + + $page_title + + + + " + } else { + return [ad_header $page_title] + } +} + +proc_doc ug_admin_footer {} "This pages are signed by the SystemOwner, because group administrators should be able to complain to programmer who can fix the bugs." { + return " +
    +
    [ad_system_owner]
     + + + " +} + +proc_doc ug_page_title { page_title db group_id group_name {show_logo_p 1}} "formats the page title for the user group. if show_logo_p is 1, logo will be displayed (given that the logo is enabled for this page), else logo will not be displayed." { + + set selection [ns_db 0or1row $db " + select case when logo_enabled_p= 't' then 1 else 0 end as logo_enabled_p, scope from page_logos where scope='group' and group_id=$group_id"] + + if { [empty_string_p $selection] } { + set logo_viewable_p 0 + } else { + set_variables_after_query + set logo_viewable_p $logo_enabled_p + } + + if { $logo_viewable_p } { + # logo is enabled + return [ad_decorate_top "$group_name

    $page_title" \ + "Logo"] + } else { + + # logo disabled either by system or group administrator, so return plain text page title + return " + $group_name + [ad_space 2] + $page_title +

    + " + } +} + +proc_doc ug_admin_page_title { page_title db group_id group_name } "formats the page title for the user groups admin pages." { + return " + $group_name + [ad_space 2] + $page_title +

    + " +} + +proc_doc ug_return_complaint { exception_count exception_text db group_id group_name admin_email } "Return a page complaining about the user's input (as opposed to an error in our software, for which ug_return_error is more appropriate). This pages are changed in order to use ug_header and ug_footer" { + # there was an error in the user input + if { $exception_count == 1 } { + set problem_string "a problem" + set please_correct "it" + } else { + set problem_string "some problems" + set please_correct "them" + } + + ns_return 200 text/html " + [ug_header "Problem with Your Input" $db $group_id] + [ug_page_title "Problem with Your Input" $db $group_id $group_name] +
    + + We had $problem_string processing your entry: +
      + $exception_text +
    + + Please back up using your browser, correct $please_correct, and + resubmit your entry. + +

    + + Thank you. + + [ug_footer $admin_email] + " +} + + +proc_doc ug_return_warning { title explanation db group_id group_name admin_email } "it returns properly formatted warning message to the user. this procedure is appropriate for messages like not authorized to access this page." { + ns_return 200 text/html " + [ug_header $title $db $group_id] + [ug_page_title $title $db $group_id $group_name] +

    +
    + $explanation +
    + [ug_footer $admin_email]" +} + +proc_doc ug_return_error { title explanation db group_id group_name admin_email } "this function should be used if we want to indicate an error to the user, which was produced by bug in our code. it returns error message properly formatted for user_groups." { + ns_return 500 text/html " + [ug_header $title $db $group_id] + [ug_page_title $title $db $group_id $group_name] +
    +
    + $explanation +
    + [ug_footer $admin_email]" +} + +proc_doc util_unset_local_vars args "this procedure will unset all the local variables in the callers environment except the variables specified in the args" { + set local_vars_list [uplevel {info locals}] + + foreach arg $args { + set index [lsearch -exact $local_vars_list $arg] + if {$index>=0} { + set local_vars_list [lreplace $local_vars_list $index $index] + } + } + + foreach var $local_vars_list { + uplevel "unset $var" + } +} + + + +# This procedure is called to send a group spam message with the +# given spam_id which only sends approved spam out + +proc_doc send_one_group_spam_message { spam_id } {This procedure sends out a group spam message with the given spam_id, provided the spam is approved ( i.e. either the spam policy of the group is "open", or policy is "wait" and the group administrator approved it)} { + + # temporarily, we'll just use ns_sendmail until gregh's qmail API is set up + # ns_sendmail is not guaranteed to do anything reasonable with envelopes, so + # it is not obvious where bounced mail will come back to, + # so until we get the new email transport running, watch out! + + ns_log Notice "running send_one_group_spam_message" + + set db [ns_db gethandle] + + # Get information related to this spam from the group_spam_history_table + + set selection [ns_db select $db "select * + from group_spam_history + where spam_id = $spam_id + and approved_p = 't' + and send_date is null"] + + if { [ns_db getrow $db $selection] == 0} { + # no sendable spam + ns_db releasehandle $db + ns_log Notice "send_one_group_spam_message : no spam to send" + return + } + + set_variables_after_query + + set group_name [database_to_tcl_string $db " + select group_name + from user_groups + where group_id = $group_id"] + + set admin_email [database_to_tcl_string $db " + select admin_email + from user_groups + where group_id = $group_id"] + + set group_spam_removal_string "[group_spam_removal_blurb $db $group_id]" + + set role_clause [ad_decode $send_to "members" "" "and ug.role='administrator'"] + + set sql_query "select u.email as receiver_email, + u.user_id as receiver_id , + u.first_names as receiver_first_names, + u.last_name as receiver_last_name + from user_group_map ug, users_spammable u + where ug.group_id = $group_id + $role_clause + and ug.user_id = u.user_id + and not exists ( select 1 + from group_member_email_preferences + where group_id = $group_id + and user_id = u.user_id + and dont_spam_me_p = 't') + and not exists ( select 1 + from user_user_bozo_filter + where origin_user_id = u.user_id + and target_user_id = $sender_id)" + + set selection [ns_db select $db $sql_query] + # query sets email for each recipient + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + set message_body $body + + # This appends group-wide removal blurb + append message_body $group_spam_removal_string + + # This appends site-wide bozo-filter blurb, + # so, the receiver doesn't get any more email from sender + append message_body "[bozo_filter_blurb $sender_id]" + + # substitute all user/group specific data in the message body + + regsub -all "" $message_body $receiver_first_names message_body + regsub -all "" $message_body $receiver_last_name message_body + regsub -all "" $message_body $receiver_email message_body + regsub -all "" $message_body $group_name message_body + regsub -all "" $message_body $admin_email message_body + + ns_sendmail $receiver_email $from_address $subject $message_body + + incr n_receivers_actual + } + + ns_db dml $db "update group_spam_history + set n_receivers_actual=$n_receivers_actual, + send_date = sysdate + where spam_id = $spam_id " + + ns_db releasehandle $db + ns_log Notice "send_one_group_spam_message : finished sending group spam id $spam_id" +} + + +# This procedure is called to send all approved spam messages +# for a specific group + +proc_doc send_all_group_spam_messages { group_id } {This procedure sends all approved spam messages of a specific group} { + + # temporarily, we'll just use ns_sendmail until gregh's qmail API is set up + # ns_sendmail is not guaranteed to do anything reasonable with envelopes, so + # it is not obvious where bounced mail will come back to, + # so until we get the new email transport running, watch out! + + ns_log Notice "running send_all_group_spam_messages" + + set db [ns_db gethandle] + + # Get information related to these spams from the group_spam_history table + + set selection [ns_db select $db "select * + from group_spam_history + where group_id = $group_id + and approved_p = 't' + and send_date is null"] + + set counter 0 + set spam_id_list [list] + + # build a list of spam_ids to send + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + incr counter + + lappend spam_id_list $spam_id + } + + ns_db releasehandle $db + + if { $counter == 0 } { + # no sendable spam + ns_log Notice "send_all_group_spam_messages : no spam to send" + return + } + + foreach spam_id $spam_id_list { + # send each spam message + send_one_group_spam_message $spam_id + } + + ns_log Notice "send_all_group_spam_messages : finished sending group spams for group id $group_id" +} + + +proc_doc group_spam_removal_blurb {db group_id} {A blurb to append to group spam messages, telling users why they got the spam and how to avoid getting it in the future} { + + set group_name [database_to_tcl_string $db "select group_name + from user_groups + where group_id=$group_id"] + + set short_name [database_to_tcl_string $db "select short_name + from user_groups + where group_id=$group_id"] + + return " + +-------------- +To stop receiving any future spam from the $group_name group : +click here" +} + + +proc_doc bozo_filter_blurb {sender_id} {A blurb to append to any spam message, letting the user avoid future emails from this specific sender} { + return " + +--------------- +To stop receiving any future email from this specific sender : +click here" +} + + + + Index: web/openacs/tcl/utils-extra.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/utils-extra.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/utils-extra.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,76 @@ +# utils-extra.tcl,v 3.0 2000/02/06 03:14:10 ron Exp +proc_doc export_form_value { var_name {default ""} } "Returns a properly formatted value part of a form field." { + + # Returns the value part of a form field ( value=\"foo\" ) for text fields. + # if the variable var_name exists in the callers environment, the value + # of var_name is used as the value. Otherwise, the value of default is used. + # Quotes are converted to " + + if [eval uplevel {info exists $var_name}] { + upvar $var_name value + return " value=\"[philg_quote_double_quotes $value]\" " + } else { + return " value=\"[philg_quote_double_quotes $default]\" " + } +} + +# philg founded this horribly named procedure on March 2, 1999 +# it should not be used. +# Tracy: you've +# 1) misunderstood why procedures are named "export_.."; it is because +# they send variables from one Tcl page to another. This procedure +# is unrelated to those. +# 2) set us up for some horrible bugs if we ever move from Oracle to +# a strict ANSI database. '[export_var html_p]' will insert NULL into +# Oracle if html_p is undefined. But Oracle reserves the right to change +# this oddity in the future. In that case, you'd probably get an error. + +proc_doc export_var { var_name { default "" } } "Returns a variable's value if it exists. This can be used to protect against undefined variables." { + + # export_var protects against undefined variables + # Returns the value of the variable if it exists in the caller's environment. + # Otherwise, returns default. + + if [eval uplevel {info exists $var_name}] { + upvar $var_name value + return "$value" + } else { + return "$default" + } +} + +# this is a little better (redesigned by philg and Tracy) +proc util_quote_var_for_sql { varname { type text } } { + if [eval uplevel {info exists $varname}] { + upvar $varname value + return "[ns_dbquotevalue $value $type]" + } else { + return "NULL" + } +} + +proc_doc util_lmember_p { value list } "is value an element in the list" { + + if { [lsearch -exact $list $value] > -1 } { + return 1 + } + return 0 +} + +proc_doc util_ldelete { list value } "deletes value from the list" { + set ix [lsearch -exact $list $value] + if {$ix >= 0} { + return [lreplace $list $ix $ix] + } else { + return $list + } +} + +proc_doc util_kill_cache_url {} "often netscape caches something we don't want to be cached. pragma: no-cache directive doesn't work always with netscape, either. solution is to pass a variable to a file, which will have a distinct value each time function is called. this function will pass a unix's time in seconds (pretty much guaranteed to be unique) in the variable called no_cache. usage of this function should be something like this example" { + return "no_cache=[ns_time]" +} + +proc_doc util_kill_cache_form {} "often netscape caches something we don't want to be cached. pragma: no-cache directive doesn't work always with netscape, either. solution is to pass a variable to a file, which will have a distinct value each time function is called. this function will pass a unix's time in seconds (pretty much guaranteed to be unique) in the variable called no_cache. usage of this function should be something like this
    \[util_kill_cache_form\] form stuff
    " { + return " + " +} \ No newline at end of file Index: web/openacs/tcl/watchdog-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/watchdog-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/watchdog-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,87 @@ +# watchdog-defs.tcl,v 3.1 2000/02/26 12:55:30 jsalz Exp + + +# A complete rewrite of Watchdog +# +# dvr@arsdigita.com, Nov 28, 1999 +# +# This package provides a page that prints all errors from +# the system log. (/admin/errors). +# +# If you add a section to your ini file like: +# +# [ns/server/yourservicename/acs/monitoring] +# WatchDogFrequency=15 +# +# then watchdog will check the error log every 15 minutes +# and sent any error messages to ad_system_owner. + +proc wd_errors {{num_minutes ""} {num_bytes ""}} { + + if ![empty_string_p $num_bytes] { + append options "-${num_bytes}b " + } + if ![empty_string_p $num_minutes] { + append options "-${num_minutes}m " + } + + set command [ad_parameter WatchDogParser monitoring] + + if { ![file exists $command] } { + ns_log Notice "watchdog(wd_errors): Can't find WatchDogParser: $command doesn't exist" + } else { + set error_log [ns_info log] + if [info exists options] { + return [exec $command $options $error_log] + } else { + return [exec $command $error_log] + } + } +} + + +proc wd_email_frequency {} { + # in minutes + return [ad_parameter WatchDogFrequency monitoring 15] +} + +proc wd_people_to_notify {} { + + set people_to_notify [ad_parameter_all_values_as_list PersontoNotify monitoring] + if [empty_string_p $people_to_notify] { + return [ad_system_owner] + } else { + return $people_to_notify + } +} + +proc wd_mail_errors {} { + set num_minutes [wd_email_frequency] + + ns_log Notice "Looking for errors..." + + set system_owner [ad_system_owner] + + set errors [wd_errors $num_minutes] + + if {[string length $errors] > 50} { + ns_log Notice "Errors found" + foreach person [wd_people_to_notify] { + ns_log Notice "Sending email to $person..." + ns_sendmail $person $system_owner "Errors on [ad_system_name]" $errors + } + } +} + + + +ns_share -init {set wd_installed_p 0} wd_installed_p + +if {! $wd_installed_p} { + set check_frequency [wd_email_frequency] + if {$check_frequency > 0} { + ad_schedule_proc [expr 60 * $check_frequency] wd_mail_errors + ns_log Notice "Scheduling watchdog" + } + set wd_installed_p 1 +} Index: web/openacs/tcl/webmail-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/webmail-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/webmail-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,175 @@ +proc wm_link_author { address } { + return "[philg_quote_double_quotes $address]" +} + +proc wm_link_subject { subject } { + # Leave "Re:" out of the filter. + regexp {^(Re: *)?(.*)} $subject ignored ignored_prefix rest_of_subject + return "[philg_quote_double_quotes $subject]" +} + +proc wm_header_display {db msg_id header_display_style user_id} { + if { $header_display_style == "short" } { + set header_restriction_clause " and lower_name in ('to', 'from', 'cc', 'subject', 'date', 'in-response-to', 'references', 'reply-to')" + } else { + set header_restriction_clause "" + } + + set header_fields [database_to_tcl_list_list $db "select lower_name, name, value +from wm_headers +where msg_id = $msg_id$header_restriction_clause +order by sort_order"] + + set results "" + foreach field $header_fields { + set lower_name [lindex $field 0] + set name [lindex $field 1] + set value [lindex $field 2] + + switch -- $lower_name { + "from" { + append results "$name: [wm_link_author $value]
    \n" + } + "subject" { + append results "$name: [wm_link_subject $value]
    \n" + } + "references" { + append results "References: " + + set count 0 + while { [regexp {^\s*(<[^>]+>)\s*(.*)$} $value dummy message_id value] } { + incr count + set selection [ns_db select $db "select m.msg_id as ref_msg_id +from wm_messages m, wm_message_mailbox_map mmm, wm_mailboxes mbx +where message_id = '[DoubleApos $message_id]' + and mbx.creation_user = $user_id + and mbx.mailbox_id = mmm.mailbox_id + and mmm.msg_id = m.msg_id"] + + if { [ns_db getrow $db $selection] } { + set_variables_after_query + append results "$count " + ns_db flush $db + } else { + append results "$count " + } + } + append results "
    \n" + } + default { + append results "[philg_quote_double_quotes "$name: $value"]
    \n" + } + } + } + return $results +} + +# Quote text with "> " at the start of each line. +proc wm_quote_message { author msg_text } { + if { ![empty_string_p $msg_text] } { + regsub -all "\n" $msg_text "\n> " quoted_text + return "$author wrote: +> $quoted_text" + } else { + return $msg_text + } +} + +proc wm_check_permissions { db msg_id user_id } { + if { [database_to_tcl_string $db "select count(*) from wm_message_mailbox_map mmm, wm_mailboxes m +where mmm.mailbox_id = m.mailbox_id + and mmm.msg_id = $msg_id + and m.creation_user = $user_id"] == 0 } { + return 0 + } else { + return 1 + } +} + +ns_register_proc GET /webmail/parts/* wm_get_mime_part + +proc wm_get_mime_part { conn context } { + set url_stub [ns_conn url] + + if { [regexp {/webmail/parts/([0-9]+)/(.*)} $url_stub match msg_id filename] } { + set db [ns_db gethandle] + set user_id [ad_verify_and_get_user_id] + + if { ![wm_check_permissions $db $msg_id $user_id] } { + ad_return_error "Permission Denied" "You do not have permission to retrieve this message part." + return + } + + ReturnHeaders [database_to_tcl_string $db "select content_type +from wm_attachments +where msg_id = $msg_id + and filename = '[DoubleApos $filename]'"] + + set lob_id [database_to_tcl_string $db "select lob +from wm_attachments +where msg_id = $msg_id + and filename = '[DoubleApos $filename]'"] + ns_pg blob_write $db $lob_id + } +} + +######## Setup webmail if it is enabled. Openacs version depends on the +######## aolserver module nsjava. See http://nsjava.sourceforge.net for +######## more details. In the acs classic version both the queue processing +######## and the message cleanup are scheduled as jobs within oracle. + +proc wm_process_queue { } { + + ns_share wm_queue + ns_mutex lock $wm_queue(lock) + + if { $wm_queue(processingP) == 0 } { + + set wm_queue(processingP) 1 + ns_mutex unlock $wm_queue(lock) + + if [catch { + + set default_qdir "/home/nsadmin/qmail/queue" + set qdir [ad_parameter QueueDirectory webmail $default_qdir] + + ns_java -detach MessageParser::process_queue $qdir + + } err] { + + ns_log Error $err + } + + ns_mutex lock $wm_queue(lock) + set wm_queue(processingP) 0 + } + + ns_mutex unlock $wm_queue(lock) +} + +proc wm_cleanup_outgoing_messages { } { + + set db [ns_db gethandle] + ns_db dml $db "delete from wm_outgoing_messages + where creation_date < (sysdate() - 1)" + + ns_db releasehandle $db +} + +# Schedule the filter to process the incoming mail queue +ns_share -init {set webmail_queue_processing_enabled_p 0} webmail_queue_processing_enabled_p + +if {! $webmail_queue_processing_enabled_p && [ad_parameter WebmailEnabledP webmail 0] } { + + ns_share wm_queue + set wm_queue(processingP) 0 + set wm_queue(lock) [ns_mutex create] + + set wm_interval [ad_parameter ProcesssQueueInterval webmail 60] + ad_schedule_proc -thread t $wm_interval wm_process_queue + + ns_schedule_daily -thread 3 30 wm_cleanup_outgoing_messages + + set webmail_queue_processing_enabled_p 1 +} + Index: web/openacs/tcl/wp-defs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/wp-defs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/wp-defs.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,853 @@ +# /tcl/wp-defs.tcl +# +# Author: Jon Salz , 28 Nov 1999 +# +# Contains definitions for WimpyPoint. +# +# wp-defs.tcl,v 3.4.2.2 2000/04/11 16:21:54 carsten Exp + +# Hooks for new stuff and user contributions. + +ns_share ad_new_stuff_module_list +ns_share ad_user_contributions_summary_proc_list + +if { ![info exists ad_new_stuff_module_list] || [lsearch -glob $ad_new_stuff_module_list "*WimpyPoint*"] == -1 } { + lappend ad_new_stuff_module_list [list "WimpyPoint Presentations" wp_new_stuff] +} +if { ![info exists ad_user_contributions_summary_proc_list] || [util_search_list_of_lists $ad_user_contributions_summary_proc_list "WimpyPoint Presentations" 0] == -1 } { + lappend ad_user_contributions_summary_proc_list [list "WimpyPoint Presentations" wp_user_contributions 0] +} + +proc wp_new_stuff { db since_when only_from_new_users_p purpose { include_date_p 0 } { include_comments_p 1 } } { + if { $only_from_new_users_p == "t" } { + set users_table "users_new" + } else { + set users_table "users" + } + + if { $purpose == "site_admin" } { + set and_public "" + } else { + set and_public "and public_p = 't'" + } + + set selection [ns_db select $db " + select p.presentation_id, p.title, to_char(creation_date, 'Mon DD, YYYY') as creation_date, + p.public_p, + u.user_id, u.first_names, u.last_name + from wp_presentations p, $users_table u + where p.creation_user = u.user_id + and creation_date > '$since_when' $and_public + order by creation_date desc + "] + + set counter 0 + while { [ns_db getrow $db $selection] } { + set_variables_after_query + switch $purpose { + email_summary { + if { $include_date_p } { + append items "$creation_date: " + } + append items "$title -- [ad_url][wp_presentation_url]/$presentation_id/\n" + } + default { + append items "
  • " + if { $include_date_p } { + append items "$creation_date: " + } + append items "$title ($first_names $last_name" + if { $public_p == "f" } { + append items " - private" + } + append items ")\n" + } + } + } + + if { ![empty_string_p $items] } { + return "
      $items
    " + } else { + return "" + } +} + +proc wp_user_contributions { db user_id purpose } { + if { $purpose == "site_admin" || $user_id == [ad_verify_and_get_user_id] } { + set and_public "" + } else { + set and_public "and public_p = 't'" + } + + set selection [ns_db select $db " + select p.presentation_id, p.title, to_char(creation_date, 'Mon DD, YYYY') as creation_date, + p.public_p, + u.user_id, u.first_names, u.last_name + from wp_presentations p, users u + where p.creation_user = u.user_id $and_public + and u.user_id = $user_id + order by creation_date desc + "] + + set items "" + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + append items "
  • $title" + if { $public_p == "f" } { + append items " (private)" + } + append items "\n" + } + + #ns_log "Warning" "{{items is $items}}" + + if [empty_string_p $items] { + return [list] + } else { + return [list 0 "WimpyPoint Presentations" "
      \n$items\n
    "] + } +} + +proc_doc wp_help_header { title } { Returns a help header for WimpyPoint. } { + return "[ad_header $title] +

    $title

    +Return to WimpyPoint +
    +" + +} + +proc_doc wp_header args { Returns a header for WimpyPoint. } { + return [wp_header_intl "*NONE*" $args] +} + +proc_doc wp_header_form { form args } { Returns a header for WimpyPoint. } { + return [wp_header_intl $form $args] +} + +proc wp_header_intl { form argv } { + set title [lindex $argv end] + + set help [help_link] + if { $help != "" } { + set help "
    $help
    " + } else { + set help "" + } + + return "[ad_header $title] +
    +

    $title

    +[wp_context_bar $argv] +
    +$help +" +} + +proc_doc wp_check_numeric { num } { Verifies that $num is numeric; otherwise bails (someone is playing games with us). } { + expr double($num) + return $num +} + +proc_doc wp_footer {} { Returns a footer for WimpyPoint. } { + set footer [ad_footer] + + return $footer +} + +proc_doc wp_access { db presentation_id user_id { priv "read" } } { Returns the user's actual level, if the user can perform $priv roles on the presention. } { + return [database_to_tcl_string $db " + select wp_access(presentation_id, $user_id, '$priv', public_p, creation_user, group_id) + from wp_presentations + where presentation_id = $presentation_id + "] +} + +proc_doc wp_check_authorization { db presentation_id user_id { priv "read" } } { Verifies that the user can perform $priv roles on the presentation, returning an error and bailing if not. If authorized, returns the level at which the user is actually authorized. } { + set auth [wp_access $db $presentation_id $user_id $priv] + if { $auth == "" } { + ad_return_error "Authorization Failed" "You do not have the proper authorization to access this feature." + return -code return + } + return $auth +} + +proc_doc wp_check_style_authorization { db style_id user_id } { Verifies that the user owns this style. } { + if { [database_to_tcl_string $db "select owner from wp_styles where style_id = [wp_check_numeric $style_id]"] != $user_id } { + ad_return_error "Authorization Failed" "You do not have the proper authorization to access this feature." + return -code return + } +} + +proc_doc wp_ljoin { list values } { Appends each of values (a list) to the list. } { + upvar $list ll + foreach v $values { + lappend ll $v + } +} + +proc_doc wp_select { db sql code { else "" } { elsecode "" } } { Performs a select, setting variables and executing code for each record. } { + uplevel set selection [ns_db select $db $sql] + set counter 0 + while { [uplevel "ns_db getrow $db " \$selection] } { + uplevel set_variables_after_query + uplevel $code + incr counter + } + if { $else == "else" } { + if { $elsecode == "" } { + error "no else code provided" + } elseif { $counter == 0 } { + uplevel $elsecode + } + } elseif { $else != "" } { + error "invalid syntax (expected else)" + } +} + +proc_doc wp_nextval { db seq } { Returns the next value of a sequence. } { + return [database_to_tcl_string $db "select $seq.nextval from dual"] +} + +proc_doc wp_prepare_dml { table names values { condition "" } } { Prepares a DML statement with columns names and value values. If condition is empty, does an insert - otherwise does an update. } { + if { $condition == "" } { + return "insert into ${table}([join $names ",\n "])\nvalues([join $values ",\n "])" + } else { + set sql "update $table set " + for { set i 0 } { $i < [llength $names] } { incr i } { + if { $i != 0 } { + append sql ",\n " + } + append sql "[lindex $names $i] = [lindex $values $i]" + } + append sql "\nwhere $condition" + return $sql + } +} + +proc_doc wp_clob_dml { db sql clobs } { Executes a DML, optionally with up to 3 clobs. } { + if { [llength $clobs] == 0 } { + ns_db dml $db $sql + } else { + ns_log "Error" "wp_clob_dml called with clob values!" + } + set clist [list] +} + +proc_doc wp_try_dml_or_break { db sql { clobs "" } } { Calls wp_try_dml, returning if it fails. } { + if { [wp_try_dml $db $sql $clobs] } { + return -code return + } +} + +proc_doc wp_try_dml { db sql { clobs "" } } { Tries to execute a DML statement, optionally with clobs. If it fails, ns_writes an error and returns 1. } { + if { [catch { wp_clob_dml $db $sql $clobs } err] } { + ad_return_error "Error" "The following error occurred while trying to write to the database: + +
    [philg_quote_double_quotes $err]
    + +Please back up and try again." + return 1 + } + return 0 +} + +proc_doc wp_context_bar { argv } "Returns a Yahoo-style hierarchical navbar, starting with a link to workspace." { + if { [ad_get_user_id] == 0 } { + set choices [list] + } else { + set choices [list "Your Workspace"] + } + set index 0 + foreach arg $argv { + incr index + if { $arg == "" } { + continue + } + if { $index == [llength $argv] } { + lappend choices $arg + } else { + lappend choices "[lindex $arg 1]" + } + } + return [join $choices " : "] +} + +proc wp_serve_style {} { + set url [ns_conn url] + + # Grok the URL. + if { ![regexp {/(default|[0-9]+)/((.+)\.css|(.+))$} $url all style_id filename serve_css serve_file] } { + ns_returnnotfound + return + } + set db [ns_db gethandle] + if { $style_id == "default" } { + set style_id -1 + } + + if { $serve_css != "" } { + # Requested file ".css" - serve up the CSS source. + set css [database_to_tcl_string $db "select css from wp_styles where style_id = $style_id"] + ns_return 200 "text/css" $css + } else { + # Requested a particular file. Find the mime type and send the file. + ReturnHeaders [database_to_tcl_string $db " + select mime_type + from wp_style_images + where style_id = $style_id + and file_name = '[DoubleApos $serve_file]' + "] + set image_id [database_to_tcl_string $db " + select lob + from wp_style_images + where style_id = $style_id + and file_name = '[DoubleApos $serve_file]' + "] + ns_pg blob_write $db $image_id + } + + ns_db releasehandle $db +} + +proc_doc wp_slide_header { presentation_id title style text_color background_color background_image link_color vlink_color alink_color } { Generates a header for slides. } { + if { $style == "" || $style == -1 } { + set style "default" + } + + set out " + + + + $title + +\n" + return $out +} + +proc_doc wp_slide_footer { presentation_id page_signature { timer_start "" } } { Generates a footer for slides, including a timer at the bottom. Use $timer_start of "style" for style selection instead. } { + + if { $timer_start == "" } { + set time_str "" + } elseif { $timer_start == "style" } { + set time_str "change style" + } else { + set elapsed [expr int(([ns_time] - $timer_start) / 60)] + if { $elapsed >= 3 } { + set time_str "$elapsed minutes" + } else { + set time_str "" + } + } + + return " +
    + + + + + +
    $page_signature + $time_str
    + + +" +} + +proc_doc wp_break_attachments { attach which } { Searches through $attach, a list of id/file_size/file_name/display lists, for items where display = $which. If any are found, generates a
    . } { + foreach item $attach { + if { [lindex $item 3] == $which } { + return "
    " + } + } + return "" +} + +proc_doc wp_show_attachments { attach which align } { Searches through $attach, a list of id/file_size/file_name/display lists, for items where display = $which, and displays them aligned right or center or linked. } { + set out "" + foreach item $attach { + if { [lindex $item 3] == $which } { + if { $align == "link" } { + if { $out != "" } { + append out " / " + } + append out "[philg_quote_double_quotes [lindex $item 2]] +([expr { [lindex $item 1] / 1024 }]K)" + } else { + if { $align == "center" } { + append out "
    " + } + append out "\n" + } else { + append out ">
    \n" + } + } + } + } + if { $align == "link" && $out != "" } { + append out "

    \n" + } + return $out +} + +proc wp_serve_presentation { conn edit } { + set url [ns_conn url] + if { ![regexp {/([0-9]+)(-v([0-9]+))?(/((break)?([0-9]+|index)\.wimpy)?)?$} $url \ + all presentation_id version_dot version after file_name break slide_id] } { + ns_returnnotfound + return + } + if { $after == "" } { + ns_returnredirect "$presentation_id/" + return + } + + if { $version == "" } { + set version_condition "max_checkpoint is null" + set version_or_null -1 + } else { + set version_condition "wp_between_checkpoints_p($version, min_checkpoint, max_checkpoint) = 't'" + set version_or_null $version + } + + set db [ns_db gethandle] + set auth [wp_check_authorization $db $presentation_id [ad_verify_and_get_user_id] "read"] + + set selection [ns_db 1row $db " + select p.*, u.first_names, u.last_name + from wp_presentations p, users u + where p.presentation_id = $presentation_id + and p.creation_user = u.user_id + "] + set_variables_after_query + + # See if the user has overridden the style preferences. + regexp {wp_override_style=(-?[0-9]+)} [ns_set get [ns_conn headers] Cookie] all style + + if { $style == "" } { + set style -1 + } + + set selection [ns_db 1row $db "select * from wp_styles where style_id = $style"] + set_variables_after_query + + set user_id [ad_verify_and_get_user_id] + + if { [regexp {wp_back=([^;]+)} [ns_set get [ns_conn headers] Cookie] all back] } { + set back [ns_urldecode $back] + } else { + set back "../../" + } + + # Set the timer cookie, if not already set. + if { [regexp {wp_timer=([0-9]+),([0-9]+)} [ns_set get [ns_conn headers] Cookie] all timer_presentation_id timer_start] && + $timer_presentation_id == $presentation_id } { + set cookie "" + } else { + set timer_start [ns_time] + set cookie "Set-Cookie: wp_timer=$presentation_id,$timer_start; path=/\n" + } + + set referer [ns_set get [ns_conn headers] Referer] + if { $break != "break" && [regexp {(/wimpy/|/(index|one-user|search|presentation-top|presentations-by-date)\.tcl)(\?|$)} $referer] } { + # Try to remember how the user got here. + append cookie "Set-Cookie: wp_back=[ns_urlencode $referer]; path=/\n" + set back $referer + } + + if { $slide_id == "index" || $file_name == "" || $break == "break" } { + # Serve a presentation index page. + + ns_write "HTTP/1.0 200 OK +MIME-Version: 1.0 +Content-Type: text/html +$cookie +[wp_slide_header $presentation_id $title $style $text_color $background_color $background_image $link_color $vlink_color $alink_color] + +" + + set first "" + set out "" + + # How should we get a list of slides in the presentation? Depends on + # whether we're looking at the most recent version, or a historical + # copy. + if { $version == "" } { + set sql " + select slide_id as id, title as slide_title + from wp_slides + where presentation_id = $presentation_id + and $version_condition + order by sort_key + " + } else { + set sql " + select s.slide_id as id, s.title as slide_title + from wp_slides s, wp_historical_sort h + where s.slide_id = h.slide_id + and h.checkpoint = $version + and s.presentation_id = $presentation_id + and $version_condition + order by h.sort_key + " + } + set before_break "" + set previous "" + wp_select $db $sql { + if { $id == $slide_id } { + set before_break $previous + } + set previous $id + + append out "

  • " + if { $break == "break" } { + # Context break: the only slide linked is the next slide. + if { $id == $slide_id } { + append out "$slide_title\n" + } else { + append out "$slide_title\n" + } + } else { + append out "$slide_title\n" + } + if { $first == "" } { + set first $id + } + } + + set menu_items [list] + + if { $break == "break" } { + lappend menu_items "previous" + lappend menu_items "top" + } else { + lappend menu_items "done" + } + if { $edit } { + lappend menu_items "edit" + } + if { $break == "break" } { + if { $slide_id != "" } { + lappend menu_items "next" + } + } else { + if { $first != "" } { + lappend menu_items "next" + } + } + + if { $edit && $auth != "read" } { + set comments [ad_general_comments_list $db $presentation_id "wp_presentations" $title "wp"] + } else { + set comments "" + } + + set collaborators "" + wp_select $db " + select u.first_names as collaborator_first, u.last_name as collaborator_last, u.user_id as collaborator_user + from users u, user_group_map m + where m.group_id = $group_id + and (m.role = 'write' or m.role = 'admin') + and m.user_id = u.user_id + " { + lappend collaborators "$collaborator_first $collaborator_last" + } + if { [llength $collaborators] != 0 } { + if { [llength $collaborators] <= 2 } { + set collaborators_str "
    in collaboration with [join $collaborators " and "]" + } else { + set collaborators [lreplace $collaborators end end "and [lindex $collaborators end]"] + set collaborators_str "
    in collaboration with [join $collaborators ", "]" + } + } else { + set collaborators_str "" + } + + ns_write " + + +
    [join $menu_items " | "]
    + +

    $title

    +a WimpyPoint presentation owned by $first_names $last_name $collaborators_str + +
    +
      +$out +
    + +[expr { $copyright_notice != "" ? "

    $copyright_notice" : "" }] + +$comments + +[wp_slide_footer $presentation_id $page_signature [expr { $break == "break" ? $timer_start : "style" }]] +" + } else { + # Serve slide $slide_id. + + # Different ways of determining previous/next slide when versioning. + # XXX: Consolidate these (they're almost identical). + if { $version == "" } { + set selection [ns_db 1row $db " + select title, + preamble, bullet_items, postamble, + include_in_outline_p, context_break_after_p, modification_date, + wp_previous_slide(sort_key, presentation_id, $version_or_null) as previous, wp_next_slide(sort_key, presentation_id, $version_or_null) as next, + coalesce(original_slide_id, slide_id) as original_slide_id + from wp_slides + where slide_id = [wp_check_numeric $slide_id] + and presentation_id = [wp_check_numeric $presentation_id] + "] + } else { + set selection [ns_db 1row $db " + select title, + preamble, bullet_items, postamble, + include_in_outline_p, context_break_after_p, modification_date, + wp_previous_slide((select sort_key from wp_historical_sort where slide_id = $slide_id and checkpoint = $version), presentation_id, $version) as previous, + wp_next_slide((select sort_key from wp_historical_sort where slide_id = $slide_id and checkpoint = $version), presentation_id, $version) as next, + coalesce(original_slide_id, slide_id) as original_slide_id + from wp_slides + where slide_id = [wp_check_numeric $slide_id] + and presentation_id = [wp_check_numeric $presentation_id] + "] + } + set_variables_after_query + + set menu_items [list] + + if { $previous != "" } { + lappend menu_items "previous" + } + lappend menu_items "top" + if { $edit } { + lappend menu_items "edit" + lappend menu_items "delete" + } + if { $next != "" } { + if { $context_break_after_p == "t" } { + lappend menu_items "next" + } else { + lappend menu_items "next" + } + } elseif { $edit } { + lappend menu_items "done" + } + + ns_write "HTTP/1.0 200 OK +MIME-Version: 1.0 +Content-Type: text/html +$cookie +[wp_slide_header $presentation_id $title $style $text_color $background_color $background_image $link_color $vlink_color $alink_color] + + + +
    [join $menu_items " | "]
    + +

    $title

    +" + + # Get attachments, if any. + set attach [list] + wp_select $db " + select attach_id, file_size, file_name, display + from wp_attachments + where slide_id = $slide_id + order by lower(file_name) + " { + lappend attach [list $attach_id $file_size $file_name $display] + } + + if { $edit && $auth != "read" } { + set comments [ad_general_comments_list $db $original_slide_id "wp_slides" $title "wp"] + } else { + set comments "" + } + + ns_write " + +
    +[wp_show_attachments $attach "" "link"] + +[wp_show_attachments $attach "top" "center"] +[wp_show_attachments $attach "preamble" "right"] + +$preamble +[wp_break_attachments $attach "preamble"] +[wp_show_attachments $attach "after-preamble" "center"] +" + + ns_write " +[wp_show_attachments $attach "bullets" "right"] +[expr { $bullet_items != "" ? "
      \n
    • [join $bullet_items "
    • \n"]\n" : ""}] +" + + ns_write [wp_break_attachments $attach "bullets"] + +ns_write " +[expr { $bullet_items != "" ? "
    " : "

    " }] +" + ns_write [wp_show_attachments $attach "after-bullets" "center"] + + ns_write " +[wp_show_attachments $attach "postamble" "right"] + +$postamble + +[wp_break_attachments $attach "postamble"] +[wp_show_attachments $attach "bottom" "center"] +" + + ns_write " +[expr { $show_modified_p == "t" ? "

    Last modified $modification_date" : "" }] +[expr { $copyright_notice != "" ? "

    $copyright_notice" : "" }] + +$comments + +[wp_slide_footer $presentation_id $page_signature $timer_start] +" + } + +} + +proc wp_serve_attach {} { + set user_id [ad_verify_and_get_user_id] + + if { ![regexp {([^/]+)/([^/]+)$} [ns_conn url] match attach_id client_filename] } { + ad_return_error "Malformed Attachment Request" "Your request for a file attachment was malformed." + return + } + + # security check (BMA, spec'ed by ad) + validate_integer attach_id $attach_id + + set db [ns_db gethandle] + + set selection [ns_db 1row $db " + select s.presentation_id, a.slide_id, a.attach_id, a.mime_type + from wp_slides s, wp_attachments a + where attach_id = $attach_id + and s.slide_id = a.slide_id + "] + set_variables_after_query + wp_check_authorization $db $presentation_id $user_id + + ReturnHeaders $mime_type + + set attachment_lob [database_to_tcl_string $db "select lob from wp_attachments where attach_id = $attach_id"] + ns_pg blob_write $db $attachment_lob + + ns_db releasehandle $db +} + + +proc_doc wp_style_url {} { Returns the StyleURL parameter (no trailing slash). } { + set url [ad_parameter "StyleURL" wp "/wp/style/"] + regsub {/$} $url "" url + return $url +} + +proc_doc wp_presentation_url {} { Returns the PresentationURL parameter (no trailing slash). } { + set url [ad_parameter "PresentationURL" wp "/wp/display/"] + regsub {/$} $url "" url + return $url +} + +proc_doc wp_presentation_edit_url {} { Returns the PresentationEditURL parameter (no trailing slash). } { + set url [ad_parameter "PresentationEditURL" wp "/wp/display-edit/"] + regsub {/$} $url "" url + return $url +} + +proc_doc wp_attach_url {} { Returns the AttachURL parameter (no trailing slash). } { + set url [ad_parameter "AttachURL" wp "/wp/attach/"] + regsub {/$} $url "" url + return $url +} + +proc_doc wp_only_if { condition text { elsetext "" } } { If condition, returns text; otherwise returns elsetext. } { + if [uplevel expr "{ $condition }"] { + return $text + } else { + return $elsetext + } +} + +proc_doc wp_role_predicate { role { title "" } } { Returns a plain-English string describing an role (read/write/admin). } { + if { $title != "" } { + set space " " + } else { + set space "" + } + + if { $role == "read" } { + return "view the presentation$space$title" + } elseif { $role == "write" } { + return "view and make changes to the presentation$space$title" + } elseif { $role == "admin" } { + return "view and make changes to the presentation$space$title, and decide who gets to view/edit it" + } + error "role must be read, write, or admin" +} + +proc_doc wp_short_role_predicate { role { title "" } } { Returns a short plain-English string describing an role (read/write/admin). } { + if { $title != "" } { + set space " " + } else { + set space "" + } + + if { $role == "read" } { + return "view the presentation$space$title" + } elseif { $role == "write" || $role == "admin" } { + return "work on the presentation$space$title" + } + error "role must be read, write, or admin" +} + +proc_doc wp_slider { which current items } { Generates a slider for form variable $which with items $items, of the form { { 1 "One" } { 2 "Two" } }, where 1/2 are the query values and One/Two are the corresponding labels. } { + set choices "" + + regexp {/([^/]*)$} [ns_conn url] "" dest_url + if { $dest_url == "" } { + set dest_url "index.tcl" + } + + foreach i $items { + set newval [lindex $i 0] + set label [lindex $i 1] + + if { $current != $newval } { + # Not currently selected - generate the link. + lappend choices "$label" + } else { + # Currently selected. + lappend choices "$label" + } + } + + return "\[ [join $choices " | "] \]" +} + +ns_register_proc GET [wp_style_url] wp_serve_style +ns_register_proc GET [wp_presentation_url] wp_serve_presentation 0 +ns_register_proc GET [wp_presentation_edit_url] wp_serve_presentation 1 +ns_register_proc GET [wp_attach_url] wp_serve_attach Index: web/openacs/tcl/zz-postload.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/tcl/zz-postload.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/tcl/zz-postload.tcl 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,15 @@ +# zz-postload.tcl,v 3.2 2000/02/27 06:57:31 jsalz Exp +# Name: 00-ad-postload.tcl +# Author: Jon Salz +# Date: 24 Feb 2000 +# Description: Sources library files that need to be loaded after the rest. + +ns_log "Notice" "Sourcing files for postload..." +foreach file { + ad-custom.tcl.postload +} { + ns_log Notice "postloading [ns_info tcllib]/$file" + source "[ns_info tcllib]/$file" +} +ns_log "Notice" "Done." + Index: web/openacs/templates/ecommerce/account.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/account.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/account.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,25 @@ +Your Account +Your Account + +

    + + +

    +

    Your Order History

    + +
      +<%= $past_orders %> +
    + +<%= $purchased_gift_certificates %> + +<%= $mailing_lists %> + +
    + + \ No newline at end of file Index: web/openacs/templates/ecommerce/category-browse-subcategory.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/category-browse-subcategory.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/category-browse-subcategory.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,36 @@ +$the_category_name +$the_category_id + +
    + + +

    +<%= $the_category_name %> +

    + + + + + + +
    + Browse +
      + <%= $subcategories %> +
    +     		+ <%= $recommendations %> +
    + + <%= $products %> + + <%= $prev_link %> <%= $separator %> <%= $next_link %> +

    + +

    + +Add yourself to the <%= $the_category_name %> mailing list! + + + + \ No newline at end of file Index: web/openacs/templates/ecommerce/category-browse-subsubcategory.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/category-browse-subsubcategory.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/category-browse-subsubcategory.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,36 @@ +$the_category_name +$the_category_id + +

    + + +

    +<%= $the_category_name %> +

    + + + + + + +
    + Browse +
      + <%= $subcategories %> +
    +     		+ <%= $recommendations %> +
    + + <%= $products %> + + <%= $prev_link %> <%= $separator %> <%= $next_link %> +

    + +

    + +Add yourself to the <%= $the_category_name %> mailing list! + + + + \ No newline at end of file Index: web/openacs/templates/ecommerce/category-browse.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/category-browse.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/category-browse.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,36 @@ +$the_category_name +$the_category_id + +

    + + +

    +<%= $the_category_name %> +

    + + + + + + +
    + Browse +
      + <%= $subcategories %> +
    +     		+ <%= $recommendations %> +
    + + <%= $products %> + + <%= $prev_link %> <%= $separator %> <%= $next_link %> +

    + +

    + +Add yourself to the <%= $the_category_name %> mailing list! + + + + \ No newline at end of file Index: web/openacs/templates/ecommerce/checkout-2.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/checkout-2.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/checkout-2.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,38 @@ +Completing Your Order + +
    + +

    Completing Your Order

    + +
      + +
    1. Check your order. + +

      + +Please verify that the items and quantities shown below are correct. Put a 0 (zero) in the +Quantity field to remove a particular item from your order. + +> + + + + + + +<%= $rows_of_items %> +
      Quantity
      + +

      + +<%= $shipping_options %> + +

    + +
    + +
    + +
    • + + Index: web/openacs/templates/ecommerce/checkout-3.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/checkout-3.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/checkout-3.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,20 @@ +Please Confirm Your Order + +
    + +

    Please Confirm Your Order

    + +
    + +
    +Push Submit to send us your order! + + +<%= $order_summary %> + +Push Submit to send us your order! + +
    + +
    + Index: web/openacs/templates/ecommerce/checkout.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/checkout.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/checkout.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,17 @@ +Completing Your Order +
    + +

    Completing Your Order

    + +
    + +

    + +<%= $saved_addresses %> +

    + +
    + \ No newline at end of file Index: web/openacs/templates/ecommerce/credit-card-correction.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/credit-card-correction.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/credit-card-correction.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,42 @@ +Sorry, We Were Unable to Authorize Your Credit Card + +
    + +

    Sorry, We Were Unable to Authorize Your Credit Card

    + +
    + +

    +At this time we are unable to receive authorization to charge your +credit card. Please check the number and the expiration date and +try again or use a different credit card. + +

    + + + + + + + + + + + + + + + + + +
    Credit card number:>
    Type:<%= $ec_creditcard_widget %>
    Expires:<%= $ec_expires_widget %>
    Billing zip code: size=5>
    + +

    + +

    + +
    +
    + +
    + Index: web/openacs/templates/ecommerce/gift-certificate-claim.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/gift-certificate-claim.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/gift-certificate-claim.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,24 @@ +Claim a Gift Certificate + +
    + +

    Claim a Gift Certificate

    + +
    + +
    +If you've received a gift certificate, enter the claim +check below in order to put the funds into your gift certificate +account. +

    +If you've entered it before, you don't need to do so again. +The funds are already in your account. +

    + +Claim Check: + + + +

    +
    + Index: web/openacs/templates/ecommerce/gift-certificate-order-2.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/gift-certificate-order-2.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/gift-certificate-order-2.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,35 @@ +Your Gift Certificate Order +
    + +

    Your Gift Certificate Order

    + +
    + +
      +
    1. + + +
      To: (optional)
      From: (optional)
      +

      +

    2. Please enter the message you want to appear on the gift +certificate: (optional)
      +(maximum 200 characters) +
      + +

      +

    3. Gift certificate amount: + (in <%= $currency %>)
      +(between <%= $minimum_amount %> and <%= $maximum_amount %>) +

      +

    4. Recipient's email address: + +
    + +
    + +
    + + + + + Index: web/openacs/templates/ecommerce/gift-certificate-order-3.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/gift-certificate-order-3.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/gift-certificate-order-3.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,36 @@ +Payment Info + +
    + +

    Payment Info

    + + +<%= $hidden_form_variables %> + +
    + + + + + + + + + + + + + + + + + +
    Credit card number:
    Type:<%= $ec_creditcard_widget %>
    Expires:<%= $ec_expires_widget %>
    Billing zip code: size=5>
    +
    + +
    + +
    + +
    + Index: web/openacs/templates/ecommerce/gift-certificate-order-4.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/gift-certificate-order-4.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/gift-certificate-order-4.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,38 @@ +Please Confirm Your Gift Certificate Order + +
    + +

    Please Confirm Your Gift Certificate Order

    + +
    + +
    +<%= $hidden_form_variables %> +Push Submit to send us your order! + + +
    + + + + + +<%= $to_row %> +<%= $from_row %> +<%= $message_row %> + + + + + + + +
    Your email address:<%= $user_email %>

    Your Gift Certificate Order:
    Will be sent to:<%= $recipient_email %>

    Subtotal:<%= $formatted_amount %>
    Shipping:<%= $zero_in_the_correct_currency %>
    Tax:<%= $zero_in_the_correct_currency %>
    ----------------------
    Total Due:<%= $formatted_amount %>
    +
    + +Push Submit to send us your order! + +
    + +
    + Index: web/openacs/templates/ecommerce/gift-certificate-order.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/gift-certificate-order.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/gift-certificate-order.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,33 @@ +Gift Certificates + + +

    Gift Certificates

    + +
    + +The perfect gift for anyone, gift certificates +can be used to to buy anything at +<%= $system_name %>! + +

    + +>Order a Gift Certificate! + +

    + +About Gift Certificates + +

      +
    • Gift certificates are sent to the recipient via email shortly after you place your order. +
    • Any unused balance will be put in the recipient's gift certificate account. +
    • Gift certificates expire <%= $expiration_time %> from date of purchase. +
    • You can purchase a gift certificate for any amount between +<%= $minimum_amount %> and <%= $maximum_amount %>. +
    + +
    + + + + + Index: web/openacs/templates/ecommerce/gift-certificate-thank-you.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/gift-certificate-thank-you.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/gift-certificate-thank-you.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,17 @@ +Thank You For Your Gift Certificate Order + + +

    Thank You For Your Gift Certificate Order

    + +
    +The lucky recipient will be notified by email shortly! + +

    + +

    +
    + Index: web/openacs/templates/ecommerce/gift-certificate.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/gift-certificate.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/gift-certificate.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,14 @@ +Your Gift Certificate + + +

    Your Gift Certificate

    + +
    + +<%= $gift_certificate_summary %> + +
    + +

    + + \ No newline at end of file Index: web/openacs/templates/ecommerce/index.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/index.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/index.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,54 @@ +Welcome to [ec_system_name] + +Home + +

    +
    + +<% +# Here's a little Tcl "if statement" so that we can give them +# a different welcome message depending on whether they're +# logged on. If you edit the text, please remember to put +# a backslash before any embedded quotation marks (\") you add. + +if { $user_is_logged_on } { + set welcome_message "Welcome back $user_name! If you're not $user_name, click here." +} else { + set welcome_message "Welcome!" +} + +# and another statement which depends on whether gift certificates +# can be bought on this site (remember to put a backslash before any +# embedded quotation marks (\") you add.) + +if { $gift_certificates_are_allowed } { + set gift_certificate_message "Order a Gift Certificate!" +} else { + set gift_certificate_message "" +} + +# We're done with the Tcl. +%> + +<%= $welcome_message %> + + +<%= $search_widget %> + +

    + +<%= $recommendations_if_there_are_any %> + +<%= $products %> + +<%= $prev_link %> <%= $separator %> <%= $next_link %> + + +

    +<%= $gift_certificate_message %> +

    + +
    + +Home + Index: web/openacs/templates/ecommerce/mailing-list-add-2.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/mailing-list-add-2.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/mailing-list-add-2.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,14 @@ +You've been added to the $mailing_list_name mailing list! + + +

    You've been added to the <%= $mailing_list_name %> mailing list!

    + +
    + +To remove yourself anytime, go to <%= $remove_link %> + +<%= $continue_shopping_options %> + +
    + + Index: web/openacs/templates/ecommerce/mailing-list-add.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/mailing-list-add.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/mailing-list-add.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,20 @@ +Add yourself to the $mailing_list_name mailing list! + + +

    Add yourself to the <%= $mailing_list_name %> mailing list!

    + +
    +We think that you are <%= $user_name %>. If not, please log in. Otherwise, + +

    + +

    +<%= $hidden_form_variables %> + +
    + +
    +
    + +
    + \ No newline at end of file Index: web/openacs/templates/ecommerce/mailing-list-remove.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/mailing-list-remove.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/mailing-list-remove.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,21 @@ +You've been removed from the $mailing_list_name mailing list + + +

    You've been removed from the <%= $mailing_list_name %> mailing list

    + +
    + +To re-add yourself anytime, go to +<%= $re_add_link %> + +

    To see your other subscriptions (if any), + return to <%= $back_to_account_link %>. + +<%= $continue_shopping_options %> + +

    + + + + + Index: web/openacs/templates/ecommerce/order.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/order.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/order.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,14 @@ +Your Order + + +

    Your Order

    + +
    + +<%= $order_summary %> + +
    + +

    + + \ No newline at end of file Index: web/openacs/templates/ecommerce/payment.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/payment.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/payment.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,103 @@ +Payment Info + +
    + +

    Payment Info

    + +
    + +
    > + +<% + +# We have to use a little bit of Tcl to take care of cases like: +# the customer's gift certificate balance covers the cost of +# the order (so they don't need a credit card form) or they +# are/aren't allowed to reuse old credit card numbers + +# If you edit the text, remember to put a backslash before any +# embedded quotation marks (\"). + +# first set certificate_message so we can use it later +if { $gift_certificate_covers_whole_order } { + set certificate_message "Your gift certificate balance covers the + total cost of your order. No need to enter any payment information! +

    " +} elseif { $gift_certificate_covers_part_of_order } { + set certificate_message "Your gift certificate balance takes care of + $certificate_amount of your order! Please enter credit card information + to pay for the rest. +

    " +} else { + set certificate_message "" +} + +# now set credit_card_message_1 and credit_card_message_2 that will be printed +# if the user is allowed to reuse old credit cards (depending on admin settings) + +set credit_card_message_1 "Since we already have a credit card on file for you, +you can just click on the button next to it to use it for this order. +

    " + +set credit_card_message_2 "

    +Or enter a new credit card for billing: +
    +If you're using a new card, please enter the full credit card number below. +

    " + +# we're done setting variables +%> + +<%= $certificate_message %> + +<% +# We have to go back into Tcl to take care of the case where the gift certificate +# doesn't cover the whole order (notice that there's an "!", which means "not", inside +# the "if statement") + +if { !$gift_certificate_covers_whole_order } { + + # ns_puts means "print this" + ns_puts "

    + Click here to claim a new gift certificate +

    + " + if { $customer_can_use_old_credit_cards } { + ns_puts "$credit_card_message_1 + $old_cards_to_choose_from + $credit_card_message_2 + " + } + + ns_puts " + + + + + + + + + + + + + + + +
    Credit card number:
    Type:$ec_creditcard_widget
    Expires:$ec_expires_widget
    Billing zip code:
    +

    + " +} + +# Done with Tcl +%> + +
    + +
    + +
    + +
    + Index: web/openacs/templates/ecommerce/product-search.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/product-search.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/product-search.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,18 @@ +$category_name + + + +

    +Your search results: +

    + +

    + +<%= $search_results %> + +
    + + + + + Index: web/openacs/templates/ecommerce/review-submit-2.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/review-submit-2.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/review-submit-2.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,34 @@ +Check Your Review + +
    + +

    Check your review of <%= $product_name %>

    + +
    + +
    +<%= $hidden_form_variables %> + +Press this button when you are ready to + +

    + +Here is your review the way it will appear: + +

    + +<%= $review_as_it_will_appear %> +

    + +

    + +If this isn't the way you want it to look, please back up using your browser and edit your review. Submissions become the property of <%= $system_name %>. + +

    + +Press this button when you are ready to +

    + +
    + + \ No newline at end of file Index: web/openacs/templates/ecommerce/review-submit-3.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/review-submit-3.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/review-submit-3.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,37 @@ +Thank you for your review of $product_name + +

    Thank you for your review of <%= $product_name %>

    + +
    + +<% + +# This is a Tcl "if statement" which used to give a different message to the +# users depending on whether your system was set up to automatically post user +# comments or to require administrator approval before comments are posted. +# If you edit any of the text, please remember to put a backslash before any +# nested quotation marks you add. + +if { $comments_need_approval } { + set message_to_print "Your review has been received. Thanks for sharing + your thoughts with us! It can take a few days for your review to appear + on our web site. If your review has not appeared on our site and you + would like to know why, please send email to + $system_owner_email." + } else { + set message_to_print "Your review has been received. Thanks for sharing + your thoughts with us! Your review is now viewable from the $product_name page." +} + +# OK, we're done with the "if statement" +%> + +<%= $message_to_print %> + +

    + +>Return to the item you just reviewed. + +

    + + \ No newline at end of file Index: web/openacs/templates/ecommerce/review-submit.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/review-submit.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/review-submit.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,34 @@ +Write your own review of $product_name + + +

    Write your own review of <%= $product_name %>

    + +
    + +> + +
      +
    1. What is your rating of this product? <%= $rating_widget %> + +

      + +

    2. Please enter a headline for your review:
      + + +

      + +

    3. Enter your review below: (maximum of 1,000 words)
      + + +

      + +

    4. We want to give you a chance to see how your review will appear before we place it online. Please take a minute to + +
      5. + +
    + + + + + Index: web/openacs/templates/ecommerce/shipping-address-international.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/shipping-address-international.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/shipping-address-international.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,48 @@ +Enter a Shipping Address +
    +

    Enter a Shipping Address

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    Name>
    Address
    2nd line (optional)
    City
    Province or Region
    Postal Code
    Country<%= $country_widget %>
    Phone day     evening
    +
    +

    +

    + +
    +
    + + \ No newline at end of file Index: web/openacs/templates/ecommerce/shipping-address.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/shipping-address.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/shipping-address.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,43 @@ +Enter a Shipping Address +
    +

    Enter a Shipping Address

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + +
    Name>
    Address
    2nd line (optional)
    City  State <%= $state_widget %>
    Zip
    Phone day     evening
    +
    +

    +

    + +
    +
    + + + + + Index: web/openacs/templates/ecommerce/shopping-cart-retrieve-2.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/shopping-cart-retrieve-2.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/shopping-cart-retrieve-2.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,19 @@ +Select Shopping Cart + + +

    Select Shopping Cart

    + +
    + +Your saved shopping cart(s): + +

    + +

      + +<%= $saved_carts %> + +
    + +
    + \ No newline at end of file Index: web/openacs/templates/ecommerce/shopping-cart-retrieve-3.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/shopping-cart-retrieve-3.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/shopping-cart-retrieve-3.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,73 @@ +$page_title + + +

    <%= $page_title %>

    + +
    + +<% + +# This page performs a number of different functions depending on how it's +# accessed. +# Therefore the content needs to be contained inside a Tcl "if statement". +# Here's the "if statement". If you modify any of the text, make sure you +# put a backslash before any embedded quotation marks you add. + +if { $page_function == "view" } { + + set page_contents "
    + $hidden_form_variables + + +
    +
    + Saved on $saved_date

    + + $shopping_cart_items +
    +

    + + " + + if { $product_counter == 0 } { + append page_contents "Your Shopping Cart is empty." + } + +} elseif { $page_function == "retrieve" } { + + set page_contents "
    + [export_form_vars order_id] + You currently already have a shopping cart. Would you like to merge your current shopping cart with the shopping cart you are retrieving, or should the shopping cart you're retrieving completely replace your current shopping cart? +

    + +

    + + +
    + +
    + " +} elseif { $page_function == "discard" } { + + set page_contents "
    + $hidden_form_variables + If you discard this shopping cart, it will never be retrievable. Are you sure you want to discard it? +

    +

    + + +
    +
    + " +} + +# OK, that's all the Tcl. Not too bad. Just make sure that all embedded +# quotation marks have a backslash before them (\"), otherwise you'll get +# an error. + +%> + +<%= $page_contents %> + +
    + \ No newline at end of file Index: web/openacs/templates/ecommerce/shopping-cart-retrieve.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/shopping-cart-retrieve.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/shopping-cart-retrieve.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,22 @@ +Retrieve Shopping Cart +
    + +

    Retrieve Your Shopping Cart

    + +
    + +We think that you are <%= $user_name %>. If not, please +log in. + +Otherwise, + +

    + +

    +
    + +
    +
    + +
    + \ No newline at end of file Index: web/openacs/templates/ecommerce/shopping-cart-save-2.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/shopping-cart-save-2.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/shopping-cart-save-2.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,20 @@ +Your Shopping Cart Has Been Saved + + +

    Your Shopping Cart Has Been Saved

    + +
    + +When you're ready to return to it, just click on "Retrieve Saved Cart" from +the Shopping Cart page. We'll save your cart for you for +CartDuration days. + +
    + +

    + +Continue Shopping + +

    + + Index: web/openacs/templates/ecommerce/shopping-cart-save.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/shopping-cart-save.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/shopping-cart-save.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,19 @@ +Save Shopping Cart + + +

    Save Your Shopping Cart

    + +
    + +We think that you are <%= $user_name %>. If not, please log in. Otherwise, + +

    + +

    +
    + +
    +
    + +
    + Index: web/openacs/templates/ecommerce/shopping-cart.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/shopping-cart.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/shopping-cart.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,13 @@ +Shopping Cart +Shopping Cart + +
    +

    + +<%= $cart_contents %> + +

      +<%= $bottom_links %> +
    +
    + Index: web/openacs/templates/ecommerce/thank-you.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/thank-you.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/thank-you.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,19 @@ +Thank You For Your Order + +

    Thank You For Your Order

    + + +
    + +Please print this page for your records + +<%= $order_summary %> + +
    + +

    + + + + + Index: web/openacs/templates/ecommerce/track.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/track.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/track.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,18 @@ +Your Shipment + + +

    Your Shipment

    + +
      +
    • Shipping Date: <%= $pretty_ship_date %> +
    • Carrier: <%= $carrier %> +
    • Tracking Number: <%= $tracking_number %> +
    + +

    Information from <%= $carrier %>

    + +
    +<%= $carrier_info %> +
    + + Index: web/openacs/templates/ecommerce/update-user-classes.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/ecommerce/update-user-classes.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/ecommerce/update-user-classes.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,34 @@ +Your Account +Your Account + +
    + +
    + +<% +# we will break out into a little Tcl so that you can change +# the message you give users depending on whether they need +# approval to become a member of a user class + +if { $user_classes_need_approval } { + set select_message "Submit a request to be in the following user classes:" +} else { + set select_message "Select the user classes you belong in:" +} +%> + +<%= $select_message %> + +
    +<%= $user_class_select_list %> +
    + +
    + +
    +
    + + +
    + + \ No newline at end of file Index: web/openacs/templates/gp/administer-permissions.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/gp/administer-permissions.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/gp/administer-permissions.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,48 @@ + + +Administer Permissions + + + + + +

    Administer Permissions

    + +for ><%= $object_name %> + +
    + +
    + +<%= $permission_grid %> + +
      +
    • <%= $grant_permission_to_user_link %> +
    • <%= $grant_permission_to_group_link %> +
    • Go >back to where you were +
    + +
    + +<%= [ad_footer] %> + Index: web/openacs/templates/gp/edit-permissions.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/gp/edit-permissions.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/gp/edit-permissions.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,47 @@ + + +Edit Permissions + + + + + +

    Edit Permissions

    + +for ><%= $object_name %> + +
    + +
    + +<%= $permission_grid %> + +
      +
    • <%= $grant_permission_to_user_link %> +
    • <%= $grant_permission_to_group_link %> +
    + +
    + +<%= [ad_footer] %> + Index: web/openacs/templates/gp/permission-grant-to-group.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/gp/permission-grant-to-group.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/gp/permission-grant-to-group.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,43 @@ +<%= [ad_header "Grant Permission"] %> + +

    Grant Permission

    + +on ><%= $object_name %> + +
    + +
    + +<%= [export_form_vars on_what_id on_which_table scope user_id_from_search return_url] %> + +
    + +Grant + +
    + read
    + comment
    + write
    + administer +
    + +permission on ><%= $object_name %> +to + +
    + all members
    + members in the role: + +
    + +of <%= $user_group_widget %> + +
    + +
    + +
    + +
    + +<%= [ad_footer] %> Index: web/openacs/templates/gp/permission-grant-to-user-2.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/gp/permission-grant-to-user-2.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/gp/permission-grant-to-user-2.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,36 @@ +<%= [ad_header "Grant Permission to $full_name"] %> + +

    Grant Permission

    + +on ><%= $object_name %> +to <%= $full_name %> + +
    + +
    + +<%= [export_form_vars on_what_id on_which_table scope user_id_from_search return_url] %> + +
    + +Grant + +
    + read
    + comment
    + write
    + administer +
    + +permission on ><%= $object_name %> +to <%= $full_name %> + +
    + +
    + +
    + +
    + +<%= [ad_footer] %> Index: web/openacs/templates/gp/permission-grant-to-user.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/gp/permission-grant-to-user.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/gp/permission-grant-to-user.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,30 @@ +<%= [ad_header "Grant Permission"] %> + +

    Grant Permission

    + +on ><%= $object_name %> + +
    + +Identify user by + +
    + +<%= [export_entire_form] %> +<%= [export_form_vars passthrough] %> + + + + + + +
    Email address:
    or by
    Last name:
    + +

    + +

    + +
    +
    + +<%= [ad_footer] %> Index: web/openacs/templates/gp/revoke-only-administer-permission.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/gp/revoke-only-administer-permission.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/gp/revoke-only-administer-permission.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,32 @@ +<% set object_link "$object_name" %> +<%= [ad_header "Revoke Only Administer Permission"] %> + +

    Revoke Only Administer Permission

    + +on <%= $object_link %> + +
    + +
    + +<%= [export_form_vars on_what_id on_which_table permission_id return_url] %> + +
    + +This is the only Administer permission granted on +<%= $object_link %>. + +

    + +Are you sure that you want to revoke it? + +

    + + + + +

    + +
    + +<%= [ad_footer] %> Index: web/openacs/templates/new-ticket/custom-field-edit.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/new-ticket/custom-field-edit.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/new-ticket/custom-field-edit.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,36 @@ +<%= [ticket_header "Edit Custom Field"] %> +

    Edit Custom Field

    +<%= [ad_context_bar_ws_or_index [list "[ticket_url_stub]/index.tcl" "Ticket Tracker"] [list "[ticket_url_stub]/project-top.tcl?[export_url_vars project_id]" "One Project"] [list [ticket_url_stub]/project-fields.tcl?[export_url_vars project_id] "Custom Fields"] "New"] %> +

    + +

    +<%= [export_form_vars field_id] %> + + + + + + + + + + + + + + + + + + + + + +
    Field Name
    Field Pretty Name
    Field Type<%= [make_html_select field_type [ticket_custom_field_types] $field_type] %>
    View Field in List?> Yes       > No
    Field Values (for selects)
    +

    + +

    + +

    +<%= [ticket_footer] %> + Index: web/openacs/templates/new-ticket/custom-field-remove.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/new-ticket/custom-field-remove.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/new-ticket/custom-field-remove.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,13 @@ +<%= [ticket_header "Remove Custom Field"] %> +

    Remove Custom Field

    +<%= [ad_context_bar_ws_or_index [list "[ticket_url_stub]/index.tcl" "Ticket Tracker"] [list "[ticket_url_stub]/project-top.tcl?[export_url_vars project_id]" "One Project"] [list project-fields.tcl?[export_url_vars project_id] "Custom Fields"] "remove"] %> +

    + +Are you sure you want to remove the field <%= $field_pretty_name %> from this project's issues? There are already some issues that have entries for this field. Deleting the field will cause all the values for this field to be removed permanently (although the issues will otherwise remain in the system). +

    +

    +<%= [export_form_vars project_id field_id] %> + +
    +

    +<%= [ticket_footer] %> \ No newline at end of file Index: web/openacs/templates/new-ticket/issue-add-attachment.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/new-ticket/issue-add-attachment.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/new-ticket/issue-add-attachment.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,13 @@ +<%= [ticket_header "Attach File to Issue"] %> +

    Attach File

    +<%= [ad_context_bar_ws_or_index [list "[ticket_url_stub]/index.tcl" "Ticket Tracker"] [list "project-top.tcl?project_id=$project_id" $title] [list "[ticket_url_stub]/issue-view.tcl?[export_url_vars msg_id]" "One Ticket"] Attachments] %> +

    + +

    +<%= [export_form_vars msg_id] %> +File:
    +Attachment Name:

    + +

    + +<%= [ticket_footer] %> \ No newline at end of file Index: web/openacs/templates/new-ticket/new-project-custom-field.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/new-ticket/new-project-custom-field.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/new-ticket/new-project-custom-field.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,36 @@ +<%= [ticket_header "New Custom Field"] %> +

    New Custom Field

    +<%= [ad_context_bar_ws_or_index [list "[ticket_url_stub]/index.tcl" "Ticket Tracker"] [list "[ticket_url_stub]/project-top.tcl?[export_url_vars project_id]" "One Project"] [list [ticket_url_stub]/project-fields.tcl?[export_url_vars project_id] "Custom Fields"] "New"] %> +

    + +

    +<%= [export_form_vars project_id] %> + + + + + + + + + + + + + + + + + + + + + +
    Field Name
    Field Pretty Name
    Field Type<%= [make_html_select field_type [ticket_custom_field_types]] %>
    View Field in List? Yes       No
    Field Values (separated by |)
    +

    + +

    + +

    +<%= [ticket_footer] %> + Index: web/openacs/templates/new-ticket/project-cleanse-2.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/new-ticket/project-cleanse-2.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/new-ticket/project-cleanse-2.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,16 @@ +<%= [ticket_header "Cleanse - 2"] %> +

    Cleanse Project - 2

    +<%= [ad_context_bar_ws_or_index [list "[ticket_url_stub]/index.tcl" "Ticket Tracker"] [list "[ticket_url_stub]/project-top.tcl?[export_url_vars project_id]" "One Project"] "Cleanse"] %> +

    + +You have opted to delete all issues with privacy level greater than <%= $privacy %>. +This means deleting <%= $delete_count %> issues. This is your LAST CONFIRMATION. If you click on continue, you will actually delete those issues now. +

    + +

    +<%= [export_form_vars project_id privacy] %> + +
    + +

    +<%= [ticket_footer] %> \ No newline at end of file Index: web/openacs/templates/new-ticket/project-cleanse.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/new-ticket/project-cleanse.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/new-ticket/project-cleanse.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,23 @@ +<%= [ticket_header "Cleanse"] %> +

    Cleanse Project

    +<%= [ad_context_bar_ws_or_index [list "[ticket_url_stub]/index.tcl" "Ticket Tracker"] [list "[ticket_url_stub]/project-top.tcl?[export_url_vars project_id]" "One Project"] "Cleanse"] %> +

    + +This option allows you to clear out issues with a certain minimum +privacy level. This will irreversably remove issues with this +level of privacy from the database, as well as clear out the privacy +information of all other remaining issues. You will have further +chances in this process to cancel this operation, just make sure to +watch out for the last warning. +

    + +

    +<%= [export_form_vars project_id] %> +Maximum Privacy Level to Allow
    +(anything strictly higher will be removed): <%= [make_html_select privacy {{0 "(not set)"} 1 2 3 4 {5 {just clear out the privacy fields}}}] %> +

    + +

    + +

    +<%= [ticket_footer] %> \ No newline at end of file Index: web/openacs/templates/new-ticket/project-fields.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/new-ticket/project-fields.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/new-ticket/project-fields.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,19 @@ +<%= [ticket_header "Custom Fields"] %> +

    Custom Fields

    +<%= [ad_context_bar_ws_or_index [list "[ticket_url_stub]/index.tcl" "Ticket Tracker"] [list "[ticket_url_stub]/project-top.tcl?[export_url_vars project_id]" "One Project"] "Custom Fields"] %> +

    + +

      +<% +foreach field $list_of_fields { + set_variables_after_query_not_selection $field + ns_puts "
    • \[remove\] \[edit\] $field_pretty_name ($field_name) - $field_type\n" +} +%> +

      +

    • >new custom field +
    + + +

    +<%= [ticket_footer] %> \ No newline at end of file Index: web/openacs/templates/news-templated/index.fancy.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/news-templated/index.fancy.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/news-templated/index.fancy.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,41 @@ + + + + +<%= $page_title %> + + + + + + + + + + + + + +
    <%= $header_image %>

    News

    +<%= [ad_context_bar [list "/" [ad_system_name]] "News"] %> +
    + +

      +<%= $news_items %> +

      +

    • <%= $post_or_suggest_item %> +
    + +<%= $archive_sentence %> + +

    + +

    +Go to the plain version of this page;
    +Check out the French version.     +
    + +
    + + + Index: web/openacs/templates/news-templated/index.fancy.fr.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/news-templated/index.fancy.fr.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/news-templated/index.fancy.fr.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,46 @@ + + + + +<%= $page_title %> + + + + + + + + + + + + + + + +
    <%= $header_image %>

    Nouvelles

    +<%= [ad_context_bar_ws_or_index "Nouvelles"] %> +
    + +
      +<%= $news_items %> +

      + +

    + +
    +L'archives +
    + + +

    + +

    +
    +Allez à le version anglais de cette page. +
    + +
    + + + Index: web/openacs/templates/news-templated/index.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/news-templated/index.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/news-templated/index.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,41 @@ + + + + +<%= $page_title %> + + + + + + + + + + + + + +
    <%= $header_image %>

    News

    +<%= [ad_context_bar [list "/" [ad_system_name]] "News"] %> +
    + +
      +<%= $news_items %> +

      +

    • <%= $post_or_suggest_item %> +
    + +<%= $archive_sentence %> + +

    + +

    +Go to the fancy version of this page
    +Check out the French version.     +
    + +
    + + + Index: web/openacs/templates/news-templated/index.plain.fr.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/news-templated/index.plain.fr.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/news-templated/index.plain.fr.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,40 @@ + + + + +<%= $page_title %> + + + + + + + + + + + + + +
    <%= $header_image %>

    Nouvelles

    +<%= [ad_context_bar [list "/" [ad_system_name]] "Nouvelles"] %> +
    + +
      +<%= $news_items %> +

      +

    + +
    +Les archives +
    +

    + +

    +Allez à le version anglais de cette page. +
    + +
    + + + Index: web/openacs/templates/news-templated/item.fancy.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/news-templated/item.fancy.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/news-templated/item.fancy.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,34 @@ + + + + +<%= $title %> + + + + + + + + + +
    <%= $header_image %>

    <%= $title %>

    +<%= $context_bar %> +
    + +
    + +
    +<%= $body %> +
    + +Contributed by <%= $author %> + +<%= $comments %> + +
    + + + + + Index: web/openacs/templates/news-templated/item.fancy.fr.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/news-templated/item.fancy.fr.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/news-templated/item.fancy.fr.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,35 @@ + + + + +<%= $title %> + + + + + + + + + +
    <%= $header_image %>

    <%= $title %>

    +<%= [ad_context_bar_ws_or_index [list "index.tcl" "Nouvelles"] "Une Item"] %> + +
    + +
    + +
    +<%= $body %> +
    + +Contribuée à <%= $author %> + +<%= $comments %> + +
    + + + + + Index: web/openacs/templates/news-templated/item.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/news-templated/item.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/news-templated/item.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,34 @@ + + + + +<%= $title %> + + + + + + + + + +
    <%= $header_image %>

    <%= $title %>

    +<%= $context_bar %> +
    + +
    + +
    +<%= $body %> +
    + +Contributed by <%= $author %> + +<%= $comments %> + +
    + + + + + Index: web/openacs/templates/news-templated/item.plain.fr.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/news-templated/item.plain.fr.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/news-templated/item.plain.fr.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,37 @@ + + + + +<%= $title %> + + + + + + + + + + +
    <%= $header_image %>

    <%= $title %>

    +<%= [ad_context_bar_ws_or_index [list "index.tcl" "Nouvelles"] "Une Item"] %> + +
    + +
    + +
    +<%= $body %> +
    + +Contribuée à <%= $author %> + + +<%= $comments %> + +
    + + + + + Index: web/openacs/templates/notifications/index.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/notifications/index.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/notifications/index.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,23 @@ +<%= [notification_header "Your Notifications"] %> +

    Your Notifications

    +<%= [ad_context_bar_ws_or_index "Notifications"] %> +

    + +

    + + + +<% +foreach notification_class $notification_classes { + set_variables_after_query_not_selection $notification_class + + ns_puts "\n" +} +%> +
    Notification ClassYour Preference
    $notification_class[make_html_select notification_pref_${notification_class_id} [notification_list_of_prefs] $notification_pref]
    +

    + + +

    + +<%= [notification_footer] %> Index: web/openacs/templates/poll/already-voted.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/poll/already-voted.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/poll/already-voted.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,30 @@ +<% # Supplied variables: poll_name, poll_description, header_image, context_bar, poll_id %> + + +<%= [ad_header "Sorry! Already voted for $poll_name"] %> + +

    Sorry! You already voted for <%= $poll_name %>

    +<%= $context_bar %> + +
    + +
    +Sorry! You've already voted for <%= $poll_name %>. + +

    + +<% +# kludge around an aolserver 3.0b6 "fancy adp" parsing problem + +set href "href=\"poll-results.tcl?poll_id=$poll_id\"" +%> + +You can >check the results of this poll. + +

    + + +<%= [ad_footer] %> + + + Index: web/openacs/templates/poll/dberror.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/poll/dberror.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/poll/dberror.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,13 @@ +<% # supplied variable: errmsg %> + +<%= [ad_header "Database Error"] %> + +There was an error processing your request. This is the error: +
    +<%= $errmsg %>
+
    + +<%= [ad_footer] %> + + + \ No newline at end of file Index: web/openacs/templates/poll/index.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/poll/index.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/poll/index.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,20 @@ +<% # Supplied variables: page_title, header_image, context_bar, polls %> + +<%= [ad_header $page_title] %> + +

    Polls

    +<%= $context_bar %> + +
    + +
      +<%= [poll_front_page $polls] %> + +
    + +

    + +<%= [ad_footer] %> + + + Index: web/openacs/templates/poll/not-active.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/poll/not-active.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/poll/not-active.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,18 @@ +<% # Supplied variables: poll_name, poll_description, header_image, context_bar, poll_id %> + +<%= [ad_header "Poll Not Active"] %> + + +

    Poll "<%= $poll_name %>" Not Active

    +<%= $context_bar %> +
    + +
    + +Sorry, but the poll "<%= $poll_name %>" is not active at this time. + +
    + +

    + +<%= [ad_footer] %> Index: web/openacs/templates/poll/novote.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/poll/novote.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/poll/novote.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,28 @@ +<% # Supplied variables: header_image, context_bar, poll_id %> + +<%= [ad_header "No Choice Specified"] %> + +

    No Choice Specified

    +<%= $context_bar %> + +
    + +
    + +Sorry, but for your vote to count, you'll need to make a choice. + +<% +# kludge around an aolserver 3.0b6 "fancy adp" parsing problem + +set href "href=\"one-poll.tcl?poll_id=$poll_id\"" +%> + +Please >return to the poll and +make a choice. + +
    + +<%= [ad_footer] %> + + + Index: web/openacs/templates/poll/one-poll.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/poll/one-poll.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/poll/one-poll.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,41 @@ +<% # Supplied variables: poll_name, poll_description, choices, form_html, context_bar %> + +<%= [ad_header $page_title] %> + +

    <%= $poll_name %>

    +<%= $context_bar %> + +
    + +
    + +<%= $poll_description %> + +
    + +<%= $form_html %> + +<%= [poll_display $choices] %> + +

    + + + +

    + +
    + +

    + +<% +# kludge around an aolserver 3.0b6 "fancy adp" parsing problem + +set href "href=\"poll-results.tcl?poll_id=$poll_id\"" +%> + +You can >check the results of this poll. + +<%= [ad_footer] %> + + + Index: web/openacs/templates/poll/poll-results.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/poll/poll-results.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/poll/poll-results.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,19 @@ +<% # Supplied variables: poll_name, poll_description, values, header_image, context_bar, poll_id, total_count %> + +<%= [ad_header "Results for $poll_name"] %> + +

    Results for <%= $poll_name %>

    +<%= $context_bar %> + +
    + +Total of <%= $total_count %> votes + +
    +<%= [poll_results $values] %> +
    + +<%= [ad_footer] %> + + + Index: web/openacs/templates/poll/vote.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/poll/vote.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/poll/vote.plain.adp 17 Apr 2001 14:05:05 -0000 1.1 @@ -0,0 +1,27 @@ +<% # Supplied variables: header_image, context_bar, poll_id %> + +<%= [ad_header "Thanks for your vote"] %> + +

    Thank you for your vote

    +<%= $context_bar %> + +
    + +
    + +<% +# kludge around an aolserver 3.0b6 "fancy adp" parsing problem + +set href "href=\"poll-results.tcl?poll_id=$poll_id\"" +%> + +You can >check the results of this poll. + +
    + +

    + +<%= [ad_footer] %> + + + Index: web/openacs/templates/poll/fancy/index.fancy.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/poll/fancy/index.fancy.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/poll/fancy/index.fancy.adp 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,42 @@ +<% # Supplied variables: page_title, header_image, context_bar, polls %> + + + +<%= $page_title %> + + + + + + + + + + + + + + + +
    <%= $header_image %>

    Polls

    +<%= $context_bar %> +
    +

    + +
    + +<%= [poll_front_page -item_start "
    " -style_start "" -style_end "" -require_registration_start "" -require_registration_text "Registration Mandatory!!!" $polls] %> +
    +
    + +

    + +

    +Go to the plain version of this page;
    +     +
    + + + + + Index: web/openacs/templates/poll/fancy/novote.fancy.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/poll/fancy/novote.fancy.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/poll/fancy/novote.fancy.adp 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,33 @@ +<% # Supplied variables: header_image, context_bar, poll_id %> + + + +No Choice Specified + + + + + + + + + + + + + +
    <%= $header_image %>

    No Choice Specified

    +<%= $context_bar %> +
    +
    + +Sorry, but for your vote to count, you'll need to make a choice. +Please return to the poll and +make a choice. + +

    + + + + + Index: web/openacs/templates/poll/fancy/one-poll.fancy.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/poll/fancy/one-poll.fancy.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/poll/fancy/one-poll.fancy.adp 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,53 @@ +<% # Supplied variables: poll_name, poll_description, choices, form_html, context_bar, poll_id %> + + + +<%= $poll_name %> + + + + + + + + + + + +

    <%= $poll_name %>

    +<%= $context_bar %> +
    +

    + +<%= $poll_description %> + +
    + +
    + +<%= $form_html %> + + +<%= [poll_display -item_start "" -style_start "" -style_end "" $choices] %> +
    " -item_end "
    + + + +
    + +
    + +

    + +See current results of this poll. + +

    + +

    +Go to the plain version of this page +
    + + + + + Index: web/openacs/templates/poll/fancy/poll-results.fancy.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/poll/fancy/poll-results.fancy.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/poll/fancy/poll-results.fancy.adp 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,49 @@ +<% # Supplied variables: poll_name, poll_description, values, header_image, context_bar, poll_id, total_count %> + + + +Results for <%= $poll_name %> + + + + + + + + + + + + + + +
    <%= $header_image %>

    Results for <%= $poll_name %>

    +<%= $context_bar %> +
    +
    + + +
    + +Total of <%= $total_count %> votes +

    + + + +
    +<% if { $total_count > 0 } { ns_puts [poll_results -bar_color purple -display_values_p "f" -display_scale_p "f" -bar_height 30 $values] } %> +
    +

    + +     + +

    + +

    +Go to the plain version of this page +
    + + + + + Index: web/openacs/templates/poll/fancy/vote.fancy.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/poll/fancy/vote.fancy.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/poll/fancy/vote.fancy.adp 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,36 @@ +<% # Supplied variables: header_image, context_bar, poll_id %> + + + +Thanks for your vote + + + + + + + + + + + + + +
    <%= $header_image %>

    Thank you for your vote

    +<%= $context_bar %> +
    +
    + +Thanks for your vote! You can check the results of this poll. + + +

    + +

    +Go to the fancy version of this page +
    + + + + + Index: web/openacs/templates/sdm/baf-assignments.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/sdm/baf-assignments.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/sdm/baf-assignments.plain.adp 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,37 @@ +<%= [sdm_header "$baf_type Assignments"] %> +

    <%= $baf_type %> Assignments

    +<%= [ad_context_bar_ws_or_index [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] $extra_menu [list "one-baf.tcl?[export_url_vars baf_id]" "$baf_type #$baf_id"] Assignments] %> +

    + + + + + + +<% +foreach assignee $list_of_assignments { + ns_puts " + + \n" +} + +if {$admin_p} { + set target [sdm_url_stub]/pvt/baf-assignment-add.tcl + set passthrough {baf_id role} + set custom_title "Pick a User to Assign" + + ns_puts " +[export_form_vars baf_id target passthrough custom_title] + +" +} + +%> + +
    WhoRoleAction
    [lindex $assignee 1][lindex $assignee 2]" + if {$admin_p} { + ns_puts "\[ remove \]" + } + ns_puts "
    name: , or +email:
    +<%= [sdm_footer] %> \ No newline at end of file Index: web/openacs/templates/sdm/baf-audit.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/sdm/baf-audit.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/sdm/baf-audit.plain.adp 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,24 @@ +<%= [sdm_header "$baf_type Audit"] %> +

    <%= $baf_type %> Audit

    +<%= [ad_context_bar_ws_or_index [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] $extra_menu [list "one-baf.tcl?[export_url_vars baf_id]" "$baf_type #$baf_id"] Audit] %> +

    + + + + +<% +foreach audit_line $audits { + set_variables_after_query_not_selection $audit_line + + ns_puts " + + + + + + \n" +} +%> +
    Field ChangedOld ValueNew ValueWhenBy
    $what $old_value $new_value[util_AnsiTimestamptoPrettyTimestamp $when]$who
    + +<%= [sdm_footer] %> \ No newline at end of file Index: web/openacs/templates/sdm/entry-history-diff.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/sdm/entry-history-diff.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/sdm/entry-history-diff.plain.adp 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,64 @@ +<%= [sdm_header "Diff"] %> +

    History Diff

    +<%= [ad_context_bar_ws_or_index [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] [list "package-repository.tcl?[export_url_vars package_id current_entry]" "One Source File"] "History Diff"] %> +

    + +

    +<% +if {[sdm_sourcecode_entry_has_parent $current_entry]} { + set parent_entry [sdm_sourcecode_entry_parent_entry $current_entry] + ns_puts "[sdm_sourcecode_entry_path $parent_entry]/[sdm_sourcecode_entry_name $parent_entry]" +} +%> +/<%= [sdm_sourcecode_entry_name $current_entry] %>

    + + + + + + + +<% +foreach diff_item $diff { + switch [lindex $diff_item 0] { + nochange { + set old_color "#dddddd" + set new_color "#dddddd" + set old [lindex $diff_item 1] + set new [lindex $diff_item 1] + } + add { + set old_color "white" + set new_color "yellow" + set old "" + set new [lindex $diff_item 1] + } + delete { + set old_color "yellow" + set new_color "white" + set old [lindex $diff_item 1] + set new "" + } + change { + set old_color "yellow" + set new_color "yellow" + set old [lindex $diff_item 1] + set new [lindex $diff_item 2] + } + } + + ns_puts " + + +" +} +%> +
    Revision ><%= $old_release %>Revision ><%= $new_release %>
    +
    [ns_quotehtml $old]
    +    		 +
    [ns_quotehtml $new]
    +
    + + +

    +<%= [sdm_footer] %> Index: web/openacs/templates/sdm/one-file-annotate.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/sdm/one-file-annotate.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/sdm/one-file-annotate.plain.adp 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,30 @@ +<%= [sdm_header "Annotations"] %> +

    Annotations

    +<%= [ad_context_bar_ws_or_index [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] [list "package-repository.tcl?[export_url_vars package_id current_entry]" "One Source File"] "Annotations"] %> +

    + +

    +<% +if {[sdm_sourcecode_entry_has_parent $current_entry]} { + set parent_entry [sdm_sourcecode_entry_parent_entry $current_entry] + ns_puts "[sdm_sourcecode_entry_path $parent_entry]/[sdm_sourcecode_entry_name $parent_entry]" +} +%> +/<%= [sdm_sourcecode_entry_name $current_entry] %>

    + + +<% +foreach line $annotations { + ns_puts "" + + foreach element [lindex $line 0] { + ns_puts "" + } + + ns_puts "\n" +} +%> +
    $element   [ns_quotehtml [lindex $line 1]]
    + +

    +<%= [sdm_footer] %> Index: web/openacs/templates/sdm/one-patch.plain.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/templates/sdm/one-patch.plain.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/templates/sdm/one-patch.plain.adp 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,31 @@ +<%= [sdm_header "One Patch"] %> +

    Patch #<%=$patch_id%>

    +<%= [ad_context_bar_ws_or_index [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] [list package-patches.tcl?[export_url_vars package_id] "Patches"] "One"] %> +

    + + + + + +
    Overall Rating<%= $overall_rating %> | >ratings
    Release<%= $release_name %>
    Action<%= $action %>
    +

    + +<% +if {$user_is_admin} { + ns_puts "Admin: Accept | Refuse

    " +} +%> + +<% +if {$user_rating == ""} { + ns_puts "[export_form_vars patch_id] Rate this patch: [make_html_select numeric_rating {1 2 3 4 5 6 7 8 9 10} 5]

    " +} else { + ns_puts "Your Rating: $user_rating" +} +%> + +

    +<%= [ns_quotehtml $patch_content] %>
+
+
    
+<%= [sdm_footer] %>
\ No newline at end of file
Index: web/openacs/templates/sdm/package-patches.plain.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/templates/sdm/package-patches.plain.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/templates/sdm/package-patches.plain.adp	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,21 @@
+<%= [sdm_header "Patches"] %>
+
    Submitted Patches
    
+<%= [ad_context_bar_ws_or_index [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] "Patches"] %>
+
    
+
+
    
+
    >Submit a new patch
    
+
    
+<%
+foreach patch $patches {
+	set_variables_after_query_not_selection $patch
+
+	ns_puts "
    Patch #$patch_id submitted on [util_AnsiDatetoPrettyDate $submission_date] - $overall_rating
    
+
    $patch_description 
    
+"
+}
+%>
+
    
+
+
    
+<%= [sdm_footer] %>
\ No newline at end of file
Index: web/openacs/templates/sdm/patch-accept.plain.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/templates/sdm/patch-accept.plain.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/templates/sdm/patch-accept.plain.adp	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,13 @@
+<%= [sdm_header "Patch Accepting"] %>
+
    Patch Accepting
    
+<%= [ad_context_bar_ws_or_index [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] [list package-patches.tcl?[export_url_vars package_id] "Patches"] [list one-patch.tcl?[export_url_vars patch_id] "Patch #$patch_id"] "Application"] %>
+
    
+The result of applying the patch was:
+
    +<%= $result %>
+
    
+
    
+
\ No newline at end of file
Index: web/openacs/templates/sdm/patch-rate.plain.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/templates/sdm/patch-rate.plain.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/templates/sdm/patch-rate.plain.adp	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,16 @@
+<%= [sdm_header "Rate Patch"] %>
+
    Rate Patch
    
+<%= [ad_context_bar_ws_or_index [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] [list package-patches.tcl?[export_url_vars package_id] "Patches"] [list one-patch.tcl?[export_url_vars patch_id] "Patch #$patch_id"] "Rate"] %>
+
    
+
+
    
+<%= [export_form_vars patch_id] %>
+
+
+
+
    Rating<%= [make_html_select numeric_rating {1 2 3 4 5 6 7 8 9 10} $numeric_rating] %>
    Comment

    
+
+
    
+
+
    
+<%= [sdm_footer] %>
Index: web/openacs/templates/sdm/patch-ratings.plain.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/templates/sdm/patch-ratings.plain.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/templates/sdm/patch-ratings.plain.adp	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,18 @@
+<%= [sdm_header "Patch Ratings"] %>
+
    Patch Ratings
    
+<%= [ad_context_bar_ws_or_index [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] [list package-patches.tcl?[export_url_vars package_id] "Patches"] [list one-patch.tcl?[export_url_vars patch_id] "Patch #$patch_id"] "Patch Ratings"] %>
+
    
+
+
    
+<%
+foreach rating $patch_ratings {
+	set_variables_after_query_not_selection $rating
+	ns_puts "
    $numeric_rating - $rate_user_name on [util_AnsiDatetoPrettyDate $rating_date]
    
+
    $description
    
+"
+}
+%>
+
    
+
+
    
+<%= [sdm_footer] %>
\ No newline at end of file
Index: web/openacs/templates/sdm/patch-submit.plain.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/templates/sdm/patch-submit.plain.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/templates/sdm/patch-submit.plain.adp	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,26 @@
+<%= [sdm_header "Submit a Patch"] %>
+
    Submit a Patch
    
+<%= [ad_context_bar_ws_or_index [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] "Patch"] %>
+
    
+
+When you submit a patch, please provide as much detail as
+possible. Your patch file must be generated from the top-level
+directory of the package. Use a contextual diff if you can to ensure
+maximal compatibility with existing changes made to the repository.
+
    
+
+
    
+<%= [export_form_vars package_id] %>
+
+
+
+
+
    Release<%= [make_html_select release_id $list_of_releases] %>
    Patch File
    Patch Description
    
+
    
+
+
    
+
+
    
+
+<%= [sdm_footer] %>
+
Index: web/openacs/templates/sdm/pvt/baf-close.plain.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/templates/sdm/pvt/baf-close.plain.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/templates/sdm/pvt/baf-close.plain.adp	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,14 @@
+<%= [sdm_header "Close a $baf_type"] %>
+
+
    Close a <%= $baf_type %>
    
+<%= [ad_context_bar_ws_or_index [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] [list "../one-baf.tcl?[export_url_vars baf_id]" "$baf_type #$baf_id"] "Close $baf_type"] %>
+
    
+
+
    
+<%= [export_form_vars baf_id severity baf_status expected_completion] %>
+Release where closed: <%= [make_html_select completion $list_of_release_values $expected_completion] %>
+
    
+
+
    
+
+<%= [sdm_footer] %>
\ No newline at end of file
Index: web/openacs/templates/sdm/pvt/module-delete.plain.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/templates/sdm/pvt/module-delete.plain.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/templates/sdm/pvt/module-delete.plain.adp	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,16 @@
+<%= [sdm_header "Delete Module Confirmation"] %>
+
    Delete Module?
    
+<%= [ad_context_bar_ws_or_index [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] [sdm_module_context_bar_item $module_id $module_name] delete] %>
+
    
+
+Are you sure you want to delete this module?
+
    
+
      
+
    •  All bugs and features associated with this module will then be associated with the package as a whole.
+
    
+
    
+
    
+<%= [export_form_vars module_id] %>
+
+
    
+<%= [sdm_footer] %>
\ No newline at end of file
Index: web/openacs/templates/sdm/pvt/notification-prefs.plain.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/templates/sdm/pvt/notification-prefs.plain.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/templates/sdm/pvt/notification-prefs.plain.adp	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,21 @@
+<%= [sdm_header "Notification Preferences"] %>
+
    Notification Preferences
    
+<%= [ad_context_bar_ws_or_index [sdm_home_context_bar_item] "Notifications"] %>
+
    
+
+
    
+
+
+
+
+
+
+
+
+
+
    Package Notification Preference:<%= [make_html_select package_pref [sdm_list_of_notification_prefs] $package_pref] %>
    Bug/Feature Notification Preference:<%= [make_html_select baf_pref [sdm_list_of_notification_prefs] $baf_pref] %>
    
+
    
+
+
    
+
+<%= [sdm_footer] %>
\ No newline at end of file
Index: web/openacs/templates/team/member-change-role.plain.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/templates/team/member-change-role.plain.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/templates/team/member-change-role.plain.adp	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,17 @@
+<%= [team_header "Change Role for Team Member"] %>
+
    Change Role for <%= "$first_names $last_name" %> for <%= $title %>
    
+<%= [ad_context_bar_ws_or_index [list [team_url_stub] [team_system_name]] [list [team_url_stub]/one-team.tcl?[export_url_vars project_id] $title] "Change Member Role"] %>
+
    
+
+
    
+<%= [export_form_vars team_id team_user_id] %>
+New Role: 
+
+
    
+
+
    
+
+<%= [team_footer] %>
\ No newline at end of file
Index: web/openacs/templates/team/new-member-2.plain.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/templates/team/new-member-2.plain.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/templates/team/new-member-2.plain.adp	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,34 @@
+<%= [team_header "Add a Member"] %>
+
    Add a Member
    
+<%= [ad_context_bar_ws_or_index [list [team_url_stub] "Team Management"]  [list one-team.tcl?[export_url_vars project_id] $title] "New Member"] %>
+
    
+
+<%
+if {[llength $all_users] > 0} {
+	ns_puts "
+The following users matched your query:
+
    	
+
+
    
+
+
    
+<%= [export_form_vars email project_id role] %>
+You want to add <%= $email %> to the team. If this user isn't listed above, you can add this user to the system.
+
+
    
+
+
    
+<%= [team_footer] %>
\ No newline at end of file
Index: web/openacs/templates/team/new-member-3.plain.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/templates/team/new-member-3.plain.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/templates/team/new-member-3.plain.adp	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,16 @@
+<%= [ad_header "Verify New Member"] %>
+
    Verification
    
+<%= [ad_context_bar_ws_or_index [list [team_url_stub] "Team Management"]  [list one-team.tcl?[export_url_vars project_id] $title] "New Member"] %>
+
    
+
+There is currently no user in the system with email address <%= $email %>.
+If you're sure you want to add this user to your team, he/she will be added as a new user to the system.
+The new account will not be fully activated until the user's first logon.
+
    
+
    
+<%= [export_form_vars project_id role email checked_p] %>
+
+
    
+
    
+
+<%= [ad_footer] %>
Index: web/openacs/templates/team/team-delete.gui.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/templates/team/team-delete.gui.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/templates/team/team-delete.gui.adp	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,12 @@
+<%= [team_header "Delete Team"] %>
+
    Delete Team
    
+<%= [ad_context_bar_ws_or_index [list [team_url_stub] "Team Management"]  [list one-team.tcl?[export_url_vars project_id] $title] "Delete"] %>
+
    
+
+Are you sure you want to delete this team?. 
    
+Doing so will delete all tickets, all todo lists, all team mappings. It's a drastic action, and should only be done on a test team.
+
    
+No, it was all a big mistake
    
+>yes, I really want to delete this team
    
+
+<%= [team_footer] %>
\ No newline at end of file
Index: web/openacs/templates/threads/index.plain.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/templates/threads/index.plain.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/templates/threads/index.plain.adp	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,53 @@
+<%= [threads_header "Your Threads"] %>
+
    Your Threads
    
+<%= [ad_context_bar_ws [threads_system_name]] %>
+
    
+
+
    
+
    
+
    
+
+
+
+
+
+
+
+
+
+
    ActiveBlocked
    
+
+
+
    
+
    
+
+
+
+
+
+
+
    Suspended
    
+
      <%
+foreach thread $list_of_suspended_threads {
+	ns_puts "
    •  [lindex $thread 1]\n"
+}
+%>
+
    
+
    
+
+
    
+
+<%= [threads_footer] %>
\ No newline at end of file
Index: web/openacs/templates/threads/new-thread.plain.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/templates/threads/new-thread.plain.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/templates/threads/new-thread.plain.adp	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,24 @@
+<%= [threads_header "New Thread"] %>
+
    New Thread
    
+<%= [ad_context_bar_ws [threads_top_level_link] "New Thread"] %>
+
    
+
+
    
+
+
+
+
+
+
+
+
+
+
+
+
+
+
     Thread Name
     Priority<%= [make_html_select priority [threads_list_of_priorities]] %>
     Description 
    
+
+
    
+
+<%= [threads_footer] %>
\ No newline at end of file
Index: web/openacs/templates/threads/one-thread.plain.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/templates/threads/one-thread.plain.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/templates/threads/one-thread.plain.adp	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,63 @@
+<%= [threads_header "$thread_name"] %>
+
    <%= $thread_name %> [ <%= $thread_state %> ]
    
+<%= [ad_context_bar_ws [threads_top_level_link] "One Thread"] %>
+
    
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
    ThreadCollaborators
    
+<%= $description %>
+
    
+started on <%= $start_date %>
+
    		
+
      
+
      
+<%
+foreach collaborator $list_of_collaborators {
+	ns_puts "
    •  \[ remove \] [lindex $collaborator 1]\n"
+}
+%>
+
    
+
    
+
+<%= [export_form_vars target passthrough custom_title thread_id] %>
+
+
+
    
+
    NotesNEW
    
+
+<%
+foreach note $list_of_notes {
+	ns_puts "[lindex $note 0]
    
+-- [lindex $note 1] on [lindex $note 2]
    "
+}
+%>
+
    		
+
    
+<%= [export_form_vars thread_id] %>
+
    
+<%= [make_html_select thread_state [threads_list_of_states] $thread_state] %>
+
+
    
+Alternate Date: 
    
+<%= [philg_dateentrywidget note_date $current_date] %>
+
    
+
    
+
+<%= [threads_footer] %>
\ No newline at end of file
Index: web/openacs/users/README
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/users/README,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/users/README	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1 @@
+This directory is required for the homepage module
Index: web/openacs/www/cookie-chain-1.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/cookie-chain-1.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/cookie-chain-1.tcl	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,22 @@
+# cookie-chain-1.tcl,v 3.0 2000/02/06 02:39:06 ron Exp
+# 1998/10/22 tea
+# updated by philg 10/25/98
+set_form_variables
+
+#Requires:
+#cookie_name, cookie_value, final_page, expire_state
+
+switch $expire_state {
+    s   { set expire_clause "" }
+    p   { set expire_clause "expires=Fri, 01-Jan-2010 01:00:00 GMT" }
+    e   { set expire_clause "expires=Mon, 01-Jan-1990 01:00:00 GMT" }
+    default { ns_log Error "cookie-chain-1.tcl called with unknown expire_state: \"$expire_state\""
+              # let's try to salvage something for the user
+              set expire_clause ""
+            }
+}
+
+ns_set put [ns_conn outputheaders] "Set-Cookie" "$cookie_name=$cookie_value; path=/; $expire_clause"
+
+ns_returnredirect "http://[ad_cookie_chain_second_host_name]/cookie-chain-2.tcl?[export_url_vars cookie_name cookie_value final_page expire_state]"
+
Index: web/openacs/www/cookie-chain-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/cookie-chain-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/cookie-chain-2.tcl	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,20 @@
+# cookie-chain-2.tcl,v 3.0 2000/02/06 02:39:06 ron Exp
+# 1998/10/22 tea
+set_form_variables
+
+#Requires:
+#cookie_name, cookie_value, final_page, expire_state
+
+switch $expire_state {
+    s   { set expire_clause "" }
+    p   { set expire_clause "expires=Fri, 01-Jan-2010 01:00:00 GMT" }
+    e   { set expire_clause "expires=Mon, 01-Jan-1990 01:00:00 GMT" }
+    default { ns_log Error "cookie-chain-2.tcl called with unknown expire_state: \"$expire_state\""
+              # let's try to salvage something for the user
+              set expire_clause ""
+            }
+}
+
+ns_set put [ns_conn outputheaders] "Set-Cookie" "$cookie_name=$cookie_value; path=/; $expire_clause"
+
+ns_returnredirect $final_page
Index: web/openacs/www/cookie-chain.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/cookie-chain.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/cookie-chain.tcl	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,49 @@
+# cookie-chain.tcl,v 3.0 2000/02/06 02:39:07 ron Exp
+# 1998/10/22 tea
+# fixed by philg 10/25/98
+set_form_variables
+
+#Requires:
+#cookie_name, cookie_value, final_page, expire_state
+
+# cookie_name - name of cookie
+# cookie_value - value of cookie
+# final_page - url of the page you want to the user to end on (ie /, or
+# index.tcl)
+# expire_state -
+#     p for a persistent cookie
+#     s for a session cookie (default)
+#     e to expire the cookie
+
+if ![info exists expire_state] {
+    set expire_state "s"
+}
+
+switch $expire_state {
+    s   { set expire_clause "" }
+    p   { set expire_clause "expires=Fri, 01-Jan-2010 01:00:00 GMT" }
+    e   { set expire_clause "expires=Mon, 01-Jan-1990 01:00:00 GMT" }
+    default { ns_log Error "cookie-chain.tcl called with unknown expire_state: \"$expire_state\""
+              # let's try to salvage something for the user
+              set expire_clause ""
+            }
+}
+
+# we're going to assume that most of the time people 
+# leave cookie_value empty when they are expiring a cookie
+
+if ![info exists cookie_value] {
+    set cookie_value "expired"
+}
+
+if [ad_need_cookie_chain_p] {
+    if { [ns_conn driver] == "nsssl" } {
+	set protocol "https"
+    } else {
+	set protocol "http"
+    }
+    ns_returnredirect "$protocol://[ad_cookie_chain_first_host_name]/cookie-chain-1.tcl?[export_url_vars cookie_name cookie_value final_page expire_state]"
+} else {
+    ns_set put [ns_conn outputheaders] "Set-Cookie" "$cookie_name=$cookie_value; path=/; $expire_clause"
+    ns_returnredirect $final_page
+}
Index: web/openacs/www/index.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/index.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/index.adp	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,106 @@
+<%= [openacs_header OpenACS.org] %>
+
    
+
    
+<%= [openacs_menu] %>
+
    
+
+
+
+
+
+
+
+
    
+
    What is OpenACS?
    
+OpenACS (Open ArsDigita Community System) is an advanced toolkit for
+building scalable, community-oriented web applications. It relies on AOLserver, a web/application server, and PostgreSQL, a true ACID-compliant
+RDBMS. These are two high-quality products available
+for free under open-source
+licenses. (read more)
+
+
+
    
+
+
    How can I use OpenACS?
     
+OpenACS is available under the GNU General
+Public License, which makes it open-source. This means you can use
+it and modify it in any way you want. If you choose to redistribute
+OpenACS, you must do so under the terms of the GNU license. In fact,
+this is how OpenACS came to be: it is the redistributed, modified
+version of the ACS, built by
+ArsDigita.
+
    
+You are thus free to use OpenACS for commercial and non-commercial
+use. For professional help, you should contact Civilution, Furfly, 
+Musea Technologies,
+OpenForce, or Ybos.
+
+
    
+
    Is there more information?
    
+Check out, in order, our documentation, our
+FAQs, and our forums.
    
+You can also check out sites that run on OpenACS.
+    		
+
+
    News
    
+
+
      
+<%
+
+set db [ns_db gethandle]
+
+# Create a clause for returning the postings for relevant groups
+set newsgroup_clause "(newsgroup_id = [join [news_newsgroup_id_list $db 0 0] " or newsgroup_id = "])"
+	
+set query "
+ select news_item_id, title, release_date, body, html_p
+ from news_items
+ where sysdate() between release_date and expiration_date
+ and release_date-sysdate() < '2 weeks'::reltime
+ and $newsgroup_clause
+ and approval_state = 'approved'
+ order by release_date desc, creation_date desc"
+
+set selection [ns_db select $db $query]
+
+set counter 0
+
+while {[ns_db getrow $db $selection]} {
+	set_variables_after_query
+	incr counter
+	ns_puts "
    •  [util_AnsiDatetoPrettyDate $release_date]: $title"
+}
+
+if {$counter == 0} {
+	ns_puts "No news items"
+}
+%>
+
    
+
+
    
+
    Statistics
    
+
+<%
+
+set num_total_users [database_to_tcl_string $db "select count(*) from users"]
+set num_downloads_rpm [database_to_tcl_string $db "select count(*) from package_release_downloads where package_id=8"]
+set num_downloads_324 [database_to_tcl_string $db "select count(*) from package_release_downloads where package_id=1 and release_id=12"]
+
+%>
+
+<%= $num_total_users %> registered users.
    
+<%= $num_downloads_324 %> downloads of OpenACS 3.2.4.
    
+<%= $num_downloads_rpm %> downloads of OpenACS Apache RPMs.
+
+
    
+
    
+
    
+The OpenACS team would like to thank ArsDigita for providing the hardware and co-location resources needed to run this site.
+
    
+
    
+
    
+<%= [openacs_footer] %>
\ No newline at end of file
Index: web/openacs/www/index.tcl.txt
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/index.tcl.txt,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/index.tcl.txt	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,88 @@
+
+set special_index_page [ad_parameter SpecialIndexPage content]
+
+if ![empty_string_p $special_index_page] {
+    set full_filename "[ns_info pageroot]$special_index_page"
+    if [file exists $full_filename] {
+	ns_returnfile 200 [ns_guesstype $full_filename] $full_filename
+	return
+    }
+}
+
+# publisher didn't have any special directive for the top-level
+# page, so let's generate something
+
+set old_login_process [ad_parameter "SeparateEmailPasswordPagesP" "" "0"]
+
+ReturnHeaders 
+
+ns_write "[ad_header [ad_system_name]]
+
+
    [ad_system_name]
    
+
+
    
+
+
    Login
    
+
+
    
+[export_form_vars return_url]
+
+
+"
+
+if { !$old_login_process } {
+    ns_write "\n"
+    if [ad_parameter AllowPersistentLoginP "" 1] {
+	if [ad_parameter PersistentLoginDefaultP "" 1] {
+	    set checked_option "CHECKED" 
+	} else {
+	    set checked_option "" 
+	}
+	ns_write "\n"
+    }
+}
+
+ns_write "
+
+
+
    Your email address:
    Your password:
     
+	Remember this address and password?
+	(help)
    
+
+
    
+
+"
+
+set user_id [ad_get_user_id]
+set db [ns_db gethandle]
+
+if { $user_id != 0 } {
+    # they've got a cookie
+    if ![catch { set user_name [database_to_tcl_string $db "select first_names || ' ' || last_name as name from users where user_id = $user_id and user_state <> 'deleted'"] } errmsg] {
+	# no errors
+	ns_write "If you like, you can go directly to $user_name's [ad_pvt_home_name] in [ad_system_name]."
+    }
+    set requires_registration_p_clause ""
+} else {
+    # not logged in 
+    set requires_registration_p_clause "\nand requires_registration_p <> 't'"
+}
+
+ns_write "
      "
+
+set selection [ns_db select $db "
+select section_url_stub, section_pretty_name
+from content_sections
+where scope='public' and enabled_p = 't' $requires_registration_p_clause
+order by sort_key, upper(section_pretty_name)"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    ns_write "
    • $section_pretty_name\n"
+}
+
+ns_write "
+
    
+
+[ad_footer]
+"
Index: web/openacs/www/monitor.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/monitor.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/monitor.tcl	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,82 @@
+# monitor.tcl,v 3.0 2000/02/06 02:39:07 ron Exp
+# this program was written by Philip Greenspun (philg@mit.edu)
+# it is free to everyone under the standard GNU Public License 
+
+set connections [ns_server active]
+
+# let's build an ns_set just to figure out how many distinct elts; kind of a kludge
+# but I don't see how it would be faster in raw Tcl
+
+set scratch [ns_set new scratch]
+foreach connection $connections {
+    ns_set cput $scratch [lindex $connection 1] 1
+}
+
+set distinct [ns_set size $scratch]
+
+
+set whole_page "
+
+Life on the [ns_info server] server
+
+
+
+
    Life on the [ns_info server] server
    
+
    
+
+There are a total of [llength $connections] requests being served
+right now (to $distinct distinct IP addresses).  Note that this number
+seems to include only the larger requests.  Smaller requests, e.g.,
+for .html files and in-line images, seem to come and go too fast for
+this program to catch.
+
+
    
+
+"
+
+if [util_aolserver_2_p] {
+    append whole_page "
+AOLserver says that the max number of threads spawned since server
+startup is [ns_totalstats HWM-threads].  The max threads since the
+last interval reset (every 5 minutes or so by default):
+[ns_intervalstats HWM-threads].  This final number is probably the
+best estimate of current server activity.
+
+
    
+"
+}
+
+if [util_aolserver_2_p] {
+    # run standard Unix uptime command to get load average (crude measure of 
+    # system health)
+    set uptime_output [exec /usr/bin/uptime]
+    append whole_page "
+
+Here's what uptime has to say about the box:
+
+
    +$uptime_output
+
    
+"
+}
+
+append whole_page "
+
+
+
+"
+
+foreach connection $connections {
+    append whole_page "
    conn #client IPstatemethodurln secondsbytes
    [join $connection ]\n"
+}
+
+
+append whole_page "
    
+
+
    
+
    philg@mit.edu
    
+
+
+"
+
+ns_return 200 text/html $whole_page
Index: web/openacs/www/openacs_button.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/openacs_button.gif,v
diff -u
Binary files differ
Index: web/openacs/www/openacs_logo_large.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/openacs_logo_large.gif,v
diff -u
Binary files differ
Index: web/openacs/www/register.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/register.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/register.tcl	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,3 @@
+# register.tcl,v 3.0 2000/02/06 02:39:07 ron Exp
+
+ns_returnredirect "register/index.tcl?[ns_conn query]"
Index: web/openacs/www/robots.txt
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/robots.txt,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/robots.txt	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,7 @@
+User-agent: *
+Disallow: /philg/scripts/
+Disallow: /philg/scratch/
+Disallow: /ftpdir/
+Disallow: /samantha/slide-show.html
+Disallow: /samantha/plaintext/
+Disallow: /samantha/ps/
Index: web/openacs/www/sites.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sites.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sites.html	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,15 @@
+
+
+
    OpenACS Sites
    
+part of OpenACS Development.
+
    
+New OpenACS sites are being built all the time. Add a link below to any
+OpenACS sites you know!
+
    
+
+If you operate an OpenACS web site, you can, if you so desire, use this button to indicate that your site is powered by OpenACS. You are absolutely not required to do so, but if you're proud to show off what software you use, we want to make it easy for you!
+
    
+
    
+
+
    
+
Index: web/openacs/www/software.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/software.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/software.adp	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,69 @@
+<%= [openacs_header OpenACS.org] %>
+
    
+
    Software
    
+<%= [openacs_menu] %>
+
    
+
+You can download OpenACS software via HTTP off this site. We have
+found HTTP to be the most reliable scheme for downloading from
+anywhere, and thus it is the only supported download mechanism at this
+time.
+
+
    
+
    Quick Downloads
    
+
+<%
+set db [ns_db gethandle]
+
+# for OpenACS
+set selection [ns_db 1row $db "select current_release as
+openacs_current_release, fetch_release_name(current_release) as
+openacs_current_release_name from packages where package_id=1"]
+set_variables_after_query
+
+# for OpenACS Apache RPM
+set selection [ns_db 1row $db "select current_release as
+apache_rpm_current_release, fetch_release_name(current_release) as
+apache_rpm_current_release_name from packages where package_id=8"]
+set_variables_after_query
+
+# for Postgres Driver
+set selection [ns_db 1row $db "select current_release as
+driver_current_release, fetch_release_name(current_release) as
+driver_current_release_name from packages where package_id=2"]
+set_variables_after_query
+
+# for Documentation
+set selection [ns_db 1row $db "select current_release as
+doc_current_release, fetch_release_name(current_release) as
+doc_current_release_name from packages where package_id=5"]
+set_variables_after_query
+
+%>
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
    >OpenACS (<%= $openacs_current_release_name %>)(general package information)
    >OpenACS Apache RPMs(<%= $apache_rpm_current_release_name %>)(general package information)
    >AOLserver Postgres Driver (<%= $driver_current_release_name %>)(general package information)
    >OpenACS Documentation (<%= $doc_current_release_name %>)(general package information)
    
+
    
+
+You can also access the Software Development Manager directly, which contains the above packages, and soon additional community-contributed additions.
+
+
+
+
    
+<%= [openacs_footer] %>
\ No newline at end of file
Index: web/openacs/www/style.css
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/style.css,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/style.css	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,12 @@
+
+                p               {font-family: Verdana, Arial, Helvetica, sans-serif; font-size: 10pt;}
+                body               {font-family: Verdana, Arial, Helvetica, sans-serif; font-size: 10pt;}
+                ul               {font-family: Verdana, Arial, Helvetica, sans-serif; font-size: 10pt;}
+                li               {font-family: Verdana, Arial, Helvetica, sans-serif; font-size: 10pt;}
+                h2               {font-family: Verdana, Arial, Helvetica, sans-serif; font-size: 18pt;}
+                h3               {font-family: Verdana, Arial, Helvetica, sans-serif; font-size: 16pt;}
+                h4               {font-family: Verdana, Arial, Helvetica, sans-serif; font-size: 14pt;}
+                h1               {font-family: Verdana, Arial, Helvetica, sans-serif; font-size: 24pt;}
+		td		{font-family: Verdana, Arial, Helvetica, sans-serif; font-size: 10pt;}
+		pre		{font-family: Courier; font-size: 10pt;}
+		tt		{font-family: Courier; font-size: 10pt;}
Index: web/openacs/www/test.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/test.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/test.tcl	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,12 @@
+
+set package_id 1
+set release_id 12
+
+set release_name "v3.2.4"
+
+set db [ns_db gethandle]
+
+ns_db dml $db "update packages set current_release=$release_id where package_id=$package_id"
+
+sdm_notify_users_package $package_id "New live release: $release_name" $db
+
Index: web/openacs/www/user-please-login.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/user-please-login.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/user-please-login.tcl	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,2 @@
+# user-please-login.tcl,v 3.0 2000/02/06 02:39:07 ron Exp
+ns_returnredirect "register/index.tcl?[ns_conn query]"
Index: web/openacs/www/user-search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/user-search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/user-search.tcl	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,124 @@
+# user-search.tcl,v 3.1 2000/02/20 10:50:01 ron Exp
+# Reusable page for searching for a user by email or last_name.
+# Returns to "target" with user_id_from_search, first_names_from_search,
+# last_name_from_search, and email_from_search, and passing along all
+# form variables listed in "passthrough".
+
+
+set_the_usual_form_variables
+# email or last_name (search strings)
+# target (URL to return to)
+# passthrough (form variables to pass along from caller)
+# custom_title (if you're doing a passthrough, 
+# this title can help inform users what the search was for
+# limit_to_users_in_group_id (optional argument that limits our search to users in the specified group id.
+#   (Note that we allow limit_to_users_in_group_id to be a comma separated list... to allow searches within 
+#    multiple groups) 
+
+
+# Check input.
+set errors ""
+set exception_count 0
+
+if { (![info exists email] || $email == "") && (![info exists last_name] || $last_name == "") } {
+    incr exception_count
+    append errors "
  • You must specify either an email address or last name to search for.\n"
+}
+
+if { [info exists email] && [info exists last_name] && $email != "" && $last_name != "" } {
+    incr exception_count
+    append errors "
  • You can only specify either email or last name, not both.\n"
+}
+
+if { ![info exists target] || $target == "" } {
+    incr exception_count
+    append errors "
  • Target was not specified. This shouldn't have happened,
+please contact the administrator
+and let them know what happened.\n"
+}
+
+if { $errors != "" } {
+    ad_return_complaint $exception_count $errors
+    return
+}
+
+if { [info exists email] && $email != "" } {
+    set search_text "email \"$email\""
+    set search_clause "lower(email) like '%[string tolower $QQemail]%'"
+} else {
+    set search_text "last name \"$last_name\""
+    set search_clause "lower(last_name) like '%[string tolower $QQlast_name]%'"
+}
+
+
+if { ![info exists passthrough] } {
+    set passthrough ""
+}
+lappend passthrough user_id_from_search first_names_from_search last_name_from_search email_from_search
+
+if { ![info exists custom_title] } {
+	set display_title "Member Search"
+} else {
+	set display_title $custom_title
+}
+
+if { [exists_and_not_null limit_to_users_in_group_id] } {
+set query "select u.user_id as user_id_from_search, 
+  u.first_names as first_names_from_search, u.last_name as last_name_from_search,
+  u.email as email_from_search, u.user_state
+from users u, user_group_map ugm
+where u.user_id=ugm.user_id
+and ugm.group_id in ($limit_to_users_in_group_id)
+and $search_clause"
+
+} else {
+set query "select user_id as user_id_from_search, 
+  first_names as first_names_from_search, last_name as last_name_from_search,
+  email as email_from_search, user_state
+from users
+where $search_clause"
+}
+
+set db [ns_db gethandle]
+
+if { [exists_and_not_null limit_to_users_in_group_id] && ![regexp {[^0-9]} $limit_to_users_in_group_id] } {
+    append display_title " in [database_to_tcl_string $db "select group_name from user_groups where group_id=$limit_to_users_in_group_id"]"
+}
+
+set selection [ns_db select $db $query]
+
+ReturnHeaders
+
+ns_write "[ad_header $display_title]
+
    $display_title
    
+for $search_text
+
    
+
      
+"
+
+set i 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    
+    with_catch errmsg {
+	set exported_variables [list]
+	foreach var $passthrough {
+	    ns_log Notice "var: $var"
+	    lappend exported_variables [export_url_vars $var]
+	}
+	ns_write "
    • $first_names_from_search $last_name_from_search ($email_from_search)\n"
+    } {
+	ns_write "
    • $errmsg\n"
+    }
+    incr i
+}
+
+if { $i == 0 } {
+    ns_write "
    • No members found.\n"
+}
+
+ns_write "
    
+[ad_footer]
+"
+
Index: web/openacs/www/user-user-bozo-filter.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/user-user-bozo-filter.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/user-user-bozo-filter.tcl	17 Apr 2001 14:05:06 -0000	1.1
@@ -0,0 +1,146 @@
+# user-user-bozo-filter.tcl,v 3.0.4.1 2000/03/17 06:00:51 jsc Exp
+# File: /user-user-bozo-filter.tcl
+# Date: Fri Jan 14 19:27:42 EST 2000
+# Contact: ahmeds@mit.edu
+# Purpose: this page implements a bozo filter
+#          i.e. it makes sure the caller does not get any site-wide email 
+#          from the specified sender   
+
+set_the_usual_form_variables 0
+# sender_id process
+
+validate_integer sender_id $sender_id
+
+set exception_count 0
+set exception_text ""
+
+if { ![info exists sender_id] || [empty_string_p $sender_id]} {
+    incr exception_count
+    append exception_text "
+    
  • No sender id was passed"
+}
+
+if {$exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+if { ![info exists process] || [empty_string_p $process]} {
+    set process set_filter
+}
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select first_names,last_name
+                                  from users
+                                  where user_id = $sender_id"]
+
+if { [empty_string_p $selection] } {
+    # to sender_id to prevent is not valid
+    incr exception_count
+    append exception_text "
+    
  • Invalid sender id"
+} else {
+    set_variables_after_query
+} 
+
+if {$exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+set user_id [ad_verify_and_get_user_id]
+
+set counter [database_to_tcl_string $db "select count(*)
+                                                 from user_user_bozo_filter
+                                                 where origin_user_id = $user_id"]
+
+if { $process == "unset_filter" } {
+    if [catch { ns_db dml $db "delete from user_user_bozo_filter
+                               where origin_user_id = $user_id
+                               and   target_user_id = $sender_id"  } errmsg ] {
+        
+        # choked; let's see if it is because filter doesn't already exist	
+	if { $counter == 0 } {
+	append html "
+	No filter was set to prevent you from any emails 
+	sent by $first_names $last_name ( ID : $sender_id )"
+
+	} else {  
+	    ad_return_error "Ouch!"\
+		    "The database choked on delete:
+	    
    
+	    $errmsg
+	    
    
+	    "  
+	    return
+	}
+
+    } else {
+	set html "
+	The filter to prevent you from any emails sent by
+	$first_names $last_name ( ID : $sender_id ) has been removed 
+	"
+    }
+    
+    append html "
+    
    
+    To stop receiving any future emails sent by $first_names $last_name, click 
+    here
+    
    
+    "
+} else {
+    # process= set_filter			     
+				
+    if [catch { ns_db dml $db "insert into user_user_bozo_filter
+                           (origin_user_id,target_user_id)
+                           values 
+                           ($user_id,$sender_id )" } errmsg ] {
+			       
+	# choked; let's see if it is because filter already exists
+	
+	if { $counter > 0 } {
+	    append html "
+	    A filter already exists to prevent you from any emails 
+	    sent by $first_names $last_name ( ID : $sender_id )  
+	    "
+	} else {
+	    ad_return_error "Ouch!"\
+		            "The database choked on your insert:
+	                     
    
+	                     $errmsg
+	                     
    
+	                     "  
+	    return
+	}
+       
+    } else {
+	set html "
+	A filter has been set to prevent you from any future emails 
+	sent by $first_names $last_name ( ID : $sender_id ) 
+	"
+    }
+    
+    append html "
+    
    
+    To resume receiving emails from $first_names $last_name , click 
+    here
+    
    
+    "
+}
+
+ReturnHeaders 
+
+set process_string [ad_decode $process "set_filter" "Set" "Unset"]
+
+ns_write "
+[ad_header "$process_string Bozo Filter" ]
+
    $process_string Bozo Filter
    
+[ad_context_bar_ws_or_index  "$process_string Bozo Filter"] 
+
    
+
+
    
+$html
+
    
+[ad_footer]
+"
Index: web/openacs/www/4/guidelines.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/4/guidelines.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/4/guidelines.adp	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,142 @@
+<%= [openacs_header "OpenACS 4.x Guidlines"] %>
+<%= [openacs_menu]%> 
    
+
    OpenACS 4.0 Guidelines
    
+by Don Baccus and Ben Adida.
+
    
+
+
    Simple Issues
    
+
+We faced most of these issues at some point during the process of developing OpenACS 3.x. It's now time to standardize these and do everything correctly in 4.x!
+
+
+
    Sequences
    
+Use Dan Wickstrom's sequence view hack. The idea is to structure a view around a sequence so that the foo_seq.nextval construct can work.
+
    
+
    +create sequence user_id_seq;
+create view user_id_sequence as select nextval('user_id_seq') as nextval;
+
    
+
+
    Empty Strings
    
+Be stricter, not Oracle'ish. Default all varchars to empty string not null.
+
    
+
    +create table foo (
+       some_text varchar(100) default '' not null
+);
+
    
+
+
    Sysdate
     
+
+No using sysdate in the data model. This is pretty important given
+that we don't really want to have the basic data-model depend on a
+PL/SQL procedure. In general, avoid user-defined functions in the data
+model. Otherwise, the sysdate() function works fine.
+
+
    Case/Decode, NVL/Coalesce
    
+These issues are solved, but let's just remind everyone how they should be solved
    
+
+In Oracle, a decode statement looks like this:
+
    +select sum(decode(available_p,'t', 1,0)) as n_available from foo;
+
    
+
    
+In PG, this looks like this:
+
    +select sum(case when available_p='t' then 1 else 0 end) as n_available from foo;
+
    
+
+
    
+
+In Oracle, an NVL statement looks like:
+
    +select user_id, nvl(screen_name, '(no screen name)') from users;
+
    
+
    
+In PG, it looks like:
+
    +select user_id, coalesce(screen_name, '(no screen name)') from users;
+
    
+
    
+Note that coalesce is more powerful than NVL in that you can list any
+number of arguments, and the first non-null one will be returned. With
+NVL, you have to nest a number of NVL statements to achieve the same
+effect.
+
+
    Outer joins
    
+conversion examples by Don.
+
+
+
    Dispatching New Queries
    
+
+This is a pretty involved topic which will be handled in a separate document. We note one important thing:
+we can easily identify which page we are in using [ns_conn
+url] and the Tcl procedure we are in using ns_info. This
+means that the unique tagging scheme used in ACS 4.0 will work
+perfectly fine to replace simple SQL queries using a different source.
+
+
    Data Model Changes
    
+
+We need to standardize ways in which a data model is modified from
+Oracle to Postgres (7.1 or later):
+
+
      
+
    •  Char(1) becomes boolean
+
    •  date becomes timestamp
+
    •  lztext gone, we use text
+
    •  varchar(4000) becomes text
+
    •  varchar < 1000 remains varchar
+
    •  clob becomes text
+
    •  blobs are moved to filesystem level persistent object stuff (content repository).
+
    •  move to Postgres object extensions (declare indexes and triggers
+on all child tables). This may still be somewhat controversial. We
+will discuss this on the bboards, right here.
+
    •  comment on is supported, which means all the commenting
+can be kept precisely as is.
+
    
+
+
    PL/pgSQL
    
+
      
+
    •  function names when packages are involved: package__function (two underbars)
+
    •  16 parameters enough? We will see.
+
    •  default params: function overloading for common cases.
+
    
+
+
    Things for PG/GB to do
    
+
      
+
    •  up the identifier length to 64.
+
    •  up the # of PL/pgSQL parameters to 32.
+
    
+
+
    Questions for aD
    
+
      
+
    •  what's with the disabled constraints, followed by index creation, followed by constraint reenablement?
+
    •  what is the security_inherit_p attribute, and why no explicit
+attribute created for it? Answer: that is used by the AFS-like
+permission scheme, where a security context is inherited or not.
+
    
+
+
    Random Issues
    
+
      
+
    •  Email done within Oracle?? No way - a new notifications module
+
    •  acs_object_context_index may not be necessary? Create views on top of pg_inherits?
+
    •  Adding a content type that is a persistent object in the FS, that other systems rely on.
+
    
+
+
    Immediate Next Steps
    
+
      
+
    •  Who's available to do work?
+
    •  Putting together a full doc of all stuff discussed by Don and Ben done!
+
    •  Pushing PG and GB on a couple of issues this cannot happen for
+7.1. Maybe 7.2
+
    •  Putting a CVS solution/repository begun on openacs.org
+
    •  DB layer - fetching queries from somewhere else initial design
+in progress
+
    •  DB bind variables work in progress
+
    •  APM 
+
    •  Porting Kernel
+
    •  a Tcl API for storing large files
+
    
+
    
+
+<%= [openacs_footer] %>
\ No newline at end of file
Index: web/openacs/www/4/guidelines.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/4/guidelines.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/4/guidelines.html	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,144 @@
+OpenACS 4.0
+
+
+
    OpenACS 4.0 Guidelines
    
+by Don Baccus and Ben Adida.
+
    
+
+
    Simple Issues
    
+
+We faced most of these issues at some point during the process of developing OpenACS 3.x. It's now time to standardize these and do everything correctly in 4.x!
+
+
+
    Sequences
    
+Use Dan Wickstrom's sequence view hack. The idea is to structure a view around a sequence so that the foo_seq.nextval construct can work.
+
    
+
    +create sequence user_id_seq;
+create view user_id_sequence as select nextval('user_id_seq') as nextval;
+
    
+
+
    Empty Strings
    
+Be stricter, not Oracle'ish. Default all varchars to empty string not null.
+
    
+
    +create table foo (
+       some_text varchar(100) default '' not null
+);
+
    
+
+
    Sysdate
     
+
+No using sysdate in the data model. This is pretty important given
+that we don't really want to have the basic data-model depend on a
+PL/SQL procedure. In general, avoid user-defined functions in the data
+model. Otherwise, the sysdate() function works fine.
+
+
    Case/Decode, NVL/Coalesce
    
+These issues are solved, but let's just remind everyone how they should be solved
    
+
+In Oracle, a decode statement looks like this:
+
    +select sum(decode(available_p,'t', 1,0)) as n_available from foo;
+
    
+
    
+In PG, this looks like this:
+
    +select sum(case when available_p='t' then 1 else 0 end) as n_available from foo;
+
    
+
+
    
+
+In Oracle, an NVL statement looks like:
+
    +select user_id, nvl(screen_name, '(no screen name)') from users;
+
    
+
    
+In PG, it looks like:
+
    +select user_id, coalesce(screen_name, '(no screen name)') from users;
+
    
+
    
+Note that coalesce is more powerful than NVL in that you can list any
+number of arguments, and the first non-null one will be returned. With
+NVL, you have to nest a number of NVL statements to achieve the same
+effect.
+
+
    Outer joins
    
+conversion examples by Don.
+
+
+
    Dispatching New Queries
    
+
+This is a pretty involved topic which will be handled in a separate document. We note one important thing:
+we can easily identify which page we are in using [ns_conn
+url] and the Tcl procedure we are in using ns_info. This
+means that the unique tagging scheme used in ACS 4.0 will work
+perfectly fine to replace simple SQL queries using a different source.
+
+
    Data Model Changes
    
+
+We need to standardize ways in which a data model is modified from
+Oracle to Postgres (7.1 or later):
+
+
      
+
    •  Char(1) becomes boolean
+
    •  date becomes timestamp
+
    •  lztext gone, we use text
+
    •  varchar(4000) becomes text
+
    •  varchar < 1000 remains varchar
+
    •  clob becomes text
+
    •  blobs are moved to filesystem level persistent object stuff (content repository).
+
    •  move to Postgres object extensions (declare indexes and triggers
+on all child tables). This may still be somewhat controversial. We
+will discuss this on the bboards, right here.
+
    •  comment on is supported, which means all the commenting
+can be kept precisely as is.
+
    
+
+
    PL/pgSQL
    
+
      
+
    •  function names when packages are involved: package__function (two underbars)
+
    •  16 parameters enough? We will see.
+
    •  default params: function overloading for common cases.
+
    
+
+
    Things for PG/GB to do
    
+
      
+
    •  up the identifier length to 64.
+
    •  up the # of PL/pgSQL parameters to 32.
+
    
+
+
    Questions for aD
    
+
      
+
    •  what's with the disabled constraints, followed by index creation, followed by constraint reenablement?
+
    •  what is the security_inherit_p attribute, and why no explicit
+attribute created for it? Answer: that is used by the AFS-like
+permission scheme, where a security context is inherited or not.
+
    
+
+
    Random Issues
    
+
      
+
    •  Email done within Oracle?? No way - a new notifications module
+
    •  acs_object_context_index may not be necessary? Create views on top of pg_inherits?
+
    •  Adding a content type that is a persistent object in the FS, that other systems rely on.
+
    
+
+
    Immediate Next Steps
    
+
      
+
    •  Who's available to do work?
+
    •  Putting together a full doc of all stuff discussed by Don and Ben done!
+
    •  Pushing PG and GB on a couple of issues this cannot happen for
+7.1. Maybe 7.2
+
    •  Putting a CVS solution/repository begun on openacs.org
+
    •  DB layer - fetching queries from somewhere else initial design
+in progress
+
    •  DB bind variables work in progress
+
    •  APM 
+
    •  Porting Kernel
+
    •  a Tcl API for storing large files
+
    
+
    
+
    
+
    dhogaza@pacifier.com / ben@mit.edu
    
+
\ No newline at end of file
Index: web/openacs/www/4/index.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/4/index.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/4/index.adp	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,20 @@
+<%= [openacs_header "OpenACS 4.x"] %>
+
    OpenACS 4.x
    
+<%= [openacs_menu] %>
+
    
+OpenACS 4.x is the porting effort of ACS 4.1 to a fully open-source platform, specifically PostgreSQL to begin with. The goals of this effort are to:
+
      
+
    •  Achieve full ACS 4.x functionality on a fully open-source platform
+
    •  Lead the way in porting the ACS to other databases
+
    •  Allow many developers to write OpenACS packages on their own (e.g. eliminate the bottlenecks)
+
    •  Potentially create a "fat binary core" which can, at the flip of a switch, run on Oracle or PostgreSQL.
+
    
+
+
    
+To find out more, read the following documents:
+
    
+<%= [openacs_footer] %>
\ No newline at end of file
Index: web/openacs/www/4/query-dispatcher.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/4/query-dispatcher.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/4/query-dispatcher.adp	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,218 @@
+<%= [openacs_header "Query Dispatcher"] %>
+
    Query Dispatcher
    
+<%= [openacs_menu] %>
    
+
+
    Goals
    
+
+OpenACS 4.x should be, to some degree, database-independent:
+
      
+
    •  New RDBMS support should be implementable on a per-package basis without editing existing code.
+
    •  Packages should be storage-aware, and potentially multi-storage capable.
+
    
+
+
    Storage-Aware Architecture
    
+
+Each ACS classic package contains storage-dependent pieces, including:
+
      
+
    •  a data model for one RDBMS, usually Oracle 8
+
    •  default queries using the new database API, written for Oracle 8
+
    
+
+In order to safely extend the ACS package structure, an OpenACS package will include additional information, including:
+
      
+
    •  data model files tagged by RDBMS type and version
+
    •  RDBMS type and version of default queries
+
    •  additional queries for other RDBMSs.
+
    
+
+If this additional information isn't included in a package's meta-data, the OpenACS package manager will assume:
+
      
+
    •  the single data model provided is built for Oracle 8
+
    •  the default queries are written for Oracle 8
+
    
+
+Because we don't want to bias OpenACS for one database or another, and
+because it is quite confusing that some queries are inline while
+others are not, OpenACS will aim to quickly move all queries
+outside of the Tcl code, including the Oracle queries.
+
+
    Data Models
    
+
    
+The data model of a package in ACS Classic 4.x is stored in package_root/sql. OpenACS 4.x will change this convention to allow for multiple data models. The package_root/sql location will be split into multiple directories, one per supported RDBMS. The directories will be named according to the RDBMS (and potentially version) they refer to. No attempt will be made at finding common data model components across RDBMSs, as this seems to complicate the situation more than simplify anything. However, it is expected that the SQL creation files are exactly parallel for all RDBMSs supported by a single package. While these specifications may not assume such a file hierarchy at this point in time, they may change to make such an assumption at a later date.
+
    
+
+
    
+Thus, a directory package_root/sql might look like:
+
      
+
    •  package_root/sql/oracle/
+
    •  package_root/sql/oracle-9/
+
    •  package_root/sql/postgres
+
    •  package_root/sql/postgres-7.0
+
    
+
    
+
+
    
+Such a structure would mean that an Oracle 8 installation would use the default oracle directory, while an Oracle 9 will use the specific oracle-9 directory (this supposes that Oracle 9 has some special features). Similarly, PostgreSQL 7.1 will use the default postgres directory, while someone might choose to make the system also compatible with PostgreSQL 7.0 by adding a specific data model for it in postgres-7.0.
+
    
+
+
    
+In order to make this work in the APM architecture, the .info file should include RDBMS information. The <%= [ns_quotehtml ""] %> currently contains no additional information. The OpenACS package specification will add an RDBMS tag (NOT an attribute!) as follows:
+
    
+
    +<%= [ns_quotehtml "oracle9"] %>
+
    
+
    
+ For now, this information will be redundant with the naming scheme selected above. Again, this may change at any time. Thus, both the naming convention and the .info additions must be respected.
+
    
+
+
    A Full Query
    
+A query in ACS Classic 4.x is currently tagged uniquely by Tcl script or Tcl procedure. Since it is relatively easy to determine in which Tcl page or procedure a DB call is being made, we have a means of uniquely identifying queries in a system-wide manner. We must also attach all required meta-data to a query. A Full Query is thus defined as:
+
+
      
+
    •  the SQL of the query
+
    •  the bind variables expected (which may be implicit in the query)
+
    •  the RDBMS(s) the query is designed for
+
    
+
+The best way to specify a "full query" is via a human-readable, easily-parsable format. Using XML for this purpose is quite appropriate. A full query would then be defined as:
+
+
    +<%= [ns_quotehtml "
+
+select * from foo where foo_id= :foo_id
+
+foo_id
+
+postgresql7
+
+"] %>
+
    
+
+
    
+The <%= [ns_quotehtml ""] %> component can be left out, or the <%= [ns_quotehtml ""] %> can be left out altogether. The Query Dispatcher will pick the most specific query possible for a given setup. Thus, it is possible to specify a generic SQL92 query that will apply to all RDBMSs. Only when an RDBMS isn't compatible with that generic query will there need to be a more precisely specified query for that particular RDBMS. This allows developers to focus on SQL92 queries, and to work on RDBMS-specific query as a "diff" from the standard. (The fact that this encourages the use of compliant RDBMSs is not a bad thing, either). 
+
    
+
+
    
+The full-query and query dispatching mechanism need to be well-abstracted for possible future enhancements in the means of storing and organizing these full queries. The following API will allow this:
+
+
      
+
    •  db_fullquery_fetch fullquery_global_name
      
+This retrieves a FullQuery data structure using the global name. The FullQuery data structure is then used by the following API calls to obtain further query information.
+
      
+
+
    •  db_fullquery_get_text fullquery {rdbms}
      
+Retrieves the SQL query text from the FullQuery data structure. If the RDBMS parameter is provided, the text for that RDBMS is returned. Otherwise, the current RDBMS is used. If no query exists for this RDBMS, this throws an exception.
+
      
+
+
    •  db_fullquery_compatible_p fullquery {rdbms}
      
+Checks if a FullQuery is compatible with a given RDBMS. If no RDBMS parameter is provided, the FullQuery is checked against the current RDBMS.
+
      
+
+
    •  db_fullquery_get_bindvars fullquery
      
+Returns a Tcl list of bind variable names for the FullQuery.
+
      
+
+
    •  db_current_rdbms
      
+Returns the current RDBMS, which can be detailed using the following two procedures.
+
      
+
+
    •  db_rdbms_get_type rdbms
      
+Returns the type of a given RDBMS.
+
      
+
+
    •  db_rdbms_get_version rdbms
      
+Returns the version of a given RDBMS.
+
      
+
+
    •  db_rdbms_match rdbms_instance rdbms_pattern
      
+Returns true if rdbms_instance matches the rdbms_patterns. rdbms_pattern might be something like oracle with no version, while rdbms_instance might be oracle 8.1.6, in which case the procedure returns true. If the rdbms_patterns is oracle version 9, though, the procedure will return false.
+
      
+
    
+
+
    The Simple Dispatching Process
    
+
+The Query Dispatcher must be able to locate the various versions of
+each query in order to create the FullQuery data structures. For this,
+each FullQuery must have a global name and, from that global name, a
+means of locating and loading the query.
+
+
    Naming Scheme
    
+The naming scheme for a FullQuery is specified as all-lowercase, as follows:
+
    
+
    +package_name.section_name.chunk_name.query_name
+
    
+
    
+
+where :
+
      
+
    •  the package_name is the name of the OpenACS
+package to which this query belongs. Packages are uniquely named in
+the system, and anything belonging to the kernel will be tagged
+acs_kernel for the purposes of this naming scheme.
+
    •  the section_name is either tcl or
+www depending on whether the query is in a Tcl procedure or
+web page.
+
    •  the chunk_name is either a Tcl procedure name, or
+a web page path.
+
    •  the query_name is the actual query tag in the
+db_ API call.
+
    
+
    • + +

    Locating FullQuery Information

    + +FullQuery information will be stored as XML text files. In order to +provide the same flexibility as Tcl procedure files and independent +web pages, FullQueries will be stored, by convention, in files that +parallel the directory hierarchy of the code they pertain to. + +

    + +For example, in package acs-subsite, the file +www/register/deleted-user.tcl will be complemented by the +file www/register/deleted-user.postgres.sql and potentially +by the file www/register/deleted-user.oracle.sql. + +

    + +The Query Dispatcher will look at any .sql files in the +tcl and www directories, and load the FullQuery +information from those files. The actual names of the files +(deleted-user and .oracle extension) don't matter, as +the fully-qualified name of the query and the RDBMS-compatibilities +are defined in the FullQuery XML itself. The file naming is a +convention to make it easier for developers to get at the right query +text. + +

    Storing & Refreshing FullQuery Information

    + +

    +The Query Dispatcher will load up all queries and store them in an nsv +array at AOLserver/OpenNSD boot time. The file location of each query +will also be stored in the nsv array so that, at a later date, the +query information can be easily located and reloaded on a +per-query-file basis. We assume that, if the definition of a query +changes place (which shouldn't happen when users are following the +proper naming conventions), an AOLserver/OpenNSD reboot will be +necessary to properly reload the queries. +

    + +

    +During development time, it is perfectly acceptable to reparse the +queries on every DB query. The first version of the Query Dispatcher +will not bother with much caching, in fact. The first production +release, however, will provide two means of caching: +

      +
    • all queries loaded up only once at server startup (i.e. no +ability to reload queries, good only for production sites) +
    • queries reloaded when the source file has changed +
    +

    + + +

    Dynamic SQL Strategies

    +under development + +<%= [openacs_footer] %> + Index: web/openacs/www/4/schedule.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/4/schedule.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/4/schedule.adp 17 Apr 2001 14:05:23 -0000 1.1 @@ -0,0 +1,15 @@ +<%= [openacs_header "OpenACS 4.x Schedule"] %> +

    OpenACS 4.x Schedule

    +<%= [openacs_menu] %>

    + +This schedule is tentative, and may be revised depending on the complexity of the ongoing porting effort. The idea, however, is that we will do our best to stick to these dates: + +

      +
    • February 15th, 2001: Guidelines posted and detailed discussions begin +
    • February 25th, 2001: Query Dispatcher spec'ed for simple and complex queries. Driver modifications spec'ed. +
    • March 5th, 2001: Query Dispatcher and driver modifications implemented and available from CVS. Work by OpenACS Core Group can begin. +
    • March 31st, 2001: Kernel ported, bits and pieces of Core begun. Work by OpenACS Community-at-large can begin. +
    • April 15th, 2001: OpenACS 4.x core released in alpha1. +
    + +<%= [openacs_footer] %> \ No newline at end of file Index: web/openacs/www/SYSTEM/dbtest-other.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/SYSTEM/dbtest-other.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/SYSTEM/dbtest-other.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,21 @@ +# this is called by server monitoring scripts, such as +# keepalive (see http://arsdigita.com/free-tools/keepalive.html) +# if it doesn't return "success" then they are supposed +# to kill the AOLserver + +# you can also use this with our Uptime monitoring system, +# described in Chapter 15 of http://photo.net/wtr/thebook/ + +# this tests total db connectivity + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select sysdate from dual"] + +if { $selection == "" } { + ns_return 500 text/plain "failed" +} else { + ns_return 200 text/plain "success" +} + + Index: web/openacs/www/SYSTEM/dbtest.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/SYSTEM/dbtest.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/SYSTEM/dbtest.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,22 @@ +# dbtest.tcl,v 3.1 2000/02/29 04:39:43 jsc Exp +# this is called by server monitoring scripts, such as +# keepalive (see http://arsdigita.com/free-tools/keepalive.html) +# if it doesn't return "success" then they are supposed +# to kill the AOLserver + +# you can also use this with our Uptime monitoring system, +# described in Chapter 15 of http://photo.net/wtr/thebook/ + +# this tests total db connectivity + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select sysdate() from dual"] + +if { $selection == "" } { + ns_return 500 text/plain "failed" +} else { + ns_return 200 text/plain "success" +} + + Index: web/openacs/www/SYSTEM/flush-memoized-statement.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/SYSTEM/flush-memoized-statement.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/SYSTEM/flush-memoized-statement.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,18 @@ +# flush-memoized-statement.tcl,v 1.1 2000/03/07 16:49:38 jsalz Exp +# Name: flush-memoized-statement.tcl +# Author: Jon Salz +# Date: 29 Feb 2000 +# Description: Performs util_memoize_flush_local on the statement parameter. +# Inputs: statement + +if { ![server_cluster_authorized_p [ns_conn peeraddr]] } { + ns_returnforbidden + return +} + +util_memoize_flush_local [ns_queryget statement] + +if { [server_cluster_logging_p] } { + ns_log "Notice" "Distributed flush of [ns_queryget statement]" +} +ns_return 200 "text/plain" "Successful." Index: web/openacs/www/SYSTEM/log-monitor.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/SYSTEM/log-monitor.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/SYSTEM/log-monitor.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,64 @@ +# this program was written by Philip Greenspun (philg@mit.edu) +# it is free to everyone under the standard GNU Public License +# Modified by Hugh Brock hbrock@arsdigita.com 3/30/00 so keepalive could +# write monitor information into the server error log before restarting. +# +# Modified by Arjun Sanyal 2/13/01 Removed the following block since +# AOLserver 3.0+ad2 dosen't have "ns_totalstats" or "ns_intervalstats". +# Maybe later I'll add stats from the current ns_telemetry.tcl page. +# +# Here's the removed block: +# +# AOLserver says that the max number of threads spawned since server +# startup is [ns_totalstats HWM-threads]. The max threads since the +# last interval reset (every 5 minutes or so by default): +# [ns_intervalstats HWM-threads]. This final number is probably the +# best estimate of current server activity. + +set connections [ns_server active] + +# let's build an ns_set just to figure out how many distinct elts; kind of a kludge +# but I don't see how it would be faster in raw Tcl + +set scratch [ns_set new scratch] +foreach connection $connections { + ns_set cput $scratch [lindex $connection 1] 1 +} + +set distinct [ns_set size $scratch] + +# run standard Unix uptime command to get load average (crude measure of +# system health) + +if [catch {set uptime_output [exec /usr/bin/uptime]} errmsg] { + # whoops something wrong with uptime (check path) + set uptime_output "ERROR running uptime, check path in script" +} + +set connection_block "" + +foreach connection $connections { + append connection_block "[join $connection " : "] +" +} + + +ns_log error "Keepalive restarted the [ns_info server] server. + +Server status just before restart: + +There are a total of [llength $connections] requests being served +right now (to $distinct distinct IP addresses). Note that this number +seems to include only the larger requests. Smaller requests, e.g., +for .html files and in-line images, seem to come and go too fast for +this program to catch. + +Here's what uptime has to say about the box: + +$uptime_output + +conn # : client IP : state : method : url : n seconds : bytes + +$connection_block +" + Index: web/openacs/www/SYSTEM/readme.txt =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/SYSTEM/readme.txt,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/SYSTEM/readme.txt 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,6 @@ +The SYSTEM directory is for scripts that are only +grabbed by robots, e.g., uptime.txt for the Uptime +robot or dbtest.tcl for keepalive + + + Index: web/openacs/www/SYSTEM/uptime.txt =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/SYSTEM/uptime.txt,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/SYSTEM/uptime.txt 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1 @@ +success \ No newline at end of file Index: web/openacs/www/about/history.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/about/history.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/about/history.adp 17 Apr 2001 14:05:23 -0000 1.1 @@ -0,0 +1,125 @@ +<%= [ad_header "History of OpenACS?"] %> +

    History of OpenACS

    +by Ben Adida. +

    + +

    In the Beginnning ...

    +Back in the summer of 1995, Philip +Greenspun, Brian Tivol and I spent a few weeks in New York working +at Hearst Publishing developing the Multimedia Newsstand. The tools +available at the time were pretty pathetic. Netscape was at version +1.1 (barely), and about 30% of our visitors were still using v0.9. + +

    + +Philip had done his homework, though, and had chosen Naviserver as +our web server platform. Naviserver was the brainchild of Jim and Doug, +two amazing hackers who immediately understood how to build +server-side web technology: +

      +
    • Built-in, simple, string-oriented, scripting language: Tcl, +
    • Efficient multi-threading, +
    • Simple and abstracted database access and connection pooling. +
    + +We set out to create a web site with daily editorials, magazine sales +and ordering, customer tracking, and quite a few more pieces. In about 12 weeks, it was +up and running and happy. The Illustra RDBMS would crap out every now +and then thanks to the Elan License Manager (among other problems), +but overall Hearst was happy. The numerous utility procedures that we +created and used that summer came together into what is now the +utilities.tcl file in your ACS installation. The information so far +should allow you to guess the reason why bt_mergepiece is +called bt_mergepiece. + +

    +

    Driving the Idea

    +It was Philip who then started to use Naviserver (later GNNserver, now +AOLserver, all the same product) and Illustra to create a host of +services that became greenspun.com, in addition to the +early versions of photo.net. Philip +created the initial versions of bboard, classified, +neighbor-to-neighbor, and many other pieces all in order to manage the +growing photo.net community. + +

    + +Philip continued to push AOLserver, eventually dropping Illustra by +hiring Cotton Seed, another hard-core hacker, to write an Oracle driver. Oracle brought a whole +new level of scalability and reliability to the thousands of lines of +Tcl code already written. At that time, in early 1998, Philip +officially created ArsDigita, LLC, in order to push the consulting +work he was already doing. He brought on 6 people (Philip, Olin, +Cotton, Terence, Ulla, and myself) to carry the initial ArsDigita flag +(although I had almost nothing to do with the setup of ArsDigita to +begin with). + +

    + +Philip brought on Jin Choi, one of the only people I know who deserves +the title of "monster hacker." Together they went ahead and built +entirely new services based on AOLserver/Oracle. The most famous of +these was, of course, scorecard.org, an amazing site that +anyone claiming to understand web scalability should take a look at +(30 db-backed hits/second on Earth day running on one Sun Ultra 2). + +

    +

    And There Was A Toolkit...

    + +It was right around that time that Philip convinced me to come back +and work full-time for ArsDigita. Jin, Eve, Tracy, Philip and I worked +through the summer of 1998 on various projects (Levi Strauss, Cognet, +ASME, Greentravel now away.com), while Philip kept talking about his +grand-integration goal: combining all of these pieces into the ArsDigita Community System. + +

    + +Soon enough, the ACS was real. The first release was posted on +December 8th, 1998, after a huge packaging, debugging, and integration +effort led by Philip. The ACS became the backbone of all ArsDigita +projects, and many hackers around the world started using it. + +

    + +With the rise of open-source software and the realization that good +software can still be free, many people started wondering if the ACS +could be made to run on some RDBMS other than Oracle. An Interbase +port of the ACS v2.1 was created, but Interbase still cost money at +the time (although it should be open-source and free by end of +2000). Many cheered for MySQL, but the lack of transaction and +subselects makes it unacceptable for a true ACS (or for any critical +system, for that matter). + +

    +

    PostgreSQL

    +In December 1999, a small group of ACS hackers came together on SourceForge to create the ACS port +to PostgreSQL. Following true +open-source methods, we gave write permissions to anyone who showed +enough competence to help out. The group soon grew to more than 20 +people, with about 5 active developers. + +

    + +The initial name of the project, ACS/pg, was changed to OpenACS as the +group realized that there was a need to push porting to possibly other +databases than PostgreSQL (Interbase?). OpenACS further represents the +importance of a fully open-sourced system that truly works in +symbiosis with the Open-Source community. + +

    + +Philip and his team have done a tremendous job creating the processes +and data model necessary to build scalable, reliable online +communities. OpenACS hopes to bring this tremendous contribution to the +world of fully open-sourced systems, available to anyone interested in +building their own online community. + +

    + +<%= [ad_footer] %> \ No newline at end of file Index: web/openacs/www/about/team.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/about/team.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/about/team.adp 17 Apr 2001 14:05:23 -0000 1.1 @@ -0,0 +1,12 @@ +<%= [ad_header "OpenACS Team"] %> +

    OpenACS Team

    +part of <%= [ad_system_name] %> +

    + +The OpenACS team has never met in a physical location. We are a +community of engineers around the Internet who want to help make the +ACS available to all. +

    +Right now, this page is being restructured to give all credit due to the many contributors. The OpenACS development team is growing, and we wish to give everyone proper credit! Until we're ready to do so, the team shall remain anonymous! +

    +<%= [ad_footer] %> \ No newline at end of file Index: web/openacs/www/about/what-is-openacs.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/about/what-is-openacs.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/about/what-is-openacs.adp 17 Apr 2001 14:05:23 -0000 1.1 @@ -0,0 +1,46 @@ +<%= [ad_header "What is OpenACS?"] %> +

    What is OpenACS?

    +in <%= [ad_system_name] %>. +

    + +OpenACS is the ArsDigita +Community System ported to run on the PostgreSQL RDBMS. +

    +The ArsDigita Community System consists of: +

      +
    • a large data model to represent many facets of web +collaboration. +
    • a web application in AOLserver +Tcl that sits atop this data model. +
    • documentation that guides a web programmer through the setup, +configuration, and customization of this very advanced web toolkit. +
    +

    +The ACS is used by a number of high-profile clients of ArsDigita's, +but its widespread acceptance in the hacker community has been greatly +handicapped by its complete dependence on the Oracle RDBMS, an expensive, +closed-source system. +

    +We, the OpenACS team, think Oracle is a fine RDBMS, but we really want +a fully open-source web toolkit, an inexpensive but good solution. We +don't use any tool simply because it is open-source. We pick good +open-source tools because open-source yields better products and more +freedom to the end-user: +

      +
    • AOLserver: an +efficiently-multithreaded web server with a built-in Tcl +interpreter. This piece of software combines ease and speed of +development with tremendous scalability. As of version 3.0, it is +open-sourced under the GPL. +
    • PostgreSQL: the most +advanced open-source RDBMS available. Postgres supports a lot of the +SQL92 standard, with increasing support in every updated release. It +offers true transactions, efficient locking optimized for web +applications, and an easy-to-use interface for setup and +administration. +
    + +

    +<%= [ad_footer] %> Index: web/openacs/www/acs-examples/README.txt =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/acs-examples/README.txt,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/acs-examples/README.txt 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,6 @@ + +This directory is for source code examples of how to use the ArsDigita +Community System. + +-- philg@mit.edu, November 8, 1999 + Index: web/openacs/www/acs-examples/adserver/page-with-ad.html =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/acs-examples/adserver/page-with-ad.html,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/acs-examples/adserver/page-with-ad.html 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,19 @@ + + +This is a page with a banner ad on it + + + + + + +

    This is a page with a banner ad on it

    + + +Note that this page will only work if you've gone into your +/admin/adserver/ pages and added an ad with a key of "arsdigita". + +
    +
    philg@mit.edu
     + + Index: web/openacs/www/acs-examples/spellcheck/form-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/acs-examples/spellcheck/form-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/acs-examples/spellcheck/form-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,38 @@ +# form-2.tcl,v 3.0 2000/02/06 02:43:27 ron Exp +# +# /acs-examples/spellcheck/form-2.tcl +# +# by philg@mit.edu, November 8, 1999 +# +# end of spellcheck demo +# + +set_the_usual_form_variables + +# first_name, occupation, dream + +ns_return 200 text/html "[ad_header "The psychiatrist talks"] + +

    The psychiatrist talks

    + +[ad_context_bar_ws_or_index "Listen"] + +
    + +Very interesting, $first_name. + +

    + +You sound conflicted about sticking with the occupation of $occupation. + +

    + +You are to be commended for your dreaming orthography in + +

    +$dream + +
    + +[ad_footer] +" Index: web/openacs/www/acs-examples/spellcheck/form.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/acs-examples/spellcheck/form.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/acs-examples/spellcheck/form.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,49 @@ +# form.tcl,v 3.0 2000/02/06 02:43:27 ron Exp +# +# /acs-examples/spellcheck/form.tcl +# +# by philg@mit.edu, November 8, 1999 +# +# beginning of spellcheck demo +# + +ns_return 200 text/html "[ad_header "Talk to the psychiatrist"] + +

    Talk to the psychiatrist

    + +[ad_context_bar_ws_or_index "Talk"] + +
    + +
    + + + + +Your first name: + + +

    + +Your occupation: + + +

    + +Your dream last night: + +

    + +

    + +
    + +
    + +
    + + +[ad_footer] +" Index: web/openacs/www/acs-examples/table-display/table-display-example.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/acs-examples/table-display/table-display-example.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/acs-examples/table-display/table-display-example.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,300 @@ +# table-display-example.tcl,v 3.0 2000/02/06 02:43:45 ron Exp +# +# The example code for ad-display-table.tcl functions... +# + +proc_doc ad_table_display_example_simple {orderby dummy1 dummy2 dummy3} { + this is a simple version using + the dimensional slider and table widgets +} { + # set up data for dimensional slider + set dimensional_list { + {visited "Last Visit" 1w { + {never "Never" {where "last_visit is null"}} + {1m "Last Month" {where "last_visit + 30 > sysdate()"}} + {1w "Last Week" {where "last_visit + 7 > sysdate()"}} + {1d "Today" {where "last_visit > trunc(sysdate())"}} + }} + {lastname "Last name " d { + {d "starts with d" {where "upper(last_name) like 'D%'"}} + {notd "does not start with d" {where "upper(last_name) not like 'D%'"}} + {all "all" {}} + }} + } + + # set up the table definition + set table_def { + {email "e-Mail" {} {}} + {email_bouncing_p "e-Bouncing?" {} tf} + {user_state "State" {} l} + {last_visit "Last Visit" {} r} + } + + # spit out the dimensional bar + ns_write "[ad_dimensional $dimensional_list]

    \n" + + # generate and submit query then generate the table. + # the 1 = 1 thing is a hack since ad_dimension_sql wants to + # prepend an add. + set sql "select * from users where 1 = 1 + [ad_dimensional_sql $dimensional_list where] + [ad_order_by_from_sort_spec $orderby $table_def]" + set db [ns_db gethandle] + set selection [ns_db select $db $sql] + + ns_write "[ad_table -Torderby $orderby $db $selection $table_def]" + + # and finally we are done + ns_write "[ad_footer]" +} + + + + +proc_doc ad_table_display_example_medium_complicated {orderby dummy1 dummy2 dummy3} { + A slightly more involved example +} { + set dimensional_list { + {visited "Last Visit" 1w { + {never "Never" {where "last_visit is null"}} + {1m "Last Month" {where "last_visit + 30 > sysdate()"}} + {1w "Last Week" {where "last_visit + 7 > sysdate()"}} + {1d "Today" {where "last_visit > trunc(sysdate())"}} + }} + {lastname "Last name " d { + {d "starts with d" {where "upper(last_name) like 'D%'"}} + {notd "does not start with d" {where "upper(last_name) not like 'D%'"}} + {all "all" {}} + }} + } + + + # Full Name is an example of a synthetic field for which you have to + # provide the ordering info yourself + # email simple db column but with formatting + # email_bounce_p an example of the built in format of tf="Yes No" + # last_visit right aligned + # actions is a non-sorting column + + set table_def { + {fullname "Full Name" + {upper(last_name) $order, upper(first_names) $order} + {$first_names $last_name} } + {email "e-Mail" {} {$email}} + {email_bouncing_p "e-Bouncing?" {} tf} + {user_state "State" {} {}} + {last_visit "Last Visit" {} r} + {actions "Actions" {} + {Edit Info | + New Password | + [ad_registration_finite_state_machine_admin_links $user_state $user_id]}} + } + + # generate the SQL query from the dimensional bar + # and the sort clause from the table + # + # once again 1 = 1 is a hack... + set sql "select * from users where 1 = 1 + [ad_dimensional_sql $dimensional_list where] + [ad_order_by_from_sort_spec $orderby $table_def]" + + # spit out the dimensional bar + ns_write "[ad_dimensional $dimensional_list]

    \n" + + set db [ns_db gethandle] + set selection [ns_db select $db $sql] + ns_write "[ad_table -Torderby $orderby $db $selection $table_def]" + + ns_write "[ad_footer]" +} + +proc_doc ad_table_display_example_ott {orderby customize table_display_example table_display_example_sort} { + A full example with all the machinery including table customization and + full dynamic query generation. +} { + set dimensional_list { + {visited "Last Visit" 1w { + {never "Never" {where "last_visit is null"}} + {1m "Last Month" {where "last_visit + 30 > sysdate()"}} + {1w "Last Week" {where "last_visit + 7 > sysdate()"}} + {1d "Today" {where "last_visit > trunc(sysdate())"}} + }} + {lastname "Last name " d { + {d "starts with d" {where "upper(last_name) like 'D%'"}} + {notd "does not start with d" {where "upper(last_name) not like 'D%'"}} + {all "all" {}} + }} + } + + set db [ns_db gethandle] + + # now build the SQL query from the user_class table + # + set user_id [ad_get_user_id] + set class_list {} + set selection [ns_db select $db "select * from user_classes"] + while {[ns_db getrow $db $selection]} { + set_variables_after_query + lappend class_list [list $user_class_id $name [list query "select users.* $sql_post_select"]] + } + + # a query for all users... + lappend class_list [list all "All" {query "select * from users where 1 = 1"}] + + # now put the list of queries into the dimensiona_list + lappend dimensional_list [list user_class "User Class" all $class_list] + + + # Full Name is an example of a synthetic field for which you have to + # provide the ordering info yourself + # email simple db column but with formatting + # email_bounce_p an example of the built in format of tf="Yes No" + # last_visit right aligned + # actions is a non-sorting column w/o + + set table_def { + {fullname "Full Name" + {upper(last_name) $order, upper(first_names) $order, upper(email) $order} + {$first_names $last_name} } + {email "e-Mail" {} {$email}} + {email_bouncing_p "e-Bouncing?" {} tf} + {user_state "State" {} {}} + {last_visit "Last Visit" {} r} + {priv_name "Priv Name" {} r} + {priv_email "Priv Email" {} r} + {converted_p "Converted?" {} tf} + {second_to_last_visit "Visit-2" {} {}} + {n_sessions "Visits" {} r} + {registration_date "Registered On" {} {}} + {registration_ip "Registration IP" {} {$registration_ip}} + {approved_date "Approved On" {} {}} + {approving_user "By UID" {} {}} + {approving_note "Note" {} {}} + {email_verified_date "E-Mail Verified On" {} {}} + {banning_note "Ban Note" {} {}} + {crm_state "CRM State" {} {}} + {crm_state_entered_date "CRM State As Of" {} {}} + {portrait_upload_date "Portrait Uploaded" {} {}} + {portrait_file_type "Portrait MIME" {} {}} + {portrait_original_width "Portrait Width" {} {}} + {portrait_original_height "Portrait Height" {} {}} + {actions "Actions" {} + {Edit Info | + New Password | + [ad_registration_finite_state_machine_admin_links $user_state $user_id]}} + } + + # load the current customized table and sort if needed + set columns {} + if { ! [empty_string_p $table_display_example] } { + set columns [ad_custom_load $db $user_id table_display_example $table_display_example table_view] + } + if {[empty_string_p $columns]} { + # if we did not have a custom set of columns set a default + set columns {fullname email approved_date registration_ip actions} + } + + if {[empty_string_p $orderby]} { + if { ![empty_string_p $table_display_example_sort]} { + set orderby [ad_custom_load $db $user_id table_display_example_sort $table_display_example_sort table_sort] + } + } else { + # if we have orderby then we have updated the sort... + set table_display_example_sort {} + } + + if { $customize == "table" } { + + # If we are in table customization mode generate the form + set return_url "[ns_conn url]?[export_ns_set_vars url [list table_display_example customize]]" + ns_write "[ad_table_form $table_def select $return_url table_display_example $table_display_example $columns]" + + } elseif { $customize == "sort" } { + + set return_url "[ns_conn url]?[export_ns_set_vars url [list orderby table_display_example_sort customize]]" + ns_write "[ad_table_sort_form $table_def select $return_url table_display_example_sort $table_display_example_sort $orderby]" + + } else { + # The normal table + + # spit out the dimensional bar + ns_write "[ad_dimensional $dimensional_list]

    \n" + + # now the table views + set customize_url "[ns_conn url]?[export_ns_set_vars url [list customize table_display_example]]&customize=table&table_display_example=" + set use_url "[ns_conn url]?[export_ns_set_vars url table_display_example]&table_display_example=" + ns_write "Table Views: [ad_custom_list $db $user_id table_display_example $table_display_example table_view $use_url $customize_url]
    " + + # now the sorts + set customize_url "[ns_conn url]?[export_ns_set_vars url [list customize orderby table_display_example_sort]]&customize=sort&table_display_example_sort=" + set use_url "[ns_conn url]?[export_ns_set_vars url [list orderby table_display_example_sort]]&table_display_example_sort=" + ns_write "Sorts: [ad_custom_list $db $user_id table_display_example_sort $table_display_example_sort table_sort $use_url $customize_url "new sort"]
    " + + # Generate the query + set sql "[ad_dimensional_sql $dimensional_list query {}] + [ad_dimensional_sql $dimensional_list where] + [ad_order_by_from_sort_spec $orderby $table_def]" + + #pull out the actual data + set selection [ns_db select $db $sql] + ns_write "[ad_table -Torderby $orderby -Tcolumns $columns $db $selection $table_def]" + } + + # and finally we are done + ns_write "[ad_footer]" +} + + + + + + + +# +# Main driver for the page +# + +ReturnHeaders + +ns_write [ad_header "Table and dimensional bar example"] + +# The good function for setting variables from +ad_page_variables { + {page_mode ad_table_display_example_ott} + {orderby {}} + {customize {}} + {table_display_example {}} + {table_display_example_sort {}} +} + +ns_write "

    JD table and dimensional bar example

    + Code:

    Page mode: " + +set exports [export_ns_set_vars url page_mode] +set url [ns_conn url] + +foreach mode {ad_table_display_example_simple ad_table_display_example_medium_complicated ad_table_display_example_ott} { + if {[string compare $mode $page_mode] == 0} { + ns_write "($mode CODE)  " + } else { + ns_write "$mode  " + } +} +ns_write "

    note the User Class field in the ad_table_display_example_ott is built dynamically from +the database and if you have a lot of user classes it will look stupid. It is just there to demonstrate +the functionality...

    " + +eval [list $page_mode $orderby $customize $table_display_example $table_display_example_sort] + + + + + + + Index: web/openacs/www/address-book/birthdays.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/address-book/birthdays.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/address-book/birthdays.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,79 @@ +# birthdays.tcl,v 3.0 2000/02/06 02:44:21 ron Exp +# File: /address-book/record-search.tcl +# Date: 12/24/99 +# Contact: teadams@arsdigita.com, tarik@arsdigita.com +# Purpose: shows a single address book record +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# maybe contact_info_only +# maybe order_by + +ad_scope_error_check user + +set db [ns_db gethandle] +ad_scope_authorize $db $scope none group_member user + +set name [address_book_name $db] + + +ReturnHeaders +ns_write " +[ad_scope_header "Birthdays" $db] +[ad_scope_page_title "Birthdays" $db ] +[ad_scope_context_bar_ws [list "index.tcl?[export_ns_set_vars]" "Address book"] "Birthdays"] +

    +[ad_scope_navbar] +" + +# this is for my ordering scheme described below +set date_format "MMDDYYYY" +set this_year [database_to_tcl_string $db "select to_char(sysdate(),'YYYY') from dual"] +set a_leap_year "1996" +set this_date_in_a_leap_year "[database_to_tcl_string $db "select to_char(sysdate(), 'MMDD') from dual"]$a_leap_year" + +# the crazy-looking ordering below was chosen so that if someone's birthday is today, it will show up first, then we'll see people who have birthdays coming up this year (in chronological order), then we'll see people whose next birthday won't be until next year (in chronological order) + +set selection [ns_db select $db "select address_book_id, first_names, last_name, birthmonth, birthday, birthyear, date_part('epoch',(to_date('$this_date_in_a_leap_year','$date_format')-to_date(birthmonth || birthday || '$a_leap_year','$date_format'))::reltime) as before_or_after_today, to_char(to_date(birthmonth,'MM'),'Mon') as pretty_birthmonth +from address_book +where [ad_scope_sql] and birthmonth is not null"] + +set count 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + incr count + # if $before_or_after_today = -1 then the birthday is later in the year than today, if it's 0 then it's today, if 1 then it won't occur until next year + + append html "$pretty_birthmonth $birthday: $first_names $last_name" + + if { ![empty_string_p $birthyear] } { + if { $before_or_after_today == "0" } { + set age_on_next_birthday [expr $this_year - $birthyear] + append html " (turns $age_on_next_birthday today!)" + } elseif { $before_or_after_today == "-1" } { + set age_on_next_birthday [expr $this_year - $birthyear] + append html " (turns $age_on_next_birthday)" + } else { + set age_on_next_birthday [expr $this_year + 1 - $birthyear] + append html " (turns $age_on_next_birthday)" + } + } + + append html "
    " +} + +if {$count == 0 } { + append html "No birthdays have been entered." +} + +ns_write " +
    +$html +
    +[ad_scope_footer] +" Index: web/openacs/www/address-book/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/address-book/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/address-book/index.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,101 @@ +# index.tcl,v 3.0 2000/02/06 02:44:21 ron Exp +# File: /address-book/index.tcl +# Date: 12/24/99 +# Contact: teadams@arsdigita.com, tarik@arsdigita.com +# Purpose: address book main page +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) + +ad_scope_error_check user + +set db [ns_db gethandle] +set user_id [ad_scope_authorize $db $scope none group_member user] + +set name [address_book_name $db] + +ReturnHeaders + +ns_write " +[ad_scope_header "Address Book for $name" $db] +[ad_scope_page_title "Address Book for $name" $db] +[ad_scope_context_bar_ws "Address Book"] +
    +[ad_scope_navbar] +" + +append html " +
  • View all records +

    +" + +if { [ad_scope_administrator_p $db $user_id] } { + append html " +

  • Add a record +

    + " +} + +append html " +

  • Search for a record: +

    + + + + + +[export_form_scope_vars] +[philg_hidden_input "search_by" "last_name"] + + + + + + + + +[export_form_scope_vars] +[philg_hidden_input "search_by" "first_names"] + + + + + + + + +[export_form_scope_vars] +[philg_hidden_input "search_by" "city"] + + + + +
    +Last Name: +
    +First Name: +
    +City: +
    + +

    +

  • View all birthdays +" + +ns_write " +
      +$html +
    +[ad_scope_footer] +" + + + + + Index: web/openacs/www/address-book/record-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/address-book/record-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/address-book/record-add-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,44 @@ +# record-add-2.tcl,v 3.0 2000/02/06 02:44:21 ron Exp +# File: /address-book/record-add-2.tcl +# Date: 12/24/99 +# Contact: teadams@arsdigita.com, tarik@arsdigita.com +# Purpose: adds an address book record +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# address_book_id, first_names, last_name, email, email2, line1, line2, city, usps_abbrev, zip_code, phone_home, phone_work, phone_cell, phone_other, country, birthmonth, birthday, birthyear, days_in_advance_to_remind, days_in_advance_to_remind_2, notes +# maybe return_url + +if { ![info exists return_url] } { + set return_url "index.tcl?[export_url_scope_vars]" +} + +validate_integer address_book_id $address_book_id + +ad_scope_error_check user + +set db [ns_db gethandle] +ad_scope_authorize $db $scope none group_admin user + +set column_list [list address_book_id first_names last_name email email2 line1 line2 city usps_abbrev zip_code phone_home phone_work phone_cell phone_other country birthmonth birthday birthyear days_in_advance_to_remind days_in_advance_to_remind_2 notes] + +foreach column $column_list { + if [info exists QQ$column] { + lappend QQvalues_list "[set QQ$column]" + lappend final_column_list $column + } +} + +ad_dbclick_check_dml $db address_book address_book_id $address_book_id $return_url " +insert into address_book +([join $final_column_list ,], [ad_scope_cols_sql]) +values +('[join $QQvalues_list "','"]', [ad_scope_vals_sql]) +" + + Index: web/openacs/www/address-book/record-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/address-book/record-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/address-book/record-add.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,61 @@ +# record-add.tcl,v 3.0 2000/02/06 02:44:21 ron Exp +# File: /address-book/record-add.tcl +# Date: 12/24/99 +# Contact: teadams@arsdigita.com, tarik@arsdigita.com +# Purpose: adds an address book record +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +if {[ad_read_only_p]} { + ad_scope_return_read_only_maintenance_message + return +} + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# maybe return_url, name + +ad_scope_error_check user +set db [ns_db gethandle] + +ad_scope_authorize $db $scope none group_admin user + +set name [address_book_name $db] +set address_book_id [database_to_tcl_string $db "select address_book_id_sequence.nextval from dual"] + +ReturnHeaders + +ns_write " +[ad_scope_header "Add a Record" $db] +[ad_scope_page_title "Add a record for $name" $db ] + + +[ad_scope_context_bar_ws [list "index.tcl?[export_url_scope_vars]" "Address book"] "Add"] + +
    +[ad_scope_navbar] +
    +[export_form_scope_vars address_book_id return_url] + + + + + + + + + + + + + + +
    Name
    Email
    Email #2
    Address
    +
    City State Zip
    Country
    Phone (home)
    Phone (work)
    Phone (cell)
    Phone (other)
    Birthday[address_book_birthday_widget]
    Days in advance to remind of birthday (Enter another value if you want a 2nd reminder: )
    Notes
    +
    +
    +[ad_scope_footer] +" \ No newline at end of file Index: web/openacs/www/address-book/record-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/address-book/record-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/address-book/record-delete-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,44 @@ +# record-delete-2.tcl,v 3.0 2000/02/06 02:44:21 ron Exp +# File: /address-book/record-delete-2.tcl +# Date: 12/24/99 +# Contact: teadams@arsdigita.com, tarik@arsdigita.com +# Purpose: deletes address book record +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# yes_submit or no_submit +# address_book_id, maybe return_url + +validate_integer address_book_id $address_book_id + +ad_scope_error_check user +set db [ns_db gethandle] +ad_scope_authorize $db $scope none group_admin user + +if {[info exists no_submit]} { + if {[info exists return_url]} { + ns_returnredirect $return_url + return + } else { + ns_returnredirect "records.tcl?[export_url_vars group_id scope]" + return + } +} + +ns_db dml $db "delete from address_book where address_book_id='$QQaddress_book_id'" + + +if [info exists return_url] { + ns_returnredirect $return_url +} else { + ns_returnredirect "index.tcl?[export_url_scope_vars]" +} + + + + Index: web/openacs/www/address-book/record-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/address-book/record-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/address-book/record-delete.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,54 @@ +# record-delete.tcl,v 3.0 2000/02/06 02:44:21 ron Exp +# File: /address-book/record-delete.tcl +# Date: 12/24/99 +# Contact: teadams@arsdigita.com, tarik@arsdigita.com +# Purpose: deletes address book record +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# address_book_id, maybe return_url + +validate_integer address_book_id $address_book_id + +ad_scope_error_check user +set db [ns_db gethandle] +ad_scope_authorize $db $scope none group_admin user + +set selection [ns_db 1row $db " +select * from +address_book where address_book_id = $address_book_id"] +set_variables_after_query + +if { ![info exists contact_info_only] } { + set contact_info_only "f" +} + +ns_return 200 text/html " +[ad_scope_header "Delete $first_names $last_name" $db] +[ad_scope_page_title "Delete $first_names $last_name" $db ] +[ad_scope_context_bar_ws [list "index.tcl?[export_url_scope_vars return_url]" "Address book"] "Delete record"] +
    +[ad_scope_navbar] +
    +[export_form_scope_vars address_book_id return_url] +Are you sure you want to delete the record for $first_names $last_name? +

    +

    + + + + +
    + + + +
    + +
    +[ad_scope_footer] +" Index: web/openacs/www/address-book/record-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/address-book/record-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/address-book/record-edit-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,40 @@ +# record-edit-2.tcl,v 3.0 2000/02/06 02:44:22 ron Exp +# File: /address-book/index.tcl +# Date: 12/24/99 +# Contact: teadams@arsdigita.com, tarik@arsdigita.com +# Purpose: address book main page +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# address_book_id, first_names, last_name, email, email2, line1, line2, city, usps_abbrev, zip_code, phone_home, phone_work, +# phone_cell, phone_other, country, birthmonth, birthday, birthyear, days_in_advance_to_remind, days_in_advance_to_remind_2, notes +# maybe return_url + +validate_integer address_book_id $address_book_id + +ad_scope_error_check user +set db [ns_db gethandle] +ad_scope_authorize $db $scope none group_admin user + +set column_list [list first_names last_name email email2 line1 line2 city usps_abbrev zip_code phone_home phone_work phone_cell phone_other country birthmonth birthday birthyear days_in_advance_to_remind days_in_advance_to_remind_2 notes] + +foreach column $column_list { + lappend column_and_QQvalue_list "$column = '[set QQ$column]'" +} + +set update_string " +update address_book set [join $column_and_QQvalue_list ,] where address_book_id='$QQaddress_book_id' +" + +ns_db dml $db $update_string + +if [info exists return_url] { + ns_returnredirect $return_url +} else { + ns_returnredirect "record.tcl?[export_url_scope_vars address_book_id]" +} \ No newline at end of file Index: web/openacs/www/address-book/record-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/address-book/record-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/address-book/record-edit.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,62 @@ +# record-edit.tcl,v 3.0 2000/02/06 02:44:22 ron Exp +# File: /address-book/index.tcl +# Date: 12/24/99 +# Contact: teadams@arsdigita.com, tarik@arsdigita.com +# Purpose: address book main page +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +if {[ad_read_only_p]} { + ad_scope_return_read_only_maintenance_message + return +} + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# address_book_id + +validate_integer address_book_id $address_book_id + +ad_scope_error_check user +set db [ns_db gethandle] + +ad_scope_authorize $db $scope none group_admin user + +set name [address_book_name $db] + +set selection [ns_db 1row $db "select * from address_book where address_book_id=$address_book_id"] +set_variables_after_query + + +ns_return 200 text/html " +[ad_scope_header "Edit record " $db] +[ad_scope_page_title "Edit record" $db] + +[ad_scope_context_bar_ws [list "index.tcl?[export_url_scope_vars return_url]" "Address book"] "Edit"] +
    +[ad_scope_navbar] +
    +[export_form_scope_vars address_book_id return_url] + + + + + + + + + + + + + + +
    Name
    Email
    Email #2
    Address
    +
    City State Zip
    Country
    Phone (home)
    Phone (work)
    Phone (cell)
    Phone (other)
    Birthday[address_book_birthday_widget $birthmonth $birthday $birthyear]
    Days in advance to remind of birthday (Enter another value if you want a 2nd reminder: )
    Notes
    +
    +
    +[ad_scope_footer] +" Index: web/openacs/www/address-book/record-search.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/address-book/record-search.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/address-book/record-search.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,60 @@ +# record-search.tcl,v 3.0 2000/02/06 02:44:22 ron Exp +# File: /address-book/record-search.tcl +# Date: 12/24/99 +# Contact: teadams@arsdigita.com, tarik@arsdigita.com +# Purpose: shows a single address book record +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# maybe return_url +# search_by, search_value + +ad_scope_error_check user + +set db [ns_db gethandle] +ad_scope_authorize $db $scope none group_member user + +set name [address_book_name $db] + +ReturnHeaders +ns_write " +[ad_scope_header "Address Book Search Results" $db] +[ad_scope_page_title "Address Book Search Results" $db] + +[ad_scope_context_bar_ws [list "index.tcl?[export_url_scope_vars return_url]" "Address book"] "Search"] +
    +[ad_scope_navbar] + +
      +" + +set selection [ns_db select $db " +select first_names, last_name, city, usps_abbrev, address_book_id +from address_book +where [ad_scope_sql] +and upper($search_by) like '%[string toupper $QQsearch_value]%'"] + +set count 0 +set result_string "" +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + incr count + append result_string "
    • $first_names $last_name ($city, $usps_abbrev): all info | contact info only

      " +} + +if {$count == 0} { + append result_string "

    • No records meet your criteria" +} + +ns_write " +$result_string +
    +[ad_scope_footer] +" + Index: web/openacs/www/address-book/record.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/address-book/record.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/address-book/record.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,63 @@ +# record.tcl,v 3.0 2000/02/06 02:44:22 ron Exp +# File: /address-book/record.tcl +# Date: 12/24/99 +# Contact: teadams@arsdigita.com, tarik@arsdigita.com +# Purpose: shows a single address book record +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# address_book_id and possibly contact_info_only + +validate_integer address_book_id $address_book_id + +ad_scope_error_check user +set db [ns_db gethandle] + +set name [address_book_name $db] + +set selection [ns_db 1row $db "select * from +address_book where address_book_id = '$QQaddress_book_id'"] + +set_variables_after_query +set user_id [ad_scope_authorize $db $scope none group_member user] + +if { ![info exists contact_info_only] } { + set contact_info_only "f" +} + +ReturnHeaders + +ns_write " +[ad_scope_header "$first_names $last_name" $db] +[ad_scope_page_title "$first_names $last_name" $db] +[ad_scope_context_bar_ws [list "index.tcl?[export_url_scope_vars]" "Address book"] "One record"] +
    +[ad_scope_navbar] +" + +append html " +[address_book_record_display $selection $contact_info_only] +

    +" + +if { [ad_scope_administrator_p $db $user_id] } { + append html "\[view map | edit | delete\] +

    + " +} else { + append html "view map +

    + " +} + +ns_write " +

    +$html +
    +[ad_scope_footer] +" Index: web/openacs/www/address-book/records.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/address-book/records.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/address-book/records.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,106 @@ +# records.tcl,v 3.0 2000/02/06 02:44:22 ron Exp +# File: /address-book/records.tcl +# Date: mid-1998 +# Contact: teadams@arsdigita.com, tarik@arsdigita.com +# Purpose: shows the list of address book records +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# maybe contact_info_only, maybe order_by +ad_scope_error_check user +set db [ns_db gethandle] +set user_id [ad_scope_authorize $db $scope none group_member user] + +set scope_administrator_p [ad_scope_administrator_p $db $user_id] + +set name [address_book_name $db] + +if { ![info exists contact_info_only] } { + set contact_info_only "f" +} +if { ![info exists order_by] } { + set order_by "last_name, first_names" +} + +ReturnHeaders + +ns_write " + +[ad_scope_header "All Records for $name" $db] +[ad_scope_page_title "All Records for $name" $db] +[ad_scope_context_bar_ws [list "index.tcl?[export_url_scope_vars]" "Address Book"] "All Records"] +
    +[ad_scope_navbar] +" + + + +set n_records [database_to_tcl_string $db " +select count(*) from address_book where [ad_scope_sql]"] + +if { $n_records == 0 } { + append html " + There are currently no addresses. +

    + Add a Record + " + ns_write " +

    + $html +
    + [ad_scope_footer] + " + return +} elseif {$n_records == 1} { + append html "$n_records record
    " +} else { + append html "$n_records records
    " +} + +if { $contact_info_only == "t" } { + append address_string " + Display All Info

    " +} else { + append address_string " + Display Only Contact Info

    " +} + + +set selection [ns_db select $db " +select * from address_book where [ad_scope_sql] order by $order_by"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append address_string " + [address_book_record_display $selection $contact_info_only]" + if { $contact_info_only == "f" && $scope_administrator_p } { + append address_string " +
    \[edit | delete\]" + } + append address_string "

    " +} + + +append html " +$address_string +" + +if { $scope_administrator_p } { + append html " +

    + Add a Record + " +} + +ns_write " +

    +$html +
    +[ad_scope_footer] +" Index: web/openacs/www/admin/host.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/host.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/host.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,74 @@ +# host.tcl,v 3.0 2000/02/06 02:44:49 ron Exp +# host.tcl +# created by philg@mit.edu on March 1, 1999 +# displays as much as we can know about activity from a particular IP address + +set_the_usual_form_variables + +# ip + +ReturnHeaders + +ns_write "[ad_admin_header $ip] + +

    $ip

    + +[ad_admin_context_bar "One Host"] + +
    + +The first thing we'll do is try to look up the ip address ... + +" + +set hostname [ns_hostbyaddr $ip] + +ns_write "$hostname. + +(If it is just the number again, that means the reverse DNS lookup failed.) + +" + +set db [ns_db gethandle] +set selection [ns_db select $db "select user_id, first_names, last_name, email +from users +where registration_ip = '$QQip'"] + +set items "" +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append items "
  • $first_names $last_name ($email)\n" +} + +if ![empty_string_p $items] { + ns_write "

    User Registrations from $hostname

    + +
      +$items +
    + +" +} + +set selection [ns_db select $db "select msg_id, one_line +from bboard +where originating_ip = '$QQip'"] + +set items "" +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append items "
  • $one_line\n" +} + +if ![empty_string_p $items] { + ns_write "

    BBoard postings from $hostname

    + +
      +$items +
    + +" +} + + +ns_write [ad_admin_footer] Index: web/openacs/www/admin/index-legacy.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/index-legacy.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/index-legacy.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,141 @@ +# index-legacy.tcl,v 3.0 2000/02/06 02:44:49 ron Exp +# /admin/index.tcl + +ReturnHeaders + +set db [ns_db gethandle] + +ns_write "[ad_admin_header "Admin Home for [ad_system_name]"] + +

    [ad_system_name] Administration

    + +[ad_context_bar_ws "Admin Home"] + +
    + +Help: see the webmasters guide + + + + +

    Heavy Duty Maintenance

    + +These pages will change fundamental properties of the service. Use +with extreme caution. + + + +[ad_admin_footer] +" + + + + Index: web/openacs/www/admin/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/index.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,134 @@ +# /admin/index.tcl +# +# by aure@arsdigita.com and dh@arsdigita.com +# +# 2000-02-03 +# +# index.tcl,v 3.4.2.2 2000/03/16 18:31:01 bryanche Exp + +ns_return 200 text/html " +[ad_admin_header "Admin Home for [ad_system_name]"] + +

    [ad_system_name] Administration

    + +[ad_context_bar_ws "Admin Home"] + +
    + +[help_upper_right_menu [list "/doc/webmasters" "help: the webmaster's guide"]] + +
    + +[help_upper_right_menu [list "index-legacy" "old style admin page"]] + + +
    +Restart the [ad_system_name] web process +
    + +[ad_admin_footer]" Index: web/openacs/www/admin/new-stuff.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/new-stuff.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/new-stuff.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,75 @@ +# /admin/new-stuff.tcl +# +# by philg@mit.edu on July 4, 1999 +# +# new-stuff.tcl,v 3.0 2000/02/06 02:44:49 ron Exp + +# gives the site admin a comprehensive view of what's +# new at the site + +set_the_usual_form_variables 0 + +# only_from_new_users_p, n_days_ago + +if ![info exists only_from_new_users_p] { + set only_from_new_users_p "f" +} + +if ![info exists n_days_ago] { + set n_days_ago 7 +} + +if { $only_from_new_users_p == "t" } { + set left_widget "from new users | expand to all users" + set user_class_description "new users" +} else { + set left_widget "limit to new users | from all users" + set user_class_description "all users" +} + +if { $n_days_ago == 1 } { + set time_description "since yesterday morning" +} else { + set time_description "in last $n_days_ago days" +} + +ReturnHeaders + +ns_write "[ad_admin_header "Stuff from $user_class_description $time_description"] + +

    Stuff from $user_class_description $time_description

    + +[ad_admin_context_bar "New Stuff"] + +
    + +" + + +set n_days_possible [list 1 2 3 4 5 6 7 14 30] + +foreach n_days $n_days_possible { + if { $n_days == $n_days_ago } { + # current choice, just the item + lappend right_widget_items $n_days + } else { + lappend right_widget_items "$n_days" + } +} + +set right_widget [join $right_widget_items] + +ns_write "
    $left_widget$right_widget
    \n" + +set db [ns_db gethandle] + +set since_when [database_to_tcl_string $db "select sysdate() - $n_days_ago from dual"] + +ns_write [ad_new_stuff $db $since_when $only_from_new_users_p "site_admin"] + +ns_write " + +[ad_admin_footer] + +" + Index: web/openacs/www/admin/restart.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/restart.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/restart.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,33 @@ +ReturnHeaders + +ns_write "[ad_admin_header "Restarting [ad_system_name]"] + + +" + +if {[empty_string_p [ad_parameter INIFile restart]]} { + ns_write "There is no restart parameter in the auxilary .ini file. Please make sure it is there. + +[ad_admin_footer] + +" + +return + +} else { + +set exec_name "[ns_info home]/bin/nsd -K -i -t [ad_parameter INIFile restart]" + +ns_write "Now restarting [ad_system_name]($exec_name)... + +[ad_admin_footer] + +" + +ns_log notice "Restarting server with $exec_name" + +ns_conn close + +exec [ad_parameter PathToACS]/bin/restartserver.sh [ns_info home] [ad_parameter INIFile restart] + +} Index: web/openacs/www/admin/acceptance-tests/gp-acceptance-test.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/acceptance-tests/gp-acceptance-test.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/acceptance-tests/gp-acceptance-test.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,198 @@ +# /admin/acceptance/tests/gp-acceptance-test.tcl +# +# automated general permissions acceptance test (tests pl/sql procs +# and data model) +# +# by richardl@arsdigita.com, created 2000 March 16 +# +# gp-acceptance-test.tcl,v 1.1.2.1 2000/03/17 15:41:48 richardl Exp + +# requires: +# o existence of system user +# o existence of site-wide admin group +# o existence of non-system user + +# all table names are inconsistently capitalized to test the to_lower stuff in PL/SQL +set html " +[ad_header "General Permissions acceptance test"] +

    General Permissions acceptance test

    +Running... +
      +" +set db [ns_db gethandle] +set system_user_id [database_to_tcl_string $db "select user_id from users where email = 'system'"] +set reg_user_id [database_to_tcl_string $db "select max(user_id) from users where email <> 'system'"] + +# test read permissions for system +ns_ora exec_plsql $db "begin :1 := ad_general_permissions.grant_permission_to_user($system_user_id,'read',1,'TEST_TabLE'); end;" +append html "
    • Created user read permission record." + +if { [ad_user_has_row_permission_p $db $system_user_id "read" 1 "TEST_TABLE"] } { + append html "
    • User test passed." +} else { + append html "
    • User test failed." +} + +# test revoking permission +set permission_id [database_to_tcl_string $db "select ad_general_permissions.user_permission_id($system_user_id,'read',1,'TesT_TABLE') + from dual"] +ns_db dml $db "begin ad_general_permissions.revoke_permission($permission_id); end;" + +if { ![ad_user_has_row_permission_p $db $system_user_id "read" 1 "TEST_TABLE"] } { + append html "
    • User revocation test passed." +} else { + append html "
    • User revocation test failed." +} + +# test group stuff now +set sitewide_group_id [database_to_tcl_string $db "select group_id from user_groups + where group_name = 'Site-Wide Administration'"] + +ns_ora exec_plsql $db "begin :1 := ad_general_permissions.grant_permission_to_group($sitewide_group_id,'read',1,'TEST_tabLE'); end;" + +append html "
    • Created group read permission record." + +if { [ad_user_has_row_permission_p $db $system_user_id "read" 1 "test_taBle"] } { + append html "
    • Group test passed." +} else { + append html "
    • Group test failed." +} + +# group revocation +set permission_id [database_to_tcl_string $db "select ad_general_permissions.group_permission_id($sitewide_group_id,'read',1,'TesT_TABLE') + from dual"] +ns_db dml $db "begin ad_general_permissions.revoke_permission($permission_id); end;" + +if { ![ad_user_has_row_permission_p $db $system_user_id "read" 1 "TeST_TABLE"] } { + append html "
    • Group revocation test passed." +} else { + append html "
    • Group revocation test failed. $permission_id" +} + +# test roles +set roleexists [database_to_tcl_string $db "select count(*) from user_group_roles + where group_id = $sitewide_group_id + and role = 'gptestrole'"] + +if { $roleexists == 0 } { + ns_db dml $db "insert into user_group_roles(group_id, role, creation_date, creation_user, creation_ip_address) + values($sitewide_group_id, 'gptestrole', sysdate, $system_user_id, '10.0.0.0')" +} + +ns_ora exec_plsql $db "begin :1 := ad_general_permissions.grant_permission_to_role($sitewide_group_id, 'gptestrole', 'read', 1, 'test_TAble'); end;" + +append html "
    • Created group/role read permission record." + +# verifies that it doesn't accidentally give the wrong user read permission +if { ![ad_user_has_row_permission_p $db $reg_user_id "read" 1 "TESt_table"] } { + append html "
    • Group/role test one passed." +} else { + append html "
    • Group/role test one failed." +} + +# admin default for system user -- system has administrator role so +# should be able to read +if { [ad_user_has_row_permission_p $db $system_user_id "read" 1 "TESt_table"] } { + append html "
    • Group/role test two passed (tests admin default)." +} else { + append html "
    • Group/role test two failed (tests admin default)." +} + +ns_db dml $db "insert into user_group_map(group_id, user_id, role, registration_date, mapping_user, mapping_ip_address) + values($sitewide_group_id, $reg_user_id, 'gptestrole', sysdate, $system_user_id, '10.0.0.0')" + +# now we insert reg user, make sure it's still okaay +if { [ad_user_has_row_permission_p $db $reg_user_id "read" 1 "TESt_table"] } { + append html "
    • Group/role test three passed." +} else { + append html "
    • Group/role test three failed." +} + +# revoke permission +set permission_id [database_to_tcl_string $db "select ad_general_permissions.group_role_permission_id($sitewide_group_id,'gptestrole','read',1,'teSt_taBle') from dual"] + +ns_db dml $db "begin ad_general_permissions.revoke_permission($permission_id); end;" + +if { ![ad_user_has_row_permission_p $db $reg_user_id "read" 1 "TESt_table"] } { + append html "
    • Group/role revocation test passed." +} else { + append html "
    • Group/role revocation test failed." +} + +# now, the regular users +ns_ora exec_plsql $db "begin :1 := ad_general_permissions.grant_permission_to_reg_users('read',1,'teST_tabLE'); end;" + +append html "
    • Granted read to all registered users." + +if { [ad_user_has_row_permission_p $db $reg_user_id "read" 1 "teST_TaBLE"] } { + append html "
    • Registered user test passed." +} else { + append html "
    • Registered user test failed." +} + +# now, revoke again (do we see a pattern here?) +set permission_id [database_to_tcl_string $db "select ad_general_permissions.reg_users_permission_id('read',1,'teST_table') from dual"] + +ns_db dml $db "begin ad_general_permissions.revoke_permission($permission_id); end;" + +if { ![ad_user_has_row_permission_p $db $reg_user_id "read" 1 "teST_TaBLE"] } { + append html "
    • Registered user revocation test passed." +} else { + append html "
    • Registered revocation user test failed." +} + +# now, all users +ns_ora exec_plsql $db "begin :1 := ad_general_permissions.grant_permission_to_all_users('read',1,'teST_tabLE'); end;" + +append html "
    • Granted read to all users." + +if { [ad_user_has_row_permission_p $db $reg_user_id "read" 1 "teST_TaBLE"] } { + append html "
    • All user test one passed." +} else { + append html "
    • All user test one failed." +} + +if { [ad_user_has_row_permission_p $db 0 "read" 1 "teST_TaBLE"] } { + append html "
    • All user test two passed." +} else { + append html "
    • All user test two failed." +} + +# now, revoke +set permission_id [database_to_tcl_string $db "select ad_general_permissions.all_users_permission_id('read',1,'teST_taBLE') from dual"] + +ns_db dml $db "begin ad_general_permissions.revoke_permission($permission_id); end;" + +if { ![ad_user_has_row_permission_p $db $reg_user_id "read" 1 "teST_TaBLE"] } { + append html "
    • Revoking all user test one passed." +} else { + append html "
    • Revoking all user test one failed." +} + +if { ![ad_user_has_row_permission_p $db 0 "read" 1 "teST_TaBLE"] } { + append html "
    • Revoking all user test two passed." +} else { + append html "
    • Revocating all user test two failed." +} + + +# clean up; technically we should put the entire test +# in one transaction, but that seems painful to accept. +ns_db dml $db "begin transaction" +ns_db dml $db "delete from general_permissions + where on_which_table = 'test_table'" +ns_db dml $db "delete from user_group_roles + where group_id = $sitewide_group_id + and role = 'gptestrole'" +ns_db dml $db "delete from user_group_map + where role = 'gptestrole'" +ns_db dml $db "end transaction" + +append html " +
    Cleanup complete. +[ad_footer]" + + + +ns_db releasehandle $db +ns_return 200 text/html $html \ No newline at end of file Index: web/openacs/www/admin/address-book/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/address-book/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/address-book/index.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,61 @@ +# index.tcl,v 3.0 2000/02/06 02:44:50 ron Exp +# +# /admin/address-book/index.tcl +# +# by philg@mit.edu on November 1, 1999 +# +# shows who is using the address book system +# + +set db [ns_db gethandle] + + +ReturnHeaders + +ns_write " +[ad_admin_header "Address Book" ] +

    Address Book

    + +[ad_admin_context_bar "Address Book"] + +
    + +Documentation: /doc/address-book.html +
    +User pages: /address-book/ + +

    + +These are the users of [ad_system_name] who are using the address book +module: + +

      +" + + +set selection [ns_db select $db "select users.user_id, users.first_names, users.last_name, count(*) as n_records +from users, address_book +where users.user_id = address_book.user_id +group by users.user_id, users.first_names, users.last_name"] + +set items "" +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append items "
    • $first_names $last_name: +$n_records +" +} + +if [empty_string_p $items] { + ns_write "no users currently have any address records" +} else { + ns_write $items +} + +ns_write " + +
    + +[ad_admin_footer] +" + Index: web/openacs/www/admin/address-book/one-user.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/address-book/one-user.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/address-book/one-user.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,51 @@ +# one-user.tcl,v 3.0 2000/02/06 02:44:50 ron Exp +# +# /admin/address-book/one-user.tcl +# +# by philg@mit.edu on November 1, 1999 +# +# a modified version of /address-book/records.tcl +# + +set_the_usual_form_variables 0 + +# user_id +# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id) +# note that owner_id is the user_id of the user who owns this module (when scope=user) + + +set db [ns_db gethandle] + +set name [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id=$user_id"] + +append whole_page " +[ad_admin_header "All Records owned by $name"] +

    Records owned by $name

    + +[ad_admin_context_bar [list "index.tcl" "Address Book"] "One User"] + +
    +" + +append whole_page "
    \n" + +set selection [ns_db select $db "select oid, * +from address_book +where address_book.user_id = $user_id +order by upper(last_name), upper(first_names)"] +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append whole_page "[address_book_display_as_html [address_book_record_display $selection "f"]]\n

    \n" +} + + +append whole_page " + +

    + +[ad_footer] +" + +ns_db releasehandle $db + +ns_return 200 text/html $whole_page Index: web/openacs/www/admin/adserver/add-adv-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/adserver/add-adv-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/adserver/add-adv-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,9 @@ +# add-adv-2.tcl,v 3.0 2000/02/06 02:46:07 ron Exp +set_the_usual_form_variables +# adv_key, target_url, local_image_p, track_clickthru_p, adv_filename + +set db [ns_db gethandle] + +ns_db dml $db "insert into advs (adv_key, target_url, local_image_p, track_clickthru_p, adv_filename) VALUES ('$QQadv_key', '$QQtarget_url', '$QQlocal_image_p', '$QQtrack_clickthru_p', '$QQadv_filename')" + +ns_returnredirect one-adv.tcl?adv_key=$adv_key \ No newline at end of file Index: web/openacs/www/admin/adserver/add-adv-group-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/adserver/add-adv-group-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/adserver/add-adv-group-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,9 @@ +# add-adv-group-2.tcl,v 3.0 2000/02/06 02:46:08 ron Exp +set_the_usual_form_variables +# group_key, pretty_name + +set db [ns_db gethandle] + +ns_db dml $db "insert into adv_groups (group_key, pretty_name, rotation_method) VALUES ('$QQgroup_key', '$QQpretty_name', '$QQrotation_method')" + +ns_returnredirect "one-adv-group.tcl?group_key=$group_key" Index: web/openacs/www/admin/adserver/add-adv-group.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/adserver/add-adv-group.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/adserver/add-adv-group.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,33 @@ +# add-adv-group.tcl,v 3.0 2000/02/06 02:46:08 ron Exp +ns_return 200 text/html " +[ad_admin_header "Add a New Ad Group"] + +

    New Ad Group

    + +[ad_admin_context_bar [list "index.tcl" "AdServer"] "New Ad Group"] + +
    + +
    + + + + + + + +
    Group Key
    (no spaces, please!)
    Group Pretty Name
    (for your convenience)
    Rotation Method
    + +

    +

    + +
    + + +
    +

    + +[ad_admin_footer] +" Index: web/openacs/www/admin/adserver/add-adv-to-group-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/adserver/add-adv-to-group-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/adserver/add-adv-to-group-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,9 @@ +# add-adv-to-group-2.tcl,v 3.0 2000/02/06 02:46:08 ron Exp +set_the_usual_form_variables +# group_key, adv_key + +set db [ns_db gethandle] + +ns_db dml $db "insert into adv_group_map (group_key, adv_key) VALUES ('$QQgroup_key', '$QQadv_key')" + +ns_returnredirect "one-adv-group.tcl?group_key=$group_key" \ No newline at end of file Index: web/openacs/www/admin/adserver/add-adv-to-group.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/adserver/add-adv-to-group.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/adserver/add-adv-to-group.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,31 @@ +# add-adv-to-group.tcl,v 3.0 2000/02/06 02:46:08 ron Exp +set_the_usual_form_variables +# group_key + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select pretty_name from adv_groups where group_key='$QQgroup_key'"] +set_variables_after_query + +ReturnHeaders +ns_write "[ad_admin_header "Add ads to group $pretty_name"] +

    Add ads

    +to Ad Group $pretty_name. +

    + +Choose an ad to include in this Ad Group:

    +

      +" + +set selection [ns_db select $db "select adv_key from advs where adv_key NOT IN (select adv_key from adv_group_map where group_key='$QQgroup_key')"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + + ns_write "
    • $adv_key\n" +} + +ns_write "
    +

    +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/adserver/add-adv.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/adserver/add-adv.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/adserver/add-adv.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,46 @@ +# add-adv.tcl,v 3.0 2000/02/06 02:46:08 ron Exp +ReturnHeaders + +set db [ns_db gethandle] + +ns_write "[ad_admin_header "Add a new Ad"] + +

    New Ad

    + +[ad_admin_context_bar [list "index.tcl" "AdServer"] "New Ad"] + +
    + +

    + +

    + + + + + + + + + + + + + + + + + + + + + +
    Ad Key(no spaces please)
    Link to:(a URL for the user who clicks on this banner or all of doubleclick stuff)
    Local Image:Yes No(Image resides on this server)
    Track Clickthru:Yes No(No for doubleclick, etc.)
    Image File Location:(pathname or URL of banner GIF, blank for doubleclick, etc.)
    +
    +
    + +
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/adserver/all-adv-groups.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/adserver/all-adv-groups.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/adserver/all-adv-groups.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,28 @@ +# all-adv-groups.tcl,v 3.0 2000/02/06 02:46:09 ron Exp + +set db [ns_db gethandle] + +ReturnHeaders + +ns_write "[ad_admin_header "Manage Ad Groups"] +

    Manage Ad Groups

    +at AdServer Administration +

    + +

      +
    • Add a new ad group. +

      +" + +set selection [ns_db select $db "select group_key, pretty_name from adv_groups"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + + ns_write "

    • $pretty_name\n" +} + +ns_write "
    +

    +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/adserver/all-advs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/adserver/all-advs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/adserver/all-advs.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,30 @@ +# all-advs.tcl,v 3.0 2000/02/06 02:46:09 ron Exp + +set db [ns_db gethandle] + +ReturnHeaders + +ns_write "[ad_admin_header "Manage Ads"] +

    Manage Ads

    +at AdServer Administration +

    + +

      +
    • Add a new ad. +

      +" + +set selection [ns_db select $db "select adv_key +from advs +order by upper(adv_key)"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + + ns_write "

    • $adv_key\n" +} + +ns_write "
    +

    +[ad_admin_footer] +" Index: web/openacs/www/admin/adserver/delete-adv-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/adserver/delete-adv-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/adserver/delete-adv-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,50 @@ +# delete-adv-2.tcl,v 3.0 2000/02/06 02:46:09 ron Exp +set_the_usual_form_variables + +# adv_key + +set db [ns_db gethandle] + +ReturnHeaders + +ns_write "[ad_admin_header "Deleting $adv_key"] + +

    Deleting $adv_key

    + +a rarely used part of AdServer Administration + +
    + +
      +" + +ns_db dml $db "begin transaction" + +ns_db dml $db "delete from adv_log where adv_key = '$QQadv_key'" + +ns_write "
    • Deleted [ns_pg ntuples $db] rows from adv_log.\n" + +ns_db dml $db "delete from adv_user_map where adv_key = '$QQadv_key'" + +ns_write "
    • Deleted [ns_pg ntuples $db] rows from adv_user_map.\n" + +ns_db dml $db "delete from adv_categories where adv_key = '$QQadv_key'" + +ns_write "
    • Deleted [ns_pg ntuples $db] rows from adv_categories.\n" + +ns_db dml $db "delete from adv_group_map where adv_key = '$QQadv_key'" + +ns_write "
    • Deleted [ns_pg ntuples $db] rows from adv_group_map.\n" + +ns_db dml $db "delete from advs where adv_key = '$QQadv_key'" + +ns_write "
    • Deleted the ad itself from advs.\n" + +ns_db dml $db "end transaction" + +ns_write "
    + +Transaction complete. + +[ad_admin_footer] +" Index: web/openacs/www/admin/adserver/delete-adv.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/adserver/delete-adv.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/adserver/delete-adv.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,57 @@ +# delete-adv.tcl,v 3.0 2000/02/06 02:46:09 ron Exp +set_the_usual_form_variables + +# adv_key + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select sum(display_count) as n_displays, sum(click_count) as n_clicks, min(entry_date) as first_display, max(entry_date) as last_display, round(max(entry_date)-min(entry_date)) as n_days, count(*) as n_entries +from adv_log +where adv_key = '$QQadv_key'"] +set_variables_after_query + +ns_return 200 text/html "[ad_admin_header "Confirm Deletion of $adv_key"] + +

    Confirm Deletion

    + +of $adv_key + +
    + +If what you want to do is stop showing an ad to users, you're in the +wrong place. What you should be doing instead is changing the places +that reference this ad to reference some other ad. Ads that have been +shown to users should never be deleted from the system because that +also deletes the logs. + +

    + +Here's what you'll be deleting if you delete this ad: + +

      +
    • $n_entries log entries +
    • covering $n_days days (from $first_display to $last_display) +
    • during which there were $n_displays displays and $n_clicks clickthroughs +
    + +

    + +If you don't want to do that, then you can simply return to ad server administration. + + + +

    + +However, if you only put this ad in the database for a demonstration +or experiment and never actually showed it to any users, then you can + +

    +
    +[export_form_vars adv_key] + +
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/adserver/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/adserver/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/adserver/index.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,85 @@ +# index.tcl,v 3.0 2000/02/06 02:46:09 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "AdServer Administration"] + +

    AdServer Administration

    + +[ad_admin_context_bar "AdServer"] + + +
    + +
      + +" + +# Let's get the groups and their corresponding ads, the ads with no +# groups will arrive at the end + +set db_conns [ns_db gethandle [philg_server_default_pool] 2] +set db [lindex $db_conns 0] +set db_sub [lindex $db_conns 1] + +# first get any groups with no ads +set selection [ns_db select $db "select group_key, pretty_name from adv_groups where not group_key in (select group_key from adv_group_map)"] +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if ![empty_string_p $pretty_name] { + set group_anchor $pretty_name + } else { + set group_anchor $group_key + } + ns_write "
    • Group $group_anchor\n" +} + +set selection [ns_db select $db "(select map.group_key as group_key, advs.adv_key +from advs, adv_group_map map +where advs.adv_key = map.adv_key) union +(select NULL as group_key, adv_key from advs where +0=(select count(*) from adv_group_map where adv_key=advs.adv_key)) +order by upper(map.group_key), upper(advs.adv_key)"] + +set last_group_key "" +set doing_standalone_ads_now_p 0 +set first_iteration_p 1 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $first_iteration_p && [empty_string_p $group_key] } { + # this installation doesn't use groups apparently + set doing_standalone_ads_now_p 1 + } + set first_iteration_p 0 + if { [string compare $group_key $last_group_key] != 0 } { + if [empty_string_p $group_key] { + # we've come to the end of the grouped ads + set doing_standalone_ads_now_p 1 + ns_write "

      ads that aren't in any group

      " + } else { + set group_pretty_name [database_to_tcl_string $db_sub "select pretty_name from adv_groups where group_key = '[DoubleApos $group_key]'"] + if ![empty_string_p $group_pretty_name] { + set group_anchor $group_pretty_name + } else { + set group_anchor $group_key + } + ns_write "
    • Group $group_anchor:\n" + } + set last_group_key $group_key + } + if $doing_standalone_ads_now_p { + ns_write "
    • " + } + ns_write "$adv_key " +} + +ns_write "

      + +

    • Create a new ad | ad group + +
    + +Documentation for this subsystem is available at +/doc/adserver.html. + +[ad_admin_footer] +" Index: web/openacs/www/admin/adserver/one-adv-detailed-stats.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/adserver/one-adv-detailed-stats.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/adserver/one-adv-detailed-stats.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,82 @@ +# one-adv-detailed-stats.tcl,v 3.0 2000/02/06 02:46:10 ron Exp +set_the_usual_form_variables + +# adv_key + +# we'll export this to adhref and adimg so that admin actions don't +# corrupt user data +set suppress_logging_p 1 + +ReturnHeaders + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select adv_key, adv_filename, track_clickthru_p, target_url from advs where adv_key='$QQadv_key'"] +set_variables_after_query + +ns_write "[ad_admin_header "Detailed Statistics: $adv_key"] +

    $adv_key

    + +[ad_admin_context_bar [list "index.tcl" "AdServer"] [list "one-adv.tcl?[export_url_vars adv_key]" "One Ad"] "Detailed Statistics"] + + +
    + +
    +" + +if {$track_clickthru_p == "f" } { + ns_write $target_url +} else { + ns_write " + +" +} +set selection [ns_db 1row $db "select sum(display_count) as n_displays, sum(click_count) as n_clicks, min(entry_date) as first_display, max(entry_date) as last_display +from adv_log +where adv_key = '$QQadv_key'"] +set_variables_after_query + +ns_write "
    + +

    Summary Statistics

    + +Between [util_AnsiDatetoPrettyDate $first_display] and [util_AnsiDatetoPrettyDate $last_display], this ad was + +
      +
    • displayed $n_displays times +
    • clicked on $n_clicks times +
    • clicked through [expr 100 * $n_clicks / $n_displays ]% of the time +
    + +

    By Date

    + + + + + +" + +set selection [ns_db select $db "select * +from adv_log +where adv_key = '$QQadv_key' +order by entry_date"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "\n" +} + +ns_write " + +
    DateDisplaysClickthroughsClickthrough Rate
    [util_AnsiDatetoPrettyDate $entry_date]$display_count$click_count" + if {$display_count > 0} { + ns_write "[expr 100 * $click_count / $display_count ]%" + } else { + ns_write "0%" + } + ns_write "
    +

    + +[ad_admin_footer] +" Index: web/openacs/www/admin/adserver/one-adv-group.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/adserver/one-adv-group.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/adserver/one-adv-group.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,61 @@ +# one-adv-group.tcl,v 3.0 2000/02/06 02:46:10 ron Exp +set_the_usual_form_variables +# group_key + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select group_key, pretty_name from adv_groups where group_key='$QQgroup_key'"] +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "One Ad Group - $pretty_name"] +

    $pretty_name

    +one of the Ad Groups at Adserver. +

    +" + +set form " +

    + + + +[export_form_vars group_key] + + + +
    Group Key$group_key
    Group Pretty Name
    (for your convenience)
    +
    +" + +ns_write "[bt_mergepiece $form $selection] +

    +

    Ads in this Group

    + +These are listed in the order that they will be displayed to users. + +
      +" + +set selection [ns_db select $db "select adv_key +from adv_group_map +where group_key='$QQgroup_key' +order by upper(adv_key)"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + + ns_write "
    • $adv_key +   (remove) +\n" +} + +ns_write "

      + +

    • Add an Ad To this Group + +
    +

    +[ad_admin_footer] +" + Index: web/openacs/www/admin/adserver/one-adv.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/adserver/one-adv.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/adserver/one-adv.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,122 @@ +# one-adv.tcl,v 3.0 2000/02/06 02:46:10 ron Exp +set_the_usual_form_variables + +# adv_key + +# we'll export this to adhref and adimg so that admin actions don't +# corrupt user data +set suppress_logging_p 1 + +ReturnHeaders + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select adv_key, adv_filename, local_image_p, track_clickthru_p, target_url from advs where adv_key='$QQadv_key'"] +set_variables_after_query + +set raw_update_form "

    + +[export_form_vars adv_key] + + + + + + +
    Ad Key$adv_key
    Link to:
    Track Click Throughs:Yes No
    Local Image:Yes No
    Image File
    +
    +
    + +
    +
    +" + +set merged_form [bt_mergepiece $raw_update_form $selection] + +ns_write "[ad_admin_header "One Ad: $adv_key"] +

    $adv_key

    + +[ad_admin_context_bar [list "index.tcl" "AdServer"] "One Ad"] + + +
    + +
    +" + +if { $track_clickthru_p == "f" } { + regsub -all {\$timestamp} $target_url [ns_time] cache_safe_target + ns_write $cache_safe_target +} elseif { $local_image_p == "t" } { + ns_write "" +} else { + ns_write "" +} + +ns_write " +
    + +" + +# note that we aren't at risk of dividing by zero because +# there won't be any rows in this table unless the ad +# has been displayed at least once +# Postgres isn't that way for some reason +# BA + +set check [database_to_tcl_string $db "select sum(display_count) from adv_log where adv_key='$QQadv_key'"] + +if {$check > 0} { + + set selection [ns_db 0or1row $db "select + sum(display_count) as n_displays, + sum(click_count) as n_clicks, + round(100*(sum(click_count)/sum(display_count)),2) as clickthrough_percent, + min(entry_date) as first_display, + max(entry_date) as last_display + from adv_log + where adv_key = '$QQadv_key'"] + + set_variables_after_query + +if ![empty_string_p $first_display] { + # we have at least one entry + ns_write " + +

    Summary Statistics

    + +Between [util_AnsiDatetoPrettyDate $first_display] and [util_AnsiDatetoPrettyDate $last_display], this ad was + +
      +
    • displayed $n_displays times +
    • clicked on $n_clicks times +
    • clicked through $clickthrough_percent% of the time +
    + +detailed stats + +" +} +} else { + + ns_write "

    This ad has never been shown

    +" + +} + +ns_write " + +

    Ad Parameters

    + +" + +ns_write "$merged_form +

    + +[ad_style_bodynote "If you only inserted this ad for debugging purposes, you can +take the extreme step of deleting this ad and its associated log entries from the database."] + +

    + +[ad_admin_footer] +" Index: web/openacs/www/admin/adserver/remove-adv-from-group-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/adserver/remove-adv-from-group-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/adserver/remove-adv-from-group-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,10 @@ +# remove-adv-from-group-2.tcl,v 3.0 2000/02/06 02:46:10 ron Exp +set_the_usual_form_variables +# group_key, adv_key + +set db [ns_db gethandle] + +ns_db dml $db "delete from adv_group_map where group_key = '$QQgroup_key' +and adv_key = '$QQadv_key'" + +ns_returnredirect "one-adv-group.tcl?group_key=$group_key" Index: web/openacs/www/admin/adserver/remove-adv-from-group.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/adserver/remove-adv-from-group.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/adserver/remove-adv-from-group.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,32 @@ +# remove-adv-from-group.tcl,v 3.0 2000/02/06 02:46:10 ron Exp +set_the_usual_form_variables + +# group_key, adv_key + +set db [ns_db gethandle] + +ns_return 200 text/html "[ad_admin_header "Confirm removal of $adv_key"] + +

    Confirm

    + +the removal of $adv_key +from $group_key + +
    + +This won't remove the ad from the system. You're only deleting the +association between the group $group_key ([database_to_tcl_string $db "select pretty_name from adv_groups where group_key = '$QQgroup_key'"]) and this ad. + +

    + +

    + +[export_form_vars group_key adv_key] + +
    + +
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/adserver/update-adv-group.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/adserver/update-adv-group.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/adserver/update-adv-group.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,11 @@ +# update-adv-group.tcl,v 3.0 2000/02/06 02:46:11 ron Exp +set_the_usual_form_variables +# pretty_name, group_key + +set db [ns_db gethandle] + +ns_db dml $db "update adv_groups set pretty_name='$QQpretty_name' where group_key='$QQgroup_key'" + +ns_returnredirect "one-adv-group.tcl?group_key=$group_key" + + Index: web/openacs/www/admin/adserver/update-adv.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/adserver/update-adv.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/adserver/update-adv.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,15 @@ +# update-adv.tcl,v 3.0 2000/02/06 02:46:11 ron Exp +set_the_usual_form_variables + +# adv_key, target_url, adv_filename + +set db [ns_db gethandle] + +ns_db dml $db "update advs set +target_url='$QQtarget_url', +adv_filename='$QQadv_filename', +local_image_p='$QQlocal_image_p' +where adv_key='$QQadv_key'" + +ns_returnredirect one-adv.tcl?adv_key=$adv_key + Index: web/openacs/www/admin/bannerideas/banner-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bannerideas/banner-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bannerideas/banner-add-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,70 @@ +# banner-add-2.tcl,v 3.0 2000/02/06 02:48:24 ron Exp +set_the_usual_form_variables + +# idea_id, intro, more_url, picture_html, keywords + +validate_integer idea_id $idea_id + +#Now check to see if the input is good as directed by the page designer + +set exception_count 0 +set exception_text "" + +# we were directed to return an error for intro +if {![info exists intro] || [empty_string_p $intro]} { + incr exception_count + append exception_text "
  • Please enter an idea." +} + +# we were directed to return an error for more_url +if {![info exists more_url] || [empty_string_p $more_url]} { + incr exception_count + append exception_text "Please enter a link to your URL." +} + +if {[info exists intro] && [string length $intro] > 4000 } { + incr exception_count + append exception_text "
  • Please limit your idea to 4000 characters." +} + +if {[info exists picture_html] && [string length $picture_html] > 4000 } { + incr exception_count + append exception_text "
  • Please limit your picture url to 4000 characters." +} + +if {[info exists keywords] && [string length $keywords] > 4000 } { + incr exception_count + append exception_text "
  • Please limit your keywords 4000 characters." +} + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + +# So the input is good -- +# Now we'll do the insertion in the bannerideas table. +set db [banner_ideas_gethandle] +if [catch {ns_db dml $db "insert into bannerideas + (idea_id, intro, more_url, picture_html, keywords) + values + ($idea_id, '$QQintro', '$QQmore_url', '$QQpicture_html', '$QQkeywords')" } errmsg] { + +# Oracle choked on the insert + if { [ database_to_tcl_string $db " + select count(*) from bannerideas where idea_id = $idea_id"] == 0 } { + + # there was an error with the insert other than a duplication + ad_return_error "Error in insert + " "We were unable to do your insert in the database. + Here is the error that was returned: +

    +

    + 
    +    $errmsg
+
    +
    " + return + } +} +ns_returnredirect index.tcl Index: web/openacs/www/admin/bannerideas/banner-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bannerideas/banner-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bannerideas/banner-add.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,36 @@ +# banner-add.tcl,v 3.0 2000/02/06 02:48:25 ron Exp +set db [banner_ideas_gethandle] +ReturnHeaders + + +ns_write " +[ad_admin_header "Add a banner idea"] + +

    Add

    + +[ad_admin_context_bar [list "index.tcl" "Banner Ideas Administration"] "Add One"] + + +
    + +
    + + + + +\n\n + +\n\n + +\n\n + +\n\n +
    Idea:
    URL:
    HTML for picture:
    Keywords:
    +

    +

    + +
    +
    +

    +[ad_admin_footer]" Index: web/openacs/www/admin/bannerideas/banner-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bannerideas/banner-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bannerideas/banner-edit-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,51 @@ +# banner-edit-2.tcl,v 3.0 2000/02/06 02:48:25 ron Exp +set_the_usual_form_variables + +# intro, more_url, picture_html, keywords, idea_id + +validate_integer idea_id $idea_id + +set exception_count 0 +set exception_text "" + +# we were directed to return an error for intro +if {![info exists intro] ||[empty_string_p $intro]} { + incr exception_count + append exception_text "

  • Please enter an idea." +} + +# we were directed to return an error for more_url +if {![info exists more_url] ||[empty_string_p $more_url]} { + incr exception_count + append exception_text "
  • Please enter a link to your URL." +} + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + +# So the input is good -- +# Now we'll do the update of the bannerideas table. +set db [banner_ideas_gethandle] +if [catch {ns_db dml $db "update bannerideas + set intro = '$QQintro', + more_url = '$QQmore_url', + picture_html = '$QQpicture_html', + keywords = '$QQkeywords' + where idea_id = '$idea_id'" } errmsg] { + +# Oracle choked on the update + ad_return_error "Error in update + " "We were unable to do your update in the database. + Here is the error that was returned: +

    +

    + 
    +    $errmsg
+
    +
    " + return +} + +ns_returnredirect index.tcl Index: web/openacs/www/admin/bannerideas/banner-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bannerideas/banner-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bannerideas/banner-edit.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,46 @@ +# banner-edit.tcl,v 3.0 2000/02/06 02:48:25 ron Exp +set_the_usual_form_variables + +# idea_id + +ReturnHeaders + +set db [banner_ideas_gethandle] +set selection [ns_db 1row $db " + select intro, more_url, picture_html, keywords + from bannerideas + where idea_id='[DoubleApos $idea_id]'"] +set_variables_after_query + + +ns_write " +[ad_admin_header "Edit banner idea"] + +

    Edit

    + +[ad_admin_context_bar [list "index.tcl" "Banner Ideas Administration"] "Edit One"] + + +
    + +
    +[export_form_vars idea_id] + + + + + + + +\n\n +
    Idea:
    URL:
    HTML for picture: \n\n
    Keywords: +
    + +

    +

    + +
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/bannerideas/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bannerideas/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bannerideas/index.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,53 @@ +# index.tcl,v 3.0 2000/02/06 02:48:25 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Banner Ideas" ] + +

    Banner Ideas

    + +[ad_admin_context_bar "Banner Ideas Administration"] + +
    + +Documentation: /doc/bannerideas.html. + +

    Banner ideas

    + + +
      +" + +set db [banner_ideas_gethandle] +set sql_query "select idea_id, intro, more_url, picture_html, clickthroughs +from bannerideas +order by idea_id" +set selection [ns_db select $db $sql_query] + +set counter 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + incr counter + # can't show the picture because it is usually absolute URLs + # and we're probably on HTTPS right now + ns_write "
    • $intro     +... +
      +more ($clickthroughs clicks so far to $more_url) | +Edit +

      +" + +} + +if { $counter == 0 } { + ns_write "

    • there are no ideas in the database right now" +} + +ns_write "

      + +

    • Add a banner idea +
    + +[ad_admin_footer] +" + Index: web/openacs/www/admin/bboard/add-new-topic-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bboard/add-new-topic-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bboard/add-new-topic-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,89 @@ +# add-new-topic-2.tcl,v 3.2 2000/02/21 21:35:32 bdolicki Exp +set_the_usual_form_variables + +# IE will BASH ¬ + +set notify_of_new_postings_p $iehelper_notify_of_new_postings_p +set QQnotify_of_new_postings_p $QQiehelper_notify_of_new_postings_p + + +set db [ns_db gethandle] + +set exception_text "" +set exception_count 0 + +if { ![info exists topic] || $topic == "" } { + append exception_text "
  • You must enter a topic name" + incr exception_count +} + +if { [info exists topic] && [string match {*"*} $topic] } { + append exception_text "
  • Your topic name can't include string quotes. It makes life too difficult for this collection of software." + incr exception_count +} + + +if { $exception_count> 0 } { + ad_return_complaint $exception_count $exception_text + return 0 +} + +# no exceptions found + +set extra_columns "" +set extra_values "" +set group_report "" + +with_transaction $db { + set topic_id [database_to_tcl_string $db "select bboard_topic_id_sequence.nextval from dual"] + ns_db dml $db "insert into bboard_topics (topic_id,topic,primary_maintainer_id,presentation_type,moderation_policy,notify_of_new_postings_p) +values + ($topic_id,'$QQtopic',$user_id_from_search,'$QQpresentation_type','$QQmoderation_policy','$QQnotify_of_new_postings_p')" + + # create the administration group for this topic + ad_administration_group_add $db "Administration Group for $topic BBoard" "bboard" $topic_id "/bboard/admin-home.tcl?[export_url_vars topic topic_id]" + + # add the current user as an administrator + ad_administration_group_user_add $db $user_id_from_search "administrator" "bboard" $topic_id + +} { + # there was an error from the database + set count [database_to_tcl_string $db "select count(*) from bboard_topics where topic = '$QQtopic'"] + if { $count > 0 } { + set existing_topic_blather "There is already a discussion group named \"$topic\" in the database. This is most likely why the database insert failed. If you think +you are the owner of that group, you can go to its admin +page." + } else { + set existing_topic_blather "" + } + ad_return_error "Topic Not Added" "The database rejected the addition of discussion topic \"$topic\". Here was +the error message: + +
    +$errmsg
+
    + +$existing_topic_blather +" +return 0 + +} + + +ns_return 200 text/html "[bboard_header "Topic Added"] + +

    Topic Added

    + +There is now a discussion group for \"$topic\" in +[bboard_system_name] + +
    +Visit the admin page +for $topic. +

    + +$group_report + +[bboard_footer]" + Index: web/openacs/www/admin/bboard/add-new-topic.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bboard/add-new-topic.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bboard/add-new-topic.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,101 @@ +# add-new-topic.tcl,v 3.0 2000/02/06 02:49:17 ron Exp +set user_id [ad_get_user_id] + +set db [ns_db gethandle] +ReturnHeaders + +ns_write "[ad_admin_header "Add New Topic"] + +

    Add New Topic

    + +[ad_admin_context_bar [list "index.tcl" "BBoard Hyper-Administration"] "Add Topic"] + +
    + +
    + + + + +

    The Most Important Things

    + +What do you want to call your forum? The topic name that you choose +will appear in the alphabetical listing on the [bboard_system_name] +home page. It will appear on pages visible to users. It will appear +in URLs. If you want to let other people link directly to your forum, +they'll need to include this. So it is probably best to pick some +short and descriptive, e.g., \"darkroom technique\". The software +adds words like \"Q&A\" and \"forum\" so don't include those in your +topic name. + +

    + +New Topic Name: + +

    +

    Maintainer

    +

    +Search for a user to be primary administrator of this domain by
    + + + + +
    Email address:
    or by
    Last name:
    +

    + +

    How this BBoard is presented to users

    + +You have to choose whether or not this is primarily a Q&A +forum or a threads-based discussion group. The user interfaces +interoperate, i.e., a posting made a user in the Q&A interface will be +seen in the threads interface and vice versa. But my software still +needs to know whether this is primarily threads or Q&A. For example, +if a user signs up for email alerts, this program will send out email +saying \"come back to the forum at http://...\". The \"come back +URL\" is different for Q&A and threads. + +
      +
    • threads - classical USENET style +
    • Q&A - questions and all answers appear on one page, use for discussion groups that tend to have short messages/responses +
    • Editorial - question and answers appear on separate pages, answers are collasped by subject line as a default, use for discussion groups that tend to have longer messages/responses +
    + +

    + +
    + +(note: I personally greatly prefer the Q&A interface; if people liked +threads, they'd have stuck with USENET.) + +

    Moderation Type

    + +What moderation category does this fall under? + + +

    Notification

    + +If your forum is inactive, you'll probably want this system to send +the primary maintainer email every time someone adds a posting of any kind (new top-level +question or reply). If you're getting 50 new postings/day then you'll +probably want to disable this feature + +

    + +Notify me of all new postings? + Yes No + +

    +

    + + + + + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/bboard/administer.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bboard/administer.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bboard/administer.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,52 @@ +# administer.tcl,v 3.0 2000/02/06 02:49:17 ron Exp +set_the_usual_form_variables + +# topic, topic_id + +set db [bboard_db_gethandle] +if [catch {set selection [ns_db 0or1row $db "select bt.*,u.password as admin_password +from bboard_topics bt, users u +where bt.topic='$QQtopic' +and bt.primary_maintainer_id = u.user_id"]} errmsg] { + [bboard_return_cannot_find_topic_page] + return +} +# we found the data we needed +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "Hyper-Admin for $topic"] + +

    Hyper-Administration for \"$topic\"

    + +[ad_admin_context_bar [list "index.tcl" "BBoard Hyper-Administration"] "One Bboard"] + + +
    + +This page is for unusual actions by the [bboard_system_name] +administrator, e.g., deleting entire discussion groups. Ordinary +diurnal operations, such as deleting particular threads, should +be handled from +the regular $topic administration page. + +

    + +Here are the things that you can do to the $topic forum from here: + +

    + +[ad_admin_footer] +" Index: web/openacs/www/admin/bboard/administrator-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bboard/administrator-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bboard/administrator-add.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,10 @@ +# administrator-add.tcl,v 3.0 2000/02/06 02:49:17 ron Exp +set_the_usual_form_variables + +# topic, topic_id, user_id_from_search + +set db [ns_db gethandle] + +ad_administration_group_user_add $db $user_id_from_search "administrator" "bboard" $topic_id + +ns_returnredirect "topic-administrators.tcl?[export_url_vars topic topic_id]" Index: web/openacs/www/admin/bboard/administrator-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bboard/administrator-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bboard/administrator-delete.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,13 @@ +# administrator-delete.tcl,v 3.0 2000/02/06 02:49:17 ron Exp +set_the_usual_form_variables + +# topic, topic_id, admin_group_id, user_id + +set db [ns_db gethandle] + +ns_db dml $db "delete from user_group_map +where user_id = $user_id +and group_id = $admin_group_id" + +ns_returnredirect "topic-administrators.tcl?[export_url_vars topic topic_id]" + Index: web/openacs/www/admin/bboard/create-admin-groups.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bboard/create-admin-groups.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bboard/create-admin-groups.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,19 @@ +# (bran Feb 25 2000) +# For each topic there must be an administration group: +# Run this Tcl code if you have some primary_maintainer_id's who +# still don't have an appropriate administration group. + + set dbs [ns_db gethandle main 2] + set db [lindex $dbs 0] + set db2 [lindex $dbs 1] + ns_db dml $db "begin transaction" + set topic_id_list [database_to_tcl_list $db "select topic_id from bboard_topics where topic_id + not in (select submodule from administration_info where module='bboard')"] + foreach topic_id $topic_id_list { + set selection [ns_db 1row $db2 "select primary_maintainer_id, topic from bboard_topics where topic_id=$topic_id"] + set_variables_after_query + ad_administration_group_add $db2 "Administration Group for $topic BBoard" "bboard" $topic_id "/bboard/admin-home.tcl?[export_url_vars topic topic_id]" + ad_administration_group_user_add $db2 $primary_maintainer_id "administrator" "bboard" $topic_id + } + ns_db dml $db "end transaction" + ns_return 200 text/html OK Index: web/openacs/www/admin/bboard/delete-all-messages-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bboard/delete-all-messages-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bboard/delete-all-messages-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,60 @@ +# delete-all-messages-2.tcl,v 3.0 2000/02/06 02:49:17 ron Exp +set_the_usual_form_variables + +# topic + +set db [bboard_db_gethandle] +if [catch {set selection [ns_db 0or1row $db "select bt.*,u.password as admin_password +from bboard_topics bt, users u +where bt.topic='$QQtopic' +and bt.primary_maintainer_id = u.user_id"]} errmsg] { + [bboard_return_cannot_find_topic_page] + return +} +# we found the data we needed +set_variables_after_query + +set n_messages [database_to_tcl_string $db "select count(*) from bboard where topic_id = $topic_id"] + +ReturnHeaders + +ns_write "[ad_admin_header "Clearing Out $topic"] + +

    Clearing Out \"$topic\"

    + +[ad_admin_context_bar [list "index.tcl" "BBoard Hyper-Administration"] [list "administer.tcl?[export_url_vars topic]" "One Bboard"] "Clearing Out"] + +
    + +We will now attempt to delete $n_messages messages from +this forum... + +" + +ns_db dml $db "begin transaction" + +set list_of_files_to_delete [database_to_tcl_list $db " +select buf.filename_stub +from bboard_uploaded_files buf, bboard +where buf.msg_id = bboard.msg_id +and bboard.topic_id = $topic_id"] + +ns_db dml $db "delete from bboard_uploaded_files +where msg_id in (select msg_id from bboard where topic_id = $topic_id)" + +# add the actual deletion of the files +if { [llength $list_of_files_to_delete] > 0 } { + ns_atclose "bboard_delete_uploaded_files $list_of_files_to_delete" +} + +ns_db dml $db "delete from bboard_thread_email_alerts where thread_id in +(select msg_id from bboard where topic_id = $topic_id)" + +ns_db dml $db "delete from bboard where topic_id = $topic_id" + +ns_db dml $db "end transaction" + +ns_write "Success! You can now use the forum afresh. + +[ad_admin_footer] +" Index: web/openacs/www/admin/bboard/delete-all-messages.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bboard/delete-all-messages.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bboard/delete-all-messages.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,42 @@ +# delete-all-messages.tcl,v 3.0 2000/02/06 02:49:17 ron Exp +set_the_usual_form_variables + +# topic_id + +set db [bboard_db_gethandle] +if [catch {set selection [ns_db 0or1row $db "select bt.*,u.password as admin_password +from bboard_topics bt, users u +where bt.topic_id=$topic_id +and bt.primary_maintainer_id = u.user_id"]} errmsg] { + [bboard_return_cannot_find_topic_page] + return +} +# we found the data we needed +set_variables_after_query + +set n_messages [database_to_tcl_string $db "select count(*) from bboard where topic_id = $topic_id"] + +ns_return 200 text/html "[ad_admin_header "Clear Out $topic"] + +

    Clear Out \"$topic\"

    + +[ad_admin_context_bar [list "index.tcl" "BBoard Hyper-Administration"] [list "administer.tcl?[export_url_vars topic]" "One Bboard"] "Clear Out"] + +
    + +Are you sure that you want to delete all $n_messages messages from +this forum? + +
    + +
    +[export_form_vars topic] + + +
    + +
    + + +[ad_admin_footer] +" Index: web/openacs/www/admin/bboard/delete-topic-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bboard/delete-topic-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bboard/delete-topic-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,51 @@ +# delete-topic-2.tcl,v 3.0 2000/02/06 02:49:17 ron Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +# topic + +set db [bboard_db_gethandle] + +set option_text "I guess you can return to the Hyper Administration page" + +if { [bboard_use_ns_perm_authorization_p] == 1 } { + set ns_perm_group_added_for_this_forum [database_to_tcl_string $db "select ns_perm_group_added_for_this_forum from bboard_topics where topic='$QQtopic'"] + if { $ns_perm_group_added_for_this_forum != "" } { + set option_text "The \"$ns_perm_group_added_for_this_forum\" AOLserver permissions group was created +when the $topic forum was created. Unless you are using this permissions +group for authenticating users in another forum or for static files, +you probably want to +delete the ns_perm group now. + +

    + +Alternatively, you can return to the Hyper Administration page" + } + +} + +# the order here is important because of the integrity constraint on +# the topic column of bboard + +ns_db dml $db "delete from bboard where topic='$QQtopic'" +ns_db dml $db "delete from bboard_q_and_a_categories where topic='$QQtopic'" +ns_db dml $db "delete from bboard_topics where topic='$QQtopic'" + +ns_return 200 text/html " + +Deletion Accomplished + + + +

    Deletion Accomplished

    + +of \"$topic\" + +
    + +$option_text + +[ad_admin_footer] + + +" Index: web/openacs/www/admin/bboard/delete-topic.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bboard/delete-topic.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bboard/delete-topic.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,42 @@ +# delete-topic.tcl,v 3.0 2000/02/06 02:49:18 ron Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +# topic + +set db [bboard_db_gethandle] +if [catch {set selection [ns_db 0or1row $db "select unique * from bboard_topics where topic='$QQtopic'"]} errmsg] { + [bboard_return_cannot_find_topic_page] + return +} +# we found the data we needed +set_variables_after_query + +set n_messages [database_to_tcl_string $db "select count(*) from bboard where topic='$QQtopic'"] + +ns_return 200 text/html " + +Confirm + + + +

    Confirm

    + +deletion of \"$topic\" + +
    + +Are you absolutely sure that you want to remove \"$topic\" and +its $n_messages postings from the [bboard_system_name] system? + +

    +

    + + + +
    + +[ad_admin_footer] + + +" Index: web/openacs/www/admin/bboard/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bboard/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bboard/index.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,64 @@ +# index.tcl,v 3.0 2000/02/06 02:49:18 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "[bboard_system_name] Hyper-Administration"] + +

    Hyper-Administration

    + +[ad_admin_context_bar "BBoard Hyper-Administration"] + +
    + +
      + +

      Active topics

      +" + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +# we successfully opened the database + +set selection [ns_db select $db "select * from bboard_topics order by active_p desc, upper(topic)"] + +set count 0 +set inactive_title_shown_p 0 + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $active_p == "f" } { + if { $inactive_title_shown_p == 0 } { + # we have not shown the inactive title yet + if { $count == 0 } { + ns_write "
    • No active topics" + } + set inactive_title_shown_p 1 + ns_write "

      Inactive topics

      " + } + set anchor "activate" + } else { + set anchor "deactivate" + } + + set_variables_after_query + ns_write "
    • $topic ($anchor)\n" + + incr count +} + + +ns_write " + +

      + +

    • Add New Topic (i.e., add a new discussion board) + +
    + +Documentation for this subsystem is available at +/doc/bboard.html. + +[ad_admin_footer]" Index: web/openacs/www/admin/bboard/toggle-active-p.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bboard/toggle-active-p.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bboard/toggle-active-p.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,10 @@ +# toggle-active-p.tcl,v 3.0 2000/02/06 02:49:18 ron Exp +set_the_usual_form_variables + +# topic + +set db [ns_db gethandle] + +ns_db dml $db "update bboard_topics set active_p = logical_negation(active_p) where topic='$QQtopic'" + +ns_returnredirect "index.tcl" Index: web/openacs/www/admin/bboard/topic-administrators.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bboard/topic-administrators.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bboard/topic-administrators.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,66 @@ +# topic-administrators.tcl,v 3.1 2000/02/28 15:52:16 michael Exp +set_the_usual_form_variables + +# topic, topic_id + +ReturnHeaders +ns_write "[ad_admin_header "[ad_system_name] $topic administrators"] + +

    Administrators for $topic

    + +[ad_admin_context_bar [list "index.tcl" "BBoard Hyper-Administration"] [list "administer.tcl?[export_url_vars topic]" "One Bboard"] Administrators] + +
    +" + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select users.user_id, first_names, last_name from +bboard_topics, users +where bboard_topics.primary_maintainer_id = users.user_id +and topic = '$QQtopic'"] + +set_variables_after_query +ns_write " +

    +The primary maintainer is $first_names $last_name. +

    +Other maintainers. +

      " + + +set admin_group_id [ad_administration_group_id $db "bboard" $topic_id] + +set selection [ns_db select $db "select distinct u.user_id, u.first_names, u.last_name +from users u, user_group_map ugm +where ugm.user_id = u.user_id +and ugm.group_id = $admin_group_id +order by u.last_name asc"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
    • $first_names $last_name-Remove" +} + +ns_write " +
    +

    Add Administrator

    +
    + + + + + +Search for a user to add to the administration list.
    + + + + +
    Email address:
    or by
    Last name:
    +

    +

    + +
    +
    +[ad_admin_footer] +" Index: web/openacs/www/admin/bookmarks/delete-bookmark-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bookmarks/delete-bookmark-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bookmarks/delete-bookmark-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,72 @@ +# delete-bookmark-2.tcl,v 3.0 2000/02/06 03:08:34 ron Exp +# delete-bookmark-2.tcl +# admin version +# +# carries out the delete function +# +# by aure@arsdigita.com and dh@arsdigita.com + +set_the_usual_form_variables +# bookmark_id + + + +# --start error---------------------------------------- +set exception_text "" +set exception_count 0 + +if {(![info exists bookmark_id])||([empty_string_p $bookmark_id])} { + incr exception_count + append exception_text "
  • No bookmark was specified" +} + +# return errors +if { $exception_count> 0 } { + ad_return_complaint $exception_count $exception_text + return 0 +} +# ----------------------------------------------------- + +set db [ns_db gethandle] + +# get the owner for this bookmark +set owner_id [database_to_tcl_string $db "select owner_id from bm_list where bookmark_id=$bookmark_id"] + + +set sql_delete " + delete from bm_list + where bookmark_id in (select bookmark_id + from bm_list + connect by prior bookmark_id = parent_id + start with parent_id = $bookmark_id) + or bookmark_id = $bookmark_id" + +if [catch {ns_db dml $db $sql_delete} errmsg] { + ns_return 200 text/html "Error +

    Error

    + [ad_admin_contextbar [ad_admin_context_bar [list index.tcl Bookmarks] [list one-user.tcl?[export_url_vars owner_id] $owner_name's] [list edit-bookmark.tcl?[export_url_vars bookmark_id] Edit] Error] +
    + We encountered an error while trying to process this delete: +
    + 
    +    $errmsg
+
    +
    + [ad_admin_footer] + " + return +} + + +# send the browser back to the url it was at before the editing process began +ns_returnredirect one-user.tcl?owner_id=$owner_id + + + + + + + + + + Index: web/openacs/www/admin/bookmarks/delete-bookmark.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bookmarks/delete-bookmark.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bookmarks/delete-bookmark.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,84 @@ +# delete-bookmark.tcl,v 3.0 2000/02/06 03:08:35 ron Exp +# delete-bookmark.tcl +# admin version +# +# the delete utility of the bookmarks system +# +# by dh@arsdigita.com and aure@arsdigita.com + +set_the_usual_form_variables +# bookmark_id + + + +# -- error-checking ------------------------------------ +set exception_text "" +set exception_count 0 + +if {(![info exists bookmark_id])||([empty_string_p $bookmark_id])} { + incr exception_count + append exception_text "
  • No bookmark was specified" +} + +# return errors +if { $exception_count> 0 } { + ad_return_complaint $exception_count $exception_text + return 0 +} + +# --------------------------------------------------------- + +set db [ns_db gethandle] + +# get local_title and folder_p +set selection [ns_db 1row $db "select local_title, folder_p, first_names||' '||last_name as owner_name, owner_id from bm_list,users where bookmark_id=$bookmark_id +and user_id = owner_id"] +set_variables_after_query + +set title "Delete One" + +set folder_html " +[ad_admin_header $title ] +

    $title

    +[ad_admin_context_bar [list index.tcl Bookmarks] [list one-user.tcl?[export_url_vars owner_id] $owner_name's] [list edit-bookmark.tcl?[export_url_vars bookmark_id] Edit] $title] +
    +" + + + +if {$folder_p=="t"} { + + set number_to_delete [database_to_tcl_string $db "select count(*) + from bm_list + connect by prior bookmark_id=parent_id + start with parent_id=$bookmark_id "] + + append folder_html " + Removing this folder will result in deleting $number_to_delete subfolders and/or bookmarks.

    " +} + +append folder_html "Are you sure you want to delete \"$local_title\"?

    " + + +append folder_html " +

    + + [export_form_vars bookmark_id] +
    + [ad_admin_footer] + " + + +# --serve the page -------------------------- +ns_return 200 text/html $folder_html + + + + + + + + + + + Index: web/openacs/www/admin/bookmarks/delete-dead-links.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bookmarks/delete-dead-links.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bookmarks/delete-dead-links.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,43 @@ +# delete-dead-links.tcl,v 3.0 2000/02/06 03:08:35 ron Exp +# delete-dead-links.tcl +# +# deletes all occurrences of bookmarks with a dead url +# +# by aure@arsdigita.com + +set_the_usual_form_variables + +# deleteable_link + +set user_id [ad_verify_and_get_user_id] +ad_maybe_redirect_for_registration + +# get the deleteable links from the form +if {$deleteable_link!=""} { + catch {nmc_GetCheckboxValues [ns_conn form] {deleteable_link}} deleteable_link + regsub -all { } $deleteable_link {,} deleteable_link +} + +set db [ns_db gethandle] + +set sql_delete " + delete from bm_list + where owner_id = $user_id + and url_id in ($deleteable_link)" + +# Note: This may break with a huge deleteable_link list, but it is somewhat +# unlikely that someone will have that many dead links and even more unlikely +# that they will check that many checkboxes on the previous page + +if [catch {ns_db dml $db $sql_delete} errmsg] { + ns_return 200 text/html "Error +

    Error

    +
    + We encountered an error while trying to process this DELETE: + 
    $errmsg
    + [ad_admin_footer] + " + return +} + +ns_returnredirect $return_url Index: web/openacs/www/admin/bookmarks/edit-bookmark-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bookmarks/edit-bookmark-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bookmarks/edit-bookmark-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,98 @@ +# edit-bookmark-2.tcl,v 3.0 2000/02/06 03:08:35 ron Exp +# edit-bookmark-2.tcl +# admin version +# +# edit a bookmark in your bookmark list +# +# by aure@arsdigita.com and dh@arsdigita.com + +set_the_usual_form_variables +# local_title, complete_url, bookmark_id, parent_id + +set user_id [ad_verify_and_get_user_id] +ad_maybe_redirect_for_registration + + +# --error-checking --------------------------- +set exception_text "" +set exception_count 0 + +if {(![info exists bookmark_id])||([empty_string_p $bookmark_id])} { + incr exception_count + append exception_text "
  • No bookmark was specified" +} + +# return errors +if { $exception_count> 0 } { + ad_return_complaint $exception_count $exception_text + return 0 +} + +# --------------------------------------------- + + +if { ![info exists parent_id] || [empty_string_p $parent_id] } { + set parent_id "null" +} + +set db [ns_db gethandle] + +set owner_id [database_to_tcl_string $db "select owner_id from bm_list where bookmark_id=$bookmark_id"] +ns_db dml $db "begin transaction" + +# if the bookmark to edit is a folder, complete_url won't be defined + +if {![info exists complete_url]} { + # this is a folder so edit its name + + ns_db dml $db " + update bm_list + set local_title = [db_postgres_null_sql [DoubleApos $local_title]], + private_p = '$private_p', + parent_id = $parent_id + where owner_id = $owner_id + and bookmark_id = $bookmark_id" + +} else { + # entry is a bookmark - need to update both name and url + + set host_url [bm_host_url $complete_url] + + # check to see if we already have the url in our database + set url_id [database_to_tcl_string_or_null $db "select url_id from bm_urls where complete_url = '[DoubleApos $complete_url]'"] + + + if {[empty_string_p $url_id]} { + # we don't have the url - insert the url into the database + set url_id [database_to_tcl_string $db "select bm_url_id_seq.nextval from dual"] + ns_db dml $db " + insert into bm_urls + (url_id, host_url, complete_url) + values + ($url_id, '[DoubleApos $host_url]', '[DoubleApos $complete_url]')" + } + + # have added the url if needed - now update the name + + ns_db dml $db " + update bm_list + set local_title = [db_postgres_null_sql [DoubleApos $local_title]], + url_id = $url_id, + private_p = '$private_p', + parent_id = $parent_id + where bookmark_id = $bookmark_id" +} + + +# propagate our changes (closed / hidden) +bm_set_hidden_p $db $owner_id +bm_set_in_closed_p $db $owner_id + +ns_db dml $db "end transaction" + +# send the user back to where they came from before editing began +ns_returnredirect one-user.tcl?owner_id=$owner_id + + + + Index: web/openacs/www/admin/bookmarks/edit-bookmark.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bookmarks/edit-bookmark.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bookmarks/edit-bookmark.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,149 @@ +# edit-bookmark.tcl,v 3.0 2000/02/06 03:08:35 ron Exp +# edit-bookmark.tcl +# admin version +# +# edit a bookmark in your bookmark list +# +# by aure@arsdigita.com and dh@arsdigita.com + + +set_the_usual_form_variables +# bookmark_id + +set user_id [ad_verify_and_get_user_id] +ad_maybe_redirect_for_registration + + + +# --error-checking --------------------------- + set exception_text "" +set exception_count 0 + +if {(![info exists bookmark_id])||([empty_string_p $bookmark_id])} { + incr exception_count + append exception_text "
  • No bookmark was specified" +} + +# return errors +if { $exception_count> 0 } { + ad_return_complaint $exception_count $exception_text + return 0 +} +# ----------------------------------------------- + + +set db [ns_db gethandle] + +# get the owner_id, owner_name for this bookmark +set selection [ns_db 1row $db "select owner_id, first_names||' '||last_name as owner_name from users, bm_list where bookmark_id=$bookmark_id +and owner_id = user_id"] + +set_variables_after_query + +# get all the current information about this bookmark +set selection [ns_db 1row $db "select nvl(local_title, url_title) as title, complete_url, folder_p, + parent_id, private_p, bookmark_id, hidden_p + from bm_list,bm_urls + where bookmark_id=$bookmark_id + and bm_list.url_id=bm_urls.url_id(+)"] + +set_variables_after_query + + +# --create the html to be served --------------------------------------- +set page_title "Edit Bookmark" + +set html " +[ad_admin_header $page_title ] +

    $page_title

    +[ad_admin_context_bar [list index.tcl Bookmarks] [list one-user.tcl?[export_url_vars owner_id] "$owner_name's"] $page_title] +
    +" + +# begin the form and table +append html "
    " + +# if the bookmark that is being edited is a real bookmark, ie. not a folder +if {$folder_p=="f"} { + append html " + + + + " +} + + +append html " + + + + + + + + + + + + + + + +" + +# write the appropriate words on the delete submit button +if {$folder_p=="t"} { + set delete_text "Delete folder and all its contents" +} else { + set delete_text "Delete this bookmark" +} + +# write out a link for deleting the bookmark, a link is used instead of a submit button +# to keep within the ACS style guidelines of having one submit button per page +append html " + + + + +
    URL:
    Title:
    Parent Folder:[bm_folder_selection $db $owner_id $bookmark_id]
    Privacy:" + +# place the appropriate radio buttons given the privacy setting of the bookmark +if {$private_p=="f" } { + append html " + Public
    + Private " +} else { + append html " + Public
    + Private" +} + +# alert the user that public/private settings will mean nothing if the bookmark is within a private folder +if {$hidden_p} { + append html "(A parent folder is private - so this file will automatically be hidden from the public)" +} else { + append html "(None of the parent folders are private)" +} + +# ending the form (note that /form is purposely put between /td and /tr to avoid any unnecessary +# implied paragraph breaks +append html " +
    [export_form_vars bookmark_id]
    Severe Actions:$delete_text
    " + +# put a footer on the page +append html "[ad_admin_footer]" + +# release the database handle before serving the page +ns_db releasehandle $db + +# --serve the page ------------------------------ +ns_return 200 text/html $html + + + + + + + + + Index: web/openacs/www/admin/bookmarks/get-site-info.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bookmarks/get-site-info.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bookmarks/get-site-info.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,152 @@ +# /admin/bookmarks/get-site-info.tcl +# +# populate the database with url titles, live status and meta tags +# +# by aure@arsdigita.com, June 1999 +# +# Note: this probably should be moved to pl/sql and run nightly +# +# get-site-info.tcl,v 3.0.4.2 2000/03/18 02:46:27 cnk Exp + + +set user_id [ad_verify_and_get_user_id] +ad_maybe_redirect_for_registration + +# this is a proc that should be in the arsdigita procs somewhere +proc get_http_status {url {use_get_p 0} {timeout 30}} { + if $use_get_p { + set http [ns_httpopen GET $url "" $timeout] + } else { + set http [ns_httpopen HEAD $url "" $timeout] + } + # philg changed these to close BOTH rfd and wfd + set rfd [lindex $http 0] + set wfd [lindex $http 1] + close $rfd + close $wfd + set headers [lindex $http 2] + set response [ns_set name $headers] + set status [lindex $response 1] + ns_set free $headers + return $status +} + +set title "Get Site Information" + +# we spool this page since it can take a long time (and also access it +# from a softlink so that we can use http instead of https) +ReturnHeaders + +ns_write " +[ad_admin_header $title] + +

    $title

    +[ad_admin_context_bar [list "" "Bookmarks"] $title] +
    " + +set db [ns_db gethandle] + +# get all the sites that haven't been checked recently + +set check_list [database_to_tcl_list_list $db " + select unique bm_list.url_id, + local_title, + complete_url, + bookmark_id + from bm_list, bm_urls + where bm_list.url_id=bm_urls.url_id + and last_live_date < sysdate() - 1 + order by bookmark_id desc"] + + +# here we release the database handle in order so that we don't stay connected +# to oracle while this procedure chugs along +ns_db releasehandle $db + +set checked_list [list ] +foreach check_set $check_list { + set url_id [lindex $check_set 0] + set local_title [lindex $check_set 1] + set complete_url [lindex $check_set 2] + + # we only want to check http: + if { [regexp -nocase "^mailto:" $complete_url] || [regexp -nocase "^file:" $complete_url] || (![regexp -nocase "^http:" $complete_url] && [regexp {^[^/]+:} $complete_url]) || [regexp "^\\#" $complete_url] } { + # it was a mailto or an ftp:// or something (but not http://) + # else that http_open won't like (or just plain #foobar) + + ns_write "Skipping $local_title...
    " + continue + } + ns_write "Checking $local_title..." + + # strip off any trailing #foo section directives to browsers + regexp {^(.*/?[^/]+)\#[^/]+$} $complete_url dummy complete_url + if [catch { set response [get_http_status $complete_url 0] } errmsg ] { + # we got an error (probably a dead server) + set response "probably the foreign server isn't responding at all" + } + if {$response == 404 || $response == 405 || $response == 500 } { + # we should try again with a full GET + # because a lot of program-backed servers return 404 for HEAD + # when a GET works fine + if [catch { set response [get_http_status $complete_url 1] } errmsg] { + set response "probably the foreign server isn't responding" + } + } + + set checked_pair $url_id + if { $response != 200 && $response != 302 } { + lappend checked_pair " " + ns_write " NOT FOUND
    " + } else { + if {![catch {ns_httpget $complete_url 3 1} url_content]} { + set title "" + set description "" + set keywords "" + regexp -nocase {([^<]*)} $url_content match title + regexp -nocase {} $url_content match description + regexp -nocase {} $url_content match keywords + + # truncate outrageously long titles and meta tags + if {[string length $title]>100} { + set title "[string range $title 0 100]..." + } + if {[string length $keywords]>990} { + set keywords "[string range $keywords 0 990]..." + } + if {[string length $description]>990} { + set description "[string range $description 0 990]..." + } + lappend checked_pair ", last_live_date=sysdate(), + url_title='[DoubleApos $title]', + meta_description='[DoubleApos $description]', + meta_keywords='[DoubleApos $keywords]'" + } + ns_write " FOUND
    " + } + lappend checked_list $checked_pair +} + +set db [ns_db gethandle] + +foreach checked_pair $checked_list { + set url_id [lindex $checked_pair 0] + set last_live_clause [lindex $checked_pair 1] + ns_db dml $db " + update bm_urls + set last_checked_date = sysdate$last_live_clause + where url_id = $url_id" +} + +ns_write " + Done! + +Click to continue. + +[ad_admin_footer]" + + + + + + Index: web/openacs/www/admin/bookmarks/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bookmarks/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bookmarks/index.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,79 @@ +# /admin/bookmarks/index.tcl +# +# administration index page for the bookmarks system +# +# by aure@arsdigita.com and dh@arsdigita.com, June 1999 +# +# index.tcl,v 3.0.4.1 2000/03/15 20:46:56 aure Exp + + +set user_id [ad_verify_and_get_user_id] +ad_maybe_redirect_for_registration + +set title "Bookmarks System Administration" + +set db [ns_db gethandle] + +set page_content " +[ad_admin_header $title ] + +

    $title

    + +[ad_admin_context_bar $title] + +
    + +
      " + + +# get all the users and their total number of bookmarks. +set selection [ns_db select $db " + select first_names||' '||last_name as name, + owner_id, + count(bookmark_id) as number_of_bookmarks + from bm_list, users + where owner_id=user_id + group by first_names, last_name, owner_id + order by last_name"] + +set user_count 0 +set user_list "" +while {[ns_db getrow $db $selection]} { + set_variables_after_query + incr user_count + append user_list "
    • + $name- $number_of_bookmarks bookmarks +
      " +} + +append page_content " +
    • List of the most popular hosts and bookmarks +

      +

    • Check to see if sites are live and if so, get title and meta tags +

      " + +if {$user_count>0} { + + append page_content " +

    • Choose a user whose bookmarks you would like to view and optionally delete: +
        + $user_list +
      " + +} else { + + append page_content "
    • There are no users in this bookmark system" + +} + +append page_content "
    [ad_admin_footer]" + +# release the database handle +ns_db releasehandle $db + +# serve the page +ns_return 200 text/html $page_content + + + + Index: web/openacs/www/admin/bookmarks/most-popular.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bookmarks/most-popular.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bookmarks/most-popular.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,81 @@ +# /admin/bookmarks/most-popular.tcl +# +# figures out the most popular hosts and urls in the system +# +# aure@arsdigita.com, June 1999 +# +# most-popular.tcl,v 3.0.4.2 2000/03/15 21:21:02 aure Exp + +set title "Most Popular Bookmarks" +set max_hosts 10 +set max_urls 20 + +set page_content "[ad_admin_header $title] + +

    $title

    + +[ad_admin_context_bar [list "" "Bookmarks"] $title] + +
    + +

    Most Popular Hosts

    + +
      " + +set db [ns_db gethandle main] + +# get the most popular hosts + +set selection [ns_db select $db " + select host_url, count(*) as n_bookmarks + from bm_list, bm_urls + where bm_list.url_id = bm_urls.url_id + group by host_url + order by n_bookmarks desc"] + +set counter 0 +while {[ns_db getrow $db $selection] && $counter < $max_hosts} { + incr counter + set_variables_after_query + + regsub {^http://([^/]*)/?} $host_url {\1} hostname + append page_content "
    • $n_bookmarks: $hostname" +} +if {$counter==$max_hosts} { + ns_db flush $db +} + +# get the most popular urls + +append page_content "
    \n\n

    Most Popular URLs

    \n\n
      \n" + +set selection [ns_db select $db " + select complete_url, url_title, count(*) as n_bookmarks + from bm_list, bm_urls + where bm_list.url_id = bm_urls.url_id + group by complete_url, url_title + order by n_bookmarks desc"] + +set counter 0 +while {[ns_db getrow $db $selection] && $counter < $max_urls} { + incr counter + set_variables_after_query + if [empty_string_p $url_title] { + set url_title $complete_url + } + append page_content " +
    • $n_bookmarks: $url_title" +} +if {$counter == $max_urls} { + ns_db flush $db +} + +append page_content "
    [ad_admin_footer]" + +# release the database handle +ns_db releasehandle $db + +# serve the page +ns_return 200 text/html $page_content + + Index: web/openacs/www/admin/bookmarks/one-host.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bookmarks/one-host.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bookmarks/one-host.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,52 @@ +# /admin/bookmarks/one-host.tcl +# +# Shows who bookmarked a URL +# +# jsc@arsdigita.com, July 1999 +# +# one-host.tcl,v 3.0.4.1 2000/03/15 21:15:29 aure Exp + +ad_page_variables {url} + +set db [ns_db gethandle] + +set html "[ad_admin_header "Bookmarks for $url"] +

    Bookmarks for $url

    + +[ad_admin_context_bar [list "" "Bookmarks"] [list "most-popular" "Most Popular"] "Bookmarks for $url"] + +
    + +
      " + +set selection [ns_db select $db " +select u.first_names || ' ' || u.last_name as name, + complete_url +from users u, bm_list bml, bm_urls bmu +where u.user_id = bml.owner_id +and bml.url_id = bmu.url_id +and bmu.host_url = '$QQurl' +order by name"] + +set old_name "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + if { $old_name != $name } { + append html "

      $name

      \n" + set old_name $name + } + + append html "
    • $complete_url\n" +} + +append html "
    + +[ad_admin_footer]" + +# release the database handle +ns_db releasehandle $db + +# serve the page +ns_return 200 text/html $html Index: web/openacs/www/admin/bookmarks/one-user.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bookmarks/one-user.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bookmarks/one-user.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,145 @@ +# /admin/bookmarks/one-user.tcl +# +# allows administration of a given users (owner_id) bookmarks +# +# by aure@arsdigita.com and dh@arsdigita.com, June 1999 +# +# one-user.tcl,v 3.0.4.1 2000/03/15 21:11:38 aure Exp + +ad_page_variables {owner_id} + +set user_id [ad_verify_and_get_user_id] +ad_maybe_redirect_for_registration + + +# get database handle +set db [ns_db gethandle] + +# get the bookmark owner's name +set owner_name [database_to_tcl_string $db "select first_names||' '||last_name from users where user_id = $owner_id"] + +set title "$owner_name's Bookmarks" + + +# get generic display parameters from the .ini file +set folder_bgcolor [ad_parameter FolderBGColor bm] +set bookmark_bgcolor [ad_parameter BookmarkBGColor bm] +set folder_decoration [ad_parameter FolderDecoration bm] +set hidden_decoration [ad_parameter HiddenDecoration bm] +set dead_decoration [ad_parameter DeadDecoration bm] + +set edit_anchor "edit" + +# --create the page --------------------------- +set page_content " +[ad_admin_header $title ] + +

    $title

    +[ad_admin_context_bar [list "" "Bookmarks"] $title] + + +
    + + + + + +
    ${folder_decoration}Bookmarks for $owner_name
    " + + +set bookmark_query " + select bookmark_id, bm_list.url_id, + nvl(local_title, url_title) as bookmark_title, + hidden_p, complete_url, + last_live_date, last_checked_date, + folder_p, closed_p, length(parent_sort_key)*8 as indent_width + from bm_list, bm_urls + where owner_id=$owner_id + and in_closed_p='f' + and bm_list.url_id=bm_urls.url_id(+) + order by parent_sort_key || local_sort_key + " + +set selection [ns_db select $db $bookmark_query] + +set bookmark_count 0 +set bookmark_list "" + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + + # decoration refers to color and font of the associated text + set decoration "" + + # make private links appear as definied in the .ini file + if {$hidden_p == "t"} { + append decoration $hidden_decoration + } + + # make dead links appear as definied in the .ini file + if {$last_checked_date != $last_live_date} { + append decoration $dead_decoration + } + + # make folder titles appear as definied in the .ini file + if {$folder_p == "t"} { + append decoration $folder_decoration + } + + # dropping apostrophes and quotation marks from the javascript title + # that will be used in the fancy edit link below + regsub -all {'|"} $bookmark_title {} javascript_title + + # this fancy edit link shows "Edit foo" in the status bar + set edit_link "$edit_anchor" + + + # define url, background color, and image depending on whether we are display a bookmark or folder + if {$folder_p=="f"} { + set url $complete_url + set bgcolor $bookmark_bgcolor + set image "/bookmarks/pics/ftv2doc.gif" + } else { + set bgcolor $folder_bgcolor + set url "toggle-open-close?[export_url_vars bookmark_id]" + + # different images for whether or not the folder is open + if {$closed_p=="t"} { + set image "/bookmarks/pics/ftv2folderclosed.gif" + } elseif {$closed_p=="f" } { + set image "/bookmarks/pics/ftv2folderopen.gif" + } + } + + append bookmark_list " + + + + + + + +
    $decoration[string trim $bookmark_title]$edit_link
    " + + incr bookmark_count +} + +# write the bookmarks if there are any to show +if {$bookmark_count!=0} { + append page_content $bookmark_list +} else { + append page_content "No bookmarks stored in the database.

    " +} + + +# Add a footer +append page_content "[ad_admin_footer]" + +# release the database handle before serving the page +ns_db releasehandle $db + +# serve the page +ns_return 200 text/html $page_content + + + Index: web/openacs/www/admin/bookmarks/toggle-open-close.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bookmarks/toggle-open-close.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bookmarks/toggle-open-close.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,53 @@ +# /admin/bookmarks/toggle-open-close.tcl +# +# opens or closes folders in the bookmarks system +# +# by dh@arsdigita.com and aure@arsdigita.com, June 1999 +# +# toggle-open-close.tcl,v 3.0.4.1 2000/03/15 21:08:22 aure Exp + +ad_page_variables {bookmark_id} + +set user_id [ad_verify_and_get_user_id] +ad_maybe_redirect_for_registration + +# note, we do no error checking for this script because anybody messing with +# the arguments in the url won't be able to do much. Besides, this is in the admin directory. + +# get database handle +set db [ns_db gethandle] + +set owner_id [database_to_tcl_string $db " +select owner_id from bm_list where bookmark_id = $bookmark_id"] + +ns_db dml $db "begin transaction" + +# determine current state of folder ( closed/open ) +set closed_p [database_to_tcl_string $db "select closed_p from bm_list where bookmark_id=$bookmark_id"] + +if { $closed_p=="t" } { + # open the folder + ns_db dml $db " + update bm_list + set closed_p = 'f' + where bookmark_id = $bookmark_id + and owner_id = $owner_id" +} else { + # close the folder + ns_db dml $db " + update bm_list + set closed_p = 't' + where bookmark_id = $bookmark_id + and owner_id = $owner_id" +} + +# set the in_closed_p flag for items in the folder +bm_set_in_closed_p $db $owner_id + +ns_db dml $db "end transaction" + +# send the browser back to the one-user page +ns_returnredirect one-user?owner_id=$owner_id + + + Index: web/openacs/www/admin/bulkmail/monitor.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/bulkmail/monitor.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/bulkmail/monitor.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,101 @@ +ns_share bulkmail_instances_mutex +ns_share bulkmail_instances +ns_share bulkmail_threads_spawned +ns_share bulkmail_threads_completed +ns_share bulkmail_db_flush_queue +ns_share bulkmail_db_flush_wait_event_mutex +ns_share bulkmail_db_flush_wait_event + +ReturnHeaders + +ns_write "[ad_header "Bulkmail Monitor"] + +

    Bulkmail Monitor

    + +[ad_context_bar [list "/pvtm/" "Your Workspace"] "Bulkmail Monitor"] + +
    +" + +if { [ad_parameter BulkmailActiveP bulkmail 0] == 0 } { + ns_write "The bulkmail system has not been enabled/initialized. Please see /doc/bulkmail.html and +check your .ini file" + return +} + + +ns_share bulkmail_hosts +ns_share bulkmail_failed_hosts +ns_share bulkmail_current_host + +ns_write " +

    bulkmail_hosts = { $bulkmail_hosts } +
    bulkmail_failed_hosts = " + +set form_size [ns_set size $bulkmail_failed_hosts] +set form_counter_i 0 +while {$form_counter_i<$form_size} { + ns_write "[ns_set key $bulkmail_failed_hosts $form_counter_i]: [ns_quotehtml [ns_set value $bulkmail_failed_hosts $form_counter_i]], " + incr form_counter_i +} + +ns_write " + +
    bulkmail_queue_threshold = [bulkmail_queue_threshold] + +
    bulkmail_acceptable_message_lossage = [bulkmail_acceptable_message_lossage] + +
    bulkmail_acceptable_host_failures = [bulkmail_acceptable_host_failures] + +
    bulkmail_bounce_threshold = [bulkmail_bounce_threshold] + +
    bulkmail_current_host = [lindex $bulkmail_hosts $bulkmail_current_host] +

    + + + +

    Currently active mailings

    +
      +" + +ns_mutex lock $bulkmail_instances_mutex +catch { + set instances [ns_set copy $bulkmail_instances] +} +ns_mutex unlock $bulkmail_instances_mutex + +set db [ns_db gethandle] + +set instances_size [ns_set size $instances] +if { $instances_size == 0 } { + ns_write "
    • There are no currently active mailings." +} else { + for { set i 0 } { $i < $instances_size } { incr i } { + set instance_stats [ns_set value $instances $i] + set n_queued [lindex $instance_stats 0] + set n_sent [lindex $instance_stats 1] + set bulkmail_id [ns_set key $instances $i] + + # Go and grab the domain name and alert title from the db + set selection [ns_db 1row $db "select description, to_char(creation_date, 'YYYY-MM-DD HH24:MI:SS') as creation_date, n_sent as db_n_sent from bulkmail_instances where bulkmail_id = $bulkmail_id"] + set_variables_after_query + + ns_write "
    • $bulkmail_id: $description ($n_queued queued, $n_sent sent, $db_n_sent recorded)\n" + } +} + +ns_write "
    " + + +ns_write " +

    System status

    +
      +
    • Total mailer threads spawned: $bulkmail_threads_spawned +
    • Total mailer threads completed: $bulkmail_threads_completed +
    " + + + + +ns_write "
    +[ad_footer]" Index: web/openacs/www/admin/calendar/categories.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/calendar/categories.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/calendar/categories.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,69 @@ +# categories.tcl,v 3.0 2000/02/06 03:08:59 ron Exp +# File: admin/calendar/categories.tcl +# Date: 1998-11-18 +# Contact: philg@mit.edu, ahmeds@arsdigita.com +# Purpose: lists all categories + +ReturnHeaders + +ns_write " +[ad_admin_header "Calendar categories"] +

    Categories

    +[ad_admin_context_bar [list "index.tcl" "Calendar"] "Categories"] + +
    +     + +[ad_admin_footer] +" + + + Index: web/openacs/www/admin/calendar/category-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/calendar/category-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/calendar/category-delete-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,24 @@ +# category-delete-2.tcl,v 3.0 2000/02/06 03:08:59 ron Exp +set_the_usual_form_variables + +# category + +set db [ns_db gethandle] + + +# see if there are any calendar entries + +set num_category_entries [database_to_tcl_string $db "select count(calendar_id) from calendar where category='$QQcategory'"] + +if {$num_category_entries > 0} { + + ns_db dml $db "update calendar_categories set enabled_p ='f' where category='$QQcategory'" + +} else { + + ns_db dml $db "delete from calendar_categories where category='$QQcategory'" + +} + +ns_returnredirect "categories.tcl" + Index: web/openacs/www/admin/calendar/category-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/calendar/category-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/calendar/category-delete.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,63 @@ +# category-delete.tcl,v 3.0 2000/02/06 03:08:59 ron Exp +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set_the_usual_form_variables + +# category + +set db [ns_db gethandle] + +# see if there are any calendar entries + +set num_category_entries [database_to_tcl_string $db "select count(calendar_id) from calendar where category='$QQcategory'"] + +if { $num_category_entries == 0 } { + + # no calendar entries, so just delete + ns_returnredirect "category-delete-2.tcl?category=[ns_urlencode $category]" + return +} + +ReturnHeaders +ns_write "[ad_admin_header "Delete Category $category"] +

    Delete

    +category $category +
    + + + +There are entries in the database that currently are categories with the category $category. +

    +Would you like to: +

    +Leave these items with category $category + +

    +or change the category to one of the following: +

    +

      +" +set counter 0 +foreach category_new [database_to_tcl_list $db "select category as category_new from calendar_categories where category <> '$QQcategory' and enabled_p <> 'f'"] { + + incr counter + ns_write "
    • $category_new\n +" +} + +if { $counter == 0 } { + ns_write "no event categories are currently defined; this is an +error in system configuration and you should complain to +[calendar_system_owner]" +} + +ns_write " + +
    + +[ad_admin_footer] +" + Index: web/openacs/www/admin/calendar/category-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/calendar/category-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/calendar/category-edit.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,63 @@ +# category-edit.tcl,v 3.0 2000/02/06 03:08:59 ron Exp +set_the_usual_form_variables + +# category, category_new + + +set exception_count 0 +set exception_text "" + +if { ![info exists category_new] || [empty_string_p $category_new] } { + incr exception_count + append exception_text "
  • Please enter a category." +} + + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + + +if { $category == $category_new } { + ns_returnredirect "category-one.tcl?category=[ns_urlencode $category_new]" + return +} + +set db [ns_db gethandle] + +if [catch { ns_db dml $db "begin transaction" + + # add the new category + ns_db dml $db "insert into calendar_categories (category) select '$QQcategory_new' from dual where 0 = (select count(category) from calendar_categories where category='$QQcategory_new')" + + + # if a new row was not inserted, make sure that the exisitng entry is enabled + if { [ns_pg ntuples $db] == 0 } { + ns_db dml $db "update calendar_categories set enabled_p = 't' where category = '$QQcategory_new'" + } + + # update all the postings + ns_db dml $db "update calendar set category='$QQcategory_new' where category='$QQcategory'" + + # delete the old category + ns_db dml $db "delete from calendar_categories where category = '$QQcategory'" + + ns_db dml $db "end transaction" } errmsg] { + + # there was some other error with the category + ad_return_error "Error updating category" "We couldn't update your category. Here is what the database returned: +

    +

    +
    +$errmsg
+
    +
    +" +return +} + + +ns_returnredirect "category-one.tcl?category=[ns_urlencode $category_new]" + + Index: web/openacs/www/admin/calendar/category-enable-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/calendar/category-enable-toggle.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/calendar/category-enable-toggle.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,12 @@ +# category-enable-toggle.tcl,v 3.0 2000/02/06 03:09:00 ron Exp + +set_the_usual_form_variables + +# category + +set db [ns_db gethandle] + +ns_db dml $db "update calendar_categories set enabled_p = logical_negation(enabled_p) where category = '$QQcategory'" + +ns_returnredirect "category-one.tcl?[export_url_vars category]" + Index: web/openacs/www/admin/calendar/category-new.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/calendar/category-new.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/calendar/category-new.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,69 @@ +# category-new.tcl,v 1.1.1.1.4.1 2000/02/03 09:19:38 ron Exp +# File: /calendar/admin/category-new.tcl +# Date: 1998-11-18 +# Contact: philg@mit.edu, ahmeds@arsdigita.com +# Purpose: creates new caegory +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_the_usual_form_variables 0 +# category_new , category_id +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) + +ad_scope_error_check +set db [ns_db gethandle] +ad_scope_authorize $db $scope admin group_admin none + +set exception_count 0 +set exception_text "" + +if { ![info exists category_new] || [empty_string_p $category_new] } { + incr exception_count + append exception_text "
  • Please enter a category." +} + + +set category_exists_p [database_to_tcl_string $db " +select count(*) +from calendar_categories +where category = '$QQcategory_new' +and [ad_scope_sql] "] + +if { $category_exists_p } { + incr exception_count + append exception_text "
  • Category $QQcategory_new already exists. Please enter a new category." +} + +if {$exception_count > 0} { + ad_scope_return_complaint $exception_count $exception_text $db + return +} + +if [catch { + # add the new category + ns_db dml $db " + insert into calendar_categories + (category_id, category, [ad_scope_cols_sql]) + values + ($category_id,'$QQcategory_new', [ad_scope_vals_sql])" + +} errmsg] { + + # there was some other error with the category + ad_scope_return_error "Error inserting category" "We couldn't insert your category. Here is what the database returned: +

    +

    +
    +$errmsg
+
    +
    +" $db +return +} + + +ns_returnredirect "category-one.tcl?[export_url_scope_vars]&category_id=[ns_urlencode $category_id]" + Index: web/openacs/www/admin/calendar/category-one.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/calendar/category-one.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/calendar/category-one.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,84 @@ +# category-one.tcl,v 3.0.4.1 2000/03/17 23:10:10 jsalz Exp +# File: admin/calendar/category-one.tcl +# Date: 1998-11-18 +# Contact: philg@mit.edu, ahmeds@arsdigita.com +# Purpose: shows one category + +set_the_usual_form_variables + +# category_id + +set db [ns_db gethandle] + +set category [database_to_tcl_string $db " +select category +from calendar_categories +where category_id=$category_id "] + +set selection [ns_db 1row $db " +select scope, group_id +from calendar_categories +where category_id = $category_id "] + +set_variables_after_query + +ns_log "Warning" "Seems to me the scope is <$scope>" + +if { $scope=="group" } { + set short_name [database_to_tcl_string $db "select short_name + from user_groups + where group_id = $group_id"] +} + +if { $scope != "group" } { + set admin_url_string "/calendar/admin/category-one.tcl?category_id=$category_id&scope=$scope" +} else { + set admin_url_string "/groups/admin/$short_name/calendar/category-one.tcl?category_id=$category_id&scope=$scope&group_id=$group_id" +} + +ReturnHeaders + +ns_write " +[ad_admin_header "Category $category"] +

    Category $category

    +[ad_admin_context_bar [list "index.tcl" "Calendar"] [list "categories.tcl" "Categories"] "One Category"] + +
    + + + + + + +
    Maintainer Page: $admin_url_string
    + +
      +" + +set selection [ns_db select $db "select calendar.*, expired_p(expiration_date) as expired_p +from calendar +where category_id = $category_id +order by expired_p, creation_date desc"] + +set counter 0 +set expired_p_headline_written_p 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + incr counter + if { $expired_p == "t" && !$expired_p_headline_written_p } { + ns_write "

      Expired Calendar Items

      \n" + set expired_p_headline_written_p 1 + } + ns_write "
    • [util_AnsiDatetoPrettyDate $start_date] - [util_AnsiDatetoPrettyDate $end_date]: $title" + if { $approved_p == "f" } { + ns_write "  not approved" + } + ns_write "\n" +} + +ns_write " +

      +

    +[ad_admin_footer] +" + Index: web/openacs/www/admin/calendar/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/calendar/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/calendar/index.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,48 @@ +# index.tcl,v 3.0 2000/02/06 03:09:00 ron Exp +ReturnHeaders + +ns_write " + +[ad_admin_header "Calendar Administration"] +

    Calendar Administration

    +[ad_admin_context_bar "Calendar"] + +
    + +
      +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select calendar.*, expired_p(expiration_date) as expired_p +from calendar +order by expired_p, creation_date desc"] + +set counter 0 +set expired_p_headline_written_p 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + incr counter + if { $expired_p == "t" && !$expired_p_headline_written_p } { + ns_write "

      Expired Calendar Items

      \n" + set expired_p_headline_written_p 1 + } + ns_write "
    • [util_AnsiDatetoPrettyDate $start_date] - [util_AnsiDatetoPrettyDate $end_date]: $title" + if { $approved_p == "f" } { + ns_write "  not approved" + } + ns_write "\n" +} + +ns_write " + +

      + +

    • categories + +
    + +[ad_admin_footer] +" + + Index: web/openacs/www/admin/calendar/item-category-change-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/calendar/item-category-change-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/calendar/item-category-change-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,11 @@ +# item-category-change-2.tcl,v 3.0 2000/02/06 03:09:00 ron Exp +set_the_usual_form_variables + +# calendar_id, category + +set db [ns_db gethandle] + +ns_db dml $db "update calendar set category='$QQcategory' where calendar_id=$calendar_id" + +ns_returnredirect "item.tcl?calendar_id=$calendar_id" + Index: web/openacs/www/admin/calendar/item-category-change.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/calendar/item-category-change.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/calendar/item-category-change.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,43 @@ +# item-category-change.tcl,v 3.0 2000/02/06 03:09:00 ron Exp +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set user_id [ad_get_user_id] +if { $user_id == 0 } { + ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode [ns_conn url]?category=$category]" + return +} + +set_form_variables + +#calendar_id + +set db [ns_db gethandle] + +set title [database_to_tcl_string $db "select title from calendar +where calendar_id = $calendar_id"] + +ReturnHeaders +ns_write "[ad_admin_header "Pick New Category for $title"] +

    Pick new category

    +for $title +
    + +
      +" + +set counter 0 +foreach category [database_to_tcl_list $db "select category from calendar_categories where enabled_p = 't'"] { + incr counter + ns_write "
    • $category\n" +} + +ns_write " + +
    + +[ad_admin_footer] +" + Index: web/openacs/www/admin/calendar/item.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/calendar/item.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/calendar/item.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,161 @@ +# item.tcl,v 3.1 2000/03/10 21:50:40 jkoontz Exp +# File: admin/calendar/item.tcl +# Date: 1998-11-18 +# Contact: philg@mit.edu, ahmeds@arsdigita.com +# Purpose: shows one calendar item + +set_the_usual_form_variables + +# calendar_id + +set return_url [ns_urlencode [ns_conn url]?calendar_id=$calendar_id] + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db " +select title, body, html_p, calendar.approved_p, start_date, end_date, expiration_date, category_id,event_url, event_email, creation_user, creation_date, first_names, last_name +from calendar, users +where calendar_id = $calendar_id +and users.user_id = creation_user"] + +if { $selection == "" } { + ad_return_error "Can't find calendar item" "Can't find calendar item $calendar_id" + return +} + +set_variables_after_query + +set category [database_to_tcl_string $db " +select category +from calendar_categories +where category_id = $category_id "] + +set selection [ns_db 1row $db " +select scope, group_id +from calendar_categories +where category_id = $category_id "] + +set_variables_after_query + +if { $scope=="group" } { + set short_name [database_to_tcl_string $db "select short_name + from user_groups + where group_id = $group_id"] +} + +if { $scope == "public" } { + set admin_url_string "/calendar/admin/item.tcl?calendar_id=$calendar_id&scope=$scope" + set userpage_url_string "/calendar/item.tcl?calendar_id=$calendar_id&scope=$scope" +} else { + set admin_url_string "/[ad_parameter GroupsDirectory ug]/[ad_parameter GroupsAdminDirectory ug]/[ad_urlencode $short_name]/calendar/item.tcl?calendar_id=$calendar_id&scope=$scope&group_id=$group_id" + set userpage_url_string "/[ad_parameter GroupsDirectory ug]/[ad_urlencode $short_name]/calendar/item.tcl?calendar_id=$calendar_id&scope=$scope&group_id=$group_id" +} + +ReturnHeaders + +ns_write " +[ad_admin_header "$title"] +

    $title

    +[ad_admin_context_bar [list "index.tcl" "Calendar"] "One Item"] + +
    + + + + + + + + + + +
    Maintainer Page: $admin_url_string
    User Page: $userpage_url_string
    + +
      +
    • Category: $category + +

      +

    • Status: +" + +if {$approved_p == "t" } { + ns_write "Approved (Revoke)" +} else { + ns_write "Awaiting approval (Approve)" +} + +ns_write " +
    • Start Date: [util_AnsiDatetoPrettyDate $start_date] +
    • End Date: [util_AnsiDatetoPrettyDate $end_date] +
    • Expires: [util_AnsiDatetoPrettyDate $expiration_date] +
    • Submitted by: $first_names $last_name" + + +if ![empty_string_p $event_url] { + ns_write "
    • Web: $event_url\n" +} + +if ![empty_string_p $event_email] { + ns_write "
    • Email: $event_email\n" +} + +ns_write "
    + +

    Body

    + +
    +[util_maybe_convert_to_html $body $html_p] +
    +
    +
    + + +
    + +
    + +" + + +# see if there are any comments on this item +set selection [ns_db select $db "select comment_id, content, comment_date, first_names || ' ' || last_name as commenter_name, users.user_id as comment_user_id, html_p as comment_html_p, general_comments.approved_p as comment_approved_p from +general_comments, users +where on_what_id = $calendar_id +and on_which_table = 'calendar' +and general_comments.user_id = users.user_id"] + +set first_iteration_p 1 +while {[ns_db getrow $db $selection]} { + set_variables_after_query + if $first_iteration_p { + ns_write "

    Comments

    \n" + set first_iteration_p 0 + } + ns_write " + + +
    \n[util_maybe_convert_to_html $content $comment_html_p]\n" + ns_write "

    -- $commenter_name" + ns_write "
    +     		" + + #we only want the following if we are allowing comments: + + # print out the approval status if we are using the approval system + if { [ad_parameter CommentApprovalPolicy calendar] != "open"} { + if {$comment_approved_p == "t" } { + ns_write "Revoke approval" + } else { + ns_write "Approve" + } + ns_write "
    " + } + + ns_write "edit +
    +delete +
    " +} + +ns_write "[ad_admin_footer]" + Index: web/openacs/www/admin/calendar/post-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/calendar/post-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/calendar/post-edit-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,103 @@ +# post-edit-2.tcl,v 3.0 2000/02/06 03:09:01 ron Exp +# File: admin/calendar/post-edit-2.tcl +# Date: 1998-11-18 +# Contact: philg@mit.edu, ahmeds@arsdigita.com +# Purpose: calendar item edit target page + +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set user_id [ad_get_user_id] +if { $user_id == 0 } { + ns_returnredirect "/register/index.tcl" + return +} + +set_the_usual_form_variables + +# category_id, calendar_id, title, body, AOLserver ns_db magic vars that can be +# kludged together to form release_date and expiration_date + + +set exception_count 0 +set exception_text "" + +if [catch { ns_dbformvalue [ns_conn form] start_date date start_date + ns_dbformvalue [ns_conn form] end_date date end_date } errmsg] { + incr exception_count + append exception_text "
  • Please make sure your dates are valid." + +} else { + + set db [ns_db gethandle] + # we assume that the event ends at the very end of the end_date + # we have to do the bogus 1000* and then rounding because of Stupid Oracle + # driver truncation errors (doesn't like big fractions) + set expire_laterthan_future_p [database_to_tcl_string $db "select date_part('epoch',('$end_date 11:59:59'::datetime - '$start_date'::datetime)) from dual"] + if {$expire_laterthan_future_p <= 0} { + incr exception_count + append exception_text "
  • Please make sure the end date is later than the start date." + } +} + +# now start_date and end_date are set + +if { ![info exists title] || $title == ""} { + incr exception_count + append exception_text "
  • Please enter a title." +} +if { ![info exists body] || $body == "" } { + incr exception_count + append exception_text "
  • Please enter the full story." +} + +if { [info exists event_email] && ![empty_string_p $event_email] && ![philg_email_valid_p $event_email] } { + incr exception_count + append exception_text "
  • The event contact email address that you typed doesn't look right to us. Examples of valid email addresses are +
      +
    • Alice1234@aol.com +
    • joe_smith@hp.com +
    • pierre@inria.fr +
    +" +} + +if { [info exists event_url] && ![philg_url_valid_p $event_url] } { + set event_url "" +} + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + + +if [catch { ns_db dml $db "update calendar +set category_id = $category_id, title='$QQtitle', +body='$QQbody', html_p='$html_p', +start_date = '$start_date', end_date = '$end_date 11:59:59'::datetime, +expiration_date= '$end_date 11:59:59'::datetime + [ad_parameter DaysFromEndToExpiration calendar 3], +event_url = [ns_dbquotevalue $event_url text], +event_email = [ns_dbquotevalue $event_email text], +country_code = [ns_dbquotevalue $country_code text], +usps_abbrev = [ns_dbquotevalue $usps_abbrev text], +zip_code = [ns_dbquotevalue $zip_code text] +where calendar_id = $calendar_id" +} errmsg] { + # update failed; let's see if it was because of duplicate submission + ns_log Error "/calendar/admin/post-edit-2.tcl choked: $errmsg" + ad_return_error "Insert Failed" "The Database did not like what you typed. This is probably a bug in our code. Here's what the database said: +
    +
    +$errmsg
+
    +
    +" + return +} + + +ns_returnredirect "item.tcl?calendar_id=$calendar_id" + Index: web/openacs/www/admin/calendar/post-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/calendar/post-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/calendar/post-edit.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,155 @@ +# post-edit.tcl,v 3.0 2000/02/06 03:09:01 ron Exp +# File: admin/calendar/post-edit.tcl +# Date: 1998-11-18 +# Contact: philg@mit.edu, ahmeds@arsdigita.com +# Purpose: calendar item edit page + +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set_form_variables 0 + +# calendar_id + +set user_id [ad_get_user_id] +if { $user_id == 0 } { + ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode [ns_conn url]?[export_url_vars calendar_id]]" + return +} + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select title, body, html_p, approved_p, start_date, end_date, expiration_date, case when event_url is null or event_url='' then 'http://' else event_url end as event_url, event_email, country_code, usps_abbrev, zip_code, category_id +from calendar +where calendar_id = $calendar_id"] + +if { $selection == "" } { + ad_return_error "Can't find calendar item" "Can't find news item $calendar_id" + return +} + +set_variables_after_query + + +ReturnHeaders + +ns_write "[ad_admin_header "edit $title"] +

    Edit

    +item $title +
    + +
    +

    The title

    + +Remember that in a list of events, users will only see the title. So +try to make the title as descriptive as possible, e.g., +\"[ad_parameter TitleExample calendar "Ansel Adams show at Getty +Center in Los Angeles, March 1-June 15"]\". + +

    + +Title: + +

    Full Description

    + +This information will be visible to a user who has clicked on a title. +Make sure to include event hours, e.g., \"10 am to 4 pm\" and +directions to the event. + +

    + + + +

    + +Text above is + + + +

    Dates

    + +To ensure that users get relevant and accurate information, the +software is programmed to show only events that are in the future. +Furthermore, these events are sorted by the time that they start. So +an event that happens next week is given more prominence than an evetn +that happens next year. Make sure that you get these right! + +

    + + +
    Event Start Date[philg_dateentrywidget start_date $start_date] +
    Event End Date[philg_dateentrywidget end_date $end_date] +
    + + +

    Additional contact information

    + +If there are Internet sources for additional information about this +event, enter a URL and/or email address below. + +

    + + + + +
    Url +
    Contact Email +
    + +" + +if [ad_parameter EventsHaveLocationsP calendar 1] { + ns_write "

    Event Location

    + +If this event can be said to occur in one location, then please tell +us where it is. This will help our software give special prominence +to events that are geographically close to a particular user. + +

    + +Note that this information is not shown to users but only used by our +computer programs. The description above should contain information +about where to find the event. + +

    + + +" + if [ad_parameter InternationalP] { + if {$country_code == "us"} { + ns_write "\n" + } else { + ns_write "\n" + } + } + + if [ad_parameter SomeAmericanReadersP] { + ns_write "\n" + ns_write " (5 digits)\n" + } + ns_write "
    Country[country_widget $db]
    Country[country_widget $db $country_code]
    State[state_widget $db $usps_abbrev]
    US Zip Code
    \n" +} + +ns_write " + +

    + + +

    + +
    +[export_form_vars category_id calendar_id] +
    +[ad_admin_footer] +" + + + + + + + Index: web/openacs/www/admin/calendar/post-new-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/calendar/post-new-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/calendar/post-new-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,142 @@ +# post-new-2.tcl,v 3.0 2000/02/06 03:09:01 ron Exp + +# +# at this point, we know what kind of event is being described +# and can potentially do something with that information +# + +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set user_id [ad_get_user_id] +if { $user_id == 0 } { + ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode [ns_conn url]]" + return +} + + +set verb "Post" + +set_the_usual_form_variables + +# category + +ReturnHeaders +ns_write "[ad_admin_header "$verb $category Item"] +

    $verb $category Item

    + +[ad_admin_context_bar [list "index.tcl" "Calendar"] "$verb Item"] + +
    + +
    +

    The title

    + +Remember that in a list of events, users will only see the title. So +try to make the title as descriptive as possible, e.g., +\"[ad_parameter TitleExample calendar "Ansel Adams show at Getty +Center in Los Angeles, March 1-June 15"]\". + +

    + +Title: + +

    Full Description

    + +This information will be visible to a user who has clicked on a title. +Make sure to include event hours, e.g., \"10 am to 4 pm\" and +directions to the event. + +

    + + + +

    + +Text above is + + +" + + +set db [ns_db gethandle] + + +set calendar_id [database_to_tcl_string $db "select calendar_id_sequence.nextval from dual"] + +ns_write " + +

    Dates

    + +To ensure that users get relevant and accurate information, the +software is programmed to show only events that are in the future. +Furthermore, these events are sorted by the time that they start. So +an event that happens next week is given more prominence than an evetn +that happens next year. Make sure that you get these right! + +

    + + +
    Event Start Date[philg_dateentrywidget start_date [database_to_tcl_string $db "select sysdate() + [ad_parameter DaysFromPostingToStart calendar 30] from dual"]] +
    Event End Date[philg_dateentrywidget end_date [database_to_tcl_string $db "select sysdate() + [ad_parameter DaysFromPostingToStart calendar 30] + [ad_parameter DaysFromStartToEnd calendar 0] from dual"]] +
    + + +

    Additional contact information

    + +If there are Internet sources for additional information about this +event, enter a URL and/or email address below. + +

    + + + + +
    Url +
    Contact Email +
    + +" + +if [ad_parameter EventsHaveLocationsP calendar 1] { + ns_write "

    Event Location

    + +If this event can be said to occur in one location, then please tell +us where it is. This will help our software give special prominence +to events that are geographically close to a particular user. + +

    + +Note that this information is not shown to users but only used by our +computer programs. The description above should contain information +about where to find the event. + +

    + + +" + if [ad_parameter InternationalP] { + ns_write "\n" + } + if [ad_parameter SomeAmericanReadersP] { + ns_write "\n" + ns_write " (5 digits)\n" + } + ns_write "
    Country[country_widget $db]
    State[state_widget $db]
    US Zip Code
    \n" +} + +ns_write " + +

    + + +

    + +
    +[export_form_vars category calendar_id] +
    +[ad_admin_footer] +" + Index: web/openacs/www/admin/calendar/post-new-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/calendar/post-new-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/calendar/post-new-3.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,119 @@ +# post-new-3.tcl,v 3.0 2000/02/06 03:09:01 ron Exp +# +# actually do the insert into the calendar table + +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set user_id [ad_get_user_id] +if { $user_id == 0 } { + ns_returnredirect "/register/index.tcl" + return +} + +set_the_usual_form_variables + +# calendar_id, title, body, AOLserver ns_db magic vars that can be +# kludged together to form release_date and expiration_date + +set creation_ip_address [ns_conn peeraddr] + +set exception_count 0 +set exception_text "" + +if [catch { ns_dbformvalue [ns_conn form] start_date date start_date + ns_dbformvalue [ns_conn form] end_date date end_date } errmsg] { + incr exception_count + append exception_text "
  • Please make sure your dates are valid." +} else { + + set db [ns_db gethandle] + # we assume that the event ends at the very end of the end_date + # we have to do the bogus 1000* and then rounding because of Stupid Oracle + # driver truncation errors (doesn't like big fractions) + set expire_laterthan_future_p [database_to_tcl_string $db "select date_part('epoch', '$end_date 11:59:59'::datetime -'$start_date'::datetime)"] + if {$expire_laterthan_future_p < 0} { + incr exception_count + append exception_text "
  • Please make sure the end date is later than the start date." + } +} + +# now start_date and end_date are set + +if { ![info exists title] || $title == ""} { + incr exception_count + append exception_text "
  • Please enter a title." +} +if { ![info exists body] || $body == "" } { + incr exception_count + append exception_text "
  • Please enter the full story." +} + +if ![info exists country_code] { + set country_code "NULL" +} + +if ![info exists usps_abbrev] { + set usps_abbrev "NULL" +} + +if ![info exists zip_code] { + set zip_code "NULL" +} + +if { [info exists event_email] && ![empty_string_p $event_email] && ![philg_email_valid_p $event_email] } { + incr exception_count + append exception_text "
  • The event contact email address that you typed doesn't look right to us. Examples of valid email addresses are +
      +
    • Alice1234@aol.com +
    • joe_smith@hp.com +
    • pierre@inria.fr +
    +" +} + +if { [info exists event_url] && ![philg_url_valid_p $event_url] } { + set event_url "" +} + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + +set approved_p "t" + +if [catch { ns_db dml $db "insert into calendar +(calendar_id, category, title, body, html_p, approved_p, +start_date, end_date, +creation_date, expiration_date, +creation_user, creation_ip_address, +event_url, event_email, +country_code, usps_abbrev, zip_code) +values +($calendar_id, '$QQcategory', '$QQtitle', '$QQbody', '$html_p', '$approved_p', +'$start_date', '$end_date 11:59:59'::datetime, +sysdate(), '$end_date 11:59:59'::datetime +[ad_parameter DaysFromEndToExpiration calendar 3], +$user_id, '$creation_ip_address', +[ns_dbquotevalue $event_url text],[ns_dbquotevalue $event_email text], +[ns_dbquotevalue $country_code text],[ns_dbquotevalue $usps_abbrev text],[ns_dbquotevalue $zip_code text])" } errmsg] { + # insert failed; let's see if it was because of duplicate submission + if {[database_to_tcl_string $db "select count(*) from calendar where calendar_id = $calendar_id"] == 0 } { + ns_log Error "/calendar/post-new-3.tcl choked: $errmsg" + ad_return_error "Insert Failed" "The Database did not like what you typed. This is probably a bug in our code. Here's what the database said: +
    +
    +$errmsg
+
    +
    +" + return + } + # we don't bother to handle the cases where there is a dupe submission + # because the user should be thanked or redirected anyway +} + + +ns_returnredirect "item.tcl?calendar_id=$calendar_id" Index: web/openacs/www/admin/calendar/post-new-4.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/calendar/post-new-4.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/calendar/post-new-4.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,130 @@ +# post-new-4.tcl,v 3.0 2000/02/06 03:09:01 ron Exp +# +# actually do the insert into the calendar table + +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set user_id [ad_get_user_id] +if { $user_id == 0 } { + ns_returnredirect "/register/index.tcl" + return +} + +set_the_usual_form_variables + +# calendar_id, title, body, AOLserver ns_db magic vars that can be +# kludged together to form release_date and expiration_date + +set creation_ip_address [ns_conn peeraddr] + +set exception_count 0 +set exception_text "" + +if [catch { ns_dbformvalue [ns_conn form] start_date date start_date + ns_dbformvalue [ns_conn form] end_date date end_date } errmsg] { + incr exception_count + append exception_text "
  • Please make sure your dates are valid." +} else { + + set db [ns_db gethandle] + # we assume that the event ends at the very end of the end_date + # we have to do the bogus 1000* and then rounding because of Stupid Oracle + # driver truncation errors (doesn't like big fractions) + set expire_laterthan_future_p [database_to_tcl_string $db "select round(1000*(to_date('$end_date 11:59:59', 'YYYY-MM-DD HH24:MI:SS') - to_date('$start_date', 'YYYY-MM-DD'))) from dual"] + if {$expire_laterthan_future_p <= 0} { + incr exception_count + append exception_text "
  • Please make sure the end date is later than the start date." + } +} + +# now start_date and end_date are set + +if { ![info exists title] || $title == ""} { + incr exception_count + append exception_text "
  • Please enter a title." +} +if { ![info exists body] || $body == "" } { + incr exception_count + append exception_text "
  • Please enter the full story." +} + +if { [info exists event_email] && ![empty_string_p $event_email] && ![philg_email_valid_p $event_email] } { + incr exception_count + append exception_text "
  • The event contact email address that you typed doesn't look right to us. Examples of valid email addresses are +
      +
    • Alice1234@aol.com +
    • joe_smith@hp.com +
    • pierre@inria.fr +
    +" +} + +if { [info exists event_url] && ![philg_url_valid_p $event_url] } { + set event_url "" +} + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + +set approved_p "t" + +if [info exists country_code] { + set country_columns ", country_code, usps_abbrev, zipcode" + set country_values ",[ns_dbquotevalue $country_code text], + [ns_dbquotevalue $usps_abbrev text], + [ns_dbquotevalue $zip_code text]" +} else { + set country_columns "" + set country_values "" +} + +if [catch { ns_db dml $db "insert into calendar +(calendar_id, category_id, title, body, html_p, approved_p, +start_date, end_date, +creation_date, expiration_date, +creation_user, creation_ip_address, +event_url, event_email $country_values ) +values +($calendar_id, $category_id, '$QQtitle', '$QQbody', '$html_p', '$approved_p', +'$start_date', to_date('$end_date 11:59:59', 'YYYY-MM-DD HH24:MI:SS'), +sysdate(), '$end_date 11:59:59'::datetime + [ad_parameter DaysFromEndToExpiration calendar 3], +$user_id, '$creation_ip_address' +$country_values )" } errmsg] { + # insert failed; let's see if it was because of duplicate submission + if {[database_to_tcl_string $db "select count(*) from calendar where calendar_id = $calendar_id"] == 0 } { + ns_log Error "/calendar/post-new-3.tcl choked: $errmsg" + ad_return_error "Insert Failed" "The Database did not like what you typed. This is probably a bug in our code. Here's what the database said: +
    +
    +$errmsg
+
    +
    +" + return + } + # we don't bother to handle the cases where there is a dupe submission + # because the user should be thanked or redirected anyway +} + +if { [ad_parameter ApprovalPolicy calendar] == "open"} { + ns_returnredirect "index.tcl" +} else { + ns_return 200 text/html "[ad_admin_header "Thank you"] + +

    Thank you

    + +for your submission to [ad_parameter SystemName calendar "Calendar"] + +
    + +Your submission will be reviewed by +[ad_parameter SystemOwner calendar [ad_system_owner]]. + +[ad_admin_footer]" +} + Index: web/openacs/www/admin/calendar/post-new.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/calendar/post-new.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/calendar/post-new.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,48 @@ +# post-new.tcl,v 3.0 2000/02/06 03:09:01 ron Exp +# +# this page exists to solicit from the user what kind of an event +# + +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set user_id [ad_get_user_id] +if { $user_id == 0 } { + ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode [ns_conn url]?category=$category]" + return +} + +ReturnHeaders +ns_write "[ad_admin_header "Pick Category"] + +

    Pick Category

    + +[ad_admin_context_bar [list "index.tcl" "Calendar"] "Pick Category"] + +
    + +
      +" + +set db [ns_db gethandle] + +set counter 0 +foreach category [database_to_tcl_list $db "select category from calendar_categories where enabled_p = 't'"] { + incr counter + ns_write "
    • $category\n" +} + +if { $counter == 0 } { + ns_write "no event categories are currently defined; you'll have to visit +the categories page and define some." +} + +ns_write " + +
    + +[ad_admin_footer] +" + Index: web/openacs/www/admin/calendar/toggle-approved-p.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/calendar/toggle-approved-p.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/calendar/toggle-approved-p.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,16 @@ +# toggle-approved-p.tcl,v 3.0 2000/02/06 03:09:01 ron Exp +# File: admin/calendar/post-edit.tcl +# Date: 1998-11-18 +# Contact: philg@mit.edu, ahmeds@arsdigita.com +# Purpose: calendar item approval toggle page + +set_form_variables 0 + +# calendar_id + +set db [ns_db gethandle] + +ns_db dml $db "update calendar set approved_p = logical_negation(approved_p) where calendar_id = $calendar_id" + +ns_returnredirect "item.tcl?calendar_id=$calendar_id" + Index: web/openacs/www/admin/categories/add-link-to-parent-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/categories/add-link-to-parent-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/categories/add-link-to-parent-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,51 @@ +# add-link-to-parent-2.tcl,v 3.1 2000/03/09 22:14:56 seb Exp +# +# /admin/categories/add-link-to-parent-2.tcl +# +# by sskracic@arsdigita.com and michael@yoon.org on October 31, 1999 +# +# creates a parent-child relationship between two categories +# + +set_the_usual_form_variables + +# category_id, parent_category_id + +set exception_count 0 +set exception_text "" + +if {![info exists category_id] || [empty_string_p $category_id]} { + incr exception_count + append exception_text "
  • Child category ID is missing\n" +} + +if {![info exists parent_category_id] || [empty_string_p $parent_category_id] || \ + $parent_category_id <= 0} { + incr exception_count + append exception_text "
  • Parent category ID is incorrect or missing\n" +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +set db [ns_db gethandle] + +with_transaction $db { + + ns_db dml $db "DELETE FROM category_hierarchy +WHERE child_category_id = $category_id +AND parent_category_id IS NULL" + + ns_db dml $db "INSERT INTO category_hierarchy(child_category_id, parent_category_id) +VALUES ($category_id, $parent_category_id)" + +} { + ad_return_error "Database error" "Database threw an error: $errmsg" + return +} + +ns_db releasehandle $db + +ns_returnredirect "edit-parentage.tcl?[export_url_vars category_id]" Index: web/openacs/www/admin/categories/add-link-to-parent.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/categories/add-link-to-parent.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/categories/add-link-to-parent.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,135 @@ +# add-link-to-parent.tcl,v 3.1 2000/03/09 22:14:56 seb Exp +# +# /admin/categories/add-link-to-parent.tcl +# +# by sskracic@arsdigita.com and michael@yoon.org on October 31, 1999 +# +# form for designating a parent for a given category +# + +set_form_variables + +# category_id + +set db [ns_db gethandle] + +set category [database_to_tcl_string $db "SELECT category FROM categories WHERE category_id='$category_id'"] + + +# If there is no hierarchy defined, then just display a flat list of the existing categories. If there +# is, then show a fancy tree (which, btw, should be a proc). + +set n_hierarchy_links [database_to_tcl_string $db "select count(*) +from category_hierarchy +where parent_category_id is not null"] + +set category_html "" + +if { $n_hierarchy_links > 0 } { + append category_html "
      + +
    • Top Level + " + + # Find all children, grand-children, etc of category in question and + # store them in a list. The category MUST NOT have parent among any + # element in this list. + + set children_list [database_to_tcl_list $db "select h.child_category_id + from category_hierarhcy h + where category_hierarchy_level($category_id, h.child_category_id, 0) != null"] + +# set children_list [database_to_tcl_list $db "SELECT h.child_category_id +# FROM category_hierarchy h +# START WITH h.child_category_id = $category_id +# CONNECT BY PRIOR h.child_category_id = h.parent_category_id"] + + set parent_list [database_to_tcl_list $db "SELECT h.parent_category_id +FROM category_hierarchy h +WHERE h.child_category_id = $category_id"] + + set exclude_list [concat $children_list $parent_list] + + set selection [ns_db select $db "SELECT c.category_id AS cat_id, c.category, hc.levelcol +FROM categories c, +(SELECT h.child_category_id, LEVEL AS levelcol, ROWNUM AS rowcol + FROM category_hierarchy h + START WITH h.parent_category_id IS NULL + CONNECT BY PRIOR h.child_category_id = h.parent_category_id) hc +WHERE c.category_id = hc.child_category_id +ORDER BY hc.rowcol"] + + # We will iterate the loop for every category. If current category + # falls within $exclude_list, turn off hyperlinking to prevent + # circular parentships or unique constraint on category_hierarchy. + + set prevlevel 0 + while {[ns_db getrow $db $selection]} { + set_variables_after_query + set indent {} + if {$prevlevel < $levelcol} { + regsub -all . [format %*s [expr $levelcol - $prevlevel] {}] \ + "
        " indent + } elseif {$prevlevel > $levelcol} { + regsub -all . [format %*s [expr $levelcol - $prevlevel] {}] \ + "
      " indent + } + set prevlevel $levelcol + append category_html "$indent
    • " + if {[lsearch -exact $exclude_list $cat_id] == -1} { + append category_html "$category \n" + } else { + append category_html "$category \n" + } + } + + # Set close_tags to the appropriate number of
    tags + + if { [info exists levelcol] } { + regsub -all . [format %*s $levelcol {}] " " close_tags + + append category_html " + $close_tags +" + } + +} else { + + # There's no hierarchy, so display all categories (except for this one) as possible parents. + + append category_html "
      \n" + + set selection [ns_db select $db "select category_id as parent_category_id, category as parent_category +from categories +where category_id <> $category_id +order by category"] + + while {[ns_db getrow $db $selection]} { + set_variables_after_query + append category_html "
    • $parent_category\n" + } + + append category_html "
    \n" +} + +ns_db releasehandle $db + + +ReturnHeaders + +ns_write "[ad_admin_header "Define parent"] + +

    Define parent for $category

    + +[ad_admin_context_bar [list "index.tcl" "Categories"] [list "one.tcl?[export_url_vars category_id]" $category] "Define parent"] + +
    + +Click on a category to designate it as a parent of $category. + +

    + +$category_html + +[ad_admin_footer] +" Index: web/openacs/www/admin/categories/category-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/categories/category-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/categories/category-add-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,87 @@ +# category-add-2.tcl,v 3.1 2000/03/09 22:14:56 seb Exp +# +# /admin/categories/category-add-2.tcl +# +# by sskracic@arsdigita.com and michael@yoon.org on October 31, 1999 +# +# inserts a new category +# + +set_the_usual_form_variables + +# category_id, parent_category_id, category, category_description, mailing_list_info, +# enabled_p, profiling_weight, category_type, maybe new_category_type + +validate_integer category_id $category_id + +set exception_count 0 +set exception_text "" + +if {![info exists category_id] || [empty_string_p $category_id]} { + incr exception_count + append exception_text "

  • Category ID is somehow missing. This is probably a bug in our software." +} + +if {![info exists parent_category_id]} { + set parent_category_id "" +} + +if {![info exists category] || [empty_string_p $category]} { + incr exception_count + append exception_text "
  • Please enter a category" +} + +if {[info exists category_description] && [string length $category_description] > 4000} { + incr exception_count + append exception_text "
  • Please limit your category description to 4000 characters" +} + +if {[info exists mailing_list_info] && [string length $mailing_list_info] > 4000} { + incr exception_count + append exception_text "
  • Please limit your Mailing list information to 4000 characters" +} + +if {![info exists profiling_weight] || [empty_string_p $profiling_weight] || \ + [catch {if {[expr $profiling_weight < 0]} {error catch-it} }] } { + incr exception_count + append exception_text "
  • Profiling weight missing or less than 0" +} + +if {[info exists new_category_type] && ![empty_string_p $new_category_type]} { + set QQcategory_type $QQnew_category_type +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +set db [ns_db gethandle] + +with_transaction $db { + ns_db dml $db "insert into categories (category_id, category, category_type, profiling_weight, category_description, mailing_list_info, enabled_p) +values ($category_id, '$QQcategory', '$QQcategory_type', '$profiling_weight', '$QQcategory_description', '$QQmailing_list_info', '$enabled_p')" + + set n_categories [database_to_tcl_string $db "select count(category_id) from categories where category_id = $category_id"] + if {$n_categories != 1 } { + error "Category $category not inserted" + } + + # Even top-level categories have at least one row in category_hierarchy, for which parent_category_id is null. + + if {[empty_string_p $parent_category_id]} { + set parent_category_id "null" + } else { + validate_integer parent_category_id $parent_category_id + } + + ns_db dml $db "insert into category_hierarchy (child_category_id, parent_category_id) values ($category_id, $parent_category_id)" + +} { + ad_return_error "Database error occured inserting $category" $errmsg + return +} + +ns_db releasehandle $db + +ns_returnredirect "one?[export_url_vars category_id]" Index: web/openacs/www/admin/categories/category-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/categories/category-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/categories/category-add.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,123 @@ +# category-add.tcl,v 3.1 2000/03/09 22:14:56 seb Exp +# +# /admin/categories/category-add.tcl +# +# by sskracic@arsdigita.com and michael@yoon.org on October 31, 1999 +# +# form for adding a new category +# + +set_the_usual_form_variables 0 + +# category_type (optional), parent_category_id (optional) + +if {![info exists category_type]} { + set category_type "" +} + +set db [ns_db gethandle] + +if {![info exists parent_category_id]} { + set parent_category_id "" +} else { + set parent_category [database_to_tcl_string $db "select category +from categories +where category_id = $parent_category_id"] +} + +set category_id [database_to_tcl_string $db "select category_id_sequence.nextval from dual"] + +set category_type_select_html [db_html_select_options $db \ + "SELECT DISTINCT category_type FROM categories ORDER BY 1" $category_type] + +set category_parentage_html "" + +if {![empty_string_p $parent_category_id]} { + append category_parentage_html " +Category parentage + +" + + # Print out a Yahoo-style context bar for each line of parentage. + # + foreach parentage_line [ad_category_parentage_list $db $parent_category_id] { + set parentage_line_html [list] + foreach ancestor $parentage_line { + set ancestor_category_id [lindex $ancestor 0] + set ancestor_category [lindex $ancestor 1] + lappend parentage_line_html \ + "$ancestor_category" + } + append category_parentage_html "[join $parentage_line_html " : "]
    \n" + } + + append category_parentage_html " + +" +} + +ns_db releasehandle $db + +ReturnHeaders + +ns_write "[ad_admin_header "Add a category"] + +

    Add a category

    + +[ad_admin_context_bar [list "index.tcl" "Categories"] "Add"] + +
    + + +
    +[export_form_vars category_id parent_category_id] + + + + + + + + + + + + + + + $category_parentage_html + + + + + + + + + + + + + + + +
    Category name
    Category type + +
    Or enter new type
    (ignore selection above)
    Profiling weight
    Category description
    Mailing list information +
    +(use this field to enter specifics about what type of spam users will get +if they express an interest in this category) +
    Enabled +Yes +No +
    +
    + +
    +
    + +[ad_admin_footer] +" + Index: web/openacs/www/admin/categories/category-nuke-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/categories/category-nuke-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/categories/category-nuke-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,39 @@ +# category-nuke-2.tcl,v 3.1 2000/03/09 22:14:56 seb Exp +# +# /admin/categories/category-nuke.tcl +# +# by sskracic@arsdigita.com and michael@yoon.org on October 31, 1999 +# +# actually nukes a category +# + +set_form_variables + +# category_id + +set db [ns_db gethandle] + +if {[database_to_tcl_string $db " +select count(child_category_id) +from category_hierarchy +where parent_category_id = $category_id +"] > 0} { + ad_return_error "Problem nuking category" \ + "Cannot nuke category until all of its subcategories have been nuked." + return +} + +with_transaction $db { + ns_db dml $db "delete from users_interests where category_id = '$category_id'" + ns_db dml $db "delete from category_hierarchy where child_category_id = '$category_id'" + ns_db dml $db "delete from categories where category_id = '$category_id'" + +} { + ad_return_error "Problem nuking category" "$errmsg" + return +} + +ns_db releasehandle $db + +ns_returnredirect "index.tcl" + Index: web/openacs/www/admin/categories/category-nuke.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/categories/category-nuke.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/categories/category-nuke.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,51 @@ +# category-nuke.tcl,v 3.1 2000/03/09 22:14:56 seb Exp +# +# /admin/categories/category-nuke.tcl +# +# by sskracic@arsdigita.com and michael@yoon.org on October 31, 1999 +# +# confirmation page for nuking a category +# + +set_form_variables + +# category_id + +set db [ns_db gethandle] + +if {[database_to_tcl_string $db "select count(child_category_id) from category_hierarchy where parent_category_id = $category_id"] > 0} { + ad_return_error "Problem nuking category" \ + "Cannot nuke category until all of its subcategories have been nuked." + return +} + +set category [database_to_tcl_string $db "select category from categories where category_id = $category_id"] + +ns_db releasehandle $db + +ReturnHeaders + +ns_write "[ad_admin_header "Nuke category"] + +

    Nuke category

    + +[ad_admin_context_bar [list index.tcl "Categories"] "Nuke category"] + +
    + +
    + +[export_form_vars category_id] + +
    + +Are you sure that you want to nuke the category \"$category\"? This action cannot be undone. + +

    + + + +

    + +[ad_admin_footer] +" Index: web/openacs/www/admin/categories/category-update.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/categories/category-update.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/categories/category-update.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,64 @@ +# category-update.tcl,v 3.1 2000/03/09 22:14:56 seb Exp +# +# /admin/categories/category-update.tcl +# +# by sskracic@arsdigita.com and michael@yoon.org on October 31, 1999 +# +# updates the properties of an existing category +# + +set_the_usual_form_variables + +# category_id, category, mailing_list_info, profiling_weight, enabled_p +# category_type, possibly new_category_type + +validate_integer category_id $category_id +validate_integer profiling_weight $profiling_weight + +set exception_count 0 +set exception_text "" + +if {![info exists category] || [empty_string_p $category]} { + incr exception_count + append exception_text "
  • Please enter or select a category." +} + +if {[info exists new_category_type] && ![empty_string_p $new_category_type]} { + set QQcategory_type $QQnew_category_type +} + +if {[info exists category_description] && [string length $category_description] > 4000} { + incr exception_count + append exception_text "
  • Please limit your category description to 4000 characters" +} + +if {[info exists mailing_list_info] && [string length $mailing_list_info] > 4000} { + incr exception_count + append exception_text "
  • Please limit your Mailing list information to 4000 characters" +} + +if {![info exists profiling_weight] || [empty_string_p $profiling_weight] || \ + [catch {if {[expr $profiling_weight < 0]} {error catch-it} }] } { + incr exception_count + append exception_text "
  • Profiling weight missing or less than 0" +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +set db [ns_db gethandle] + +ns_db dml $db "UPDATE categories +SET category = '$QQcategory', +category_type = '$QQcategory_type', +category_description = '$QQcategory_description', +mailing_list_info = '$QQmailing_list_info', +enabled_p = '$QQenabled_p', +profiling_weight = '$QQprofiling_weight' +WHERE category_id = $category_id" + +ns_db releasehandle $db + +ns_returnredirect "one?[export_url_vars category_id]" Index: web/openacs/www/admin/categories/edit-parentage.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/categories/edit-parentage.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/categories/edit-parentage.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,79 @@ +# edit-parentage.tcl,v 3.1 2000/03/09 22:14:56 seb Exp +# +# /admin/categories/edit-parentage.tcl +# +# by sskracic@arsdigita.com and michael@yoon.org on October 31, 1999 +# +# form for adding parents to and removing parents from a category +# + +set_form_variables + +# category_id + +validate_integer category_id $category_id + +set db [ns_db gethandle] + +set category [database_to_tcl_string $db "SELECT c.category +FROM categories c +WHERE c.category_id = $category_id"] + +set parentage_lines [ad_category_parentage_list $db $category_id] + +set parentage_html "" + +if { [llength $parentage_lines] == 0 } { + append parentage_html "
  • none\n" + +} else { + foreach parentage_line $parentage_lines { + set n_generations [llength $parentage_line] + set n_generations_excluding_self [expr $n_generations - 1] + + set parentage_line_html [list] + for { set i 0 } { $i < $n_generations_excluding_self } { incr i } { + set ancestor [lindex $parentage_line $i] + set ancestor_category_id [lindex $ancestor 0] + set ancestor_category [lindex $ancestor 1] + lappend parentage_line_html \ + "$ancestor_category" + } + + if { [llength $parentage_line_html] == 0 } { + append parentage_html "
  • none\n" + } else { + set parent_category_id [lindex [lindex $parentage_line [expr $n_generations - 2]] 0] + + append parentage_html "
  • [join $parentage_line_html " : "] (remove link to this parentage line)\n" + } + } +} + +ns_db releasehandle $db + +ReturnHeaders + +ns_write "[ad_admin_header "Edit parentage"] + +

    Edit parentage for $category

    + +

    + +[ad_admin_context_bar [list "index.tcl" "Categories"] [list "one.tcl?[export_url_vars category_id]" $category] "Edit parentage"] + +

    + +Lines of parentage: + + + +[ad_admin_footer] +" Index: web/openacs/www/admin/categories/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/categories/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/categories/index.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,101 @@ +# index.tcl,v 3.1 2000/03/09 22:14:56 seb Exp +# +# /admin/categories/index.tcl +# +# by sskracic@arsdigita.com and michael@yoon.org on October 31, 1999 +# +# home page for category administration +# + +set db [ns_db gethandle] + +# If the category_hierarchy table only contains rows with null parent_category_ids, then +# we know that there are only top-level categories and that the site is not organizing +# categories hierarchically. + +set n_hierarchy_links [database_to_tcl_string $db "select count(*) +from category_hierarchy +where parent_category_id is not null"] + +# Postgres +# set n_category_types [database_to_tcl_string $db "select count(distinct category_type) from categories where category_type is not null"] +set n_category_types [database_to_tcl_string $db "select count(category_type) from categories where category_type is not null"] + +# If there is a category hierarchy but there are no category types defined, then redirect to +# the tree view page. + +if { $n_hierarchy_links > 0 && $n_category_types == 0 } { + ns_returnredirect "tree.tcl" + return +} + +set return_html " + +[ad_admin_header "Content Categories"] + +

    Content Categories

    + +[ad_admin_context_bar "Categories"] + +
    + +" + +# If there are any category_types, then display them in a list, along with the number +# of categories of each type. + +if { $n_category_types > 0 } { + + append return_html "Currently, categories of the following types exist: + +
      +" + + set selection [ns_db select $db "select coalesce(c.category_type, 'none') as category_type, count(c.category_id) as n_categories +from categories c +group by c.category_type +order by c.category_type asc"] + + while {[ns_db getrow $db $selection]} { + set_variables_after_query + append return_html "
    • $category_type (number of categories defined: $n_categories)\n" + } + +} else { + append return_html "
        \n" + + set selection [ns_db select $db "select category_id, category from categories order by category"] + while {[ns_db getrow $db $selection]} { + set_variables_after_query + append return_html "
      • $category\n" + } +} + + append return_html " +

        +

      • Add a category +
      + +(To define a new category type, simply add a category but instead of +picking an existing category type, enter a new one.) + +" + +# If a category hierarchy exists, then provide a link to the tree view page. + +if { $n_hierarchy_links > 0 } { + append return_html "

      + +You may also be interested in a tree representation of the category hierarchy. + +" +} + +append return_html "[ad_admin_footer]\n" + +ns_db releasehandle $db + +ReturnHeaders + +ns_write $return_html Index: web/openacs/www/admin/categories/one-type.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/categories/one-type.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/categories/one-type.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,75 @@ +# one-type.tcl,v 3.1 2000/03/09 22:14:56 seb Exp +# +# /admin/categories/one.tcl +# +# by sskracic@arsdigita.com and michael@yoon.org on October 31, 1999 +# +# displays all categories of one category type +# + +set_the_usual_form_variables 0 + +# category_type + +if { [info exists category_type] && ![empty_string_p $category_type]} { + set category_type_criterion "c.category_type = '$QQcategory_type'" + set page_title $category_type +} else { + set category_type_criterion "c.category_type is null" + set category_type "" + set page_title "None" +} + +set db [ns_db gethandle] + +set selection [ns_db select $db "(select c.category, c.category_id, count(ui.user_id) as n_interested_users +from users_interests ui, categories c +where ui.category_id = c.category_id +and $category_type_criterion +group by c.category, c.category_id) +union +(select c.category,c.category_id, 0 as n_interested_users +from categories c +where 0=(select count(*) from users_interests ui where ui.category_id=c.category_id) +and $category_type_criterion) +order by n_interested_users desc"] + +set category_list_html "" + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + + # Postgres group by hack + if {$category_id == ""} { + continue + } + + append category_list_html "

    • $category\n" + + if {$n_interested_users > 0} { + append category_list_html " (number of interested users: $n_interested_users)\n" + } +} + +ns_db releasehandle $db + +ReturnHeaders + +ns_write "[ad_admin_header $page_title] + +

      $page_title

      + +[ad_admin_context_bar [list "index.tcl" "Categories"] "One category type"] + +
      + + + +[ad_admin_footer] +" Index: web/openacs/www/admin/categories/one.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/categories/one.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/categories/one.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,232 @@ +# one.tcl,v 3.1 2000/03/09 22:14:56 seb Exp +# +# /admin/categories/one.tcl +# +# by sskracic@arsdigita.com and michael@yoon.org on October 31, 1999 +# +# displays the properties of one category +# + +set_form_variables + +# category_id + +set db [ns_db gethandle] + +set selection [ns_db select $db "(select c.category, c.category_type, c.enabled_p, c.category_description, c.mailing_list_info, c.profiling_weight, count(ui.user_id) as n_interested_users +from users_interests ui, categories c +where ui.category_id = c.category_id +and c.category_id = $category_id +group by c.category, c.category_type, c.enabled_p, c.category_description, c.mailing_list_info, c.profiling_weight) +union +(select c.category, c.category_type, c.enabled_p, c.category_description, c.mailing_list_info, c.profiling_weight, 0 as n_interested_users +from categories c +where 0=(select count(*) from users_interests ui where ui.category_id=c.category_id) +and c.category_id = $category_id +group by c.category, c.category_type, c.enabled_p, c.category_description, c.mailing_list_info, c.profiling_weight)"] + +##Postgres Group By Hack +while {[ns_db getrow $db $selection]} { + set_variables_after_query + if {$category==""} { + continue + } + ns_db flush $db + break +} + +# set_variables_after_query + +# Save this ns_set so we can use it later +set oldselection $selection + +set interested_users_html $n_interested_users + +if {$n_interested_users > 0} { + set interested_users_html "$n_interested_users" +} + +set category_type_select_html [db_html_select_options $db \ + "SELECT DISTINCT category_type FROM categories ORDER BY 1" $category_type] + +set parentage_lines [ad_category_parentage_list $db $category_id] + +set parentage_html "" + +if { [llength $parentage_lines] == 0 } { + append parentage_html "
    • none\n" + +} else { + # Print out a Yahoo-style context bar for each line of parentage. + # + foreach parentage_line $parentage_lines { + set parentage_line_html [list] + set n_generations [llength $parentage_line] + set this_generation [expr $n_generations - 1] + for { set i 0 } { $i < $n_generations } { incr i } { + set ancestor [lindex $parentage_line $i] + set ancestor_category_id [lindex $ancestor 0] + set ancestor_category [lindex $ancestor 1] + if { $i != $this_generation } { + lappend parentage_line_html \ + "$ancestor_category" + } else { + lappend parentage_line_html $ancestor_category + } + } + append parentage_html "
    • [join $parentage_line_html " : "]\n" + } +} + + +# Now find subtree that category is root of. We START WITH our category +# and let Oracle find its children, grandchildren, etc. + +set selection [ns_db select $db \ +"SELECT c.category_id AS child_id, c.category AS child_category, category_hierarchy_level(h.child_category_id, $category_id,0) as level_col +from categories c, category_hierarchy h +where c.category_id= h.child_category_id +AND c.category_id != $category_id +and category_hierarchy_level(h.child_category_id, $category_id,0) is not null +order by category_hierarchy_sortkey(h.child_category_id, $category_id,'')"] + +# set selection [ns_db select $db \ +# "SELECT c.category_id AS child_id, c.category AS child_category, hc.level_col +# FROM categories c, +# (SELECT h.child_category_id, LEVEL AS level_col, ROWNUM AS row_col +# FROM category_hierarchy h +# START WITH h.child_category_id = $category_id +# CONNECT BY PRIOR h.child_category_id = h.parent_category_id) hc +# WHERE c.category_id = hc.child_category_id +# AND c.category_id <> $category_id +# ORDER BY hc.row_col"] + +set children_html "" + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + # make proper indentation + regsub -all . [format %*s [expr $level_col - 1] {}] {\  \  } \ + indent + append children_html "$indent $child_category
      \n" +} + +set category_nuke_html "" + +if {$n_interested_users < 5} { + set category_nuke_html "

      +

    • Nuke this category" +} + +ns_db releasehandle $db + + +ReturnHeaders + +ns_write "[ad_admin_header $category] + +

      $category

      + +[ad_admin_context_bar [list "index.tcl" "Categories"] "One category"] + +
      + +
      +[export_form_vars category_id] + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
      Category name
      Category type + +
      Or enter new type
      (ignore selection above)
      Profiling weight
      Category description + +
      Mailing list information +
      +(use this field to enter specifics about what type of spam users will get +if they express an interest in this category) +
      Enabled[bt_mergepiece "Yes +No" $oldselection] +
      +
      + +
      +
      + +
        +
      • Number of users who've expressed interest in this category: + + $interested_users_html + +
      + +

      Location of this category in the category hierarchy

      + +
        +
      • Parentage of this category: + +

        + +

          + + $parentage_html + +
        + +

        + +

      • Children (subcategories) of this category: + +

        + + $children_html + +

      + + + +

      Advanced stuff (you should know what you're doing)

      + + + +[ad_admin_footer] +" Index: web/openacs/www/admin/categories/remove-link-to-parent.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/categories/remove-link-to-parent.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/categories/remove-link-to-parent.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,58 @@ +# remove-link-to-parent.tcl,v 3.1 2000/03/09 22:14:56 seb Exp +# +# /admin/categories/remove-link-to-parent.tcl +# +# by sskracic@arsdigita.com and michael@yoon.org on October 31, 1999 +# +# deletes a parent-child relationship between two categories +# + +set_the_usual_form_variables + +# category_id, parent_category_id + +validate_integer category_id $category_id +validate_integer parent_category_id $parent_category_id + +set exception_count 0 +set exception_text "" + +if {![info exists category_id] || [empty_string_p $category_id]} { + incr exception_count + append exception_text "
    • Child category ID missing\n" +} + +if {![info exists parent_category_id] || [empty_string_p $parent_category_id]} { + incr exception_count + append exception_text "
    • Parent category ID missing\n" +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +set db [ns_db gethandle] +with_transaction $db { + ns_db dml $db "DELETE FROM category_hierarchy + WHERE child_category_id = $category_id + AND parent_category_id = $parent_category_id" + set parent_count [database_to_tcl_string $db "SELECT COUNT(*) + FROM category_hierarchy WHERE child_category_id=$category_id"] + + # IMPORTANT! We must provide each category with at least one parent, even + # the NULL one, otherwise strange things may happen (categories + # mysteriously disappear from list etc) + + if {$parent_count == 0} { + ns_db dml $db "INSERT INTO category_hierarchy + (child_category_id, parent_category_id) VALUES ($category_id, NULL)" + } +} { + ad_return_error 1 "Database error" $errmsg + return +} + +ns_db releasehandle $db + +ns_returnredirect "edit-parentage?[export_url_vars category_id]" Index: web/openacs/www/admin/categories/tree.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/categories/tree.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/categories/tree.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,71 @@ +# tree.tcl,v 3.1 2000/03/09 22:14:57 seb Exp +# +# /admin/categories/tree.tcl +# +# by sskracic@arsdigita.com and michael@yoon.org on October 31, 1999 +# +# presents the contents of the categories and the category_hierarchy table +# as a tree +# + +set db [ns_db gethandle] + +set selection [ns_db select $db "SELECT c.category_id, c.category, c.category_type, c.profiling_weight, c.enabled_p, cat_tree.rownum_col, cat_tree.level_col, COUNT(ui.user_id) AS n_interested_users +FROM users_interests ui, categories c, +(SELECT h.child_category_id, ROWNUM as rownum_col, LEVEL AS level_col + FROM category_hierarchy h + START WITH h.parent_category_id IS NULL + CONNECT BY PRIOR h.child_category_id = h.parent_category_id) cat_tree +WHERE c.category_id = cat_tree.child_category_id +AND c.category_id = ui.category_id (+) +GROUP BY c.category_id, c.category, c.category_type, c.profiling_weight, c.enabled_p, cat_tree.rownum_col, cat_tree.level_col +ORDER BY cat_tree.rownum_col"] + +set category_tree "" + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + # We want to form a string consisting of $level_col " "s. + # Or two times $level_col. + regsub -all . [format %*s [expr $level_col - 1] {}] {\  \  } indent + append category_tree " + +$indent $category +$category_type +$profiling_weight +$enabled_p +[expr {$n_interested_users > 0 ? "$n_interested_users\n" : 0}] + +" +} + +ns_db releasehandle $db + +ReturnHeaders + +ns_write "[ad_admin_header "Content Categories Tree"] + +

      Content Categories Tree

      + +[ad_admin_context_bar [list index.tcl "Categories"] "Category tree"] + +
      + + + + + + + + + + +$category_tree + +
      CategoryTypeWeightEnabled# of Interested Users
      + + +[ad_admin_footer] +" Index: web/openacs/www/admin/chat/create-room-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/chat/create-room-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/chat/create-room-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,53 @@ +# create-room-2.tcl,v 3.0 2000/02/06 03:10:08 ron Exp +# File: admin/chat/create-room-2.tcl +# Date: 1998-11-18 +# Contact: aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com +# Purpose: creates a new chat room + +set_the_usual_form_variables + +# pretty_name, maybe group_id, moderated_p, expiration_days, active_p + +ad_maybe_redirect_for_registration + +set exception_count 0 +set exception_text "" + +if {[empty_string_p $pretty_name]} { + incr exception_count + append exception_text "
    • Please name your chat room." +} + + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + +set db [ns_db gethandle] + +ns_db dml $db "begin transaction" + +set chat_room_id [database_to_tcl_string $db "select chat_room_id_sequence.nextval from dual"] + +if { [empty_string_p $group_id] } { + set scope_val "public" +} else { + set scope_val "group" + validate_integer group_id $group_id +} + +# Postgres NULL check +set group_id_sql [db_postgres_null_sql $group_id] + +ns_db dml $db "insert into chat_rooms +(chat_room_id, pretty_name, group_id, scope, moderated_p, expiration_days, active_p) +values +($chat_room_id, '$QQpretty_name', $group_id_sql, '$scope_val', '$moderated_p', '$expiration_days', '$active_p')" + +# create a new admin group within this transaction +ad_administration_group_add $db "$pretty_name Moderation" chat $chat_room_id "/chat/moderate.tcl?chat_room_id=$chat_room_id" "f" + +ns_db dml $db "end transaction" + +ns_returnredirect "one-room.tcl?[export_url_vars chat_room_id]" Index: web/openacs/www/admin/chat/create-room.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/chat/create-room.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/chat/create-room.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,70 @@ +# create-room.tcl,v 3.0 2000/02/06 03:10:08 ron Exp +# File: admin/chat/create-room.tcl +# Date: 1998-11-18 +# Contact: aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com +# Purpose: creates a new chat room + +set user_id [ad_verify_and_get_user_id] + +ad_maybe_redirect_for_registration + +set db [ns_db gethandle] + +ReturnHeaders + +set title "Create a Room" + +ns_write "[ad_admin_header "$title"] + +

      $title

      + +[ad_admin_context_bar [list "index.tcl" "Chat System"] "$title"] + +
      +
      + + + + + + + + + +
      +Room Name:
      +Restrict to Members of a Group: +
      +Expire messages after days (or leave blank to archive messages indefinitely) +
      +Active? + +(pick \"No\" if you want to wait before launching this publicly) +
      +Moderated? +
      +

      +

      + +
      +
      + +[ad_admin_footer] +" + + Index: web/openacs/www/admin/chat/delete-messages-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/chat/delete-messages-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/chat/delete-messages-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,17 @@ +# delete-messages-2.tcl,v 3.0 2000/02/06 03:10:09 ron Exp +# File: admin/chat/delete-messages-2.tcl +# Date: 1998-11-18 +# Contact: aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com +# Purpose: deletes messages of a chat room + +set_the_usual_form_variables + +# chat_room_id + +ad_maybe_redirect_for_registration + +set db [ns_db gethandle] + +ns_db dml $db "delete from chat_msgs where chat_room_id=$chat_room_id" + +ns_returnredirect "one-room.tcl?[export_url_vars chat_room_id]" Index: web/openacs/www/admin/chat/delete-messages.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/chat/delete-messages.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/chat/delete-messages.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,45 @@ +# delete-messages.tcl,v 3.0 2000/02/06 03:10:09 ron Exp +# File: admin/chat/delete-messages.tcl +# Date: 2000-01-31 +# Contact: aure@arsdigita.com +# Purpose: deletes a chat room's emssages + +set_the_usual_form_variables + +# chat_room_id + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select * from chat_rooms where chat_room_id = $chat_room_id"] + +if { $selection == "" } { + ad_return_error "Not Found" "Could not find chat_room $chat_room_id" + return +} + +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "Confirm deletion of messages in$pretty_name"] + +

      Confirm deletion of messages in $pretty_name

      + +[ad_admin_context_bar [list "index.tcl" Chat] [list "one-room.tcl?[export_url_vars chat_room_id]" "One Room"] "Confirm Deletion"] + +
      + +Are you sure that you want to delete [database_to_tcl_string $db "select count(*) from chat_msgs where chat_room_id = $chat_room_id"] messages from $pretty_name? + +

      + +

      +
      +[export_form_vars chat_room_id] + +
      +
      + + +[ad_admin_footer] +" Index: web/openacs/www/admin/chat/delete-room-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/chat/delete-room-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/chat/delete-room-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,31 @@ +# delete-room-2.tcl,v 3.0 2000/02/06 03:10:09 ron Exp +# File: admin/chat/delete-room-2.tcl +# Date: 1998-11-18 +# Contact: aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com +# Purpose: deletes a chat room + +set_the_usual_form_variables + +# chat_room_id + +ad_maybe_redirect_for_registration + +set db [ns_db gethandle] + +ns_db dml $db "begin transaction" + +# delete the admin group we were using for moderation + +set admin_group_id [ad_administration_group_id $db chat $chat_room_id] +if ![empty_string_p $admin_group_id] { + ns_db dml $db "delete from user_group_map_queue where group_id = $admin_group_id" + ns_db dml $db "delete from user_group_map where group_id = $admin_group_id" +} + +ns_db dml $db "delete from chat_msgs where chat_room_id=$chat_room_id" + +ns_db dml $db "delete from chat_rooms where chat_room_id=$chat_room_id" + +ns_db dml $db "end transaction" + +ns_returnredirect index.tcl Index: web/openacs/www/admin/chat/delete-room.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/chat/delete-room.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/chat/delete-room.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,46 @@ +# delete-room.tcl,v 3.0 2000/02/06 03:10:09 ron Exp +# File: admin/chat/delete-room.tcl +# Date: 1998-11-18 +# Contact: aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com +# Purpose: deletes a chat room + +set_the_usual_form_variables + +# chat_room_id + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select * from chat_rooms where chat_room_id = $chat_room_id"] + +if { $selection == "" } { + ad_return_error "Not Found" "Could not find chat_room $chat_room_id" + return +} + +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "Confirm deletion of $pretty_name"] + +

      Confirm deletion of $pretty_name

      + +[ad_admin_context_bar [list "index.tcl" Chat] [list "one-room.tcl?[export_url_vars chat_room_id]" "One Room"] "Confirm Deletion"] + +
      + +Are you sure that you want to delete $pretty_name (and its +[database_to_tcl_string $db "select count(*) from chat_msgs where chat_room_id = $chat_room_id"] messages)? + +

      + +

      +
      +[export_form_vars chat_room_id] + +
      +
      + + +[ad_admin_footer] +" Index: web/openacs/www/admin/chat/edit-room.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/chat/edit-room.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/chat/edit-room.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,45 @@ +# edit-room.tcl,v 3.0 2000/02/06 03:10:09 ron Exp +# File: admin/chat/edit-room.tcl +# Date: 1998-11-18 +# Contact: aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com +# Purpose: edits properties of a chat room + +set_the_usual_form_variables + +# pretty_name, maybe group_id, moderated_p, user_id_from_search, expiration_days, active_p + +ad_maybe_redirect_for_registration + +set exception_count 0 +if {[empty_string_p $pretty_name]} { + incr exception_count + append exception_text "
    • Please give this chat room a name." +} + + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + +set db [ns_db gethandle] + +if { [empty_string_p $group_id] } { + set scope_sql "group_id = null, + scope = 'public', " +} else { + set scope_sql "group_id = $group_id, + scope = 'group', " +} + +ns_db dml $db "update chat_rooms +set pretty_name='$QQpretty_name', +moderated_p='$moderated_p', +$scope_sql +active_p='$active_p', +expiration_days= [ns_dbquotevalue $expiration_days number] +where chat_room_id=$chat_room_id" + +ns_returnredirect "one-room.tcl?[export_url_vars chat_room_id]" + + Index: web/openacs/www/admin/chat/expire-messages.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/chat/expire-messages.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/chat/expire-messages.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,41 @@ +# expire-messages.tcl,v 3.0 2000/02/06 03:10:09 ron Exp +# File: admin/chat/expire-messages.tcl +# Date: 1998-11-18 +# Contact: aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com +# Purpose: expires messages of a chat room + +set_the_usual_form_variables + +# chat_room_id + +ad_maybe_redirect_for_registration + +set db [ns_db gethandle] + +set expiration_days [database_to_tcl_string $db "select expiration_days from chat_rooms where chat_room_id=$chat_room_id"] + +if {[empty_string_p $expiration_days]} { + ad_return_complaint 1 "You haven't set expiration_days so we +couldn't possibly delete any messages" + return +} + +ns_db dml $db "delete from chat_msgs +where chat_room_id = $chat_room_id +and creation_date < sysdate()- timespan_days($expiration_days)" + +set n_rows_deleted [ns_pg ntuples $db] + +ns_return 200 text/html "[ad_admin_header "$n_rows_deleted rows were deleted"] + +

      $n_rows_deleted rows deleted

      + +[ad_admin_context_bar [list "index.tcl" Chat] [list "one-room.tcl?[export_url_vars chat_room_id]" "One Room"] "Deleted Expired Messages"] + +
      + +[ad_admin_footer] +" + + + Index: web/openacs/www/admin/chat/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/chat/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/chat/index.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,80 @@ +# index.tcl,v 3.0 2000/02/06 03:10:09 ron Exp +# File: admin/chat/index.tcl +# Date: 1998-11-18 +# Contact: aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com +# Purpose: admin chat main page + +ReturnHeaders + +set title "Chat System" + +ns_write "[ad_admin_header $title] + +

      $title

      + +[ad_admin_context_bar $title] + +
      + +Documentation: /doc/chat.html +
      +User pages: /chat/ + + +
        +

        Active chat rooms

        +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "(select chat_rooms.chat_room_id, chat_rooms.pretty_name, chat_rooms.active_p, count(chat_msg_id) as n_messages, max(chat_msgs.creation_date) as most_recent_date +from chat_rooms, chat_msgs +where chat_rooms.chat_room_id = chat_msgs.chat_room_id +group by chat_rooms.chat_room_id, chat_rooms.pretty_name, chat_rooms.active_p +) union (select chat_rooms.chat_room_id, chat_rooms.pretty_name, chat_rooms.active_p, 0 as n_messages, NULL as most_recent_date from chat_rooms where 0=chat_room_msgs(chat_room_id)) +order by chat_rooms.active_p desc, upper(chat_rooms.pretty_name)"] + + +set count 0 +set inactive_title_shown_p 0 +set room_items "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + # POSTGRES hack + if {$chat_room_id == ""} { + continue + } + + if { $active_p == "f" } { + if { $inactive_title_shown_p == 0 } { + # we have not shown the inactive title yet + if { $count == 0 } { + append room_items "
      • No active chat rooms" + } + set inactive_title_shown_p 1 + append room_items "

        Inactive chat rooms

        " + } + } + + append room_items "
      • $pretty_name\n" + if { $n_messages == 0 } { + append room_items " (no messages)\n" + } else { + append room_items " ($n_messages; most recent on $most_recent_date)\n" + } + incr count +} + + +ns_write " +$room_items + +

        + +Create a new room +

      + +[ad_admin_footer] +" Index: web/openacs/www/admin/chat/msgs-for-user.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/chat/msgs-for-user.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/chat/msgs-for-user.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,60 @@ +# msgs-for-user.tcl,v 3.0 2000/02/06 03:10:10 ron Exp +# File: admin/chat/msgs-for-user.tcl +# Date: 1998-11-18 +# Contact: aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com + +set_the_usual_form_variables +# user_id + +ad_maybe_redirect_for_registration + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select first_names || ' ' || last_name as username +from users +where user_id = $user_id"] + +set_variables_after_query + +set selection [ns_db select $db "select cr.pretty_name, cm.msg, u.first_names || ' ' || u.last_name as recipient +from chat_rooms cr, chat_msgs cm, users u +where creation_user = $user_id +and cm.chat_room_id = cr.chat_room_id(+) +and cm.recipient_user = u.user_id(+) +and cm.system_note_p = 'f' +order by cr.pretty_name, u.first_names, u.last_name, cm.creation_date"] + +set msgs "" +set last_chat_room "" +set last_recipient " " + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + + if { ![empty_string_p $pretty_name] && $last_chat_room != $pretty_name } { + append msgs "

      Messages in $pretty_name room

      \n" + set last_chat_room $pretty_name + } + if { ![empty_string_p $recipient] && $recipient != $last_recipient } { + append msgs "

      Messages to $recipient

      \n" + set last_recipient $recipient + } + + append msgs "
    • $msg\n" +} + +ns_return 200 text/html "[ad_admin_header "Messages By $username"] + +

      Messages By $username

      + +[ad_admin_context_bar [list "index.tcl" "Chat System"] "Messages By $username"] + +
      + +
        +$msgs +
      + +[ad_admin_footer] +" Index: web/openacs/www/admin/chat/one-room.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/chat/one-room.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/chat/one-room.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,190 @@ +# one-room.tcl,v 3.0 2000/02/06 03:10:10 ron Exp +# File: admin/chat/one-room.tcl +# Date: 1998-11-18 +# Contact: aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com +# Purpose: shows one chat room + +set_the_usual_form_variables + +# chat_room_id + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select * from chat_rooms where chat_room_id = $chat_room_id"] + +if { $selection == "" } { + ad_return_error "Not Found" "Could not find chat_room $chat_room_id" + return +} + +set_variables_after_query + +set selection [ns_db 1row $db " +select scope, group_id +from chat_rooms +where chat_room_id = $chat_room_id "] + +set_variables_after_query + +if { $scope=="group" } { + set short_name [database_to_tcl_string $db "select short_name + from user_groups + where group_id = $group_id"] +} + +if { $scope == "public" } { + set userpage_url_string "/chat/chat.tcl?chat_room_id=$chat_room_id&scope=$scope" +} else { + set userpage_url_string "/groups/$short_name/chat/chat.tcl?chat_room_id=$chat_room_id&scope=$scope&group_id=$group_id" +} + + +ReturnHeaders + +ns_write " + +[ad_admin_header "$pretty_name"] +

      $pretty_name

      +[ad_admin_context_bar [list "index.tcl" Chat] "One Room"] + +
      + +User page: $userpage_url_string + + +" + +if [empty_string_p $expiration_days] { + set n_expired_msgs 0 + set expired_select_item "" +} else { + set expired_select_item ", sum(case when (date_part('epoch',(sysdate()-timespan_days($expiration_days))-creation_date)) > 0 then 1 else 0 end) as n_expired_msgs" +} + +set selection [ns_db 1row $db "select min(creation_date) as min_date, max(creation_date) as max_date, count(*) as n_messages, count(creation_user) as n_users $expired_select_item +from chat_msgs +where chat_room_id = $chat_room_id"] + +set_variables_after_query + +ns_write " +
        +
      • oldest message: $min_date +
      • newest message: $max_date +
      • total messages: $n_messages (from $n_users distinct users) +
      + +

      Properties

      + +
      +[export_form_vars chat_room_id] + + + + + + + + + + + + + + + + + + + + + + +
      Room Name:
      Group (optional):
      Expire messages after days (or leave blank to archive messages indefinitely)
      Active? +
      Moderation Policy: +
      +
      +

      Moderators

      +" + +set group_id [ad_administration_group_id $db chat $chat_room_id] +set selection [ns_db select $db "select users.user_id as moderator_id, first_names, last_name +from users, user_group_map +where group_id=$group_id +and users.user_id = user_group_map.user_id"] + +set moderators "" +while {[ns_db getrow $db $selection]} { + set_variables_after_query + lappend moderators "$first_names $last_name" +} + +set moderators [join $moderators ", "] + +if {[empty_string_p $moderators]} { + set moderators "none" +} + +ns_write " +Current Moderator(s): +$moderators + +
      +
      +[export_form_vars group_id] + +
      +
      + +

      Extreme Actions

      + + +[ad_admin_footer] +" Index: web/openacs/www/admin/click/all-from-local.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/click/all-from-local.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/click/all-from-local.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,47 @@ +# all-from-local.tcl,v 3.0 2000/02/06 03:14:40 ron Exp +set_the_usual_form_variables + +# local_url + +ReturnHeaders + +ns_write "[ad_admin_header "Clickthroughs from $local_url"] + +

      from + + +$local_url + +

      + +[ad_admin_context_bar [list "report.tcl" "Clickthroughs"] "All from Local URL"] + + +
      + +
        + +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select entry_date, sum(click_count) as n_clicks +from clickthrough_log +where local_url = '[DoubleApos $local_url]' +group by entry_date +order by entry_date desc"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
      • $entry_date : + +$n_clicks +" +} + +ns_write " +
      +[ad_admin_footer] +" + + Index: web/openacs/www/admin/click/all-to-foreign.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/click/all-to-foreign.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/click/all-to-foreign.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,48 @@ +# all-to-foreign.tcl,v 3.0 2000/02/06 03:14:41 ron Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +# foreign_url + +ReturnHeaders + +ns_write "[ad_admin_header "-> $foreign_url"] + +

      -> + + +$foreign_url + +

      + +[ad_admin_context_bar [list "report.tcl" "Clickthroughs"] "All to Foreign URL"] + + + +
      + +
        + +" +set db [ns_db gethandle] + +set selection [ns_db select $db "select entry_date, sum(click_count) as n_clicks from clickthrough_log +where foreign_url = '[DoubleApos $foreign_url]' +group by entry_date +order by entry_date desc"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
      • $entry_date : + +$n_clicks +" +} + +ns_write " +
      + +[ad_admin_footer] +" + + Index: web/openacs/www/admin/click/blank.gif =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/click/blank.gif,v diff -u Binary files differ Index: web/openacs/www/admin/click/by-foreign-url-aggregate.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/click/by-foreign-url-aggregate.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/click/by-foreign-url-aggregate.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,49 @@ +# by-foreign-url-aggregate.tcl,v 3.0 2000/02/06 03:14:42 ron Exp +set_form_variables 0 + +# minimum (optional) + +ReturnHeaders + +ns_write "[ad_admin_header "by foreign URL"] + +

      by foreign URL

      + +[ad_admin_context_bar [list "report.tcl" "Clickthroughs"] "By Foreign URL"] + +
      + +Note: this page may be slow to generate; it requires a tremendous +amount of chugging by the RDBMS. + +
        + +" + +set db [ns_db gethandle] + +if { [info exists minimum] } { + set having_clause "\nhaving sum(click_count) >= $minimum" +} else { + set having_clause "" +} + +set selection [ns_db select $db "select local_url, foreign_url, sum(click_count) as n_clicks +from clickthrough_log +group by local_url, foreign_url $having_clause +order by foreign_url +"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
      • +$foreign_url (from $local_url) : $n_clicks + +" +} + +ns_write " +
      + +[ad_admin_footer] +" Index: web/openacs/www/admin/click/by-foreign-url.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/click/by-foreign-url.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/click/by-foreign-url.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,35 @@ +# by-foreign-url.tcl,v 3.0 2000/02/06 03:14:43 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Clickthroughs by foreign URL from [ad_system_name]"] + + +

      by foreign URL

      + +[ad_admin_context_bar [list "report.tcl" "Clickthroughs"] "By Foreign URL"] + +
      + +
        + +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select distinct local_url, foreign_url +from clickthrough_log +order by foreign_url"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
      • +$foreign_url (from $local_url) + +" +} + +ns_write " +
      + +[ad_admin_footer] +" Index: web/openacs/www/admin/click/by-local-url-aggregate.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/click/by-local-url-aggregate.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/click/by-local-url-aggregate.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,39 @@ +# by-local-url-aggregate.tcl,v 3.0 2000/02/06 03:14:44 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "by local URL"] + +

      by local URL

      + +[ad_admin_context_bar [list "report.tcl" "Clickthroughs"] "By Local URL"] + + +
      + +Note: this page may be slow to generate; it requires a tremendous +amount of chugging by the RDBMS. + +
        + +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select local_url, foreign_url, sum(click_count) as n_clicks +from clickthrough_log +group by local_url, foreign_url +order by local_url +"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
      • +$local_url -> $foreign_url : $n_clicks + +" +} + +ns_write " +
      +[ad_admin_footer] +" Index: web/openacs/www/admin/click/by-local-url.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/click/by-local-url.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/click/by-local-url.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,35 @@ +# by-local-url.tcl,v 3.0 2000/02/06 03:14:46 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Clickthroughs for [ad_system_name]"] + +

      by local URL

      + +[ad_admin_context_bar [list "report.tcl" "Clickthroughs"] "By Local URL"] + + +
      + +
        + +" + +set db [ns_db gethandle] +set selection [ns_db select $db "select distinct local_url, foreign_url +from clickthrough_log +order by local_url +"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
      • +$local_url -> $foreign_url + +" +} + +ns_write " +
      + +[ad_admin_footer] +" Index: web/openacs/www/admin/click/one-foreign-one-day.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/click/one-foreign-one-day.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/click/one-foreign-one-day.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,42 @@ +# one-foreign-one-day.tcl,v 3.0 2000/02/06 03:14:47 ron Exp +set_the_usual_form_variables + +# foreign_url, query_date + +ReturnHeaders + +ns_write "[ad_admin_header "$query_date : -> $foreign_url"] + +

      -> + + +$foreign_url + +

      + +[ad_admin_context_bar [list "report.tcl" "Clickthroughs"] [list "all-to-foreign.tcl?[export_url_vars foreign_url]" "To One Foreign URL"] "Just $query_date"] + +
      + +
        + +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select local_url, click_count +from clickthrough_log +where foreign_url = '[DoubleApos $foreign_url]' +and entry_date = '$query_date' +order by local_url"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
      • from $local_url : $click_count\n" +} + +ns_write " +
      + +[ad_admin_footer] +" Index: web/openacs/www/admin/click/one-local-one-day.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/click/one-local-one-day.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/click/one-local-one-day.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,37 @@ +# one-local-one-day.tcl,v 3.0 2000/02/06 03:14:48 ron Exp +set_the_usual_form_variables + +# local_url, query_date + +ReturnHeaders + +ns_write "[ad_admin_header "$query_date : from $local_url"] + +

      from $local_url +

      + +[ad_admin_context_bar [list "report.tcl" "Clickthroughs"] [list "all-from-local.tcl?[export_url_vars local_url]" "From One Local URL"] "Just $query_date"] + +
      + +
        + +" +set db [ns_db gethandle] + +set selection [ns_db select $db "select foreign_url, click_count +from clickthrough_log +where local_url = '[DoubleApos $local_url]' +and entry_date = '$query_date' +order by foreign_url"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
      • to $foreign_url : $click_count\n" +} + +ns_write " +
      + +[ad_admin_footer] +" Index: web/openacs/www/admin/click/one-url-pair.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/click/one-url-pair.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/click/one-url-pair.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,65 @@ +# one-url-pair.tcl,v 3.0 2000/02/06 03:14:49 ron Exp +set_the_usual_form_variables + +# local_url, foreign_url + +ReturnHeaders + +ns_write "[ad_admin_header "$local_url -> $foreign_url"] + +

      + + +$local_url + + + -> + + +$foreign_url + +

      + +[ad_admin_context_bar [list "report.tcl" "Clickthroughs"] "One URL Pair"] + + +
      + +
        + +" +set db [ns_db gethandle] + +set selection [ns_db select $db "select entry_date, click_count +from clickthrough_log +where local_url = '$QQlocal_url' +and foreign_url = '$QQforeign_url' +order by entry_date desc"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
      • $entry_date : $click_count\n" +} + +ns_write " +
      + +

      Still not satisfied?

      + +[ad_system_name] adminstration can build you a report of + + + +[ad_admin_footer] +" + + Index: web/openacs/www/admin/click/report.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/click/report.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/click/report.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,37 @@ +# report.tcl,v 3.0 2000/02/06 03:14:50 ron Exp +# this really should be index.tcl but sadly due to legacy links (dating +# back to 1996 or so), it has to be "report.tcl" + +ReturnHeaders + +ns_write "[ad_admin_header "Clickthroughs from [ad_system_name]"] + +

      Clickthroughs for [ad_system_name]

      + +[ad_admin_context_bar "Clickthroughs"] + +
      + + + +

      Expensive Queries (may take a long time)

      + + + +To learn how to augment HTML pages to take advantage of clickthrough +logging, read the documentation at /doc/clickthrough.html. + +[ad_admin_footer] +" Index: web/openacs/www/admin/comments/by-page.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/comments/by-page.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/comments/by-page.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,67 @@ +# by-page.tcl,v 3.0 2000/02/06 03:14:51 ron Exp +set_the_usual_form_variables 0 + +# optional: show_page_title_p, only_unanswered_questions_p + +if { [info exists only_unanswered_questions_p] && $only_unanswered_questions_p } { + set title "Pages raising questions" + set and_clause "\nand comment_type = 'unanswered_question'" + set order_by "n_comments desc, url_stub" + set link_suffix "#unanswered_question" + if { [info exists show_page_title_p] && $show_page_title_p } { + set options "hide page title | all types of comments" + } else { + set options "show page title | all types of comments" + } +} else { + set title "Comments by page" + set and_clause "" + set order_by "url_stub" + set link_suffix "" + if { [info exists show_page_title_p] && $show_page_title_p } { + set options "hide page title | just unanswered questions" + } else { + set options "show page title | just unanswered questions" + } +} + +ReturnHeaders + +ns_write "[ad_admin_header $title] + +

      $title

      + +[ad_admin_context_bar [list "index.tcl" "Comments"] "By Page"] + +
      + +$options + +
        +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select static_pages.page_id, page_title, url_stub, count(user_id) as n_comments +from static_pages, comments_not_deleted comments +where static_pages.page_id = comments.page_id $and_clause +group by static_pages.page_id, page_title, url_stub +order by $order_by"] + +set items "" +while {[ns_db getrow $db $selection]} { + set_variables_after_query + + append items "
      • $url_stub ($n_comments)\n" + if { [info exists show_page_title_p] && $show_page_title_p && ![empty_string_p $page_title]} { + append items "-- $page_title\n" + } +} + +ns_write $items + +ns_write " +
      + +[ad_admin_footer] +" Index: web/openacs/www/admin/comments/by-user.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/comments/by-user.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/comments/by-user.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,39 @@ +# by-user.tcl,v 3.0 2000/02/06 03:14:52 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Comments by user"] + +

      Comments by user

      + +[ad_admin_context_bar [list "index.tcl" "Comments"] "By Page"] + +
      + +
        +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select comments.user_id, first_names, last_name, count(comments.page_id) as n_comments, +sum(case when comments.deleted_p = 't' then 1 else 0 end) as n_deleted +from comments, users +where comments.user_id = users.user_id +group by comments.user_id, first_names, last_name +order by n_comments desc, upper(last_name), upper(first_names)"] + + +set items "" +while {[ns_db getrow $db $selection]} { + set_variables_after_query + append items "
      • $first_names $last_name ($n_comments" + if { $n_deleted > 0 } { + append items "; $n_deleted deleted" + } + append items ")\n" +} + +ns_write "$items +
      + +[ad_admin_footer] +" Index: web/openacs/www/admin/comments/comment-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/comments/comment-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/comments/comment-edit.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,81 @@ +# comment-edit.tcl,v 3.0 2000/02/06 03:14:53 ron Exp +# return 1 if you want to send the author email + +# if the author is not listed for a page, it is assumed +# to be the comments_system_owner + +# send_author_message_p +# return 1 if the author should recieve mail +# The author is assumed to be the comments_system_owner +# if there is none listed +# (this really should be handled with parameters.ini) + +proc send_author_message_p { comment_type } { + switch $comment_type { + "unanswered_question" { return 1 } + "alternative_perspective" { return 1 } + "rating" { return 1 } + default { return 0 } + } +} + +set_the_usual_form_variables + +# page_id, message, comment_type, comment_id +# maybe rating, maybe html_p + + +set db [ns_db gethandle] + +if [catch { ns_ora clob_dml $db "update comments set message = empty_clob(), rating='[export_var rating]', posting_time = SYSDATE, html_p='[export_var html_p]' where comment_id = $comment_id returning message into :1" "$message"} errmsg] { + + # there was some other error with the comment update + + ad_return_complaint "Error in updating comment" " +There was an error in updating your comment in the database. +Here is what the database returned: +

      +

      +$errmsg
+
      + + +Don't quit your browser. The database may just be busy. +You might be able to resubmit your posting five or ten minutes from now." + +} + +# page information +# if there is no title, we use the url stub +# if there is no author, we use the system administrator + +set selection [ns_db 1row $db " +select + case when page_title is null then url_stub else page_title end as page_title, + url_stub, email +from static_pages, users +where static_pages.original_author = users.user_id (+) +and page_id = $page_id +union +select + case when page_title is null then url_stub else page_title end as page_title, + url_stub, '[ad_system_owner]' as email +from static_pages +where not exists (select * from users + where static_pages.original_author = users.user_id) +and page_id = $page_id +"] + +set_variables_after_query + +ns_return 200 text/html "[ad_admin_header "Comment modified"] + +

      Comment modified

      + +
      +Comment of $page_title is modified. + +[ad_admin_footer]" + + + Index: web/openacs/www/admin/comments/delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/comments/delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/comments/delete-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,51 @@ +# delete-2.tcl,v 3.0 2000/02/06 03:14:54 ron Exp +set_the_usual_form_variables + +# comment_id, page_id +# maybe user_charge + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select url_stub,coalesce(page_title, url_stub) as page_title +from static_pages +where static_pages.page_id = $page_id"] + +set_variables_after_query + + +ns_db dml $db "update comments set deleted_p = 't' where comment_id=$comment_id" + +ReturnHeaders +ns_write "[ad_admin_header "Comment Deleted"] + +

      Comment Deleted

      + +
      + +" + +if { [info exists user_charge] && ![empty_string_p $user_charge] } { + if { [info exists charge_comment] && ![empty_string_p $charge_comment] } { + # insert separately typed comment + set user_charge [mv_user_charge_replace_comment $user_charge $charge_comment] + } + ns_write "

      ... adding a user charge: +

      +[mv_describe_user_charge $user_charge] +
      +... " + mv_charge_user $db $user_charge + ns_write "Done." +} + +ns_write " + +

      +Go to $page_title +

      +[ad_admin_footer] +" + + + + Index: web/openacs/www/admin/comments/delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/comments/delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/comments/delete.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,76 @@ +# delete.tcl,v 3.0 2000/02/06 03:14:55 ron Exp +set admin_id [ad_verify_and_get_user_id] + +ad_maybe_redirect_for_registration + +set_the_usual_form_variables + +# comment_id, page_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select static_pages.url_stub, coalesce(page_title, url_stub) as page_title +from static_pages +where page_id = $page_id"] +set_variables_after_query + +set selection [ns_db 1row $db "select message, html_p, user_id +from comments +where comment_id = $comment_id"] +set_variables_after_query + +if [mv_enabled_p] { + set mistake_wad [mv_create_user_charge $user_id $admin_id "comment_dupe" $comment_id [mv_rate CommentDupeRate]] + set spam_wad [mv_create_user_charge $user_id $admin_id "comment_spam" $comment_id [mv_rate CommentSpamRate]] + set options [list [list "" "Don't charge user"] [list $mistake_wad "Mistake of some kind, e.g., duplicate posting"] [list $spam_wad "Spam or other serious policy violation"]] + set member_value_section "

      Charge this user for his sins?

      + +
      +
      +Charge Comment: +
      +
      +
      " +} else { + set member_value_section "" +} + + +ReturnHeaders + +ns_write "[ad_admin_header "Verify comment deletion on $page_title" ] + +

      Verify comment deletion

      + +on $page_title +
      + +Are you sure that you want to delete this comment on $url_stub ($page_title)? +

      + +

      +[util_maybe_convert_to_html $message $html_p] +
      + +
      +[export_form_vars comment_id page_id] + +
      + +
      + +

      + +$member_value_section + +

      + + +[ad_admin_footer] +" Index: web/openacs/www/admin/comments/find.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/comments/find.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/comments/find.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,88 @@ +# find.tcl,v 3.0 2000/02/06 03:14:56 ron Exp +# find.tcl +# +# by philg@mit.edu on July 18, 1999 +# +# improved on January 21, 2000 to quote the string, display the whole comment +# +# a system for an administrator to find an exact string match in a comment +# + +set_the_usual_form_variables + +# query_string + +# the query string might contain HTML so let's quote it + +set safely_printable_query_string [philg_quote_double_quotes $query_string] + +ReturnHeaders + +ns_write "[ad_admin_header "Comments matching \"$safely_printable_query_string\""] + +

      Comments matching \"$safely_printable_query_string\"

      + +[ad_admin_context_bar [list "index.tcl" "Comments"] "Search Results"] + +
      + +
        + +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select comments.comment_id, comments.message, comments.html_p, comments.rating, comments.comment_type, posting_time, comments.originating_ip, users.user_id, first_names || ' ' || last_name as name, comments.page_id, sp.url_stub, sp.page_title +from static_pages sp, comments_not_deleted comments, users +where sp.page_id = comments.page_id +and users.user_id = comments.user_id +and (dbms_lob.instr(comments.message,'$QQquery_string') > 0 + or + upper(last_name) like upper('%$QQquery_string%') + or + upper(first_names) like upper('%$QQquery_string%')) +order by comment_type, posting_time desc"] + +set items "" +set last_comment_type "" + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + if { $last_comment_type != $comment_type } { + append items "

        $comment_type

        " + set last_comment_type $comment_type + } + append items "
      • [util_AnsiDatetoPrettyDate $posting_time]: " + if { ![empty_string_p $rating] } { + append items "$rating -- " + } + append items "[util_maybe_convert_to_html $message $html_p] +
        +-- $name +from $originating_ip +on $url_stub" + if ![empty_string_p $page_title] { + append items " ($page_title) " + } + append items "    edit     delete +
        +
        +" + +} + +if ![empty_string_p $items] { + ns_write $items +} else { + ns_write "No comments found" +} + +ns_write " +
      + +Due to the brain-damaged nature of Oracle's CLOB datatype, this search +is case-sensitive when searching through the bodies of comments (i.e., +a query for \"greyhound\" won't match \"Greyhound\"). + +[ad_admin_footer] +" Index: web/openacs/www/admin/comments/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/comments/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/comments/index.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,71 @@ +# index.tcl,v 3.0 2000/02/06 03:14:57 ron Exp +ReturnHeaders + +set day_list {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21} + +ns_write "[ad_admin_header "Comments on Static Pages"] + +

      Comments

      + +[ad_admin_context_bar "Comments"] + +
      + +
        +
      • +last + days +
        +
      • by page +
      • by user +
      • all +

        + +

        +
      • Search for substring: +
        • + +
      + +" + +set db [ns_db gethandle] + +# -- comment_type is generally one of the following: +# -- alternative_perspective +# -- private_message_to_page_authors +# -- rating +# -- unanswered_question + +set selection [ns_db 1row $db "select + count(*) as n_total, + sum(case when comment_type='alternative_perspective' then 1 else 0 end) as n_alternative_perspectives, + sum(case when comment_type='rating' then 1 else 0 end) as n_ratings, + sum(case when comment_type='unanswered_question' then 1 else 0 end) as n_unanswered_questions, + sum(case when comment_type='private_message_to_page_authors' then 1 else 0 end) as n_private_messages +from comments"] +set_variables_after_query + +ns_write " +

      Statistics

      + +
        +
      • private messages: $n_private_messages +
      • unanswered questions: $n_unanswered_questions +
      • ratings: $n_ratings +
      • alternative perspectives: $n_alternative_perspectives + + +

        +

      • total: $n_total + +
      + +Note that these are only comments on static .html pages. If +you want to view comments on other commentable items, e.g., news or calendar postings, visit +the general comments admin pages. + +[ad_admin_footer] +" Index: web/openacs/www/admin/comments/persistent-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/comments/persistent-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/comments/persistent-edit-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,101 @@ +# persistent-edit-2.tcl,v 3.0 2000/02/06 03:14:58 ron Exp +set_form_variables + +# comment_id, page_id, submit +# maybe message, comment_type, html_p + + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select static_pages.url_stub, nvl(page_title, url_stub) as page_title +from static_pages +where page_id = $page_id"] +set_variables_after_query + + +ReturnHeaders + +if { [regexp -nocase "delete" $submit] } { + #user wants to delete the comment + + set selection [ns_db 1row $db "select message, html_p from comments where comment_id = $comment_id"] + set_variables_after_query + + ns_write "[ad_admin_header "Verify comment deletion on $page_title" ] + +

      Verify comment deletion

      + +on $page_title +
      + +You have asked to delete the following comment on the page $page_title. +

      + +

      +[util_maybe_convert_to_html $message $html_p] +
      + +
      +[export_form_vars comment_id page_id] +
      + +
      +
      " + +} else { + + # user wants to edit the comment + # check for bad input + if { (![info exists message] || [empty_string_p $message]) && [regexp -nocase "delete" $submit] } { + ad_return_complaint 1 "
    • please type a comment!" + return + } + + if { [info exists html_p] && $html_p == "t" } { + set pretty_message $message + } else { + set pretty_message [util_convert_plaintext_to_html $message] + } + + ns_write "[ad_admin_header "Verify comment on $page_title" ] + +

      Verify comment

      + +on $page_title +
      + +The following is your comment as it would appear on the page $page_title. +If it looks incorrect, please use the back button on your browser to return and +correct it. Otherwise, press \"Proceed\". +

      + +

      +$pretty_message +
      " + + + if { [info exists html_p] && $html_p == "t" } { + ns_write "

      +Note: if the comment has lost all of its paragraph breaks then you +probably should have selected \"Plain Text\" rather than HTML. Use +your browser's Back button to return to the submission form. +" + } else { + ns_write "

      +Note: if the comment has a bunch of visible HTML tags then you probably +should have selected \"HTML\" rather than \"Plain Text\". Use your +browser's Back button to return to the submission form. " + } + + ns_write " +

      +[export_form_vars message html_p page_id comment_id] + +
      + +
      +
      " +} + +ns_write "[ad_admin_footer]" + Index: web/openacs/www/admin/comments/persistent-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/comments/persistent-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/comments/persistent-edit.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,41 @@ +# persistent-edit.tcl,v 3.0 2000/02/06 03:14:59 ron Exp +set_form_variables + +# comment_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select comments.comment_id, comments.page_id, comments.message, static_pages.url_stub, coalesce(page_title, url_stub) as page_title, html_p +from comments, static_pages +where comments.page_id = static_pages.page_id +and comment_id = $comment_id"] + +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "Edit comment on $page_title" ] + +

      Edit comment

      + +on $page_title +
      + +
      +[export_form_vars page_id comment_id] + +Edit your comment or alternative perspective.
      +
      +
      +Text above is + +

      +

      + + +
      +
      +[ad_admin_footer] +" Index: web/openacs/www/admin/comments/recent.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/comments/recent.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/comments/recent.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,76 @@ +# recent.tcl,v 3.0 2000/02/06 03:15:00 ron Exp +set_the_usual_form_variables + +# num_days (could be "all") + +if { $num_days == "all" } { + set title "All comments" + set subtitle "" + set posting_time_clause "" +} else { + set title "Recent comments" + set subtitle "added over the past $num_days day(s)" + set posting_time_clause "\nand posting_time > (sysdate() - $num_days)::datetime" +} + +ReturnHeaders + +ns_write "[ad_admin_header $title] + +

      Comments

      + +$subtitle + +

      + +[ad_admin_context_bar [list "index.tcl" "Comments"] "Listing"] + +

      + +
        +" + +set db [ns_db gethandle] + + +set selection [ns_db select $db "select comments.comment_id, substr(comments.message,1, 750) as message_intro, comments.rating, comments.comment_type, posting_time, comments.originating_ip, users.user_id, first_names || ' ' || last_name as name, comments.page_id, sp.url_stub, sp.page_title, client_file_name, html_p, file_type, original_width, original_height, caption +from static_pages sp, comments_not_deleted comments, users +where sp.page_id = comments.page_id $posting_time_clause +and users.user_id = comments.user_id +order by comment_type, posting_time desc"] + +set items "" +set last_comment_type "" + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + if { $last_comment_type != $comment_type } { + append items "

        $comment_type

        " + set last_comment_type $comment_type + } + append items "
      • [util_AnsiDatetoPrettyDate $posting_time]: " + if { ![empty_string_p $rating] } { + append items "$rating -- " + } + append items "[format_static_comment $comment_id $client_file_name $file_type $original_width $original_height $caption "$message_intro ..." $html_p] +
        +-- $name +from $originating_ip +on $url_stub" + if ![empty_string_p $page_title] { + append items " ($page_title) " + } + append items "    edit     delete +
        +
        +" + +} + +ns_write $items + +ns_write " +
      + +[ad_admin_footer] +" Index: web/openacs/www/admin/content-sections/add-link-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/content-sections/add-link-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/content-sections/add-link-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,31 @@ +# add-link-2.tcl,v 3.0 2000/02/06 03:15:02 ron Exp +# File: /admin/content-sections/add-link-2.tcl +# Date: 29/12/99 +# Contact: ahmeds@mit.edu +# Purpose: Content Section add link target page +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# from_section_id, to_section_id, section_link_id + +ad_scope_error_check + +set db [ns_db gethandle] +ad_scope_authorize $db $scope admin group_admin none +ns_db dml $db " +insert into content_section_links +(section_link_id, from_section_id, to_section_id) +select $section_link_id, $from_section_id, $to_section_id +from dual +where not exists (select 1 + from content_section_links + where section_link_id = $section_link_id ) +" + +ns_returnredirect link.tcl?[export_url_scope_vars] + Index: web/openacs/www/admin/content-sections/add-link.help =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/content-sections/add-link.help,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/content-sections/add-link.help 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,16 @@ +<%= [ad_header "Help for Edit Display Settings"] %> + +

      Help

      + +for the Section Navigation page + +
      +
      +

      +You can use the links on this page to add section navigation links. +Just click on one of the sections names listed under " Add Link to" to add a link from the originally chosen content section. +

      +

      + + +<%= [ad_footer] %> Index: web/openacs/www/admin/content-sections/add-link.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/content-sections/add-link.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/content-sections/add-link.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,155 @@ +# add-link.tcl,v 3.1 2000/03/11 03:14:05 michael Exp +# File: /admin/content-sections/add-link.tcl +# Date: 29/12/99 +# Contact: ahmeds@mit.edu +# Purpose: Content Section add link page +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +ReturnHeaders + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# from_section_id + +ad_scope_error_check + +set db [ns_db gethandle] +ad_scope_authorize $db $scope admin group_admin none + + +set from_section_key [database_to_tcl_string $db " + select section_key from content_sections + where section_id = $from_section_id"] + +set page_title "Add link from $from_section_key" + +set html " +[ad_scope_admin_header $page_title $db ] +[ad_scope_admin_page_title $page_title $db] + +[ad_scope_admin_context_bar [list "index.tcl?[export_url_scope_vars]" "Content Sections"] [list "link.tcl?[export_url_scope_vars]" "Link Sections"] $page_title] + +
      + +[help_upper_right_menu] + +
      +" + + + +# show existing links +set selection [ns_db select $db " +select to_section_id , + content_section_id_to_key(to_section_id) as to_section_key +from content_section_links +where from_section_id=$from_section_id +and enabled_section_p(from_section_id)='t' +and enabled_section_p(to_section_id)='t' +order by to_section_key +"] + + +set link_counter 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append old_links " + + $to_section_key + + " + + incr link_counter +} + +if { $link_counter > 0 } { + append html " +

      $from_section_key

      +

      Current Links

      +
        + + $old_links +
        +
      +
      + " +} else { + append html " +

      $from_section_key

      + " +} + +set section_link_id [database_to_tcl_string $db "select section_link_id_sequence.nextval from dual"] + +# show all linking possibilities (all content sections for +# which links from from_section_key don't already exist) +set selection [ns_db select $db " +select section_id, section_id as to_section_id , section_key as link_section_key +from content_sections +where group_id=$group_id +and section_id not in ( select to_section_id + from content_section_links + where from_section_id=$from_section_id + and enabled_section_p(from_section_id)='t' + and enabled_section_p(to_section_id)='t') +and enabled_p='t' +and ( not (section_type = 'admin')) +and not (section_id = $from_section_id) +order by section_key +"] + + +set add_link_counter 0 + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + set to_section_key $link_section_key + append add_links " + + $link_section_key +
      + " + incr add_link_counter +} + +if { $add_link_counter > 0 } { + append html " +

      Add Link to

      +
        + $add_links +
      + " +} else { + append html " +
        + No link additions possible +
      + " + +} + + +ns_db releasehandle $db + +ns_write " +
      +$html +
      +[ad_scope_admin_footer] +" + + + + + + + + + + + Index: web/openacs/www/admin/content-sections/content-section-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/content-sections/content-section-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/content-sections/content-section-add-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,157 @@ +# content-section-add-2.tcl,v 3.0 2000/02/06 03:15:05 ron Exp +# File: /admin/content-sections/content-section-add-2.tcl +# Date: 22/12/99 +# Contact: tarik@arsdigita.com +# Purpose: adding a content section +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# section_id, section_key, section_type, section_pretty_name, section_url_stub, sort_key, requires_registration_p, intro_blurb, help_blurb +# maybe section_type (section_type is provided for static and custom sections only, for system and admin sections we have to figure out +# the section_type using module_key and quering acs_modules table) +# maybe module_key (if section is system or admin section we expect the module_key) + +validate_integer section_id $section_id +validate_integer sort_key $sort_key + +ad_scope_error_check + +set db [ns_db gethandle] +ad_scope_authorize $db $scope admin group_admin none + +# let's figure out the section_type using module_key for system and admin sections +if { [info exists module_key] } { + set section_type [database_to_tcl_string $db "select module_type from acs_modules where module_key='[DoubleApos $module_key]'"] +} + +set exception_count 0 +set exception_text "" + +# we were directed to return an error for section_key +if {![info exists section_key] || [empty_string_p $section_key]} { + incr exception_count + append exception_text "
    • You did not enter a value for section_key.
      " +} + +# we were directed to return an error for section_pretty_name +if {![info exists section_pretty_name] || [empty_string_p $section_pretty_name]} { + incr exception_count + append exception_text "
    • You did not enter a value for section_pretty_name.
      " +} + +# we were directed to return an error for empty section_url_stub when section_type=static +if { ([string compare $section_type static]==0) && (![info exists section_url_stub] || [empty_string_p $section_url_stub])} { + incr exception_count + append exception_text "
    • You did not enter a value for section_url_stub. + Section URL stub must be specifed for the static sections.
      " +} + +# if registration_enabled_p and visibility are not provided (in the case of module, then set them to default values) +if { ![info exists requires_registration_p] || [empty_string_p $requires_registration_p]} { + set requires_registration_p f + set QQrequires_registration_p f +} + +if { ![info exists visibility] || [empty_string_p $visibility] } { + set visibility public + set QQvisibility public +} + +if {[string length $intro_blurb] > 4000} { + incr exception_count + append exception_text "
    • \"intro_blurb\" is too long\n" +} + +if {[string length $help_blurb] > 4000} { + incr exception_count + append exception_text "
    • \"help_blurb\" is too long\n" +} + +if {$exception_count > 0} { + ad_scope_return_complaint $exception_count $exception_text $db + return +} + +# So the input is good -- +# Now we'll do the insertion in the content_sections table. + + +if { $section_type=="admin" || $section_type=="system" } { + set type_cols "section_type, module_key" + set type_vals "'[DoubleApos $section_type]', '[DoubleApos $module_key]'" +} + +if { $section_type=="custom" } { + set type_cols "section_type" + set type_vals "'[DoubleApos $section_type]'" +} + +if { $section_type=="static" } { + set type_cols "section_type, section_url_stub" + set type_vals "'[DoubleApos $section_type]', '$QQsection_url_stub'" +} + +if [catch { + ns_db dml $db " + insert into content_sections + (section_id, section_key, section_pretty_name, [ad_scope_cols_sql], $type_cols, + sort_key, requires_registration_p, visibility, intro_blurb, help_blurb) + values + ($section_id, '$QQsection_key', '$QQsection_pretty_name', [ad_scope_vals_sql], $type_vals, + $sort_key, '$QQrequires_registration_p', '$QQvisibility', '$QQintro_blurb', '$QQhelp_blurb')" +} errmsg] { + # Oracle choked on the insert + + # detect double click + set selection [ns_db 0or1row $db " + select section_id + from content_sections + where section_id=$section_id"] + if { ![empty_string_p $selection] } { + # it's a double click, so just redirct the user to the index page + set_variables_after_query + ns_returnredirect index.tcl?[export_url_scope_vars] + return + } + + set selection [ns_db 0or1row $db " + select section_pretty_name + from content_sections + where [ad_scope_sql] and section_key='[DoubleApos $section_key]'"] + + if { ![empty_string_p $selection] } { + # user supplied name, which violates section_key unique constraint + set_variables_after_query + incr exception_count + append exception_text "
    • Section key $section_key is already used by section $section_pretty_name. + Please go back and choose different section key." + ad_scope_return_complaint $exception_count $exception_text $db + return + } + + ad_scope_return_error "Error in insert" "We were unable to do your insert in the database. + Here is the error that was returned: +

      +

      + 
      +    $errmsg
+
      +
      " $db + return +} + +ns_returnredirect "index.tcl?[export_url_scope_vars]" + + + + + + + + + Index: web/openacs/www/admin/content-sections/content-section-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/content-sections/content-section-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/content-sections/content-section-add.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,145 @@ +# content-section-add.tcl,v 3.0 2000/02/06 03:15:07 ron Exp +# File: /admin/content-sections/content-section-add.tcl +# Date: 22/12/99 +# Contact: tarik@arsdigita.com +# Purpose: adding a content section +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) + +ad_scope_error_check + +set db [ns_db gethandle] +ad_scope_authorize $db $scope admin group_admin none + + +if { ![info exists type] } { + set type section +} + +set section_id [database_to_tcl_string $db "select content_section_id_sequence.nextval from dual"] + +ReturnHeaders + +switch $type { + module { + set page_title "Add Module" + } + static { + set page_title "Add Static Section" + } + custom { + set page_title "Add Custom Section" + } +} + +ns_write " +[ad_scope_admin_header $page_title $db] +[ad_scope_admin_page_title $page_title $db] +[ad_scope_admin_context_bar [list "index.tcl?[export_url_scope_vars]" "Content Sections"] $page_title] +
      +" + +append html " +
      +[export_form_scope_vars section_id] + + + + + + + +" + +if { [string compare $type static]==0 } { + set section_type static + append html " + [export_form_scope_vars section_type ] + " +} +if { [string compare $type custom]==0 } { + set section_type custom + append html " + [export_form_scope_vars section_type] + " +} + +if { [string compare $type static]==0 } { + append html " + + + " +} + + + +if { $type=="module"} { + + set selection [ns_db select $db " + select module_key, pretty_name + from acs_modules + where supports_scoping_p='t' + and module_key not in (select module_key + from content_sections + where [ad_scope_sql] + and (section_type='system' or section_type='admin')) + "] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + lappend name_list $pretty_name + lappend key_list $module_key + } + + append html " + + + " +} + +append html " + + +" + +if { [string compare $type custom]==0 || [string compare $type static]==0 } { + # visibility and registration enforcment apply only to the static and custom sections + append html " + + + + + + " +} + +append html " + + + + + + +
      Section key
      Section pretty name
      Section url stub
      Module[ns_htmlselect -labels $name_list module_key $key_list]
      Sort key
      Requires registration?[ns_htmlselect -labels {Yes No} requires_registration_p {t f} f]
      Visible to everybody?[ns_htmlselect -labels {Yes No} visibility {public private} public]
      Introduction blurb
      Help blurb
      + +

      +

      + +
      +
      +

      +" + +ns_write " +$html +[ad_scope_admin_footer] +" + + Index: web/openacs/www/admin/content-sections/content-section-edit-1.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/content-sections/content-section-edit-1.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/content-sections/content-section-edit-1.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,129 @@ +# content-section-edit-1.tcl,v 3.0 2000/02/06 03:15:08 ron Exp +# File: /admin/content-sections/content-section-edit-1.tcl +# Date: 22/12/99 +# Contact: tarik@arsdigita.com +# Purpose: editing a content section +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# section_key + +ad_scope_error_check + +set db [ns_db gethandle] +ad_scope_authorize $db $scope admin group_admin none + +if {[catch {set selection [ns_db 1row $db " + select section_key, section_pretty_name, section_type, section_url_stub, sort_key, + requires_registration_p, visibility, intro_blurb, help_blurb, module_key + from content_sections + where [ad_scope_sql] and section_key='$QQsection_key'"]} errmsg]} { + ad_scope_return_error "Error in finding the data" "We encountered an error in querying the database for your object. +Here is the error that was returned: +

      +

      +
      +$errmsg
+
      +
      " $db + return +} + + +set_variables_after_query + +# now we have the values from the database. + +switch $section_type { + admin {set type_name Module} + system {set type_name Module} + custom {set type_name "Custom Section"} + static {set type_name "Static Section"} +} + +ReturnHeaders + +set page_title "Edit $type_name $section_pretty_name" +ns_write " +[ad_scope_admin_header $page_title $db] +[ad_scope_admin_page_title $page_title $db] +[ad_scope_admin_context_bar [list "index.tcl?[export_url_scope_vars]" "Content Sections"] [list "content-section-edit.tcl?[export_url_scope_vars section_key]" "Property"] "Edit" ] +
      +" + +append html " + +" + +if { ([string compare $section_type admin]==0) || ([string compare $section_type system]==0) } { + append html " + + " +} + +append html " + +[export_form_scope_vars section_key section_type] + + + + + + +" + +if { [string compare $section_type static]==0 } { + append html " + + + " +} + +append html " + + +" + +if { [string compare $section_type static]==0 || [string compare $section_type custom]==0 } { + append html " + + + + + + " +} + +append html " + + + + + + +
      Module + [database_to_tcl_string $db "select pretty_name from acs_modules where module_key='[DoubleApos $module_key]'"]
      Section key
      Section pretty name
      Section url stub
      Sort key
      Requires registration?[ns_htmlselect -labels {Yes No} requires_registration_p {t f} $requires_registration_p]
      Visible to everybody?[ns_htmlselect -labels {Yes No} visibility {public private} $visibility]
      Introduction blurb
      Help blurb
      +

      +

      + +
      + +

      +" + +ns_write " +$html +[ad_scope_admin_footer] +" + + + + + + Index: web/openacs/www/admin/content-sections/content-section-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/content-sections/content-section-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/content-sections/content-section-edit-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,129 @@ +# content-section-edit-2.tcl,v 3.0 2000/02/06 03:15:10 ron Exp +# File: /admin/content-sections/content-section-edit-2.tcl +# Date: 22/12/99 +# Contact: tarik@arsdigita.com +# Purpose: editing a content section +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# section_key, section_pretty_name, section_type, maybe section_url_stub, maybe module_key, +# sort_key, enabled_p, static_p, requires_registration_p, intro_blurb, help_blurb + +validate_integer sort_key $sort_key + +ad_scope_error_check + +set db [ns_db gethandle] +ad_scope_authorize $db $scope admin group_admin none + +set exception_count 0 +set exception_text "" + +# we were directed to return an error for section_key +if {![info exists section_key] ||[empty_string_p $section_key]} { + incr exception_count + append exception_text "

    • You did not enter a value for section_key.
      " +} + +# we were directed to return an error for section_pretty_name +if {![info exists section_pretty_name] ||[empty_string_p $section_pretty_name]} { + incr exception_count + append exception_text "
    • You did not enter a value for section_pretty_name.
      " +} + +# we were directed to return an error for empty section_url_stub when section_type=static +if { ([string compare $section_type static]==0) && (![info exists section_url_stub] || [empty_string_p $section_url_stub])} { + incr exception_count + append exception_text "
    • You did not enter a value for section_url_stub. + Section URL stub must be specifed for the static sections.
      " +} + +# if registration_enabled_p and visibility are not provided (in the case of module, then set them to default values) +if { ![info exists requires_registration_p] || [empty_string_p $requires_registration_p]} { + set requires_registration_p f +} + +if { ![info exists visibility] || [empty_string_p $visibility] } { + set visibility public +} + +if {[string length $intro_blurb] > 4000} { + incr exception_count + append exception_text "
    • \"intro_blurb\" is too long\n" +} + +if {[string length $help_blurb] > 4000} { + incr exception_count + append exception_text "
    • \"help_blurb\" is too long\n" +} + +if {$exception_count > 0} { + ad_scope_return_complaint $exception_count $exception_text $db + return +} + +if { $section_type=="static" } { + set url_stub_sql "section_url_stub = '$QQsection_url_stub'," +} else { + set url_stub_sql "" +} + +# So the input is good -- +# Now we'll do the update of the content_sections table. + +if [catch { + ns_db dml $db " + update content_sections + set section_key = '$QQnew_section_key', + section_pretty_name = '$QQsection_pretty_name', + $url_stub_sql + sort_key = $sort_key, + requires_registration_p = '[DoubleApos $requires_registration_p]', + visibility= '[DoubleApos $visibility]', + intro_blurb = '$QQintro_blurb', + help_blurb = '$QQhelp_blurb' + where [ad_scope_sql] + and section_key = '$QQsection_key' + " +} errmsg] { + + # Oracle choked on the update + + if { [string compare $section_key $new_section_key]!=0 } { + set selection [ns_db 0or1row $db " + select section_pretty_name + from content_sections + where [ad_scope_sql] + and section_key='$QQnew_section_key'"] + + if { ![empty_string_p $selection] } { + # user supplied name, which violates section_key unique constraint + set_variables_after_query + incr exception_count + append exception_text "
    • Section key $section_key is already used by section $section_pretty_name. + Please go back and choose different section key." + ad_scope_return_complaint $exception_count $exception_text $db + return + } + } + + ad_scope_return_error "Error in update" \ + " + We were unable to do your update in the database. Here is the error that was returned: +

      +

      + 
      +    $errmsg
+
      +
      " $db + return +} + +ns_returnredirect index.tcl?[export_url_scope_vars] + + Index: web/openacs/www/admin/content-sections/content-section-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/content-sections/content-section-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/content-sections/content-section-edit.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,165 @@ +# content-section-edit.tcl,v 3.0 2000/02/06 03:15:11 ron Exp +# File: /admin/content-sections/content-section-edit.tcl +# Date: 22/12/99 +# Contact: tarik@arsdigita.com +# Purpose: editing a content section +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +#note that user_id is the user_id of the user who owns this module (when scope=user) +# section_key + +ad_scope_error_check + +set db [ns_db gethandle] +ad_scope_authorize $db $scope admin group_admin none + +if {[catch {set selection [ns_db 1row $db " + select section_key, section_pretty_name, section_type, section_url_stub, sort_key, + requires_registration_p, visibility, intro_blurb, help_blurb, module_key , + case when enabled_p='t' then 1 else 0 end as enabled_p + from content_sections + where [ad_scope_sql] and section_key='$QQsection_key'"]} errmsg]} { + ad_scope_return_error "Error in finding the data" "We encountered an error in querying the database for your object. +Here is the error that was returned: +

      +

      +
      +$errmsg
+
      +
      " $db + return +} + + +set_variables_after_query + +# now we have the values from the database. + +switch $section_type { + admin {set type_name Module} + system {set type_name Module} + custom {set type_name "Custom Section"} + static {set type_name "Static Section"} +} + +ReturnHeaders + +set page_title "Properties of $type_name $section_pretty_name" +ns_write " +[ad_scope_admin_header $page_title $db] +[ad_scope_admin_page_title $page_title $db] +[ad_scope_admin_context_bar [list "index.tcl?[export_url_scope_vars]" "Content Sections"] "Properties"] +
      +" + +lappend section_options_list " +edit" + +switch $scope { + public { + lappend section_options_list " + [ad_decode $enabled_p 1 disable enable] + " + } + group { + # if scope is group, let's see what is the level of module administration allowed by + # system administrator for this group. + set group_module_administration [database_to_tcl_string $db " + select group_module_administration + from user_group_types + where group_type=user_group_group_type($group_id)"] + + if { $group_module_administration!="none" } { + lappend section_options_list " + [ad_decode $enabled_p 1 disable enable] + " + } + + if { $group_module_administration=="full" } { + lappend section_options_list " + remove module + " + } + } +} + +append html " +([join $section_options_list " | "]) +

      + +" + +if { ([string compare $section_type admin]==0) || ([string compare $section_type system]==0) } { + append html " + + " +} + + +append html " + + + + + +" + +if { [string compare $section_type static]==0 } { + append html " + + + " +} + +append html " + + + +" + +if { [string compare $section_type static]==0 || [string compare $section_type custom]==0 } { + append html " + + + + + + " +} + +append html " + + + + + + + + + + +
      Module + [database_to_tcl_string $db "select pretty_name from acs_modules where module_key='[DoubleApos $module_key]'"]
      Section key$section_key
      Section pretty name$section_pretty_name
      Section url stub$section_url_stub
      Sort key[ad_decode $sort_key "" none $sort_key]
      Requires registration?[ad_decode $requires_registration_p f No Yes]
      Visible to everybody?$visibility
      Introduction blurb[ad_decode $intro_blurb "" none [ns_quotehtml $intro_blurb]]
      Help blurb[ad_decode $help_blurb "" none [ns_quotehtml $help_blurb]]
      +

      +" + +ns_write " +

      +$html +
      +[ad_scope_admin_footer] +" + + + + + + + Index: web/openacs/www/admin/content-sections/content-section-view.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/content-sections/content-section-view.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/content-sections/content-section-view.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,85 @@ +# content-section-view.tcl,v 3.0 2000/02/06 03:15:12 ron Exp +# File: /admin/content-sections/content-section-view.tcl +# Date: 22/12/99 +# Contact: tarik@arsdigita.com +# Purpose: shows the properties of the content section +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_the_usual_form_variables +# section_key + +if { ![info exist scope] } { + set scope public +} + +set db [ns_db gethandle] +set selection [ns_db 1row $db " +select section_pretty_name, type, section_url_stub, requires_registration_p, + decode(sort_key, NULL, 'N/A', sort_key) as sort_key, + decode(intro_blurb, NULL, 'N/A', intro_blurb) as intro_blurb, + decode(help_blurb, NULL, 'N/A', help_blurb) as help_blurb +from content_sections_temp +where [ad_scope_sql] and section_key='[DoubleApos $section_key]'"] + +set_variables_after_query + +ReturnHeaders + +ns_write " +[ad_admin_header "View the entry for $section_pretty_name"] + +

      View the entry for $section_pretty_name

      + +[ad_admin_context_bar [list "index.tcl" "Content sections"] "View a content section"] + +
      +" + +append html " +
      + + + + + + + + + + + + +" + +if { [string compare $type static]==0 } { + append html " + + + " +} + +append html " + + + + + + + + + +
      Section key[ad_space 2] $section_key
      Section pretty name[ad_space 2] $section_pretty_name
      Type[ad_space 2] $type
      Requires Registration[ad_space 2] [ad_decode $requires_registration_p 1 Yes No]
      Section url stub[ad_space 2] $section_url_stub
      Sort key[ad_space 2] $sort_key
      Introduction blurb[ad_space 2] $intro_blurb
      Help blurb[ad_space 2] $help_blurb
      + +

      +" + +ns_write " +$html +[ad_admin_footer] +" Index: web/openacs/www/admin/content-sections/delete-link.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/content-sections/delete-link.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/content-sections/delete-link.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,27 @@ +# delete-link.tcl,v 3.0 2000/02/06 03:15:13 ron Exp +# File: /admin/content-sections/delete-link.tcl +# Date: 29/12/99 +# Contact: ahmeds@mit.edu +# Purpose: Content Section delete link target page +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# from_section_id, to_section_id + +ad_scope_error_check + +set db [ns_db gethandle] +ad_scope_authorize $db $scope admin group_admin none + +ns_db dml $db " +delete from content_section_links +where from_section_id= $from_section_id +and to_section_id= $to_section_id" + +ns_returnredirect link.tcl?[export_url_scope_vars] + Index: web/openacs/www/admin/content-sections/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/content-sections/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/content-sections/index.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,302 @@ +# index.tcl,v 3.0 2000/02/06 03:15:14 ron Exp +# File: /admin/content-sections/index.tcl +# Date: 22/12/99 +# Contact: tarik@arsdigita.com +# Purpose: Content Section administration main page +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) + +ad_scope_error_check + +set db [ns_db gethandle] + +ad_scope_authorize $db $scope admin group_admin none + +ReturnHeaders + +set page_title "Content Sections" + +ns_write " +[ad_scope_admin_header $page_title $db ] +[ad_scope_admin_page_title $page_title $db ] +[ad_scope_admin_context_bar $page_title ] +

      +" + +if { $scope=="group" } { + # if scope is group, let's see what is the level of module administration allowed by + # system administrator for this group. + + set group_module_administration [database_to_tcl_string $db " + select group_module_administration + from user_group_types + where group_type=user_group_group_type($group_id)"] + + # let's see if custom section module is installed + + set selection [ns_db 0or1row $db " + select 1 from content_sections + where scope='group' and group_id=$group_id and module_key='custom-sections'"] + set custom_sections_p [ad_decode $selection "" 0 1] + + # let's get the group public url + set group_public_url [ns_set get $group_vars_set group_public_url] +} + +set sql_query " +select section_key, section_pretty_name, section_type, module_key, + section_url_stub, case when enabled_p='t' then 1 else 0 end as enabled_p +from content_sections +where [ad_scope_sql] +order by enabled_p desc, sort_key asc" + + +set selection [ns_db select $db $sql_query] + +set system_section_counter 0 +set enabled_system_section_counter 0 +set disabled_system_section_counter 0 +set custom_section_counter 0 +set enabled_custom_section_counter 0 +set disabled_custom_section_counter 0 +set static_section_counter 0 +set enabled_static_section_counter 0 +set disabled_static_section_counter 0 + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + if { $section_type=="system" || $section_type=="admin" } { + + # for now, we only support system and admin sections for scope group + if { $scope=="group" && $group_module_administration!="none" } { + + set system_sections_html " +
    • $section_pretty_name + [ad_space 1](properties" + # notice that in special case of custom-section module, there are no public pages, so we will not + # offer view link + if { $section_type=="system" && $module_key!="custom-sections" && $enabled_p} { + append system_sections_html " | + view) + " + } else { + append system_sections_html ")" + } + + # if groups have full module administration, we can allow them to completely remove the module + if { $group_module_administration=="full" } { + + } + + if { $enabled_p } { + append enabled_system_sections_html $system_sections_html + incr enabled_system_section_counter + } else { + append disabled_system_sections_html $system_sections_html + incr disabled_system_section_counter + } + incr system_section_counter + + } + } + + if { [string compare $section_type custom]==0 } { + + # for now, we only support custom sections for the scope group + if { $scope=="group" && $custom_sections_p } { + + set custom_sections_html " +
    • $section_pretty_name + [ad_space 1](properties + " + + if { $enabled_p } { + append custom_sections_html " | + view) + " + append enabled_custom_sections_html $custom_sections_html + incr enabled_custom_section_counter + } else { + append custom_sections_html ")" + append disabled_custom_sections_html $custom_sections_html + incr disabled_custom_section_counter + } + + incr custom_section_counter + } + } + + if { [string compare $section_type static]==0 } { + + set static_sections_html " +
    • $section_pretty_name + [ad_space 1](properties + " + if { $enabled_p } { + switch $scope { + public { + append static_sections_html " | + view) + " + } + group { + append static_sections_html " | + view) + " + } + } + append enabled_static_sections_html $static_sections_html + incr enabled_static_section_counter + } else { + append static_sections_html ")" + append disabled_static_sections_html $static_sections_html + incr disabled_static_section_counter + } + + + incr static_section_counter + } +} + +if { $system_section_counter>0 } { + append html " +

      Modules

      +

      + " +} + +if { $enabled_system_section_counter>0 } { + append html " + enabled

      +

        + $enabled_system_sections_html +
      +

      + " +} + +if { $disabled_system_section_counter>0 } { + append html " + disabled

      +

        + $disabled_system_sections_html +
      +

      + " +} + +if { $custom_section_counter>0 } { + append html " +

      Custom Sections

      +

      + " +} +if { $enabled_custom_section_counter>0 } { + append html " + enabled

      +

        + $enabled_custom_sections_html +
      +

      + " +} + +if { $disabled_custom_section_counter>0 } { + append html " + disabled

      +

        + $disabled_custom_sections_html +
      +

      + " +} + +if { $static_section_counter>0 } { + append html " +

      Static Sections

      +

      + " +} +if { $enabled_static_section_counter>0 } { + append html " + enabled

      +

        + $enabled_static_sections_html +
      +

      + " +} + +if { $disabled_static_section_counter>0 } { + append html " + disabled

      +

        + $disabled_static_sections_html +
      +

      + " +} +if { [expr $system_section_counter + $custom_section_counter + $static_section_counter] == 0 } { + append html "There are no Content Sections in the database right now.

      " +} + + + +# for now, we only support system and admin sections for scope group +if { $scope=="group" && $group_module_administration=="full" } { + + # let's see if there are any modules to be associated with this group + set selection [ns_db 0or1row $db " + select 1 from dual + where exists (select 1 + from acs_modules + where supports_scoping_p='t' + and module_key not in (select module_key + from content_sections + where [ad_scope_sql] + and (section_type='system' or section_type='admin')))"] + + set module_available_p [ad_decode $selection "" 0 1] + + if { $module_available_p } { + append html " +

      +

    • Add Module
      + " + } +} + + +# for now, linking sections, system and custom sections are supported only for the group scope +if { $scope=="group" } { + append html " +
    • Section Navigation
      + " +} + +append html " +
    • Add Static Section
      +" +# for now, we only support custom sections for the scope group +if { $scope=="group" && $custom_sections_p } { + append html " +
    • Add Custom Section

      + " +} + +ns_write " +

      +$html +
      +[ad_scope_admin_footer] +" + + + Index: web/openacs/www/admin/content-sections/link.help =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/content-sections/link.help,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/content-sections/link.help 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,19 @@ +<%= [ad_header "Help for Edit Display Settings"] %> + +

      Help

      + +for the Section Navigation page + +
      +
      +

      +You can use the links on this page to add/remove section navigation links. +The names on the left are content_section names from which links to other sections are defined. Existing links from a section arev listed right below the section name. +

        +
      • To add new links to other sections, click on the "add link". +
      • To remove existing links, click on the "remove link" right next to it. +
      +

      +

      + +<%= [ad_footer] %> Index: web/openacs/www/admin/content-sections/link.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/content-sections/link.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/content-sections/link.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,127 @@ +# link.tcl,v 3.0 2000/02/06 03:15:15 ron Exp +# File: /admin/content-sections/id/index.tcl +# Date: 29/12/99 +# Contact: ahmeds@mit.edu +# Purpose: Content Section link main page +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +ReturnHeaders + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) + +ad_scope_error_check + +set db [ns_db gethandle] + +ad_scope_authorize $db $scope admin group_admin none + +set page_title "Section Navigation" + +ns_write " +[ad_scope_admin_header $page_title $db ] +[ad_scope_admin_page_title $page_title $db] + +[ad_scope_admin_context_bar [list "index.tcl?[export_url_scope_vars]" "Content Sections"] $page_title] + +
      +[help_upper_right_menu] +
      +" + +# show all the links in the tree structure +# notice the use of outer join to show content +# sections for which no from_to links were defined + +set selection [ns_db select $db " +select cs.section_id as from_section_id, + csl.to_section_id as to_section_id, + content_section_id_to_key(cs.section_id) as from_section_key, + content_section_id_to_key(to_section_id) as to_section_key +from content_sections cs, content_section_links csl +where [ad_scope_sql cs] +and cs.section_id= csl.from_section_id(+) +and cs.enabled_p='t' +and (((csl.from_section_id is null) and (csl.to_section_id is null)) or + ((enabled_section_p(csl.from_section_id)='t') and enabled_section_p(csl.to_section_id)='t')) +and ( not ((cs.section_type = 'admin') or (cs.section_type = 'static')) ) +order by from_section_key, to_section_key +"] + + + +set link_counter 0 +set last_from_section_id 0 + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + if { $from_section_id!=$last_from_section_id } { + + if { $link_counter > 0 } { + append links " + + + \[add link\] +



      +
    + " + } + + append links " + $from_section_key +
      + + " + + } + + if { ![empty_string_p $to_section_key] } { + append links " + + + " + } + + incr link_counter + set last_from_section_id $from_section_id +} + +if { $link_counter > 0 } { + append links " +
      + $to_section_key + + delete +
      + + \[add link\] +
      +
    + " + + append html " +
      + $links +
    + " +} else { + append html " + No content sections defined in the database. + " +} + + +ns_db releasehandle $db + +ns_write " +
    +$html +
    +[ad_scope_admin_footer] +" + Index: web/openacs/www/admin/content-sections/remove-module-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/content-sections/remove-module-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/content-sections/remove-module-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,56 @@ +# remove-module-2.tcl,v 3.0 2000/02/06 03:15:17 ron Exp +# File: /admin/content-sections/module-remove-2.tcl +# Date: 01/01/2000 +# Contact: tarik@arsdigita.com +# Purpose: removes association between module and the group + +set_the_usual_form_variables +# group_id, section_key, confirm_button + +ad_scope_error_check +set db [ns_db gethandle] +ad_scope_authorize $db $scope none group_admin none + +if { [string compare $confirm_button yes]!=0 } { + ns_returnredirect "content-section-edit.tcl?[export_url_scope_vars section_key]" + return +} + +ns_db dml $db "begin transaction" + +ns_db dml $db " +delete from content_section_links +where from_section_id=(select section_id + from content_sections + where scope='group' + and group_id=$group_id + and section_key='$QQsection_key') +or to_section_id=(select section_id + from content_sections + where scope='group' + and group_id=$group_id + and section_key='$QQsection_key') +" + +ns_db dml $db " +delete from content_files +where section_id=(select section_id + from content_sections + where scope='group' + and group_id=$group_id + and section_key='$QQsection_key') +" + +ns_db dml $db " +delete from content_sections +where scope='group' +and group_id=$group_id +and section_key='$QQsection_key' +" + +ns_db dml $db "end transaction" + +ns_returnredirect index.tcl + + + Index: web/openacs/www/admin/content-sections/remove-module.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/content-sections/remove-module.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/content-sections/remove-module.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,37 @@ +# remove-module.tcl,v 3.0 2000/02/06 03:15:18 ron Exp +# File: /admin/content-sections/module-remove.tcl +# Date: 01/01/2000 +# Contact: tarik@arsdigita.com +# Purpose: confirmation page for removing association between module and the group + +set_the_usual_form_variables +# scope, group_id, section_key + +ad_scope_error_check +set db [ns_db gethandle] +ad_scope_authorize $db $scope none group_admin none + +set group_name [ns_set get $group_vars_set group_name] + +set page_title "Remove Module" + +ns_return 200 text/html " +[ad_scope_admin_header $page_title $db] +[ad_scope_admin_page_title $page_title $db] +[ad_scope_admin_context_bar [list "index.tcl?[export_url_scope_vars]" "Content Sections"] $page_title] +
    +
    +

    Confirm Module Removal

    + +
    Warning: +Removing module implies that users of $group_name will not be able to use this module. +
    +
    Are you sure you want to proceed ? +
    +[export_form_scope_vars section_key] + +[ad_space 5] +
    +
    +[ad_scope_footer] +" Index: web/openacs/www/admin/content-sections/toggle-enabled-p.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/content-sections/toggle-enabled-p.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/content-sections/toggle-enabled-p.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,27 @@ +# toggle-enabled-p.tcl,v 3.0 2000/02/06 03:15:20 ron Exp +# File: /admin/content-sections/toggle-enabled-p.tcl +# Date: 22/12/99 +# Contact: tarik@arsdigita.com +# Purpose: toggles enabled_p column of the section +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_the_usual_form_variables 0 +# section_key + +ad_scope_error_check + +set db [ns_db gethandle] +ad_scope_authorize $db $scope admin group_admin none + +ns_db dml $db " +update content_sections +set enabled_p = logical_negation(enabled_p) where +[ad_scope_sql] and section_key = '$QQsection_key' +" + +ns_returnredirect index.tcl + Index: web/openacs/www/admin/content-sections/toggle-requires-registration-p.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/content-sections/toggle-requires-registration-p.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/content-sections/toggle-requires-registration-p.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,32 @@ +# toggle-requires-registration-p.tcl,v 3.0 2000/02/06 03:15:22 ron Exp +# File: /admin/content-sections/toggle-requires_registration_p.tcl +# Date: 22/12/99 +# Contact: tarik@arsdigita.com +# Purpose: toggles enabled_p column of the section +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_the_usual_form_variables 0 +# section_key + +ad_scope_error_check + +set db [ns_db gethandle] +ad_scope_authorize $db $scope admin group_admin none + +ns_db dml $db " +update content_sections +set requires_registration_p = logical_negation(requires_registration_p) +where [ad_scope_sql] and section_key = '$QQsection_key' +" + +ns_returnredirect index.tcl + + + + + + Index: web/openacs/www/admin/content-tagging/add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/content-tagging/add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/content-tagging/add.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,33 @@ +# add.tcl,v 3.0 2000/02/06 03:15:23 ron Exp +# adds a bunch of words to the database (or updates their tags if they +# are already in Oracle) + +set_the_usual_form_variables + +# words, tag + +set db [ns_db gethandle] + +set user_id [ad_get_user_id] + +# bash the words down to lowercase +set words [ns_striphtml [string tolower $words ]] +# turn them into a standard Tcl list +regsub -all {[^A-z ]+} $words " " words + +foreach word $words { + # insert if not present + ns_db dml $db "insert into content_tags +(word, tag, creation_user, creation_date) +select '$word', $tag, $user_id, sysdate() +from dual +where 0 = (select count(*) from content_tags where word = '$word')" + set n_rows_inserted [ns_pg ntuples $db] + if { $n_rows_inserted == 0 } { + # it was already in the db + ns_db dml $db "update content_tags set tag = $tag where word = '$word'" + } +} + +ns_returnredirect "index.tcl" + Index: web/openacs/www/admin/content-tagging/all.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/content-tagging/all.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/content-tagging/all.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,43 @@ +# all.tcl,v 3.0 2000/02/06 03:15:24 ron Exp +ReturnHeaders + +set title "Naughty Dictionary" + +ns_write "[ad_admin_header $title] + +

    $title

    + +[ad_admin_context_bar [list "index.tcl" "Content Tagging Package"] $title] + +
    + +
    + +" +set db [ns_db gethandle] +set pretty_tag(0) "Rated G" +set pretty_tag(1) "Rated PG" +set pretty_tag(3) "Rated R" +set pretty_tag(7) "Rated X" + + +set sql "select word, tag from content_tags order by tag, word" +set selection [ns_db select $db $sql] + +set last_tag "" +while {[ns_db getrow $db $selection]} { + set_variables_after_query + if {[string compare $tag $last_tag]} { + ns_write "$pretty_tag($tag)
      " + set last_tag $tag + } + ns_write "
    • $word" +} + +ns_write "
    + +[ad_admin_footer] +" + + + Index: web/openacs/www/admin/content-tagging/by-user.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/content-tagging/by-user.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/content-tagging/by-user.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,48 @@ +# by-user.tcl,v 3.0 2000/02/06 03:15:26 ron Exp +ReturnHeaders + +set title "Naughtiness by user" + +ns_write "[ad_admin_header $title] + +

    $title

    + +[ad_admin_context_bar [list "index.tcl" "Content Tagging Package"] $title] + +
    + +
      +" + +set db [ns_db gethandle] + +set selection [ns_db select $db " +select offensive_text, naughty_events.table_name, the_key, creation_date, user_id, first_names, last_name, url_stub +from naughty_events, users, naughty_table_to_url_map +where creation_user = users.user_id +and naughty_events.table_name=naughty_table_to_url_map.table_name +union +select offensive_text, naughty_events.table_name, the_key, creation_date, user_id, first_names, last_name, NULL as url_stub +from naughty_events, users +where creation_user = users.user_id +and 0=(select count(*) from naughty_table_to_url_map where table_name= naughty_events.table_name) +order by creation_date, upper(last_name), upper(first_names)"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
    • $first_names $last_name \n +
      $offensive_text
      " + + if {[empty_string_p $url_stub]} { + ns_write "Date: [util_AnsiDatetoPrettyDate $creation_date]

      " + } else { + ns_write "Date: [util_AnsiDatetoPrettyDate $creation_date]
      + Edit

      " + } +} + +ns_write " +

    + +[ad_admin_footer] +" Index: web/openacs/www/admin/content-tagging/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/content-tagging/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/content-tagging/index.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,66 @@ +# index.tcl,v 3.0 2000/02/06 03:15:27 ron Exp +ReturnHeaders + +set title "Content Tagging" + +ns_write "[ad_admin_header "$title Package"] + +

    $title Package

    + +[ad_admin_context_bar "$title Package"] + +
    + +Documentation: /doc/content-tagging.html + +

    Dictionary

    + +
    + +
    +Enter words(s) to add to the tagged dictionary:
    + +
    + + +
    +
    + +

    Historical Naughtiness

    + + + +

    Test

    + + +
    +Phrase to test: +
    + +
    + + + +
    + +
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/content-tagging/lookup.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/content-tagging/lookup.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/content-tagging/lookup.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,67 @@ +# lookup.tcl,v 3.0 2000/02/06 03:15:28 ron Exp +set_the_usual_form_variables + +# word + +if {[empty_string_p $word]} { + ns_returnredirect "all.tcl" + return +} + +ReturnHeaders + +set title "Tagged Word Results" + +ns_write "[ad_admin_header $title] + +

    $title

    + +[ad_admin_context_bar [list "index.tcl" "Naughty Package"] $title] + +
    + +
    +[export_entire_form] +" + +set db [ns_db gethandle] +set pretty_tag(0) "Rated G" +set pretty_tag(1) "Rated PG" +set pretty_tag(3) "Rated R" +set pretty_tag(7) "Rated X" + +set sql "select tag from content_tags where word='$QQword'" +set selection [ns_db 0or1row $db $sql] + +if {![empty_string_p $selection]} { + set_variables_after_query + ns_write "\n" +} else { + set tag 0 + ns_write "$word is not yet rated

    + \n" +} + +ns_write "

    Give a rating to $word:

      " + +foreach potential_tag {0 1 3 7} { + if { $tag != $potential_tag } { + ns_write "
    • $pretty_tag($potential_tag)" + } else { + ns_write "
    • $pretty_tag($potential_tag)" + } +} +ns_write " +

      (A \"G\" rating will remove the word from the database) +

    +
    + + +
    + +[ad_admin_footer] +" + + + + Index: web/openacs/www/admin/content-tagging/rate.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/content-tagging/rate.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/content-tagging/rate.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,24 @@ +# rate.tcl,v 3.0 2000/02/06 03:15:30 ron Exp +set_the_usual_form_variables + +# word, tag, todo + +set db [ns_db gethandle] + +set user_id [ad_get_user_id] + +if { $todo == "create" } { + ns_db dml $db "insert into content_tags +(word, tag, creation_user, creation_date) +values +('$QQword', $tag,$user_id, sysdate())" +} else { + if { $tag == 0 } { + ns_db dml $db "delete from content_tags where word='$QQword'" + } else { + ns_db dml $db "update content_tags set tag = $tag where word = '$QQword'" + } +} + +ns_returnredirect "index.tcl" + Index: web/openacs/www/admin/content-tagging/test.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/content-tagging/test.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/content-tagging/test.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,55 @@ +# test.tcl,v 3.0 2000/02/06 03:15:31 ron Exp +ad_maybe_redirect_for_registration + +set_the_usual_form_variables + +# testarea, optionally table_name, the_key + +ReturnHeaders + +set title "Testing the Content Tagging Package" + +ns_write "[ad_admin_header $title ] + +

    $title

    + +[ad_admin_context_bar [ list index.tcl "Content Tagging Package"] $title ] + +
    + +" + +if {![info exists the_key]} { + set the_key "" +} +if {![info exists table_name]} { + set table_name "" +} + + +ns_write "Testing...
    $testarea
    +

    Running content_string_ok_for_site_p results in: " + +if {[content_string_ok_for_site_p $testarea $table_name $the_key]} { + ns_write "This site would allow the text." +} else { + ns_write "This site would bounce the text." +} + +set tag [tag_content $testarea] + +ns_write "

    tag_content yields \"$tag\" +

    +" +set deleted "apply_content_mask yields \"\[apply_content_mask $tag\]\" +

    +" + +ns_write " +bowdlerize_text yields: +

    [bowdlerize_text $testarea]
    +" + +ns_write "[ad_admin_footer]" + + Index: web/openacs/www/admin/contest/add-custom-column-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/contest/add-custom-column-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/contest/add-custom-column-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,87 @@ +# add-custom-column-2.tcl,v 3.2 2000/03/12 20:01:18 markd Exp +set_the_usual_form_variables + +# domain_id, column_actual_name, column_type +# column_extra_sql + +validate_integer domain_id $domain_id + +set db [ns_db gethandle] + +set domain [database_to_tcl_string $db "select domain from contest_domains where domain_id = $domain_id"] + +set table_name [database_to_tcl_string $db "select entrants_table_name from contest_domains where domain_id = $domain_id"] + +if { $column_type == "boolean" } { + set real_column_type "char(1) default 't' check ($column_actual_name in ('t', 'f'))" +} else { + set real_column_type $column_type +} + +# PG 7.0 weird +# set alter_sql "alter table $table_name add ($column_actual_name $real_column_type $column_extra_sql)" +set alter_sql "alter table $table_name add $column_actual_name $real_column_type $column_extra_sql" + +set insert_sql "insert into contest_extra_columns (domain_id, column_pretty_name, column_actual_name, column_type, column_extra_sql) +values +( $domain_id, '$QQcolumn_pretty_name', '$QQcolumn_actual_name','$QQcolumn_type', [ns_dbquotevalue $column_extra_sql text])" + +if [catch { ns_db dml $db $alter_sql + ns_db dml $db $insert_sql } errmsg] { + # an error + ad_return_error "Database Error" "Error while trying to customize $domain. + +Tried the following SQL: + +
    +
    +$alter_sql
+$insert_sql    
+
    +
    + +and got back the following: + +
    +
    +$errmsg
+
    +
    + +[ad_contest_admin_footer]" } else { + # database stuff went OK + ns_return 200 text/html "[ad_admin_header "Column Added"] + +

    Column Added

    + +[ad_admin_context_bar [list "index.tcl" "Contests"] [list "manage-domain.tcl?[export_url_vars domain_id]" "Manage Contest"] "Customize"] + +
    + +The following action has been taken: + +
      + +
    • a column called \"$column_actual_name\" has been added to the +table $table_name in the database. The sql was +

      + +

      +$alter_sql +
      + + +

      + +

    • a row has been added to the SQL table contest_extra_columns +reflecting that + +
        + +
      • this column has the pretty name (for user interface) of \"$column_pretty_name\" + +
      +
    + +[ad_contest_admin_footer] +"} Index: web/openacs/www/admin/contest/add-custom-column.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/contest/add-custom-column.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/contest/add-custom-column.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,123 @@ +# add-custom-column.tcl,v 3.1 2000/03/10 20:01:58 markd Exp +set_the_usual_form_variables + +# domain_id + +validate_integer domain_id $domain_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select distinct * from contest_domains where domain_id=$domain_id"] +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "Customize $pretty_name"] + +

    Customize $pretty_name

    + +[ad_admin_context_bar [list "index.tcl" "Contests"] [list "manage-domain.tcl?[export_url_vars domain_id]" "Manage Contest"] "Customize"] + + +
    + +Customization is accomplished by adding columns to collect extra +information. + +

    The Default Columns (for all contests)

    + + +
    Pretty NameActual NameTypeExtra SQL +
    Entry Dateentry_datedatenot null +
    User IDuser_idintegernot null +
    + +

    Current Extra Columns

    + +" + +# entry_date and user_id are not null, but they are supplied +# by the system +set not_null_vars [list] + +set selection [ns_db select $db "select * from contest_extra_columns where domain_id = $domain_id"] +set n_rows_found 0 + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + incr n_rows_found + if [regexp -nocase {not null} $column_extra_sql] { + lappend not_null_vars $column_actual_name + } + append table_rows "$column_pretty_name$column_actual_name$column_type$column_extra_sql\n" +} + +if { $n_rows_found == 0 } { + ns_write "No extra columns are currently defined." +} else { + ns_write " +
    Pretty NameActual NameTypeExtra SQL +$table_rows +
    +" +} + +ns_write "

    Define a New Custom Column

    + +
    +[export_form_vars domain_id] + +Column Pretty Name: + +

    + +Column Actual Name: + +

    + +Column Type: + +

    + +If you're a database wizard, you might want to add some +extra SQL, such as \"not null\"
    +Extra SQL: + +

    + +(note that you can only truly add not null columns when the table is +empty, i.e., before anyone has entered the contest) + +

    + + + +

    + +

    Hints for building static .html forms

    + +You must have a hidden variable called \"domain_id\" with \"$domain_id\" as +its value. + +

    + +You don't ever need to have a form input for entry_date or user_id; +these fields are filled in automatically by our entry processing +script. + +

    + +Any field with a \"not null\" constraint must have a value and +therefore must be a form variable. Currently, you have the following +not null columns: $not_null_vars. + + + +[ad_contest_admin_footer] +" Index: web/openacs/www/admin/contest/add-domain-choose-maintainer.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/contest/add-domain-choose-maintainer.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/contest/add-domain-choose-maintainer.adp 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,45 @@ +<%=[ad_admin_header "Choose Maintainer"]%> + +

    Choose Maintainer

    + +<%=[ad_admin_context_bar [list "index.tcl" "Contests"] "Choose Maintainer"]%> + +
    + +Some entry, confirmation, and error pages will need to be signed with +an email address. This should be the name of the person who is the +maintainer of the contest or it might be a role, e.g., "Contest +Master". + +

    + +The maintainer may optionally choose to receive email notifications of +new contest entrants or, perhaps, daily summaries of contest activity. + +

    + +In any case, it needs to be an already-registered user of +this community. + +

    + +Look for a Maintainer by + +

    +
    + + +

    + +Last Name: +

    +or

    +Email Address: +

    +
    + + +
    + +<%=[ad_admin_footer]%> + Index: web/openacs/www/admin/contest/add-domain-one-shot-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/contest/add-domain-one-shot-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/contest/add-domain-one-shot-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,144 @@ +# add-domain-one-shot-2.tcl,v 3.2.2.1 2000/03/17 23:37:04 tzumainn Exp +set_the_usual_form_variables + +# expects domain_id, domain, home_url, pretty_name, maintainer, +# start_date, end_date (magic AOLserver date thingies) + +set exception_text "" +set exception_count 0 + +ns_dbformvalue [ns_conn form] start_date date start_date +ns_dbformvalue [ns_conn form] end_date date end_date +ns_set delkey [ns_conn form] "ColValue.start%5fdate.month" +ns_set delkey [ns_conn form] "ColValue.start%5fdate.year" +ns_set delkey [ns_conn form] "ColValue.start%5fdate.day" +ns_set delkey [ns_conn form] "ColValue.end%5fdate.month" +ns_set delkey [ns_conn form] "ColValue.end%5fdate.year" +ns_set delkey [ns_conn form] "ColValue.end%5fdate.day" +ns_set put [ns_conn form] start_date $start_date +ns_set put [ns_conn form] end_date $end_date + +if { ![info exists domain] || $domain == "" } { + append exception_text "
  • You didn't give us a domain name. This is required." + incr exception_count +} + +if { [info exists domain] && $domain != "" && [regexp {[^a-zA-Z0-9_]} $domain] } { + append exception_text "
  • You can't have spaces, dashes, slashes, quotes, or colons in a domain name. It has to be just alphanumerics and underscores" + incr exception_count +} + +if { ![info exists home_url] || $home_url == "" } { + append exception_text "
  • You didn't enter a contest home URL. It doesn't make any sense to have a contest that isn't associated with any page." + incr exception_count +} + + +if { ![info exists pretty_name] || $pretty_name == "" } { + append exception_text "
  • The pretty name was blank. We need this for the user interface." + incr exception_count +} + +if { ![info exists maintainer] || [empty_string_p $maintainer] } { + append exception_text "
  • We didn't get a maintainer user id. This is probably a bug in our software." + incr exception_count + +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +# no obvious problems with the input + +set db [ns_db gethandle] + +set n_already [database_to_tcl_string $db "select count(*) from contest_domains where domain='$QQdomain'"] + +if { $n_already > 0 } { + # there already is a contest with this ID + set selection [ns_db 1row $db "select distinct * from contest_domains where domain='$QQdomain'"] + set_variables_after_query + ns_return 200 text/html "[ad_admin_header "$domain"] + +

    $domain is already in use

    + +for a contest from $home_url + +
    + +So you should back up and choose another domain for the contest +you have in mind, or if what you really wanted to do is manage +the $pretty_name, then go +for it + + + +[ad_contest_admin_footer] +" + return +} + +# everything was normal + +set entrants_table_name "contest_entrants_$domain" +# add it to the form ns_set +ns_set put [ns_conn form] entrants_table_name $entrants_table_name +set meta_table_insert [util_prepare_insert_no_primary_key $db contest_domains [ns_conn form]] + +set entrants_table_ddl "create table $entrants_table_name ( + entry_date datetime not null, + user_id integer not null references users)" +if [catch { ns_db dml $db $meta_table_insert + ns_db dml $db $entrants_table_ddl } errmsg] { ad_return_error "Error trying to update the database." "Here was the bad news from the database: + +
    +
    +$errmsg
+
    +
    +" } else { + ReturnHeaders + ns_write "[ad_admin_header "$domain added"] + +

    $domain added

    + +[ad_admin_context_bar [list "index.tcl" "Contests"] "New Contest"] + +
    + +In order to make this work for users, what you must do one of the +following: + +
      + +
    • add a link to the generated entry form: + +
      +<a href=\"/contest/entry-form.tcl?[export_url_vars domain_id]\">enter our contest</a> +
      + +

      or

      + +
    • create a static page on the site that contains all the proper +HTML variables. The target for the form should be +/contest/process-entry.tcl. +You will need a hidden variable +
      +<input type=hidden name=domain_id value=\"$domain_id\"> +
      + +

      + +If you want to collect more than just which user entered, e.g., the +answer to a question, you need to use + the management page for this contest. + +

    + +[ad_contest_admin_footer]" + +} Index: web/openacs/www/admin/contest/add-domain-one-shot.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/contest/add-domain-one-shot.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/contest/add-domain-one-shot.adp 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,144 @@ +<% + +set_form_variables + +# user_id_from_search is the one we care about + +set db [ns_db gethandle] +set domain_id [database_to_tcl_string $db "select contest_domain_id_sequence.nextval from dual"] +ns_db releasehandle $db + +%> + +<%=[ad_header "Add New Contest"]%> + +

    Add New Contest

    + +<%=[ad_admin_context_bar [list "index.tcl" "Contests"] "New Contest"]%> + +
    + + +> +<%= [export_form_vars domain_id] %> + +

    About your Contest

    + +We need something to use as a database key. Something reasonably +short and without spaces, but descriptive. E.g., for a contest where +you are giving away tickets to Paris, you could use "ParisTix" or +"Paris_tickets". + +

    + +Your domain name is going to be part of a SQL table definition. That +means that special characters such as "-" are out. Just use +alphanumerics and underscores. Oracle limits table names to 30 +characters and we're already using 17 some to form the entrants table, so +please limit you domain name to no more than 13 characters. + +

    + + +Domain Name: + +

    + +You don't want to show something ugly like "Paris_tickets" to +readers. So please enter a pretty name, e.g., "Tickets to Paris +Contest". + +

    + +Pretty Name: + +

    + +Next, we need to know the part of this service where the contest +starts off (typically one page before the entry form). Presumably +this is on this server and need not include the "http://hostname" + + +

    + +Contest Home URL: + +

    + +<% + +if [ad_parameter SomeAmericanReadersP] { + ns_puts " +Is your contest limited to residents of the United States? + Yes + No +" +} else { + ns_puts "\n" +} +%> + +

    + +If we're going to generate an entry form for you, then you'll want to +explain something about this contest on the top level page, e.g., +stating the conditions under which you are giving out prizes and what +people must do to win. Note that, at least in the United States, it +is very difficult to run games of skill (where you give prizes only to +people who answer correctly). It is much easier legally to run games +of chance (where you give prizes to everyone who enters). An example +would be "Every month, we'll give away a free round-trip ticket to +Paris from any city in the United States.". + +

    + +Explanatory HTML for the entry form:
    + + + +

    + +Note that this is unnecessary if you're going to write your own +entry form from scratch. + +

    Dates

    + +This software will bounce entrants who are too early or too late. You +just have to say when this contest starts and ends. + +

    + +Contest Start Date (optional): <%=[philg_dateentrywidget_default_to_today start_date]%> + +
    +Contest End Date (optional): <%=[philg_dateentrywidget_default_to_today end_date]%> + + +

    Options

    + +You can change these later, so don't agonize too much... + +

    + +Do you want the maintainer to be notified every time a user enters the +contest? + + Yes + No + +

    + +Note: you might set this up to notify you right now, then disable it +once you have a good feel for the volume of entries. + +

    + + +

    + +
    + + + +<%=[ad_contest_admin_footer]%> Index: web/openacs/www/admin/contest/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/contest/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/contest/index.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,66 @@ +# index.tcl,v 3.2 2000/03/10 20:57:32 markd Exp +ReturnHeaders + +ns_write "[ad_admin_header "All [ad_system_name] Contests"] + +

    Contests

    + +[ad_admin_context_bar "Contests"] + + +
    + +

    Active Contests

    +
      +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select domain_id, domain, pretty_name, home_url +from contest_domains +where sysdate() between start_date and end_date +order by upper(pretty_name)"] + +set counter 0 +while {[ns_db getrow $db $selection]} { + set_variables_after_query + incr counter + ns_write "
    • $pretty_name : home URL | generated entry form | +management page" +} + +if { $counter == 0 } { + ns_write "there are no live contests at present" +} + +ns_write " +
    + +

    Inactive Contests

    + +
      +" + +set selection [ns_db select $db "select domain_id, domain, pretty_name, home_url +from contest_domains +where sysdate() not between start_date and end_date +order by upper(pretty_name)"] + +set counter 0 +while {[ns_db getrow $db $selection]} { + set_variables_after_query + incr counter + ns_write "
    • $pretty_name : home URL | generated entry form | +management page" +} + + +ns_write " + +

      +

    • add a contest + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/contest/manage-domain.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/contest/manage-domain.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/contest/manage-domain.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,133 @@ +# manage-domain.tcl,v 3.1.2.1 2000/03/17 23:37:45 tzumainn Exp +set_the_usual_form_variables + +# domain_id + +validate_integer domain_id $domain_id + +set db [ns_db gethandle] + +set update_form_raw "
    +[export_form_vars domain_id] + +
    Contest Pretty Name +
    Home URL +
    Blather
    (arbitrary HTML for the top of the page)    		 +
    Notify maintainer when a user enters this contest? + Yes + No +
    Open only to residents of the United States? + Yes + No +
    -- the fields below only matter for our generated entry form; if you are using a static .html form on your own server then these switches don't change anything -- +
    +

    + +

    +" + +set selection [ns_db 1row $db "select distinct * from contest_domains where domain_id=$domain_id"] + +set_variables_after_query +set final_form [bt_mergepiece $update_form_raw $selection] + +ReturnHeaders + +ns_write "[ad_admin_header "Manage $domain"] + +

    Manage $domain ($pretty_name)

    + +[ad_admin_context_bar [list "index.tcl" "Contests"] "Manage Contest"] + +
    + + + +

    Entrants

    + + + + +

    Pick Winner(s)

    + +
    + +[export_form_vars domain_id] + +How many winners: + +

    + +Start Date: [philg_dateentrywidget_default_to_today from_date] + +

    + +End Date: [philg_dateentrywidget_default_to_today to_date] + +

    + +(note: dates are inclusive, so 1995-11-01 and 1995-11-14 gets all +those who entered between midnight on the 1st of November and until +11:59 pm on the 14th) + +

    + +

    + + + +
    + +
    + +

    Customize Your Contest

    + +You don't have to limit yourself to collecting basic name, address, +and demographic information from each entrant. You can define extra +columns to record whatever information people are willing to give you. + +

    + +Suppose that you're a software publisher. You would probably want to +know what kinds of computer are used by readers of your Web site. You +can start a contest and then customize it to record +\"desktop_operating_system\" along with the standard stuff. If you +let this server generate your entry form, users will be able to type +anything they want into this field. If you run the entry form off +your own server, then you are free to code whatever HTML you like. +You can use an HTML SELECT to limit entrants' choices to Macintosh, +OS/2, Unix, Windows 95, or Windows NT. + +

    + +These data that you collect will be reported along with the standard +columns in all the reports from this site. + +

    + +If you're sold on this approach, then go ahead and start customizing. + +

    Basic Contest Parameters

    + +$final_form + +

    + +[ad_contest_admin_footer] +" + Index: web/openacs/www/admin/contest/pick-winners.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/contest/pick-winners.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/contest/pick-winners.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,70 @@ +# pick-winners.tcl,v 3.1.2.1 2000/03/17 23:46:19 tzumainn Exp +set_the_usual_form_variables + +# domain_id, n_winners, AOLserver crud that adds up to from_date, to_date + +validate_integer domain_id $domain_id + +page_validation { + if {![info exists n_winners] || [empty_string_p $n_winners]} { + error "Number of winners must be specified." + } +} + +ns_dbformvalue [ns_conn form] from_date date from_date +ns_dbformvalue [ns_conn form] to_date date to_date + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select distinct * from contest_domains where domain_id=$domain_id"] +set_variables_after_query + +set where_clause "where ct.entry_date between '$from_date'::datetime and '$to_date 23:59:59'::datetime" + +set n_contestants [database_to_tcl_string $db "select count(user_id) +from $entrants_table_name ct +$where_clause"] + +# seed the random number generator +randomInit [ns_time] + +for {set i 1} {$i <= $n_winners} {incr i} { + # we'll have winner_numbers between 0 and $n_contestants - 1 + lappend winner_numbers [randomRange $n_contestants] +} + +ReturnHeaders + +ns_write "[ad_admin_header "Picking N winners"] + +

    Picking N winners

    + +[ad_admin_context_bar [list "index.tcl" "Contests"] [list "manage-domain.tcl?[export_url_vars domain_id]" "Manage Contest"] "Winners"] + +
    + + +Found $n_contestants. Winners will be $winner_numbers. + + +
      +" + +set selection [ns_db select $db "select distinct user_id +from $entrants_table_name ct +$where_clause"] + +set counter 0 + +while { [ns_db getrow $db $selection] } { + if { [lsearch -exact $winner_numbers $counter] != -1 } { + set_variables_after_query + ns_write "
    • User $user_id\n" + } + incr counter +} + +ns_write "
    + +[ad_contest_admin_footer]" + Index: web/openacs/www/admin/contest/show-one-winner.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/contest/show-one-winner.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/contest/show-one-winner.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,82 @@ +# show-one-winner.tcl,v 3.1 2000/03/10 20:02:03 markd Exp +set_the_usual_form_variables + +# domain_id, user_id + +validate_integer domain_id $domain_id +validate_integer user_id $user_id + +# show the contest manager everything about one user_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select distinct * from contest_domains where domain_id='$QQdomain_id'"] +set_variables_after_query + +set selection [ns_db 1row $db "select first_names, last_name, email from users where user_id = $user_id"] +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "$first_names $last_name entries to $pretty_name"] + +

    One User

    + +[ad_admin_context_bar [list "index.tcl" "Contests"] [list "manage-domain.tcl?[export_url_vars domain_id]" "Manage Contest"] "One User"] + +
    + + + +entries sorted by date + +

    +" + +set extra_column_info [database_to_tcl_list_list $db "select column_pretty_name, column_actual_name, column_type +from contest_extra_columns +where domain_ID = '$QQdomain_id'"] + +# write the table headers + +ns_write " + +\n" +} + +ns_write " +
    Entry Date +" +foreach custom_column_list $extra_column_info { + set column_pretty_name [lindex $custom_column_list 0] + set column_actual_name [lindex $custom_column_list 1] + set column_type [lindex $custom_column_list 2] + ns_write "$column_pretty_name" +} + + +set selection [ns_db select $db "select * +from $entrants_table_name +where user_id = $user_id +order by entry_date desc"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    $entry_date" + # we have to do the custom columns now + foreach custom_column_list $extra_column_info { + set column_pretty_name [lindex $custom_column_list 0] + set column_actual_name [lindex $custom_column_list 1] + set column_type [lindex $custom_column_list 2] + ns_write "[set $column_actual_name]" + } + ns_write "
    + +[ad_contest_admin_footer] +" + + Index: web/openacs/www/admin/contest/update-domain.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/contest/update-domain.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/contest/update-domain.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,62 @@ +# update-domain.tcl,v 3.1 2000/03/10 20:02:03 markd Exp +set_the_usual_form_variables + +# expects domain_id + +validate_integer domain_id $domain_id + +set db [ns_db gethandle] + +set domain [database_to_tcl_string $db "select domain from contest_domains where domain_id=$domain_id"] + +set form [ns_conn form $conn] + +set sql_statement [util_prepare_update $db contest_domains domain_id $domain_id $form] + +if [catch { ns_db dml $db $sql_statement } errmsg] { + # something went a bit wrong + ad_return_error "Update Error" "Error while trying to update $domain. +Tried the following SQL: + +

    +
    +$sql_statement
+
    +
    + +and got back the following: + +
    +
    +$errmsg
+
    +
    +" +return +} + +ns_return 200 text/html "[ad_admin_header "Update of $domain complete"] + +

    Update of $domain Complete

    + +in the contest system + +
    + +Here was the SQL: + +
    +
    +$sql_statement
+
    +
    + +

    + +You probably want to +return to the management page for $domain. + +[ad_contest_admin_footer] +" + + Index: web/openacs/www/admin/contest/view-verbose.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/contest/view-verbose.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/contest/view-verbose.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,94 @@ +# view-verbose.tcl,v 3.1 2000/03/10 20:02:04 markd Exp +set_the_usual_form_variables + +# domain_id, order_by (either "email" or "entry_date") + +validate_integer domain_id $domain_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select distinct * from contest_domains where domain_id=$domain_id"] +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "All Entrants"] + +

    All Entrants

    + +[ad_admin_context_bar [list "index.tcl" "Contests"] [list "manage-domain.tcl?[export_url_vars domain_id]" "Manage Contest"] "View Entrants"] + + +
    + +sorted by $order_by + +

    +" + +set extra_column_info [database_to_tcl_list_list $db "select column_pretty_name, column_actual_name, column_type +from contest_extra_columns +where domain_id = $domain_id"] + +if { $order_by == "email" } { + set order_by_clause "order by upper(u.email)" +} elseif { $order_by == "entry_date" } { + set order_by_clause "order by entry_date desc, upper(u.email)" +} + +set selection [ns_db select $db "select et.*, u.email, u.first_names || ' ' || u.last_name as full_name +from $entrants_table_name et, users u +where et.user_id = u.user_id +$order_by_clause"] + +# write the table headers + +ns_write " + + +
    Name and email +" + +foreach custom_column_list $extra_column_info { + set column_pretty_name [lindex $custom_column_list 0] + set column_actual_name [lindex $custom_column_list 1] + set column_type [lindex $custom_column_list 2] + ns_write "$column_pretty_name" +} + +ns_write " + +
    +" + +set last_entry_date "" +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $entry_date != $last_entry_date && $order_by != "email" } { + ns_write "

    [util_AnsiDatetoPrettyDate $entry_date]

    \n" + set last_entry_date $entry_date + } + ns_write " + + +" + # we have to do the custom columns now + foreach custom_column_list $extra_column_info { + set column_pretty_name [lindex $custom_column_list 0] + set column_actual_name [lindex $custom_column_list 1] + set column_type [lindex $custom_column_list 2] + ns_write " +
    $full_name ($email) +[set $column_actual_name]" + } + ns_write " + +
    " + +} + +ns_write " + +[ad_contest_admin_footer] +" + Index: web/openacs/www/admin/conversion/copy-acs-tables.sql =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/conversion/copy-acs-tables.sql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/conversion/copy-acs-tables.sql 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,392 @@ +-- +-- copy-acs-tables.sql +-- +-- by randyg@arsdigita.com in July 1999 for HP MiniPress +-- commented and edited by philg@mit.edu on October 30, 1999 + +-- warning: this script is not complete; you have to think about which +-- ACS tables and columns you're actually using. Use this script as a model. + +-- assume that the online site has a username of "minipress". + + +insert into users (USER_ID,FIRST_NAMES,LAST_NAME,PRIV_NAME,EMAIL,PRIV_EMAIL,EMAIL_BOUNCING_P,CONVERTED_P,PASSWORD,URL,ON_VACATION_UNTIL,LAST_VISIT,SECOND_TO_LAST_VISIT,N_SESSIONS,REGISTRATION_DATE,REGISTRATION_IP,APPROVING_USER,BANNING_USER,BANNING_NOTE) +(select USER_ID,FIRST_NAMES,LAST_NAME,PRIV_NAME,EMAIL,PRIV_EMAIL,EMAIL_BOUNCING_P,CONVERTED_P,PASSWORD,URL,ON_VACATION_UNTIL,LAST_VISIT,SECOND_TO_LAST_VISIT,N_SESSIONS,REGISTRATION_DATE,REGISTRATION_IP,APPROVING_USER,BANNING_USER,BANNING_NOTE +from minipress.users where user_id > 2); + +- this will need to be modified to not try to +-overwrite existing group types +insert into user_group_types ( +GROUP_TYPE, +PRETTY_NAME, +PRETTY_PLURAL, +APPROVAL_POLICY, +DEFAULT_NEW_MEMBER_POLICY +) (select +GROUP_TYPE, +PRETTY_NAME, +PRETTY_PLURAL, +APPROVAL_POLICY, +DEFAULT_NEW_MEMBER_POLICY +from minipress.user_group_types +where not group_type = 'administration' +); + + +- this will also need to be modified to only import non-common groups +insert into user_groups ( +GROUP_ID, +GROUP_TYPE, +GROUP_NAME, +REGISTRATION_DATE, +CREATION_USER, +CREATION_IP_ADDRESS, +APPROVED_P, +ACTIVE_P, +EXISTENCE_PUBLIC_P, +NEW_MEMBER_POLICY, +EMAIL_ALERT_P, +MULTI_ROLE_P, +GROUP_ADMIN_PERMISSIONS_P) +(select GROUP_ID, +GROUP_TYPE, +GROUP_NAME, +REGISTRATION_DATE, +CREATION_USER, +CREATION_IP_ADDRESS, +APPROVED_P, +ACTIVE_P, +EXISTENCE_PUBLIC_P, +NEW_MEMBER_POLICY, +EMAIL_ALERT_P, +MULTI_ROLE_P, +GROUP_ADMIN_PERMISSIONS_P +from minipress.user_groups +where group_id > 2); + + + +insert into user_group_type_fields ( +GROUP_TYPE, +COLUMN_NAME, +PRETTY_NAME, +COLUMN_TYPE, +COLUMN_ACTUAL_TYPE, +COLUMN_EXTRA +) +( select GROUP_TYPE, +COLUMN_NAME, +PRETTY_NAME, +COLUMN_TYPE, +COLUMN_ACTUAL_TYPE, +COLUMN_EXTRA +from minipress.user_group_type_fields); + + +insert into user_group_map_queue ( +GROUP_ID, +USER_ID, +IP_ADDRESS, +QUEUE_DATE) +(select GROUP_ID, +USER_ID, +IP_ADDRESS, +QUEUE_DATE +from minipress.user_group_map_queue); + + +insert into user_group_roles ( +GROUP_ID, +ROLE, +CREATION_DATE, +CREATION_USER, +CREATION_IP_ADDRESS) +(select GROUP_ID, +ROLE, +CREATION_DATE, +CREATION_USER, +CREATION_IP_ADDRESS +from minipress.user_group_roles); + + +insert into user_group_actions ( +GROUP_ID, +ACTION, +CREATION_DATE, +CREATION_USER, +CREATION_IP_ADDRESS) +(select GROUP_ID, +ACTION, +CREATION_DATE, +CREATION_USER, +CREATION_IP_ADDRESS +from minipress.user_group_actions); + + + +insert into user_group_action_role_map ( +GROUP_ID, +ROLE, +ACTION, +CREATION_DATE, +CREATION_USER, +CREATION_IP_ADDRESS) +(select GROUP_ID, +ROLE, +ACTION, +CREATION_DATE, +CREATION_USER, +CREATION_IP_ADDRESS +from minipress.user_group_action_role_map); + + + + +insert into user_group_map ( +GROUP_ID, +USER_ID, +ROLE, +REGISTRATION_DATE, +MAPPING_USER, +MAPPING_IP_ADDRESS) +(select GROUP_ID, +USER_ID, +ROLE, +REGISTRATION_DATE, +MAPPING_USER, +MAPPING_IP_ADDRESS +from minipress.user_group_map); + + + +insert into administration_info ( +GROUP_ID, +MODULE, +SUBMODULE, +URL) +(select GROUP_ID, +MODULE, +SUBMODULE, +URL +from minipress.administration_info where group_id > 3); + + +--------------------------------- +--- bboard stuff + +insert into bboard_topics ( +TOPIC, +BACKLINK, +BACKLINK_TITLE, +BLATHER, +RESTRICTED_P, +NS_PERM_GROUP, +NS_PERM_GROUP_ADDED_FOR_FORUM, +PRIMARY_MAINTAINER_ID, +SUBJECT_LINE_SUFFIX, +NOTIFY_OF_NEW_POSTINGS_P, +PRE_POST_CAVEAT, +MODERATION_POLICY, +RESTRICT_TO_WORKGROUP_P, +USERS_CAN_INITIATE_THREADS_P, +POLICY_STATEMENT, +PRESENTATION_TYPE, +Q_AND_A_SORT_ORDER, +Q_AND_A_CATEGORIZED_P, +Q_AND_A_NEW_DAYS, +Q_AND_A_SOLICIT_CATEGORY_P, +Q_AND_A_CATS_USER_EXTENSIBLE_P, +Q_AND_A_USE_INTEREST_LEVEL_P, +Q_AND_A_SHOW_CATS_ONLY_P, +CUSTOM_SORT_KEY_P, +CUSTOM_SORT_KEY_NAME, +CUSTOM_SORT_KEY_TYPE, +CUSTOM_SORT_ORDER, +CUSTOM_SORT_NOT_FOUND_TEXT, +CUSTOM_SORT_SOLICIT_P, +CUSTOM_SORT_SOLICIT_PRETTY_P, +CUSTOM_SORT_PRETTY_NAME, +CUSTOM_SORT_PRETTY_EXPLANATION, +CUSTOM_SORT_VALIDATION_CODE, +CATEGORY_CENTRIC_P, +UPLOADS_ANTICIPATED, +ACTIVE_P) +(select TOPIC, +BACKLINK, +BACKLINK_TITLE, +BLATHER, +RESTRICTED_P, +NS_PERM_GROUP, +NS_PERM_GROUP_ADDED_FOR_FORUM, +PRIMARY_MAINTAINER_ID, +SUBJECT_LINE_SUFFIX, +NOTIFY_OF_NEW_POSTINGS_P, +PRE_POST_CAVEAT, +MODERATION_POLICY, +RESTRICT_TO_WORKGROUP_P, +USERS_CAN_INITIATE_THREADS_P, +POLICY_STATEMENT, +PRESENTATION_TYPE, +Q_AND_A_SORT_ORDER, +Q_AND_A_CATEGORIZED_P, +Q_AND_A_NEW_DAYS, +Q_AND_A_SOLICIT_CATEGORY_P, +Q_AND_A_CATS_USER_EXTENSIBLE_P, +Q_AND_A_USE_INTEREST_LEVEL_P, +Q_AND_A_SHOW_CATS_ONLY_P, +CUSTOM_SORT_KEY_P, +CUSTOM_SORT_KEY_NAME, +CUSTOM_SORT_KEY_TYPE, +CUSTOM_SORT_ORDER, +CUSTOM_SORT_NOT_FOUND_TEXT, +CUSTOM_SORT_SOLICIT_P, +CUSTOM_SORT_SOLICIT_PRETTY_P, +CUSTOM_SORT_PRETTY_NAME, +CUSTOM_SORT_PRETTY_EXPLANATION, +CUSTOM_SORT_VALIDATION_CODE, +CATEGORY_CENTRIC_P, +UPLOADS_ANTICIPATED, +ACTIVE_P +from minipress.bboard_topics); + +insert into bboard_authorized_maintainers ( +TOPIC, +USER_ID) +(select topic, user_id from minipress.bboard_authorized_maintainers); + +insert into bboard_workgroup ( +USER_ID, +GROUP_ID, +TOPIC) +(select user_id, group_id, topic from minipress.bboar_workgroup); + + +insert into bboard_q_and_a_categories ( +TOPIC, +CATEGORY +) (select topic, category from minipress.bboard_q_and_a_categories); + +insert into bboard_bozo_patterns ( +TOPIC, +THE_REGEXP, +SCOPE, +MESSAGE_TO_USER, +CREATION_DATE, +CREATION_USER, +CREATION_COMMENT) +(select TOPIC +THE_REGEXP, +SCOPE, +MESSAGE_TO_USER, +CREATION_DATE, +CREATION_USER, +CREATION_COMMENT +from minipress.bboard_bozo_patterns); + + + +insert into bboard ( +MSG_ID, +REFERS_TO, +TOPIC, +CATEGORY, +ORIGINATING_IP, +USER_ID, +ONE_LINE, +MESSAGE, +HTML_P, +NOTIFY, +POSTING_TIME, +EXPIRATION_DAYS, +INTEREST_LEVEL, +SORT_KEY, +CUSTOM_SORT_KEY, +CUSTOM_SORT_KEY_PRETTY, +EPA_REGION, +USPS_ABBREV, +FIPS_COUNTY_CODE, +ZIP_CODE) +(select MSG_ID, +REFERS_TO, +TOPIC, +CATEGORY, +ORIGINATING_IP, +USER_ID, +ONE_LINE, +MESSAGE, +HTML_P, +NOTIFY, +POSTING_TIME, +EXPIRATION_DAYS, +INTEREST_LEVEL, +SORT_KEY, +CUSTOM_SORT_KEY, +CUSTOM_SORT_KEY_PRETTY, +EPA_REGION, +USPS_ABBREV, +FIPS_COUNTY_CODE, +ZIP_CODE +from minipress.bboard + + +insert into msg_id_generator (LAST_MSG_ID) (select last_msg_id from minipress.msg_id_generator); + + + +insert into bboard_email_alerts ( +USER_ID, +TOPIC, +VALID_P, +FREQUENCY, +KEYWORDS) +(select USER_ID, +TOPIC, +VALID_P, +FREQUENCY, +KEYWORDS +from minipress.bboard_email_alerts); + + + +insert into bboard_email_alerts_updates ( +WEEKLY, +WEEKLY_TOTAL, +DAILY, +DAILY_TOTAL, +MONTHU, +MONTHU_TOTAL) +(select WEEKLY, +WEEKLY_TOTAL, +DAILY, +DAILY_TOTAL, +MONTHU, +MONTHU_TOTAL +from minipress.bboard_email_alerts_updates); + +-- you'll have to also copy files around in the file system + +insert into bboard_uploaded_files ( +BBOARD_UPLOAD_ID, +MSG_ID, +FILE_TYPE, +FILE_EXTENSION, +N_BYTES, +CLIENT_FILE, +FILE_STUB, +CAPTION, +THUMBNAIL_STUB, +ORIGINAL_WIDTH, + ORIGINAL_HEIGHT) +(select BBOARD_UPLOAD_ID, +MSG_ID, +FILE_TYPE, +FILE_EXTENSION, +N_BYTES, +CLIENT_FILE, +FILE_STUB, +CAPTION, +THUMBNAIL_STUB, +ORIGINAL_WIDTH, +ORIGINAL_HEIGHT +from minipress.bboard_uploaded_files); + Index: web/openacs/www/admin/conversion/make-acs-dist =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/conversion/make-acs-dist,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/conversion/make-acs-dist 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,98 @@ +#!/usr/local/bin/bash + +# to create a distribution of an ArsDigita Community System, you +# need to cd to your home directory and run +# make-acs-dist /web/yourdomainname + +if [ $# != 1 ]; then + echo "usage: $0 " + exit +fi + +distfile=acs-`/bin/date +%Y%m%d`.tar +distdir=$1 + +if [ ! -d $distdir ]; then + echo "$distdir is not a directory" + exit +fi + +if [ -e acs ]; then + echo "Please remove acs from this directory (or do this somewhere else)" + exit +fi + +/bin/ln -s $distdir acs + +# exclude ~ files and .bak files and Emacs backup files +# exclude everything .ini from parameters except for ad.ini +# (i.e., don't include the publisher's specific config stuff) +# exclude any philg stuff + +/usr/local/bin/tar -c -v -f $distfile \ + --exclude='*~' --exclude='*#' --exclude='*.bak' --exclude='*/core' --exclude='*/.#*' --exclude='*/CVS' \ + --exclude='acs/parameters' \ + --exclude='acs/tcl/photodb.tcl' \ + --exclude='acs/tcl/sql-book-defs.tcl' \ + --exclude='acs/tcl/teaching-defs.tcl' \ + --exclude='acs/www/Architext' \ + --exclude='acs/www/Excite' \ + --exclude='acs/www/WealthClock.html' \ + --exclude='acs/www/acsplans' \ + --exclude='acs/www/alta-vista.html' \ + --exclude='acs/www/bg' \ + --exclude='acs/www/bp' \ + --exclude='acs/www/ca' \ + --exclude='acs/www/cgi-bin' \ + --exclude='acs/www/cr' \ + --exclude='acs/www/diary' \ + --exclude='acs/www/dldf' \ + --exclude='acs/www/dm' \ + --exclude='acs/www/dreamgirl' \ + --exclude='acs/www/global-photonet-specific' \ + --exclude='acs/www/hardware.html' \ + --exclude='acs/www/htbin' \ + --exclude='acs/www/incoming' \ + --exclude='acs/www/index.html' \ + --exclude='acs/www/italy' \ + --exclude='acs/www/large' \ + --exclude='acs/www/materialism' \ + --exclude='acs/www/mjcal' \ + --exclude='acs/www/nz' \ + --exclude='acs/www/outgoing' \ + --exclude='acs/www/philg' \ + --exclude='acs/www/photo' \ + --exclude='acs/www/photodb' \ + --exclude='acs/www/samantha' \ + --exclude='acs/www/scratch' \ + --exclude='acs/www/smyly' \ + --exclude='acs/www/soccer' \ + --exclude='acs/www/sql' \ + --exclude='acs/www/sukuma' \ + --exclude='acs/www/summer94' \ + --exclude='acs/www/sweden' \ + --exclude='acs/www/tcl' \ + --exclude='acs/www/teaching' \ + --exclude='acs/www/thesis' \ + --exclude='acs/www/webtravel' \ + --exclude='acs/www/wtr' \ + --exclude='acs/www/zoo' \ + --exclude='acs/www/philg.css' \ + --exclude='acs/www/doc/social-shopping.html' \ + --exclude='acs/www/doc/sql/photodb.sql' \ + --exclude='acs/www/social-shopping' \ + --exclude='acs/www/admin/social-shopping' \ + acs/readme.txt acs/templates acs/tcl acs/www acs/parameters/ad.ini + +/bin/rm acs + +/usr/local/bin/gzip $distfile + +# Note: if you're releasing this on Homepage into /web/acs, you're not done. +# What you have to do is + +# cd /web +# mv acs archived-servers/acs1999whatever +# /usr/local/bin/tar xvfz /home/philg/scratch/acs-19990208.tar.gz +# cp -rp archived-servers/acs1999whatever/old-versions-of-the-acs-that-suck acs/old-versions-of-the-acs-that-suck +# Index: web/openacs/www/admin/conversion/parameter-differences.pl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/conversion/parameter-differences.pl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/conversion/parameter-differences.pl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,93 @@ +#!/usr/local/bin/perl + +# parameter-differences.pl +# +# by jsc@arsdigita.com in October 1999 +# +# Compares two ArsDigita System "ad.ini" parameter files +# and prints out a human-readable report of differences. +# This is useful during version upgrades of the ACS. + +use strict; + +my $usage = "Usage: $0 \n"; + +if (scalar(@ARGV) != 2) { + die $usage; +} + +my $first_file = $ARGV[0]; +my $second_file = $ARGV[1]; + +if (! -f $first_file || ! -f $second_file) { + die $usage; +} + + +# Basic idea: run through both files, record each parameter in a hash +# table as "section:parameter" (e.g., SystemName under +# [ns/server/yourservername/acs] would be ":SystemName"; Administrator +# under [ns/server/yourservername/acs/portals] would be +# "portals:Administrator"). The two hash tables are unioned together, +# and whatever is in the union and not in each file is reported. + +my %union; +my %f1_params; +my %f2_params; + +%f1_params = read_parameter_file($first_file); +%f2_params = read_parameter_file($second_file); +%union = union_hashes(\%f1_params, \%f2_params); + +print "$first_file:\n"; +report_difference(\%union, \%f1_params); + +print "\n\n$second_file:\n"; +report_difference(\%union, \%f2_params); + +sub read_parameter_file { + my %params; + my ($file_name) = shift; + + my $section; + my $parameter; + + open(F, $file_name) || die $!; + while () { + next if /^\s*$/o; + if (m,^\[ns/server/[^/]+/acs/?([^\]]*),) { + $section = $1; + } elsif (/^\s*;?\s*([A-Za-z0-9]+)=(.*)$/) { + $parameter = $1; + $params{"$section:$parameter"} = 1; + } + } + close F; + return %params; +} + + +# Returns a union of the keys of the two argument hashes. +# The values are unimportant. +sub union_hashes { + my %union; + my $h1_ref = shift; + my $h2_ref = shift; + + foreach my $key (keys(%$h1_ref), keys(%$h2_ref)) { + $union{$key} = 1; + } + return %union; +} + +# Reports keys in first hash argument which are not in the second. +sub report_difference { + my $h1_ref = shift; + my $h2_ref = shift; + + foreach my $key (sort keys %$h1_ref) { + if (!defined($$h2_ref{$key})) { + print "* $key\n"; + } + } +} Index: web/openacs/www/admin/conversion/readme.txt =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/conversion/readme.txt,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/conversion/readme.txt 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,3 @@ +This is for scripts to convert legacy standalone applications to the +community system and also for scripts that may help with version +upgrades of the ACS. Index: web/openacs/www/admin/conversion/sequence-update.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/conversion/sequence-update.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/conversion/sequence-update.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,72 @@ +# sequence-update.tcl,v 3.1 2000/03/10 21:53:55 jkoontz Exp +# +# /admin/conversion/sequence-update.tcl +# +# by randyg@arsdigita.com, July 1999 for the HP MiniPress project +# documented and "improved" by philg@mit.edu on October 30, 1999 +# +# for each sequence in the Oracle database, we query to figure out the maximum +# key that is being used. We then drop and recreate the sequence starting at +# this max value + 1 (or 1 if there aren't any rows yet in the table). +# +# Note that this rude behavior is required by Oracle; you can't ALTER SEQUENCE +# to move to a new next value (at least not in Oracle 8.1.5). + +ReturnHeaders text/plain + +set db [ns_db gethandle] + +# each sublists has sequence name, key name that uses the sequence, table name + +set sequences [list] +lappend sequences [list idea_id_sequence idea_id bannerideas] +lappend sequences [list bboard_upload_id_sequence bboard_upload_id bboard_uploaded_files] +lappend sequences [list calendar_id_sequence calendar_id calendar] +lappend sequences [list chat_room_id_sequence chat_room_id chat_rooms] +lappend sequences [list chat_msg_id_sequence chat_msg_id chat_msgs] +lappend sequences [list classified_ad_id_sequence classified_ad_id classified_ads] +lappend sequences [list user_id_sequence user_id users] +lappend sequences [list category_id_sequence category_id categories] +lappend sequences [list page_id_sequence page_id static_pages] +lappend sequences [list comment_id_sequence comment_id comments] +lappend sequences [list query_sequence query_id queries] +lappend sequences [list incoming_email_queue_sequence id incoming_email_queue] +lappend sequences [list general_comment_id_sequence comment_id general_comments] +lappend sequences [list glassroom_host_id_sequence host_id glassroom_hosts] +lappend sequences [list glassroom_cert_id_sequence cert_id glassroom_certificates] +lappend sequences [list glassroom_module_id_sequence module_id glassroom_modules] +lappend sequences [list glassroom_release_id_sequence release_id glassroom_releases]lappend sequences [list glassroom_logbook_entry_id_seq entry_id glassroom_logbook] +lappend sequences [list intranet_offices_id_seq office_id intranet_offices] +lappend sequences [list intranet_users_id_seq user_id intranet_users] +lappend sequences [list proj_customer_id_seq customer_id proj_customers] +lappend sequences [list proj_projects_id_seq project_id proj_projects] +lappend sequences [list proj_deadline_id_seq deadline_id proj_deadlines] +lappend sequences [list proj_hours_id_seq hours_id proj_hours] +lappend sequences [list intranet_goals_id_seq goal_id intranet_goals] +lappend sequences [list intranet_reviews_id_seq user_id intranet_reviews] +lappend sequences [list users_order_id_sequence order_id users_orders] +lappend sequences [list n_to_n_primary_category_id_seq category_id n_to_n_primary_categories] +lappend sequences [list n_to_n_subcategory_id_seq subcategory_id n_to_n_subcategories] +lappend sequences [list newsgroup_id_sequence newsgroup_id newsgroups] +lappend sequences [list news_item_id_sequence news_item_id news_items] +lappend sequences [list stolen_registry_sequence stolen_id stolen_registry] +lappend sequences [list spam_id_sequence spam_id spam_history] +lappend sequences [list user_group_sequence group_id user_groups] + +foreach sequence_set $sequences { + set sequence_name [lindex $sequence_set 0] + ns_db dml $db "drop sequence $sequence_name" + set column_name [lindex $sequence_set 1] + set table_name [lindex $sequence_set 2] + set maxvalue [database_to_tcl_string $db "select nvl(max($column_name)+1,1) from $table_name"] + ns_db dml $db "create sequence $sequence_name start with $maxvalue" + ns_write "updated $sequence_name new value = $maxvalue\n" +} + + + + + + + + Index: web/openacs/www/admin/conversion/users.pl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/conversion/users.pl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/conversion/users.pl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,103 @@ +#!/usr/local/bin/perl + +# Script to convert users from old photo.net to new ACS. +# we leave this here as an example of how to convert from a +# system that keys by email address to one that keys by user id + +use strict; +use DBI; + +require 'util.pl'; + + +my $dbh = get_dbhandle("philgserver", "theolddbpassword"); +my $db2 = get_dbhandle("photonet", "thedbpassword"); + +my %users = sql_to_hash($db2, "select email, user_id from users"); +my %user_map = sql_to_hash($db2, "select email || name, user_id from user_map"); + + +# my $sql = "select distinct poster_name name, poster_email email from philgserver.neighbor_to_neighbor +# union +# select distinct maintainer_name name, maintainer_email from philgserver.bboard_topics +# union +# select distinct name, email from philgserver.bboard +# union +# select distinct maintainer_name name, maintainer_email email from philgserver.ad_domains +# union +# select distinct name, email from philgserver.stolen_registry +# union +# select distinct name, email from philgserver.comment_comments where realm = 'philg' +# union select distinct name, email from philgserver.comment_ratings where realm = 'philg' +# union select distinct name, email from philgserver.links" +# union select distinct poster_name as name, poster_email as email from philgserver.classified_ads"; +my $sql = "select distinct name, email from philgserver.comment_comments where realm = 'philg'"; + + +my $sth = $dbh->prepare($sql) || die $dbh->errstr; +$sth->execute || die $dbh->errstr; + +my $users_sth = $db2->prepare("insert into users (user_id, first_names, last_name, email, password, converted_p) values (user_id_sequence.nextval, ?, ?, ?, 'none', 't') returning user_id into ?") || die $db2->errstr; + +my $user_map_sth = $db2->prepare("insert into user_map (email, name, user_id) values (?, ?, ?)") || die $db2->errstr; + +while (set_query_variables($sth)) { + no strict 'vars'; + + $canon_email = canonicalize_email($email, $name); + + my ($first_names, $last_name) = parse_name($name); + if (! $first_names) { + $first_names = "--"; + } + if (! $last_name) { + $last_name = "--"; + } + if (! $canon_email) { + $canon_email = "no_email:$first_names:$last_name"; + } + + print "$email ($name) (canonical email $canon_email) ($last_name, $first_names)\n"; + + my $user_id = $users{$canon_email}; + if (! $user_id) { + print " inserting into users\n"; + $users_sth->bind_param(1, $first_names); + $users_sth->bind_param(2, $last_name); + $users_sth->bind_param(3, $canon_email); + $users_sth->bind_param_inout(4, \$user_id, 100); + $users_sth->execute; + $users{$canon_email} = $user_id; + } + if (! $user_map{$email . $name}) { + print " inserting into user_map\n"; + $user_map_sth->execute($email, $name, $user_id); + $user_map{$email . $name} = $user_id; + } +} + +$db2->commit; +$users_sth->finish; +$sth->finish; + +$dbh->disconnect; +$db2->disconnect; + +sub parse_name { + my $name = shift; + + $name =~ s/<[^>]+>//g; + if ($name =~ /^(\S+),\s*(.*)\s*$/) { + # last name first + return ($2, $1); + } elsif ($name =~ /^(\S+)\s+(\S+)\s*$/) { + # first last + return ($1, $2); + } elsif ($name =~ /^(\S+)\s+(\S+)\s+(\S+)\s*$/) { + # first mi last + return ("$1 $2", $3); + } else { + # put it all in the first name. + return ($name, undef); + } +} Index: web/openacs/www/admin/conversion/util.pl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/conversion/util.pl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/conversion/util.pl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,100 @@ +# +# util.pl +# +# by jsc@arsdigita.com +# +# allegedly good for making Perl DBI scripts that mung data in Oracle +# + +sub get_dbhandle { + my ($username, $passwd) = @_; + my $dbh = DBI->connect('dbi:Oracle:', $username, $passwd) || die "Couldn't connect"; + $dbh->{AutoCommit} = 0; + $dbh->{LongReadLen} = 4000000; + $dbh->{LongTruncOk} = 0; + $dbh; +} + +sub parse_name { + my $name = shift; + + $name =~ s/<[^>]+>//g; + if ($name =~ /^(\S+),\s*(.*)\s*$/) { + # last name first + return ($2, $1); + } elsif ($name =~ /^(\S+)\s+(\S+)\s*$/) { + # first last + return ($1, $2); + } elsif ($name =~ /^(\S+)\s+(\S+)\s+(\S+)\s*$/) { + # first mi last + return ("$1 $2", $3); + } else { + # put it all in the first name. + return ($name, undef); + } +} + +# Attempt to clean up random email crap. If there was no email specified, +# use the name argument to create a class of anonymous users. +sub canonicalize_email { + my ($email, $name) = shift; + $email = lc($email); + $email =~ s/^<(.*)>\s*$/\1/; + $email =~ s/<[^>]+>//gi; + $email =~ s/remove-nospam\.//gi; + $email =~ s/nospam\.//gi; + $email =~ s/\.nospam//gi; + $email =~ s/\*nospam//gi; + $email =~ s/_no_spam//gi; + $email =~ s/nospam//gi; + + if (! $email) { + my ($first_names, $last_name) = parse_name($name); + if (! $first_names) { + $first_names = "--"; + } + if (! $last_name) { + $last_name = "--"; + } + $email = "no_email:$first_names:$last_name"; + } + + $email; +} + +sub set_query_variables { + my $sth = shift; + my @field_values = $sth->fetchrow_array; + if (! @field_values) { + return undef; + } + my @field_names = @{ $sth->{NAME} }; + my $callpack = caller; + no strict 'refs'; + + my $fieldcount = scalar(@field_names); + for (my $i = 0; $i < $fieldcount; $i++) { + my $var = lc($field_names[$i]); + my $value = $field_values[$i]; + *{"${callpack}::$var"} = \$value; + } + 1; +} + +# Takes a select statement that returns two fields, returns a hash +# table that uses the first column as the key and the second as the value. +sub sql_to_hash { + my ($dbh, $sql) = @_; + my $sth = $dbh->prepare($sql) || die $dbh->errstr; + my @field_values; + my %rethash; + + $sth->execute || die $dbh->errstr; + while (my ($key, $value) = $sth->fetchrow_array) { + $rethash{$key} = $value; + } + $sth->finish; + %rethash; +} + +1; Index: web/openacs/www/admin/crm/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/crm/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/crm/index.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,106 @@ +# /admin/crm/index.tcl +# by jsc@arsdigita.com + +# Let the user define states and transitions for the customer +# relationship manager. + +set user_id [ad_verify_and_get_user_id] +if { $user_id == 0 } { + ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode [ns_conn url]]" + return +} + +ReturnHeaders +ns_write "[ad_admin_header "Customer Relationship States"] +

    Customer Relationship States

    +[ad_admin_context_bar CRM] +
    +Documentation: /doc/crm.html +" + +set db [ns_db gethandle] + + +set selection [ns_db select $db "select state_name, description, crm_state_count_users(state_name) as n_users +from crm_states +order by state_name"] + +ns_write "

    Possible States

    +
    + + +" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "\n" +} + +ns_write "
    State NameDescriptionNumber of Users
    $state_name$description$n_users
    +
    +

    + +add a new state
    +run the state machine +

    +" + +# If there are users without state, then let the administrator assign them +# to a state. +set n_unstated_users [database_to_tcl_string $db "select count(*) +from users +where crm_state is null"] + +set initial_state [database_to_tcl_string_or_null $db "select state_name +from crm_states +where initial_state_p = 't'"] + +ns_write "

    +

    +Assign new users to: + + +
    + +There are $n_unstated_users users who have not been assigned to a state. + +

    Transitions

    +
    + + +" + + +set selection [ns_db select $db "select state_name, next_state, triggering_order, transition_condition +from crm_state_transitions +order by state_name, triggering_order"] + +set old_state "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + if { $old_state != $state_name } { + ns_write "" + set old_state $state_name + } else { + ns_write "" + } + + ns_write " + +\n" +} + +ns_write "
    FromToCondition
    $state_name
     $next_state
    $transition_condition
    		insert after
    edit
    +
    + +add a new transition + +[ad_admin_footer] +" Index: web/openacs/www/admin/crm/initial-state-assign.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/crm/initial-state-assign.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/crm/initial-state-assign.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,27 @@ +# /admin/crm/initial-state-assign.tcl +# by jsc@arsdigita.com + +# Assign the initial state by updating initial_state_p in crm_states, +# assigning all unassigned users to that state, +# and by altering the crm_state field in the users table. + +set_the_usual_form_variables +# state + +set db [ns_db gethandle] + +with_transaction $db { + ns_db dml $db "update crm_states set initial_state_p = case when state_name='$QQstate' then 't'::char else 'f'::char end" + ns_db dml $db "update users set crm_state = '$QQstate' where crm_state is null" + ns_db dml $db "alter table users alter crm_state set default '$QQstate'" +} { + ad_return_error "Error setting initial state" "A database error +occured while attempting to set the initial state for CRM: +
    +$errmsg
+
    +" + return +} + +ns_returnredirect "index.tcl" \ No newline at end of file Index: web/openacs/www/admin/crm/run-states.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/crm/run-states.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/crm/run-states.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,39 @@ +# run-states.tcl,v 3.0 2000/02/06 03:15:46 ron Exp +set dbs [ns_db gethandle main 2] +set db [lindex $dbs 0] +set sub_db [lindex $dbs 1] + +ReturnHeaders + +ns_write "[ad_admin_header "Update User States"] +

    Update User States

    +[ad_admin_context_bar [list "/admin/crm" CRM] "Update User States"] +
    +" + +# set now [database_to_tcl_string $db "select to_char(sysdate(), 'YYYYMMDDHH24MISS') from dual"] + +# ns_sleep 1 + +set selection [ns_db select $db "select state_name, next_state, transition_condition +from crm_state_transitions +order by triggering_order"] + +with_transaction $sub_db { + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + ns_write "$state_name to $next_state:\n" + ns_db dml $sub_db "update users +set crm_state = '$next_state', crm_state_entered_date = sysdate() +where crm_state = '$state_name' +and ((crm_state_entered_date < (sysdate() - '1 second'::timespan)) or crm_state_entered_date is null) +and ($transition_condition)" + + ns_write "[ns_pg ntuples $sub_db]
    \n" + } +} { + ns_log Bug "CRM update failed: $errmsg" +} + +ns_write [ad_admin_footer] Index: web/openacs/www/admin/crm/state-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/crm/state-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/crm/state-add-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,19 @@ +# state-add-2.tcl,v 3.0 2000/02/06 03:15:48 ron Exp +set_the_usual_form_variables +# state_name, description + +set db [ns_db gethandle] + +with_catch errmsg { + ns_db dml $db "insert into crm_states (state_name, description) values ('$QQstate_name', '$QQdescription')" +} { + ad_return_warning "Error Creating CRM State" "There was a database error encountered while creating your new customer state. Most likely, there already exists a state of the same name. The Oracle error message was: +
    +$errmsg
+
    +[ad_admin_footer]" + return +} + + +ns_returnredirect "index.tcl" \ No newline at end of file Index: web/openacs/www/admin/crm/state-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/crm/state-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/crm/state-add.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,23 @@ +# state-add.tcl,v 3.0 2000/02/06 03:15:49 ron Exp +set user_id [ad_verify_and_get_user_id] +if { $user_id == 0 } { + ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode [ns_conn url]]" + return +} + +ns_return 200 text/html "[ad_admin_header "Add a User State"] +

    Add a User State

    +[ad_admin_context_bar [list "/admin/crm" CRM] "Add a State"] +
    + +
    + + + + + +
    State Name
    Description
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/crm/transition-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/crm/transition-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/crm/transition-add-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,64 @@ +# transition-add-2.tcl,v 3.0 2000/02/06 03:15:50 ron Exp +set user_id [ad_verify_and_get_user_id] +if { $user_id == 0 } { + ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode [ns_conn url]]" + return +} + +set_the_usual_form_variables +# from_state, to_state, after, transition_condition + + +set exception_count 0 +set exception_text "" + +set db [ns_db gethandle] + +if { $from_state == $to_state } { + incr exception_count + append exception_text "
  • You cannot specify a transition from a state to itself.\n" +} + +if { [empty_string_p $transition_condition] } { + incr exception_count + append exception_text "
  • You must specify a transition condition.\n" +} else { + # Check to see if the SQL fragment is valid. + with_catch errmsg { + database_to_tcl_string $db "select count(*) from users where crm_state = '$QQfrom_state' and ($transition_condition)" + } { + incr exception_count + append exception_text "
  • Your SQL was invalid: 
    $errmsg
    \n" + } +} + + +if { [database_to_tcl_string $db "select count(*) from crm_state_transitions +where state_name = '$QQfrom_state' +and next_state = '$QQto_state'"] } { + incr exception_count + append exception_text "
  • There is already a transition defined for those two states.\n" +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +with_transaction $db { + ns_db dml $db "update crm_state_transitions +set triggering_order = triggering_order + 1 +where triggering_order > $after +and state_name = '$QQfrom_state'" + + ns_db dml $db "insert into crm_state_transitions (state_name, next_state, triggering_order, transition_condition) values ('$QQfrom_state', '$QQto_state', [expr $after + 1], '$QQtransition_condition')" +} { + ad_return_warning "Database Error" "We encountered a database error while trying to create +your new state transition. +
    +$errmsg
+
    +[ad_admin_footer]" +} + +ns_returnredirect "index.tcl" \ No newline at end of file Index: web/openacs/www/admin/crm/transition-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/crm/transition-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/crm/transition-add.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,56 @@ +# transition-add.tcl,v 3.0 2000/02/06 03:15:51 ron Exp +set user_id [ad_verify_and_get_user_id] +if { $user_id == 0 } { + ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode [ns_conn url]]" + return +} + + +set_the_usual_form_variables 0 +# all optional: from_state, after + +if { ![exists_and_not_null after] } { + set after 0 +} + +set db [ns_db gethandle] + +ReturnHeaders + +ns_write "[ad_admin_header "Add a State Transition"] +

    Add a State Transition

    +[ad_admin_context_bar [list "/admin/crm" CRM] "Add a State Transition"] +
    + +
    +[export_form_vars from_state after] + + +" + +set state_name_options [db_html_select_value_options $db "select state_name as state_name_value, state_name as state_name_name from crm_states order by state_name"] + +if { ![exists_and_not_null from_state] } { + ns_write "\n" +} else { + ns_write "\n" +} + +ns_write " + + +
    From
    From $from_state
    To
    Transition Condition +update users
    +set crm_state = to_state, crm_state_entered_date = sysdate()
    +where crm_state = from_state
    and (
    +
    +)
    +
    + +[ad_admin_footer] +" + + + + + Index: web/openacs/www/admin/crm/transition-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/crm/transition-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/crm/transition-edit-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,49 @@ +# transition-edit-2.tcl,v 3.0 2000/02/06 03:15:52 ron Exp +set user_id [ad_verify_and_get_user_id] +if { $user_id == 0 } { + ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode [ns_conn url]]" + return +} + +set_the_usual_form_variables +# state_name, next_state, transition_condition + +set exception_count 0 +set exception_text "" + +set db [ns_db gethandle] + +if { [empty_string_p $transition_condition] } { + incr exception_count + append exception_text "
  • You must specify a transition condition.\n" +} else { + # Check to see if the SQL fragment is valid. + with_catch errmsg { + database_to_tcl_string $db "select count(*) from users where crm_state = '$QQstate_name' and ($transition_condition)" + } { + incr exception_count + append exception_text "
  • Your SQL was invalid: 
    $errmsg
    \n" + } +} + + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +with_catch errmsg { + ns_db dml $db "update crm_state_transitions +set transition_condition = '$QQtransition_condition' +where state_name = '$QQstate_name' +and next_state = '$QQnext_state'" +} { + ad_return_warning "Database Error" "We encountered a database error while trying to edit +your new state transition. +
    +$errmsg
+
    +[ad_admin_footer]" +} + +ns_returnredirect "index.tcl" \ No newline at end of file Index: web/openacs/www/admin/crm/transition-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/crm/transition-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/crm/transition-edit.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,47 @@ +# transition-edit.tcl,v 3.0 2000/02/06 03:15:53 ron Exp +set user_id [ad_verify_and_get_user_id] +if { $user_id == 0 } { + ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode [ns_conn url]]" + return +} + + +set_the_usual_form_variables +# state_name, next_state + +set db [ns_db gethandle] + +set transition_condition [database_to_tcl_string $db "select transition_condition +from crm_state_transitions +where state_name = '$QQstate_name' +and next_state = '$QQnext_state'"] + +ReturnHeaders + +ns_write "[ad_admin_header "Edit State Transition"] +

    Edit State Transition

    +[ad_admin_context_bar [list "/admin/crm" CRM] "Edit State Transition"] +
    + +
    +[export_form_vars state_name next_state] + + + + + +
    From $state_name
    To $next_state
    Transition Condition +update users
    +set crm_state = to_state, crm_state_entered_date = sysdate()
    +where crm_state = from_state
    and (
    +
    +)
    +
    + +[ad_admin_footer] +" + + + + + Index: web/openacs/www/admin/curriculum/element-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/curriculum/element-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/curriculum/element-add-2.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,62 @@ +# element-add-2.tcl,v 3.0 2000/02/06 03:15:55 ron Exp +#This file should be called element-add-2.tcl +set_the_usual_form_variables + +# element_index, url, very_very_short_name, one_line_description, full_description, curriculum_element_id + +validate_integer element_index $element_index +validate_integer curriculum_element_id $curriculum_element_id + +set user_id [ad_get_user_id] + +#Now check to see if the input is good as directed by the page designer + +set exception_count 0 +set exception_text "" + + +# we were directed to return an error for element_index +if {![info exists element_index] || [empty_string_p $element_index]} { + incr exception_count + append exception_text "
  • You did not enter a value for element_index.
    " +} + +# we were directed to return an error for very_very_short_name +if {![info exists very_very_short_name] || [empty_string_p $very_very_short_name]} { + incr exception_count + append exception_text "
  • You did not enter a value for very_very_short_name.
    " +} +if {[string length $full_description] > 4000} { + incr exception_count + append exception_text "
  • \"full_description\" is too long\n" +} + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + +# So the input is good -- +# Now we'll do the insertion in the curriculum table. +set db [ns_db gethandle] +if [catch {ns_db dml $db "insert into curriculum + (curriculum_element_id, element_index, url, very_very_short_name, one_line_description, full_description) + values + ($curriculum_element_id, $element_index, '$QQurl', '$QQvery_very_short_name', '$QQone_line_description', '$QQfull_description')" } errmsg] { + + # Oracle choked on the insert + if { [ database_to_tcl_string $db "select count(*) from curriculum where curriculum_element_id = $curriculum_element_id"] == 0 } { + + # there was an error with the insert other than a duplication + ad_return_error "Error in insert" "We were unable to do your insert in the database. +Here is the error that was returned: +

    +

    +
    +$errmsg
+
    +
    " + return + } +} +ns_returnredirect element-list.tcl Index: web/openacs/www/admin/curriculum/element-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/curriculum/element-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/curriculum/element-add.tcl 17 Apr 2001 14:05:06 -0000 1.1 @@ -0,0 +1,50 @@ +# element-add.tcl,v 3.0 2000/02/06 03:15:56 ron Exp +#Code for element-add.tcl + +ad_maybe_redirect_for_registration +set db [ns_db gethandle] +ReturnHeaders + + +ns_write " +[ad_admin_header "Add a curriculum element"] + +

    Add a curriculum element

    + +[ad_admin_context_bar [list "element-list.tcl" "Curriculum"] "Add a curriculum element"] + +
    + +
    + + + + + + + + + + + + + + + + + +
    Sequence (0 is the first element in the curriculum)
    URL (start with / for internal, http: for external) +
    +note that a URL ending in / doesn't work with this package; +you need to include the \"index.html\" or \"index.tcl\" or whatever. + +
    A very very short name (for the curriculum bar)
    A full one-line description of this element
    A full description of this element and why it is part of the curriculum
    + +

    +

    + +
    +
    +

    +[ad_admin_footer]" Index: web/openacs/www/admin/curriculum/element-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/curriculum/element-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/curriculum/element-edit-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,57 @@ +# element-edit-2.tcl,v 3.0 2000/02/06 03:15:58 ron Exp +#This file should be called element-edit-2.tcl +set_the_usual_form_variables + +# element_index, url, very_very_short_name, one_line_description, full_description, curriculum_element_id + +validate_integer element_index $element_index +validate_integer curriculum_element_id $curriculum_element_id + +set user_id [ad_get_user_id] + +#Now check to see if the input is good as directed by the page designer + +set exception_count 0 +set exception_text "" + +# we were directed to return an error for element_index +if {![info exists element_index] ||[empty_string_p $element_index]} { + incr exception_count + append exception_text "

  • You did not enter a value for element_index.
    " +} + +# we were directed to return an error for very_very_short_name +if {![info exists very_very_short_name] ||[empty_string_p $very_very_short_name]} { + incr exception_count + append exception_text "
  • You did not enter a value for very_very_short_name.
    " +} +if {[string length $full_description] > 4000} { + incr exception_count + append exception_text "
  • \"full_description\" is too long\n" +} + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + +# So the input is good -- +# Now we'll do the update of the curriculum table. +set db [ns_db gethandle] +if [catch {ns_db dml $db "update curriculum + set element_index = $element_index, url = '$QQurl', very_very_short_name = '$QQvery_very_short_name', one_line_description = '$QQone_line_description', full_description = '$QQfull_description' + where curriculum_element_id = '$curriculum_element_id'" } errmsg] { + +# Oracle choked on the update + ad_return_error "Error in update" +"We were unable to do your update in the database. Here is the error that was returned: +

    +

    +
    +$errmsg
+
    +
    " + return +} + +ns_returnredirect element-list.tcl Index: web/openacs/www/admin/curriculum/element-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/curriculum/element-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/curriculum/element-edit.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,69 @@ +# element-edit.tcl,v 3.0 2000/02/06 03:15:59 ron Exp +#This file should be called element-edit.tcl +#Called from element-list.tcl +set_the_usual_form_variables + +# curriculum_element_id + +ad_maybe_redirect_for_registration +set db [ns_db gethandle] +if {[catch {set selection [ns_db 1row $db " + select element_index, url, very_very_short_name, one_line_description, full_description + from curriculum + where curriculum_element_id=$curriculum_element_id"]} errmsg]} { + ad_return_error "Error in finding the data" "We encountered an error in querying the database for your object. +Here is the error that was returned: +

    +

    +
    +$errmsg
+
    +
    " + return +} + + +set_variables_after_query + +#now we have the values from the database. + +ReturnHeaders + +ns_write " +[ad_admin_header "Edit the entry for $one_line_description"] + +

    Edit the entry for $one_line_description

    + +[ad_admin_context_bar [list "element-list.tcl" "Curriculum"] "Edit a curriculum element"] + +
    + +
    +[export_form_vars curriculum_element_id]" + +# Make the forms: + +ns_write " + + + + + + + + + + + + + + + +
    Sequence (0 is the first element in the curriculum)
    URL (start with / for internal, http: for external)
    A very very short name (for the curriculum bar)
    A full one-line description of this element
    A full description of this element and why it is part of the curriculum
    +

    +

    + +
    +
    +

    +[ad_admin_footer]" Index: web/openacs/www/admin/curriculum/element-list.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/curriculum/element-list.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/curriculum/element-list.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,71 @@ +# element-list.tcl,v 3.0 2000/02/06 03:16:00 ron Exp +# +# /admin/curriculum/element-list.tcl +# +# the main admin page for the curriculum system +# autogenerated by the prototype tool and then +# hacked a bit by philg@mit.edu +# + +ReturnHeaders + +ns_write "[ad_admin_header "Curriculum" ] +

    Curriculum

    + + +[ad_admin_context_bar "Curriculum"] + +
    + +Documentation: /doc/curriculum.html + +

    How the users are doing

    + +
    + + + +" + +set db [ns_db gethandle] +set selection [ns_db select $db "select coalesce(curriculum_users_n_elements_completed(user_id),0) as n_rows, count(*) as n_users +from users +group by n_rows +order by n_rows desc"] + +set table_rows "" +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append table_rows " + \n" +} + +ns_write "$table_rows + +
    Curriculum Elements
    Completed +     		Number of Users +
    $n_rows + $n_users
    +
    +

    All the curriculum elements

    +
      " + + +set sql_query "select element_index, very_very_short_name, one_line_description, curriculum_element_id +from curriculum +order by element_index" +set selection [ns_db select $db $sql_query] + +set counter 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + incr counter + ns_write "
    • $element_index: $very_very_short_name ($one_line_description)
      \n" +} + +if { $counter == 0 } { + ns_write "
    • There are no curriculum elements in the database right now.

      " +} + +ns_write "

    • Add a curriculum element

    +[ad_admin_footer]" Index: web/openacs/www/admin/curriculum/element-view.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/curriculum/element-view.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/curriculum/element-view.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,49 @@ +# element-view.tcl,v 3.0 2000/02/06 03:16:01 ron Exp +#This file should be called element-view.tcl +#Called from element-list.tcl +set_the_usual_form_variables + +# curriculum_element_id + +set db [ns_db gethandle] +set selection [ns_db 1row $db " + select element_index, url, very_very_short_name, one_line_description, full_description + from curriculum + where curriculum_element_id='[DoubleApos $curriculum_element_id]'"] +set_variables_after_query + +#now we have the values from the database. + +ReturnHeaders + +ns_write " +[ad_admin_header "View the entry for $one_line_description"] + +

    View the entry for $one_line_description

    + +[ad_admin_context_bar [list "element-list.tcl" "Curriculum"] "View a curriculum element"] + +
    + + + + + + + + + + + + + + + + + +
    Sequence (0 is the first element in the curriculum) $element_index
    URL (start with / for internal, http: for external) $url
    A very very short name (for the curriculum bar) $very_very_short_name
    A full one-line description of this element $one_line_description
    A full description of this element and why it is part of the curriculum $full_description
    + +

    +[ad_admin_footer]" Index: web/openacs/www/admin/custom-sections/add-page-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/custom-sections/add-page-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/custom-sections/add-page-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,93 @@ +# add-page-2.tcl,v 3.0 2000/02/06 03:16:02 ron Exp +# File: admin/custom-sections/add-page-2.tcl +# Date: 12/30/99 +# Contact: ahmeds@arsdigita.com +# Purpose: adds custom section page +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# section_id, file_name, page_pretty_name, body, html_p + +ad_scope_error_check + +set db [ns_db gethandle] + +ad_scope_authorize $db $scope admin group_admin none + + +set exception_count 0 +set exception_text "" + +if { [regexp {[^A-Za-z0-9_\.\-]} $file_name garbage] } { + incr exception_count + append exception_text "

  • Section key must be only alphanumeric characters with underscores, spaces not permitted" +} + +if { [empty_string_p $file_name] } { + incr exception_count + append exception_text "
  • file_name cannot be empty" +} + +if { [empty_string_p $page_pretty_name] } { + incr exception_count + append exception_text "
  • Page_pretty_name cannot be empty" +} + +if { $exception_count > 0 } { + ad_scope_return_complaint $exception_count $exception_text $db + return +} + +if [catch { + + ns_ora clob_dml $db " + insert into content_files + (content_file_id, section_id, file_name, file_type, page_pretty_name, body, html_p) + values + ($content_file_id, $section_id, '$QQfile_name', 'text/html', '$QQpage_pretty_name', empty_clob(), '$QQhtml_p') + returning body + into :1" $body + +} errmsg] { + + set file_already_exists_p [database_to_tcl_string $db " + select count(*) + from content_files + where section_id=$section_id + and file_name= '$QQfile_name' + "] + + if { $file_already_exists_p > 0 } { + + incr exception_count + append exception_text " +
  • File $file_name already exists. +
    Please choose another name for your file. + " + } else { + incr exception_count + append exception_text " +
  • Error occured while inserting data into database. Oracle returned error: +
    $errmsg + " + + } + + ad_scope_return_complaint $exception_count $exception_text $db + return + +} + +ns_returnredirect index.tcl?[export_url_scope_vars section_id] + + + + + + Index: web/openacs/www/admin/custom-sections/add-page.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/custom-sections/add-page.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/custom-sections/add-page.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,83 @@ +# add-page.tcl,v 3.0 2000/02/06 03:16:03 ron Exp +# File: admin/custom-sections/add-page.tcl +# Date: 12/30/99 +# Contact: ahmeds@arsdigita.com +# Purpose: adds custom section page +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +ReturnHeaders + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# section_id + +ad_scope_error_check + +set db [ns_db gethandle] + +ad_scope_authorize $db $scope admin group_admin none + + +set exception_count 0 +set exception_text "" + +set page_title "Add Page" +set section_pretty_name [database_to_tcl_string $db " + select section_pretty_name + from content_sections + where section_id = $section_id"] + +set content_file_id [database_to_tcl_string $db "select content_file_id_sequence.nextval from dual"] + +ns_write " +[ad_scope_admin_header $page_title $db] +[ad_scope_admin_page_title $page_title $db] +[ad_scope_admin_context_bar [list "index.tcl?[export_url_scope_vars section_id]" $section_pretty_name] $page_title] + +
    +
    + +
    +

    Add Page

    +
    + +
    + +[export_form_scope_vars section_id content_file_id] + +File Name +[ad_space 8] + +


    + +Page Pretty Name +[ad_space 8] + +


    + + +Page Content +
    + +


    + +Text above is + + +
    + +
    + +
    +
    + +[ad_scope_admin_footer] +" + Index: web/openacs/www/admin/custom-sections/delete-file-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/custom-sections/delete-file-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/custom-sections/delete-file-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,34 @@ +# delete-file-2.tcl,v 3.0 2000/02/06 03:16:05 ron Exp +# File: admin/custom-sections/delete-file-2.tcl +# Date: 12/30/99 +# Contact: ahmeds@arsdigita.com +# Purpose: deletes a custom section page +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# content_file_id section_id confirm_deletion + +ad_scope_error_check + +set db [ns_db gethandle] + +ad_scope_authorize $db $scope admin group_admin none + +if { $confirm_deletion =="yes" } { + ns_db dml $db " + delete from content_files + where content_file_id=$content_file_id + " +} + +ns_returnredirect "index.tcl?[export_url_vars section_id]" + + + + Index: web/openacs/www/admin/custom-sections/delete-file.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/custom-sections/delete-file.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/custom-sections/delete-file.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,59 @@ +# delete-file.tcl,v 3.0 2000/02/06 03:16:06 ron Exp +# File: admin/custom-sections/delete-file.tcl +# Date: 12/30/99 +# Contact: ahmeds@arsdigita.com +# Purpose: deletes custom section page +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +ReturnHeaders + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# content_file_id section_id + +ad_scope_error_check + +set db [ns_db gethandle] + +ad_scope_authorize $db $scope admin group_admin none + +set exception_count 0 +set exception_text "" + +set page_title "Delete Page Confirmation" + +set section_pretty_name [database_to_tcl_string $db " + select section_pretty_name + from content_sections + where section_id = $section_id"] + +ns_write " +[ad_scope_admin_header $page_title $db] +[ad_scope_admin_page_title $page_title $db] +[ad_scope_admin_context_bar [list "index.tcl?[export_url_scope_vars section_id]" $section_pretty_name] [list "edit-page.tcl?[export_url_scope_vars content_file_id section_id]" "Page Property"] $page_title] + +
    +
    + +
    +

    Confirm Page Deletion

    +
    + +Warning: Are you sure you want to delete this page + +

    Are you sure you want to proceed ? + +
    +[export_form_scope_vars content_file_id section_id] + +[ad_space 5] +
    + +
    + +[ad_scope_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/custom-sections/edit-index-page-1.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/custom-sections/edit-index-page-1.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/custom-sections/edit-index-page-1.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,117 @@ +# edit-index-page-1.tcl,v 3.0 2000/02/06 03:16:07 ron Exp +# File: admin/custom-sections/edit-index-file.tcl +# Date: 12/30/99 +# Contact: ahmeds@arsdigita.com +# Purpose: edits custom section index page +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +ReturnHeaders + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# section_id + +ad_scope_error_check + +set db [ns_db gethandle] + +ad_scope_authorize $db $scope admin group_admin none + +set exception_count 0 +set exception_text "" + +set selection [ns_db 0or1row $db " +select body, html_p +from content_sections +where section_id=$section_id +"] + +if { [empty_string_p $selection] } { + set page_exists_p [database_to_tcl_string $db " + select count(*) + from content_sections + where section_id=$section_id + "] + + if { !$page_exists_p } { + incr exception_count + append exception_text " +
  • Page does not exits. Only existing pages can be edited. + " + + if { $exception_count > 0 } { + ad_scope_return_complaint $exception_count $exception_text $db + return + } + + } + +} else { + # we got 1 row back, now let's get data from it + set_variables_after_query +} + +if { $html_p=="t" } { + set html_selected selected + set plain_text_selected "" +} else { + set html_selected "" + set plain_text_selected selected +} + +set page_title "Edit Section Index Page" + +set section_pretty_name [database_to_tcl_string $db " + select section_pretty_name + from content_sections + where section_id = $section_id"] + +ns_write " +[ad_scope_admin_header $page_title $db] +[ad_scope_admin_page_title $page_title db] +[ad_scope_admin_context_bar [list "index.tcl?[export_url_vars section_id]" $section_pretty_name] [list "edit-index-page.tcl?[export_url_vars section_id]" "Index Page Property"] Edit] + +
    +
    + +
    +

    Edit index.html

    +
    + +
    +[export_form_scope_vars section_id] + +Page Content +
    + +


    + +Text above is + + +
    + +
    + +
    + + + +[ad_scope_admin_footer] +" + + + + + + + Index: web/openacs/www/admin/custom-sections/edit-index-page-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/custom-sections/edit-index-page-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/custom-sections/edit-index-page-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,49 @@ +# edit-index-page-2.tcl,v 3.0 2000/02/06 03:16:09 ron Exp +# File: admin/custom-sections/edit-index-file-2.tcl +# Date: 12/30/99 +# Contact: ahmeds@arsdigita.com +# Purpose: edits custom section index page +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# section_id, body, html_p + +ad_scope_error_check + +set db [ns_db gethandle] + +ad_scope_authorize $db $scope admin group_admin none + + +set exception_count 0 +set exception_text "" + +if [catch { + + ns_ora clob_dml $db " + update content_sections + set html_p = '$QQhtml_p', + body = empty_clob() + where section_id= $section_id + returning body + into :1" $body + +} errmsg] { + + incr exception_count + append exception_text " +
  • Error occured while inserting data into database. Oracle returned error: +
    $errmsg + " + ad_scope_return_complaint $exception_count $exception_text ddddb + return + +} + +ns_returnredirect index.tcl?[export_url_scope_vars section_id] + Index: web/openacs/www/admin/custom-sections/edit-index-page.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/custom-sections/edit-index-page.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/custom-sections/edit-index-page.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,95 @@ +# edit-index-page.tcl,v 3.0 2000/02/06 03:16:10 ron Exp +# File: admin/custom-sections/edit-index-file.tcl +# Date: 12/30/99 +# Contact: ahmeds@mit.edu +# Purpose: shows custom section index page +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +ReturnHeaders + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# section_id + +ad_scope_error_check + +set db [ns_db gethandle] + +ad_scope_authorize $db $scope admin group_admin none + +set exception_count 0 +set exception_text "" + +set selection [ns_db 0or1row $db " +select body, html_p +from content_sections +where section_id=$section_id +"] + +if { [empty_string_p $selection] } { + set page_exists_p [database_to_tcl_string $db " + select count(*) + from content_sections + where section_id=$section_id + "] + + if { !$page_exists_p } { + incr exception_count + append exception_text " +
  • Page does not exits. Only existing pages can be showed. + " + + if { $exception_count > 0 } { + ad_scope_return_complaint $exception_count $exception_text $db + return + } + + } + +} else { + # we got 1 row back, now let's get data from it + set_variables_after_query +} + +set page_title "Index Page" + +set section_pretty_name [database_to_tcl_string $db " + select section_pretty_name + from content_sections + where section_id = $section_id"] + +ns_write " +[ad_scope_admin_header $page_title $db] +[ad_scope_admin_page_title $page_title db] +[ad_scope_admin_context_bar [list "index.tcl?[export_url_vars section_id]" $section_pretty_name] $page_title] + +
    +
    + +
    + +(edit) +

    + +Page Content +

    +$body +

    +Text above is [ad_decode $html_p t HTML "Plain Text"] +

    + +

    + +[ad_scope_admin_footer] +" + + + + + + + Index: web/openacs/www/admin/custom-sections/edit-page-1.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/custom-sections/edit-page-1.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/custom-sections/edit-page-1.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,125 @@ +# edit-page-1.tcl,v 3.0 2000/02/06 03:16:11 ron Exp +# File: admin/custom-sections/edit-page.tcl +# Date: 12/30/99 +# Contact: ahmeds@arsdigita.com +# Purpose: adds custom section page +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +ReturnHeaders + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# conent_file_id + +ad_scope_error_check + +set db [ns_db gethandle] + +ad_scope_authorize $db $scope admin group_admin none + +set exception_count 0 +set exception_text "" + +set selection [ns_db 0or1row $db " +select page_pretty_name, body, html_p +from content_files +where content_file_id=$content_file_id +"] + +if { [empty_string_p $selection] } { + set page_exists_p [database_to_tcl_string $db " + select count(*) + from content_files + where content_file_id=$content_file_id + "] + + if { !$page_exists_p } { + incr exception_count + append exception_text " +
  • Page does not exits. Only existing pages can be edited. + " + + if { $exception_count > 0 } { + ad_scope_return_complaint $exception_count $exception_text $db + return + } + + } + +} else { + # we got 1 row back, now let's get data from it + set_variables_after_query +} + +if { $html_p=="t" } { + set html_selected selected + set plain_text_selected "" +} else { + set html_selected "" + set plain_text_selected selected +} + +set file_name [database_to_tcl_string $db " +select file_name +from content_files +where content_file_id = $content_file_id +"] + +set page_title "Edit" + +set section_pretty_name [database_to_tcl_string $db " + select section_pretty_name + from content_sections + where section_id = $section_id"] + + +ns_write " +[ad_scope_admin_header $page_title $db] +[ad_scope_admin_page_title $page_title $db] +[ad_scope_admin_context_bar [list "index.tcl?[export_url_scope_vars section_id]" $section_pretty_name] [list "edit-page.tcl?[export_url_scope_vars content_file_id section_id]" "$file_name Property"] $page_title] + +
    +
    + +
    + +
    +[export_form_scope_vars section_id content_file_id] + +Page Pretty Name +[ad_space 8] + +


    + + +Page Content +
    + +


    + +Text above is + + +
    + +
    + +
    + + + +[ad_scope_admin_footer ] +" + Index: web/openacs/www/admin/custom-sections/edit-page-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/custom-sections/edit-page-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/custom-sections/edit-page-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,60 @@ +# edit-page-2.tcl,v 3.0 2000/02/06 03:16:13 ron Exp +# File: admin/custom-sections/edit-page-2.tcl +# Date: 12/30/99 +# Contact: ahmeds@arsdigita.com +# Purpose: edits custom section page +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# section_id content_file_id , page_pretty_name, body, html_p + +ad_scope_error_check + +set db [ns_db gethandle] + +ad_scope_authorize $db $scope admin group_admin none + +set exception_count 0 +set exception_text "" + +if { [empty_string_p $page_pretty_name] } { + incr exception_count + append exception_text "
  • page_pretty_name cannot be empty" +} + +if { $exception_count > 0 } { + ad_scope_return_complaint $exception_count $exception_text $db + return +} + +if [catch { + + ns_ora clob_dml $db " + update content_files + set page_pretty_name='$QQpage_pretty_name', + html_p = '$QQhtml_p', + body = empty_clob() + where content_file_id=$content_file_id + returning body + into :1" $body + +} errmsg] { + + incr exception_count + append exception_text " +
  • Error occured while inserting data into database. Oracle returned error: +
    $errmsg + " + ad_scope_return_complaint $exception_count $exception_text $db + return + +} + +ns_returnredirect index.tcl?[export_url_vars section_id] + Index: web/openacs/www/admin/custom-sections/edit-page.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/custom-sections/edit-page.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/custom-sections/edit-page.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,102 @@ +# edit-page.tcl,v 3.0 2000/02/06 03:16:14 ron Exp +# File: admin/custom-sections/edit-page.tcl +# Date: 12/30/99 +# Contact: ahmeds@arsdigita.com +# Purpose: summarizes custom section page +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +ReturnHeaders + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# conent_file_id + +ad_scope_error_check + +set db [ns_db gethandle] + +ad_scope_authorize $db $scope admin group_admin none + +set exception_count 0 +set exception_text "" + +set selection [ns_db 0or1row $db " +select page_pretty_name, body, html_p +from content_files +where content_file_id=$content_file_id +"] + +if { [empty_string_p $selection] } { + set page_exists_p [database_to_tcl_string $db " + select count(*) + from content_files + where content_file_id=$content_file_id + "] + + if { !$page_exists_p } { + incr exception_count + append exception_text " +
  • Page does not exits. Only existing pages can be edited. + " + + if { $exception_count > 0 } { + ad_scope_return_complaint $exception_count $exception_text $db + return + } + + } + +} else { + # we got 1 row back, now let's get data from it + set_variables_after_query +} + + +set file_name [database_to_tcl_string $db " +select file_name +from content_files +where content_file_id = $content_file_id +"] + +set page_title "$file_name" + +set section_pretty_name [database_to_tcl_string $db " + select section_pretty_name + from content_sections + where section_id = $section_id"] + + +ns_write " +[ad_scope_admin_header $page_title $db] +[ad_scope_admin_page_title $page_title $db] +[ad_scope_admin_context_bar [list "index.tcl?[export_url_scope_vars section_id]" $section_pretty_name] $page_title] + +
    +
    + +
    + +(edit | +delete) + +

    +Page Pretty Name +[ad_space 3] $page_pretty_name +

    + +Page Content +

    +$body +

    + +Text Type[ad_space 3] [ad_decode $html_p t HTML "Plain Text"] + +

    + +[ad_scope_admin_footer ] +" + Index: web/openacs/www/admin/custom-sections/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/custom-sections/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/custom-sections/index.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,148 @@ +# index.tcl,v 3.0 2000/02/06 03:16:15 ron Exp +# File: admin/custom-sections/index.tcl +# Date: 12/30/99 +# Contact: ahmeds@arsdigita.com +# Purpose: custom sections index page +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +ReturnHeaders + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# section_id + +ad_scope_error_check + +set db [ns_db gethandle] + +ad_scope_authorize $db $scope admin group_admin none + +if { $scope=="group" } { + set group_public_url [ns_set get $group_vars_set group_public_url] +} + +set section_pretty_name [database_to_tcl_string $db " + select section_pretty_name + from content_sections + where section_id = $section_id"] + +set section_key [database_to_tcl_string $db " + select section_key + from content_sections + where section_id = $section_id"] + +set page_title "$section_pretty_name Section" + +ns_write " +[ad_scope_admin_header $page_title $db ] +[ad_scope_admin_page_title $page_title $db] +[ad_scope_admin_context_bar $page_title] + +
    + +" + +append html " +

    Edit Index Page

    + +
    +
  • index.html +[ad_space 1] +(view | + property) +
    • +
    +" + +set selection [ns_db select $db " +select content_file_id, file_name, file_type +from content_files +where section_id=$section_id +"] + +set page_counter 0 +set photo_counter 0 + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + if { $file_type=="text/html" } { + + + + append page_html " +
  • $file_name + [ad_space 1] + (view | + property) + + " + incr page_counter + } else { + append photo_html " +
  • $file_name + [ad_space 1] + (view | + delete) + " + incr photo_counter + } +} + +if { $page_counter > 0 } { + append html " +

    Edit Section Pages

    +
    + $page_html +

    + " +} else { + append html " + No pages defined for this section. +

    +

    + " +} + +append html " + +Add new page to the section +

    +
    +" + +if { $photo_counter > 0 } { + append html " +

    Section Images

    +
    + $photo_html +

    +" +} else { + append html " +

    + No photos uploaded for this section. +

    + " +} + +append html " + +Upload image for the section +

    +
    +" + +ns_db releasehandle $db + +ns_write " +
    +$html +
    +

    +[ad_scope_admin_footer] +" Index: web/openacs/www/admin/custom-sections/upload-image-1.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/custom-sections/upload-image-1.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/custom-sections/upload-image-1.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,139 @@ +# upload-image-1.tcl,v 3.0 2000/02/06 03:16:17 ron Exp +# File: admin/custom-sections/upload-image-1.tcl +# Date: 12/30/99 +# Contact: ahmeds@arsdigita.com +# Purpose: This is the target program for the form in upload-image.tcl +# that uploads an image for the specified section in the database + +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + + +ad_page_variables { + {scope ""} + {user_id ""} + {group_id ""} + {on_which_group ""} + {on_what_id ""} + section_id + content_file_id + upload_file + file_name +} + +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# section_id,content_file_id, upload_file , file_name + +ad_scope_error_check + +set db [ns_db gethandle] + +ad_scope_authorize $db $scope admin group_admin none + +set exception_count 0 +set exception_text "" + +if { ![info exists upload_file] || [empty_string_p $upload_file] } { + append exception_text "

  • Please specify a file to upload\n" + incr exception_count +} +if { ![info exists file_name] || [empty_string_p $file_name] } { + incr exception_count + append exception_text "
  • No file name was passed. Please specify a file name of the image you want to upload." +} +if {$exception_count > 0} { + ad_scope_return_complaint $exception_count $exception_text $db + return +} + + +set file_name_already_exists_p [database_to_tcl_string $db " +select count(*) +from content_files +where file_name='$QQfile_name' +and section_id = $section_id"] + +if { $file_name_already_exists_p } { + append exception_text " +
  • The file with name $file_name already exists. Please choose a different file name.\n" + incr exception_count +} + +# conflict with system filename has to be checked later + +if {$exception_count > 0} { + ad_scope_return_complaint $exception_count $exception_text $db + return +} + +set tmp_filename [ns_queryget upload_file.tmpfile] + +set file_extension [string tolower [file extension $upload_file]] + +# remove the first . from the file extension +regsub {\.} $file_extension "" file_extension + +set guessed_file_type [ns_guesstype $upload_file] + +set n_bytes [file size $tmp_filename] + + +if { ![empty_string_p [ad_parameter MaxBinaryFileSize "custom-sections"]] && +$n_bytes > [ad_parameter MaxBinaryFileSize "custom-sections"] } { + append exception_text "
  • Your file is too large. The publisher of + [ad_system_name] has chosen to limit attachments to + [util_commify_number [ad_parameter MaxBinaryFileSize "custom-sections"]] bytes.\n" + incr exception_count +} + +if { $n_bytes == 0 } { + append exception_text "
  • Your file is zero-length. Either you + attempted to upload a zero length file, a file which does not exist, or + something went wrong during the transfer.\n" + incr exception_count +} + + +if { $exception_count > 0 } { + ad_scope_return_complaint $exception_count $exception_text $db + return +} + + +if [catch { + + ns_ora blob_dml_file $db " + insert into content_files + (content_file_id,section_id,file_name,binary_data ,file_type,file_extension) + values + ($content_file_id,$section_id,'$QQfile_name',empty_blob(),'$guessed_file_type', '$file_extension') + returning binary_data into :1" $tmp_filename + +} errmsg] { + + # Oracle choked on the insert + ad_scope_return_error "Error in insert" "We were unable to do your insert in the database. + Here is the error that was returned: +

    +

    + 
    +    $errmsg
+
    +
    " $db + return +} + +ns_returnredirect "index.tcl?[export_url_scope_vars section_id]" + + + + + + + + + + Index: web/openacs/www/admin/custom-sections/upload-image.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/custom-sections/upload-image.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/custom-sections/upload-image.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,86 @@ +# upload-image.tcl,v 3.0 2000/02/06 03:16:18 ron Exp +# File: admin/custom-sections/upload-image.tcl +# Date: 12/30/99 +# Contact: ahmeds@arsdigita.com +# Purpose: This page lets the user upload animage from the desktop +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +ReturnHeaders + +set_the_usual_form_variables 0 +# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id) +# section_id + +ad_scope_error_check + +set db [ns_db gethandle] + +ad_scope_authorize $db $scope admin group_admin none + + +set exception_count 0 +set exception_text "" + +set section_pretty_name [database_to_tcl_string $db " +select section_pretty_name +from content_sections +where section_id=$section_id +"] + +set page_title "Upload Image for $section_pretty_name" + +ns_write " +[ad_scope_admin_header $page_title $db] +[ad_scope_admin_page_title $page_title $db] +[ad_scope_admin_context_bar [list "index.tcl?[export_url_scope_vars section_id]" $section_pretty_name] $page_title] + +
    +
    +" + +set content_file_id [database_to_tcl_string $db " + select content_file_id_sequence.nextval from dual"] + +set html " + +

    Upload an Image for $section_pretty_name Section

    + + + + +[export_form_scope_vars section_id content_file_id] + + + + + + + + + +
    Upload File + + + +
    Filename + +
    + +

    + + +" + +ns_db releasehandle $db + +ns_write " +

    +$html +
    +[ad_scope_admin_footer ] +" + Index: web/openacs/www/admin/display/add-complete-css-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/display/add-complete-css-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/display/add-complete-css-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,59 @@ +# add-complete-css-2.tcl,v 3.0 2000/02/06 03:16:19 ron Exp +# File: /admin/css/add-complete-css-2.tcl +# Date: 12/26/99 +# Author: ahmeds@arsdigita.com +# Purpose: target page for adding new style selector +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_the_usual_form_variables +# maybe return_url, css_id, selector, property, value +# maybe scope, maybe scope related variables (group_id, user_id) + +set exception_count 0 +set exception_text "" + +set db [ns_db gethandle] + +if {![info exists css_id] || [empty_string_p $css_id] } { + incr exception_count + append exception_text "
  • No css_id was supplied." +} + +if {![info exists selector] || [empty_string_p $selector] } { + incr exception_count + append exception_text "
  • The selector field was empty." +} + +if {![info exists property] || [empty_string_p $property] } { + incr exception_count + append exception_text "
  • The property field was empty." +} + +if {![info exists value] || [empty_string_p $value] } { + incr exception_count + append exception_text "
  • The value field was empty." +} + +if {$exception_count > 0 } { + ad_scope_return_complaint $exception_count $exception_text $db + return +} + + +if { ![info exists return_url] } { + set return_url "index.tcl?[export_url_scope_vars]" +} + +ad_scope_error_check + + +ad_dbclick_check_dml $db css_complete css_id $css_id $return_url " +insert into css_complete +([ad_scope_cols_sql], css_id, selector, property, value) +values ([ad_scope_vals_sql], $css_id,'$selector','$property', '$value') +" + Index: web/openacs/www/admin/display/add-complete-css-property-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/display/add-complete-css-property-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/display/add-complete-css-property-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,56 @@ +# add-complete-css-property-2.tcl,v 3.0 2000/02/06 03:16:21 ron Exp +# File: /admin/css/add-complete-css-property-2.tcl +# Date: 12/26/99 +# Author: ahmeds@arsdigita.com +# Purpose: setting up cascaded style sheet properties of a chosen selector +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_the_usual_form_variables +# maybe return_url, css_id, selector, property, value +# maybe scope, maybe scope related variables (group_id, user_id) + +set exception_count 0 +set exception_text "" + +set db [ns_db gethandle] + +if {![info exists css_id] || [empty_string_p $css_id] } { + incr exception_count + append exception_text "
  • No css_id was supplied." +} + +if {![info exists selector] || [empty_string_p $selector] } { + incr exception_count + append exception_text "
  • No selector was supplied." +} + +if {![info exists property] || [empty_string_p $property] } { + incr exception_count + append exception_text "
  • The property field was empty." +} + +if {![info exists value] || [empty_string_p $value] } { + incr exception_count + append exception_text "
  • The value field was empty." +} + +if {$exception_count > 0 } { + ad_scope_return_complaint $exception_count $exception_text $db + return +} + +if { ![info exists return_url] } { + set return_url "index.tcl?[export_url_scope_vars]" +} + +ad_scope_error_check + +ad_dbclick_check_dml $db css_complete css_id $css_id $return_url " +insert into css_complete +([ad_scope_cols_sql], css_id, selector, property, value) +values ([ad_scope_vals_sql], $css_id,'$selector','$property', '$value') +" Index: web/openacs/www/admin/display/add-complete-css-property.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/display/add-complete-css-property.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/display/add-complete-css-property.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,68 @@ +# add-complete-css-property.tcl,v 3.0 2000/02/06 03:16:22 ron Exp +# File: /admin/diplay/add-complete-css-property.tcl +# Date: 12/26/99 +# Author: ahmeds@arsdigita.com +# Purpose: adds cascaded style sheet properties +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_the_usual_form_variables 0 +# maybe return_url +# maybe scope, maybe scope related variables (group_id, user_id) + +ad_scope_error_check + +ReturnHeaders + +set page_title "Add New Property" +set db [ns_db gethandle] + +ns_write " +[ad_scope_admin_header $page_title $db] +[ad_scope_admin_page_title $page_title $db] +[ad_scope_admin_context_bar [list "index.tcl?[export_url_scope_vars]" "Display Settings"] [list "edit-complete-css.tcl?[export_url_scope_vars]" "Edit"] $page_title] +
    +" + +set css_id [database_to_tcl_string $db "select css_complete_id_sequence.nextval from dual"] + +ns_db releasehandle $db + +append html " +
    +[export_form_scope_vars return_url selector css_id] + + + + + + + + + + + + + +
    Selector +$selector +
    Property +[ad_space 5](eg. color) +
    Value +[ad_space 5](eg. blue) +
    +

    + +

    +" + +ns_write " +
    +$html +
    +[ad_scope_admin_footer] +" + Index: web/openacs/www/admin/display/add-complete-css.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/display/add-complete-css.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/display/add-complete-css.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,68 @@ +# add-complete-css.tcl,v 3.0 2000/02/06 03:16:23 ron Exp +# File: /admin/display/add-complete-css.tcl +# Date: 12/26/99 +# Author: ahmeds@arsdigita.com +# Purpose: adds new style selector +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_form_variables 0 +# maybe return_url +# maybe scope, maybe scope related variables (group_id, user_id) + +ad_scope_error_check + +ReturnHeaders + +set page_title "Add New Style Selector " +set db [ns_db gethandle] + +ns_write " +[ad_scope_admin_header $page_title $db] +[ad_scope_admin_page_title $page_title $db] +[ad_scope_admin_context_bar [list "index.tcl?[export_url_scope_vars]" "Display Settings"] [list "edit-complete-css.tcl?[export_url_scope_vars]" "Edit"] $page_title] +
    +" + +set css_id [database_to_tcl_string $db "select css_complete_id_sequence.nextval from dual"] + +ns_db releasehandle $db + +append html " +
    +[export_form_scope_vars return_url css_id] + + + + + + + + + + + + + +
    Selector +[ad_space 5](eg. H1) +
    Property +[ad_space 5](eg. color) +
    Value +[ad_space 5](eg. blue) +
    +

    + +

    +" + +ns_write " +
    +$html +
    +[ad_scope_admin_footer] +" + Index: web/openacs/www/admin/display/delete-complete-css.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/display/delete-complete-css.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/display/delete-complete-css.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,33 @@ +# delete-complete-css.tcl,v 3.0 2000/02/06 03:16:25 ron Exp +# File: /admin/diplay/delete-complete-css-2.tcl +# Date: 12/26/99 +# Author: ahmeds@arsdigita.com +# Purpose: deleting cascaded style sheet properties +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_the_usual_form_variables 0 +# maybe return_url, selector, property +# maybe scope, maybe scope related variables (group_id, user_id) + +if { ![info exists return_url] } { + set return_url "index.tcl?[export_url_scope_vars]" +} + +ad_scope_error_check + +set db [ns_db gethandle ] + +ns_db dml $db " +delete from css_complete +where selector = '$selector' +and property = '$property' +and [ad_scope_sql] +" + +ns_db releasehandle $db + +ns_returnredirect $return_url Index: web/openacs/www/admin/display/edit-complete-css-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/display/edit-complete-css-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/display/edit-complete-css-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,53 @@ +# edit-complete-css-2.tcl,v 3.0 2000/02/06 03:16:26 ron Exp +# File: /admin/display/edit-complete-css-2.tcl +# Date: 12/26/99 +# Author: ahmeds@arsdigita.com +# Purpose: target page for setting up/editing cascaded style sheet properties +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_the_usual_form_variables 0 +# maybe return_url +# maybe scope, maybe scope related variables (group_id, user_id) + +if { ![info exists return_url] } { + set return_url "index.tcl?[export_url_scope_vars]" +} + +ad_scope_error_check + +set db_pools [ns_db gethandle [philg_server_default_pool] 2] +set db [lindex $db_pools 0] +set db_sub [lindex $db_pools 1] + +set selection [ns_db select $db " +select selector, property +from css_complete +where [ad_scope_sql]"] + +set_variables_after_query + +while { [ns_db getrow $db $selection] } { + + set_variables_after_query + + set update_sql " + update css_complete + set value = '[set css\_$selector\_$property]' + where selector='$selector' + and property='$property' + and [ad_scope_sql] + " + ns_db dml $db_sub $update_sql + +} + + +ns_db releasehandle $db + +ns_returnredirect $return_url + + Index: web/openacs/www/admin/display/edit-complete-css.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/display/edit-complete-css.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/display/edit-complete-css.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,125 @@ +# edit-complete-css.tcl,v 3.0 2000/02/06 03:16:27 ron Exp +# File: /admin/css/edit-complete-css.tcl +# Date: 12/27/99 +# Author: ahmeds@arsdigita.com +# Purpose: setting up cascaded style sheet properties +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_form_variables 0 +# maybe return_url +# maybe scope, maybe scope related variables (group_id, user_id) + + +ad_scope_error_check + +set db [ns_db gethandle] + +ReturnHeaders + +set page_title "Edit Display Settings " + +ns_write " +[ad_scope_admin_header $page_title $db] +[ad_scope_admin_page_title $page_title $db] +[ad_scope_admin_context_bar [list "index.tcl?[export_url_scope_vars]" "Display Settings"] $page_title] +
    +" + +set css_string [css_generate_complete_css $db] + +if { ![empty_string_p $css_string] } { + # there are css information in the database + + append html " +
    + [export_form_scope_vars return_url] + " + + set selection [ns_db select $db " + select selector, property, value + from css_complete + where [ad_scope_sql]"] + + set_variables_after_query + + set counter 0 + set last_selector "" + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + if { [string compare $selector $last_selector]!=0 } { + + if { $counter == 0 } { + append css " + $selector + + $selector +
      + + " + } + } + + append css " + + + " + incr counter + set last_selector $selector + } + + if { $counter > 0 } { + append css " + + +
      $property + : + + [ad_space 10]remove +
      add new property +
      +
    " + } else { + # no css values supplied + set css "" + } + append html " + $css + " +} else { + # no css information in the database + append html "No CSS currently defined.
    " +} + +ns_db releasehandle $db + +append html " +

    +

    + +
    +
    +

    add new style selector +" + +ns_write " +

    +$html +
    +[ad_scope_admin_footer] +" + + Index: web/openacs/www/admin/display/edit-simple-css-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/display/edit-simple-css-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/display/edit-simple-css-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,73 @@ +# edit-simple-css-2.tcl,v 3.0 2000/02/06 03:16:29 ron Exp +# File: /admin/css/edit-simple-css-2.tcl +# Date: 12/26/99 +# Author: gtewari@mit.edu (revised by tarik@arsdigita.com) +# Contact: tarik@arsdigita.com +# Purpose: setting up cascaded style sheet properties +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_the_usual_form_variables +# css_bgcolor, css_textcolor, css_unvisited_link, css_visited_link, css_link_text_decoration, css_font_type +# css_bgcolor_val, css_textcolor_val, css_unvisited_link_val, css_visited_link_val +# maybe return_url +# maybe scope, maybe scope related variables (group_id, user_id) + +if { ![info exists return_url] } { + set return_url "edit-simple-css.tcl" +} + +ad_scope_error_check + +set db [ns_db gethandle] + +append update_sql " +update css_simple +set " + + +if { ([info exists css_bgcolor] && ![empty_string_p $css_bgcolor]) || \ + ([info exists css_bgcolor_val] && ![empty_string_p $css_bgcolor_val]) } { + append update_sql "css_bgcolor = [ad_decode $css_bgcolor_val "" '$css_bgcolor' '$css_bgcolor_val'], + " +} + +if { ([info exists css_textcolor] && ![empty_string_p $css_textcolor]) || \ + ([info exists css_textcolor_val] && ![empty_string_p $css_textcolor_val]) } { + append update_sql "css_textcolor = [ad_decode $css_textcolor_val "" '$css_textcolor' '$css_textcolor_val'], + " +} + +if { ([info exists css_unvisited_link] && ![empty_string_p $css_unvisited_link]) || \ + ([info exists css_unvisited_link_val] && ![empty_string_p $css_unvisited_link_val]) } { + append update_sql "css_unvisited_link = [ad_decode $css_unvisited_link_val "" '$css_unvisited_link' '$css_unvisited_link_val'], + " +} + +if { ([info exists css_visited_link] && ![empty_string_p $css_visited_link]) || \ + ([info exists css_visited_link_val] && ![empty_string_p $css_visited_link_val]) } { + append update_sql "css_visited_link = [ad_decode $css_visited_link_val "" '$css_visited_link' '$css_visited_link_val'], + " +} + +if { [info exists css_font_type] && ![empty_string_p $css_font_type] } { + append update_sql "css_font_type = '$css_font_type', + " +} + +append update_sql "css_link_text_decoration = '$css_link_text_decoration' +where [ad_scope_sql] +" + + +ns_db dml $db $update_sql + +ns_db releasehandle $db + +ns_returnredirect $return_url + + + Index: web/openacs/www/admin/display/edit-simple-css.help =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/display/edit-simple-css.help,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/display/edit-simple-css.help 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,21 @@ +<%= [ad_header "Help for Edit Display Settings"] %> + +

    Help

    + +for the Edit CSS display settings page + +
    + +Instead of choosing a color, you may elect to type in a hex RGB value +for a color, e.g., + +
      +
    • #000000 is black +
    • #FFFFFF is white +
    • #FF0000 is red + +
    + +Make sure to include the # sign. + +<%= [ad_footer] %> Index: web/openacs/www/admin/display/edit-simple-css.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/display/edit-simple-css.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/display/edit-simple-css.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,143 @@ +# edit-simple-css.tcl,v 3.0 2000/02/06 03:16:30 ron Exp +# File: /admin/css/edit-simple-css.tcl +# Date: 12/26/99 +# Author: gtewari@mit.edu (revised by tarik@arsdigita.com) +# Contact: tarik@arsdigita.com +# Purpose: setting up cascaded style sheet properties +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_form_variables 0 +# maybe return_url +# maybe scope, maybe scope related variables (group_id, user_id) + +ad_scope_error_check + +set db [ns_db gethandle] + +ReturnHeaders + +set page_title "Edit Display Settings " + +ns_write " +[ad_scope_admin_header $page_title $db] +[ad_scope_admin_page_title $page_title $db] +[ad_scope_admin_context_bar [list "index.tcl?[export_url_scope_vars]" "Display Settings"] "Edit"] +
    + +[help_upper_right_menu] +" + +set selection [ns_db 0or1row $db " +select css_bgcolor, css_textcolor, css_unvisited_link, css_visited_link, css_link_text_decoration, css_font_type +from css_simple +where [ad_scope_sql] +"] + +if { [empty_string_p $selection] } { + # there is no entry for this scope, let's go and create the default one + ns_db dml $db " + insert into css_simple + (css_id, [ad_scope_cols_sql], css_bgcolor, css_textcolor, css_unvisited_link, css_visited_link, + css_link_text_decoration, css_font_type) + values + ([db_sequence_nextval_sql css_simple_id_sequence], [ad_scope_vals_sql], 'white', 'black', 'blue', 'purple', 'none', 'arial') + " + + set selection [ns_db 1row $db " + select css_bgcolor, css_textcolor, css_unvisited_link, css_visited_link, css_link_text_decoration, css_font_type + from css_simple + where [ad_scope_sql] + "] +} + +set_variables_after_query + +set color_names_list { "choose new color" Black Blue Cyan Gray Green Lime Magenta Maroon Navy Olive Purple Red Silver Teal White Yellow } +set color_values_list { "" black blue cyan gray green lime magenta maroon navy olive purple red silver teal white yellow } + +#present the user with graphical options: +append html " +
    +[export_form_scope_vars return_url] + + + + + + + + + + + + + + + + + +" + +if { $css_link_text_decoration == "underline" } { + append html " + + + " +} else { + append html " + + + " +} + +append html " +
      +hex value (alternative) +
    Body Background Color: +[ad_space 2]$css_bgcolor +[ns_htmlselect -labels $color_names_list css_bgcolor $color_values_list $css_bgcolor] + +
    Body Text Color: +[ad_space 2]$css_textcolor +[ns_htmlselect -labels $color_names_list css_textcolor $color_values_list $css_textcolor] + +
    Links Color: +[ad_space 2]$css_unvisited_link +[ns_htmlselect -labels $color_names_list css_unvisited_link $color_values_list $css_unvisited_link] + +
    Visited Links Color: +[ad_space 2] $css_visited_link +[ns_htmlselect -labels $color_names_list css_visited_link $color_values_list $css_visited_link] + +
    Choose Font: +[ad_space 2]$css_font_type +[ns_htmlselect -labels {"choose new font" Arial Courier Geneva Helvetica Palatino Sans-Serif Times} \ + css_font_type \ + {"" arial courier geneva helvetica palatino sans-serif times} \ + $css_font_type] +
    Links: + Underlined + Not Underlined +
    Links: + Underlined + Not Underlined +
    +

    + +

    +" + +ns_write " +
    +$html +
    +[ad_scope_admin_footer] +" + + + + Index: web/openacs/www/admin/display/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/display/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/display/index.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,42 @@ +# index.tcl,v 3.0 2000/02/06 03:16:31 ron Exp +# File: /display/index.tcl +# Date: 12/27/99 +# Contact: tarik@arsdigita.com +# Purpose: display settings administration page +# +# Note: if this page is accessed through /groups/admin pages then +# group_id, group_name, short_name and admin_email are already +# set up in the environment by the ug_serve_section + +set_the_usual_form_variables 0 +# maybe return_url +# maybe scope, maybe scope related variables (group_id, user_id) + + +ad_scope_error_check + +set db [ns_db gethandle] + +append html " + + +Cascaded Style Sheet Settings
    + + +Logo Settings +" + +set page_title "Display Settings" + +ns_return 200 text/html " +[ad_scope_admin_header $page_title $db] +[ad_scope_admin_page_title $page_title $db] +[ad_scope_admin_context_bar "Display Settings"] + +
    +
    +$html +
    +[ad_scope_admin_footer] +" + Index: web/openacs/www/admin/display/toggle-logo-enabled.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/display/toggle-logo-enabled.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/display/toggle-logo-enabled.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,25 @@ +# toggle-logo-enabled.tcl,v 3.0 2000/02/06 03:16:32 ron Exp +# File: /display/toggle-logo-enabled.tcl +# Date: 12/27/99 +# Contact: tarik@arsdigita.com +# Purpose: display settings administration page +# +# Note: if this page is accessed through /groups/admin pages then +# group_id, group_name, short_name and admin_email are already +# set up in the environment by the ug_serve_section + +set_form_variables +# maybe scope, maybe scope related variables (group_id, user_id) +# logo_id + +ad_scope_error_check + +set db [ns_db gethandle] + +ns_db dml $db " +update page_logos +set logo_enabled_p=logical_negation(logo_enabled_p) +where logo_id=$logo_id +" + +ns_returnredirect "upload-logo.tcl?[export_url_scope_vars]" Index: web/openacs/www/admin/display/upload-logo-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/display/upload-logo-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/display/upload-logo-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,130 @@ +# upload-logo-2.tcl,v 3.0 2000/02/06 03:16:33 ron Exp +# File: /admin/css/upload-logo-2.tcl +# Date: 12/27/99 +# Contact: tarik@arsdigita.com +# Purpose: uploading logo to be displayed on pages +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + + +ad_page_variables { + {return_url ""} + {scope ""} + {group_id ""} + {user_id ""} + upload_file +} + +# maybe return_url +# maybe scope, maybe scope related variables (group_id, user_id) + +if { ![info exists return_url] } { + set return_url "index.tcl?[export_url_scope_vars]" +} + +ad_scope_error_check + +set db [ns_db gethandle] + +set exception_count 0 +set exception_text "" + +if { ![info exists upload_file] || [empty_string_p $upload_file] } { + append exception_text "
  • Please specify a file to upload\n" + incr exception_count +} + +if {$exception_count > 0} { + ad_scope_return_complaint $exception_count $exception_text $db + return +} + +set tmp_filename [ns_queryget upload_file.tmpfile] +set file_extension [string tolower [file extension $upload_file]] + +# remove the first . from the file extension +regsub {\.} $file_extension "" file_extension + +set guessed_file_type [ns_guesstype $upload_file] +set n_bytes [file size $tmp_filename] + + +if { ![empty_string_p [ad_parameter MaxLogoSize display]] && $n_bytes > [ad_parameter MaxLogoSize display] } { + append exception_text "
  • Your file is too large. The publisher of + [ad_system_name] has chosen to limit attachments to + [util_commify_number [ad_parameter MaxLogoSize display]] bytes.\n" + incr exception_count +} + +if { $n_bytes == 0 } { + append exception_text "
  • Your file is zero-length. Either you + attempted to upload a zero length file, a file which does not exist, or + something went wrong during the transfer.\n" + incr exception_count +} + + +if { $exception_count > 0 } { + ad_scope_return_complaint $exception_count $exception_text $db + return +} + + +set logo_already_exists_p [ad_decode [ns_db 0or1row $db "select 1 from page_logos where [ad_scope_sql]"] "" 0 1] + +if [catch { + + ns_db dml $db "begin transaction" + + set lob_id [database_to_tcl_string $db "select empty_lob()"] + + if { $logo_already_exists_p } { + ns_db dml $db " + update page_logos + set lob= $lob_id, + logo_file_type= '$guessed_file_type', + logo_file_extension= '$file_extension' + where [ad_scope_sql]" + + } else { + ns_db dml $db " + insert into page_logos + (logo_id, [ad_scope_cols_sql], logo_file_type, logo_file_extension, lob, logo_enabled_p) + values + ([db_sequence_nextval_sql page_logos_id_sequence], [ad_scope_vals_sql], '$guessed_file_type', '$file_extension', $lob_id, 't') + " + } + + # Stuff the actual file into there + ns_pg blob_dml_file $db $lob_id $tmp_filename + + ns_db dml $db "end transaction" + +} errmsg] { + + # Oracle choked on the insert or update + if { $logo_already_exists_p } { + set insert_or_update update + } else { + set insert_or_update insert + } + + ad_scope_return_error "Error in $insert_or_update" " + We were unable to do database $insert_or_update. + Here is the error that was returned by Oracle: +

    +

    + 
    +    $errmsg
+
    +
    " $db + return +} + +ns_returnredirect $return_url + + + Index: web/openacs/www/admin/display/upload-logo.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/display/upload-logo.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/display/upload-logo.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,152 @@ +# upload-logo.tcl,v 3.0 2000/02/06 03:16:34 ron Exp +# File: /admin/css/upload-logo.tcl +# Date: 12/26/99 +# Contact: tarik@arsdigita.com +# Purpose: uploading logo to be displayed on pages +# +# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in +# the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, +# group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url, +# group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list) + +set_form_variables 0 +# maybe return_url +# maybe scope, maybe scope related variables (group_id, user_id) + +ad_scope_error_check + +set db [ns_db gethandle] + +ReturnHeaders + +set page_title "Logo Settings" + +ns_write " +[ad_scope_admin_header $page_title $db] +[ad_scope_admin_page_title $page_title $db] +[ad_scope_admin_context_bar [list "index.tcl?[export_url_scope_vars]" "Display Settings"] $page_title] +
    +" + +append html " + +" + +set selection [ns_db 0or1row $db "select logo_id from page_logos where [ad_scope_sql]"] +if { [empty_string_p $selection] } { + set logo_exists_p 0 +} else { + set logo_exists_p 1 + set_variables_after_query +} + +if { $logo_exists_p } { + append html " + + + " +} else { + append html " + + + + " +} + +append html " + +[export_form_scope_vars return_url] + +" + +if { $logo_exists_p } { + append html " + +" + +ns_log Notice "SCOPE: $scope" + +switch $scope { + public { + # this may be later set using parameters file + set logo_enabled_p 0 + } + group { + if { $logo_exists_p } { + set logo_enabled_p [database_to_tcl_string $db " + select case when logo_enabled_p = 't' then 1 else 0 end + from page_logos + where logo_id=$logo_id"] + ns_log Notice "LOGO EXIST" + } else { + set logo_enabled_p 0 + ns_log Notice "LOGO DOESN'T EXIST" + } + } + user { + # if we add support for logo for personal pages this can do something better + set logo_enabled_p 0 + } +} + +if { $logo_exists_p } { + if { $logo_enabled_p } { + append html " + + + " + } else { + append html " + + + " + } +} + +append html " +
    Current Logo + Logo +
    Currently no logo exists. +
    Change Logo + " +} else { + append html " + Upload New Logo + " +} + +append html " + + +
    Logo is enabled + disable +
    Logo is disabled + enable +
    + +

    + + +" + +ns_db releasehandle $db + +if { $logo_exists_p } { + set note_html "[ad_style_bodynote "Your browser may cache the logo, in which case you won't be able to see changed logo immediately.
    You will be able to see the new logo once you restart your browser." ]" +} else { + set note_html "" +} + +ns_write " +

    +$html +
    +$note_html +[ad_scope_admin_footer] +" + + + + + + Index: web/openacs/www/admin/documentation/directory-view-with-contents.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/documentation/directory-view-with-contents.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/documentation/directory-view-with-contents.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,67 @@ +# directory-view-with-contents.tcl,v 3.0 2000/02/06 03:16:35 ron Exp +set_the_usual_form_variables + +# directory, maybe text_p + +# if text_p = t, we are looking at pure text + +if ![info exists text_p] { + set text_p "f" +} + +set exception_count 0 +set exception_text "" + +if {![info exists directory] || [empty_string_p $directory]} { + incr exception_count + append exception_text "
  • Please enter a directory." +} + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + +ReturnHeaders + +ns_write "[ad_header "Contents of $directory"] + +

    Contents of $directory

    + +[ad_admin_context_bar [list "index.tcl" "Documentation"] "Full Contents"] +
    +" +set directory_text "" + +foreach f [glob -nocomplain $directory/*] { + if { [string match "*CVS" $f ] == 0 && [string match "*~*" $f] == 0 && [string match "*#*" $f] == 0 } { + # this is not a CVS directory or a backup file + if {[file isdirectory $f]} { + append directory_text "
  • $f" + } else { + set last_accessed [ns_fmttime [file atime $f] "%m/%d/%Y %T"] + set last_modified [ns_fmttime [file mtime $f] "%m/%d/%Y %T"] + set size [file size $f] + set stream [open $f r] + + regsub [ns_info pageroot] $f "" f + regsub {\.\./} $f "" f + + ns_write "

    $f

    Last modified: $last_modified | Last accessed: $last_accessed | Size: $size

    +

    " + if {$text_p == "t"} { + ns_write "

    [ns_quotehtml [read $stream]]
    " + } else { + ns_write "[read $stream]" + } + + close $stream + } + } +} +ns_write " +
      +$directory_text +
    +[ad_admin_footer]" + Index: web/openacs/www/admin/documentation/directory-view.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/documentation/directory-view.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/documentation/directory-view.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,91 @@ +# directory-view.tcl,v 3.0 2000/02/06 03:16:36 ron Exp +set_the_usual_form_variables + +# directory, maybe text_p + +# if text_p = t, we are looking at pure text + +if ![info exists text_p] { + set text_p "f" +} + + +set exception_count 0 +set exception_text "" + +if {![info exists directory] || [empty_string_p $directory]} { + incr exception_count + append exception_text "
  • Please enter a directory." +} + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + +ReturnHeaders + +ns_write "[ad_header "Contents of $directory"] + +

    Contents of $directory

    + +[ad_admin_context_bar [list "index.tcl" "Documentation"] "Browse"] +
    +
      +" +set file_text "" +set directory_text "" + +foreach f [glob -nocomplain $directory/*] { + if { [string match "*CVS" $f ] == 0 && [string match "*~*" $f] == 0 && [string match "*#*" $f] == 0 } { + # this is not a CVS directory or a backup file + if {[file isdirectory $f]} { + append directory_text "
    • $f (directory)" + } else { + set last_accessed [ns_fmttime [file atime $f] "%m/%d/%Y %T"] + set last_modified [ns_fmttime [file mtime $f] "%m/%d/%Y %T"] + set size [file size $f] + set stream [open $f r] + + regsub [ns_info pageroot] $f "" f + set comments "" + set line_list [split [read $stream] "\n"] + + set group_together 0 + + foreach line $line_list { + set line [string trim $line] + if {[regexp "^#" $line dummy]} { + append comments "$line
      " + set group_together 1 + } elseif {$group_together == 1} { + append comments "

      " + set group_together 0 + } + } + + if {$text_p == "t"} { + append file_text "

    • $f
      Last modified: $last_modified | Last accessed: $last_accessed | Size: $size

      +$comments +

      +" + } else { + append file_text "

    • $f
      Last modified: $last_modified | Last accessed: $last_accessed | Size: $size

      +$comments +

      +" + } + + close $stream + set comments "" + } + + } +} +ns_write " +$file_text +

      +$directory_text +

    +[ad_admin_footer]" + Index: web/openacs/www/admin/documentation/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/documentation/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/documentation/index.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,24 @@ +# index.tcl,v 3.1 2000/03/11 10:51:14 aure Exp +ReturnHeaders +ns_write "[ad_admin_header "Documentation"] + +

    Documentation

    + +[ad_admin_context_bar "Documentation"] +
    +Human-generated documentation +

    Browse

    + +

    Major changes to ACS

    + + + +[ad_admin_footer]" Index: web/openacs/www/admin/ecommerce/audit-one-id.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/audit-one-id.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/audit-one-id.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,29 @@ +# audit-one-id.tcl,v 3.0 2000/02/06 03:16:46 ron Exp +# Jesse 7/17 +# Displays the audit info for one id in the id_column of a table and its +# audit history + +set_the_usual_form_variables +# id, id_column, audit_table_name, main_table_name + +set table_names_and_id_column [list $main_table_name $audit_table_name $id_column] + +set db [ns_db gethandle] + +ns_return 200 text/html " +[ad_admin_header "[ec_system_name] Audit of $id_column $id"] + +

    [ec_system_name] Audit Trail

    + +[ad_admin_context_bar [list index.tcl Ecommerce] [list "audit-tables.tcl?[export_url_vars table_names_and_id_column]" "Audit $main_table_name"] "[ec_system_name] Audit Trail"] +
    + +

    $main_table_name

    +
    + +[ad_audit_trail $db $id $audit_table_name $main_table_name $id_column] + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/audit-table.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/audit-table.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/audit-table.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,100 @@ +# audit-table.tcl,v 3.0 2000/02/06 03:16:47 ron Exp +# Jesse 7/18 +# Returns the audit trails of a table and its audit table for entry that +# exists between the start date and end date. + +set_form_variables +# expects table_names_and_id_column start_date end_date +# start_date can be blank + +set main_table_name [lindex $table_names_and_id_column 0] +set audit_table_name [lindex $table_names_and_id_column 1] +set id_column [lindex $table_names_and_id_column 2] + +set form [ns_getform] + +# ns_dbformvalue $form start_date date start_date will give an error +# message if the day of the month is 08 or 09 (this octal number problem +# we've had in other places). So I'll have to trim the leading zeros +# from ColValue.start%5fdate.day and stick the new value into the $form +# ns_set. + +set "ColValue.start%5fdate.day" [string trimleft [set ColValue.start%5fdate.day] "0"] +ns_set update $form "ColValue.start%5fdate.day" [set ColValue.start%5fdate.day] + + +set "ColValue.end%5fdate.day" [string trimleft [set ColValue.end%5fdate.day] "0"] +ns_set update $form "ColValue.end%5fdate.day" [set ColValue.end%5fdate.day] + +set exception_count 0 +set exception_text "" + +# check that either all elements are blank +# date and time value is formated correctly for ns_dbformvalue +if { [empty_string_p [set ColValue.start%5fdate.day]] && + [empty_string_p [set ColValue.start%5fdate.year]] && + [empty_string_p [set ColValue.start%5fdate.month]] && + [empty_string_p [set ColValue.start%5fdate.time]] } { + # Blank date means that all the table history should be displayed + set start_date "" +} elseif { [catch { ns_dbformvalue $form start_date datetime start_date} errmsg ] } { + incr exception_count + append exception_text "
  • The date or time was specified in the wrong format. The date should be in the format Month DD YYYY. The time should be in the format HH:MI:SS (seconds are optional), where HH is 01-12, MI is 00-59 and SS is 00-59.\n" +} elseif { ![empty_string_p [set ColValue.start%5fdate.year]] && [string length [set ColValue.start%5fdate.year]] != 4 } { + incr exception_count + append exception_text "
  • The year needs to contain 4 digits.\n" +} + +if [catch { ns_dbformvalue $form end_date datetime end_date} errmsg ] { + incr exception_count + append exception_text "
  • The date or time was specified in the wrong format. The date should be in the format Month DD YYYY. The time should be in the format HH:MI:SS (seconds are optional), where HH is 01-12, MI is 00-59 and SS is 00-59.\n" +} elseif { ![empty_string_p [set ColValue.end%5fdate.year]] && [string length [set ColValue.end%5fdate.year]] != 4 } { + incr exception_count + append exception_text "
  • The year needs to contain 4 digits.\n" +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +set db [ns_db gethandle] + +ReturnHeaders +ns_write " +[ad_admin_header "[ec_system_name] Audit Table"] + +

    [ec_system_name] Audit for $main_table_name

    + +[ad_admin_context_bar [list "index.tcl" Ecommerce] [list "audit-tables.tcl" "Audit Table"] "Audit $main_table_name"] + +
    + +
    +[export_form_vars table_names_and_id_column] + + + + + + + + + + + + + +
    From:[ad_dateentrywidget start_date [lindex [split $start_date " "] 0]][ec_timeentrywidget start_date $start_date]
    To:[ad_dateentrywidget end_date [lindex [split $end_date " "] 0]][ec_timeentrywidget end_date $end_date]
    +
    + +

    $main_table_name

    +" + +ns_write " +
    +[ad_audit_trail_for_table $db $main_table_name $audit_table_name $id_column $start_date $end_date "audit-one-id.tcl" ""] +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/audit-tables.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/audit-tables.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/audit-tables.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,85 @@ +# audit-tables.tcl,v 3.0 2000/02/06 03:16:48 ron Exp +# Jesse 7/18 +# Gives user a list of tables to audit + +set_form_variables 0 +# possibly table_names_and_id_column + +set db [ns_db gethandle] + +ReturnHeaders +ns_write " +[ad_admin_header "Audit [ec_system_name]"] + +

    Audit [ec_system_name]

    + +[ad_admin_context_bar [list "index.tcl" Ecommerce] "Audit Tables"] + +
    + +
    +This page will let you see all changes to one table of the [ec_system_name] database over a specified period of time. It is recommended that you start with a narrow time window and expand as needed. Some tables are very large. +
    + +
    + +
      +" + +if { [info exists table_names_and_id_column] } { + ns_write "[export_form_vars table_names_and_id_column] +
      + Audit for table [lindex $table_names_and_id_column 0] +
      +" +} else { + ns_write " +
    • What table do you want to audit: + +" +} + +ns_write " +

      + +

    • When do you want to audit back to: (Leave blank to start at the begining of the table's history.)
      +[ad_dateentrywidget start_date ""] [ec_timeentrywidget start_date ""] + +

      + +

    • When do you want to audit up to:
      +[ad_dateentrywidget end_date] [ec_timeentrywidget end_date] + +
    + +
    +Note: if the table is very large, this may take a while.
    + +
    + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/audit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/audit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/audit.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,35 @@ +# audit.tcl,v 3.0 2000/02/06 03:16:49 ron Exp +# Jesse 7/17 +# Displays the audit info for one id in the id_column of a table and its +# audit history + +set_the_usual_form_variables +# audit_name, audit_id, audit_id_column, return_url, audit_tables, main_tables + +# where audit_tables and main_tables are tcl lists of tables to audit + +set db [ns_db gethandle] + +ReturnHeaders +ns_write " +[ad_admin_header "[ec_system_name] Audit Trail"] +

    $audit_name

    + +[ad_admin_context_bar [list index.tcl Ecommerce] "Audit Trail"] +
    +" + +set counter 0 + +foreach main_table $main_tables { + ns_write "

    $main_table

    +
    + + [ad_audit_trail $db $audit_id [lindex $audit_tables $counter] $main_table $audit_id_column] + +
    + " + incr counter +} + +ns_write "[ad_admin_footer]" Index: web/openacs/www/admin/ecommerce/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/index.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,92 @@ +# index.tcl,v 3.0 2000/02/06 03:16:50 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "[ec_system_name] Administration"] + +

    [ec_system_name] Administration

    + +[ad_admin_context_bar Ecommerce] + +
    +Documentation: /doc/ecommerce.html + + +
      + +" + +set db [ns_db gethandle] + +# Problems + +set unresolved_problem_count [database_to_tcl_string $db "select count(*) from ec_problems_log where resolved_date is null"] + +ns_write " + +
    • Potential Problems ($unresolved_problem_count unresolved problem[ec_decode $unresolved_problem_count 1 "" "s"]) +

      +" + +set selection [ns_db 1row $db " +select + sum(one_if_within_n_days(confirmed_date,1)) as n_in_last_24_hours, + sum(one_if_within_n_days(confirmed_date,7)) as n_in_last_7_days +from ec_orders_reportable"] +set_variables_after_query + +set selection [ns_db 1row $db "select count(*) as n_products, round(avg(price::float8),2) as avg_price from ec_products_displayable"] +set_variables_after_query + +ns_write " + +

    • Orders / Shipments / Refunds ($n_in_last_24_hours orders in last 24 hours; $n_in_last_7_days in last 7 days) + +

      + +

    • Products ($n_products products; average price: [ec_pretty_price $avg_price]) + +

      +

    • Customer Service ([database_to_tcl_string $db "select count(*) from ec_customer_service_issues where close_date is null"] open issues) +

      +" + +if { [ad_parameter ProductCommentsAllowP ecommerce] } { + ns_write "

    • Customer Reviews ([database_to_tcl_string $db "select count(*) from ec_product_comments where approved_p is null"] not yet approved) +

      + " +} + +set n_not_yet_approved [database_to_tcl_string $db "select count(*) from ec_user_class_user_map where user_class_approved_p is null or user_class_approved_p='f'"] + +ns_write "

    • User Classes +($n_not_yet_approved not yet approved user[ec_decode $n_not_yet_approved 1 "" "s"]) + +

      +" + + +set multiple_retailers_p [ad_parameter MultipleRetailersPerProductP ecommerce] + +if { $multiple_retailers_p } { + ns_write "

    • Retailers\n" +} else { + ns_write "
    • Shipping Costs +
    • Sales Tax\n" +} + +ns_write "
    • Product Templates +" + + +ns_write "
    • Mailing Lists +
    • Email Templates\n + +

      + +

    • Audit [ec_system_name] +
    + +[ad_admin_footer] +" + + Index: web/openacs/www/admin/ecommerce/restore-one-id.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/restore-one-id.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/restore-one-id.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,85 @@ +# restore-one-id.tcl,v 3.0 2000/02/06 03:16:51 ron Exp +# Jesse 7/17 +# Tries to restore from the audit table to the main table +# for one id in the id_column + +set_the_usual_form_variables +# id, id_column, audit_table_name, main_table_name, rowid + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +# we have to generate audit information +set audit_fields "last_modified, last_modifying_user, modified_ip_address" +set audit_info "sysdate, '$user_id', '[DoubleApos [ns_conn peeraddr]]'" + +set db [ns_db gethandle] + +set sql_insert "" +set result "The $main_table_name table is not supported at this time." + +# Get all values from the selected row of the audit table +set selection [ns_db 1row $db "select * from $audit_table_name where rowid = '$rowid'"] +set_variables_after_query + +# ss_subcategory_features +if { [string compare $main_table_name "ss_subcategory_features"] == 0 } { + set sql_insert "insert into $main_table_name ( +feature_id, +subcategory_id, +feature_name, +recommended_p, +feature_description, +sort_key, +filter_p, +comparison_p, +feature_list_p, +$audit_fields +) values ( +'[DoubleApos $feature_id]', +'[DoubleApos $subcategory_id]', +'[DoubleApos $feature_name]', +'[DoubleApos $recommended_p]', +'[DoubleApos $feature_description]', +'[DoubleApos $sort_key]', +'[DoubleApos $filter_p]', +'[DoubleApos $comparison_p]', +'[DoubleApos $feature_list_p]', +$audit_info +)" + +} + +# ss_product_feature_map +if { [string compare $main_table_name "ss_product_feature_map"] == 0 } { + set sql_insert "" +} + +if { ![empty_string_p $sql_insert] } { + if [catch { set result [ns_db dml $db $sql_insert] } errmsg] { + set result $errmsg + } +} + +ns_return 200 text/html " +[ss_new_staff_header "Restore of $id_column $id"] +[ss_staff_context_bar "Restore Data"] + +

    Restore of $main_table_name

    +For a the SQL insert +
    +$sql_insert +
    +This result was obtained +
    +$result +
    +[ls_admin_footer]" Index: web/openacs/www/admin/ecommerce/cat/category-add-0.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/cat/category-add-0.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/cat/category-add-0.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,43 @@ +# category-add-0.tcl,v 3.0 2000/02/06 03:16:52 ron Exp +set_the_usual_form_variables +# prev_sort_key, next_sort_key + +# error checking: make sure that there is no category with a sort key +# equal to the new sort key (average of prev_sort_key and next_sort_key); +# otherwise warn them that their form is not up-to-date +set db [ns_db gethandle] +set n_conflicts [database_to_tcl_string $db "select count(*) +from ec_categories +where sort_key = ($prev_sort_key + $next_sort_key)/2"] + +if { $n_conflicts > 0 } { + ad_return_complaint 1 "
  • The page you came from appears to be out-of-date; + perhaps someone has changed the categories since you last reloaded the page. + Please go back to the previous page, push \"reload\" or \"refresh\" and try + again." + return +} + + +ReturnHeaders + +ns_write "[ad_admin_header "Add a New Category"] + +

    Add a New Category

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Product Categories"] "Add a New Category"] + +
    + +
      + +
      +[export_form_vars prev_sort_key next_sort_key] +Name: + +
      + +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/cat/category-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/cat/category-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/cat/category-add-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,49 @@ +# category-add-2.tcl,v 3.0 2000/02/06 03:16:53 ron Exp +set_the_usual_form_variables +# category_name, category_id, prev_sort_key, next_sort_key + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +# see first whether they already entered this category (in case they +# pushed submit twice), in which case, just redirect to +# index.tcl + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select category_id from ec_categories +where category_id=$category_id"] + +if { $selection != ""} { + ns_returnredirect "index.tcl" + return +} + +# now make sure there's no category with that sort key already +set n_conflicts [database_to_tcl_string $db "select count(*) +from ec_categories +where sort_key = ($prev_sort_key + $next_sort_key)/2"] + +if { $n_conflicts > 0 } { + ad_return_complaint 1 "
  • The category page appears to be out-of-date; + perhaps someone has changed the categories since you last reloaded the page. + Please go back to the category page, push + \"reload\" or \"refresh\" and try again." + return +} + +ns_db dml $db "insert into ec_categories +(category_id, category_name, sort_key, last_modified, last_modifying_user, modified_ip_address) +values +($category_id, '$QQcategory_name', ($prev_sort_key + $next_sort_key)/2, sysdate(), $user_id, '[DoubleApos [ns_conn peeraddr]]')" + + +ns_returnredirect "index.tcl" Index: web/openacs/www/admin/ecommerce/cat/category-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/cat/category-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/cat/category-add.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,49 @@ +# category-add.tcl,v 3.0 2000/02/06 03:16:54 ron Exp +set_the_usual_form_variables +# category_name, prev_sort_key, next_sort_key + +# error checking: make sure that there is no category with a sort key +# equal to the new sort key (average of prev_sort_key and next_sort_key); +# otherwise warn them that their form is not up-to-date +set db [ns_db gethandle] +set n_conflicts [database_to_tcl_string $db "select count(*) +from ec_categories +where sort_key = ($prev_sort_key + $next_sort_key)/2"] + +if { $n_conflicts > 0 } { + ad_return_complaint 1 "
  • The category page appears to be out-of-date; + perhaps someone has changed the categories since you last reloaded the page. + Please go back to the category page, push + \"reload\" or \"refresh\" and try again." + return +} + + +ReturnHeaders + +ns_write "[ad_admin_header "Confirm New Category"] + +

    Confirm New Category

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Categories & Subcategories"] "Confirm New Category"] + +
    + +Add the following new category? + +
    +$category_name +
    +" + +set category_id [database_to_tcl_string $db "select ec_category_id_sequence.nextval from dual"] + +ns_write "
    +[export_form_vars category_name category_id prev_sort_key next_sort_key] +
    + +
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/cat/category-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/cat/category-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/cat/category-delete-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,99 @@ +# category-delete-2.tcl,v 3.0 2000/02/06 03:16:55 ron Exp +set_the_usual_form_variables +# category_id + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_url_vars category_name category_id subcategory_id]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +# What has to be done (in order, so that no constraints are violated): +# 1. remove the rows in ec_subsubcategory_product_map where the +# subsubcategory_ids share a row with the subcategory_ids that share a +# row with $category_id in ec_subcategories +# 2. remove those rows in ec_subsubcategories +# 3. remove the rows in ec_subcategory_product_map where the subcategory_ids +# share a row with $category_id in ec_subcategories +# 4. remove those rows in ec_subcategories +# 5. remove the rows in ec_category_product_map where the category_id is +# $category_id +# 6. remove the rows in ec_category_template_map where the category_id is +# $category_id +# 7. remove the row in ec_categories where category_id = $category_id + +# So, here goes: + +set db [ns_db gethandle] +ns_db dml $db "begin transaction" + +# 1. remove the rows in ec_subsubcategory_product_map where the +# subsubcategory_ids share a row with the subcategory_ids that share a +# row with $category_id in ec_subcategories + +set subsubcategory_list [database_to_tcl_list $db "select subsubcategory_id from ec_subsubcategories where subcategory_id in (select subcategory_id from ec_subcategories where category_id=$category_id)"] + +set subcategory_list [database_to_tcl_list $db "select subcategory_id from ec_subcategories where category_id=$category_id"] + +ns_db dml $db "delete from ec_subsubcategory_product_map +where subsubcategory_id in (select subsubcategory_id from ec_subsubcategories where subcategory_id in (select subcategory_id from ec_subcategories where category_id=$category_id))" + +# audit table +foreach subsubcategory $subsubcategory_list { + ad_audit_delete_row $db [list $subsubcategory] [list subsubcategory_id] ec_subsubcat_prod_map_audit +} + +# 2. remove those rows in ec_subsubcategories + +ns_db dml $db "delete from ec_subsubcategories where subcategory_id in (select subcategory_id from ec_subcategories where category_id=$category_id)" + +# audit table +foreach subsubcategory $subsubcategory_list { + ad_audit_delete_row $db [list $subsubcategory] [list subsubcategory_id] ec_subsubcategories_audit +} + +# 3. remove the rows in ec_subcategory_product_map where the subcategory_ids +# share a row with $category_id in ec_subcategories + +ns_db dml $db "delete from ec_subcategory_product_map +where subcategory_id in (select subcategory_id from ec_subcategories where category_id=$category_id)" + +# audit table +foreach subcategory $subcategory_list { + ad_audit_delete_row $db [list $subcategory] [list subcategory_id] ec_subcat_prod_map_audit +} + +# 4. remove those rows in ec_subcategories + +ns_db dml $db "delete from ec_subcategories where category_id=$category_id" + +foreach subcategory $subcategory_list { + ad_audit_delete_row $db [list $subcategory] [list subcategory_id] ec_subcategories_audit +} + +# 5. remove the rows in ec_category_product_map where the category_id is +# $category_id + +ns_db dml $db "delete from ec_category_product_map where category_id=$category_id" +ad_audit_delete_row $db [list $category_id] [list category_id] ec_category_product_map_audit + +# 6. remove the rows in ec_category_template_map where the category_id is +# $category_id + +ns_db dml $db "delete from ec_category_template_map where category_id=$category_id" + +## no audit table associated with this one + +# 7. remove the row in ec_categories where category_id = $category_id + +ns_db dml $db "delete from ec_categories where category_id=$category_id" +ad_audit_delete_row $db [list $category_id] [list category_id] ec_categories_audit + +ns_db dml $db "end transaction" + +ns_returnredirect "index.tcl" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/cat/category-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/cat/category-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/cat/category-delete.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,31 @@ +# category-delete.tcl,v 3.0 2000/02/06 03:16:57 ron Exp +set_the_usual_form_variables +# category_id, category_name + +ReturnHeaders + +ns_write "[ad_admin_header "Confirm Deletion"] + +

    Confirm Deletion

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Categories & Subcategories"] [list "category.tcl?[export_url_vars category_id category_name]" $category_name] "Delete this Category"] + +
    + +
    +[export_form_vars category_id] +Please confirm that you wish to delete the category $category_name. Please also note the following: +

    +

      +
    • This will delete all subcategories and subsubcategories of the category $category_name. +
    • This will not delete the products in this category (if any). However, it will cause them to no longer be associated with this category. +
    • This will not delete the templates associated with this category (if any). However, it will cause them to no longer be associated with this category. +
    +

    +

    + +
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/cat/category-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/cat/category-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/cat/category-edit.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,26 @@ +# category-edit.tcl,v 3.0 2000/02/06 03:16:58 ron Exp +set_the_usual_form_variables +# category_name, category_id + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_url_vars category_name category_id]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + + +set db [ns_db gethandle] + +ns_db dml $db "update ec_categories +set category_name='$QQcategory_name', +last_modified=sysdate(), +last_modifying_user=$user_id, +modified_ip_address='[DoubleApos [ns_conn peeraddr]]' +where category_id=$category_id" + +ns_returnredirect "category.tcl?[export_url_vars category_id category_name]" Index: web/openacs/www/admin/ecommerce/cat/category-swap.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/cat/category-swap.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/cat/category-swap.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,29 @@ +# category-swap.tcl,v 3.0 2000/02/06 03:16:59 ron Exp +set_the_usual_form_variables +# category_id, next_category_id, sort_key, next_sort_key + +# switches the ordering of a category with that of the next category + +set db [ns_db gethandle] + +# check that the sort keys are the same as before; otherwise the page +# they got here from is out of date + +set item_match [database_to_tcl_string $db "select count(*) from ec_categories where category_id=$category_id and sort_key=$sort_key"] + +set next_item_match [database_to_tcl_string $db "select count(*) from ec_categories where category_id=$next_category_id and sort_key=$next_sort_key"] + +if { $item_match != 1 || $next_item_match != 1 } { + ad_return_complaint 1 "
  • The page you came from appears to be out-of-date; + perhaps someone has changed the categories since you last reloaded the page. + Please go back to the previous page, push \"reload\" or \"refresh\" and try + again." + return +} + +ns_db dml $db "begin transaction" +ns_db dml $db "update ec_categories set sort_key=$next_sort_key where category_id=$category_id" +ns_db dml $db "update ec_categories set sort_key=$sort_key where category_id=$next_category_id" +ns_db dml $db "end transaction" + +ns_returnredirect "index.tcl" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/cat/category.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/cat/category.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/cat/category.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,86 @@ +# category.tcl,v 3.0 2000/02/06 03:17:01 ron Exp +set_the_usual_form_variables +# category_id, category_name + +ReturnHeaders + +ns_write "[ad_admin_header "Category: $category_name"] + +

    Category: $category_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Categories & Subcategories"] "One Category"] + +
    + +
      + +
      +[export_form_vars category_id] +
    • Change category name to: + + +
      • + +

      + +

    • View all products in this category + +

      + +

    • Delete this category + +

      +" + +# Set audit variables +# audit_name, audit_id, audit_id_column, return_url, audit_tables, main_tables +set audit_name "$category_name" +set audit_id $category_id +set audit_id_column "category_id" +set return_url "category.tcl?[export_url_vars category_id category_name]" +set audit_tables [list ec_categories_audit ec_subcategories_audit ec_category_product_map_audit] +set main_tables [list ec_categories ec_subcategories ec_category_product_map] + +ns_write "

    • Audit Trail + +
    + +

    + +

    Current Subcategories of $category_name

    + +
    + +" + +set db [ns_db gethandle] +set selection [ns_db select $db "select subcategory_id, sort_key, subcategory_name from ec_subcategories where category_id=$category_id order by sort_key"] + +set old_subcategory_id "" +set old_sort_key "" +set subcategory_counter 0 + +while { [ns_db getrow $db $selection] } { + incr subcategory_counter + set_variables_after_query + if { ![empty_string_p $old_subcategory_id] } { + ns_write "" + } + set old_subcategory_id $subcategory_id + set old_sort_key $sort_key + ns_write "\n" +} + +if { $subcategory_counter != 0 } { + ns_write " + " +} else { + ns_write "You haven't set up any subcategories. Add a subcategory.\n" +} + +ns_write " +
      insert after    swap with next
    $subcategory_counter. $subcategory_name   insert after
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/cat/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/cat/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/cat/index.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,53 @@ +# index.tcl,v 3.0 2000/02/06 03:17:02 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Product Category Administration"] + +

    Product Category Administration

    + +[ad_admin_context_bar [list "../" "Ecommerce"] "Product Categories"] + +
    + +

    Current Categories

    + +
    + +" + +set db [ns_db gethandle] +set selection [ns_db select $db "select category_id, sort_key, category_name from ec_categories order by sort_key"] + +set old_category_id "" +set old_sort_key "" +set category_counter 0 + +while { [ns_db getrow $db $selection] } { + incr category_counter + set_variables_after_query + if { ![empty_string_p $old_category_id] } { + ns_write "" + } + set old_category_id $category_id + set old_sort_key $sort_key + ns_write "\n" +} + +if { $category_counter != 0 } { + ns_write " + " +} else { + ns_write "You haven't set up any categories. Add a category.\n" +} + +ns_write " +
      insert after    swap with next
    $category_counter. $category_name   insert after
    +
    + + +[ad_admin_footer] +" + + + + Index: web/openacs/www/admin/ecommerce/cat/subcategory-add-0.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/cat/subcategory-add-0.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/cat/subcategory-add-0.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,45 @@ +# subcategory-add-0.tcl,v 3.0 2000/02/06 03:17:03 ron Exp +set_the_usual_form_variables +# category_id, category_name, prev_sort_key, next_sort_key + +# error checking: make sure that there is no subcategory in this category +# with a sort key equal to the new sort key +# (average of prev_sort_key and next_sort_key); +# otherwise warn them that their form is not up-to-date + +set db [ns_db gethandle] +set n_conflicts [database_to_tcl_string $db "select count(*) +from ec_subcategories +where category_id=$category_id +and sort_key = ($prev_sort_key + $next_sort_key)/2"] + +if { $n_conflicts > 0 } { + ad_return_complaint 1 "
  • The page you came from appears to be out-of-date; + perhaps someone has changed the subcategories since you last reloaded the page. + Please go back to the previous page, push \"reload\" or \"refresh\" and try + again." + return +} + +ReturnHeaders + +ns_write "[ad_admin_header "Add a New Subcategory"] + +

    Add a New Subcategory

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Product Categories"] [list "category.tcl?[export_url_vars category_id category_name]" $category_name] "Add a New Subcategory"] + +
    + +
      + +
      +[export_form_vars category_id category_name prev_sort_key next_sort_key] +Name: + +
      + +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/cat/subcategory-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/cat/subcategory-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/cat/subcategory-add-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,49 @@ +# subcategory-add-2.tcl,v 3.0 2000/02/06 03:17:05 ron Exp +set_the_usual_form_variables +# category_name, category_id, subcategory_name, subcategory_id, prev_sort_key, next_sort_key + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_url_vars category_name category_id subcategory_name subcategory_id]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +# see first whether they already entered this subcategory (in case they +# pushed submit twice), in which case, just redirect to +# category.tcl + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select subcategory_id from ec_subcategories +where subcategory_id=$subcategory_id"] + +if { $selection != ""} { + ns_returnredirect "category.tcl?[export_url_vars category_id category_name]" + return +} + +# now make sure there's no subcategory in this category with that sort key already + +set n_conflicts [database_to_tcl_string $db "select count(*) +from ec_subcategories +where category_id=$category_id +and sort_key = ($prev_sort_key + $next_sort_key)/2"] +if { $n_conflicts > 0 } { + ad_return_complaint 1 "
  • The $category_name page appears to be out-of-date; + perhaps someone has changed the subcategories since you last reloaded the page. + Please go back to the $category_name page, push + \"reload\" or \"refresh\" and try again." + return +} + +ns_db dml $db "insert into ec_subcategories +(category_id, subcategory_id, subcategory_name, sort_key, last_modified, last_modifying_user, modified_ip_address) +values +($category_id, $subcategory_id, '$QQsubcategory_name', ($prev_sort_key + $next_sort_key)/2, sysdate(), $user_id, '[DoubleApos [ns_conn peeraddr]]')" + +ns_returnredirect "category.tcl?[export_url_vars category_id category_name]" Index: web/openacs/www/admin/ecommerce/cat/subcategory-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/cat/subcategory-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/cat/subcategory-add.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,51 @@ +# subcategory-add.tcl,v 3.0 2000/02/06 03:17:06 ron Exp +set_the_usual_form_variables +# category_id, category_name, subcategory_name, prev_sort_key, next_sort_key + +# error checking: make sure that there is no subcategory in this category +# with a sort key equal to the new sort key +# (average of prev_sort_key and next_sort_key); +# otherwise warn them that their form is not up-to-date + +set db [ns_db gethandle] +set n_conflicts [database_to_tcl_string $db "select count(*) +from ec_subcategories +where category_id=$category_id +and sort_key = ($prev_sort_key + $next_sort_key)/2"] + +if { $n_conflicts > 0 } { + ad_return_complaint 1 "
  • The $category_name page appears to be out-of-date; + perhaps someone has changed the subcategories since you last reloaded the page. + Please go back to the $category_name page, push + \"reload\" or \"refresh\" and try again." + return +} + +ReturnHeaders + +ns_write "[ad_admin_header "Confirm New Subcategory"] + +

    Confirm New Subcategory

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Categories & Subcategories"] [list "category.tcl?[export_url_vars category_id category_name]" $category_name] "Confirm New Subcategory"] + +
    + +Add the following new subcategory to $category_name? + +
    +$subcategory_name +
    +" + +set subcategory_id [database_to_tcl_string $db "select ec_subcategory_id_sequence.nextval from dual"] + +ns_write "
    +[export_form_vars category_name category_id subcategory_name subcategory_id prev_sort_key next_sort_key] +
    + +
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/cat/subcategory-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/cat/subcategory-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/cat/subcategory-delete-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,68 @@ +# subcategory-delete-2.tcl,v 3.0 2000/02/06 03:17:07 ron Exp +set_the_usual_form_variables +# subcategory_id + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_url_vars subcategory_id]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +# What has to be done (in order, so that no constraints are violated): +# 1. remove the rows in ec_subsubcategory_product_map where the subsubcategory_ids +# share a row with $subcategory_id in ec_subsubcategories +# 2. remove those rows in ec_subsubcategories +# 3. remove the rows in ec_subcategory_product_map where the subcategory_id is +# $subcategory_id +# 4. remove the row in ec_subcategories where subcategory_id = $subcategory_id + +# So, here goes: + +set db [ns_db gethandle] +ns_db dml $db "begin transaction" + +# 1. remove the rows in ec_subsubcategory_product_map where the subsubcategory_ids +# share a row with $subcategory_id in ec_subsubcategories + +set subsubcategory_list [database_to_tcl_list $db "select subsubcategory_id from ec_subsubcategories where subcategory_id=$subcategory_id"] + +ns_db dml $db "delete from ec_subsubcategory_product_map +where subsubcategory_id in (select subsubcategory_id from ec_subsubcategories where subcategory_id=$subcategory_id)" + +# audit table +foreach subsubcategory $subsubcategory_list { + ad_audit_delete_row $db [list $subsubcategory] [list subsubcategory_id] ec_subsubcat_prod_map_audit +} + +# 2. remove those rows in ec_subsubcategories + +ns_db dml $db "delete from ec_subsubcategories where subcategory_id=$subcategory_id" + +# audit table +foreach subsubcategory $subsubcategory_list { + ad_audit_delete_row $db [list $subsubcategory] [list subsubcategory_id] ec_subsubcategories_audit +} + +# 3. remove the rows in ec_subcategory_product_map where the subcategory_id is +# $subcategory_id + +ns_db dml $db "delete from ec_subcategory_product_map where subcategory_id=$subcategory_id" + +# audit table +ad_audit_delete_row $db [list $subcategory_id] [list subcategory_id] ec_subcat_prod_map_audit + +# 4. remove the row in ec_subcategories where subcategory_id = $subcategory_id + +ns_db dml $db "delete from ec_subcategories where subcategory_id=$subcategory_id" + +# audit table +ad_audit_delete_row $db [list $subcategory_id] [list subcategory_id] ec_subcategories_audit + +ns_db dml $db "end transaction" + +ns_returnredirect "index.tcl" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/cat/subcategory-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/cat/subcategory-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/cat/subcategory-delete.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,30 @@ +# subcategory-delete.tcl,v 3.0 2000/02/06 03:17:08 ron Exp +set_the_usual_form_variables +# category_id, category_name, subcategory_id, subcategory_name + +ReturnHeaders + +ns_write "[ad_admin_header "Confirm Deletion"] + +

    Confirm Deletion

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Categories & Subcategories"] [list "category.tcl?[export_url_vars category_id category_name]" $category_name] [list "subcategory.tcl?[export_url_vars subcategory_id subcategory_name category_id category_name]" $subcategory_name] "Delete this Subcategory"] + +
    + +
    +[export_form_vars subcategory_id category_id category_name] +Please confirm that you wish to delete the category $category_name. Please also note the following: +

    +

      +
    • This will delete all subsubcategories of the subcategory $subcategory_name. +
    • This will not delete the products in this subcategory (if any). However, it will cause them to no longer be associated with this subcategory. +
    +

    +

    + +
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/cat/subcategory-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/cat/subcategory-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/cat/subcategory-edit.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,26 @@ +# subcategory-edit.tcl,v 3.0 2000/02/06 03:17:09 ron Exp +set_the_usual_form_variables +# category_name, category_id, subcategory_id, subcategory_name + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_url_vars category_name category_id subcategory_id subcategory_name]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + + +set db [ns_db gethandle] + +ns_db dml $db "update ec_subcategories +set subcategory_name='$QQsubcategory_name', +last_modified=sysdate(), +last_modifying_user=$user_id, +modified_ip_address='[DoubleApos [ns_conn peeraddr]]' +where subcategory_id=$subcategory_id" + +ns_returnredirect "subcategory.tcl?[export_url_vars category_id category_name subcategory_id subcategory_name]" Index: web/openacs/www/admin/ecommerce/cat/subcategory-swap.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/cat/subcategory-swap.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/cat/subcategory-swap.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,26 @@ +# subcategory-swap.tcl,v 3.0 2000/02/06 03:17:10 ron Exp +set_the_usual_form_variables +# subcategory_id, next_subcategory_id, sort_key, next_sort_key, category_id, category_name + +# switches the ordering of a category with that of the next subcategory + +set db [ns_db gethandle] + +set item_match [database_to_tcl_string $db "select count(*) from ec_subcategories where subcategory_id=$subcategory_id and sort_key=$sort_key"] + +set next_item_match [database_to_tcl_string $db "select count(*) from ec_subcategories where subcategory_id=$next_subcategory_id and sort_key=$next_sort_key"] + +if { $item_match != 1 || $next_item_match != 1 } { + ad_return_complaint 1 "
  • The page you came from appears to be out-of-date; + perhaps someone has changed the subcategories since you last reloaded the page. + Please go back to the previous page, push \"reload\" or \"refresh\" and try + again." + return +} + +ns_db dml $db "begin transaction" +ns_db dml $db "update ec_subcategories set sort_key=$next_sort_key where subcategory_id=$subcategory_id" +ns_db dml $db "update ec_subcategories set sort_key=$sort_key where subcategory_id=$next_subcategory_id" +ns_db dml $db "end transaction" + +ns_returnredirect "category.tcl?[export_url_vars category_id category_name]" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/cat/subcategory.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/cat/subcategory.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/cat/subcategory.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,87 @@ +# subcategory.tcl,v 3.0 2000/02/06 03:17:11 ron Exp +set_the_usual_form_variables +# category_id, category_name, subcategory_id, subcategory_name + +ReturnHeaders + +ns_write "[ad_admin_header "Subcategory: $subcategory_name"] + +

    Subcategory: $subcategory_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Categories & Subcategories"] [list "category.tcl?[export_url_vars category_id category_name]" $category_name] "One Subcategory"] + +
    + +
      + +
      +[export_form_vars category_id category_name subcategory_id] +
    • Change subcategory name to: + + +
      • + +

      + +

    • View all products in this subcategory + +

      + +

    • Delete this subcategory + +

      +" + +# Set audit variables +# audit_name, audit_id, audit_id_column, return_url, audit_tables, main_tables +set audit_name "$subcategory_name" +set audit_id $subcategory_id +set audit_id_column "subcategory_id" +set return_url "subcategory.tcl?[export_url_vars subcategory_id subcategory_name]" +set audit_tables [list ec_subcategories_audit ec_subsubcategories_audit ec_subcat_prod_map_audit] +set main_tables [list ec_subcategories ec_subsubcategories ec_subcategory_product_map] + +ns_write "

    • Audit Trail + +
    + +

    Current Subsubcategories of $subcategory_name

    + + +" + +set db [ns_db gethandle] +set selection [ns_db select $db "select subsubcategory_id, sort_key, subsubcategory_name from ec_subsubcategories where subcategory_id=$subcategory_id order by sort_key"] + +set old_subsubcategory_id "" +set old_sort_key "" +set subsubcategory_counter 0 + +while { [ns_db getrow $db $selection] } { + incr subsubcategory_counter + set_variables_after_query + if { ![empty_string_p $old_subsubcategory_id] } { + ns_write "" + } + set old_subsubcategory_id $subsubcategory_id + set old_sort_key $sort_key + ns_write "\n" +} + +if { $subsubcategory_counter != 0 } { + ns_write " + " +} else { + ns_write "You haven't set up any subsubcategories. Add a subsubcategory.\n" +} + + +ns_write "
      insert after    swap with next
    $subsubcategory_counter. $subsubcategory_name   insert after
    +[ad_admin_footer] +" + + + + + + Index: web/openacs/www/admin/ecommerce/cat/subsubcategory-add-0.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/cat/subsubcategory-add-0.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/cat/subsubcategory-add-0.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,46 @@ +# subsubcategory-add-0.tcl,v 3.0 2000/02/06 03:17:13 ron Exp +set_the_usual_form_variables +# category_id, category_name, subcategory_id, subcategory_name, prev_sort_key, next_sort_key + +# error checking: make sure that there is no subsubcategory in this subcategory +# with a sort key equal to the new sort key +# (average of prev_sort_key and next_sort_key); +# otherwise warn them that their form is not up-to-date + +set db [ns_db gethandle] +set n_conflicts [database_to_tcl_string $db "select count(*) +from ec_subsubcategories +where subcategory_id=$subcategory_id +and sort_key = ($prev_sort_key + $next_sort_key)/2"] + +if { $n_conflicts > 0 } { + ad_return_complaint 1 "
  • The page you came from appears to be out-of-date; + perhaps someone has changed the subsubcategories since you last reloaded the page. + Please go back to the previous page, push \"reload\" or \"refresh\" and try + again." + return +} + + +ReturnHeaders + +ns_write "[ad_admin_header "Add a New Subsubcategory"] + +

    Add a New Subsubcategory

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Product Categories"] [list "category.tcl?[export_url_vars category_id category_name]" $category_name] [list "subcategory.tcl?[export_url_vars category_id category_name subcategory_id subcategory_name]" $subcategory_name] "Add a New Subsubcategory"] + +
    + +
      + +
      +[export_form_vars category_id category_name subcategory_id subcategory_name prev_sort_key next_sort_key] +Name: + +
      + +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/cat/subsubcategory-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/cat/subsubcategory-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/cat/subsubcategory-add-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,52 @@ +# subsubcategory-add-2.tcl,v 3.0 2000/02/06 03:17:14 ron Exp +set_the_usual_form_variables +# category_name, category_id, subcategory_name, subcategory_id, subsubcategory_name, subsubcategory_id, prev_sort_key, next_sort_key + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_url_vars category_name category_id subcategory_name subcategory_id subsubcategory_name subsubcategory_id]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + + +# see first whether they already entered this subsubcategory (in case they +# pushed submit twice), in which case, just redirect to +# subcategory.tcl + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select subsubcategory_id from ec_subsubcategories +where subsubcategory_id=$subsubcategory_id"] + +if { $selection != ""} { + ns_returnredirect "subcategory.tcl?[export_url_vars category_id category_name subcategory_id subcategory_name]" + return +} + +# now make sure there's no subsubcategory in this subcategory with that sort key already + +set n_conflicts [database_to_tcl_string $db "select count(*) +from ec_subsubcategories +where subcategory_id=$subcategory_id +and sort_key = ($prev_sort_key + $next_sort_key)/2"] + +if { $n_conflicts > 0 } { + ad_return_complaint 1 "
  • The $subcategory_name page appears to be out-of-date; + perhaps someone has changed the subcategories since you last reloaded the page. + Please go back to the $subcategory_name page, push + \"reload\" or \"refresh\" and try again." + return +} + +ns_db dml $db "insert into ec_subsubcategories +(subcategory_id, subsubcategory_id, subsubcategory_name, sort_key, last_modified, last_modifying_user, modified_ip_address) +values +($subcategory_id, $subsubcategory_id, '$QQsubsubcategory_name', ($prev_sort_key + $next_sort_key)/2, sysdate(), $user_id, '[DoubleApos [ns_conn peeraddr]]')" + +ns_returnredirect "subcategory.tcl?[export_url_vars category_id category_name subcategory_id subcategory_name]" + Index: web/openacs/www/admin/ecommerce/cat/subsubcategory-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/cat/subsubcategory-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/cat/subsubcategory-add.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,52 @@ +# subsubcategory-add.tcl,v 3.0 2000/02/06 03:17:15 ron Exp +set_the_usual_form_variables +# category_id, category_name, subcategory_id, subcategory_name, subsubcategory_name, prev_sort_key, next_sort_key + +# error checking: make sure that there is no subcategory in this category +# with a sort key equal to the new sort key +# (average of prev_sort_key and next_sort_key); +# otherwise warn them that their form is not up-to-date + +set db [ns_db gethandle] +set n_conflicts [database_to_tcl_string $db "select count(*) +from ec_subsubcategories +where subcategory_id=$subcategory_id +and sort_key = ($prev_sort_key + $next_sort_key)/2"] + +if { $n_conflicts > 0 } { + ad_return_complaint 1 "
  • The $subcategory_name page appears to be out-of-date; + perhaps someone has changed the subcategories since you last reloaded the page. + Please go back to the $subcategory_name page, push + \"reload\" or \"refresh\" and try again." + return +} + + +ReturnHeaders + +ns_write "[ad_admin_header "Confirm New Subsubcategory"] + +

    Confirm New Subsubcategory

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Categories & Subcategories"] "Confirm New Subsubcategory"] + +
    + +Add the following new subsubcategory to $subcategory_name? + +
    +$subsubcategory_name +
    +" + +set subsubcategory_id [database_to_tcl_string $db "select ec_subsubcategory_id_sequence.nextval from dual"] + +ns_write "
    +[export_form_vars category_name category_id subcategory_name subcategory_id subsubcategory_name subsubcategory_id prev_sort_key next_sort_key] +
    + +
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/cat/subsubcategory-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/cat/subsubcategory-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/cat/subsubcategory-delete-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,43 @@ +# subsubcategory-delete-2.tcl,v 3.0 2000/02/06 03:17:16 ron Exp +set_the_usual_form_variables +# subsubcategory_id, subcategory_id, subcategory_name, category_id, category_name + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_url_vars category_name category_id subcategory_id subcategory_name subsubcategory_id]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +# What has to be done (in order, so that no constraints are violated): +# 1. remove the rows in ec_subsubcategory_product_map where subsubcategory_id +# is $subsubcategory_id +# 2. remove the row in ec_subsubcategories where subsubcategory_id = $subsubcategory_id + +# So, here goes: + +set db [ns_db gethandle] +ns_db dml $db "begin transaction" + +# 1. remove the rows in ec_subsubcategory_product_map where subsubcategory_id +# is $subsubcategory_id + +ns_db dml $db "delete from ec_subsubcategory_product_map where subsubcategory_id=$subsubcategory_id" + +# audit table +ad_audit_delete_row $db [list $subsubcategory_id] [list subsubcategory_id] ec_subsubcat_prod_map_audit + +# 2. remove the row in ec_subsubcategories where subsubcategory_id = $subsubcategory_id + +ns_db dml $db "delete from ec_subsubcategories where subsubcategory_id = $subsubcategory_id" + +# audit table +ad_audit_delete_row $db [list $subsubcategory_id] [list subsubcategory_id] ec_subsubcategories_audit + +ns_db dml $db "end transaction" + +ns_returnredirect "subcategory.tcl?[export_url_vars subcategory_id subcategory_name category_id category_name]" Index: web/openacs/www/admin/ecommerce/cat/subsubcategory-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/cat/subsubcategory-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/cat/subsubcategory-delete.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,25 @@ +# subsubcategory-delete.tcl,v 3.0 2000/02/06 03:17:17 ron Exp +set_the_usual_form_variables +# category_id, category_name, subcategory_id, subcategory_name, subsubcategory_id, subsubcategory_name + +ReturnHeaders + +ns_write "[ad_admin_header "Confirm Deletion"] + +

    Confirm Deletion

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Categories & Subcategories"] [list "category.tcl?[export_url_vars category_id category_name]" $category_name] [list "subcategory.tcl?[export_url_vars subcategory_id subcategory_name category_id category_name]" $subcategory_name] [list "subsubcategory.tcl?[export_url_vars subsubcategory_id subsubcategory_name subcategory_id subcategory_name category_id category_name]" $subsubcategory_name] "Delete this Subsubcategory"] + +
    + +
    +[export_form_vars subsubcategory_id subcategory_id subcategory_name category_id category_name] +Please confirm that you wish to delete the subsubcategory $subsubcategory_name. This will not delete the products in this subsubcategory (if any). However, it will cause them to no longer be associated with this subsubcategory. +

    +

    + +
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/cat/subsubcategory-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/cat/subsubcategory-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/cat/subsubcategory-edit.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,25 @@ +# subsubcategory-edit.tcl,v 3.0 2000/02/06 03:17:18 ron Exp +set_the_usual_form_variables +# category_name, category_id, subcategory_name, subcategory_id, subsubcategory_id, subsubcategory_name + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_url_vars category_name category_id subcategory_id subcategory_name]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +ns_db dml $db "update ec_subsubcategories +set subsubcategory_name='$QQsubsubcategory_name', +last_modified=sysdate(), +last_modifying_user=$user_id, +modified_ip_address='[DoubleApos [ns_conn peeraddr]]' +where subsubcategory_id=$subsubcategory_id" + +ns_returnredirect "subsubcategory.tcl?[export_url_vars category_id category_name subcategory_id subcategory_name subsubcategory_id subsubcategory_name]" Index: web/openacs/www/admin/ecommerce/cat/subsubcategory-swap.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/cat/subsubcategory-swap.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/cat/subsubcategory-swap.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,27 @@ +# subsubcategory-swap.tcl,v 3.0 2000/02/06 03:17:20 ron Exp +set_the_usual_form_variables +# subsubcategory_id, next_subsubcategory_id, sort_key, next_sort_key, category_id, category_name, subcategory_id, subcategory_name + +# switches the ordering of a category with that of the next subsubcategory + +set db [ns_db gethandle] + +set item_match [database_to_tcl_string $db "select count(*) from ec_subsubcategories where subsubcategory_id=$subsubcategory_id and sort_key=$sort_key"] + +set next_item_match [database_to_tcl_string $db "select count(*) from ec_subsubcategories where subsubcategory_id=$next_subsubcategory_id and sort_key=$next_sort_key"] + +if { $item_match != 1 || $next_item_match != 1 } { + ad_return_complaint 1 "
  • The page you came from appears to be out-of-date; + perhaps someone has changed the subsubcategories since you last reloaded the page. + Please go back to the previous page, push \"reload\" or \"refresh\" and try + again." + return +} + + +ns_db dml $db "begin transaction" +ns_db dml $db "update ec_subsubcategories set sort_key=$next_sort_key where subsubcategory_id=$subsubcategory_id" +ns_db dml $db "update ec_subsubcategories set sort_key=$sort_key where subsubcategory_id=$next_subsubcategory_id" +ns_db dml $db "end transaction" + +ns_returnredirect "subcategory.tcl?[export_url_vars category_id category_name subcategory_id subcategory_name]" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/cat/subsubcategory.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/cat/subsubcategory.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/cat/subsubcategory.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,55 @@ +# subsubcategory.tcl,v 3.0 2000/02/06 03:17:21 ron Exp +set_the_usual_form_variables +# category_id, category_name, subcategory_id, subcategory_name, subsubcategory_id, subsubcategory_name + +ReturnHeaders + +ns_write "[ad_admin_header "Subsubcategory: $subsubcategory_name"] + +

    Subsubcategory: $subsubcategory_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Categories & Subcategories"] [list "category.tcl?[export_url_vars category_id category_name]" $category_name] [list "subcategory.tcl?[export_url_vars category_id category_name subcategory_id subcategory_name]" $subcategory_name] "One Subsubcategory"] + +
    + +
      + +
      +[export_form_vars category_id category_name subcategory_id subcategory_name subsubcategory_id] +
    • Change subsubcategory name to: + + +
      • + +

      + +

    • View all products in this subsubcategory + +

      + +

    • Delete this subsubcategory + +

      +" + +# Set audit variables +# audit_name, audit_id, audit_id_column, return_url, audit_tables, main_tables +set audit_name "$subsubcategory_name" +set audit_id $subsubcategory_id +set audit_id_column "subsubcategory_id" +set return_url "subsubcategory.tcl?[export_url_vars subsubcategory_id subsubcategory_name]" +set audit_tables [list ec_subsubcategories_audit ec_subsubcat_prod_map_audit] +set main_tables [list ec_subsubcategories ec_subsubcategory_product_map] + +ns_write "

    • Audit Trail + +
    + +[ad_admin_footer] +" + + + + + + Index: web/openacs/www/admin/ecommerce/customer-reviews/approval-change.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-reviews/approval-change.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-reviews/approval-change.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,28 @@ +# approval-change.tcl,v 3.0 2000/02/06 03:17:23 ron Exp +set_the_usual_form_variables +# approved_p, comment_id, +# possibly return_url + +set user_id [ad_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] +ns_db dml $db "update ec_product_comments set +approved_p='$approved_p', +last_modified = sysdate(), +last_modifying_user = $user_id, +modified_ip_address = '[ns_conn peeraddr]' +where comment_id=$comment_id" + +if { ![info exists return_url] } { + ns_returnredirect index.tcl +} else { + ns_returnredirect $return_url +} Index: web/openacs/www/admin/ecommerce/customer-reviews/index-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-reviews/index-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-reviews/index-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,104 @@ +# index-2.tcl,v 3.0 2000/02/06 03:17:24 ron Exp +set_the_usual_form_variables +# approved_p or product_id + +set db [ns_db gethandle] + +if { [info exists approved_p] } { + if { $approved_p == "null" } { + set review_status "Not Yet Approved/Disapproved" + set query_end "and approved_p is null" + } elseif { $approved_p == "t" } { + set review_status "Approved" + set query_end "and approved_p='t'" + } elseif { $approved_p == "f" } { + set review_status "Disapproved" + set query_end "and approved_p='f'" + } else { + set review_status "" + set query_end "" + } + + set page_title "$review_status Reviews" + set navbar [ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Customer Reviews"] "$review_status Reviews"] + set return_url "index-2.tcl?[export_url_vars approved_p]" + +} elseif { [info exists product_id] } { + set product_name [ec_product_name $product_id] + set page_title $product_name + set navbar [ad_admin_context_bar [list "../" "Ecommerce"] [list "../products/index.tcl" "Products"] [list "../products/one.tcl?product_id=$product_id" "One"] "Customer Reviews"] + set query_end "and p.product_id=$product_id" + set return_url "index-2.tcl?[export_url_vars product_id]" +} + +ReturnHeaders +ns_write "[ad_admin_header $page_title] + +

    $page_title

    + +$navbar + +
    + +
      +" + +# Set audit variables +# audit_id_column, return_url, audit_tables, main_tables +set audit_id_column "comment_id" +set audit_tables [list ec_product_comments_audit] +set main_tables [list ec_product_comments] + + +set selection [ns_db select $db "select c.comment_id, c.product_id, c.user_id, c.user_comment, c.one_line_summary, c.rating, p.product_name, u.email, c.comment_date, c.approved_p +from ec_product_comments c, ec_products p, users u +where c.product_id = p.product_id +and c. user_id = u.user_id +$query_end +order by c.comment_date desc +"] + + +set review_counter 0 + +while { [ns_db getrow $db $selection] } { + incr review_counter + set_variables_after_query + ns_write "
    • [util_AnsiDatetoPrettyDate $comment_date]
      + $product_name
      + $email [ec_display_rating $rating]
      + $one_line_summary
      + [ns_quotehtml $user_comment] +
      + " + + if { [info exists product_id] } { + # then we don't know a priori whether this is an approved review + ns_write "Review Status: " + if { $approved_p == "t" } { + ns_write "Approved
      " + } elseif { $approved_p == "f" } { + ns_write "Disapproved
      " + } else { + ns_write "Not yet Approved/Disapproved
      " + } + } + + # Set audit variables + # audit_name, audit_id + set audit_name "Customer Review $one_line_summary" + set audit_id $comment_id + + ns_write "\[Approve | Disapprove | Audit Trail\] +

      + " +} + +if { $review_counter == 0 } { + ns_write "No reviews were found.\n" +} + +ns_write "

    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/customer-reviews/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-reviews/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-reviews/index.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,60 @@ +# index.tcl,v 3.0 2000/02/06 03:17:26 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Customer Reviews"] + +

    Customer Reviews

    + +[ad_admin_context_bar [list "../" "Ecommerce"] "Customer Reviews"] + +
    +" + +if {[ad_parameter ProductCommentsNeedApprovalP ecommerce]} { + ns_write "Comments must be approved before they will appear on the web site." +} else { + ns_write "Your ecommerce system is set up so that comments automatically appear on the web site, unless you specifically Disapprove them. Even though it's not necessary, you may also wish to specifically Approve comments so that you can distinguish them from comments that you have not yet looked at." +} + +ns_write " +
      +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select approved_p, count(*) as n_reviews +from ec_product_comments +group by approved_p +order by approved_p desc"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if [empty_string_p $approved_p] { + set passthrough_approved_p "null" + set anchor_value "Not Yet Approved/Disapproved Customer Reviews" + } elseif { $approved_p == "t" } { + set passthrough_approved_p "t" + set anchor_value "Approved Reviews" + } elseif { $approved_p == "f" } { + set passthrough_approved_p "f" + set anchor_value "Disapproved Reviews" + } else { + ns_log Error "/admin/ecommerce/customer-reviews/index.tcl found unrecognized approved_p value of \"$approved_p\"" + # note that we'll probably also get a Tcl error below + } + ns_write "
    • $anchor_value ($n_reviews)\n\n

      \n\n" +} + +set table_names_and_id_column [list ec_product_comments ec_product_comments_audit comment_id] + +ns_write " + +

      + +

    • Audit All Customer Reviews + +
    + +[ad_admin_footer] +" + Index: web/openacs/www/admin/ecommerce/customer-reviews/one.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-reviews/one.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-reviews/one.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,50 @@ +# one.tcl,v 3.0 2000/02/06 03:17:27 ron Exp +set_the_usual_form_variables +# comment_id + +ReturnHeaders + +ns_write "[ad_admin_header "One Review"] + +

    One Review

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Customer Reviews"] "One Review"] + +
    +
    +" +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select c.product_id, c.user_id, c.user_comment, c.one_line_summary, c.rating, p.product_name, u.email, c.comment_date, c.approved_p +from ec_product_comments c, ec_products p, users u +where c.product_id = p.product_id +and c. user_id = u.user_id +and c.comment_id=$comment_id"] + +set_variables_after_query + +ns_write "[util_AnsiDatetoPrettyDate $comment_date]
    +$product_name
    +$email [ec_display_rating $rating]
    +$one_line_summary
    +$user_comment +
    +" + +if { [info exists product_id] } { + # then we don't know a priori whether this is an approved review + ns_write "Review Status: " + if { $approved_p == "t" } { + ns_write "Approved
    " + } elseif { $approved_p == "f" } { + ns_write "Disapproved
    " + } else { + ns_write "Not yet Approved/Disapproved
    " + } +} + +ns_write "\[Approve | Disapprove\] + +
    +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/customer-service/actions.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/actions.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/actions.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,235 @@ +# actions.tcl,v 3.0 2000/02/06 03:17:28 ron Exp +set_form_variables 0 +# possibly view_info_used and/or view_rep and/or view_interaction_date and/or order_by + +if { ![info exists view_info_used] } { + set view_info_used "none" +} +if { ![info exists view_rep] } { + set view_rep "all" +} +if { ![info exists view_interaction_date] } { + set view_interaction_date "all" +} +if { ![info exists order_by] } { + set order_by "a.action_id" +} + + +ReturnHeaders + +ns_write "[ad_admin_header "Customer Service Actions"] + +

    Customer Service Actions

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] "Actions"] + +
    + +
    +[export_form_vars view_interaction_date] + + + + + + + + + + +
    Info UsedRepInteraction Date
    + + + +" + +set interaction_date_list [list [list last_24 "last 24 hrs"] [list last_week "last week"] [list last_month "last month"] [list all all]] + +set linked_interaction_date_list [list] + +foreach interaction_date $interaction_date_list { + if {$view_interaction_date == [lindex $interaction_date 0]} { + lappend linked_interaction_date_list "[lindex $interaction_date 1]" + } else { + lappend linked_interaction_date_list "[lindex $interaction_date 1]" + } +} + + +ns_write "\[ [join $linked_interaction_date_list " | "] \] + +
    + +
    +
    +" + +if { $view_rep == "all" } { + set rep_query_bit "" +} else { + set rep_query_bit "and i.customer_service_rep=[ns_dbquotevalue $view_rep]" +} + +if { $view_interaction_date == "last_24" } { + set interaction_date_query_bit "and sysdate()-i.interaction_date <= 1" +} elseif { $view_interaction_date == "last_week" } { + set interaction_date_query_bit "and sysdate()-i.interaction_date <= 7" +} elseif { $view_interaction_date == "last_month" } { + set interaction_date_query_bit "and months_between(sysdate(),i.interaction_date) <= 1" +} else { + set interaction_date_query_bit "" +} + +if { $view_info_used == "none" } { + set sql_query "select a.action_id, a.interaction_id, a.issue_id, i.interaction_date, i.customer_service_rep, i.interaction_originator, i.interaction_type, to_char(i.interaction_date,'YYYY-MM-DD HH24:MI:SS') as full_interaction_date, reps.first_names as rep_first_names, reps.last_name as rep_last_name, i.user_identification_id, customer_info.user_id as customer_user_id, customer_info.first_names as customer_first_names, customer_info.last_name as customer_last_name + from ec_customer_service_actions a, ec_customer_serv_interactions i, users reps, + (select id.user_identification_id, id.user_id, u2.first_names, u2.last_name from ec_user_identification id, users u2 where id.user_id=u2.user_id(+)) customer_info + where a.interaction_id = i.interaction_id + and i.user_identification_id=customer_info.user_identification_id + and i.customer_service_rep=reps.user_id(+) + and 0 = (select count(*) from ec_cs_action_info_used_map map where map.action_id=a.action_id) + $interaction_date_query_bit $rep_query_bit + order by $order_by + " +} elseif { $view_info_used == "all others" } { + if { [llength $important_info_used_list] > 0 } { + set safe_important_info_used_list [DoubleApos $important_info_used_list] + set info_used_query_bit "and map.info_used not in ('[join $safe_important_info_used_list "', '"]')" + } else { + set info_used_query_bit "" + } + + set sql_query "select a.action_id, a.interaction_id, a.issue_id, i.interaction_date, i.customer_service_rep, i.user_identification_id, i.interaction_originator, i.interaction_type, to_char(i.interaction_date,'YYYY-MM-DD HH24:MI:SS') as full_interaction_date, reps.first_names as rep_first_names, reps.last_name as rep_last_name, customer_info.user_id as customer_user_id, customer_info.first_names as customer_first_names, customer_info.last_name as customer_last_name + from ec_customer_service_actions a, ec_customer_serv_interactions i, ec_cs_action_info_used_map map, users reps, + (select id.user_identification_id, id.user_id, u2.first_names, u2.last_name from ec_user_identification id, users u2 where id.user_id=u2.user_id(+)) customer_info + where a.interaction_id = i.interaction_id + and i.user_identification_id=customer_info.user_identification_id + and a.action_id=map.action_id + and i.customer_service_rep=reps.user_id(+) + $info_used_query_bit $interaction_date_query_bit $rep_query_bit + order by $order_by + " +} else { + + set sql_query "select a.action_id, a.interaction_id, a.issue_id, i.interaction_date, i.customer_service_rep, i.user_identification_id, i.interaction_originator, i.interaction_type, to_char(i.interaction_date,'YYYY-MM-DD HH24:MI:SS') as full_interaction_date, reps.first_names as rep_first_names, reps.last_name as rep_last_name, customer_info.user_id as customer_user_id, customer_info.first_names as customer_first_names, customer_info.last_name as customer_last_name + from ec_customer_service_actions a, ec_customer_serv_interactions i, ec_cs_action_info_used_map map, users reps, + (select id.user_identification_id, id.user_id, u2.first_names, u2.last_name from ec_user_identification id, users u2 where id.user_id=u2.user_id(+)) customer_info + where a.interaction_id = i.interaction_id + and i.user_identification_id=customer_info.user_identification_id + and reps.user_id=i.customer_service_rep + and a.action_id=map.action_id + and map.info_used='[DoubleApos $view_info_used]' + $interaction_date_query_bit $rep_query_bit + order by $order_by + " +} + +# set link_beginning "actions.tcl?[export_url_vars view_issue_type view_status view_open_date]" + +set link_beginning "actions.tcl?[export_url_vars view_info_used view_rep view_interaction_date]" + +set table_header " + + + + + + + + + + +" + +set selection [ns_db select $db $sql_query] + +set row_counter 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $row_counter == 0 } { + ns_write $table_header + } elseif { $row_counter == 20 } { + ns_write "
    Action IDInteraction IDIssue IDDateCustomerRepOriginatorInteraction Type
    +

    + $table_header + " + set row_counter 1 + } + # even rows are white, odd are grey + if { [expr floor($row_counter/2.)] == [expr $row_counter/2.] } { + set bgcolor "white" + } else { + set bgcolor "ececec" + } + + ns_write "$action_id + $interaction_id + $issue_id + [ec_formatted_full_date $full_interaction_date] + " + if { [empty_string_p $customer_user_id] } { + ns_write "unregistered user $user_identification_id" + } else { + ns_write "$customer_last_name, $customer_first_names" + } + + if { ![empty_string_p $customer_service_rep] } { + ns_write "$rep_last_name, $rep_first_names" + } else { + ns_write " " + } + + ns_write "$interaction_originator + $interaction_type + + " + incr row_counter +} + +if { $row_counter != 0 } { + ns_write "" +} else { + ns_write "

    None Found
    " +} + +ns_write " +
    +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/customer-service/active-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/active-toggle.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/active-toggle.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,10 @@ +# active-toggle.tcl,v 3.0 2000/02/06 03:17:30 ron Exp +set_the_usual_form_variables +# table_name, primary_key_name, primary_key_value, active_p + +set db [ns_db gethandle] +ns_db dml $db "update $table_name +set active_p='$active_p' +where $primary_key_name='$QQ$primary_key_value'" + +ns_returnredirect picklists.tcl Index: web/openacs/www/admin/ecommerce/customer-service/canned-response-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/canned-response-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/canned-response-add-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,18 @@ +# canned-response-add-2.tcl,v 3.0 2000/02/06 03:17:31 ron Exp +set_the_usual_form_variables +# one_line, response_text + +set db [ns_db gethandle] + +set existing_response_id [database_to_tcl_string_or_null $db "select response_id from ec_canned_responses where one_line = '$QQone_line'"] + +if { ![empty_string_p $existing_response_id] } { + ad_return_warning "Response Exists" "There already exists a canned response +with this description. You can edit it or go back and try again." + return +} + +ns_db dml $db "insert into ec_canned_responses (response_id, one_line, response_text) +values ([db_sequence_nextval_sql ec_canned_response_id_sequence], '$QQone_line', '$QQresponse_text')" + +ns_returnredirect "canned-responses.tcl" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/customer-service/canned-response-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/canned-response-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/canned-response-add.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,18 @@ +# canned-response-add.tcl,v 3.0 2000/02/06 03:17:32 ron Exp +ns_return 200 text/html "[ad_admin_header "New Canned Response"] +

    New Canned Response

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] [list "canned-responses.tcl" "Canned Responses"] "New Canned Response"] + +
    + +
    + + + + +
    Description
    Text
    +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/customer-service/canned-response-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/canned-response-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/canned-response-delete-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,10 @@ +# canned-response-delete-2.tcl,v 3.0 2000/02/06 03:17:33 ron Exp +set_form_variables + +# response_id + +set db [ns_db gethandle] + +ns_db dml $db "delete from ec_canned_responses where response_id = $response_id" + +ns_returnredirect "canned-responses.tcl" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/customer-service/canned-response-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/canned-response-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/canned-response-delete.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,33 @@ +# canned-response-delete.tcl,v 3.0 2000/02/06 03:17:34 ron Exp +set_form_variables +# response_id + + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select one_line, response_text +from ec_canned_responses +where response_id = $response_id"] + +set_variables_after_query + +ns_return 200 text/html "[ad_admin_header "Confirm Delete"] + +

    Confirm Delete

    + +
    + +Are you sure you want to delete this canned response? + +

    $one_line

    +[ec_display_as_html $response_text] + +

    + +

    +Yes, get rid of it +
    + + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/customer-service/canned-response-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/canned-response-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/canned-response-edit-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,11 @@ +# canned-response-edit-2.tcl,v 3.0 2000/02/06 03:17:36 ron Exp +set_the_usual_form_variables +# response_id, one_line, response_text + +set db [ns_db gethandle] + +ns_db dml $db "update ec_canned_responses +set one_line = '$QQone_line', response_text = '$QQresponse_text' +where response_id = $response_id" + +ns_returnredirect "canned-responses.tcl" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/customer-service/canned-response-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/canned-response-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/canned-response-edit.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,30 @@ +# canned-response-edit.tcl,v 3.0 2000/02/06 03:17:37 ron Exp +set_form_variables +# response_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select one_line, response_text +from ec_canned_responses +where response_id = $response_id"] + +set_variables_after_query + +ns_return 200 text/html "[ad_admin_header "Edit Canned Response"] +

    Edit Canned Response

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] [list "canned-responses.tcl" "Canned Responses"] "Edit Canned Response"] + +
    + +
    +[export_form_vars response_id] + + + + +
    Description
    Text
    +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/customer-service/canned-responses.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/canned-responses.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/canned-responses.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,44 @@ +# canned-responses.tcl,v 3.0 2000/02/06 03:17:38 ron Exp +set db [ns_db gethandle] + +ReturnHeaders + +ns_write "[ad_admin_header "Canned Responses"] +

    Canned Responses

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] "Canned Responses"] + +
    + +

    Defined Responses

    +
      +" + +set selection [ns_db select $db "select response_id, one_line, response_text +from ec_canned_responses +order by one_line"] + +set count 0 + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + ns_write "
    • $one_line +
      +[ec_display_as_html $response_text] Delete +
      +" + + incr count +} + +if { $count == 0 } { + ns_write "
    • No defined canned responses.\n" +} + +ns_write "

      +Add a new canned response +

    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/customer-service/customer-search.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/customer-search.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/customer-search.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,72 @@ +# customer-search.tcl,v 3.0 2000/02/06 03:17:40 ron Exp +set_the_usual_form_variables +# amount, days + +# error checking +set exception_count 0 +set exception_text "" + +if { ![info exists amount] || [empty_string_p $amount] } { + incr exception_count + append exception_text "
  • You forgot to enter the amount." +} elseif { [regexp {[^0-9\.]} $amount] } { + incr exception_count + append exception_text "
  • The amount must be a number (no special characters)." +} + +if { ![info exists days] || [empty_string_p $days] } { + incr exception_count + append exception_text "
  • You forgot to enter the number of days." +} elseif { [regexp {[^0-9\.]} $days] } { + incr exception_count + append exception_text "
  • The number of days must be a number (no special characters)." +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +ReturnHeaders +ns_write "[ad_admin_header "Customer Search"] + +

    Customer Search

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] "Customer Search"] + +
    +Customers who spent more than [ec_pretty_price $amount [ad_parameter Currency ecommerce]] in the last $days days: +
      +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select unique o.user_id, u.first_names, u.last_name, u.email +from ec_orders o, users u +where o.user_id=u.user_id +and o.order_state not in ('void','in_basket') +and sysdate() - o.confirmed_date <= $days +and $amount <= (select sum(i.price_charged) from ec_items i where i.order_id=o.order_id and (i.item_state is null or i.item_state not in ('void','received_back'))) +"] + +set user_id_list [list] +while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • $first_names $last_name ($email)" + lappend user_id_list $user_id +} + + +if { [llength $user_id_list] == 0 } { + ns_write "None found." +} + +ns_write "
    +" + +if { [llength $user_id_list] != 0 } { + ns_write "Spam these users" +} + +ns_write "[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/customer-service/email-send-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/email-send-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/email-send-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,67 @@ +# email-send-2.tcl,v 3.0 2000/02/06 03:17:42 ron Exp +set_the_usual_form_variables +# action_id, issue_id, customer_service_rep, +# email_to_use, cc_to, bcc_to, subject, message, +# user_identification_id + +# no confirm page because they were just sent through the spell +# checker (that's enough submits to push) + +# check for double-click +set db [ns_db gethandle] + +if { [database_to_tcl_string $db "select count(*) from ec_customer_service_actions where action_id=$action_id"] > 0 } { + ns_returnredirect "issue.tcl?[export_url_vars issue_id]" + return +} + +# 1. create interaction +# 2. create action +# 3. send email + +set email_from [ad_parameter CustomerServiceEmailAddress ecommerce] + +set action_details "From: $email_from +To: $email_to_use +" +if { ![empty_string_p $cc_to] } { + append action_details "Cc: $cc_to + " +} +if { ![empty_string_p $bcc_to] } { + append action_details "Bcc: $bcc_to + " +} + +append action_details "Subject: $subject + +$message +" + +ns_db dml $db "begin transaction" + +set interaction_id [database_to_tcl_string $db "select ec_interaction_id_sequence.nextval from dual"] + +ns_db dml $db "insert into ec_customer_serv_interactions +(interaction_id, customer_service_rep, user_identification_id, interaction_date, interaction_originator, interaction_type) +values +($interaction_id, $customer_service_rep, $user_identification_id, sysdate(), 'rep', 'email') +" + +ns_db dml $db "insert into ec_customer_service_actions +(action_id, issue_id, interaction_id, action_details) +values +($action_id, $issue_id, $interaction_id, '[DoubleApos $action_details]') +" + +ns_db dml $db "end transaction" + +set extra_headers [ns_set new] +if { [info exists cc_to] && $cc_to != "" } { + ns_set put $extra_headers "Cc" "$cc_to" + ec_sendmail_from_service $email_to_use [ad_parameter CustomerServiceEmailAddress ecommerce] $subject $message $extra_headers $bcc_to +} else { + ec_sendmail_from_service $email_to_use [ad_parameter CustomerServiceEmailAddress ecommerce] $subject $message "" $bcc_to +} + +ns_returnredirect "issue.tcl?issue_id=$issue_id" Index: web/openacs/www/admin/ecommerce/customer-service/email-send.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/email-send.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/email-send.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,104 @@ +# email-send.tcl,v 3.0 2000/02/06 03:17:43 ron Exp +set_the_usual_form_variables +# issue_id, user_identification_id + +set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + +set customer_service_rep [ad_get_user_id] + +if {$customer_service_rep == 0} { + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +ReturnHeaders +set page_title "Send Email to Customer" +ns_write "[ad_admin_header $page_title] +

    $page_title

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] $page_title] + +
    +" + +# make sure this user_identification_id has an email address associated with it + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select u.email as user_email, id.email as id_email +from users u, ec_user_identification id +where id.user_id = u.user_id +and id.user_identification_id=$user_identification_id +union +select NULL as user_email, id.email as id_email +from ec_user_identification id +where not exists (select user_id from users where user_id = id.user_id) +and id.user_identification_id=$user_identification_id +"] +set_variables_after_query + +if { ![empty_string_p $user_email] } { + set email_to_use $user_email +} else { + set email_to_use $id_email +} + +if { [empty_string_p $email_to_use] } { + ns_write " + + Sorry, we don't have the customer's email address on file. + + [ad_admin_footer] + " + return +} + +# generate action_id here for double-click protection +set action_id [database_to_tcl_string $db "select ec_action_id_sequence.nextval from dual"] + +ns_write "If you are not [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id=$customer_service_rep"], please log in + +
    +[philg_hidden_input var_to_spellcheck "message"] +[philg_hidden_input target_url "/admin/ecommerce/customer-service/email-send-2.tcl"] +[export_form_vars email_to_use action_id issue_id customer_service_rep user_identification_id] + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    From[ad_parameter CustomerServiceEmailAddress ecommerce]
    To$email_to_use
    Cc
    Bcc
    Subject
    Message
    Canned Responses[ec_canned_response_selector $db email_form message]
    + +

    + +

    + +
    + +
    +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/customer-service/gift-certificate-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/gift-certificate-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/gift-certificate-add-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,26 @@ +# gift-certificate-add-2.tcl,v 3.0 2000/02/06 03:17:44 ron Exp +set_the_usual_form_variables +# user_id, amount, expires + +set expires_to_insert [ec_decode $expires "" "null" $expires] + +set customer_service_rep [ad_get_user_id] + +if {$customer_service_rep == 0} { + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +# put a record into ec_gift_certificates +# and add the amount to the user's gift certificate account + +ns_db dml $db "insert into ec_gift_certificates +(gift_certificate_id, user_id, amount, expires, issue_date, issued_by, gift_certificate_state, last_modified, last_modifying_user, modified_ip_address) +values +(ec_gift_cert_id_sequence.nextval, $user_id, $amount, $expires_to_insert, sysdate(), $customer_service_rep, 'authorized', sysdate(), $customer_service_rep, '[DoubleApos [ns_conn peeraddr]]') +" + +ns_returnredirect "gift-certificates.tcl?[export_url_vars user_id]" Index: web/openacs/www/admin/ecommerce/customer-service/gift-certificate-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/gift-certificate-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/gift-certificate-add.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,40 @@ +# gift-certificate-add.tcl,v 3.0 2000/02/06 03:17:46 ron Exp +set_the_usual_form_variables +# user_id, amount, expires + +# make sure there's an amount +if { ![info exists amount] || [empty_string_p $amount] } { + ad_return_complaint 1 "
  • You forgot to specify an amount." + return +} + +ReturnHeaders + +set page_title "Confirm New Gift Certificate" +ns_write "[ad_admin_header $page_title] +

    $page_title

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] $page_title] + +
    +" + +set db [ns_db gethandle] +set expiration_to_print [database_to_tcl_string $db "select [ec_decode $expires "" "null" $expires] from dual"] +set expiration_to_print [ec_decode $expiration_to_print "" "never" [util_AnsiDatetoPrettyDate $expiration_to_print]] + +ns_write "Please confirm that you wish to add [ec_pretty_price $amount [ad_parameter Currency ecommerce]] to +[database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id=$user_id"]'s gift certificate account (expires $expiration_to_print). + +

    + +

    +[export_form_vars user_id amount expires] +
    + +
    + +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/customer-service/gift-certificate-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/gift-certificate-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/gift-certificate-edit.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,18 @@ +# gift-certificate-edit.tcl,v 3.0 2000/02/06 03:17:48 ron Exp +set_the_usual_form_variables +# user_id, gift_certificate_id, expires + +set customer_service_rep [ad_get_user_id] + +if {$customer_service_rep == 0} { + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +ns_db dml $db "update ec_gift_certificates +set expires=sysdate(), last_modified=sysdate(), last_modifying_user=$customer_service_rep, +modified_ip_address='[DoubleApos [ns_conn peeraddr]]' where gift_certificate_id=$gift_certificate_id" + +ns_returnredirect "gift-certificates.tcl?[export_url_vars user_id]" Index: web/openacs/www/admin/ecommerce/customer-service/gift-certificate-void-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/gift-certificate-void-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/gift-certificate-void-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,19 @@ +# gift-certificate-void-2.tcl,v 3.0 2000/02/06 03:17:49 ron Exp +set_the_usual_form_variables +# gift_certificate_id, reason_for_void + +set customer_service_rep [ad_get_user_id] + +if {$customer_service_rep == 0} { + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +ns_db dml $db "update ec_gift_certificates set gift_certificate_state='void', voided_date=sysdate(), voided_by=$customer_service_rep, reason_for_void='[DoubleApos $reason_for_void]' where gift_certificate_id=$gift_certificate_id" + +set user_id [database_to_tcl_string $db "select user_id from ec_gift_certificates where gift_certificate_id=$gift_certificate_id"] + +ns_returnredirect "gift-certificates.tcl?[export_url_vars user_id]" Index: web/openacs/www/admin/ecommerce/customer-service/gift-certificate-void.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/gift-certificate-void.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/gift-certificate-void.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,38 @@ +# gift-certificate-void.tcl,v 3.0 2000/02/06 03:17:50 ron Exp +set_the_usual_form_variables +# gift_certificate_id + +set customer_service_rep [ad_get_user_id] + +if {$customer_service_rep == 0} { + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +ReturnHeaders + +set page_title "Void Gift Certificate" +ns_write "[ad_admin_header $page_title] +

    $page_title

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] $page_title] + +
    +Please explain why you are voiding this gift certificate: + +
    +[export_form_vars gift_certificate_id] + +
    + +
    + +
    + +
    + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/customer-service/gift-certificates.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/gift-certificates.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/gift-certificates.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,110 @@ +# gift-certificates.tcl,v 3.0 2000/02/06 03:17:51 ron Exp +set_the_usual_form_variables +# user_id + +ReturnHeaders + +set page_title "Gift Certificates" +ns_write "[ad_admin_header $page_title] +

    $page_title

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] $page_title] + +
    +" + +set db [ns_db gethandle] + +ns_write "Customer: [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id=$user_id"] + +

    + +Gift Certificate Account Balance: [ec_pretty_price [database_to_tcl_string $db "select ec_gift_certificate_balance($user_id) from dual"]] + +

    +Grant a gift certificate +

    +
    +[export_form_vars user_id] + + + + + + + + + + +
    Amount ([ad_parameter Currency ecommerce])
    Expires[ec_gift_certificate_expires_widget "in 1 year"]
    +
    +
    + +" + +set selection [ns_db select $db "select c.*, i.first_names || ' ' || i.last_name as issuer, i.user_id as issuer_user_id, p.first_names || ' ' || p.last_name as purchaser, p.user_id as purchaser_user_id, gift_certificate_amount_left(c.gift_certificate_id) as amount_left, decode(sign(sysdate()-expires),1,'t',0,'t','f') as expired_p, v.first_names as voided_by_first_names, v.last_name as voided_by_last_name +from ec_gift_certificates c, users i, users p, users v +where c.issued_by=i.user_id(+) +and c.purchased_by=p.user_id(+) +and c.voided_by=v.user_id(+) +and c.user_id=$user_id +order by expired_p, decode(amount_left,0,1,0), decode(gift_certificate_state,'void',1,0), gift_certificate_id"] + +set gift_certificate_counter 0 +set current_printed 0 +set old_printed 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $current_printed == 0 && $expired_p == "f" && $amount_left > 0 && $gift_certificate_state != "void"} { + ns_write "Currently Available Gift Certificates +
    + " + set current_printed 1 + } elseif { $old_printed == 0 && ($expired_p == "t" || $amount_left == 0 || $gift_certificate_state == "void") } { + if { $current_printed == 1 } { + ns_write "
    " + } + ns_write "Expired or Used Gift Certificates +
    + " + set old_printed 1 + } + + incr gift_certificate_counter + + ns_write " + + + + + " + if { ![empty_string_p $issuer_user_id] } { + ns_write "" + } else { + ns_write "" + } + ns_write " + " + + if { $gift_certificate_state == "void" } { + ns_write "" + } + + + ns_write "
    Gift Certificate ID    $gift_certificate_id
    Amount Left[ec_pretty_price $amount_left] (out of [ec_pretty_price $amount])
    Issue Date[util_AnsiDatetoPrettyDate $issue_date]
    Issued By$issuer
    Purchased By$purchaser
    [ec_decode $expired_p "t" "Expired" "Expires"][ec_decode $expires "" "never" [util_AnsiDatetoPrettyDate $expires]]
    Voided[util_AnsiDatetoPrettyDate $voided_date] by $voided_by_first_names $voided_by_last_name because: $reason_for_void
    " + + if { $expired_p == "f" && $amount_left > 0 && $gift_certificate_state != "void"} { + ns_write "(void this) + " + } + + ns_write "

    + " +} + +if { $current_printed == 1 || $old_printed == 1 } { + ns_write "

    " +} + +ns_write "[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/customer-service/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/index.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,132 @@ +# index.tcl,v 3.0 2000/02/06 03:17:47 ron Exp +ReturnHeaders +ns_write "[ad_admin_header "Customer Service Administration"] + +

    Customer Service Administration

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] "Customer Service Administration"] + +
    + + + +

    Customer Service Issues

    + +
      +
    • uncategorized : +" + +set db [ns_db gethandle] + +set num_open_issues [database_to_tcl_string $db "select count(*) +from ec_customer_service_issues issues, ec_user_identification id +where issues.user_identification_id = id.user_identification_id +and close_date is NULL +and deleted_p = 'f' +and 0 = (select count(*) from ec_cs_issue_type_map map where map.issue_id=issues.issue_id)"] + +ns_write "open ($num_open_issues) | +closed + +

      +" + +# only want to show issue types in the issue type widget, and then clump all others under +# "other" +set issue_type_list [database_to_tcl_list $db "select picklist_item from ec_picklist_items where picklist_name='issue_type' order by sort_key"] + + +foreach issue_type $issue_type_list { + + set num_open_issues [database_to_tcl_string $db "select count(*) +from ec_customer_service_issues issues, ec_user_identification id +where issues.user_identification_id = id.user_identification_id +and close_date is NULL +and deleted_p = 'f' +and 1 <= (select count(*) from ec_cs_issue_type_map map where map.issue_id=issues.issue_id and map.issue_type='[DoubleApos $issue_type]')"] + + +ns_write "

    • $issue_type : + +open ($num_open_issues) | closed + +

      +" + +} + +# same query for issues that aren't in issue_type_list + +if { [llength $issue_type_list] > 0 } { + # taking advantage of the fact that tcl lists are just strings + set safe_issue_type_list [DoubleApos $issue_type_list] + set last_bit_of_query "and 1 <= (select count(*) from ec_cs_issue_type_map map where map.issue_id=issues.issue_id and map.issue_type not in ('[join $safe_issue_type_list "', '"]'))" +} else { + set last_bit_of_query "and 1 <= (select count(*) from ec_cs_issue_type_map map where map.issue_id=issues.issue_id)" +} + +set num_open_issues [database_to_tcl_string $db "select count(*) +from ec_customer_service_issues issues, ec_user_identification id +where issues.user_identification_id = id.user_identification_id +and close_date is NULL +and deleted_p = 'f' +$last_bit_of_query"] + + +ns_write "

    • all others : +open ($num_open_issues) | +closed +
    +

    +" + +if { [llength $issue_type_list] == 0 } { + ns_write "If you want to see issues separated out by commonly used issue types, then add those issue types to the issue type picklist below in Picklist Management." +} + +ns_write " +

    + +

    Customers

    + +
      +
      + +
    • Quick search for registered users: +
      • + +

      + +

      +
    • Quick search for unregistered users with a customer service history: + +
      • + +

      + +

      +
    • Customers who have spent over + +([ad_parameter Currency ecommerce]) +in the last days + +
      • +
    + +

    Administrative Actions

    + + + +[ad_admin_footer] +" + Index: web/openacs/www/admin/ecommerce/customer-service/interaction-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/interaction-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/interaction-add-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,324 @@ +# interaction-add-2.tcl,v 3.0 2000/02/06 03:17:53 ron Exp +set_the_usual_form_variables +# If this is coming from interaction-add.tcl: +# open_date, interaction_type, interaction_type_other, interaction_originator, and +# (a) If it's an unknown customer: first_names, last_name, email, postal_code, +# other_id_info +# (b) If it's a known customer: c_user_identification_id and issue_id + +# If this is coming from interaction-add-3.tcl (meaning that they are adding +# another action to this interaction): +# interaction_id, c_user_identification_id ("c" stands for "confirmed" meaning +# that they've been through interaction-add-3.tcl and now they cannot change +# the user_identification_id) + +# Possibly: +# return_to_issue + +# the customer service rep must be logged on + +set customer_service_rep [ad_get_user_id] + +if {$customer_service_rep == 0} { + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +if { ![info exists interaction_id] } { + + # put together open_date, and do error checking + + set exception_count 0 + set exception_text "" + set form [ns_getform] + + # ns_dbformvalue $form open_date date open_date will give an error + # message if the day of the month is 08 or 09 (this octal number problem + # we've had in other places). So I'll have to trim the leading zeros + # from ColValue.open%5fdate.day and stick the new value into the $form + # ns_set. + + set "ColValue.open%5fdate.day" [string trimleft [set ColValue.open%5fdate.day] "0"] + ns_set update $form "ColValue.open%5fdate.day" [set ColValue.open%5fdate.day] + + if [catch { ns_dbformvalue $form open_date datetime open_date} errmsg ] { + incr exception_count + append exception_text "
  • The date or time was specified in the wrong format. The date should be in the format Month DD YYYY. The time should be in the format HH:MI:SS (seconds are optional), where HH is 01-12, MI is 00-59 and SS is 00-59.\n" + } elseif { [string length [set ColValue.open%5fdate.year]] != 4 } { + incr exception_count + append exception_text "
  • The year needs to contain 4 digits.\n" + } + + if { ![info exists interaction_type] || [empty_string_p $interaction_type] } { + incr exception_count + append exception_text "
  • You forgot to specify the method of inquiry (phone/email/etc.).\n" + } elseif { $interaction_type == "other" && (![info exists interaction_type_other] || [empty_string_p $interaction_type_other]) } { + incr exception_count + append exception_text "
  • You forgot to fill in the text box for Other.\n" + } elseif { $interaction_type != "other" && ([info exists interaction_type_other] && ![empty_string_p $interaction_type_other]) } { + incr exception_count + append exception_text "
  • You selected \"Inquired via: [string toupper [string index $interaction_type 0]][string range $interaction_type 1 [expr [string length $interaction_type] -1]]\", but you also filled in something in the \"If Other, specify\" field. This is inconsistent.\n" + } + + if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return + } + + # done error checking +} + +set db_pools [ns_db gethandle [philg_server_default_pool] 2] +set db [lindex $db_pools 0] +set db_sub [lindex $db_pools 1] + +# Have to generate action_id +# action_id will be used by the next page to tell whether the user pushed +# submit twice +# interaction_id will not be generated until the next page (if it doesn't +# exist) so that I can use the fact of its existence or lack of existence +# to create this page's UI + +set action_id [database_to_tcl_string $db "select ec_action_id_sequence.nextval from dual"] + +ReturnHeaders + +ns_write "[ad_admin_header "One Issue"] +

    One Issue

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] "One Issue (part of New Interaction)"] + +
    +A customer may discuss several issues during the course of one interaction. Please +enter the information about only one issue below: + +
    +[export_form_vars interaction_id c_user_identification_id action_id open_date interaction_type interaction_type_other interaction_originator first_names last_name email postal_code other_id_info return_to_issue] + + +" + +if { [info exists c_user_identification_id] } { + ns_write " + + + + " +} + +if { ![info exists issue_id] } { + ns_write " + + + + + + + + + + + + " +} else { + set order_id [database_to_tcl_string $db "select order_id from ec_customer_service_issues where issue_id=$issue_id"] + set issue_type_list [database_to_tcl_list $db "select issue_type from ec_cs_issue_type_map where issue_id=$issue_id"] + + ns_write " + + + + + + + + + + + + " +} +ns_write " + + + + + + + + + + + + + + + +
    Customer:[ec_user_identification_summary $db $c_user_identification_id "t"]" + + if { [info exists postal_code] } { + ns_write "
    + [ec_location_based_on_zip_code $db $postal_code] + " + } + + + ns_write "
    Issue ID: + If this is a new issue, please leave this blank (a new Issue ID will be generated)
    Order ID: + Fill this in if this inquiry is about a specific order. +
    Issue Type: (leave blank if based on an existing issue):[ec_issue_type_widget $db]
    Issue ID:$issue_id[export_form_vars issue_id]
    Order ID:[ec_decode $order_id "" "none" $order_id]
    Issue Type[join $issue_type_list ", "]
    Details:
    Information used to respond to inquiry:[ec_info_used_widget $db]
    If follow-up is required, please specify:
    Close this issue? +No (Issue requires follow-up) +Yes (Issue is resolved) +
    +" + +if { ![info exists c_user_identification_id] } { + ns_write " +

    + + Customer identification: + +

    + + Here's what we could determine about the customer given the information you typed + into the previous form: +

      + " + + set positively_identified_p 0 + + # see if we can find their city/state from the zip code + + set location [ec_location_based_on_zip_code $db $postal_code] + + if { ![empty_string_p $location] } { + ns_write "
    • They live in $location.\n" + } + + + # I'll be setting variables d_user_id, d_user_identification_id, d_first_names, etc., + # based on the user info they typed into the last form. "d" stands for "determined", + # meaning that I determined it, as opposed to it being something that they typed in + + # if their email address was filled in, see if they're a registered user + if { ![empty_string_p $email] } { + set selection [ns_db 0or1row $db "select first_names as d_first_names, last_name as d_last_name, user_id as d_user_id from users where upper(email) = '[string toupper $email]'"] + + if { ![empty_string_p $selection] } { + set_variables_after_query + } + + if { [info exists d_user_id] } { + ns_write "
    • This is a registered user of the system: $d_first_names $d_last_name. + [export_form_vars d_user_id]" + set positively_identified_p 1 + } + + } + + if { !$positively_identified_p } { + # then keep trying to identify them + + if { ![empty_string_p $first_names] || ![empty_string_p $last_name] } { + if { ![empty_string_p $first_names] && ![empty_string_p $last_name] } { + set selection [ns_db select $db "select user_id as d_user_id from users where upper(first_names)='[DoubleApos [string toupper $first_names]]' and upper(last_name)='[DoubleApos [string toupper $last_name]]'"] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • This may be the registered user $first_names $last_name (check here if this is correct).\n" + } + } elseif { ![empty_string_p $first_names] } { + set selection [ns_db select $db "select user_id as d_user_id, last_name as d_last_name from users where upper(first_names)='[DoubleApos [string toupper $first_names]]'"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • This may be the registered user $first_names $d_last_name (check here if this is correct).\n" + } + + } elseif { ![empty_string_p $last_name] } { + set selection [ns_db select $db "select user_id as d_user_id, first_names as d_first_names from users where upper(last_name)='[DoubleApos [string toupper $last_name]]'"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • This may be the registered user $d_first_names $last_name (check here if this is correct).\n" + } + + } + } + + # also see if they might be a non-user who + # has had an interaction before + + set already_selected_user_identification_id_list [list] + if { ![empty_string_p $email] } { + set selection [ns_db select $db "select user_identification_id as d_user_identification_id from ec_user_identification where upper(email)='[DoubleApos [string toupper $email]]' and user_id is null"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • This may be the non-registered person who has had a previous interaction with us: [ec_user_identification_summary $db_sub $d_user_identification_id "t"] (check here if this is correct)." + lappend already_selected_user_identification_id_list $d_user_identification_id + } + } + + set additional_and_clause "" + if { [llength $already_selected_user_identification_id_list] > 0 } { + set additional_and_clause "and user_identification_id not in ([join $already_selected_user_identification_id_list ", "])" + } + + if { ![empty_string_p $first_names] || ![empty_string_p $last_name] } { + if { ![empty_string_p $first_names] && ![empty_string_p $last_name] } { + set selection [ns_db select $db "select user_identification_id as d_user_identification_id from ec_user_identification where upper(first_names)='[DoubleApos [string toupper $first_names]]' and upper(last_name)='[DoubleApos [string toupper $last_name]]' and user_id is null $additional_and_clause"] + } elseif { ![empty_string_p $first_names] } { + set selection [ns_db select $db "select user_identification_id as d_user_identification_id from ec_user_identification where upper(first_names)='[DoubleApos [string toupper $first_names]]' and user_id is null $additional_and_clause"] + } elseif { ![empty_string_p $last_name] } { + set selection [ns_db select $db "select user_identification_id as d_user_identification_id from ec_user_identification where upper(last_name)='[DoubleApos [string toupper $last_name]]' and user_id is null $additional_and_clause"] + } + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • This may be the non-registered person who has had a previous interaction with us: [ec_user_identification_summary $db_sub $d_user_identification_id "t"] (check here if this is correct)." + lappend already_selected_user_identification_id_list $d_user_identification_id + } + } + + if { [llength $already_selected_user_identification_id_list] > 0 } { + set additional_and_clause "and user_identification_id not in ([join $already_selected_user_identification_id_list ", "])" + } + + if { ![empty_string_p $other_id_info] } { + set selection [ns_db select $db "select user_identification_id as d_user_identification_id from ec_user_identification where other_id_info like '%[DoubleApos $other_id_info]%' $additional_and_clause"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • This may be the non-registered person who has had a previous interaction with us: [ec_user_identification_summary $db_sub $d_user_identification_id "t"] (check here if this is correct)." + lappend already_selected_user_identification_id_list $d_user_identification_id + } + + } + + if { [llength $already_selected_user_identification_id_list] > 0 } { + set additional_and_clause "and user_identification_id not in ([join $already_selected_user_identification_id_list ", "])" + } + + if { ![empty_string_p $postal_code] } { + set selection [ns_db select $db "select user_identification_id as d_user_identification_id from ec_user_identification where postal_code='[DoubleApos $postal_code]' $additional_and_clause"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • This may be the non-registered person who has had a previous interaction with us: [ec_user_identification_summary $db_sub $d_user_identification_id "t"] (check here if this is correct)." + lappend already_selected_user_identification_id_list $d_user_identification_id + } + } + } + ns_write "
    +

    + " +} + +ns_write "

    + + +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/customer-service/interaction-add-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/interaction-add-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/interaction-add-3.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,480 @@ +# interaction-add-3.tcl,v 3.0 2000/02/06 03:17:54 ron Exp +set_the_usual_form_variables +# Always: +# action_id, submit, +# issue_id, action_details, +# info_used (select multiple), follow_up_required, +# close_issue_p + +# If this is the first issue in this interaction: +# open_date, interaction_type, interaction_type_other, interaction_originator, +# first_names, last_name, email, postal_code, other_id_info +# possibly d_user_id or d_user_identification_id (shouldn't have both) + +# If this is NOT the first issue in this interaction: +# interaction_id, c_user_identification_id, possibly postal_code + +# If not coming from issue.tcl originally: +# order_id, issue_type (select multiple) + +# Possibly: +# return_to_issue + +set db [ns_db gethandle] + +# doubleclick protection: +if { [database_to_tcl_string $db "select count(*) from ec_customer_service_actions where action_id=$action_id"] > 0 } { + if { $submit == "Interaction Complete" } { + ns_returnredirect interaction-add.tcl + } else { + # I have to use the action_id to figure out user_identification_id + # and interaction_id so that I can pass them to interaction-add-2.tcl + set selection [ns_db 0or1row $db "select i.user_identification_id as c_user_identification_id, a.interaction_id + from ec_customer_service_actions a, ec_customer_serv_interactions i + where i.interaction_id=a.interaction_id + and a.action_id=$action_id"] + set_variables_after_query + ns_returnredirect "interaction-add-2.tcl?[export_url_vars interaction_id postal_code c_user_identification_id]" + } + return +} + + +# the customer service rep must be logged on + +set customer_service_rep [ad_get_user_id] + +if {$customer_service_rep == 0} { + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +# error checking +# what matters for the logic of the customer service system: +# 1. that we don't have more than one d_user_id or d_user_identification_id +# (it's ok to have zero -- then a new user_identification_id will be generated, +# unless c_user_identification_id exists) +# 2. if this is based on a previous issue_id, then issue_id must be valid and +# issue ownership must be consistent +# 3. if this is based on a previous order, then order_id must be valid and +# order ownership must be consistent + +set exception_count 0 +set exception_text "" + +# first some little checks on the input data + +# issue_id and order_id should be numbers and action_details should be non-empty + +if { [regexp "\[^0-9\]+" $issue_id] } { + incr exception_count + append exception_text "
  • The issue ID should be numeric.\n" +} + +if { [info exists order_id] && [regexp "\[^0-9\]+" $order_id] } { + incr exception_count + append exception_text "
  • The order ID should be numeric.\n" +} + +if { [empty_string_p $action_details] } { + incr exception_count + append exception_text "
  • You forgot to enter any details." +} + + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +# now for the painful checks + +# only do this check for new interactions +if { ![info exists interaction_id] } { + # 1. d_user_id and d_user_identification_id + # d_user_id and d_user_identification_id come from checkboxes, so I have to + # loop through $form to find all values + + set form [ns_getform] + set form_size [ns_set size $form] + set form_counter 0 + + set d_user_id_list [list] + set d_user_identification_id_list [list] + while { $form_counter < $form_size} { + set form_key [ns_set key $form $form_counter] + if { $form_key == "d_user_id" || $form_key == "d_user_identification_id" } { + lappend ${form_key}_list [ns_set value $form $form_counter] + } + incr form_counter + } + + if { [expr [llength $d_user_id_list] + [llength $d_user_identification_id_list] ] > 1 } { + incr exception_count + append exception_text "
  • You selected more than one user. Please select at most one.\n" + } + + # Don't even go on to check #2 if this first requirement isn't fulfilled + if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return + } +} + +# 2. consistent issue ownership + +# If it's the first time through, give them the chance of matching up a +# user with the interaction based on issue_id or order_id. +# Otherwise, the user_identification_id is set, so they will just be +# given an error message. +if { ![empty_string_p $issue_id] } { + # see who this issue belongs to + set selection [ns_db 0or1row $db "select u.user_id as issue_user_id, u.user_identification_id as issue_user_identification_id + from ec_user_identification u, ec_customer_service_issues i + where u.user_identification_id = i.user_identification_id + and i.issue_id=$issue_id"] + if { [empty_string_p $selection] } { + ad_return_complaint 1 "
  • The issue ID that you specified is invalid. Please go back and check the issue ID you entered. If this is a new issue, please leave the issue ID blank.\n" + return + } + set_variables_after_query + + if { ![info exists c_user_identification_id] } { + # if the issue has a user_id associated with it and d_user_id doesn't exist or match + # the associated user_id, then give them a message with the chance to make them match + if { ![empty_string_p $issue_user_id] } { + if { ![info exists d_user_id] || [string compare $d_user_id $issue_user_id] != 0 } { + ReturnHeaders + ns_write "[ad_admin_header "User Doesn't Match Issue"] +

    User Doesn't Match Issue

    + [ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] "New Interaction"] + +
    + Issue ID $issue_id belongs to the registered user [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id=$issue_user_id"]. + +

    + + However, you haven't selected that user as the customer involved in this interaction. + +

    + + Would you like to make this user be the owner of this interaction? (If not, push Back and fix the issue ID.) + + + [philg_hidden_input "d_user_id" $issue_user_id] + [ec_export_entire_form_except d_user_id d_user_identification_id] +

    + +
    +
    • + + [ad_admin_footer] + " + return + } + } elseif { ![info exists d_user_identification_id] || [string compare $d_user_identification_id $issue_user_identification_id] != 0 } { + # if d_user_identification_id doesn't match the issue's user_identification_id, give + # them a message with the chance to make them match + + ReturnHeaders + ns_write "[ad_admin_header "User Doesn't Match Issue"] +

    User Doesn't Match Issue

    + [ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] "New Interaction"] + +
    + Issue ID $issue_id belongs to the the non-registered person who has had a previous interaction with us: [ec_user_identification_summary $db $issue_user_identification_id] + +

    + + However, you haven't selected that user as the customer involved in this interaction. + +

    + + Would you like to make this user be the owner of this interaction? (If not, push Back and fix the issue ID.) + +

    + [philg_hidden_input "d_user_identification_id" $issue_user_identification_id] + [ec_export_entire_form_except d_user_id d_user_identification_id] +
    + +
    +
    + + [ad_admin_footer] + " + return + } + + } else { + # non-new interaction; user_identification_id fixed + # if the issue has a user_id, then the user_id associated with user_identification_id should match. + # since it's possible for the same user to be represented by more than one user_identification_id, + # we can't require that they match, although it is unfortunate if they don't (but it's too late to + # do anything about it at this point -- I should make some way to combine user_identifications) + if { ![empty_string_p $issue_user_id] } { + # find out the user_id associated with c_user_identification_id + set c_user_id [database_to_tcl_string $db "select user_id from ec_user_identification where user_identification_id=$c_user_identification_id"] + # if the c_user_id is null, they should be told about the option of matching up a user_id with + # user_identification_id + # otherwise, if the issue doesn't belong to them, they just get a plain error message + if { [empty_string_p $c_user_id] } { + ad_return_complaint 1 "The issue ID you specified belongs to the registered user + [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id=$issue_user_id"]. However, you haven't associated this interaction with any registered user. You've associated it with the unregistered user [ec_user_identification_summary $db $c_user_identification_id]. If these are really the same user, match them up by clicking on the \"user info\" link and then you can reload this page without getting this error message." + return + } elseif { [string compare $c_user_id $issue_user_id] != 0 } { + ad_return_complaint 1 "The issue ID you specified does not belong to the user you specified." + return + } + } + } +} + + +# 3. consistent order ownership +if { [info exists order_id] && ![empty_string_p $order_id] } { + # see who the order belongs to + set selection [ns_db 0or1row $db "select user_id as order_user_id from ec_orders where order_id='$order_id'"] + if { [empty_string_p $selection] } { + ad_return_complaint 1 "
  • The order ID that you specified is invalid. Please go back and check the order ID you entered. If this issue is not about a specific order, please leave the order ID blank.\n" + return + } + set_variables_after_query + + if { ![empty_string_p $order_user_id] } { + + if { ![info exists interaction_id] } { + if { ![info exists d_user_id] || [string compare $d_user_id $order_user_id] != 0 } { + + ReturnHeaders + ns_write "[ad_admin_header "User Doesn't Match Order"] +

    User Doesn't Match Order

    + [ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] "New Interaction"] + +
    + Order ID $order_id belongs to the registered user [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id='$order_user_id'"]. + +

    + + However, you haven't selected that user as the customer involved in this interaction. + +

    + + Would you like to make this user be the owner of this interaction? (If not, push Back and fix the order ID.) + +

    + [philg_hidden_input "d_user_id" $order_user_id] + [ec_export_entire_form_except d_user_id d_user_identification_id] +
    + +
    +
    + + [ad_admin_footer] + " + return + } + } else { + # interaction_id exists + # find out the user_id associated with c_user_identification_id + set c_user_id [database_to_tcl_string $db "select user_id from ec_user_identification where user_identification_id=$c_user_identification_id"] + # if the c_user_id is null, they should be told about the option of matching up a user_id with + # user_identification_id + # otherwise, if the order doesn't belong to them, they just get a plain error message + if { [empty_string_p $c_user_id] } { + ad_return_complaint 1 "The order ID you specified belongs to the registered user + [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id='$order_user_id'"]. However, you haven't associated this interaction with any registered user. You've associated it with the unregistered user [ec_user_identification_summary $db $c_user_identification_id]. If these are really the same user, match them up by clicking on the \"user info\" link and then you can reload this page without getting this error message." + return + } elseif { [string compare $c_user_id $order_user_id] != 0 } { + ad_return_complaint 1 "The order ID you specified does not belong to the user you specified." + return + } + + } + } + # Otherwise, the order is in_basket (that's why it has no user_id associated with it). + # If the user_identification_id has a user_id associated with it, we should + # probably give them them opportunity of sticking that into the ec_orders + # table + # but maybe that's giving them too much power to mess things up, so I guess not +} + +# done error checking +# deal w/select multiples + +set form_counter 0 + +set issue_type_list [list] +set info_used_list [list] + +while { $form_counter < $form_size} { + set form_key [ns_set key $form $form_counter] + if { $form_key == "issue_type" || $form_key == "info_used" } { + set form_value [ns_set value $form $form_counter] + if { ![empty_string_p $form_value] } { + lappend ${form_key}_list $form_value + } + } + incr form_counter +} + + +if { [info exists interaction_id] } { + # then the open_date didn't get passed along to this + # script (but we need it for new customer service issues) + set open_date [database_to_tcl_string $db "select to_char(interaction_date, 'YYYY-MM-DD HH24:MI:SS') as open_date from ec_customer_serv_interactions where interaction_id=$interaction_id"] +} + + + +# create the sql string for inserting open_date +set date_string "to_date('$open_date','YYYY-MM-DD HH24:MI:SS')" + +if { [info exists interaction_id] } { + set create_new_interaction_p "f" +} else { + set create_new_interaction_p "t" +} + +ns_db dml $db "begin transaction" + + +# I. Have to generate: +# 1. interaction_id, unless it already exists +# 2. issue_id, unless it already exists + +# interaction_id will either be a number or it will not exist +if { ![info exists interaction_id] } { + set interaction_id [database_to_tcl_string $db "select ec_interaction_id_sequence.nextval from dual"] +} + +# issue_id will either be a number or it will be the empty string +if { [empty_string_p $issue_id] } { + set issue_id [database_to_tcl_string $db "select ec_issue_id_sequence.nextval from dual"] + set create_new_issue_p "t" +} else { + set create_new_issue_p "f" +} + +# II. User identification (first time through): +# 1. If we have d_user_id, see if there's a user_identification with that user_id +# 2. Otherwise, see if we have d_user_identification_id +# 3. Otherwise, create a new user_identification_id + +if { $create_new_interaction_p == "t" && ![info exists c_user_identification_id] } { + if { [info exists d_user_id] } { + set selection [ns_db select $db "select user_identification_id as uiid_to_insert from ec_user_identification where user_id=$d_user_id"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_db flush $db + break + } + } + + if { ![info exists uiid_to_insert] } { + + if { [info exists d_user_identification_id] } { + set uiid_to_insert $d_user_identification_id + } else { + set user_id_to_insert "" + if { [info exists d_user_id] } { + set user_id_to_insert $d_user_id + } + set uiid_to_insert [database_to_tcl_string $db "select ec_user_ident_id_sequence.nextval from dual"] + ns_db dml $db "insert into ec_user_identification + (user_identification_id, user_id, email, first_names, last_name, postal_code, other_id_info) + values + ($uiid_to_insert, '$user_id_to_insert', '$QQemail','$QQfirst_names','$QQlast_name','$QQpostal_code','$QQother_id_info') + " + } + } +} else { + set uiid_to_insert $c_user_identification_id +} + + +# III. Interaction (only if this is the first time through): +# Have to insert into ec_customer_serv_interactions: +# 1. interaction_id +# 2. customer_service_rep +# 3. user_identification_id (= uiid_to_insert determined in II) +# 4. interaction_date (= open_date) +# 5. interaction_originator +# 6. interaction_type (= interaction_type or interaction_type_other) + +if { $create_new_interaction_p == "t" } { + ns_db dml $db "insert into ec_customer_serv_interactions + (interaction_id, customer_service_rep, user_identification_id, interaction_date, interaction_originator, interaction_type) + values + ($interaction_id, $customer_service_rep, $uiid_to_insert, $date_string, '$QQinteraction_originator', [ec_decode $interaction_type "other" "'$QQinteraction_type_other'" "'$QQinteraction_type'"]) + " +} + +# IV. Issue (unless we already have an issue): +# 1. Have to insert into ec_customer_service_issues: +# A. issue_id (passed along or generated) +# B. user_identification_id (= uiid_to_insert determined in II) +# C. order_id +# D. open_date +# E. close_date (=null if close_issue_p=f, =open_date if close_issue_p=t) +# F. closed_by (=null if close_issue_p=f, =customer_service_rep if close_issue_p=t) +# 2. Have to insert into ec_cs_issue_type_map: +# issue_id & issue_type for each issue_type in issue_type_list + + +if { $create_new_issue_p == "t" } { + ns_db dml $db "insert into ec_customer_service_issues + (issue_id, user_identification_id, order_id, open_date, close_date, closed_by) + values + ($issue_id, $uiid_to_insert, [db_null_sql $order_id], $date_string, [ec_decode $close_issue_p "t" $date_string "NULL"], [ec_decode $close_issue_p "t" $customer_service_rep "NULL"]) + " + + foreach issue_type $issue_type_list { + ns_db dml $db "insert into ec_cs_issue_type_map + (issue_id, issue_type) + values + ($issue_id, '[DoubleApos $issue_type]') + " + } +} + +# V. Action: +# 1. Have to insert into ec_customer_service_actions: +# A. action_id +# B. issue_id (passed along or generated) +# C. interaction_id (generated in II) +# D. action_details +# E. follow_up_required +# 2. Have to insert into ec_cs_action_info_used_map: +# action_id and info_used for each info_used in info_used_list + +ns_db dml $db "insert into ec_customer_service_actions +(action_id, issue_id, interaction_id, action_details, follow_up_required) +values +($action_id, $issue_id, $interaction_id, '$QQaction_details','$QQfollow_up_required') +" + +foreach info_used $info_used_list { + ns_db dml $db "insert into ec_cs_action_info_used_map + (action_id, info_used) + values + ($action_id, '[DoubleApos $info_used]') + " +} + +ns_db dml $db "end transaction" + + +if { $submit == "Interaction Complete" } { + if { ![info exists return_to_issue] } { + ns_returnredirect interaction-add.tcl + } else { + ns_returnredirect "issue.tcl?issue_id=$return_to_issue" + } +} else { + # (in c_user_identification_id, "c" stands for "confirmed" meaning + # that they've been through interaction-add-3.tcl and now they cannot change + # the user_identification_id) + ns_returnredirect "interaction-add-2.tcl?[export_url_vars interaction_id postal_code return_to_issue]&c_user_identification_id=$uiid_to_insert" +} Index: web/openacs/www/admin/ecommerce/customer-service/interaction-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/interaction-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/interaction-add.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,111 @@ +# interaction-add.tcl,v 3.0 2000/02/06 03:17:55 ron Exp +set_form_variables 0 +# possibly issue_id, user_identification_id + +# the customer service rep must be logged on + +set return_url "[ns_conn url]" + +set customer_service_rep [ad_get_user_id] + +if {$customer_service_rep == 0} { + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +if { [info exists issue_id] } { + set return_to_issue $issue_id +} +if { [info exists user_identification_id] } { + set c_user_identification_id $user_identification_id +} + +ReturnHeaders + +ns_write "[ad_admin_header "New Interaction"] +

    New Interaction

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] "New Interaction"] + + +
    + +
    +[export_form_vars issue_id return_to_issue c_user_identification_id] +
    + +" + +set db [ns_db gethandle] + +if { [info exists user_identification_id] } { + ns_write " + + + + " +} + +ns_write " + + + + + + + + + + + + + + + +
    Customer:[ec_user_identification_summary $db $user_identification_id]
    Customer Service Rep:[database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id=$customer_service_rep"] (if this is wrong, please log in)
    Date & Time:[ad_dateentrywidget open_date] [ec_timeentrywidget open_date "[ns_localsqltimestamp]"]
    Inquired via: +[ec_interaction_type_widget $db] +
    Who initiated this inquiry? +
    +
    +" + +if { ![info exists user_identification_id] } { + ns_write "

    + Fill in any of the following information, which the system can use to try to identify the customer: +

    +

    + + + + + + + + + + + + + + + + + +
    First Name: Last Name:
    Email Address:
    Zip Code: + If you fill this in, we'll determine which city/state they live in.
    Other Identifying Info:
    + " +} + +ns_write "
    + +
    + +
    + +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/customer-service/interaction-summary.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/interaction-summary.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/interaction-summary.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,102 @@ +# interaction-summary.tcl,v 3.0 2000/02/06 03:17:57 ron Exp +set_the_usual_form_variables +# user_id or user_interaction_id + +ReturnHeaders + +set page_title "Interaction Summary" +ns_write "[ad_admin_header $page_title] +

    $page_title

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] $page_title] + +
    + +Customer: +" + +set db [ns_db gethandle] + +if { [info exists user_id] } { + ns_write "Registered user: [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id=$user_id"]" +} else { + ns_write "[ec_user_identification_summary $db $user_identification_id]" +} + +ns_write "

    +

    +" + +if { [info exists user_id] } { + + set selection [ns_db select $db "select a.issue_id, a.action_id, a.interaction_id, a.action_details, a.follow_up_required, i.customer_service_rep, i.interaction_date, to_char(i.interaction_date,'YYYY-MM-DD HH24:MI:SS') as full_interaction_date, i.interaction_originator, i.interaction_type, reps.first_names || ' ' || reps.last_name as rep_name + from ec_customer_service_actions a, ec_customer_serv_interactions i, ec_user_identification id, users reps + where a.interaction_id=i.interaction_id + and i.user_identification_id=id.user_identification_id + and id.user_id=$user_id + and i.customer_service_rep = reps.user_id(+) + order by a.action_id desc"] + +} else { + set selection [ns_db select $db "select a.issue_id, a.action_id, a.interaction_id, a.action_details, a.follow_up_required, i.customer_service_rep, i.interaction_date, to_char(i.interaction_date,'YYYY-MM-DD HH24:MI:SS') as full_interaction_date, i.interaction_originator, i.interaction_type, reps.first_names || ' ' || reps.last_name as rep_name + from ec_customer_service_actions a, ec_customer_serv_interactions i, ec_user_identification id + where a.interaction_id=i.interaction_id + and i.user_identification_id=$user_identification_id + and i.customer_service_rep = reps.user_id + order by a.action_id desc"] +} + +set old_interaction_id "" +set action_counter 0 +while { [ns_db getrow $db $selection] } { + incr action_counter + set_variables_after_query + + if { [string compare $interaction_id $old_interaction_id] != 0 } { + ns_write "

    +
    + + [ec_formatted_full_date $full_interaction_date]
    + + + + +
    Rep$rep_name
    Originator$interaction_originator
    Via$interaction_type
    + +
    + " + } + + + ns_write "

    + + + + " + if { ![empty_string_p $follow_up_required] } { + ns_write " + " + } + ns_write "
    Issue ID: $issue_id
    +
    + Details: +
    + [ec_display_as_html $action_details] +
    +
    +
    +
    + Follow-up Required: +
    + [ec_display_as_html $follow_up_required] +
    +
    +
    + " + + set old_interaction_id $interaction_id +} + +ns_write "

    +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/customer-service/interaction.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/interaction.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/interaction.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,85 @@ +# interaction.tcl,v 3.0 2000/02/06 03:17:58 ron Exp +set_the_usual_form_variables +# interaction_id + +ReturnHeaders + +set page_title "Interaction #$interaction_id" +ns_write "[ad_admin_header $page_title] +

    $page_title

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] $page_title] + +
    + + + + +" + +set db [ns_db gethandle] +set selection [ns_db 1row $db "select user_identification_id, customer_service_rep, to_char(interaction_date,'YYYY-MM-DD HH24:MI:SS') as full_interaction_date, interaction_originator, interaction_type, interaction_headers from ec_customer_serv_interactions where interaction_id=$interaction_id"] +set_variables_after_query + +ns_write " + +" + + +ns_write " + + + + + + + + + + + + + + + +" + +if { ![empty_string_p $interaction_headers] } { + ns_write " + +
    Customer[ec_user_identification_summary $db $user_identification_id]
    Interaction Date[util_AnsiDatetoPrettyDate [lindex [split $full_interaction_date " "] 0]] [lindex [split $full_interaction_date " "] 1]
    Rep$customer_service_rep
    Originator$interaction_originator
    Inquired Via$interaction_type
    Interaction Heade +
    + " +} + +ns_write " +
    +

    +

    All actions associated with this interaction

    +
    +" + +set selection [ns_db select $db "select a.action_details, a.follow_up_required, a.issue_id +from ec_customer_service_actions a +where a.interaction_id=$interaction_id +order by a.action_id desc"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write " + + +" +if { ![empty_string_p $follow_up_required] } { + ns_write " + " +} +ns_write "
    Issue: $issue_id
    Details:
    [ec_display_as_html $action_details]
    Follow-up Required:
    [ec_display_as_html $follow_up_required]
    +

    +" + +} + +ns_write "

    +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/customer-service/interactions.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/interactions.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/interactions.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,228 @@ +# interactions.tcl,v 3.0 2000/02/06 03:18:00 ron Exp +set_form_variables 0 +# possibly view_rep and/or view_interaction_originator and/or view_interaction_type and/or view_interaction_date + +if { ![info exists view_rep] } { + set view_rep "all" +} +if { ![info exists view_interaction_originator] } { + set view_interaction_originator "all" +} +if { ![info exists view_interaction_type] } { + set view_interaction_type "all" +} +if { ![info exists view_interaction_date] } { + set view_interaction_date "all" +} +if { ![info exists order_by] } { + set order_by "interaction_id" +} + +ReturnHeaders +ns_write "[ad_admin_header "Customer Service Interactions"] + +

    Customer Service Interactions

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] "Issues"] + +
    + +
    +[export_form_vars view_interaction_originator view_interaction_type view_interaction_date order_by] + + + + + + + + + + + + +
    RepOriginatorTypeDate
    + +" + +set interaction_originator_list [database_to_tcl_list $db "select distinct interaction_originator from ec_customer_serv_interactions"] + +lappend interaction_originator_list "all" + +set linked_interaction_originator_list [list] + +foreach interaction_originator $interaction_originator_list { + if { $interaction_originator == $view_interaction_originator } { + lappend linked_interaction_originator_list "$interaction_originator" + } else { + lappend linked_interaction_originator_list "$interaction_originator" + } +} + +ns_write "\[ [join $linked_interaction_originator_list " | "] \] + +" + +set interaction_type_list [database_to_tcl_list $db "select picklist_item from ec_picklist_items where picklist_name='interaction_type' order by sort_key"] + +lappend interaction_type_list "all" + +foreach interaction_type $interaction_type_list { + if { $interaction_type == $view_interaction_type } { + lappend linked_interaction_type_list "$interaction_type" + } else { + lappend linked_interaction_type_list "$interaction_type" + } +} + +ns_write "\[ [join $linked_interaction_type_list " | "] \] + +" + +set interaction_date_list [list [list last_24 "last 24 hrs"] [list last_week "last week"] [list last_month "last month"] [list all all]] + +set linked_interaction_date_list [list] + +foreach interaction_date $interaction_date_list { + if {$view_interaction_date == [lindex $interaction_date 0]} { + lappend linked_interaction_date_list "[lindex $interaction_date 1]" + } else { + lappend linked_interaction_date_list "[lindex $interaction_date 1]" + } +} + + +ns_write "\[ [join $linked_interaction_date_list " | "] \] + +
    + +
    +
    +" + + +if { $view_rep == "all" } { + set rep_query_bit "" +} else { + set rep_query_bit "and i.customer_service_rep=[ns_dbquotevalue $view_rep]" +} + +if { $view_interaction_originator == "all" } { + set interaction_originator_query_bit "" +} else { + set interaction_originator_query_bit "and i.interaction_originator='[DoubleApos $view_interaction_originator]'" +} + +if { $view_interaction_type == "all" } { + set interaction_type_query_bit "" +} else { + set interaction_type_query_bit "and i.interaction_type='[DoubleApos $view_interaction_type]'" +} + +if { $view_interaction_date == "last_24" } { + set interaction_date_query_bit "and sysdate()-i.interaction_date <= 1" +} elseif { $view_interaction_date == "last_week" } { + set interaction_date_query_bit "and sysdate()-i.interaction_date <= 7" +} elseif { $view_interaction_date == "last_month" } { + set interaction_date_query_bit "and months_between(sysdate(),i.interaction_date) <= 1" +} else { + set interaction_date_query_bit "" +} + +set link_beginning "interactions.tcl?[export_url_vars view_rep view_interaction_originator view_interaction_type view_interaction_date]" + +set table_header " + + + + + + + +" + + +set selection [ns_db select $db "select i.interaction_id, i.customer_service_rep, i.interaction_date, +to_char(i.interaction_date,'YYYY-MM-DD HH24:MI:SS') as full_interaction_date, i.interaction_originator, +i.interaction_type, i.user_identification_id, reps.first_names as rep_first_names, +reps.last_name as rep_last_name, customer_info.user_identification_id, +customer_info.user_id as customer_user_id, customer_info.first_names as customer_first_names, +customer_info.last_name as customer_last_name +from ec_customer_serv_interactions i, users reps, +(select id.user_identification_id, id.user_id, u2.first_names, u2.last_name from ec_user_identification id, users u2 where id.user_id=u2.user_id(+)) customer_info +where i.customer_service_rep=reps.user_id(+) +and i.user_identification_id=customer_info.user_identification_id +$rep_query_bit $interaction_originator_query_bit $interaction_type_query_bit $interaction_date_query_bit +order by $order_by"] + +set row_counter 0 + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $row_counter == 0 } { + ns_write $table_header + } elseif { $row_counter == 20 } { + ns_write "
    Interaction IDDateRepCustomerOriginatorType
    +

    + $table_header + " + set row_counter 1 + } + # even rows are white, odd are grey + if { [expr floor($row_counter/2.)] == [expr $row_counter/2.] } { + set bgcolor "white" + } else { + set bgcolor "ececec" + } + + ns_write "$interaction_id + [ec_formatted_full_date $full_interaction_date] + " + if { ![empty_string_p $customer_service_rep] } { + ns_write "$rep_last_name, $rep_first_names" + } else { + ns_write " " + } + if { ![empty_string_p $customer_user_id] } { + ns_write "$customer_last_name, $customer_first_names" + } else { + ns_write "unregistered user: $user_identification_id" + } + ns_write "$interaction_originator + $interaction_type + + " + incr row_counter +} + +if { $row_counter != 0 } { + ns_write "" +} else { + ns_write "

    None Found
    " +} + +ns_write " +
    +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/customer-service/issue-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/issue-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/issue-edit-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,33 @@ +# issue-edit-2.tcl,v 3.0 2000/02/06 03:18:01 ron Exp +set_the_usual_form_variables +# issue_id, issue_type (select multiple) + +set form [ns_getform] +set form_size [ns_set size $form] +set form_counter 0 +set issue_type_list [list] +while { $form_counter < $form_size} { + set form_key [ns_set key $form $form_counter] + if { $form_key == "issue_type" } { + set form_value [ns_set value $form $form_counter] + if { ![empty_string_p $form_value] } { + lappend ${form_key}_list $form_value + } + } + incr form_counter +} + + +set db [ns_db gethandle] + +ns_db dml $db "begin transaction" + +ns_db dml $db "delete from ec_cs_issue_type_map where issue_id=$issue_id" + +foreach issue_type $issue_type_list { + ns_db dml $db "insert into ec_cs_issue_type_map (issue_id, issue_type) values ($issue_id, '[DoubleApos $issue_type]')" +} + +ns_db dml $db "end transaction" + +ns_returnredirect "issue.tcl?[export_url_vars issue_id]" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/customer-service/issue-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/issue-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/issue-edit.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,50 @@ +# issue-edit.tcl,v 3.0 2000/02/06 03:18:02 ron Exp +set_the_usual_form_variables +# issue_id + +set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + +set customer_service_rep [ad_get_user_id] + +if {$customer_service_rep == 0} { + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +ReturnHeaders + +set page_title "Edit Issue #$issue_id" +ns_write "[ad_admin_header $page_title] +

    $page_title

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] $page_title] + +
    +" + +set db [ns_db gethandle] +set issue_type_list [database_to_tcl_list $db "select issue_type from ec_cs_issue_type_map where issue_id=$issue_id"] + +ns_write " +If you are not [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id=$customer_service_rep"], please log in + +

    + +

    +[export_form_vars issue_id] + +Modify Issue Type: +
    +[ec_issue_type_widget $db $issue_type_list] +
    + +

    + +

    + +
    + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/customer-service/issue-open-or-close-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/issue-open-or-close-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/issue-open-or-close-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,13 @@ +# issue-open-or-close-2.tcl,v 3.0 2000/02/06 03:18:03 ron Exp +set_the_usual_form_variables +# issue_id, close_p, customer_service_rep + +set db [ns_db gethandle] + +if { $close_p == "t" } { + ns_db dml $db "update ec_customer_service_issues set close_date=sysdate(), closed_by=$customer_service_rep where issue_id=$issue_id" +} else { + ns_db dml $db "update ec_customer_service_issues set close_date=null where issue_id=$issue_id" +} + +ns_returnredirect "issue.tcl?[export_url_vars issue_id]" Index: web/openacs/www/admin/ecommerce/customer-service/issue-open-or-close.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/issue-open-or-close.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/issue-open-or-close.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,47 @@ +# issue-open-or-close.tcl,v 3.0 2000/02/06 03:18:05 ron Exp +set_the_usual_form_variables +# issue_id, close_p + +set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + +set customer_service_rep [ad_get_user_id] + +if {$customer_service_rep == 0} { + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +ReturnHeaders + +if { $close_p == "t" } { + set page_title "Close Issue #$issue_id" +} else { + set page_title "Reopen Issue #$issue_id" +} + +ns_write "[ad_admin_header $page_title] +

    $page_title

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] $page_title] + +
    +" + +set db [ns_db gethandle] + +ns_write " +If you are not [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id=$customer_service_rep"], please log in + +

    +Please confirm that you wish to [ec_decode $close_p "t" "close" "reopen"] this issue. + +

    +[export_form_vars issue_id close_p customer_service_rep] + +
    + +
    + + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/customer-service/issue.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/issue.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/issue.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,182 @@ +# issue.tcl,v 3.0 2000/02/06 03:18:06 ron Exp +set_the_usual_form_variables +# issue_id + +set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + +set customer_service_rep [ad_get_user_id] + +if {$customer_service_rep == 0} { + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +ReturnHeaders + +set page_title "Issue #$issue_id" +ns_write "[ad_admin_header $page_title] +

    $page_title

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] $page_title] + +
    +" + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select i.user_identification_id, i.order_id, i.closed_by, i.deleted_p, i.open_date, i.close_date, to_char(i.open_date,'YYYY-MM-DD HH24:MI:SS') as full_open_date, to_char(i.close_date,'YYYY-MM-DD HH24:MI:SS') as full_close_date, u.first_names || ' ' || u.last_name as closed_rep_name +from ec_customer_service_issues i, users u +where i.closed_by=u.user_id +and issue_id=$issue_id +union +select i.user_identification_id, i.order_id, i.closed_by, i.deleted_p, i.open_date, i.close_date, to_char(i.open_date,'YYYY-MM-DD HH24:MI:SS') as full_open_date, to_char(i.close_date,'YYYY-MM-DD HH24:MI:SS') as full_close_date, NULL as closed_rep_name +from ec_customer_service_issues i +where not exists (select user_id from users where user_id=closed_by) +and issue_id=$issue_id"] + +set_variables_after_query + +if { [empty_string_p $close_date] } { + set open_close_link "close" +} else { + set open_close_link "reopen" +} + +ns_write " +\[ edit | $open_close_link | send email | record an interaction \] + +

    + +

    + + + + + +" + +if { ![empty_string_p $order_id] } { + ns_write " + + + + " +} + +set issue_type_list [database_to_tcl_list $db "select issue_type from ec_cs_issue_type_map where issue_id=$issue_id"] +set issue_type [join $issue_type_list ", "] + +if { ![empty_string_p $issue_type] } { + ns_write " + + + + " +} + + +ns_write " + + + +" + +if { ![empty_string_p $close_date] } { + ns_write " + + + + + + + + " +} + +ns_write " +
    Customer[ec_user_identification_summary $db $user_identification_id]
    Order #$order_id
    Issue Type$issue_type
    Open Date[util_AnsiDatetoPrettyDate [lindex [split $full_open_date " "] 0]] [lindex [split $full_open_date " "] 1]
    Close Date[util_AnsiDatetoPrettyDate [lindex [split $full_close_date " "] 0]] [lindex [split $full_close_date " "] 1]
    Closed By$closed_rep_name
    +
    + +

    + +

    All actions associated with this issue

    +
    +" + +set selection [ns_db select $db " +select a.action_id, a.interaction_id, a.action_details, a.follow_up_required, i.customer_service_rep, i.interaction_date, to_char(i.interaction_date,'YYYY-MM-DD HH24:MI:SS') as full_interaction_date, i.interaction_originator, i.interaction_type, m.info_used +from ec_customer_service_actions a, ec_customer_serv_interactions i, ec_cs_action_info_used_map m +where a.interaction_id=i.interaction_id +and a.action_id=m.action_id +and a.issue_id=$issue_id +union +select a.action_id, a.interaction_id, a.action_details, a.follow_up_required, i.customer_service_rep, i.interaction_date, to_char(i.interaction_date,'YYYY-MM-DD HH24:MI:SS') as full_interaction_date, i.interaction_originator, i.interaction_type, NULL as info_used +from ec_customer_service_actions a, ec_customer_serv_interactions i +where a.interaction_id=i.interaction_id +and not exists (select action_id from ec_cs_action_info_used_map where action_id= a.action_id) +and a.issue_id=$issue_id +order by a.action_id desc"] + + +set old_action_id "" +set info_used_list [list] +set action_counter 0 +while { [ns_db getrow $db $selection] } { + incr action_counter + set_variables_after_query + if { [string compare $action_id $old_action_id] != 0 } { + if { [llength $info_used_list] > 0 } { + ns_write "[join $info_used_list "
    "]" + set info_used_list [list] + } else { + ns_write " " + } + + + if { ![empty_string_p $old_action_id] } { + ns_write "$old_interaction_id + Details:
    [ec_display_as_html $old_action_details]
    + " + if { ![empty_string_p $old_follow_up_required] } { + ns_write "Follow-up Required:
    [ec_display_as_html $old_follow_up_required]
    " + } + ns_write " +

    + " + } + ns_write " + + + " + } + + if { ![empty_string_p $info_used] } { + lappend info_used_list $info_used + } + set old_action_id $action_id + set old_interaction_id $interaction_id + set old_action_details $action_details + set old_follow_up_required $follow_up_required +} + +if { [llength $info_used_list] > 0 } { + ns_write "" + set info_used_list [list] +} else { + ns_write "" +} +if { ![empty_string_p $old_action_id] } { + ns_write " + + " + if { ![empty_string_p $follow_up_required] } { + ns_write " + " + } + ns_write "
    DateRepOriginatorInquired ViaInfo UsedInteraction
    [util_AnsiDatetoPrettyDate [lindex [split $full_interaction_date " "] 0]] [lindex [split $full_interaction_date " "] 1][ec_decode $customer_service_rep "" " " "$customer_service_rep"]$interaction_originator$interaction_type[join $info_used_list "
    "]    		 $interaction_id
    Details:
    [ec_display_as_html $action_details]
    Follow-up Required:
    [ec_display_as_html $follow_up_required]
    + " +} + +ns_write "

    +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/customer-service/issues.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/issues.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/issues.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,269 @@ +# issues.tcl,v 3.0 2000/02/06 03:18:07 ron Exp +set_form_variables 0 +# possibly view_issue_type and/or view_status and/or view_open_date and/or order_by + +if { ![info exists view_issue_type] } { + set view_issue_type "uncategorized" +} +if { ![info exists view_status] } { + set view_status "open" +} +if { ![info exists view_open_date] } { + set view_open_date "all" +} +if { ![info exists order_by] } { + set order_by "i.issue_id" +} + +ReturnHeaders + +ns_write "[ad_admin_header "Customer Service Issues"] + +

    Customer Service Issues

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] "Issues"] + +
    + + +[export_form_vars view_issue_type view_status view_open_date order_by] + + + + + + + + + + +
    Issue TypeStatusOpen Date
    + + +" + +set status_list [list "open" "closed"] + +set linked_status_list [list] + +foreach status $status_list { + if { $status == $view_status } { + lappend linked_status_list "$status" + } else { + lappend linked_status_list "$status" + } +} + +ns_write "\[ [join $linked_status_list " | "] \] + +" + +set open_date_list [list [list last_24 "last 24 hrs"] [list last_week "last week"] [list last_month "last month"] [list all all]] + +set linked_open_date_list [list] + +foreach open_date $open_date_list { + if {$view_open_date == [lindex $open_date 0]} { + lappend linked_open_date_list "[lindex $open_date 1]" + } else { + lappend linked_open_date_list "[lindex $open_date 1]" + } +} + +ns_write "\[ [join $linked_open_date_list " | "] \] + +
    + +
    +
    +" + +if { $view_status == "open" } { + set status_query_bit "and i.close_date is null" +} else { + set status_query_bit "and i.close_date is not null" +} + +if { $view_open_date == "last_24" } { + set open_date_query_bit "and sysdate()-i.open_date <= timespan_days(1)" +} elseif { $view_open_date == "last_week" } { + set open_date_query_bit "and sysdate()-i.open_date <= timespan_days(7)" +} elseif { $view_open_date == "last_month" } { + set open_date_query_bit "and sysdate()-i.open_date <= '1 month'::reltime" +} else { + set open_date_query_bit "" +} + +if { $view_issue_type == "uncategorized" } { + + set sql_query "(select i.issue_id, u.user_id, u.first_names as users_first_names, + u.last_name as users_last_name, id.user_identification_id, i.order_id, + to_char(open_date,'YYYY-MM-DD HH24:MI:SS') as full_open_date, + to_char(close_date,'YYYY-MM-DD HH24:MI:SS') as full_close_date + from ec_customer_service_issues i, users u, ec_user_identification id + where i.user_identification_id = id.user_identification_id + and id.user_id = u.user_id + and 0 = (select count(*) from ec_cs_issue_type_map m where m.issue_id=i.issue_id) + $open_date_query_bit $status_query_bit) union + (select i.issue_id, null as user_id, null as users_first_names, + null as users_last_name, id.user_identification_id, i.order_id, + to_char(open_date,'YYYY-MM-DD HH24:MI:SS') as full_open_date, + to_char(close_date,'YYYY-MM-DD HH24:MI:SS') as full_close_date + from ec_customer_service_issues i, ec_user_identification id + where i.user_identification_id = id.user_identification_id + and id.user_id is null + and 0 = (select count(*) from ec_cs_issue_type_map m where m.issue_id=i.issue_id) + $open_date_query_bit $status_query_bit) + order by i.issue_id desc + " + +} elseif { $view_issue_type == "all others" } { + + if { [llength $important_issue_type_list] > 0 } { + # taking advantage of the fact that tcl lists are just strings + set safe_important_issue_type_list [DoubleApos $important_issue_type_list] + set issue_type_query_bit "and m.issue_type not in ('[join $safe_important_issue_type_list "', '"]')" + } else { + set issue_type_query_bit "" + } + + set sql_query "(select i.issue_id, u.user_id, u.first_names as users_first_names, + u.last_name as users_last_name, id.user_identification_id, i.order_id, + to_char(open_date,'YYYY-MM-DD HH24:MI:SS') as full_open_date, + to_char(close_date,'YYYY-MM-DD HH24:MI:SS') as full_close_date, + m.issue_type + from ec_customer_service_issues i, users u, ec_user_identification id, ec_cs_issue_type_map m + where i.user_identification_id = id.user_identification_id + and id.user_id = u.user_id + and i.issue_id = m.issue_id + $open_date_query_bit $status_query_bit + $issue_type_query_bit) union + (select i.issue_id, null as user_id, null as users_first_names, + null as users_last_name, id.user_identification_id, i.order_id, + to_char(open_date,'YYYY-MM-DD HH24:MI:SS') as full_open_date, + to_char(close_date,'YYYY-MM-DD HH24:MI:SS') as full_close_date, + m.issue_type + from ec_customer_service_issues i, ec_user_identification id, ec_cs_issue_type_map m + where i.user_identification_id = id.user_identification_id + and id.user_id is null + and i.issue_id = m.issue_id + $open_date_query_bit $status_query_bit + $issue_type_query_bit) + order by $order_by + " + +} else { + + set sql_query "(select i.issue_id, u.user_id, u.first_names as users_first_names, + u.last_name as users_last_name, id.user_identification_id, i.order_id, + to_char(open_date,'YYYY-MM-DD HH24:MI:SS') as full_open_date, + to_char(close_date,'YYYY-MM-DD HH24:MI:SS') as full_close_date, + m.issue_type + from ec_customer_service_issues i, users u, ec_user_identification id, ec_cs_issue_type_map m + where i.user_identification_id = id.user_identification_id + and id.user_id = u.user_id + and i.issue_id = m.issue_id + and m.issue_type='[DoubleApos $view_issue_type]' + $open_date_query_bit $status_query_bit) union + (select i.issue_id, null as user_id, null as users_first_names, + null as users_last_name, id.user_identification_id, i.order_id, + to_char(open_date,'YYYY-MM-DD HH24:MI:SS') as full_open_date, + to_char(close_date,'YYYY-MM-DD HH24:MI:SS') as full_close_date, + m.issue_type + from ec_customer_service_issues i, ec_user_identification id, ec_cs_issue_type_map m + where i.user_identification_id = id.user_identification_id + and id.user_id is null + and i.issue_id = m.issue_id + and m.issue_type='[DoubleApos $view_issue_type]' + $open_date_query_bit $status_query_bit) + order by $order_by + " +} + +set link_beginning "issues.tcl?[export_url_vars view_issue_type view_status view_open_date]" + + +set table_header " + + + + + + + +" + + +set selection [ns_db select $db $sql_query] + + +set row_counter 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $row_counter == 0 } { + ns_write $table_header + } elseif { $row_counter == 20 } { + ns_write "
    Issue IDOpen DateClose DateCustomerOrder IDIssue Type
    +

    + $table_header + " + set row_counter 1 + } + # even rows are white, odd are grey + if { [expr floor($row_counter/2.)] == [expr $row_counter/2.] } { + set bgcolor "white" + } else { + set bgcolor "ececec" + } + + + ns_write "$issue_id + [ec_formatted_full_date $full_open_date] + [ec_decode $full_close_date "" " " [ec_formatted_full_date $full_close_date]] + " + + if { ![empty_string_p $user_id] } { + ns_write "$users_last_name, $users_first_names" + } else { + ns_write "unregistered user $user_identification_id" + } + + ns_write "[ec_decode $order_id "" " " "$order_id"]" + + if { $view_issue_type =="uncategorized" } { + ns_write " " + } else { + ns_write "$issue_type" + } + + ns_write "" + incr row_counter +} + +if { $row_counter != 0 } { + ns_write "" +} else { + ns_write "

    None Found
    " +} + +ns_write " +
    +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/customer-service/picklist-item-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/picklist-item-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/picklist-item-add-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,52 @@ +# picklist-item-add-2.tcl,v 3.0 2000/02/06 03:18:09 ron Exp +set_the_usual_form_variables +# picklist_item_id, picklist_item, picklist_name, prev_sort_key, next_sort_key + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +# see first whether they already entered this category (in case they +# pushed submit twice), in which case, just redirect to +# index.tcl + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select picklist_item_id from ec_picklist_items +where picklist_item_id=$picklist_item_id"] + +if { $selection != ""} { + ns_returnredirect "picklists.tcl" + return +} + +# now make sure that there is no picklist_item with the +# same picklist_name with a sort key equal to the new sort key + +set n_conflicts [database_to_tcl_string $db "select count(*) +from ec_picklist_items +where picklist_name='$QQpicklist_name' +and sort_key = ($prev_sort_key + $next_sort_key)/2"] + +if { $n_conflicts > 0 } { + ad_return_complaint 1 "
  • The picklist management page you came from appears + to be out-of-date; perhaps someone has changed the picklist items since you + last reloaded the page. + Please go back to the picklist management page, + push \"reload\" or \"refresh\" and try again." + return +} + +ns_db dml $db "insert into ec_picklist_items +(picklist_item_id, picklist_item, picklist_name, sort_key, last_modified, last_modifying_user, modified_ip_address) +values +($picklist_item_id, '$QQpicklist_item', '$QQpicklist_name', ($prev_sort_key + $next_sort_key)/2, sysdate(), $user_id, '[DoubleApos [ns_conn peeraddr]]')" + +ns_returnredirect "picklists.tcl" Index: web/openacs/www/admin/ecommerce/customer-service/picklist-item-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/picklist-item-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/picklist-item-add.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,48 @@ +# picklist-item-add.tcl,v 3.0 2000/02/06 03:18:10 ron Exp +set_the_usual_form_variables +# picklist_name, prev_sort_key, next_sort_key + +# error checking: make sure that there is no picklist_item with the +# same picklist_name with a sort key equal to the new sort key +# (average of prev_sort_key and next_sort_key); +# otherwise warn them that their form is not up-to-date + +set db [ns_db gethandle] +set n_conflicts [database_to_tcl_string $db "select count(*) +from ec_picklist_items +where picklist_name='$QQpicklist_name' +and sort_key = ($prev_sort_key + $next_sort_key)/2"] + +if { $n_conflicts > 0 } { + ad_return_complaint 1 "
  • The page you came from appears to be out-of-date; + perhaps someone has changed the picklist items since you last reloaded the page. + Please go back to the previous page, push \"reload\" or \"refresh\" and try + again." + return +} + +ReturnHeaders + +ns_write "[ad_admin_header "Add an Item"] + +

    Add an Item

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] [list "picklists.tcl" "Picklist Management"] "Add an Item"] + +
    +" + +set picklist_item_id [database_to_tcl_string $db "select ec_picklist_item_id_sequence.nextval from dual"] + +ns_write "
      + +
      +[export_form_vars prev_sort_key next_sort_key picklist_name picklist_item_id] +Name: + +
      + +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/customer-service/picklist-item-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/picklist-item-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/picklist-item-delete-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,9 @@ +# picklist-item-delete-2.tcl,v 3.0 2000/02/06 03:18:11 ron Exp +set_the_usual_form_variables +# picklist_item_id + +set db [ns_db gethandle] + +ns_db dml $db "delete from ec_picklist_items where picklist_item_id=$picklist_item_id" + +ns_returnredirect "picklists.tcl" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/customer-service/picklist-item-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/picklist-item-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/picklist-item-delete.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,24 @@ +# picklist-item-delete.tcl,v 3.0 2000/02/06 03:18:13 ron Exp +set_the_usual_form_variables +# picklist_item_id + +ReturnHeaders + +ns_write "[ad_admin_header "Please Confirm Deletion"] + +

    Please Confirm Deletion

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] [list "picklists.tcl" "Picklist Management"] "Delete Item"] + +
    +Please confirm that you wish to delete this item. + +
    +
    +[export_form_vars picklist_item_id] + +
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/customer-service/picklist-item-swap.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/picklist-item-swap.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/picklist-item-swap.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,27 @@ +# picklist-item-swap.tcl,v 3.0 2000/02/06 03:18:14 ron Exp +set_the_usual_form_variables +# picklist_item_id, next_picklist_item_id, sort_key, next_sort_key + +set db [ns_db gethandle] + +# check that the sort keys are the same as before; otherwise the page +# they got here from is out of date + +set item_match [database_to_tcl_string $db "select count(*) from ec_picklist_items where picklist_item_id=$picklist_item_id and sort_key=$sort_key"] + +set next_item_match [database_to_tcl_string $db "select count(*) from ec_picklist_items where picklist_item_id=$next_picklist_item_id and sort_key=$next_sort_key"] + +if { $item_match != 1 || $next_item_match != 1 } { + ad_return_complaint 1 "
  • The page you came from appears to be out-of-date; + perhaps someone has changed the picklist items since you last reloaded the page. + Please go back to the previous page, push \"reload\" or \"refresh\" and try + again." + return +} + +ns_db dml $db "begin transaction" +ns_db dml $db "update ec_picklist_items set sort_key=$next_sort_key where picklist_item_id=$picklist_item_id" +ns_db dml $db "update ec_picklist_items set sort_key=$sort_key where picklist_item_id=$next_picklist_item_id" +ns_db dml $db "end transaction" + +ns_returnredirect "picklists.tcl" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/customer-service/picklist-row-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/picklist-row-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/picklist-row-delete.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,9 @@ +# picklist-row-delete.tcl,v 3.0 2000/02/06 03:18:16 ron Exp +set_the_usual_form_variables +# table_name, rowid + +set db [ns_db gethandle] + +ns_db dml $db "delete from $table_name where rowid='$QQrowid'" + +ns_returnredirect picklists.tcl \ No newline at end of file Index: web/openacs/www/admin/ecommerce/customer-service/picklist-value-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/picklist-value-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/picklist-value-add.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,13 @@ +# picklist-value-add.tcl,v 3.0 2000/02/06 03:18:17 ron Exp +set_the_usual_form_variables +# table_name, col_to_insert, val_to_insert + +set db [ns_db gethandle] + +ns_db dml $db "insert into $table_name +($col_to_insert) +values +('$QQval_to_insert') +" + +ns_returnredirect picklists.tcl \ No newline at end of file Index: web/openacs/www/admin/ecommerce/customer-service/picklists.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/picklists.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/picklists.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,76 @@ +# picklists.tcl,v 3.0 2000/02/06 03:18:19 ron Exp +# To add a new picklist, just add an element to picklist_list; +# all UI changes on this page will be taken care of automatically + +ReturnHeaders + +ns_write "[ad_admin_header "Picklist Management"] +

    Picklist Management

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] "Picklist Management"] + +
    +These items will appear in the pull-down menus for customer service data entry. +These also determine which items are singled out in reports (items not in these +lists will be grouped together under \"all others\"). + +
    +" + +set db [ns_db gethandle] + +set picklist_list [list [list issue_type "Issue Type"] [list info_used "Information used to respond to inquiry"] [list interaction_type "Inquired Via"]] + +set picklist_counter 0 +foreach picklist $picklist_list { + if { $picklist_counter != 0 } { + ns_write " +
    + " + } + ns_write "

    [lindex $picklist 1]

    +
    + + " + + set selection [ns_db select $db "select picklist_item_id, picklist_item, picklist_name, sort_key + from ec_picklist_items + where picklist_name='[DoubleApos [lindex $picklist 0]]' + order by sort_key"] + + set picklist_item_counter 0 + set old_picklist_item_id "" + set old_picklist_sort_key "" + + while { [ns_db getrow $db $selection] } { + incr picklist_item_counter + set_variables_after_query + if { ![empty_string_p $old_picklist_item_id] } { + ns_write "" + } + set old_picklist_item_id $picklist_item_id + set old_sort_key $sort_key + ns_write " + \n" + + } + + if { $picklist_item_counter != 0 } { + ns_write " + " + } else { + ns_write "You haven't added any items. Add a picklist item.\n" + } + + incr picklist_counter +} + +if { $picklist_counter != 0 } { + ns_write "
      insert after    swap with next
    $picklist_item_counter. $picklist_itemdelete   insert after
    +
    + " +} + +ns_write "
    • +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/customer-service/spam-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/spam-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/spam-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,135 @@ +# spam-2.tcl,v 3.0 2000/02/06 03:18:20 ron Exp +set_the_usual_form_variables +# one of the following: mailing_list, user_class_id, product_id, the pieces of start_date, user_id_list, category_id, viewed_product_id +# also possibly: show_users_p + +set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + +set customer_service_rep [ad_get_user_id] + +if {$customer_service_rep == 0} { + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + + +ReturnHeaders + +ns_write "[ad_admin_header "Spam Users, Cont."] +

    Spam Users, Cont.

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] "Spam Users, Cont."] + +
    +" + +set db [ns_db gethandle] + +if { [info exists show_users_p] && $show_users_p == "t" } { + if { [info exists user_id_list] } { + set selection [ns_db select $db "select user_id, first_names, last_name + from users + where user_id in ([join $user_id_list ", "])"] + } elseif { [info exists mailing_list] } { + if { [llength $mailing_list] == 0 } { + set search_criteria "(category_id is null and subcategory_id is null and subsubcategory_id is null)" + } elseif { [llength $mailing_list] == 1 } { + set search_criteria "(category_id=$mailing_list and subcategory_id is null)" + } elseif { [llength $mailing_list] == 2 } { + set search_criteria "(subcategory_id=[lindex $mailing_list 1] and subsubcategory_id is null)" + } else { + set search_criteria "subsubcategory_id=[lindex $mailing_list 2]" + } + + set selection [ns_db select $db "select users.user_id, first_names, last_name + from users, ec_cat_mailing_lists + where users.user_id=ec_cat_mailing_lists.user_id + and $search_criteria"] + } elseif { [info exists user_class_id] } { + if { ![empty_string_p $user_class_id]} { + set sql_query "select users.user_id, first_names, last_name + from users, ec_user_class_user_map m + where m.user_class_id=$user_class_id + and m.user_id=users.user_id" + } else { + set sql_query "select user_id, first_names, last_name + from users" + } + + set selection [ns_db select $db $sql_query] + } elseif { [info exists product_id] } { + set selection [ns_db select $db "select unique users.user_id, first_names, last_name + from users, ec_items, ec_orders + where ec_items.order_id=ec_orders.order_id + and ec_orders.user_id=users.user_id + and ec_items.product_id=$product_id"] + } elseif { [info exists viewed_product_id] } { + set selection [ns_db select $db "select unique u.user_id, first_names, last_name + from users u, ec_user_session_info ui, ec_user_sessions us + where us.user_session_id=ui.user_session_id + and us.user_id=u.user_id + and ui.product_id=$viewed_product_id"] + } elseif { [info exists category_id] } { + set selection [ns_db select $db "select unique u.user_id, first_names, last_name + from users u, ec_user_session_info ui, ec_user_sessions us + where us.user_session_id=ui.user_session_id + and us.user_id=u.user_id + and ui.category_id=$category_id"] + } elseif { [info exists ColValue.start%5fdate.month] } { + # this is used in ec_report_get_start_date_and_end_date, which uses uplevel and puts + # together start_date and end_date + set return_date_error_p "t" + ec_report_get_start_date_and_end_date + if { [string compare $start_date "0"] == 0 || [string compare $end_date "0"] == 0 } { + ns_write "One of the dates you entered was specified incorrectly. The correct format is Month DD YYYY. Please go back and correct the date. Thank you. [ad_admin_footer]" + return + } + set selection [ns_db select $db "select user_id, first_names, last_name + from users + where last_visit >= to_date('$start_date','YYYY-MM-DD HH24:MI:SS') and last_visit <= to_date('$end_date','YYYY-MM-DD HH24:MI:SS')"] + } + + ns_write "The following users will be spammed: +
      " + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • $first_names $last_name\n" + } + ns_write "
    " +} + +set spam_id [database_to_tcl_string $db "select spam_id_sequence.nextval from dual"] + +# will export start_date and end_date separately so that they don't have to be re-put-together +# in spam-3.tcl +ns_write " +
    +[philg_hidden_input var_to_spellcheck "message"] +[philg_hidden_input target_url "/admin/ecommerce/customer-service/spam-3.tcl"] +[export_entire_form] +[export_form_vars spam_id start_date end_date] + + + + + + + + + + + + +
    From[ad_parameter CustomerServiceEmailAddress ecommerce]
    Subject Line
    Message
    Gift Certificate*Amount ([ad_parameter Currency ecommerce])     Expires [ec_gift_certificate_expires_widget "in 1 year"]
    Issue Type**[ec_issue_type_widget $db "spam"]
    +

    +

    + +
    +
    + +* Note: You can optionally issue a gift certificate to each user you're spamming (if you don't want to, just leave the amount blank). +

    +** Note: A customer service issue is created whenever an email is sent. The issue is automatically closed unless the customer replies to the issue, in which case it is reopened. + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/customer-service/spam-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/spam-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/spam-3.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,208 @@ +# spam-3.tcl,v 3.0 2000/02/06 03:18:21 ron Exp +set_the_usual_form_variables +# definitely: spam_id, subject, message, issue_type (select multiple), amount, expires +# possibly: mailing_list or user_class_id or product_id or (start_date & end_date) or user_id_list or viewed_product_id or category_id +# possibly: show_users_p + +# no confirm page because they were just sent through the spell +# checker (that's enough submits to push) + +set expires_to_insert [ec_decode $expires "" "null" $expires] + +# get rid of stupid ^Ms +regsub -all "\r" $message "" message + +set db_pools [ns_db gethandle [philg_server_default_pool] 2] +set db [lindex $db_pools 0] +set db_sub [lindex $db_pools 1] + +# doubleclick protection +if { [database_to_tcl_string $db "select count(*) from ec_spam_log where spam_id=$spam_id"] > 0 } { + ReturnHeaders + ns_write "[ad_admin_header "Spam Sent"] +

    Spam Sent

    + [ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] "Spam Sent"] +
    + You are seeing this page because you probably either hit reload or pushed the Submit button twice. +

    + If you wonder whether the users got the spam, just check the customer service issues for one of the users (all mail sent to a user is recorded as a customer service issue). + [ad_admin_footer] + " + return +} + +set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + +set customer_service_rep [ad_get_user_id] + +if {$customer_service_rep == 0} { + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +# deal w/issue_type +set form [ns_getform] +set form_size [ns_set size $form] +set form_counter 0 +set issue_type_list [list] +while { $form_counter < $form_size} { + set form_key [ns_set key $form $form_counter] + if { $form_key == "issue_type" } { + set form_value [ns_set value $form $form_counter] + if { ![empty_string_p $form_value] } { + lappend ${form_key}_list $form_value + } + } + incr form_counter +} + +# 1. Write row to spam log +# 2. Select the users to be spammed +# 3. For each user: +# a. create interaction +# b. create issue +# c. create action +# d. send email +# e. perhaps issue gift_certificate + +set mailing_list_category_id "" +set mailing_list_subcategory_id "" +set mailing_list_subsubcategory_id "" + +if { [info exists user_id_list] } { + set users_query "select user_id, email + from users + where user_id in ([join $user_id_list ", "])" +} elseif { [info exists mailing_list] } { + if { [llength $mailing_list] == 0 } { + set search_criteria "(category_id is null and subcategory_id is null and subsubcategory_id is null)" + } elseif { [llength $mailing_list] == 1 } { + set search_criteria "(category_id=$mailing_list and subcategory_id is null)" + set mailing_list_category_id $mailing_list + } elseif { [llength $mailing_list] == 2 } { + set search_criteria "(subcategory_id=[lindex $mailing_list 2] and subsubcategory_id is null)" + set mailing_list_category_id [lindex $mailing_list 0] + set mailing_list_subcategory_id [lindex $mailing_list 1] + } else { + set search_criteria "subsubcategory_id=[lindex $mailing_list 3]" + set mailing_list_category_id [lindex $mailing_list 0] + set mailing_list_subcategory_id [lindex $mailing_list 1] + set mailing_list_subsubcategory_id [lindex $mailing_list 2] + } + + set users_query "select users.user_id, email +from users, ec_cat_mailing_lists +where users.user_id=ec_cat_mailing_lists.user_id +and $search_criteria" + +} elseif { [info exists user_class_id] } { + if { ![empty_string_p $user_class_id]} { + set users_query "select users.user_id, first_names, last_name, email + from users, ec_user_class_user_map m + where m.user_class_id=$user_class_id + and m.user_id=users.user_id" + } else { + set users_query "select user_id, first_names, last_name, email + from users" + } +} elseif { [info exists product_id] } { + set users_query "select unique users.user_id, first_names, last_name, email + from users, ec_items, ec_orders + where ec_items.order_id=ec_orders.order_id + and ec_orders.user_id=users.user_id + and ec_items.product_id=$product_id" +} elseif { [info exists viewed_product_id] } { + set users_query "select unique u.user_id, first_names, last_name, email + from users u, ec_user_session_info ui, ec_user_sessions us + where us.user_session_id=ui.user_session_id + and us.user_id=u.user_id + and ui.product_id=$viewed_product_id" +} elseif { [info exists category_id] } { + set users_query "select unique u.user_id, first_names, last_name, email + from users u, ec_user_session_info ui, ec_user_sessions us + where us.user_session_id=ui.user_session_id + and us.user_id=u.user_id + and ui.category_id=$category_id" +} elseif { [info exists start_date] } { + set users_query "select user_id, first_names, last_name, email + from users + where last_visit >= to_date('$start_date','YYYY-MM-DD HH24:MI:SS') and last_visit <= to_date('$end_date','YYYY-MM-DD HH24:MI:SS')" +} + +# have to make all variables exist that will be inserted into ec_spam_log +if { ![info exists mailing_list_category_id] } { + set mailing_list_category_id "" +} +if { ![info exists mailing_list_subcategory_id] } { + set mailing_list_subcategory_id "" +} +if { ![info exists mailing_list_subsubcategory_id] } { + set mailing_list_subsubcategory_id "" +} +if { ![info exists user_class_id] } { + set user_class_id "" +} +if { ![info exists product_id] } { + set product_id "" +} +if { ![info exists start_date] } { + set start_date "" +} +if { ![info exists end_date] } { + set end_date "" +} + + +ns_db dml $db "begin transaction" + +ns_db dml $db "insert into ec_spam_log +(spam_id, spam_text, mailing_list_category_id, mailing_list_subcategory_id, mailing_list_subsubcategory_id, user_class_id, product_id, last_visit_start_date, last_visit_end_date) +values +($spam_id, '$QQmessage', '$mailing_list_category_id', '$mailing_list_subcategory_id', '$mailing_list_subsubcategory_id', '$user_class_id', '$product_id', to_date('$start_date','YYYY-MM-DD HH24:MI:SS'), to_date('$end_date','YYYY-MM-DD HH24:MI:SS')) +" + +set selection [ns_db select $db $users_query] + +ReturnHeaders +ns_write "[ad_admin_header "Spamming Users..."] +

    Spamming Users...

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] "Spamming Users..."] + +
    +
      +" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + # create a customer service issue/interaction/action + set user_identification_and_issue_id [ec_customer_service_simple_issue $db_sub "" "automatic" "email" "[DoubleApos "To: $email\nFrom: [ad_parameter CustomerServiceEmailAddress ecommerce]\nSubject: $subject"]" "" $issue_type_list $message $user_id "f"] + + set user_identification_id [lindex $user_identification_and_issue_id 0] + set issue_id [lindex $user_identification_and_issue_id 1] + + set email_from [ec_customer_service_email_address $user_identification_id $issue_id] + + ec_sendmail_from_service "$email" "$email_from" "$subject" "$message" + + if { ![empty_string_p $amount] && $amount > 0 } { + # put a record into ec_gift_certificates + # and add the amount to the user's gift certificate account + + ns_db dml $db_sub "insert into ec_gift_certificates + (gift_certificate_id, user_id, amount, expires, issue_date, issued_by, gift_certificate_state, last_modified, last_modifying_user, modified_ip_address) + values + (ec_gift_cert_id_sequence.nextval, $user_id, $amount, $expires_to_insert, sysdate(), $customer_service_rep, 'authorized', sysdate(), $customer_service_rep, '[DoubleApos [ns_conn peeraddr]]') + " + } + + ns_write "
    • Email has been sent to $email\n" +} + +ns_db dml $db "end transaction" + +ns_write "
    + +[ad_admin_footer]" + Index: web/openacs/www/admin/ecommerce/customer-service/spam-log.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/spam-log.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/spam-log.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,58 @@ +# spam-log.tcl,v 3.0 2000/02/06 03:18:23 ron Exp +set_form_variables 0 +# maybe the pieces of start_date and end_date + +proc spam_to_summary { db mailing_list_category_id mailing_list_subcategory_id mailing_list_subsubcategory_id user_class_id product_id full_last_visit_start_date full_last_visit_end_date } { + if { ![empty_string_p $mailing_list_category_id] } { + return "Members of the [ec_full_categorization_display $db $mailing_list_category_id $mailing_list_subcategory_id $mailing_list_subsubcategory_id] mailing list." + } + if { ![empty_string_p $user_class_id] } { + return "Members of the [database_to_tcl_string $db "select user_class_name from ec_user_classes where user_class_id=$user_class_id"] user class." + } + if { ![empty_string_p $product_id] } { + return "Customers who purchased [database_to_tcl_string $db "select product_name from ec_products where product_id=$product_id"] (product ID $product_id)." + } + if { ![empty_string_p $full_last_visit_start_date] } { + return "Users whose last visit to the site was between [ec_formatted_full_date $full_last_visit_start_date] and [ec_formatted_full_date $full_last_visit_end_date]." + } +} + +ReturnHeaders + +ns_write "[ad_admin_header "Spam Log"] +

    Spam Log

    +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] [list "spam.tcl" "Spam Users"] "Spam Log"] + +
    +" + +set db_pools [ns_db gethandle [philg_server_default_pool] 2] +set db [lindex $db_pools 0] +set db_sub [lindex $db_pools 1] + +ec_report_get_start_date_and_end_date + +set date_part_of_query "(spam_date >= to_date('$start_date 00:00:00','YYYY-MM-DD HH24:MI:SS') and spam_date <= to_date('$end_date 23:59:59','YYYY-MM-DD HH24:MI:SS'))" + +ns_write "
    +[ec_report_date_range_widget $start_date $end_date] + +
    + + + +" + +set selection [ns_db select $db "select spam_text, mailing_list_category_id, mailing_list_subcategory_id, mailing_list_subsubcategory_id, user_class_id, product_id, to_char(last_visit_start_date,'YYYY-MM-DD HH24:MI:SS') as full_last_visit_start_date, to_char(last_visit_end_date,'YYYY-MM-DD HH24:MI:SS') as full_last_visit_end_date, to_char(spam_date,'YYYY-MM-DD HH24:MI:SS') as full_spam_date from ec_spam_log where $date_part_of_query order by spam_date desc"] + +set rows_to_return "" +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append rows_to_return "" +} + +ns_write "$rows_to_return +
    DateToText
    [ec_formatted_full_date $full_spam_date][spam_to_summary $db_sub $mailing_list_category_id $mailing_list_subcategory_id $mailing_list_subsubcategory_id $user_class_id $product_id $full_last_visit_start_date $full_last_visit_end_date][ec_display_as_html $spam_text]
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/customer-service/spam.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/spam.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/spam.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,114 @@ +# spam.tcl,v 3.0 2000/02/06 03:18:24 ron Exp +set return_url "[ns_conn url]" + +set customer_service_rep [ad_get_user_id] + +if {$customer_service_rep == 0} { + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +ReturnHeaders + +ns_write "[ad_admin_header "Spam Users"] +

    Spam Users

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] "Spam Users"] + +
    +

    +View spam log +

    +" + +set db [ns_db gethandle] + +ns_write "
      + +
    1. Spam all users in a mailing list: + +
      +Mailing lists: [ec_mailing_list_widget $db]
      +Show me the users who will be spammed.
      +

      +

      + +
      +
      + +

      + +

    2. Spam all members of a user class: + +
      +User classes: [ec_user_class_widget $db]
      +Show me the users who will be spammed.
      +

      +

      + +
      +
      + +

      + +

    3. Spam all users who bought this product: + +
      +Product ID:
      +Show me the users who will be spammed.
      +

      +

      + +
      +
      + +

      + +

    4. Spam all users who viewed this product: + +
      +Product ID:
      +Show me the users who will be spammed.
      +

      +

      + +
      +
      + +

      + +

    5. Spam all users who viewed this category: + +
      +Category: [ec_only_category_widget $db]
      +Show me the users who will be spammed.
      +

      +

      + +
      +
      + +

      + +

    6. Spam all users whose last visit was: + +
      +" + +# this proc uses uplevel and assumes the existence of $db +# it sets the variables start_date and end_date +ec_report_get_start_date_and_end_date + +ns_write " +[ec_report_date_range_widget $start_date $end_date]
      +Show me the users who will be spammed.
      +

      +

      + +
      +
      + +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/customer-service/statistics.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/statistics.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/statistics.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,151 @@ +# statistics.tcl,v 3.0 2000/02/06 03:18:26 ron Exp +ReturnHeaders + +set page_title "Statistics and Reports" + +ns_write "[ad_admin_header $page_title] +

    $page_title

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] $page_title] + +
    + +

    Issues by Issue Type

    +
      +" + +set db [ns_db gethandle] + +set important_issue_type_list [database_to_tcl_list $db "select picklist_item from ec_picklist_items where picklist_name='issue_type' order by sort_key"] + +# for sorting +if { [llength $important_issue_type_list] > 0 } { + set issue_type_decode "order by case when issue_type is NULL then 0::integer " + set issue_type_counter 1 + foreach issue_type $important_issue_type_list { + append issue_type_decode "when issue_type='[DoubleApos $issue_type]' then ${issue_type_counter}::integer " + incr issue_type_counter + } + append issue_type_decode "else ${issue_type_counter}::integer end " +} else { + set issue_type_decode "" +} + +set selection [ns_db select $db " +select issue_type, count(*) as n_issues +from ec_customer_service_issues, ec_cs_issue_type_map +where ec_customer_service_issues.issue_id=ec_cs_issue_type_map.issue_id +group by issue_type +union +select ''::char as issue_type, count(*) as n_issues +from ec_customer_service_issues +where not exists (select issue_id from ec_cs_issue_type_map where issue_id=ec_customer_service_issues.issue_id) +group by issue_type +$issue_type_decode"] + +set other_issue_type_count 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { [lsearch $important_issue_type_list $issue_type] != -1 } { + ns_write "
    • $issue_type: $n_issues\n" + } elseif { ![empty_string_p $issue_type] } { + set other_issue_type_count [expr $other_issue_type_count + $n_issues] + } else { + if { $other_issue_type_count > 0 } { + ns_write "
    • all others: $other_issue_type_count\n" + } + if { $n_issues > 0 } { + ns_write "
    • none: $n_issues\n" + } + } +} + +ns_write "
    + +

    Interactions by Originator

    + +
      +" + +set selection [ns_db select $db "select interaction_originator, count(*) as n_interactions +from ec_customer_serv_interactions +group by interaction_originator +order by case when interaction_originator='customer' then 0 when interaction_originator='rep' then 1 when interaction_originator='automatic' then 2 end"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • $interaction_originator: $n_interactions\n" +} + +ns_write "
    + +

    Interactions by Customer Service Rep

    + +
      +" + +set selection [ns_db select $db "select customer_service_rep, first_names, last_name, count(*) as n_interactions +from ec_customer_serv_interactions, users +where ec_customer_serv_interactions.customer_service_rep=users.user_id +group by customer_service_rep, first_names, last_name +order by count(*) desc"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • $first_names $last_name: $n_interactions\n" +} + +ns_write "
    + +

    Actions by Info Used

    + +
      +" + +set important_info_used_list [database_to_tcl_list $db "select picklist_item from ec_picklist_items where picklist_name='info_used' order by sort_key"] + +# for sorting +if { [llength $important_info_used_list] > 0 } { + set info_used_decode "order by case " + set info_used_counter 0 + foreach info_used $important_info_used_list { + append info_used_decode "when info_used='[DoubleApos $info_used]' then ${info_used_counter}::integer " + incr info_used_counter + } + append info_used_decode "else ${info_used_counter}::integer end" +} else { + set info_used_decode "" +} + +set selection [ns_db select $db "select info_used, count(*) as n_actions +from ec_customer_service_actions, ec_cs_action_info_used_map +where ec_customer_service_actions.action_id=ec_cs_action_info_used_map.action_id +group by info_used +union +select ''::char as info_used, count(*) as n_actions +from ec_customer_service_actions +where not exists (select action_id from ec_cs_action_info_used_map where action_id= ec_customer_service_actions.action_id) +group by info_used +$info_used_decode"] + +set other_info_used_count 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { [lsearch $important_info_used_list $info_used] != -1 } { + ns_write "
    • $info_used: $n_issues\n" + } elseif { ![empty_string_p $info_used] } { + set other_info_used_count [expr $other_info_used_count + $n_actions] + } else { + if { $other_info_used_count > 0 } { + ns_write "
    • all others: $other_info_used_count\n" + } + if { $n_issues > 0 } { + ns_write "
    • none: $n_actions\n" + } + } +} + +ns_write "
    +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/customer-service/user-identification-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/user-identification-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/user-identification-edit.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,15 @@ +# user-identification-edit.tcl,v 3.0 2000/02/06 03:18:27 ron Exp +set_the_usual_form_variables +# user_identification_id, first_names, last_name, email, postal_code, other_id_info + +set db [ns_db gethandle] +ns_db dml $db "update ec_user_identification +set first_names='$QQfirst_names', +last_name='$QQlast_name', +email='$QQemail', +postal_code='$QQpostal_code', +other_id_info='$QQother_id_info' +where user_identification_id=$user_identification_id" + +ns_returnredirect "user-identification.tcl?[export_url_vars user_identification_id]" + Index: web/openacs/www/admin/ecommerce/customer-service/user-identification-match-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/user-identification-match-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/user-identification-match-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,8 @@ +# user-identification-match-2.tcl,v 3.0 2000/02/06 03:18:28 ron Exp +set_the_usual_form_variables +# user_identification_id, d_user_id + +set db [ns_db gethandle] +ns_db dml $db "update ec_user_identification set user_id=$d_user_id where user_identification_id=$user_identification_id" + +ns_returnredirect "/admin/users/one.tcl?user_id=$d_user_id" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/customer-service/user-identification-match.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/user-identification-match.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/user-identification-match.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,35 @@ +# user-identification-match.tcl,v 3.0 2000/02/06 03:18:30 ron Exp +set_the_usual_form_variables +# user_identification_id, d_user_id + +set exception_count 0 +set exception_text "" + +if { ![info exists d_user_id] || [empty_string_p $d_user_id] } { + incr exception_count + append exception_text "
  • You forgot to pick a registered user to match up this unregistered user with." +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +ReturnHeaders +set page_title "Confirm Match" +ns_write "[ad_admin_header $page_title] +

    $page_title

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] $page_title] + +
    + +Please confirm that you want to make this match. This cannot be undone. +
    +
    +[export_form_vars d_user_id user_identification_id] + +
    +
    +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/customer-service/user-identification-search.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/user-identification-search.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/user-identification-search.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,42 @@ +# user-identification-search.tcl,v 3.0 2000/02/06 03:18:31 ron Exp +set_the_usual_form_variables +# keyword + +set page_title "Unregistered User Search" +ReturnHeaders + +ns_write "[ad_admin_header $page_title] +

    $page_title

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] $page_title] + +
    +
      +" + +set db_pools [ns_db gethandle [philg_server_default_pool] 2] +set db [lindex $db_pools 0] +set db_sub [lindex $db_pools 1] + +# keyword can refer to email, first_names, last_name, postal_code, or other_id_info + +set selection [ns_db select $db "select user_identification_id from ec_user_identification +where (lower(email) like '%[string tolower $keyword]%' or lower(first_names || ' ' || last_name) like '%[string tolower $keyword]%' or lower(postal_code) like '%[string tolower $keyword]%' or lower(other_id_info) like '%[string tolower $keyword]%') +and user_id is null +" +] + +set user_counter 0 +while { [ns_db getrow $db $selection] } { + incr user_counter + set_variables_after_query + ns_write "
    • [ec_user_identification_summary $db_sub $user_identification_id]" +} + +if { $user_counter == 0 } { + ns_write "No users found." +} + +ns_write "
    +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/customer-service/user-identification.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/customer-service/user-identification.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/customer-service/user-identification.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,175 @@ +# user-identification.tcl,v 3.0 2000/02/06 03:18:32 ron Exp +set_the_usual_form_variables +# user_identification_id + +set db [ns_db gethandle] +set selection [ns_db 1row $db "select * from ec_user_identification where user_identification_id=$user_identification_id"] +set_variables_after_query + +if { ![empty_string_p $user_id] } { + ns_returnredirect "/admin/users/one.tcl?user_id=$user_id" + return +} + +ReturnHeaders + +set page_title "Unregistered User" +ns_write "[ad_admin_header $page_title] +

    $page_title

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Customer Service Administration"] $page_title] + +
    + +

    What we know about this user

    + + + + + + + + + + + + + + + + + + + + + + + + + + +
    First Name$first_names
    Last Name$last_name
    Email$email
    Zip Code$postal_code +" + +set location [ec_location_based_on_zip_code $db $postal_code] +if { ![empty_string_p $location] } { + ns_write " ($location)" +} + +ns_write "
    Other Identifying Info$other_id_info
    Record Created[util_AnsiDatetoPrettyDate $date_added]
    + +

    Customer Service Issues

    + +[ec_all_cs_issues_by_one_user $db "" $user_identification_id] + +

    Edit User Info

    + +
    +[export_form_vars user_identification_id] + + + + + + + + + + + + + + + + + +
    First Name: Last Name:
    Email Address:
    Zip Code:
    Other Identifying Info:
    + +
    + +
    +
    + +

    Try to match this user up with a registered user

    +
      +
      +[export_form_vars user_identification_id] +" + +set positively_identified_p 0 + + +# if their email address was filled in, see if they're a registered user +if { ![empty_string_p $email] } { + set selection [ns_db 0or1row $db "select first_names as d_first_names, last_name as d_last_name, user_id as d_user_id from users where upper(email) = '[string toupper $email]'"] + + if { ![empty_string_p $selection] } { + set_variables_after_query + } + + if { [info exists d_user_id] } { + ns_write "
    • This is a registered user of the system: $d_first_names $d_last_name. + [export_form_vars d_user_id]" + set positively_identified_p 1 + } + +} + +if { !$positively_identified_p } { + # then keep trying to identify them + + if { ![empty_string_p $first_names] || ![empty_string_p $last_name] } { + if { ![empty_string_p $first_names] && ![empty_string_p $last_name] } { + set selection [ns_db select $db "select user_id as d_user_id from users where upper(first_names)='[DoubleApos [string toupper $first_names]]' and upper(last_name)='[DoubleApos [string toupper $last_name]]'"] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • This may be the registered user $first_names $last_name (check here if this is correct).\n" + } + } elseif { ![empty_string_p $first_names] } { + set selection [ns_db select $db "select user_id as d_user_id, last_name as d_last_name from users where upper(first_names)='[DoubleApos [string toupper $first_names]]'"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • This may be the registered user $first_names $d_last_name (check here if this is correct).\n" + } + + } elseif { ![empty_string_p $last_name] } { + set selection [ns_db select $db "select user_id as d_user_id, first_names as d_first_names from users where upper(last_name)='[DoubleApos [string toupper $last_name]]'"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • This may be the registered user $d_first_names $last_name (check here if this is correct).\n" + } + + } + } + # see if they have a gift certificate that a registered user has claimed. + # email_template_id 5 is the automatic email sent to gift certificate recipients. + # it's kind of convoluted, but so is this whole user_identification thing + set selection [ns_db select $db "select g.user_id as d_user_id, u.first_names as d_first_names, u.last_name as d_last_name + from ec_automatic_email_log l, ec_gift_certificates g, users u + where g.user_id=u.user_id + and l.gift_certificate_id=g.gift_certificate_id + and l.user_identification_id=$user_identification_id + and l.email_template_id=5 + group by g.user_id, u.first_names, u.last_name"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • This may be the registered user $d_first_names $d_last_name who claimed a gift certificate sent to $email (check here if this is correct).\n" + } +} + +if { [info exists d_user_id] } { + ns_write "

      +

      + +
      " +} else { + ns_write "No matches found." +} + +ns_write "
      • +
    +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/email-templates/add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/email-templates/add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/email-templates/add-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,40 @@ +# add-2.tcl,v 3.0 2000/02/06 03:18:34 ron Exp +set_the_usual_form_variables +# variables, title, subject, message, when_sent, issue_type (select multiple) + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set form [ns_getform] +set form_size [ns_set size $form] +set form_counter 0 +set issue_type_list [list] +while { $form_counter < $form_size} { + set form_key [ns_set key $form $form_counter] + if { $form_key == "issue_type" } { + set form_value [ns_set value $form $form_counter] + if { ![empty_string_p $form_value] } { + lappend ${form_key}_list $form_value + } + } + incr form_counter +} + +set db [ns_db gethandle] + +regsub -all "\r" $QQmessage "" newQQmessage + +ns_db dml $db "insert into ec_email_templates +(email_template_id, title, subject, message, variables, when_sent, issue_type_list, last_modified, last_modifying_user, modified_ip_address) +values +(ec_email_template_id_sequence.nextval, '$QQtitle', '$QQsubject', '$QQmessage', '$QQvariables', '$QQwhen_sent', '[DoubleApos $issue_type_list]', sysdate, '$user_id', '[DoubleApos [ns_conn peeraddr]]')" + +ns_returnredirect "index.tcl" Index: web/openacs/www/admin/ecommerce/email-templates/add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/email-templates/add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/email-templates/add.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,46 @@ +# add.tcl,v 3.0 2000/02/06 03:18:35 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Add Email Template"] +

    Add Email Template

    +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Email Templates"] "New Template"] +
    +

    +Please note: Email templates are designed be edited by a content writer (e.g. a customer service rep), but a programmer will have to schedule the sending of this email and program in the variable substitution. + +

    + +

    For informational purposes

    + +
    + + + + +
    Title
    Variables Note on variables
    When Sent
    +
    + +

    Actually used when sending email

    + +
    + + + +" + +set db [ns_db gethandle] + +ns_write " +
    Subject Line
    Message
    Issue Type*[ec_issue_type_widget $db]
    +
    + +

    +

    + +
    +
    + +* Note: A customer service issue is created whenever an email is sent. The issue is automatically closed unless the customer replies to the issue, in which case it is reopened. + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/email-templates/edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/email-templates/edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/email-templates/edit-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,38 @@ +# edit-2.tcl,v 3.0 2000/02/06 03:18:36 ron Exp +set_the_usual_form_variables +# email_template_id, variables, title, subject, message, when_sent, issue_type (select multiple) + +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set form [ns_getform] +set form_size [ns_set size $form] +set form_counter 0 +set issue_type_list [list] +while { $form_counter < $form_size} { + set form_key [ns_set key $form $form_counter] + if { $form_key == "issue_type" } { + set form_value [ns_set value $form $form_counter] + if { ![empty_string_p $form_value] } { + lappend ${form_key}_list $form_value + } + } + incr form_counter +} + +set db [ns_db gethandle] + +regsub -all "\r" $QQmessage "" newQQmessage + +ns_db dml $db "update ec_email_templates +set title='$QQtitle', subject='$QQsubject', message='$QQmessage', variables='$QQvariables', when_sent='$QQwhen_sent', issue_type_list='[DoubleApos $issue_type_list]', last_modified=sysdate, last_modifying_user='$user_id', modified_ip_address='[DoubleApos [ns_conn peeraddr]]' +where email_template_id=$email_template_id" + +ns_returnredirect "index.tcl" Index: web/openacs/www/admin/ecommerce/email-templates/edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/email-templates/edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/email-templates/edit.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,63 @@ +# edit.tcl,v 3.0 2000/02/06 03:18:38 ron Exp +set_the_usual_form_variables +# email_template_id + + +ReturnHeaders + +ns_write "[ad_admin_header "Edit Email Template"] +

    Edit Email Template

    +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Email Templates"] "Edit Template"] +
    +
    +[export_form_vars email_template_id] +" + +set db [ns_db gethandle] +set selection [ns_db 1row $db "select * from ec_email_templates where email_template_id=$email_template_id"] +set_variables_after_query + +ns_write "

    For informational purposes

    +
    + + + + +
    Title
    Variables Note on variables
    When Sent
    +
    + +

    Actually used when sending email

    + +
    + + + + + +
    Template ID$email_template_id
    Subject Line
    Message
    Issue Type*[ec_issue_type_widget $db $issue_type_list]
    +
    +

    +

    + +
    +
    + +* Note: A customer service issue is created whenever an email is sent. The issue is automatically closed unless the customer replies to the issue, in which case it is reopened. +" + +set table_names_and_id_column [list ec_email_templates ec_email_templates_audit email_template_id] + +# Set audit variables +# audit_id_column, return_url, audit_tables, main_tables +set audit_id_column "email_template_id" +set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" +set audit_tables [list ec_email_templates_audit] +set main_tables [list ec_email_templates] +set audit_name "Email Template: $title" +set audit_id $email_template_id + +ns_write "

    +\[Audit Trail\] + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/email-templates/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/email-templates/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/email-templates/index.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,30 @@ +# index.tcl,v 3.0 2000/02/06 03:18:39 ron Exp +ReturnHeaders + +set table_names_and_id_column [list ec_email_templates ec_email_templates_audit email_template_id] + +ns_write "[ad_admin_header "Email Templates"] +

    Email Templates

    +[ad_admin_context_bar [list "../" "Ecommerce"] "Email Templates"] +

    +

    +

    +Current Email Templates: +

      +" + +set db [ns_db gethandle] +set selection [ns_db select $db "select title, email_template_id from ec_email_templates order by title"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + + ns_write "
    • $title \n" +} + +ns_write "
    +[ad_admin_footer]" Index: web/openacs/www/admin/ecommerce/email-templates/variables.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/email-templates/variables.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/email-templates/variables.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,74 @@ +# variables.tcl,v 3.0 2000/02/06 03:18:40 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Note on Variables"] + +

    Note on Variables

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Email Templates"] "Note on Variables"] + +
    + +We ask you to list the variables you're using so that programmers will know what things they should substitute for in the body of the email. Variable names should be descriptive so that it's obvious to the programmers what each one means. + +

    + +An example: + +

    + + + + + + + + + + + + + + + + + + + + + + + + + + +
    TitleNew Order
    Variablesconfirmed_date_here, address_here, order_summary_here, price_here, shipping_here, tax_here, total_here
    When SentThis email will automatically be sent out after an order has been authorized
    Subject LineYour Order
    Message[ec_display_as_html "Thank you for your order. We received your order on +confirmed_date_here. + +To view the status of your order at any time, please log in to +www.whatever.com and view \"Your Account\". + +The following is your order information. If you need to contact us +regarding this information, please contact info@whatever.com. + +order_summary_here + +Shipping Address: +address_here + +Price: price_here +S&H: shipping_here +Tax: tax_here +----------------- +Total: total_here + + +Thank you. + +Sincerely, +Customer Service +info@whatever.com +http://www.whatever.com"]
    Issue Typenew order
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/mailing-lists/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/mailing-lists/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/mailing-lists/index.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,31 @@ +# index.tcl,v 3.0 2000/02/06 03:18:42 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Mailing Lists"] + +

    Mailing Lists

    + +[ad_admin_context_bar [list "../" "Ecommerce"] "Mailing Lists"] + +
    + +

    Mailing Lists with Users

    +" + +set db [ns_db gethandle] + +ns_write "[ec_mailing_list_widget $db "f"] + +

    All Mailing Lists

    + +
    +
    + +[ec_category_widget $db] + +
    + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/mailing-lists/member-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/mailing-lists/member-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/mailing-lists/member-add-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,36 @@ +# member-add-2.tcl,v 3.0 2000/02/06 03:18:43 ron Exp +set_the_usual_form_variables +# user_id, category_id, subcategory_id, subsubcategory_id + +# we need them to be logged in +set admin_user_id [ad_verify_and_get_user_id] + +if {$admin_user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +if { ![info exists subcategory_id] || [empty_string_p $subcategory_id] } { + set check_string "select count(*) from ec_cat_mailing_lists where user_id=$user_id and category_id=$category_id and subcategory_id is null" + set insert_string "insert into ec_cat_mailing_lists (user_id, category_id) values ($user_id, $category_id)" +} elseif { ![info exists subsubcategory_id] || [empty_string_p $subsubcategory_id] } { + set check_string "select count(*) from ec_cat_mailing_lists where user_id=$user_id and subcategory_id=$subcategory_id and subsubcategory_id is null" + set insert_string "insert into ec_cat_mailing_lists (user_id, category_id, subcategory_id) values ($user_id, $category_id, $subcategory_id)" +} elseif { [info exists subsubcategory_id] && ![empty_string_p $subsubcategory_id] } { + set check_string "select count(*) from ec_cat_mailing_lists where user_id=$user_id and subsubcategory_id=$subsubcategory_id" + set insert_string "insert into ec_cat_mailing_lists (user_id, category_id, subcategory_id, subsubcategory_id) values ($user_id, $category_id, $subcategory_id, $subsubcategory_id)" +} else { + set check_string "select count(*) from ec_cat_mailing_lists where user_id=$user_id and category_id is null" + set insert_string "insert into ec_cat_mailing_lists (user_id) values ($user_id)" +} + +if { [database_to_tcl_string $db $check_string] == 0 } { + ns_db dml $db $insert_string +} + +ns_returnredirect "one.tcl?[export_url_vars category_id subcategory_id subsubcategory_id]" Index: web/openacs/www/admin/ecommerce/mailing-lists/member-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/mailing-lists/member-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/mailing-lists/member-add.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,47 @@ +# member-add.tcl,v 3.0 2000/02/06 03:18:44 ron Exp +set_the_usual_form_variables +# category_id, subcategory_id, subsubcategory_id +# and either last_name or email + +ReturnHeaders + +ns_write "[ad_admin_header "Add Member to this Mailing List"] + +

    Add Member to this Mailing List

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Mailing Lists"] "Add Member" ] + +
    +" + +if { [info exists last_name] } { + ns_write "

    Users whose last name contains '$last_name':

    \n" + set last_bit_of_query "upper(last_name) like '%[string toupper $QQlast_name]%'" +} else { + ns_write "

    Users whose email contains '$email':

    \n" + set last_bit_of_query "upper(email) like '%[string toupper $QQemail]%'" +} + +ns_write "
      +" + +set db [ns_db gethandle] +set selection [ns_db select $db "select user_id, first_names, last_name, email +from users +where $last_bit_of_query"] + +set user_counter 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • $first_names $last_name ($email)\n" + incr user_counter +} + +if { $user_counter == 0 } { + ns_write "No such users were found.\n
    \n" +} else { + ns_write "\n

    Click on a name to add them to the mailing list.\n" +} + +ns_write "[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/mailing-lists/member-remove-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/mailing-lists/member-remove-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/mailing-lists/member-remove-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,17 @@ +# member-remove-2.tcl,v 3.0 2000/02/06 03:18:45 ron Exp +set_the_usual_form_variables +# category_id, subcategory_id, subsubcategory_id, user_id + +set db [ns_db gethandle] + +if { ![empty_string_p $subsubcategory_id] } { + ns_db dml $db "delete from ec_cat_mailing_lists where user_id=$user_id and subsubcategory_id=$subsubcategory_id" +} elseif { ![empty_string_p $subcategory_id] } { + ns_db dml $db "delete from ec_cat_mailing_lists where user_id=$user_id and subcategory_id=$subcategory_id and subsubcategory_id is null" +} elseif { ![empty_string_p $category_id] } { + ns_db dml $db "delete from ec_cat_mailing_lists where user_id=$user_id and category_id=$category_id and subcategory_id is null" +} else { + ns_db dml $db "delete from ec_cat_mailing_lists where user_id=$user_id and category_id is null" +} + +ns_returnredirect "one.tcl?[export_url_vars category_id subcategory_id subsubcategory_id]" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/mailing-lists/member-remove.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/mailing-lists/member-remove.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/mailing-lists/member-remove.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,25 @@ +# member-remove.tcl,v 3.0 2000/02/06 03:18:46 ron Exp +set_the_usual_form_variables +# category_id, subcategory_id, subsubcategory_id, user_id + +ReturnHeaders + +ns_write "[ad_admin_header "Confirm Removal"] + +

    Confirm Removal

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Mailing Lists"] "Confirm Removal"] + +
    + +Please confirm that you wish to remove this user from this mailing list. + +
    +[export_form_vars category_id subcategory_id subsubcategory_id user_id] +
    + +
    +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/mailing-lists/one.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/mailing-lists/one.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/mailing-lists/one.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,87 @@ +# one.tcl,v 3.0 2000/02/06 03:18:47 ron Exp +set_the_usual_form_variables +# either category_id, subcategory_id, and/or subsubcategory_id +# OR categorization (list which contains category_id, subcategory_id, and/or subsubcategory_id) +# depending on how they got here + +if { [info exists categorization] } { + catch { set category_id [lindex $categorization 0] } + catch { set subcategory_id [lindex $categorization 1] } + catch { set subsubcategory_id [lindex $categorization 2] } +} + +# now we're left with category_id, subcategory_id, and/or subsubcategory_id +# regardless of how we got here +if { ![info exists category_id] } { + set category_id "" +} +if { ![info exists subcategory_id] } { + set subcategory_id "" +} +if { ![info exists subsubcategory_id] } { + set subsubcategory_id "" +} + +set db [ns_db gethandle] +set mailing_list_name [ec_full_categorization_display $db $category_id $subcategory_id $subsubcategory_id] + +ReturnHeaders +ns_write "[ad_admin_header "$mailing_list_name"] + +

    $mailing_list_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Mailing Lists"] "One Mailing List"] + +
    +

    Members

    +
      +" + +set user_query "select u.user_id, first_names, last_name + from users u, ec_cat_mailing_lists m + where u.user_id=m.user_id + " + +if { ![empty_string_p $subsubcategory_id] } { + append user_query "and m.subsubcategory_id=$subsubcategory_id" +} elseif { ![empty_string_p $subcategory_id] } { + append user_query "and m.subcategory_id=$subcategory_id + and m.subsubcategory_id is null" +} elseif { ![empty_string_p $category_id] } { + append user_query "and m.category_id=$category_id + and m.subcategory_id is null" +} else { + append user_query "and m.category_id is null" +} + +set selection [ns_db select $db $user_query] + +set n_users 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + incr n_users + ns_write "
    • $first_names $last_name \[remove\]" +} + +if { $n_users == 0 } { + ns_write "None" +} + +ns_write "
    + +

    Add a Member

    + +
    +[export_form_vars category_id subcategory_id subsubcategory_id] +By last name: + +
    + +
    +[export_form_vars category_id subcategory_id subsubcategory_id] +By email address: + +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/orders/address-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/address-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/address-add-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,41 @@ +# address-add-2.tcl,v 1.2.4.1 2000/02/03 09:24:39 ron Exp +set_the_usual_form_variables +# order_id, and either: +# attn, line1, line2, city, usps_abbrev, zip_code, phone, phone_time OR +# attn, line1, line2, city, full_state_name, zip_code, country_code, phone, phone_time + +if { ![info exists usps_abbrev] } { + set usps_abbrev "" +} +if { ![info exists full_state_name] } { + set full_state_name "" +} +if { ![info exists country_code] } { + set country_code "us" +} + +ReturnHeaders +ns_write "[ad_admin_header "Confirm Shipping Address"] + +

    Confirm Shipping Address

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] [list "one.tcl?[export_url_vars order_id]" "One Order"] "Confirm Shipping Address"] + +
    +Please confirm new address: +
    +" +set db [ns_db gethandle] + +ns_write " + +[ec_display_as_html [ec_pretty_mailing_address_from_args $db $line1 $line2 $city $usps_abbrev $zip_code $country_code $full_state_name $attn $phone $phone_time]] + +
    +
    +[export_entire_form] +
    + +
    +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/orders/address-add-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/address-add-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/address-add-3.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,35 @@ +# address-add-3.tcl,v 1.1.4.1 2000/02/03 09:24:41 ron Exp +set_the_usual_form_variables +# order_id, and either: +# attn, line1, line2, city, usps_abbrev, zip_code, phone, phone_time OR +# attn, line1, line2, city, full_state_name, zip_code, country_code, phone, phone_time + +if { ![info exists QQusps_abbrev] } { + set QQusps_abbrev "" +} +if { ![info exists QQfull_state_name] } { + set QQfull_state_name "" +} +if { ![info exists QQcountry_code] } { + set QQcountry_code "us" +} + + +# insert the address into ec_addresses, update the address in ec_orders + +set db [ns_db gethandle] + +ns_db dml $db "begin transaction" +set address_id [database_to_tcl_string $db "select ec_address_id_sequence.nextval from dual"] +set user_id [database_to_tcl_string $db "select user_id from ec_orders where order_id=$order_id"] + +ns_db dml $db "insert into ec_addresses +(address_id, user_id, address_type, attn, line1, line2, city, usps_abbrev, full_state_name, zip_code, country_code, phone, phone_time) +values +($address_id, $user_id, 'shipping', '$QQattn', '$QQline1','$QQline2','$QQcity','$QQusps_abbrev','$QQfull_state_name','$QQzip_code','$QQcountry_code','$QQphone','$QQphone_time') +" +ns_db dml $db "update ec_orders set shipping_address=$address_id where order_id=$order_id" + +ns_db dml $db "end transaction" + +ns_returnredirect "one.tcl?[export_url_vars order_id]" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/orders/address-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/address-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/address-add.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,107 @@ +# address-add.tcl,v 1.2.4.1 2000/02/03 09:24:42 ron Exp +set_the_usual_form_variables +# order_id + +ReturnHeaders +ns_write "[ad_admin_header "New Shipping Address"] + +

    New Shipping Address

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] [list "one.tcl?[export_url_vars order_id]" "One Order"] "New Shipping Address"] + +
    +Please enter a new domestic address or a new international address. All future shipments for this order will go to this address. + +

    +New domestic address: +" + +set db [ns_db gethandle] +set user_name [database_to_tcl_string $db "select first_names || ' ' || last_name from users, ec_orders where ec_orders.user_id=users.user_id and order_id=$order_id"] + +ns_write " +

    + +[export_form_vars order_id] + + + + + + + + + + + + + + + + + + + + + + + + + +
    Name
    Address
    2nd line (optional)
    City  State [state_widget $db]
    Zip
    Phone day     evening
    +

    +

    + +
    + +
    + +

    +New international address: +

    +

    +[export_form_vars order_id] +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    Name
    Address
    2nd line (optional)
    City
    Province or Region
    Postal Code
    Country[ec_country_widget $db ""]
    Phone day     evening
    +
    +

    +

    + +
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/orders/by-order-state-and-time.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/by-order-state-and-time.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/by-order-state-and-time.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,166 @@ +# by-order-state-and-time.tcl,v 1.2.4.1 2000/02/03 09:24:43 ron Exp +set_form_variables 0 +# possibly view_order_state and/or view_confirmed and/or order_by + +if { ![info exists view_order_state] } { + set view_order_state "reportable" +} +if { ![info exists view_confirmed] } { + set view_confirmed "all" +} +if { ![info exists order_by] } { + set order_by "o.order_id" +} + +ReturnHeaders + +ns_write "[ad_admin_header "Order History"] + +

    Order History

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] "History"] + +
    + +
    +[export_form_vars view_confirmed order_by] + + + + + + + + +
    Order StateConfirmed Date
    + + +" + +set confirmed_list [list [list last_24 "last 24 hrs"] [list last_week "last week"] [list last_month "last month"] [list all all]] + +set linked_confirmed_list [list] + +foreach confirmed $confirmed_list { + if {$view_confirmed == [lindex $confirmed 0]} { + lappend linked_confirmed_list "[lindex $confirmed 1]" + } else { + lappend linked_confirmed_list "[lindex $confirmed 1]" + } +} + +ns_write "\[ [join $linked_confirmed_list " | "] \] + +
    + +
    +
    +" + +if { $view_order_state == "reportable" } { + set order_state_query_bit "and o.order_state in ('authorized_plus_avs','authorized_minus_avs','partially_fulfilled','fulfilled')" +} else { + set order_state_query_bit "and o.order_state='$view_order_state'" +} + +if { $view_confirmed == "last_24" } { + set confirmed_query_bit "and sysdate()-o.confirmed_date <= 1" +} elseif { $view_confirmed == "last_week" } { + set confirmed_query_bit "and sysdate()-o.confirmed_date <= 7" +} elseif { $view_confirmed == "last_month" } { + set confirmed_query_bit "and months_between(sysdate(),o.confirmed_date) <= 1" +} else { + set confirmed_query_bit "" +} + +set link_beginning "by-order-state-and-time.tcl?[export_url_vars view_order_state view_confirmed]" + +set table_header " + + + + + + + +" + + +set db [ns_db gethandle] + +set selection [ns_db select $db " +(select o.order_id, o.confirmed_date, o.order_state, ec_total_price(o.order_id) as price_to_display, o.user_id, u.first_names, u.last_name, count(*) as n_items +from ec_orders o, users u, ec_items i +where o.user_id=u.user_id +and o.order_id=i.order_id +$confirmed_query_bit $order_state_query_bit +group by o.order_id, o.confirmed_date, o.order_state, ec_total_price(o.order_id), o.user_id, u.first_names, u.last_name) +union +(select o.order_id, o.confirmed_date, o.order_state, ec_total_price(o.order_id) as price_to_display, o.user_id, ''::char as first_names, ''::char as last_name, count(*) as n_items +from ec_orders o, ec_items i +where 0=(select count(*) from users where user_id= o.user_id) +and o.order_id=i.order_id +$confirmed_query_bit $order_state_query_bit +group by o.order_id, o.confirmed_date, o.order_state, ec_total_price(o.order_id), o.user_id, first_names, last_name) +order by $order_by +"] + +set row_counter 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + # Pgsql 6.x hack for group by (BMA) + if {$order_id == ""} { + continue + } + + if { $row_counter == 0 } { + ns_write $table_header + } elseif { $row_counter == 20 } { + ns_write "
    Order IDDate ConfirmedOrder StateCustomerAmount# of Items
    +

    + $table_header + " + set row_counter 1 + } + # even rows are white, odd are grey + if { [expr floor($row_counter/2.)] == [expr $row_counter/2.] } { + set bgcolor "white" + } else { + set bgcolor "ececec" + } + ns_write " +$order_id +[ec_nbsp_if_null [util_AnsiDatetoPrettyDate $confirmed_date]] +$order_state +[ec_decode $last_name "" " " "$last_name, $first_names"] +[ec_nbsp_if_null [ec_pretty_price $price_to_display]] +$n_items + " + incr row_counter +} + + +if { $row_counter != 0 } { + ns_write "" +} else { + ns_write "

    None Found
    " +} + +ns_write "
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/orders/comments-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/comments-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/comments-edit.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,9 @@ +# comments-edit.tcl,v 1.1.4.1 2000/02/03 09:24:45 ron Exp +set_the_usual_form_variables +# order_id, cs_comments + +set db [ns_db gethandle] + +ns_db dml $db "update ec_orders set cs_comments='$QQcs_comments' where order_id=$order_id" + +ns_returnredirect "one.tcl?[export_url_vars order_id]" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/orders/comments.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/comments.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/comments.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,35 @@ +# comments.tcl,v 1.2.4.1 2000/02/03 09:24:46 ron Exp +set_the_usual_form_variables +# order_id + +set db [ns_db gethandle] + +ReturnHeaders +ns_write "[ad_admin_header "Comments"] + +

    Comments

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] [list "one.tcl?order_id=$order_id" "One Order"] "Comments"] + +
    + +
    +[export_form_vars order_id] + +Please add or edit comments below: + +
    + +
    + +
    + +

    +

    + +
    + +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/orders/creditcard-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/creditcard-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/creditcard-add-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,70 @@ +# creditcard-add-2.tcl,v 1.2.4.1 2000/02/03 09:24:48 ron Exp +set_the_usual_form_variables +# order_id, +# creditcard_number, creditcard_type, creditcard_expire_1, +# creditcard_expire_2, billing_zip_code + +# get rid of spaces and dashes +regsub -all -- "-" $creditcard_number "" creditcard_number +regsub -all " " $creditcard_number "" creditcard_number + +# error checking +set exception_count 0 +set exception_text "" + +if { [regexp {[^0-9]} $creditcard_number] } { + # I've already removed spaces and dashes, so only numbers should remain + incr exception_count + append exception_text "
  • Your credit card number contains invalid characters." +} + +if { ![info exists creditcard_type] || [empty_string_p $creditcard_type] } { + incr exception_count + append exception_text "
  • You forgot to enter your credit card type." +} + +# make sure the credit card type is right & that it has the right number +# of digits +set additional_count_and_text [ec_creditcard_precheck $creditcard_number $creditcard_type] + +set exception_count [expr $exception_count + [lindex $additional_count_and_text 0]] +append exception_text [lindex $additional_count_and_text 1] + +if { ![info exists creditcard_expire_1] || [empty_string_p $creditcard_expire_1] || ![info exists creditcard_expire_2] || [empty_string_p $creditcard_expire_2] } { + incr exception_count + append exception_text "
  • Please enter your full credit card expiration date (month and year)" +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +ReturnHeaders +ns_write "[ad_admin_header "Confirm Credit Card"] + +

    Confirm Credit Card

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] [list "one.tcl?[export_url_vars order_id]" "One Order"] "Confirm Credit Card"] + +
    +Please confirm that this is correct: + +
    +
    +[ec_pretty_creditcard_type $creditcard_type]
+$creditcard_number
+exp: $creditcard_expire_1/$creditcard_expire_2
+zip: $billing_zip_code
+
    +
    + +
    +[export_entire_form] + +
    + +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/orders/creditcard-add-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/creditcard-add-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/creditcard-add-3.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,24 @@ +# creditcard-add-3.tcl,v 1.1.4.1 2000/02/03 09:24:49 ron Exp +set_the_usual_form_variables +# order_id, +# creditcard_number, creditcard_type, creditcard_expire_1, +# creditcard_expire_2, billing_zip_code + +set db [ns_db gethandle] +ns_db dml $db "begin transaction" + +set user_id [database_to_tcl_string $db "select user_id from ec_orders where order_id=$order_id"] + +set creditcard_id [database_to_tcl_string $db "select ec_creditcard_id_sequence.nextval from dual"] + +ns_db dml $db "insert into ec_creditcards +(creditcard_id, user_id, creditcard_number, creditcard_last_four, creditcard_type, creditcard_expire, billing_zip_code) +values +($creditcard_id, $user_id, '$creditcard_number', '[string range $creditcard_number [expr [string length $creditcard_number] -4] [expr [string length $creditcard_number] -1]]', '[DoubleApos $creditcard_type]','$creditcard_expire_1/$creditcard_expire_2','[DoubleApos $billing_zip_code]') +" + +ns_db dml $db "update ec_orders set creditcard_id=$creditcard_id where order_id=$order_id" + +ns_db dml $db "end transaction" + +ns_returnredirect "one.tcl?[export_url_vars order_id]" Index: web/openacs/www/admin/ecommerce/orders/creditcard-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/creditcard-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/creditcard-add.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,51 @@ +# creditcard-add.tcl,v 1.2.4.1 2000/02/03 09:24:50 ron Exp +set_the_usual_form_variables +# order_id + +ReturnHeaders +ns_write "[ad_admin_header "New Credit Card"] + +

    New Credit Card

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] [list "one.tcl?[export_url_vars order_id]" "One Order"] "New Credit Card"] + +
    +Entering a new credit card will cause all future transactions involving this order +to use this credit card. However, it will not have any effect on transactions that +are currently underway (e.g., if a transaction has already been authorized with a +different credit card, that credit card will be used to complete the transaction). +" + +set db [ns_db gethandle] +set zip_code [database_to_tcl_string $db "select zip_code from ec_addresses a, ec_orders o where a.address_id=o.shipping_address and order_id=$order_id"] + +ns_write " +[export_form_vars order_id] +
    + + + + + + + + + + + + + + + + +
    Credit card number:
    Type:[ec_creditcard_widget]
    Expires:[ec_creditcard_expire_1_widget] [ec_creditcard_expire_2_widget]
    Billing zip code:
    +
    + +
    + +
    + +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/orders/fulfill-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/fulfill-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/fulfill-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,184 @@ +# fulfill-2.tcl,v 1.2.4.1 2000/02/03 09:24:52 ron Exp +set_the_usual_form_variables +# order_id, shipment_date (in pieces), expected_arrival_date (in pieces), +# carrier, carrier_other, tracking_number, +# either all_items_p or a series of item_ids + +# This script shows confirmation page & shipping address + +# the customer service rep must be logged on +set customer_service_rep [ad_get_user_id] + +if {$customer_service_rep == 0} { + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +if { ![empty_string_p $carrier_other] } { + set carrier $carrier_other +} + +set exception_count 0 +set exception_text "" + +# they must have either checked "All items" and none of the rest, or +# at least one of the rest and not "All items" +# they also need to have shipment_date filled in + +if { [info exists all_items_p] && [info exists item_id] } { + incr exception_count + append exception_text "
  • Please either check off \"All items\" or check off some of the items, but not both." +} +if { ![info exists all_items_p] && ![info exists item_id] } { + incr exception_count + append exception_text "
  • Please either check off \"All items\" or check off some of the items." +} + +# the annoying date stuff +set form [ns_getform] + +# ns_dbformvalue $form shipment_date date shipment_date will give an error +# message if the day of the month is 08 or 09 (this octal number problem +# we've had in other places). So I'll have to trim the leading zeros +# from ColValue.shipment%5fdate.day and ColValue.expected%5farrival%5fdate.day +# and stick the new value into the $form ns_set. + +set "ColValue.shipment%5fdate.day" [string trimleft [set ColValue.shipment%5fdate.day] "0"] +ns_set update $form "ColValue.shipment%5fdate.day" [set ColValue.shipment%5fdate.day] + +set "ColValue.expected%5farrival%5fdate.day" [string trimleft [set ColValue.shipment%5fdate.day] "0"] +ns_set update $form "ColValue.expected%5farrival%5fdate.day" [set ColValue.expected%5farrival%5fdate.day] + +if [catch { ns_dbformvalue $form shipment_date datetime shipment_date} errmsg ] { + # maybe they left off time, which is ok; we'll just try to set the date & not the time + if [catch { ns_dbformvalue $form shipment_date date shipment_date} errmsg] { + incr exception_count + append exception_text "
  • The shipment date was specified in the wrong format. The date should be in the format Month DD YYYY. The time should be in the format HH:MI:SS (seconds are optional), where HH is 01-12, MI is 00-59 and SS is 00-59.\n" + } else { + set shipment_date "$shipment_date 00:00:00" + } +} elseif { [empty_string_p $shipment_date] } { + incr exception_count + append exception_text "
  • Please enter a shipment date.\n" +} elseif { [string length [set ColValue.shipment%5fdate.year]] != 4 } { + incr exception_count + append exception_text "
  • The shipment year needs to contain 4 digits.\n" +} + +if [catch { ns_dbformvalue $form expected_arrival_date datetime expected_arrival_date} errmsg ] { + # maybe they left off time, which is ok; we'll just try to set the date & not the time + if [catch { ns_dbformvalue $form expected_arrival_date date expected_arrival_date} errmsg] { + set expected_arrival_date "" + } else { + set expected_arrival_date "$expected_arrival_date 00:00:00" + } +} elseif { [string length [set ColValue.expected%5farrival%5fdate.year]] != 4 && [string length [set ColValue.expected%5farrival%5fdate.year]] != 0 } { + # if the expected arrival year is non-null, then it needs to contain 4 digits + incr exception_count + append exception_text "
  • The expected arrival year needs to contain 4 digits.\n" +} + +if { $exception_count > 0 } { + ad_return_complaint 1 $exception_text + return +} + +ReturnHeaders +ns_write "[ad_admin_header "Confirm that these item(s) have been shipped"] + +

    Confirm that these item(s) have been shipped

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] [list "fulfillment.tcl" "Fulfillment"] "One Order"] + +
    +" + +set db [ns_db gethandle] +set shipment_id [database_to_tcl_string $db "select ec_shipment_id_sequence.nextval from dual"] + +if { ![info exists all_items_p] } { + set form [ns_getform] + set form_size [ns_set size $form] + set form_counter 0 + + set item_id_list [list] + while { $form_counter < $form_size} { + if { [ns_set key $form $form_counter] == "item_id" } { + lappend item_id_list [ns_set value $form $form_counter] + } + incr form_counter + } + + set selection [ns_db select $db "select i.item_id, p.product_name, p.one_line_description, p.product_id, i.price_charged, i.price_name + from ec_items i, ec_products p + where i.product_id=p.product_id + and i.item_id in ([join $item_id_list ", "])"] +} else { + set selection [ns_db select $db "select i.item_id, p.product_name, p.one_line_description, p.product_id, i.price_charged, i.price_name + from ec_items i, ec_products p + where i.product_id=p.product_id + and i.order_id=$order_id + and i.item_state='to_be_shipped'"] +} + +# If they select "All items", I want to generate a list of the items because, regardless +# of what happens elsewhere on the site (e.g. an item is added to the order, thereby causing +# the query for all items to return one more item), I want only the items that they confirm +# here to be recorded as part of this shipment. +if { [info exists all_items_p] } { + set item_id_list [list] +} + +set items_to_print "" +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { [info exists all_items_p] } { + lappend item_id_list $item_id + } + append items_to_print "
  • $product_name; $price_name: [ec_pretty_price $price_charged]" +} + +ns_write "
    +[export_form_vars shipment_id order_id item_id_list shipment_date expected_arrival_date carrier tracking_number] +
    + +
    +
    +Item(s): +
      +$items_to_print +
    + +Shipment information: + +
      + +
    • Shipment date: [ec_formatted_date $shipment_date] + +[ec_decode $expected_arrival_date "" "" "
    • Expected arrival date: [ec_formatted_date $expected_arrival_date]"] + +[ec_decode $carrier "" "" "
    • Carrier: $carrier"] + +[ec_decode $tracking_number "" "" "
    • Tracking Number: $tracking_number"] + +
    + +Ship to: +
    + +
    + +[ec_display_as_html [ec_pretty_mailing_address_from_ec_addresses $db [database_to_tcl_string $db "select shipping_address from ec_orders where order_id=$order_id"]]] + +
    + +
    + +
    + +
    +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/orders/fulfill-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/fulfill-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/fulfill-3.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,173 @@ +# fulfill-3.tcl,v 1.3.4.1 2000/02/03 09:24:53 ron Exp +set_the_usual_form_variables +# shipment_id, order_id, shipment_date, expected_arrival_date, carrier, carrier_other, +# tracking_number, item_id_list + +# We have to: +# 1. Add a row to ec_shipments. +# 2. Update item_state and shipment_id in ec_items. +# 3. Compute how much we need to charge the customer +# (a) If the total amount is the same as the amount previously calculated +# for the entire order, then update to_be_captured_p and to_be_captured_date +# in ec_financial_transactions and try to mark the transaction* +# (b) If the total amount is different and greater than 0: +# I. add a row to ec_financial_transactions with +# to_be_captured_p and to_be_captured_date set +# II. do a new authorization* +# III. mark transaction* + +# * I was debating with myself whether it really makes sense to do the CyberCash +# transactions on this page since, by updating to_be_captured_* in +# ec_financial_transactions, a cron job can easily come around later and +# see what needs to be done. +# Pros: (1) instant feedback, if desired, if the transaction fails, which means the +# shipment can possibly be aborted +# (2) if it were done via a cron job, the cron job would need to query CyberCash +# first to see if CyberCash had a record for the transaction before it could +# try to auth/mark it (in case we had attempted the transaction before an got +# an inconclusive result), whereas on this page there's no need to query first +# (you know CyberCash doesn't have a record for it). CyberCash charges 20 +# cents per transaction, although I don't actually know if a query is considered +# a transaction. +# Cons: it slows things down for the person recording shipments + +# I guess I'll just do the transactions on this page, for now, and if they prove too +# slow they can be taken out without terrible consequences (the cron job has to run +# anyway in case the results here are inconclusive). + +# the customer service rep must be logged on +set customer_service_rep [ad_get_user_id] + +if {$customer_service_rep == 0} { + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +# doubleclick protection +if { [database_to_tcl_string $db "select count(*) from ec_shipments where shipment_id=$shipment_id"] > 0 } { + ns_returnredirect fulfillment.tcl + return +} + +ns_db dml $db "begin transaction" + +ns_db dml $db "insert into ec_shipments +(shipment_id, order_id, shipment_date, expected_arrival_date, carrier, tracking_number, last_modified, last_modifying_user, modified_ip_address) +values +($shipment_id, $order_id, [ns_dbquotevalue $shipment_date]::datetime, [ns_dbquotevalue $expected_arrival_date], '$QQcarrier', '$QQtracking_number', sysdate(), $customer_service_rep, '[DoubleApos [ns_conn peeraddr]]') +" + +ns_db dml $db "update ec_items +set item_state='shipped', shipment_id=$shipment_id +where item_id in ([join $item_id_list ", "])" + +# calculate the total shipment cost (price + shipping + tax - gift certificate) of the shipment +set shipment_cost [database_to_tcl_string $db "select ec_shipment_cost($shipment_id) from dual"] + +# calculate the total order cost (price + shipping + tax - gift_certificate) so we'll +# know if we can use the original transaction +set order_cost [database_to_tcl_string $db "select ec_order_cost($order_id) from dual"] + + +# It is conceivable, albeit unlikely, that a partial shipment, +# return, and an addition of more items to the order by the site +# administrator can make the order_cost equal the shipment_cost +# even if it isn't the first shipment, which is fine. But if +# this happens twice, this would have caused the system (which is +# trying to minimize financial transactions) to try to reuse an old +# transaction, which will fail, so I've added the 2nd half of the +# "if statement" below to make sure that transaction doesn't get reused: + +if { $shipment_cost == $order_cost && [database_to_tcl_string $db "select count(*) from ec_financial_transactions where order_id=$order_id and to_be_captured_p='t'"] == 0} { + set transaction_id [database_to_tcl_string $db "select max(transaction_id) from ec_financial_transactions where order_id=$order_id"] + # 1999-08-11: added shipment_id to the update + + # 1999-08-29: put the update inside an if statement in case there is + # no transaction to update + if { ![empty_string_p $transaction_id] } { + ns_db dml $db "update ec_financial_transactions set shipment_id=$shipment_id, to_be_captured_p='t', to_be_captured_date=sysdate() where transaction_id=$transaction_id" + } + + ns_db dml $db "end transaction" + + # try to mark the transaction + # 1999-08-29: put the marking inside an if statement in case there is + # no transaction to update + if { ![empty_string_p $transaction_id] } { + + set cc_mark_result [ec_creditcard_marking $db $transaction_id] + if { $cc_mark_result == "invalid_input" } { + ns_db dml $db "insert into ec_problems_log + (problem_id, problem_date, problem_details, order_id) + values + (nextval('ec_problem_id_sequence'), sysdate(), 'When trying to mark shipment $shipment_id (transaction $transaction_id) at [DoubleApos [ns_conn url]], the following result occurred: $cc_mark_result', $order_id) + " + } elseif { $cc_mark_result == "success" } { + ns_db dml $db "update ec_financial_transactions set marked_date=sysdate() where transaction_id=$transaction_id" + } + } +} else { + if { $shipment_cost > 0 } { + # 1. add a row to ec_financial_transactions with to_be_captured_p and to_be_captured_date set + # 2. do a new authorization + # 3. mark transaction + + # Note: 1 is the only one we want to do inside the transaction; if 2 & 3 fail, they will be + # tried later with a cron job (they involve talking to CyberCash, so you never know what will + # happen with them) + + set transaction_id [database_to_tcl_string $db "select ec_transaction_id_sequence.nextval from dual"] + # 1999-08-11: added shipment_id to the insert + + ns_db dml $db "insert into ec_financial_transactions + (transaction_id, order_id, shipment_id, transaction_amount, transaction_type, to_be_captured_p, inserted_date, to_be_captured_date) + values + ($transaction_id, $order_id, $shipment_id, $shipment_cost, 'charge','t',sysdate(),sysdate()) + " + ns_db dml $db "end transaction" + + # CyberCash stuff + # this attempts an auth and returns failed_authorization, authorized_plus_avs, authorized_minus_avs, no_recommendation, or invalid_input + set cc_result [ec_creditcard_authorization $db $order_id $transaction_id] + if { $cc_result == "failed_authorization" || $cc_result == "invalid_input" } { + ns_db dml $db "insert into ec_problems_log + (problem_id, problem_date, problem_details, order_id) + values + (nextval('ec_problem_id_sequence'), sysdate(), 'When trying to authorize shipment $shipment_id (transaction $transaction_id) at [DoubleApos [ns_conn url]], the following result occurred: $cc_result', $order_id) + " + + if { [ad_parameter DisplayTransactionMessagesDuringFulfillmentP ecommerce] } { + ad_return_warning "Credit Card Failure" "Warning: the credit card authorization for this shipment (shipment_id $shipment_id) of order_id $order_id failed. You may wish to abort the shipment (if possible) until this is issue is resolved. A note has been made in the problems log.

    Continue with order fulfillment." + return + } + if { $cc_result == "failed_p" } { + ns_db dml $db "update ec_financial_transactions set failed_p='t' where transaction_id=$transaction_id" + } + } elseif { $cc_result == "authorized_plus_avs" || $cc_result == "authorized_minus_avs" } { + # put authorized_date into ec_financial_transacions + ns_db dml $db "update ec_financial_transactions set authorized_date=sysdate() where transaction_id=$transaction_id" + # try to mark the transaction + set cc_mark_result [ec_creditcard_marking $db $transaction_id] + ns_log Notice "fulfill-3.tcl: cc_mark_result is $cc_mark_result" + if { $cc_mark_result == "invalid_input" } { + ns_db dml $db "insert into ec_problems_log + (problem_id, problem_date, problem_details, order_id) + values + (nextval('ec_problem_id_sequence'), sysdate(), 'When trying to mark shipment $shipment_id (transaction $transaction_id) at [DoubleApos [ns_conn url]], the following result occurred: $cc_mark_result', $order_id) + " + } elseif { $cc_mark_result == "success" } { + ns_db dml $db "update ec_financial_transactions set marked_date=sysdate() where transaction_id=$transaction_id" + } + } + } else { + ns_db dml $db "end transaction" + } +} + +# send the "Order Shipped" email +ec_email_order_shipped $shipment_id + +ns_returnredirect "fulfillment.tcl" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/orders/fulfill.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/fulfill.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/fulfill.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,82 @@ +# fulfill.tcl,v 1.1.4.1 2000/02/03 09:24:54 ron Exp +set_the_usual_form_variables +# order_id + +# the customer service rep must be logged on +set customer_service_rep [ad_get_user_id] + +if {$customer_service_rep == 0} { + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] +set user_id [database_to_tcl_string $db "select user_id from ec_orders where order_id=$order_id"] + +ReturnHeaders +ns_write " +Order Fulfillment + + + +

    Order Fulfillment

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] [list "fulfillment.tcl" "Fulfillment"] "One Order"] + +
    + +
    +[export_form_vars order_id] + +Check off the shipped items: +
    +[ec_items_for_fulfillment_or_return $db $order_id "t"] +
    + +

    +
    +Enter the following if relevant: + +

    + + + + + + + + + + + + + + + + + +
    Shipment date (required):[ad_dateentrywidget shipment_date] [ec_timeentrywidget shipment_date "[ns_localsqltimestamp]"]
    Expected arrival date:[ad_dateentrywidget expected_arrival_date ""] [ec_timeentrywidget expected_arrival_date ""]
    Carrier + + + +Other: + +
    Tracking Number
    +
    + +
    + +
    + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/orders/fulfillment-items-needed.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/fulfillment-items-needed.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/fulfillment-items-needed.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,39 @@ +# fulfillment-items-needed.tcl,v 1.2.4.1 2000/02/03 09:24:55 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Items Needed"] + +

    Items Needed

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] [list "fulfillment.tcl" "Fulfillment"] "Items Needed"] + +
    +The following items are needed in order to fulfill all outstanding orders: +
    + + +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select p.product_id, p.product_name, count(*) as quantity +from ec_products p, ec_items_shippable i +where p.product_id=i.product_id +group by p.product_id, p.product_name +order by quantity desc"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + ## Pgsql 6.x group by hack (BMA) + if {$product_id == "" } { + continue + } + + ns_write "\n" +} + +ns_write "
    QuantityProduct
    $quantity$product_name
    +
    +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/orders/fulfillment.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/fulfillment.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/fulfillment.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,63 @@ +# fulfillment.tcl,v 1.2.4.1 2000/02/03 09:24:56 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Order Fulfillment"] + +

    Order Fulfillment

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] "Fulfillment"] + +
    +(these items are needed in order to fulfill all outstanding orders) +

    +" + +set old_order_state "" +set old_shipping_method "" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select o.order_id, o.confirmed_date, o.order_state, o.shipping_method, u.first_names, u.last_name, u.user_id +from ec_orders_shippable o, users u +where o.user_id=u.user_id +order by o.shipping_method, o.order_state, o.order_id"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $shipping_method != $old_shipping_method } { + if { $old_shipping_method != "" } { + ns_write " +

    • " + } + + ns_write "

    [string toupper "$shipping_method shipping"]

    +
    " + } + + if { $order_state != $old_order_state || $shipping_method != $old_shipping_method } { + if { $shipping_method == $old_shipping_method } { + ns_write "" + } + ns_write "Orders in state '$order_state' +
      + " + } + + ns_write "
    • " + ns_write "[ec_order_summary_for_admin $order_id $first_names $last_name $confirmed_date $order_state $user_id]" + ns_write " \[Fulfill\]\n" + + set old_shipping_method $shipping_method + set old_order_state $order_state +} + + +if { $old_shipping_method != "" } { + ns_write " +
    +
    + " +} + +ns_write "[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/orders/gift-certificate-void-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/gift-certificate-void-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/gift-certificate-void-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,17 @@ +# gift-certificate-void-2.tcl,v 1.1.4.1 2000/02/03 09:24:57 ron Exp +set_the_usual_form_variables +# gift_certificate_id, reason_for_void + +set customer_service_rep [ad_get_user_id] + +if {$customer_service_rep == 0} { + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +ns_db dml $db "update ec_gift_certificates set gift_certificate_state='void', voided_date=sysdate(), voided_by=$customer_service_rep, reason_for_void='[DoubleApos $reason_for_void]' where gift_certificate_id=$gift_certificate_id" + +ns_returnredirect "gift-certificate.tcl?[export_url_vars gift_certificate_id]" Index: web/openacs/www/admin/ecommerce/orders/gift-certificate-void.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/gift-certificate-void.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/gift-certificate-void.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,38 @@ +# gift-certificate-void.tcl,v 1.2.4.1 2000/02/03 09:24:58 ron Exp +set_the_usual_form_variables +# gift_certificate_id + +set customer_service_rep [ad_get_user_id] + +if {$customer_service_rep == 0} { + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +ReturnHeaders + +set page_title "Void Gift Certificate" +ns_write "[ad_admin_header $page_title] +

    $page_title

    + +[ad_admin_context_bar [list "../index.tcl" "Ecommerce"] [list "index.tcl" "Orders"] [list "gift-certificates.tcl" "Gift Certificates"] "Void One"] + +
    +Please explain why you are voiding this gift certificate: + +
    +[export_form_vars gift_certificate_id] + +
    + +
    + +
    + +
    + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/orders/gift-certificate.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/gift-certificate.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/gift-certificate.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,72 @@ +# gift-certificate.tcl,v 1.2.4.1 2000/02/03 09:24:59 ron Exp +set_the_usual_form_variables +# gift_certificate_id + +ReturnHeaders + +ns_write "[ad_admin_header "One Gift Certificate"] + +

    One Gift Certificate

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] [list "gift-certificates.tcl" "Gift Certificates"] "One"] + +
    +
    +" + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select c.*, i.first_names || ' ' || i.last_name as issuer, i.user_id as issuer_user_id, p.first_names || ' ' || p.last_name as purchaser, p.user_id as purchaser_user_id, gift_certificate_amount_left(c.gift_certificate_id) as amount_left, decode(sign(sysdate()-expires),1,'t',0,'t','f') as expired_p, v.first_names as voided_by_first_names, v.last_name as voided_by_last_name, o.first_names || ' ' || o.last_name as owned_by +from ec_gift_certificates c, users i, users p, users v, users o +where c.issued_by=i.user_id(+) +and c.purchased_by=p.user_id(+) +and c.voided_by=v.user_id(+) +and c.user_id=o.user_id(+) +and c.gift_certificate_id=$gift_certificate_id"] + + +if { [empty_string_p $selection] } { + ns_write "Not Found. [ad_admin_footer]" + return +} + +set_variables_after_query + +ns_write " + + + +" +if { ![empty_string_p $issuer_user_id] } { + ns_write " + " +} else { + ns_write " + + " + + if { ![empty_string_p $user_id] } { + ns_write "" + } + +} +ns_write " +" + +if { $gift_certificate_state == "void" } { + ns_write "" +} + + +ns_write "
    Gift Certificate ID    $gift_certificate_id
    Amount Left[ec_pretty_price $amount_left] (out of [ec_pretty_price $amount])
    Issued By$issuer on [util_AnsiDatetoPrettyDate $issue_date]
    Issued To$owned_by
    Purchased By$purchaser on [util_AnsiDatetoPrettyDate $issue_date]
    Sent To$recipient_email
    Claimed By$owned_by on [util_AnsiDatetoPrettyDate $claimed_date]
    [ec_decode $expired_p "t" "Expired" "Expires"][ec_decode $expires "" "never" [util_AnsiDatetoPrettyDate $expires]]
    Voided[util_AnsiDatetoPrettyDate $voided_date] by $voided_by_first_names $voided_by_last_name because: $reason_for_void
    " + +if { $expired_p == "f" && $amount_left > 0 && $gift_certificate_state != "void"} { + ns_write "(void this) + " +} + + + +ns_write "
    +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/orders/gift-certificates-issued.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/gift-certificates-issued.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/gift-certificates-issued.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,150 @@ +# gift-certificates-issued.tcl,v 1.2.4.1 2000/02/03 09:25:00 ron Exp +set_form_variables 0 +# possibly view_rep and/or view_issue_date and/or order_by + +if { ![info exists view_rep] } { + set view_rep "all" +} +if { ![info exists view_issue_date] } { + set view_issue_date "all" +} +if { ![info exists order_by] } { + set order_by "g.gift_certificate_id" +} + +ReturnHeaders + +ns_write "[ad_admin_header "Gift Certificate Issue History"] + +

    Gift Certificate Issue History

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] "Gift Certificate Issue History"] + +
    + +
    +[export_form_vars view_issue_date order_by] + + + + + + + + +
    RepIssue Date
    + + +" + +set issue_date_list [list [list last_24 "last 24 hrs"] [list last_week "last week"] [list last_month "last month"] [list all all]] + +set linked_issue_date_list [list] + +foreach issue_date $issue_date_list { + if {$view_issue_date == [lindex $issue_date 0]} { + lappend linked_issue_date_list "[lindex $issue_date 1]" + } else { + lappend linked_issue_date_list "[lindex $issue_date 1]" + } +} + +ns_write "\[ [join $linked_issue_date_list " | "] \] + +
    + +
    +
    +" + +if { $view_issue_date == "last_24" } { + set issue_date_query_bit "and sysdate()-g.issue_date <= timespan_days(1)" +} elseif { $view_issue_date == "last_week" } { + set issue_date_query_bit "and sysdate()-g.issue_date <= timespan_days(7)" +} elseif { $view_issue_date == "last_month" } { + set issue_date_query_bit "and sysdate()-g.issue_date <= '1 month'::reltime" +} else { + set issue_date_query_bit "" +} + +if [regexp {^[0-9]+$} $view_rep] { + set rep_query_bit "and g.issued_by = $view_rep" +} else { + set rep_query_bit "" +} + + +set link_beginning "gift-certificates-issued.tcl?[export_url_vars view_rep view_issue_date]" + +set table_header " + + + + + + +" + +set selection [ns_db select $db " +SELECT g.gift_certificate_id, g.issue_date, g.amount, + g.issued_by, u.first_names, u.last_name, + g.user_id as issued_to, r.first_names as issued_to_first_names, r.last_name as issued_to_last_name +from ec_gift_certificates_issued g, users u, users r +where g.issued_by=u.user_id and g.user_id=r.user_id +$issue_date_query_bit $rep_query_bit +order by $order_by +"] + +set row_counter 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $row_counter == 0 } { + ns_write $table_header + } + # even rows are white, odd are grey + if { [expr floor($row_counter/2.)] == [expr $row_counter/2.] } { + set bgcolor "white" + } else { + set bgcolor "ececec" + } + ns_write " + + + + + + " + incr row_counter +} + + +if { $row_counter != 0 } { + ns_write "
    IDDate IssuedIssued ByRecipientAmount
    $gift_certificate_id[ec_nbsp_if_null [util_AnsiDatetoPrettyDate $issue_date]][ec_decode $last_name "" " " "$last_name, $first_names"][ec_decode $last_name "" " " "$issued_to_last_name, $issued_to_first_names"][ec_pretty_price $amount]
    " +} else { + ns_write "
    None Found
    " +} + +ns_write "
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/orders/gift-certificates.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/gift-certificates.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/gift-certificates.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,143 @@ +# gift-certificates.tcl,v 1.2.4.1 2000/02/03 09:25:02 ron Exp +set_form_variables 0 +# possibly view_gift_certificate_state and/or view_issue_date and/or order_by + +if { ![info exists view_gift_certificate_state] } { + set view_gift_certificate_state "reportable" +} +if { ![info exists view_issue_date] } { + set view_issue_date "all" +} +if { ![info exists order_by] } { + set order_by "g.gift_certificate_id" +} + +ReturnHeaders + +ns_write "[ad_admin_header "Gift Certificate Purchase History"] + +

    Gift Certificate Purchase History

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] "Gift Certificate Purchase History"] + +
    + +
    +[export_form_vars view_issue_date order_by] + + + + + + + + +
    Gift Certificate StateIssue Date
    + + +" + +set issue_date_list [list [list last_24 "last 24 hrs"] [list last_week "last week"] [list last_month "last month"] [list all all]] + +set linked_issue_date_list [list] + +foreach issue_date $issue_date_list { + if {$view_issue_date == [lindex $issue_date 0]} { + lappend linked_issue_date_list "[lindex $issue_date 1]" + } else { + lappend linked_issue_date_list "[lindex $issue_date 1]" + } +} + +ns_write "\[ [join $linked_issue_date_list " | "] \] + +
    + +
    +
    +" + +if { $view_gift_certificate_state == "reportable" } { + set gift_certificate_state_query_bit "and g.gift_certificate_state in ('authorized_plus_avs','authorized_minus_avs')" +} else { + set gift_certificate_state_query_bit "and g.gift_certificate_state='$view_gift_certificate_state'" +} + +if { $view_issue_date == "last_24" } { + set issue_date_query_bit "and sysdate()-g.issue_date <= 1" +} elseif { $view_issue_date == "last_week" } { + set issue_date_query_bit "and sysdate()-g.issue_date <= 7" +} elseif { $view_issue_date == "last_month" } { + set issue_date_query_bit "and months_between(sysdate(),g.issue_date) <= 1" +} else { + set issue_date_query_bit "" +} + +set link_beginning "gift-certificates.tcl?[export_url_vars view_gift_certificate_state view_issue_date]" + +set table_header " + + + + + + + +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select g.gift_certificate_id, g.issue_date, g.gift_certificate_state, g.recipient_email, g.purchased_by, g.amount, u.first_names, u.last_name +from ec_gift_certificates g, users u +where g.purchased_by=u.user_id +$issue_date_query_bit $gift_certificate_state_query_bit +order by $order_by +"] + +set row_counter 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $row_counter == 0 } { + ns_write $table_header + } + # even rows are white, odd are grey + if { [expr floor($row_counter/2.)] == [expr $row_counter/2.] } { + set bgcolor "white" + } else { + set bgcolor "ececec" + } + ns_write " + + + + + + + " + incr row_counter +} + + +if { $row_counter != 0 } { + ns_write "
    IDDate IssuedGift Certificate StatePurchased ByRecipientAmount
    $gift_certificate_id[ec_nbsp_if_null [util_AnsiDatetoPrettyDate $issue_date]]$gift_certificate_state[ec_decode $last_name "" " " "$last_name, $first_names"]$recipient_email[ec_pretty_price $amount]
    " +} else { + ns_write "
    None Found
    " +} + +ns_write "
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/orders/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/index.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,89 @@ +# index.tcl,v 1.2.4.1 2000/02/03 09:25:03 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Orders / Shipments / Refunds"] + +

    Orders / Shipments / Refunds

    + +[ad_admin_context_bar [list "../" "Ecommerce"] "Orders / Shipments / Refunds"] + +
    +" + +set db [ns_db gethandle] + +ns_write "
      " + +set selection [ns_db 1row $db " +select + sum(one_if_within_n_days(confirmed_date,1)) as n_o_in_last_24_hours, + sum(one_if_within_n_days(confirmed_date,7)) as n_o_in_last_7_days +from ec_orders_reportable"] +set_variables_after_query + +set selection [ns_db 1row $db " +select + sum(one_if_within_n_days(issue_date,1)) as n_g_in_last_24_hours, + sum(one_if_within_n_days(issue_date,7)) as n_g_in_last_7_days +from ec_gift_certificates_purchased"] +set_variables_after_query + +set selection [ns_db 1row $db " +select + sum(one_if_within_n_days(issue_date,1)) as n_gi_in_last_24_hours, + sum(one_if_within_n_days(issue_date,7)) as n_gi_in_last_7_days +from ec_gift_certificates_issued"] +set_variables_after_query + +set selection [ns_db 1row $db " +select + sum(one_if_within_n_days(shipment_date,1)) as n_s_in_last_24_hours, + sum(one_if_within_n_days(shipment_date,7)) as n_s_in_last_7_days +from ec_shipments"] +set_variables_after_query + +set selection [ns_db 1row $db " +select + sum(one_if_within_n_days(refund_date,1)) as n_r_in_last_24_hours, + sum(one_if_within_n_days(refund_date,7)) as n_r_in_last_7_days +from ec_refunds"] +set_variables_after_query + +set n_standard_to_ship [database_to_tcl_string $db "select count(*) from ec_orders_shippable where shipping_method='standard'"] +set n_express_to_ship [database_to_tcl_string $db "select count(*) from ec_orders_shippable where shipping_method='express'"] + + +ns_write " +
    • Orders ($n_o_in_last_24_hours in last 24 hours; $n_o_in_last_7_days in last 7 days) +

      +

    • Order Fulfillment ($n_standard_to_ship order[ec_decode $n_standard_to_ship 1 "" "s"] to be shipped via standard shipping[ec_decode $n_express_to_ship "0" "" ", $n_express_to_ship via express shipping"]) +

      +

    • Gift Certificate Purchases ($n_g_in_last_24_hours in last 24 hours; $n_g_in_last_7_days in last 7 days) +

      +

    • Gift Certificates Issued ($n_gi_in_last_24_hours in last 24 hours; $n_gi_in_last_7_days in last 7 days) +

      +

    • Shipments ($n_s_in_last_24_hours in last 24 hours; $n_s_in_last_7_days in last 7 days) +

      +

    • Refunds ($n_r_in_last_24_hours in last 24 hours; $n_r_in_last_7_days in last 7 days) +

      +

    • Financial Reports +

      +

    • Search for an order: +
      + +
      +By Order ID: +
      + +
      +By Product Name: +
      + +
      +By Customer Last Name: +
      + +
      +
    +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/orders/items-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/items-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/items-add-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,47 @@ +# items-add-2.tcl,v 1.2.4.1 2000/02/03 09:25:04 ron Exp +set_the_usual_form_variables +# order_id and +# product_id or product_name + +ReturnHeaders +ns_write "[ad_admin_header "Add Items, Cont."] + +

    Add Items, Cont.

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] [list "one.tcl?order_id=$order_id" "One Order"] "Add Items, Cont."] + +
    +" + +if { [info exists product_id] } { + set additional_query_part "product_id=[ns_dbquotevalue $product_id number]" +} else { + set additional_query_part "upper(product_name) like '%[string toupper $QQproduct_name]%'" +} + +set db [ns_db gethandle] +set selection [ns_db select $db "select product_id, product_name from ec_products where $additional_query_part"] + +set product_counter 0 +while {[ns_db getrow $db $selection]} { + if { $product_counter == 0 } { + ns_write "Here are the product(s) that match your search. Click on a product to add it to the order. +

    + Note: the customer's credit card is not going to be reauthorized when you add this item to the order (their card was already found to be valid when they placed the intial order). They will, as usual, be automatically billed for this item when it ships. If the customer's credit limit is in question, just make a test authorization offline. +

      + " + } + incr product_counter + set_variables_after_query + ns_write "
    • $product_name\n" +} + +if { $product_counter == 0 } { + ns_write "No matching products were found.\n" +} else { + ns_write "
    " +} + +ns_write " +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/orders/items-add-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/items-add-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/items-add-3.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,40 @@ +# items-add-3.tcl,v 1.2.4.1 2000/02/03 09:25:05 ron Exp +set_the_usual_form_variables +# order_id, product_id + +ReturnHeaders +ns_write "[ad_admin_header "Add Items, Cont."] + +

    Add Items, Cont.

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] [list "one.tcl?order_id=$order_id" "One Order"] "Add Items, Cont."] + +
    +" + +set db [ns_db gethandle] +set item_id [database_to_tcl_string $db "select ec_item_id_sequence.nextval from dual"] +set user_id [database_to_tcl_string $db "select user_id from ec_orders where order_id=$order_id"] +set lowest_price_and_price_name [ec_lowest_price_and_price_name_for_an_item $db $product_id $user_id ""] + +ns_write "
    +[export_form_vars order_id product_id item_id] + +
    +This is the price that this user would normally receive for this product. +Make modifications as needed: + +
    + + ([ad_parameter Currency ecommerce]) +
    + +
    + +
    + +
    +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/orders/items-add-4.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/items-add-4.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/items-add-4.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,49 @@ +# items-add-4.tcl,v 1.1.4.1 2000/02/03 09:25:06 ron Exp +set_the_usual_form_variables +# item_id, order_id, product_id, price_charged, price_name + +# minor error checking +if { [empty_string_p $price_charged] || [regexp {[^0-9\.]} $price_charged] } { + ad_return_complaint 1 "The price must be a number (no special characters)." + return +} + +set db [ns_db gethandle] + +# double-click protection +if { [database_to_tcl_string $db "select count(*) from ec_items where item_id=$item_id"] > 0 } { + ns_returnredirect "one.tcl?[export_url_vars order_id]" + return +} + +# must have associated credit card +if [empty_string_p [database_to_tcl_string $db "select creditcard_id from ec_orders where order_id=$order_id"]] { + ad_return_error "Unable to add items to this order." " + This order does not have an associated credit card, so new items cannot be added. +
    Please create a new order instead." + return +} + + +set shipping_method [database_to_tcl_string $db "select shipping_method from ec_orders where order_id=$order_id"] + +ns_db dml $db "begin transaction" + +ns_db dml $db "insert into ec_items +(item_id, product_id, order_id, in_cart_date, item_state, price_charged, price_name) +values +($item_id, $product_id, $order_id, sysdate(), 'to_be_shipped', $price_charged, '$QQprice_name') +" + +# I calculate the shipping after it's inserted because this procedure goes and checks +# whether this is the first instance of this product in this order. +# I know it's non-ideal efficiency-wise, but this procedure (written for the user pages) +# is already written and it works. + +set shipping_price [ec_shipping_price_for_one_item $db $item_id $product_id $order_id $shipping_method] + +ns_db dml $db "update ec_items set shipping_charged='$shipping_price' where item_id=$item_id" + +ns_db dml $db "end transaction" + +ns_returnredirect "one.tcl?[export_url_vars order_id]" Index: web/openacs/www/admin/ecommerce/orders/items-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/items-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/items-add.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,41 @@ +# items-add.tcl,v 1.2.4.1 2000/02/03 09:25:07 ron Exp +set_the_usual_form_variables +# order_id + +ReturnHeaders +ns_write "[ad_admin_header "Add Items"] + +

    Add Items

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] [list "one.tcl?order_id=$order_id" "One Order"] "Add Items"] + +
    +
    +Search for a product to add: + +
      + + +
      +[export_form_vars order_id] +
    • By Name: + +
      • + +

      + +

      +[export_form_vars order_id] +
    • By ID: + +
      • + +
    + +
    +[ad_admin_footer] +" + + + + Index: web/openacs/www/admin/ecommerce/orders/items-return-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/items-return-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/items-return-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,155 @@ +# items-return-2.tcl,v 1.2.4.1 2000/02/03 09:25:08 ron Exp +set_the_usual_form_variables +# refund_id, order_id, received_back_date (in pieces), reason_for_return, +# either all_items_p or a series of item_ids + +# the customer service rep must be logged on +set customer_service_rep [ad_get_user_id] + +if {$customer_service_rep == 0} { + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +# make sure they haven't already inserted this refund +if { [database_to_tcl_string $db "select count(*) from ec_refunds where refund_id=$refund_id"] > 0 } { + ad_return_complaint 1 "
  • This refund has already been inserted into the database; it looks like you are using an old form. Return to the order." + return +} + +set exception_count 0 +set exception_text "" + +# they must have either checked "All items" and none of the rest, or +# at least one of the rest and not "All items" +# they also need to have shipment_date filled in + +if { [info exists all_items_p] && [info exists item_id] } { + incr exception_count + append exception_text "
  • Please either check off \"All items\" or check off some of the items, but not both." +} +if { ![info exists all_items_p] && ![info exists item_id] } { + incr exception_count + append exception_text "
  • Please either check off \"All items\" or check off some of the items." +} + +# the annoying date stuff +set form [ns_getform] + +# ns_dbformvalue $form received_back_date date received_back_date will give an error +# message if the day of the month is 08 or 09 (this octal number problem +# we've had in other places). So I'll have to trim the leading zeros +# from ColValue.received%5fback%5fdate.day +# and stick the new value into the $form ns_set. + +set "ColValue.received%5fback%5fdate.day" [string trimleft [set ColValue.received%5fback%5fdate.day] "0"] +ns_set update $form "ColValue.received%5fback%5fdate.day" [set ColValue.received%5fback%5fdate.day] + +if [catch { ns_dbformvalue $form received_back_date datetime received_back_date} errmsg ] { + # maybe they left off time, which is ok; we'll just try to set the date & not the time + if [catch { ns_dbformvalue $form received_back_date date received_back_date} errmsg] { + incr exception_count + append exception_text "
  • The date received back was specified in the wrong format. The date should be in the format Month DD YYYY. The time should be in the format HH:MI:SS (seconds are optional), where HH is 01-12, MI is 00-59 and SS is 00-59.\n" + } else { + set received_back_date "$received_back_date 00:00:00" + } +} elseif { [empty_string_p $received_back_date] } { + incr exception_count + append exception_text "
  • Please enter the date received back.\n" +} elseif { [string length [set ColValue.received%5fback%5fdate.year]] != 4 } { + incr exception_count + append exception_text "
  • The shipment year needs to contain 4 digits.\n" +} + +if { $exception_count > 0 } { + ad_return_complaint 1 $exception_text + return +} + +ReturnHeaders +ns_write "[ad_admin_header "Specify refund amount"] + +

    Specify refund amount

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] [list "one.tcl?[export_url_vars order_id]" "One"] "Mark Items Returned"] + +
    +" + +set shipping_refund_percent [ad_parameter ShippingRefundPercent ecommerce] + +if { ![info exists all_items_p] } { + set form [ns_getform] + set form_size [ns_set size $form] + set form_counter 0 + + set item_id_list [list] + while { $form_counter < $form_size} { + if { [ns_set key $form $form_counter] == "item_id" } { + lappend item_id_list [ns_set value $form $form_counter] + } + incr form_counter + } + + set selection [ns_db select $db "select i.item_id, p.product_name, i.price_charged, i.shipping_charged + from ec_items i, ec_products p + where i.product_id=p.product_id + and i.item_id in ([join $item_id_list ", "]) + and i.item_state in ('shipped','arrived')"] + # the last line is for error checking (we don't want them to push "back" and + # try to do a refund again for the same items) +} else { + set selection [ns_db select $db "select i.item_id, p.product_name, i.price_charged, i.shipping_charged + from ec_items i, ec_products p + where i.product_id=p.product_id + and i.order_id=$order_id + and i.item_state in ('shipped','arrived')"] +} + +# If they select "All items", I want to generate a list of the items because, regardless +# of what happens elsewhere on the site (e.g. an item is added to the order, thereby causing +# the query for all items to return one more item), I want only the items that they confirm +# here to be recorded as part of this return. +if { [info exists all_items_p] } { + set item_id_list [list] +} + +set items_to_print "" +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { [info exists all_items_p] } { + lappend item_id_list $item_id + } + append items_to_print "$product_name (out of [ec_pretty_price $price_charged]) (out of [ec_pretty_price $shipping_charged])" +} + +ns_write "
    +[export_form_vars refund_id order_id item_id_list received_back_date reason_for_return] +
    + + +$items_to_print +
    ItemPrice to RefundShipping to Refund
    +

    +" + +# we assume that, although only one refund may be done on an item, multiple refunds +# may be done on the base shipping cost, so we show them shipping_charged - shipping_refunded +set base_shipping [database_to_tcl_string $db "select coalesce(shipping_charged,0) - coalesce(shipping_refunded,0) from ec_orders where order_id=$order_id"] + +ns_write "Base shipping charge to refund: + (out of [ec_pretty_price $base_shipping]) + +

    + +

    + +
    + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/orders/items-return-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/items-return-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/items-return-3.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,185 @@ +# items-return-3.tcl,v 1.2.4.1 2000/02/03 09:25:09 ron Exp +set_the_usual_form_variables +# refund_id, order_id, received_back_date, reason_for_return, +# item_id_list, price_to_refund($item_id) for each item_id, +# shipping_to_refund($item_id) for each item_id, +# base_shipping_to_refund + +# the customer service rep must be logged on +set customer_service_rep [ad_get_user_id] + +if {$customer_service_rep == 0} { + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +# error checking: +# make sure price_to_refund($item_id) is <= price_charged for that item +# same with shipping +# make sure base_shipping_to_refund is <= base shipping charged - refunded + +set db_pools [ns_db gethandle [philg_server_default_pool] 2] +set db [lindex $db_pools 0] +set db_sub [lindex $db_pools 1] + +# make sure they haven't already inserted this refund +if { [database_to_tcl_string $db "select count(*) from ec_refunds where refund_id=$refund_id"] > 0 } { + ad_return_complaint 1 "
  • This refund has already been inserted into the database; it looks like you are using an old form. Return to the order." + return +} + +set exception_count 0 +set exception_text "" + +set selection [ns_db select $db "select i.item_id, p.product_name, coalesce(i.price_charged,0) as price_charged, coalesce(i.shipping_charged,0) as shipping_charged, coalesce(i.price_tax_charged,0) as price_tax_charged, coalesce(i.shipping_tax_charged,0) as shipping_tax_charged +from ec_items i, ec_products p +where i.product_id=p.product_id +and i.item_id in ([join $item_id_list ", "])"] + +# add up the items' price/shipping/tax to refund as we go +set total_price_to_refund 0 +set total_shipping_to_refund 0 +set total_price_tax_to_refund 0 +set total_shipping_tax_to_refund 0 + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { [empty_string_p $price_to_refund($item_id)] } { + incr exception_count + append exception_text "
  • Please enter a price to refund for $product_name." + } elseif {[regexp {[^0-9\.]} $price_to_refund($item_id)]} { + incr exception_count + append exception_text "
  • Please enter a purely numeric price to refund for $product_name (no letters or special characters)." + } elseif { $price_to_refund($item_id) > $price_charged } { + incr exception_count + append exception_text "
  • Please enter a price to refund for $product_name that is less than or equal to [ec_pretty_price $price_charged]." + } else { + set total_price_to_refund [expr $total_price_to_refund + $price_to_refund($item_id)] + # tax will be the minimum of the tax actually charged and the tax that would have been charged on the price to refund + # (tax rates may have changed in the meantime and we don't want to refund more than they paid) + set iteration_price_tax_to_refund [ec_min $price_tax_charged [database_to_tcl_string $db_sub "select ec_tax($price_to_refund($item_id),0,$order_id) from dual"]] + set total_price_tax_to_refund [expr $total_price_tax_to_refund + $iteration_price_tax_to_refund] + } + + if { [empty_string_p $shipping_to_refund($item_id)] } { + incr exception_count + append exception_text "
  • Please enter a shipping amount to refund for $product_name." + } elseif {[regexp {[^0-9\.]} $shipping_to_refund($item_id)]} { + incr exception_count + append exception_text "
  • Please enter a purely numeric shipping amount to refund for $product_name (no letters or special characters)." + } elseif { $shipping_to_refund($item_id) > $shipping_charged } { + incr exception_count + append exception_text "
  • Please enter a shipping amount to refund for $product_name that is less than or equal to [ec_pretty_price $shipping_charged]." + } else { + set total_shipping_to_refund [expr $total_shipping_to_refund + $shipping_to_refund($item_id)] + + set iteration_shipping_tax_to_refund [ec_min $shipping_tax_charged [database_to_tcl_string $db_sub "select ec_tax(0,$shipping_to_refund($item_id),$order_id) from dual"]] + set total_shipping_tax_to_refund [expr $total_shipping_tax_to_refund + $iteration_shipping_tax_to_refund] + } +} + +set selection [ns_db 1row $db "select coalesce(shipping_charged,0) - coalesce(shipping_refunded,0) as base_shipping, coalesce(shipping_tax_charged,0) - coalesce(shipping_tax_refunded,0) as base_shipping_tax from ec_orders where order_id=$order_id"] +set_variables_after_query + +if { [empty_string_p $base_shipping_to_refund] } { + incr exception_count + append exception_text "
  • Please enter a base shipping amount to refund." +} elseif {[regexp {[^0-9\.]} $base_shipping_to_refund]} { + incr exception_count + append exception_text "
  • Please enter a purely numeric base shipping amount to refund (no letters or special characters)." +} elseif { $base_shipping_to_refund > $base_shipping } { + incr exception_count + append exception_text "
  • Please enter a base shipping amount to refund that is less than or equal to [ec_pretty_price $base_shipping]." +} else { + set total_shipping_to_refund [expr $total_shipping_to_refund + $base_shipping_to_refund] + + set iteration_shipping_tax_to_refund [ec_min $base_shipping_tax [database_to_tcl_string $db_sub "select ec_tax(0,$base_shipping,$order_id) from dual"]] + set total_shipping_tax_to_refund [expr $total_shipping_tax_to_refund + $iteration_shipping_tax_to_refund] + +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +set total_tax_to_refund [expr $total_price_tax_to_refund + $total_shipping_tax_to_refund] +set total_amount_to_refund [expr $total_price_to_refund + $total_shipping_to_refund + $total_tax_to_refund] + +# determine how much of this will be refunded in cash +set cash_amount_to_refund [database_to_tcl_string $db "select ec_cash_amount_to_refund($total_amount_to_refund,$order_id) from dual"] + +# calculate gift certificate amount and tax to refund +set certificate_amount_to_reinstate [expr $total_amount_to_refund - $cash_amount_to_refund] +if { $certificate_amount_to_reinstate < 0 } { + # because of rounding + set certificate_amount_to_reinstate 0 +} + +# see if the credit card data is still in the database (otherwise they'll have to type in the query password) +set creditcard_number [database_to_tcl_string $db "select creditcard_number from ec_orders o, ec_creditcards c where o.creditcard_id=c.creditcard_id and o.order_id=$order_id"] + +ReturnHeaders +ns_write "[ad_admin_header "Refund Totals"] + +

    Refund Totals

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] [list "one.tcl?[export_url_vars order_id]" "One"] "Refund Totals"] + +
    + +[export_entire_form] +[export_form_vars cash_amount_to_refund certificate_amount_to_reinstate] +
    +Total refund amount: [ec_pretty_price $total_amount_to_refund] (price: [ec_pretty_price $total_price_to_refund], shipping: [ec_pretty_price $total_shipping_to_refund], tax: [ec_pretty_price $total_tax_to_refund]) +

    +

      +
    • [ec_pretty_price $certificate_amount_to_reinstate] will be reinstated in gift certificates.
      +
    • [ec_pretty_price $cash_amount_to_refund] will be refunded to the customer's credit card.
      +
    +" + +# have them type in the query password +if { [empty_string_p $creditcard_number] && $cash_amount_to_refund > 0 } { + ns_write "
    + Enter either your CyberCash card-query password (which we can use to try to obtain + the credit card number used on this order) or enter a new credit card: +
    + + + + + +
    Password for card-query:
    New Credit Card: + not yet functional + + + + + + + + + + + + + + + + +
    Credit card number:
    Type:[ec_creditcard_widget]
    Expires:[ec_creditcard_expire_1_widget] [ec_creditcard_expire_2_widget]
    Billing zip code:
    +
    +
    + " +} + +ns_write "
    +
    +
    + +
    +
    • +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/orders/items-return-4.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/items-return-4.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/items-return-4.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,326 @@ +# items-return-4.tcl,v 1.3.4.1 2000/02/03 09:25:10 ron Exp +# items-return-4.tcl +# +# by eveander@arsdigita.com, July 22, 1999 +# +# This script does the following: +# 1. tries to get credit card number (insert it if new) +# 2. puts records into ec_refunds, individual items, the order, and +# ec_financial transactions +# 3. does the gift certificate reinstatements +# 4. tries to do refund + + +set_the_usual_form_variables +# refund_id, order_id, received_back_date, reason_for_return, +# item_id_list, price_to_refund($item_id) for each item_id, +# shipping_to_refund($item_id) for each item_id, +# base_shipping_to_refund, +# cash_amount_to_refund, certificate_amount_to_reinstate + +# possibly card_query_p, card_query_password, +# creditcard_number, creditcard_type, creditcard_expire_1, +# creditcard_expire_2, billing_zip_code + +# the customer service rep must be logged on +set customer_service_rep [ad_get_user_id] + +if {$customer_service_rep == 0} { + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +if { [info exists creditcard_number] } { + # get rid of spaces and dashes + regsub -all -- "-" $creditcard_number "" creditcard_number + regsub -all " " $creditcard_number "" creditcard_number +} + +# error checking: +# unless the credit card number is in the database or if the total +# amount to refund is $0.00, card_query_p +# should exist and be "t" or "f". If it's "t", we need a password +# and no new credit card number. If it's "f", we need new credit +# card information and no card-query password. + +set exception_count 0 +set exception_text "" + +set db [ns_db gethandle] + +set user_id [database_to_tcl_string $db "select user_id from ec_orders where order_id=$order_id"] + + +# make sure they haven't already inserted this refund +if { [database_to_tcl_string $db "select count(*) from ec_refunds where refund_id=$refund_id"] > 0 } { + ad_return_complaint 1 "
  • This refund has already been inserted into the database; it looks like you are using an old form. Return to the order." + return +} + + +if { [expr $cash_amount_to_refund] > 0 && [empty_string_p [database_to_tcl_string $db "select creditcard_number from ec_orders o, ec_creditcards c where o.creditcard_id=c.creditcard_id and o.order_id=$order_id"]]} { + + # then we need a card query or a new credit card number + if { ![info exists card_query_p] || [empty_string_p $card_query_p] } { + incr exception_count + append exception_text "
  • You must specify whether you want to query CyberCash for the old credit card number or whether you want to use a new credit card." + } elseif { $card_query_p == "t" } { + if { [empty_string_p $card_query_password] } { + incr exception_count + append exception_text "
  • You specified that you want to query CyberCash for the old credit card number, but you didn't type in the card-query password." + } + if { ![empty_string_p $creditcard_number] } { + incr exception_count + append exception_text "
  • You specified that you want to query CyberCash for the old credit card number, but you entered a new credit card number. Please choose one or the other." + } + } else { + + # card_query_p is "f" + if { ![empty_string_p $card_query_password] } { + incr exception_count + append exception_text "
  • You specified that you want to use a new credit card number, but you entered a card-query password. Please choose one or the other." + } + + if { ![info exists creditcard_number] || [empty_string_p $creditcard_number] } { + # then they haven't selected a previous credit card nor have they entered + # new credit card info + incr exception_count + append exception_text "
  • You forgot to specify which credit card you'd like to use." + return + } else { + # then they are using a new credit card and we just have to check that they + # got it all right + + if { [regexp {[^0-9]} $creditcard_number] } { + # I've already removed spaces and dashes, so only numbers should remain + incr exception_count + append exception_text "
  • The credit card number contains invalid characters." + } + + if { ![info exists billing_zip_code] || [empty_string_p $billing_zip_code] } { + incr exception_count + append exception_text "
  • You forgot to enter the billing zip code." + } + + if { ![info exists creditcard_type] || [empty_string_p $creditcard_type] } { + incr exception_count + append exception_text "
  • You forgot to enter the credit card type." + } + + # make sure the credit card type is right & that it has the right number + # of digits + set additional_count_and_text [ec_check_creditcard_type_number_match $creditcard_number $creditcard_type] + + set exception_count [expr $exception_count + [lindex $additional_count_and_text 0]] + append exception_text [lindex $additional_count_and_text 1] + + if { ![info exists creditcard_expire_1] || [empty_string_p $creditcard_expire_1] || ![info exists creditcard_expire_2] || [empty_string_p $creditcard_expire_2] } { + incr exception_count + append exception_text "
  • Please enter the full credit card expiration date (month and year)" + } + } + } +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +# done with error checking + +if { [expr $cash_amount_to_refund] > 0 } { + # 1. try to get credit card number (insert it if new) + + + if { [info exists card_query_p] && $card_query_p == "t" } { + set creditcard_id [database_to_tcl_string $db "select creditcard_id from ec_orders where order_id=$order_id"] + + # find the latest transaction with this card number, preferably one with authorized_date set + set transaction_to_query [database_to_tcl_string $db "select max(transaction_id) from ec_financial_transactions where creditcard_id=$creditcard_id and (authorized_date is not null OR 0=(select count(*) from ec_financial_transactions where creditcard_id=$creditcard_id and authorized_date is not null)"] + + # talk to CyberCash to get the card number + set cc_args [ns_set new] + set cc_output [ns_set new] + ns_set put $cc_args "order-id" $transaction_to_query + ns_set put $cc_args "passwd" $card_query_password + + cc_send_to_server_21 "card-query" $cc_args $cc_output + + set creditcard_number [ns_set get $cc_output "card-number"] + + if { [empty_string_p $creditcard_number] } { + ad_return_complaint 1 "
  • The card-query was unsuccessful. Please try again (check the password) or manually enter a new credit card." + return + } else { + # this is where we begin the transaction for Case A (card-query to get credit card number) + + ns_db dml $db "begin transaction" + + # update the credit card number in ec_creditcards + ns_db dml $db "update ec_creditcards set creditcard_number='[DoubleApos $creditcard_number]' where creditcard_id=$creditcard_id" + } + } elseif { [info exists card_query_p] && $card_query_p == "f" } { + # this is where we begin the transaction for Case B (insert new credit card number) + + ns_db dml $db "begin transaction" + + # insert a new credit card into ec_creditcards + set creditcard_id [db_sequence_nextval $db "creditcard_id_sequence"] + + ns_db dml $db "insert into ec_creditcards + (creditcard_id, user_id, creditcard_number, creditcard_last_four, creditcard_type, creditcard_expire, billing_zip_code) + values + ($creditcard_id, $user_id, '$creditcard_number', '[string range $creditcard_number [expr [string length $creditcard_number] -4] [expr [string length $creditcard_number] -1]]', '[DoubleApos $creditcard_type]','$creditcard_expire_1/$creditcard_expire_2','[DoubleApos $billing_zip_code]') + " + } else { + set creditcard_id [database_to_tcl_string $db "select creditcard_id from ec_orders where order_id=$order_id"] + + # this is where we begin the transaction for Case C (credit card number still in database) + ns_db dml $db "begin transaction" + } +} else { + # this is where we begin the transaction for Case D (no money has to be refunded) + ns_db dml $db "begin transaction" +} + +# 2. put records into ec_refunds, individual items, the order, and +# ec_financial_transactions + +ns_db dml $db "insert into ec_refunds +(refund_id, order_id, refund_amount, refund_date, refunded_by, refund_reasons) +values +($refund_id, $order_id, $cash_amount_to_refund, sysdate(), $customer_service_rep,'$QQreason_for_return') +" + +foreach item_id $item_id_list { + # this is annoying (doing these selects before each insert), but that's how it goes because we don't + # want to refund more tax than was actually paid even if the tax rates changed + + set selection [ns_db 1row $db "select coalesce(price_tax_charged,0) as price_tax_charged, coalesce(shipping_tax_charged,0) as shipping_tax_charged from ec_items where item_id=$item_id"] + set_variables_after_query + + set price_tax_to_refund [ec_min $price_tax_charged [database_to_tcl_string $db "select ec_tax($price_to_refund($item_id),0,$order_id) from dual"]] + set shipping_tax_to_refund [ec_min $shipping_tax_charged [database_to_tcl_string $db "select ec_tax(0,$shipping_to_refund($item_id),$order_id) from dual"]] + + ns_db dml $db "update ec_items set item_state='received_back', received_back_date=to_date('$received_back_date','YYYY-MM-DD HH24:MI:SS'), price_refunded=[ns_dbquotevalue $price_to_refund($item_id)], shipping_refunded=[ns_dbquotevalue $shipping_to_refund($item_id)], price_tax_refunded=[ns_dbquotevalue $price_tax_to_refund], shipping_tax_refunded=[ns_dbquotevalue $shipping_tax_to_refund], refund_id=$refund_id where item_id=$item_id" +} + +set base_shipping_tax_charged [database_to_tcl_string $db "select coalesce(shipping_tax_charged,0) from ec_orders where order_id=$order_id"] +set base_shipping_tax_to_refund [ec_min $base_shipping_tax_charged [database_to_tcl_string $db "select ec_tax(0,$base_shipping_to_refund,$order_id) from dual"]] + +ns_db dml $db "update ec_orders set shipping_refunded=[ns_dbquotevalue $base_shipping_to_refund], shipping_tax_refunded=[ns_dbquotevalue $base_shipping_tax_to_refund] where order_id=$order_id" + +if { [expr $cash_amount_to_refund] > 0 } { + + # 1999-08-11: added refund_id to the insert + set transaction_id [database_to_tcl_string $db "select ec_transaction_id_sequence.nextval from dual"] + ns_db dml $db "insert into ec_financial_transactions + (transaction_id, order_id, refund_id, creditcard_id, transaction_amount, transaction_type, inserted_date) + values + ($transaction_id, $order_id, $refund_id, $creditcard_id, $cash_amount_to_refund, 'refund', sysdate()) + " +} + +# 3. do the gift certificate reinstatements (start with ones that expire furthest in +# to future) + +if { $certificate_amount_to_reinstate > 0 } { + + # this will be a list of 2-element lists (gift_certificate_id, original_amount) + set certs_to_reinstate_list [list] + set selection [ns_db select $db "select u.gift_certificate_id, c.amount as original_amount + from ec_gift_certificate_usage u, ec_gift_certificates c + where u.gift_certificate_id = c.gift_certificate_id + and u.order_id = $order_id + order by expires desc + gift_certificate_id desc"] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + lappend certs_to_reinstate_list [list $gift_certificate_id $original_amount] + } + + # the amount used on that order + set certificate_amount_used [database_to_tcl_string $db "select ec_order_gift_cert_amount($order_id) from dual"] + + if { $certificate_amount_used < $certificate_amount_to_reinstate } { + ns_db dml $db "insert into ec_problems_log + (problem_id, problem_date, problem_details, order_id) + values + (ec_problem_id_sequence.nextval, sysdate(), 'We were unable to reinstate the customer''s gift certificate balance because the amount to be reinstated was larger than the original amount used. This shouldn''t have happened unless there was a programming error or unless the database was incorrectly updated manually. This transaction was aborted (refund_id $refund_id), i.e. no refund was given to the customer.', $order_id) + " + ad_return_error "Gift Certificate Error" "We were unable to reinstate the customer's gift certificate balance because the amount to be reinstated was larger than the original amount used. This shouldn't have happened unless there was a programming error or unless the database was incorrectly updated manually.

    This transaction has been aborted, i.e. no refund has been given to the customer. This has been logged in the problems log." + return + } else { + # go through and reinstate certificates in order; it's not so bad + # to loop through all of them because I don't expect there to be + # many + + set amount_to_reinstate $certificate_amount_to_reinstate + foreach cert_and_original_amount $certs_to_reinstate_list { + if { $amount_to_reinstate > 0 } { + set cert [lindex $cert_and_original_amount 0] + set original_amount [lindex $cert_and_original_amount 1] + set reinstatable_amount [expr $original_amount - [database_to_tcl_string $db "select gift_certificate_amount_left($cert) from dual"]] + if { $reinstatable_amount > 0 } { + set iteration_reinstate_amount [ec_min $reinstatable_amount $amount_to_reinstate] + + ns_db dml $db "insert into ec_gift_certificate_usage + (gift_certificate_id, order_id, amount_reinstated, reinstated_date) + values + ($cert, $order_id, $iteration_reinstate_amount, sysdate()) + " + + set amount_to_reinstate [expr $amount_to_reinstate - $iteration_reinstate_amount] + } + } + } + } +} + +# end the transaction before going out to CyberCash to do the refund (if it fails, +# we still have a row in ec_financial_transactions telling us that it tried to do +# the refund, so we will know it needs to be done) + +ns_db dml $db "end transaction" +# 4. try to do refund + +if { $cash_amount_to_refund > 0} { + # transaction_id should exist if the above is true + set refund_status [ec_creditcard_return $db $transaction_id] + if { $refund_status == "failure" || $refund_status == "invalid_input" } { + ns_db dml $db "insert into ec_problems_log + (problem_id, problem_date, problem_details, order_id) + values + (ec_problem_id_sequence.nextval, sysdate(), 'When trying to refund refund_id $refund_id (transaction $transaction_id) at [DoubleApos [ns_conn url]], the following result occurred: $refund_status', $order_id) + " + set results_explanation "The refund did not occur. We have made a record of this in the problems log so that the situation can be corrected manually." + } elseif { $refund_status == "inconclusive" } { + set results_explanation "The results of the refund attempt were inconclusive (perhaps due to a communications failure between us and CyberCash. A program will keep trying to complete the refund and the problems log will be updated if it the refund cannot be completed within 24 hours." + } else { + # refund successful + ns_db dml $db "update ec_financial_transactions set refunded_date=sysdate() where transaction_id=$transaction_id" + set results_explanation "The refund is complete!" + } + + set page_title "Refund completed with status $refund_status" +} else { + set page_title "No credit card refund needed." + set results_explanation "No credit card refund was necessary because the entire amount was refunded to the gift certificates the customer used when purchasing the order." +} + +ReturnHeaders +ns_write "[ad_admin_header $page_title] +

    $page_title

    +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] [list "one.tcl?[export_url_vars order_id]" "One"] "Refund Complete"] + +
    +
    +$results_explanation +

    +Back to Order $order_id +

    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/orders/items-return.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/items-return.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/items-return.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,65 @@ +# items-return.tcl,v 1.2.4.1 2000/02/03 09:25:12 ron Exp +set_the_usual_form_variables +# order_id + +# we need them to be logged in +set customer_service_rep [ad_verify_and_get_user_id] + +if {$customer_service_rep == 0} { + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +# in case they reload this page after completing the refund process: +if { [database_to_tcl_string $db "select count(*) from ec_items_refundable where order_id=$order_id"] == 0 } { + ad_return_complaint 1 "
  • This order doesn't contain any refundable items; perhaps you are using an old form. Return to the order." + return +} + +ReturnHeaders +ns_write "[ad_admin_header "Mark Items Returned"] + +

    Mark Items Returned

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] [list "one.tcl?order_id=$order_id" "One Order"] "Mark Items Returned"] + +
    +" +# generate the new refund_id here (we don't want them reusing this form) +set refund_id [database_to_tcl_string $db "select refund_id_sequence.nextval from dual"] + + +ns_write "
    +[export_form_vars order_id refund_id] + +
    +Date received back: +[ad_dateentrywidget received_back_date] [ec_timeentrywidget received_back_date "[ns_localsqltimestamp]"] + +

    + +Please check off the items that were received back: +

    +[ec_items_for_fulfillment_or_return $db $order_id "f"] +
    + +Reason for return (if known): +
    + +
    + +
    + +

    +

    + +
    + +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/orders/items-void-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/items-void-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/items-void-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,114 @@ +# items-void-2.tcl,v 1.1.4.1 2000/02/03 09:25:13 ron Exp +set_the_usual_form_variables +# order_id, product_id +# and possibly a series of item_ids from checkboxes (if there's more than one) + +# we need them to be logged in +set customer_service_rep [ad_verify_and_get_user_id] + +if {$customer_service_rep == 0} { + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + + +# See if there's a gift certificate amount applied to this order that's being +# tied up by unshipped items, in which case we may need to reinstate some or +# all of it. +# The equations are: +# (tied up g.c. amount) = (g.c. bal applied to order) - (amount paid for shipped items) +# + (amount refunded for shipped items) +# (amount to be reinstated for to-be-voided items) = (tied up g.c. amount) +# - (total cost of unshipped items) +# + (cost of to-be-voided items) +# +# So, (amount to be reinstated) = (g.c. bal applied to order) - (amount paid for shipped items) +# + (amount refunded for shipped items) - (total cost of unshipped items) + cost of to-be-voided items) +# = (g.c. bal applied to order) - (total amount for all nonvoid items in the order, incl the ones that are about to be voided) +# + (total amount refunded on nonvoid items) +# + (cost of to-be-voided items) +# = (g.c. bal applied to order) - (total amount for all nonvoid items in the order after these are voided) +# + total amount refunded on nonvoid items +# This equation is now officially simple to solve. G.c. balance should be calculated first, then things +# should be voided, then final calculation should be made and g.c.'s should be reinstated. + +set db [ns_db gethandle] + +ns_db dml $db "begin transaction" + +set gift_certificate_amount [database_to_tcl_string $db "select ec_order_gift_cert_amount($order_id) from dual"] + +# see if there's more than one item in this order with that order_id & product_id + +set n_items [database_to_tcl_string $db "select count(*) from ec_items where order_id=$order_id and product_id=$product_id"] + +if { $n_items > 1 } { + # make sure they checked at least one checkbox + set form [ns_conn form] + set item_id_list [util_GetCheckboxValues $form item_id] + if { [llength $item_id_list] == 1 && [lindex 0 $item_id_list] == 0 } { + ad_return_complaint 1 "
  • You didn't check off any items." + return + } + ns_db dml $db "update ec_items set item_state='void', voided_date=sysdate(), voided_by=$customer_service_rep where item_id in ([join $item_id_list ", "])" +} else { + ns_db dml $db "update ec_items set item_state='void', voided_date=sysdate(), voided_by=$customer_service_rep where order_id=$order_id and product_id=$product_id" +} + +set amount_charged_minus_refunded_for_nonvoid_items [database_to_tcl_string $db "select nvl(sum(nvl(price_charged,0)) + sum(nvl(shipping_charged,0)) + sum(nvl(price_tax_charged,0)) + sum(nvl(shipping_tax_charged,0)) - sum(nvl(price_refunded,0)) - sum(nvl(shipping_refunded,0)) + sum(nvl(price_tax_refunded,0)) - sum(nvl(shipping_tax_refunded,0)),0) from ec_items where item_state <> 'void' and order_id=$order_id"] + +set certificate_amount_to_reinstate [expr $gift_certificate_amount - $amount_charged_minus_refunded_for_nonvoid_items] + +if { $certificate_amount_to_reinstate > 0 } { + + set certs_to_reinstate_list [list] + + set certs_to_reinstate_list [database_to_tcl_list $db "select u.gift_certificate_id + from ec_gift_certificate_usage u, ec_gift_certificates c + where u.gift_certificate_id = c.gift_certificate_id + and u.order_id = $order_id + order by expires desc"] + + # the amount used on that order + set certificate_amount_used [database_to_tcl_string $db "select ec_order_gift_cert_amount($order_id) from dual"] + + if { $certificate_amount_used < $certificate_amount_to_reinstate } { + ns_db dml $db "insert into ec_problems_log + (problem_id, problem_date, problem_details, order_id) + values + (ec_problem_id_sequence.nextval, sysdate(), 'We were unable to reinstate the customer''s gift certificate balance because the amount to be reinstated was larger than the original amount used. This shouldn''t have happened unless there was a programming error or unless the database was incorrectly updated manually. The voiding of this order has been aborted.', $order_id) + " + ad_return_error "Gift Certificate Error" "We were unable to reinstate the customer's gift certificate balance because the amount to be reinstated was larger than the original amount used. This shouldn't have happened unless there was a programming error or unless the database was incorrectly updated manually.

    The voiding of this order has been aborted. This has been logged in the problems log." + return + } else { + # go through and reinstate certificates in order; it's not so bad + # to loop through all of them because I don't expect there to be + # many + + set amount_to_reinstate $certificate_amount_to_reinstate + foreach cert $certs_to_reinstate_list { + if { $amount_to_reinstate > 0 } { + + # any amount up to the original amount used on this order can be reinstated + set reinstatable_amount [database_to_tcl_string $db "select ec_one_gift_cert_on_one_order($cert,$order_id) from dual"] + + if { $reinstatable_amount > 0 } { + set iteration_reinstate_amount [ec_min $reinstatable_amount $amount_to_reinstate] + + ns_db dml $db "insert into ec_gift_certificate_usage + (gift_certificate_id, order_id, amount_reinstated, reinstated_date) + values + ($cert, $order_id, $iteration_reinstate_amount, sysdate()) + " + + set amount_to_reinstate [expr $amount_to_reinstate - $iteration_reinstate_amount] + } + } + } + } +} + +ns_db dml $db "end transaction" + +ns_returnredirect "one.tcl?[export_url_vars order_id]" Index: web/openacs/www/admin/ecommerce/orders/items-void.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/items-void.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/items-void.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,119 @@ +# items-void.tcl,v 1.2.4.1 2000/02/03 09:25:14 ron Exp +set_the_usual_form_variables +# order_id, product_id + +# we need them to be logged in +set customer_service_rep [ad_verify_and_get_user_id] + +if {$customer_service_rep == 0} { + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +# in case they reload this page after completing the void process: +if { [database_to_tcl_string $db "select count(*) from ec_items where order_id=$order_id and product_id=$product_id and item_state<>'void'"] == 0 } { + ad_return_complaint 1 "

  • These items are already void; perhaps you are using an old form. Return to the order." + return +} + +set n_items [database_to_tcl_string $db "select count(*) from ec_items where order_id=$order_id and product_id=$product_id"] + +if { $n_items > 1 } { + set item_or_items "Items" +} else { + set item_or_items "Item" +} + +ReturnHeaders +ns_write "[ad_admin_header "Void $item_or_items"] + +

    Void $item_or_items

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] [list "one.tcl?order_id=$order_id" "One Order"] "$item_or_items"] + +
    +
    +
    +[export_form_vars order_id product_id] +" + +# we have to take care of some cases (hopefully #1, the simplest, will be most +# prevalent) +# different cases get different wording and cases 1-2 are functionally different +# than cases 3-4 +# 1. there's only one item in this order with this product_id and it hasn't shipped yet +# 2. there's only one item in this order with this product_id and it's already shipped +# 3. more than one item in this order with this product_id and no non-void items have +# already shipped +# 4. more than one item in this order with this product_id and at least one non-void +# item has already shipped + +if { $n_items == 1 } { + # cases 1 & 2 (only differ by a warning message) + # we assume it's not void, otherwise they wouldn't have been given the link to + # this page + set item_state [database_to_tcl_string $db "select item_state from ec_items where order_id=$order_id and product_id=$product_id"] + + if { $item_state == "shipped" || $item_state == "arrived" || $item_state == "received_back" } { + ns_write "Warning: our records show that this item has already + shipped, which means that the customer has already been charged for this + item. Voiding an item will not cause the customer's credit card to be + refunded (you can only do that by marking it \"received back\"). +

    + " + } + ns_write "Please confirm that you want to void this item. + " + +} else { + # cases 3 & 4 (only differ by a warning message) + set n_shipped_items [database_to_tcl_string $db "select count(*) from ec_items where order_id=$order_id and product_id=$product_id and item_state in ('shipped','arrived','received_back')"] + + if { $n_shipped_items > 0 } { + ns_write "Warning: our records show that at least one of these + items has already shipped, which means that the customer has already + been charged (for shipped items only). Voiding an item will not cause + the customer's credit card to be refunded (you can only do that by marking + it \"received back\"). +

    + " + } + ns_write "Please check off the item(s) you wish to void. + + " + + set selection [ns_db select $db "select i.item_id, i.item_state, p.product_name, i.price_name, i.price_charged + from ec_items i, ec_products p + where i.product_id=p.product_id + and i.order_id=$order_id + and i.product_id=$product_id"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "" + } + + ns_write "
    Void ItemProductItem State
    " + if { $item_state == "void" } { + ns_write " (already void) " + } else { + ns_write "" + } + ns_write "$product_name; $price_name: [ec_pretty_price $price_charged]$item_state
    " + +} + +ns_write "

    + +

    +
    + +
    + + + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/orders/one.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/one.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/one.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,344 @@ +# one.tcl,v 1.2.4.1 2000/02/03 09:25:16 ron Exp +set_the_usual_form_variables +# order_id + +set db_pools [ns_db gethandle [philg_server_default_pool] 2] +set db [lindex $db_pools 0] +set db_sub [lindex $db_pools 1] + +set selection [ns_db 1row $db "select * from ec_orders where order_id=$order_id"] +set_variables_after_query + +set selection [ns_db 0or1row $db "select first_names, last_name from users where user_id=[ns_dbquotevalue $user_id]"] +if { ![empty_string_p $selection] } { + set_variables_after_query +} else { + set first_names "" + set last_name "" +} + +ReturnHeaders +ns_write "[ad_admin_header "One Order"] + +

    One Order

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] "One Order"] + +
    + +

    Overview

    + +[ec_decode $order_state "void" "" "
    "] + + + + + + + + + + + + + + + + + +
    Order ID$order_id[ec_decode $order_state "void" "" "
    [ec_formatted_price_shipping_gift_certificate_and_tax_in_an_order $db $order_id]
    "]
    Ordered by$first_names $last_name
    Confirmed date[util_AnsiDatetoPrettyDate $confirmed_date]
    Order state[ec_decode $order_state "void" "void" $order_state]
    +

    + + +

    +" + +if { $order_state == "void" } { + ns_write "

    Details of Void

    +
    +Voided by: [database_to_tcl_string_or_null $db "select first_names || ' ' || last_name from users where user_id=[ns_dbquotevalue $voided_by]"] +
    +Date: [util_AnsiDatetoPrettyDate $voided_date] +
    +[ec_decode $reason_for_void "" "" "Reason: [ec_display_as_html $reason_for_void]"] +
    +" +} + +ns_write " +[ec_decode $cs_comments "" "" "

    Comments

    \n
    [ec_display_as_html $cs_comments]
    "] + + + +

    Items

    +
      +" + +set selection [ns_db select $db "select p.product_name, p.product_id, i.price_name, i.price_charged, count(*) as quantity, i.item_state, i.color_choice, i.size_choice, i.style_choice +from ec_items i, ec_products p +where i.product_id=p.product_id +and i.order_id=$order_id +group by p.product_name, p.product_id, i.price_name, i.price_charged, i.item_state, i.color_choice, i.size_choice, i.style_choice"] + +set items_ul "" + +# We want to display these by item (with all order states in parentheses), like: +# Quantity 3: #2 Standard Pencils; Our Price: $0.99 (2 shipped, 1 to_be_shipped). +# This UI will break if the customer has more than one of the same product with +# different prices in the same order (the shipment summary is by product_id). + +set old_product_id 0 +set item_quantity 0 +set state_list [list] +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + if { $product_id != $old_product_id && $old_product_id != 0 } { + append items_ul "
    • Quantity $item_quantity: + $item_description ([join $item_state_list ", "]) + " + if { [llength $item_state_list] != 1 || [lindex [split [lindex $item_state_list 0] " "] 1] != "void" } { + # i.e., if the items of this product_id are not all void + # (I know that "if" statement could be written more compactly, + # but I didn't want to offend Philip by relying on Tcl's internal + # representation of a list) + append items_ul "(remove)" + } + + + append items_ul "
      + [ec_shipment_summary $db_sub $product_id $color_choice $size_choice $style_choice $price_charged $price_name $order_id] + " + set item_state_list [list] + set item_quantity 0 + } + + lappend item_state_list "$quantity $item_state" + set item_quantity [expr $item_quantity + $quantity] + set item_description "$product_name; $price_name: [ec_pretty_price $price_charged]" + set old_product_id $product_id +} + +if { $old_product_id != 0 } { + # append the last line + append items_ul "
    • Quantity $item_quantity: + $item_description ([join $item_state_list ", "]) + " + if { [llength $item_state_list] != 1 || [lindex [split [lindex $item_state_list 0] " "] 1] != "void" } { + # i.e., if the items of this product_id are not all void + append items_ul "(remove)" + } + append items_ul "
      + [ec_shipment_summary $db_sub $old_product_id $color_choice $size_choice $style_choice $price_charged $price_name $order_id] + " +} + + + +ns_write "$items_ul" + +if { $order_state == "authorized_plus_avs" || $order_state == "authorized_minus_avs" || $order_state == "partially_fulfilled" } { + ns_write "

      +

    • Record a Shipment +
    • Add Items + " +} +if { $order_state == "fulfilled" || $order_state == "partially_fulfilled" } { + ns_write "

    • Mark Items Returned" +} + +ns_write "
    + +

    + +

    Details

    + + + + + + +" + +if { ![empty_string_p $creditcard_id] } { + ns_write " + + + \n" +} + +ns_write " + + + + + + + + + + + + + + + + +
    Ship to[ec_display_as_html [ec_pretty_mailing_address_from_ec_addresses $db $shipping_address]]
    +" +if { $order_state == "confirmed" || $order_state == "authorized_plus_avs" || $order_state == "authorized_minus_avs" || $order_state == "partially_fulfilled" } { + ns_write "(modify)" +} +ns_write " +
    Credit card[ec_display_as_html [ec_creditcard_summary $db $creditcard_id] ] +
    + (modify)
    In basket date[util_AnsiDatetoPrettyDate $in_basket_date]
    Confirmed date[util_AnsiDatetoPrettyDate $confirmed_date]
    Authorized date[util_AnsiDatetoPrettyDate $authorized_date]
    Base shipping charged[ec_pretty_price $shipping_charged]
    + +

    Financial Transactions

    +" + +set table_header " + +" + +set selection [ns_db select $db "select t.transaction_id, t.inserted_date, t.transaction_amount, t.transaction_type, t.to_be_captured_p, t.authorized_date, t.marked_date, t.settled_date, t.refunded_date, t.refund_settled_date, t.failed_p, c.creditcard_last_four +from ec_financial_transactions t, ec_creditcards c +where t.creditcard_id=c.creditcard_id +and t.order_id=$order_id +order by transaction_id"] + +set transaction_counter 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $transaction_counter == 0 } { + ns_write $table_header + } + ns_write " + + + + + + + + + + + + + + " + incr transaction_counter +} + +if { $transaction_counter != 0 } { + ns_write "
    IDDateCreditcard Last 4AmountTypeTo Be CapturedAuth DateMark DateSett DateRefund DateRefund Sett DateFailed
    $transaction_id[ec_nbsp_if_null [util_AnsiDatetoPrettyDate $inserted_date]]$creditcard_last_four[ec_pretty_price $transaction_amount][ec_decode $transaction_type "charge" "authorization to charge" "intent to refund"][ec_nbsp_if_null [ec_decode $transaction_type "refund" "Yes" [ec_decode $to_be_captured_p "t" "Yes" "f" "No" ""]]][ec_nbsp_if_null [util_AnsiDatetoPrettyDate $authorized_date]][ec_nbsp_if_null [util_AnsiDatetoPrettyDate $marked_date]][ec_nbsp_if_null [util_AnsiDatetoPrettyDate $settled_date]][ec_nbsp_if_null [util_AnsiDatetoPrettyDate $refunded_date]][ec_nbsp_if_null [util_AnsiDatetoPrettyDate $refund_settled_date]][ec_nbsp_if_null [ec_decode $failed_p "t" "Yes" "f" "No" ""]]
    + " +} else { + ns_write "
    None Found
    " +} + +ns_write " +

    Shipments

    +
    +" + + +set selection [ns_db select $db "select s.shipment_id, s.address_id, s.shipment_date, s.expected_arrival_date, s.carrier, s.tracking_number, s.actual_arrival_date, s.actual_arrival_detail, p.product_name, p.product_id, i.price_name, i.price_charged, count(*) as quantity +from ec_shipments s, ec_items i, ec_products p +where i.shipment_id=s.shipment_id +and i.product_id=p.product_id +and s.order_id=$order_id +group by s.shipment_id, s.address_id, s.shipment_date, s.expected_arrival_date, s.carrier, s.tracking_number, s.actual_arrival_date, s.actual_arrival_detail, p.product_name, p.product_id, i.price_name, i.price_charged +order by s.shipment_id"] + +set old_shipment_id 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $shipment_id != $old_shipment_id } { + if { $old_shipment_id != 0 } { + ns_write " +
    +

    " + } + ns_write " + + + +
    Shipment ID: $shipment_id
    + Date: [util_AnsiDatetoPrettyDate $shipment_date]
    + [ec_decode $expected_arrival_date "" "" "Expected Arrival: [util_AnsiDatetoPrettyDate $expected_arrival_date]
    "] + [ec_decode $carrier "" "" "Carrier: $carrier
    "] + [ec_decode $tracking_number "" "" "Tracking #: $tracking_number
    "] + [ec_decode $actual_arrival_date "" "" "Actual Arrival Date: [util_AnsiDatetoPrettyDate $actual_arrival_date]
    "] + [ec_decode $actual_arrival_detail "" "" "Actual Arrival Detail: $actual_arrival_detail
    "] + (track) +     		[ec_display_as_html [ec_pretty_mailing_address_from_ec_addresses $db_sub $address_id]]
    +

      + " + } + ns_write "
    • Quantity $quantity: $product_name" + set old_shipment_id $shipment_id +} + +if { $old_shipment_id == 0 } { + ns_write "No Shipments Have Been Made" +} else { + ns_write "
    " +} + +ns_write "
    +

    Returns

    +
    +" + +set selection [ns_db select $db "select r.refund_id, r.refund_date, r.refunded_by, r.refund_reasons, r.refund_amount, u.first_names, u.last_name, p.product_name, p.product_id, i.price_name, i.price_charged, count(*) as quantity +from ec_refunds r, users u, ec_items i, ec_products p +where r.order_id=$order_id +and r.refunded_by=u.user_id +and i.refund_id=r.refund_id +and p.product_id=i.product_id +group by r.refund_id, r.refund_date, r.refunded_by, r.refund_reasons, r.refund_amount, u.first_names, u.last_name, p.product_name, p.product_id, i.price_name, i.price_charged"] + +set old_refund_id 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $refund_id != $old_refund_id } { + if { $old_refund_id != 0 } { + ns_write " +
    +

    " + } + ns_write "Refund ID: $refund_id
    + Date: [util_AnsiDatetoPrettyDate $refund_date]
    + Amount: [ec_pretty_price $refund_amount]
    + Refunded by: $first_names $last_name
    + Reason: $refund_reasons +

      + " + } + ns_write "
    • Quantity $quantity: $product_name" + set old_refund_id $refund_id +} + +if { $old_refund_id == 0 } { + ns_write "No Returns Have Been Made" +} else { + ns_write "
    " +} + + +ns_write "
    " + + +if { $order_state != "void" } { + ns_write "

    Actions

    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/orders/refunds.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/refunds.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/refunds.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,122 @@ +# refunds.tcl,v 1.2.4.1 2000/02/03 09:25:17 ron Exp +set_form_variables 0 +# possibly view_refund_date and/or order_by + +if { ![info exists view_refund_date] } { + set view_refund_date "all" +} +if { ![info exists order_by] } { + set order_by "r.refund_id" +} + +ReturnHeaders + +ns_write "[ad_admin_header "Refund History"] + +

    Refund History

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] "Refund History"] + +
    + + + + + + +
    Refund Date
    +" + +set refund_date_list [list [list last_24 "last 24 hrs"] [list last_week "last week"] [list last_month "last month"] [list all all]] + +set linked_refund_date_list [list] + +foreach refund_date $refund_date_list { + if {$view_refund_date == [lindex $refund_date 0]} { + lappend linked_refund_date_list "[lindex $refund_date 1]" + } else { + lappend linked_refund_date_list "[lindex $refund_date 1]" + } +} + +ns_write "\[ [join $linked_refund_date_list " | "] \] + +
    + + +
    +" + +if { $view_refund_date == "last_24" } { + set refund_date_query_bit "and sysdate()-r.refund_date <= timespan_days(1)" +} elseif { $view_refund_date == "last_week" } { + set refund_date_query_bit "and sysdate()-r.refund_date <= timespan_days(7)" +} elseif { $view_refund_date == "last_month" } { + set refund_date_query_bit "and sysdate()-r.refund_date <= '1 month'::reltime" +} else { + set refund_date_query_bit "" +} + + +set link_beginning "refunds.tcl?[export_url_vars view_refund_date]" + +set table_header " + + + + + + + +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select r.refund_id, r.refund_date, r.order_id, r.refund_amount, r.refunded_by, u.first_names, u.last_name, count(*) as n_items +from ec_refunds r, users u, ec_items i +where r.refunded_by=u.user_id +and i.refund_id=r.refund_id +$refund_date_query_bit +group by r.refund_id, r.refund_date, r.order_id, r.refund_amount, r.refunded_by, u.first_names, u.last_name +order by $order_by"] + +set row_counter 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + # Pgsql 6.x group by hack (BMA) + if {$refund_id == ""} { + continue + } + + if { $row_counter == 0 } { + ns_write $table_header + } + # even rows are white, odd are grey + if { [expr floor($row_counter/2.)] == [expr $row_counter/2.] } { + set bgcolor "white" + } else { + set bgcolor "ececec" + } + ns_write " + + + + + + + " + incr row_counter +} + + +if { $row_counter != 0 } { + ns_write "
    Refund IDDate RefundedOrder IDAmount# of ItemsBy
    $refund_id[util_AnsiDatetoPrettyDate $refund_date]$order_id[ec_pretty_price $refund_amount]$n_items$last_name, $first_names
    " +} else { + ns_write "
    None Found
    " +} + +ns_write "
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/orders/revenue.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/revenue.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/revenue.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,181 @@ +# revenue.tcl,v 1.2.4.1 2000/02/03 09:25:18 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Financial Reports"] + +

    Financial Reports

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] "Financial Reports"] + +
    + + + +" + + +set db [ns_db gethandle] + +set selection [ns_db select $db "select date_part('year',inserted_date) as transaction_year, to_char(inserted_date,'Q') as transaction_quarter, sum(case when transaction_type='charge' then transaction_amount else -1*transaction_amount end) as revenue +from ec_fin_transactions_reportable +group by date_part('year',inserted_date), to_char(inserted_date,'Q') +order by date_part('year',inserted_date)::text || to_char(inserted_date,'Q')"] + +set revenue_sum 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + # Pgsql 6.x hack for group by (BMA) + if {$transaction_year == ""} { + continue + } + + set revenue_sum [expr $revenue_sum + $revenue] + ns_write "\n" + if { $transaction_quarter == "4" } { + ns_write "\n" + set revenue_sum 0 + } +} + +ns_write " + + +" + +# This slightly strange-looking query says: +# Give me the total price, shipping, and tax charged for the items in +# each shipment (that's what the view ec_items_money_view gives you). +# Then, if it's the first shipment in an order, add in the base shipping +# cost (and the tax on that shipping cost) for the order, because that's +# the time at which the base shipping is charged (that's what the two +# decodes give you). +# So now we're recognizing revenue at the time that the items are +# shipped, which is what we're supposed to do (read the ecommerce chapter +# of P & A's Guide to Web Publishing). +# Then, group this stuff by year & quarter for display purposes. + +set selection [ns_db select $db "select date_part('year',shipment_date) as shipment_year, +to_char(shipment_date,'Q') as shipment_quarter, +coalesce(sum(bal_price_charged),0) as total_price_charged, +coalesce(sum(bal_shipping_charged + decode(mv.shipment_id,(select min(s2.shipment_id) from ec_shipments s2 where s2.order_id=mv.order_id),(select nvl(o.shipping_charged,0)-nvl(o.shipping_refunded,0) from ec_orders o where o.order_id=mv.order_id),0)),0) as total_shipping_charged, +nvl(sum(bal_tax_charged + decode(mv.shipment_id,(select min(s2.shipment_id) from ec_shipments s2 where s2.order_id=mv.order_id),(select nvl(o.shipping_tax_charged,0)-nvl(o.shipping_tax_refunded,0) from ec_orders o where o.order_id=mv.order_id),0)),0) as total_tax_charged +from ec_items_money_view mv +group by to_char(shipment_date,'YYYY'), to_char(shipment_date,'Q') +order by to_char(shipment_date,'YYYY') || to_char(shipment_date,'Q')"] + +set price_sum 0 +set shipping_sum 0 +set tax_sum 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + set price_sum [expr $price_sum + $total_price_charged] + set shipping_sum [expr $shipping_sum + $total_shipping_charged] + set tax_sum [expr $tax_sum + $total_tax_charged] + ns_write "\n" + if { $transaction_quarter == "4" } { + ns_write "\n" + set price_sum 0 + set shipping_sum 0 + set tax_sum 0 + } +} + +ns_write " + + +" + +set selection [ns_db select $db "select to_char(issue_date,'YYYY') as issue_year, +to_char(issue_date,'Q') as issue_quarter, +nvl(sum(amount),0) as amount +from ec_gift_certificates where gift_certificate_state in ('authorized_plus_avs','authorized_minus_avs') +group by to_char(issue_date,'YYYY'), to_char(issue_date,'Q') +order by to_char(issue_date,'YYYY') || to_char(issue_date,'Q')"] + +set amount_sum 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + set amount_sum [expr $amount_sum + $amount] + ns_write "\n" + if { $issue_quarter == "4" } { + ns_write "\n" + set amount_sum 0 + } +} + +ns_write " + + +" + +set selection [ns_db select $db "select to_char(issue_date,'YYYY') as issue_year, +to_char(issue_date,'Q') as issue_quarter, +nvl(sum(amount),0) as amount +from ec_gift_certificates where gift_certificate_state = 'authorized' +group by to_char(issue_date,'YYYY'), to_char(issue_date,'Q') +order by to_char(issue_date,'YYYY') || to_char(issue_date,'Q')"] + +set amount_sum 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + set amount_sum [expr $amount_sum + $amount] + ns_write "\n" + if { $issue_quarter == "4" } { + ns_write "\n" + set amount_sum 0 + } +} + +ns_write " + + +" + +# Even if a gift certificate is tied to items that have been ordered, it is still +# considered outstanding until it is actually applied to shipped items. + +# The "untied" amount is equal to the remaining amount of each gift certificate. +# The "tied but not officially used" amount is equal to the amount tied to an +# order minus the total cost of the part of the order that has already shipped. +# The "outstanding" amount is the sum of these two. +# The thing that makes this complicated is that gift certificates aren't tied +# to certain parts of an order (the shipped part vs. the unshipped part), so we +# have to take the latest-expiring part to be the "not officially used" part +# (since that's the part that would be reinstated if part of the order were +# unable to be shipped) + +set selection [ns_db select $db "select to_char(expires,'YYYY') as expires_year, +to_char(expires,'Q') as expires_quarter, +nvl(sum(gift_certificate_amount_left(gift_certificate_id)),0) + nvl(sum(ec_gift_cert_unshipped_amount(gift_certificate_id)),0) as amount_outstanding +from ec_gift_certificates_approved +group by to_char(expires,'YYYY'), to_char(expires,'Q') +order by to_char(expires,'YYYY') || to_char(expires,'Q')"] + +set amount_outstanding_sum 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + set amount_outstanding_sum [expr $amount_outstanding_sum + $amount_outstanding] + ns_write "\n" + if { $expires_quarter == "4" } { + ns_write "\n" + set amount_sum 0 + } +} + +ns_write "
    PeriodRevenue 1
    $transaction_year Q$transaction_quarter[ec_pretty_price $revenue]
    total for $transaction_year[ec_pretty_price $revenue_sum]
     
    PeriodProduct Sales 2
    $transaction_year Q$transaction_quarterPrice: [ec_pretty_price $total_price_charged] | Shipping: [ec_pretty_price $total_shipping_charged] | Tax [ec_pretty_price $total_tax_charged]
    total for $transaction_yearPrice: [ec_pretty_price $price_sum] | Shipping [ec_pretty_price $shipping_sum] | Tax [ec_pretty_price $tax_sum]
     
    PeriodGift Certificate Sales 3
    $issue_year Q$issue_quarter[ec_pretty_price $amount]
    total for $issue_year[ec_pretty_price $amount_sum]
     
    PeriodGift Certificates Issued 4
    $issue_year Q$issue_quarter[ec_pretty_price $amount]
    total for $issue_year[ec_pretty_price $amount_sum]
     
    ExpiresGift Certificates Outstanding 5
    $expires_year Q$expires_quarter[ec_pretty_price $amount_outstanding]
    total for $expires_year[ec_pretty_price $amount_outstanding_sum]
    + +

    +
    +1 Revenue: the actual amount of credit card charges minus the amount of credit card refunds. +

    +2 Sales: the price charged, the shipping charged, and the tax charged (minus the amounts refunded) for shipped items (most companies recognize revenue when items are shipped so that they don't risk double counting an account receivable and an item in inventory; see the ecommerce chapter of Philip & Alex's Guide to Web Publishing). Note that this is different from revenue because revenue includes sales of gift certificates. Additionally, some products were paid for using gift certificates. +

    +3 Gift Certificate Sales: the amount of gift certificates purchased (recognized on date of purchase). +

    +4 Gift Certificates Issued: the amount of gift certificates issued to customers free of charge by web site administrators. +

    +5 Gift Certificates Outstanding: gift certificates which have not yet been applied to shipped items (therefore they are +considered a liability). +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/orders/search.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/search.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/search.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,99 @@ +# search.tcl,v 1.2.4.1 2000/02/03 09:25:20 ron Exp +set_the_usual_form_variables +# order_id_query_string, product_name_query_string, or customer_last_name_query_string + +ReturnHeaders + +ns_write "[ad_admin_header "Search Results"] + +

    Search Results

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] "Search Results"] + +
    +
    +" + +set db [ns_db gethandle] + +if { [info exists order_id_query_string] } { + set selection [ns_db select $db "select o.order_id, o.confirmed_date, o.order_state, ec_total_price(o.order_id) as price_to_display, o.user_id, u.first_names, u.last_name, count(*) as n_items +from ec_orders o, users u, ec_items i +where o.order_id like '$order_id_query_string%' +and o.user_id=u.user_id(+) +and o.order_id=i.order_id +group by o.order_id, o.confirmed_date, o.order_state, ec_total_price(o.order_id), o.user_id, u.first_names, u.last_name +order by order_id +"] +} elseif { [info exists product_name_query_string] } { + set selection [ns_db select $db "select o.order_id, o.confirmed_date, o.order_state, ec_total_price(o.order_id) as price_to_display, o.user_id, u.first_names, u.last_name, count(*) as n_items +from ec_orders o, users u, ec_items i, ec_products p +where upper(p.product_name) like '[string toupper [DoubleApos $product_name_query_string]]%' +and i.product_id=p.product_id +and o.user_id=u.user_id(+) +and o.order_id=i.order_id +group by o.order_id, o.confirmed_date, o.order_state, ec_total_price(o.order_id), o.user_id, u.first_names, u.last_name +order by order_id +"] +} elseif { [info exists customer_last_name_query_string] } { + set selection [ns_db select $db "select o.order_id, o.confirmed_date, o.order_state, ec_total_price(o.order_id) as price_to_display, o.user_id, u.first_names, u.last_name, count(*) as n_items +from ec_orders o, users u, ec_items i +where upper(u.last_name) like '[string toupper [DoubleApos $customer_last_name_query_string]]%' +and o.user_id=u.user_id(+) +and o.order_id=i.order_id +group by o.order_id, o.confirmed_date, o.order_state, ec_total_price(o.order_id), o.user_id, u.first_names, u.last_name +order by order_id +"] +} + + + + + + +set link_beginning "by-order-state-and-time.tcl?[export_url_vars view_order_state view_confirmed]" + +set table_header " + + + + + + + +" + +set row_counter 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $row_counter == 0 } { + ns_write $table_header + } + # even rows are white, odd are grey + if { [expr floor($row_counter/2.)] == [expr $row_counter/2.] } { + set bgcolor "white" + } else { + set bgcolor "ececec" + } + ns_write " + + + + + + + " + incr row_counter +} + + +if { $row_counter != 0 } { + ns_write "
    Order IDDate ConfirmedOrder StateCustomerAmount# of Items
    $order_id[ec_nbsp_if_null [util_AnsiDatetoPrettyDate $confirmed_date]]$order_state[ec_decode $last_name "" " " "$last_name, $first_names"][ec_nbsp_if_null [ec_pretty_price $price_to_display]]$n_items
    " +} else { + ns_write "
    None Found
    " +} + +ns_write "
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/orders/shipments.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/shipments.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/shipments.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,156 @@ +# shipments.tcl,v 1.3.4.1 2000/02/03 09:25:21 ron Exp +set_form_variables 0 +# possibly view_carrier and/or view_shipment_date and/or order_by + +if { ![info exists view_carrier] } { + set view_carrier "all" +} +if { ![info exists view_shipment_date] } { + set view_shipment_date "all" +} +if { ![info exists order_by] } { + set order_by "s.shipment_id" +} + +ReturnHeaders + +ns_write "[ad_admin_header "Shipment History"] + +

    Shipment History

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] "Shipment History"] + +
    + + + + + + + + +
    CarrierShipment Date
    +" + +set db [ns_db gethandle] + +set carrier_list [database_to_tcl_list $db "select distinct carrier from ec_shipments where carrier is not null order by carrier"] +set carrier_list [concat "all" $carrier_list] + +set linked_carrier_list [list] + +foreach carrier $carrier_list { + if {$view_carrier == $carrier} { + lappend linked_carrier_list "$carrier" + } else { + lappend linked_carrier_list "$carrier" + } +} + +ns_write "\[ [join $linked_carrier_list " | "] \] + +" + +set shipment_date_list [list [list last_24 "last 24 hrs"] [list last_week "last week"] [list last_month "last month"] [list all all]] + +set linked_shipment_date_list [list] + +foreach shipment_date $shipment_date_list { + if {$view_shipment_date == [lindex $shipment_date 0]} { + lappend linked_shipment_date_list "[lindex $shipment_date 1]" + } else { + lappend linked_shipment_date_list "[lindex $shipment_date 1]" + } +} + +ns_write "\[ [join $linked_shipment_date_list " | "] \] + +
    + + +
    +" + +if { $view_carrier == "all" } { + set carrier_query_bit "" +} else { + set carrier_query_bit "s.carrier='[DoubleApos $view_carrier]'" +} + +if { $view_shipment_date == "last_24" } { + set shipment_date_query_bit "sysdate()-s.shipment_date <= timespan_days(1)" +} elseif { $view_shipment_date == "last_week" } { + set shipment_date_query_bit "sysdate()-s.shipment_date <= timespan_days(7)" +} elseif { $view_shipment_date == "last_month" } { + set shipment_date_query_bit "sysdate()-s.shipment_date <= '1 month'::reltime" +} else { + set shipment_date_query_bit "" +} + +if { [empty_string_p $carrier_query_bit] && [empty_string_p $shipment_date_query_bit] } { + set where_clause "" +} elseif { [empty_string_p $carrier_query_bit] } { + set where_clause "where $shipment_date_query_bit" +} elseif { [empty_string_p $shipment_date_query_bit] } { + set where_clause "where $carrier_query_bit" +} else { + set where_clause "where $shipment_date_query_bit and $carrier_query_bit" +} + +set link_beginning "shipments.tcl?[export_url_vars view_carrier view_shipment_date]" + +set table_header " + + + + + + + +" + + +# set selection [ns_db select $db "select s.shipment_id, s.shipment_date, s.order_id, s.carrier, decode((select count(*) from ec_items where order_id=s.order_id),(select count(*) from ec_items where shipment_id=s.shipment_id),'Full','Partial') as full_or_partial, (select count(*) from ec_items where shipment_id=s.shipment_id) as n_items +# from ec_shipments s +# $where_clause +# order by $order_by"] + +set selection [ns_db select $db "select s.shipment_id, s.shipment_date, s.order_id, s.carrier, ec_shipment_status(s.order_id, s.shipment_id) as full_or_partial, ec_shipment_n_items(s.shipment_id) as n_items +from ec_shipments s +$where_clause +order by $order_by"] + +set row_counter 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $row_counter == 0 } { + ns_write $table_header + } + # even rows are white, odd are grey + if { [expr floor($row_counter/2.)] == [expr $row_counter/2.] } { + set bgcolor "white" + } else { + set bgcolor "ececec" + } + ns_write " + + + + + + + " + incr row_counter +} + + +if { $row_counter != 0 } { + ns_write "
    Shipment IDDate ShippedOrder IDCarrier# of ItemsFull / Partial
    $shipment_id[ec_nbsp_if_null [util_AnsiDatetoPrettyDate $shipment_date]]$order_id[ec_nbsp_if_null $carrier]$n_items$full_or_partial
    " +} else { + ns_write "
    None Found
    " +} + +ns_write "
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/orders/track.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/track.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/track.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,67 @@ +# track.tcl,v 1.2.4.1 2000/02/03 09:25:23 ron Exp +set_the_usual_form_variables +# shipment_id + +ReturnHeaders +ns_write "[ad_admin_header "Track Shipment"] + +

    Track Shipment

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] [list "one.tcl?[export_url_vars order_id]" "One Order"] "Track Shipment"] + +
    +" + +set db [ns_db gethandle] +set selection [ns_db 1row $db "select to_char(shipment_date, 'MMDDYY') as ship_date_for_fedex, to_char(shipment_date, 'MM/DD/YYYY') as pretty_ship_date, carrier, tracking_number +from ec_shipments +where shipment_id = $shipment_id"] + +set_variables_after_query + +set carrier_info "" + +if { $carrier == "FedEx" } { + set fedex_url "http://www.fedex.com/cgi-bin/track_it?airbill_list=$tracking_number&kurrent_airbill=$tracking_number&language=english&cntry_code=us&state=0" + with_catch errmsg { + set page_from_fedex [ns_httpget $fedex_url] + regexp {(.*)} $page_from_fedex match carrier_info + } { + set carrier_info "Unable to retrieve data from FedEx." + } +} elseif { [string match "UPS*" $carrier] } { + set ups_url "http://wwwapps.ups.com/etracking/tracking.cgi?submit=Track&InquiryNumber1=$tracking_number&TypeOfInquiryNumber=T" + with_catch errmsg { + set first_ups_page [ns_httpget $ups_url] + # UPS needs this magic line1 to get to the more interesting detail page. + if { ![regexp {NAME="line1" VALUE="([^\"]+)"} $first_ups_page match line1] } { + set carrier_info "Unable to parse summary information from UPS." + } else { + set url "http://wwwapps.ups.com/etracking/tracking.cgi" + set formvars "InquiryNumber1=$tracking_number&TypeOfInquiryNumber=T&line1=[ns_urlencode $line1]&tdts1=1" + set second_ups_page [util_httppost $url $formvars] + if { ![regexp {(]*>Tracking Number:.*).*Tracking results provided by UPS} $second_ups_page match ups_info] } { + set carrier_info "Unable to parse detail data from UPS." + } else { + set carrier_info "$ups_info" + } + } + } { + set carrier_info "Unable to retrieve data from UPS. + } +} + +ns_write "
      +
    • Shipping Date: $pretty_ship_date +
    • Carrier: $carrier +
    • Tracking Number: $tracking_number +
    + +

    Information from [ec_decode $carrier "" "Carrier" $carrier]

    + +
    +[ec_decode $carrier_info "" "None Available" $carrier_info] +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/orders/void-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/void-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/void-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,27 @@ +# void-2.tcl,v 1.1.4.1 2000/02/03 09:25:24 ron Exp +set_the_usual_form_variables +# order_id, reason_for_void + +# we need them to be logged in +set customer_service_rep [ad_verify_and_get_user_id] + +if {$customer_service_rep == 0} { + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +ns_db dml $db "begin transaction" + +ns_db dml $db "update ec_orders set order_state='void',reason_for_void='$QQreason_for_void',voided_by=$customer_service_rep, voided_date=sysdate() where order_id=$order_id" + +ns_db dml $db "update ec_items set item_state='void', voided_by=$customer_service_rep where order_id=$order_id" + +# reinstate gift certificates +ns_db select $db "select ec_reinst_gift_cert_on_order($order_id)" + +ns_db dml $db "end transaction" + +ns_returnredirect "one.tcl?[export_url_vars order_id]" Index: web/openacs/www/admin/ecommerce/orders/void.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/orders/void.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/orders/void.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,65 @@ +# void.tcl,v 1.2.4.1 2000/02/03 09:25:25 ron Exp +set_the_usual_form_variables +# order_id + +# we need them to be logged in +set customer_service_rep [ad_verify_and_get_user_id] + +if {$customer_service_rep == 0} { + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +ReturnHeaders +ns_write "[ad_admin_header "Void Order"] + +

    Void Order

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Orders"] [list "one.tcl?order_id=$order_id" "One Order"] "Void"] + +
    +" + +set n_shipped_items [database_to_tcl_string $db "select count(*) from ec_items where order_id=$order_id and item_state in ('shipped', 'arrived', 'received_back')"] + +if { $n_shipped_items > 0 } { + ns_write "Warning: our records show that at least one item in this + order has already shipped, which means that the customer has already been charged + (for shipped items only). Voiding an order will not cause + the customer's credit card to be refunded (you can only do that by marking + individual items \"received back\"). +

    + Voiding is usually done if the customer cancels their order before it ships. +

    + " +} + +ns_write "Note: this will cause all individual items in this order +to be marked 'void'. +

    " + +ns_write " +
    +[export_form_vars order_id] + +Please explain why you are voiding this order: + +
    + +

    + +
    + +

    +

    + +
    + + + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/problems/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/problems/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/problems/index.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,81 @@ +# index.tcl,v 3.0 2000/02/06 03:19:38 ron Exp +# +# jkoontz@arsdigita.com July 21, 1999 +# modified by eveander@arsdigita.com July 23, 1999 +# +# This page dislpays the problems in the problem log, if display_all is +# not set then only unresolved problems are displayed + +set_form_variables 0 +# possibly display_all + +ReturnHeaders + +ns_write "[ad_admin_header "Potental Problems"] + +

    Potential Problems

    + +[ad_admin_context_bar [list "/admin/ecommerce/" Ecommerce] "Potential Problems"] + +
    +" + +set db [ns_db gethandle] +set problem_count [database_to_tcl_string $db "select count(*) from ec_problems_log"] +set unresolved_problem_count [database_to_tcl_string $db "select count(*) from ec_problems_log where resolved_date is null"] + +if { ![info exists display_all] } { + set sql_clause "and resolved_date is null" + ns_write " + Unresolved Problems($unresolved_problem_count) | All Problems($problem_count) +

    + " +} else { + set sql_clause "" + ns_write " + Unresolved Problems ($unresolved_problem_count) | All Problems ($problem_count) +

    + " +} + + +ns_write " +

      +" + +set selection [ns_db select $db "select + l.*, + user_full_name(l.resolved_by) as user_name +from ec_problems_log l +where problem_id=problem_id $sql_clause +order by problem_date asc"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + ns_write " +

      +

    • [util_AnsiDatetoPrettyDate $problem_date] (" + + if { ![empty_string_p $order_id] } { + ns_write "order #$order_id | " + } + + if { [empty_string_p $resolved_date] } { + ns_write "mark resolved" + } else { + ns_write "resolved by [ec_admin_present_user $resolved_by $user_name] on [util_AnsiDatetoPrettyDate $resolved_date]" + } + + ns_write ") +

      + $problem_details +

      + " +} + +ns_write " +

    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/problems/resolve-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/problems/resolve-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/problems/resolve-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,25 @@ +# resolve-2.tcl,v 3.0 2000/02/06 03:19:40 ron Exp +# +# jkoontz@arsdigita.com July 21, 1999 +# +# This page confirms that a problems in the problem log is resolved + +set_form_variables +# problem_id + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +ns_db dml $db "update ec_problems_log set resolved_by=$user_id, resolved_date=sysdate where problem_id = $problem_id" + +ns_returnredirect index.tcl \ No newline at end of file Index: web/openacs/www/admin/ecommerce/problems/resolve.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/problems/resolve.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/problems/resolve.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,42 @@ +# resolve.tcl,v 3.0 2000/02/06 03:19:41 ron Exp +# +# jkoontz@arsdigita.com July 21, 1999 +# modified by eveander@arsdigita.com July 23, 1999 +# +# This page confirms that a problems in the problem log is resolved + +set_form_variables +# problem_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select * from ec_problems_log where problem_id = $problem_id"] +set_variables_after_query + +ns_return 200 text/html "[ad_admin_header "Confirm the Problem is Resolved"] + +

    Confirm that Problem is Resolved

    + +[ad_admin_context_bar [list "/admin/ecommerce/" Ecommerce] [list "index.tcl" "Potential Problems"] "Confirm Resolve Problem"] + +
    + + +[export_form_vars problem_id] +
    + +

    +

    +[util_AnsiDatetoPrettyDate $problem_date] +

    +$problem_details +

    +
    + +
    + +
    + + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/add-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,214 @@ +# add-2.tcl,v 3.1 2000/03/07 04:11:01 eveander Exp +ad_page_variables { + product_name + sku + one_line_description + detailed_description + color_list + size_list + style_list + email_on_purchase_list + search_keywords + url + price + no_shipping_avail_p + present_p + available_date + shipping + shipping_additional + weight + stock_status +} + +set_the_usual_form_variables +# product_name, sku, one_line_description, detailed_description, color_list, +# size_list, style_list, search_keywords, url, price, +# present_p, available_date, shipping, shipping_additional, weight, stock_status +# and all active custom fields (except ones that are boolean and weren't filled in) +# and price$user_class_id for all the user classes +# - categorization is a select multiple, so that will be dealt with separately +# - the dates are special (as usual) so they'll have to be "put together" + +# first do error checking +# product_name is mandatory +set exception_count 0 +set exception_text "" +if { ![info exists product_name] || [empty_string_p $product_name] } { + incr exception_count + append exception_text "
  • You forgot to enter the name of the product.\n" +} +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +# categorization is a select multiple, so deal with that separately +set form [ns_getform] +set form_size [ns_set size $form] +set form_counter 0 + +set categorization_list [list] +while { $form_counter < $form_size} { + if { [ns_set key $form $form_counter] == "categorization" } { + lappend categorization_list [ns_set value $form $form_counter] + } + incr form_counter +} + +# break categorization into category_id_list, subcategory_id_list, subsubcategory_id_list +set category_id_list [list] +set subcategory_id_list [list] +set subsubcategory_id_list [list] +foreach categorization $categorization_list { + if ![catch {set category_id [lindex $categorization 0] } ] { + if { [lsearch -exact $category_id_list $category_id] == -1 && ![empty_string_p $category_id]} { + lappend category_id_list $category_id + } + } + if ![catch {set subcategory_id [lindex $categorization 1] } ] { + if {[lsearch -exact $subcategory_id_list $subcategory_id] == -1 && ![empty_string_p $subcategory_id]} { + lappend subcategory_id_list $subcategory_id + } + } + if ![catch {set subsubcategory_id [lindex $categorization 2] } ] { + if {[lsearch -exact $subsubcategory_id_list $subsubcategory_id] == -1 && ![empty_string_p $subsubcategory_id] } { + lappend subsubcategory_id_list $subsubcategory_id + } + } +} + +# Now deal with dates. +# The column available_date is known to be a date. +# Also, some of the custom fields may be dates. + +set date_fields [list "available_date"] + +set db [ns_db gethandle] +set additional_date_fields [database_to_tcl_list $db "select field_identifier from ec_custom_product_fields where column_type='date' and active_p='t'"] + +set all_date_fields [concat $date_fields $additional_date_fields] + +foreach date_field $all_date_fields { + if [catch { ns_dbformvalue $form $date_field date $date_field} errmsg ] { + set $date_field "" + } +} + +# one last manipulation of data is needed: get rid of "http://" if that's all that's +# there for the url (since that was the default value) +if { [string compare $url "http://"] == 0 } { + set url "" +} + +# We now have all values in the correct form + +# Things to generate: + +# 1. generate a product_id +set product_id [database_to_tcl_string $db "select ec_product_id_sequence.nextval from dual"] + +# 2. generate a directory name (and create the directory) to store pictures +# and other supporting product info + +# let's have dirname be the first four letters (lowercase) of the product_name +# followed by the product_id (for uniqueness) +regsub -all {[^a-zA-Z]} $product_name "" letters_in_product_name +set letters_in_product_name [string tolower $letters_in_product_name] +if [catch {set dirname "[string range $letters_in_product_name 0 3]$product_id"}] { + #maybe there aren't 4 letters in the product name + set dirname "$letters_in_product_name$product_id" +} + +# Get the directory where dirname is stored +set subdirectory "[ad_parameter EcommerceDataDirectory ecommerce][ad_parameter ProductDataDirectory ecommerce][ec_product_file_directory $product_id]" +ec_assert_directory $subdirectory + +set full_dirname "$subdirectory/$dirname" +ec_assert_directory $full_dirname + +# if an image file has been specified, upload it into the +# directory that was just created and make a thumbnail (using +# dimensions specified in parameters/whatever.ini) + +if { [info exists upload_file] && ![string compare $upload_file ""] == 0 } { + + # this takes the upload_file and sticks its contents into a temporary + # file (will be deleted when the thread ends) + set tmp_filename [ns_queryget upload_file.tmpfile] + + + # so that we'll know if it's a gif or a jpg + set file_extension [file extension $upload_file] + + # copies this temp file into a permanent file + set perm_filename "$full_dirname/product$file_extension" + ns_cp $tmp_filename $perm_filename + + # create thumbnails + # thumbnails are all jpg files + + # set thumbnail dimensions + if [catch {set thumbnail_width [ad_parameter ThumbnailWidth ecommerce]} ] { + if [catch {set thumbnail_height [ad_parameter ThumbnailHeight ecommerce]} ] { + set convert_dimensions "100x10000" + } else { + set convert_dimensions "10000x$thumbnail_height" + } + } else { + set convert_dimensions "${thumbnail_width}x10000" + } + + set perm_thumbnail_filename "$full_dirname/product-thumbnail.jpg" + + exec /usr/local/bin/convert -geometry $convert_dimensions $perm_filename $perm_thumbnail_filename +} + +set linked_thumbnail [ec_linked_thumbnail_if_it_exists $dirname] + +# Need to let them select template based on category + +ReturnHeaders +ns_write "[ad_admin_header "Add a Product, Continued"] + +

    Add a Product, Continued

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] "Add Product"] + +
    +
    +[export_form_vars product_name sku category_id_list subcategory_id_list subsubcategory_id_list one_line_description detailed_description color_list size_list style_list search_keywords url price present_p available_date shipping shipping_additional weight linked_thumbnail product_id dirname stock_status] +" + +# also need to export custom field values +set additional_variables_to_export [database_to_tcl_list $db "select field_identifier from ec_custom_product_fields where active_p='t'"] + +foreach user_class_id [database_to_tcl_list $db "select user_class_id from ec_user_classes"] { + lappend additional_variables_to_export "price$user_class_id" +} + +eval "ns_write \"\[export_form_vars $additional_variables_to_export\]\n\"" + + +# create the template drop-down list + +ns_write " + +

    Select a template to use when displaying this product.

    + +

    + +If none is +selected, the product will be displayed with the system default template.
    +

    +[ec_template_widget $db $category_id_list] +
    +

    + + +

    + +
    + + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/products/add-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/add-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/add-3.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,261 @@ +# add-3.tcl,v 3.1 2000/03/07 04:11:14 eveander Exp +set_the_usual_form_variables +# product_name, sku, one_line_description, color_list, size_list, style_list, +# detailed_description, search_keywords, url, price, +# present_p, available_date, shipping, shipping_additional, weight, +# product_id, linked_thumbnail, dirname, stock_status, template_id +# and all active custom fields (except ones that are boolean and weren't filled in) +# and price$user_class_id for all the user classes +# category_id_list, subcategory_id_list, subsubcategory_id_list + +set form [ns_getform] +set form_size [ns_set size $form] +set form_counter 0 + + +ReturnHeaders +ns_write "[ad_admin_header "Confirm New Product"] + +

    Confirm New Product

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] "Add Product"] + +
    +

    Please confirm that the information below is correct:

    +" + +set currency [ad_parameter Currency ecommerce] +set multiple_retailers_p [ad_parameter MultipleRetailersPerProductP ecommerce] + +set db [ns_db gethandle] + +ns_write "
    +
    + +
    +
    +$linked_thumbnail +
    • + + + + + + + + + + + + +" +if { !$multiple_retailers_p } { + ns_write " + + + + " +} +ns_write " + + + + + + + + + + + + + + + + + + + + + + + + + + + +" +if { !$multiple_retailers_p } { + ns_write " + + + + " +} +ns_write " + + + +" +if { !$multiple_retailers_p } { + ns_write " + + + + + + + + " +} +ns_write " + + + +" +if { !$multiple_retailers_p } { + set selection [ns_db select $db "select user_class_id, user_class_name from ec_user_classes order by user_class_name"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { [info exists price$user_class_id] } { + ns_write " + + + + + " + } + } +} + +set selection [ns_db select $db "select field_identifier, field_name, column_type from ec_custom_product_fields where active_p = 't'"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { [info exists $field_identifier] } { + ns_write " + + + + + " + } +} + +ns_write " + + + +
    +Product Name: + +$product_name +
    +SKU: + +$sku +
    +Categorization: + +[ec_category_subcategory_and_subsubcategory_display $db $category_id_list $subcategory_id_list $subsubcategory_id_list] +
    + Stock Status: + + " + if { ![empty_string_p $stock_status] } { + ns_write [ad_parameter "StockMessage[string toupper $stock_status]" ecommerce] + } else { + ns_write [ec_message_if_null $stock_status] + } + + ns_write "
    +One-Line Description: + +[ec_message_if_null $one_line_description] +
    +Additional Descriptive Text: + +[ec_display_as_html [ec_message_if_null $detailed_description]] +
    +Search Keywords: + +[ec_message_if_null $search_keywords] +
    +Color Choices: + +[ec_message_if_null $color_list] +
    +Size Choices: + +[ec_message_if_null $size_list] +
    +Style Choices: + +[ec_message_if_null $style_list] +
    +URL: + +[ec_message_if_null $url] +
    + Regular Price: + + [ec_message_if_null [ec_pretty_price $price $currency]] +
    +Display this product when user does a search? + +[ec_message_if_null [ec_PrettyBoolean $present_p]] +
    + Shipping Price + + [ec_message_if_null [ec_pretty_price $shipping $currency]] +
    + Shipping - Additional + + [ec_message_if_null [ec_pretty_price $shipping_additional $currency]] +
    +Weight + +[ec_message_if_null $weight] [ec_decode $weight "" "" [ad_parameter WeightUnits ecommerce]] +
    + $user_class_name Price: + + [ec_message_if_null [ec_pretty_price [set price$user_class_id] $currency]] +
    + $field_name + + " + if { $column_type == "char(1)" } { + ns_write "[ec_message_if_null [ec_PrettyBoolean [set $field_identifier]]]\n" + } elseif { $column_type == "date" } { + ns_write "[ec_message_if_null [util_AnsiDatetoPrettyDate [set $field_identifier]]]\n" + } else { + ns_write "[ec_display_as_html [ec_message_if_null [set $field_identifier]]]\n" + } + ns_write "
    +Template + +[ec_message_if_null [database_to_tcl_string_or_null $db "select template_name from ec_templates where template_id='$template_id'"]] +
    + +

    +[export_form_vars product_name sku category_id_list subcategory_id_list subsubcategory_id_list one_line_description detailed_description color_list size_list style_list search_keywords url price present_p available_date shipping shipping_additional weight template_id product_id dirname stock_status] +" + +# also need to export custom field values +set additional_variables_to_export [database_to_tcl_list $db "select field_identifier from ec_custom_product_fields where active_p='t'"] + +eval "ns_write \"\[export_form_vars $additional_variables_to_export\]\n\"" + +# and export each price$user_class_id +foreach user_class_id [database_to_tcl_list $db "select user_class_id from ec_user_classes"] { + ns_write "[export_form_vars "price$user_class_id"]\n" +} + +ns_write "

    + +
    + + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/products/add-4.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/add-4.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/add-4.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,98 @@ +# add-4.tcl,v 3.1 2000/03/07 04:11:19 eveander Exp +set_the_usual_form_variables + +# product_id, product_name, sku, category_id_list, subcategory_id_list, subsubcategory_id_list, one_line_description, detailed_description, color_list, size_list, style_list, search_keywords, url, price, present_p, available_date, shipping, shipping_additional, weight, template_id, dirname, stock_status +# the custom product fields may or may not exist +# and price$user_class_id for all the user classes may or may not exist +# (because someone may have added a user class while this product was +# being added) + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +# make sure this product isn't already in the database (implying they pushed reload) +if { [database_to_tcl_string $db "select count(*) from ec_products where product_id=$product_id"] > 0 } { + ns_returnredirect "one.tcl?[export_url_vars product_id]" + return +} + +set user_class_id_list [database_to_tcl_list $db "select user_class_id from ec_user_classes"] + +ns_db dml $db "begin transaction" + +# we have to insert things into 6 tables: ec_products, ec_custom_product_field_values, +# ec_category_product_map, ec_subcategory_product_map, ec_subsubcategory_product_map, +# ec_product_user_class_prices + +# we have to generate audit information +set audit_fields "last_modified, last_modifying_user, modified_ip_address" +set audit_info "sysdate(), '$user_id', '[DoubleApos [ns_conn peeraddr]]'" + +ns_db dml $db "insert into ec_products +(product_id, product_name, sku, one_line_description, detailed_description, color_list, size_list, style_list, search_keywords, url, price, present_p, available_date, shipping, shipping_additional, weight, template_id, dirname, active_p, stock_status, $audit_fields) +values +($product_id, '$QQproduct_name', '$QQsku', '$QQone_line_description', '$QQdetailed_description', '$QQcolor_list', '$QQsize_list', '$QQstyle_list', '$QQsearch_keywords', '$QQurl', [db_postgres_null_sql $price], '$present_p', '$available_date', [db_postgres_null_sql $shipping], [db_postgres_null_sql $shipping_additional], [db_postgres_null_sql $weight], [db_postgres_null_sql $template_id], '$dirname', 't', '$QQstock_status', $audit_info) +" + +# things to insert into ec_custom_product_field_values if they exist +set custom_columns [database_to_tcl_list $db "select field_identifier from ec_custom_product_fields where active_p='t'"] +set custom_columns_to_insert [list product_id] +set custom_column_values_to_insert [list $product_id] +foreach custom_column $custom_columns { + if {[info exists $custom_column] } { + lappend custom_columns_to_insert $custom_column + lappend custom_column_values_to_insert "'[set QQ$custom_column]'" + } +} + +ns_db dml $db "insert into ec_custom_product_field_values +([join $custom_columns_to_insert ", "], $audit_fields) +values +([join $custom_column_values_to_insert ","], $audit_info) +" + +# Take care of categories and subcategories and subsubcategories +foreach category_id $category_id_list { + ns_db dml $db " + insert into ec_category_product_map ( + product_id, category_id, $audit_fields) values ( + $product_id, $category_id, $audit_info)" +} + +foreach subcategory_id $subcategory_id_list { + ns_db dml $db " + insert into ec_subcategory_product_map ( + product_id, subcategory_id, $audit_fields) values ( + $product_id, $subcategory_id, $audit_info)" +} + +foreach subsubcategory_id $subsubcategory_id_list { + ns_db dml $db " + insert into ec_subsubcategory_product_map ( + product_id, subsubcategory_id, $audit_fields) values ( + $product_id, $subsubcategory_id, $audit_info)" +} + +# Take care of special prices for user classes +foreach user_class_id $user_class_id_list { + if { [info exists price$user_class_id] } { + ns_db dml $db " + insert into ec_product_user_class_prices ( + product_id, user_class_id, price, $audit_fields) values ( + $product_id, $user_class_id, [db_null_sql [set price$user_class_id]], $audit_info)" + } +} + +ns_db dml $db "end transaction" + +ns_returnredirect "one.tcl?[export_url_vars product_id]" Index: web/openacs/www/admin/ecommerce/products/add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/add.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,194 @@ +# add.tcl,v 3.1 2000/03/07 04:11:27 eveander Exp +ReturnHeaders + +ns_write "[ad_admin_header "Add a Product"] + +

    Add a Product

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] "Add Product"] + +
    + +All fields are optional except Product Name. +

    +" +set multiple_retailers_p [ad_parameter MultipleRetailersPerProductP ecommerce] + +set db [ns_db gethandle] + +ns_write "

    + + + + + + + + + + + + + + + +" +if { !$multiple_retailers_p } { + ns_write " + + + + " +} else { + ns_write "[philg_hidden_input stock_status ""]\n" +} +ns_write " + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +" +if { !$multiple_retailers_p } { + ns_write " + + + + " +} else { + ns_write "[philg_hidden_input price ""]\n" +} +ns_write " + + + + + + + + +" +if { !$multiple_retailers_p } { + ns_write " + + + + + + + + + " +} else { + ns_write "[philg_hidden_input shipping ""]\n[philg_hidden_input shipping_additional ""]\n" +} +ns_write " + + + +
    Product Name
    SKUIt's not necessary to include a SKU because the system generates its own +internal product_id to uniquely distinguish products.
    Product Category[ec_category_widget $db t]Choose as many categories as you like. The product will +be displayed on the web site in each of the categories you select.
    Stock Status[ec_stock_status_widget]
    One-Line Description
    Additional Descriptive Text
    Search Keywords
    PictureThis picture (.gif or .jpg format) can be as large as you like. A thumbnail will be automatically generated. Note that file uploading doesn't work with Internet Explorer 3.0.
    Color ChoicesThis should be a comma-separated list of colors the user is allowed to choose from +when ordering. If there are no choices, leave this blank.
    Size ChoicesThis should be a comma-separated list of sizes the user is allowed to choose from +when ordering. If there are no choices, leave this blank.
    Style ChoicesThis should be a comma-separated list of styles the user is allowed to choose from +when ordering. If there are no choices, leave this blank.
    URL where the consumer can get more info on the product
    Regular PriceAll prices are in [ad_parameter Currency ecommerce]. The price should + be written as a decimal number (no special characters like \$). +
    Should this product be displayed when the user does a search?Yes +   +No +You might choose \"No\" if this product is part of a series.
    When does this product become available for purchase?[ad_dateentrywidget available_date]
    Shipping PriceThe \"Shipping Price\", \"Shipping Price - Additional\", and \"Weight\" fields + may or may not be applicable, depending on the + shipping rules you have set up for + your ecommerce system.
    Shipping Price - Additional per item if ordering more than 1 (leave blank if same as Shipping Price above)
    Weight ([ad_parameter WeightUnits ecommerce])
    + +

    +" + +set n_user_classes [database_to_tcl_string $db "select count(*) from ec_user_classes"] +if { $n_user_classes > 0 && !$multiple_retailers_p} { + ns_write "

    Special Prices for User Classes

    + +

    + + + " + + set selection [ns_db select $db "select user_class_id, user_class_name from ec_user_classes order by user_class_name"] + + set first_class_p 1 + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write " + + " + + if { $first_class_p } { + set first_class_p 0 + ns_write "\n" + } + ns_write "\n" + } + ns_write "
    $user_class_nameEnter prices (no + special characters like \$) only if you want people in + user classes to be charged a different price than the + regular price. If you leave user class prices blank, + then the users will be charged regular price.
    \n" +} + + +if { [database_to_tcl_string $db "select count(*) from ec_custom_product_fields where active_p='t'"] > 0 } { + + ns_write "

    Custom Fields

    + +

    + + + " + + set selection [ns_db select $db "select field_identifier, field_name, default_value, column_type from ec_custom_product_fields where active_p='t' order by creation_date"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "\n" + } + + ns_write "
    $field_name[ec_custom_product_field_form_element $field_identifier $column_type $default_value]
    \n" +} + +ns_write "

    + +
    +
    +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/products/by-category.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/by-category.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/by-category.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,56 @@ +# by-category.tcl,v 3.0 2000/02/06 03:19:46 ron Exp +# by-category.tcl +# +# by philg@mit.edu on July 18, 1999 +# +# list the product categories and summary data for each (how many +# products, how many sales) + +ReturnHeaders + +ns_write "[ad_admin_header "Products by Category"] + +

    Products by category

    + +[ad_admin_context_bar [list "/admin/ecommerce/" "Ecommerce"] [list "index.tcl" "Products"] "by Category"] + +
    + +
      +" + +set db [ns_db gethandle] +set selection [ns_db select $db " +select cats.category_id, cats.sort_key, cats.category_name, ec_category_product_count(cats.category_id) as n_products, sum(ec_items_reportable_count(map.product_id)) as total_sold_in_category +from + ec_categories cats, ec_category_product_map map +where cats.category_id = map.category_id +group by cats.category_id, cats.sort_key, cats.category_name +order by cats.sort_key"] + +set items "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append items "
    • $category_name +  +($n_products products; $total_sold_in_category sales)\n" +} + +if ![empty_string_p $items] { + ns_write $items +} else { + ns_write "apparently products aren't being put into categories" +} + +ns_write " + +
    + + +[ad_admin_footer] +" + + + + Index: web/openacs/www/admin/ecommerce/products/categories-upload-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/categories-upload-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/categories-upload-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,99 @@ +# categories-upload-2.tcl,v 3.0 2000/02/06 03:19:47 ron Exp +ad_page_variables { + {csv_file ""} +} + +# maybe csv_file + +if { [empty_string_p $csv_file] } { + ad_return_error "Missing CSV File" "You must input the name of the .csv file on your local hard drive." + return +} + +set user_id [ad_get_user_id] +set ip [ns_conn peeraddr] + +ReturnHeaders + +ns_write "[ad_admin_header "Uploading Category Mappings"] + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] "Uploading Categories"] + +
    + +

    Uploading Category Mappings

    + +
    +" + +set csv_file_name [ns_queryget csv_file.tmpfile] + +set db [ns_db gethandle] +set db_sub [ns_db gethandle subquery] + +set csvfp [open $csv_file_name] + +set count 0 +set success_count 0 +while { [ns_getcsv $csvfp elements] != -1 } { + incr count + # this line is a product + set product_id [lindex $elements 0] + set category [DoubleApos [lindex $elements 1]] + + # see if this matches any subcategories + set sql "select c.category_id, c.category_name, s.subcategory_id, s.subcategory_name from ec_subcategories s, ec_categories c where c.category_id = s.category_id and upper('$category') like upper(subcategory_name) || '%'" + set selection [ns_db select $db $sql] + set submatch_p 0 + while { [ns_db getrow $db $selection] } { + set submatch_p 1 + set_variables_after_query + # add this product to the matched subcategory + set sql "insert into ec_subcategory_product_map (product_id, subcategory_id, publisher_favorite_p, last_modified, last_modifying_user, modified_ip_address) values ($product_id, $subcategory_id, 'f', sysdate(), $user_id, '$ip')" + if { [catch {ns_db dml $db_sub $sql} errmsg] } { + #error, probably already loaded this one + } else { + ns_write "Matched $category to subcategory $subcategory_name in category $category_name
    \n" + } + # now add it to the category that owns this subcategory + set sql "insert into ec_category_product_map (product_id, category_id, publisher_favorite_p, last_modified, last_modifying_user, modified_ip_address) values ($product_id, $category_id, 'f', sysdate(), $user_id, '$ip')" + if { [catch {ns_db dml $db_sub $sql} errmsg] } { + #error, probably already loaded this one + } + } + + # see if this matches any categories + set sql "select category_id, category_name from ec_categories where upper('$category') like upper(category_name) || '%'" + set selection [ns_db select $db $sql] + set match_p 0 + while { [ns_db getrow $db $selection] } { + set match_p 1 + set_variables_after_query + set sql "insert into ec_category_product_map (product_id, category_id, publisher_favorite_p, last_modified, last_modifying_user, modified_ip_address) values ($product_id, $category_id, 'f', sysdate(), $user_id, '$ip')" + if { [catch {ns_db dml $db_sub $sql} errmsg] } { + #error, probably already loaded this one + } else { + ns_write "Matched $category to category $category_name
    \n" + } + } + if { ! ($match_p || $submatch_p) } { + ns_write "Could not find matching category or subcategory for $category
    \n" + } else { + incr success_count + } +} + +if { $success_count == 1 } { + set category_string "category mapping" +} else { + set category_string "category mappings" +} + +ns_write "

    Done loading $success_count $category_string out of $count. + +

    + +[ad_admin_footer] +" + + Index: web/openacs/www/admin/ecommerce/products/categories-upload.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/categories-upload.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/categories-upload.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,76 @@ +# categories-upload.tcl,v 3.0 2000/02/06 03:19:48 ron Exp +# This page uploads a CSV file containing product category "hints" and creates product category mappings. +# This is probably not generally useful for people who have clean data... +# +# The file format should be: +# +# product_id_1, category_description_1 +# product_id_2, category_description_2 +# ... +# product_id_n, category_description_n +# +# Where each line contains a product id, category name pair. There may be multiple lines for a single product id +# which will cause the product to get placed in multiple categories (or subcategories) +# +# This program attempts to match the category name to an existing category using looses matching (SQL: like) +# because some data is really nasty with lots of different formats for similar categories. Maybe loose matching +# should be an option. +# +# If a subcategory match is found, the product is placed into the matching subcategory as well as the parent category +# of the matching subcategory. If no match is found for a product, no mapping entry is made. A product id may +# appear on multiple lines to place a product in multiple categories. + +ReturnHeaders + +ns_write "[ad_admin_header "Upload Category Mapping Data"] + +

    Upload Catalog Category Mapping Data

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] "Upload Category Mapping Data"] + +
    + +
    + +
    +CSV Filename +

    +

    + +
    +
    + +

    + +Notes: + +

    +

    + +This page uploads a CSV file containing product category \"hints\" and creates product category mappings. +This is probably not generally useful for people who have clean data... +

    +The file format should be: +

    +

    +product_id_1, category_description_1
    +product_id_2, category_description_2
    +...
    +product_id_n, category_description_n     +
    +

    +Where each line contains a product id, category name pair. There may be multiple lines for a single product id +which will cause the product to get placed in multiple categories (or subcategories) +

    +This program attempts to match the category name to an existing category using looses matching (SQL: like) +because some data is really nasty with lots of different formats for similar categories. +

    +If a subcategory match is found, the product is placed into the matching subcategory as well as the parent category +of the matching subcategory. If no match is found for a product, no mapping entry is made. + +

    +
    + +[ad_admin_footer] + +" Index: web/openacs/www/admin/ecommerce/products/custom-field-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/custom-field-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/custom-field-add-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,91 @@ +# custom-field-add-2.tcl,v 3.0 2000/02/06 03:19:50 ron Exp +set_the_usual_form_variables + +# field_identifier, field_name, default_value, column_type + +set field_identifier [string tolower $field_identifier] + +set exception_count 0 +set exception_text "" + +if { [empty_string_p $field_identifier] } { + incr exception_count + append exception_text "
  • You forgot to enter a unique identifier." +} elseif { [regexp {[^a-z]} $field_identifier] } { + incr exception_count + append exception_text "
  • The unique identifier can only contain lowercase letters; no other characters are allowed." +} elseif { [string length $field_identifier] > 30 } { + incr exception_count + append exception_text "
  • The unique identifier is too long. It can be at most 30 characters. The current length is [string length $field_identifier] characters." +} else { + set db [ns_db gethandle] + if { [database_to_tcl_string $db "select count(*) from ec_custom_product_fields where field_identifier='$QQfield_identifier'"] > 0 } { + incr exception_count + append exception_text "
  • The identifier $field_identifier has already been used. Please choose another." + } elseif { [ns_column exists $db ec_products [string toupper $QQfield_identifier]] } { + incr exception_count + append exception_text "
  • The identifier $field_identifer is already being used by the system in a different table. Please choose another identifier to avoid ambiguity." + } +} + + +if { [empty_string_p $field_name] } { + incr exception_count + append exception_text "
  • You forgot to enter a field name." +} + +if { [empty_string_p $column_type] } { + incr exception_count + append exception_text "
  • You forgot to enter the kind of information." +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +ReturnHeaders + +ns_write "[ad_admin_header "Confirm Custom Field"] + +

    Confirm Custom Field

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "custom-fields.tcl" "Custom Fields"] "Confirm New Custom Field"] + +
    + + + + + + + + + + + + + + + + + + +
    Unique Identifier:$field_identifier
    Field Name:$field_name
    Default Value:$default_value
    Kind of Information:[ec_pretty_column_type $column_type]
    + +

    + +Please note that you can never remove a custom field, although you can deactivate it. Furthermore, the Unique +Identifier cannot be changed and, in most cases, neither can Kind of Information. + +

    + +

    +[export_form_vars field_identifier field_name default_value column_type] +
    + +
    +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/products/custom-field-add-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/custom-field-add-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/custom-field-add-3.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,106 @@ +# custom-field-add-3.tcl,v 3.0 2000/02/06 03:19:51 ron Exp +set_the_usual_form_variables + +# field_identifier, field_name, default_value, column_type + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +# if the column type is boolean, we want to add a (named) check constraint at the end +if { $column_type == "char(1)" } { + set end_of_alter ",\nconstraint ${field_identifier}_constraint check ($field_identifier in ('t', 'f'))" +} else { + set end_of_alter "" +} + +set db [ns_db gethandle] + +if { [database_to_tcl_string $db "select count(*) from ec_custom_product_fields where field_identifier='$QQfield_identifier'"] > 0 } { + # then they probably just hit submit twice, so send them to custom-fields.tcl + ns_returnredirect "custom-fields.tcl" +} + +set audit_fields "last_modified, last_modifying_user, modified_ip_address" +set audit_info "sysdate(), '$user_id', '[DoubleApos [ns_conn peeraddr]]'" + +set insert_statement "insert into ec_custom_product_fields +(field_identifier, field_name, default_value, column_type, $audit_fields) +values +('$QQfield_identifier', '$QQfield_name', '$QQdefault_value', '$QQcolumn_type', $audit_info)" + +if [catch { ns_db dml $db $insert_statement } errmsg] { + ad_return_error "Unable to Add Field" "Sorry, we were unable to add the field you requested. Here's the error message: 
    $errmsg
    " + return +} + +# have to alter ec_custom_product_field_values, the corresponding audit +# table, and the corresponding trigger + +set alter_statement "alter table ec_custom_product_field_values add ( + $field_identifier $column_type$end_of_alter +)" + +if [catch { ns_db dml $db $alter_statement } errmsg] { + # this means we were unable to add the column to ec_custom_product_field_values, so undo the insert into ec_custom_product_fields + ns_db dml $db "delete from ec_custom_product_fields where field_identifier='$QQfield_identifier'" + ad_return_error "Unable to Add Field" "Sorry, we were unable to add the field you requested. The error occurred when adding the column $field_identifier to ec_custom_product_field_values, so we've deleted the row containing $field_identifier from ec_custom_product_fields as well (for consistency). Here's the error message: 
    $errmsg
    " + return +} + +# 1999-08-10: took out $end_of_alter because the constraints don't +# belong in the audit table + +set alter_statement_2 "alter table ec_custom_p_field_values_audit add ( + $field_identifier $column_type +)" + +if [catch {ns_db dml $db $alter_statement_2} errmsg] { + # this means we were unable to add the column to ec_custom_p_field_values_audit, so undo the insert into ec_custom_product_fields and the alteration to ec_custom_product_field_values + ns_db dml $db "delete from ec_custom_product_fields where field_identifier='$QQfield_identifier'" + ns_db dml $db "alter table ec_custom_product_field_values drop column $field_identifier" + ad_return_error "Unable to Add Field" "Sorry, we were unable to add the field you requested. The error occurred when adding the column $field_identifier to ec_custom_p_field_values_audit, so we've dropped that column from ec_custom_product_field_values and we've deleted the row containing $field_identifier from ec_custom_product_fields as well (for consistency). Here's the error message: 
    $errmsg
    " + return +} + + + +# determine what the new trigger should be +set new_trigger_beginning "create or replace trigger ec_custom_p_f_values_audit_tr +before update or delete on ec_custom_product_field_values +for each row +begin + insert into ec_custom_p_field_values_audit (" + +set trigger_column_list [list] +for {set i 0} {$i < [ns_column count $db ec_custom_product_field_values]} {incr i} { + lappend trigger_column_list [ns_column name $db ec_custom_product_field_values $i] +} + +set new_trigger_columns [join $trigger_column_list ", "] + +set new_trigger_middle ") values (" + +set new_trigger_values ":old.[join $trigger_column_list ", :old."]" + +set new_trigger_end "); +end; +" + +set new_trigger "$new_trigger_beginning +$new_trigger_columns +$new_trigger_middle +$new_trigger_values +$new_trigger_end" + +ns_db dml $db "drop trigger ec_custom_p_f_values_audit_tr" +ns_db dml $db $new_trigger + +ns_returnredirect "custom-fields.tcl" Index: web/openacs/www/admin/ecommerce/products/custom-field-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/custom-field-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/custom-field-add.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,52 @@ +# custom-field-add.tcl,v 3.0 2000/02/06 03:19:52 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Add a Custom Field"] + +

    Add a Custom Field

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "custom-fields.tcl" "Custom Fields"] "Add a Custom Field"] + +
    + +
    + + + + + + + + + + + + + + + + + + + + + + + + +
    Unique IdentifierNo spaces or special characters (just lowercase letters). The customers won't see this, but the site +administrator might, so make it indicative of what the field is.
    Field NameThis is the name that the customers will see (if you choose to display this field on the site) and +the name you'll see when adding/updating products.
    Default Value (if any)
    What kind of information will this field hold? +[ec_column_type_widget] +
    + +

    + +

    + +
    + +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/products/custom-field-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/custom-field-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/custom-field-edit-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,63 @@ +# custom-field-edit-2.tcl,v 3.0 2000/02/06 03:19:54 ron Exp +set_the_usual_form_variables + +# field_identifier, field_name, default_value, column_type, old_column_type + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +# I'm not going to let them change from a non-boolean column type to a boolean +# one because it's too complicated adding the constraint (because first you +# change the column type and then you try to add the constraint, but if you +# fail when you add the constraint, you've still changed the column type (there's no +# rollback when you're altering tables), and in theory I could then change the +# column type back to the original one if the constraint addition fails, but +# what if that fails, so I'm just not going to allow it). + +if { $old_column_type != "char(1)" && $column_type == "char(1)"} { + ad_return_complaint 1 "
  • The Kind of Information cannot be changed from non-boolean to boolean." + return +} + +ns_db dml $db "begin transaction" + +ns_db dml $db "update ec_custom_product_fields +set field_name = '$QQfield_name', +default_value = '$QQdefault_value', +column_type='$QQcolumn_type', +last_modified=sysdate(), +last_modifying_user='$user_id', +modified_ip_address='[DoubleApos [ns_conn peeraddr]]' +where field_identifier = '$QQfield_identifier'" + +if { $column_type != $old_column_type } { + + # if the old column_type is a boolean, then let's drop the old constraint + if { $old_column_type == "char(1)" } { + ns_db dml $db "alter table ec_custom_product_field_values drop constraint ${field_identifier}_constraint" + } + + set alter_table_statement "alter table ec_custom_product_field_values modify ( + $field_identifier $column_type +)" + + if [catch { ns_db dml $db $alter_table_statement } errmsg] { + ad_return_complaint 1 "
  • The modification of Kind of Information failed. Here is the error message that Oracle gave us:
    $errmsg
    " + return + } + +} + +ns_db dml $db "end transaction" + +ns_returnredirect "custom-fields.tcl" Index: web/openacs/www/admin/ecommerce/products/custom-field-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/custom-field-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/custom-field-edit.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,55 @@ +# custom-field-edit.tcl,v 3.0 2000/02/06 03:19:55 ron Exp +set_the_usual_form_variables + +# field_identifier + +set db [ns_db gethandle] +set selection [ns_db 1row $db "select field_name, default_value, column_type, active_p from ec_custom_product_fields where field_identifier='$QQfield_identifier'"] +set_variables_after_query + +set old_column_type $column_type + +ReturnHeaders + +ns_write "[ad_admin_header "Edit $field_name"] + +

    Edit $field_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "custom-fields.tcl" "Custom Fields"] "Edit Custom Field"] + +
    + +
    +[export_form_vars old_column_type field_identifier] + + + + + + + + + + + + + + + + + + + + + + +
    Unique Identifier:$field_identifierThis can't be changed.
    Field Name:
    Default Value:
    Kind of Information:[ec_column_type_widget $column_type]We might not be able to change this, depending on what it is, what you're trying to change it to, and what values are already in the database for this field (you can always try it & find out).
    + +

    + +

    + +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/products/custom-field-status-change.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/custom-field-status-change.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/custom-field-status-change.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,21 @@ +# custom-field-status-change.tcl,v 3.0 2000/02/06 03:19:56 ron Exp +set_the_usual_form_variables +# field_identifier, active_p + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +ns_db dml $db "update ec_custom_product_fields set active_p='$active_p', last_modified=sysdate(), last_modifying_user='$user_id', modified_ip_address='[DoubleApos [ns_conn peeraddr]]' + where field_identifier='$field_identifier'" + +ns_returnredirect custom-fields.tcl \ No newline at end of file Index: web/openacs/www/admin/ecommerce/products/custom-field.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/custom-field.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/custom-field.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,72 @@ +# custom-field.tcl,v 3.0 2000/02/06 03:19:58 ron Exp +set_the_usual_form_variables + +# field_identifier + +set db [ns_db gethandle] +set selection [ns_db 1row $db "select field_name, default_value, column_type, active_p from ec_custom_product_fields where field_identifier='$QQfield_identifier'"] +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "$field_name"] + +

    $field_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "custom-fields.tcl" "Custom Fields"] "One Custom Field"] + +
    + + + + + + + + + + + + + + + + + + + + + + +
    Unique Identifier:$field_identifier
    Field Name:$field_name
    Default Value:$default_value
    Kind of Information:[ec_pretty_column_type $column_type]
    Active:[util_PrettyBoolean $active_p]
    + +

    + +

    Actions:

    + +

    + +

      +
    • Edit +" + +if { $active_p == "t" } { + ns_write "
    • Make Inactive" +} else { + ns_write "
    • Reactivate" +} + +# Set audit variables +# audit_name, id, id_column, return_url, audit_tables, main_tables +set audit_name "$field_name" +set id $field_identifier +set id_column "field_identifier" +set return_url "custom-field.tcl?[export_url_vars field_identifier]" +set audit_tables [list ec_custom_product_fields_audit] +set main_tables [list ec_custom_product_fields] + +ns_write "
    • Audit Trail +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/products/custom-fields.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/custom-fields.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/custom-fields.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,39 @@ +# custom-fields.tcl,v 3.0 2000/02/06 03:19:59 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Custom Fields"] + +

    Custom Fields

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] "Custom Fields"] + +
    + +
      + +" + +set db [ns_db gethandle] +set selection [ns_db select $db "select field_identifier, field_name, active_p from ec_custom_product_fields order by active_p desc, field_name"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • $field_name" + if { $active_p == "f" } { + ns_write " (inactive)" + } + ns_write "\n" +} + +set table_names_and_id_column [list ec_custom_product_fields ec_custom_product_fields_audit field_identifier] + +ns_write "

      + +

    • Add a custom field + +

      + +

    • Audit All Custom Fields +
    +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/products/delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/delete-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,156 @@ +# delete-2.tcl,v 3.0 2000/02/06 03:20:01 ron Exp +set_the_usual_form_variables +# product_id, product_name + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_url_vars product_id product_name]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +# cannot delete if there is an order which has this product, i.e. if +# this product exists in: +# ec_items + +# have to delete from: +# ec_offers +# ec_custom_product_field_values +# ec_subsubcategory_product_map +# ec_subcategory_product_map +# ec_category_product_map +# ec_product_reviews +# ec_product_comments +# ec_product_links +# ec_product_user_class_prices +# ec_product_series_map +# ec_products + +set db [ns_db gethandle] + +if { [database_to_tcl_string $db "select count(*) from ec_items where product_id=$product_id"] > 0 } { + ns_return 200 text/html "[ad_admin_header "Sorry"]\nSorry, you cannot delete a product for which an order has already been made. Instead, you can Mark It Inactive, which will make it no longer show up in the consumer pages." + return +} + +ns_db dml $db "begin transaction" + +# 1. Offers +set offer_list [database_to_tcl_list $db "select offer_id from ec_offers where product_id=$product_id"] + +ns_db dml $db "delete from ec_offers where product_id=$product_id" + +# audit +foreach offer_id $offer_list { + ad_audit_delete_row $db [list $offer_id $product_id] [list offer_id product_id] ec_offers_audit +} + +# 2. Custom Product Field Values +ns_db dml $db "delete from ec_custom_product_field_values where product_id=$product_id" +ad_audit_delete_row $db [list $product_id] [list product_id] ec_custom_p_field_values_audit + +# 3. Subsubcategory Product map +set subsubcategory_list [database_to_tcl_list $db "select subsubcategory_id from ec_subsubcategory_product_map where product_id=$product_id"] + +ns_db dml $db "delete from ec_subsubcategory_product_map where product_id=$product_id" + +# audit +foreach subsubcategory_id $subsubcategory_list { + ad_audit_delete_row $db [list $subsubcategory_id $product_id] [list subsubcategory_id product_id] ec_subsubcat_prod_map_audit +} + +# 4. Subcategory Product map +set subcategory_list [database_to_tcl_list $db "select subcategory_id from ec_subcategory_product_map where product_id=$product_id"] + +ns_db dml $db "delete from ec_subcategory_product_map where product_id=$product_id" + +# audit +foreach subcategory_id $subcategory_list { + ad_audit_delete_row $db [list $subcategory_id $product_id] [list subcategory_id product_id] ec_subcat_prod_map_audit +} + +# 5. Category Product map +set category_list [database_to_tcl_list $db "select category_id from ec_category_product_map where product_id=$product_id"] + +ns_db dml $db "delete from ec_category_product_map where product_id=$product_id" + +# audit +foreach category_id $category_list { + ad_audit_delete_row $db [list $category_id $product_id] [list category_id product_id] ec_category_product_map_audit +} + +# 6. Product Reviews +set review_list [database_to_tcl_list $db "select review_id from ec_product_reviews where product_id=$product_id"] + +ns_db dml $db "delete from ec_product_reviews where product_id=$product_id" + +# audit +foreach review_id $review_list { + ad_audit_delete_row $db [list $review_id $product_id] [list review_id product_id] ec_product_reviews_audit +} + +# 7. Product Comments +ns_db dml $db "delete from ec_product_comments where product_id=$product_id" + +# comments aren't audited + +# 8. Product Relationship Links +set product_a_list [database_to_tcl_list $db "select product_a from ec_product_links where product_b=$product_id"] +set product_b_list [database_to_tcl_list $db "select product_b from ec_product_links where product_a=$product_id"] + +ns_db dml $db "delete from ec_product_links where product_a=$product_id or product_b=$product_id" + +# audit +foreach product_a $product_a_list { + ad_audit_delete_row $db [list $product_a $product_id] [list product_a product_id] ec_product_links_audit +} +foreach product_b $product_b_list { + ad_audit_delete_row $db [list $product_b $product_id] [list product_b product_id] ec_product_links_audit +} + +# 9. User Class +set user_class_id_list [list] +set user_class_price_list [list] +set selection [ns_db select $db "select user_class_id, price from ec_product_user_class_prices where product_id=$product_id"] +while { [ns_db getrow $db $selection] } { + set_variables_after_query + lappend user_class_id_list $user_class_id + lappend user_class_price_list $price +} + +ns_db dml $db "delete from ec_product_user_class_prices where product_id=$product_id" + +# audit +set counter 0 +foreach user_class_id $user_class_id_list { + ad_audit_delete_row $db [list $user_class_id [lindex $user_class_price_list $counter] $product_id] [list user_class_id price product_id] ec_product_u_c_prices_audit + incr counter +} + +# 10. Product Series map +set series_id_list [database_to_tcl_list $db "select series_id from ec_product_series_map where component_id=$product_id"] +set component_id_list [database_to_tcl_list $db "select component_id from ec_product_series_map where series_id=$product_id"] + +ns_db dml $db "delete from ec_product_series_map where series_id=$product_id or component_id=$product_id" + +# audit +foreach series_id $series_id_list { + ad_audit_delete_row $db [list $series_id $product_id] [list series_id component_id] ec_product_series_map_audit +} +foreach component_id $component_id_list { + ad_audit_delete_row $db [list $product_id $component_id] [list series_id component_id] ec_product_series_map_audit +} + +# 11. Products +ns_db dml $db "delete from ec_products where product_id=$product_id" + +# audit +ad_audit_delete_row $db [list $product_id] [list product_id] ec_products_audit + +ns_db dml $db "end transaction" + +ns_returnredirect "index.tcl" Index: web/openacs/www/admin/ecommerce/products/delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/delete.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,27 @@ +# delete.tcl,v 3.0 2000/02/06 03:20:02 ron Exp +set_the_usual_form_variables +# product_id, product_name + +ReturnHeaders +ns_write "[ad_admin_header "Confirm Deletion of $product_name"] + +

    Confirm Deletion

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "one.tcl?[export_url_vars product_id]" "One"] "Confirm Deletion"] + +
    + +Are you sure you want to delete $product_name? Note that the system +will not let you delete a product if anyone has already ordered it +(you might want to mark the product \"discontinued\" instead). + +

    + +[export_form_vars product_id product_name] +

    + +
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/edit-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,411 @@ +# edit-2.tcl,v 3.1 2000/03/07 04:11:50 eveander Exp +ad_page_variables { + product_name + sku + one_line_description + detailed_description + color_list + size_list + style_list + email_on_purchase_list + search_keywords + url + price + no_shipping_avail_p + present_p + available_date + shipping + shipping_additional + weight + stock_status + product_id + template_id +} + +validate_integer product_id $product_id + +set_the_usual_form_variables +# product_name, sku, one_line_description, detailed_description, color_choices, +# size_choices, style_choices, search_keywords, url, price +# present_p, available_date, shipping, shipping_additional, weight, stock_status +# and product_id, template_id +# and all active custom fields (except ones that are boolean and weren't filled in) +# and price$user_class_id for all the user classes +# - categorization is a select multiple, so that will be dealt with separately +# - the dates are special (as usual) so they'll have to be "put together" + +# first do error checking +# product_name is mandatory +set exception_count 0 +set exception_text "" +if { ![info exists product_name] || [empty_string_p $product_name] } { + incr exception_count + append exception_text "
  • You forgot to enter the name of the product.\n" +} +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +# categorization is a select multiple, so deal with that separately +set form [ns_getform] +set form_size [ns_set size $form] +set form_counter 0 + +set categorization_list [list] +while { $form_counter < $form_size} { + if { [ns_set key $form $form_counter] == "categorization" } { + lappend categorization_list [ns_set value $form $form_counter] + } + incr form_counter +} + +# break categorization into category_id_list, subcategory_id_list, subsubcategory_id_list +set category_id_list [list] +set subcategory_id_list [list] +set subsubcategory_id_list [list] +foreach categorization $categorization_list { + if ![catch {set category_id [lindex $categorization 0] } ] { + if { [lsearch -exact $category_id_list $category_id] == -1 && ![empty_string_p $category_id]} { + lappend category_id_list $category_id + } + } + if ![catch {set subcategory_id [lindex $categorization 1] } ] { + if {[lsearch -exact $subcategory_id_list $subcategory_id] == -1 && ![empty_string_p $subcategory_id]} { + lappend subcategory_id_list $subcategory_id + } + } + if ![catch {set subsubcategory_id [lindex $categorization 2] } ] { + if {[lsearch -exact $subsubcategory_id_list $subsubcategory_id] == -1 && ![empty_string_p $subsubcategory_id] } { + lappend subsubcategory_id_list $subsubcategory_id + } + } +} + +# Now deal with dates. +# The column available_date is known to be a date. +# Also, some of the custom fields may be dates. +# Unlike in add-2.tcl, some dates may be passed on as hidden form elements +# and might not be passed in parts as with the dateentry widgets. So I'm not going +# to set them to null if the date recombination failes and the dates already exist. + + +set date_fields [list "available_date"] + +set db [ns_db gethandle] +set additional_date_fields [database_to_tcl_list $db "select field_identifier from ec_custom_product_fields where column_type='date' and active_p='t'"] + +set all_date_fields [concat $date_fields $additional_date_fields] + +foreach date_field $all_date_fields { + if [catch { ns_dbformvalue $form $date_field date $date_field} errmsg ] { + if { ![info exists $date_field] } { + set $date_field "" + } + } +} + +# one last manipulation of data is needed: get rid of "http://" if that's all that's +# there for the url (since that was the default value) +if { [string compare $url "http://"] == 0 } { + set url "" +} + +# We now have all values in the correct form + +# Get the directory where dirname is stored +set dirname [database_to_tcl_string $db "select dirname from ec_products where product_id=$product_id"] +set subdirectory [ec_product_file_directory $product_id] +set full_dirname "[ad_parameter EcommerceDataDirectory ecommerce][ad_parameter ProductDataDirectory ecommerce]$subdirectory/$dirname" + +# if an image file has been specified, upload it into the +# directory that was just created and make a thumbnail (using +# dimensions specified in parameters/whatever.ini) + +if { [info exists upload_file] && ![string compare $upload_file ""] == 0 } { + + # this takes the upload_file and sticks its contents into a temporary + # file (will be deleted when the thread ends) + set tmp_filename [ns_queryget upload_file.tmpfile] + + + # so that we'll know if it's a gif or a jpg + set file_extension [file extension $upload_file] + + # copies this temp file into a permanent file + set perm_filename "$full_dirname/product$file_extension" + ns_cp $tmp_filename $perm_filename + + # create thumbnails + # thumbnails are all jpg files + + # set thumbnail dimensions + if [catch {set thumbnail_width [ad_parameter ThumbnailWidth ecommerce]} ] { + if [catch {set thumbnail_height [ad_parameter ThumbnailHeight ecommerce]} ] { + set convert_dimensions "100x10000" + } else { + set convert_dimensions "10000x$thumbnail_height" + } + } else { + set convert_dimensions "${thumbnail_width}x10000" + } + + set perm_thumbnail_filename "$full_dirname/product-thumbnail.jpg" + + exec /usr/local/bin/convert -geometry $convert_dimensions $perm_filename $perm_thumbnail_filename +} + +set linked_thumbnail [ec_linked_thumbnail_if_it_exists $dirname] + +ReturnHeaders +ns_write "[ad_admin_header "Confirm Product Changes"] + +

    Confirm Product Changes

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "one.tcl?[export_url_vars product_id]" $product_name] "Edit Product"] +
    +

    Please confirm that the information below is correct:

    +" + +set currency [ad_parameter Currency ecommerce] +set multiple_retailers_p [ad_parameter MultipleRetailersPerProductP ecommerce] + +ns_write "
    +
    + +
    +
    +$linked_thumbnail + + + + + + + + + + + + + +" +if { !$multiple_retailers_p } { + ns_write " + + + + " +} +ns_write " + + + + + + + + + + + + + + + + + + + + + + + + + + + +" +if { !$multiple_retailers_p } { + ns_write " + + + + " +} +ns_write " + + + +" +if { !$multiple_retailers_p } { + ns_write " + + + + + + + + " +} +ns_write " + + + +" +if { !$multiple_retailers_p } { + set selection [ns_db select $db "select user_class_id, user_class_name from ec_user_classes order by user_class_name"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { [info exists price$user_class_id] } { + ns_write " + + + + + " + } + } +} + +set selection [ns_db select $db "select field_identifier, field_name, column_type from ec_custom_product_fields where active_p = 't'"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { [info exists $field_identifier] } { + ns_write " + + + + + " + } +} + +ns_write " + + + + + + + +
    +Product Name: + +$product_name +
    +SKU + +$sku +
    +Categorization: + +[ec_category_subcategory_and_subsubcategory_display $db $category_id_list $subcategory_id_list $subsubcategory_id_list] +
    + Stock Status: + + " + if { ![empty_string_p $stock_status] } { + ns_write [ad_parameter "StockMessage[string toupper $stock_status]" ecommerce] + } else { + ns_write [ec_message_if_null $stock_status] + } + + ns_write "
    +One-Line Description: + +[ec_message_if_null $one_line_description] +
    +Additional Descriptive Text: + +[ec_display_as_html [ec_message_if_null $detailed_description]] +
    +Search Keywords: + +[ec_message_if_null $search_keywords] +
    +Color Choices: + +[ec_message_if_null $color_list] +
    +Size Choices: + +[ec_message_if_null $size_list] +
    +Style Choices: + +[ec_message_if_null $style_list] +
    +URL: + +[ec_message_if_null $url] +
    + Regular Price: + + [ec_message_if_null [ec_pretty_price $price $currency]] +
    +Display this product when user does a search? + +[ec_message_if_null [ec_PrettyBoolean $present_p]] +
    + Shipping Price + + [ec_message_if_null [ec_pretty_price $shipping $currency]] +
    + Shipping - Additional + + [ec_message_if_null [ec_pretty_price $shipping_additional $currency]] +
    +Weight + +[ec_message_if_null $weight] [ec_decode $weight "" "" [ad_parameter WeightUnits ecommerce]] +
    + $user_class_name Price: + + [ec_message_if_null [ec_pretty_price [set price$user_class_id] $currency]] +
    + $field_name + + " + if { $column_type == "char(1)" } { + ns_write "[ec_message_if_null [ec_PrettyBoolean [set $field_identifier]]]\n" + } elseif { $column_type == "date" } { + ns_write "[ec_message_if_null [util_AnsiDatetoPrettyDate [set $field_identifier]]]\n" + } else { + ns_write "[ec_display_as_html [ec_message_if_null [set $field_identifier]]]\n" + } + ns_write "
    +Template + +[ec_message_if_null [database_to_tcl_string_or_null $db "select template_name from ec_templates where template_id='$template_id'"]] +
    +Available Date + +[ec_message_if_null [util_AnsiDatetoPrettyDate $available_date]] +
    +
    +

    + +[export_form_vars product_name sku category_id_list subcategory_id_list subsubcategory_id_list one_line_description detailed_description color_list size_list style_list search_keywords url price present_p available_date shipping shipping_additional weight template_id product_id stock_status] +" + +# also need to export custom field values +set additional_variables_to_export [database_to_tcl_list $db "select field_identifier from ec_custom_product_fields where active_p='t'"] + +foreach user_class_id [database_to_tcl_list $db "select user_class_id from ec_user_classes"] { + lappend additional_variables_to_export "price$user_class_id" +} + +eval "ns_write \"\[export_form_vars $additional_variables_to_export\]\n\"" + + +ns_write "

    + +
    +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/products/edit-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/edit-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/edit-3.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,209 @@ +# edit-3.tcl,v 3.1 2000/03/07 04:11:56 eveander Exp +set_the_usual_form_variables + +# product_id, product_name, sku, category_id_list, subcategory_id_list, subsubcategory_id_list, one_line_description, detailed_description, color_list, size_list, style_list, search_keywords, url, price, present_p, available_date, shipping, shipping_additional, weight, template_id, stock_status +# the custom product fields may or may not exist +# and price$user_class_id for all the user classes may or may not exist +# (because someone may have added a user class while this product was +# being added) + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +# we have to generate audit information +# First, write as insert +set audit_fields "last_modified, last_modifying_user, modified_ip_address" +set audit_info "sysdate(), '$user_id', '[DoubleApos [ns_conn peeraddr]]'" + +# Or otherwise write as update +set audit_update "last_modified=sysdate(), last_modifying_user='$user_id', modified_ip_address='[DoubleApos [ns_conn peeraddr]]'" + +ns_db dml $db "begin transaction" + +# we have to insert or update things in 6 tables: ec_products, ec_custom_product_field_values, +# ec_category_product_map, ec_subcategory_product_map, ec_subsubcategory_product_map, +# ec_product_user_class_prices + +if {$available_date == ""} { + set available_date_sql sysdate() +} else { + set available_date_sql '$available_date' +} + +ns_db dml $db "update ec_products +set product_name='$QQproduct_name', sku='$QQsku', one_line_description='$QQone_line_description', detailed_description='$QQdetailed_description', color_list='$QQcolor_list', size_list='$QQsize_list', style_list='$QQstyle_list', search_keywords='$QQsearch_keywords', url='$QQurl', price=[db_null_sql $price], present_p='$present_p', available_date='$available_date', shipping=[db_null_sql $shipping], shipping_additional=[db_null_sql $shipping_additional], weight=[db_null_sql $weight], template_id=[db_null_sql $template_id], stock_status='$QQstock_status', $audit_update +where product_id=$product_id +" +# things to insert or update in ec_custom_product_field_values if they exist +set custom_columns [database_to_tcl_list $db "select field_identifier from ec_custom_product_fields where active_p='t'"] + +if { [database_to_tcl_string $db "select count(*) from ec_custom_product_field_values where product_id=$product_id"] == 0 } { + # then we want to insert, not update + set custom_columns_to_insert [list product_id] + set custom_column_values_to_insert [list $product_id] + foreach custom_column $custom_columns { + if {[info exists $custom_column] } { + lappend custom_columns_to_insert $custom_column + lappend custom_column_values_to_insert "'[set QQ$custom_column]'" + } + } + + ns_db dml $db "insert into ec_custom_product_field_values + ([join $custom_columns_to_insert ", "], $audit_fields) + values + ([join $custom_column_values_to_insert ","], $audit_info) + " + +} else { + set update_list [list] + foreach custom_column $custom_columns { + if {[info exists $custom_column] } { + lappend update_list "$custom_column='[set QQ$custom_column]'" + } + } + + if {[llength $update_list] > 0 } { + ns_db dml $db "update ec_custom_product_field_values set [join $update_list ", "], $audit_update where product_id=$product_id" + } +} + +# Take care of categories and subcategories and subsubcategories. +# This is going to leave current values in the map tables, remove +# rows no longer valid and add new rows for ids not already there. +# Because the reference constraints go from categories to subsubcategories +# first the subsubcategories to categories will be deleted, then +# new categories down to subsubcategories will be added. + +# Make a list of categories, subcategories, subsubcategories in the database +set old_category_id_list [database_to_tcl_list $db "select category_id from ec_category_product_map where product_id=$product_id"] + +set old_subcategory_id_list [database_to_tcl_list $db "select subcategory_id from ec_subcategory_product_map where product_id=$product_id"] + +set old_subsubcategory_id_list [database_to_tcl_list $db "select subsubcategory_id from ec_subsubcategory_product_map where product_id=$product_id"] + +# Delete subsubcategory maps through category maps + +foreach old_subsubcategory_id $old_subsubcategory_id_list { + if { [lsearch -exact $subsubcategory_id_list $old_subsubcategory_id] == -1 } { + # This old subsubcategory id is not in the new list and needs + # to be deleted + ns_db dml $db "delete from ec_subsubcategory_product_map where product_id=$product_id and subsubcategory_id=$old_subsubcategory_id" + + # audit + ad_audit_delete_row $db [list $old_subsubcategory_id $product_id] [list subsubcategory_id product_id] ec_subsubcat_prod_map_audit + } +} + +foreach old_subcategory_id $old_subcategory_id_list { + if { [lsearch -exact $subcategory_id_list $old_subcategory_id] == -1 } { + # This old subcategory id is not in the new list and needs + # to be deleted + ns_db dml $db "delete from ec_subcategory_product_map where product_id=$product_id and subcategory_id=$old_subcategory_id" + + # audit + ad_audit_delete_row $db [list $old_subcategory_id $product_id] [list subcategory_id product_id] ec_subcat_prod_map_audit + } +} + +foreach old_category_id $old_category_id_list { + if { [lsearch -exact $category_id_list $old_category_id] == -1 } { + # This old category id is not in the new list and needs + # to be deleted + ns_db dml $db "delete from ec_category_product_map where product_id=$product_id and category_id=$old_category_id" + + # audit + ad_audit_delete_row $db [list $old_category_id $product_id] [list category_id product_id] ec_category_product_map_audit + } +} + +# Now add categorization maps + +foreach new_category_id $category_id_list { + if { [lsearch -exact $old_category_id_list $new_category_id] == -1 } { + # The new category id is not an existing category mapping + # so add it. + ns_db dml $db "insert into ec_category_product_map (product_id, category_id, $audit_fields) values ($product_id, $new_category_id, $audit_info)" + } +} + +foreach new_subcategory_id $subcategory_id_list { + if { [lsearch -exact $old_subcategory_id_list $new_subcategory_id] == -1 } { + # The new subcategory id is not an existing subcategory mapping + # so add it. + ns_db dml $db "insert into ec_subcategory_product_map (product_id, subcategory_id, $audit_fields) values ($product_id, $new_subcategory_id, $audit_info)" + } +} + +foreach new_subsubcategory_id $subsubcategory_id_list { + if { [lsearch -exact $old_subsubcategory_id_list $new_subsubcategory_id] == -1 } { + # The new subsubcategory id is not an existing subsubcategory mapping + # so add it. + ns_db dml $db "insert into ec_subsubcategory_product_map (product_id, subsubcategory_id, $audit_fields) values ($product_id, $new_subsubcategory_id, $audit_info)" + } +} + +# Take care of special prices for user classes +# First get a list of old user_class_id values and a list of all +# user_class_id values. +# Then delete a user_class_price if its ID does not exist or value is empty. +# Last go through all user_class_id values and add the user_class_price +# if it is not in the old user_class_id_list +set all_user_class_id_list [database_to_tcl_list $db "select user_class_id from ec_user_classes"] + +set old_user_class_id_list [list] +set old_user_class_price_list [list] +set selection [ns_db select $db "select user_class_id, price from ec_product_user_class_prices where product_id=$product_id"] +while { [ns_db getrow $db $selection] } { + set_variables_after_query + lappend old_user_class_id_list $user_class_id + lappend old_user_class_price_list [ns_dbquotevalue $price] +} + +# Counter is used to find the corresponding user_class_price for the current +# user_class_id +set counter 0 +foreach user_class_id $old_user_class_id_list { + if { ![info exists price$user_class_id] || [empty_string_p [set price$user_class_id]] } { + # This old user_class_id does not have a value, so delete it + + ns_db dml $db "delete from ec_product_user_class_prices where user_class_id = $user_class_id" + + # audit + ad_audit_delete_row $db [list $user_class_id [lindex $old_user_class_price_list $counter] $product_id] [list user_class_id price product_id] ec_product_u_c_prices_audit + } + incr counter +} + +# Add new values +foreach user_class_id $all_user_class_id_list { + if { [info exists price$user_class_id] } { + # This user_class_id exists and must either be inserted + # or updated if its value has changed. + + set index [lsearch -exact $old_user_class_id_list $user_class_id] + if { $index == -1 } { + # This user_class_id exists and is not in the + ns_db dml $db "insert into ec_product_user_class_prices (product_id, user_class_id, price, $audit_fields) values ($product_id, $user_class_id, [db_null_sql [set price$user_class_id]], $audit_info)" + } else { + # Check if user_class_price has changed + if { [set price$user_class_id] != [lindex $old_user_class_price_list $index] } { + ns_db dml $db "update ec_product_user_class_prices set price=[db_null_sql [set price$user_class_id]], $audit_update where user_class_id = $user_class_id and product_id = $product_id" + } + } + } +} + +ns_db dml $db "end transaction" + +ns_returnredirect "one.tcl?product_id=$product_id" +return Index: web/openacs/www/admin/ecommerce/products/edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/edit.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,256 @@ +# edit.tcl,v 3.1 2000/03/07 04:12:53 eveander Exp +# edit.tcl +# +# by eveander@arsdigita.com June 1999 +# +# form for the user to edit the main fields in the ec_product table +# plus custom fields + +set_the_usual_form_variables + +# product_id + +set product_name [ec_product_name $product_id] + +ReturnHeaders + +ns_write "[ad_admin_header "Edit $product_name"] + +

    Edit $product_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "one.tcl?[export_url_vars product_id]" "One"] "Edit"] + +
    + +All fields are optional except Product Name. +

    +" +set multiple_retailers_p [ad_parameter MultipleRetailersPerProductP ecommerce] + +set db_pools [ns_db gethandle [philg_server_default_pool] 2] +set db [lindex $db_pools 0] +set db_sub [lindex $db_pools 1] + +set selection [ns_db 1row $db "select * from ec_products where product_id=$product_id"] +set_variables_after_query + +ns_write "

    +[export_form_vars product_id] + + + + + + + + + + +" + +# have to deal with category widget + +set category_list [database_to_tcl_list $db "select category_id from ec_category_product_map where product_id=$product_id"] + +set subcategory_list [database_to_tcl_list $db "select subcategory_id from ec_subcategory_product_map where product_id=$product_id"] + +set subsubcategory_list [database_to_tcl_list $db "select subsubcategory_id from ec_subsubcategory_product_map where product_id=$product_id"] + + +set categorization_default [ec_determine_categorization_widget_defaults $db $category_list $subcategory_list $subsubcategory_list] + + +ns_write " + + + + +" +if { !$multiple_retailers_p } { + ns_write " + + + + " +} else { + ns_write "[philg_hidden_input stock_status $stock_status]\n" +} +ns_write " + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +" +if { [empty_string_p $url] } { + set url "http://" +} +ns_write " + +" +if { !$multiple_retailers_p } { + ns_write " + + + + " +} else { + ns_write "[philg_hidden_input price $price]\n" +} +ns_write " + + + + + + + + +" +if { !$multiple_retailers_p } { + ns_write " + + + + + + + + + " +} else { + ns_write "[philg_hidden_input shipping $shipping]\n[philg_hidden_input shipping_additional $shipping_additional]\n" +} +ns_write " + + + + + + + + +
    Product Name
    SKUIt's not necessary to include a SKU because the system generates its own +internal product_id to uniquely distinguish products.
    Product Category[ec_category_widget $db t $categorization_default]Choose as many categories as you like. The product will +be displayed on the web site in each of the categories you select.
    Stock Status[ec_stock_status_widget $stock_status]
    One-Line Description
    Additional Descriptive Text
    Search Keywords
    Picture" + +set thumbnail [ec_linked_thumbnail_if_it_exists $dirname f] +if { ![empty_string_p $thumbnail] } { + ns_write "
    Your current picture is:
    $thumbnail" +} + +ns_write "    		This picture (.gif or .jpg format) can be as large as you like. A thumbnail will be automatically generated. Note that file uploading doesn't work with Internet Explorer 3.0.
    Color ChoicesThis should be a comma-separated list of colors the user is allowed to choose from +when ordering. If there are no choices, leave this blank.
    Size ChoicesThis should be a comma-separated list of sizes the user is allowed to choose from +when ordering. If there are no choices, leave this blank.
    Style ChoicesThis should be a comma-separated list of styles the user is allowed to choose from +when ordering. If there are no choices, leave this blank.
    URL where the consumer can get more info on the product
    Regular PriceAll prices are in [ad_parameter Currency ecommerce]. The price should + be written as a decimal number (no special characters like \$). +
    Should this product be displayed when the user does a search?Yes +   +No +You might choose \"No\" if this product is part of a series.
    When does this product become available for purchase?[ad_dateentrywidget available_date $available_date]
    Shipping PriceThe \"Shipping Price\", \"Shipping Price - Additional\", and \"Weight\" fields + may or may not be applicable, depending on the + shipping rules you have set up for + your ecommerce system.
    Shipping Price - Additional per item if ordering more than 1 (leave blank if same as Shipping Price above)
    Weight ([ad_parameter WeightUnits ecommerce])
    Template[ec_template_widget $db $category_list $template_id]Select a template to use when displaying this product. If none is +selected, the product will be displayed with the system default template.
    + +

    +" + +set n_user_classes [database_to_tcl_string $db "select count(*) from ec_user_classes"] +if { $n_user_classes > 0 && !$multiple_retailers_p} { + ns_write "

    Special Prices for User Classes

    + +

    + + + " + + set selection [ns_db select $db "select user_class_id, user_class_name from ec_user_classes order by user_class_name"] + + set first_class_p 1 + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write " + + " + + if { $first_class_p } { + set first_class_p 0 + ns_write "\n" + } + ns_write "\n" + } + ns_write "
    $user_class_nameEnter prices (no + special characters like \$) only if you want people in + user classes to be charged a different price than the + regular price. If you leave user class prices blank, + then the users will be charged regular price.
    \n" +} + + +if { [database_to_tcl_string $db "select count(*) from ec_custom_product_fields where active_p='t'"] > 0 } { + + ns_write "

    Custom Fields

    + +

    + + + " + + set selection [ns_db select $db "select field_identifier, field_name, default_value, column_type from ec_custom_product_fields where active_p='t' order by creation_date"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "\n" + } + + ns_write "
    $field_name[ec_custom_product_field_form_element $field_identifier $column_type [database_to_tcl_string $db_sub "select $field_identifier from ec_custom_product_field_values where product_id=$product_id"]]
    \n" +} + +ns_write "

    + +
    +
    +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/extras-upload-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/extras-upload-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/extras-upload-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,97 @@ +# extras-upload-2.tcl,v 3.0 2000/02/06 03:20:06 ron Exp +# This file updates ec_custom_product_field_values (as opposed to inserting +# new rows) because upload*.tcl (which are to be run before extras-upload*.tcl) +# insert rows into ec_custom_product_field_values (with everything empty except +# product_id and the audit columns) when they insert the rows into ec_products +# (for consistency with add*.tcl). + +ad_page_variables {{csv_file ""}} + +# csv_file + +if { [empty_string_p $csv_file] } { + ad_return_error "Missing CSV File" "You must input the name of the .csv file on your local hard drive." + return +} + +set user_id [ad_get_user_id] +set ip [ns_conn peeraddr] + + +ReturnHeaders + +ns_write "[ad_admin_header "Uploading Extras"] + +

    Uploading Extras

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] "Uploading Extras"] + +
    + +" + +set unix_file_name [ns_queryget csv_file.tmpfile] +#set unix_file_name "[ns_info pageroot]/$csv_file" + +set db [ns_db gethandle] + +if { ![file readable $unix_file_name] } { + ns_write "Cannot read file $unix_file_name" + return +} + +ns_write "
    +"
+
+set csvfp [open $unix_file_name]
+
+set count 0
+while { [ns_getcsv $csvfp elements] != -1 } {
+    incr count
+    if { $count == 1 } {
+	# first time thru, we grab the number of columns and their names
+	set number_of_columns [llength $elements]
+	set columns $elements
+	set product_id_column [lsearch -exact $columns "product_id"]
+    } else {
+	# this line is a product
+# (this file used to insert rows into ec_custom_product_field_values, but
+# now that is done in upload-2.tcl, so we need to update instead)
+# 	set columns_sql "insert into ec_custom_product_field_values (last_modified, last_modifying_user, modified_ip_address "
+# 	set values_sql " values (sysdate(), $user_id, '$ip' "
+# 	for { set i 0 } { $i < $number_of_columns } { incr i } {
+# 	    append columns_sql ", [lindex $columns $i]"
+# 	    append values_sql ", '[DoubleApos [lindex $elements $i]]'"
+# 	}
+# 	set sql "$columns_sql ) $values_sql )"
+
+	set sql "update ec_custom_product_field_values set last_modified=sysdate(), last_modifying_user=$user_id, modified_ip_address='$ip'"
+
+	for { set i 0 } { $i < $number_of_columns } { incr i } {
+	    if { $i != $product_id_column } {
+		append sql ", [lindex $columns $i]='[DoubleApos [lindex $elements $i]]'"
+	    }
+	}
+	append sql "where product_id=[lindex $elements $product_id_column]"
+
+	if { [catch {ns_db dml $db $sql} errmsg] } {
+	    append bad_products_sql "$sql\n"
+	    ns_write "FAILURE! SQL: $sql
    \n"
+	} else {
+	    ns_write "Success!
    \n"
+	}
+    }
+}
+
+ns_write "
    +

    Done loading [ec_decode $count "0" "0" [expr $count -1]] products extras! + +

    + +(Note: \"success\" doesn't actually mean that the information was uploaded; it +just means that Oracle didn't choke on it (since updates to tables are considered +successes even if 0 rows are updated). If you need reassurance, spot check some of the individual products.) +[ad_admin_footer] +" + + Index: web/openacs/www/admin/ecommerce/products/extras-upload.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/extras-upload.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/extras-upload.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,92 @@ +# extras-upload.tcl,v 3.0 2000/02/06 03:20:07 ron Exp +# This page uploads a CSV file containing client-specific product information into the catalog. The file format +# should be: +# +# field_name_1, field_name_2, ... field_name_n +# value_1, value_2, ... value_n +# +# where the first line contains the actual names of the columns in ec_custom_product_field_values and the remaining lines contain +# the values for the specified fields, one line per product. +# +# Legal values for field names are site-specific: whatever additional fields the administrator has created prior to +# loading a file can be populated by this script. +# +# Note: last_modified, last_modifying_user and modified_ip_address are set automatically and should not appear in +# the CSV file. + +ReturnHeaders + +ns_write "[ad_admin_header "Upload Product Extras"] + +

    Upload Product Extras

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] "Upload Product Extras"] + +
    + +
    + +
    +CSV Filename +

    +

    + +
    +
    + + +

    + +Notes: + +

    +

    + +This page uploads a CSV file containing product information into the database. The file format should be: +

    +

    +field_name_1, field_name_2, ... field_name_n
    +value_1, value_2, ... value_n     +
    +

    +where the first line contains the actual names of the columns in ec_custom_product_field_values and the remaining lines contain +the values for the specified fields, one line per product. +

    +Legal values for field names are the columns in ec_custom_product_field_values +(which are set by you when you add custom database fields): +

    +

    +
    +"
+
+set db [ns_db gethandle]
+
+for {set i 0} {$i < [ns_column count $db ec_custom_product_field_values]} {incr i} {
+    set col_to_print [ns_column name $db ec_custom_product_field_values $i]
+    set undesirable_cols [list "available_date" "last_modified" "last_modifying_user" "modified_ip_address"]
+    set required_cols [list "product_id"]
+    if { [lsearch -exact $undesirable_cols $col_to_print] == -1 } {
+	ns_write "$col_to_print"
+	if { [lsearch -exact $required_cols $col_to_print] != -1 } {
+	    ns_write " (required)"
+	}
+	ns_write "\n"
+    }
+}
+
+ns_write "
    +
    +

    +Note: Some of these fields may be inactive, in which case there +might be no good reason for you to include them in the upload. +Additionally, [join $undesirable_cols ", "] are set +automatically and should not appear in the CSV file. + + +

    + +
    + +[ad_admin_footer] + +" Index: web/openacs/www/admin/ecommerce/products/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/index.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,58 @@ +# index.tcl,v 3.0 2000/02/06 03:20:09 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Product Administration"] + +

    Product Administration

    + +[ad_admin_context_bar [list "../" "Ecommerce"] "Products"] + +
    + +" + +# For Audit tables +set table_names_and_id_column [list ec_products ec_products_audit product_id] + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select count(*) as n_products, round(avg(price::float8),2) as avg_price from ec_products_displayable"] +set_variables_after_query + +ns_write " + + + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/link-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/link-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/link-add-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,31 @@ +# link-add-2.tcl,v 3.0 2000/02/06 03:20:10 ron Exp +set_the_usual_form_variables +# product_id, product_name, link_product_name, link_product_id + +ReturnHeaders +ns_write "[ad_admin_header "Create New Link, Cont."] + +

    Create New Link, Cont.

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "one.tcl?[export_url_vars product_id]" $product_name] "New Link, Cont."] + +
    + +Please choose an action: + + + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/products/link-add-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/link-add-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/link-add-3.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,44 @@ +# link-add-3.tcl,v 3.0 2000/02/06 03:20:11 ron Exp +set_the_usual_form_variables +# action, product_id, product_name, link_product_name, link_product_id + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +ns_db dml $db "begin transaction" + +if { $action == "both" || $action == "to" } { + + # see if it's already in there + if { 0 == [database_to_tcl_string $db "select count(*) from ec_product_links where product_a=$link_product_id and product_b=$product_id"] } { + ns_db dml $db "insert into ec_product_links + (product_a, product_b, last_modified, last_modifying_user, modified_ip_address) + values + ($link_product_id, $product_id, sysdate(), $user_id, '[DoubleApos [ns_conn peeraddr]]') + " + } +} + +if { $action == "both" || $action == "from" } { + if { 0 == [database_to_tcl_string $db "select count(*) from ec_product_links where product_a=$product_id and product_b=$link_product_id"] } { + ns_db dml $db "insert into ec_product_links + (product_a, product_b, last_modified, last_modifying_user, modified_ip_address) + values + ($product_id, $link_product_id, sysdate(), $user_id, '[DoubleApos [ns_conn peeraddr]]') + " + } +} + +ns_db dml $db "end transaction" + +ns_returnredirect "link.tcl?[export_url_vars product_id product_name]" Index: web/openacs/www/admin/ecommerce/products/link-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/link-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/link-add.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,41 @@ +# link-add.tcl,v 3.0 2000/02/06 03:20:13 ron Exp +set_the_usual_form_variables +# product_id, product_name +# either link_product_name or link_product_id + +ReturnHeaders +ns_write "[ad_admin_header "Create New Link"] + +

    Create New Link

    + +[ad_admin_context_bar [list ../" "Ecommerce"] [list "index.tcl" "Products"] [list "one.tcl?[export_url_vars product_id]" $product_name] "New Link"] + +
    +Please select the product you wish to link to or from: +
      +" + +if { [info exists link_product_id] } { + set additional_query_part "product_id='$link_product_id'" +} else { + set additional_query_part "upper(product_name) like '%[string toupper $link_product_name]%'" +} + +set db [ns_db gethandle] +set selection [ns_db select $db "select product_id as link_product_id, product_name as link_product_name from ec_products where $additional_query_part"] + +set product_counter 0 +while {[ns_db getrow $db $selection]} { + incr product_counter + set_variables_after_query + ns_write "
    • $link_product_name\n" +} + +if { $product_counter == 0 } { + ns_write "No matching products were found.\n" +} + +ns_write "
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/products/link-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/link-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/link-delete-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,11 @@ +# link-delete-2.tcl,v 3.0 2000/02/06 03:20:14 ron Exp +set_the_usual_form_variables +# product_a, product_b, product_id, product_name + +set db [ns_db gethandle] + +ns_db dml $db "delete from ec_product_links where product_a=$product_a and product_b=$product_b" + +ad_audit_delete_row $db [list $product_a $product_b] [list "product_a" "product_b"] ec_product_links_audit + +ns_returnredirect "link.tcl?[export_url_vars product_id product_name]" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/products/link-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/link-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/link-delete.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,26 @@ +# link-delete.tcl,v 3.0 2000/02/06 03:20:15 ron Exp +set_the_usual_form_variables +# product_a, product_b, product_id, product_name, rowid + +ReturnHeaders +ns_write "[ad_admin_header "Confirm Deletion"] + +

    Confirm Deletion

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "one.tcl?[export_url_vars product_id]" $product_name] "Delete Link"] + +
    +Please confirm that you wish to delete this link. + +
    + +[export_form_vars product_id product_name product_a product_b] + +
    + +
    + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/link.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/link.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/link.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,130 @@ +# link.tcl,v 3.0 2000/02/06 03:20:17 ron Exp +# link.tcl +# +# by eveander@arsdigita.com June 1999 +# +# lets admin maintain links among products (e.g., "you should also think +# about buying X if you're buying Y") + +set_the_usual_form_variables + +# product_id + +set product_name [ec_product_name $product_id] + +ReturnHeaders + +ns_write "[ad_admin_header "Links between $product_name and other products"] + +

    Links

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "one.tcl?[export_url_vars product_id]" "One"] "Links"] + +
    + +Links from the page for $product_name to other products' display pages: + +

    + +

      +" +set db [ns_db gethandle] + +set selection [ns_db select $db "select product_b, product_name as product_b_name +from ec_product_links, ec_products +where product_a=$product_id +and product_b=ec_products.product_id"] + +set product_counter 0 +while { [ns_db getrow $db $selection] } { + incr product_counter + set_variables_after_query + ns_write "
    • $product_b_name \[delete link\]\n" +} + +if { $product_counter == 0 } { + ns_write "None\n" +} + +ns_write "
    + +

    + +Links to $product_name from other products' display pages: + +

    + +

      +" + +set selection [ns_db select $db "select product_a, product_name as product_a_name +from ec_product_links, ec_products +where product_b=$product_id +and ec_product_links.product_a=ec_products.product_id"] + +set product_counter 0 +while { [ns_db getrow $db $selection] } { + incr product_counter + set_variables_after_query + ns_write "
    • $product_a_name \[delete link\]\n" +} + +if { $product_counter == 0 } { + ns_write "None\n" +} + +ns_write "
    + +

    + +Search for a product to add a link to/from: + +

    + +

    + +
    +[export_form_vars product_id product_name] +Name: + +
    + +

    + +

    +[export_form_vars product_id product_name] +ID: + +
    + +
    +" + +# Set audit variables +# audit_name, audit_id, audit_id_column, return_url, audit_tables, main_tables +set audit_name "Links from $product_name" +set audit_id $product_id +set audit_id_column "product_a" +set return_url "[ns_conn url]?[export_url_vars product_id]" +set audit_tables [list ec_product_links_audit] +set main_tables [list ec_product_links] + +ns_write " +

    Audit Trail

    + + + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/list.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/list.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/list.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,85 @@ +# list.tcl,v 3.0 2000/02/06 03:20:18 ron Exp +# list.tcl +# +# by philg@mit.edu on July 18, 1999 +# +# lists a class of products, ordered to the user's taste +# + +set_the_usual_form_variables 0 + +# category_id (optional), order_by (optional) + +set db [ns_db gethandle] + +if { ![info exists category_id] || [empty_string_p $category_id] } { + # we're going to give the user all products + set title "All Products" + set menubar_stub "list.tcl?" + set category_exclusion_clause "" +} else { + set category_name [database_to_tcl_string $db "select category_name from ec_categories where category_id = $category_id"] + set title "$category_name Products" + set menubar_stub "list.tcl?category_id=$category_id&" + set category_exclusion_clause "\nand exists (select 1 from ec_category_product_map map where map.product_id = ep.product_id and map.category_id = $category_id)" +} + +if { ![info exists order_by] || [empty_string_p $order_by] || $order_by == "name"} { + set order_by_clause "order by upper(product_name)" + set ordering_options "sales | name | age | comments" +} elseif { $order_by == "sales" } { + set order_by_clause "order by n_items_ordered desc" + set ordering_options "sales | name | age | comments" +} elseif { $order_by == "comments" } { + set order_by_clause "order by n_comments desc" + set ordering_options "sales | name | age | comments" +} else { + # must be age + set order_by_clause "order by available_date desc" + set ordering_options "sales | name | age | comments" +} + +ReturnHeaders + +ns_write "[ad_admin_header $title] + +

    $title

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] $title] + +
    + +order by $ordering_options + +
      +" + +set selection [ns_db select $db "select ep.product_id, ep.product_name, ep.available_date, ec_items_reportable_count(ep.product_id) as n_items_ordered, ec_comments_count(ep.product_id) as n_comments +from ec_products ep +where product_id=product_id $category_exclusion_clause +group by ep.product_id, ep.product_name, ep.available_date +$order_by_clause"] + +set list_items "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append list_items "
    • $product_name +(available since [util_AnsiDatetoPrettyDate $available_date]; $n_items_ordered sold" + if { $n_comments > 0 } { + append list_items "; $n_comments customer reviews" + } + append list_items ")\n" + +} + +if { [empty_string_p $list_items] } { + ns_write "No products found.\n" +} else { + ns_write $list_items +} + +ns_write "
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/offer-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/offer-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/offer-add-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,42 @@ +# offer-add-2.tcl,v 3.0 2000/02/06 03:20:20 ron Exp +set_the_usual_form_variables +# offer_id, product_id, product_name, retailer_id, price, shipping, stock_status, +# offer_begins, offer_ends, special_offer_p, special_offer_html +# and possibly shipping_unavailable_p + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +# see if an offer with this offer_id exists, meaning they pushed +# submit twice + +if { [database_to_tcl_string $db "select count(*) from ec_offers where offer_id=$offer_id"] > 0 } { + ns_returnredirect "offers.tcl?[export_url_vars product_id product_name]" + return +} + +if { [info exists shipping_unavailable_p] } { + set additional_column ", shipping_unavailable_p" + set additional_value ", 't'" +} else { + set additional_column "" + set additional_value "" +} + +ns_db dml $db "insert into ec_offers +(offer_id, product_id, retailer_id, price, shipping, stock_status, special_offer_p, special_offer_html, offer_begins, offer_ends $additional_column, last_modified, last_modifying_user, modified_ip_address) +values +($offer_id, $product_id, $retailer_id, '$QQprice', '$QQshipping', '$QQstock_status', '$special_offer_p','$QQspecial_offer_html', to_date('$offer_begins','YYYY-MM-DD HH24:MI:SS'), to_date('$offer_ends','YYYY-MM-DD HH24:MI:SS') $additional_value, sysdate(), $user_id, '[DoubleApos [ns_conn peeraddr]]') +" + +ns_returnredirect "offers.tcl?[export_url_vars product_id product_name]" Index: web/openacs/www/admin/ecommerce/products/offer-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/offer-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/offer-add.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,172 @@ +# offer-add.tcl,v 3.0 2000/02/06 03:20:21 ron Exp +set_the_usual_form_variables +# product_id, product_name, retailer_id, price, shipping, stock_status, +# offer_begins & offer_ends (in parts), special_offer_p, special_offer_html +# and possibly shipping_unavailable_p + +set exception_count 0 +set exception_text "" + +set possible_error_list [list [list retailer_id "to pick a retailer"] [list price "to enter the price"] [list special_offer_p "to specify whether this is a special offer"] ] + +foreach possible_error $possible_error_list { + if { ![info exists [lindex $possible_error 0]] || [empty_string_p [set [lindex $possible_error 0]]] } { + incr exception_count + append exception_text "
  • You forgot [lindex $possible_error 1]." + } +} + +if { [regexp {[^0-9\.]} $price] } { + incr exception_count + append exception_text "
  • The price must be a number." +} + +if { [regexp {[^0-9\.]} $shipping] } { + incr exception_count + append exception_text "
  • The shipping price must be a number." +} + +# either there should be a shipping price or shipping_unavailable_p +# should exist (in which case it will be "t"), but not both +if { ![info exists shipping_unavailable_p] && [empty_string_p $shipping] } { + incr exception_count + append exception_text "
  • Please either enter a shipping cost or + specify that only Pick Up is available.\n" +} elseif { [info exists shipping_unavailable_p] && ![empty_string_p $shipping] } { + incr exception_count + append exception_text "
  • You have specified that only Pick Up is available, therefore you must leave the shipping price blank.\n" +} + + +# deal w/dates +set form [ns_getform] +if [catch { ns_dbformvalue $form offer_begins date offer_begins} errmsg ] { + incr exception_count + append exception_text "
  • The date that the offer begins was specified in the wrong format. It should be in the format Month DD YYYY.\n" +} elseif { [string length [set ColValue.offer%5fbegins.year]] < 4 } { + incr exception_count + append exception_text "
  • The year that the offer begins needs to contain 4 digits.\n" +} + + +if [catch { ns_dbformvalue $form offer_ends date offer_ends} errmsg ] { + incr exception_count + append exception_text "
  • The date that the offer expires was specified in the wrong format. It should be in the format Month DD YYYY.\n" +} elseif { [string length [set ColValue.offer%5fends.year]] < 4 } { + incr exception_count + append exception_text "
  • The year that the offer expires needs to contain 4 digits.\n" +} + +if { [info exists offer_begins] && [empty_string_p $offer_begins] } { + incr exception_count + append exception_text "
  • You forgot to enter the date that the offer begins.\n" +} + +if { [info exists offer_ends] && [empty_string_p $offer_ends] } { + incr exception_count + append exception_text "
  • You forgot to enter the date that the offer expires.\n" +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + + +# add some times to the dates, so that it starts at the beginning +# of the first day and ends at the end of the last day +set offer_begins "$offer_begins 00:00:00" +set offer_ends "$offer_ends 23:59:59" +set to_date_offer_begins "to_date('$offer_begins','YYYY-MM-DD HH24:MI:SS')" +set to_date_offer_ends "to_date('$offer_ends','YYYY-MM-DD HH24:MI:SS')" + + +# see if a non-deleted offer for this product and retailer whose +# dates of validity overlap this offer is already in ec_offers, in which +# case they can't add this new offer + +set db [ns_db gethandle] + +if { [database_to_tcl_string $db "select count(*) from ec_offers +where product_id=$product_id +and retailer_id=$retailer_id +and deleted_p='f' +and (($to_date_offer_begins >= offer_begins and $to_date_offer_begins <= offer_ends) or ($to_date_offer_ends >= offer_begins and $to_date_offer_ends <= offer_ends) or ($to_date_offer_begins <= offer_ends and $to_date_offer_ends >= offer_ends)) +"] > 0 } { + ad_return_complaint 1 "
  • You already have an offer from this retailer for this product whose dates overlap with the dates of this offer. Please either delete the previous offer before adding this one, or edit the previous offer instead of adding this one.\n" + return +} + + +# error checking done + +ReturnHeaders +ns_write "[ad_admin_header "Confirm Retailer Offer on $product_name"] + +

    Confirm Retailer Offer on $product_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "one.tcl?[export_url_vars product_id]" $product_name] "Confirm Retailer Offer"] + +
    +" + +set currency [ad_parameter Currency ecommerce] + +ns_write " + + + + + + + + + + +" +if { [info exists shipping_unavailable_p] } { + ns_write "\n" +} else { + ns_write "\n" +} + +ns_write " + + + + + + + + + + + + +" + +if { $special_offer_p == "t" } { + ns_write "\n" +} + +ns_write "
    Retailer:[database_to_tcl_string $db "select retailer_name || ' (' || decode(reach,'web',url,city || ', ' || usps_abbrev) || ')' from ec_retailers where retailer_id=$retailer_id"]
    Price:[ec_pretty_price $price $currency]
    Shipping:Pick Up[ec_pretty_price $shipping $currency]
    Stock Status: +" +if { ![empty_string_p $stock_status] } { + ns_write [ad_parameter "StockMessage[string toupper $stock_status]" ecommerce] +} else { + ns_write [ec_message_if_null $stock_status] +} +ns_write "
    Offer Begins[util_AnsiDatetoPrettyDate [ec_date_with_time_stripped $offer_begins]]
    Offer Expires[util_AnsiDatetoPrettyDate [ec_date_with_time_stripped $offer_ends]]
    Special Offer:$special_offer_html
    +" + +set offer_id [database_to_tcl_string $db "select ec_offer_sequence.nextval from dual"] + +ns_write "
    +[export_form_vars offer_id product_id product_name retailer_id price shipping stock_status shipping_unavailable_p offer_begins offer_ends special_offer_p special_offer_html] +
    + +
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/offer-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/offer-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/offer-delete-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,19 @@ +# offer-delete-2.tcl,v 3.0 2000/02/06 03:20:22 ron Exp +set_the_usual_form_variables +# deleted_p, product_id, product_name, retailer_id + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] +ns_db dml $db "update ec_offers set deleted_p='$deleted_p', last_modified=sysdate(), last_modifying_user='$user_id', modified_ip_address='[DoubleApos [ns_conn peeraddr]]' where product_id=$product_id and retailer_id=$retailer_id" + +ns_returnredirect "offers.tcl?[export_url_vars product_id product_name]" Index: web/openacs/www/admin/ecommerce/products/offer-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/offer-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/offer-delete.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,33 @@ +# offer-delete.tcl,v 3.0 2000/02/06 03:20:24 ron Exp +set_the_usual_form_variables +# deleted_p, product_id, product_name, retailer_id + +if { $deleted_p == "t" } { + set delete_or_undelete "Delete" + set deletion_or_undeletion "Deletion" +} else { + set delete_or_undelete "Undelete" + set deletion_or_undeletion "Undeletion" +} + +ReturnHeaders +ns_write "[ad_admin_header "Confirm $deletion_or_undeletion of Retailer Offer on $product_name"] + +

    Confirm $deletion_or_undeletion of Retailer Offer on $product_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "one.tcl?[export_url_vars product_id]" $product_name] "$delete_or_undelete Retailer Offer"] + +
    +" + +ns_write "
    +[export_form_vars deleted_p product_id product_name retailer_id] + +
    + +
    + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/offer-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/offer-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/offer-edit-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,168 @@ +# offer-edit-2.tcl,v 3.0 2000/02/06 03:20:25 ron Exp +set_the_usual_form_variables +# offer_id, product_id, product_name, retailer_id, price, shipping, stock_status, old_retailer_id, offer_begins, offer_ends +# special_offer_p, special_offer_html +# and possibly shipping_unavailable_p + +set exception_count 0 +set exception_text "" + +set possible_error_list [list [list retailer_id "to pick a retailer"] [list price "to enter the price"] [list special_offer_p "to specify whether this is a special offer"]] + +foreach possible_error $possible_error_list { + if { ![info exists [lindex $possible_error 0]] || [empty_string_p [set [lindex $possible_error 0]]] } { + incr exception_count + append exception_text "
  • You forgot [lindex $possible_error 1]." + } +} + +if { [regexp {[^0-9\.]} $price] } { + incr exception_count + append exception_text "
  • The price must be a number." +} + +if { [regexp {[^0-9\.]} $shipping] } { + incr exception_count + append exception_text "
  • The shipping price must be a number." +} + +# either there should be a shipping price or shipping_unavailable_p +# should exist (in which case it will be "t"), but not both +if { ![info exists shipping_unavailable_p] && [empty_string_p $shipping] } { + incr exception_count + append exception_text "
  • Please either enter a shipping cost or + specify that only Pick Up is available.\n" +} elseif { [info exists shipping_unavailable_p] && ![empty_string_p $shipping] } { + incr exception_count + append exception_text "
  • You have specified that only Pick Up is available, therefore you must leave the shipping price blank.\n" +} + +# deal w/dates +set form [ns_getform] +if [catch { ns_dbformvalue $form offer_begins date offer_begins} errmsg ] { + incr exception_count + append exception_text "
  • The date that the offer begins was specified in the wrong format. It should be in the format Month DD YYYY.\n" +} elseif { [string length [set ColValue.offer%5fbegins.year]] < 4 } { + incr exception_count + append exception_text "
  • The year that the offer begins needs to contain 4 digits.\n" +} + + +if [catch { ns_dbformvalue $form offer_ends date offer_ends} errmsg ] { + incr exception_count + append exception_text "
  • The date that the offer expires was specified in the wrong format. It should be in the format Month DD YYYY.\n" +} elseif { [string length [set ColValue.offer%5fends.year]] < 4 } { + incr exception_count + append exception_text "
  • The year that the offer expires needs to contain 4 digits.\n" +} + +if { [info exists offer_begins] && [empty_string_p $offer_begins] } { + incr exception_count + append exception_text "
  • You forgot to enter the date that the offer begins.\n" +} + +if { [info exists offer_ends] && [empty_string_p $offer_ends] } { + incr exception_count + append exception_text "
  • You forgot to enter the date that the offer expires.\n" +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + + +# add some times to the dates, so that it starts at the beginning +# of the first day and ends at the end of the last day +set offer_begins "$offer_begins 00:00:00" +set offer_ends "$offer_ends 23:59:59" +set to_date_offer_begins "to_date('$offer_begins','YYYY-MM-DD HH24:MI:SS')" +set to_date_offer_ends "to_date('$offer_ends','YYYY-MM-DD HH24:MI:SS')" + +# see if a non-deleted offer for this product and retailer whose +# dates of validity overlap this offer is already in ec_offers, in which +# case they can't add this new offer + +set db [ns_db gethandle] +# +if { [database_to_tcl_string $db "select count(*) from ec_offers +where product_id=$product_id +and retailer_id=$retailer_id +and offer_id != $offer_id +and deleted_p='f' +and (($to_date_offer_begins >= offer_begins and $to_date_offer_begins <= offer_ends) or ($to_date_offer_ends >= offer_begins and $to_date_offer_ends <= offer_ends) or ($to_date_offer_begins <= offer_ends and $to_date_offer_ends >= offer_ends)) +"] > 0 } { + ad_return_complaint 1 "
  • You already have an offer from this retailer for this product whose dates overlap with the dates of this offer. Please either delete the previous offer before editing this one, or edit the previous offer instead of editing this one.\n" + + return +} + + +ReturnHeaders +ns_write "[ad_admin_header "Confirm Retailer Offer on $product_name"] + +

    Confirm Retailer Offer on $product_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "one.tcl?[export_url_vars product_id]" $product_name] "Confirm Retailer Offer"] + +
    +" + +set currency [ad_parameter Currency ecommerce] + +ns_write " + + + + + + + + + + +" +if { [info exists shipping_unavailable_p] } { + ns_write "\n" +} else { + ns_write "\n" +} + +ns_write " + + + + + + + + + + + + +" + +if { $special_offer_p == "t" } { + ns_write "\n" +} + + +ns_write "
    Retailer:[database_to_tcl_string $db "select retailer_name || ' (' || city || ', ' || usps_abbrev || ')' as retailer_name_to_print from ec_retailers where retailer_id=$retailer_id"]
    Price:[ec_pretty_price $price $currency]
    Shipping:Pick Up[ec_pretty_price $shipping $currency]
    Stock Status: +" +if { ![empty_string_p $stock_status] } { + ns_write [ad_parameter "StockMessage[string toupper $stock_status]" ecommerce] +} else { + ns_write [ec_message_if_null $stock_status] +} +ns_write "
    Offer Begins[util_AnsiDatetoPrettyDate $offer_begins]
    Offer Expires[util_AnsiDatetoPrettyDate $offer_ends]
    Special Offer:$special_offer_html
    + +
    +[export_form_vars offer_id product_id product_name retailer_id price shipping stock_status old_retailer_id offer_begins offer_ends special_offer_p special_offer_html shipping_unavailable_p] +
    + +
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/offer-edit-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/offer-edit-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/offer-edit-3.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,30 @@ +# offer-edit-3.tcl,v 3.0 2000/02/06 03:20:26 ron Exp +set_the_usual_form_variables +# offer_id, product_id, product_name, retailer_id, price, shipping, stock_status, old_retailer_id, offer_begins, offer_ends, +# special_offer_p, special_offer_html +# and possibly shipping_unavailable_p + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +if { [info exists shipping_unavailable_p] } { + set additional_thing_to_insert ", shipping_unavailable_p='t'" +} else { + set additional_thing_to_insert ", shipping_unavailable_p='f'" +} + +ns_db dml $db "update ec_offers +set retailer_id=$retailer_id, price='$QQprice', shipping='$QQshipping', stock_status='$QQstock_status', special_offer_p='$special_offer_p', special_offer_html='$QQspecial_offer_html', offer_begins=to_date('$offer_begins','YYYY-MM-DD HH24:MI:SS'), offer_ends=to_date('$offer_ends','YYYY-MM-DD HH24:MI:SS') $additional_thing_to_insert, last_modified=sysdate(), last_modifying_user='$user_id', modified_ip_address='[DoubleApos [ns_conn peeraddr]]' +where offer_id=$offer_id" + +ns_returnredirect "offers.tcl?[export_url_vars product_id product_name]" Index: web/openacs/www/admin/ecommerce/products/offer-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/offer-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/offer-edit.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,110 @@ +# offer-edit.tcl,v 3.0 2000/02/06 03:20:28 ron Exp +set_the_usual_form_variables +# offer_id, product_id, product_name, retailer_id + +ReturnHeaders +ns_write "[ad_admin_header "Edit Retailer Offer on $product_name"] + +

    Edit Retailer Offer on $product_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "one.tcl?[export_url_vars product_id]" $product_name] "Edit Retailer Offer"] + +
    +" + +set old_retailer_id $retailer_id + +ns_write "
    +[export_form_vars offer_id product_id product_name old_retailer_id] + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +Retailer + + +
    Price (in $currency)
    Shipping (in $currency) +  or   + +Pick Up only +
    Stock Status[ec_stock_status_widget $stock_status]
    Offer Begins[ad_dateentrywidget offer_begins $offer_begins]
    Offer Expires[ad_dateentrywidget offer_ends $offer_ends]
    Is this a Special Offer? +Yes   +No +
    If yes, elaborate:
    + +
    + +
    + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/offers.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/offers.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/offers.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,198 @@ +# offers.tcl,v 3.0 2000/02/06 03:20:29 ron Exp +set_the_usual_form_variables +# product_id, product_name + +proc ec_write_out_one_offer {} { + uplevel { + ns_write "
  • $retailer_name
    + Price: [ec_message_if_null [ec_pretty_price $price $currency]]
    + Shipping: + " + if { $shipping_unavailable_p != "t" } { + ns_write "[ec_message_if_null [ec_pretty_price $shipping $currency]]
    " + } else { + ns_write "Pick Up
    " + } + ns_write "Stock Status: " + if { ![empty_string_p $stock_status] } { + ns_write "[ad_parameter "StockMessage[string toupper $stock_status]" ecommerce]
    \n" + } else { + ns_write "[ec_message_if_null $stock_status]
    \n" + } + ns_write "Offer Begins: [util_AnsiDatetoPrettyDate $offer_begins]
    + Offer Expires: [util_AnsiDatetoPrettyDate $offer_ends]
    + " + if { $special_offer_p == "t" } { + ns_write "Special Offer: $special_offer_html
    \n" + } + + if { $deleted_p == "t" } { + ns_write "This offer is deleted.
    \n" + } elseif { !$offer_begun_p } { + ns_write "This offer has not yet begun.
    \n" + } elseif { $offer_expired_p } { + ns_write "This offer has expired.
    \n" + } + + ns_write "\[edit | " + + if { $deleted_p == "t" } { + ns_write "un" + } + + # Set audit variables + # audit_name, id, id_column, return_url, audit_tables, main_tables + set audit_name "$product_name Offer" + set id $offer_id + set id_column "offer_id" + set return_url "offers.tcl?[export_url_vars product_id product_name]" + set audit_tables [list ec_offers_audit] + set main_tables [list ec_offers] + + ns_write "delete | audit trail\] +

    + " + } +} + +ReturnHeaders +ns_write "[ad_admin_header "Retailer Offers on $product_name"] + +

    Retailer Offers on $product_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "one.tcl?[export_url_vars product_id]" $product_name] "Retailer Offers"] + +
    +

    Current Offers

    +
      +" +set currency [ad_parameter Currency ecommerce] + +set db [ns_db gethandle] + +set selection [ns_db select $db "select o.offer_id, o.retailer_id, r.retailer_name, price, shipping, stock_status, special_offer_p, special_offer_html, shipping_unavailable_p, offer_begins, offer_ends, o.deleted_p, decode(sign(sysdate()-offer_begins),1,1,0) as offer_begun_p, decode(sign(sysdate()-offer_ends),1,1,0) as offer_expired_p +from ec_offers_current o, ec_retailers r +where o.retailer_id=r.retailer_id +and o.product_id=$product_id +order by o.last_modified desc"] + +set offer_counter 0 +while { [ns_db getrow $db $selection] } { + incr offer_counter + set_variables_after_query + ec_write_out_one_offer +} + +if { $offer_counter == 0 } { + ns_write "There are no current offers.\n" +} + +ns_write "
    + +

    + +

    Add an Offer

    + +
    +[export_form_vars product_id product_name] + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +Retailer + + +
    Price (in $currency)
    Shipping (in $currency) +  or   + +Pick Up only +
    Stock Status[ec_stock_status_widget]
    Offer Begins[ad_dateentrywidget offer_begins]
    Offer Expires[ad_dateentrywidget offer_ends]
    Is this a Special Offer? +Yes   +No +
    If yes, elaborate:
    + +

    + +

    + +
    + +
    + +

    + +

    Non-Current or Deleted Offers

    + +
      +" +set currency [ad_parameter Currency ecommerce] + +set selection [ns_db select $db "select o.offer_id, o.retailer_id, retailer_name, price, shipping, stock_status, special_offer_p, special_offer_html, shipping_unavailable_p, offer_begins, offer_ends, o.deleted_p, decode(sign(sysdate()-offer_begins),1,1,0) as offer_begun_p, decode(sign(sysdate()-offer_ends),1,1,0) as offer_expired_p +from ec_offers o, ec_retailers r +where o.retailer_id=r.retailer_id +and o.product_id=$product_id +and (o.deleted_p='t' or o.offer_begins - sysdate() > 0 or o.offer_ends - sysdate() < 0) +order by o.last_modified desc"] + +set offer_counter 0 +while { [ns_db getrow $db $selection] } { + incr offer_counter + set_variables_after_query + ec_write_out_one_offer +} + +if { $offer_counter == 0 } { + ns_write "There are no non-current or deleted offers.\n" +} + +ns_write "
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/one-subcategory.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/one-subcategory.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/one-subcategory.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,40 @@ +# one-subcategory.tcl,v 3.0 2000/02/06 03:20:30 ron Exp +set_the_usual_form_variables +# category_id, category_name, subcategory_id, subcategory_name + +ReturnHeaders + +ns_write "[ad_admin_header "Products in $category_name: $subcategory_name"] + +

    Products in $category_name: $subcategory_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] "Products in $category_name: $subcategory_name"] + +
    + +
      +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select m.product_id, p.product_name +from ec_subcategory_product_map m, ec_products p +where m.product_id = p.product_id +and m.subcategory_id=$subcategory_id +order by product_name"] + +set product_counter 0 +while { [ns_db getrow $db $selection] } { + incr product_counter + set_variables_after_query + ns_write "
    • $product_name\n" +} + +if { $product_counter == 0 } { + ns_write "There are no products in this subcategory.\n" +} + +ns_write "
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/one-subsubcategory.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/one-subsubcategory.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/one-subsubcategory.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,49 @@ +# one-subsubcategory.tcl,v 3.0 2000/02/06 03:20:31 ron Exp +set_the_usual_form_variables +# category_id, category_name, subcategory_id, subcategory_name, subsubcategory_id subsubcategory_name + +ReturnHeaders + +ns_write "[ad_admin_header "Products in $category_name: $subcategory_name: $subsubcategory_name"] + +

    Products in $category_name: $subcategory_name: $subsubcategory_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] "Products in $category_name: $subcategory_name: $subsubcategory_name"] + +
    + +
      +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select m.product_id, p.product_name, publisher_favorite_p +from ec_subsubcategory_product_map m, ec_products p +where m.product_id = p.product_id +and m.subsubcategory_id=$subsubcategory_id +order by product_name"] + +set product_counter 0 +while { [ns_db getrow $db $selection] } { + incr product_counter + set_variables_after_query + ns_write "
    • $product_name " + if { $publisher_favorite_p == "t" } { + ns_write "This is a favorite. " + } + if { $publisher_favorite_p == "t" } { + ns_write " \[make it not be a favorite\]" + } else { + ns_write "\[make this a favorite\]" + } + +} + +if { $product_counter == 0 } { + ns_write "There are no products in this subsubcategory.\n" +} + +ns_write "
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/one.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/one.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/one.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,390 @@ +# one.tcl,v 3.1 2000/03/07 04:14:24 eveander Exp +# one.tcl +# +# by eveander@arsdigita.com June 1999 +# +# main admin page for a single product +# + +set_the_usual_form_variables + +# product_id + +# Have to get everything about this product from ec_products, +# ec_custom_product_field_values (along with the info about the fields from +# ec_custom_product_fields), ec_category_product_map, ec_subcategory_product_map, ec_subsubcategory_product_map + +set db_pools [ns_db gethandle [philg_server_default_pool] 2] +set db [lindex $db_pools 0] +set db_sub [lindex $db_pools 1] + +set selection [ns_db 1row $db "select * from ec_products where product_id=$product_id"] +set_variables_after_query + +# we know these won't conflict with the ec_products columns because of the constraint +# in custom-field-add-2.tcl +set selection [ns_db 1row $db "select * from ec_custom_product_field_values where product_id=$product_id"] +set_variables_after_query + +set category_list [database_to_tcl_list $db "select category_id from ec_category_product_map where product_id=$product_id"] + +set subcategory_list [database_to_tcl_list $db "select subcategory_id from ec_subcategory_product_map where product_id=$product_id"] + +set subsubcategory_list [database_to_tcl_list $db "select subsubcategory_id from ec_subsubcategory_product_map where product_id=$product_id"] + +set multiple_retailers_p [ad_parameter MultipleRetailersPerProductP ecommerce] +set currency [ad_parameter Currency ecommerce] + +set n_professional_reviews [database_to_tcl_string $db "select count(*) from ec_product_reviews where product_id = $product_id"] + +if { $n_professional_reviews == 0 } { + set product_review_anchor "none yet; click to add" +} else { + set product_review_anchor $n_professional_reviews +} + +set n_customer_reviews [database_to_tcl_string $db "select count(*) from ec_product_comments where product_id = $product_id"] + +if { $n_customer_reviews == 0 } { + set customer_reviews_link "none yet" +} else { + set customer_reviews_link "$n_customer_reviews" +} + +set n_links_to [database_to_tcl_string $db "select count(*) from ec_product_links where product_b = $product_id"] + +set n_links_from [database_to_tcl_string $db "select count(*) from ec_product_links where product_a = $product_id"] + +if { $multiple_retailers_p } { + set price_row "" +} else { + if { [database_to_tcl_string $db "select count(*) from ec_sale_prices_current where product_id=$product_id"] > 0 } { + set sale_prices_anchor "on sale; view price" + } else { + set sale_prices_anchor "put on sale" + } + set price_row " + + Regular Price: + + + [ec_message_if_null [ec_pretty_price $price $currency]] + ($sale_prices_anchor) + + + " +} + +if { $active_p == "t" } { + set active_p_for_display "Active" +} else { + set active_p_for_display "Discontinued" +} + +set active_p_row " + + +Active/Discontinued: + + +$active_p_for_display +(toggle) + + +" + +if [empty_string_p $dirname] { + set dirname_cell "something is wrong with this product; there is no place to put files!" +} else { + set dirname_cell "$dirname (Supporting Files)" +} + +ReturnHeaders + +ns_write "[ad_admin_header "$product_name"] + +

    $product_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] "One Product"] + +
    + + + + +

    Complete Record

    + +
    + +" + +if { $active_p == "f" } { + ns_write "This product is discontinued.

    \n" +} + +ns_write "[ec_linked_thumbnail_if_it_exists $dirname] + + + + + + + + + + + + + +$price_row +$active_p_row + + + + +" +if { !$multiple_retailers_p } { + ns_write " + + + + " +} +ns_write " + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +" +if { !$multiple_retailers_p } { + ns_write " + + + + + + + + " +} +ns_write " + + + +" +if { !$multiple_retailers_p } { + + set selection [ns_db select $db "select user_class_id, user_class_name from ec_user_classes order by user_class_name"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + set temp_price [database_to_tcl_string_or_null $db_sub "select price from ec_product_user_class_prices where product_id=$product_id and user_class_id=$user_class_id"] + + ns_write " + + + + + " + } +} + +set selection [ns_db select $db "select field_identifier, field_name, column_type from ec_custom_product_fields where active_p = 't'"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { [info exists $field_identifier] } { + ns_write " + + + + + " + } +} + +ns_write " + + + + + + + + + + + + + + + +
    +Product ID: + +$product_id +
    +Product Name: + +$product_name +
    +SKU: + +[ec_message_if_null $sku] +
    +Categorization: + +[ec_category_subcategory_and_subsubcategory_display $db $category_list $subcategory_list $subsubcategory_list] +
    + Stock Status: + + " + if { ![empty_string_p $stock_status] } { + ns_write [ad_parameter "StockMessage[string toupper $stock_status]" ecommerce] + } else { + ns_write [ec_message_if_null $stock_status] + } + + ns_write "
    +One-Line Description: + +[ec_message_if_null $one_line_description] +
    +Additional Descriptive Text: + +[ec_display_as_html [ec_message_if_null $detailed_description]] +
    +Search Keywords: + +[ec_message_if_null $search_keywords] +
    +Color Choices: + +[ec_message_if_null $color_list] +
    +Size Choices: + +[ec_message_if_null $size_list] +
    +Style Choices: + +[ec_message_if_null $style_list] +
    +URL: + +[ec_message_if_null $url] +
    +Display this product when user does a search? + +[ec_message_if_null [ec_PrettyBoolean $present_p]] +
    + Shipping Price: + + [ec_message_if_null [ec_pretty_price $shipping $currency]] +
    + Shipping - Additional: + + [ec_message_if_null [ec_pretty_price $shipping_additional $currency]] +
    +Weight: + +[ec_message_if_null $weight] [ec_decode $weight "" "" [ad_parameter WeightUnits ecommerce]] +
    + $user_class_name Price: + + [ec_message_if_null [ec_pretty_price $temp_price $currency]] +
    + $field_name: + + " + if { $column_type == "char(1)" } { + ns_write "[ec_message_if_null [ec_PrettyBoolean [set $field_identifier]]]\n" + } elseif { $column_type == "date" } { + ns_write "[ec_message_if_null [util_AnsiDatetoPrettyDate [set $field_identifier]]]\n" + } else { + ns_write "[ec_display_as_html [ec_message_if_null [set $field_identifier]]]\n" + } + ns_write "
    +Template: + +[ec_message_if_null [database_to_tcl_string_or_null $db "select template_name from ec_templates where template_id='$template_id'"]] +
    +Date Added: + +[util_AnsiDatetoPrettyDate $creation_date] +
    +Date Available: + +[util_AnsiDatetoPrettyDate $available_date] +
    +Directory Name (where image & other product info is kept): + +$dirname_cell +
    +(Edit) +

    + +

    + +

    Miscellaneous

    + +
      +" +if { $multiple_retailers_p } { + ns_write "
    • Retailer Offers + " +} + +ns_write " +

      +

    • Delete +

      +" +# Set audit variables +# audit_name, audit_id, audit_id_column, return_url, audit_tables, main_tables +set audit_name $product_name +set audit_id $product_id +set audit_id_column "product_id" +set return_url "[ns_conn url]?[export_url_vars product_id]" +set audit_tables [list ec_products_audit ec_custom_p_field_values_audit ec_category_product_map_audit ec_subcat_prod_map_audit ec_subsubcat_prod_map_audit] +set main_tables [list ec_products ec_custom_product_field_values ec_category_product_map ec_subcategory_product_map ec_subsubcategory_product_map] + +ns_write "

    • Audit Trail + +
    +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/recommendation-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/recommendation-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/recommendation-add-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,47 @@ +# recommendation-add-2.tcl,v 3.0 2000/02/06 03:20:34 ron Exp +set_the_usual_form_variables +#product_id product_name + +ReturnHeaders + +ns_write "[ad_admin_header "Add a Product Recommendation"] + +

    Add a Product Recommendation

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "recommendations.tcl" "Recommendations"] "Add One"] + +
    + +
    +[export_form_vars product_id product_name] + + + + + + + + +" +set db [ns_db gethandle] + +ns_write " + + + + + + + + + +
    Product:$product_name
    Recommended For:[ec_user_class_widget $db]
    Display Recommendation In:[ec_category_widget $db "f" "" "t"]
    Accompanying Text
    (HTML format):
    + +
    + +
    + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/recommendation-add-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/recommendation-add-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/recommendation-add-3.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,83 @@ +# recommendation-add-3.tcl,v 3.0 2000/02/06 03:20:36 ron Exp +set_the_usual_form_variables +# product_id product_name user_class_id recommendation_text categorization + +# deal w/categorization for display purposes +set category_list [list] +set subcategory_list [list] +set subsubcategory_list [list] +for { set counter 0 } { $counter < [llength $categorization] } {incr counter} { + if { $counter == 0 } { + lappend category_list [lindex $categorization 0] + } + if { $counter == 1 } { + lappend subcategory_list [lindex $categorization 1] + } + if { $counter == 2 } { + lappend subsubcategory_list [lindex $categorization 2] + } +} + + +set db [ns_db gethandle] +set recommendation_id [database_to_tcl_string $db "select ec_recommendation_id_sequence.nextval from dual"] + +ReturnHeaders + +ns_write "[ad_admin_header "Confirm Product Recommendation"] + +

    Confirm Product Recommendation

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "recommendations.tcl" "Recommendations"] "Add One"] + +
    + +Please confirm your product recommendation: + +
    + + + + + + + + +" +if { ![empty_string_p $user_class_id] } { + ns_write " + " +} else { + ns_write " + " +} +ns_write " + + +" +if { [empty_string_p $categorization] } { + ns_write "" +} else { + ns_write "" +} + +ns_write " + + + + +
    Product:$product_name
    Recommended For:[database_to_tcl_string $db "select user_class_name from ec_user_classes where user_class_id=$user_class_id"]All Users
    Display Recommendation In:Top Level[ec_category_subcategory_and_subsubcategory_display $db $category_list $subcategory_list $subsubcategory_list]
    Accompanying Text
    (HTML format):    		$recommendation_text
    + +
    + +
    +[export_form_vars product_id product_name user_class_id recommendation_text recommendation_id categorization] + +
    + +
    + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/recommendation-add-4.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/recommendation-add-4.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/recommendation-add-4.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,49 @@ +# recommendation-add-4.tcl,v 3.0 2000/02/06 03:20:37 ron Exp +set_the_usual_form_variables + +# product_id product_name user_class_id recommendation_text recommendation_id categorization + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +# we only want to insert this into the last level of the categorization +set category_id "" +set subcategory_id "" +set subsubcategory_id "" +if { [llength $categorization] == 1 } { + set category_id [lindex $categorization 0] +} elseif { [llength $categorization] == 2 } { + set subcategory_id [lindex $categorization 1] +} elseif { [llength $categorization] == 3 } { + set subsubcategory_id [lindex $categorization 2] +} + +set db [ns_db gethandle] + +# see if recommendation is already in the database, in which case they +# pushed submit twice, so just redirect + +set n_occurrences [database_to_tcl_string $db "select count(*) from ec_product_recommendations where recommendation_id=$recommendation_id"] + +if { $n_occurrences > 0 } { + ns_returnredirect "recommendations.tcl" + return +} + +ns_db dml $db "insert into ec_product_recommendations +(recommendation_id, product_id, user_class_id, recommendation_text, active_p, category_id, subcategory_id, subsubcategory_id, +last_modified, last_modifying_user, modified_ip_address) +values +($recommendation_id, $product_id, '$user_class_id','$QQrecommendation_text', 't', '$category_id', '$subcategory_id', '$subsubcategory_id', +sysdate, '$user_id', '[DoubleApos [ns_conn peeraddr]]') +" + +ns_returnredirect "recommendations.tcl" Index: web/openacs/www/admin/ecommerce/products/recommendation-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/recommendation-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/recommendation-add.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,42 @@ +# recommendation-add.tcl,v 3.0 2000/02/06 03:20:39 ron Exp +set_the_usual_form_variables +# product_name_query + +set db [ns_db gethandle] +set selection [ns_db select $db "select product_name, product_id +from ec_products +where upper(product_name) like '%[string toupper $QQproduct_name_query]%'"] + +set header_to_print "Please choose the product you wish to recommend. +
      +" + +ReturnHeaders + +ns_write "[ad_admin_header "Add a Product Recommendation"] + +

      Add a Product Recommendation

      + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "recommendations.tcl" "Recommendations"] "Add One"] + +
      +" + +set header_written_p 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $header_written_p == 0 } { + ns_write $header_to_print + incr header_written_p + } + ns_write "
    • $product_name \[view | recommend\] ($product_id)\n" +} + +if { $header_written_p } { + ns_write "
    " +} else { + ns_write "No matching products were found." +} + +ns_write "[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/recommendation-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/recommendation-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/recommendation-delete-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,19 @@ +# recommendation-delete-2.tcl,v 3.0 2000/02/06 03:20:40 ron Exp +# recommendation-delete-2.tcl +# +# by philg@mit.edu on July 18, 1999 +# +# actually deletes the row +# + +set_the_usual_form_variables + +# recommendation_id + +set db [ns_db gethandle] + +ns_db dml $db "delete from ec_product_recommendations where recommendation_id=$recommendation_id" + +ad_audit_delete_row $db [list $recommendation_id] [list recommendation_id] ec_product_recommend_audit + +ns_returnredirect "recommendations.tcl" Index: web/openacs/www/admin/ecommerce/products/recommendation-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/recommendation-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/recommendation-delete.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,47 @@ +# recommendation-delete.tcl,v 3.0 2000/02/06 03:20:42 ron Exp +# recommendation-delete.tcl +# +# by philg@mit.edu on July 18, 1999 +# +# confirmation page, takes no action +# + +set_the_usual_form_variables + +# recommendation_id + +set db [ns_db gethandle] +set selection [ns_db 1row $db "select r.*, p.product_name +from ec_product_recommendations r, ec_products p +where recommendation_id=$recommendation_id +and r.product_id=p.product_id"] +set_variables_after_query + +if { ![empty_string_p $user_class_id] } { + set user_class_description "to [database_to_tcl_string $db "select user_class_name from ec_user_classes where user_class_id=$user_class_id"]" +} else { + set user_class_description "to all users" +} + +ns_db releasehandle $db + +ns_return 200 text/html "[ad_admin_header "Really Delete Product Recommendation?"] + +

    Confirm

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "recommendations.tcl" "Recommendations"] [list "recommendation.tcl?[export_url_vars recommendation_id]" "One"] "Confirm Deletion"] + +
    + +Are you sure that you want to delete this recommendation of +$product_name ($user_class_description)? + +
    +
    +[export_form_vars recommendation_id] + +
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/recommendation-text-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/recommendation-text-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/recommendation-text-edit-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,30 @@ +# recommendation-text-edit-2.tcl,v 3.0 2000/02/06 03:20:43 ron Exp +# recommendation-text-edit-2.tcl +# +# by philg@mit.edu on July 18, 1999 +# +# actually updates the row +# + +set_the_usual_form_variables + +# recommendation_id, recommendation_text + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +ns_db dml $db "update ec_product_recommendations +set recommendation_text = '$QQrecommendation_text', last_modified=sysdate, last_modifying_user='$user_id', modified_ip_address='[DoubleApos [ns_conn peeraddr]]' +where recommendation_id=$recommendation_id" + +ns_returnredirect "recommendation.tcl?[export_url_vars recommendation_id]" Index: web/openacs/www/admin/ecommerce/products/recommendation-text-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/recommendation-text-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/recommendation-text-edit.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,46 @@ +# recommendation-text-edit.tcl,v 3.0 2000/02/06 03:20:44 ron Exp +# recommendation-text-edit.tcl +# +# by philg@mit.edu on July 18, 1999 +# +# entry form to let user edit the HTML text of a recommendation +# + +set_the_usual_form_variables + +# recommendation_id + +set db [ns_db gethandle] +set selection [ns_db 1row $db "select r.*, p.product_name +from ec_product_recommendations r, ec_products p +where recommendation_id=$recommendation_id +and r.product_id=p.product_id"] +set_variables_after_query + +ns_db releasehandle $db + +ns_return 200 text/html "[ad_admin_header "Edit Product Recommendation Text"] + +

    Edit Recommendation Text

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "recommendations.tcl" "Recommendations"] [list "recommendation.tcl?[export_url_vars recommendation_id]" "One"] "Edit Recommendation"] + +
    + +Edit text for the recommendation of $product_name: + +
    +
    +[export_form_vars recommendation_id] + +

    +

    + + +
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/recommendation.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/recommendation.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/recommendation.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,83 @@ +# recommendation.tcl,v 3.0 2000/02/06 03:20:45 ron Exp +set_the_usual_form_variables + +# recommendation_id + +set db [ns_db gethandle] +set selection [ns_db 1row $db "select r.*, p.product_name +from ec_recommendations_cats_view r, ec_products p +where recommendation_id=$recommendation_id +and r.product_id=p.product_id"] +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "Product Recommendation"] + +

    Product Recommendation

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "recommendations.tcl" "Recommendations"] "One"] + +
    + +
    + + + + + + + + +" +if { ![empty_string_p $user_class_id] } { + ns_write " + " +} else { + ns_write " + " +} +ns_write " + + +" +if { [empty_string_p $the_category_id] && [empty_string_p $the_subcategory_id] && [empty_string_p $the_subsubcategory_id] } { + ns_write "" +} else { + ns_write "" +} + +ns_write " + + + + +
    Product:$product_name
    Recommended For:[database_to_tcl_string $db "select user_class_name from ec_user_classes where user_class_id=$user_class_id"]All Users
    Display Recommendation In:Top Level[ec_category_subcategory_and_subsubcategory_display $db $the_category_id $the_subcategory_id $the_subsubcategory_id]
    Accompanying Text
    (HTML format):    		$recommendation_text +

    +(edit) +

    + +
    +" + +# Set audit variables +# audit_name, audit_id, audit_id_column, return_url, audit_tables, main_tables +set audit_name Recommendation +set audit_id $recommendation_id +set audit_id_column "recommendation_id" +set return_url "[ns_conn url]?[export_url_vars product_id]" +set audit_tables [list ec_product_recommend_audit] +set main_tables [list ec_product_recommendations] + +ns_write " + + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/recommendations.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/recommendations.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/recommendations.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,126 @@ +# recommendations.tcl,v 3.0 2000/02/06 03:20:47 ron Exp + +ReturnHeaders + +ns_write "[ad_admin_header "Product Recommendations"] + +

    Product Recommendations

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] "Recommendations"] + +
    + +

    Currently Recommended Products

    + +These products show up when the customer is browsing the site, either on the +home page (if a product is recommended at the top level), or when the +customer is browsing categories, subcategories, or subsubcategories. + +

    + +You can also associate product recommendations with a user classs if you +only want people in that user class to see a given recommendation. + +

      + +" + +# For Audit tables +set table_names_and_id_column [list ec_product_recommendations ec_product_recommend_audit product_id] + +set db [ns_db gethandle] + +set selection [ns_db select $db " +(select + r.recommendation_id, r.the_category_name, r.the_subcategory_name, r.the_subsubcategory_name, + p.product_name, + c.user_class_name +from ec_recommendations_cats_view r, ec_products p, ec_user_classes c +where r.active_p='t' +and r.user_class_id = c.user_class_id +and r.product_id = p.product_id) union +(select + r.recommendation_id, r.the_category_name, r.the_subcategory_name, r.the_subsubcategory_name, + p.product_name, + null as user_class_name +from ec_recommendations_cats_view r, ec_products p +where r.active_p='t' +and r.user_class_id is null +and r.product_id = p.product_id) +order by case when the_category_name is NULL then 0 else 1 end, upper(the_category_name), upper(the_subcategory_name), upper(the_subsubcategory_name)"] + +set last_category "" +set last_subcategory "" +set last_subsubcategory "" +set subcat_ul_open_p 0 +set subsubcat_ul_open_p 0 + +set moby_string "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $the_category_name != $last_category } { + append moby_string "

      $the_category_name

      \n" + set last_category $the_category_name + set last_subcategory "" + set last_subsubcategory "" + } + if { $the_subcategory_name != $last_subcategory } { + if $subsubcat_ul_open_p { + append moby_string "
    " + set subsubcat_ul_open_p 0 + } + if $subcat_ul_open_p { + append moby_string "" + set subcat_ul_open_p 0 + } + append moby_string "
      $the_subcategory_name
      \n" + set last_subcategory $the_subcategory_name + set last_subsubcategory "" + set subcat_ul_open_p 1 + } + if { $the_subsubcategory_name != $last_subsubcategory } { + if $subsubcat_ul_open_p { + append moby_string "
    " + set subsubcat_ul_open_p 0 + } + append moby_string "
      $the_subsubcategory_name
      " + set last_subsubcategory $ + set subsubcat_ul_open_p 1 + } + append moby_string "
    • $product_name [ec_decode $user_class_name "" "" "($user_class_name)"]\n" +} + +if $subsubcat_ul_open_p { + append moby_string "
    " + set subsubcat_ul_open_p 0 +} +if $subcat_ul_open_p { + append moby_string "" + set subcat_ul_open_p 0 +} + +ns_write " + +$moby_string + + + +

    Add a Recommendation

    + +
    + +
    +Search for a product to recommend: + + +
    + +

    Options

    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/review-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/review-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/review-add-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,32 @@ +# review-add-2.tcl,v 3.0 2000/02/06 03:20:48 ron Exp +set_the_usual_form_variables +# product_id, product_name, publication, display_p, review, +# review_id, author_name, review_date + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +# see if this review is already there +if { [database_to_tcl_string $db "select count(*) from ec_product_reviews where review_id=$review_id"] > 0 } { + ns_returnredirect "reviews.tcl?[export_url_vars product_id product_name]" + return +} + +ns_db dml $db "insert into ec_product_reviews +(review_id, product_id, publication, author_name, review, display_p, review_date, last_modified, last_modifying_user, modified_ip_address) +values +($review_id, $product_id, '$QQpublication', '$QQauthor_name', '$QQreview', '$QQdisplay_p', '$review_date', +sysdate, $user_id, '[DoubleApos [ns_conn peeraddr]]') +" + +ns_returnredirect "reviews.tcl?[export_url_vars product_id]" Index: web/openacs/www/admin/ecommerce/products/review-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/review-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/review-add.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,80 @@ +# review-add.tcl,v 3.0 2000/02/06 03:20:49 ron Exp +set_the_usual_form_variables +# product_id, publication, display_p, review +# author_name, review_date + +set product_name [ec_product_name $product_id] + +# Check review_date is correct format +set form [ns_getform] + +set exception_count 0 +set exception_text "" + +# ns_dbformvalue $form review_date date review_date will give an error +# message if the day of the month is 08 or 09 (this octal number problem +# we've had in other places). So I'll have to trim the leading zeros +# from ColValue.review%5fdate.day and stick the new value into the $form +# ns_set. + +set "ColValue.review%5fdate.day" [string trimleft [set ColValue.review%5fdate.day] "0"] +ns_set update $form "ColValue.review%5fdate.day" [set ColValue.review%5fdate.day] + +# check that either all elements are blank or date is formated +# correctly for ns_dbformvalue +if { [empty_string_p [set ColValue.review%5fdate.day]] && + [empty_string_p [set ColValue.review%5fdate.year]] && + [empty_string_p [set ColValue.review%5fdate.month]] } { + set review_date "" + } elseif { [catch { ns_dbformvalue $form review_date date review_date} errmsg ] } { + incr exception_count + append exception_text "
  • The date or time was specified in the wrong format. The date should be in the format Month DD YYYY.\n" +} elseif { ![empty_string_p [set ColValue.review%5fdate.year]] && [string length [set ColValue.review%5fdate.year]] != 4 } { + incr exception_count + append exception_text "
  • The year needs to contain 4 digits.\n" +} + +# If errors, return error page +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +ReturnHeaders +ns_write "[ad_admin_header "Confirm Review of $product_name"] + +

    Confirm Review of $product_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "one.tcl?[export_url_vars product_id]" $product_name] [list "reviews.tcl?[export_url_vars product_id product_name]" "Professional Reviews"] "Confirm Review"] + +
    + + + + + + + + + + + + + + +
    Summary[ec_product_review_summary $author_name $publication $review_date]
    Display on web site?[util_PrettyBoolean $display_p]
    Review$review
    +" + +set db [ns_db gethandle] +set review_id [database_to_tcl_string $db "select ec_product_review_id_sequence.nextval from dual"] + +ns_write " +[export_form_vars product_id publication display_p review review_id author_name review_date] + +
    + +
    +
    • + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/review-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/review-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/review-edit.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,58 @@ +# review-edit.tcl,v 3.0 2000/02/06 03:20:50 ron Exp +set_the_usual_form_variables +# product_id, publication, author_name, review_date, display_p, review, review_id + +# Check review_date is correct format +set form [ns_getform] + +set exception_count 0 +set exception_text "" + +# ns_dbformvalue $form review_date date review_date will give an error +# message if the day of the month is 08 or 09 (this octal number problem +# we've had in other places). So I'll have to trim the leading zeros +# from ColValue.review%5fdate.day and stick the new value into the $form +# ns_set. + +set "ColValue.review%5fdate.day" [string trimleft [set ColValue.review%5fdate.day] "0"] +ns_set update $form "ColValue.review%5fdate.day" [set ColValue.review%5fdate.day] + +# check that either all elements are blank or date is formated +# correctly for ns_dbformvalue +if { [empty_string_p [set ColValue.review%5fdate.day]] && + [empty_string_p [set ColValue.review%5fdate.year]] && + [empty_string_p [set ColValue.review%5fdate.month]] } { + set review_date "" + } elseif { [catch { ns_dbformvalue $form review_date date review_date} errmsg ] } { + incr exception_count + append exception_text "
  • The date or time was specified in the wrong format. The date should be in the format Month DD YYYY.\n" +} elseif { ![empty_string_p [set ColValue.review%5fdate.year]] && [string length [set ColValue.review%5fdate.year]] != 4 } { + incr exception_count + append exception_text "
  • The year needs to contain 4 digits.\n" +} + +# If errors, return error page +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +ns_db dml $db "update ec_product_reviews +set product_id=$product_id, publication='$QQpublication', author_name='$QQauthor_name', review_date='$review_date', review='$QQreview', display_p='$QQdisplay_p', last_modified=sysdate(), last_modifying_user='$user_id', modified_ip_address='[DoubleApos [ns_conn peeraddr]]' +where review_id=$review_id +" + +ns_returnredirect "review.tcl?[export_url_vars review_id]" Index: web/openacs/www/admin/ecommerce/products/review.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/review.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/review.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,125 @@ +# review.tcl,v 3.0 2000/02/06 03:20:51 ron Exp +set_the_usual_form_variables +# review_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select * from ec_product_reviews where review_id=$review_id"] +set_variables_after_query + +set product_name [ec_product_name $product_id] + +ReturnHeaders +ns_write "[ad_admin_header "Professional Review of $product_name"] + +

    Professional Review of $product_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "one.tcl?[export_url_vars product_id]" $product_name] [list "reviews.tcl?[export_url_vars product_id]" "Professional Reviews"] "One Review"] + +
    +

    The Review

    +
    + + + + + + + + + + + + + +
    Summary[ec_product_review_summary $author_name $publication $review_date]
    Display on web site?[util_PrettyBoolean $display_p]
    Review$review
    +
    + +

    + +

    Edit this Review

    + +
    + +
    +[export_form_vars review_id product_id] + + + + + + + + + + + + + + + + + + + + + + +
    +Publication + + +
    +Reviewed By + + +
    +Reviewed On + +[ad_dateentrywidget review_date $review_date] +
    +Display on web site? + +Yes   +No +
    +Review
    +(HTML format) +    		 + +
    + +

    + +

    + +
    + +
    + +
    + +

    Audit Review

    + +
    +
      +" + +# Set audit variables +# audit_name, audit_id, audit_id_column, return_url, audit_tables, main_tables +set audit_name "$product_name, Review:[ec_product_review_summary $author_name $publication $review_date]" +set audit_id $review_id +set audit_id_column "review_id" +set return_url "[ns_conn url]?[export_url_vars review_id]" +set audit_tables [list ec_product_reviews_audit] +set main_tables [list ec_product_reviews] + +ns_write "
    • audit trail + +
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/reviews.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/reviews.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/reviews.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,120 @@ +# reviews.tcl,v 3.0 2000/02/06 03:20:52 ron Exp +# reviews.tcl +# +# by eveander@arsdigita.com June 1999 +# +# summarize professional reviews of one product and let site owner +# add a new review + +set_the_usual_form_variables + +# product_id + +set product_name [ec_product_name $product_id] + + +ReturnHeaders + +ns_write "[ad_admin_header "Professional Reviews of $product_name"] + +

    Professional Reviews

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "one.tcl?[export_url_vars product_id]" "One Product"] "Professional Reviews"] + +
    + +
      +
    • Product Name: $product_name +
    + +

    Current Reviews

    +
      +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select review_id, author_name, publication, review_date, display_p +from ec_product_reviews +where product_id=$product_id"] + +set review_counter 0 +while { [ns_db getrow $db $selection] } { + incr review_counter + set_variables_after_query + ns_write "
    • [ec_product_review_summary $author_name $publication $review_date] + " + if { $display_p != "t" } { + ns_write " (this will not be displayed on the site)" + } +} + +if { $review_counter == 0 } { + ns_write "There are no current reviews.\n" +} + +ns_write "
    + +

    + +

    Add a Review

    + +
    +
    +[export_form_vars product_id] + + + + + + + + + + + + + + + + + + + + + + +
    +Publication + + +
    +Reviewed By + + +
    +Reviewed On + +[ad_dateentrywidget review_date] +
    +Display on web site? + +Yes   +No +
    +Review
    +(HTML format) +    		 + +
    + +

    + +

    + +
    + +
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/sale-price-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/sale-price-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/sale-price-add-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,30 @@ +# sale-price-add-2.tcl,v 3.0 2000/02/06 03:20:53 ron Exp +set_the_usual_form_variables +# sale_price_id product_id product_name sale_price sale_name sale_begins sale_ends offer_code + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +# see if a sale price with this sale_price_id exists, meaning they pushed +# submit twice + +if { [database_to_tcl_string $db "select count(*) from ec_sale_prices where sale_price_id=$sale_price_id"] > 0 } { + ns_returnredirect "sale-prices.tcl?[export_url_vars product_id product_name]" +} + +ns_db dml $db "insert into ec_sale_prices +(sale_price_id, product_id, sale_price, sale_begins, sale_ends, sale_name, offer_code, last_modified, last_modifying_user, modified_ip_address) +values +($sale_price_id, $product_id, $sale_price, '$sale_begins'::datetime, '$sale_ends'::datetime, '$QQsale_name', '$QQoffer_code', sysdate(), $user_id, '[DoubleApos [ns_conn peeraddr]]')" + +ns_returnredirect "sale-prices.tcl?[export_url_vars product_id product_name]" Index: web/openacs/www/admin/ecommerce/products/sale-price-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/sale-price-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/sale-price-add.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,124 @@ +# sale-price-add.tcl,v 3.0 2000/02/06 03:20:54 ron Exp +set_the_usual_form_variables +# product_id, product_name, sale_price, sale_name, sale_begins (in parts), +# sale_ends (in parts), offer_code_needed (no, yes_supplied, yes_generate) and maybe offer_code + +set exception_count 0 +set exception_text "" + +if { ![info exists sale_price] || [empty_string_p $sale_price] } { + incr exception_count + append exception_text "
  • You forgot to enter the sale price\n" +} elseif { [regexp {[^0-9\.]} $sale_price] } { + incr exception_count + append exception_text "
  • The sale price must be a number." +} + +if { ![info exists sale_name] || [empty_string_p $sale_name] } { + # just set it to "Sale Price" -- don't bother giving them an error + set sale_name "Sale Price" +} + +# deal w/dates +set form [ns_getform] +if [catch { ns_dbformvalue $form sale_begins datetime sale_begins} errmsg ] { + incr exception_count + append exception_text "
  • The date that the sale begins was specified in the wrong format. It should be in the format Month DD YYYY.\n" +} elseif { [string length [set ColValue.sale%5fbegins.year]] < 4 } { + incr exception_count + append exception_text "
  • The year that the sale begins needs to contain 4 digits.\n" +} + +if [catch { ns_dbformvalue $form sale_ends datetime sale_ends} errmsg ] { + incr exception_count + append exception_text "
  • The date that the sale ends was specified in the wrong format. It should be in the format Month DD YYYY.\n" +} elseif { [string length [set ColValue.sale%5fends.year]] < 4 } { + incr exception_count + append exception_text "
  • The year that the sale ends needs to contain 4 digits.\n" +} + +if { [info exists sale_begins] && [empty_string_p $sale_begins] } { + incr exception_count + append exception_text "
  • You forgot to enter the date that the sale begins.\n" +} + +if { [info exists sale_ends] && [empty_string_p $sale_ends] } { + incr exception_count + append exception_text "
  • You forgot to enter the date that the sale ends.\n" +} + +if { ![info exists offer_code_needed] || [empty_string_p $offer_code_needed] } { + incr exception_count + append exception_text "
  • You forgot to specify whether an offer code is needed.\n" +} + +if { [info exists offer_code_needed] && $offer_code_needed == "yes_supplied" && (![info exists offer_code] || [empty_string_p $offer_code]) } { + incr exception_count + append exception_text "
  • You forgot to specify an offer code.\n" +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +# error checking done + +# if offer_code_needed is yes_generate, I need to generate a offer_code +if { $offer_code_needed == "yes_generate" } { + set offer_code [ec_generate_random_string 8] +} + +# for the case where no offer code is required to get the sale price +if { ![info exists offer_code] } { + set offer_code "" +} + +ReturnHeaders +ns_write "[ad_admin_header "Confirm Sale Price for $product_name"] + +

    Confirm Sale Price for $product_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "one.tcl?[export_url_vars product_id]" $product_name] "Confirm Sale Price"] + +
    +" + +set currency [ad_parameter Currency ecommerce] + +set db [ns_db gethandle] + +set sale_price_id [database_to_tcl_string $db "select ec_sale_price_id_sequence.nextval from dual"] + +ns_write " + + + + + + + + + + + + + + + + + + + + +
    Sale Price[ec_pretty_price $sale_price $currency]
    Name$sale_name
    Sale Begins[util_AnsiDatetoPrettyDate [lindex [split $sale_begins " "] 0]] [lindex [split $sale_begins " "] 1]
    Sale Ends[util_AnsiDatetoPrettyDate [lindex [split $sale_ends " "] 0]] [lindex [split $sale_ends " "] 1]
    Offer Code[ec_decode $offer_code "" "None Needed" $offer_code]
    + +
    +[export_form_vars sale_price_id product_id product_name sale_price sale_name sale_begins sale_ends offer_code] +
    + +
    + +
    +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/products/sale-price-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/sale-price-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/sale-price-edit-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,122 @@ +# sale-price-edit-2.tcl,v 3.0 2000/02/06 03:20:55 ron Exp +set_the_usual_form_variables +# sale_price_id, product_id, product_name, sale_price, sale_name, sale_begins (in parts), +# sale_ends (in parts), offer_code_needed (no, yes_supplied, yes_generate) and maybe offer_code + +set exception_count 0 +set exception_text "" + +if { ![info exists sale_price] || [empty_string_p $sale_price] } { + incr exception_count + append exception_text "
  • You forgot to enter the sale price\n" +} elseif { [regexp {[^0-9\.]} $sale_price] } { + incr exception_count + append exception_text "
  • The sale price must be a number." +} + +if { ![info exists sale_name] || [empty_string_p $sale_name] } { + # just set it to "Sale Price" -- don't bother giving them an error + set sale_name "Sale Price" +} + +# deal w/dates +set form [ns_getform] +if [catch { ns_dbformvalue $form sale_begins datetime sale_begins} errmsg ] { + incr exception_count + append exception_text "
  • The date that the sale begins was specified in the wrong format. It should be in the format Month DD YYYY.\n" +} elseif { [string length [set ColValue.sale%5fbegins.year]] < 4 } { + incr exception_count + append exception_text "
  • The year that the sale begins needs to contain 4 digits.\n" +} + +if [catch { ns_dbformvalue $form sale_ends datetime sale_ends} errmsg ] { + incr exception_count + append exception_text "
  • The date that the sale ends was specified in the wrong format. It should be in the format Month DD YYYY.\n" +} elseif { [string length [set ColValue.sale%5fends.year]] < 4 } { + incr exception_count + append exception_text "
  • The year that the sale ends needs to contain 4 digits.\n" +} + +if { [info exists sale_begins] && [empty_string_p $sale_begins] } { + incr exception_count + append exception_text "
  • You forgot to enter the date that the sale begins.\n" +} + +if { [info exists sale_ends] && [empty_string_p $sale_ends] } { + incr exception_count + append exception_text "
  • You forgot to enter the date that the sale ends.\n" +} + +if { ![info exists offer_code_needed] || [empty_string_p $offer_code_needed] } { + incr exception_count + append exception_text "
  • You forgot to specify whether an offer code is needed.\n" +} + +if { [info exists offer_code_needed] && $offer_code_needed == "yes_supplied" && (![info exists offer_code] || [empty_string_p $offer_code]) } { + incr exception_count + append exception_text "
  • You forgot to specify an offer code.\n" +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +# error checking done + +# if offer_code_needed is yes_generate, I need to generate a offer_code +if { $offer_code_needed == "yes_generate" } { + set offer_code [ec_generate_random_string 8] +} + +# for the case where no offer code is required to get the sale price +if { ![info exists offer_code] } { + set offer_code "" +} + +ReturnHeaders +ns_write "[ad_admin_header "Confirm Sale Price for $product_name"] + +

    Confirm Sale Price for $product_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "one.tcl?[export_url_vars product_id]" $product_name] "Confirm Sale Price"] + +
    +" + +set currency [ad_parameter Currency ecommerce] + +set db [ns_db gethandle] + +ns_write " + + + + + + + + + + + + + + + + + + + + +
    Sale Price[ec_pretty_price $sale_price $currency]
    Name$sale_name
    Sale Begins[util_AnsiDatetoPrettyDate [lindex [split $sale_begins " "] 0]] [lindex [split $sale_begins " "] 1]
    Sale Ends[util_AnsiDatetoPrettyDate [lindex [split $sale_ends " "] 0]] [lindex [split $sale_ends " "] 1]
    Offer Code[ec_decode $offer_code "" "None Needed" $offer_code]
    + +
    +[export_form_vars sale_price_id product_id product_name sale_price sale_name sale_begins sale_ends offer_code] +
    + +
    + +
    +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/products/sale-price-edit-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/sale-price-edit-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/sale-price-edit-3.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,21 @@ +# sale-price-edit-3.tcl,v 3.0 2000/02/06 03:20:56 ron Exp +set_the_usual_form_variables +# sale_price_id product_id product_name sale_price sale_name sale_begins sale_ends offer_code + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + + +ns_db dml $db "update ec_sale_prices set sale_price=$sale_price, sale_begins=to_date('$sale_begins','YYYY-MM-DD HH24:MI:SS'), sale_ends=to_date('$sale_ends','YYYY-MM-DD HH24:MI:SS'), sale_name='$QQsale_name', offer_code='$QQoffer_code', last_modified=sysdate(), last_modifying_user=$user_id, modified_ip_address='[DoubleApos [ns_conn peeraddr]]' where sale_price_id=$sale_price_id" + +ns_returnredirect "sale-prices.tcl?[export_url_vars product_id product_name]" Index: web/openacs/www/admin/ecommerce/products/sale-price-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/sale-price-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/sale-price-edit.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,59 @@ +# sale-price-edit.tcl,v 3.0 2000/02/06 03:20:57 ron Exp +set_the_usual_form_variables +# product_id, product_name, sale_price_id + +ReturnHeaders + +ns_write "[ad_admin_header "Edit Sale Price for $product_name"] + +

    Edit Sale Price for $product_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "one.tcl?[export_url_vars product_id]" $product_name] "Edit Sale Price"] + +
    +
    + +[export_form_vars product_id product_name sale_price_id] +" + +set db [ns_db gethandle] +set selection [ns_db 1row $db "select sale_price, to_char(sale_begins,'YYYY-MM-DD HH24:MI:SS') as sale_begins, to_char(sale_ends,'YYYY-MM-DD HH24:MI:SS') as sale_ends, sale_name, offer_code from ec_sale_prices where sale_price_id=$sale_price_id"] +set_variables_after_query + +ns_write " + + + + + + + + + + + + + + + + + + + + +
    Sale Price (in [ad_parameter Currency ecommerce])
    Name (like Special Offer or Introductory Price or Sale Price)
    Sale Begins[ad_dateentrywidget sale_begins [ec_date_with_time_stripped $sale_begins]] [ec_timeentrywidget sale_begins $sale_begins]
    Sale Ends[ad_dateentrywidget sale_ends [ec_date_with_time_stripped $sale_ends]] [ec_timeentrywidget sale_ends $sale_ends]
    Offer Code None needed
    + Require this code: +
    + Please generate a [ec_decode $offer_code "" "" "new "]code +
    + +

    + +

    + +
    + +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/products/sale-price-expire-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/sale-price-expire-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/sale-price-expire-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,19 @@ +# sale-price-expire-2.tcl,v 3.0 2000/02/06 03:20:59 ron Exp +set_the_usual_form_variables +# product_id, product_name, sale_price_id + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] +ns_db dml $db "update ec_sale_prices set sale_ends=sysdate, last_modified=sysdate, last_modifying_user=$user_id, modified_ip_address='[DoubleApos [ns_conn peeraddr]]' where sale_price_id=$sale_price_id" + +ns_returnredirect "sale-prices.tcl?[export_url_vars product_id product_name]" Index: web/openacs/www/admin/ecommerce/products/sale-price-expire.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/sale-price-expire.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/sale-price-expire.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,30 @@ +# sale-price-expire.tcl,v 3.0 2000/02/06 03:21:00 ron Exp +set_the_usual_form_variables +# product_id, product_name, sale_price_id + +ReturnHeaders + +ns_write "[ad_admin_header "Expire Sale Price for $product_name"] + +

    Expire Sale Price for $product_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "one.tcl?[export_url_vars product_id]" $product_name] "Expire Sale Price"] + +
    + +Please confirm that you want to end the sale price right now. + +
    + +[export_form_vars product_id product_name sale_price_id] + +

    + +

    + +
    + +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/products/sale-prices.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/sale-prices.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/sale-prices.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,155 @@ +# sale-prices.tcl,v 3.0 2000/02/06 03:21:01 ron Exp +# sale-prices.tcl +# +# by eveander@arsdigita.com June 1999 +# +# let's site admin define a special time-limited price for an item + +set_the_usual_form_variables + +# product_id + +set product_name [ec_product_name $product_id] + +proc ec_write_out_one_sale {} { + uplevel { + ns_write "
  • $sale_name
    + Price: [ec_message_if_null [ec_pretty_price $sale_price $currency]]
    + Sale Begins: [util_AnsiDatetoPrettyDate [ec_date_with_time_stripped $sale_begins]] [lindex [split $sale_begins " "] 1]
    + Sale Ends: [util_AnsiDatetoPrettyDate [ec_date_with_time_stripped $sale_ends]] [lindex [split $sale_ends " "] 1]
    + [ec_decode $offer_code "" "" "Offer Code: $offer_code
    "] + " + if { !$sale_begun_p } { + ns_write "This sale has not yet begun.
    \n" + } elseif { $sale_expired_p } { + ns_write "This sale has ended.
    \n" + } + + ns_write "\[edit[ec_decode $sale_expired_p "0" " | expire now" ""]" + + # Set audit variables + # audit_name, id, id_column, return_url, audit_tables, main_tables + set audit_name "$product_name Sale" + set id $sale_price_id + set id_column "sale_price_id" + set return_url "sale-prices.tcl?[export_url_vars product_id product_name]" + set audit_tables [list ec_sale_prices_audit] + set main_tables [list ec_sale_prices] + + ns_write " | audit trail\] +

    + " + } +} + +ReturnHeaders +ns_write "[ad_admin_header "Sale Prices for $product_name"] + +

    Sale Price for $product_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "one.tcl?[export_url_vars product_id]" "One"] "Sale Prices"] + +
    +

    Current Sale Prices

    +
      +" +set currency [ad_parameter Currency ecommerce] + +set db [ns_db gethandle] + +set selection [ns_db select $db "select sale_price_id, sale_name, sale_price, offer_code, to_char(sale_begins,'YYYY-MM-DD HH24:MI:SS') as sale_begins, to_char(sale_ends,'YYYY-MM-DD HH24:MI:SS') as sale_ends, case when sysdate()>=sale_begins then 1 else 0 end as sale_begun_p, case when sysdate()>sale_ends then 1 else 0 end as sale_expired_p +from ec_sale_prices_current +where product_id=$product_id +order by last_modified desc"] + +set sale_price_counter 0 +while { [ns_db getrow $db $selection] } { + incr sale_price_counter + set_variables_after_query + ec_write_out_one_sale +} + +if { $sale_price_counter == 0 } { + ns_write "There are no current sale prices.\n" +} + +ns_write "
    + +

    + +

    Add a Sale Price

    + +
    + +
    +[export_form_vars product_id product_name] + + + + + + + + + + + + + + + + + + + + + + +
    Sale Price (in $currency)
    Name (like Special Offer or Introductory Price or Sale Price)
    Sale Begins[ad_dateentrywidget sale_begins] [ec_timeentrywidget sale_begins "x 00:00:00"]
    Sale Ends[ad_dateentrywidget sale_ends] [ec_timeentrywidget sale_ends "x 23:59:59"]
    Offer Code None needed
    + Require this code: +
    + Please generate a code +
    + +

    + +

    + +
    + +
    + +
    + +

    + +

    Old or Yet-to-Come Sale Prices

    + +
      +" +set currency [ad_parameter Currency ecommerce] + +set selection [ns_db select $db "select sale_price_id, sale_name, sale_price, offer_code, to_char(sale_begins,'YYYY-MM-DD HH24:MI:SS') as sale_begins, to_char(sale_ends,'YYYY-MM-DD HH24:MI:SS') as sale_ends, case when sysdate()>sale_begins then 1 else 0 end as sale_begun_p, case when sysdate()>sale_ends then 1 else 0 end as sale_expired_p +from ec_sale_prices +where product_id=$product_id +and (sale_begins < sysdate() or sale_ends > sysdate()) +order by last_modified desc"] + +set sale_price_counter 0 +while { [ns_db getrow $db $selection] } { + incr sale_price_counter + set_variables_after_query + ec_write_out_one_sale +} + +if { $sale_price_counter == 0 } { + ns_write "There are no non-current sale prices.\n" +} + +ns_write "
    + +To let customers take advantage a sale price that requires an offer_code, send them to the URL +of the product display page with &offer_code=offer_code +appended to the URL. +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/search.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/search.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/search.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,48 @@ +# search.tcl,v 3.0 2000/02/06 03:21:02 ron Exp +set_the_usual_form_variables + +# product_id or product_name + +if { [info exists product_id] } { + set additional_query_part "product_id=[ns_dbquotevalue $product_id number]" + set description "Products with id #$product_id:" +} else { + set additional_query_part "upper(product_name) like '%[string toupper $QQproduct_name]%'" + set description "Products whose name includes \"$product_name\":" +} + +ReturnHeaders + +ns_write "[ad_admin_header "Product Search"] + +

    Product Search

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] "Product Search"] + +
    + +$description + +
      +" + + +set db [ns_db gethandle] +set selection [ns_db select $db "select product_id, product_name from ec_products where $additional_query_part"] + +set product_counter 0 +while {[ns_db getrow $db $selection]} { + incr product_counter + set_variables_after_query + ns_write "
    • $product_name\n" +} + +if { $product_counter == 0 } { + ns_write "No matching products were found.\n" +} + +ns_write "
    + + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/subsubcategory-property-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/subsubcategory-property-toggle.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/subsubcategory-property-toggle.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,20 @@ +# subsubcategory-property-toggle.tcl,v 3.0 2000/02/06 03:21:03 ron Exp +set_the_usual_form_variables +# product_id and publisher_favorite_p +# and, for the purpose of redirecting back, category_id, category_name, subcategory_id, subcategory_name, subsubcategory_id, subsubcategory_name + +if { [info exists publisher_favorite_p] && ![empty_string_p $publisher_favorite_p] } { + set thing_to_update "publisher_favorite_p='$publisher_favorite_p'" +} + + +if { ![info exists thing_to_update] } { + ad_return_complaint 1 "
  • No column to update has been specified.\n" +} + +set db [ns_db gethandle] +ns_db dml $db "update ec_subsubcategory_product_map +set $thing_to_update +where product_id=$product_id" + +ns_returnredirect one-subsubcategory.tcl?[export_url_vars category_id category_name subcategory_id subcategory_name subsubcategory_id subsubcategory_name] Index: web/openacs/www/admin/ecommerce/products/supporting-file-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/supporting-file-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/supporting-file-delete-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,19 @@ +# supporting-file-delete-2.tcl,v 3.0 2000/02/06 03:21:04 ron Exp +set_the_usual_form_variables +# file product_id + +if { [regexp {/} $file] } { + error "Invalid filename." +} + +set db [ns_db gethandle] +set dirname [database_to_tcl_string $db "select dirname from ec_products where product_id=$product_id"] +ns_db releasehandle $db + +set subdirectory [ec_product_file_directory $product_id] + +set full_dirname "[ad_parameter EcommerceDataDirectory ecommerce][ad_parameter ProductDataDirectory ecommerce]$subdirectory/$dirname" + +exec rm $full_dirname/$file + +ns_returnredirect "supporting-files-upload.tcl?[export_url_vars product_id]" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/products/supporting-file-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/supporting-file-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/supporting-file-delete.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,29 @@ +# supporting-file-delete.tcl,v 3.0 2000/02/06 03:21:05 ron Exp +set_the_usual_form_variables +# file product_id product_name + +ReturnHeaders +ns_write "[ad_admin_header "Delete Supporting File for $product_name"] + +

    Delete Supporting File for $product_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "one.tcl?[export_url_vars product_id]" $product_name] "Delete Supporting File"] + +
    + +Please confirm that you wish to delete this file. +" + +if { $file == "product-thumbnail.jpg" } { + ns_write "Note: this file is the thumbnail picture of the product. If you delete it, the customer will not be able to see what the product looks like." +} + +ns_write "
    +[export_form_vars file product_id] +
    + +
    +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/products/supporting-files-upload-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/supporting-files-upload-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/supporting-files-upload-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,30 @@ +# supporting-files-upload-2.tcl,v 3.0 2000/02/06 03:21:06 ron Exp +set_the_usual_form_variables +# upload_file, product_id + +if { ![info exists upload_file] || [string compare $upload_file ""] == 0 } { + ad_return_complaint 1 "
  • You didn't specify a file to upload.\n" + return +} + + +set tmp_filename [ns_queryget upload_file.tmpfile] + +set subdirectory [ec_product_file_directory $product_id] + +set db [ns_db gethandle] +set dirname [database_to_tcl_string $db "select dirname from ec_products where product_id=$product_id"] +ns_db releasehandle $db + +set full_dirname "[ad_parameter EcommerceDataDirectory ecommerce][ad_parameter ProductDataDirectory ecommerce]$subdirectory/$dirname" + +if ![regexp {([^//\]+)$} $upload_file match client_filename] { + # couldn't find a match + set client_filename $upload_file +} + +set perm_filename "$full_dirname/$client_filename" + +ns_cp $tmp_filename $perm_filename + +ns_returnredirect "supporting-files-upload.tcl?[export_url_vars product_id]" Index: web/openacs/www/admin/ecommerce/products/supporting-files-upload.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/supporting-files-upload.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/supporting-files-upload.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,77 @@ +# supporting-files-upload.tcl,v 3.0 2000/02/06 03:21:07 ron Exp +set_the_usual_form_variables + +# product_id + +set product_name [ec_product_name $product_id] + +ReturnHeaders + +ns_write "[ad_admin_header "Supporting Files for $product_name"] + +

    Supporting Files for $product_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] [list "one.tcl?[export_url_vars product_id]" "One"] "Supporting Files"] + +
    +

    Current Supporting Files

    +
      +" + +set db [ns_db gethandle] +set dirname [database_to_tcl_string $db "select dirname from ec_products where product_id=$product_id"] + +# make sure there are no /'s in dirname +if { [regexp {/} $dirname] } { + error "Invalid dirname." +} + +if { ![empty_string_p $dirname] } { + set subdirectory [ec_product_file_directory $product_id] + + set full_dirname "[ad_parameter EcommerceDataDirectory ecommerce][ad_parameter ProductDataDirectory ecommerce]$subdirectory/$dirname" + + # see what's in that directory + set files [exec ls $full_dirname] + set file_list [split $files "\n"] + + foreach file $file_list { + ns_write "
    • $file \[delete]\n" + } + + if { [string length $file_list] == 0 } { + ns_write "No files found.\n" + } +} else { + ns_write "No directory found.\n" +} + +ns_write "
    + +

    Upload New File

    + +
    +" +if { [string compare $dirname ""] != 0 } { + ns_write "
    + [export_form_vars product_id] + + +
    + " +} else { + ns_write "No directory found in which to upload files." +} + +ns_write "
    + +
    + +Note that the picture of the product is not considered a supporting +file. If you want to change it, go to +the regular product edit page. + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/toggle-active-p.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/toggle-active-p.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/toggle-active-p.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,26 @@ +# toggle-active-p.tcl,v 3.0 2000/02/06 03:21:09 ron Exp +set_the_usual_form_variables + +# product_id + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +ns_db dml $db "update ec_products +set active_p = logical_negation(active_p), + last_modified = sysdate(), + last_modifying_user = $user_id, + modified_ip_address = '[DoubleApos [ns_conn peeraddr]]' +where product_id = $product_id" + +ns_returnredirect "one.tcl?[export_url_vars product_id]" Index: web/openacs/www/admin/ecommerce/products/upload-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/upload-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/upload-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,109 @@ +# upload-2.tcl,v 3.0 2000/02/06 03:21:10 ron Exp +ad_page_variables {{csv_file ""}} +# csv_file + +if { [empty_string_p csv_file] } { + ad_return_error "Missing CSV File" "You must input the name of the .csv file on your local hard drive." + return +} + +set user_id [ad_get_user_id] +set ip [ns_conn peeraddr] + + +ReturnHeaders + +ns_write "[ad_admin_header "Uploading Products"] + +

    Uploading Products

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] "Uploading Products"] + +
    + +
    +" + +set unix_file_name [ns_queryget csv_file.tmpfile] + +set db [ns_db gethandle] + +if { ![file readable $unix_file_name] } { + ns_write "Cannot read file $unix_file_name" + return +} + +set csvfp [open $unix_file_name] + +set count 0 +set success_count 0 +while { [ns_getcsv $csvfp elements] != -1 } { + incr count + if { $count == 1 } { + # first time through, we grab the number of columns and their names + set number_of_columns [llength $elements] + set columns $elements + # These 2 lines added 1999-08-08 + set product_id_column [lsearch -exact $columns "product_id"] + set product_name_column [lsearch -exact $columns "product_name"] + } else { + # this line is a product + + # All this directory stuff added 1999-08-08 + # To be consistent with directory-creation that occurs when a + # product is added, dirname will be the first four letters + # (lowercase) of the product_name followed by the product_id + # (for uniqueness) + regsub -all {[^a-zA-Z]} [lindex $elements $product_name_column] "" letters_in_product_name + set letters_in_product_name [string tolower $letters_in_product_name] + if [catch {set dirname "[string range $letters_in_product_name 0 3][lindex $elements $product_id_column]"}] { + #maybe there aren't 4 letters in the product name + set dirname "$letters_in_product_name[lindex $elements $product_id_column]" + } + + set columns_sql "insert into ec_products (creation_date, available_date, dirname, last_modified, last_modifying_user, modified_ip_address " + set values_sql " values (sysdate(), sysdate(), '[DoubleApos $dirname]', sysdate(), $user_id, '$ip' " + for { set i 0 } { $i < $number_of_columns } { incr i } { + append columns_sql ", [lindex $columns $i]" + append values_sql ", '[DoubleApos [lindex $elements $i]]'" + } + set sql "$columns_sql ) $values_sql )" + + # we have to also write a row into ec_custom_product_field_values + # for consistency with add*.tcl (added 1999-08-08) + ns_db dml $db "begin transaction" + + if { [catch {ns_db dml $db $sql} errmsg] } { + ns_write "FAILURE! SQL: $sql
    \n" + ns_db dml $db "end transaction" + } else { + incr success_count + if { [catch {ns_db dml $db "insert into ec_custom_product_field_values (product_id, last_modified, last_modifying_user, modified_ip_address) values ([lindex $elements $product_id_column], sysdate(), '$user_id', '[DoubleApos [ns_conn peeraddr]]')" } errmsg] } { + ns_write "FAILURE! Insert into ec_custom_product_field_values failed for product_id=$product_id
    \n" + } + ns_db dml $db "end transaction" + + # Get the directory where dirname is stored + set subdirectory "[ad_parameter EcommerceDataDirectory ecommerce][ad_parameter ProductDataDirectory ecommerce][ec_product_file_directory [lindex $elements $product_id_column]]" + ec_assert_directory $subdirectory + + set full_dirname "$subdirectory/$dirname" + ec_assert_directory $full_dirname + } + } +} + +if { $success_count == 1 } { + set product_string "product" +} else { + set product_string "products" +} + +ns_write "
    + +

    Successfully loaded $success_count $product_string out of [ec_decode $count "0" "0" [expr $count -1]]. + +[ad_admin_footer] +" + + Index: web/openacs/www/admin/ecommerce/products/upload-utilities.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/upload-utilities.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/upload-utilities.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,49 @@ +# upload-utilities.tcl,v 3.0 2000/02/06 03:21:12 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Upload Utilities"] + +

    Upload Utilities

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] "Upload Utilities"] + +
    + +There are three utilities provided with the ecommerce module that can +help you load you catalog data into the database: + + + +

    The product loader uploads a CSV file that contains one line per product +in your catalog. Each line has fields corresponding to a subset of the +columns in the ec_products table. The first line of the CSV file is a +header that defines which fields are being loaded and the order that +they appear in the CSV file. The remaining lines contain the product +data. + +

    The product extras loader is similar to the product loader except it +loads data into ec_custom_product_field_values, the table which contains +the values for each product of the custom fields you've added. +The file format is +also similar to that of the product data CSV file. + +

    Note:You must load the products and define the extra fields +you wish to use before you can load the product extras. + +

    The product category map loader creates the mappings between products +and categories and products and subcategories (specifically, it inserts +rows into ec_category_product_map and ec_subcategory_product_map.) The +CSV file you create for uploading should consist of product id and +category or subcategory names, one per row. This program attempts to be +smart by using the SQL like function to resolve close matches between +categories listed in the CSV file and those known in the database. + +

    Note:You must create the categories and subcategories before +you can use the product category map loader. + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/products/upload.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/products/upload.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/products/upload.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,105 @@ +# upload.tcl,v 3.0 2000/02/06 03:21:13 ron Exp +# This page uploads a CSV file containing store-specific products into the catalog. The file format should be: +# +# field_name_1, field_name_2, ... field_name_n +# value_1, value_2, ... value_n +# +# where the first line contains the actual names of the columns in ec_products and the remaining lines contain +# the values for the specified fields, one line per product. +# +# Legal values for field names are the columns in ec_products (see [ns_info pageroot]/docs/sql/ecommerce.sql +# for current column names): +# product_id (required) +# sku +# product_name (required) +# one_line_description +# detailed_description +# search_keywords +# price +# shipping +# shipping_additional +# weight +# dirname +# present_p +# active_p +# available_date +# announcements +# announcements_expire +# url +# template_id +# stock_status +# +# Note: dirname, creation_date, available_date, last_modified, last_modifying_user and modified_ip_address are set +# automatically and should not appear in the CSV file. + +ReturnHeaders + +ns_write "[ad_admin_header "Upload Products"] + +

    Upload Products

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Products"] "Upload Products"] + +
    + +
    + +
    +CSV Filename +

    +

    + +
    +
    + +

    + +Notes: + +

    +

    + +This page uploads a CSV file containing product information into the database. The file format should be: +

    +

    +field_name_1, field_name_2, ... field_name_n
    +value_1, value_2, ... value_n     +
    +

    +where the first line contains the actual names of the columns in ec_products and the remaining lines contain +the values for the specified fields, one line per product. +

    +Legal values for field names are the columns in ec_products: +

    +

    +
    +"
+
+set undesirable_cols [list "dirname" "creation_date" "available_date" "last_modified" "last_modifying_user" "modified_ip_address"]
+set required_cols [list "product_id" "product_name"]
+
+set db [ns_db gethandle]
+
+for {set i 0} {$i < [ns_column count $db ec_products]} {incr i} {
+    set col_to_print [ns_column name $db ec_products $i]
+    if { [lsearch -exact $undesirable_cols $col_to_print] == -1 } {
+	ns_write "$col_to_print"
+	if { [lsearch -exact $required_cols $col_to_print] != -1 } {
+	    ns_write " (required)"
+	}
+	ns_write "\n"
+    }
+}
+
+ns_write "
    +
    +

    +Note: [join $undesirable_cols ", "] are set +automatically and should not appear in the CSV file. + +

    +
    + +[ad_admin_footer] + +" Index: web/openacs/www/admin/ecommerce/retailers/add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/retailers/add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/retailers/add-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,185 @@ +# add-2.tcl,v 3.0 2000/02/06 03:21:15 ron Exp +set_the_usual_form_variables +# retailer_name, primary_contact_name, secondary_contact_name, +# primary_contact_info, secondary_contact_info, line1, line2, +# city, usps_abbrev, zip_code, phone, fax, url, country_code, reach, +# nexus_states, financing_policy, return_policy, +# price_guarantee_policy, delivery_policy, installation_policy + +# nexus_states is a select multiple, so deal with that separately +set form [ns_getform] +set form_size [ns_set size $form] +set form_counter 0 + +set nexus_states [list] +while { $form_counter < $form_size} { + if { [ns_set key $form $form_counter] == "nexus_states" } { + lappend nexus_states [ns_set value $form $form_counter] + } + incr form_counter +} + +# I think retailer_name, line1, city, usps_abbrev, zip_code, phone, +# country_code, and reach should be required + +set possible_error_list [list [list retailer_name "the name of the retailer"] [list line1 "the address"] [list city "the city"] [list usps_abbrev "the state"] [list zip_code "the zip code"] [list phone "the phone number"] [list country_code "the country"] [list reach "the reach"] ] + +set exception_count 0 +set exception_text "" + +foreach possible_error $possible_error_list { + if { ![info exists [lindex $possible_error 0]] || [empty_string_p [set [lindex $possible_error 0]]] } { + incr exception_count + append exception_text "
  • You forgot to enter [lindex $possible_error 1]." + } +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +ReturnHeaders +ns_write "[ad_admin_header "Confirm New Retailer"] + +

    Confirm New Retailer

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Retailers"] "Add Retailer"] + +
    +

    Please confirm that the information below is correct:

    + +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +Retailer Name: + +$retailer_name +
    +Primary Contact: + +$primary_contact_name
    +[bboard_convert_plaintext_to_html $primary_contact_info] +
    +Secondary Contact: + +$secondary_contact_name
    +[bboard_convert_plaintext_to_html $secondary_contact_info] +
    +Address + +" +set db [ns_db gethandle] +ns_write "[bboard_convert_plaintext_to_html [ad_pretty_mailing_address_from_args $db $line1 $line2 $city $usps_abbrev $zip_code $country_code]] +
    +Phone + +$phone +
    +Fax + +$fax +
    +URL +$url
    +Reach + +$reach +
    +Nexus States + +$nexus_states +
    +Financing + +[bboard_convert_plaintext_to_html $financing_policy] +
    +Return Policy + +[bboard_convert_plaintext_to_html $return_policy] +
    +Price Guarantee Policy + +[bboard_convert_plaintext_to_html $price_guarantee_policy] +
    +Delivery + +[bboard_convert_plaintext_to_html $delivery_policy] +
    +Installation + +[bboard_convert_plaintext_to_html $installation_policy] +
    +
    + +
    +" + +set retailer_id [database_to_tcl_string $db "select ec_retailer_sequence.nextval from dual"] + +ns_write "[export_form_vars retailer_id retailer_name primary_contact_name secondary_contact_name primary_contact_info secondary_contact_info line1 line2 city usps_abbrev zip_code phone fax url country_code reach nexus_states financing_policy return_policy price_guarantee_policy delivery_policy installation_policy] + +
    + +
    +
    + +[ad_admin_footer] +" + Index: web/openacs/www/admin/ecommerce/retailers/add-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/retailers/add-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/retailers/add-3.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,34 @@ +# add-3.tcl,v 3.0 2000/02/06 03:21:16 ron Exp +set_the_usual_form_variables + +# retailer_id, +# retailer_name, primary_contact_name, secondary_contact_name, +# primary_contact_info, secondary_contact_info, line1, line2, +# city, usps_abbrev, zip_code, phone, fax, url, country_code, reach, +# nexus_states, financing_policy, return_policy, +# price_guarantee_policy, delivery_policy, installation_policy + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +# we have to generate audit information +set audit_fields "last_modified, last_modifying_user, modified_ip_address" +set audit_info "sysdate, '$user_id', '[DoubleApos [ns_conn peeraddr]]'" + +ns_db dml $db "insert into ec_retailers +(retailer_id, retailer_name, primary_contact_name, secondary_contact_name, primary_contact_info, secondary_contact_info, line1, line2, city, usps_abbrev, zip_code, phone, fax, url, country_code, reach, nexus_states, financing_policy, return_policy, price_guarantee_policy, delivery_policy, installation_policy, $audit_fields) +values +($retailer_id, '$QQretailer_name', '$QQprimary_contact_name', '$QQsecondary_contact_name', '$QQprimary_contact_info', '$QQsecondary_contact_info', '$QQline1', '$QQline2', '$QQcity', '$QQusps_abbrev', '$QQzip_code', '$QQphone', '$QQfax', '$QQurl', '$QQcountry_code', '$QQreach', '$QQnexus_states', '$QQfinancing_policy', '$QQreturn_policy', '$QQprice_guarantee_policy', '$QQdelivery_policy', '$QQinstallation_policy', $audit_info) +" + +ns_returnredirect index.tcl \ No newline at end of file Index: web/openacs/www/admin/ecommerce/retailers/add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/retailers/add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/retailers/add.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,123 @@ +# add.tcl,v 3.0 2000/02/06 03:21:17 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Add a Retailer"] + +

    Add a Retailer

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Retailers"] "Add Retailer"] + +
    + +

    + +

    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    Retailer Name
    Primary Contact + + + + + + + + + + +
    Name
    Contact Info
    + +
    Secondary Contact + + + + + + + + + + +
    Name
    Contact Info
    + +
    Address
    +
    City +" + +set db [ns_db gethandle] + +ns_write "State [state_widget $db] +Zip +
    Country[country_widget $db "us" "country_code" ""]
    Phone
    Fax
    URL
    Reach[ec_reach_widget]
    Nexus States[ec_multiple_state_widget $db "" nexus_states]
    Financing
    Return Policy
    Price Guarantee Policy
    Delivery
    Installation
    + +

    + +

    + +
    +
    +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/retailers/edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/retailers/edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/retailers/edit-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,44 @@ +# edit-2.tcl,v 3.0 2000/02/06 03:21:19 ron Exp +set_the_usual_form_variables + +# retailer_id, +# retailer_name, primary_contact_name, secondary_contact_name, +# primary_contact_info, secondary_contact_info, line1, line2, +# city, usps_abbrev, zip_code, phone, fax, url, country_code, reach, +# nexus_states, financing_policy, return_policy, +# price_guarantee_policy, delivery_policy, installation_policy, + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set audit_update "last_modified=sysdate, last_modifying_user='$user_id', modified_ip_address='[DoubleApos [ns_conn peeraddr]]'" + +# nexus_states is a select multiple, so deal with that separately +set form [ns_getform] +set form_size [ns_set size $form] +set form_counter 0 + +set nexus_states [list] +while { $form_counter < $form_size} { + if { [ns_set key $form $form_counter] == "nexus_states" } { + lappend nexus_states [ns_set value $form $form_counter] + } + incr form_counter +} + +set db [ns_db gethandle] + +ns_db dml $db "update ec_retailers +set retailer_name='$QQretailer_name', primary_contact_name='$QQprimary_contact_name', secondary_contact_name='$QQsecondary_contact_name', primary_contact_info='$QQprimary_contact_info', secondary_contact_info='$QQsecondary_contact_info', line1='$QQline1', line2='$QQline2', city='$QQcity', usps_abbrev='$QQusps_abbrev', zip_code='$QQzip_code', phone='$QQphone', fax='$QQfax', url='$QQurl', country_code='$QQcountry_code', reach='$QQreach', nexus_states='$nexus_states', financing_policy='$QQfinancing_policy', return_policy='$QQreturn_policy', price_guarantee_policy='$QQprice_guarantee_policy', delivery_policy='$QQdelivery_policy', installation_policy='$QQinstallation_policy', $audit_update +where retailer_id=$retailer_id +" + +ns_returnredirect index.tcl \ No newline at end of file Index: web/openacs/www/admin/ecommerce/retailers/edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/retailers/edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/retailers/edit.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,128 @@ +# edit.tcl,v 3.0 2000/02/06 03:21:20 ron Exp +set_the_usual_form_variables +# retailer_id + +ReturnHeaders + +ns_write "[ad_admin_header "Edit Retailer"] + +

    Edit Retailer

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Retailers"] "Edit Retailer"] + +
    + +

    +" + +set db [ns_db gethandle] +set selection [ns_db 1row $db "select * from ec_retailers where retailer_id=$retailer_id"] +set_variables_after_query + +ns_write "

    +[export_form_vars retailer_id] + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    Retailer Name
    Primary Contact + + + + + + + + + + +
    Name
    Contact Info
    + +
    Secondary Contact + + + + + + + + + + +
    Name
    Contact Info
    + +
    Address
    +
    City +State [state_widget $db $usps_abbrev] +Zip +
    Country[country_widget $db "$country_code" "country_code" ""]
    Phone
    Fax
    URL
    Reach[ec_reach_widget $reach]
    Nexus States[ec_multiple_state_widget $db "$nexus_states" nexus_states]
    Financing
    Return Policy
    Price Guarantee Policy
    Delivery
    Installation
    + +

    + +

    + +
    +
    +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/retailers/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/retailers/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/retailers/index.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,37 @@ +# index.tcl,v 3.0 2000/02/06 03:21:21 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Retailer Administration"] + +

    Retailer Administration

    + +[ad_admin_context_bar [list "../" "Ecommerce"] "Retailers"] + +
    +

    Current Retailers

    +
      +" + +set db [ns_db gethandle] +set selection [ns_db select $db "select retailer_id, retailer_name, decode(reach,'web',url,city || ', ' || usps_abbrev) as location from ec_retailers order by retailer_name"] + +set retailer_counter 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • $retailer_name ($location)\n" + incr retailer_counter +} + +if { $retailer_counter == 0 } { + ns_write "There are currently no retailers.\n" +} + +ns_write " +
    +

    +

    Actions

    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/retailers/one.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/retailers/one.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/retailers/one.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,150 @@ +# one.tcl,v 3.0 2000/02/06 03:21:22 ron Exp +set_the_usual_form_variables +# retailer_id + +set db [ns_db gethandle] +set selection [ns_db 1row $db "select * from ec_retailers where retailer_id=$retailer_id"] +set_variables_after_query + +ReturnHeaders +ns_write "[ad_admin_header "$retailer_name"] + +

    $retailer_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Retailers"] "One Retailer"] + +
    +

    Current Information

    + +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +Retailer Name: + +$retailer_name +
    +Primary Contact: + +$primary_contact_name
    +[bboard_convert_plaintext_to_html $primary_contact_info] +
    +Secondary Contact: + +$secondary_contact_name
    +[bboard_convert_plaintext_to_html $secondary_contact_info] +
    +Address + +[ec_display_as_html [ad_pretty_mailing_address_from_args $db $line1 $line2 $city $usps_abbrev $zip_code $country_code]] +
    +Phone + +$phone +
    +Fax + +$fax +
    +Reach + +$reach +
    +Nexus States + +$nexus_states +
    +Financing + +[ec_display_as_html $financing_policy] +
    +Return Policy + +[ec_display_as_html $return_policy] +
    +Price Guarantee Policy + +[ec_display_as_html $price_guarantee_policy] +
    +Delivery + +[ec_display_as_html $delivery_policy] +
    +Installation + +[ec_display_as_html $installation_policy] +
    +
    +" +ns_write "

    Actions

    +
      +
    • Edit +" + +# Set audit variables +# audit_name, id, id_column, return_url, audit_tables, main_tables +set audit_name "$retailer_name" +set id $retailer_id +set id_column "retailer_id" +set return_url "one.tcl?[export_url_vars retailer_id]" +set audit_tables [list ec_retailers_audit] +set main_tables [list ec_retailers] + +ns_write "
    • Audit Trail + +
    + +[ad_admin_footer] +" + Index: web/openacs/www/admin/ecommerce/sales-tax/clear-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/sales-tax/clear-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/sales-tax/clear-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,8 @@ +# clear-2.tcl,v 3.0 2000/02/06 03:21:23 ron Exp +set db [ns_db gethandle] + +# delete all tax settings +ns_db dml $db "delete from ec_sales_tax_by_state" +ad_audit_delete_row $db "" "" ec_sales_tax_by_state_audit + +ns_returnredirect index.tcl \ No newline at end of file Index: web/openacs/www/admin/ecommerce/sales-tax/clear.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/sales-tax/clear.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/sales-tax/clear.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,21 @@ +# clear.tcl,v 3.0 2000/02/06 03:21:24 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Clear Sales Tax Settings"] + +

    Clear Sales Tax Settings

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Sales Tax"] "Clear Settings"] + +
    + +Please confirm that you wish to clear all your sales tax settings. + +
    +
    + +
    +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/sales-tax/edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/sales-tax/edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/sales-tax/edit-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,67 @@ +# edit-2.tcl,v 3.0 2000/02/06 03:21:25 ron Exp +set_the_usual_form_variables + +# the variables will be of the form ${usps_abbrev}_tax_rate and ${usps_abbrev}_shipping_p, +# in addition to usps_abbrev_list (which tells us which of the above we're expecting) + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] +# error checking (must have a tax rate and shipping_p for each state) +set exception_count 0 +set exception_text "" +foreach usps_abbrev $usps_abbrev_list { + + if { ![info exists ${usps_abbrev}_tax_rate] || [empty_string_p [set ${usps_abbrev}_tax_rate]] } { + incr exception_count + append exception_text "
  • You forgot to enter the tax rate for [ad_state_name_from_usps_abbrev $db $usps_abbrev]" + } + + if { ![info exists ${usps_abbrev}_shipping_p] || [empty_string_p [set ${usps_abbrev}_shipping_p]] } { + incr exception_count + append exception_text "
  • You forgot to specify whether tax is charged for shipping in [ad_state_name_from_usps_abbrev $db $usps_abbrev]" + } + +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text +} + +set old_states_with_taxes_set [database_to_tcl_list $db "select usps_abbrev from ec_sales_tax_by_state"] + +ns_db dml $db "begin transaction" + +foreach usps_abbrev $usps_abbrev_list { + if { [database_to_tcl_string $db "select count(*) from ec_sales_tax_by_state where usps_abbrev='$usps_abbrev'"] > 0 } { + ns_db dml $db "update ec_sales_tax_by_state set tax_rate=[ec_percent_to_decimal [set ${usps_abbrev}_tax_rate]], shipping_p='[set ${usps_abbrev}_shipping_p]', last_modified=sysdate(), last_modifying_user='$user_id', modified_ip_address='[DoubleApos [ns_conn peeraddr]]' where usps_abbrev='$usps_abbrev'" + } else { + ns_db dml $db "insert into ec_sales_tax_by_state +(usps_abbrev, tax_rate, shipping_p, last_modified, last_modifying_user, modified_ip_address) +values +('$usps_abbrev', [ec_percent_to_decimal [set ${usps_abbrev}_tax_rate]], '[set ${usps_abbrev}_shipping_p]',sysdate(), '$user_id', '[DoubleApos [ns_conn peeraddr]]')" + } +} + +# get rid of rows for states where tax is no longer being collected +foreach old_state $old_states_with_taxes_set { + if { [lsearch $usps_abbrev_list $old_state] == -1 } { + # then this state is no longer taxable + ns_db dml $db "delete from ec_sales_tax_by_state where usps_abbrev='$old_state'" + ad_audit_delete_row $db [list $old_state] [list usps_abbrev] ec_sales_tax_by_state_audit + } +} + +ns_db dml $db "end transaction" + +ns_returnredirect index.tcl + Index: web/openacs/www/admin/ecommerce/sales-tax/edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/sales-tax/edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/sales-tax/edit.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,72 @@ +# edit.tcl,v 3.0 2000/02/06 03:21:26 ron Exp +# The only form element is a usps_abbrev multiple select. +# If I end up adding something else, I'll have to modify +# below and use it in conjunction with set_form_variables +set form [ns_getform] + +if [catch {set form_size [ns_set size $form]} ] { + ad_return_complaint 1 "
  • Please choose at least one state." + return +} +set form_counter 0 + +set usps_abbrev_list [list] +while { $form_counter < $form_size} { + lappend usps_abbrev_list [ns_set value $form $form_counter] + incr form_counter +} + +ReturnHeaders +ns_write "[ad_admin_header "Sales Tax, Continued"] + +

    Sales Tax, Continued

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Sales Tax"] "Edit"] + +
    + +Please specify the sales tax rates below for each state listed and whether tax +is charged on shipping in that state: + +

    + +

    +[export_form_vars usps_abbrev_list] + +
      +" + +set db [ns_db gethandle] +foreach usps_abbrev $usps_abbrev_list { + ns_write "
    • [ad_state_name_from_usps_abbrev $db $usps_abbrev]: +
      +Tax rate %
      +Charge tax on shipping? +" + +set shipping_p [database_to_tcl_string_or_null $db "select shipping_p from ec_sales_tax_by_state where usps_abbrev='$usps_abbrev'"] +if { [empty_string_p $shipping_p] || $shipping_p == "t" } { + ns_write "Yes +   No + " +} else { + ns_write "Yes +   No + " +} + +ns_write "
      +" +} + +ns_write "
    + +
    + +
    + +
    +[ad_admin_footer] +" + + Index: web/openacs/www/admin/ecommerce/sales-tax/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/sales-tax/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/sales-tax/index.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,108 @@ +# index.tcl,v 3.0 2000/02/06 03:21:27 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Sales Tax"] + +

    Sales Tax

    + +[ad_admin_context_bar [list "../" "Ecommerce"] "Sales Tax"] + +
    + +

    Your Current Settings

    + +

    + +

      +" + +# for audit table +set table_names_and_id_column [list ec_sales_tax_by_state ec_sales_tax_by_state_audit usps_abbrev] + +set db [ns_db gethandle] + +set selection [ns_db select $db "select state_name, tax_rate*100 as tax_rate_in_percent, case when shipping_p='t' then 'Yes' else 'No' end as shipping_p +from ec_sales_tax_by_state, states +where ec_sales_tax_by_state.usps_abbrev = states.usps_abbrev"] + +set state_counter 0 +while { [ns_db getrow $db $selection] } { + incr state_counter + set_variables_after_query + ns_write "
    • $state_name: +
      + Tax rate: $tax_rate_in_percent%
      + Charge tax on shipping? $shipping_p +
      + " +} + +if { $state_counter == 0 } { + ns_write "No tax is currently charged in any state.\n" +} +ns_write " +
    + +

    + +

    Change Your Settings

    + +

    + +

    + +Please select all the states in which you need to charge sales tax. You will be asked +later what the tax rates are and whether to charge tax on shipping in those states. + +

    + +

    +" + +set current_state_list [database_to_tcl_list $db "select usps_abbrev from ec_sales_tax_by_state"] + +ns_write "[ec_multiple_state_widget $db $current_state_list] + +
    + +
    + +
    + +
    + +

    + +

    Clear All Settings

    + +
    +If you want to start from scratch, clear all settings. +
    + +In general, you must collect sales tax on orders shipped to states +where you have some kind of physical presence, e.g., a warehouse, a +sales office, or a retail store. A reliable source of data on sales +tax rates by zip code is +www.salestax.com. + +

    + +We tried to keep this module simple by ignoring the ugly fact of local +taxing jurisdictions (e.g., that New York City collects tax on top of +what New York State collects). If you're a Fortune 500 company with +nexus in 50 states, you'll probably have to add in a fair amount of +complexity to collect tax more precisely or at least remit +sales tax more precisely. See +the ecommerce chapter + of Philip and Alex's Guide to Web Publishing for +more on this mournful topic. + + +

    Audit Trail

    + + + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/shipping-costs/edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/shipping-costs/edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/shipping-costs/edit-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,15 @@ +# edit-2.tcl,v 3.0 2000/02/06 03:21:28 ron Exp +set_the_usual_form_variables +# base_shipping_cost, default_shipping_per_item, weight_shipping_cost, add_exp_base_shipping_cost, add_exp_amount_per_item, add_exp_amount_by_weight + +set db [ns_db gethandle] + +ns_db dml $db "update ec_admin_settings +set base_shipping_cost = [db_postgres_null_sql $base_shipping_cost], +default_shipping_per_item = [db_postgres_null_sql $default_shipping_per_item], +weight_shipping_cost = [db_postgres_null_sql $weight_shipping_cost], +add_exp_base_shipping_cost = [db_postgres_null_sql $add_exp_base_shipping_cost], +add_exp_amount_per_item = [db_postgres_null_sql $add_exp_amount_per_item], +add_exp_amount_by_weight = [db_postgres_null_sql $add_exp_amount_by_weight]" + +ns_returnredirect "index.tcl" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/shipping-costs/edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/shipping-costs/edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/shipping-costs/edit.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,85 @@ +# edit.tcl,v 3.0 2000/02/06 03:21:30 ron Exp +set_the_usual_form_variables +# base_shipping_cost, default_shipping_per_item, weight_shipping_cost, add_exp_base_shipping_cost, add_exp_amount_per_item, add_exp_amount_by_weight + +# error checking: +# anything on this page can be blank (if *everything* is blank, it means +# that the shipping costs are included in the costs of the items, which +# is fine) +# however, if something is not blank, I have to make sure that it's +# purely numeric (0-9 and .) +# I don't allow both default_shipping_per_item and weight_shipping_cost +# to be filled in -- it's one or the other, so there's no question about +# what takes precedence + +set exception_count 0 +set exception_text "" + +if { [info exists base_shipping_cost] && ![empty_string_p $base_shipping_cost] && [regexp {[^0-9\.]} $base_shipping_cost] } { + incr exception_count + append exception_text "
  • The Base Cost must be a number (like 4.95). It cannot contain any other characters than numerals or a decimal point." +} + +if { [info exists default_shipping_per_item] && ![empty_string_p $default_shipping_per_item] && [regexp {[^0-9\.]} $default_shipping_per_item] } { + incr exception_count + append exception_text "
  • The Default Amount Per Item must be a number (like 4.95). It cannot contain any other characters than numerals or a decimal point." +} + +if { [info exists weight_shipping_cost] && ![empty_string_p $weight_shipping_cost] && [regexp {[^0-9\.]} $weight_shipping_cost] } { + incr exception_count + append exception_text "
  • The Weight Charge must be a number (like 4.95). It cannot contain any other characters than numerals or a decimal point." +} + +if { [info exists add_exp_base_shipping_cost] && ![empty_string_p $add_exp_base_shipping_cost] && [regexp {[^0-9\.]} $add_exp_base_shipping_cost] } { + incr exception_count + append exception_text "
  • The Additional Base Cost must be a number (like 4.95). It cannot contain any other characters than numerals or a decimal point." +} + +if { [info exists add_exp_amount_per_item] && ![empty_string_p $add_exp_amount_per_item] && [regexp {[^0-9\.]} $add_exp_amount_per_item] } { + incr exception_count + append exception_text "
  • Additional Amount Per Item must be a number (like 4.95). It cannot contain any other characters than numerals or a decimal point." +} + +if { [info exists add_exp_amount_by_weight] && ![empty_string_p $add_exp_amount_by_weight] && [regexp {[^0-9\.]} $add_exp_amount_by_weight] } { + incr exception_count + append exception_text "
  • The Additional Amount by Weight must be a number (like 4.95). It cannot contain any other characters than numerals or a decimal point." +} + +if { [info exists default_shipping_per_item] && ![empty_string_p $default_shipping_per_item] && [info exists weight_shipping_cost] && ![empty_string_p $weight_shipping_cost] } { + incr exception_count + append exception_text "
  • You can't fill in both Default Amount Per Item and Weight Charge. Please choose one or the other (the method you choose will be used to determine the shipping price if the price isn't explicitly set in the \"Shipping Price\" field)." +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +# error checking done + +ReturnHeaders + +ns_write "[ad_admin_header "Confirm Shipping Costs"] + +

    Confirm Shipping Costs

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Shipping Costs"] "Edit"] + +
    + +Please confirm that you want shipping to be charged as follows: + +
    +[ec_shipping_cost_summary $base_shipping_cost $default_shipping_per_item $weight_shipping_cost $add_exp_base_shipping_cost $add_exp_amount_per_item $add_exp_amount_by_weight] +
    + +
    +[export_form_vars base_shipping_cost default_shipping_per_item weight_shipping_cost add_exp_base_shipping_cost add_exp_amount_per_item add_exp_amount_by_weight] + +
    + +
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/shipping-costs/examples.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/shipping-costs/examples.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/shipping-costs/examples.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,70 @@ +# examples.tcl,v 3.0 2000/02/06 03:21:31 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Shipping Cost Examples"] + +

    Shipping Cost Examples

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Shipping Costs"] "Some Examples"] + +
    + +
      + +
    • Example 1: CD Store + +

      + +

        +
      • What I want: + I want to charge customers \$3.00 per order, and also an additional \$1.00 per CD. +

        + However, I also sell some double CDs and some boxed sets, so those should have an additional shipping charge associated with them. +

        +

      • What I fill in: + I put in \"3.00\" as the Base Cost and \"1.00\" as the Default Amount Per Item. + For each product that should have a shipping cost of more than \$1.00, + I have to make sure that I set its Shipping Price on the page where I + enter or edit product information. +
      + +

      + +

    • Example 2: Furniture Store + +

      + +

        + +
      • What I want: I want to charge people 50 cents per pound of furniture + that I ship them. + +

        + +

      • What I fill in: I can leave the Base Cost blank (or set it to \"0\"), + and then I put in \"0.50\" as the \"Weight Charge\". + +
      + +

      + +

    • Example 3: Store with Many Different Kinds of Products + +

      + +

        +
      • What I want: I want to charge people \$4.00 for each order and then + an additional amount per item that is different for each product. + +

        + +

      • What I fill in: Just the Base Cost as \"4.00\". Leave everything + else blank. When I add new products to my store, I just have to make + sure I fill in the \"Shipping Price\" field for each of them. + +
      + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/shipping-costs/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/shipping-costs/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/shipping-costs/index.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,129 @@ +# index.tcl,v 3.0 2000/02/06 03:21:33 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Shipping Costs"] + +

    Shipping Costs

    + +[ad_admin_context_bar [list "../" "Ecommerce"] "Shipping Costs"] + +
    + +

    Your Current Settings

    + +

    +

    +" +# for audit table +set table_names_and_id_column [list ec_admin_settings ec_admin_settings_audit 1] + +set db [ns_db gethandle] +set selection [ns_db 1row $db "select base_shipping_cost, default_shipping_per_item, weight_shipping_cost, add_exp_base_shipping_cost, add_exp_amount_per_item, add_exp_amount_by_weight +from ec_admin_settings"] +set_variables_after_query + +ns_write "[ec_shipping_cost_summary $base_shipping_cost $default_shipping_per_item $weight_shipping_cost $add_exp_base_shipping_cost $add_exp_amount_per_item $add_exp_amount_by_weight] + +
    + +

    + +

    Change Your Settings

    + +

    +

    + +All prices are in [ad_parameter Currency ecommerce]. The price should +be written as a decimal number (no special characters like \$). If a +section is not applicable, just leave it blank. + +

    + +It is recommended that you read some +examples before you fill in this form. + +

    + +

      + +
      + +
    1. Set the Base Cost: + + +

      + +The Base Cost is the base amount that everybody has to pay regardless of +what they purchase. Then additional amounts are added, as specified below. + +

      + +

    2. Set the Per-Item Cost: + +If the \"Shipping Price\" field of a product is filled in, that will +override any of the settings below. Also, you can fill in the +\"Shipping Price - Additional\" field if you want to charge the +customer a lower shipping amount if they order more than one of the +same product. (If \"Shipping Price - Additional\" is blank, they'll +just be charged \"Shipping Price\" for each item). + +

      + +If the \"Shipping Price\" field is blank, charge them by one of +these methods (fill in only one): + +

      + +

        + +
      • Default Amount Per Item: + + +

        + +

      • Weight Charge: [ad_parameter Currency ecommerce]/[ad_parameter WeightUnits ecommerce] + +
      + +

      + +

    3. Set the Express Shipping Charges: + +

      + +Ignore this section if you do not do express shipping. The amounts you specify below will be added to the amounts you set above if the user elects to have their order express shipped. + +

      + +

        + +
      • Additional Base Cost: + +

        + +

      • Additional Amount Per Item: + +

        + +

      • Additional Amount by Weight: [ad_parameter Currency ecommerce]/[ad_parameter WeightUnits ecommerce] + +
      + +
    + +
    + +
    + + + +
    + +

    Audit Trail

    + + + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/templates/add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/templates/add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/templates/add-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,70 @@ +# add-2.tcl,v 3.0 2000/02/06 03:21:34 ron Exp +set_the_usual_form_variables +# template_name, template + +set exception_count 0 +set exception_text "" + +if { ![info exists template_name] || [empty_string_p $template_name] } { + incr exception_count + append exception_text "
  • You forgot to enter a template name.\n" +} + +if { ![info exists template] || [empty_string_p $template] } { + incr exception_count + append exception_text "
  • You forgot to enter anything into the ADP template box.\n" +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +ReturnHeaders + +ns_write "[ad_admin_header "Confirm Template"] + +

    Confirm Template

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Product Templates"] "Confirm Template"] + +
    +" + +set db [ns_db gethandle] +set template_id [database_to_tcl_string $db "select ec_template_id_sequence.nextval from dual"] + +ns_write "
    +[export_form_vars template_id template_name template] + + +Name: + +

    + +

    +
    $template_name
    +
    + +

    + +ADP template: + +

    + +

    +
    +[ns_quotehtml $template]
+
    +
    + +

    + +

    + +
    + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/templates/add-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/templates/add-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/templates/add-3.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,47 @@ +# add-3.tcl,v 3.0 2000/02/06 03:21:35 ron Exp +set_the_usual_form_variables +# template_id, template_name, template + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_url_vars template_id template_name template]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set exception_count 0 +set exception_text "" + +if { ![info exists template_name] || [empty_string_p $template_name] } { + incr exception_count + append exception_text "
  • You forgot to enter a template name.\n" +} + +if { ![info exists template] || [empty_string_p $template] } { + incr exception_count + append exception_text "
  • You forgot to enter anything into the ADP template box.\n" +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +set db [ns_db gethandle] + +# see if the template's already in there, which means they pushed reload +if { [database_to_tcl_string $db "select count(*) from ec_templates where template_id=$template_id"] > 0 } { + ns_returnredirect index.tcl + return +} + +ns_db dml $db "insert into ec_templates +(template_id, template_name, template, last_modified, last_modifying_user, modified_ip_address) +values +($template_id, '$QQtemplate_name', '$QQtemplate', sysdate(), $user_id, '[DoubleApos [ns_conn peeraddr]]')" + +ns_returnredirect index.tcl Index: web/openacs/www/admin/ecommerce/templates/add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/templates/add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/templates/add.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,41 @@ +# add.tcl,v 3.0 2000/02/06 03:21:37 ron Exp +set_form_variables 0 +# possibly based_on + +ReturnHeaders + +ns_write "[ad_admin_header "Add a Template"] + +

    Add a Template

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Product Templates"] "Add a Template"] + +
    +" + +if { [info exists based_on] && ![empty_string_p $based_on] } { + set db [ns_db gethandle] + set template [database_to_tcl_string $db "select template from ec_templates where template_id=$based_on"] +} else { + set template "" +} + +ns_write "
    + +Name: + +

    + +ADP template:
    + + +

    + +

    + +
    + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/templates/category-associate-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/templates/category-associate-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/templates/category-associate-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,61 @@ +# category-associate-2.tcl,v 3.0 2000/02/06 03:21:38 ron Exp +set_the_usual_form_variables +# template_id, category_id + +# see if the category_id is already in ec_category_template_map because +# then the user should be warned and also we can then do an update instead +# of an insert + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select template_name as old_template from +ec_templates, ec_category_template_map m +where ec_templates.template_id = m.template_id +and m.category_id=$category_id"] + +if { [empty_string_p $selection] } { + # then this category_id isn't already in the map table + + ns_db dml $db "insert into ec_category_template_map (category_id, template_id) values ($category_id, $template_id)" + + ns_returnredirect "index.tcl" + return +} elseif { [info exists confirmed] && $confirmed == "yes" } { + # then the user has confirmed that they want to overwrite old mapping + + ns_db dml $db "update ec_category_template_map set template_id=$template_id where category_id=$category_id" + + ns_returnredirect "index.tcl" + return +} + +# to get old_template +set_variables_after_query + +set template_name [database_to_tcl_string $db "select template_name from ec_templates where template_id=$template_id"] +set category_name [database_to_tcl_string $db "select category_name from ec_categories where category_id=$category_id"] + +# we have to warn the user first that the category will no longer be mapped to its previous template +ReturnHeaders + +ns_write "[ad_admin_header "Confirm Association"] + +

    Confirm Association

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Product Templates"] [list "one.tcl?template_id=$template_id" "$template_name"] "Confirm Association"] + +
    + +This will cause $category_name to no longer be associated with its previous template, $old_template. Continue? + +
    +[export_form_vars template_id category_id] +[philg_hidden_input "confirmed" "yes"] + +
    + +
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/templates/category-associate.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/templates/category-associate.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/templates/category-associate.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,87 @@ +# category-associate.tcl,v 3.0 2000/02/06 03:21:39 ron Exp +set_the_usual_form_variables +# template_id + +set db [ns_db gethandle] +set selection [ns_db 1row $db "select template_name, template from ec_templates where template_id=$template_id"] +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "Associate with a Category"] + +

    Associate with a Category

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Product Templates"] [list "one.tcl?template_id=$template_id" "$template_name"] "Associate with a Category"] + +
    +The point of doing this is just to make it a little faster when you are adding new products. +It is completely optional. + +

    + +If you associate this template with a product category, then whenever you add a new product of that category, +the product will by default be set to display with this template, although you can always change it. (However, if you +add a new product and put it in more than one category, then this template might not end +up being the default for that product.) + +

    + +This template may be associated with as many categories as you like. +" +# see if it's already associated with any categories + +set n_categories_associated_with [database_to_tcl_string $db "select count(*) from ec_category_template_map where template_id=$template_id"] + +if { $n_categories_associated_with > 0 } { + set selection [ns_db select $db "select m.category_id, c.category_name +from ec_category_template_map m, ec_categories c +where m.category_id = c.category_id +and m.template_id = $template_id"] + + ns_write "Currently this template is associated with the category(ies):\n

      \n" + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • $category_name\n" + } + + ns_write "
    \n" + +} else { + ns_write " This template has not yet been associated with any categories." +} + +# see if there are any categories left to associate it with +set n_categories_left [database_to_tcl_string $db "select count(*) +from ec_categories +where category_id not in (select category_id from ec_category_template_map where template_id=$template_id)"] + +if { $n_categories_left == 0 } { + ns_write "All categories are associated with this template. There are none left to add!" +} else { + + ns_write "
    + [export_form_vars template_id] + + Category: + + +
    + " +} + +ns_write "[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/templates/delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/templates/delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/templates/delete-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,36 @@ +# delete-2.tcl,v 3.0 2000/02/06 03:21:40 ron Exp +set_the_usual_form_variables +# template_id + +# check if this is the template that the admin has assigned as the default +# in which case they'll have to select a new default before they can delete +# this one + +set db [ns_db gethandle] +set default_template_id [database_to_tcl_string $db "select default_template +from ec_admin_settings"] + +if { $template_id == $default_template_id } { + ad_return_complaint 1 "You cannot delete this template because it is the default template that + products will be displayed with if they are not set to be displayed with a different template. +

    + If you want to delete this template, you can do so by first setting a different template to + be the default template. (To do this, go to a different template and click \"Make this template + be the default template\".)" + return +} + +ns_db dml $db "begin transaction" + +# we have to first remove all references to this template in ec_products and ec_category_template_map + +ns_db dml $db "update ec_products set template_id=null, last_modified=sysdate(), last_modifying_user='$user_id', modified_ip_address='[DoubleApos [ns_conn peeraddr]]' where template_id=$template_id" + +ns_db dml $db "delete from ec_category_template_map where template_id=$template_id" + +ns_db dml $db "delete from ec_templates where template_id=$template_id" +ad_audit_delete_row $db [list $template_id] [list template_id] ec_templates_audit + +ns_db dml $db "end transaction" +ns_returnredirect index.tcl + Index: web/openacs/www/admin/ecommerce/templates/delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/templates/delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/templates/delete.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,45 @@ +# delete.tcl,v 3.0 2000/02/06 03:21:42 ron Exp +set_the_usual_form_variables +# template_id + +# check if this is the template that the admin has assigned as the default +# in which case they'll have to select a new default before they can delete +# this one + +set db [ns_db gethandle] +set default_template_id [database_to_tcl_string $db "select default_template +from ec_admin_settings"] + +if { $template_id == $default_template_id } { + ad_return_complaint 1 "You cannot delete this template because it is the default template that + products will be displayed with if they are not set to be displayed with a different template. +

    + If you want to delete this template, you can do so by first setting a different template to + be the default template. (To do this, go to a different template and click \"Make this template + be the default template\".)" + return +} + +ReturnHeaders + +ns_write "[ad_admin_header "Confirm Deletion"] + +

    Confirm Deletion

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Product Templates"] "Delete Template"] + +
    + +Please confirm that you want to delete this template. If any products are set to use this template, they will +now be displayed with the default template. + +
    +[export_form_vars template_id] +
    + +
    + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/templates/edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/templates/edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/templates/edit-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,11 @@ +# edit-2.tcl,v 3.0 2000/02/06 03:21:43 ron Exp +set_the_usual_form_variables +# template_id, template_name, template + +set db [ns_db gethandle] + +ns_db dml $db "update ec_templates +set template_name='$QQtemplate_name', template='$QQtemplate' +where template_id=$template_id" + +ns_returnredirect index.tcl Index: web/openacs/www/admin/ecommerce/templates/edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/templates/edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/templates/edit.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,38 @@ +# edit.tcl,v 3.0 2000/02/06 03:21:45 ron Exp +set_the_usual_form_variables +# template_id + +set db [ns_db gethandle] +set selection [ns_db 1row $db "select template_name, template from ec_templates where template_id=$template_id"] +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "Edit Template"] + +

    Edit Template

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Product Templates"] [list "one.tcl?template_id=$template_id" "$template_name"] "Edit Template"] + +
    + +
    +[export_form_vars template_id] + +Name: + +

    + +ADP template:
    + + +

    + +

    + +
    + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/templates/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/templates/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/templates/index.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,76 @@ +# index.tcl,v 3.0 2000/02/06 03:21:47 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Product Templates"] + +

    Product Templates

    + +[ad_admin_context_bar [list "../" "Ecommerce"] "Product Templates"] + +
    +
      +" + +# +# A list of templates and their associated categories (if any) +# + +set db [ns_db gethandle] +set selection [ns_db select $db " +(SELECT t.template_id, t.template_name, c.category_id, c.category_name + FROM ec_templates t, ec_category_template_map m, ec_categories c + WHERE t.template_id = m.template_id + and m.category_id = c.category_id) +union +(SELECT t.template_id, t.template_name, null as category_id, null as category_name + FROM ec_templates t + WHERE 0=(select count(*) from ec_category_template_map where template_id=t.template_id)) + ORDER BY template_name, category_name"] + +set the_template_name "" +set the_template_id "" +set the_categories "" +proc maybe_write_a_template_line {} { + uplevel { + if [empty_string_p $the_template_name] { return } + ns_write "
    • $the_template_name \n" + regsub {, $} $the_categories {} the_categories + if ![empty_string_p $the_categories] { ns_write "
      associated with categories ($the_categories)" } + } +} +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if {[string compare $template_name $the_template_name] != 0} { + maybe_write_a_template_line + set the_template_name $template_name + set the_template_id $template_id + set the_categories "" + } + if ![empty_string_p $category_name] { + append the_categories "$category_name, " + } +} +maybe_write_a_template_line + + + +# For audit tables +set table_names_and_id_column [list ec_templates ec_templates_audit template_id] + +ns_write " +
    + +

    + +

    Actions

    + + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/templates/make-default-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/templates/make-default-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/templates/make-default-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,13 @@ +# make-default-2.tcl,v 3.0 2000/02/06 03:21:48 ron Exp +set_the_usual_form_variables +# template_id + +set db [ns_db gethandle] + + +if [catch { ns_db dml $db "update ec_admin_settings set default_template = $template_id" } errmsg] { + ad_return_complaint 1 "
  • We couldn't change this to be the default template. Here is the error message that Oracle gave us:
    $errmsg
    " + return +} + +ns_returnredirect index.tcl \ No newline at end of file Index: web/openacs/www/admin/ecommerce/templates/make-default.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/templates/make-default.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/templates/make-default.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,32 @@ +# make-default.tcl,v 3.0 2000/02/06 03:21:49 ron Exp +set_the_usual_form_variables +# template_id + +set db [ns_db gethandle] +set selection [ns_db 1row $db "select template_name, template from ec_templates where template_id=$template_id"] +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "Set Default Template"] + +

    Set Default Template

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Product Templates"] [list "one.tcl?template_id=$template_id" "$template_name"] "Set as Default"] + +
    + +Please confirm that you want this to become the default template that products will be displayed with +if no template has been specifically assigned to them. + +

    +

    +[export_form_vars template_id] +
    + +
    +
    + + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/templates/one.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/templates/one.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/templates/one.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,61 @@ +# one.tcl,v 3.0 2000/02/06 03:21:50 ron Exp +set_the_usual_form_variables +# template_id + +set db [ns_db gethandle] +set selection [ns_db 1row $db "select template_name, template from ec_templates where template_id=$template_id"] +set_variables_after_query + +set default_template_id [database_to_tcl_string $db "select default_template from ec_admin_settings"] + +ReturnHeaders + +ns_write "[ad_admin_header "$template_name"] + +

    $template_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "Product Templates"] "One Template"] + +
    +" + +if { $template_id == $default_template_id } { + ns_write "This is the default template used for product display.

    " +} + +ns_write "

    The template:

    + +
    +
    +[ns_quotehtml $template]
+
    +
    + +

    + +

    Actions:

    + + + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/user-classes/add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/user-classes/add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/user-classes/add-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,31 @@ +# add-2.tcl,v 3.0 2000/02/06 03:21:52 ron Exp +set_the_usual_form_variables +# user_class_id, user_class_name + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +# see if it's already in the database, meaning the user pushed reload + +set db [ns_db gethandle] + +if { [database_to_tcl_string $db "select count(*) from ec_user_classes where user_class_id=$user_class_id"] > 0 } { + ns_returnredirect index.tcl + return +} + +ns_db dml $db "insert into ec_user_classes +(user_class_id, user_class_name, last_modified, last_modifying_user, modified_ip_address) +values +($user_class_id,'$QQuser_class_name', sysdate(), '$user_id', '[DoubleApos [ns_conn peeraddr]]') +" + +ns_returnredirect index.tcl Index: web/openacs/www/admin/ecommerce/user-classes/add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/user-classes/add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/user-classes/add.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,33 @@ +# add.tcl,v 3.0 2000/02/06 03:21:53 ron Exp +set_the_usual_form_variables +# user_class_name + +ReturnHeaders + +ns_write "[ad_admin_header "Confirm New User Class"] + +

    Confirm New User Class

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "User Classes"] "Confirm New User Class"] + +
    + +Add the following new user class? + +
    +$user_class_name +
    +" + +set db [ns_db gethandle] +set user_class_id [database_to_tcl_string $db "select ec_user_class_id_sequence.nextval from dual"] + +ns_write "
    +[export_form_vars user_class_name user_class_id] +
    + +
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/user-classes/approve-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/user-classes/approve-toggle.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/user-classes/approve-toggle.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,27 @@ +# approve-toggle.tcl,v 3.0 2000/02/06 03:21:55 ron Exp +# +# jkoontz@arsdigita.com July 22 1999 +# +# Toggles a user_class between approved and unapproved + +set_the_usual_form_variables +# user_class_id user_class_approved_p user_id + +# we need them to be logged in +set admin_user_id [ad_verify_and_get_user_id] + +if {$admin_user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +ns_db dml $db "update ec_user_class_user_map +set user_class_approved_p=[ec_decode $user_class_approved_p "t" "'f'" "'t'"], last_modified=sysdate(), last_modifying_user=$admin_user_id, modified_ip_address='[DoubleApos [ns_conn peeraddr]]' +where user_id=$user_id and user_class_id=$user_class_id" + +ns_returnredirect "members.tcl?[export_url_vars user_class_id]" Index: web/openacs/www/admin/ecommerce/user-classes/delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/user-classes/delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/user-classes/delete-2.tcl 17 Apr 2001 14:05:07 -0000 1.1 @@ -0,0 +1,40 @@ +# delete-2.tcl,v 3.0 2000/02/06 03:21:56 ron Exp +set_the_usual_form_variables +# user_class_id + +# we need them to be logged in +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +# have to first remove references to this user_class in ec_user_class_user_map +# then it can be deleted from ec_user_classes + +ns_db dml $db "begin transaction" + +set user_id_list [database_to_tcl_list $db "select user_id from ec_user_class_user_map where user_class_id = $user_class_id"] + +ns_db dml $db "delete from ec_user_class_user_map where user_class_id=$user_class_id +" + +foreach user_id $user_id_list { + ad_audit_delete_row $db [list $user_id $user_class_id] [list user_id user_class_id] ec_user_class_user_map_audit +} + +ns_db dml $db "delete from ec_user_classes +where user_class_id=$user_class_id +" + +ad_audit_delete_row $db [list $user_class_id] [list user_class_id] ec_user_classes_audit + +ns_db dml $db "end transaction" + +ns_returnredirect "index.tcl" Index: web/openacs/www/admin/ecommerce/user-classes/delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/user-classes/delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/user-classes/delete.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,29 @@ +# delete.tcl,v 3.0 2000/02/06 03:21:57 ron Exp +set_the_usual_form_variables +# user_class_id + +set db [ns_db gethandle] +set user_class_name [database_to_tcl_string $db "select user_class_name from ec_user_classes where user_class_id=$user_class_id"] + +ReturnHeaders + +ns_write "[ad_admin_header "Delete $user_class_name"] + +

    Delete $user_class_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "User Classes"] [list "one.tcl?[export_url_vars user_class_name user_class_id]" $user_class_name] "Delete User Class"] + +
    +Please confirm that you wish to delete this user class. Note that this will leave any users who are currently in this class (if any) classless. + +

    + +

    +
    +[export_form_vars user_class_id] + +
    +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/user-classes/edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/user-classes/edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/user-classes/edit.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,10 @@ +# edit.tcl,v 3.0 2000/02/06 03:21:58 ron Exp +set_the_usual_form_variables +# user_class_name, user_class_id + +set db [ns_db gethandle] +ns_db dml $db "update ec_user_classes +set user_class_name='$QQuser_class_name' +where user_class_id=$user_class_id" + +ns_returnredirect "one.tcl?[export_url_vars user_class_id user_class_name]" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/user-classes/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/user-classes/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/user-classes/index.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,93 @@ +# index.tcl,v 3.0 2000/02/06 03:22:00 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "User Class Administration"] + +

    User Class Administration

    + +[ad_admin_context_bar [list "../" "Ecommerce"] "User Classes"] + +
    + +

    Current User Classes

    + +
      +" + +set db_pools [ns_db gethandle [philg_server_default_pool] 2] +set db [lindex $db_pools 0] +set db_sub [lindex $db_pools 1] + +set selection [ns_db select $db "(select + ec_user_classes.user_class_id, + ec_user_classes.user_class_name, + count(user_id) as n_users +from ec_user_classes, ec_user_class_user_map m +where ec_user_classes.user_class_id = m.user_class_id +group by ec_user_classes.user_class_id, ec_user_classes.user_class_name) union +(select + ec_user_classes.user_class_id, + ec_user_classes.user_class_name, + 0 as n_users +from ec_user_classes +where 0=(select count(*) from ec_user_class_user_map where user_class_id= ec_user_classes.user_class_id) +group by ec_user_classes.user_class_id, ec_user_classes.user_class_name) +order by user_class_name"] + +set user_class_counter 0 +while { [ns_db getrow $db $selection] } { + incr user_class_counter + set_variables_after_query + + # PGsql 6.x hack by BMA + if {$user_class_id == ""} { + continue + } + + ns_write "
    • $user_class_name ($n_users user[ec_decode $n_users "1" "" "s"]" + + if { [ad_parameter UserClassApproveP ecommerce] } { + set n_approved_users [database_to_tcl_string $db_sub "select +count(*) as approved_n_users +from ec_user_class_user_map +where user_class_approved_p = 't' +and user_class_id=$user_class_id"] + + ns_write " , $n_approved_users approved user[ec_decode $n_approved_users "1" "" "s"]" + } + ns_write ")\n" +} + +if { $user_class_counter == 0 } { + ns_write "You haven't set up any user classes.\n" +} + +# For audit tables +set table_names_and_id_column [list ec_user_classes ec_user_classes_audit user_class_id] + +ns_write " +
    + +

    + +

    Actions

    + + + +

    + +

    Add a New User Class

    + +
      + +
      +Name: + +
      + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/user-classes/member-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/user-classes/member-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/user-classes/member-add-2.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,33 @@ +# member-add-2.tcl,v 3.0 2000/02/06 03:22:01 ron Exp +set_the_usual_form_variables +# user_class_id user_class_name user_id + +# we need them to be logged in +set admin_user_id [ad_verify_and_get_user_id] + +if {$admin_user_id == 0} { + + set return_url "[ns_conn url]?[export_entire_form_as_url_vars]" + + ns_returnredirect "/register.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +# see if they're already in ec_user_class_user_map, in which case just update +# their record + +if { [database_to_tcl_string $db "select count(*) from ec_user_class_user_map where user_id=$user_id and user_class_id=$user_class_id"] > 0 } { + ns_db dml $db "update ec_user_class_user_map +set user_class_approved_p='t', last_modified=sysdate(), last_modifying_user=$admin_user_id, modified_ip_address='[DoubleApos [ns_conn peeraddr]]' +where user_id=$user_id and user_class_id=$user_class_id" +} else { + ns_db dml $db "insert into ec_user_class_user_map +(user_id, user_class_id, user_class_approved_p, last_modified, last_modifying_user, modified_ip_address) +values +($user_id, $user_class_id, 't', sysdate(), $user_id, '[DoubleApos [ns_conn peeraddr]]') +" +} + +ns_returnredirect "one.tcl?[export_url_vars user_class_id user_class_name]" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/user-classes/member-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/user-classes/member-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/user-classes/member-add.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,47 @@ +# member-add.tcl,v 3.0 2000/02/06 03:22:02 ron Exp +set_the_usual_form_variables +# user_class_id, user_class_name +# and either last_name or email + +ReturnHeaders + +ns_write "[ad_admin_header "Add Member to $user_class_name"] + +

    Add Member to $user_class_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "User Classes"] [list "one.tcl?[export_url_vars user_class_id user_class_name]" $user_class_name] "Add Member" ] + +
    +" + +if { [info exists last_name] } { + ns_write "

    Users whose last name contains '$last_name':

    \n" + set last_bit_of_query "upper(last_name) like '%[string toupper $QQlast_name]%'" +} else { + ns_write "

    Users whose email contains '$email':

    \n" + set last_bit_of_query "upper(email) like '%[string toupper $QQemail]%'" +} + +ns_write "
      +" + +set db [ns_db gethandle] +set selection [ns_db select $db "select user_id, first_names, last_name, email +from users +where $last_bit_of_query"] + +set user_counter 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • $first_names $last_name ($email)\n" + incr user_counter +} + +if { $user_counter == 0 } { + ns_write "No such users were found.\n
    \n" +} else { + ns_write "\n

    Click on a name to add that user to $user_class_name.\n" +} + +ns_write "[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/user-classes/member-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/user-classes/member-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/user-classes/member-delete-2.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,11 @@ +# member-delete-2.tcl,v 3.0 2000/02/06 03:22:03 ron Exp +set_the_usual_form_variables +# user_class_id, user_class_name, user_id + +set db [ns_db gethandle] + +ns_db dml $db "delete from ec_user_class_user_map where user_id=$user_id and user_class_id=$user_class_id" + +ad_audit_delete_row $db [list $user_class_id $user_id] [list user_class_id user_id] ec_user_class_user_map_audit + +ns_returnredirect "members.tcl?[export_url_vars user_class_id user_class_name]" Index: web/openacs/www/admin/ecommerce/user-classes/member-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/user-classes/member-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/user-classes/member-delete.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,25 @@ +# member-delete.tcl,v 3.1 2000/03/10 01:26:41 eveander Exp +set_the_usual_form_variables +# user_class_id, user_class_name, user_id + +ReturnHeaders + +ns_write "[ad_admin_header "Remove Member from $user_class_name"] + +

    Remove Member from $user_class_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "User Classes"] [list "one.tcl?[export_url_vars user_class_id user_class_name]" $user_class_name] "Members" ] + +
    + +Please confirm that you wish to remove this member from $user_class_name. + +
    +
    +[export_form_vars user_class_id user_class_name user_id] + +
    +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ecommerce/user-classes/members.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/user-classes/members.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/user-classes/members.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,60 @@ +# members.tcl,v 3.0 2000/02/06 03:22:06 ron Exp +set_the_usual_form_variables + +# user_class_id + +ReturnHeaders + +set db [ns_db gethandle] + +set user_class_name [database_to_tcl_string $db "select user_class_name from ec_user_classes where user_class_id = $user_class_id"] + +ns_write "[ad_admin_header "Members of $user_class_name"] + +

    Members of $user_class_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "User Classes"] [list "one.tcl?[export_url_vars user_class_id user_class_name]" "One Class"] "Members" ] + +
    + +
      +" + +set selection [ns_db select $db "select +users.user_id, first_names, last_name, email, +m.user_class_approved_p +from users, ec_user_class_user_map m +where users.user_id = m.user_id +and m.user_class_id=$user_class_id"] + +set user_counter 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • $first_names $last_name ($email) " + + if { [ad_parameter UserClassApproveP ecommerce] } { + ns_write "[ec_decode $user_class_approved_p "t" "" "un"]approved " + } + + ns_write "(remove" + + if { [ad_parameter UserClassApproveP ecommerce] } { + if { $user_class_approved_p == "t" } { + ns_write " | unapprove" + } else { + ns_write " | approve" + } + } + + ns_write ")\n" + incr user_counter +} + +if { $user_counter == 0 } { + ns_write "There are no users in this user class." +} + +ns_write "
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ecommerce/user-classes/one.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ecommerce/user-classes/one.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ecommerce/user-classes/one.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,62 @@ +# one.tcl,v 3.0 2000/02/06 03:22:07 ron Exp +set_the_usual_form_variables + +# user_class_id, user_class_name + +ReturnHeaders + +ns_write "[ad_admin_header "$user_class_name"] + +

    $user_class_name

    + +[ad_admin_context_bar [list "../" "Ecommerce"] [list "index.tcl" "User Classes"] "One Class"] + +
    + +
      +
      +[export_form_vars user_class_id] +
    • Change user class name to: + +
      • + +
    • View all members of this user class + +

      + +

    • Delete this user class + +

      +" + +# Set audit variables +# audit_name, audit_id, audit_id_column, return_url, audit_tables, main_tables +set audit_name "$user_class_name" +set audit_id $user_class_id +set audit_id_column "user_class_id" +set return_url "[ns_conn url]?[export_url_vars user_class_id user_class_name]" +set audit_tables [list ec_user_classes_audit] +set main_tables [list ec_user_classes] + +ns_write "

    • Audit Trail + +

      + +

    • Add a member to this user class. Search for a member to add
      + +
      +[export_form_vars user_class_id user_class_name] +By last name: + +
      + +
      +[export_form_vars user_class_id user_class_name] +By email address: + +
      + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/education/classes.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/education/classes.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/education/classes.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,84 @@ +# +# /www/admin/education/classes.tcl +# +# by randyg@arsdigita.com, aileen@mit.edu, January 2000 +# +# this page lists all of the classes offered during the given term +# + +ad_page_variables { + term_id +} + + +if {[empty_string_p $term_id]} { + ad_return_complaint 1 "
  • You must provide a valid term_id" + return +} + + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select term_name, start_date, end_date from edu_terms where term_id = $term_id"] + +if { $selection == 0 } { + ad_return_complaint 1 "
  • The term id that you provided does not correspond to any term." + return +} else { + set_variables_after_query +} + + +if {[empty_string_p $start_date]} { + set actual_start_date "No Start Date Specified" +} else { + set actual_start_date [util_AnsiDatetoPrettyDate $start_date] +} + +if {[empty_string_p $end_date]} { + set actual_end_date "No End Date Specified" +} else { + set actual_end_date [util_AnsiDatetoPrettyDate $end_date] +} + + +set return_string " + +[ad_admin_header "[ad_system_name] Administration - Terms"] +

    Classes in $term_name

    + +[ad_context_bar_ws [list "/admin/" "Admin Home"] [list "" "[ad_system_name] Administration"] [list terms.tcl "Terms"] "One Term"] + +
    +
    +" + +set selection [ns_db select $db "select class_id, class_name from edu_classes where term_id = $term_id"] + +set count 0 + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + incr count + append return_string "
  • $class_name" +} + +if {$count == 0} { + append return_string "There are no clsses signed up for this term." +} + +append return_string " +
    • +[ad_admin_footer] +" + +ns_db releasehandle $db + +ns_return 200 text/html $return_string + + + + + + + Index: web/openacs/www/admin/education/department-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/education/department-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/education/department-add-2.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,208 @@ +# +# /www/admin/education/department-add-2.tcl +# +# by randyg@arsdigita.com, aileen@mit.edu, January 2000 +# +# this page allows the admin to add a new department to the system +# + +ad_page_variables { + group_name + {department_number ""} + {external_homepage_url ""} + {mailing_address ""} + {phone_number ""} + {fax_number ""} + {inquiry_email ""} + {description ""} + {mission_statement ""} +} + + +# check and make sure we received all of the input we were supposed to + +set exception_text "" +set exception_count 0 + +# group_name is the only one that must be not null + +if {[empty_string_p $group_name]} { + append exception_text "
  • You must provide a name for the new department." + incr exception_count +} + + + +# if an email is provided, make sure that it is of the correct for. + +if {[info exists inquiry_email] && ![empty_string_p $inquiry_email] && ![philg_email_valid_p $inquiry_email]} { + incr exception_count + append exception_text "
  • The inquiry email address that you typed doesn't look right to us. Examples of valid email addresses are +
      +
    • Alice1234@aol.com +
    • joe_smith@hp.com +
    • pierre@inria.fr +
    +" +} + + +# if a phone number is provided, check its form + +if {[info exists phone_number] && ![empty_string_p $phone_number] && ![edu_phone_number_p $phone_number]} { + incr exception_count + append exception_text "
  • The phone number you have entered is not in the correct form. It must be of the form XXX-XXX-XXXX \n" +} + + +# if a fax nubmer is provided, check its form + +if {[info exists fax_number] && ![empty_string_p $fax_number] && ![edu_phone_number_p $fax_number]} { + incr exception_count + append exception_text "
  • The fax number you have entered is not in the correct form. It must be of the form XXX-XXX-XXXX \n" +} + + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + + +if {[string compare $external_homepage_url "http://"] == 0} { + set external_homepage_url "" +} + + +# so we don't get hit by duplicates if the user double-submits, +# let's generate the group_id here + +set db [ns_db gethandle] + +set group_id [database_to_tcl_string $db "select user_group_sequence.nextval from dual"] + + + +set return_string " +[ad_admin_header "[ad_system_name] Administration - Add a Department"] +

    Confirm Department Information

    + +[ad_context_bar_ws [list "/admin/" "Admin Home"] [list "" "[ad_system_name] Administration"] "Add a Department"] + +
    +
    + +
    + +[export_form_vars group_name department_number external_homepage_url mailing_address phone_number fax_number inquiry_email description mission_statement group_id] + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +Department Name + + +$group_name +
    +Department Number + + +[edu_maybe_display_text $department_number] +
    +External Homepage URL + + +[edu_maybe_display_text $external_homepage_url] +
    +Mailing Address + + +[edu_maybe_display_text $mailing_address] +
    +Phone Number + + +[edu_maybe_display_text $phone_number] +
    +Fax Number + + +[edu_maybe_display_text $fax_number] +
    +Inquiry Email Address + + +[edu_maybe_display_text $inquiry_email] +
    +Description + + +[address_book_display_as_html $description] +
    +Mission Statement + + +[edu_maybe_display_text [address_book_display_as_html $mission_statement]] +
    + +
    + +
    + +
    +[ad_admin_footer] +" + +ns_db releasehandle $db + +ns_return 200 text/html $return_string + + + + + + + Index: web/openacs/www/admin/education/department-add-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/education/department-add-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/education/department-add-3.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,135 @@ +# +# /www/admin/education/department-add-3.tcl +# +# by randyg@arsdigita.com, aileen@mit.edu, January 2000 +# +# this page allows the admin to add a new department to the system +# this page actually does the insert +# + + +ad_page_variables { + group_name + group_id + {department_number ""} + {external_homepage_url ""} + {mailing_address ""} + {phone_number ""} + {fax_number ""} + {inquiry_email ""} + {description ""} + {mission_statement ""} +} + + +set db [ns_db gethandle] + +# lets make sure this is not a double-click. If so, just redirect the user + +if {[empty_string_p $group_id]} { + append exception_text "
  • You must provide an identification nubmer for the new department." + incr exception_count +} else { + if {[database_to_tcl_string $db "select count(group_id) from user_groups where group_id = $group_id"] > 0} { + ns_returnredirect "" + } +} + +# check and make sure we received all of the input we were supposed to + +set exception_text "" +set exception_count 0 + +# group_name is the only one that cannot be null + +if {[empty_string_p $group_name]} { + append exception_text "
  • You must provide a name for the new department." + incr exception_count +} + + +# if an email is provided, make sure that it is of the correct for. + +if {[info exists inquiry_email] && ![empty_string_p $inquiry_email] && ![philg_email_valid_p $inquiry_email]} { + incr exception_count + append exception_text "
  • The inquiry email address that you typed doesn't look right to us. Examples of valid email addresses are +
      +
    • Alice1234@aol.com +
    • joe_smith@hp.com +
    • pierre@inria.fr +
    +" +} + + +# if a phone number is provided, check its form + +if {[info exists phone_number] && ![empty_string_p $phone_number] && ![edu_phone_number_p $phone_number]} { + incr exception_count + append exception_text "
  • The phone number you have entered is not in the correct form. It must be of the form XXX-XXX-XXXX \n" +} + + +# if a fax nubmer is provided, check its form + +if {[info exists fax_number] && ![empty_string_p $fax_number] && ![edu_phone_number_p $fax_number]} { + incr exception_count + append exception_text "
  • The fax number you have entered is not in the correct form. It must be of the form XXX-XXX-XXXX \n" +} + + + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + + +if {[empty_string_p $external_homepage_url]} { + set external_homepage_url "" +} + + +# now that all of the input has been check, lets put the information into +# an ns_set + + +set var_set [ns_set new] + +ns_set put $var_set department_number $department_number +ns_set put $var_set external_homepage_url $external_homepage_url +ns_set put $var_set mailing_address $mailing_address +ns_set put $var_set phone_number $phone_number +ns_set put $var_set fax_number $fax_number +ns_set put $var_set inquiry_email $inquiry_email +ns_set put $var_set description $description +ns_set put $var_set mission_statement $mission_statement + + +ad_user_group_add $db edu_department $group_name t f closed f $var_set $group_id + +ns_db releasehandle $db + +ns_returnredirect "" + + + + + + + + + + + + + + + + + + + + + + Index: web/openacs/www/admin/education/department-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/education/department-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/education/department-add.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,130 @@ +# +# /www/admin/education/department-add.tcl +# +# by randyg@arsdigita.com, aileen@mit.edu, January 2000 +# +# this page allows the admin to add a new department to the system +# + + +set return_string " +[ad_admin_header "[ad_system_name] Administration - Add a Department"] +

    Add a Department

    + +[ad_context_bar_ws [list "/admin/" "Admin Home"] [list "" "[ad_system_name] Administration"] "Add a Department"] + +
    +
    + +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +Department Name + + + +
    +Department Number + + + +
    +External Homepage URL + + + +
    +Mailing Address + + + +
    +Phone Number + + + +
    +Fax Number + + + +
    +Inquiry Email Address + + + +
    +Description + + + +
    +Mission Statement + + + +
    + +
    + +
    + +
    +[ad_admin_footer] +" + +ns_return 200 text/html $return_string + + + + + + + + + Index: web/openacs/www/admin/education/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/education/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/education/index.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,87 @@ +# +# /www/admin/education/index.tcl +# +# by randyg@arsdigita.com, aileen@mit.edu, January 2000 +# +# this page is the index to the educational system +# + +# this page does not expect any input + + +set db [ns_db gethandle] + + +set return_string " +[ad_admin_header "[ad_system_name] Administration"] +

    Education Administration

    + +[ad_context_bar_ws [list "/admin/" "Admin Home"] "Education Administration"] + +
    +
    + +

    Departments

    +
      +" + +set count 0 + +set selection [ns_db select $db "select department_name, department_id from edu_departments order by lower(department_name)"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append return_string "
    • $department_name admin page + | home page" + incr count +} + +if {$count == 0} { + append return_string "There are currently no departments in the system." +} else { + append return_string "
      " +} + +set n_subjects [database_to_tcl_string $db "select count(subject_name) from edu_subjects"] + +if {$n_subjects > 0} { + set subject_string "$n_subjects" +} else { + set subject_string 0 +} + +set n_textbooks [database_to_tcl_string $db "select count(textbook_id) from edu_textbooks"] + +if {$n_textbooks > 0} { + set textbook_string "$n_textbooks" +} else { + set textbook_string 0 +} + +append return_string " +
      +Add a Department +
    + +

    Reports

    + + + +
    + +[ad_admin_footer] +" + + +ns_db releasehandle $db + +ns_return 200 text/html $return_string Index: web/openacs/www/admin/education/term-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/education/term-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/education/term-add-2.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,149 @@ +# +# /www/admin/education/term-add-2.tcl +# +# by randyg@arsdigita.com, aileen@mit.edu, January 2000 +# +# this page confirms the information concerning a new term +# + +set_form_variables 0 + +# ad_page_variables { +# term_name +# {ColValue.end%5fdate.month ""} +# {ColValue.end%5fdate.day ""} +# {ColValue.end%5fdate.year ""} +# {ColValue.start.month ""} +# {ColValue.start%5fdate.day ""} +# {ColValue.start%5fdate.year ""} +# } + +set db [ns_db gethandle] + +set exception_count 0 +set exception_text "" + +if {![info exists term_name] || [empty_string_p $term_name]} { + append exception_text "
  • You must provide a name for the term." + incr exception_count +} + + +# put together due_date, and do error checking +set form [ns_getform] + +# ns_dbformvalue $form start_date date start_date will give an error +# message if the day of the month is 08 or 09 (this octal number problem +# we've had in other places). So I'll have to trim the leading zeros +# from ColValue.start%5fdate.day and stick the new value into the $form +# ns_set. + +#set "ColValue.start%5fdate.day" [string trimleft [set ColValue.start%5fdate.day] "0"] +#ns_set update $form "ColValue.start%5fdate.day" [set ColValue.start%5fdate.day] + +if [catch { ns_dbformvalue [ns_conn form] start_date date start_date} errmsg ] { + ns_log Debug "start_date = $errmsg, start_date = $start_date" + incr exception_count + append exception_text "
  • The date was specified in the wrong format. The date should be in the format Month DD YYYY.\n" +} elseif { [string length [set ColValue.start%5fdate.year]] != 4 } { + incr exception_count + append exception_text "
  • The year needs to contain 4 digits.\n" +} + + +#set "ColValue.end%5fdate.day" [string trimleft [set ColValue.end%5fdate.day] "0"] +#ns_set update $form "ColValue.end%5fdate.day" [set ColValue.end%5fdate.day] + +if [catch { ns_dbformvalue [ns_conn form] end_date date end_date} errmsg ] { + ns_log Debug "errmsg = $errmsg, end_date" + incr exception_count + append exception_text "
  • The date was specified in the wrong format. The date should be in the format Month DD YYYY.\n" +} elseif { [string length [set ColValue.end%5fdate.year]] != 4 } { + incr exception_count + append exception_text "
  • The year needs to contain 4 digits.\n" +} elseif {[database_to_tcl_string $db "select date_part('day',sysdate() - to_date('$end_date','YYYY-MM-DD')) from dual"] > 1} { + incr exception_count + append exception_text "
  • The end date must be in the future." +} + +if {$exception_count == 0} { + if {[database_to_tcl_string $db "select to_date('$start_date', 'YYYY-MM-DD') - to_date('$end_date','YYYY-MM-DD') from dual"] > 1} { + incr exception_count + append exception_text "
  • The end date must be after the start date." + } +} + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + + + +if {[empty_string_p $start_date]} { + set actual_start_date "No Start Date" +} else { + set actual_start_date [util_AnsiDatetoPrettyDate $start_date] +} + +if {[empty_string_p $start_date]} { + set actual_end_date "Does Not End" +} else { + set actual_end_date [util_AnsiDatetoPrettyDate $end_date] +} + + +#set the term_id on this page so we avoid double-click errors +set term_id [database_to_tcl_string $db "select edu_term_id_sequence.nextval from dual"] + + + +set return_string " +[ad_admin_header "[ad_system_name] Administration - Add a Term"] +

    Add a Term

    + +[ad_context_bar_ws [list "/admin/" "Admin Home"] [list "" "Education Administration"] "Add a Term"] + +
    +
    + +Are you sure you wish to add this term? Once you add it, you will not +be able to remove it (but you will be able to edit it). + +

    + + + + + + + +
    Term Name: +$term_name +
    Date term begins: +$actual_start_date +
    Date term ends: +$actual_end_date +
    + +

    + +[export_form_vars term_name start_date end_date term_id] +
    + +
    +[ad_admin_footer] +" + + +ns_db releasehandle $db + +ns_return 200 text/html $return_string + + + + + + + + Index: web/openacs/www/admin/education/term-add-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/education/term-add-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/education/term-add-3.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,67 @@ +# +# /www/admin/education/term-add-3.tcl +# +# by randyg@arsdigita.com, aileen@mit.edu, January 2000 +# +# This page inserts the new term into the database +# + +ad_page_variables { + term_id + term_name + start_date + end_date +} + + +#make sure we got all of the correct input +set exception_text "" +set exception_count 0 + +if {[empty_string_p $term_name]} { + incr exception_count + append exception_text "
  • You must provide a term name" +} + +if {[empty_string_p $term_id]} { + incr exception_count + append exception_text "
  • You must provide a term id" +} + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + + +set db [ns_db gethandle] + +#check and make sure it was not a double click...if it was, redirect them to the terms page +if {[database_to_tcl_string $db "select count(term_id) from edu_terms where term_id = $term_id"] > 0} { + ns_returnredirect terms.tcl + return +} + + +#now that the input is taken care of, lets insert the term + +if [catch { ns_db dml $db "insert into edu_terms (term_id, term_name, start_date, end_date) + values + ($term_id, '$QQterm_name', to_date('$start_date', 'YYYY-MM-DD'), to_date('$end_date', 'YYYY-MM-DD'))"} errmsg] { + # something went wrong + ad_return_error "database choked" "The database choked on your insert: +
    + 
    +			 $errmsg
+
    +
    + You can back up, edit your data, and try again" + return + } + +# insert went OK + +ns_db releasehandle $db + +ns_returnredirect "terms.tcl" + Index: web/openacs/www/admin/education/term-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/education/term-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/education/term-add.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,60 @@ +# +# /www/admin/education/term-add.tcl +# +# by randyg@arsdigita.com, aileen@mit.edu, January 2000 +# +# this page allows the admin to add a term to the system +# + +# this does not expect any arguments + +set db [ns_db gethandle] + + +set return_string " +[ad_admin_header "[ad_system_name] Administration - Add a Term"] +

    Add a Term

    + +[ad_context_bar_ws [list "/admin/" "Admin Home"] [list "" "Education Administration"] "Add a Term"] + +
    +
    + +
    + + + + + + + + + + + +
    Term Name + +
    Date term begins: +[ad_dateentrywidget start_date [database_to_tcl_string $db "select date(sysdate())"]] +
    Date term ends: +[ad_dateentrywidget end_date [database_to_tcl_string $db "select date(add_months(date(sysdate()),6)) from dual"]] +
    + +
    +
    + +
    +[ad_admin_footer] +" + +ns_db releasehandle $db + +ns_return 200 text/html $return_string + + + + + + + + Index: web/openacs/www/admin/education/term-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/education/term-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/education/term-edit-2.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,146 @@ +# +# /www/admin/education/term-edit-2.tcl +# +# by randyg@arsdigita.com, aileen@mit.edu, January 2000 +# +# this page allows the admin to edit information about the given term +# + +ad_page_variables { + term_id + term_name + {ColValue.end%5fdate.month ""} + {ColValue.end%5fdate.day ""} + {ColValue.end%5fdate.year ""} + {ColValue.start.month ""} + {ColValue.start%5fdate.day ""} + {ColValue.start%5fdate.year ""} +} + + +#This expects term_name, start_date_year, start_date_month, start_date_day, +#end_date_year, end_date_month, end_date_year and term_id + +set db [ns_db gethandle] + +set exception_count 0 +set exception_text "" + + +if {[empty_string_p $term_name]} { + append exception_text "
  • You must provide a name for the term." + incr exception_count +} + + +# put together due_date, and do error checking + +set form [ns_getform] + +# ns_dbformvalue $form start_date date start_date will give an error +# message if the day of the month is 08 or 09 (this octal number problem +# we've had in other places). So I'll have to trim the leading zeros +# from ColValue.start%5fdate.day and stick the new value into the $form +# ns_set. + +set "ColValue.start%5fdate.day" [string trimleft [set ColValue.start%5fdate.day] "0"] +ns_set update $form "ColValue.start%5fdate.day" [set ColValue.start%5fdate.day] + +if [catch { ns_dbformvalue $form start_date date start_date} errmsg ] { + incr exception_count + append exception_text "
  • The date was specified in the wrong format. The date should be in the format Month DD YYYY.\n" +} elseif { [string length [set ColValue.start%5fdate.year]] != 4 } { + incr exception_count + append exception_text "
  • The year needs to contain 4 digits.\n" +} + + +set "ColValue.end%5fdate.day" [string trimleft [set ColValue.end%5fdate.day] "0"] +ns_set update $form "ColValue.end%5fdate.day" [set ColValue.end%5fdate.day] + +if [catch { ns_dbformvalue $form end_date date end_date} errmsg ] { + incr exception_count + append exception_text "
  • The date was specified in the wrong format. The date should be in the format Month DD YYYY.\n" +} elseif { [string length [set ColValue.end%5fdate.year]] != 4 } { + incr exception_count + append exception_text "
  • The year needs to contain 4 digits.\n" +} elseif {[database_to_tcl_string $db "select date(sysdate()) - to_date('$end_date','YYYY-MM-DD') from dual"] > 1} { + incr exception_count + append exception_text "
  • The end date must be in the future." +} + +if {$exception_count == 0} { + if {[database_to_tcl_string $db "select to_date('$start_date', 'YYYY-MM-DD') - to_date('$end_date','YYYY-MM-DD') from dual"] > 1} { + incr exception_count + append exception_text "
  • The end date must be after the start date." + } +} + + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + + + +if {[empty_string_p $start_date]} { + set actual_start_date "No Start Date" +} else { + set actual_start_date [util_AnsiDatetoPrettyDate $start_date] +} + +if {[empty_string_p $start_date]} { + set actual_end_date "Does Not End" +} else { + set actual_end_date [util_AnsiDatetoPrettyDate $end_date] +} + + + +set return_string " +[ad_admin_header "[ad_system_name] Administration - Edit Term"] +

    Edit Term

    + +[ad_context_bar_ws [list "/admin/" "Admin Home"] [list "" "Education Administration"] "Edit Term"] + +
    +
    +Are you sure you wish to edit this term? +

    + + + + + + + +
    Term Name +$term_name +
    Date term begins: +$actual_start_date +
    Date term ends: +$actual_end_date +
    + +
    + +[export_form_vars term_name start_date end_date term_id] +
    + +
    +[ad_admin_footer] +" + +ns_db releasehandle $db + +ns_return 200 text/html $return_string + + + + + + + + + Index: web/openacs/www/admin/education/term-edit-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/education/term-edit-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/education/term-edit-3.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,62 @@ +# +# /www/admin/education/term-edit-3.tcl +# +# by randyg@arsdigita.com, aileen@mit.edu, January 2000 +# +# this page allows the admin to edit information about the given term +# + +ad_page_variables { + term_id + term_name + {start_date ""} + {end_date ""} +} + +#make sure we got all of the correct input +set exception_text "" +set exception_count 0 + +if {[empty_string_p $term_name]} { + incr exception_count + append exception_text "
  • You must provide a term name" +} + + +if {[empty_string_p $term_id]} { + incr exception_count + append exception_text "
  • You must provide a term id" +} + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + + +set db [ns_db gethandle] + +#now that the input is taken care of, lets insert the term + +if [catch { ns_db dml $db "update edu_terms + set term_name = '$QQterm_name', + start_date = to_date('$start_date', 'YYYY-MM-DD'), + end_date = to_date('$end_date', 'YYYY-MM-DD') + where term_id = $term_id" } errmsg] { + # something went wrong + ad_return_error "database choked" "The database choked on your insert: +
    + 
    +	 $errmsg
+
    +
    + You can back up, edit your data, and try again" + return + } + +# insert went OK + +ns_db releasehandle $db + +ns_returnredirect "terms.tcl" + Index: web/openacs/www/admin/education/term-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/education/term-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/education/term-edit.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,88 @@ +# +# /www/admin/education/term-edit.tcl +# +# by randyg@arsdigita.com, aileen@mit.edu, January 2000 +# +# this page allows the admin to edit information about the given term +# + +ad_page_variables { + term_id + term_name + {start_date ""} + {end_date ""} +} + + +#check the input +set exception_count 0 +set exception_text "" + +if {[empty_string_p $term_id]} { + incr exception_count + append exception_text "
  • You must provide a term_id" +} + +if {[empty_string_p $term_name]} { + incr exception_count + append exception_text "
  • You must provide a term name" +} + + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + + +set db [ns_db gethandle] + + +set return_string " +[ad_admin_header "[ad_system_name] Administration - Edit Term"] +

    Edit Term

    + +[ad_context_bar_ws [list "/admin/" "Admin Home"] [list "" "Education Administration"] "Edit a Term"] + +
    +
    + +
    + + + + + + + + + + + +
    Term Name + +
    Date term begins: +[ad_dateentrywidget start_date $start_date] +
    Date term ends: +[ad_dateentrywidget end_date $end_date] +
    + +
    + +
    + +
    +[ad_admin_footer] +" + +ns_db releasehandle $db + +ns_return 200 text/html $return_string + + + + + + + + Index: web/openacs/www/admin/education/term-one.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/education/term-one.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/education/term-one.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,95 @@ +# +# /www/admin/education/term-one.tcl +# +# by randyg@arsdigita.com, aileen@mit.edu, January 2000 +# +# this page displays the information about one term +# + +ad_page_variables { + term_id +} + + +if {[empty_string_p $term_id]} { + ad_return_complaint 1 "
  • You must provide a valid term_id" + return +} + + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select term_name, date(start_date) as start_date, date(end_date) as end_date from edu_terms where term_id = $term_id"] + +if { $selection == 0 } { + ad_return_complaint 1 "
  • The term id that you provided does not correspond to any term." + return +} else { + set_variables_after_query +} + +if {[empty_string_p $start_date]} { + set actual_start_date "No Start Date Specified" +} else { + set actual_start_date [util_AnsiDatetoPrettyDate $start_date] +} + +if {[empty_string_p $end_date]} { + set actual_end_date "No End Date Specified" +} else { + set actual_end_date [util_AnsiDatetoPrettyDate $end_date] +} + + + +set return_string " +[ad_admin_header "[ad_system_name] Administration - Terms"] +

    One Term - $term_name

    + +[ad_context_bar_ws [list "/admin/" "Admin Home"] [list "" "Education Administration"] [list terms.tcl "Terms"] "One Term"] + +
    +
    + +
  • Term Name: $term_name +
  • Start Date: $actual_start_date +
  • End Date: $actual_end_date +
    +(edit) +

    +

    Classes

    +
      +" + +set selection [ns_db select $db "select class_id, class_name from edu_classes where term_id = $term_id"] + +set count 0 + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + incr count + append return_string "
    • $class_name + [ad_space 2] \[ admin page \]" +} + +if {$count == 0} { + append return_string "There are no clsses signed up for this term." +} + +append return_string " +
    +
    • +[ad_admin_footer] +" + +ns_db releasehandle $db + +ns_return 200 text/html $return_string + + + + + + + + Index: web/openacs/www/admin/education/terms.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/education/terms.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/education/terms.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,104 @@ +# +# /www/admin/education/terms.tcl +# +# by randyg@arsdigita.com, aileen@mit.edu, January 2000 +# +# this page lists all of the terms in the system +# + +# not expecting anything + +set db [ns_db gethandle] + +set return_string " +[ad_admin_header "[ad_system_name] Administration - Terms"] +

    Terms

    + +[ad_context_bar_ws [list "/admin/" "Admin Home"] [list "" "Education Administration"] "Terms"] + +
    +
    + + + + + + + + + + +" + +# set sql "select count(class_id) as n_classes, +# edu_terms.term_id, +# edu_terms.term_name, +# edu_terms.start_date, +# edu_terms.end_date +# from edu_terms, +# edu_classes +# where edu_terms.term_id = edu_classes.term_id(+) +# group by edu_terms.term_id, edu_terms.term_name, edu_terms.start_date, edu_terms + + +set sql "\ +select edu_terms.term_id, + edu_terms.term_name, + edu_terms.start_date, + edu_terms.end_date, + edu_count_classes(term_id) as n_classes + from edu_terms + group by edu_terms.term_id, edu_terms.term_name, edu_terms.start_date, edu_terms.end_date + order by edu_terms.end_date desc" + +# lets list all of the terms that have been entered and lets also give +# the option of adding a new term. Each term links to a term.tcl page +# that tells the dates it is good for, classes for the term, etc. + +set selection [ns_db select $db $sql] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + append return_string " + + + + " + if {$n_classes == 0} { + append return_string "" + } else { + append return_string " + + + " + } +} + +append return_string " +
    +Term Name + +Start Date + +End Date + +Number Of Classes +
    $term_name [util_AnsiDatetoPrettyDate $start_date] [util_AnsiDatetoPrettyDate $end_date] $n_classes
    $n_classes
    + +
    +Add a Term +
    +[ad_admin_footer] +" + +ns_db releasehandle $db + +ns_return 200 text/html $return_string + + + + + + + + Index: web/openacs/www/admin/education/textbook-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/education/textbook-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/education/textbook-delete-2.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,26 @@ +# +# /www/admin/education/textbook-delete.tcl +# +# by randyg@arsdigita.com, aileen@mit.edu, January 2000 +# +# this page allows admin to select books to delete from the system. +# + +ad_page_variables { + textbook_id +} + +set db [ns_db gethandle] + +ns_db dml $db "begin transaction" + +ns_db dml $db "delete from edu_classes_to_textbooks_map where textbook_id=$textbook_id" + +ns_db dml $db "delete from edu_textbooks where textbook_id=$textbook_id" + +ns_db dml $db "end transaction" + +ns_db releasehandle $db + +ns_returnredirect "" + Index: web/openacs/www/admin/education/textbook-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/education/textbook-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/education/textbook-delete.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,68 @@ +# +# /www/admin/education/textbook-delete.tcl +# +# by randyg@arsdigita.com, aileen@mit.edu, January 2000 +# +# this page allows admin to select books to delete from the system. +# + +ad_page_variables { + textbook_id +} + +set db [ns_db gethandle] + +set selection [ns_db select $db "select m.class_id, c.class_name +from edu_classes c, edu_classes_to_textbooks_map m +where m.textbook_id = $textbook_id +and m.class_id = c.class_id"] + +set return_string " +[ad_header "Textbooks @ [ad_system_name]"] + +

    Confirm Textbook Deletion

    + +[ad_context_bar_ws [list "/admin/" "Admin Home"] [list "" "[ad_system_name] Administration"] [list "textbook.tcl?textbook_id=$textbook_id" "Textbook Information"] Delete] + +
    +
    +Warning! Deleting this textbook will affect all classes +that are currently using it: +
      " + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + append return_string " +
    • $class_name" +} + +append return_string " +
    +

    Do you wish to continue?

    + +
    + +[export_form_vars textbook_id] + + + +
    +
    +[ad_admin_footer] +" + +ns_db releasehandle $db + +ns_return 200 text/html $return_string + + + + + + + + + + + + Index: web/openacs/www/admin/education/textbook-info.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/education/textbook-info.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/education/textbook-info.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,76 @@ +# +# /www/admin/education/textbook-info.tcl +# +# by randyg@arsdigita.com, aileen@mit.edu +# +# this lists all of the textbooks used by the system +# + +ad_page_variables { + textbook_id +} + +if {[empty_string_p $textbook_id]} { + ad_return_complaint 1 "
  • You must provide a textbook identification number. + return +} + + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select title, author, publisher, isbn from edu_textbooks where textbook_id = $textbook_id"] + +if {$selection == ""} { + ad_return_complaint 1 "
  • The textbook identification number you have provided is not valid." + return +} else { + set_variables_after_query +} + + +set return_string " +[ad_admin_header "Textbooks @ [ad_system_name]"] + +

    Textbook Information

    + +[ad_context_bar_ws [list "/admin/" "Admin Home"] [list "" "Education Administration"] [list "textbooks.tcl" Textbooks] "One Textbook"] + +
    +
    + + + + + + + + + + + + + + +
    Title: +$title +
    Author: +$author +
    Publisher: +$publisher +
    ISBN: +$isbn +
    + +

    +Delete this textbook +

    +

    + +[ad_admin_footer] +" + + +ns_db releasehandle $db + +ns_return 200 text/html $return_string + Index: web/openacs/www/admin/education/textbook-search.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/education/textbook-search.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/education/textbook-search.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,130 @@ +# +# /www/admin/education/textbook-search.tcl +# +# by randyg@arsdigita.com, aileen@mit.edu, January 2000 +# +# This page shows a list of textbooks that match the search criteria +# + +ad_page_variables { + search_string + search_isbn +} + +# either search_string or isbn must be not null + + +set db [ns_db gethandle] + +if {[empty_string_p $search_string] && [empty_string_p $search_isbn]} { + ad_return_complaint 1 "
  • You need to enter either a search string or an ISBN number." + return +} elseif {![empty_string_p $search_string] && ![empty_string_p $search_isbn]} { + ad_return_complaint 1 "
  • You must search by either a string or the ISBN. You cannot search by both." + return +} + + +if { ![empty_string_p $search_string] } { + set search_text "Author/Title/Publisher \"$search_string\"" + set search_clause " + lower(author) like [ns_dbquotevalue %[string tolower $search_string]%] + or lower(publisher) like [ns_dbquotevalue %[string tolower $search_string]%] + or lower(title) like [ns_dbquotevalue %[string tolower $search_string]%]" +} else { + set search_text "ISBN \"$search_isbn\"" + set search_clause "lower(isbn) like [ns_dbquotevalue %[string tolower $search_isbn]%]" +} + + +# lets get a list of books so we can see whether or not a +# book matching the criteria in already in the class. We do +# not want to do a join because we want to display different +# types of error messages + +set textbook_id_list [database_to_tcl_list $db "select map.textbook_id + from edu_textbooks, + edu_classes_to_textbooks_map map + where class_id = $class_id + and map.textbook_id = edu_textbooks.textbook_id"] + +set selection [ns_db select $db " +select t.textbook_id, author, publisher, + title, isbn + from edu_textbooks t + where $search_clause"] + + + +set return_string " +[ad_admin_header "[ad_system_name] Administration"] + +

    Text Book Search Results

    + +[ad_context_bar_ws [list "/admin/" "Admin Home"] [list "" "Education Administration"] [list textbooks.tcl "All Textbooks"] "Search Textbooks"] + +
    +
    +" + +set count 0 +# count of how many books is actually available for add +set addable 0 + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + + if {!$count} { + append return_string " + + + + + + + + " + } + + append return_string " + + + + + + " + incr count +} + +if {$count == 0} { + append return_string " +

    + No textbooks matched your search criteria. Please + Add the textbook +

    " +} else { + append return_string " +
    TitleAuthorPublisherISBN
    $title$author$publisher$isbnDelete
    " + +} + +append return_string " +
    +[ad_admin_footer] +" + + +ns_db releasehandle $db + +ns_return 200 text/html $return_string + + + + + + + + + + + Index: web/openacs/www/admin/education/textbooks.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/education/textbooks.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/education/textbooks.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,102 @@ +# +# /www/admin/education/textbooks.tcl +# +# by randyg@arsdigita.com, aileen@mit.edu +# +# this lists all of the textbooks used by the system +# + +ad_page_variables { + {order_by title} +} + + +set db [ns_db gethandle] + +set return_string " +[ad_admin_header "[ad_system_name] Administration"] +

    Education Administration

    + +[ad_context_bar_ws [list "/admin/" "Admin Home"] [list "" "Education Administration"] Textbooks] + +
    +
    +" + +set header "" + +if {[string compare $order_by title] == 0} { + set order_by "lower(title)" + append header "" +} else { + append header "" +} + +if {[string compare $order_by author] == 0} { + set order_by "lower(author)" + append header "" +} else { + append header "" +} + +if {[string compare $order_by n_classes] == 0} { + set order_by "count(class_id)" + append header "" +} else { + append header "" +} + +append header "" + +set order_by "lower(title)" + +set selection [ns_db select $db "select books.textbook_id, + count(class_id) as n_classes, + title, + author + from edu_textbooks books, + edu_classes_to_textbooks_map map +where books.textbook_id = map.textbook_id(+) +group by title, author, books.textbook_id +order by $order_by"] + +set count 0 + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + if {$count == 0} { + append return_string "$header" + } + + append return_string " + + + + + + " + + incr count +} + + +if {$count > 0} { + append return_string "
    TitleTitleAuthorAuthorNumber of ClassesNumber of Classes
    + $title + + $author + + $n_classes +
    " +} else { + append return_string "There are currently no books used by any of the classes." +} + +append return_string " +
    +[ad_admin_footer] +" + +ns_db releasehandle $db + +ns_return 200 text/html $return_string Index: web/openacs/www/admin/faq/faq-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/faq/faq-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/faq/faq-add-2.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,72 @@ +# admin/faq/faq-add-2.tcl +# +# Creates a new faq in the database after checking the input +# use a catch around the insert so double-clicks wont give an error +# +# by dh@arsdigita.com, Created on Dec 20, 1999 +# +# faq-add-2.tcl,v 3.0.4.2 2000/03/16 03:40:10 dh Exp +#----------------------------------- + +ad_page_variables { + {next_faq_id} + {faq_name "" qq} + {group_id} +} + +# -- form validation ------------------ +set error_count 0 +set error_text "" + +if {![info exists faq_name] || [empty_string_p [string trim $faq_name]] } { + incr error_count + append error_text "
  • You must supply a name for the new FAQ." +} + +if {$error_count > 0 } { + ad_return_complaint $error_count $error_text + return +} + +#------------------------------------- + +set db [ns_db gethandle] + + +if { [empty_string_p $group_id] } { + set scope "public" +} else { + set scope "group" +} + +ns_db dml $db "begin transaction" + +set double_click_p [database_to_tcl_string $db " +select count(*) +from faqs +where faq_id = $next_faq_id"] + + +if {$double_click_p == "0"} { + # not a double click, make the new faq in the faqs table + ns_db dml $db "insert into faqs + (faq_id, faq_name, [ad_scope_cols_sql]) + values + ($next_faq_id, '$QQfaq_name', [ad_scope_vals_sql])" +} + +ns_db dml $db "end transaction" + +ns_db releasehandle $db + +ns_returnredirect "one?faq_id=$next_faq_id" + + + + + + + + + + Index: web/openacs/www/admin/faq/faq-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/faq/faq-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/faq/faq-add.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,67 @@ + +# admin/faq/faq-add.tcl +# +# A form for creating a new faq (just the name and associated group) +# +# by dh@arsdigita.com, Created on Dec 20, 1999 +# +# faq-add.tcl,v 3.0.4.1 2000/03/16 03:16:52 dh Exp +#------------------------------------------------- + +set db [ns_db gethandle] + +# get the next faq_id +set next_faq_id [database_to_tcl_string $db "select faq_id_sequence.nextval from dual"] + +# make and option list of all the group names +set selection [ns_db select $db " +select group_name, + group_id +from user_groups +where user_groups.group_type <> 'administration' +order by group_name "] + +set group_option_list "" +ns_db releasehandle $db + + +# -- serve the page ------------------------------- + +ns_return 200 text/html " +[ad_admin_header "Create a FAQ"] + + +

    Create a FAQ

    + +[ad_admin_context_bar [list index "FAQs"] "Create a FAQ"] + +
    + +
    +[export_form_vars next_faq_id] + + + + + + + + + + + + + + +
    Name:
    Group:$group_option_list
    + + +[ad_admin_footer]" + Index: web/openacs/www/admin/faq/faq-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/faq/faq-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/faq/faq-delete-2.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,42 @@ +# admin/faq/faq-delete-2.tcl +# +# deletes a FAQ (defined by faq_id) from the database +# +# by dh@arsdigita.com, Created on Dec 20, 1999 +# +# +# faq-delete-2.tcl,v 3.0.4.1 2000/03/16 03:34:33 dh Exp +#--------------------------------- + +ad_page_variables {faq_id} + +set db [ns_db gethandle] + +# get the faq_name +set faq_name [database_to_tcl_string $db "select faq_name from faqs where faq_id = $faq_id"] + +ns_db dml $db "begin transaction" + +# delete the contents of the FAQ (question and answers) +ns_db dml $db "delete from faq_q_and_a where faq_id = $faq_id" + +# delete the FAQ properties (name, associated group, scope) +ns_db dml $db "delete from faqs where faq_id = $faq_id" + +ns_db dml $db "end transaction" + +ns_db releasehandle $db + +ns_return 200 text/html " +[ad_admin_header "FAQ Deleted"] +

    FAQ Deleted

    +[ad_admin_context_bar [list "index" "FAQs"] "deleted"] +
    +The FAQ $faq_name has been deleted. +[ad_admin_footer] +" + + + + + Index: web/openacs/www/admin/faq/faq-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/faq/faq-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/faq/faq-delete.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,45 @@ + +# admin/faq/faq-delete.tcl +# +# asks are you sure you want to delete this FAQ? +# +# by dh@arsdigita.com, Created on Dec 20, 1999 +# +# faq-delete.tcl,v 3.0.4.1 2000/03/16 03:18:00 dh Exp +#----------------------------------------------- + +ad_page_variables {faq_id} + +set db [ns_db gethandle] + +set faq_name [database_to_tcl_string $db "select faq_name from faqs where faq_id = $faq_id"] + +ns_db releasehandle $db + +# --serve the page ------------------------------ + +ns_return 200 text/html " +[ad_admin_header "Delete a FAQ"] + +

    Delete a FAQ

    + +[ad_admin_context_bar [list index "FAQs"] [list "one?faq_id=$faq_id" "$faq_name"] "Delete FAQ"] + +
    + +

    + +[export_form_vars faq_id] +Are you sure you want to delete the FAQ $faq_name?

    + +

    + +

    + +[ad_admin_footer]" + + + + + + Index: web/openacs/www/admin/faq/faq-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/faq/faq-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/faq/faq-edit-2.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,58 @@ +# admin/faq/faq-edit-2.tcl +# +# Edits faq in the database after checking the input +# +# by dh@arsdigita.com, Created on Dec 20, 1999 +# +# faq-edit-2.tcl,v 3.0.4.1 2000/03/16 03:30:33 dh Exp +#----------------------------------- + +ad_page_variables { + {faq_id} + {faq_name "" qq} + {group_id} +} + +# -- form validation ------------------ +set error_count 0 +set error_text "" + +if {![info exists faq_name] || [empty_string_p $faq_name] } { + incr error_count + append error_text "

  • You must supply a name for the new FAQ." +} + +if {$error_count > 0 } { + ad_return_complaint $error_count $error_text + return +} + +#------------------------------------- + +set db [ns_db gethandle] + + +if { [empty_string_p $group_id] } { + set scope "public" +} else { + set scope "group" +} + +ns_db dml $db " + update faqs + set faq_name = '$QQfaq_name', + group_id = '$group_id', + scope = '$scope' + where faq_id = $faq_id + " + + +ns_db releasehandle $db + +ns_returnredirect "one?faq_id=$faq_id" + + + + + + Index: web/openacs/www/admin/faq/faq-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/faq/faq-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/faq/faq-edit.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,70 @@ + +# admin/faq/faq-edit.tcl +# +# A form for editing a faq (just the name and associated group) +# +# by dh@arsdigita.com , Created on Dec 20, 1999 +# +# faq-edit.tcl,v 3.0.4.1 2000/03/16 03:18:53 dh Exp +#------------------------------------------------- + +ad_page_variables {faq_id} + +set db [ns_db gethandle] + +# get the faq_name, group_id, scope +set selection [ns_db 1row $db " +select faq_name, group_id as current_group_id, scope +from faqs +where faq_id = $faq_id"] +set_variables_after_query + +# make and option list of all the group names +set selection [ns_db select $db " +select group_name, + group_id +from user_groups +where user_groups.group_type <> 'administration' +order by group_name "] + +set group_option_list "" +ns_db releasehandle $db + + +# -- serve the page ------------------------------- + +ns_return 200 text/html " +[ad_admin_header "Edit a FAQ"] + +

    Edit a FAQ

    + +[ad_admin_context_bar [list index "FAQs"] [list "one?faq_id=$faq_id" "$faq_name"] "Edit FAQ"] + +
    + +
    +[export_form_vars faq_id] + + + + + + + + + + + + + +
    Name:
    Group:$group_option_list
    + +[ad_admin_footer]" + Index: web/openacs/www/admin/faq/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/faq/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/faq/index.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,66 @@ +# admin/faq/index.tcl +# +# presents a list of all the FAQs and gives option to add a FAQ +# +# by dh@arsdigita.com, Created on Dec 20, 1999 +# +# index.tcl,v 3.0.4.1 2000/03/16 03:15:52 dh Exp +#----------------------------------------------------------- + +set db [ns_db gethandle] + +set selection [ns_db select $db " +select f.faq_name, + f.faq_id, + f.scope, + count(fqa.entry_id) as number_of_questions +from faqs f, faq_q_and_a fqa +where f.faq_id = fqa.faq_id +group by f.faq_name, f.faq_id, f.scope +order by faq_name" ] + +set faqs_list "" +set faq_count 0 +set old_faq_id "" + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + incr faq_count + + append faqs_list "
  • $faq_name - [expr {$number_of_questions==0?"No Questions":"$number_of_questions question(s)"}], [expr {$scope=="group"?"Private":"Public"}] \n" + +} + +ns_db releasehandle $db + +if { $faq_count == 0 } { + set faqs_list "There are no FAQs in the database." +} + +# --serve the page ---------------------------------- + +ns_return 200 text/html " +[ad_admin_header "Admin: FAQs"] + +

    Admin: FAQs

    + +[ad_admin_context_bar "FAQs"] + +
    +Documentation: /doc/faq
    +User pages: /faq + +

    + +

      +$faqs_list + +

      +

    • Add a new FAQ. +
    +[ad_admin_footer] +" + + + + Index: web/openacs/www/admin/faq/one.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/faq/one.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/faq/one.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,160 @@ + +# admin/faq/one.tcl +# +# displays the properties of one FAQ +# +# Allowed actions on existing FAQs - change associated group +# - change / add maintainer +# - change privacy policy +# - delete FAQ +# +# by dh@arsidigita.com, created on Dec 20, 1999 +# +# one.tcl,v 3.0.4.1 2000/03/17 17:42:47 aure Exp +#----------------------------------------------------------- + +ad_page_variables {faq_id} + +set db [ns_db gethandle] + +# get the faq_name and scope-------------------------------- +set selection [ns_db 0or1row $db " +select f.faq_name, + f.scope, + f.group_id as current_group_id, + faq_count_entries(faq_id) as number_of_questions +from faqs f +where f.faq_id = $faq_id "] + +if { [empty_string_p $selection] } { + # this FAQ doesn't exist + ns_return 200 text/html " + [ad_admin_header "No FAQ"] + +

    No FAQ

    + + [ad_admin_context_bar [list index "FAQs"] "No FAQ"] + + +
    + + Sorry, but the FAQ you requested does not exist. + +

    + + [ad_admin_footer]" + + return +} else { + # the FAQ exists + set_variables_after_query +} + +# set_variables_after_query + + +if { $scope == "public" } { + set admin_url_string "/faq/admin/one?[export_url_vars faq_id scope]" + set userpage_url_string "/faq/one?[export_url_vars faq_id scope]" +} else { + set short_name [database_to_tcl_string $db "select short_name + from user_groups + where group_id = $current_group_id"] + set admin_url_string "/[ad_parameter GroupsDirectory ug]/[ad_parameter GroupsAdminDirectory ug]/[ad_urlencode $short_name]/faq/one?[export_url_vars faq_id scope]&group_id=$current_group_id" + set userpage_url_string "/[ad_parameter GroupsDirectory ug]/[ad_urlencode $short_name]/faq/one?[export_url_vars faq_id scope]&group_id=$current_group_id" +} + + +# make and option list of all the group names -------------- +# highlighting the current group --------------------------- + +set selection [ns_db select $db " +select group_name, + group_id +from user_groups +where user_groups.group_type <> 'administration' +order by group_name "] + +set group_option_list "" + +#------------------------------------------------------------ + +ns_db releasehandle $db + +# -- serve the page --------------------------------- + +ns_return 200 text/html " +[ad_admin_header "FAQ: $faq_name"] + +

    FAQ: $faq_name

    + +[ad_admin_context_bar [list index "FAQs"] $faq_name] + +
    + + + + + + + + + + + + + + +
    Maintainer Page: $admin_url_string
    User Page: $userpage_url_string
    Number of questions: $number_of_questions
    + +

    Properties

    + + + + + +[export_form_vars faq_id] + + + + + + + + + + + + + + + +
    FAQ Name:
    Group:$group_option_list
     
    + + +     + + +

    + +

    Extreme Actions

    + + + +[ad_admin_footer]" + + + + + Index: web/openacs/www/admin/file-storage/delete-file-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/file-storage/delete-file-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/file-storage/delete-file-2.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,93 @@ +# delete-file-2.tcl,v 1.4.2.1 2000/02/03 09:28:03 ron Exp +set_the_usual_form_variables + +# file_id, maybe group_id + +set return_url index.tcl + + + +set exception_count 0 +set exception_text "" + + +## does the file exist? +if {(![info exists file_id])||([empty_string_p $file_id])} { + incr exception_count + append exception_text "
  • No file was specified" +} + + +## return errors +if { $exception_count> 0 } { + ad_return_complaint $exception_count $exception_text + return 0 +} + +set db [ns_db gethandle] + +set owner_id [database_to_tcl_string $db "select owner_id from fs_files where file_id=$file_id"] +set group_id [database_to_tcl_string $db "select group_id from fs_files where file_id=$file_id"] + + +# is this a folder ? Get all its children +set folder_p [database_to_tcl_string $db "select folder_p from fs_files where file_id=$file_id"] +ns_db dml $db "begin transaction" + +if {$folder_p=="t"} { + +# set sql_query " +# select file_id +# from fs_files +# connect by prior file_id = parent_id +# start with file_id = $file_id " + + set sql_query " + select file_id + from fs_files + where fs_node_is_child($file_id,file_id) = 't'" + + + set children_list [database_to_tcl_list $db $sql_query] + set children_list [join $children_list ", "] + + set sql_real_delete_versions " + delete from fs_versions + where file_id in ($children_list)" + + set sql_real_delete " + delete from fs_files + where file_id in ( $children_list ) " + + +} else { + set sql_real_delete_versions " + delete from fs_versions + where file_id = $file_id" + + set sql_real_delete " + delete from fs_files + where file_id = $file_id" +} + +ns_db dml $db $sql_real_delete_versions + +ns_db dml $db $sql_real_delete + +fs_order_files $db $owner_id $group_id + +ns_db dml $db "end transaction" + + + +ns_returnredirect $return_url + + + + + + + + + + Index: web/openacs/www/admin/file-storage/delete-file.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/file-storage/delete-file.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/file-storage/delete-file.tcl 17 Apr 2001 14:05:08 -0000 1.1 @@ -0,0 +1,83 @@ +# delete-file.tcl,v 1.1.4.1 2000/02/03 09:28:04 ron Exp +set_the_usual_form_variables + +# file_id, object_type, return_url, maybe group_id + + +set title "Delete $object_type" +set db [ns_db gethandle ] +# Determine if we are working in a Group, or our personal space +# this is based if no group_id was sent - then we are in +# our personal area - otherwise the group defined by group_id +set exception_text "" +set exception_count 0 + +if { [info exists group_id] && ![empty_string_p $group_id]} { + set group_name [database_to_tcl_string $db " + select group_name + from user_groups + where group_id=$group_id"] + + set navbar [ad_admin_context_bar [list "index.tcl" [ad_parameter SystemName fs]] [list $return_url $group_name] $title] +} else { + set navbar [ad_admin_context_bar [list "index.tcl" [ad_parameter SystemName fs]] $title] +} +## does the file exist? +if {(![info exists file_id])||([empty_string_p $file_id])} { + ns_returnredirect $return_url + return +} + +if {(![info exists object_type])||([empty_string_p $object_type])} { + incr exception_count + incr exception_text "
  • This page may only be accessed from the edit page" +} +## return errors +if { $exception_count> 0 } { + ad_return_complaint $exception_count $exception_text + return 0 +} + +set file_title [database_to_tcl_string $db "select file_title from fs_files where file_id=$file_id"] + +set html "[ad_admin_header $title] + +

    $title

    + +$navbar + +
    " + +# if this is a folder - get the number of childern +if {$object_type=="Folder"} { +# set sql_child_count "Select count(*) - 1 +# from fs_files +# connect by prior file_id = parent_id +# start with file_id=$file_id " + + set sql_child_count "Select count(*) - 1 + from fs_files + where fs_node_is_child($file_id,file_id) = 't'" + + set number_of_children [database_to_tcl_string $db $sql_child_count] + append html "This folder has $number_of_children sub-folders/files.
    " +} + + +append html " + Are you sure you want to delete $file_title?
    + Since you are an administrator, delete will really delete from the database. +
    + +
    +
    + + + [export_form_vars file_id return_url] +
    + [ad_admin_footer] +" + + +ns_return 200 text/html $html + Index: web/openacs/www/admin/file-storage/delete-version-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/file-storage/delete-version-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/file-storage/delete-version-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,58 @@ +# delete-version-2.tcl,v 1.3.2.1 2000/02/03 09:28:06 ron Exp +# delete-version-2.tcl +# +# by dh@arsdigita.com, July 1999 +# +# 1) finds the id of the latest version of a file that is not being deleted (new_latest_id) +# 2) updates all the old versions to point to this one (new_latest_id) +# 3) updates the new latest to have a NULL superseded_id +# 4) deletes the version to kill +# +# (note that if the version being deleted is NOT the latest one, we still do all of the +# preceding work but it doesn't have any effect) + +set_the_usual_form_variables + +# file_id, version_id + +set return_url index.tcl + +set exception_count 0 +set exception_text "" + +## does the file exist? +if {(![info exists file_id])||([empty_string_p $file_id])} { + incr exception_count + append exception_text "
  • No file was specified" +} + + +## return errors +if { $exception_count> 0 } { + ad_return_complaint $exception_count $exception_text + return 0 +} + +set db [ns_db gethandle] + +set new_newest_query "select max(version_id) +from fs_versions +where file_id = $file_id +and version_id <> $version_id" + +set new_latest_id [database_to_tcl_string $db $new_newest_query] + + +set sql_delete_version + +ns_db dml $db "begin transaction" + +ns_db dml $db "update fs_versions set superseded_by_id = $new_latest_id where file_id = $file_id" + +ns_db dml $db "update fs_versions set superseded_by_id = NULL where version_id = $new_latest_id and file_id = $file_id" + +ns_db dml $db "delete from fs_versions where version_id = $version_id" + +ns_db dml $db "end transaction" + +ns_returnredirect $return_url Index: web/openacs/www/admin/file-storage/delete-version.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/file-storage/delete-version.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/file-storage/delete-version.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,93 @@ +# delete-version.tcl,v 1.2.4.1 2000/02/03 09:28:07 ron Exp +# delete-version.tcl +# +# by dh@arsdigita.com, July 1999 +# +# presents options to user of versions to delete + +set_the_usual_form_variables + +# file_id, object_type, return_url, maybe group_id + + +set title "Delete a file version" +set db [ns_db gethandle ] +# Determine if we are working in a Group, or our personal space +# this is based if no group_id was sent - then we are in +# our personal area - otherwise the group defined by group_id +set exception_text "" +set exception_count 0 + +if { [info exists group_id] && ![empty_string_p $group_id]} { + set group_name [database_to_tcl_string $db " + select group_name + from user_groups + where group_id=$group_id"] + + set navbar [ad_admin_context_bar "index.tcl {[ad_parameter SystemName fs]}" "$return_url $group_name" "$title"] +} else { + set navbar [ad_admin_context_bar "index.tcl {[ad_parameter SystemName fs]}" $title] +} +## does the file exist? +if {(![info exists file_id])||([empty_string_p $file_id])} { + ns_returnredirect $return_url + return +} + +## does the version exist? +if {(![info exists version_id]) || ([empty_string_p $version_id]) || ([catch {database_to_tcl_string $db "select 1 from fs_versions where version_id=$version_id"} junk]) } { + ns_returnredirect $return_url +} + +## return errors +if { $exception_count> 0 } { + ad_return_complaint $exception_count $exception_text + return 0 +} + +set file_title [database_to_tcl_string $db "select file_title from fs_files where file_id=$file_id"] +set number_of_versions [database_to_tcl_string $db "select count(version_id) from fs_versions where file_id=$file_id"] + +set html "[ad_admin_header $title ] +

    $title

    +$navbar +
    " + +set version_date [database_to_tcl_string $db " select to_char(creation_date,'MM/DD/YY HH24:MI') from fs_versions where version_id=$version_id"] + +if {$number_of_versions >1 } { +append html " + Are you sure you want to delete the version of $file_title dated $version_date?
    + Since you are an administrator, delete will really delete from the database. +
    + +
    +
    + + + [export_form_vars file_id version_id return_url] +
    + [ad_admin_footer] + " +} else { +append html " + Are you sure you want to delete the only version of $file_title?
    + Since you are an administrator, delete will really delete from the database. +
    + +
    +
    + + + [export_form_vars file_id return_url] +
    + [ad_admin_footer] + " +} + ns_return 200 text/html $html + + + + + + Index: web/openacs/www/admin/file-storage/display-info.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/file-storage/display-info.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/file-storage/display-info.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,217 @@ +# display-info.tcl,v 1.7.2.1 2000/02/03 09:28:08 ron Exp +set_the_usual_form_variables + +# file_id maybe group_id return_url + +set return_url /admin/file-storage/display-info.tcl?[ns_conn query] +set graphic "" + +set db [ns_db gethandle] + +set exception_text "" +set exception_count 0 + +if {![info exists file_id] || [empty_string_p $file_id] } { + ns_returnredirect index.tcl +} + +# set file_info_query " +# select count(fs_versions.version_id) as n_versions, f1.file_title, f2.file_title as parent_title, f1.folder_p, f1.parent_id, +# fs_versions_latest.url, first_names || ' ' || last_name as owner_name, +# public_read_p +# from fs_files f1, fs_files f2, fs_versions_latest, users, general_permissions gp, fs_versions +# where f1.file_id=$file_id +# and f1.parent_id=f2.file_id(+) +# and fs_versions_latest.version_id = gp.on_what_id +# and gp.on_which_table = 'FS_VERSIONS' +# and fs_versions_latest.file_id = f1.file_id +# and f1.file_id = fs_versions.file_id +# and f1.owner_id=user_id +# group by f1.file_title, f2.file_title, f1.folder_p, f1.parent_id, fs_versions_latest.url, first_names, last_name, public_read_p" + + +set file_info_query " +select count(fs_versions.version_id) as n_versions, f1.file_title, f2.file_title as parent_title, f1.folder_p, f1.parent_id, + fs_versions_latest.url, first_names || ' ' || last_name as owner_name, + public_read_p +from fs_files f1, fs_files f2, fs_versions_latest, users, general_permissions gp, fs_versions +where f1.file_id=$file_id +and f1.parent_id=f2.file_id +and fs_versions_latest.version_id = gp.on_what_id +and gp.on_which_table = 'FS_VERSIONS' +and fs_versions_latest.file_id = f1.file_id +and f1.file_id = fs_versions.file_id +and f1.owner_id=user_id +union +select count(fs_versions.version_id) as n_versions, f1.file_title, '' as parent_title, f1.folder_p, f1.parent_id, + fs_versions_latest.url, first_names || ' ' || last_name as owner_name, + public_read_p +from fs_files f1, fs_versions_latest, users, general_permissions gp, fs_versions +where f1.file_id=$file_id +and not exists (select 1 from fs_files + where file_id = f1.parent_id) +and fs_versions_latest.version_id = gp.on_what_id +and gp.on_which_table = 'FS_VERSIONS' +and fs_versions_latest.file_id = f1.file_id +and f1.file_id = fs_versions.file_id +and f1.owner_id=user_id +group by f1.file_title, parent_title, f1.folder_p, f1.parent_id, fs_versions_latest.url, first_names, last_name, public_read_p" + + +set selection [ns_db 0or1row $db $file_info_query] +if [empty_string_p $selection] { + ad_return_error "File not found" "Could not find file $file_id; it may have been deleted." + return +} + +set_variables_after_query + +if {$folder_p=="t"} { + set object_type "Folder" +} else { + set object_type "File" +} + + +if { [info exists group_id] && ![empty_string_p $group_id]} { + set group_name [database_to_tcl_string $db " + select group_name + from user_groups + where group_id=$group_id"] + + set tree_name "$group_name document tree" +} else { + if {$public_read_p == "t"} { + set tree_name "Shared [ad_system_name] document tree" + } else { + set tree_name "Your personal document tree" + } +} + + +set title "$file_title" + +if {[empty_string_p $parent_title]} { + set parent_title "Root (Top Level)" +} + + +# the navbar is determined by where they just came from +if ![info exists source] { + set source "" +} + +switch $source { + "personal" { + set navbar [ad_context_bar_ws [list "index.tcl" [ad_parameter SystemName fs]] [list "personal.tcl" "Personal document tree"] "One File"] +} + "group" { + set navbar [ad_context_bar_ws [list "index.tcl" [ad_parameter SystemName fs]] [list "group.tcl?group_id=$group_id" "$group_name document tree"] "One File"] + } + "public_individual" { + set navbar [ad_context_bar_ws [list "index.tcl" [ad_parameter SystemName fs]] [list "public-one-person.tcl?[export_url_vars owner_id]" "$owner_name's publically accessible files"] "One File"] + } + "public_group" { + set navbar [ad_context_bar_ws [list "index.tcl" [ad_parameter SystemName fs]] [list "public-one-group.tcl?[export_url_vars group_id]" "$group_name publically accessible files"] "One File"] + } + default { + set navbar [ad_context_bar_ws [list "index.tcl" [ad_parameter SystemName fs]] "One File"] + } +} + + +set html " + +[ad_header $title ] + +

    $title

    + +$navbar +
    +" + + +append html " +
      +
    • $object_type Title: $file_title +
    • Owner: $owner_name +
    • Located in: $tree_name / $parent_title +
    • Delete File +
    • Edit File +
    +
    +" + +set version_html "" +set version_count 0 + + +set selection [ns_db select $db "select distinct permissions_id, + version_id, + version_description, + client_file_name, + round(float8(n_bytes)/1024.0) as n_kbytes, + first_names||' '||last_name as creator_name, + to_char(creation_date,'[fs_date_picture]') as pretty_creation_date, + coalesce(file_type,upper(file_extension)||' File') as file_type, + author_id + from fs_versions, + users, + general_permissions gp + where file_id=$file_id + and author_id=users.user_id + and gp.on_what_id = fs_versions.version_id + and gp.on_which_table = 'FS_VERSIONS' + order by pretty_creation_date desc"] + + + +set font "" + +set header_color [ad_parameter HeaderColor fs] + +if [empty_string_p $url] { + append html "
    + + +" + + while {[ns_db getrow $db $selection]} { + set_variables_after_query + incr version_count + set page_name "$file_title: version [expr $n_versions - $version_count + 1]" + + regexp {.*\\([^\\]+)} $client_file_name match client_file_name + + append version_html " + " + + append version_html " + + + + + + + + \n" + } + + append html "$version_html +
    +$font   All Versions of $file_title
    $font   Name  $font   Author  $font   Size  $font   Type  $font   Modified  $font   Version Notes  $font   Permissions  $font  
      $font$graphic$client_file_name    $creator_name  $font   $n_kbytes  $font   [fs_pretty_file_type $file_type]  $font   $pretty_creation_date  $font $version_description  $font View$font Delete  
    " + +} else { + append html "$url" +} + +append html " +
    +" +append html " + +[ad_admin_footer]" + +ns_db releasehandle $db + +ns_return 200 text/html $html Index: web/openacs/www/admin/file-storage/download-file.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/file-storage/download-file.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/file-storage/download-file.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,32 @@ +# download-file.tcl,v 1.1.4.1 2000/02/03 09:28:10 ron Exp +set_the_usual_form_variables + +# version_id + +################ +# Must check the user's privelages of downloading this file + +set db [ns_db gethandle] + +set filename [database_to_tcl_string $db " +select client_file_name +from fs_versions +where version_id=$version_id"] + +ReturnHeaders [ns_guesstype $filename] + +# ns_ora write_blob $db "select version_content +# from fs_versions +# where version_id=$version_id" + + +with_transaction $db { + + set blob_id [database_to_tcl_string $db "select lob + from fs_versions + where version_id=$version_id"] + ns_pg blob_write $db $blob_id + +} + +ns_db releasehandle $db Index: web/openacs/www/admin/file-storage/download.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/file-storage/download.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/file-storage/download.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,32 @@ +# download.tcl,v 3.1 2000/03/11 23:09:34 aure Exp + +set_the_usual_form_variables + +# version_id + +################ +# Must check the user's privelages of downloading this file + +set db [ns_db gethandle] + +set filename [database_to_tcl_string $db " +select client_file_name +from fs_versions +where version_id=$version_id"] + +ReturnHeaders [ns_guesstype $filename] + +# ns_ora write_blob $db "select version_content +# from fs_versions +# where version_id=$version_id" + +with_transaction $db { + + set blob_id [database_to_tcl_string $db "select lob + from fs_versions + where version_id=$version_id"] + ns_pg blob_write $db $blob_id + +} + +ns_db releasehandle $db Index: web/openacs/www/admin/file-storage/edit-file-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/file-storage/edit-file-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/file-storage/edit-file-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,94 @@ +# edit-file-2.tcl,v 1.4.2.1 2000/02/03 09:28:11 ron Exp +set_the_usual_form_variables + +# file_id, return_url, maybe group_id (lots of things) +# parent_id + + +set db [ns_db gethandle] + + +# check the user input first + +set exception_text "" +set exception_count 0 + +if { ![info exists file_title] || [empty_string_p $file_title] } { + append exception_text "
  • You must give a title to the file\n" + incr exception_count +} + +if {![info exists return_url]} { + append exception_text "
  • The return url was missing" + incr exception_count +} + +set user_id [database_to_tcl_string $db "select owner_id from fs_files where file_id=$file_id"] +if { [info exists group_id] && ![empty_string_p $group_id]} { + set check "select 1 + from user_group_map + where user_id=$user_id + and group_id=$group_id" + if [catch { set check [database_to_tcl_string $db $check]} error_msg] { + append exception_text "
  • You are not a member of this group $group_id \n" + incr exception_count + } +} else { + set group_id "" +} +## does the file exist? +if {(![info exists file_id])||([empty_string_p $file_id])} { + incr exception_count + append exception_text "
  • No file was specified" +} +## does user_id own the file? +set sql_test "select file_title + from fs_files + where file_id=$file_id + and owner_id=$user_id" +if { [ catch {database_to_tcl_string $db $sql_test} file_title] } { + incr exception_count + append exception_text "
  • You do not own this file" +} + + +if { $exception_count> 0 } { + ad_return_complaint $exception_count $exception_text + return 0 +} +set folder_p [database_to_tcl_string $db "select folder_p from fs_files where file_id=$file_id"] + + +set file_insert " + update fs_files + set file_title = '$QQfile_title', + parent_id=[ns_dbquotevalue $parent_id] + where file_id=$file_id + and owner_id=$user_id +" + + + + +ns_db dml $db "begin transaction" + +if {[ catch { ns_db dml $db $file_insert } junk] } { + ns_dml $db "end transaction" + ns_returnredirect $return_url +} + +fs_order_files $db $user_id $group_id + +ns_db dml $db "end transaction" + +ns_returnredirect $return_url + + + + + + + + + + Index: web/openacs/www/admin/file-storage/edit-file.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/file-storage/edit-file.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/file-storage/edit-file.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,99 @@ +# edit-file.tcl,v 1.5.2.1 2000/02/03 09:28:12 ron Exp +set_the_usual_form_variables + +# return url and maybe group_id +# file_id + +set title "Edit Properties" + +set db [ns_db gethandle] + +set exception_text "" +set exception_count 0 + +if {(![info exists group_id])||([empty_string_p $group_id]) } { + set group_id "" +} + +if {(![info exists file_id])||([empty_string_p $file_id])} { + incr exception_count + append exception_text "
  • No file was specified" +} + +set owner_id [database_to_tcl_string $db "select owner_id from fs_files where file_id=$file_id"] +## return errors +if { $exception_count> 0 } { + ad_return_complaint $exception_count $exception_text + return 0 +} + +# get the owner_id of this file +set owner_id [database_to_tcl_string $db "select owner_id from fs_files where file_id=$file_id"] +set file_title [database_to_tcl_string $db "select file_title from fs_files where file_id=$file_id"] + +## get the object type of this file_id +if {[database_to_tcl_string $db "select folder_p from fs_files where file_id=$file_id"]=="t" } { + set object_type "Folder" +} else { + set object_type "File" +} + +## get the current location of the file (ie parent_id) +set current_parent_id [database_to_tcl_string $db "select parent_id from fs_files where file_id=$file_id"] + +if { [info exists group_id] && ![empty_string_p $group_id]} { + set group_name [database_to_tcl_string $db " + select group_name + from user_groups + where group_id=$group_id"] + + set navbar [ad_admin_context_bar "index.tcl {[ad_parameter SystemName fs]}" "group.tcl?group_id=$group_id \"$group_name\"" "$return_url {$file_title}" "$title"] +} else { + set user_id [database_to_tcl_string $db "select owner_id from fs_files where file_id=$file_id"] + set personal_name [database_to_tcl_string $db "select first_names||' '||last_name from users where user_id=$user_id"] + append personal_name "'s Files" + set navbar [ad_admin_context_bar "index.tcl {[ad_parameter SystemName fs]}" "personal-space.tcl?owner_id=$user_id \"$personal_name\"" "$return_url {$file_title}" "$title"] + set group_id "" +} + +set html "[ad_admin_header $title] + +

    $title

    + +$navbar + +
    +
    + +[export_form_vars file_id return_url group_id] + + + + + + + + + + + + + + + + +
    $object_type Title:
    Location:[fs_folder_selection $db $owner_id $group_id $file_id]
    Severe actions:Delete this $object_type and all of it's versions. +
    +
    + +
    + +[ad_admin_footer] +" + +ns_db releasehandle $db + +ns_return 200 text/html $html + + + Index: web/openacs/www/admin/file-storage/file-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/file-storage/file-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/file-storage/file-delete-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,92 @@ +# file-delete-2.tcl,v 3.1 2000/03/11 23:09:35 aure Exp +set_the_usual_form_variables + +# file_id, maybe group_id + +set return_url index.tcl + + + +set exception_count 0 +set exception_text "" + + +## does the file exist? +if {(![info exists file_id])||([empty_string_p $file_id])} { + incr exception_count + append exception_text "
  • No file was specified" +} + + +## return errors +if { $exception_count> 0 } { + ad_return_complaint $exception_count $exception_text + return 0 +} + +set db [ns_db gethandle] + +set owner_id [database_to_tcl_string $db "select owner_id from fs_files where file_id=$file_id"] +set group_id [database_to_tcl_string $db "select group_id from fs_files where file_id=$file_id"] + + +# is this a folder ? Get all its children +set folder_p [database_to_tcl_string $db "select folder_p from fs_files where file_id=$file_id"] +ns_db dml $db "begin transaction" + +if {$folder_p=="t"} { + +# set sql_query " +# select file_id +# from fs_files +# connect by prior file_id = parent_id +# start with file_id = $file_id " + + set sql_query " + select file_id + from fs_files + where fs_node_is_child($file_id,file_id) = 't'" + + set children_list [database_to_tcl_list $db $sql_query] + set children_list [join $children_list ", "] + + set sql_real_delete_versions " + delete from fs_versions + where file_id in ($children_list)" + + set sql_real_delete " + delete from fs_files + where file_id in ( $children_list ) " + + +} else { + set sql_real_delete_versions " + delete from fs_versions + where file_id = $file_id" + + set sql_real_delete " + delete from fs_files + where file_id = $file_id" +} + +ns_db dml $db $sql_real_delete_versions + +ns_db dml $db $sql_real_delete + +fs_order_files $db $owner_id $group_id + +ns_db dml $db "end transaction" + + + +ns_returnredirect $return_url + + + + + + + + + + Index: web/openacs/www/admin/file-storage/file-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/file-storage/file-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/file-storage/file-delete.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,82 @@ +# file-delete.tcl,v 3.1 2000/03/11 23:09:35 aure Exp +set_the_usual_form_variables + +# file_id, object_type, return_url, maybe group_id + + +set title "Delete $object_type" +set db [ns_db gethandle ] +# Determine if we are working in a Group, or our personal space +# this is based if no group_id was sent - then we are in +# our personal area - otherwise the group defined by group_id +set exception_text "" +set exception_count 0 + +if { [info exists group_id] && ![empty_string_p $group_id]} { + set group_name [database_to_tcl_string $db " + select group_name + from user_groups + where group_id=$group_id"] + + set navbar [ad_admin_context_bar [list "index.tcl" [ad_parameter SystemName fs]] [list $return_url $group_name] $title] +} else { + set navbar [ad_admin_context_bar [list "index.tcl" [ad_parameter SystemName fs]] $title] +} +## does the file exist? +if {(![info exists file_id])||([empty_string_p $file_id])} { + ns_returnredirect $return_url + return +} + +if {(![info exists object_type])||([empty_string_p $object_type])} { + incr exception_count + incr exception_text "
  • This page may only be accessed from the edit page" +} +## return errors +if { $exception_count> 0 } { + ad_return_complaint $exception_count $exception_text + return 0 +} + +set file_title [database_to_tcl_string $db "select file_title from fs_files where file_id=$file_id"] + +set html "[ad_admin_header $title] + +

    $title

    + +$navbar + +
    " + +# if this is a folder - get the number of childern +if {$object_type=="Folder"} { +# set sql_child_count "Select count(*) - 1 +# from fs_files +# connect by prior file_id = parent_id +# start with file_id=$file_id " + set sql_child_count " + select count(*) - 1 + from fs_files + where fs_node_is_child($file_id,file_id) = 't'" + set number_of_children [database_to_tcl_string $db $sql_child_count] + append html "This folder has $number_of_children sub-folders/files.
    " +} + + +append html " + Are you sure you want to delete $file_title?
    + Since you are an administrator, delete will really delete from the database. +
    + +
    +
    + + + [export_form_vars file_id return_url] +
    + [ad_admin_footer] +" + + +ns_return 200 text/html $html + Index: web/openacs/www/admin/file-storage/file-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/file-storage/file-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/file-storage/file-edit-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,93 @@ +# file-edit-2.tcl,v 3.1.2.1 2000/03/22 09:02:27 carsten Exp +set_the_usual_form_variables + +# file_id, return_url, maybe group_id (lots of things) +# parent_id + + +set db [ns_db gethandle] + + +# check the user input first + +set exception_text "" +set exception_count 0 + +if { ![info exists file_title] || [empty_string_p $file_title] } { + append exception_text "
  • You must give a title to the file\n" + incr exception_count +} + +if {![info exists return_url]} { + append exception_text "
  • The return url was missing" + incr exception_count +} + +set user_id [database_to_tcl_string $db "select owner_id from fs_files where file_id=$file_id"] +if { [info exists group_id] && ![empty_string_p $group_id]} { + + set check "select ad_group_member_p ( $user_id, $group_id ) from dual" + + if [catch { set check [database_to_tcl_string $db $check]} error_msg] { + append exception_text "
  • You are not a member of this group $group_id \n" + incr exception_count + } +} else { + set group_id "" +} +## does the file exist? +if {(![info exists file_id])||([empty_string_p $file_id])} { + incr exception_count + append exception_text "
  • No file was specified" +} +## does user_id own the file? +set sql_test "select file_title + from fs_files + where file_id=$file_id + and owner_id=$user_id" +if { [ catch {database_to_tcl_string $db $sql_test} file_title] } { + incr exception_count + append exception_text "
  • You do not own this file" +} + + +if { $exception_count> 0 } { + ad_return_complaint $exception_count $exception_text + return 0 +} +set folder_p [database_to_tcl_string $db "select folder_p from fs_files where file_id=$file_id"] + + +set file_insert " + update fs_files + set file_title = '$QQfile_title', + parent_id=[ns_dbquotevalue $parent_id] + where file_id=$file_id + and owner_id=$user_id +" + + + + +ns_db dml $db "begin transaction" + +if {[ catch { ns_db dml $db $file_insert } junk] } { + ns_db dml $db "end transaction" + ns_returnredirect $return_url +} + +fs_order_files $db $user_id $group_id + +ns_db dml $db "end transaction" + +ns_returnredirect $return_url + + + + + + + + + + Index: web/openacs/www/admin/file-storage/file-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/file-storage/file-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/file-storage/file-edit.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,98 @@ +# file-edit.tcl,v 3.1.2.1 2000/03/22 09:02:27 carsten Exp + +set_the_usual_form_variables +# file_id, public_p, return_url and maybe group_id + +set title "Edit Properties" + +set db [ns_db gethandle] + +set exception_text "" +set exception_count 0 + +if {(![info exists group_id])||([empty_string_p $group_id]) } { + set group_id "" +} + +if {(![info exists file_id])||([empty_string_p $file_id])} { + incr exception_count + append exception_text "
  • No file was specified" +} + +set owner_id [database_to_tcl_string $db "select owner_id from fs_files where file_id=$file_id"] +## return errors +if { $exception_count> 0 } { + ad_return_complaint $exception_count $exception_text + return 0 +} + +# get the owner_id of this file +set owner_id [database_to_tcl_string $db "select owner_id from fs_files where file_id=$file_id"] +set file_title [database_to_tcl_string $db "select file_title from fs_files where file_id=$file_id"] + +## get the object type of this file_id +if {[database_to_tcl_string $db "select folder_p from fs_files where file_id=$file_id"]=="t" } { + set object_type "Folder" +} else { + set object_type "File" +} + +## get the current location of the file (ie parent_id) +set current_parent_id [database_to_tcl_string $db "select parent_id from fs_files where file_id=$file_id"] + +if { [info exists group_id] && ![empty_string_p $group_id]} { + set group_name [database_to_tcl_string $db " + select group_name + from user_groups + where group_id=$group_id"] + + set navbar [ad_admin_context_bar "index.tcl {[ad_parameter SystemName fs]}" "group.tcl?group_id=$group_id \"$group_name\"" "$return_url {$file_title}" "$title"] +} else { + set user_id [database_to_tcl_string $db "select owner_id from fs_files where file_id=$file_id"] + set personal_name [database_to_tcl_string $db "select first_names||' '||last_name from users where user_id=$user_id"] + append personal_name "'s Files" + set navbar [ad_admin_context_bar "index.tcl {[ad_parameter SystemName fs]}" "personal-space.tcl?owner_id=$user_id \"$personal_name\"" "$return_url {$file_title}" "$title"] + set group_id "" +} + +set html "[ad_admin_header $title] + +

    $title

    + +$navbar + +
    +
    + +[export_form_vars file_id return_url group_id] + + + + + + + + + + + + + + + + +
    $object_type Title:
    Location:[fs_folder_selection $db $owner_id $group_id $public_p $file_id]
    Severe actions:Delete this $object_type and all of it's versions. +
    +
    + +
    + +[ad_admin_footer] +" + +ns_db releasehandle $db + +ns_return 200 text/html $html + + + Index: web/openacs/www/admin/file-storage/group.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/file-storage/group.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/file-storage/group.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,187 @@ +# /admin/file-storage/group.tcl +# +# by aure@arsdigita.com, July 1999 +# +# displays a group's files +# +# group.tcl,v 3.1.2.1 2000/03/17 17:42:25 aure Exp + +ad_page_variables {group_id} + +set db [ns_db gethandle] + +if [empty_string_p $group_id] { + ad_return_error "Can't find group" "Can't find group #$group_id" + return +} + +set group_name [database_to_tcl_string_or_null $db " + select group_name from user_groups where group_id = $group_id"] + +if [empty_string_p $group_name] { + ad_return_error "Can't find group" "Can't find group #$group_id" + return +} + +set return_url "group?[ns_conn query]" +set title "$group_name's files" + +set page_content " +[ad_admin_header $title] + +

    $title

    + +[ad_admin_context_bar [list "" [ad_parameter SystemName fs]] $title] + +
    " + +# get the user's files from the database and parse the output to reflect the folder stucture + +# set sorted_query " +# select fs_files.file_id, +# file_title, +# folder_p, +# lpad('x',depth,'x') as spaces, +# to_char(v.creation_date,'MM/DD/YY HH24:MI') as creation_date, +# round(n_bytes/1024) as n_kbytes, +# coalesce(file_type,upper(file_extension)||' File') as file_type, +# first_names||' '||last_name as owner_name, +# fs_files.deleted_p, +# owner_id +# from fs_files, +# fs_versions_latest v, +# users +# where group_id = $group_id +# and owner_id = users.user_id +# and fs_files.file_id = v.file_id(+) +# order by sort_key" + + +set sorted_query " + select fs_files.file_id, + file_title, + folder_p, + lpad('x',depth,'x') as spaces, + to_char(v.creation_date,'MM/DD/YY HH24:MI') as creation_date, + round(float8(n_bytes)/1024.0) as n_kbytes, + coalesce(file_type,upper(file_extension)||' File') as file_type, + first_names||' '||last_name as owner_name, + fs_files.deleted_p, + owner_id + from fs_files, + fs_versions_latest v, + users + where group_id = $group_id + and owner_id = users.user_id + and fs_files.file_id = v.file_id + union + select fs_files.file_id, + file_title, + folder_p, + lpad('x',depth,'x') as spaces, + '' as creation_date, + 0 as n_kbytes, + '' as file_type, + first_names||' '||last_name as owner_name, + fs_files.deleted_p, + owner_id + from fs_files, + users + where group_id = $group_id + and owner_id = users.user_id + and not exists (select 1 from fs_versions_latest + where file_id = fs_files.file_id) + order by sort_key" + +set file_html "" +set file_count 0 + +set selection [ns_db select $db $sorted_query] + +set font "    " +set header_color "#cccccc" + +append page_content " + + +
    + + + + + + + + + + " + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + regsub -all x $spaces "" spaces + set spaces [string trim $spaces] + + if {$folder_p=="t"} { + + append file_html " + + + + + + + \n" + + } else { + + append file_html " + + + + + + + \n" + + } + + incr file_count +} + +if {$file_count!=0} { + + append page_content $file_html + +} else { + + append page_content "" + +} + +append page_content " +
    $font   + $group_name's files
    $font   Name$font   Author  $font   Size  $font   Type  $font   Modified  
      ${spaces}$font + $file_title $font   File Folder   
      ${spaces}$font + $file_title $font$owner_name $font   $n_kbytes KB  $font   $file_type  $font   $creation_date  
      No files available in this group.  
    + + + + +[ad_admin_footer]" + +# release the database handle + +ns_db releasehandle $db + +# serve the page + +ns_return 200 text/html $page_content + + + + + + + + + Index: web/openacs/www/admin/file-storage/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/file-storage/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/file-storage/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,92 @@ +# /admin/file-storage/index.tcl +# +# at this point mostly by philg@mit.edu +# +# gives a site-admin a high-level view of who is using the file storage system +# +# index.tcl,v 3.1 2000/03/11 23:10:04 aure Exp + + +set page_content " +[ad_admin_header "[ad_parameter SystemName fs] Administration"] + +

    [ad_parameter SystemName fs]

    + +[ad_admin_context_bar [ad_parameter SystemName fs]] + +
    + +Documentation: /doc/file-storage + +

    + +Users with files/folders in their personal directories: " + +set db [ns_db gethandle subquery] + + +# get the names of users who have stuff in their personal space + +set selection [ns_db select $db " + select users.user_id, users.first_names, users.last_name, + count(distinct fs_files.file_id) as n_files, + round(float8(sum(fs_versions.n_bytes))/1024.0) as n_kbytes + from users, fs_files, fs_versions + where users.user_id = fs_files.owner_id + and fs_files.file_id = fs_versions.file_id + and fs_files.group_id is NULL + and fs_files.deleted_p='f' + group by users.user_id, users.first_names, users.last_name"] + +set persons_html "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append persons_html " +

  • $first_names $last_name: + $n_files files; $n_kbytes Kbytes\n" +} + +append page_content "
      $persons_html
    " + +set selection [ns_db select $db " +select user_groups.group_id, + group_name, + round(float8(sum(fs_versions.n_bytes))/1024.0) as n_kbytes, + count(distinct fs_files.file_id) as n_files +from user_groups, fs_files, fs_versions +where user_groups.group_id = fs_files.group_id +and fs_files.file_id = fs_versions.file_id +group by user_groups.group_id, group_name"] + +set group_html "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append group_html " +
  • $group_name: + $n_files files; $n_kbytes Kbytes\n" +} + +if { ![empty_string_p $group_html] } { + append page_content "Groups with files/folders stored: +
      $group_html
    \n" +} + +append page_content "[ad_admin_footer]" + +# release the database handle + +ns_db releasehandle $db + +# serve the page + +ns_return 200 text/html $page_content + + + + + + + + Index: web/openacs/www/admin/file-storage/info.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/file-storage/info.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/file-storage/info.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,268 @@ +# +# /admin/file-storage/info.tcl +# +# by aure@arsdigita.com, July 1999 +# +# info.tcl,v 3.1.2.8 2000/03/24 02:37:36 aure Exp +# + +ad_page_variables { + {file_id} + {group_id ""} + {owner_id ""} +} + +set return_url "info?[ns_conn query]" +set graphic "" + +set db [ns_db gethandle] + +set exception_text "" +set exception_count 0 + +if {![info exists file_id] || [empty_string_p $file_id] } { + ns_returnredirect "" +} + + +set file_info_query " +select count(fs_versions.version_id) as n_versions, + f1.file_title, + f2.file_title as parent_title, + f1.folder_p, + f1.parent_id, + fs_versions_latest.url, + first_names || ' ' || last_name as owner_name, + f1.public_p +from fs_files f1, + fs_files f2, + fs_versions_latest, + users, + general_permissions gp, fs_versions +where f1.file_id = $file_id +and f1.parent_id = f2.file_id +and fs_versions_latest.version_id = gp.on_what_id +and upper(gp.on_which_table) = 'FS_VERSIONS' +and fs_versions_latest.file_id = f1.file_id +and f1.file_id = fs_versions.file_id +and f1.owner_id=users.user_id +group by f1.file_title, parent_title, f1.folder_p, f1.parent_id, fs_versions_latest.url, first_names, last_name, f1.public_p +union +select count(fs_versions.version_id) as n_versions, + f1.file_title, + ''::varchar as parent_title, + f1.folder_p, + f1.parent_id, + fs_versions_latest.url, + first_names || ' ' || last_name as owner_name, + f1.public_p +from fs_files f1, + fs_versions_latest, + users, + general_permissions gp, fs_versions +where f1.file_id = $file_id +and not exists (select 1 from fs_files + where file_id = f1.parent_id) +and fs_versions_latest.version_id = gp.on_what_id +and upper(gp.on_which_table) = 'FS_VERSIONS' +and fs_versions_latest.file_id = f1.file_id +and f1.file_id = fs_versions.file_id +and f1.owner_id=users.user_id +group by f1.file_title, parent_title, f1.folder_p, f1.parent_id, fs_versions_latest.url, first_names, last_name, f1.public_p" + + +set selection [ns_db 0or1row $db $file_info_query] +if [empty_string_p $selection] { + ad_return_error "File not found" "Could not find file $file_id; it may have been deleted. +
    $file_info_query
    " + return +} + +set_variables_after_query + +if {$folder_p=="t"} { + set object_type "Folder" +} else { + set object_type "File" +} + +if { [info exists group_id] && ![empty_string_p $group_id]} { + set group_name [database_to_tcl_string $db " + select group_name + from user_groups + where group_id=$group_id"] + + set tree_name "$group_name document tree" +} else { + if {$public_p == "t"} { + set tree_name "Shared [ad_system_name] document tree" + } else { + set tree_name "Your personal document tree" + } +} + + +set title "$file_title" + +if {[empty_string_p $parent_title]} { + set parent_title "Root (Top Level)" +} + + + +# the navbar is determined by where they just came from +if ![info exists source] { + set source "" +} + +switch $source { + "personal" { + set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]]\ + [list "personal" "Personal document tree"]\ + "$owner_name's Files"] +} + "group" { + set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]]\ + [list "group?group_id=$group_id" "$group_name document tree"]\ + "$owner_name's Files"] + } + "public_individual" { + set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]]\ + [list "public-one-person?[export_url_vars owner_id]" "$owner_name's publically accessible files"] + "$owner_name's Files"] + } + "public_group" { + set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]]\ + [list "public-one-group?[export_url_vars group_id]" "$group_name publically accessible files"] + "$owner_name's Files"] + } + default { + set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]] "$owner_name's Files"] + } +} + + +set page_content " + +[ad_header $title ] + +

    $title

    +$navbar +
    + +
      +
    • $object_type Title: $file_title +
    • Owner: $owner_name +
    • Located in: $tree_name / $parent_title +
    • Delete File +
    • Edit File +
    +
    +" + +set version_html "" +set version_count 0 + + + + +set sql_query " + select version_id, + version_description, + client_file_name, + round(float8(n_bytes)/1024) as n_kbytes, + first_names||' '||last_name as creator_name, + to_char(creation_date,'[fs_date_picture]') as pretty_creation_date, + coalesce(file_type,upper(file_extension)||' File') as file_type, + author_id + from fs_versions, + users + where file_id = $file_id + and author_id=users.user_id + and fs_versions.file_id = file_id + order by pretty_creation_date desc" + +set font "" + +set header_color [ad_parameter HeaderColor fs] + +if [empty_string_p $url] { + append page_content " + + +
    + + + + + + + + + + + + + " + + set selection [ns_db select $db $sql_query] + + # URL vars for /gp/administer-permissions + # + set on_which_table FS_VERSIONS + set return_url "[ns_conn url]?[ns_conn query]" + + while {[ns_db getrow $db $selection]} { + set_variables_after_query + incr version_count + set page_name "$file_title: version [expr $n_versions - $version_count + 1]" + + regexp {.*\\([^\\]+)} $client_file_name match client_file_name + + regsub -all {[^-_.0-9a-zA-Z]+} $client_file_name "_" pretty_file_name + + append version_html " + + " + + # more URL vars for /gp/administer-permissions + # + set object_name "${file_title} ($pretty_creation_date version)" + set on_what_id $version_id + + append version_html " + + + + + + + + \n" + } + + append page_content "$version_html
    $font   + All Versions of $file_title
    $font   Name  $font   Author  $font   Size  $font   Type  $font   Modified  $font   Version Notes  $font   Permissions  $font  
      $font$graphic + + $client_file_name    $creator_name  $font   $n_kbytes  $font   [fs_pretty_file_type $file_type]  $font   $pretty_creation_date  $font $version_description  $font View$font Delete  
    " + +} else { + + append page_content "$url" + +} + +append page_content "
    + + +[ad_admin_footer]" + +# release the database handle + +ns_db releasehandle $db + +# serve the page + +ns_return 200 text/html $page_content + + Index: web/openacs/www/admin/file-storage/personal-space.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/file-storage/personal-space.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/file-storage/personal-space.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,171 @@ +# /admin/file-storage/personal-space.tcl +# +# by aure@arsdigita.com, July 1999 +# +# +# personal-space.tcl,v 3.1.2.3 2000/03/27 14:06:15 carsten Exp + +ad_page_variables {owner_id} + +set user_id $owner_id +set return_url group?[ns_conn query] + + +set db [ns_db gethandle ] +set sql_query "select first_names||' '||last_name as name + from users + where user_id=$user_id" +set name [database_to_tcl_string $db $sql_query] + +set title "$name's Files" +set owner_name $name + +set return_url personal-space?[ns_conn query] + +set page_content "[ad_admin_header $title] + +

    $title

    + +[ad_admin_context_bar [list "" [ad_parameter SystemName fs]] $title] + +
    + +
    +" +# get the user's files from the database and parse the output to reflect the folder stucture + +# set sorted_query " +# select fs_files.file_id, +# file_title, +# folder_p, +# depth * 24 as n_pixels_in, +# round(n_bytes/1024) as n_kbytes, +# to_char(fs_versions_latest.creation_date,'[fs_date_picture]') as creation_date, +# coalesce(file_type,upper(file_extension)||' File') as file_type +# from fs_files, fs_versions_latest +# where owner_id = $user_id +# and fs_files.file_id=fs_versions_latest.file_id(+) +# and group_id is NULL +# and deleted_p='f' +# order by sort_key" + +set sorted_query " + select fs_files.file_id, + file_title, + folder_p, + depth * 24 as n_pixels_in, + round(float8(n_bytes)/1024.0) as n_kbytes, + to_char(fs_versions_latest.creation_date,'[fs_date_picture]') as creation_date, + coalesce(file_type,upper(file_extension)||' File') as file_type + from fs_files, fs_versions_latest + where owner_id = $user_id + and fs_files.file_id=fs_versions_latest.file_id + and group_id is NULL + and deleted_p='f' + union + select fs_files.file_id, + file_title, + folder_p, + depth * 24 as n_pixels_in, + round(float8(n_bytes)/1024) as n_kbytes, + '' as creation_date, + coalesce(file_type,upper(file_extension)||' File') as file_type + from fs_files, fs_versions_latest + where owner_id = $user_id + and not exists (select 1 from fs_versions_latest + where file_id = fs_files.file_id) + and group_id is NULL + and deleted_p='f' + order by sort_key" + +set file_html "" +set file_count 0 + +set selection [ns_db select $db $sorted_query] + +set font "" +set header_color "#cccccc" + +append page_content " + + +
    + + + + + + + + + + " + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + if { $n_pixels_in == 0 } { + set spacer_gif "" + } else { + set spacer_gif "" + } + + if {$folder_p == "t"} { + + append file_html " + + + + + + + \n" + + } else { + append file_html " + + + + + + \n" + } + + incr file_count +} + +if {$file_count!=0} { + append page_content "$file_html" +} else { + append page_content "" +} + +append page_content " +
    + $font   $name's files
    $font   Name$font   Author  $font   Size  $font   Type  $font   Modified  
      ${spacer_gif}$font + + + $file_title $font   File Folder   
      ${spacer_gif}$font + + + $file_title $owner_name $font   $n_kbytes KB  $font   [fs_pretty_file_type $file_type]  $font   $creation_date  
      No files available in this group.  
    + +summary page for $name + +[ad_admin_footer]" + +# release the database handle + +ns_db releasehandle $db + +# serve the page + +ns_return 200 text/html $page_content + + + + + + + + + Index: web/openacs/www/admin/file-storage/version-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/file-storage/version-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/file-storage/version-delete-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,56 @@ +# version-delete-2.tcl,v 3.1.2.1 2000/04/10 14:44:21 carsten Exp +# version-delete-2.tcl +# +# by dh@arsdigita.com, July 1999 +# +# 1) finds the id of the latest version of a file that is not being deleted (new_latest_id) +# 2) updates all the old versions to point to this one (new_latest_id) +# 3) updates the new latest to have a NULL superseded_id +# 4) deletes the version to kill +# +# (note that if the version being deleted is NOT the latest one, we still do all of the +# preceding work but it doesn't have any effect) + +set_the_usual_form_variables + +# file_id, version_id + +set return_url index.tcl + +set exception_count 0 +set exception_text "" + +## does the file exist? +if {(![info exists file_id])||([empty_string_p $file_id])} { + incr exception_count + append exception_text "
  • No file was specified" +} + + +## return errors +if { $exception_count> 0 } { + ad_return_complaint $exception_count $exception_text + return 0 +} + +set db [ns_db gethandle] + +set new_newest_query "select max(version_id) +from fs_versions +where file_id = $file_id +and version_id <> $version_id" + +set new_latest_id [database_to_tcl_string $db $new_newest_query] + + +ns_db dml $db "begin transaction" + +ns_db dml $db "update fs_versions set superseded_by_id = $new_latest_id where file_id = $file_id" + +ns_db dml $db "update fs_versions set superseded_by_id = NULL where version_id = $new_latest_id and file_id = $file_id" + +ns_db dml $db "delete from fs_versions where version_id = $version_id" + +ns_db dml $db "end transaction" + +ns_returnredirect $return_url Index: web/openacs/www/admin/file-storage/version-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/file-storage/version-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/file-storage/version-delete.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,93 @@ +# version-delete.tcl,v 3.1 2000/03/11 23:09:36 aure Exp +# version-delete.tcl +# +# by dh@arsdigita.com, July 1999 +# +# presents options to user of versions to delete + +set_the_usual_form_variables + +# file_id, object_type, return_url, maybe group_id + + +set title "Delete a file version" +set db [ns_db gethandle ] +# Determine if we are working in a Group, or our personal space +# this is based if no group_id was sent - then we are in +# our personal area - otherwise the group defined by group_id +set exception_text "" +set exception_count 0 + +if { [info exists group_id] && ![empty_string_p $group_id]} { + set group_name [database_to_tcl_string $db " + select group_name + from user_groups + where group_id=$group_id"] + + set navbar [ad_admin_context_bar "index.tcl {[ad_parameter SystemName fs]}" "$return_url $group_name" "$title"] +} else { + set navbar [ad_admin_context_bar "index.tcl {[ad_parameter SystemName fs]}" $title] +} +## does the file exist? +if {(![info exists file_id])||([empty_string_p $file_id])} { + ns_returnredirect $return_url + return +} + +## does the version exist? +if {(![info exists version_id]) || ([empty_string_p $version_id]) || ([catch {database_to_tcl_string $db "select 1 from fs_versions where version_id=$version_id"} junk]) } { + ns_returnredirect $return_url +} + +## return errors +if { $exception_count> 0 } { + ad_return_complaint $exception_count $exception_text + return 0 +} + +set file_title [database_to_tcl_string $db "select file_title from fs_files where file_id=$file_id"] +set number_of_versions [database_to_tcl_string $db "select count(version_id) from fs_versions where file_id=$file_id"] + +set html "[ad_admin_header $title ] +

    $title

    +$navbar +
    " + +set version_date [database_to_tcl_string $db " select to_char(creation_date,'MM/DD/YY HH24:MI') from fs_versions where version_id=$version_id"] + +if {$number_of_versions >1 } { +append html " + Are you sure you want to delete the version of $file_title dated $version_date?
    + Since you are an administrator, delete will really delete from the database. +
    + +
    +
    + + + [export_form_vars file_id version_id return_url] +
    + [ad_admin_footer] + " +} else { +append html " + Are you sure you want to delete the only version of $file_title?
    + Since you are an administrator, delete will really delete from the database. +
    + +
    +
    + + + [export_form_vars file_id return_url] +
    + [ad_admin_footer] + " +} + ns_return 200 text/html $html + + + + + + Index: web/openacs/www/admin/gc/ads-from-one-category.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/ads-from-one-category.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/ads-from-one-category.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,69 @@ +# ads-from-one-category.tcl,v 3.1 2000/03/11 00:45:10 curtisg Exp +set_the_usual_form_variables + +# domain_id, primary_category + +set db [gc_db_gethandle] +set selection [ns_db 1row $db "select domain, full_noun from ad_domains where domain_id = $domain_id"] +set_variables_after_query + + +append html "[ad_admin_header "$primary_category Classified Ads"] + +

    $primary_category Ads

    + +[ad_admin_context_bar [list "index.tcl" "Classifieds"] [list "domain-top.tcl?domain_id=$domain_id" $full_noun] [list "manage-categories-for-domain.tcl?[export_url_vars domain_id]" "Categories"] "One Category"] + + +
    + +

    $primary_category Ads

    + +
      +" + +set selection [ns_db select $db "select classified_ad_id, one_line, primary_category, classified_ads.user_id, email as poster_email, posted, last_modified as edited_date, expired_p(expires) as expired_p, originating_ip, case when last_modified=posted then 'f' else 't' end as ever_edited_p +from classified_ads, users +where users.user_id = classified_ads.user_id +and domain_id = $domain_id +and primary_category = '$QQprimary_category' +order by classified_ad_id desc"] + +set items "" + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + if { $originating_ip == "" } { + set ip_stuff "" + } else { + set ip_stuff "(at +$originating_ip)" + } + if { $expired_p == "t" } { + set expired_flag "expired; " + } else { + set expired_flag "" + } + append items "
    • $classified_ad_id $primary_category: +$one_line
      +(${expired_flag}submitted by +$poster_email $ip_stuff $posted" + if { $ever_edited_p == "t" } { + append items "; edited $edited_date" + } + append items ") +\[Edit | +Delete \] +" + +} + +append html $items + +append html " +
    + +[ad_admin_footer]" + +ns_db releasehandle $db +ns_return 200 text/html $html Index: web/openacs/www/admin/gc/ads-from-one-ip.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/ads-from-one-ip.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/ads-from-one-ip.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,74 @@ +# ads-from-one-ip.tcl,v 3.1 2000/03/11 00:45:10 curtisg Exp +set_form_variables +set_form_variables_string_trim_DoubleAposQQ + +# domain_id, originating_ip + +set db [gc_db_gethandle] +set selection [ns_db 1row $db "select * from ad_domains where domain_id = $domain_id"] +set_variables_after_query + +append html "[ad_admin_header "$domain Classified Ads"] + +

    Classified Ads

    + +from $originating_ip in $domain + +
    + +

    The Ads

    + +
      +" + +set selection [ns_db select $db "select classified_ad_id, one_line, primary_category, classified_ads.user_id, email as poster_email, posted, last_modified as edited_date, expired_p(expires) as expired_p, decode(last_modified, posted, 'f', 't') as ever_edited_p +from classified_ads, users +where users.user_id = classified_ads.user_id +and domain_id = $domain_id +and originating_ip = '$QQoriginating_ip' +order by classified_ad_id desc"] + +while {[ns_db getrow $db $selection]} { + + set_variables_after_query + if { $expired_p == "t" } { + set expired_flag "expired; " + } else { + set expired_flag "" + } + append html "
    • $classified_ad_id $primary_category: +$one_line
      +(${expired_flag}submitted by +$poster_email $posted" + if { $ever_edited_p == "t" } { + append html "; edited $edited_date" + } + append html ") +\[Edit | +Delete \] + +" + +} + + + +append html " +
    + + +Doing a reverse DNS now: $originating_ip maps to ... + +" + +append html "[ns_hostbyaddr $originating_ip] + +

    + +(note: if you just get the number again, that means the hostname could +not be found.) + +[ad_admin_footer]" + +ns_db releasehandle $db +ns_return 200 text/html $html \ No newline at end of file Index: web/openacs/www/admin/gc/ads-from-one-user.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/ads-from-one-user.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/ads-from-one-user.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,87 @@ +# ads-from-one-user.tcl,v 3.1 2000/03/11 00:45:10 curtisg Exp +set_the_usual_form_variables + +# domain_id, user_id + +set db [gc_db_gethandle] +set selection [ns_db 1row $db "select full_noun from ad_domains where domain_id = $domain_id"] +set_variables_after_query + +set selection [ns_db 1row $db "select first_names, last_name, email +from users +where user_id = $user_id"] +set_variables_after_query + +append html "[ad_admin_header "Ads from $email"] + +

    Ads from $email

    + +[ad_admin_context_bar [list "index.tcl" "Classifieds"] [list "domain-top.tcl?domain_id=$domain_id" $full_noun] "One User"] + +
    + + + +

    The Ads

    + +
      +" + +set selection [ns_db select $db "select classified_ad_id, one_line, primary_category, posted, last_modified as edited_date, expired_p(expires) as expired_p, originating_ip, case when last_modified = posted then 'f' else 't' end as ever_edited_p +from classified_ads, users +where users.user_id = classified_ads.user_id +and domain_id = $domain_id +and classified_ads.user_id = $user_id +order by classified_ad_id desc"] + +set counter 0 +while {[ns_db getrow $db $selection]} { + set_variables_after_query + incr counter + if { [empty_string_p $originating_ip] } { + set ip_stuff "" + } else { + set ip_stuff "at +$originating_ip" + } + + if { $expired_p == "t" } { + set expired_flag "expired; " + } else { + set expired_flag "" + } + append html "
    • $classified_ad_id $primary_category: +$one_line
      +($ip_stuff; $posted" + if { $ever_edited_p == "t" } { + append html "; edited $edited_date" + } + append html ") +\[Edit | +Delete \] +" + +} + +append html " +
    + +" + +if { $counter != 0 } { + append html "

    +You can delete all of the above ads. +" +} + +append html [ad_admin_footer] + +ns_db releasehandle $db +ns_return 200 text/html $html Index: web/openacs/www/admin/gc/ads.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/ads.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/ads.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,81 @@ +# ads.tcl,v 3.1 2000/03/11 00:45:10 curtisg Exp +# will display all ads or some number of days worth + +set_the_usual_form_variables + +# domain_id, optional num_days + +set db [gc_db_gethandle] +set selection [ns_db 1row $db "select * from ad_domains where domain_id = $domain_id"] +set_variables_after_query + +if { ![info exists num_days] || [empty_string_p $num_days] || $num_days == "all" } { + # all the ads + set description "All Ads" + set day_limit_clause "" +} else { + set day_limit_clause "\nand age(sysdate(), posted) < '$num_days days'" + if { $num_days == 1 } { + set description "Ads from last 24 hours" + } else { + set description "Ads from last $num_days days" + } +} + + +append html "[ad_admin_header "$domain Classified Ads"] + +

    Classified Ads

    + +[ad_admin_context_bar [list "index.tcl" "Classifieds"] [list "domain-top.tcl?domain_id=$domain_id" $full_noun] $description] + + +
    + +

    The Ads

    + +
      + +" + +set selection [ns_db select $db "select classified_ad_id, one_line, primary_category,posted, last_modified as edited_date, originating_ip, users.user_id, email as poster_email, case when last_modified=posted then 'f' else 't' end as ever_edited_p +from classified_ads, users +where domain_id = $domain_id +and users.user_id = classified_ads.user_id +and (expires is null or sysdate()::date <= expires::date) $day_limit_clause +order by classified_ad_id desc"] + +set items "" +while {[ns_db getrow $db $selection]} { + set_variables_after_query + if { $originating_ip == "" } { + set ip_stuff "" + } else { + set ip_stuff "(at +$originating_ip)" + } + append items "
    • $classified_ad_id $primary_category: +$one_line
      +(from +$poster_email $ip_stuff on $posted" + if { $ever_edited_p == "t" } { + append items "; edited $edited_date" + } + append items ") +\[Edit | +Delete \] + +" + +} + +append html $items + +append html " +
    + +[ad_admin_footer] +" + +ns_db releasehandle $db +ns_return 200 text/html $html Index: web/openacs/www/admin/gc/alert-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/alert-toggle.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/alert-toggle.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,18 @@ +# alert-toggle.tcl,v 3.1 2000/03/11 00:45:10 curtisg Exp +set_form_variables + +# alert_id, domain_id + +set db [ns_db gethandle] + +if [catch {ns_db dml $db "update classified_email_alerts set valid_p = logical_negation(valid_p) where alert_id = $alert_id"} errmsg] { + ad_return_error "Error Editing Alert" "Here's what the database produced: + +
    +$errmsg +
    +" +return +} + +ns_returnredirect "view-alerts.tcl?[export_url_vars domain_id]" Index: web/openacs/www/admin/gc/category-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/category-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/category-add-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,40 @@ +# category-add-2.tcl,v 3.1 2000/03/11 00:45:11 curtisg Exp +# parameters + +set_form_variables +set_form_variables_string_trim_DoubleAposQQ + +# category_id, domain_id, primary_category, ad_placement_blurb + +# user error checking + +set exception_text "" +set exception_count 0 + +if { ![info exists primary_category] || [empty_string_p $primary_category] } { + incr exception_count + append exception_text "
  • Please enter a category name." +} + +if { ![info exists ad_placement_blurb] || [string length ad_placement_blurb] > 4000 } { + incr exception_count + append exception_text "
  • Please limit you ad placement annotation to 4000 characters." +} + + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + + +set db [gc_db_gethandle] + + +ns_db dml $db "insert into ad_categories + (category_id, primary_category, domain_id, ad_placement_blurb) + values ($category_id, '$QQprimary_category' , $domain_id , '$QQad_placement_blurb')" + +ns_returnredirect "manage-categories-for-domain.tcl?domain_id=$domain_id" + + Index: web/openacs/www/admin/gc/category-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/category-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/category-add.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,33 @@ +# category-add.tcl,v 3.1 2000/03/11 00:45:11 curtisg Exp +set_the_usual_form_variables + +# domain_id + +set db [gc_db_gethandle] +set selection [ns_db 1row $db "select full_noun from ad_domains where domain_id = $domain_id"] +set_variables_after_query + +set category_id [database_to_tcl_string $db "select ad_category_id_seq.nextval from dual"] + +ns_db releasehandle $db + +ns_return 200 text/html "[ad_admin_header "Add category"] + +

    Add category

    + +[ad_admin_context_bar [list "index.tcl" "Classifieds"] [list "domain-top.tcl?domain_id=$domain_id" $full_noun] [list "manage-categories-for-domain.tcl?[export_url_vars domain_id]" "Categories"] "Add Category"] + +
    + +
    +[export_form_vars category_id domain_id] +Category name: + +

    +Annotation for the ad placement page:
    + +

    + +
    +[ad_admin_footer] +" Index: web/openacs/www/admin/gc/category-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/category-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/category-edit-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,54 @@ +# category-edit-2.tcl,v 3.1 2000/03/11 00:45:11 curtisg Exp +# +# parameters + +set_the_usual_form_variables + +# domain_id, primary_category, old_primary_category, submit_type, ad_placement_blurb + + +# user error checking + +set exception_text "" +set exception_count 0 + +if { ![info exists primary_category] || [empty_string_p $primary_category] } { + incr exception_count + append exception_text "
  • Please enter a category name." +} + +if { ![info exists ad_placement_blurb] || [string length ad_placement_blurb] > 4000 } { + incr exception_count + append exception_text "
  • Please limit you ad placement annotation to 4000 characters." +} + + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + + +set db [gc_db_gethandle] + +if { [regexp -nocase {Edit} $submit_type] } { + set new_category_value $QQprimary_category +} elseif { [regexp -nocase {convert} $submit_type] } { + set new_category_value [string tolower $QQprimary_category] +} else { + ns_return 200 text/html "couldn't figure out what to do" + return +} + +ns_db dml $db "begin transaction" +ns_db dml $db "update ad_categories +set primary_category = '$new_category_value', +ad_placement_blurb = '$QQad_placement_blurb' +where domain_id = $domain_id and primary_category = '$QQold_primary_category'" +ns_db dml $db "update classified_ads +set primary_category = '$new_category_value' +where domain_id = $domain_id and primary_category = '$QQold_primary_category'" +ns_db dml $db "end transaction" + +ns_returnredirect "manage-categories-for-domain.tcl?domain_id=$domain_id" + Index: web/openacs/www/admin/gc/category-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/category-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/category-edit.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,40 @@ +# category-edit.tcl,v 3.1.2.2 2000/03/15 05:18:15 curtisg Exp +set_the_usual_form_variables + +# domain_id, primary_category + +set db [gc_db_gethandle] +set selection [ns_db 1row $db "select ac.*, ad.domain +from ad_categories ac, ad_domains ad +where ac.domain_id = $domain_id +and ad.domain_id = ac.domain_id +and primary_category = '$QQprimary_category'"] +set_variables_after_query + +append html "[ad_admin_header "Edit $primary_category"] + +

    Edit $primary_category

    + +in the $domain classifieds + +
    + + + + + +Category name:

    +Annotation for the ad placement page:
    + +

    + +
    +
    +
    + + +[ad_admin_footer] +" + +ns_db releasehandle $db +ns_return 200 text/html $html Index: web/openacs/www/admin/gc/community-view.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/community-view.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/community-view.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,72 @@ +# community-view.tcl,v 3.1 2000/03/11 00:45:11 curtisg Exp +set_the_usual_form_variables + +# domain_id, n_postings, hairy AOLserver widgets for start_date, end_date + +# pull out start_date, end_date (ANSI format that will make Oracle hurl) + +ns_dbformvalue [ns_conn form] start_date date start_date +ns_dbformvalue [ns_conn form] end_date date end_date + + +set db [ns_db gethandle] +set selection [ns_db 1row $db "select * from ad_domains where domain_id = $domain_id"] +set_variables_after_query + +append html "[ad_admin_header "Users who've made $n_postings postings between $start_date and $end_date"] + +

    Users

    + +[ad_admin_context_bar [list "index.tcl" "Classifieds"] [list "domain-top.tcl?domain_id=$domain_id" $full_noun] "Users with $n_postings postings"] + + + +
    + +Here are the participants who've made at least $n_postings postings +between $start_date and $end_date... + +
      + +" + +if { $n_postings < 2 } { + set sql "select users.user_id, email, count(*) as how_many_posts +from classified_ads , users +where classified_ads.user_id = users.user_id +and domain_id = $domain_id +and posted >= '$start_date'::datetime +and posted <= '$end_date'::datetime +group by users.user_id, email +order by how_many_posts desc" +} else { + set sql "select users.user_id, email, count(*) as how_many_posts +from classified_ads, users +where classified_ads.user_id = users.user_id +and domain_id = $domain_id +and posted >= '$start_date'::datetime +and posted <= '$end_date'::datetime +group by users.user_id, email +having count(*) >= $n_postings +order by how_many_posts desc" +} + +set selection [ns_db select $db $sql] +set count 0 + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append html "
    • $email ($how_many_posts)\n" + incr count +} + +if { $count == 0 } { + append html "
    • None" +} +append html "
    + +[ad_admin_footer] +" + +ns_db releasehandle $db +ns_return 200 text/html $html Index: web/openacs/www/admin/gc/delete-ad-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/delete-ad-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/delete-ad-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,86 @@ +# delete-ad-2.tcl,v 3.1 2000/03/11 00:45:11 curtisg Exp +set admin_id [ad_verify_and_get_user_id] +if { $admin_id == 0 } { + ns_returnredirect "/register/" + return +} + +set_the_usual_form_variables + +# classified_ad_id +# maybe user_charge (and if so, then perhaps charge_comment) + +set db [ns_db gethandle] + +if [catch { set selection [ns_db 1row $db "select ca.one_line, ca.full_ad, ca.domain_id, ad.domain, u.user_id, u.email, u.first_names, u.last_name +from classified_ads ca, ad_domains ad, users u +where ca.user_id = u.user_id +and ad.domain_id = ca.domain_id +and classified_ad_id = $classified_ad_id"] } errmsg ] { + ad_return_error "Could not find Ad $classified_ad_id" "Either you are fooling around with the Location field in your browser +or my code has a serious bug. The error message from the database was + +
    +$errmsg +
    " + return +} +set_variables_after_query + +if [catch { ns_db dml $db "begin transaction" + ns_db dml $db [gc_audit_insert $classified_ad_id 1] + ns_db dml $db "delete from classified_auction_bids where classified_ad_id = $classified_ad_id" + ns_db dml $db "delete from classified_ads where classified_ad_id = $classified_ad_id" + ns_db dml $db "end transaction" } errmsg] { + # we shouldn't be able to get here except because of + # violating integrity constraints + ad_return_error "Could not delete Ad $classified_ad_id" "I think my code must have a serious bug. +The error message from the database was + +
    +$errmsg +
    " + return +} + +append html "[gc_header "Ad $classified_ad_id Deleted"] + +

    Ad $classified_ad_id Deleted

    + + in the $domain domain of [gc_system_name] +
    + +Deletion of ad $classified_ad_id confirmed.\n\n + +" + +if { [info exists user_charge] && ![empty_string_p $user_charge] } { + if { [info exists charge_comment] && ![empty_string_p $charge_comment] } { + # insert separately typed comment + set user_charge [mv_user_charge_replace_comment $user_charge $charge_comment] + } + append html "

    ... adding a user charge: +

    +[mv_describe_user_charge $user_charge] +
    +... " + mv_charge_user $db $user_charge "Deleting your ad from [ad_system_name]" "We had to delete your ad from [ad_system_name]. + +For clarity, here is what we had in the database.. + +Subject: $one_line + +Full Ad: + +$full_ad +" + append html "Done." +} + +append html " + +[ad_admin_footer] +" + +ns_db releasehandle $db +ns_return 200 text/html $html Index: web/openacs/www/admin/gc/delete-ad.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/delete-ad.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/delete-ad.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,85 @@ +# delete-ad.tcl,v 3.1 2000/03/11 00:45:11 curtisg Exp +set admin_id [ad_verify_and_get_user_id] +if { $admin_id == 0 } { + ns_returnredirect "/register/" + return +} + +set_the_usual_form_variables + +# classified_ad_id + +set db [ns_db gethandle] + +if [catch { set selection [ns_db 1row $db "select ca.one_line, ca.full_ad, ca.domain_id, ad.domain, u.user_id, u.email, u.first_names, u.last_name +from classified_ads ca, users u, ad_domains ad +where ca.user_id = u.user_id +and ad.domain_id = ca.domain_id +and classified_ad_id = $classified_ad_id"] } errmsg ] { + ad_return_error "Could not find Ad $classified_ad_id" "Either you are fooling around with the Location field in your browser +or my code has a serious bug. The error message from the database was + +
    +$errmsg +
    " + return +} + +# OK, we found the ad in the database if we are here... +# the variable SELECTION holds the values from the db +set_variables_after_query + +if [ad_parameter EnabledP "member-value"] { + set mistake_wad [mv_create_user_charge $user_id $admin_id "classified_ad_mistake" $classified_ad_id [mv_rate ClassifiedAdMistakeRate]] + set spam_wad [mv_create_user_charge $user_id $admin_id "classified_ad_spam" $classified_ad_id [mv_rate ClassifiedAdSpamRate]] + set options [list [list "" "Don't charge user"] [list $mistake_wad "Mistake of some kind, e.g., duplicate posting"] [list $spam_wad "Spam or other serious policy violation"]] + set member_value_section "

    Charge this user for his sins?

    + +
    +
    +Charge Comment: +
    +
    +
    " +} else { + set member_value_section "" +} + + +ns_return 200 text/html "[gc_header "Confirm Deletion"] + +

    Confirm Deletion

    + +of ad number $classified_ad_id in the + $domain domain of [gc_system_name] + +
    + + +[export_form_vars classified_ad_id] +$member_value_section +

    +

    + +
    +
    • + +

    $one_line

    + +
    +$full_ad +
    +
    +-- $first_names $last_name +($email) +
    + + +[ad_admin_footer]" + Index: web/openacs/www/admin/gc/delete-ads-from-one-user-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/delete-ads-from-one-user-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/delete-ads-from-one-user-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,133 @@ +# delete-ads-from-one-user-2.tcl,v 3.1 2000/03/11 00:45:11 curtisg Exp +set admin_id [ad_verify_and_get_user_id] +if { $admin_id == 0 } { + ns_returnredirect "/register/" + return +} + +set_the_usual_form_variables + +# classified_ad_id, user_id, domain_id +# maybe user_charge (and if so, then perhaps charge_comment) + +set db [ns_db gethandle] + +set audit_sql "insert into classified_ads_audit + (classified_ad_id, + user_id, + domain_id, + originating_ip, + posted, + expires, + wanted_p, + private_p, + primary_category, + subcategory_1, + subcategory_2, + manufacturer, + model, + one_line, + full_ad, + html_p, + last_modified, + audit_ip, + deleted_by_admin_p) +select + classified_ad_id, + user_id, + domain_id, + originating_ip, + posted, + expires, + wanted_p, + private_p, + primary_category, + subcategory_1, + subcategory_2, + manufacturer, + model, + one_line, + full_ad, + html_p, + last_modified, + '[DoubleApos [ns_conn peeraddr]]', + 't' +from classified_ads +where user_id = $user_id +and domain_id = $domain_id + +set delete_bids_sql "delete from classified_auction_bids +where classified_ad_id in + (select classified_ad_id + from classified_ads + where user_id = $user_id + and domain_id = $domain_id)" + +set delete_ads_sql "delete from classified_ads +where user_id = $user_id +and domain_id = $domain_id" + +if [catch { ns_db dml $db "begin transaction" + ns_db dml $db $audit_sql + ns_db dml $db $delete_bids_sql + ns_db dml $db $delete_ads_sql + ns_db dml $db "end transaction" } errmsg] { + # we shouldn't be able to get here except because of + # violating integrity constraints + ad_return_error "Could not delete Ad $classified_ad_id" "I think my code must have a serious bug. +The error message from the database was + +
    +$errmsg +
    " + return +} + +set domain [database_to_tcl_string $db "select domain +from ad_domains where domain_id = $domain_id"] + +append html "[gc_header "Ads from User $user_id Deleted"] + +

    Ads from User $user_id Deleted

    + +in the $domain domain of [gc_system_name] + +
    + +Deletion of ads confirmed.\n\n + +" + +if { [info exists user_charge] && ![empty_string_p $user_charge] } { + if { [info exists charge_comment] && ![empty_string_p $charge_comment] } { + # insert separately typed comment + set user_charge [mv_user_charge_replace_comment $user_charge $charge_comment] + } + append html "

    ... adding a user charge: +

    +[mv_describe_user_charge $user_charge] +
    +... " + mv_charge_user $db $user_charge "Deleted your ads from [ad_system_name]" "We had to delete your ads from [ad_system_name]. + +Comment: $charge_comment + +(most likely you've violated the stated policy against screaming with +all-uppercase words or using other attention-getting characters in the +subject line). + +Sorry for deleting all of your ads but that is really the only +possible way for a free site like this to stay afloat. We can't +afford to pick through every ad so the easiest thing to do is just +click once and delete all the ads. +" + append html "Done." +} + +append html " + +[ad_admin_footer] +" + +ns_db releasehandle $db +ns_return 200 text/html $html \ No newline at end of file Index: web/openacs/www/admin/gc/delete-ads-from-one-user.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/delete-ads-from-one-user.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/delete-ads-from-one-user.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,61 @@ +# delete-ads-from-one-user.tcl,v 3.1 2000/03/11 00:45:11 curtisg Exp +set admin_id [ad_verify_and_get_user_id] +if { $admin_id == 0 } { + ns_returnredirect "/register/" + return +} + +set_the_usual_form_variables + +# domain_id, user_id + +set db [ns_db gethandle] + +set domain [database_to_tcl_string $db "select domain +from ad_domains where domain_id = $domain_id"] + +set classified_ad_id [database_to_tcl_string $db "select max(classified_ad_id) from classified_ads where user_id = $user_id"] + +if [ad_parameter EnabledP "member-value"] { + set mistake_wad [mv_create_user_charge $user_id $admin_id "classified_ad_mistake" $classified_ad_id [mv_rate ClassifiedAdMistakeRate]] + set spam_wad [mv_create_user_charge $user_id $admin_id "classified_ad_spam" $classified_ad_id [mv_rate ClassifiedAdSpamRate]] + set options [list [list "" "Don't charge user"] [list $mistake_wad "Mistake of some kind, e.g., duplicate posting"] [list $spam_wad "Spam or other serious policy violation"]] + set member_value_section "

    Charge this user for his sins?

    + +
    +
    +Charge Comment: +
    +
    +
    " +} else { + set member_value_section "" +} + +ns_return 200 text/html "[gc_header "Confirm Deletion"] + +

    Confirm Deletion

    + +of ads from +[database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id = $user_id"] +in the + $domain domain of [gc_system_name] + +
    + +
    +[export_form_vars domain user_id] +$member_value_section +

    +

    + +
    +
    + +[ad_admin_footer]" Index: web/openacs/www/admin/gc/delete-category.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/delete-category.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/delete-category.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,12 @@ +# delete-category.tcl,v 3.1 2000/03/11 00:45:11 curtisg Exp +set_the_usual_form_variables + +# domain_id, primary_category + +set db [gc_db_gethandle] + +ns_db dml $db "delete from ad_categories +where domain_id = $domain_id +and primary_category = '$QQprimary_category'" + +ns_returnredirect "manage-categories-for-domain.tcl?domain_id=$domain_id" Index: web/openacs/www/admin/gc/delete-email-alerts.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/delete-email-alerts.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/delete-email-alerts.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,36 @@ +# delete-email-alerts.tcl,v 3.0.4.1 2000/03/15 05:11:30 curtisg Exp +set_form_variables +set_form_variables_string_trim_DoubleAposQQ + +# bad_addresses (separated by spaces, thus a Tcl list) + +set db [ns_db gethandle] + +set sql "delete from classified_email_alerts where user_id in (select user_id from users where upper(email) in ('[join [string toupper $QQbad_addresses] "','"]'))" + +ns_db dml $db $sql + +set n_alerts_killed [ns_ora resultrows $db] + +ns_return 200 text/html " + +Alerts Deleted + + + +

    Alerts Deleted

    + +in $domain classifieds +
    + + +Deleted a total of $n_alerts_killed alerts for the following email addresses: + +
    +$bad_addresses +
    + +
    +
    philg@mit.edu
    + +" Index: web/openacs/www/admin/gc/domain-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/domain-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/domain-add-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,128 @@ +# domain-add-2.tcl,v 3.1 2000/03/11 00:45:11 curtisg Exp +set_the_usual_form_variables + +# domain_id, full_noun, domain, user_id_from_search, +# first_names_from_search, last_name_from_search, email_from_search + + +# user error checking + +set exception_text "" +set exception_count 0 + +if { ![info exists full_noun] || [empty_string_p $full_noun] } { + incr exception_count + append exception_text "
  • Please enter a name for this domain." +} + +if { ![info exists domain] || [empty_string_p $domain] } { + incr exception_count + append exception_text "
  • Please enter a short key." +} + + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +set db [ns_db gethandle] + +if { [database_to_tcl_string $db "select count(domain) from ad_domains where domain = '$QQdomain'"] > 0 } { + ad_return_error "$domain already exists" "A domain with a short key \"$domain\" already exists in [ad_system_name]. The short key must be unique. Perhaps there is a conflict with an existing domain or you double clicked and submitted the form twice." + return +} + +ns_db dml $db "begin transaction" + +ns_db dml $db "insert into ad_domains +(domain_id, primary_maintainer_id, domain, full_noun) +values +($domain_id, $user_id_from_search, '$QQdomain', '$QQfull_noun')" + +# create an administration group for users authorized to +# delete and edit ads +ns_db select $db "select administration_group_add('Admin group for the $QQdomain classifieds', short_name_from_group_name('Admin group for the $QQdomain classifieds'), 'gc', '$QQdomain', 'f', '/gc/admin/domain-top.tcl?domain=[ns_urlencode $domain]')" + +ns_db dml $db "end transaction" + +append html "[ad_admin_header "Add a domain, Step 2"] + +

    Add domain

    + +[ad_admin_context_bar [list "index.tcl" "Classifieds"] "Add domain, Step 2"] + + +
    + +
    +

    User Interface

    +Annotation for the top of the domain page:
    + +

    +Annotation for the bottom of the domain page:
    +
    +

    Ad Parameters

    +By default, a full ad and a short description will be collected for all ads. To include more fields, write the form fragment to collect the ad data you desire. This fragment will be place inside a 2 column table. +
    +Valid fields: + + + + + + + +
    NameProperties
    manufacturerMaxlength 50
    modelMaxlength 50
    item_sizeMaxlength 100
    colorMaxlength 50
    us_citizen_p\"t\" or \"f\"
    +
    +The default below is a sample of a form fragment +that incorporates all the above fields. Modify this +to use the fields and annotation you desire.
    + + + + + + + + + +
    +Default expiration days: + + +
    +Do you want to allow \"Wanted to by\" adds? + +Yes +No +
    +Do you wish to have auctions on this site? + +Yes +No +
    +Are your ads based on geography? + +Yes +No +
    +

    + +

    + +
    +[export_form_vars domain_id domain] +
    +[ad_admin_footer] +" + +ns_db releasehandle $db +ns_return 200 text/html $html Index: web/openacs/www/admin/gc/domain-add-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/domain-add-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/domain-add-3.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,42 @@ +# domain-add-3.tcl,v 3.1 2000/03/11 00:45:11 curtisg Exp +set_the_usual_form_variables + +# domain_id, domain, insert_form_fragments, default_expiration_days, +# wtb_common_p, auction_p, geocentric_p +# submit + +# user error checking + +set exception_text "" +set exception_count 0 + +if { [info exists insert_for_fragments] && [string length $insert_form_fragments] > 4000 } { + incr exception_count + append exception_text "
  • Please limit you form fragment for ad parameters to 4000 characters." +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +set db [ns_db gethandle] + +ns_set delkey [ns_conn form] submit + + +set sql_statement [util_prepare_update $db ad_domains domain_id $domain_id [ns_getform]] + + +if [catch { ns_db dml $db $sql_statement } errmsg] { + ad_return_error "Failure to update domain information" "The database rejected the attempt: +
    +
    +$errmsg
+
    +
    +" + return +} + +ns_returnredirect "index.tcl" Index: web/openacs/www/admin/gc/domain-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/domain-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/domain-add.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,42 @@ +# domain-add.tcl,v 3.1 2000/03/11 00:45:11 curtisg Exp + +set db [ns_db gethandle] +set domain_id [database_to_tcl_string $db "select ad_domain_id_seq.nextval from dual"] +ns_db releasehandle $db + +ns_return 200 text/html "[ad_admin_header "Add a domain"] + +

    Add domain

    + +[ad_admin_context_bar [list "index.tcl" "Classifieds"] "Add domain"] + +
    + +
    +[export_form_vars domain_id] + + + + +

    Identity

    + + + +
    Full domain name:
    Pick a short key:
    +

    Administration

    +Search for a user to be primary administrator of this domain by
    + + + + +
    Email address:
    or by
    Last name:
    + +

    + +

    + +
    + +
    +[ad_admin_footer] +" Index: web/openacs/www/admin/gc/domain-administrator-update-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/domain-administrator-update-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/domain-administrator-update-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,11 @@ +# domain-administrator-update-2.tcl,v 3.1 2000/03/11 00:45:11 curtisg Exp +set_the_usual_form_variables + +# domain_id, user_id_from_search +# first_names_from_search, last_name_from_search, email_from_search + +set db [ns_db gethandle] + +ns_db dml $db "update ad_domains set primary_maintainer_id = $user_id_from_search where domain_id = $domain_id" + +ns_returnredirect "domain-top.tcl?[export_url_vars domain_id]" \ No newline at end of file Index: web/openacs/www/admin/gc/domain-administrator-update.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/domain-administrator-update.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/domain-administrator-update.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,54 @@ +# domain-administrator-update.tcl,v 3.1.2.2 2000/03/14 22:23:07 curtisg Exp +set_the_usual_form_variables + +# domain_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select ad_domains.*, +users.email from ad_domains, users +where domain_id = $domain_id +and users.user_id = ad_domains.primary_maintainer_id +union +select ad_domains.*, null as users +from ad_domains +where domain_id = $domain_id +and not exists (select * from users + where users.user_id = ad_domains.primary_maintainer_id) +"] +set_variables_after_query + +set action "Edit administrator for $domain" + +append html "[ad_admin_header "$action"] + +

    $action

    + +in [neighbor_system_name] administration +
    + +
    +[export_form_vars domain_id] + + + + +

    +

    +Search for a user to be primary administrator of this domain by
    + + + + +
    Email address:
    or by
    Last name:
    + +

    + +
    +[export_form_vars category_id] +
    +[neighbor_footer] +" + +ns_db releasehandle $db +ns_return 200 text/html $html Index: web/openacs/www/admin/gc/domain-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/domain-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/domain-delete-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,53 @@ +# domain-delete-2.tcl,v 3.1 2000/03/11 00:45:12 curtisg Exp +set_the_usual_form_variables + +# domain_id + +set db [ns_db gethandle] + +set domain [database_to_tcl_string $db "select domain +from ad_domains where domain_id = $domain_id"] + +set n_ads [database_to_tcl_string $db "select count(*) +from classified_ads +where domain_id = $domain_id +and (expires is null or expires::date > sysdate()::date)"] + +if { $n_ads > 50 } { + ad_return_complaint 1 "
  • I'm sorry but we're not going to delete a domain with $n_ads live ads in it; you'll need to go into SQL*Plus and delete the ads yourself first." + return +} + +set admin_group_id [ad_administration_group_id $db "gc" $domain] + +ns_db dml $db "begin transaction" +if ![empty_string_p $admin_group_id] { + ns_db dml $db "delete from user_group_map_queue where group_id = $admin_group_id" + ns_db dml $db "delete from user_group_map where group_id = $admin_group_id" +} +ns_db dml $db "delete from administration_info where group_id = $admin_group_id" +ns_db dml $db "delete from user_groups where group_id = $admin_group_id" +ns_db dml $db "delete from classified_email_alerts where domain_id = $domain_id" +ns_db dml $db "delete from classified_auction_bids +where classified_ad_id in (select classified_ad_id from classified_ads where domain_id = $domain_id)" +ns_db dml $db "delete from classified_ads where domain_id = $domain_id" +ns_db dml $db "delete from ad_categories where domain_id = $domain_id" +ns_db dml $db "delete from ad_integrity_checks where domain_id = $domain_id" +ns_db dml $db "delete from ad_domains where domain_id = $domain_id" +ns_db dml $db "end transaction" + +append html "[ad_admin_header "Deleted $domain"] + +

    Deleted $domain

    + +[ad_admin_context_bar [list "index.tcl" "Classifieds"] "Domain Deleted"] + +
    + +The $domain domain has been deleted. + +[ad_admin_footer] +" + +ns_db releasehandle $db +ns_return 200 text/html $html Index: web/openacs/www/admin/gc/domain-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/domain-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/domain-delete.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,34 @@ +# domain-delete.tcl,v 3.1 2000/03/11 00:45:12 curtisg Exp +set_the_usual_form_variables + +# domain_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select * from ad_domains +where domain_id=$domain_id"] +set_variables_after_query + +append html "[ad_admin_header "Delete $domain"] + +

    Delete $domain

    + +[ad_admin_context_bar [list "index.tcl" "Classifieds"] [list "domain-top.tcl?[export_url_vars domain_id]" $full_noun] "Confirm Deletion"] + +
    + +Are you sure that you want to delete $domain and its +[database_to_tcl_string $db "select count(*) from classified_ads where domain_id = $domain_id"] ads? + +
    +[export_form_vars domain_id] +
    + +
    + +
    +[ad_admin_footer] +" + +ns_db releasehandle $db +ns_return 200 text/html $html Index: web/openacs/www/admin/gc/domain-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/domain-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/domain-edit-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,53 @@ +# domain-edit-2.tcl,v 3.1.2.1 2000/03/14 22:24:51 curtisg Exp +set_the_usual_form_variables + +# domain_id, domain, insert_form_fragments, default_expiration_days, +# wtb_common_p, auction_p, geocentric_p +# submit + +# user error checking + +set exception_text "" +set exception_count 0 + +if { ![info exists full_noun] || [empty_string_p $full_noun] } { + incr exception_count + append exception_text "
  • Please enter a name for this domain." +} + +if { ![info exists domain] || [empty_string_p $domain] } { + incr exception_count + append exception_text "
  • Please enter a short key." +} + + +if { [info exists insert_for_fragments] && [string length $insert_form_fragments] > 4000 } { + incr exception_count + append exception_text "
  • Please limit you form fragment for ad parameters to 4000 characters." +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +set db [ns_db gethandle] + +ns_set delkey [ns_conn form] submit + + +set sql_statement [util_prepare_update $db ad_domains domain_id $domain_id [ns_conn form]] + + +if [catch { ns_db dml $db $sql_statement } errmsg] { + ad_return_error "Failure to update domain information" "The database rejected the attempt: +
    +
    +$errmsg
+
    +
    +" + return +} + +ns_returnredirect "domain-top.tcl?[export_url_vars domain_id]" Index: web/openacs/www/admin/gc/domain-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/domain-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/domain-edit.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,85 @@ +# domain-edit.tcl,v 3.1.2.1 2000/03/16 22:09:55 curtisg Exp +set_the_usual_form_variables + +# domain_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select * from ad_domains +where domain_id=$domain_id"] +set_variables_after_query + +append html "[ad_admin_header "Edit $domain parameters"] + +

    Edit $domain parameters

    + +in the classifieds + +
    + +
    +

    Identity

    +Full domain name:
    +Pick a short key :
    +

    User Interface

    +Annotation for the top of the domain page:
    + +

    +Annotation for the bottom of the domain page:
    +
    +

    Ad Parameters

    +By default, a full ad and a short description will be collected for all ads. To include more fields, write the form fragment to collect the ad data you desire. This fragment will be place inside a 2 column table. +
    +Valid fields: + + + + + + + +
    NameProperties
    manufacturerMaxlength 50
    modelMaxlength 50
    item_sizeMaxlength 100
    colorMaxlength 50
    us_citizen_p\"t\" or \"f\"
    +
    + + + + + + + +
    +Default expiration days: + + +
    +Do you want to allow \"Wanted to by\" ads? +" + +set html_form "Yes +No +
    +Do you wish to have auctions on this site? + +Yes +No +
    +Are your ads based on geography? + +Yes +No" + + +append html "[bt_mergepiece $html_form $selection] +
    +

    + +

    + +
    +[export_form_vars domain_id] +
    +[ad_admin_footer] +" + +ns_db releasehandle $db +ns_return 200 text/html $html Index: web/openacs/www/admin/gc/domain-top.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/domain-top.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/domain-top.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,81 @@ +# domain-top.tcl,v 3.1.2.1 2000/03/14 22:21:17 curtisg Exp +set_the_usual_form_variables + +# domain_id + +set db [gc_db_gethandle] +set selection [ns_db 1row $db [gc_query_for_domain_info $domain_id ad_domains.oid,]] +set_variables_after_query + +append html "[ad_admin_header "Administer the $domain Classifieds"] + +

    Administration

    + +[ad_admin_context_bar [list "index.tcl" "Classifieds"] $full_noun] + +
    + + + + + +[ad_admin_footer]" + +ns_db releasehandle $db +ns_return 200 text/html $html Index: web/openacs/www/admin/gc/edit-ad-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/edit-ad-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/edit-ad-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,98 @@ +# edit-ad-2.tcl,v 3.1 2000/03/11 00:45:12 curtisg Exp +set admin_id [ad_verify_and_get_user_id] +if { $admin_id == 0 } { + ns_returnredirect "/register/" + return +} + +set_the_usual_form_variables + +# bunch of stuff including classified_ad_id; maybe user_charge +# actually most of these will have gotten overwritten by +# set_variables_after_query after the next query + + +set db [ns_db gethandle] + +if [catch { set selection [ns_db 1row $db "select * from classified_ads +where classified_ad_id = $classified_ad_id"] } errmsg ] { + ad_return_error "Could not find Ad $classified_ad_id" "Either you are fooling around with the Location field in your browser +or my code has a serious bug. The error message from the database was + +
    +$errmsg +
    " + return +} + +# OK, we found the ad in the database if we are here... +# the variable SELECTION holds the values from the db +set_variables_after_query + +set update_sql [util_prepare_update $db classified_ads classified_ad_id $classified_ad_id [ns_conn form]] + +if [catch { ns_db dml $db $update_sql } errmsg] { + # something went a bit wrong + set_variables_after_query + ad_return_error "Error Updating Ad $classified_ad_id" "Tried the following SQL: + +
    +$update_sql
+
    + +and got back the following: + +
    +$errmsg +
    " + return + } else { + + # everything went nicely + append html "[gc_header "Success"] + +

    Success!

    + +updating ad number $classified_ad_id in the + $domain domain of [gc_system_name] + +
    + +" + +if { [info exists user_charge] && ![empty_string_p $user_charge] } { + if { [info exists charge_comment] && ![empty_string_p $charge_comment] } { + # insert separately typed comment + set user_charge [mv_user_charge_replace_comment $user_charge $charge_comment] + } + append html "

    ... adding a user charge: +

    +[mv_describe_user_charge $user_charge] +
    +... " + mv_charge_user $db $user_charge "Editing your ad in [ad_system_name]" "We had to edit your ad in [ad_system_name]. + +For clarity, here is what we had in the database.. + +Subject: $one_line + +Full Ad: + +$full_ad +" + append html "Done." +} + + +append html " + +

    + +If you'd like to check the ad, then take a look +at the public page. + +[ad_admin_footer]" +} + +ns_db releasehandle $db +ns_return 200 text/html $html Index: web/openacs/www/admin/gc/edit-ad.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/edit-ad.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/edit-ad.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,144 @@ +# edit-ad.tcl,v 3.1 2000/03/11 00:45:12 curtisg Exp +# /admin/gc/edit-ad.tcl +# a script for letting the site administrator edit a user's classified + +set admin_id [ad_verify_and_get_user_id] +if { $admin_id == 0 } { + ns_returnredirect "/register/" + return +} + +set_the_usual_form_variables + +# classified_ad_id + +set db [gc_db_gethandle] +if [catch { set selection [ns_db 1row $db "select ca.*, to_char(expires,'YYYY-MM-DD') as ansi_expires +from classified_ads ca +where classified_ad_id = $classified_ad_id"] } errmsg] { + ad_return_error "Could not find Ad $classified_ad_id" "Either you are fooling around with the Location field in your browser +or my code has a serious bug. The error message from the database was + +

    +$errmsg +
    " + return +} + +# OK, we found the ad in the database if we are here... +# the variable SELECTION holds the values from the db +set_variables_after_query + +# user wants to edit the ad +set selection_domain [ns_db 1row $db "select insert_form_fragments, wtb_common_p, geocentric_p, auction_p from ad_domains where domain_id = $domain_id"] +set_variables_after_query_not_selection $selection_domain + +if { [string first "full_ad" $insert_form_fragments] == -1 } { + set insert_form_fragments [concat "Full Ad
    + + +" $insert_form_fragments] + +} elseif { [string first "html_p" $insert_form_fragments] == -1 } { + # there was full-ad in the form fragments, but there is no corresponding html_p + append insert_form_fragments "The full ad above is " +} + +if { [string first "one_line" $insert_form_fragments] == -1 } { + set insert_form_fragments [concat "One Line Summary
    + + " $insert_form_fragments] +} +set raw_form "
    + + + +$insert_form_fragments +" + + +if {$geocentric_p == "t"} { + append raw_form " + + + " +} + +if {$wtb_common_p == "t" && [string first "wanted_p" $insert_form_fragments] == -1 } { + append raw_form " + " +} + +if {$auction_p == "t"} { + append raw_form " + " +} + +set selection_without_nulls [remove_nulls_from_ns_set $selection] +set final_form [bt_mergepiece $raw_form $selection_without_nulls] + +if [ad_parameter EnabledP "member-value"] { + set mistake_wad [mv_create_user_charge $user_id $admin_id "classified_ad_mistake" $classified_ad_id [mv_rate ClassifiedAdMistakeRate]] + set spam_wad [mv_create_user_charge $user_id $admin_id "classified_ad_spam" $classified_ad_id [mv_rate ClassifiedAdSpamRate]] + set options [list [list "" "Don't charge user"] [list $mistake_wad "Mistake of some kind, e.g., duplicate posting"] [list $spam_wad "Spam or other serious policy violation"]] + set member_value_section "

    Charge this user for his sins?

    + +
    +
    +Charge Comment: +
    +
    +
    " +} else { + set member_value_section "" +} + + +append html "[gc_header "Edit \"$one_line\""] + +

    Edit \"$one_line\"

    + +ad number $classified_ad_id in +the classifieds +
    + +$final_form +
    State[state_widget $db "" "state"]
    Country[country_widget $db "" "country"]
    Do you want to buy or sell? + Sell + Buy +
    Auction? + Yes + No + (this allows members to place bids)
    Expires + YYYY-MM-DD \[format must be exact\] +
    Category + +
    +

    + +$member_value_section + +

    + +
    +
    + +If this ad really looks nasty, you can choose to +delete it instead. + +[ad_admin_footer] +" + +ns_db releasehandle $db +ns_return 200 text/html $html Index: web/openacs/www/admin/gc/edit-categories.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/edit-categories.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/edit-categories.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,30 @@ +# edit-categories.tcl,v 3.0.4.1 2000/03/15 05:09:06 curtisg Exp +set db [ns_db gethandle] + +set selection [ns_db select $db "select * from ad_domains"] +while {[ns_db getrow $db $selection]} { + set_variables_after_query + append bullet_list "
  • $backlink_title\n" +} + +ns_return 200 text/html " + +Pick a Domain + + +

    Pick a Domain

    + +
    + +
      + +$bullet_list + +
    + + +
    +
    philg@mit.edu
     + + +" Index: web/openacs/www/admin/gc/edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/edit.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,30 @@ +# edit.tcl,v 3.0.4.1 2000/03/15 05:08:22 curtisg Exp +set db [ns_db gethandle] + +set selection [ns_db select $db "select * from ad_domains"] +while {[ns_db getrow $db $selection]} { + set_variables_after_query + append bullet_list "
  • $backlink_title\n" +} + +ns_return 200 text/html " + +Pick a Domain + + +

    Pick a Domain

    + +
    + +
      + +$bullet_list + +
    + + +
    +
    philg@mit.edu
     + + +" Index: web/openacs/www/admin/gc/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,55 @@ +# index.tcl,v 3.1 2000/03/11 00:45:12 curtisg Exp +append html "[ad_admin_header "Classified Administration"] + +

    Classified Administration

    + +[ad_admin_context_bar "Classifieds"] + +
    +
      + +

      Active domains

      " + +set db [gc_db_gethandle] + +set selection [ns_db select $db "select * +from ad_domains +order by active_p desc, upper(domain)"] + +set count 0 +set inactive_title_shown_p 0 + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $active_p == "f" } { + if { $inactive_title_shown_p == 0 } { + # we have not shown the inactive title yet + if { $count == 0 } { + append html "
    • No active domains" + } + set inactive_title_shown_p 1 + append html "

      Inactive domains

      " + } + set anchor "activate" + } else { + set anchor "deactivate" + } + + set_variables_after_query + + append html "
    • $domain\n ($anchor)\n" + incr count +} + +append html " + +

      + +

    • create a new domain + +
    + +[ad_admin_footer]" + +ns_db releasehandle $db +ns_return 200 text/html $html Index: web/openacs/www/admin/gc/manage-categories-for-domain.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/manage-categories-for-domain.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/manage-categories-for-domain.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,97 @@ +# manage-categories-for-domain.tcl,v 3.1.2.4 2000/03/15 05:23:57 curtisg Exp +set_the_usual_form_variables + +# domain_id + +set db [gc_db_gethandle] +set selection [ns_db 1row $db "select full_noun, domain from ad_domains where domain_id = $domain_id"] +set_variables_after_query + +append html "[ad_admin_header "Categories for $domain Classified Ads"] + +

    Categories

    + +[ad_admin_context_bar [list "index.tcl" "Classifieds"] [list "domain-top.tcl?domain_id=$domain_id" $full_noun] "Categories"] + +
    + +

    The Categories

    + +
      + +" + +set selection [ns_db select $db "select ac.primary_category, count(*) as n_ads +from ad_categories ac, classified_ads ca +where ac.domain_id = $domain_id +and ca.domain_id = $domain_id +and ac.primary_category = ca.primary_category +and (sysdate() <= expires or expires is null) +group by ac.primary_category +order by upper(ac.primary_category)"] + +set counter 0 +while {[ns_db getrow $db $selection]} { + set_variables_after_query + incr counter + append html "
    • +$primary_category +($n_ads) +\[ delete | + edit +\]" + +} + +if { $counter == 0 } { + append html "no categories defined currently" +} + +append html " + +

      + +

    • add a new category + +
    + +

    Categories that are presented to users placing ads

    + +(but that don't show up on the front page because there aren't any ads +in these categories) + +

    + +

      +" + +set selection [ns_db select $db "select ac.primary_category +from ad_categories ac +where ac.domain_id = $domain_id +and 0 = (select count(*) from classified_ads ca + where ca.domain_id = $domain_id + and ca.primary_category = ac.primary_category) +order by upper(ac.primary_category)"] + +set counter 0 +while {[ns_db getrow $db $selection]} { + incr counter + set_variables_after_query + append html "
    • $primary_category \[ DELETE | + EDIT +\]" + +} + +if { $counter == 0 } { + append html "No orphan categories found." +} + +append html " +
    + +[ad_admin_footer] +" + +ns_db releasehandle $db +ns_return 200 text/html $html Index: web/openacs/www/admin/gc/manage-categories.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/manage-categories.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/manage-categories.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,30 @@ +# manage-categories.tcl,v 3.1 2000/03/11 00:45:12 curtisg Exp +set db [ns_db gethandle] + +set selection [ns_db select $db "select * from ad_domains"] +while {[ns_db getrow $db $selection]} { + set_variables_after_query + append bullet_list "
  • $backlink_title\n" +} + +ns_return 200 text/html " + +Pick a Domain + + +

    Pick a Domain

    + +
    + +
      + +$bullet_list + +
    + + +
    +
    philg@mit.edu
     + + +" Index: web/openacs/www/admin/gc/test.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/test.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/test.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,92 @@ +# test.tcl,v 3.1 2000/03/11 00:45:12 curtisg Exp +# let's test out our spamming system to remind people who've placed ads + +set db [gc_db_gethandle] +#set db_sub [ns_db gethandle orasubquery] +set db_sub [ns_db gethandle subquery] + +append html "
      " + +set generic_preamble " + +In the interests of having a well-groomed classified ad system for +everyone, we're sending you this robotically generated message to +remind you to + +1) delete ads for items that have sold +2) consider updating the price on items that haven't sold +3) delete duplicate ads + +It is effort like this on the part of the users that makes it possible +to offer this service for free. + +Here are the ads you've placed to date: + +" + +set generic_postamble " + +Thank you for using [gc_system_name] +(at [gc_system_url]). +" + +set selection [ns_db select $db "select max(poster_email) as email, max(domain_id) as domain_id, max(last_modified) as most_recent_visit, min(last_modified) as least_recent_visit, count(*) as n_ads +from classified_ads +where (sysdate() <= expires or expires is null) +and (wanted_p <> 't' or sysdate() > (last_modified + 30)) +and sysdate() > last_modified + 6 +group by poster_email"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append html "
    • $email has $n_ads, most recent edit was $most_recent_visit; oldest ad hasn't been touched since $least_recent_visit. URL: edit them\n" + set sub_selection [ns_db select $db_sub "select classified_ad_id, posted, last_modified, one_line, expired_p(expires) as expired_p +from classified_ads +where poster_email = '[DoubleApos $email]' +order by expired_p, classified_ad_id desc"] + if { $n_ads == 1 } { + set subject_line "your ad in [gc_system_name]" + } else { + set subject_line "your $n_ads ads in [gc_system_name]" + } + set body $generic_preamble + set expired_section_started_yet_p 0 + while { [ns_db getrow $db_sub $sub_selection] } { + set_variables_after_subquery + if { $last_modified == $posted || $last_modified == "" } { + set modified_phrase "" + } else { + set modified_phrase "(modified $last_modified)" + } + if { $expired_p == "t" } { + if { !$expired_section_started_yet_p } { + append body "\n -- expired ads -- \n\n" + set expired_section_started_yet_p 1 + } + set expired_phrase "(EXPIRED)" + } else { + set expired_phrase "" + } + append body "${posted}${expired_phrase} : $one_line $modified_phrase +[gc_system_url]edit-ad-3.tcl?classified_ad_id=$classified_ad_id +" + } + if { $expired_p == "t" } { + # there was at least one expired ad + append body "\n\nNote: you can revive an expired ad by going to the edit URL (above) +and changing the expiration date." + } + append body $generic_postamble + append html "
      +Subject: $subject_line
+Body:
+$body
+
      +" +} + +append html "
    " + +ns_db releasehandle $db +ns_db releasehandle $db_sub +ns_return 200 text/html $html Index: web/openacs/www/admin/gc/toggle-active-p.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/toggle-active-p.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/toggle-active-p.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,10 @@ +# toggle-active-p.tcl,v 3.1 2000/03/11 00:45:12 curtisg Exp +set_the_usual_form_variables + +# domain_id + +set db [ns_db gethandle] + +ns_db dml $db "update ad_domains set active_p = logical_negation(active_p) where domain_id = $domain_id" + +ns_returnredirect "index.tcl" Index: web/openacs/www/admin/gc/view-alerts.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gc/view-alerts.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gc/view-alerts.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,96 @@ +# view-alerts.tcl,v 3.1 2000/03/11 00:45:12 curtisg Exp +set_form_variables +set_form_variables_string_trim_DoubleAposQQ + +# domain_id + +set db [ns_db gethandle] + +# cookie checks out; user is authorized + +set keyword_header "" +if { [bboard_pls_blade_installed_p] == 1 } { + set keyword_header "Keywords" +} + +set domain [database_to_tcl_string $db "select domain +from ad_domains where domain_id = $domain_id"] + +append html " +Alerts for $domain + + + +

    Alerts for $domain

    + +in [ad_system_name] classifieds + +
    + + +$keyword_header + +" + + +set selection [ns_db select $db "select cea.*, cea.alert_id, +case when valid_p='f' then 't'::char else 'f'::char end as not_valid_p, +upper(email) as upper_email, email +from classified_email_alerts cea, users +where cea.user_id = users.user_id +and domain_id = $domain_id +order by not_valid_p, upper_email"] + +set seen_any_enabled_p 0 +set seen_disabled_p 0 + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + if { $valid_p == "f" } { + # we're into the disabled section + if { $seen_any_enabled_p && !$seen_disabled_p } { + if { [bboard_pls_blade_installed_p] == 1 } { + append html "\n" + } else { + append html "\n" + } + set seen_disabled_p 1 + } + set action "Re-enable" + } else { + # alert is enabled + set seen_any_enabled_p 1 + set action "Disable" + } + if { [bboard_pls_blade_installed_p] == 1 } { + append html "\n" + } else { + append html "\n" + } +} + +append html " + +
    EmailActionFrequency
    -- Disabled Alerts --
    -- Disabled Alerts --
    $email$action$frequency\"$keywords\"
    $email$action$frequency
    +

    +If you are seeing consistent bounces from the email notification +system then just type these addresses into the form below and the +alerts will be flushed from the database. Place spaces between the +email addresses (but no actual carriage returns). + +

    +[export_form_vars domain_id] + + + +

    + + + +

    + +[ad_admin_footer] +" + +ns_db releasehandle $db +ns_return 200 text/html $html Index: web/openacs/www/admin/general-comments/delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/general-comments/delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/general-comments/delete-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,47 @@ +# delete-2.tcl,v 3.0 2000/02/06 03:23:22 ron Exp +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set_the_usual_form_variables + +# comment_id, content, html_p, submit, maybe return_url + +if {![info exists return_url]} { + set return_url "index.tcl" +} + +if {[regexp -nocase "cancel" $submit]} { + ns_return 200 text/html "comment not deleted" + return +} + +set db [ns_db gethandle] +set user_id [ad_get_user_id] + +if [catch { ns_db dml $db "begin transaction" + # insert into the audit table + ns_db dml $db "insert into general_comments_audit +(comment_id, user_id, ip_address, audit_entry_time, modified_date, content) +select comment_id, user_id, '[ns_conn peeraddr]', sysdate(), modified_date, content from general_comments where comment_id = $comment_id" + + ns_db dml $db "delete from general_comments where +comment_id=$comment_id" + + ns_db dml $db "end transaction" } errmsg] { + + # there was some other error with the comment update + ad_return_error "Error updating comment" "We couldn't update your comment. Here is what the database returned: +

    +

    +
    +$errmsg
+
    +
    +" +return +} + +ns_return 200 text/html "done" + Index: web/openacs/www/admin/general-comments/delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/general-comments/delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/general-comments/delete.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,45 @@ +# delete.tcl,v 3.0 2000/02/06 03:23:24 ron Exp +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set_form_variables + +# comment_id + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select comment_id, content, general_comments.html_p as comment_html_p +from general_comments +where comment_id = $comment_id"] + +if { $selection == "" } { + ad_return_error "Can't find comment" "Can't find comment $comment_id" + return +} + +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "Really delete comment" ] + +

    Really delete comment

    + +
    + + +
    +Do you really wish to delete the following comment? +
    +[util_maybe_convert_to_html $content $comment_html_p] +
    +
    + + +
    +[export_form_vars comment_id] +
    +[ad_admin_footer] +" Index: web/openacs/www/admin/general-comments/edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/general-comments/edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/general-comments/edit-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,60 @@ +# edit-2.tcl,v 3.0 2000/02/06 03:23:25 ron Exp +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set admin_id [ad_verify_and_get_user_id] +if { $admin_id == 0 } { + # we don't know who this is administering, + # so we won't be able to audit properly + ns_returnredirect "/register/" + return +} + +set_the_usual_form_variables + +# comment_id, content, html_p, approved_p + +# check for bad input +if {![info exists content] || [empty_string_p $content] } { + ad_return_complaint 1 "
  • the comment field was empty" + return +} + +# user has input something, so continue on + +set db [ns_db gethandle] + +if [catch { ns_db dml $db "begin transaction" + # insert into the audit table + ns_db dml $db "insert into general_comments_audit +(comment_id, user_id, ip_address, audit_entry_time, modified_date, content) +select comment_id, $admin_id, '[ns_conn peeraddr]', sysdate(), modified_date, content from general_comments where comment_id = $comment_id" + ns_db dml $db "update general_comments +set content = '[DoubleApos $content]', html_p = '$html_p', approved_p = '$approved_p' +where comment_id = $comment_id" + ns_db dml $db "end transaction" } errmsg] { + + # there was some other error with the comment update + ad_return_error "Error updating comment" "We couldn't update your comment. Here is what the database returned: +

    +

    +
    +$errmsg
+
    +
    +" +return +} + +ns_return 200 text/html "[ad_admin_header "Done"] + +

    Done

    + +[ad_admin_context_bar [list "index.tcl" "General Comments"] "Edit"] + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/general-comments/edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/general-comments/edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/general-comments/edit.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,62 @@ +# edit.tcl,v 3.0 2000/02/06 03:23:26 ron Exp +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set admin_id [ad_verify_and_get_user_id] +if { $admin_id == 0 } { + # we don't know who this is administering, + # so we won't be able to audit properly + ns_returnredirect "/register/" + return +} + +set_form_variables + +# comment_id + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select comment_id, content, general_comments.html_p as comment_html_p, approved_p +from general_comments +where comment_id = $comment_id"] + + +if { $selection == "" } { + ad_return_error "Can't find comment" "Can't find comment $comment_id" + return +} + +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "Edit comment" ] + +

    Edit comment

    + +[ad_admin_context_bar [list "index.tcl" "General Comments"] "Edit"] + +
    + +
    +
    +
    +Text above is + +
    +Approval status + +
    + +
    +[export_form_vars comment_id] +
    +
    +[ad_admin_footer] +" Index: web/openacs/www/admin/general-comments/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/general-comments/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/general-comments/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,192 @@ +# index.tcl,v 3.0 2000/02/06 03:23:27 ron Exp +# /admin/general-comments/index.tcl +# +# by philg@mit.edu on September 5, 1999 + +# the idea here is to present the newer comments, separated by +# section, with dimensional controls up top to control +# how much is displayed + +# within each section, we sort by date descending + +# the dimensions: +# time (limit to 1 7 30 days or "all") +# section ("all" or limit to one section), presented as a select box +# approval ("all" or "unapproved only") + +set_form_variables 0 + +# time_dimension_value, section_dimension_value, approval_dimension_value + +if { ![info exists time_dimension_value] || [empty_string_p $time_dimension_value] } { + set time_dimension_value "30" +} + +if { ![info exists section_dimension_value] || [empty_string_p $section_dimension_value] } { + set section_dimension_value "all" +} + +if { ![info exists approval_dimension_value] || [empty_string_p $approval_dimension_value] } { + set approval_dimension_value "all" +} + +# return_url to be passed to various helper pages so that we return to +# this page with the proper parameters + +set return_url "[ns_urlencode "index.tcl?[export_ns_set_vars "url"]"]" + +set db [ns_db gethandle] + +set n_days_possible [list 1 7 30 all] + +foreach n_days $n_days_possible { + if { $n_days == $time_dimension_value } { + # current choice, just the item + lappend time_widget_items $n_days + } else { + lappend time_widget_items "$n_days" + } +} + +set time_widget [join $time_widget_items] + +set individual_section_options [ad_db_optionlist $db "select section_name, table_name +from table_acs_properties +order by upper(section_name)" $section_dimension_value] + +if { $section_dimension_value == "all" } { + set all_sections_option "\n" +} else { + set all_sections_option "\n" +} + +set section_widget "
    +[export_ns_set_vars "form" [list section_dimension_value]] + + +
    +" + +if { $approval_dimension_value == "all" } { + set approval_widget "all | unapproved only" +} else { + # we're currently looking at unapproved + set approval_widget "all | unapproved only" +} + +ReturnHeaders + +ns_write "[ad_admin_header "General Comments Administration"] + +

    General Comments Administration

    + +[ad_admin_context_bar "General Comments"] + +
    " + +#DRB: I got rid of this because the table it depends on doesn't exist +#in the (virgin aD ACS) data model. So hitting the link craps out +#in typical aD "we don't check our code" style. + +#Also, the delete triggers defined in general-comments.sql should make this +#unecessary. This just reinforces the notion that we need a general +#means to register modules with general comments, so the triggers get +#defined automatically etc, which would bop the problem dealt with here +#out of existence. + +#[help_upper_right_menu [list "integrity-check.tcl" "check comments' referential integrity"]] + +ns_write " +[ad_style_bodynote "Due to some ugly software history, if you're interested in comments on +static .html pages, you have to visit +/admin/comments/"] + +

    + +
    $section_widget +$approval_widget +$time_widget +
    +" + +if { $section_dimension_value == "all" } { + set where_clause_for_section "" +} else { + set where_clause_for_section "and gc.on_which_table = '$section_dimension_value'" +} + +if { $approval_dimension_value == "all" } { + set where_clause_for_approval "" +} else { + set where_clause_for_approval "and gc.approved_p = 'f'" +} + +if { $time_dimension_value == "all" } { + set where_clause_for_time "" +} else { + set where_clause_for_time "and sysdate()::date-gc.comment_date::date < $time_dimension_value" +} + +set selection [ns_db select $db "select + gc.*, + first_names || ' ' || last_name as commenter_name, + tm.admin_url_stub, + tm.section_name +from general_comments gc, users, table_acs_properties tm +where users.user_id = gc.user_id +and gc.on_which_table = tm.table_name +$where_clause_for_section +$where_clause_for_approval +$where_clause_for_time +order by gc.on_which_table, gc.comment_date desc"] + +set the_comments "" + +set last_section_name "" +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $section_name != $last_section_name } { + if ![empty_string_p $section_name] { + append the_comments "

    Comments within $section_name

    \n" + } else { + append the_comments "

    Comments on $on_which_table

    \n" + } + set last_section_name $section_name + } + if { [empty_string_p $one_line_item_desc] } { + set best_item_description "$section_name ID#$on_what_id" + } else { + set best_item_description $one_line_item_desc + } + append the_comments " + + +
    +[format_general_comment $comment_id $client_file_name $file_type $original_width $original_height $caption $content $html_p] +

    -- $commenter_name ([util_AnsiDatetoPrettyDate $comment_date]) +on $best_item_description +
    +    		 +" + if { $approved_p == "f" } { + append the_comments "Approve\n
    \n" + } + append the_comments "edit +
    +delete +
    \n" +} + +if [empty_string_p $the_comments] { + ns_write "there aren't any comments in this ACS installation that fit your criteria" +} else { + ns_write $the_comments +} + + +ns_write [ad_admin_footer] + + Index: web/openacs/www/admin/general-comments/integrity-check-delete-comment.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/general-comments/integrity-check-delete-comment.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/general-comments/integrity-check-delete-comment.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,9 @@ +# integrity-check-delete-comment.tcl,v 3.0 2000/02/06 03:23:28 ron Exp +set_the_usual_form_variables +# comment_id + +set db [ns_db gethandle] + +ns_db dml $db "delete from general_comments where comment_id = $comment_id" + +ns_returnredirect "integrity-check.tcl" Index: web/openacs/www/admin/general-comments/integrity-check.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/general-comments/integrity-check.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/general-comments/integrity-check.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,64 @@ +# integrity-check.tcl,v 3.0 2000/02/06 03:23:29 ron Exp +# This page is to verify that the rows that general comments reference +# actually exist, and enable the user to delete any comments that aren't +# tied to anything. This can happen when + +set dbs [ns_db gethandle main 2] +set db [lindex $dbs 0] +set sub_db [lindex $dbs 1] + +# Get table name, section name, and primary key for all sections. +set selection [ns_db select $db "select m.table_name, section_name, column_name as primary_key_column +from user_constraints uc, user_cons_columns ucc, table_acs_properties m +where ucc.table_name = upper(m.table_name) +and uc.table_name = ucc.table_name +and ucc.constraint_name = uc.constraint_name +and uc.constraint_type = 'P' +order by m.table_name"] + + +set results "" + +set counter 0 + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + if { $counter == 0 } { + append results "

    $section_name

    \n
      \n" + } else { + append results "
    \n

    $section_name

    \n
      \n" + } + incr counter + + set sub_selection [ns_db select $sub_db "select comment_id, one_line_item_desc from general_comments where on_which_table = '$table_name' and on_what_id not in (select $primary_key_column from $table_name)"] + + while { [ns_db getrow $sub_db $sub_selection] } { + set_variables_after_subquery + + append results "
    • $one_line_item_desc delete\n" + } + +} +if { $counter > 0 } { + append results "
    " +} + +ns_db releasehandle $db +ns_db releasehandle $sub_db + +ns_return 200 text/html "[ad_admin_header "General Comments Integrity Check"] +

    General Comment Integrity Check

    + +[ad_admin_context_bar [list "index.tcl" "General Comments"] "Integrity Check"] + +
    + +If an appropriate delete trigger was not created for a module which uses +general comments, comments may exist for rows which have been deleted. +This page searches out any such rows and lets you delete them. + +$results + +[ad_admin_footer] +" Index: web/openacs/www/admin/general-comments/toggle-approved-p.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/general-comments/toggle-approved-p.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/general-comments/toggle-approved-p.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,15 @@ +# toggle-approved-p.tcl,v 3.0 2000/02/06 03:23:31 ron Exp +set_form_variables + +# comment_id maybe return_url + +if {![info exists return_url]} { + set return_url "index.tcl" +} + +set db [ns_db gethandle] + +ns_db dml $db "update general_comments set approved_p = logical_negation(approved_p) where comment_id = $comment_id" + +ns_returnredirect $return_url + Index: web/openacs/www/admin/general-links/approve-all.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/general-links/approve-all.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/general-links/approve-all.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,28 @@ +# /admin/general-links/approve-all.tcl +# +# Author: tzumainn@arsdigita.com, 2/01/2000 +# +# Approves a link and all its associations +# +# approve-all.tcl,v 3.0 2000/02/06 03:23:33 ron Exp +#-------------------------------------------------------- + +ad_page_variables {link_id {return_url "index.tcl"}} + +set db [ns_db gethandle] + +ns_db dml $db "begin transaction" + +set current_approval_status [database_to_tcl_string $db "select approved_p from general_links where link_id = $link_id"] + +if { $current_approval_status == "f" } { + ns_db dml $db "update general_links set approved_p = 't', last_approval_change = sysdate() where link_id = $link_id" +} + +ns_db dml $db "update site_wide_link_map set approved_p = 't' where link_id = $link_id" + +ns_db dml $db "end transaction" + +ns_db releasehandle $db + +ns_returnredirect $return_url Index: web/openacs/www/admin/general-links/check-all-links.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/general-links/check-all-links.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/general-links/check-all-links.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,64 @@ +# File: /admin/general-links/check-all-links.tcl +# Date: 2/01/2000 +# Author: tzumainn@arsdigita.com +# +# Purpose: +# Checks all links for live/dead status and meta tags +# +# check-all-links.tcl,v 3.0 2000/02/06 03:23:34 ron Exp +#-------------------------------------------------------- + +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set admin_id [ad_maybe_redirect_for_registration] + +ad_return_top_of_page "[ad_header "Check All Links" ] + +

    Check All Links

    + +[ad_admin_context_bar [list "" "General Links"] "Check All Links"] + +
    + +
      +" + +set return_url "check-all-links.tcl" +set db [ns_db gethandle] + +set link_info_list [database_to_tcl_list_list $db "select link_id, url from general_links order by url"] + +foreach link_info $link_info_list { + + set link_id [lindex $link_info 0] + set url [lindex $link_info 1] + + set check_p [ad_general_link_check $db $link_id] + + if { $check_p == 1 } { + ns_write "
    • $url is live" + + } else { + set last_live_date [database_to_tcl_string_or_null $db "select last_live_date from general_links where link_id = $link_id"] + if [empty_string_p $last_live_date] { + set last_live_date "N/A" + } + + ns_write " +
    • $url is unreachable - $check_p +
      Last Live Date: $last_live_date + " + } + ns_write " - edit link | delete link

      " +} + +ns_db releasehandle $db + +ns_write " +

    + +[ad_footer] +" Index: web/openacs/www/admin/general-links/check-one-link.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/general-links/check-one-link.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/general-links/check-one-link.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,56 @@ +# File: /admin/general-links/check-one-link.tcl +# Date: 2/01/2000 +# Author: tzumainn@arsdigita.com +# +# Purpose: +# Checks one link for live/dead status and meta tags +# +# check-one-link.tcl,v 3.0 2000/02/06 03:23:35 ron Exp +#-------------------------------------------------------- + +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set admin_id [ad_maybe_redirect_for_registration] + +ad_page_variables {link_id} + +ad_return_top_of_page "[ad_header "Check One Link" ] + +

    Check One Link

    + +[ad_admin_context_bar [list "" "General Links"] "Check One Link"] + +
    +" + +set db [ns_db gethandle] + +set url [database_to_tcl_string $db "select url from general_links where link_id = $link_id"] + +set check_p [ad_general_link_check $db $link_id] + +if { $check_p == 1 } { + set link_status "$url is live" +} else { + set last_live_date [database_to_tcl_string_or_null $db "select last_live_date from general_links where link_id = $link_id"] + if [empty_string_p $last_live_date] { + set last_live_date "N/A" + } + + set link_status " + $url is unreachable - $check_p +
    Last Live Date: $last_live_date" +} + +ns_db releasehandle $db + +ns_write " +
      +
    • $link_status +
    + +[ad_footer] +" Index: web/openacs/www/admin/general-links/delete-assoc-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/general-links/delete-assoc-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/general-links/delete-assoc-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,52 @@ +# File: /admin/general-links/delete-assoc-2.tcl +# Date: 2/01/2000 +# Author: tzumainn@arsdigita.com +# +# Purpose: +# Step 2 of 2 in deleting a link association +# +# delete-assoc-2.tcl,v 3.0 2000/02/06 03:23:36 ron Exp +#-------------------------------------------------------- + +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +ad_page_variables {map_id {return_url ""}} + +set db [ns_db gethandle] +set user_id [ad_get_user_id] + +if [catch { ns_db dml $db "begin transaction" + + ### No audits (yet) - Tzu-Mainn Chen + # insert into the audit table + # ns_db dml $db "insert into general_comments_audit + # (comment_id, user_id, ip_address, audit_entry_time, modified_date, content) + # select comment_id, user_id, '[ns_conn peeraddr]', sysdate, modified_date, content from general_comments where comment_id = $comment_id" + + set link_id [database_to_tcl_string $db "select link_id from site_wide_link_map where map_id = $map_id"] + + + ns_db dml $db "delete from site_wide_link_map where map_id = $map_id" + ns_db dml $db "end transaction" } errmsg] { + + # there was some other error with the link deletion + ad_return_error "Error deleting link" "We couldn't update your link. Here is what the database returned: +

    +

    +
    +$errmsg
+
    +
    +" +return +} + +if {[empty_string_p $return_url]} { + set return_url "view-associations.tcl?link_id=$link_id" +} + +ns_returnredirect $return_url + Index: web/openacs/www/admin/general-links/delete-assoc.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/general-links/delete-assoc.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/general-links/delete-assoc.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,54 @@ +# File: /admin/general-links/delete-assoc.tcl +# Date: 2/01/2000 +# Author: tzumainn@arsdigita.com +# +# Purpose: +# Step 1 of 2 in deleting a link association +# +# delete-assoc.tcl,v 3.0 2000/02/06 03:23:37 ron Exp +#-------------------------------------------------------- + +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +ad_page_variables {map_id {return_url ""}} + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select slm.link_id, on_which_table, on_what_id, one_line_item_desc, url, link_title +from site_wide_link_map slm, general_links gl +where map_id = $map_id +and slm.link_id = gl.link_id +"] + +if { $selection == "" } { + ad_return_error "Can't find link association" "Can't find link association $map_id" + return +} + +set_variables_after_query + +if {[empty_string_p $return_url]} { + set return_url "view-associations.tcl?link_id=$link_id" +} + +ns_return 200 text/html "[ad_header "Confirm Link Association Deletion"] + +

    Confirm Link Association Deletion

    + +
    + +Do you really wish to delete the following link association? +
    +$on_which_table: $on_what_id - $one_line_item_desc - links to: $link_title ($url) +
    + + + +[ad_footer] +" \ No newline at end of file Index: web/openacs/www/admin/general-links/delete-link-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/general-links/delete-link-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/general-links/delete-link-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,51 @@ +# File: /admin/general-links/delete-link-2.tcl +# Date: 2/01/2000 +# Author: tzumainn@arsdigita.com +# +# Purpose: +# Step 2 of 2 in deleting a link and everything associated with it +# +# delete-link-2.tcl,v 3.0 2000/02/06 03:23:39 ron Exp +#-------------------------------------------------------- + +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +ad_page_variables {link_id {return_url "index.tcl"}} + +set db [ns_db gethandle] +set user_id [ad_get_user_id] + +if [catch { ns_db dml $db "begin transaction" + + ### No audits (yet) - Tzu-Mainn Chen + # insert into the audit table + # ns_db dml $db "insert into general_comments_audit + # (comment_id, user_id, ip_address, audit_entry_time, modified_date, content) + # select comment_id, user_id, '[ns_conn peeraddr]', sysdate, modified_date, content from general_comments where comment_id = $comment_id" + + ns_db dml $db "delete from site_wide_category_map where on_which_table = 'general_links' and on_what_id = $link_id" + + ns_db dml $db "delete from general_link_user_ratings where link_id = $link_id" + ns_db dml $db "delete from site_wide_link_map where link_id = $link_id" + ns_db dml $db "delete from general_links where +link_id=$link_id" + + ns_db dml $db "end transaction" } errmsg] { + + # there was some other error with the link deletion + ad_return_error "Error deleting link" "We couldn't update your link. Here is what the database returned: +

    +

    +
    +$errmsg
+
    +
    +" +return +} + +ns_returnredirect $return_url + Index: web/openacs/www/admin/general-links/delete-link.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/general-links/delete-link.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/general-links/delete-link.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,71 @@ +# File: /admin/general-links/delete-link.tcl +# Date: 2/01/2000 +# Author: tzumainn@arsdigita.com +# +# Purpose: +# Step 1 of 2 in deleting a link and everything associated with it +# +# delete-link.tcl,v 3.0 2000/02/06 03:23:40 ron Exp +#-------------------------------------------------------- + +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +ad_page_variables {link_id {return_url "index.tcl"}} + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select link_id, url, link_title, link_description +from general_links +where link_id = $link_id"] + +if { $selection == "" } { + ad_return_error "Can't find link" "Can't find link $link_id" + return +} + +set_variables_after_query + +set selection [ns_db select $db "select on_which_table, on_what_id, one_line_item_desc from site_wide_link_map where link_id = $link_id"] + +set n_assoc 0 +set assoc_list "
      " +while {[ns_db getrow $db $selection]} { + incr n_assoc + set_variables_after_query + + append assoc_list "
    • $on_which_table: $on_what_id - $one_line_item_desc" +} + +ns_db releasehandle $db + +if { $n_assoc == 0 } { + append assoc_list "
    • This link has no associations." +} +append assoc_list "
    " + +ns_return 200 text/html "[ad_header "Confirm Link Deletion" ] + +

    Confirm Link Deletion

    + +
    + +Do you really wish to delete the following link? +
    +$link_title ($url) +
    $link_description +

    +

      +
    • All associations with this link will be deleted as well: $assoc_list +
    +
    + + + +[ad_footer] +" Index: web/openacs/www/admin/general-links/edit-link-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/general-links/edit-link-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/general-links/edit-link-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,77 @@ +# File: /admin/general-links/edit-link-2.tcl +# Date: 2/01/2000 +# Author: tzumainn@arsdigita.com +# +# Purpose: +# Step 2 of 2 in editing a link +# +# edit-link-2.tcl,v 3.0 2000/02/06 03:23:41 ron Exp +#-------------------------------------------------------- + +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set admin_id [ad_maybe_redirect_for_registration] + +set category_id_list "" +ad_page_variables {link_id link_title url link_description approved_p {return_url "index.tcl"} {category_id_list -multiple-list}} + + +page_validation { + if {[empty_string_p $url]} { + error "Please enter a url." + } +} { + if {[empty_string_p $link_title]} { + error "Please enter a link title." + } +} + +# user has input something, so continue on + +set db [ns_db gethandle] + +if [catch { ns_db dml $db "begin transaction" + + #### No audits, yet - Tzu-Mainn Chen + # insert into the audit table +# ns_db dml $db "insert into general_comments_audit +#(comment_id, user_id, ip_address, audit_entry_time, modified_date, content) +# select comment_id, $admin_id, '[ns_conn peeraddr]', sysdate, modified_date, content from general_comments where comment_id = $comment_id" + + set current_approval_status [database_to_tcl_string $db "select approved_p from general_links where link_id = $link_id"] + + if { $current_approval_status != $approved_p } { + ns_db dml $db "update general_links set approved_p = logical_negation(approved_p), last_approval_change = sysdate() where link_id = $link_id" + } + + ns_db dml $db "update general_links + set url = '[DoubleApos $url]', + link_title = '[DoubleApos $link_title]', + link_description = '[DoubleApos $link_description]', + last_modified = sysdate(), + last_modifying_user = $admin_id + where link_id = $link_id" + + if { $category_id_list != "{}"} { + ad_categorize_row -db $db -which_table "general_links" -what_id $link_id -category_id_list $category_id_list -one_line_item_desc "[DoubleApos $link_title]" + } + ad_general_link_check $db $link_id + + ns_db dml $db "end transaction" } errmsg] { + + # there was some other error with the link update + ad_return_error "Error updating link" "We couldn't update your link. Here is what the database returned: +

    +

    +
    +$errmsg
+
    +
    +" +return +} + +ns_returnredirect $return_url Index: web/openacs/www/admin/general-links/edit-link.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/general-links/edit-link.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/general-links/edit-link.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,104 @@ +# File: /admin/general-links/edit-link.tcl +# Date: 2/01/2000 +# Author: tzumainn@arsdigita.com +# +# Purpose: +# Step 1 of 2 in editing a link +# +# edit-link.tcl,v 3.0 2000/02/06 03:23:43 ron Exp +#-------------------------------------------------------- + +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set admin_id [ad_maybe_redirect_for_registration] + +ad_page_variables {link_id {return_url "index.tcl"}} + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select url, link_title, link_description, approved_p +from general_links +where link_id = $link_id"] + + +if { $selection == "" } { + ad_return_error "Can't find link" "Can't find link $link_id" + return +} + +set_variables_after_query + +set category_select [ad_categorization_widget -db $db -which_table "general_links" -what_id $link_id] + +ns_db releasehandle $db + +if {[empty_string_p $url]} { + set url "http://" +} + +set body "[ad_header "Edit Link" ] + +

    Edit Link

    + +[ad_admin_context_bar [list "$return_url" "General Links"] "Edit Link"] + +
    + +
    +
    + + + + + + + + + + + + + + + + + +" + +if {[regexp {option} $category_select match] == 0} { + append body "" +} else { + append body " + + + + +" +} + +append body " + + + + + +
    Link Title
    URL
    Link Description
    Associated Categories$category_select
    Approval status +
    + +
    + +
    +[export_form_vars link_id return_url] +
    +
    +[ad_footer] +" +#-- serve the page ------------ + +ns_return 200 text/html $body + Index: web/openacs/www/admin/general-links/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/general-links/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/general-links/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,338 @@ +# /admin/general-links/index.tcl +# +# Author: tzumainn@arsdigita.com, 2/01/2000 +# +# The idea here is to present the newer links, separated by +# section, with dimensional controls up top to control +# how much is displayed +# +# Notes: adapted from general-comments +# +# index.tcl,v 3.1 2000/03/09 00:22:04 tzumainn Exp +#-------------------------------------------------------- + +# within each section, we sort by date descending + +# the dimensions: +# time (limit to 1 7 30 days or "all") +# section ("all" or limit to one section), presented as a select box +# approval ("all" or "approved only" or "unapproved only" or "unexamined only") + +ad_page_variables {{time_dimension_value 30} {section_dimension_value "all"} {approval_dimension_value "unexamined"} {search_query ""}} + +set return_url "[ns_urlencode "index.tcl?[export_ns_set_vars "url"]"]" + +set db [ns_db gethandle] + +### time widget stuff + +if { $time_dimension_value == 1 } { + lappend time_widget_items "last 24 hrs" +} else { + lappend time_widget_items "last 24 hrs" +} + +if { $time_dimension_value == 7 } { + lappend time_widget_items "last week" +} else { + lappend time_widget_items "last week" +} + +if { $time_dimension_value == 30 } { + lappend time_widget_items "last month" +} else { + lappend time_widget_items "last month" +} + +if { $time_dimension_value == "all" } { + lappend time_widget_items "all" +} else { + lappend time_widget_items "all" +} + + +set time_widget [join $time_widget_items " | "] + + + +if { [empty_string_p $search_query] } { + set where_clause_for_search_query "" +} else { + set QQsearch_query [DoubleApos $search_query] + set where_clause_for_search_query " + and (upper(meta_keywords) like '%[string toupper $QQsearch_query]%' + or upper(meta_description) like '%[string toupper $QQsearch_query]%' + or upper(link_description) like '%[string toupper $QQsearch_query]%' + or upper(link_title) like '%[string toupper $QQsearch_query]%' + )" +} + +if { $approval_dimension_value == "all" } { + set approval_widget "all | unexamined only | approved only | unapproved only" + +} elseif { $approval_dimension_value == "approved_only" } { + # we're currently looking at approved + set approval_widget "all | unexamined only | approved only | unapproved only" + +} elseif { $approval_dimension_value == "unapproved_only" } { + # we're currently looking at unapproved + set approval_widget "all | unexamined only | approved only | unapproved only" +} else { + # we're looking at unexamined + set approval_widget "all | unexamined only | approved only | unapproved only" +} + +if { $section_dimension_value == "all" } { + set start_with_clause "start with parent_category_id is null" + # pg hack (BMA) + set start_with_proc "0" + + ad_return_top_of_page " + [ad_header "General Links Administration"] + +

    General Links Administration

    + + [ad_admin_context_bar "General Links Administration"] + +
    + " + +} else { + set category_select_name [database_to_tcl_string_or_null $db "select category from categories where category_id = '$section_dimension_value'"] + + set start_with_clause "start with child_category_id = $section_dimension_value" + # PG hack (BMA) + set start_with_proc "$section_dimension_value" + + ad_return_top_of_page " + [ad_header "$category_select_name"] + +

    $category_select_name

    + + [ad_admin_context_bar [list "" "General Links Administration"] $category_select_name] + +
    + " + +} + +ns_write " +

    + + + + + + + + + + + + + + + +
    Search for a link: +[export_form_vars time_dimension_value section_dimension_value approval_dimension_value] +
    Approval StatusCreation Time
    $approval_widget +$time_widget +
    +

    +
    check all links
    +

    +" + +if { $approval_dimension_value == "all" } { + set where_clause_for_approval "" +} elseif { $approval_dimension_value == "approved_only" } { + set where_clause_for_approval "and gl.approved_p = 't'" +} elseif { $approval_dimension_value == "unapproved_only" } { + set where_clause_for_approval "and gl.approved_p = 'f'" +} else { + set where_clause_for_approval "and gl.approved_p is NULL" +} + +if { $time_dimension_value == "all" } { + set where_clause_for_time "" +} else { + set where_clause_for_time "and gl.creation_time > [db_sysdate] - $time_dimension_value" +} + +set selection [ns_db select $db "select c.category_id, category_hierarchy_level(c.category_id, $start_with_proc,0) - 1 as indent, +c.category, c.category_type, link_id, gl.url, link_title, +gl.creation_time, gl.last_approval_change, gl.approved_p, user_first_names(gl.approval_change_by) as first_names, user_last_name(gl.approval_change_by) as last_name +from categories c, general_links gl +where exists (select 1 from site_wide_category_map swm + where gl.link_id = swm.on_what_id + and swm.on_which_table = 'general_links' + and swm.category_id = c.category_id) +and category_hierarchy_level(c.category_id, $start_with_proc, 0) is not null +$where_clause_for_approval +$where_clause_for_time +$where_clause_for_search_query +order by category_hierarchy_reverse_sortkey(c.category_id, $start_with_proc, ''), link_title"] + +set current_category_name "" +set current_indent 0 +set n_links 0 +set the_links "

      " + +while {[ns_db getrow $db $selection]} { + + set_variables_after_query + incr n_links + + set category_name $category + if {![empty_string_p $category_type]} { + append category_name " ($category_type)" + } + + if { $current_category_name != $category_name } { + if {![empty_string_p $current_category_name]} { + append the_links "
    " + for {set i 1} {$i <= $current_indent} {incr i} { + append the_links "\n" + } + } + set current_category_name $category_name + set current_indent $indent + + for {set i 1} {$i <= $current_indent} {incr i} { + append the_links "\n
      " + } + + append the_links "
    • $current_category_name\n
        " + } + + append the_links "
      • + $link_title ($url)
        Posted on [util_AnsiDatetoPrettyDate $creation_time]; " + + if {![empty_string_p $last_name]} { + set approval_user " by $first_names $last_name" + } else { + set approval_user "" + } + + if { $approved_p == "f" } { + append the_links " + Rejected on [util_AnsiDatetoPrettyDate $last_approval_change]$approval_user +
        + approve | \n" + } elseif { $approved_p == "t" } { + append the_links " + Approved on [util_AnsiDatetoPrettyDate $last_approval_change]$approval_user +
        + reject | \n" + } else { + append the_links " +
        + approve | reject | \n" + } + + append the_links " + approve link plus mappings + | + view associations + | + edit + | + check + | + delete + \n + " +} + +### wrap up last ul/blockquote +if { $n_links > 0 } { + append the_links "
      " +} + +for {set i 1} {$i <= $current_indent} {incr i} { + append the_links "\n
    " +} + +### deal with uncategorized links - maybe +set uncategorized_link_list "" +if { $section_dimension_value == "all" } { + + set n_uncategorized 0 + set selection [ns_db select $db "select link_id, gl.url, link_title, gl.creation_time, gl.last_approval_change, gl.approved_p, user_first_names(gl.approval_change_by) as first_names, user_last_name(gl.approval_change_by) as last_name + from general_links gl + where not exists (select 1 from site_wide_category_map swm + where gl.link_id = swm.on_what_id + and swm.on_which_table = 'general_links') + $where_clause_for_approval + $where_clause_for_time + $where_clause_for_search_query + "] + + while {[ns_db getrow $db $selection]} { + set_variables_after_query + + incr n_links + incr n_uncategorized + + append uncategorized_link_list "
  • + $link_title ($url)
    Posted on [util_AnsiDatetoPrettyDate $creation_time]; " + + if {![empty_string_p $last_name]} { + set approval_user " by $first_names $last_name" + } else { + set approval_user "" + } + + if { $approved_p == "f" } { + append uncategorized_link_list " + Rejected on [util_AnsiDatetoPrettyDate $last_approval_change]$approval_user +
    + approve | \n" + } elseif { $approved_p == "t" } { + append uncategorized_link_list " + Approved on [util_AnsiDatetoPrettyDate $last_approval_change]$approval_user +
    + reject | \n" + } else { + append uncategorized_link_list " +
    + approve | reject | \n" + } + + append uncategorized_link_list " + approve link plus mappings + | + view associations + | + edit + | + check + | + delete\n + " + } + + if { $n_uncategorized != 0 } { + set uncategorized_link_list "
  • Uncategorized Links
      $uncategorized_link_list
    " + } +} + +if { $n_links == 0 } { + append the_links "
  • No links available." +} + +ns_db releasehandle $db + +append the_links $uncategorized_link_list + +append the_links "" + +if { $n_links == 0 } { + ns_write "Sorry, there aren't any links in this ACS installation that fit your criteria" +} else { + ns_write $the_links +} + +ns_write [ad_admin_footer] + + Index: web/openacs/www/admin/general-links/toggle-assoc-approved-p.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/general-links/toggle-assoc-approved-p.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/general-links/toggle-assoc-approved-p.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,28 @@ +# File: /admin/general-links/toggle-assoc-approved-p.tcl +# Date: 2/01/2000 +# Author: tzumainn@arsdigita.com +# +# Purpose: +# toggles approved_p of link association +# +# toggle-assoc-approved-p.tcl,v 3.1 2000/03/09 00:22:31 tzumainn Exp +#-------------------------------------------------------- + +ad_page_variables {map_id approved_p {return_url "view-associations.tcl?link_id=$link_id"}} + +set current_user_id [ad_maybe_redirect_for_registration] + +set db [ns_db gethandle] + +ns_db dml $db "begin transaction" + +set link_id [database_to_tcl_string $db "select link_id from site_wide_link_map where map_id = $map_id"] + +ns_db dml $db "update site_wide_link_map set approved_p = '$approved_p', approval_change_by = $current_user_id where map_id = $map_id" + +ns_db dml $db "end transaction" + +ns_db releasehandle $db + +ns_returnredirect $return_url + Index: web/openacs/www/admin/general-links/toggle-link-approved-p.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/general-links/toggle-link-approved-p.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/general-links/toggle-link-approved-p.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,22 @@ +# File: /admin/general-links/toggle-link-approved-p.tcl +# Date: 2/01/2000 +# Author: tzumainn@arsdigita.com +# +# Purpose: +# toggles approved_p of link +# +# toggle-link-approved-p.tcl,v 3.1 2000/03/09 00:22:20 tzumainn Exp +#-------------------------------------------------------- + +ad_page_variables {link_id {return_url "index.tcl"} approved_p} + +set current_user_id [ad_maybe_redirect_for_registration] + +set db [ns_db gethandle] + +ns_db dml $db "update general_links set approved_p = '$approved_p', last_approval_change = [db_sysdate], approval_change_by = $current_user_id where link_id = $link_id" + +ns_db releasehandle $db + +ns_returnredirect $return_url + Index: web/openacs/www/admin/general-links/view-associations.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/general-links/view-associations.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/general-links/view-associations.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,121 @@ +# File: /admin/general-links/view-associations.tcl +# Date: 2/01/2000 +# Author: tzumainn@arsdigita.com +# +# Purpose: +# view all associations of a specific link +# +# view-associations.tcl,v 3.1 2000/03/09 00:21:42 tzumainn Exp +#-------------------------------------------------------- + +ad_page_variables {link_id {approval_dimension_value "unexamined_only"}} + +set return_url "view-associations.tcl?link_id=$link_id&approval_dimension_value=$approval_dimension_value" + +if { $approval_dimension_value == "all" } { + set approval_widget "all | unexamined only | approved only | unapproved only" +} elseif { $approval_dimension_value == "approved_only" } { + # we're currently looking at approved + set approval_widget "all | unexamined only | approved only | unapproved only" +} elseif { $approval_dimension_value == "unapproved_only" } { + # we're currently looking at unapproved + set approval_widget "all | unexamined only | approved only | unapproved only" +} else { + # we're currently looking at unexamined + set approval_widget "all | unexamined only | approved only | unapproved only" +} + +if { $approval_dimension_value == "all" } { + set where_clause_for_approval "" +} elseif { $approval_dimension_value == "approved_only" } { + set where_clause_for_approval "and approved_p = 't'" +} elseif { $approval_dimension_value == "unapproved_only" } { + set where_clause_for_approval "and approved_p = 'f'" +} else { + set where_clause_for_approval "and approved_p is NULL" +} + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select url, link_title from general_links where link_id = $link_id"] + +page_validation { + if {[empty_string_p $selection]} { + error "Link $link_id is not a valid link id." + } +} + +set_variables_after_query + +ad_return_top_of_page "[ad_header "Link Associations for $url"] + +

    Link Associations for $url

    + +[ad_admin_context_bar [list "" "General Links"] "Link Associations for $url"] + +
    + +

    +" + +set selection [ns_db select $db "select + map_id, + on_which_table, + on_what_id, + one_line_item_desc, + slm.creation_time, + approved_p, + first_names || ' ' || last_name as linker_name +from site_wide_link_map slm, users +where slm.link_id = $link_id +and slm.creation_user = users.user_id +$where_clause_for_approval +order by on_which_table, slm.creation_time desc"] + +set assoc_html "" +set n_assoc 0 + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + incr n_assoc + + append assoc_html " + + +
    + $on_which_table: $on_what_id - $one_line_item_desc +

    -- Posted by $linker_name on [util_AnsiDatetoPrettyDate creation_time] +

    +     		+ " + + if { $approved_p == "f" } { + append assoc_html "approve\n
    \n" + } elseif { $approved_p == "t" } { + append assoc_html "reject\n
    \n" + } else { + append assoc_html "approve\n
    \n reject\n
    \n" + } + + append assoc_html " + delete association +
    \n + " +} + +if { $n_assoc == 0 } { + set assoc_html "

    • no associations
    " +} + +ns_write " +
      +
    • Link associations for $link_title ($url): +

      +$approval_widget +
      +

      $assoc_html +

    + +[ad_admin_footer] +" + Index: web/openacs/www/admin/glassroom/readme.txt =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/glassroom/readme.txt,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/glassroom/readme.txt 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,4 @@ +Regrettably, philg only had time to write the data model and +documentation for this module. So you'll have to hassle him to crank +out the .tcl scripts! + Index: web/openacs/www/admin/glossary/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/glossary/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/glossary/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,101 @@ +# index.tcl,v 3.0 2000/02/06 03:23:49 ron Exp +# +# /admin/glossary/index.tcl +# +# by jsc@arsdigita.com in February 1999 +# + +set user_id [ad_verify_and_get_user_id] +if { $user_id == 0 } { + ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode [ns_conn url]]" + return +} + + +ReturnHeaders +ns_write "[ad_admin_header "Terms Defined"] +

    Terms Defined

    +[ad_admin_context_bar Glossary] +
    +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select term +from glossary +where approved_p = 'f' +order by upper(term)"] + +set old_first_char "" +set count 0 +set pending_items "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + set first_char [string toupper [string index $term 0]] + if { [string compare $first_char $old_first_char] != 0 } { + if { $count > 0 } { + append pending_items "\n" + } + append pending_items "

    $first_char

    \n
      \n" + } + + append pending_items "
    • $term +\[ Approve \]\n" + + set old_first_char $first_char + incr count +} + +if { ![empty_string_p $pending_items] } { + ns_write "

      Pending Definitions

      +
        +$pending_items +
      +
    +" +} + +ns_write " + + + +

    Approved Definitions

    +
    +" + +set selection [ns_db select $db "select term +from glossary +where approved_p = 't' +order by upper(term)"] + +set old_first_char "" +set count 0 + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + set first_char [string toupper [string index $term 0]] + if { [string compare $first_char $old_first_char] != 0 } { + if { $count > 0 } { + ns_write "\n" + } + ns_write "

    $first_char

    \n
      \n" + } + + ns_write "
    • $term\n" + + set old_first_char $first_char + incr count +} + +ns_write "
    + +

    +Add a Term + +

    + +[ad_admin_footer] +" Index: web/openacs/www/admin/glossary/one.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/glossary/one.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/glossary/one.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,55 @@ +# one.tcl,v 3.0 2000/02/06 03:23:51 ron Exp +set user_id [ad_verify_and_get_user_id] +if { $user_id == 0 } { + ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode [ns_conn url]]" + return +} + +set_the_usual_form_variables +# term + +if { ![info exists term] || [empty_string_p $QQterm] } { + ad_return_complaint 1 "No term given" + return +} + +ReturnHeaders +ns_write "[ad_admin_header $term] + +

    $term

    + +[ad_admin_context_bar [list "index.tcl" Glossary] "One Term"] + +
    + +$term: +" + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select definition, approved_p from glossary where term = '$QQterm'"] + +if { $selection == "" } { + set definition "Not defined in glossary." + set approved_p 't' +} else { + set_variables_after_query +} + +ns_write " +
    $definition
    + + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/glossary/term-approve.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/glossary/term-approve.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/glossary/term-approve.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,46 @@ +# term-approve.tcl,v 3.0 2000/02/06 03:23:52 ron Exp +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set user_id [ad_verify_and_get_user_id] +if { $user_id == 0 } { + ns_returnredirect "/register/index.tcl" + return +} + +set_the_usual_form_variables + +# term + +set exception_count 0 +set exception_text "" + +set db [ns_db gethandle] + +if { ![info exists term] || [empty_string_p $QQterm]} { + incr exception_count + append exception_text "
  • You somehow got here without specifying a term to approve." +} + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + +if [catch { ns_db dml $db "update glossary +set approved_p = 't' +where term = '$QQterm'" } errmsg] { + # update failed + ad_return_error "Insert Failed" "The Database did not like what you typed. This is probably a bug in our code. Here's what the database said: +
    +
    +$errmsg
+
    +
    +" + return +} + +ns_returnredirect "index.tcl" Index: web/openacs/www/admin/glossary/term-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/glossary/term-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/glossary/term-delete.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,45 @@ +# term-delete.tcl,v 3.0 2000/02/06 03:23:53 ron Exp +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set user_id [ad_verify_and_get_user_id] +if { $user_id == 0 } { + ns_returnredirect "/register/index.tcl" + return +} + +set_the_usual_form_variables + +# term + +set exception_count 0 +set exception_text "" + +set db [ns_db gethandle] + +if { ![info exists term] || [empty_string_p $QQterm]} { + incr exception_count + append exception_text "
  • You somehow got here without specifying a term to delete." +} + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + +if [catch { ns_db dml $db "delete from glossary +where term = '$QQterm'" } errmsg] { + # update failed + ad_return_error "Delete Failed" "The Database did not like what you typed. This is probably a bug in our code. Here's what the database said: +
    +
    +$errmsg
+
    +
    +" + return +} + +ns_returnredirect "index.tcl" Index: web/openacs/www/admin/glossary/term-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/glossary/term-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/glossary/term-edit-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,44 @@ +# term-edit-2.tcl,v 3.0 2000/02/06 03:23:55 ron Exp +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + ns_returnredirect /register/index.tcl?return_url=[ns_urlencode [ns_conn url]]?term=$term +} + +set exception_count 0 +set exception_text "" + +set_the_usual_form_variables +# term, definition + +set db [ns_db gethandle] + + +if { ![info exists term] || [empty_string_p $QQterm] } { + incr exception_count + append exception_text "
  • No term to edit\n" +} else { + set author [database_to_tcl_string_or_null $db "select author + from glossary + where term = '$QQterm'"] + +} + +if { ![info exists definition] || [empty_string_p $QQdefinition] } { + incr exception_count + append exception_text "
  • No definition provided\n" +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +ns_db dml $db "update glossary set definition = '$QQdefinition' where term = '$QQterm'" + +ns_returnredirect "one.tcl?term=[ns_urlencode $term]" \ No newline at end of file Index: web/openacs/www/admin/glossary/term-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/glossary/term-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/glossary/term-edit.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,66 @@ +# term-edit.tcl,v 3.0 2000/02/06 03:23:56 ron Exp +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + ns_returnredirect /register/index.tcl?return_url=[ns_urlencode [ns_conn url]]?term=$term +} + +set exception_count 0 +set exception_text "" + +set_the_usual_form_variables +# term + +set db [ns_db gethandle] + +if { ![info exists term] || [empty_string_p $QQterm] } { + incr exception_count + append exception_text "
  • No term to edit\n" +} else { + set selection [ns_db 0or1row $db "select definition, author + from glossary + where term = '$QQterm'"] + + # In case of someone clicking on an old window + if [empty_string_p $selection] { + ns_db releasehandle $db + ns_returnredirect index.tcl + return + } + + set_variables_after_query +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +ReturnHeaders + +ns_write "[ad_admin_header "Edit Definition" ] + +

    Edit Definition

    +[ad_admin_context_bar [list "index.tcl" "Glossary"] Edit] +
    + +
    +Edit your definition for +

    +$term:
    +
    + +

    +

    + +
    +[export_form_vars term] +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/glossary/term-new-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/glossary/term-new-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/glossary/term-new-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,62 @@ +# term-new-2.tcl,v 3.0 2000/02/06 03:23:57 ron Exp +# display a confirmation page for new news postings + +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set user_id [ad_verify_and_get_user_id] +if { $user_id == 0 } { + ns_returnredirect "/register/index.tcl" + return +} + +set_the_usual_form_variables +# term, definition + +set exception_count 0 +set exception_text "" + +if { ![info exists term] || $QQterm == ""} { + incr exception_count + append exception_text "
  • Please enter a term to define." +} +if { ![info exists definition] || $QQdefinition == "" } { + incr exception_count + append exception_text "
  • Please enter a definition for the term." +} + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + + +ReturnHeaders + +ns_write "[ad_admin_header "Confirm"] + +

    Confirm

    + +your submission to the glossary for [ad_site_home_link] + +
    + +

    What viewers of your definition will see

    + +$term: +
    $definition
    +

    + +

    +[export_entire_form] +
    + +
    +
    + + +[ad_admin_footer]" + + Index: web/openacs/www/admin/glossary/term-new-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/glossary/term-new-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/glossary/term-new-3.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,57 @@ +# term-new-3.tcl,v 3.0 2000/02/06 03:23:59 ron Exp +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set user_id [ad_verify_and_get_user_id] +if { $user_id == 0 } { + ns_returnredirect "/register/index.tcl" + return +} + +set_the_usual_form_variables + +# term, definition + +set exception_count 0 +set exception_text "" + +set db [ns_db gethandle] + +if { ![info exists term] || [empty_string_p $QQterm]} { + incr exception_count + append exception_text "
  • You somehow got here without entering a term to define." +} +if { ![info exists definition] || [empty_string_p $QQdefinition] } { + incr exception_count + append exception_text "
  • You somehow got here without entering a definition." +} +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + + + +if [catch { ns_db dml $db "insert into glossary +(term, definition, author, approved_p, creation_date) +values +('$QQterm', '$QQdefinition', $user_id, 't', sysdate())" } errmsg] { + # insert failed; let's see if it was because of duplicate submission + if { [database_to_tcl_string $db "select count(*) from glossary where term = '$QQterm'"] == 0 } { + ns_log Error "/glossary/term-new-3.tcl choked: $errmsg" + ad_return_error "Insert Failed" "The Database did not like what you typed. This is probably a bug in our code. Here's what the database said: +
    +
    +$errmsg
+
    +
    +" + return + } + # we don't bother to handle the cases where there is a dupe submission + # because the user should be thanked or redirected anyway +} + +ns_returnredirect "index.tcl" Index: web/openacs/www/admin/glossary/term-new.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/glossary/term-new.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/glossary/term-new.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,37 @@ +# term-new.tcl,v 3.0 2000/02/06 03:24:00 ron Exp +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set user_id [ad_verify_and_get_user_id] +if { $user_id == 0 } { + ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode [ns_conn url]]" + return +} + +ReturnHeaders +ns_write "[ad_admin_header "Add a Term"] +

    Add a Term

    +to the glossary for [ad_site_home_link] +
    +" + +set db [ns_db gethandle] + +ns_write " +
    + + +
    Term +
    Definition +
    +
    +
    + +
    +
    +[ad_admin_footer] +" + + Index: web/openacs/www/admin/gp/comment-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gp/comment-toggle.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gp/comment-toggle.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,37 @@ +# comment-toggle.tcl,v 1.1.4.1 2000/02/03 09:29:43 ron Exp +# requires: permissions_id, user_id OR group_id +# optional: page_url, page_name, return_url (these are merely kept to save state) + +ad_page_variables { + permissions_id + {user_id {}} + {group_id {}} + {orderby {}} + {dim {}} +} + +set db [ns_db gethandle] + +if { [info exists user_id] && ![empty_string_p $user_id] } { + if { [empty_string_p $group_id] } { + ns_db dml $db "update permissions_ug_map + set comment_p = logical_negation(comment_p) + where user_id = $user_id + and permissions_id = $permissions_id" + } else { + ns_db dml $db "update permissions_ug_map + set comment_p = logical_negation(comment_p) + where user_id = $user_id + and group_id = $group_id + and permissions_id = $permissions_id" + } +} else { + ns_db dml $db "update permissions_ug_map + set comment_p = logical_negation(comment_p) + where group_id = $group_id + and permissions_id = $permissions_id" +} + +ns_returnredirect "index.tcl?[export_url_vars permissions_id orderby dim]" + + Index: web/openacs/www/admin/gp/find-group.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gp/find-group.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gp/find-group.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,53 @@ +# +# admin/gp/find-group.tcl +# mark@ciccarello.com +# February, 2000 +# + +set_the_usual_form_variables + +# +# expects: table_name, row_id +# + +ReturnHeaders + +set html "[ad_admin_header "General Permissions Administration" ] +

    General Permissions Administration

    +[ad_admin_context_bar { "index.tcl" "General Permissions"} "Find Group"] +
    +

    +Please select a user group on which to set permissions:

    +" + +set db [ns_db gethandle] + +set selection [ns_db select $db " + select + group_name, + group_id + from + user_groups + order by + group_name +"] + + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append html "$group_name
    " +} + +ns_db releasehandle $db + +append html [ad_admin_footer] + +ns_write $html + + + + + + + + Index: web/openacs/www/admin/gp/find-user.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gp/find-user.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gp/find-user.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,37 @@ +# +# find-user.tcl +# mark@ciccarello.com + + +set_the_usual_form_variables + +# +# expects: table_name, row_id +# + + +set html "[ad_admin_header "Edit Permissions for a User" ] +

    Add or Edit Permissions for a User

    +
    +

    +" + +set custom_title "Edit Permissions for User" +set target "/admin/gp/one-user.tcl" +set passthrough [list table_name row_id] + +append html "" +append html "

    Edit permissions for user:

    +
    +[export_form_vars passthrough custom_title target table_name row_id] + + + + +
    Email address:
    or by
    Last name:
    + +
    +[ad_admin_footer] +" + +ad_return_top_of_page $html Index: web/openacs/www/admin/gp/grant.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gp/grant.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gp/grant.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,38 @@ +# +# admin/gp/grant.tcl +# +# mark@ciccarello.com +# February 2000 +# +# grants a permission on a row to a user, or all users, or all registered users + +set_the_usual_form_variables + +# +# expects: permission_type, row_id, table_name, user_id, scope +# + + +set db [ns_db gethandle] + +if { $user_id != 0 } { + ns_db select $db "select grant_permission_to_user('$user_id', '$permission_type', '$row_id', '$table_name')" + set user_id_from_search $user_id + set redirection_url "one-user.tcl?[export_url_vars user_id_from_search table_name row_id]" +} else { + if { $scope == "all_users" } { + ns_db select $db "select grant_permission_to_all_users('$permission_type','$row_id', '$table_name')" + } else { + ns_db select $db "select grant_permission_to_reg_users('$permission_type','$row_id', '$table_name')" + } + set redirection_url "one-user.tcl?[export_url_vars table_name row_id scope]" +} + +ns_returnredirect $redirection_url + + + + + + + Index: web/openacs/www/admin/gp/group-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gp/group-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gp/group-add-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,69 @@ +# group-add-2.tcl,v 1.1.4.1 2000/02/03 09:29:45 ron Exp +# UI for selecting a particular role once a group has been selected + +ad_page_variables { + permissions_id + group_id + {orderby {}} + {dim {}} +} + +set db [ns_db gethandle] + +# first check to see if we need to do roles +set multi_role_p [database_to_tcl_string $db "select multi_role_p from user_groups + where group_id = $group_id"] + +if { $multi_role_p == "f" } { + ns_returnredirect "group-add-3.tcl?[export_url_vars permissions_id group_id orderby dim]" +} + +# first, check to see if the "all" role has been added +set null_role_p [database_to_tcl_string_or_null $db "select 1 from permissions_ug_map + where permissions_id = $permissions_id + and group_id = $group_id + and role is null"] + +# get all roles for a particular group that aren't in pum +set selection [ns_db select $db "select * from user_group_roles ugr + where group_id = $group_id + and not exists (select 1 from permissions_ug_map pum + where permissions_id = $permissions_id + and ugr.role = pum.role + and pum.group_id = $group_id)"] + +if { $selection == "" && $null_role_p == 1 } { + ns_returnredirect "group-add-3.tcl?[export_url_vars permissions_id group_id orderby dim]" +} + +# show the UI. we have roles we want the user to choose. + +set edit_perm_url edit-page-permissions.tcl?[export_url_vars permissions_id orderby dim] +set group_edit_url group-add.tcl?[export_url_vars permissions_id orderby dim] + +set navbar [ad_admin_context_bar [list "/admin/gp/" "General Permissions"] [list "/admin/gp/group-add.tcl?[export_url_vars permissions_id orderby dim]" "Add a Group"] "Choose a Role"] + +ReturnHeaders +ns_write " +[ad_header "Choose a Role"] + +

    Choose a Role

    +$navbar +
    +Choose a role: +
      +" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • $role" +} + +# if we want to give permissions to all roles, we don't pass role +if { $null_role_p == "" } { + ns_write "
    • all" +} + +ns_write " +
    +[ad_admin_footer]" Index: web/openacs/www/admin/gp/group-add-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gp/group-add-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gp/group-add-3.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,32 @@ +# group-add-3.tcl,v 1.1.4.1 2000/02/03 09:29:46 ron Exp +ad_page_variables { + permissions_id + group_id + {role {}} + {orderby {}} + {dim {}} +} + +set local_user_id [ad_verify_and_get_user_id] +set local_group_id [ad_get_group_id] +set db [ns_db gethandle] + +# check permissions +if { ![ad_g_owner_p $db $permissions_id $local_user_id $local_group_id] } { + ad_return_error "Unauthorized" "You are not authorized to edit the permissions for this page.

    " + return +} + +if { ![info exists role] || [empty_string_p $role] } { + ns_db dml $db "insert into permissions_ug_map + (permissions_id, group_id) + values + ($permissions_id, $group_id)" +} else { + ns_db dml $db "insert into permissions_ug_map + (permissions_id, group_id, role) + values + ($permissions_id, $group_id, '[DoubleApos $role]')" +} + +ns_returnredirect "index.tcl?[export_url_vars orderby dim]" Index: web/openacs/www/admin/gp/group-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gp/group-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gp/group-add.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,62 @@ +# group-add.tcl,v 1.1.4.1 2000/02/03 09:29:47 ron Exp +ad_page_variables { + permissions_id + {orderby {}} + {dim {}} +} + +set db [ns_db gethandle] + +set navbar [ad_admin_context_bar [list "/admin/gp/" "General Permissions"] "Add a Group"] + +ReturnHeaders + +ns_write " +[ad_header "Add a Group"] + +

    Add a Group

    +$navbar +
    +" + +set selection [ns_db select $db "select ug.group_id, ug.group_name, ugt.pretty_plural +from user_groups ug, user_group_types ugt +where ug.group_type = ugt.group_type +and existence_public_p = 't' +and approved_p = 't' +and exists + ((select role from user_group_roles ugr where ugr.group_id = ug.group_id union select null from dual) + EXCEPT + (select role from permissions_ug_map pum where pum.group_id = ug.group_id and permissions_id = $permissions_id)) +order by upper(ug.group_type)"] + +set count 0 +set last_pretty_plural "" + +set groups_list "Please choose a group to add:\n
      " + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + if { $last_pretty_plural != $pretty_plural } { + append groups_list "

      $pretty_plural

      \n" + set last_pretty_plural $pretty_plural + } + + append groups_list "
    • $group_name\n" + incr count +} + + + +if { $count == 0 } { + set groups_list "
      Sorry, no groups are available to be added.
      " +} else { + append groups_list "
    " +} + +ns_write " +$groups_list + +[ad_admin_footer] +" Index: web/openacs/www/admin/gp/group-grant.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gp/group-grant.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gp/group-grant.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,49 @@ +# +# admin/gp/group-grant.tcl +# +# mark@ciccarello.com +# February 2000 +# +# grants a permission on a row to a user, or all users + +set_the_usual_form_variables + +# +# expects: permission_type, row_id, table_name, group_id +# + +set db [ns_db gethandle] + + +if { $role == "" } { + set permission_id [database_to_tcl_string_or_null $db " + select + group_permission_id('$group_id','$permission_type','$row_id','$table_name') + from + dual" + ] + if { $permission_id == "0" } { + ns_db select $db "select grant_permission_to_group('$group_id', '$permission_type', '$row_id', '$table_name')" + } +} else { + set permission_id [database_to_tcl_string_or_null $db " + select + group_role_permission_id('$group_id','$role','$permission_type','$row_id','$table_name') + from + dual" + ] + if { $permission_id == "0" } { + ns_db select $db "select grant_permission_to_role('$group_id', '$role', '$permission_type','$row_id', '$table_name')" + } +} + + +ns_returnredirect "one-group.tcl?[export_url_vars group_id table_name row_id]" + + + + + + + + Index: web/openacs/www/admin/gp/group-remove.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gp/group-remove.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gp/group-remove.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,20 @@ +# +# admin/gp/group-remove.tcl +# +# mark@ciccarello.com +# February 2000 +# +# removes a permission on a row for a user group + +set_the_usual_form_variables + +# +# expects: permission_id, row_id, table_name, group_id +# + +set db [ns_db gethandle] + +ns_db select $db "select revoke_permission('$permission_id')" + +ns_returnredirect "one-group.tcl?[export_url_vars group_id table_name row_id]" + Index: web/openacs/www/admin/gp/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gp/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gp/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,45 @@ +# +# /admin/gp/index.tcl +# +# markc@ciccarello.com +# February 2000 +# + +ReturnHeaders + + +set whole_page "[ad_admin_header "General Permissions Administration"] +

    General Permissions Administration

    +[ad_admin_context_bar "General Permissions"] +
    +

    +Please select an object type on which to administer permissions: +

      +" + + +set db [ns_db gethandle] + +set selection [ns_db select $db " + select + table_name, + pretty_table_name_plural + from + general_table_metadata + order by + pretty_table_name_plural +"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append whole_page "
    • $pretty_table_name_plural
      • " +} + + +append whole_page " +
    +[ad_admin_footer]" + +ns_db releasehandle $db +ns_write $whole_page + Index: web/openacs/www/admin/gp/one-group.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gp/one-group.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gp/one-group.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,138 @@ +# +# one-group.tcl +# mark@ciccarello.com +# February 2000 +# allows editing of the permissions held by a user group on a single db row +# + + +ad_page_variables { + table_name + row_id + group_id +} + +# +# expects: table_name, row_id, group_id +# + +set db [ns_db gethandle] + +set group_name [database_to_tcl_string $db " + select + group_name + from + user_groups + where + group_id = $group_id +"] + + + +set html "[ad_admin_header "Edit Group Permissions on $table_name" ] + +

    General Permissions Administration for $table_name

    +[ad_admin_context_bar [list "index.tcl" "General Permissions"] [list "one-row.tcl?[export_url_vars table_name row_id]" "One Row"] "One Group"] +
    +back +

    +" + +# +# get the group's existing permissions +# + +set selection [ns_db select $db " + select + permission_id, + permission_type, + role + from + general_permissions + where + on_what_id = '$row_id' and + lower(on_which_table) = '[string tolower $table_name]' and + group_id = $group_id + order by + role, + permission_type +"] + +append html "

    Existing Record Permissions

    +(click to remove) + +" +set n_permissions 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $n_permissions % 2 } { + set bgcolor "#FFFFFF" + } else { + set bgcolor "#DDDDDD" + } + if { $role == "" } { + set role "-- any --" + } + append html "" + incr n_permissions +} +if { $n_permissions == 0 } { + append html "" + +# +# get a list of legal permission types and render them as select options +# + +set permission_type_list [database_to_tcl_list $db " + select + permission_type + from + general_permission_types + where + lower(table_name) = '[string tolower $table_name]' + order by + permission_type +"] + +set permission_options "" +foreach permission_type $permission_type_list { + append permission_options "" +} + +# +# get a list of roles and render them as select options as well. +# +# + +set role_list [database_to_tcl_list $db " + select distinct + role + from + user_group_map +"] + +set role_options "" +foreach role $role_list { + append role_options "" +} + + +append html "

    Add Permission

    + +[export_form_vars row_id table_name group_id] +
    RolePermission
    $role$permission_type
    none
    + + + + + + + +
    Role:
    Permission:
    + + +[ad_admin_footer]" + +ns_return 200 text/html $html Index: web/openacs/www/admin/gp/one-row.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gp/one-row.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gp/one-row.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,301 @@ +# +# admin/gp/one-row.tcl +# mark@ciccarello.com +# February, 2000 +# + + +ad_page_variables { + table_name + row_id +} + +ReturnHeaders + +set db [ns_db gethandle] + +set selection [ns_db 1row $db " + select + pretty_table_name_singular, + pretty_table_name_plural, + denorm_view_name, + lower(id_column_name) as id_column_name + from + general_table_metadata + where + upper(table_name) = '[string toupper $table_name]' +"] + +set_variables_after_query + +ns_write "[ad_admin_header "General Permissions Administration for $pretty_table_name_plural" ] +

    General Permissions Administration for $pretty_table_name_plural

    +[ad_admin_context_bar [list "index.tcl" "General Permissions"] [list "one-table.tcl?[export_url_vars table_name]" $table_name] "One Row"] +
    +

    +" + +# +# get the list of displayable columns +# + +set selection [ns_db select $db " + select + column_pretty_name, + column_name, + is_date_p + from + table_metadata_denorm_columns + where + upper(table_name) = '[string toupper $table_name]' + order by + display_ordinal +"] + +set column_list "" +set column_name_list "" +while { [ns_db getrow $db $selection] } { + set_variables_after_query + lappend column_list [list $column_pretty_name $column_name $is_date_p] + lappend column_name_list $column_name +} + + +set selection [ns_db select $db "select [join $column_name_list ","] from $denorm_view_name where $id_column_name = '$row_id'"] + +append html " + +

    Database Row

    +" + +set n 0 + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $n % 2 } { + set bgcolor "#FFFFFF" + } else { + set bgcolor "#CCCCCC" + } + append html "" + foreach column $column_list { + set column_name [lindex $column 1] + upvar 0 $column_name column_value + append html "" + } + append html "" + incr n +} +append html "
    [lindex $column 0]:$column_value
    " + + +# select +# permission_id, +# scope, +# general_permissions.user_id, +# first_names || ' ' || last_name as user_name, +# general_permissions.group_id, +# group_name, +# role, +# permission_type +# from +# general_permissions, +# users, +# user_groups +# where +# general_permissions.user_id = users.user_id(+) and +# general_permissions.group_id = user_groups.group_id(+) and +# on_what_id = '$row_id' and +# lower(on_which_table) = '[string tolower $table_name]' +# order by +# scope, +# group_name, +# user_name, +# role + + +# +# show existing permissions +# + +set selection [ns_db select $db " + select + permission_id, + scope, + general_permissions.user_id, + first_names || ' ' || last_name as user_name, + general_permissions.group_id, + group_name, + role, + permission_type + from + general_permissions, + users, + user_groups + where + general_permissions.user_id = users.user_id and + general_permissions.group_id = user_groups.group_id and + on_what_id = '$row_id' and + lower(on_which_table) = '[string tolower $table_name]' + union + select + permission_id, + scope, + general_permissions.user_id, + first_names || ' ' || last_name as user_name, + general_permissions.group_id, + '' as group_name, + role, + permission_type + from + general_permissions, + users, + user_groups + where + general_permissions.user_id = users.user_id and + not exists (select 1 from user_groups + where group_id = general_permissions.group_id) and + on_what_id = '$row_id' and + lower(on_which_table) = '[string tolower $table_name]' + union + select + permission_id, + scope, + general_permissions.user_id, + '' as user_name, + general_permissions.group_id, + group_name, + role, + permission_type + from + general_permissions, + users, + user_groups + where + not exists (select 1 from users + where user_id = general_permissions.user_id) and + general_permissions.group_id = user_groups.group_id and + on_what_id = '$row_id' and + lower(on_which_table) = '[string tolower $table_name]' + union + select + permission_id, + scope, + general_permissions.user_id, + '' as user_name, + general_permissions.group_id, + '' as group_name, + role, + permission_type + from + general_permissions, + users, + user_groups + where + not exists (select 1 from users + where user_id = general_permissions.user_id) and + not exists (select 1 from user_groups + where group_id = general_permissions.group_id) and + on_what_id = '$row_id' and + lower(on_which_table) = '[string tolower $table_name]' + order by + scope, + group_name, + user_name, + role +"] + +append html "

    Existing Permissions

    + +" +set permission_count 0 +while {[ns_db getrow $db $selection]} { + set_variables_after_query + if { $user_id != "" } { + set user_id_from_search $user_id + set name "User: $user_name" + } elseif { $group_id != "" } { + set name "Group: $group_name" + if { $role == "" } { + set role "(any)" + } + } else { + if { $scope == "all_users" } { + set name "All Users" + } elseif { $scope == "registered_users" } { + set name "Registered Users" + } + } + if { $permission_count % 2 } { + set bgcolor "#FFFFFF" + } else { + set bgcolor "#DDDDDD" + } + append html "" + incr permission_count +} + + +append html "
    User/GroupRolePermission Type
    $name$role$permission_type
    +

    Add a new permission

    +[ad_admin_footer]" + +ns_db releasehandle $db + +ns_write $html + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Index: web/openacs/www/admin/gp/one-table.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gp/one-table.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gp/one-table.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,237 @@ +# +# admin/gp/one-table.tcl +# mark@ciccarello.com +# February 2000 +# +set_the_usual_form_variables + +# +# expected: table_name, rownum (optional) +# + +set rows_per_page 50 + +ReturnHeaders + + +set db [ns_db gethandle] + +set row_count [database_to_tcl_string $db "select count(*) from $table_name"]; + +set selection [ns_db 1row $db " + select + pretty_table_name_singular, + pretty_table_name_plural, + denorm_view_name, + lower(id_column_name) as id_column_name + from + general_table_metadata + where + upper(table_name) = '[string toupper $table_name]' +"] + +set_variables_after_query + + +set html "[ad_admin_header "General Permissions Administration for $pretty_table_name_plural" ] +

    General Permissions Administration for $pretty_table_name_plural

    +[ad_admin_context_bar { "index.tcl" "General Permissions"} "One Table"] +
    +" + + + +# +# get the list of displayable columns +# + + +set selection [ns_db select $db " + select + column_pretty_name, + column_name, + is_date_p, + use_as_link_p + from + table_metadata_denorm_columns + where + upper(table_name) = '[string toupper $table_name]' + order by + display_ordinal +"] + +set column_list "" +set column_name_list "" +while { [ns_db getrow $db $selection] } { + set_variables_after_query + lappend column_list [list $column_pretty_name $column_name $is_date_p $use_as_link_p] + lappend column_name_list $column_name +} + + +# +# start at record one if not specified +# + +if { [info exists rownum] } { + set rownum_first_this_page $rownum +} else { + set rownum_first_this_page 1 +} + +# +# make sure the starting row isn't too high +# + +if { $rownum_first_this_page >= $row_count } { + set rownum_first_this_page [expr $row_count - $rows_per_page] + if { $rownum_first_this_page < 1 } { + set rownum_first_this_page 1 + } +} + +# +# figure out the last row number on this page +# + +set rownum_last_this_page [expr $rownum_first_this_page + $rows_per_page - 1] +if { $rownum_last_this_page > $row_count } { + set rownum_last_this_page [expr $row_count] +} +if { $rownum_last_this_page < $rownum_first_this_page } { + + set rownum_last_this_page $rownum_first_this_page +} + +# +# and the first on the next page, "" if there is no next page +# + +set rownum_first_next_page [expr $rownum_last_this_page + 1] +if { $rownum_first_next_page > $row_count } { + set rownum_first_next_page "" +} + + +# +# finally the starting row number of the previous page, "" if no previous +# + + +if { $rownum_first_this_page == "1" } { + set rownum_first_previous_page "" +} else { + set rownum_first_previous_page [expr $rownum_first_this_page - $rows_per_page] + if { $rownum_first_previous_page < 1 } { + set rownum_first_previous_page 1 + } +} + +if { $row_count > $rows_per_page } { + set to_row_num 1 + set to_page_num 1 + append html "
    " + if { $rownum_first_previous_page != "" } { + append html "\[prev\]" + } else { + append html "\[prev\]" + } + + while { $to_row_num <= $row_count } { + if { $to_row_num != $rownum_first_this_page } { + append html " $to_page_num" + } else { + append html " $to_page_num" + } + incr to_page_num + incr to_row_num $rows_per_page + } + + if { $rownum_first_next_page != "" } { + append html " \[next\]" + } else { + append html " \[next\]" + } + +} + + + +append html " +

    There are $row_count $pretty_table_name_plural. Here are $rownum_first_this_page to $rownum_last_this_page. +" + +# set selection [ns_db select $db " +# select * from ( +# select +# [join $column_name_list ","], +# rownum as row_number +# from +# $denorm_view_name +# ) +# where +# row_number >= $rownum_first_this_page and row_number <= $rownum_last_this_page +# "] + +set selection [ns_db select $db " + select [join $column_name_list ","] + from $denorm_view_name + limit [expr $rownum_last_this_page - $rownum_first_this_page + 1] + offset $rownum_first_this_page +"] + +# go ahead and flush the output so far so the user doesn't have to wait to see something +ns_write $html + +set html " + + +" + +# generate column headers + +foreach column $column_list { + append html "" +} + +append html "" + +set n 0 + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $n % 2 } { + set bgcolor "#FFFFFF" + } else { + set bgcolor "#CCCCCC" + } + append html "" + foreach column $column_list { + set column_name [lindex $column 1] + upvar 0 $column_name column_value + if { [lindex $column 3] == "t" } { + upvar 0 $id_column_name row_id + append html "" + } else { + append html "" + } + } + append html "" + incr n +} + +append html " +
    [lindex $column 0]
    $column_value$column_value
    + +[ad_admin_footer]" + +ns_db releasehandle $db +ns_write $html + + + + + + + + Index: web/openacs/www/admin/gp/one-user.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gp/one-user.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gp/one-user.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,122 @@ +# +# one-user.tcl +# mark@ciccarello.com +# +# allows editing of the permissions held by a single user on a single db row +# or of the permissions held by all users, or all registered users +# + +set_the_usual_form_variables + +# +# expects: table_name, row_id, and either +# user_id_from_search (for a single user) or scope (for all users or all registered users) +# + +set db [ns_db gethandle] + +if {![info exists scope]} { + set scope "" +} + + +if { [info exists user_id_from_search] } { + set selection [ns_db 1row $db " + select + user_id, + first_names || ' ' || last_name as user_name + from + users + where + user_id = $user_id_from_search + "] + set_variables_after_query + set menu_item "One User" +} elseif { $scope == "all_users" } { + set user_id 0 + set user_name "all users" + set menu_item "All Users" +} else { + set user_id 0 + set user_name "registered users" + set menu_item "Registered Users" +} + + +set html "[ad_admin_header "Edit Permissions for $user_name on $table_name $row_id" ] +

    Add or Edit Permissions for $user_name on $table_name $row_id

    +[ad_admin_context_bar [list "index.tcl" "General Permissions"] [list "one-table.tcl?[export_url_vars table_name]" $table_name] [list "one-row.tcl?[export_url_vars table_name row_id]" "One Row"] $menu_item] +
    +

    +" + +# +# get the user's existing permissions +# + +if { $user_id != 0 } { + set user_or_scope_clause "user_id = $user_id" +} else { + set user_or_scope_clause "scope = '$scope'" +} + +set selection [ns_db select $db " + select + permission_id, + permission_type + from + general_permissions + where + on_what_id = '$row_id' and + lower(on_which_table) = '[string tolower $table_name]' and + $user_or_scope_clause + order by + permission_type +"] + +append html "

    Existing Record Permissions

    +(click to remove) +
      " +set granted_permission_types "" +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append html "
    • $permission_type
      • " + lappend granted_permission_types $permission_type +} +if { $granted_permission_types == "" } { + append html "
    • none
      • " +} +append html "
    " + +append html "

    Available Permissions

    +(click to grant) +
      " + +set selection [ns_db select $db " + select + permission_type + from + general_permission_types + where + lower(table_name) = '[string tolower $table_name]' +"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + set granted_p "f" + foreach granted_permission_type $granted_permission_types { + if { $permission_type == $granted_permission_type } { + set granted_p "t" + } + } + if { $granted_p == "f" } { + append html "
    • $permission_type" + } +} + +append html "
    +[ad_admin_footer]" + +ns_return 200 text/html $html + + Index: web/openacs/www/admin/gp/owner-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gp/owner-toggle.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gp/owner-toggle.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,37 @@ +# owner-toggle.tcl,v 1.1.4.1 2000/02/03 09:29:50 ron Exp +# requires: permissions_id, user_id OR group_id +# optional: page_url, page_name, return_url (these are merely kept to save state) + +ad_page_variables { + permissions_id + {user_id {}} + {group_id {}} + {orderby {}} + {dim {}} +} + +set db [ns_db gethandle] + +if { [info exists user_id] && ![empty_string_p $user_id] } { + if { [empty_string_p $group_id] } { + ns_db dml $db "update permissions_ug_map + set owner_p = logical_negation(owner_p) + where user_id = $user_id + and permissions_id = $permissions_id" + } else { + ns_db dml $db "update permissions_ug_map + set owner_p = logical_negation(owner_p) + where user_id = $user_id + and group_id = $group_id + and permissions_id = $permissions_id" + } +} else { + ns_db dml $db "update permissions_ug_map + set owner_p = logical_negation(owner_p) + where group_id = $group_id + and permissions_id = $permissions_id" +} + +ns_returnredirect "index.tcl?[export_url_vars permissions_id orderby dim]" + + Index: web/openacs/www/admin/gp/public-comment-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gp/public-comment-toggle.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gp/public-comment-toggle.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,17 @@ +# public-comment-toggle.tcl,v 1.1.4.1 2000/02/03 09:29:51 ron Exp +# requires: permissions_id +# optional: page_url, page_name, return_url, return_name + +ad_page_variables { + permissions_id + {orderby {}} + {dim {}} +} + +set db [ns_db gethandle] + +ns_db dml $db "update general_permissions + set public_comment_p = logical_negation(public_comment_p) + where permissions_id = $permissions_id" + +ns_returnredirect index.tcl?[export_url_vars orderby dim] \ No newline at end of file Index: web/openacs/www/admin/gp/public-read-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gp/public-read-toggle.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gp/public-read-toggle.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,19 @@ +# public-read-toggle.tcl,v 1.1.4.1 2000/02/03 09:29:53 ron Exp +# requires: permissions_id +# optional: page_url, page_name, return_url, return_name + +ad_page_variables { + permissions_id + {orderby {}} + {dim {}} +} + +set db [ns_db gethandle] + +ns_db dml $db "update general_permissions + set public_read_p = logical_negation(public_read_p) + where permissions_id = $permissions_id" + +ns_returnredirect index.tcl?[export_url_vars orderby dim] + + Index: web/openacs/www/admin/gp/public-write-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gp/public-write-toggle.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gp/public-write-toggle.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,17 @@ +# public-write-toggle.tcl,v 1.1.4.1 2000/02/03 09:29:54 ron Exp +# requires: permissions_id +# optional: page_url, page_name, return_url, return_name + +ad_page_variables { + permissions_id + {orderby {}} + {dim {}} +} + +set db [ns_db gethandle] + +ns_db dml $db "update general_permissions + set public_write_p = logical_negation(public_write_p) + where permissions_id = $permissions_id" + +ns_returnredirect index.tcl?[export_url_vars orderby dim] Index: web/openacs/www/admin/gp/read-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gp/read-toggle.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gp/read-toggle.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,37 @@ +# read-toggle.tcl,v 1.1.4.1 2000/02/03 09:29:56 ron Exp +# requires: permissions_id, user_id OR group_id +# optional: page_url, page_name, return_url (these are merely kept to save state) + +ad_page_variables { + permissions_id + {user_id {}} + {group_id {}} + {orderby {}} + {dim {}} +} + +set db [ns_db gethandle] + +if { [info exists user_id] && ![empty_string_p $user_id] } { + if { [empty_string_p $group_id] } { + ns_db dml $db "update permissions_ug_map + set read_p = logical_negation(read_p) + where user_id = $user_id + and permissions_id = $permissions_id" + } else { + ns_db dml $db "update permissions_ug_map + set read_p = logical_negation(read_p) + where user_id = $user_id + and group_id = $group_id + and permissions_id = $permissions_id" + } +} else { + ns_db dml $db "update permissions_ug_map + set read_p = logical_negation(read_p) + where group_id = $group_id + and permissions_id = $permissions_id" +} + +ns_returnredirect "index.tcl?[export_url_vars permissions_id orderby dim]" + + Index: web/openacs/www/admin/gp/remove-ug.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gp/remove-ug.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gp/remove-ug.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,27 @@ +# remove-ug.tcl,v 1.1.4.1 2000/02/03 09:29:57 ron Exp +# requires: permissions_id + +ad_page_variables { + permissions_id + {user_id {}} + {group_id {}} + {orderby {}} + {dim {}} +} + +set db [ns_db gethandle] + +if { $user_id != 0 && ![empty_string_p $user_id] } { + ns_db dml $db "delete from permissions_ug_map + where user_id = $user_id + and permissions_id = $permissions_id" +} + +if { $group_id != 0 && ![empty_string_p $group_id] } { + ns_db dml $db "delete from permissions_ug_map + where group_id = $group_id + and user_id is null + and permissions_id = $permissions_id" +} + +ns_returnredirect "index.tcl?[export_url_vars permissions_id orderby dim]" \ No newline at end of file Index: web/openacs/www/admin/gp/remove.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gp/remove.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gp/remove.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,27 @@ +# +# admin/gp/remove.tcl +# +# mark@ciccarello.com +# February 2000 +# +# removes a permission from a user, or all users + +set_the_usual_form_variables + +# +# expects: permission_id, row_id, table_name, user_id, scope +# + +set db [ns_db gethandle] + +ns_db select $db "select revoke_permission('$permission_id')" + +if { $user_id != 0 } { + set redirection_url "one-user.tcl?[export_url_vars user_id_from_search table_name row_id]" +} else { + set redirection_url "one-user.tcl?[export_url_vars table_name row_id scope]" +} + +ns_returnredirect $redirection_url + + Index: web/openacs/www/admin/gp/search.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gp/search.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gp/search.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,107 @@ +# search.tcl,v 1.1.4.1 2000/02/03 09:29:58 ron Exp +# (stolen from admin/users/search.tcl) + +# Reusable page for searching for a user by email or last_name. +# Returns to "target" with user_id_from_search, first_names_from_search, +# last_name_from_search, and email_from_search, and passing along all +# form variables listed in "passthrough". + +set_the_usual_form_variables + +# email or last_name (search strings) +# also accept "keyword" (for looking through both) +# target (URL to return to) +# passthrough (form variables to pass along from caller) + + +# Check input. +set exception_count 0 +set exception_text "" + +# from one of the user pages +if { (![info exists email] || $email == "") && (![info exists last_name] || $last_name == "") } { + incr exception_count + append exception_text "
  • You must specify either an email address or last name to search for.\n" +} + +if { [info exists email] && [info exists last_name] && $email != "" && $last_name != "" } { + incr exception_count + append exception_text "
  • You can only specify either email or last name, not both.\n" +} + +if { ![info exists target] || $target == "" } { + incr exception_count + append exception_text "
  • Target was not specified. This shouldn't have happened, + please contact the administrator + and let them know what happened.\n" +} + +if { $exception_count != 00 } { + ad_return_complaint $exception_count $exception_text + return +} + +if { [info exists keyword] } { + set search_clause "lower(email) like '%[string tolower $keyword]%' or lower(first_names || ' ' || last_name) like '%[string tolower $keyword]%'" + set search_text "name or email matching \"$keyword\"" +} elseif { [info exists email] && $email != "" } { + set search_text "email \"$email\"" + set search_clause "lower(email) like '%[string tolower $email]%'" +} else { + set search_text "last name \"$last_name\"" + set search_clause "lower(last_name) like '%[string tolower $last_name]%'" +} + +if { ![info exists passthrough] } { + set passthrough_parameters "" +} else { + set passthrough_parameters "&[export_entire_form_as_url_vars $passthrough]" +} + +# append some sql to remove users already in this permission record +append search_clause " and not exists (select 1 from permissions_ug_map + where permissions_id = $permissions_id + and users.user_id = permissions_ug_map.user_id)" + + +set db [ns_db gethandle] +set selection [ns_db select $db "select user_id as user_id_from_search, + first_names as first_names_from_search, last_name as last_name_from_search, + email as email_from_search, user_state +from users +where $search_clause"] + +ReturnHeaders + +ns_write "[ad_admin_header "User Search"] +

    User Search

    +for $search_text +
    +
      +" + +set i 0 + +set user_items "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + append user_items "
    • $first_names_from_search $last_name_from_search ($email_from_search)\n" + incr i + if { $user_state != "authorized" } { + set user_finite_state_links [ad_registration_finite_state_machine_admin_links $user_state $user_id_from_search] + append user_items "$user_state [join $user_finite_state_links " | "] \n" + } +} + +if { $i == 0 } { + ns_write "
    • No users found that can be added to this permissions record.\n" +} else { + ns_write $user_items +} + +ns_write "
    +[ad_admin_footer] +" + Index: web/openacs/www/admin/gp/user-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gp/user-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gp/user-add-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,40 @@ +# user-add-2.tcl,v 1.1.4.1 2000/02/03 09:30:02 ron Exp +# requires: users_to_be_added, permissions_id +# optional: return_url, page_url, page_name + +ad_page_variables { + permissions_id + {orderby {}} + {dim {}} + {user_id_from_search {}} + {first_names_from_search {}} + {last_name_from_search {}} + {email_from_search {}} +} + +set db [ns_db gethandle] + +if { [info exists user_id_from_search] && ![empty_string_p $user_id_from_search] } { + ns_db dml $db "insert into permissions_ug_map + (permissions_id, user_id) + values + ($permissions_id, $user_id_from_search)" +} else { + set add_users_list [util_GetCheckboxValues [ns_conn form] users_to_be_added] + + if {[llength $add_users_list] > 0 && $add_users_list != 0} { + ns_db dml $db "begin transaction" + + foreach user_id $add_users_list { + ns_db dml $db "insert into permissions_ug_map + (permissions_id, user_id) + values + ($permissions_id, $user_id)" + } + + ns_db dml $db "end transaction" + } +} + +ns_returnredirect "index.tcl?[export_url_vars orderby dim]" + Index: web/openacs/www/admin/gp/user-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gp/user-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gp/user-add.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,111 @@ +# user-add.tcl,v 1.1.4.1 2000/02/03 09:30:07 ron Exp +# requires: permissions_id +# optional: page_url, page_name, return_url + +ad_page_variables { + permissions_id + {orderby {}} + {dim {}} +} + +set db [ns_db gethandle] + +set count 0 + +if { [ad_parameter ShowUsersP gp] } { + + set user_list_info " + + + + + + " + + set selection [ns_db select $db "select users.user_id, first_names, last_name, email + from users + where not exists + (select 1 from permissions_ug_map + where permissions_id = $permissions_id + and users.user_id = permissions_ug_map.user_id) + order by last_name, first_names"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + append user_list_info " + + + + + " + + incr count + } + +} + +set navbar [ad_admin_context_bar [list "/admin/gp/" "General Permissions"] "Add a User"] + +ReturnHeaders + +ns_write " +[ad_header "Add a User"] + +

    Add a User

    +$navbar +
    + +" + +if { [ad_parameter ShowUsersP gp] } { + if { $count == 0 } { + + ns_write " + No users are available to be added. + " + + } else { + + append user_list_info "
    UserEmail
    $last_name, $first_names$email
    " + + ns_write " +
    + + [export_entire_form] + + + $user_list_info + +

    + + + + +

    + " + } +} + +ns_write " + +
    +[export_entire_form] + + + + + + +
    Email address:
    or by
    Last name:
    + + +

    + +

    + +
    +
    + + +[ad_admin_footer] +" Index: web/openacs/www/admin/gp/write-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/gp/write-toggle.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/gp/write-toggle.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,35 @@ +# write-toggle.tcl,v 1.1.4.1 2000/02/03 09:30:10 ron Exp +# requires: permissions_id, user_id OR group_id +# optional: page_url, page_name, return_url (these are merely kept to save state) + +ad_page_variables { + permissions_id + {user_id {}} + {group_id {}} + {orderby {}} + {dim {}} +} + +set db [ns_db gethandle] + +if { [info exists user_id] && ![empty_string_p $user_id] } { + if { [empty_string_p $group_id] } { + ns_db dml $db "update permissions_ug_map + set write_p = logical_negation(write_p) + where user_id = $user_id + and permissions_id = $permissions_id" + } else { + ns_db dml $db "update permissions_ug_map + set write_p = logical_negation(write_p) + where user_id = $user_id + and group_id = $group_id + and permissions_id = $permissions_id" + } +} else { + ns_db dml $db "update permissions_ug_map + set write_p = logical_negation(write_p) + where group_id = $group_id + and permissions_id = $permissions_id" +} + +ns_returnredirect "index.tcl?[export_url_vars permissions_id orderby dim]" Index: web/openacs/www/admin/intranet/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/intranet/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/intranet/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,16 @@ +# index.tcl,v 3.0 2000/02/06 03:24:22 ron Exp +ReturnHeaders + +ns_write " +[ad_admin_header "Intranet administration"] +

    Intranet administration

    +[ad_context_bar_ws [list ../index.tcl "Admin Home"] "Intranet administration"] +
    + + + +[ad_admin_footer] +" Index: web/openacs/www/admin/links/blacklist-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/links/blacklist-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/links/blacklist-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,103 @@ +# blacklist-2.tcl,v 3.1 2000/02/29 04:39:33 jsc Exp +set admin_id [ad_verify_and_get_user_id] + +if { $admin_id == 0 } { + ns_returnredirect "/register/" + return +} + +# we know who the administrator is + +set_the_usual_form_variables + +# relevant_page_id, glob_pattern + +set db_conns [ns_db gethandle [philg_server_default_pool] 2] +set db [lindex $db_conns 0] +set db_sub [lindex $db_conns 1] + +if { $page_id == "*" } { + set complete_page_id "NULL" + set pretty_page_id "everywhere" +} else { + set url_stub [database_to_tcl_string $db "select url_stub from static_pages where page_id = $page_id"] + set complete_page_id $page_id + set pretty_page_id "from $url_stub" +} + +ReturnHeaders + +ns_write "[ad_admin_header "Blacklisting $glob_pattern"] + +

    Blacklisting $glob_pattern

    + +from the links in [ad_system_name] + +
    + +
      + +
    • Step 1: Inserting \"$glob_pattern\" into the table of kill patterns (relevant pages: $pretty_page_id) ..." + +set insert_sql "insert into link_kill_patterns +(page_id, user_id, date_added, glob_pattern) +values +($complete_page_id, $admin_id, sysdate(), '$QQglob_pattern')" + +ns_db dml $db $insert_sql + +ns_write "DONE + +
    • Step 2: Searching through the database to find links that match +this kill pattern. If you've asked for a blacklist everywhere, this +could take a long time.... +
        " + +if { $page_id == "*" } { + set search_sql "select oid as rowid,url +from links" +} else { + set search_sql "select oid as rowid,url +from links +where page_id = $page_id" +} + +set selection [ns_db select $db $search_sql] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + if { [string match $glob_pattern $url] } { + # it matches, kill it + # subquery for some info about what we're killing; do it with + # correlation names so that we don't clobber existing variables + set sub_selection [ns_db 1row $db_sub "select + links.url as killed_url, + links.link_title as killed_title, + links.posting_time as killed_posting_time, + links.originating_ip as killed_ip, + sp.url_stub as killed_url_stub, + users.user_id as killed_user_id, + users.first_names as killed_first_names, + users.last_name as killed_last_name +from links, static_pages sp, users +where links.page_id = sp.page_id +and links.user_id = users.user_id +and links.oid='$rowid'"] + set_variables_after_subquery + ns_db dml $db_sub "delete from links where oid='$rowid'" + set item "
      • Deleted $killed_url ($killed_title) from $killed_url_stub, originally posted by $killed_first_names $killed_last_name\n" + if ![empty_string_p $killed_ip] { + append item "from $killed_ip" + } + ns_write "$item\n" + } +} + +ns_write "
      +

      +

    + +Done. + +[ad_admin_footer] +" Index: web/openacs/www/admin/links/blacklist-all.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/links/blacklist-all.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/links/blacklist-all.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,59 @@ +# blacklist-all.tcl,v 3.0 2000/02/06 03:24:25 ron Exp +set db [ns_db gethandle] + +ReturnHeaders + +ns_write "[ad_admin_header "The Blacklist"] + +

    The Blacklist

    + +[ad_admin_context_bar [list "index.tcl" "Links"] "Spam Blacklist"] + +
    +
      + +" + +# we go through all the patterns, joining with static_pages (where possible; +# site-wide kill patterns have NULL for page_id) and users table (to see +# which administrator added the pattern) + +set selection [ns_db select $db " +select lkp.oid as rowid, lkp.page_id, lkp.date_added, lkp.glob_pattern, sp.url_stub, users.user_id, users.first_names, users.last_name +from link_kill_patterns lkp, static_pages sp, users +where lkp.page_id = sp.page_id +and lkp.user_id = users.user_id +union +select lkp.oid as rowid, lkp.page_id, lkp.date_added, lkp.glob_pattern, null as url_stub, users.user_id, users.first_names, users.last_name +from link_kill_patterns lkp, users +where not exists (select * from static_pages sp + where lkp.page_id = sp.page_id) +and lkp.user_id = users.user_id +order by url_stub"] + +set items "" +while {[ns_db getrow $db $selection]} { + set_variables_after_query + if ![empty_string_p $url_stub] { + set scope_description "for $url_stub" + } else { + set scope_description "for this entire site" + } + append items "
    • $scope_description: $glob_pattern \[REMOVE\]" + +} + +if ![empty_string_p $items] { + ns_write $items +} else { + ns_write "No kill patterns in the database.\n" +} + +ns_write "
    + +
    + +
    philg@mit.edu
    + + +" Index: web/openacs/www/admin/links/blacklist-remove.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/links/blacklist-remove.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/links/blacklist-remove.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,17 @@ +# blacklist-remove.tcl,v 3.0 2000/02/06 03:24:26 ron Exp +set admin_id [ad_verify_and_get_user_id] + +if { $admin_id == 0 } { + ns_returnredirect "/register/" + return +} + +set_the_usual_form_variables + +# rowid + +set db [ns_db gethandle] + +ns_db dml $db "delete from link_kill_patterns where oid='$QQrowid'" + +ns_returnredirect blacklist-all.tcl Index: web/openacs/www/admin/links/blacklist.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/links/blacklist.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/links/blacklist.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,65 @@ +# blacklist.tcl,v 3.0 2000/02/06 03:24:28 ron Exp +set admin_id [ad_verify_and_get_user_id] + +if { $admin_id == 0 } { + ns_returnredirect "/register/" + return +} + +set_the_usual_form_variables + +# page_id, url + +set db [ns_db gethandle] +set url_stub [database_to_tcl_string $db "select url_stub from static_pages where page_id = $page_id"] + +ns_return 200 text/html "[ad_admin_header "Blacklist $url"] + +

    Blacklist $url

    + +on $url_stub (or everywhere) + +
    + +
    + On all pages + Just on $url_stub +

    +Kill Pattern: +
    + +Note: This uses Unix \"glob-style\" matching. * matches zero or more +characters. ? matches any single character. \"\[a9\]\" matches a lower +case letter A or the number 9. You can use a backslash if you want one of +these special characters to be matched. + +
    +
    + +

    + + + +
    + +
    + +

    + +

    Example patterns

    + +
      +
    • \"*mit.edu*\" will match any URL that includes \"mit.edu\". This +would be useful to exclude all Web sites served off MIT machines, but +would also falsely trigger on random other sites that had \"mit.edu\" +as part of a URL, like \"http://bozo.com/hermit.education.in.caves.html\" + +
    • \"http://www.microsoft.com*\" would exclude the entire Microsoft +main Web server. + +
    • \"http://photo.net/photo/nudes.html\" would exclude only this one +naughty document. +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/links/by-page.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/links/by-page.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/links/by-page.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,68 @@ +# by-page.tcl,v 3.0 2000/02/06 03:24:30 ron Exp +set_the_usual_form_variables 0 + +# optional: show_page_title_p, order_by + +if { ![info exists order_by] || $order_by == "n_links" } { + set title "Related Links" + set order_by "n_links desc, url_stub" + if { [info exists show_page_title_p] && $show_page_title_p } { + set options "hide page title | order by URL" + } else { + set options "show page title | order by URL" + } +} else { + set title "Related Links" + set order_by "url_stub" + if { [info exists show_page_title_p] && $show_page_title_p } { + set options "hide page title | order by number of links" + } else { + set options "show page title | order by number of links" + } +} + + +ReturnHeaders + +ns_write "[ad_admin_header $title] + +

    $title

    + +[ad_admin_context_bar [list "index.tcl" "Links"] "By Page"] + +
    + +$options + +
      +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select static_pages.page_id, page_title, url_stub, count(user_id) as n_links +from static_pages, links +where static_pages.page_id = links.page_id +group by static_pages.page_id, page_title, url_stub +order by $order_by"] + +set items "" +while {[ns_db getrow $db $selection]} { + set_variables_after_query + + if { [string length $page_title] == 0 } { + set page_title "$url_stub" + } + + append items "
    • $url_stub ($n_links)\n" + if { [info exists show_page_title_p] && $show_page_title_p && ![empty_string_p $page_title]} { + append items "-- $page_title\n" + } +} + +ns_write $items + +ns_write " +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/links/by-user.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/links/by-user.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/links/by-user.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,36 @@ +# by-user.tcl,v 3.0 2000/02/06 03:24:32 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Related links per user"] + +

    Related links per user

    + +[ad_admin_context_bar [list "index.tcl" "Links"] "By User"] + +
    + +
      +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select links.user_id, first_names, last_name, count(links.page_id) as n_links +from links, users +where links.user_id = users.user_id +group by links.user_id, first_names, last_name +order by n_links desc"] + +set items "" + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + append items "
    • $first_names $last_name ($n_links)\n" +} + +ns_write $items + +ns_write " +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/links/delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/links/delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/links/delete-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,72 @@ +# delete-2.tcl,v 3.0 2000/02/06 03:24:33 ron Exp +set admin_id [ad_verify_and_get_user_id] + +if { $admin_id == 0 } { + ns_returnredirect "/register/" + return +} + +# we know who the administrator is + +set_the_usual_form_variables + +# page_id, url, deletion_reason ("spam", "dupe", "other") + +set db [ns_db gethandle] + +set offending_user_id [database_to_tcl_string $db "select user_id from links +where page_id = $page_id +and url = '$QQurl'"] + +ns_db dml $db "delete from links +where page_id = $page_id +and url = '$QQurl'" + +set selection [ns_db 1row $db "select url_stub, nvl(page_title, url_stub) as page_title +from static_pages +where static_pages.page_id = $page_id"] +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "Link Deleted"] + +

    Link Deleted

    + +
    + +The link to $url has been deleted from the database. + +" + +if { [mv_enabled_p] && [info exists $deletion_reason] && ![empty_string_p $deletion_reason] && $deletion_reason != "other" } { + # this is a naughty user; let's assess a charge + if { $deletion_reason == "spam" } { + set amount [mv_parameter LinkSpamRate] + set charge_type "link_spam" + set charge_comment "SPAM: Added a link from $url_stub to $url." + } else { + # assume it was some kind of mistake + set amount [mv_parameter LinkDupeRate] + set charge_type "link_dupe" + set charge_comment "Dupe/Mistake: Added a link from $url_stub to $url." + } + if { $amount > 0 } { + ns_db dml $db "insert into users_charges (user_id, admin_id, charge_type, amount, currency, entry_date, charge_comment) +values +($offending_user_id, $admin_id, '$charge_type', $amount, '[mv_parameter Currency]', sysdate(), '[DoubleApos $charge_comment]')" + ns_write "

    +Charged user $offending_user_id ([database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id = $offending_user_id"]) [mv_parameter Currency] $amount, under category $charge_type." + } +} + + +ns_write " + +

    + +You can visit $url_stub if you'd like to see +how the links look now. + +[ad_admin_footer] +" Index: web/openacs/www/admin/links/delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/links/delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/links/delete.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,81 @@ +# delete.tcl,v 3.0 2000/02/06 03:24:35 ron Exp +set admin_id [ad_verify_and_get_user_id] + +if { $admin_id == 0 } { + ns_returnredirect "/register/" + return +} + +# we know who the administrator is + +set_the_usual_form_variables + +# page_id, url + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select url_stub, nvl(page_title, url_stub) as page_title +from static_pages +where static_pages.page_id = $page_id"] +set_variables_after_query + +set selection [ns_db 1row $db "select l.user_id, l.link_title, l.link_description, l.status, l.originating_ip, l.posting_time, u.first_names, u.last_name, u.email +from links l, users u +where l.user_id = u.user_id +and l.page_id = $page_id +and l.url = '$QQurl'"] +set_variables_after_query + + +if ![empty_string_p $originating_ip] { + set ip_note "from $originating_ip" +} else { + set ip_note "" +} + +if [mv_enabled_p] { + set user_charge_option "

    Charge this user for his or her sins?

    + + + +" +} else { + set user_charge_option "" +} + +ns_return 200 text/html "[ad_admin_header "Confirm Deletion"] + +

    Confirm Deletion

    + +
    + + + +Added by $first_names +$last_name ($email) on [util_AnsiDatetoPrettyDate $posting_time] +$ip_note + +

    + +

    +
    +[export_form_vars page_id url] + + + +$user_charge_option + +
    +
    + +[ad_admin_footer] +" + Index: web/openacs/www/admin/links/edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/links/edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/links/edit-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,104 @@ +# edit-2.tcl,v 3.0 2000/02/06 03:24:37 ron Exp +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set_the_usual_form_variables + +# page_id, submit, old_url +# maybe link_description, link_title, contact_p, url, link_user_id + + +set db [ns_db gethandle] +set user_id [ad_verify_and_get_user_id] + +set selection [ns_db 1row $db "select page_title, url_stub +from static_pages +where page_id = $page_id"] +set_variables_after_query + +# check for valid data + +set exception_count 0 +set exception_text "" + +if { [info exists url] && [string match $url "http://"] == 1 } { + # the user left the default hint for the url + incr exception_count + append exception_text "
  • Please type in a URL." +} + +if { ![info exists url] || [empty_string_p $url] } { + incr exception_count + append exception_text "
  • Please type in a URL." +} + +if {[info exists url] && ![empty_string_p $url] && ![philg_url_valid_p $url] } { + # there is a URL but it doesn't match our REGEXP + incr exception_count + append exception_text "
  • You URL doesn't have the correct form. A valid URL would be something like \"http://photo.net/philg/\"." +} + +if { ![info exists link_description] || [empty_string_p $link_description] } { + incr exception_count + append exception_text "
  • Please type in a description of your link." +} + +if { [info exists link_description] && ([string length $link_description] > 4000) } { + incr exception_count + append exception_text "
  • Please limit your link description to 4000 characters." +} + +if { ![info exists link_title] || [empty_string_p $link_title] } { + incr exception_count + append exception_text "
  • Please type in a title for your linked page." +} + +if { [database_to_tcl_string $db "select count(url) +from links +where page_id = $page_id +and lower(url)='[string tolower $QQurl]' +and user_id <> $link_user_id"] > 0 } { + # another user has submitted this link + incr exception_count + append exception_text "
  • $url was already submitted as a related link to this page by another user." +} + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + +# data are valid, move on + +ns_return 200 text/html "[ad_admin_header "Confirm link from $url_stub" ] + +

    Confirm link

    + +from $url_stub + +
    + +The following is the link as it will appear on the page $url_stub +($page_title). + +If it looks incorrect, please use the back button on your browser to return and +correct it. Otherwise, press \"Proceed\". + +

    + +

    +$link_title- $link_description +
    + +

    + +

    +[export_form_vars page_id url_stub link_title link_description url contact_p old_url] +
    + +
    +
    +[ad_admin_footer] +" Index: web/openacs/www/admin/links/edit-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/links/edit-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/links/edit-3.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,88 @@ +# edit-3.tcl,v 3.0 2000/02/06 03:24:38 ron Exp +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set_the_usual_form_variables + +# page_id, link_description, page_title, url, old_url + +set db [ns_db gethandle] +set user_id [ad_verify_and_get_user_id] + +# get the page and author information + +set selection [ns_db 1row $db " +select url_stub, page_title, email as author_email +from static_pages, users +where static_pages.original_author = users.user_id +and static_pages.page_id = $page_id +union +select url_stub, page_title, '[ad_system_owner]' as author_email +from static_pages +where not exists (select * from users + where static_pages.original_author = users.user_id ) +and static_pages.page_id = $page_id +"] +set_variables_after_query + +if [catch {ns_db dml $db "update links +set url='$QQurl', + link_title='$QQlink_title', + link_description='$QQlink_description', + contact_p='$contact_p' +where page_id=$page_id +and url='$QQold_url'"} errmsg] { + ad_return_error "Error in updating link" "Here is what the database returned: +

    +

    +$errmsg
+
    +" + return +} + + +ns_return 200 text/html "[ad_admin_header "Link edited"] + +

    Link edited

    + +from $url_stub + +
    + +Here's what we've got in the database now: + +
      +
    • Url: $url +
    • Title: $link_title +
    • Description: $link_description +
    + +[ad_admin_footer] +" + + +if [ad_parameter EmailEditedLink links] { + + # send email if necessary + + set selection [ns_db 1row $db "select first_names || ' ' || last_name as name, email from users where user_id = $user_id"] + set_variables_after_query + + ns_db releasehandle $db + + set subject "$email edited a link from $url_stub" + set body "$name ($email) edited a related link to +[ad_url]/$url_stub: + +Url: $url +Title: $link_title +Description: +$link_description +" + if [ catch { ns_sendmail $author_email $email $subject $body } errmsg] { + ns_log Warning "Error in email to $author_email from [ns_conn url]" + } +} Index: web/openacs/www/admin/links/edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/links/edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/links/edit.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,67 @@ +# edit.tcl,v 3.0 2000/02/06 03:24:40 ron Exp +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set_the_usual_form_variables + +# page_id, url + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select static_pages.page_id, static_pages.url_stub, nvl(page_title, url_stub) as page_title +from static_pages +where page_id = $page_id"] +set_variables_after_query + +set selection [ns_db 1row $db "select +url, link_title, link_description, contact_p, page_id, user_id as link_user_id +from links +where page_id = $page_id and url='$QQurl'"] +set_variables_after_query + +ns_db releasehandle $db + +ns_return 200 text/html "[ad_admin_header "Edit related link on $page_title" ] + +

    Edit related link

    + +[ad_admin_context_bar [list "index.tcl" "Links"] "Edit link"] + +
    + + + + +
    +[export_form_vars page_id link_user_id] + + + \n + \n + + +
    URL:
    Title:
    Description:
    Notify user if this link +becomes invalid?
    +Yes +[bt_mergepiece " +No +" $selection]
    +
    +
    +
    + +
    +
    + +

    + +Note: If you absolutely hate this link, you can +delete it. + +[ad_admin_footer] +" + Index: web/openacs/www/admin/links/find.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/links/find.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/links/find.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,91 @@ +# find.tcl,v 3.0 2000/02/06 03:24:41 ron Exp +# find.tcl +# +# by philg@mit.edu on July 18, 1999 +# +# let the site admin look for a related link +# + +set_the_usual_form_variables + +# query_string + +ReturnHeaders + +ns_write "[ad_admin_header "Related links matching \"$query_string\""] + +

    Links matching \"$query_string\"

    + +[ad_admin_context_bar [list "index.tcl" "Links"] "Search Results"] + +
    + +Matching links: + +
      +" + +set db [ns_db gethandle] + +set selection [ns_db select $db " +select links.link_title, links.link_description, links.url, links.status, posting_time, +users.user_id, first_names || ' ' || last_name as name, links.url, sp.page_id, sp.page_title, sp.url_stub +from static_pages sp, links, users +where sp.page_id = links.page_id +and users.user_id = links.user_id +and (upper(links.url) like upper('%$QQquery_string%') + or + upper(links.link_title) like upper('%$QQquery_string%') + or + upper(links.link_description) like upper('%$QQquery_string%')) +union +select links.link_title, links.link_description, links.url, links.status, posting_time, +users.user_id, first_names || ' ' || last_name as name, links.url, +null as page_id, null as page_title, null as url_stub +from links, users +where not exists (select * from static_pages sp + where sp.page_id = links.page_id) +and users.user_id = links.user_id +and (upper(links.url) like upper('%$QQquery_string%') + or + upper(links.link_title) like upper('%$QQquery_string%') + or + upper(links.link_description) like upper('%$QQquery_string%')) +"] + +set items "" + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + set old_url $url + append items "
    • [util_AnsiDatetoPrettyDate $posting_time]: +$link_title " + if { $status != "live" } { + append items "($status)" + } + append items "- $link_description +
      +-- +posted by $name +on $url_stub +  +\[ +edit | +delete | +blacklist +\] +

      +" +} + +if ![empty_string_p $items] { + ns_write $items +} else { + ns_write "no matching links found" +} + +ns_write " +

    + +[ad_admin_footer] +" Index: web/openacs/www/admin/links/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/links/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/links/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,64 @@ +# index.tcl,v 3.0 2000/02/06 03:24:43 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Related Links"] + +

    Related Links

    + +[ad_admin_context_bar "Links"] + + +
    + + + +" + +set db [ns_db gethandle] + +set selection [ns_db 1row $db " +select + count(*) as total, + sum(case status when 'live' then 1 else 0 end) as n_live, + sum(case status when 'coma' then 1 else 0 end) as n_coma, + sum(case status when 'dead' then 1 else 0 end) as n_dead, + sum(case status when 'removed' then 1 else 0 end) as n_removed +from links"] + +set_variables_after_query + +ns_write " +

    Statistics

    + +
      +
    • total: $total +
    • live: $n_live +
    • coma: $n_coma +
    • dead: $n_dead +
    • removed: $n_removed +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/links/links-all.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/links/links-all.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/links/links-all.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,49 @@ +# links-all.tcl,v 3.0 2000/02/06 03:24:44 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "All related links"] + +

    All related links

    + +in [ad_system_name] + +
    + +Listing of all related links. + +
      +" + +set db [ns_db gethandle] + + +set selection [ns_db select $db " +select links.link_title, links.link_description, links.url, links.status, +to_char(posting_time,'Month DD, YYYY') as posted, +users.user_id, first_names || ' ' || last_name as name +from static_pages sp, links, users +where sp.page_id = links.page_id +and users.user_id = links.user_id +union +select links.link_title, links.link_description, links.url, links.status, +to_char(posting_time,'Month DD, YYYY') as posted, +users.user_id, first_names || ' ' || last_name as name +from links, users +where not exists (select * from static pages + where sp.page_id = links.page_id) +and users.user_id = links.user_id +order by posted asc +"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + + ns_write "
    • $posted: $link_title - $link_description ([string trim $status]) posted by $name     edit     delete" + +} + +ns_write " +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/links/one-page.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/links/one-page.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/links/one-page.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,110 @@ +# one-page.tcl,v 3.0 2000/02/06 03:24:46 ron Exp +set_form_variables + +# page_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db " +select page_title, url_stub, draft_p, obsolete_p, accept_comments_p, accept_links_p, inline_comments_p, inline_links_p, last_updated, users.user_id, users.first_names, users.last_name +from static_pages sp, users +where sp.original_author = users.user_id +and sp.page_id = $page_id +union +select page_title, url_stub, draft_p, obsolete_p, accept_comments_p, accept_links_p, inline_comments_p, inline_links_p, last_updated, +null as user_id, null as first_names, null as last_name +from static_pages sp +where not exists (select * from users + where sp.original_author = users.user_id) +and sp.page_id = $page_id + "] +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "$url_stub"] + +

    Related links to $url_stub

    + +[ad_admin_context_bar [list "index.tcl" "Links"] "One Page"] + +
    + + + +

    The Links

    + +
      + +" + + +set selection [ns_db select $db " +select links.link_title, links.link_description, links.url, links.status, posting_time, +users.user_id, first_names || ' ' || last_name as name +from static_pages sp, links, users +where sp.page_id = links.page_id +and users.user_id = links.user_id +and links.page_id = $page_id +union +select links.link_title, links.link_description, links.url, links.status, posting_time, +users.user_id, first_names || ' ' || last_name as name +from static_pages sp, links, users +where not exists (select * from static_pages sp + where sp.page_id = links.page_id) +and users.user_id = links.user_id +and links.page_id = $page_id +order by posting_time desc"] + +set items "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + set old_url $url + append items "
    • [util_AnsiDatetoPrettyDate $posting_time]: +$link_title " + if { $status != "live" } { + append items "($status)" + set extra_option "\n    restore to live status" + } else { + set extra_option "" + } + append items "- $link_description +
      +-- posted by $name +    +edit +    +delete +    +blacklist +$extra_option +

      +" +} + +ns_write " +$items +

    + +[ad_admin_footer] +" Index: web/openacs/www/admin/links/recent.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/links/recent.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/links/recent.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,81 @@ +# recent.tcl,v 3.0 2000/02/06 03:24:47 ron Exp +set_form_variables + +# num_days (could be "all") + +if { $num_days == "all" } { + set title "All related links" + set subtitle "" + set posting_time_clause "" +} else { + set title "Related links" + set subtitle "added over the past $num_days day(s)" + set posting_time_clause "\nand (sysdate()::date - posting_time::date < $num_days)" +} + +ReturnHeaders + +ns_write "[ad_admin_header $title] + +

    $title

    + +[ad_admin_context_bar [list "index.tcl" "Links"] "List"] + +
    + +$subtitle + + +
      +" + +set db [ns_db gethandle] + +set selection [ns_db select $db " +select links.link_title, links.link_description, links.url, links.status, posting_time, +users.user_id, first_names || ' ' || last_name as name, links.url, sp.page_id, sp.page_title, sp.url_stub +from static_pages sp, links, users +where sp.page_id = links.page_id +and users.user_id = links.user_id $posting_time_clause +union +select links.link_title, links.link_description, links.url, links.status, posting_time, +users.user_id, first_names || ' ' || last_name as name, links.url, +page_id, null as page_title, null as url_stub +from links, users +where not exists (select * from static_pages sp + where sp.page_id = links.page_id) +and users.user_id = links.user_id $posting_time_clause +order by posting_time desc"] + +set items "" + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + set old_url $url + append items "
    • [util_AnsiDatetoPrettyDate $posting_time]: +$link_title " + if { $status != "live" } { + append items "($status)" + } + append items "- $link_description +
      +-- +posted by $name +on $url_stub +  +\[ +edit | +delete | +blacklist +\] +

      +" +} + +ns_write $items + +ns_write " +

    + +[ad_admin_footer] +" Index: web/openacs/www/admin/links/restore.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/links/restore.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/links/restore.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,29 @@ +# restore.tcl,v 3.0 2000/02/06 03:24:49 ron Exp +# restore.tcl +# +# by philg@mit.edu on July 18, 1999 +# +# restores a link to "live" status if it has been erroneously kicked +# into "dead" or "removed" for whatever reason + +set admin_id [ad_verify_and_get_user_id] + +if { $admin_id == 0 } { + ns_returnredirect "/register/" + return +} + +# we know who the administrator is + +set_the_usual_form_variables + +# page_id, url + +set db [ns_db gethandle] + +ns_db dml $db "update links +set status = 'live' +where page_id = $page_id +and url = '$QQurl'" + +ns_returnredirect "one-page.tcl?[export_url_vars page_id]" Index: web/openacs/www/admin/links/spam-hunter-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/links/spam-hunter-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/links/spam-hunter-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,44 @@ +# spam-hunter-2.tcl,v 3.0 2000/02/06 03:24:50 ron Exp +set_the_usual_form_variables + +# url + +ReturnHeaders + +ns_write "[ad_admin_header "$url"] + +

    $url

    + +[ad_admin_context_bar [list "index.tcl" "Links"] [list "spam-hunter.tcl" "Spam Hunter"] "One potential spammer"] + + +
    + +
      + +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select links.page_id, links.user_id, link_title, link_description, links.status, links.originating_ip, links.posting_time, sp.url_stub, sp.page_title, users.first_names, users.last_name +from links, static_pages sp, users +where links.url = '$QQurl' +and links.page_id = sp.page_id +and links.user_id = users.user_id"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
    • added by $first_names $last_name +on [util_AnsiDatetoPrettyDate $posting_time] +to $url_stub +" +} + +ns_write "
    + +[ad_admin_footer] +" + + + + Index: web/openacs/www/admin/links/spam-hunter.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/links/spam-hunter.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/links/spam-hunter.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,35 @@ +# spam-hunter.tcl,v 3.1 2000/02/29 04:39:24 jsc Exp +# find spam URLs + +ReturnHeaders + +ns_write "[ad_admin_header "Hunting for spam"] + +

    Hunting for spam

    + +[ad_admin_context_bar [list "index.tcl" "Links"] "Spam Hunter"] + +
    + +
      + +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select url, count(*) as n_copies +from links +group by url +having count(*) > 2 +order by count(*) desc"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
    • $url ($n_copies)\n" +} + + +ns_write "
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/links/sweep.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/links/sweep.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/links/sweep.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,153 @@ +# sweep.tcl,v 3.0 2000/02/06 03:24:53 ron Exp +# *** the "notify user who posted link" proc is totally broken +# -- philg 2/27/1999 + +# sweep out dead links from part or all of the links table + +set_the_usual_form_variables + +# page_id (could be "all"), verbose_p is optional + +# want to turn this off when we haven't swept for a long time +set actually_send_email_p 0 + +if { ![info exists verbose_p] } { + set verbose_p 1 +} + +set db_conns [ns_db gethandle [philg_server_default_pool] 2] +set db [lindex $db_conns 0] +set db_sub [lindex $db_conns 1] + +if { $page_id == "all" } { + set page_id_clause "" + set scope_description "all of the related links contributed to [ad_system_name]" +} else { + # we're only sweeping links related to one page + set page_id_clause "and links.page_id = $page_id" + set url_stub [database_to_tcl_string $db "select url_stub from static_pages where page_id = $page_id"] + set scope_description "related links contributed to $url_stub" +} + +proc link_notify {db url new_status} { + set selection [ns_db select $db "select l.page_id, url, link_title, email, pi.backlink, pi.backlink_title +from links l, page_ids pi +where url = '[DoubleApos $url]' +and contact_p +and l.page_id = pi.page_id"] + + set body "The BooHoo automated link management system is unable to reach +$url + +Its new status is [string toupper $new_status]. Links go from 'live' to 'coma' to +'dead' and then are removed. Promotion in status occurs if the link +is unreachable one night. A link that becomes reachable goes back to +live immediately. + +Here are the pages that will no longer have $url +as a related link: + +" + + while {[ns_db getrow $db $selection]} { + + set_variables_after_query + + append body " $backlink ($backlink_title)\n" + + } + + append body " + +If you have moved servers or something and the URL is no longer valid, +then just come back to the pages above and add the new URL. The old +dead one will get weeded out within a day or two. + +" + + # we don't want errors killing us + + catch { ns_sendmail $email "philg@mit.edu" "$url is unreachable" $body } + + +} + +ReturnHeaders + +ns_write "[ad_admin_header "Sweeping"] + +

    Sweeping

    + +[ad_admin_context_bar [list "index.tcl" "Links"] "Sweeping"] + +
    + +Scope: $scope_description + +

    + +This program cycles through links that + +

      +
    1. haven't been checked in the last 24 hours +
    2. aren't in the \"removed\" status +
    + +Any link that is reachable is promoted to \"live\" status if it wasn't +already there. Links that aren't reachable go through a life cycle of +live, coma, dead, and removed. We test the coma and dead links first. + +
      + +" + +set selection [ns_db select $db "select links.page_id, url, link_title, status, contact_p, sp.url_stub +from links, static_pages sp +where links.page_id = sp.page_id +and links.status <> 'removed' +and (checked_date is null or checked_date::date + 1 < sysdate()::date) $page_id_clause +order by links.status, links.url"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_log Notice "attempting to reach $url, whose current status is $status" + if ![util_link_responding_p $url] { + # couldn't get the URL + if { $status == "live" } { + set new_status "coma" + ns_db dml $db_sub "update links set status='coma' where page_id = $page_id and url='[DoubleApos $url]'" + } elseif { $status == "coma" } { + set new_status "dead" + ns_db dml $db_sub "update links set status='dead' where page_id = $page_id and url='[DoubleApos $url]'" + if { $contact_p == "t" && $actually_send_email_p } { + link_notify $db_sub $url dead + } + } elseif { $status == "dead" } { + set new_status "removed" + if { $contact_p == "t" && $actually_send_email_p } { + link_notify $db_sub $url removed + } + ns_db dml $db_sub "update links set status='removed' where page_id = $page_id and url='[DoubleApos $url]'" + } + + ns_write "
    • Could not reach $link_title. Status has gone from $status to $new_status.\n" + + } else { + # we made it + if { $verbose_p == 1 } { + ns_write "
    • Successfully reached $link_title.\n" + } + if { $status != "live" } { + # was marked coma or dead, but now it is back + ns_db dml $db_sub "update links set status='live' where page_id = $page_id and url='[DoubleApos $url]'" + ns_write " Updated status to \"live\" (from \"$status\")." + } + } + # either way, let's mark this URL as having been checked + ns_db dml $db_sub "update links set checked_date = sysdate() where page_id = $page_id and url='[DoubleApos $url]'" +} + +ns_write " +
    +[ad_admin_footer] +" Index: web/openacs/www/admin/member-value/add-charge.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/member-value/add-charge.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/member-value/add-charge.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,23 @@ +# add-charge.tcl,v 3.0 2000/02/06 03:24:54 ron Exp +set_the_usual_form_variables + +# note: nobody gets to this page who isn't a site administrator (ensured +# by a filter in ad-security.tcl) + +# user_id (the guy who will be charged), charge_type +# amount, charge_comment + +set admin_id [ad_verify_and_get_user_id] + +if { $admin_id == 0 } { + ad_return_error "no filter" "something wrong with the filter on add-charge.tcl; couldn't find registered user_id" + return +} + +set db [ns_db gethandle] +ns_db dml $db "insert into users_charges (user_id, admin_id, charge_type, amount, charge_comment, entry_date) +values +($user_id, $admin_id, '$QQcharge_type', $amount, '$QQcharge_comment', sysdate())" + +ns_returnredirect "user-charges.tcl?user_id=$user_id" + Index: web/openacs/www/admin/member-value/charges-all.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/member-value/charges-all.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/member-value/charges-all.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,50 @@ +# charges-all.tcl,v 3.0 2000/02/06 03:24:56 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "All Charges for [ad_system_name]"] + +

    All charges

    + +[ad_admin_context_bar [list "index.tcl" "Member Value"] "All Charges"] + + +
    + +
      + +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select uc.*, u.first_names || ' ' || u.last_name as user_name, au.first_names || ' ' || au.last_name as administrator_name +from users_charges uc, users u, users au +where uc.user_id = u.user_id +and uc.admin_id = au.user_id(+) +order by entry_date desc"] + +set counter 0 +set items "" +while { [ns_db getrow $db $selection] } { + set_variables_after_query + incr counter + append items "
    • $entry_date: $user_name charged [mv_pretty_amount $currency $amount], +[mv_pretty_user_charge $charge_type $charge_key $charge_comment] +\n" + if ![empty_string_p $admin_id] { + append items "by $administrator_name" + } +} + +ns_db releasehandle $db + +if { $counter == 0 } { + ns_write "No charges found." +} else { + ns_write $items +} + +ns_write " +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/member-value/charges-by-one-admin.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/member-value/charges-by-one-admin.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/member-value/charges-by-one-admin.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,41 @@ +# charges-by-one-admin.tcl,v 3.0 2000/02/06 03:24:57 ron Exp +set_the_usual_form_variables + +# admin_id + +set db [ns_db gethandle] + +set admin_name [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id = $admin_id"] + +ReturnHeaders + +ns_write "[ad_admin_header "All charges by $admin_name"] + +

    All charges imposed by $admin_name

    + +[ad_admin_context_bar [list "index.tcl" "Member Value"] "Charges by one admin"] + +
    + +
      + +" + +set selection [ns_db select $db "select uc.*, u.first_names || ' ' || u.last_name as user_name +from users_charges uc, users u +where uc.user_id = u.user_id +and uc.admin_id = $admin_id +order by entry_date desc"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • $entry_date: $user_name charged [mv_pretty_amount $currency $amount], +[mv_pretty_user_charge $charge_type $charge_key $charge_comment] +\n" +} + +ns_write " +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/member-value/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/member-value/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/member-value/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,83 @@ +# index.tcl,v 3.0 2000/02/06 03:24:59 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Member Value Home for [ad_system_name]"] + +

    Member Value (Money)

    + +[ad_admin_context_bar "Member Value"] + +
    + +
      +
    • documentation: /doc/member-value.html +
    • using real money? [util_PrettyTclBoolean [mv_parameter UseRealMoneyP]] +
    • charging monthly? [util_PrettyTclBoolean [mv_parameter ChargeMonthlyP]] +
    + +" + +set db [ns_db gethandle] + + +if [mv_parameter ChargeMonthlyP 0] { + # we have to do a monthly rate section + ns_write "

    Monthly Rates

    \n
      \n" + set selection [ns_db select $db "select mvmr.subscriber_class, mvmr.rate, count(user_id) as n_subscribers +from mv_monthly_rates mvmr, users_payment up +where mvmr.subscriber_class = up.subscriber_class(+) +group by mvmr.subscriber_class, mvmr.rate +order by mvmr.rate desc"] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • $subscriber_class ($rate): +$n_subscribers subscribers\n" + } + ns_write "

      \n

    • create a new subscriber class\n
    \n" + +} + +ns_write " +

    Charges

    + + + +" + +if [mv_parameter UseRealMoneyP 0] { + ns_write " +

    Billing

    + +These are records of when we actually tried to bill users' credit +cards. + +
      +" + + set selection [ns_db select $db "select mbs.*,round((success_time-start_time)*24*60) as n_minutes from mv_billing_sweeps mbs order by start_time desc"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • $start_time: generated $n_orders orders;" + if { $success_time == "" } { + ns_write "terminated prematurely" + } else { + ns_write "terminated $n_minutes minutes later" + } + } + + ns_write " +
    +" +} + +ns_write "[ad_admin_footer] +" Index: web/openacs/www/admin/member-value/subscriber-class-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/member-value/subscriber-class-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/member-value/subscriber-class-delete-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,36 @@ +# subscriber-class-delete-2.tcl,v 3.0 2000/02/06 03:25:00 ron Exp +set_the_usual_form_variables + +# subscriber_class, new_subscriber_class + +set db [ns_db gethandle] + +ReturnHeaders + +ns_write "[ad_no_menu_header "Deleting $subscriber_class"] + +

    Deleting $subscriber_class

    + +from [ad_system_name] + +
    + +Moving all the old subscribers to $new_subscriber_class ... + +" + +ns_db dml $db "begin transaction" + + +ns_db dml $db "update users_payment set subscriber_class = '$QQnew_subscriber_class' where subscriber_class = '$QQsubscriber_class'" + +ns_write " .. done. Now deleting the subscriber class from mv_monthly_rates... " + +ns_db dml $db "delete from mv_monthly_rates where subscriber_class = '$QQsubscriber_class'" + +ns_db dml $db "end transaction" + +ns_write " ... done. + +[ad_no_menu_footer] +" Index: web/openacs/www/admin/member-value/subscriber-class-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/member-value/subscriber-class-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/member-value/subscriber-class-delete.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,44 @@ +# subscriber-class-delete.tcl,v 3.0 2000/02/06 03:25:01 ron Exp +set_the_usual_form_variables + +# subscriber_class + +ReturnHeaders + +ns_write "[ad_no_menu_header "Delete $subscriber_class"] + +

    Delete subscriber class $subscriber_class

    + +from [ad_system_name] + +
    + +
    +[export_form_vars subscriber_class] + +
      +
    • Number of subscribers presently in this class: + +" + +set db [ns_db gethandle] +set n_subscribers [database_to_tcl_string $db "select count(*) from users_payment where subscriber_class = '$QQsubscriber_class'"] + +ns_write "$n_subscribers" + +ns_write "
    • subscriber class into which to move the above folks: + +
    + +
    + +
    +
    + +[ad_no_menu_footer] +" Index: web/openacs/www/admin/member-value/subscriber-class-new-currency.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/member-value/subscriber-class-new-currency.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/member-value/subscriber-class-new-currency.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,10 @@ +# subscriber-class-new-currency.tcl,v 3.0 2000/02/06 03:25:02 ron Exp +set_the_usual_form_variables + +# subscriber_class, currency + +set db [ns_db gethandle] + +ns_db dml $db "update mv_monthly_rates set currency = '$QQcurrency' where subscriber_class = '$QQsubscriber_class'" + +ns_returnredirect "subscriber-class.tcl?subscriber_class=[ns_urlencode $subscriber_class]" Index: web/openacs/www/admin/member-value/subscriber-class-new-rate.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/member-value/subscriber-class-new-rate.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/member-value/subscriber-class-new-rate.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,10 @@ +# subscriber-class-new-rate.tcl,v 3.0 2000/02/06 03:25:03 ron Exp +set_the_usual_form_variables + +# subscriber_class, rate + +set db [ns_db gethandle] + +ns_db dml $db "update mv_monthly_rates set rate = $rate where subscriber_class = '$QQsubscriber_class'" + +ns_returnredirect "subscriber-class.tcl?subscriber_class=[ns_urlencode $subscriber_class]" Index: web/openacs/www/admin/member-value/subscriber-class.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/member-value/subscriber-class.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/member-value/subscriber-class.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,44 @@ +# subscriber-class.tcl,v 3.0 2000/02/06 03:25:04 ron Exp +set_the_usual_form_variables + +# subscriber_class + +ReturnHeaders + +ns_write "[ad_no_menu_header "$subscriber_class"] + +

    $subscriber_class

    + +a subscription class in [ad_system_name] + +
    + +
      + +" + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select * from mv_monthly_rates where subscriber_class = '$QQsubscriber_class'"] + +set_variables_after_query + +ns_write "
    • +[export_form_vars subscriber_class] +Set rate: + +
      +
    • +
      +[export_form_vars subscriber_class] +Set currency: + +
      + +
    + +If you decide that this subscriber class isn't working anymore, you can +delete it and move all the subscribers into another class. + +[ad_no_menu_footer] +" Index: web/openacs/www/admin/member-value/subscribers-in-class.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/member-value/subscribers-in-class.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/member-value/subscribers-in-class.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,36 @@ +# subscribers-in-class.tcl,v 3.0 2000/02/06 03:25:05 ron Exp +set_the_usual_form_variables + +# subscriber_class + +ReturnHeaders + +ns_write "[ad_no_menu_header "$subscriber_class subscribers"] + +

    $subscriber_class subscribers

    + +in [ad_system_name] + +
    + +
      +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select u.user_id, u.first_names, u.last_name, u.email +from users u, users_payment up +where u.user_id = up.user_id +and up.subscriber_class = '$QQsubscriber_class' +order by upper(u.last_name), upper(u.first_names)"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • $first_names $last_name ($email)\n" +} + +ns_write " +
    + +[ad_no_menu_footer] +" Index: web/openacs/www/admin/member-value/user-charges.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/member-value/user-charges.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/member-value/user-charges.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,97 @@ +# user-charges.tcl,v 3.0 2000/02/06 03:25:07 ron Exp +# +# /admin/member-value/user-charges.tcl +# +# by philg@mit.edu in July 1998 +# +# shows all the charges for one user +# + +set_the_usual_form_variables + +# note: nobody gets to this page who isn't a site administrator (ensured +# by a filter in ad-security.tcl) + +# user_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select first_names, last_name from users where user_id = $user_id"] +set_variables_after_query + +ReturnHeaders +ns_write "[ad_admin_header "Charges for $first_names $last_name"] + +

    Charge history

    + +[ad_admin_context_bar [list "index.tcl" "Member Value"] "Charges for one user"] + +
    + +User: $first_names $last_name + +

    + + + +Add a miscellaneous charge: + +

    + + + + + + + +
    Amount: + +
    Comment + +
    +
    + +
    +
    + +

    Older Charges

    + +
      + +" + + +set selection [ns_db select $db "select + uc.entry_date, + uc.charge_type, + uc.currency, + uc.amount, + uc.charge_comment, + uc.admin_id, + u.first_names || ' ' || u.last_name as admin_name +from users_charges uc, users u +where uc.user_id = $user_id +and uc.admin_id = u.user_id +order by uc.entry_date desc"] + +set items "" +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append items "
    • $entry_date: $charge_type $currency $amount, +by $admin_name" + if ![empty_string_p $charge_comment] { + append items " ($charge_comment)" + } + append items "\n" +} + +if { [empty_string_p $items] } { + ns_write "no charges found" +} else { + ns_write $items +} + +ns_write " +
    +[ad_admin_footer] +" Index: web/openacs/www/admin/member-value/user-subscription-classify.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/member-value/user-subscription-classify.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/member-value/user-subscription-classify.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,21 @@ +# user-subscription-classify.tcl,v 3.0 2000/02/06 03:25:08 ron Exp +set_the_usual_form_variables + +# user_id, subscriber_class + +set admin_id [ad_verify_and_get_user_id] + +if { $admin_id == 0 } { + ad_return_error "no filter" "something wrong with the filter on add-charge.tcl; couldn't find registered user_id" + return +} + +set db [ns_db gethandle] + +if { [database_to_tcl_string $db "select count(*) from users_payment where user_id = $user_id"] == 0 } { + ns_db dml $db "insert into users_payment (user_id, subscriber_class) values ($user_id, '$QQsubscriber_class')" +} else { + ns_db dml $db "update users_payment set subscriber_class = '$QQsubscriber_class' where user_id = $user_id" +} + +ns_returnredirect "user-subscription.tcl?user_id=$user_id" Index: web/openacs/www/admin/member-value/user-subscription.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/member-value/user-subscription.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/member-value/user-subscription.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,60 @@ +# user-subscription.tcl,v 3.0 2000/02/06 03:25:10 ron Exp +set_the_usual_form_variables + +# note: nobody gets to this page who isn't a site administrator (ensured +# by a filter in ad-security.tcl) + +# user_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select unique * from users where user_id = $user_id"] +set_variables_after_query + +ReturnHeaders +ns_write "[ad_no_menu_header "Subscription for $first_names $last_name"] + +

    Subscription Info

    + +for $first_names $last_name +in [ad_system_name] +
    + +" + +set selection [ns_db 0or1row $db "select * from users_payment where user_id = $user_id"] + +if { $selection == "" } { + ns_write " + +
    + +Place user in a subscription class: + + +
    +" +} else { + set_variables_after_query + ns_write "Current subscription class: $subscriber_class + +

    + +

    + +Place user in a new subscription class: + + +
    +" +} + + +ns_write " + +[ad_no_menu_footer] +" Index: web/openacs/www/admin/monitoring/db-logging.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/db-logging.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/db-logging.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,58 @@ +ad_page_variables { + {n_messages 100} +} + +page_validation { + if { $n_messages < 1 } { + error "n_messages < 1" + } +} + +set db [ns_db gethandle] + +set time_format "DD/Mon/YYYY:HH24:MI:DD" + +set order_by_clause "order by creation_date asc" + +set selection [ns_db select $db "select + to_char(creation_date, '$time_format') as timestamp, severity, message +from ad_db_log_messages +$order_by_clause"] + +set i 0 +while { [ns_db getrow $db $selection] } { + + incr i + + if { $i == $n_messages } { + ns_db flush $db + break + } + + set_variables_after_query + + append log_messages "\[$timestamp\] $severity: $message\n" +} + +ad_return_top_of_page "[ad_admin_header "Database Logging"] + +

    Database Logging

    + +[ad_admin_context_bar {"" "Monitoring"} "Database Logging"] + +
    + +
    + +Last + +Messages: + +
    + +
    +$log_messages
+
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/monitoring/filters.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/filters.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/filters.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,89 @@ +# File: filters.tcl +# Author: Jon Salz +# Description: Displays a filter list. +# Inputs: match_method, match_path + +set_the_usual_form_variables 0 + +ReturnHeaders + +if { ![info exists match_method] } { + set match_method "GET" +} +if { ![info exists match_path] || $match_path == "" || $match_path == "(any)" } { + set match_path "(any)" +} else { + if { ![regexp {^/} $match_path] } { + set match_path "/$match_path" + } +} + +ns_write "[ad_admin_header "Filters"] + +
    + +

    Filters on [ad_system_name]

    + +[ad_admin_context_bar [list "" "Monitoring"] "Filters"] +
    + +Showing + +filters matching path: + + +[ad_decode [expr { $match_path == "(any)" }] 0 "" ""] + + + + + + + + + + + +" + +if { $match_method == "" } { + set match_method [list GET HEAD POST] +} + +set counter 0 +set bgcolors { white #E0E0E0 } +foreach k { preauth postauth trace } { + foreach meth $match_method { + foreach f [nsv_get ad_filters "$meth,$k"] { + set bgcolor [lindex $bgcolors [expr { $counter % [llength $bgcolors] }]] + incr counter + + set priority [lindex $f 0] + set kind [lindex $f 1] + set method [lindex $f 2] + set path [lindex $f 3] + set proc [lindex $f 4] + set args [lindex $f 5] + if { $args == "" } { + set args " " + } + set debug [ad_decode [lindex $f 6] "t" "Yes" "No"] + set critical [ad_decode [lindex $f 7] "t" "Yes" "No"] + if { $kind != $k || ($match_path != "(any)" && ![string match $path $match_path]) } { + continue + } + ns_write "" + foreach name { priority kind method path proc args debug critical } { + ns_write "" + } + ns_write "\n" + } + } +} + +ns_write "
    PriorityKindMethodPathProcArgsDebug?Crit.?
    [set $name]
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/monitoring/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,21 @@ +# index.tcl,v 3.1 2000/02/26 12:54:49 jsalz Exp +ns_return 200 text/html "[ad_admin_header "Monitoring [ad_system_name]"] + +

    Monitoring [ad_system_name]

    + +[ad_admin_context_bar "Monitoring"] + +
    + + +[ad_admin_footer] +" Index: web/openacs/www/admin/monitoring/scheduled-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/scheduled-procs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/scheduled-procs.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,84 @@ +# File: scheduled-procs.tcl +# Author: Jon Salz +# Description: Displays a list of scheduled procedures. + +ReturnHeaders + +ns_write "[ad_admin_header "Scheduled Procedures"] + + + +

    Scheduled Procedures on [ad_system_name]

    + +[ad_admin_context_bar [list "" "Monitoring"] "Scheduled Procedures"] +
    + + + + + + + + + + + + + +" + +set time_fmt "%m-%d %T" + +set counter 0 +set bgcolors { white #E0E0E0 } + +proc ad_scheduled_procs_compare { a b } { + set next_run_a [expr { [lindex $a 5] + [lindex $a 2] }] + set next_run_b [expr { [lindex $b 5] + [lindex $b 2] }] + if { $next_run_a < $next_run_b } { + return -1 + } elseif { $next_run_a > $next_run_b } { + return 1 + } else { + return [string compare [lindex $a 3] [lindex $b 3]] + } +} + +foreach proc_info [lsort -command ad_scheduled_procs_compare [nsv_get ad_procs .]] { + set bgcolor [lindex $bgcolors [expr { $counter % [llength $bgcolors] }]] + incr counter + + set thread [ad_decode [lindex $proc_info 0] "t" "Yes" "No"] + set once [ad_decode [lindex $proc_info 1] "t" "Yes" "No"] + set interval [lindex $proc_info 2] + set proc [lindex $proc_info 3] + set args [lindex $proc_info 4] + if { $args == "" } { + set args " " + } + set time [lindex $proc_info 5] + set count [lindex $proc_info 6] + set debug [ad_decode [lindex $proc_info 7] "t" "Yes" "No"] + set last_run [ad_decode $count 0 " " [ns_fmttime $time $time_fmt]] + set next_run [ns_fmttime [expr { $time + $interval }] $time_fmt] + set next_run_in "[expr { $time + $interval - [ns_time] }] s" + + ns_write "" + foreach name { proc args } { + ns_write "" + } + ns_write "" + foreach name { last_run next_run } { + ns_write "" + } + ns_write "" + foreach name { thread once debug } { + ns_write "" + } + ns_write "\n" +} + +ns_write "
    ProcArgsCountLast RunNext RunNext Run InThread?Once?Debug?
    [set $name]$count[set $name]$next_run_in[set $name]
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/monitoring/cassandracle/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/cassandracle/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/cassandracle/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,30 @@ +# index.tcl,v 3.0 2000/02/06 03:25:13 ron Exp +ns_return 200 text/html " +[ad_admin_header "Cassandracle"] + +

    Cassandracle

    + +[ad_admin_context_bar [list "/admin/monitoring" "Monitoring"] "Cassandracle"] + +
    + + +[ad_admin_footer] +" Index: web/openacs/www/admin/monitoring/cassandracle/jobs/running-jobs.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/cassandracle/jobs/running-jobs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/cassandracle/jobs/running-jobs.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,31 @@ +# running-jobs.tcl,v 3.0 2000/02/06 03:25:16 ron Exp +set page_name "Currently Running Jobs" +ReturnHeaders +set db [cassandracle_gethandle] + +ns_write " +[ad_admin_header $page_name] + + +" + + + +set job_running_info [database_to_tcl_list_list $db "Select R.job, J.Log_User, J.Priv_USER, J.What, R.Last_Date, SUBSTR(R.Last_Sec, 1, 5), R.This_Date, SUBSTR(R.This_Sec, 1, 5), R.Failures from DBA_JOBS_RUNNING R, DBA_JOBS J where R.JOB=J.JOB"] + +if {[llength $job_running_info]==0} { + ns_write "" +} else { + foreach row $job_running_info { + ns_write " +\n" + } +} +ns_write "
    IDSubmitted BySecurityJobLast OK DateLast OK TimeThis Run DateThis Run TimeErrors
    No Running Jobs found!
    [lindex $row 0][lindex $row 1][lindex $row 2][lindex $row 3][lindex $row 4][lindex $row 5][lindex $row 6][lindex $row 7][lindex $row 8]
    \n +

    +Here is the SQL responsible for this information:

    +Select R.job, J.Log_User, J.Priv_USER, J.What, R.Last_Date, SUBSTR(R.Last_Sec, 1, 5), R.This_Date, SUBSTR(R.This_Sec, 1, 5), R.Failures
    +from DBA_JOBS_RUNNING R, DBA_JOBS J
    +where R.JOB=J.JOB     +[ad_admin_footer] +" Index: web/openacs/www/admin/monitoring/cassandracle/objects/add-comments-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/cassandracle/objects/add-comments-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/cassandracle/objects/add-comments-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,93 @@ +# add-comments-2.tcl,v 3.0 2000/02/06 03:25:18 ron Exp +# we do not ReturnHeaders as we will either call +# ns_returnredirect or ad_return_complaint, either of which do headers +set_the_usual_form_variables + + +# verify user input -------------------------------------------------------- +set exception_count 0 +set exception_text "" +if { ![info exists object_name] || [empty_string_p $object_name] } { + incr exception_count + append exception_text "

  • The object_name (format: OWBER.TABLE_NAME) was left blank, but it is required.\n" +} +if { ![info exists table_comment] } { + incr exception_count + append exception_text "
  • The table_comment was missing, but it is required (but null is OK).\n" +} + +# start processing -------------------------------------------------------- + +# it is not clear to me whey we have one object_name argument here +# of the format OWBER.TABLE_NAME that needs to be parsed, rather than +# two seperate arguments? +set object_info [split $object_name .] +set owner [lindex $object_info 0] +set object_name [lindex $object_info 1] + +# get two db handles +set db [ns_db gethandle] + +# table ---------------------------------------------------------------------- + +# update table comment +set table_sql " +-- update table comment in a redirect page +-- /objects/add-comments-2.tcl +comment on table $owner.$object_name is '$QQtable_comment' +" +ns_db exec $db $table_sql + + +# columns --------------------------------------------------------------------- + +# for columns, we need to 1) know how manty there are, +# and 2) know their names. This allows us to loop as needed. +set get_column_info_sql " +-- get column name and id in preparation +-- for comment updates in a redirect page +-- /objects/add-comments-2.tcl +select + dtc.column_id, + dtc.column_name +from + dba_tab_columns dtc +where + -- specify table to dtc + dtc.owner='$owner' +and dtc.table_name='$object_name' +order by + dtc.column_id +" + +# run query (already have db handle) and output rows +set selection [ns_db select $db $get_column_info_sql] +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + # I am using the set command as shown on Welch pp. 12 + # when passed a single argument, the set command interprets + # that argument as a variable name, and returns the value + # of that variable. For example, for the first column, + # the variable column_id will be equal to '1', so Tcl + # intyerprets the argument as a (constructed) variable + # name of QQcolumn_comment_1. This just happens to be one + # of the form variables passed to this page, and so an + # sql statement is prepared. + # + # I constrcut a Tcl array with one element per row + # retrieved by the query. After the while loop, I + # then execute each of these SQL statement array elements. + set sql_array($column_id) "comment on column $owner.$object_name.$column_name is '[set QQcolumnComment_$column_id]'" +} + +foreach index [array names sql_array] { + ns_db exec $db $sql_array($index) +} + + +# done, ridirect back to tble page ------------------------------------------------------ + +# return to main table page +ns_returnredirect "describe-table.tcl?object_name=$owner.$object_name" + Index: web/openacs/www/admin/monitoring/cassandracle/objects/add-comments.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/cassandracle/objects/add-comments.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/cassandracle/objects/add-comments.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,142 @@ +# add-comments.tcl,v 3.0 2000/02/06 03:25:20 ron Exp +# called from ../users/one-user-specific-objects.tcl + +set_form_variables + +# check arguments ----------------------------------------------------- + +# it is not clear to me whey we have one object_name argument here +# of the format OWBER.TABLE_NAME that needs to be parsed, rather than +# two seperate arguments? + +# $object_type REQUIRED ARGUMENT +if { ![info exists object_name] } { + ns_returnerror 500 "Missing \$object_name (format: OWBER.TABLE_NAME)" + return +} +set object_info [split $object_name .] +set owner [lindex $object_info 0] +set object_name [lindex $object_info 1] + + +# check parameter to see if we want to display SQL as comments +# actually harcoded now during development, but will use ns_info later + +set show_sql_p "t" + +# arguments OK, get database handle, start building page ---------------------------------------- + +set page_name "Add or update comments on table $owner.$object_name" +ReturnHeaders +set db [cassandracle_gethandle] +ns_write " +[ad_admin_header $page_name] +

    $page_name

    +[ad_admin_context_bar [list "../users/index.tcl" "Users"] [list "../users/user-owned-objects.tcl" "Object Ownership"] [list "../users/one-user-specific-objects.tcl?owner=$owner&object_type=TABLE" "Tables"] [list "describe-table.tcl?object_name=$owner.$object_name" "One Table"] "Add comment"] + +
    +" + +# begin form ------------------------------------------------------------------------------------ +ns_write " + + +

    +" + + +# we do two seperate queries: one for the table (0 or 1) +# and one for the columns (0, 1, or many) +# note that these same queries are similar to +# those run in /objects/describe-table.tcl, excpet +# I do not have the not null conditions + +set table_comment_query " +-- /objects/add-comments.tcl +-- get table comments +-- +select + dtc.comments as table_comment +from + DBA_TAB_COMMENTS dtc +where + dtc.owner='$owner' +and dtc.table_name='$object_name' + -- do NOT need to make sure there really is a comment +-- and dtc.comments is not null +" +if { [string compare $show_sql_p "t" ]==0 } { + ns_write "\n" +} + +set column_comment_query " +-- /objects/add-comments.tcl +-- get column comments +select + dtc.column_id, + dtc.column_name, + dcc.comments as column_comment +from + DBA_COL_COMMENTS dcc, + dba_tab_columns dtc +where + -- join dtc to dcc + -- dtc is getting involved so I can order by column_id + dcc.owner = dtc.owner +and dcc.table_name = dtc.table_name +and dcc.column_name = dtc.column_name + -- specify table to dcc +and dcc.owner='$owner' +and dcc.table_name='$object_name' + -- specify table to dtc + -- this is obviuosly redundant (given the join), + -- but it helps performance on these Oracle + -- data dictionary views +and dtc.owner='$owner' +and dtc.table_name='$object_name' + -- do NOT need to make sure there really is a comment +-- and dcc.comments is not null +order by + dtc.column_id +" +if { [string compare $show_sql_p "t" ]==0 } { + ns_write "\n" +} + + +# run table query (already have db handle) +# deal with nulls (is this necessary?) +set selection [ns_db 0or1row $db $table_comment_query] +if {[string compare $selection ""]!=0 } { + set_variables_after_query +} else { + set table_comment "" +} +# write user input text box for table comment +# need to quote value arg in case it contains spaces +ns_write " +

    Table: $object_name

    +" + +# run column query (already have db handle) +# and output rows as form text areas with comuted names +# I create variable names like "columnComment_1", etc. +# so the "...-2" page needs to know about this format +set selection [ns_db select $db $column_comment_query] +while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write " +

    Column $column_id: $column_name

    + " +} + +# close up form -------------------------------------------------------------------- +ns_write " +
    • +" + + +# close up page -------------------------------------------------------------------- +ns_write " +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/monitoring/cassandracle/objects/describe-object.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/cassandracle/objects/describe-object.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/cassandracle/objects/describe-object.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,41 @@ +# describe-object.tcl,v 3.0 2000/02/06 03:25:22 ron Exp +set_form_variables +set page_name "Description of $object_name" +set object_info [split $object_name .] +set owner [lindex $object_info 0] +set object_name [lindex $object_info 1] +ReturnHeaders +set db [cassandracle_gethandle] + +set description_info [database_to_tcl_list_list_and_column_names $db "select column_name as 'Column Name', data_type || '(' || data_length || ') ' || DECODE(nullable, 'Y', '', 'N', 'NOT NULL', '?') as 'Data Type' from dba_tab_columns where owner='$owner' and table_name='$object_name'"] + +set description_data [lindex $description_info 0] +set description_columns [lindex $description_info 1] +set column_html "" +foreach column_heading $description_columns { + append column_html "$column_heading" +} + +ns_write " +[ad_admin_header $page_name] + +$column_html +" +if {[llength $description_data]==0} { + ns_write "" +} else { + set column_data_html "" + for {set i 0} {$i<[llength $desciption_columns]} {incr i} { + append column_data_html "" + } + foreach row $description_data { + ns_write "[subst $column_data_html]\n" + } +} +ns_write "
    No data found
    \[lindex \$row $i\]
    \n +

    +Here is the SQL responsible for this information:

    +describe $object_name + +[ad_admin_footer] +" Index: web/openacs/www/admin/monitoring/cassandracle/objects/describe-table.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/cassandracle/objects/describe-table.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/cassandracle/objects/describe-table.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,664 @@ +# describe-table.tcl,v 3.0 2000/02/06 03:25:23 ron Exp +# called from ../users/one-user-specific-objects.tcl + +set_form_variables + +# check arguments ----------------------------------------------------- + +# it is not clear to me whey we have one object_name argument here +# of the format OWBER.TABLE_NAME that needs to be parsed, rather than +# two seperate arguments? + +# $object_type REQUIRED ARGUMENT +if { ![info exists object_name] } { + ns_returnerror 500 "Missing \$object_name (format: OWBER.TABLE_NAME)" + return +} +set object_info [split $object_name .] +set owner [lindex $object_info 0] +set object_name [lindex $object_info 1] + + +# check parameter to see if we want to display SQL as comments +# actually harcoded now during development, but will use ns_info later + +set show_sql_p "t" + +# arguments OK, get database handle, start building page ---------------------------------------- + +set page_name "Description of table $owner.$object_name" +ReturnHeaders +set db [cassandracle_gethandle] +ns_write " + +[ad_admin_header "$page_name"] + +

    $page_name

    + +[ad_admin_context_bar [list "/admin/monitoring" "Monitoring"] [list "/admin/monitoring/cassandracle" "Cassandracle"] [list "/admin/monitoring/cassandracle/users/" "Users"] [list "/admin/monitoring/cassandracle/users/user-owned-objects.tcl" "Objects" ] [list "/admin/monitoring/cassandracle/users/one-user-specific-objects.tcl?owner=$owner&object_type=TABLE" "One Object Type"] "One Object"] + + +
    +" + + +ns_write "\n" +# tabular display of column names, datatypes, etc ------------------------------- +# the main table that displays column datatype information +# also shows foreign keys and primary keys. The foreign +# key is shown as a link to the appropriate parent table. +# The SQL is rather complicated. It does an outer join +# from the list of columns to two subqueries: one for +# priomary keys, and the other for foreign keys. Since +# the SQL and subqueries are complicated, I use Tcl to +# form the subqueries, send them out as HTML comments, +# and include them in the main query. This makes the main +# query easier to maintain, and the subqueries can be snagged +# from the browser 'view source' and run as standalone +# queries for testing, etc. + + +# build the foreign key subquery, display as comment, then use below +set fk_subquery " + -- /objects/describe-table.tcl + -- subquery to get foreign key data for a given child table + -- can be run as stand-alone + select + chld_tbl.table_name as child_table_name, + chld_col.column_name as child_column_name, + chld_tbl.constraint_name as child_fk_constraint_name, + prnt_tbl.table_name as parent_table_name, + chld_tbl.r_constraint_name as parent_pk_constraint_name, + '(FK)' as fk_display_flag + from + dba_constraints prnt_tbl, + dba_cons_columns chld_col, + dba_constraints chld_tbl + where + -- start with child table name and owner + chld_tbl.owner = '$owner' + and chld_tbl.table_name = '$object_name' + -- get only foreign key constraints for child table + and chld_tbl.constraint_type = 'R' + -- get column names for each constraint + and chld_tbl.constraint_name = chld_col.constraint_name + -- join child FK constraint to parent PK constraint + and chld_tbl.r_constraint_name = prnt_tbl.constraint_name + -- The remaining two criteria help performance. + -- Our test case runs in 0.10 second with BOTH criteria: we + -- gave up after 20 seconds without prnt_tbl criterion, and + -- it took about six seconds without chld_tbl criterion. + -- Our use of these critera limits our display to foreign keys + -- and parents that have the same owner as the child table. + and prnt_tbl.owner = '$owner' + and chld_col.owner = '$owner' +" +if { [string compare $show_sql_p "t" ]==0 } { + ns_write "\n" +} + +set pk_subquery " + -- /objects/describe-table.tcl + -- subquery to get primary key data for a given table + -- can be run as stand-alone + select + dc1.table_name, + dcc1.column_name, + dcc1.constraint_name, + '(PK)' as pk_display_flag + from + dba_cons_columns dcc1, + dba_constraints dc1 + where + -- select constraints for this table + dc1.owner='$owner' + and dc1.table_name = '$object_name' + -- limit to only primary key constraints + and dc1.constraint_type = 'P' + -- link to dba_cons_columns to get column names + and dc1.constraint_name = dcc1.constraint_name + -- specify owner for preformance (takes 5 seconds without) + and dcc1.owner = '$owner' +" +if { [string compare $show_sql_p "t" ]==0 } { + ns_write "\n" +} + +set ak_constraint_subquery " + -- /objects/describe-table.tcl + -- subquery to get alternate keys implemented as constraints + -- can be run as stand-alone + select + dc2.table_name, + dcc2.column_name, + dcc2.constraint_name, + '(AKc)' as akc_display_flag + from + dba_cons_columns dcc2, + dba_constraints dc2 + where + -- select constraints for this table + dc2.owner='$owner' + and dc2.table_name = '$object_name' + -- limit to only unique constraints + and dc2.constraint_type = 'U' + -- link to dba_cons_columns to get column names + and dc2.constraint_name = dcc2.constraint_name + -- specify owner for preformance (takes 5 seconds without) + and dcc2.owner = '$owner' +" +if { [string compare $show_sql_p "t" ]==0 } { + ns_write "\n" +} + +set ak_index_subquery " + -- /objects/describe-table.tcl + -- subquery to get alternate keys implemented as indexes + -- can be run as stand-alone + select + di.table_name, + dic.column_name, + dic.index_name, + '(AKi)' as aki_display_flag + from + dba_ind_columns dic, + dba_indexes di + where + -- select indexes for this table + di.owner='ACS' + and di.table_name = '$object_name' + -- limit to only unique indexes + and di.uniqueness = 'UNIQUE' + -- link to dba_ind_columns to get column names + and di.index_name = dic.index_name + -- specify owner for preformance (takes 5 seconds without) + and dic.table_owner = '$owner' + -- but we do not want primary key index constraints + and not exists + (select + dc3.constraint_name + from + dba_constraints dc3 + where + -- PK constrain name = unique index name + dc3.constraint_name = di.index_name + -- the following are redundant, but help performance + -- select constraints for this table + and dc3.owner='$owner' + and dc3.table_name = '$object_name' + -- limit to only primary key constraints + and dc3.constraint_type = 'P') +" +if { [string compare $show_sql_p "t" ]==0 } { + ns_write "\n" +} + + +# build the SQL and write out as comment +set main_query " +-- /objects/describe-table.tcl +-- includes pk_subquery and fk_subquery +select + dtc.column_name, + dtc.data_type, + dtc.data_scale, + dtc.data_precision, + dtc.data_length, + dtc.nullable, + pk.pk_display_flag, + fk.fk_display_flag, + fk.parent_table_name, + akc.akc_display_flag, + aki.aki_display_flag +from + DBA_TAB_COLUMNS dtc, + ($fk_subquery) fk, + ($pk_subquery) pk, + ($ak_constraint_subquery) akc, + ($ak_index_subquery) aki +where + dtc.owner='$owner' +and dtc.table_name='$object_name' +and dtc.table_name = pk.table_name(+) +and dtc.column_name = pk.column_name(+) +and dtc.table_name = fk.child_table_name(+) +and dtc.column_name = fk.child_column_name(+) +and dtc.table_name = akc.table_name(+) +and dtc.column_name = akc.column_name(+) +and dtc.table_name = aki.table_name(+) +and dtc.column_name = aki.column_name(+) +order by + dtc.column_id +" +if { [string compare $show_sql_p "t" ]==0 } { + ns_write "\n" +} + + + + +# specify output columns 1 2 3 4 5 6 7 +set description_columns [list "Column Name" "Datatype" "NULL?" "PK?" "FK?" "AK(c)?" "AK(i)?"] +set column_html "" +foreach column_heading $description_columns { + append column_html "$column_heading" +} + +# begin main table +ns_write " + +$column_html +" + +# run query (already have db handle) and output rows +set selection [ns_db select $db $main_query] +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + # start row + set row_html "\n" + + # 1) column_name + append row_html " \n" + + # 2) datatype + set datatype_list [list $data_type $data_scale $data_precision $data_length ] + append row_html " \n" + + # 3) null - replace with non-breaking space if Y, otherwise say NOT NULL + if { [string compare $nullable "Y"]==0 } { + set nullable " " + } else { + set nullable "NOT NULL" + } + append row_html " \n" + + # 4) PK - replace with non-breaking space if null + if { [string compare $pk_display_flag ""]==0 } { + set pk_display_flag " " + } + append row_html " \n" + + # 5) FK - replace with non-breaking space if null + # otherwise make a link to parent table (assumes same owner) + if { [string compare $fk_display_flag ""]==0 } { + set fk_display_flag " " + } else { + set fk_display_flag "$fk_display_flag" + } + append row_html " \n" + + # 6) AK constraint - replace with non-breaking space if null + if { [string compare $akc_display_flag ""]==0 } { + set akc_display_flag " " + } + append row_html " \n" + + # 6) AK index - replace with non-breaking space if null + if { [string compare $aki_display_flag ""]==0 } { + set aki_display_flag " " + } + append row_html " \n" + + # close up row + append row_html "\n" + + # write row + ns_write "$row_html" +} + +# close up table +ns_write "
    $column_name[cassandracle_format_data_type_column $datatype_list]$nullable$pk_display_flag$fk_display_flag$akc_display_flag$aki_display_flag
    \n" + + +ns_write "\n" +# display comments on tables and columns, if any exist ------------------------------- +ns_write "
    " + +# we do two seperate queries: one for the table (0 or 1) +# and one for the columns (0, 1, or many) +# note that these same queries are run in /objects/add-comments.tcl + +set table_comment_query " +-- /objects/describe-table.tcl +-- get table comments +select + dtc.comments as table_comment +from + DBA_TAB_COMMENTS dtc +where + dtc.owner='$owner' +and dtc.table_name='$object_name' +and dtc.comments is not null +" +if { [string compare $show_sql_p "t" ]==0 } { + ns_write "\n" +} + +# run query (already have db handle) and row +# if it exists as a paragraph of plain text +# (hmmm... one could probably put some strange HTML +# in the comment that could be good or bad!) +set selection [ns_db 0or1row $db $table_comment_query] +if {[string compare $selection ""]!=0 } { + set_variables_after_query + ns_write "

    $table_comment

    " +} + + +set column_comment_query " +-- /objects/describe-table.tcl +-- get column comments +select + dtc.column_id, + dtc.column_name, + dcc.comments as column_comment +from + DBA_COL_COMMENTS dcc, + dba_tab_columns dtc +where + -- join dtc to dcc + -- dtc is getting involved so I can order by column_id + dcc.owner = dtc.owner +and dcc.table_name = dtc.table_name +and dcc.column_name = dtc.column_name + -- specify table to dcc +and dcc.owner='$owner' +and dcc.table_name='$object_name' + -- specify table to dtc + -- this is obviuosly redundant (given the join), + -- but it helps performance on these Oracle + -- data dictionary views +and dtc.owner='$owner' +and dtc.table_name='$object_name' + -- make sure there really is a comment +and dcc.comments is not null +order by + dtc.column_id +" +if { [string compare $show_sql_p "t" ]==0 } { + ns_write "\n" +} + + +# run query (already have db handle) +# and output rows as emphasized text (not table) +set selection [ns_db select $db $column_comment_query] +while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "

    $column_name: $column_comment

    " +} + + +ns_write " +

    Add or update comments on this table or its columns

    +" + + +ns_write "\n" +# display child tables, if any exist ------------------------------- +ns_write "
    " + +# it would be nice to do this as a CONNECT BY query to get all children, +# but dba_constraints is a view, and you will get a ORA-01437 error. +# it might be possible to wrte some procedure or use a tmp table, but later... + + +# build the SQL and write out as comment +set child_query " +-- /objects/describe-table.tcl +-- get child tables based on actual foreign key constraints +select + c2.table_name as child, + c2.constraint_name as fk +from + dba_constraints c1, + dba_constraints c2 +where + -- specify parent table + c1.table_name = '$object_name' +and c1.owner = '$owner' + -- get primary key of this table (parent) +and c1.constraint_type = 'P' + -- get foreign key constraints in children + -- equal to parent primary key +and c2.constraint_type = 'R' +and c2.r_constraint_name = c1.constraint_name + -- redundantly specifying this owner + -- speeds up query by a factor of 30 or so +and c2.owner = '$owner' +order by + c2.table_name +" + +if { [string compare $show_sql_p "t" ]==0 } { + ns_write "\n" +} + +# I do not want to show an empty table, +# so I initialize a flag to a value of "f" +# then I flip it to 't' on the first row (after doing table header) +set at_least_one_row_already_retrieved "f" + +# run query (already have db handle) +set selection [ns_db select $db $child_query] +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + if { [string compare $at_least_one_row_already_retrieved "f"]==0 } { + + # we get here only on first row, + # so I start the table and flip the flag + + set at_least_one_row_already_retrieved "t" + + # table title + ns_write "

    This table has the following child tables.

    " + + # specify output columns 1 2 + set description_columns [list "Child Table" "Constraint" ] + set column_html "" + foreach column_heading $description_columns { + append column_html "$column_heading" + } + + # begin main table + ns_write " + + $column_html + " + # end of first row tricks + } + + ns_write " + + + + + " +} + +# close up table if present, otherwise indicate that there were none +if { [string compare $at_least_one_row_already_retrieved "t"]==0 } { + ns_write "
    $child$fk

    \n" +} else { + ns_write "

    This table has no child tables.

    " +} + + + +ns_write "\n" +# display constraints, if any exist ------------------------------------------- +ns_write "
    " + +# build the SQL and write out as comment +set constraint_query " +-- /objects/describe-table.tcl +-- get constraints +-- http://oradoc.photo.net/ora81/DOC/server.815/a67790/ch2.htm#1175 +-- I include all dba_constraint columns, but comment out those which I do not need +select + dc.constraint_name, + dcc.column_name, + dc.constraint_type, + -- use decode to decode these codes! + decode(dc.constraint_type,'C','table check constraint', + 'P','primary key', + 'U','unique key', + 'R','referential integrity', + 'V','view check option', + 'O','view with read only', + 'unknown') as decoded_constraint_type, + dc.search_condition, + dc.r_owner, + dc.r_constraint_name, + -- get table name so we can make a link + dc2.table_name as r_table_name, + dc.delete_rule, + dc.status, + -- dc.deferrable, + -- dc.deferred, + dc.validated, + -- dc.generated, + -- dc.bad, + dc.last_change +from + dba_constraints dc, + -- these inline views speed up performance drastically in databases + -- with many objects, but they do assume that parent are owned + -- by the same owner as the child table + (select table_name, constraint_name + from dba_constraints + where owner = '$owner') dc2, + (select column_name, constraint_name + from dba_cons_columns + where owner = '$owner' + and table_name = '$object_name') dcc +where + -- join dc and dcc + dc.constraint_name = dcc.constraint_name + -- user (Tcl) specifies table and owner +and dc.owner = '$owner' +and dc.table_name = '$object_name' + -- obviously need outer join here since most + -- constraints are NOT foreign keys +and dc.r_constraint_name = dc2.constraint_name (+) +order by + dc.constraint_name, + dcc.column_name +" + +if { [string compare $show_sql_p "t" ]==0 } { + ns_write "\n" +} + +# I do not want to show an empty table, +# so I initialize a flag to a value of "f" +# then I flip it to 't' on the first row (after doing table header) +set at_least_one_row_already_retrieved "f" + +# run query (already have db handle) +set selection [ns_db select $db $constraint_query] +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + if { [string compare $at_least_one_row_already_retrieved "f"]==0 } { + + # we get here only on first row, + # so I start the table and flip the flag + + set at_least_one_row_already_retrieved "t" + + # table title + ns_write "

    This table has the following constraints

    " + + + # specify output columns 1 2 3 4 5 6 7 8 9 + set description_columns [list "Constraint" "Column" "Type" "Condition" "Parent" "Delete Rule" "Status" "Validity" "Changed" ] + set column_html "" + foreach column_heading $description_columns { + append column_html "$column_heading" + } + + # begin main table + ns_write " + + $column_html + " + + # end of first row tricks + } + + # start row + set row_html "\n" + + # 1) constraint_name + append row_html " \n" + + # 2) column_name - set lower case since not in cut-and-paste + set column_name [string tolower $column_name] + append row_html " \n" + + # 3) decoded_constraint_type - set lower case since not on cut-paste-paste + set decoded_constraint_type [string tolower $decoded_constraint_type] + append row_html " \n" + + # 4) search_condition - replace with non-breaking space if null + if { [empty_string_p $search_condition] } { + set search_condition " " + } + append row_html " \n" + + # 5) r_table_name - replace with non-breaking space if null + # othwise replace with link to parent + if { [empty_string_p $r_table_name] } { + set r_table_name " " + } else { + set r_table_name "[string tolower $r_table_name]" + } + append row_html " \n" + + # 6) delete_rule - replace with non-breaking space if null + # else set to lower to save space since will not be cut-and-paste + if { [empty_string_p $delete_rule] } { + set delete_rule " " + } else { + set delete_rule [string tolower $delete_rule] + } + append row_html " \n" + + # 7 status - set to lower case since it will not be cut-and-paste + # never null + set status [string tolower $status] + append row_html " \n" + + # 8 validated - set to lower case since it will not be cut-and-paste + # never null + set validated [string tolower $validated] + append row_html " \n" + + # 9 last_change - never null + append row_html " \n" + + # close up row + append row_html "\n" + + # write row + ns_write "$row_html" +} + + +# close up table if present, otherwise indicate that there were none +if { [string compare $at_least_one_row_already_retrieved "t"]==0 } { + ns_write "
    $constraint_name$column_name$decoded_constraint_type$search_condition$r_table_name$delete_rule$status$validated$last_change

    \n" +} else { + ns_write "

    This table has no constraints! Why?.

    " +} + +ns_write " +

    See other constraints for this user.

    \n" + + +ns_write " +[ad_admin_footer] +" Index: web/openacs/www/admin/monitoring/cassandracle/objects/detail-function-or-procedure.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/cassandracle/objects/detail-function-or-procedure.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/cassandracle/objects/detail-function-or-procedure.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,41 @@ +# detail-function-or-procedure.tcl,v 3.0 2000/02/06 03:25:25 ron Exp +set_form_variables + +# object_name, owner + +set page_name $object_name + +set db [cassandracle_gethandle] + +set the_query " +select + text +from + DBA_SOURCE +where + name='$object_name' and owner='$owner' +order by + line" + +set description [join [database_to_tcl_list $db $the_query]] + +ReturnHeaders +ns_write " + +[ad_admin_header "Space usage"] + +

    Space usage

    + + +[ad_admin_context_bar [list "/admin/monitoring" "Monitoring"] [list "/admin/monitoring/cassandracle" "Cassandracle"] [list \"/admin/monitoring/cassandracle/users/\" "Users"] [list "/admin/monitoring/cassandracle/users/user-owned-objects.tcl" "Objects" ] [list "/admin/monitoring/cassandracle/users/one-user-specific-objects.tcl?owner=ACS&object_type=FUNCTION" "Functions"] "One"] + +
    +

    +

    $description
    +

    +The SQL: +

    +$the_query
+
    +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/monitoring/cassandracle/objects/list-all-functions-and-procedures.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/cassandracle/objects/list-all-functions-and-procedures.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/cassandracle/objects/list-all-functions-and-procedures.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,70 @@ +# list-all-functions-and-procedures.tcl,v 3.0 2000/02/06 03:25:26 ron Exp +set page_name "PL/SQL Functions and Procedures by User" +ReturnHeaders +set db [cassandracle_gethandle] + +ns_write " +[ad_admin_header $page_name] +

    $page_name

    + +[ad_admin_context_bar [list "/admin/monitoring" "Monitoring"] [list "/admin/monitoring/cassandracle" "Cassandracle"] "All Functions and Procedures"] + + +
    + + +" + +set object_info [database_to_tcl_list_list $db " +select + owner, object_name, object_type, created, status +from + dba_objects +where + (object_type='FUNCTION' or object_type='PROCEDURE') +group by + owner, object_type, object_name, created, status +order by + owner, object_name"] + +if {[llength $object_info]==0} { + ns_write "" +} else { + set current_user "" + + foreach row $object_info { + if {$current_user==""} { + set current_user [lindex $row 0] + ns_write "\n" + continue + } + if {[lindex $row 0]!=$current_user} { + set current_user [lindex $row 0] + ns_write "\n" + } else { + ns_write "\n" + } +} +} +ns_write " +
    OwnerObject NameObject TypeDate CreatedStatus
    No objects found!
    [lindex $row 0][lindex $row 1][lindex $row 2][lindex $row 3][lindex $row 4]
    [lindex $row 0][lindex $row 1][lindex $row 2][lindex $row 3][lindex $row 4]
     [lindex $row 1][lindex $row 2][lindex $row 3][lindex $row 4]
    + +

    + +The SQL: + +

    +select
+  owner, object_name, object_type, created, status
+from
+  dba_objects
+where
+  (object_type='FUNCTION' or object_type='PROCEDURE')
+group by
+  owner, object_type, object_name, created, status
+order by
+  owner, object_name
+
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/monitoring/cassandracle/performance/data-block-waits.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/cassandracle/performance/data-block-waits.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/cassandracle/performance/data-block-waits.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,47 @@ +# data-block-waits.tcl,v 3.0 2000/02/06 03:25:27 ron Exp +set db [cassandracle_gethandle] + +set the_query "select + A.Value, B.Count from V\$PARAMETER A, V\$WAITSTAT B +where + (A.Name = 'db_writers' or A.Name = 'dbwr_io_slaves') + and B.Class = 'data block'" + +set wait_info [database_1row_to_tcl_list $db $the_query] + +ReturnHeaders +ns_write " + +[ad_admin_header "Data Block Waits"] + +

    Data Block Waits

    + +[ad_admin_context_bar [list "/admin/" "Admin Home"] [list "/admin/monitoring" "Monitoring"] [list "/admin/monitoring/cassandracle" "Cassandracle"] "Data Block Waits"] + +
    + +
    + + + + + + + +
    Number of DBWR processCumulative Data Block Waits
    [lindex $wait_info 0][lindex $wait_info 1]
    + +
    + +Data Block Waits are cumulative since database startup. If the number +is excessive, you can increase the number of DBWR processes. + +

    +The SQL: +

    +$the_query
+
    + +[annotated_archive_reference 78] + +[ad_admin_footer] +" Index: web/openacs/www/admin/monitoring/cassandracle/performance/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/cassandracle/performance/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/cassandracle/performance/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,21 @@ +# index.tcl,v 3.0 2000/02/06 03:25:28 ron Exp +ns_return 200 text/html " +[ad_admin_header "Performance"] + +

    Performance

    + +[ad_admin_context_bar [list "/admin/monitoring" "Monitoring"] [list "/admin/monitoring/cassandracle" "Cassandracle"] "Performance"] + + +
    + + + + +[ad_admin_footer] +" Index: web/openacs/www/admin/monitoring/cassandracle/performance/pct-large-table-scans.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/cassandracle/performance/pct-large-table-scans.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/cassandracle/performance/pct-large-table-scans.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,97 @@ +# pct-large-table-scans.tcl,v 3.0 2000/02/06 03:25:30 ron Exp +set db [ns_db gethandle] + +set the_query " +select + A.Value, B.Value +from + V\$SYSSTAT A, V\$SYSSTAT B +where + A.Name = 'table scans (long tables)' and B.Name = 'table scans (short tables)'" + +set scan_info [database_1row_to_tcl_list $db $the_query] + +ReturnHeaders +ns_write " + +[ad_admin_header "Table Scans"] + +

    Table Scans

    + +[ad_admin_context_bar [list "/admin/monitoring" "Monitoring"] [list "/admin/monitoring/cassandracle" "Cassandracle"] "Table scans"] + +
    + +If you have a high percentage of large table scans, you want to see if +those tables have been indexed, and whether the queries accessing them +are written in such a way to take advantage of the indicies. + +

    + + + +

    + + + + + + + +
    # Large Table Scans# Small Table Scans% Large Scans
    [lindex $scan_info 0][lindex $scan_info 1][format %4.2f [expr 100*(double([lindex $scan_info 0])/double([lindex $scan_info 0]+[lindex $scan_info 1]))]]
    + +
    + +

    +The SQL: +

    +$the_query
+
    +

    +SQL queries resulting in more than 100 disk reads: + +

    + + + +" + +set disk_read_query "select + sql_text, disk_reads, loads, optimizer_cost, parsing_user_id, serializable_aborts, au.username +from + v\$sql, all_users au +where + disk_reads > 100 +and + parsing_user_id = au.user_id" + +set selection [ns_db select $db $disk_read_query] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write " + + + + + + + + + +" +} + +ns_write " +
    User NameDisk ReadsLoadsOptimizer Cost
    $username (id $parsing_user_id)$disk_reads$loads$optimizer_cost
    SQL: $sql_text
    +
    + +The SQL: +
    +$disk_read_query
+
    + +[annotated_archive_reference 69] + +[ad_admin_footer] +" Index: web/openacs/www/admin/monitoring/cassandracle/tablespaces/space-usage.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/cassandracle/tablespaces/space-usage.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/cassandracle/tablespaces/space-usage.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,88 @@ +# space-usage.tcl,v 3.0 2000/02/06 03:25:31 ron Exp +set db [ns_db gethandle] +set block_size [database_to_tcl_string $db {select value from v$parameter where name='db_block_size'}] + +ReturnHeaders +ns_write " + +[ad_admin_header "Space usage"] + +

    Space usage

    + +[ad_admin_context_bar [list "/admin/monitoring" "Monitoring"] [list "/admin/monitoring/cassandracle" "Cassandracle"] "Space Usage"] + +
    +Database Block Size is $block_size bytes.
    + + +" + +set the_query " +select + FS.tablespace_name, File_Name, SUM(FS.Blocks) as remaining, + DF.Blocks as total_space, SUM(FS.bytes), maxextend*$block_size, + inc*$block_size +from + DBA_FREE_SPACE FS, DBA_DATA_FILES DF, SYS.FILEXT\$ +where + FS.File_Id = DF.File_id and FS.File_id=File#(+) +group by + FS.tablespace_name, File_Name, DF.Blocks, maxextend, inc +order by + FS.tablespace_name, File_Name" + +set tablespace_usage_info [database_to_tcl_list_list $db $the_query] + +if {[llength $tablespace_usage_info]==0} { + ns_write "" +} else { + set current_tablespace "" + set ts_total_sum 0 + set ts_remaining_sum 0 + + foreach row $tablespace_usage_info { + if {[lindex $row 6]==""} { + set last_columns "" + } else { + set last_columns "" + } + + if {$current_tablespace==""} { + set include_summary 0 + ns_write "$last_columns\n" + set current_tablespace [lindex $row 0] + incr ts_total_sum [lindex $row 3] + incr ts_remaining_sum [lindex $row 2] + continue + } + if {[lindex $row 0]!=$current_tablespace} { + #finish the remaining tablespace + if {$include_summary} { + ns_write "\n\n" + } + set ts_total_sum 0 + set ts_remaining_sum 0 + set include_summary 0 + ns_write "$last_columns\n" + incr ts_total_sum [lindex $row 3] + incr ts_remaining_sum [lindex $row 2] + } else { + ns_write "$last_columns\n" + set include_summary 1 + incr ts_total_sum [lindex $row 3] + incr ts_remaining_sum [lindex $row 2] + } +} + +} +ns_write "
    TablespaceFileBytes RemainingBlocks RemainingTotal BlocksMaximum Extended Size (Bytes)Extension Increment (Bytes)
    No tablespaces found!
    Autoextend OffAutoextend Off[lindex $row 5][lindex $row 6]
    [lindex $row 0][lindex $row 1][lindex $row 4][lindex $row 2][lindex $row 3]
    Sum for $current_tablespace: $ts_remaining_sum out of $ts_total_sum blocks remain.
    [lindex $row 0][lindex $row 1][lindex $row 4][lindex $row 2][lindex $row 3]
     [lindex $row 1][lindex $row 4][lindex $row 2][lindex $row 3]
    \n +

    +The SQL: +

    +$the_query
+
    +[annotated_archive_reference "318 and 334"] +

    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/monitoring/cassandracle/users/concurrent-active-users.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/cassandracle/users/concurrent-active-users.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/cassandracle/users/concurrent-active-users.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,44 @@ +# concurrent-active-users.tcl,v 3.0 2000/02/06 03:25:32 ron Exp +set page_name "Concurrent Active Users" +set db [cassandracle_gethandle] +db_query_to_vars $db "select * from V\$LICENSE" +if {$sessions_max=="0"} {set sessions_max "unspecified."} +if {$sessions_warning=="0"} {set sessions_warning "No warning level specified."} +if {$users_max=="0"} {set users_max "unspecified."} + + +ns_return 200 text/html " + +[ad_admin_header "$page_name"] + +

    $page_name

    + +[ad_admin_context_bar [list "/admin/monitoring" "Monitoring"] [list "/admin/monitoring/cassandracle" "Cassandracle"] [list \"/admin/monitoring/cassandracle/users/\" "Users"] [list "/admin/monitoring/cassandracle/users/user-owned-objects.tcl" "Objects" ] "One Object"] + + +
    + +
      + +

      What you paid for

      + +
    • LICENSE_MAX_SESSIONS: $sessions_max +
    • LICENSE_SESSIONS_WARNING: $sessions_warning +
    • LICENSE_MAX_USERS: $users_max + + +

      What you're actually doing

      + +
    • Number current sessions: $sessions_current +
    • Sessions Highwater Mark: $sessions_highwater + +
    + +The SQL: + +
    +select * from V\$LICENSE
+
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/monitoring/cassandracle/users/hit-ratio.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/cassandracle/users/hit-ratio.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/cassandracle/users/hit-ratio.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,63 @@ +# hit-ratio.tcl,v 3.0 2000/02/06 03:25:33 ron Exp +ReturnHeaders + +ns_write " + +[ad_admin_header "Hit ratio"] + +

    Hit ratio

    + +[ad_admin_context_bar [list "/admin/monitoring" "Monitoring"] [list "/admin/monitoring/cassandracle" "Cassandracle"] "Hit ratio"] + +
    + +The hit ratio is the percentage of block gets that were satisfied from +the block cache in the SGA (RAM). The number of physical reads shows +the times that Oracle had to go to disk to get table information. Hit +ratio should be at least 98% for anything except a data warehouse. + + +
    + + +" +set db [ns_db gethandle] + +set the_query " +select + username, consistent_gets, block_gets, physical_reads +from + V\$SESSION, V\$SESS_IO +where + V\$SESSION.SID = V\$SESS_IO.SID and (Consistent_gets + block_gets > 0) and Username is not null" + +set object_ownership_info [database_to_tcl_list_list $db $the_query] + +if {[llength $object_ownership_info]==0} { + ns_write "" +} else { + foreach row $object_ownership_info { + ns_write "\n" + } +} +ns_write "
    UsernameConsistent GetsBlock GetsPhysical ReadsHit Ratio
    No objects found!
    [lindex $row 0][lindex $row 1][lindex $row 2][lindex $row 3][format %4.2f [expr 100*(double([lindex $row 1]+[lindex $row 2]-[lindex $row 3])/double([lindex $row 1]+[lindex $row 2]))]]%
    + +
    + +

    + +The SQL: + +

    +select 
+  username, consistent_gets, block_gets, physical_reads 
+from 
+  V\$SESSION, V\$SESS_IO 
+where
+  V\$SESSION.SID = V\$SESS_IO.SID and (Consistent_gets + block_gets > 0) and Username is not null
+
    + +[annotated_archive_reference 38] + +[ad_admin_footer] +" Index: web/openacs/www/admin/monitoring/cassandracle/users/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/cassandracle/users/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/cassandracle/users/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,31 @@ +# index.tcl,v 3.0 2000/02/06 03:25:34 ron Exp +#what we want to know for a user: +#info about a session +#info about ownership +#space usage + + +ns_return 200 text/html " + +[ad_admin_header "Users"] + +

    Users

    + +[ad_admin_context_bar [list "/admin/monitoring" "Monitoring"] [list "/admin/monitoring/cassandracle" "Cassandracle"] "Users"] + +
    + + +[ad_admin_footer] +" Index: web/openacs/www/admin/monitoring/cassandracle/users/one-session-info.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/cassandracle/users/one-session-info.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/cassandracle/users/one-session-info.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,100 @@ +# one-session-info.tcl,v 3.0 2000/02/06 03:25:35 ron Exp +set_form_variables + +# sid + +set db [ns_db gethandle] + +set session_query "select + S.username, S.osuser, S.machine, S.terminal, + S.process, P.spid, S.program session_info, S.serial# as serial +from + V\$SESSION S, V\$PROCESS P +where + P.Addr = S.Paddr and S.sid='$sid'" + +db_query_to_vars $db " +$session_query +" + +if { ![empty_string_p $username] } { + set page_name "Session Information for $username" +} else { + set page_name "Session Information for sid #$sid" +} + +ReturnHeaders + +ns_write " + +[ad_admin_header "Session #$sid"] + +

    Session #$sid

    + +[ad_admin_context_bar [list "/admin/monitoring" "Monitoring"] [list "/admin/monitoring/cassandracle" "Cassandracle"] [list "sessions-info.tcl" "Open sessions"] "One session"] + + +
    +
    + + + + + + + + + +
    Session Id$sid
    Serial #$serial
    Username:$username
    Local Account:$osuser
    Connecting From:$machine ($terminal)
    Client PID:$process
    Server PID:$spid
    Client Progam:$session_info
    +
    + +

    +You may be interested in a list of all active sessions. +

    +Here is the SQL responsible for this information:

    +

    +$session_query
+
    + +[annotated_archive_reference 393] + +

    + +Looking for current SQL available from this user:
    +

    +" + +set sql_text [string trim [join [database_to_tcl_list $db " +select + sql_text +from + v\$sqltext st, v\$session s +where + s.sql_address=st.address and s.sql_hash_value=st.hash_value and s.sid='$sid' +order by + piece"] ""]] + +if {$sql_text==""} { + set sql_text "No SQL available to report for this session." +} +ns_write " +$sql_text +
    +

    +Here is the SQL responsible for this information:

    +

    +select 
+  sql_text 
+from 
+  v\$sqltext st, v\$session s 
+where 
+  s.sql_address=st.address and s.sql_hash_value=st.hash_value and s.sid='$sid'
+order by 
+  piece
+
    + + + +

    +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/monitoring/cassandracle/users/one-user-constraints.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/cassandracle/users/one-user-constraints.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/cassandracle/users/one-user-constraints.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,215 @@ +# one-user-constraints.tcl,v 3.0 2000/02/06 03:25:37 ron Exp +# called from ??? + +set_form_variables + +set show_sql_p "t" + +# check arguments ----------------------------------------------------- + +# $object_type REQUIRED ARGUMENT +if { ![info exists owner] } { + ns_returnerror 500 "Missing \$owner (format: OWBER)" + return +} + +# $order OPTIONAL ARGUMENT, BUT NEED TO SET DEFAULT +if { ![info exists order] } { + set order "constraint_name" +} + + +# arguments OK, start building page ---------------------------------------- + +set page_name "Constraints owned by $owner" +ReturnHeaders +set db [cassandracle_gethandle] + +ns_write " + +[ad_admin_header "$page_name"] + +

    $page_name

    + +[ad_admin_context_bar [list "/admin/monitoring" "Monitoring"] [list "/admin/monitoring/cassandracle" "Cassandracle"] [list "/admin/monitoring/cassandracle/users/" "Users"] [list "/admin/monitoring/cassandracle/users/user-owned-constraints.tcl" "Constraints" ] "One User Constraints"] + + +
    +" + +# build the SQL and write out as comment +set constraint_query " +-- cassandracle/users/one-user-constraints.tcl +-- get constraints +-- http://oradoc.photo.net/ora81/DOC/server.815/a67790/ch2.htm#1175 +-- I include all dba_constraint columns, but comment out those which I do not need +select + dc.constraint_name, + dc.table_name, + dc.constraint_type, + -- use decode to decode these codes! + decode(dc.constraint_type,'C','table check constraint', + 'P','primary key', + 'U','unique key', + 'R','referential integrity', + 'V','view check option', + 'O','view with read only', + 'unknown') as decoded_constraint_type, + dc.search_condition, + dc.r_owner, + dc.r_constraint_name, + -- get table name so we can make a link + dc2.table_name as r_table_name, + dc.delete_rule, + dc.status, + -- dc.deferrable, + -- dc.deferred, + dc.validated, + -- dc.generated, + -- dc.bad, + dc.last_change +from + dba_constraints dc, + -- inline view for performance + -- this drops execution time from 40+ seconds + -- to a couple seconds, but limits retrival to + -- parents of the same owner as the child (which + -- is probably just fine) + (select table_name, constraint_name + from dba_constraints + where owner = '$owner') dc2 +where + -- user (Tcl) specifies table and owner + dc.owner = '$owner' + -- obviously need outer join here since most + -- constraints are NOT foreign keys + -- note that inline view dc2 already limited to current owner + -- so we will not get table names if they are owned by others +and dc.r_constraint_name = dc2.constraint_name (+) +order by + $order +" +if { [string compare $show_sql_p "t" ]==0 } { + ns_write "\n" +} + +# I do not want to show an empty table, +# so I initialize a flag to a value of "f" +# then I flip it to 't' on the first row (after doing table header) +set at_least_one_row_already_retrieved "f" + +# run query (already have db handle) +set selection [ns_db select $db $constraint_query] +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + if { [string compare $at_least_one_row_already_retrieved "f"]==0 } { + + # we get here only on first row, + # so I start the table and flip the flag + + set at_least_one_row_already_retrieved "t" + + # table title + ns_write "

    This user has the following constraints

    " + + + # specify output columns + # 1 + set description_columns [list "Constraint" ] + lappend description_columns "Table" + lappend description_columns "Type" + # can not sort on LONG + lappend description_columns "Condition" + lappend description_columns "Parent" + lappend description_columns "Delete Rule" + lappend description_columns "Status" + lappend description_columns "Validity" + lappend description_columns "Changed" + set column_html "" + foreach column_heading $description_columns { + append column_html "$column_heading" + } + + # begin main table + ns_write " + + $column_html + " + + # end of first row tricks + } + + # start row + set row_html "\n" + + # 1) constraint_name + append row_html " \n" + + # 2) table_name - set lower case LINK since not in cut-and-paste + set table_name "[string tolower $table_name]" + append row_html " \n" + + # 3) decoded_constraint_type - set lower case since not on cut-paste-paste + set decoded_constraint_type [string tolower $decoded_constraint_type] + append row_html " \n" + + # 4) search_condition - replace with non-breaking space if null + if { [empty_string_p $search_condition] } { + set search_condition " " + } + append row_html " \n" + + # 5) r_table_name - replace with non-breaking space if null + # othwise replace with link to parent + if { [empty_string_p $r_table_name] } { + set r_table_name " " + } else { + set r_table_name "[string tolower $r_table_name]" + } + append row_html " \n" + + # 6) delete_rule - replace with non-breaking space if null + # else set to lower to save space since will not be cut-and-paste + if { [empty_string_p $delete_rule] } { + set delete_rule " " + } else { + set delete_rule [string tolower $delete_rule] + } + append row_html " \n" + + # 7 status - set to lower case since it will not be cut-and-paste + # never null + set status [string tolower $status] + append row_html " \n" + + # 8 validated - set to lower case since it will not be cut-and-paste + # never null + set validated [string tolower $validated] + append row_html " \n" + + # 9 last_change - never null + append row_html " \n" + + # close up row + append row_html "\n" + + # write row + ns_write "$row_html" +} + + +# close up table if present, otherwise indicate that there were none +if { [string compare $at_least_one_row_already_retrieved "t"]==0 } { + ns_write "
    $constraint_name$table_name$decoded_constraint_type$search_condition$r_table_name$delete_rule$status$validated$last_change

    \n" +} else { + ns_write "

    This user has no constraints! Why?.

    " +} + + +ns_write " +
    +

    More information:

    +

    See Oracle documentation about view dba_constraints on which this page is based.

    +[ad_admin_footer] +" Index: web/openacs/www/admin/monitoring/cassandracle/users/one-user-specific-objects.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/cassandracle/users/one-user-specific-objects.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/cassandracle/users/one-user-specific-objects.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,131 @@ +# one-user-specific-objects.tcl,v 3.0 2000/02/06 03:25:38 ron Exp +# called from ./user-owned-objects.tcl + +set_form_variables + +# check arguments ----------------------------------------------------- + +# $object_type REQUIRED ARGUMENT +if { ![info exists object_type] } { + ns_returnerror 500 "Missing \$object_type" + return +} +# $owner REQUIRED ARGUMENT +if { ![info exists owner] } { + ns_returnerror 500 "Missing \$owner" + return +} + +# $order OPTIONAL ARGUMENT, BUT NEED TO SET DEFAULT +if { ![info exists order] } { + set order "object_name" +} + +# $order TWO VALUES ONLY ARE VALID +if { [string compare $order "object_name"] != 0 && [string compare $order "last_ddl_time"] != 0 } { + ns_returnerror 500 "Invalid value of \$order: $order, Valid values include only \"object_name\" and \"last_ddl_time\" " + return +} + +# $order - If order is "last_ddl_time", then order descending +if { [string compare $order "last_ddl_time"]==0 } { + append order " DESC" +} + + + +# arguments OK, start building page ---------------------------------------- + +set page_name "Objects of type $object_type owned by $owner" +ReturnHeaders +set db [cassandracle_gethandle] + +ns_write " + +[ad_admin_header "$page_name"] + +

    $page_name

    + +[ad_admin_context_bar [list "/admin/monitoring" "Monitoring"] [list "/admin/monitoring/cassandracle" "Cassandracle"] [list \"/admin/monitoring/cassandracle/users/\" "Users"] [list "/admin/monitoring/cassandracle/users/user-owned-objects.tcl" "Objects" ] "One Object Type"] + + +
    +" + +# set $href variable used for linking from object_name column of table (after substitution) +if {$object_type=="FUNCTION"||$object_type=="PROCEDURE"} { + set href "\[lindex \$row 0]" +} elseif {$object_type=="TABLE"||$object_type=="VIEW"} { + set href "\[lindex \$row 0]" +} else { + set href "\[lindex \$row 0\]" +} + + +# build the SQL and write out as comment +set the_query " +-- /users/one-user-specific-objects.tcl +select + do.object_name, + do.created, + do.last_ddl_time, + lower(do.status) as status +from + dba_objects do +where + do.owner='$owner' +and do.object_type='$object_type' +order by + $order +" +ns_write "" + +# write the table headers +# put sort links in as appropriate +# headers depend on sort order, I use a switch for future flexibility +switch -exact -- $order { + "object_name" { + set object_name_header "Object Name" + set last_ddl_time_header "Last DDL" + } + "last_ddl_time DESC" { + set object_name_header "Object Name" + set last_ddl_time_header "Last DDL" + } +} + +ns_write " + + + + + + + +" + +# run query +set object_ownership_info [database_to_tcl_list_list $db $the_query] + +# output rows +if {[llength $object_ownership_info]==0} { + ns_write "" +} else { + foreach row $object_ownership_info { + ns_write " + + + + + + \n" + } +} + +# close up shop +ns_write "
    $object_name_headerCreated$last_ddl_time_headerStatus
    No objects found!
    [subst $href]  [lindex $row 1][lindex $row 2][lindex $row 3]
    +
    +

    More information:

    +

    See Oracle documentation about view dba_objects on which this page is based.

    +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/monitoring/cassandracle/users/sessions-info.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/cassandracle/users/sessions-info.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/cassandracle/users/sessions-info.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,134 @@ +# sessions-info.tcl,v 3.0 2000/02/06 03:25:39 ron Exp +# called from ../users/one-user-specific-objects.tcl + +set_form_variables 0 + +set show_sql_p "t" + +# get database handle, start building page + +ReturnHeaders + +ns_write " + +[ad_admin_header "Open sessions"] + +

    Open sessions

    + +[ad_admin_context_bar [list "/admin/monitoring" "Monitoring"] [list "/admin/monitoring/cassandracle" "Cassandracle"] "Open sessions"] + + +
    +" + +# make SQL + +set db [ns_db gethandle] +# set up for dynamic re-ordering + +set order_by [export_var order_by username] + +set session_sql " +-- /users/sessions-info.tcl +-- get session info +select + v\$session.sid, + username, + osuser, + process, + program, + type, + terminal, + to_char(logon_time, 'YYYY-MM-DD HH24:MI') as logon_time, + round((sysdate()-logon_time)*24,2) as hours_ago, + serial# as serial, + v\$session_wait.seconds_in_wait as n_seconds, + status +from v\$session, v\$session_wait +where v\$session.sid = v\$session_wait.sid +order by $order_by +" + +# start building table ----------------------------------- + + +# specify output columns 1 2 3 4 5 6 7 8 9 10 +set description_columns [list "Session" "Serial#" "Oracle user" "Program" "Seconds in wait" "Active/Inactive" "UNIX user" "UNIX pid" "Type" "tty" "Logged in" "Hours ago" ] +set column_html "" +foreach column_heading $description_columns { + append column_html "$column_heading" +} + +# begin main table +ns_write " + +$column_html +" + +# run query (already have db handle) and output rows +set selection [ns_db select $db $session_sql] +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + # start row + set row_html "\n" + + # 1) session + append row_html " \n" + + # 2) Serial number + append row_html " " + + # 3) Oracle user + if { [string compare $username ""]==0 } { + set username " " + } + + append row_html " \n" + + # 4) Program + append row_html " \n" + + # 6) Session length + append row_html " \n" + + # 7) Unix user + append row_html " \n" + + # 8) Unix PID + append row_html " \n" + + # 9) session type + append row_html " \n" + + # 10) tty + if { [string compare $terminal ""]==0 } { + set terminal " " + } + append row_html " \n" + + # 10) logged in + append row_html " \n" + + # 11) hours ago + append row_html " \n" + + # close up row + append row_html "\n" + + # write row + ns_write "$row_html" +} + +# close up table +ns_write "
    $sid$serial$username$program\n" + + # 5) Session length + append row_html " $n_seconds$status$osuser$process$type$terminal$logon_time$hours_ago
    \n +

    +See \"Be Wary of SQLPlus\" in Oracle Tips for how this page be useful in killing hung database sessions. +(Any queries that are ACTIVE and have a high \"Seconds in wait\" +are good canidates to consider killing.) + +[ad_admin_footer] +" Index: web/openacs/www/admin/monitoring/cassandracle/users/space-usage.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/cassandracle/users/space-usage.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/cassandracle/users/space-usage.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,47 @@ +# space-usage.tcl,v 3.0 2000/02/06 03:25:41 ron Exp +set page_name "Tablespace Block Allocation by User" +ReturnHeaders +set db [cassandracle_gethandle] + +ns_write " +[ad_admin_header $page_name] +This table sums up the blocks allocated in each segment of a tablespace by a user.

    + + +" + + +#"select username, tablespace_name, blocks, max_blocks from dba_ts_quotas order by username, tablespace_name" + +set tablespace_usage_info [database_to_tcl_list_list $db "select S.owner, S.tablespace_name, sum(S.blocks), DF.Blocks from dba_segments S, DBA_DATA_FILES DF where S.tablespace_name=DF.tablespace_name group by S.owner, S.tablespace_name, DF.Blocks order by S.owner, S.tablespace_name, DF.blocks"] + +if {[llength $tablespace_usage_info]==0} { + ns_write "" +} else { + set current_user "" + + foreach row $tablespace_usage_info { + if {$current_user==""} { + ns_write "\n" + set current_user [lindex $row 0] + continue + } + if {[lindex $row 0]!=$current_user} { + #finish the remaining tablespace + ns_write "\n" + set current_user [lindex $row 0] + } else { + ns_write "\n" + } +} +} +ns_write "
    UserTablespace NameBlocks AllocatedTotal Space for this Tablespace
    No data segments found!
    [lindex $row 0][lindex $row 1][lindex $row 2][lindex $row 3]
    [lindex $row 0][lindex $row 1][lindex $row 2][lindex $row 3]
     [lindex $row 1][lindex $row 2][lindex $row 3]
    \n +

    +Here is the SQL responsible for this information:

    +select S.owner, S.tablespace_name, sum(S.blocks), DF.Blocks
    +from dba_segments S, DBA_DATA_FILES DF
    +where S.tablespace_name=DF.tablespace_name
    +group by S.owner, S.tablespace_name, DF.Blocks
    +order by S.owner, S.tablespace_name, DF.blocks     +[ad_admin_footer] +" Index: web/openacs/www/admin/monitoring/cassandracle/users/user-owned-constraints.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/cassandracle/users/user-owned-constraints.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/cassandracle/users/user-owned-constraints.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,147 @@ +# user-owned-constraints.tcl,v 3.0 2000/02/06 03:25:42 ron Exp +# called from ??? + +# set_form_variables + +set show_sql_p "t" + +# check arguments ----------------------------------------------------- + +# (none) + +# arguments OK, start building page ---------------------------------------- + +set page_name "User Owned Constraints" +ReturnHeaders +set db [cassandracle_gethandle] + +ns_write " + +[ad_admin_header "$page_name"] + +

    $page_name

    + +[ad_admin_context_bar [list "/admin/monitoring" "Monitoring"] [list "/admin/monitoring/cassandracle" "Cassandracle"] [list "/admin/monitoring/cassandracle/users/" "Users"] "Constraints"] + + +
    +" + +# build the SQL and write out as comment +set constraint_query " +-- cassandracle/users/user-owned-constraints.tcl +-- get constraints +-- http://oradoc.photo.net/ora81/DOC/server.815/a67790/ch2.htm#1175 +select + dc.owner, + -- use decode to decode these codes! + decode(dc.constraint_type,'C','table check constraint', + 'P','primary key', + 'U','unique key', + 'R','referential integrity', + 'V','view check option', + 'O','view with read only', + 'unknown') as decoded_constraint_type, + count(dc.constraint_name) as constraint_count +from + dba_constraints dc +where + -- do not need system tables + dc.owner not in ('SYS','SYSTEM') +group by + dc.owner, + dc.constraint_type +order by + dc.owner, + dc.constraint_type +" +if { [string compare $show_sql_p "t" ]==0 } { + ns_write "\n" +} + +# I do not want to show an empty table, +# so I initialize a flag to a value of "f" +# then I flip it to 't' on the first row (after doing table header) +set at_least_one_row_already_retrieved "f" + +# run query (already have db handle) +set selection [ns_db select $db $constraint_query] +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + if { [string compare $at_least_one_row_already_retrieved "f"]==0 } { + + # we get here only on first row, + # so I start the table and flip the flag + set at_least_one_row_already_retrieved "t" + + # I want to suppress display of owner on rows after the first + # one in which it shows up - I will use this for cpmparison + set last_row_owner "" + + # table title + ns_write "

    This instance has the following constraints

    " + + + # specify output columns + # 1 + set description_columns [list "Owner" ] + lappend description_columns "Type" + lappend description_columns "Count" + set column_html "" + foreach column_heading $description_columns { + append column_html "$column_heading" + } + + # begin main table + ns_write " + + $column_html + " + + # end of first row tricks + } + + # start row + set row_html "\n" + + # 1) owner + if { [string compare $owner $last_row_owner]==0 } { + # same owner as before so we suppress its display + append row_html "" + } else { + # new owner, so we store and display + set last_row_owner $owner + append row_html " \n" + } + + # 2) decoded_constraint_type + append row_html " \n" + + # 3) constraint_count + append row_html " \n" + + + # close up row + append row_html "\n" + + # write row + ns_write "$row_html" +} + +# close up table if present, otherwise indicate that there were none +if { [string compare $at_least_one_row_already_retrieved "t"]==0 } { + ns_write "
     $owner$decoded_constraint_type$constraint_count

    \n" +} else { + ns_write "

    This instance has no constraints! Why?.

    " +} + + +# I am thinking about adding a table of disabled constraints + +ns_write " +
    +

    More information:

    +

    See Oracle documentation about view dba_constraints on which this page is based.

    +[ad_admin_footer] +" Index: web/openacs/www/admin/monitoring/cassandracle/users/user-owned-objects.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/cassandracle/users/user-owned-objects.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/cassandracle/users/user-owned-objects.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,57 @@ +# user-owned-objects.tcl,v 3.0 2000/02/06 03:25:43 ron Exp +ReturnHeaders +ns_write " + +[ad_admin_header "User owned objects"] + +

    User owned objects

    + +[ad_admin_context_bar [list "/admin/monitoring" "Monitoring"] [list "/admin/monitoring/cassandracle" "Cassandracle"] [list "/admin/monitoring/cassandracle/users/index.tcl" "Users"] "Objects"] + +
    + + +" + +set db [cassandracle_gethandle] + + +set the_query " +select + owner, object_type, count(*) +from + dba_objects +where + owner<>'SYS' +group by + owner, object_type" + +set object_ownership_info [database_to_tcl_list_list $db $the_query] + +if {[llength $object_ownership_info]==0} { + ns_write "" +} else { + set current_user "" + + foreach row $object_ownership_info { + if {$current_user==""} { + set current_user [lindex $row 0] + ns_write "\n" + continue + } + if {[lindex $row 0]!=$current_user} { + set current_user [lindex $row 0] + ns_write "\n" + } else { + ns_write "\n" + } +} +} +ns_write "
    OwnerObject TypeCount
    No objects found!
    [lindex $row 0][lindex $row 1][lindex $row 2]
    [lindex $row 0][lindex $row 1][lindex $row 2]
     [lindex $row 1][lindex $row 2]
    \n +

    +The SQL: +

    +$the_query
+
    +[ad_admin_footer] +" Index: web/openacs/www/admin/monitoring/configuration/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/configuration/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/configuration/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,16 @@ +# index.tcl,v 3.0 2000/02/06 03:25:45 ron Exp +ns_return 200 text/html "[ad_admin_header "[ad_system_name] Configuration"] + +

    [ad_system_name] Configuration

    + +[ad_admin_context_bar [list "/admin/monitoring/index.tcl" "Monitoring"] "Configuration"] + +
    + + +[ad_admin_footer] +" Index: web/openacs/www/admin/monitoring/watchdog/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/monitoring/watchdog/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/monitoring/watchdog/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,45 @@ +# index.tcl,v 3.0 2000/02/06 03:25:46 ron Exp +set_form_variables 0 +# kbytes + +if {![info exists kbytes] || [empty_string_p $kbytes]} { + if ![info exists num_minutes] { + set kbytes 200 + } else { + set kbytes "" + } +} + +if ![empty_string_p $kbytes] { + set bytes [expr $kbytes * 1000] +} else { + set bytes "" +} + +if {![info exists num_minutes]} { + set num_minutes "" +} + +ns_return 200 text/html "[ad_admin_header "WatchDog"] + +

    WatchDog

    + +[ad_admin_context_bar [list "/admin/monitoring/index.tcl" "Monitoring"] "WatchDog"] + +
    + +
    +Errors from the last Kbytes of error log. + +
    + +
    +Errors from the last minutes of error log. +
    + +
    +[ns_quotehtml [wd_errors "$num_minutes" "$bytes"]]
+
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/neighbor/category-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/neighbor/category-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/neighbor/category-add-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,130 @@ +# category-add-2.tcl,v 3.0 2000/02/06 03:25:47 ron Exp +set_form_variables + +# category_id, user_id_from_search, category_name +# first_names_from_search, last_name_from_search, email_from_search +# approval_policy + +# submit + + +# user error checking + +set exception_text "" +set exception_count 0 + + +if { ![info exist primary_category] || [empty_string_p $primary_category] } { + incr exception_count + append exception_text "
  • Please enter a category name." +} + + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + + + +ReturnHeaders + +ns_write "[neighbor_header "$primary_category values"] + +

    $primary_category values

    + +in [neighbor_system_name] administration +
    + +
    +[export_form_vars primary_category] +" + +set db [ns_db gethandle] + +# edit the form vars so we can use the magic insert/update +ns_set delkey [ns_conn form] submit +ns_set delkey [ns_conn form] user_id_from_search +ns_set delkey [ns_conn form] last_name_from_search +ns_set delkey [ns_conn form] first_names_from_search +ns_set delkey [ns_conn form] email_from_search +ns_set update [ns_conn form] primary_maintainer_id $user_id_from_search + +# Check the database to see if there is a row for this category already. +# If there is a row, update the database with the information from the form. +# If there is no row, insert into the database with the information from the form. + +if { [database_to_tcl_string $db "select count(category_id) from n_to_n_primary_categories where category_id = $category_id"] > 0 } { + set sql_statement [util_prepare_update $db n_to_n_primary_categories category_id $category_id [ns_conn form]] +} else { + set sql_statement [util_prepare_insert $db n_to_n_primary_categories category_id $category_id [ns_conn form]] +} + + +if [catch { ns_db dml $db $sql_statement } errmsg] { + ad_return_error "Failure to update category information" "The database rejected the attempt: +
    +
    +$errmsg
+
    +
    +" + return +} + +# there is now a row for this category +# get the category information to fill in the form + +set selection [ns_db 1row $db "select * from n_to_n_primary_categories +where category_id = $category_id"] +set_variables_after_query + +ns_write " +

    User Interface

    +By default, the category name will be used for the user interface. +If you wish to use a different title, state it here:
    + +

    +Annotation for the top of the main category page:
    + +

    +We tell users what they are posting about. For example, if users will be commenting on experiences they have had buying items, you might use \"merchants\": +
    +

    +You can use the upper left corner of the category page to put an image or other custom HTML code. For example: +

    +
    +<a href=\"http://photo.net/photo/pcd3609/burano-main-square-6.tcl\">
+<img src=\"http://photo.net/photo/pcd3609/burano-main-square-6.1.jpg\" height=50 width=50>
+
    +
    + +Custom HTML code:
    +
    +

    +Annotation for users about to make a posting:
    + +

    Regional

    +Would you like users to have the option to show postings by region?" + +set html_form "Yes +No
    " + +if { [info exists regional_p] } { + ns_write [bt_mergepiece $html_form $selection] +} else { + ns_write $html_form +} + +ns_write "

    If so, what type of groupings? + + +

    + +
    +[export_form_vars category_id] +
    +[neighbor_footer] +" Index: web/openacs/www/admin/neighbor/category-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/neighbor/category-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/neighbor/category-add.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,59 @@ +# category-add.tcl,v 3.0 2000/02/06 03:25:49 ron Exp +set_form_variables 0 + +# either category_id or subcategory_id + +set db [ns_db gethandle] + +if { [info exists category_id] } { + # get the previous data + set selection [ns_db 1row $db "select n_to_n_primary_categories.*, +users.email from n_to_n_primary_categories, users +where category_id = $category_id +and users.user_id(+) = n_to_n_primary_categories.primary_maintainer_id"] + set_variables_after_query + set action "Edit category $primary_category" +} else { + set action "Add a new category" + # generate a new category_id to use + set category_id [database_to_tcl_string $db "select +nextval('n_to_n_primary_category_id_seq') from dual"] +} + +ReturnHeaders + +ns_write "[ad_admin_header "$action"] + +

    $action

    + +[ad_admin_context_bar [list "index.tcl" "Neighbor to Neighbor"] $action] + +
    + +
    + + + + +

    + +What would you like to call this category? +

    +Search for a user to be primary administrator of this domain by
    + + + + +
    Email address:
    or by
    Last name:
    +

    +What type of approval system would you like for new postings?
    + +

    + +
    +[export_form_vars category_id] +
    +[ad_admin_footer] +" Index: web/openacs/www/admin/neighbor/category-administrator-update-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/neighbor/category-administrator-update-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/neighbor/category-administrator-update-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,11 @@ +# category-administrator-update-2.tcl,v 3.0 2000/02/06 03:25:51 ron Exp +set_form_variables + +# category_id, user_id_from_search +# first_names_from_search, last_name_from_search, email_from_search + +set db [ns_db gethandle] + +ns_db dml $db "update n_to_n_primary_categories set primary_maintainer_id = $user_id_from_search where category_id = $category_id" + +ns_returnredirect "category.tcl?[export_url_vars category_id]" \ No newline at end of file Index: web/openacs/www/admin/neighbor/category-administrator-update.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/neighbor/category-administrator-update.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/neighbor/category-administrator-update.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,53 @@ +# category-administrator-update.tcl,v 3.0 2000/02/06 03:25:53 ron Exp +set_form_variables 0 + +# category_id + +set db [ns_db gethandle] + + +set selection [ns_db 1row $db "(select n_to_n_primary_categories.*, +users.email from n_to_n_primary_categories, users +where category_id = $category_id +and users.user_id = n_to_n_primary_categories.primary_maintainer_id) +union +(select n_to_n_primary_categories.*, +NULL as email from n_to_n_primary_categories +where category_id = $category_id +and n_to_n_primary_categories.primary_maintainer_id is NULL)"] + +set_variables_after_query +set action "Edit $primary_category administrator" + + +ReturnHeaders + +ns_write "[neighbor_header "$action"] + +

    $action

    + +[ad_admin_context_bar [list "index.tcl" "Neighbor to Neighbor"] [list "category.tcl?[export_url_vars category_id]" "One Category"] "Update Administrator"] + +
    + +
    + + + + +

    +

    +Search for a user to be primary administrator of this domain by
    + + + + +
    Email address:
    or by
    Last name:
    + +

    + +
    +[export_form_vars category_id] +
    +[neighbor_footer] +" Index: web/openacs/www/admin/neighbor/category-posts.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/neighbor/category-posts.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/neighbor/category-posts.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,75 @@ +# category-posts.tcl,v 3.0 2000/02/06 03:25:54 ron Exp +set_form_variables + +# category_id, optional all_p + +if { [info exists all_p] && $all_p } { + set extra_stipulation "" + set new_clause "" + set option "limit to last 30 days" +} else { + set extra_stipulation "within the last 30 days " + set new_clause "\nand posted > (sysdate() - 30)::datetime" + set option "view all postings" +} + +set db [ns_db gethandle] + +set primary_category [database_to_tcl_string $db "select primary_category +from n_to_n_primary_categories where category_id = $category_id"] + +ReturnHeaders + +ns_write "[ad_admin_header "$primary_category postings"] + +

    Postings

    + +$extra_stipulation + +

    + +[ad_admin_context_bar [list "index.tcl" "Neighbor to Neighbor"] [list "category.tcl?[export_url_vars category_id]" "One Category"] "Postings"] + +

    + +$option + +
      +" + + +set selection [ns_db select $db "select neighbor_to_neighbor_id, title, posted, about, upper(about) as sort_key, nn.approved_p, nns.subcategory_1, users.user_id, users.first_names || ' ' || users.last_name as poster_name +from neighbor_to_neighbor nn, n_to_n_subcategories nns, users +where nn.category_id = $category_id +and nn.subcategory_id = nns.subcategory_id +and (expires > sysdate() or expires is NULL) $new_clause +and nn.poster_user_id = users.user_id +order by posted desc"] + +set counter 0 +set items "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + incr counter + if [empty_string_p $title] { + set anchor $about + } else { + set anchor "$about : $title" + } + append items "
    • $anchor" + if { $approved_p == "f" } { + append items "  not approved" + } + append items " ($subcategory_1)\n" +} + +ns_write "$items + + +
    + + +[ad_admin_footer] +" + Index: web/openacs/www/admin/neighbor/category-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/neighbor/category-toggle.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/neighbor/category-toggle.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,12 @@ +# category-toggle.tcl,v 3.0 2000/02/06 03:25:56 ron Exp +set_form_variables + +# category_id + +set db [ns_db gethandle] + +ns_db dml $db "update n_to_n_primary_categories set +active_p = logical_negation(active_p) where category_id = $category_id" + +ns_returnredirect "index.tcl" + Index: web/openacs/www/admin/neighbor/category-update-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/neighbor/category-update-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/neighbor/category-update-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,73 @@ +# category-update-2.tcl,v 3.0 2000/02/06 03:25:59 ron Exp +set_form_variables + +# category_id, submit +# regional_p, region_type, top_title, top_blurb, +# noun_for_action, decorative_photo + + +# user error checking + +set exception_text "" +set exception_count 0 + + +if { ![info exist primary_category] || [empty_string_p $primary_category] } { + incr exception_count + append exception_text "
  • Please enter a category name." +} + +if { ![info exist noun_for_about] || [empty_string_p $noun_for_about] } { + incr exception_count + append exception_text "
  • Please enter what users are posting about." +} + +if { [info exist top_blurb] && [string length $top_blurb] > 4000 } { + incr exception_count + append exception_text "
  • Please limit the length of your category page annotation to 4000 characters." +} + +if { [info exist decorative_photo] && [string length $decorative_photo] > 400 } { + incr exception_count + append exception_text "
  • Please limit the length of your custom HTML code to 400 characters." +} + +if { [info exist pre_post_blurb] && [string length $pre_post_blurb] > 4000 } { + incr exception_count + append exception_text "
  • Please limit the length of your pre-posting annotation to 4000 characters." +} + +if { [info exist regional_p] && [string tolower $regional_p] != "t" && ![empty_string_p $region_type] } { + incr exception_count + append exception_text "
  • You selected a region type, but did not say \"Yes\" to group by region." +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +set db [ns_db gethandle] + +# edit the form vars so we can use the magic update +ns_set delkey [ns_conn form] submit + + +# Check the database to see if there is a row for this category already. +# If there is a row, update the database with the information from the form. +# If there is no row, insert into the database with the information from the form. + +set sql_statement [util_prepare_update $db n_to_n_primary_categories category_id $category_id [ns_conn form]] + +if [catch { ns_db dml $db $sql_statement } errmsg] { + ad_return_error "Failure to update category information" "The database rejected the attempt: +
    +
    +$errmsg
+
    +
    +" + return +} + +ns_returnredirect "category.tcl?[export_url_vars category_id]" \ No newline at end of file Index: web/openacs/www/admin/neighbor/category-update.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/neighbor/category-update.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/neighbor/category-update.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,89 @@ +# category-update.tcl,v 3.0 2000/02/06 03:26:01 ron Exp +set_form_variables + +# category_id + +set db [ns_db gethandle] + +# get the category information to fill in the form + +set selection [ns_db 1row $db "select * from n_to_n_primary_categories +where category_id = $category_id"] +set_variables_after_query + +ReturnHeaders + +ns_write "[neighbor_header "$primary_category values"] + +

    $primary_category values

    + +[ad_admin_context_bar [list "index.tcl" "Neighbor to Neighbor"] [list "category.tcl?[export_url_vars category_id]" "One Category"] "Update Category"] + + +
    + +
    + +

    Category name

    +What would you like to call this category? +

    + +

    User Interface

    +By default, the category name will be used for the user interface. +If you wish to use a different title, state it here:
    + +

    +Annotation for the top of the main category page:
    + +

    + +A singular noun for pages that have to say what users are posting +about. For example, if users will be commenting on experiences they +have had buying items, you might use \"merchant\": + +
    +

    +You can use the upper left corner of the category page to put an image or other custom HTML code. For example: +

    +
    +<a href=\"http://photo.net/photo/pcd3609/burano-main-square-6.tcl\">
+<img src=\"http://photo.net/photo/pcd3609/burano-main-square-6.1.jpg\" height=50 width=50>
+
    +
    + +Custom HTML code:
    +
    +

    +Annotation for users about to make a posting:
    + +

    +

    Regional

    +Would you like users to have the option to show postings by region?" + +set html_form "Yes +No
    +" + +if { [info exists regional_p] } { + ns_write [bt_mergepiece $html_form $selection] +} else { + ns_write $html_form +} + +ns_write "

    If so, what type of groupings? + + +

    Administration

    +What type of approval system would you like for new postings?
    + +
    + +
    +[export_form_vars category_id] +
    +[neighbor_footer] +" Index: web/openacs/www/admin/neighbor/category.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/neighbor/category.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/neighbor/category.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,87 @@ +# category.tcl,v 3.0 2000/02/06 03:26:02 ron Exp +set_form_variables + +# category_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select +* from n_to_n_primary_categories where +category_id = $category_id"] +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "$primary_category"] + +

    $primary_category

    + +[ad_admin_context_bar [list "index.tcl" "Neighbor to Neighbor"] "One Category"] + + +
    + +

    Statistics

    + +
      + +" + +set selection [ns_db 1row $db "select + count(*) as n_postings, + max(posted) as latest, + min(posted) as earliest +from neighbor_to_neighbor +where category_id = $category_id +and (expires > sysdate() or expires is NULL)"] +set_variables_after_query + +ns_write " +
    • Total postings: $n_postings +
    • From: [util_AnsiDatetoPrettyDate $earliest] +
    • To: [util_AnsiDatetoPrettyDate $latest] + +

      + +

    • User page: /neighbor/opc.tcl?category_id=$category_id +
    + + +

    Administration

    + +

    +Users will be asked to post in the +following subcategories: + +

    + +[ad_admin_footer] + +" Index: web/openacs/www/admin/neighbor/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/neighbor/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/neighbor/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,58 @@ +# index.tcl,v 3.0 2000/02/06 03:26:04 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "[neighbor_system_name]"] + +

    Neighbor to Neighbor Admin

    + +[ad_admin_context_bar "Neighbor to Neighbor"] + +
    + +
      +

      Active categories

      +" + +set db [neighbor_db_gethandle] + +set selection [ns_db select $db "select primary_category, category_id, active_p from n_to_n_primary_categories +order by active_p desc, upper(primary_category)"] + +set count 0 + + +set count 0 +set inactive_title_shown_p 0 + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $active_p == "f" } { + if { $inactive_title_shown_p == 0 } { + # we have not shown the inactive title yet + if { $count == 0 } { + ns_write "
    • No active categories" + } + set inactive_title_shown_p 1 + ns_write "

      Inactive categories

      " + } + set anchor "activate" + } else { + set anchor "deactivate" + } + + set_variables_after_query + + ns_write "
    • $primary_category ($anchor)\n" + incr count +} + +ns_write " +

      +

    • Add a category +
    + +[ad_admin_footer] + +" + + Index: web/openacs/www/admin/neighbor/posting-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/neighbor/posting-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/neighbor/posting-delete-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,47 @@ +# posting-delete-2.tcl,v 3.0 2000/02/06 03:26:06 ron Exp +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set_the_usual_form_variables + +# comment_id, content, html_p, submit, maybe return_url + +if {![info exists return_url]} { + set return_url "index.tcl" +} + +if {[regexp -nocase "cancel" $submit]} { + ns_return 200 text/html "comment not deleted" + return +} + +set db [ns_db gethandle] +set user_id [ad_get_user_id] + +if [catch { ns_db dml $db "begin transaction" + # insert into the audit table + ns_db dml $db "insert into general_comments_audit +(comment_id, user_id, ip_address, audit_entry_time, modified_date, content) +select comment_id, user_id, '[ns_conn peeraddr]', sysdate(), modified_date, content from general_comments where comment_id = $comment_id" + + ns_db dml $db "delete from general_comments where +comment_id=$comment_id" + + ns_db dml $db "end transaction" } errmsg] { + + # there was some other error with the comment update + ad_return_error "Error updating comment" "We couldn't update your comment. Here is what the database returned: +

    +

    +
    +$errmsg
+
    +
    +" +return +} + +ns_return 200 text/html "done" + Index: web/openacs/www/admin/neighbor/posting-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/neighbor/posting-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/neighbor/posting-delete.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,45 @@ +# posting-delete.tcl,v 3.0 2000/02/06 03:26:08 ron Exp +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set_form_variables + +# comment_id + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select comment_id, content, general_comments.html_p as comment_html_p +from general_comments +where comment_id = $comment_id"] + +if { $selection == "" } { + ad_return_error "Can't find comment" "Can't find comment $comment_id" + return +} + +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "Really delete comment" ] + +

    Really delete comment

    + +
    + + +
    +Do you really wish to delete the following comment? +
    +[util_maybe_convert_to_html $content $comment_html_p] +
    +
    + + +
    +[export_form_vars comment_id] +
    +[ad_admin_footer] +" Index: web/openacs/www/admin/neighbor/posting-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/neighbor/posting-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/neighbor/posting-edit-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,44 @@ +# posting-edit-2.tcl,v 3.0 2000/02/06 03:26:10 ron Exp +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set_the_usual_form_variables + +# comment_id, content, html_p, approved_p + +# check for bad input +if {![info exists content] || [empty_string_p $content] } { + ad_return_complaint 1 "
  • the comment field was empty" + return +} + +# user has input something, so continue on + +set db [ns_db gethandle] +set user_id [ad_get_user_id] + +if [catch { ns_db dml $db "begin transaction" + # insert into the audit table + ns_db dml $db "insert into general_comments_audit +(comment_id, user_id, ip_address, audit_entry_time, modified_date, content) +select comment_id, user_id, '[ns_conn peeraddr]', sysdate(), modified_date, content from general_comments where comment_id = $comment_id" + ns_ora clob_dml $db "update general_comments +set content = empty_clob(), html_p = '$html_p', approved_p = '$approved_p' +where comment_id = $comment_id returning content into :1" "$content" + ns_db dml $db "end transaction" } errmsg] { + + # there was some other error with the comment update + ad_return_error "Error updating comment" "We couldn't update your comment. Here is what the database returned: +

    +

    +
    +$errmsg
+
    +
    +" +return +} + +ns_return 200 text/html "done" Index: web/openacs/www/admin/neighbor/posting-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/neighbor/posting-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/neighbor/posting-edit.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,52 @@ +# posting-edit.tcl,v 3.0 2000/02/06 03:26:11 ron Exp +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set_form_variables + +# comment_id + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select comment_id, content, general_comments.html_p as comment_html_p, approved_p +from general_comments +where comment_id = $comment_id"] + + +if { $selection == "" } { + ad_return_error "Can't find comment" "Can't find comment $comment_id" + return +} + +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "Edit comment" ] + +

    Edit comment

    + +
    + +
    +
    +
    +Text above is + +
    +Approval status + +
    + +
    +[export_form_vars comment_id] +
    +
    +[ad_admin_footer] +" Index: web/openacs/www/admin/neighbor/subcategory-update-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/neighbor/subcategory-update-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/neighbor/subcategory-update-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,67 @@ +# subcategory-update-2.tcl,v 3.0 2000/02/06 03:26:12 ron Exp +set_form_variables + +# subcategory_id, category_id +# and all the subcategory parameters + +# user error checking + +set exception_text "" +set exception_count 0 + +if { ![info exist subcategory_1] || [empty_string_p $subcategory_1] } { + incr exception_count + append exception_text "
  • Please entry a subcategory name." +} + + +if { [info exist decorative_photo] && [string length $decorative_photo] > 400 } { + incr exception_count + append exception_text "
  • Please limit the length of your custom HTML code to 400 characters." +} + + +if { [info exist publisher_hint] && [string length $publisher_hint] > 4000 } { + incr exception_count + append exception_text "
  • Please limit the top annotation to 4000 characters." +} + +if { [info exist regional_p] && [string tolower $regional_p] != "t" && ![empty_string_p $region_type] } { + incr exception_count + append exception_text "
  • You selected a region type, but did not say \"Yes\" to group by region." +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +set db [ns_db gethandle] + +# edit the form vars so we can use the magic insert/update +ns_set delkey [ns_conn form] submit + + +# Check the database to see if there is a row for this subcategory already. +# If there is a row, update the database with the information from the form. +# If there is no row, insert into the database with the information from the form. + +if { [database_to_tcl_string $db "select count(subcategory_id) from n_to_n_subcategories where subcategory_id = $subcategory_id"] > 0 } { + set sql_statement [util_prepare_update $db n_to_n_subcategories subcategory_id $subcategory_id [ns_conn form]] +} else { + set sql_statement [util_prepare_insert $db n_to_n_subcategories subcategory_id $subcategory_id [ns_conn form]] +} + + +if [catch { ns_db dml $db $sql_statement } errmsg] { + ad_return_error "Failure to update subcategory information" "The database rejected the attempt: +
    +
    +$errmsg
+
    +
    +" + return +} + +ns_returnredirect "category.tcl?[export_url_vars category_id]" Index: web/openacs/www/admin/neighbor/subcategory-update.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/neighbor/subcategory-update.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/neighbor/subcategory-update.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,89 @@ +# subcategory-update.tcl,v 3.0 2000/02/06 03:26:20 ron Exp +set_form_variables 0 + +# either subcategory_id or category_id + +set db [ns_db gethandle] + +if { ![info exists subcategory_id] } { + set action "Add a subcategory" + # get the name of the category for the user + # interface + + set primary_category [database_to_tcl_string $db "select +primary_category from n_to_n_primary_categories where +category_id = $category_id"] + + # generate a new subcategory_id to use + set subcategory_id [database_to_tcl_string $db "select +nextval('n_to_n_subcategory_id_seq') from dual"] +} else { + # get the previous data + set selection [ns_db 1row $db "select n_to_n_subcategories.*, primary_category +from n_to_n_subcategories, n_to_n_primary_categories +where subcategory_id = $subcategory_id +and n_to_n_subcategories.category_id = n_to_n_primary_categories.category_id"] + set_variables_after_query + set action "Edit $subcategory_1" + +} + +ReturnHeaders + +ns_write "[neighbor_header "$action to $primary_category"] + +

    $action

    + +[ad_admin_context_bar [list "index.tcl" "Neighbor to Neighbor"] [list "category.tcl?[export_url_vars category_id]" "One Category"] "One Subcategory"] + +
    + +
    +" + +ns_write " +What would you like to call this subcategory? +

    +Annotation for the top of the main subcategory page:
    + +

    +You can use the upper right section of the +subcategory page to put an image or other custom HTML code. An +ALIGN=RIGHT is helpful. + +For example: +

    +
    +<a href=\"http://photo.net/photo/pcd3609/burano-main-square-6.tcl\">
+<img align=right src=\"http://photo.net/photo/pcd3609/burano-main-square-6.1.jpg\" height=50 width=50>
+
    +
    + +Custom HTML code:
    +
    +

    + +

    Regional

    +Would you like these entries to be grouped by region?" + +set html_form "Yes +No
    " + +if { [info exists regional_p] } { + ns_write [bt_mergepiece $html_form $selection] +} else { + ns_write $html_form +} + +ns_write "

    If so, what type of groupings? + +

    +

    + +
    +[export_form_vars subcategory_id category_id] +
    +[neighbor_footer] +" Index: web/openacs/www/admin/neighbor/toggle-approved-p.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/neighbor/toggle-approved-p.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/neighbor/toggle-approved-p.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,14 @@ +# toggle-approved-p.tcl,v 3.0 2000/02/06 03:26:21 ron Exp +set_form_variables + +# neighbor_to_neighbor_id + +set db [ns_db gethandle] + +ns_db dml $db "update neighbor_to_neighbor set approved_p = logical_negation(approved_p) where neighbor_to_neighbor_id = $neighbor_to_neighbor_id" + +ns_returnredirect "view-one.tcl?[export_url_vars neighbor_to_neighbor_id]" + + + + Index: web/openacs/www/admin/neighbor/view-one.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/neighbor/view-one.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/neighbor/view-one.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,109 @@ +# view-one.tcl,v 3.0 2000/02/06 03:26:22 ron Exp +# +# /admin/neighbor/view-one.tcl +# +# by philg@mit.edu sometime in 1998, ported from horrible +# old legacy Illustra-backed code from 1995 +# + +set_form_variables + +# neighbor_to_neighbor_id is set now + +set db [neighbor_db_gethandle] + +set selection [ns_db 0or1row $db "select about, title, body, html_p, posted, n.approved_p, users.user_id, users.first_names || ' ' || users.last_name as poster_name, n.category_id, pc.primary_category, nns.subcategory_1 +from neighbor_to_neighbor n, users, n_to_n_subcategories nns, n_to_n_primary_categories pc +where neighbor_to_neighbor_id = $neighbor_to_neighbor_id +and n.subcategory_id = nns.subcategory_id +and users.user_id = n.poster_user_id +and n.category_id = pc.category_id"] + +if { $selection == "" } { + # user is looking at an old posting + ad_return_error "Bad story id" "Couldn't find posting number $neighbor_to_neighbor_id. + +

    + +Probably you've bookmarked an old story +that has been deleted by the moderator." + return +} + +# found the row + +set_variables_after_query + +if [empty_string_p $title] { + set headline $about +} else { + set headline "$about : $title" +} + + +ReturnHeaders + +ns_write "[neighbor_header $headline] + +

    $headline

    + +posted in $subcategory_1 $primary_category + +
    " + +ns_write " +
      +
    • Status: +" + +if {$approved_p == "t" } { + ns_write "Approved (Revoke)" +} else { + ns_write "Awaiting approval (Approve)" +} + + +ns_write " +
    +
    + +[util_maybe_convert_to_html $body $html_p] +
    +
    +-- $poster_name, [util_AnsiDatetoPrettyDate $posted] +
    + +" + +if [ad_parameter SolicitCommentsP neighbor 1] { + # see if there are any comments on this story + set selection [ns_db select $db "select comment_id, content, comment_date, general_comments.approved_p as comment_approved_p, first_names || ' ' || last_name as commenter_name, users.user_id as comment_user_id, html_p as comment_html_p +from general_comments, users +where on_what_id= $neighbor_to_neighbor_id +and on_which_table = 'neighbor_to_neighbor' +and general_comments.user_id = users.user_id"] + + set first_iteration_p 1 + while {[ns_db getrow $db $selection]} { + set_variables_after_query + if $first_iteration_p { + ns_write "

    Comments

    \n" + set first_iteration_p 0 + } + ns_write "
    \n[util_maybe_convert_to_html $content $comment_html_p]\n" + ns_write "

    -- $commenter_name (edit)\n" + if {$comment_approved_p == "t" } { + ns_write "    Approved (Revoke)" + } else { + ns_write "    Awaiting approval (Approve)" + } + ns_write "
    " + } + ns_write " +
    + Add a comment +
    + " +} + +ns_write [ad_admin_footer] Index: web/openacs/www/admin/neighbor/lumping/delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/neighbor/lumping/delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/neighbor/lumping/delete.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,11 @@ +# delete.tcl,v 3.0 2000/02/06 03:26:14 ron Exp +set_form_variables + +# neighbor_to_neighbor_id + +set db [neighbor_db_gethandle] + +ns_db dml $db "delete from neighbor_to_neighbor where neighbor_to_neighbor_id = $neighbor_to_neighbor_id" + +ns_return 200 text/plain "Deleted posting $neighbor_to_neighbor_id" + Index: web/openacs/www/admin/neighbor/lumping/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/neighbor/lumping/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/neighbor/lumping/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,41 @@ +# index.tcl,v 3.0 2000/02/06 03:26:15 ron Exp +set db [neighbor_db_gethandle] + +ReturnHeaders + +ns_write "[neighbor_header [neighbor_system_name]] + +

    Neighbor to Neighbor Admin

    + +
    + +

    Lumpen Categorization

    + +
      + +" + + + set selection [ns_db select $db "select count(neighbor_to_neighbor_id) as count,subcategory_1 +from neighbor_to_neighbor +where domain = 'photo.net' +and primary_category = 'photographic' +group by subcategory_1 +order by subcategory_1"] + + while {[ns_db getrow $db $selection]} { + + set_variables_after_query + set url "lump-into-about.tcl?subcategory_1=[ns_urlencode $subcategory_1]" + ns_write "
    • $subcategory_1 ($count postings)" + } + +ns_write " + +
    + +[neighbor_footer] + +" + + Index: web/openacs/www/admin/neighbor/lumping/lump-into-about-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/neighbor/lumping/lump-into-about-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/neighbor/lumping/lump-into-about-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,41 @@ +# lump-into-about-2.tcl,v 3.0 2000/02/06 03:26:17 ron Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +# lump_about, lump_ids + +set lump_ids [util_GetCheckboxValues [ns_conn form] lump_ids] + +if { $lump_ids == 0 } { + ns_return 200 text/plain "oops! You didn't pick any posting" +} + +set db [neighbor_db_gethandle] + +ReturnHeaders + +ns_write "[neighbor_header "lumping"] + +

    Lumping

    + +
    + +Going to lump + +
    + +[join $lump_ids ","] + +
    + +into \"$lump_about\" ..." + +ns_db dml $db "update neighbor_to_neighbor +set about = '$QQlump_about' +where neighbor_to_neighbor_id in ([join $lump_ids ","])" + +ns_write "... done. + +[neighbor_footer] +" + Index: web/openacs/www/admin/neighbor/lumping/lump-into-about.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/neighbor/lumping/lump-into-about.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/neighbor/lumping/lump-into-about.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,88 @@ +# lump-into-about.tcl,v 3.0 2000/02/06 03:26:18 ron Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +# subcategory_1 + +ReturnHeaders + +ns_write "[neighbor_header "Lumping $subcategory_1 Postings"] + +

    Lumping $subcategory_1 Postings

    + +together by the about column in [neighbor_system_name] + +
    + +When users don't categorize things very well, e.g., spell \"KEH Photo\" +differently in two different postings, then you can use this page to +fix things up. + +

    + +Pick what you want to be the canonical About value: + +

    + +

    + + + + +
      + +" + +set db [neighbor_db_gethandle] + +set selection [ns_db select $db "select neighbor_to_neighbor_id, +users.email as poster_email, one_line, posted, about, upper(about) as sort_key +from neighbor_to_neighbor, users +where domain = 'photo.net' and +primary_category = 'photographic' +and subcategory_1 = '[DoubleApos $subcategory_1]' +and (expires > sysdate or expires is NULL) +and users.user_id = neighbor_to_neighbor.poster_user_id +order by sort_key, posted desc"] + +set last_about "" +set first_pass 1 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $sort_key != $last_about } { + if { $first_pass != 1 } { + # not first time through, separate + ns_write "

      \n" + } + set first_pass 0 + set last_about $sort_key + } + if { $one_line == "" } { + set anchor $about + } else { + set anchor "$about : $one_line" + } + ns_write "

    • + + +
      +$anchor + (by $poster_email on $posted) + + Pick +
      +" + +} + +ns_write "
    + +
    + +

    + +Please contribute to making this a useful service by +posting your own story. + +[neighbor_footer] +" Index: web/openacs/www/admin/news/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/news/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/news/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,103 @@ +# +# /www/admin/news/index.tcl +# +# main admin news page +# +# Author: jkoontz@arsdigita.com March 8, 2000 +# +# index.tcl,v 3.1 2000/03/10 23:45:54 jkoontz Exp + +set db [ns_db gethandle] + +append page_content " +[ad_admin_header "News Administration"] +

    News Administration

    +[ad_admin_context_bar "News"] +
    +
      +" + +set selection [ns_db select $db " +select n.title, n.news_item_id, n.approval_state, n.release_date, + case when ng.group_id=NULL then 0 else ng.group_id end as group_id, + expired_p(n.expiration_date) as expired_p, + case when ng.scope= 'all_users' then 'All users' + when ng.scope= 'registered_users' then 'All registered users' + when ng.scope= 'public' then 'Public' + when ng.scope= 'group' then 'Group' end as fancy_scope, scope, + user_group_name_from_id(ng.group_id) as group_name, ng.newsgroup_id +from news_items n, newsgroups ng +where n.newsgroup_id = ng.newsgroup_id +order by ng.newsgroup_id, expired_p, release_date desc"] + +set counter 0 +set old_newsgroup_id "" +set displayed_all_users_p 0 +set displayed_registered_users_p 0 +set expired_p_headline_written_p 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + incr counter + + # Check if the special newsgroups have been displayed + if { [string match $scope "all_users"] } { + set displayed_all_users_p 1 + } + if { [string match $scope "registered_users"] } { + set displayed_registered_users_p 1 + } + + # if we are displaying the public newsgroup, show a link + # for the special newsgroups not seen. + if { [string match $scope "public"] } { + if { !$displayed_all_users_p } { + append page_content "

    All users

      +
    • add an item" + } + if { !$displayed_registered_users_p } { + append page_content "

    All registered users

      +
    • add an item" + } + set displayed_all_users_p 1 + set displayed_registered_users_p 1 + } + + if { $old_newsgroup_id != $newsgroup_id } { + append page_content "

    $fancy_scope $group_name

      +
    • add an item +

      + " + set old_newsgroup_id $newsgroup_id + set expired_p_headline_written_p 0 + } + + if { $expired_p == "t" && !$expired_p_headline_written_p } { + append page_content "

      Expired News Items\n" + set expired_p_headline_written_p 1 + } + append page_content "

    • [util_AnsiDatetoPrettyDate $release_date]: $title" + if { ![string match $approval_state "approved"] } { + append page_content "  not approved" + } + append page_content "\n" +} + +# BUG FIX (BMA) +if {$counter == 0} { + append page_content " +

      All users

      +

      All registered users

      " +} + +append page_content " + +
    + +[ad_admin_footer] +" + +ns_return 200 text/html $page_content Index: web/openacs/www/admin/news/item.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/news/item.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/news/item.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,88 @@ +# +# /www/admin/news/item.tcl +# +# shows one news item +# +# Author: jkoontz@arsdigita.com March 8, 2000 +# +# item.tcl,v 3.1 2000/03/10 23:45:54 jkoontz Exp + +set_the_usual_form_variables 0 +# news_item_id +# maybe contact_info_only, maybe order_by + +set return_url "[ns_conn url]?news_item_id=$news_item_id" + +# need outer join here. +set db [ns_db gethandle] +set selection [ns_db 0or1row $db " +select n.title, n.body, n.html_p, n.approval_state, n.release_date, n.expiration_date, + n.creation_user, n.creation_date, u.first_names, u.last_name, ng.scope, ug.group_name +from news_items n, users u, newsgroups ng, user_groups ug +where news_item_id = $news_item_id +and n.newsgroup_id = ng.newsgroup_id +and ng.group_id = ug.group_id +and u.user_id = n.creation_user +union +select n.title, n.body, n.html_p, n.approval_state, n.release_date, n.expiration_date, + n.creation_user, n.creation_date, u.first_names, u.last_name, ng.scope, NULL +from news_items n, users u, newsgroups ng +where news_item_id = $news_item_id +and n.newsgroup_id = ng.newsgroup_id +and u.user_id = n.creation_user +and not exists + (select ug.group_name from user_groups ug where ug.group_id = ng.group_id) +"] + +if { $selection == "" } { + ad_scope_return_error "Can't find news item" "Can't find news item $news_item_id" $db + return +} + +set_variables_after_query + +append page_content " +[ad_admin_header "$title"] +

    $title

    +[ad_admin_context_bar [list "index.tcl" "News"] "One Item"] + +
    + +
      +
    • Scope: $scope $group_name news +
    • Status: +" + +if { [string match $approval_state "approved"] } { + append page_content "Approved (Revoke)" +} else { + append page_content "Awaiting approval (Approve)" +} + +append page_content " +
    • Release Date: [util_AnsiDatetoPrettyDate $release_date] +
    • Expires: [util_AnsiDatetoPrettyDate $expiration_date] +
    • Submitted by: $first_names $last_name +
    + +

    Body

    + +
    +[util_maybe_convert_to_html $body $html_p] +
    +
    +
    + + + +
    + +
    + +[ad_general_comments_list $db $news_item_id news_items $title news] + +[ad_admin_footer]" + +ns_db releasehandle $db + +ns_return 200 text/html $page_content Index: web/openacs/www/admin/news/post-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/news/post-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/news/post-edit-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,69 @@ +# +# /www/admin/news/post-edit-2.tcl +# +# process the edit form for the news item +# +# Author: jkoontz@arsdigita.com March 8, 2000 +# +# post-edit-2.tcl,v 3.1.2.1 2000/04/03 13:53:26 carsten Exp + +set_the_usual_form_variables 0 + +# maybe return_url, name +# news_item_id, title, body, html_p, AOLserver ns_db magic vars that can be +# kludged together to form release_date and expiration_date + +set exception_count 0 +set exception_text "" + +set db [ns_db gethandle] + +if [catch { + ns_dbformvalue [ns_conn form] release_date date release_date + ns_dbformvalue [ns_conn form] expiration_date date expiration_date} errmsg] { + incr exception_count + append exception_text "
  • Please make sure your dates are valid." +} else { + + set expire_laterthan_future_p [database_to_tcl_string $db "select date_part('epoch','$expiration_date'::datetime - '$release_date'::datetime)"] + if {$expire_laterthan_future_p <= 0} { + incr exception_count + append exception_text "
  • Please make sure the expiration date is later than the release date." + } +} + +# now release_date and expiration_date are set + +if { ![info exists title] || [empty_string_p $title] } { + incr exception_count + append exception_text "
  • Please enter a title." +} + +if { ![info exists body] || [empty_string_p $body] } { + incr exception_count + append exception_text "
  • Please enter the full story." +} + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + +if [catch { ns_db dml $db "update news_items + set title='$QQtitle', body='$QQbody', + html_p='$html_p', release_date='$release_date', + expiration_date='$expiration_date' + where news_item_id = $news_item_id" } errmsg] { + # update failed + ns_log Error "/admin/news/post-edit-2.tcl choked: $errmsg" + ad_return_error "Insert Failed" "The Database did not like what you typed. This is probably a bug in our code. Here's what the database said: +
    +
    +$errmsg
+
    +
    +" $db + return +} + +ns_returnredirect item.tcl?[export_url_vars news_item_id] Index: web/openacs/www/admin/news/post-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/news/post-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/news/post-edit.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,55 @@ +# +# /www/admin/news/post-edit.tcl +# +# input form for editing a news item +# +# Author: jkoontz@arsdigita.com March 8, 2000 +# +# post-edit.tcl,v 3.1 2000/03/10 23:45:54 jkoontz Exp + +# Note: if this page is accessed from the group pages (scope=group), then +# group_id, group_name, short_name and admin_email are already +# set up in the environment by the ug_serve_section + +set_the_usual_form_variables 0 + +# maybe return_url, name +# news_item_id + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db " +select title, body, html_p, release_date, expiration_date +from news_items where news_item_id = $news_item_id"] +set_variables_after_query + +set page_content " +[ad_admin_header "Edit $title"] +

    Edit $title

    +[ad_admin_context_bar [list "index.tcl" "News"] "Edit Item"] +
    +
    + + + + +
    Title +
    Full Story +
    Text above is +
    Release Date [philg_dateentrywidget release_date $release_date] +
    Expire Date [philg_dateentrywidget expiration_date $expiration_date] +
    +
    +
    + +
    + +
    +[ad_admin_footer] +" + +ns_db releasehandle $db + +ns_return 200 text/html $page_content \ No newline at end of file Index: web/openacs/www/admin/news/post-new-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/news/post-new-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/news/post-new-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,116 @@ +# +# /www/news/admin/post-new-2.tcl +# +# process the input form for the new news item +# +# Author: jkoontz@arsdigita.com March 8, 2000 +# +# post-new-2.tcl,v 3.1 2000/03/10 23:45:54 jkoontz Exp + +set_the_usual_form_variables 0 +# maybe return_url, name +# news_item_id, title, body, html_p, AOLserver ns_db magic vars that can be +# kludged together to form release_date and expiration_date + +if { ![info exists return_url] } { + set return_url "index.tcl" +} + +set db [ns_db gethandle] +set user_id [ad_verify_and_get_user_id $db] +set creation_ip_address [ns_conn peeraddr] + +set exception_count 0 +set exception_text "" + + +if [catch { + ns_dbformvalue [ns_conn form] release_date date release_date + ns_dbformvalue [ns_conn form] expiration_date date expiration_date} errmsg] { + incr exception_count + append exception_text "
  • Please make sure your dates are valid." +} else { + + set expire_laterthan_future_p [database_to_tcl_string $db "select date_part('epoch', '$expiration_date'::datetime - '$release_date'::datetime)"] + if {$expire_laterthan_future_p <= 0} { + incr exception_count + append exception_text "
  • Please make sure the expiration date is later than the release date." + } +} + + +if { ![info exists title] || [empty_string_p $title]} { + incr exception_count + append exception_text "
  • Please enter a title." +} +if { ![info exists body] || [empty_string_p $body]} { + incr exception_count + append exception_text "
  • Please enter the full story." +} + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text $db + return +} + +if { ![exists_and_not_null scope] } { + set scope "public" +} + +set additional_clause "" +if { [string match $scope "group"] && ![empty_string_p $group_id] } { + set additional_clause "and group_id = $group_id" +} + +# Get the newsgroup_id for this board +set newsgroup_id [database_to_tcl_string_or_null $db "select newsgroup_id +from newsgroups +where scope = '$scope' $additional_clause"] + +# Check if there is no news group for this scope +if { [empty_string_p $newsgroup_id] } { + # Create the newsgroup for the group + ns_db dml $db "insert into newsgroups (newsgroup_id, scope, group_id) values (nextval('newsgroup_id_sequence'), '$scope', $group_id)" +} + +# Let's use data pipeline here to handle the clob for body, and the double click situation +set form_setid [ns_getform] +ns_set put $form_setid dp.news_items.news_item_id $news_item_id +ns_set put $form_setid dp.news_items.newsgroup_id $newsgroup_id +ns_set put $form_setid dp.news_items.title $title +ns_set put $form_setid dp.news_items.body $body +ns_set put $form_setid dp.news_items.html_p $html_p +ns_set put $form_setid dp.news_items.approval_state approved +ns_set put $form_setid dp.news_items.approval_date.expr sysdate() +ns_set put $form_setid dp.news_items.approval_ip_address $creation_ip_address +ns_set put $form_setid dp.news_items.release_date $release_date +ns_set put $form_setid dp.news_items.expiration_date $expiration_date +ns_set put $form_setid dp.news_items.creation_date.expr sysdate() +ns_set put $form_setid dp.news_items.creation_user $user_id +ns_set put $form_setid dp.news_items.creation_ip_address $creation_ip_address + +with_transaction $db { + +if [catch { dp_process -db $db -where_clause "news_item_id=$news_item_id" } errmsg] { + ns_log Error "/admin/news/post-edit-2.tcl choked: $errmsg" + ad_return_error "Insert Failed" "The Database did not like what you typed. This is probably a bug in our code. Here's what the database said: +
    +
    +$errmsg
+
    +
    +" + return +} +} {} +# Above is bug fix (BMA) on error. + +# ad_dbclick_check_dml $db news news_item_id $news_item_id $return_url " +# insert into news +# (news_item_id, title, body, html_p, approved_p, release_date, expiration_date, creation_date, creation_user, creation_ip_address, scope) +# values +# ($news_item_id, '$QQtitle', '$QQbody', '$html_p', 't', '$release_date', '$expiration_date', sysdate(), $user_id, '$creation_ip_address', 'public') +# " + + +ns_returnredirect "index.tcl" Index: web/openacs/www/admin/news/post-new.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/news/post-new.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/news/post-new.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,55 @@ +# +# /www/admin/news/post-new.tcl +# +# input form for the new news item +# +# Author: jkoontz@arsdigita.com March 8, 2000 +# +# post-new.tcl,v 3.1 2000/03/10 23:45:54 jkoontz Exp + +set_the_usual_form_variables 0 +# maybe return_url, name, scope, group_id + +set db [ns_db gethandle] + +# Get the group name +if { ![info exists group_id] } { + set group_id 0 +} +set group_name [database_to_tcl_string_or_null $db "select group_name from user_groups where group_id= '$group_id'"] + +set page_content " +[ad_admin_header "Add Item"] +

    Add Item

    +[ad_admin_context_bar [list "index.tcl" "News"] "Add Item"] + +
    + +
    +For $scope $group_name news +
    + +
    + + + + +
    Title +
    Full Story +
    Text above is +
    Release Date [philg_dateentrywidget release_date [database_to_tcl_string $db "select sysdate from dual"]] +
    Expire Date [philg_dateentrywidget expiration_date [database_to_tcl_string $db "select sysdate + [ad_parameter DefaultStoryLife news 30] from dual"]] +
    +
    +
    + +
    + +[export_form_vars scope group_id] +
    +[ad_admin_footer] +" + +ns_db releasehandle $db + +ns_return 200 text/html $page_content \ No newline at end of file Index: web/openacs/www/admin/news/toggle-approved-p.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/news/toggle-approved-p.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/news/toggle-approved-p.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,27 @@ +# +# /www/admin/news/toggle-approved-p.tcl +# +# toggles approval status for one news item +# +# Author: jkoontz@arsdigita.com March 8, 2000 +# +# toggle-approved-p.tcl,v 3.1 2000/03/10 23:45:55 jkoontz Exp + +set_the_usual_form_variables 0 +# maybe return_url, name +# news_item_id + +set db [ns_db gethandle] +set user_id [ad_get_user_id] + +# permission check + +ns_db dml $db "update news_items set approval_state = + case when approval_state= 'approved' then 'disapproved'::varchar + else 'approved'::varchar end, +approval_user = $user_id, approval_date = sysdate(), approval_ip_address = '[DoubleApos [ns_conn peeraddr]]' where news_item_id = $news_item_id" + +ns_returnredirect "item.tcl?[export_url_vars news_item_id]" + + + Index: web/openacs/www/admin/partner/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/partner/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/partner/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,30 @@ +# index.tcl,v 3.0 2000/02/06 03:26:33 ron Exp + +set page_title "Partner Manager" +set context_bar [ad_context_bar_ws "Partner manager"] + +set page_body " +Partners +
      +" + +set db [ns_db gethandle] +set selection [ns_db select $db \ + "select distinct partner_id, partner_name, upper(partner_name) as upper_partner_name + from ad_partner + order by upper(partner_name)"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append page_body "
    • $partner_name\n" +} +ns_db releasehandle $db + +append page_body " + +

      +

    • Add a partner +
    +" + +ns_return 200 text/html [ad_partner_return_template] Index: web/openacs/www/admin/partner/partner-ae-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/partner/partner-ae-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/partner/partner-ae-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,34 @@ +# partner-ae-2.tcl,v 3.0 2000/02/06 03:26:34 ron Exp +set_form_variables +# partner_id, partner_name, partner_cookie, default_font_face, default_font_color, +# title_font_face, title_font_color, group_id, operation +# Plus more partner variables + +validate_integer partner_id $partner_id + +# Check arguments +set req_vars [list "dp.ad_partner.partner_id" "dp.ad_partner.partner_cookie" "dp.ad_partner.partner_name"] +set err "" +foreach var $req_vars { + if { ![exists_and_not_null $var] } { + append err "
  • Must specify $var\n" + } +} +if { ![empty_string_p $err] } { + ad_partner_return_error "Missing Arguments" "
      $err
    " + return +} + +set db [ns_db gethandle] + +with_transaction $db { + + dp_process -where_clause "partner_id=${dp.ad_partner.partner_id}" +} { ns_log Error "transaction failed" } + +if { [exists_and_not_null return_url] } { + ns_returnredirect $return_url +} else { + ns_returnredirect "index.tcl?[export_url_vars partner_id]" +} + Index: web/openacs/www/admin/partner/partner-ae.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/partner/partner-ae.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/partner/partner-ae.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,75 @@ +# partner-ae.tcl,v 3.0 2000/02/06 03:26:35 ron Exp +set_the_usual_form_variables 0 +# partner_id if we're editing + +validate_integer partner_id $partner_id + +set db [ns_db gethandle] + +if {[info exists partner_id] && ![empty_string_p $partner_id]} { + set selection [ns_db 1row $db "select * + from ad_partner + where partner_id=$partner_id"] + set_variables_after_query + set page_title "Edit partner" +} else { + set partner_id [database_to_tcl_string $db "select ad_partner_partner_id_seq.nextval from dual"] + set page_title "Add partner" + set group_id "" +} + + +set selection [ns_db select $db \ + "select group_id as id, group_name + from user_groups + order by lower(group_name)"] +set inner [list ""] +set outer [list "-- Please Select --"] +while { [ns_db getrow $db $selection] } { + set_variables_after_query + lappend inner $id + lappend outer $group_name +} + + + +set context_bar [ad_context_bar_ws [list "index.tcl" "Partner manager"] [list "partner-view.tcl?[export_url_vars partner_id]" "One partner"] "$page_title"] + +set partner_vars [ad_partner_list_all_vars] + +set table " +
    +[export_form_vars return_url] + + + +" + +foreach pair $partner_vars { + append table " + + + + + +" +} + +append page_body " +$table + + + + + + +
    [lindex $pair 1]
    Group
    + +
    +
    + +" + +ns_return 200 text/html [ad_partner_return_template] \ No newline at end of file Index: web/openacs/www/admin/partner/partner-proc-ae-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/partner/partner-proc-ae-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/partner/partner-proc-ae-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,52 @@ +# partner-proc-ae-2.tcl,v 3.0 2000/02/06 03:26:37 ron Exp +set_the_usual_form_variables +# url_id, proc_name, proc_id, proc_type, call_number + +validate_integer url_id $url_id +validate_integer proc_id $proc_id + +# Check arguments +set err "" +set req_vars [list url_id proc_id proc_name proc_type call_number] +foreach var $req_vars { + if {![exists_and_not_null $var] } { + append err "
  • Must specify $var\n" + } +} + +set db [ns_db gethandle] + +# Check for uniqueness +set exists_p [database_to_tcl_string $db "select case count(*) when 0 then 0 else 1 end + from ad_partner_procs + where url_id='$QQurl_id' + and proc_name='$QQproc_name' + and proc_id<>$proc_id + and proc_type='$QQproc_type'"] + +if { $exists_p } { + append err "
  • Specified proc \"$proc_name\" has already been registered for this partner and url\n" +} + +if { ![empty_string_p $err] } { + ad_partner_return_error "Missing Arguments" "
      $err
    " + return +} + +ns_db dml $db "begin transaction" + +ns_db dml $db "update ad_partner_procs set + proc_name='$QQproc_name' + where proc_id = $proc_id" + +if {[ns_pg ntuples $db] == 0} { + ns_db dml $db "insert into ad_partner_procs +(url_id, proc_id, proc_name, proc_type, call_number) +values +($url_id, $proc_id, '$QQproc_name', '$QQproc_type', $call_number)" +} + +ns_db dml $db "end transaction" + +ns_returnredirect "partner-url.tcl?[export_url_vars url_id]" + Index: web/openacs/www/admin/partner/partner-proc-ae.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/partner/partner-proc-ae.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/partner/partner-proc-ae.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,53 @@ +# partner-proc-ae.tcl,v 3.0 2000/02/06 03:26:39 ron Exp +set_the_usual_form_variables +# url_id, proc_type if we're adding (proc_type is either header or footer) +# proc_id if we're editing + +validate_integer proc_id $proc_id +validate_integer url_id $url_id + +set db [ns_db gethandle] + +if {[info exists proc_id] && ![empty_string_p $proc_id]} { + set selection [ns_db 1row $db "select proc_name, url_id, proc_type, call_number + from ad_partner_procs + where proc_id=$proc_id"] + set_variables_after_query + set proc_type [string trim $proc_type] + set page_title "Edit $proc_type procedure" +} else { + set proc_id [database_to_tcl_string $db "select ad_partner_procs_proc_id_seq.nextval from dual"] + set page_title "Add $proc_type procedure" + set call_number [database_to_tcl_string_or_null $db \ + "select max(call_number)+1 + from ad_partner_procs + where url_id=$url_id + and proc_type='$QQproc_type'"] + if {[empty_string_p $call_number]} { + set call_number 1 + } +} + +set partner_id [database_to_tcl_string $db \ + "select partner_id from ad_partner_url where url_id='$url_id'"] + +ns_db releasehandle $db + +set context_bar [ad_context_bar_ws [list "index.tcl" "Partner manager"] [list "partner-view.tcl?[export_url_vars partner_id]" "One partner"] [list "partner-url.tcl?[export_url_vars url_id]" URL] "$page_title"] + +set page_body " +
    +[export_form_vars url_id proc_id return_url proc_type call_number] + + + + + + +
    Procedure name:
    + +
    +
    +" + +ns_return 200 text/html [ad_partner_return_template] Index: web/openacs/www/admin/partner/partner-proc-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/partner/partner-proc-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/partner/partner-proc-delete-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,16 @@ +# partner-proc-delete-2.tcl,v 3.0 2000/02/06 03:26:40 ron Exp +set_the_usual_form_variables +# proc_id, operation + +validate_integer proc_id $proc_id + +set db [ns_db gethandle] +set url_id [database_to_tcl_string $db "select url_id + from ad_partner_procs + where proc_id=$proc_id"] + +if { [string compare $operation "Yes"] == 0 } { + ns_db dml $db "delete from ad_partner_procs where proc_id='$proc_id'" +} + +ns_returnredirect partner-url.tcl?[export_url_vars url_id] \ No newline at end of file Index: web/openacs/www/admin/partner/partner-proc-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/partner/partner-proc-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/partner/partner-proc-delete.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,36 @@ +# partner-proc-delete.tcl,v 3.0 2000/02/06 03:26:42 ron Exp +set_the_usual_form_variables +# proc_id + +validate_integer proc_id $proc_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db \ + "select p.proc_name, trim(p.proc_type) as proc_type, p.url_id, u.partner_id + from ad_partner_procs p, ad_partner_url u + where p.proc_id=$proc_id + and p.url_id=u.url_id"] +set_variables_after_query + +set page_title "Delete procedure" +set context_bar [ad_context_bar_ws [list "index.tcl" "Partner manager"] [list "partner-view.tcl?[export_url_vars partner_id]" "One partner"] [list "partner-url.tcl?[export_url_vars url_id]" URL] "$page_title"] + +set page_body " +Are you sure you want to unassociate the $proc_type procedure \"$proc_name\"? + + + + + + +
    + [export_form_vars proc_id] +
    +
    + [export_form_vars proc_id] +
    +
    +" + +ns_return 200 text/html [ad_partner_return_template] Index: web/openacs/www/admin/partner/partner-url-ae-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/partner/partner-url-ae-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/partner/partner-url-ae-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,60 @@ +# partner-url-ae-2.tcl,v 3.0 2000/02/06 03:26:43 ron Exp +set_the_usual_form_variables +# partner_id, url_stub, url_id + +# Check arguments +set err "" +set req_vars [list partner_id url_id url_stub] +foreach var $req_vars { + if { ![exists_and_not_null $var] } { + append err "
  • Must specify $var\n" + } +} + +if { [info exists url_stub] && ![regexp {^/} $url_stub] } { + append err "
  • URL Stub must start with a leading forward slash\n" +} + +set db [ns_db gethandle] + +# Check for uniqueness +set exists_count [database_to_tcl_string $db \ + "select count(*) + from ad_partner_url + where partner_id=$partner_id + and url_stub='$QQurl_stub' + and url_id != $url_id"] + +# Quick PG hack (BMA) +if {$exists_count > 0} { + set exists_p 1 +} else { + set exists_p 0 +} + +if { $exists_p } { + append err "
  • Specified url \"$url_stub\" has already been registered for this partner\n" +} + +if { ![empty_string_p $err] } { + ad_partner_return_error "Problems with your input" "
      $err
    " + return +} + +ns_db dml $db "begin transaction" + +ns_db dml $db "update ad_partner_url set + url_stub='$QQurl_stub' + where url_id = $url_id" + +if {[ns_pg ntuples $db] == 0} { + ns_db dml $db "insert into ad_partner_url +(partner_id, url_id, url_stub) +values +($partner_id, $url_id, '$QQurl_stub')" +} + +ns_db dml $db "end transaction" + +ns_returnredirect "partner-view.tcl?[export_url_vars partner_id]" + Index: web/openacs/www/admin/partner/partner-url-ae.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/partner/partner-url-ae.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/partner/partner-url-ae.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,39 @@ +# partner-url-ae.tcl,v 3.0 2000/02/06 03:26:44 ron Exp +set_the_usual_form_variables +# partner_id if we're adding +# url_id if we're editing + +set db [ns_db gethandle] + +if {[info exists url_id] && ![empty_string_p $url_id]} { + validate_integer url_id $url_id + + set selection [ns_db 1row $db "select url_stub, partner_id + from ad_partner_url + where url_id=$url_id"] + set_variables_after_query + set page_title "Edit URL" +} else { + set url_id [database_to_tcl_string $db "select ad_partner_url_url_id_seq.nextval from dual"] + set page_title "Add URL" + set url_stub "/" +} + +set context_bar [ad_context_bar_ws [list "index.tcl" "Partner manager"] [list "partner-view.tcl?[export_url_vars partner_id]" "One partner"] "$page_title"] + +set page_body " +
    +[export_form_vars partner_id url_id return_url] + + + + + + +
    URL Stub (with leading slash):
    + +
    +
    +" + +ns_return 200 text/html [ad_partner_return_template] Index: web/openacs/www/admin/partner/partner-url-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/partner/partner-url-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/partner/partner-url-delete-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,20 @@ +# partner-url-delete-2.tcl,v 3.0 2000/02/06 03:26:46 ron Exp +set_the_usual_form_variables +# url_id, operation + +validate_integer url_id $url_id + +set db [ns_db gethandle] +set partner_id [database_to_tcl_string $db \ + "select partner_id + from ad_partner_url + where url_id=$url_id"] + +if { [string compare $operation "Yes"] == 0 } { + ns_db dml $db "begin transaction" + ns_db dml $db "delete from ad_partner_procs where url_id='$url_id'" + ns_db dml $db "delete from ad_partner_url where url_id='$url_id'" + ns_db dml $db "end transaction" +} + +ns_returnredirect partner-view.tcl?[export_url_vars partner_id] \ No newline at end of file Index: web/openacs/www/admin/partner/partner-url-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/partner/partner-url-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/partner/partner-url-delete.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,35 @@ +# partner-url-delete.tcl,v 3.0 2000/02/06 03:26:47 ron Exp +set_the_usual_form_variables +# url_id + +validate_integer url_id $url_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select url_stub, partner_id + from ad_partner_url + where url_id=$url_id"] +set_variables_after_query + +set page_title "Delete URL" +set context_bar [ad_context_bar_ws [list "index.tcl" "Partner manager"] [list "partner-view.tcl?[export_url_vars partner_id]" "One partner"] "$url_stub"] + +set page_body " +Are you sure you want to unassociate the url \"$url_stub\" for this partner? + + + + + + +
    + [export_form_vars url_id] +
    +
    + [export_form_vars url_id] +
    +
    +" + + +ns_return 200 text/html [ad_partner_return_template] \ No newline at end of file Index: web/openacs/www/admin/partner/partner-url-sample.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/partner/partner-url-sample.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/partner/partner-url-sample.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,25 @@ +# partner-url-sample.tcl,v 3.0 2000/02/06 03:26:49 ron Exp +set_the_usual_form_variables +# url_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db \ + "select u.url_stub, p.partner_cookie + from ad_partner p, ad_partner_url u + where u.url_id=$url_id + and p.partner_id=u.partner_id"] +set_variables_after_query +ns_db releasehandle $db + +if { ![regexp {/$} $url_stub] } { + append url_stub "/" +} + +ReturnHeaders +ns_write " + +[ad_partner_header $partner_cookie] +

    This is the contents of your page

    +[ad_partner_footer $partner_cookie] +" Index: web/openacs/www/admin/partner/partner-url.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/partner/partner-url.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/partner/partner-url.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,58 @@ +# partner-url.tcl,v 3.0 2000/02/06 03:26:51 ron Exp +proc ad_partner_proc_html { db url_id proc_type} { + set selection [ns_db select $db "select proc_name, proc_id + from ad_partner_${proc_type}_procs + where url_id='$url_id'"] + + set str "" + while { [ns_db getrow $db $selection] } { + set_variables_after_query + append str "
  • $proc_name | view | edit | delete\n" + } + + if { [empty_string_p $str] } { + set str "
    • No procedures have been registered.
    " + } else { + set str "
      $str
    " + } + + return " + $proc_type calling order + $str + +" +} + + +set_the_usual_form_variables +# url_id + +set db [ns_db gethandle] +set selection [ns_db 1row $db "select partner_id, url_stub + from ad_partner_url + where url_id=$url_id"] + +set_variables_after_query + +set selection [ns_db 1row $db \ + "select partner_name + from ad_partner + where partner_id='$partner_id'"] +set_variables_after_query + +set page_title "$partner_name ($url_stub)" +set context_bar [ad_context_bar_ws [list "index.tcl" "Partner manager"] [list "partner-view.tcl?[export_url_vars partner_id]" "One partner"] "URL"] + +set page_body " +[ad_partner_proc_html $db $url_id header] +[ad_partner_proc_html $db $url_id footer] + +preview +
      +
    • Preview what this template looks like +
    +" + +ns_return 200 text/html [ad_partner_return_template] \ No newline at end of file Index: web/openacs/www/admin/partner/partner-view.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/partner/partner-view.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/partner/partner-view.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,77 @@ +# partner-view.tcl,v 3.0 2000/02/06 03:26:52 ron Exp +set_the_usual_form_variables +# partner_id + +validate_integer partner_id $partner_id + +set db [ns_db gethandle] + +set return_url "partner-view.tcl?[export_url_vars partner_id]" + +set selection [ns_db 0or1row $db \ + "select * from ad_partner where partner_id=$partner_id"] + +if { [empty_string_p $selection] } { + ad_partner_return_error "Partner doesn't exist" \ + "There is no partner with a partner_id of $partner_id" + return +} + +set_variables_after_query + +set page_title $partner_name +set context_bar [ad_context_bar_ws [list "index.tcl" "Partner manager"] "One partner"] + +set url_string "" +set selection [ns_db select $db "select distinct url_stub, url_id, upper(url_stub) as upper_url_stub + from ad_partner_url + where partner_id=$partner_id + order by upper(url_stub)"] +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append url_string "
  • $url_stub | +View | +Edit | +Delete | +Preview +" +} + +if { [empty_string_p $url_string] } { + set url_string "
  • There are no registered urls" +} + +append page_body " + +Registered URL's + +

    + +Variables | Edit +

      +" + +if { ![empty_string_p $group_id] && $group_id != 0} { + set user_groups_name [database_to_tcl_string $db \ + "select group_name from user_groups where group_id=$group_id"] +} else { + set user_groups_name "" +} +set partner_vars [ad_partner_list_all_vars] + +foreach pair $partner_vars { + set variable [lindex $pair 0] + set text [lindex $pair 1] + append page_body "
    • $text ($variable): [set $variable]\n" +} + +append page_body " +
    • Group: $user_groups_name +
    +" + +ns_return 200 text/html [ad_partner_return_template] \ No newline at end of file Index: web/openacs/www/admin/poll/choice-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/poll/choice-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/poll/choice-delete.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,41 @@ +# choice-delete.tcl,v 3.1 2000/02/18 03:53:48 jsc Exp +# choice-delete.tcl Nuke a choice. +# +# since choices are light-weight, don't require confirmation + + +set_form_variables + +# expects choice_id, poll_id + +set db [ns_db gethandle] + +set delete_sql " +delete from poll_choices + where choice_id = $choice_id +" + +if [catch { ns_db dml $db $delete_sql } errmsg ] { + ad_return_error "Error deleting choice" "Here is +what the database returned: +

    +

    +
    +$errmsg
+
    +
    + +Probably this is because users have already recorded results for this +choice. +" + return +} + +# update memoized choices + +validate_integer "poll_id" $poll_id +util_memoize_flush "poll_labels_internal $poll_id" + +ns_returnredirect "one-poll.tcl?[export_url_vars poll_id]" + + Index: web/openacs/www/admin/poll/choice-new.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/poll/choice-new.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/poll/choice-new.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,151 @@ +# choice-new.tcl,v 3.1 2000/02/18 03:54:46 jsc Exp +# choice-new.tcl -- insert a new choice, or re-order existing choices + +set_the_usual_form_variables +# expects poll_id, choice_id, count, action, label, option lists of the form +# 'order_$choice_id', + + +# random preliminaries + +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set user_id [ad_verify_and_get_user_id] +ad_maybe_redirect_for_registration + +# THIS was a bug! Fixed in ACS/pg (BMA) +if {![info exists action]} { + set action "Add" +} + +if { $action == "Change Ordering" } { + set just_reorder_p 1 +} else { + set just_reorder_p 0 +} + + +# collect the ordering options, then sanity check in the input + + +set exception_count 0 +set exception_text "" + +set form [ns_getform] +set form_size [ns_set size $form] + +for { set i 0 } { $i < $form_size } { incr i } { + set key [ns_set key $form $i] + set value [ns_set value $form $i] + + if [regexp {order_([0-9]*)} $key match a_choice_id] { + + if [info exists seen_order_p($value)] { + incr exception_count + append exception_text "
  • You have repeated a number in your re-ordering of items." + break + } else { + set seen_order_p($value) 1 + } + + set choice_order($a_choice_id) $value + } +} + +if { !$just_reorder_p } { + if [info exists seen_order_p($choice_new)] { + incr exception_count + append exception_text "
  • Your new choice has the same ordering number as an existing choice" + } +} + + + +if { ![info exists poll_id] || [empty_string_p $poll_id] } { + incr exception_count + append exception_text "
  • poll_id is missing. This could mean there's a problem in our software" +} + +if { !$just_reorder_p } { + + if { ![info exists choice_id] || [empty_string_p $choice_id] } { + incr exception_count + append exception_text "
  • choice_id is missing. This could mean there's a problem in our software" + } + + if { ![info exists label] || [empty_string_p $label] } { + incr exception_count + append exception_text "
  • Please supply a label for the choice" + } +} + + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + + + +# insert the value + +set db [ns_db gethandle] + +if { !$just_reorder_p } { + + set insert_sql " +insert into poll_choices + (choice_id, poll_id, label, sort_order) +values + ($choice_id, $poll_id, '$QQlabel', $choice_new) +" + + if [catch { ns_db dml $db $insert_sql } errmsg ] { + ns_return 200 text/html " +[ad_admin_header "Error inserting poll"] +

    Error in inserting a poll

    +
    +There was an error in inserting the poll. Here is +what the database returned: +

    +

    +$errmsg
+
    +[ad_admin_footer] +" + return + } +} + + +# update the sort orders of the existing choices + +if [info exists choice_order] { + + ns_db dml $db "begin transaction" + + foreach i [array names choice_order] { + ns_db dml $db " +update poll_choices + set sort_order = $choice_order($i) + where choice_id = $i +" + } + + ns_db dml $db "end transaction" +} + +ns_db releasehandle $db + + +# update memoized choices + +validate_integer "poll_id" $poll_id +util_memoize_flush "poll_labels_internal $poll_id" + +# redirect back to where they came from + +ns_returnredirect "one-poll.tcl?[export_url_vars poll_id]" Index: web/openacs/www/admin/poll/delete-anonymous-dupes.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/poll/delete-anonymous-dupes.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/poll/delete-anonymous-dupes.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,29 @@ +# delete-anonymous-dupes.tcl,v 3.0 2000/02/06 03:26:56 ron Exp +# delete-anonymous-dupes.tcl +# +# by philg@mit.edu on October 25, 1999 +# +# deletes anonymous duplicate votes from the same IP address + +set_the_usual_form_variables + +# poll_id, deletion_threshold (if there are this many or more, nuke 'em) + +if { $deletion_threshold == 1 } { + ad_return_complaint 1 "
  • you picked a threshold of 1; this would mean that you'd delete ALL the anonymous votes!" + return +} + +set db [ns_db gethandle] + +ns_db dml $db "delete from poll_user_choices +where poll_id = $poll_id +and user_id is null +and (choice_id, ip_address) in + (select choice_id, ip_address + from poll_user_choices + where user_id is null + group by choice_id, ip_address + having count(*) >= $deletion_threshold)" + +ns_returnredirect "integrity-stats.tcl?[export_url_vars poll_id]" Index: web/openacs/www/admin/poll/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/poll/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/poll/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,74 @@ +# index.tcl,v 3.0 2000/02/06 03:26:57 ron Exp +# index.tcl - top-level admin page for polls + +# make sure user is registered + +ad_maybe_redirect_for_registration + +# return the page + +ReturnHeaders + +ns_write " +[ad_admin_header "Polls Admin"] +

    Polls Admin

    +[ad_admin_context_bar Polls] +
    + +Documentation: /doc/poll.html + +

    Polls

    + +
      +" + +set db [ns_db gethandle] + +set selection [ns_db select $db " +select poll_id, name, start_date, end_date, require_registration_p, + poll_is_active_p(start_date, end_date) as active_p + from polls + order by active_p desc, name +"] + +set count 0 +set written_inactive_header_p 0 + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + if { $active_p == "f" && !$written_inactive_header_p } { + set written_inactive_header_p 1 + ns_write "

      Inactive

      \n" + } + + if { $require_registration_p == "t" } { + set require_registration "(requires registration)" + } else { + set require_registration "" + } + + ns_write "
    • $name from $start_date to $end_date $require_registration\n" + + incr count +} + +if { $count == 0 } { + ns_write "
    • No polls found" +} + +ns_write " + +

      + +

    • create a new poll + +
    + +

    + +[ad_admin_footer] +" + + + Index: web/openacs/www/admin/poll/integrity-stats.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/poll/integrity-stats.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/poll/integrity-stats.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,110 @@ +# integrity-stats.tcl,v 3.0 2000/02/06 03:26:58 ron Exp +# integrity-stats.tcl +# +# try to get a handle on whether people are voting early and often + +# by philg@mit.edu on October 25, 1999 + +set_form_variables + +# expects poll_id + +ad_maybe_redirect_for_registration + +set db [ns_db gethandle] + +set selection [ns_db 1row $db " +select name, description, start_date, end_date, require_registration_p + from polls + where poll_id = $poll_id +"] + +set_variables_after_query + +ReturnHeaders + +ns_write " +[ad_admin_header "Integrity Statistics for $name"] + +

    Integrity Statistics for $name

    + +[ad_admin_context_bar [list "/admin/poll" Polls] [list "one-poll.tcl?[export_url_vars poll_id]" "One"] "Integrity Statistics"] + +
    + +This page tries to help you figure out if people are people are +stuffing the ballot box in \"$name\". This is particularly important +for polls that don't require registration. + +

    + +First, let's have a look at votes from the same IP address where the +user ID is not null. Presumably these are genuinely distinct people +since the poll software won't accept votes from the same person twice. +This should give you an idea of how likely it is that your users are +coming through proxies, etc.: + +

      +" + +set selection [ns_db select $db "select pc.label, puc.ip_address, count(*) as n_from_same_ip +from poll_choices pc, poll_user_choices puc +where pc.choice_id = puc.choice_id +and pc.poll_id = $poll_id +and user_id is not null +group by pc.label, puc.ip_address +having count(*) > 1 +order by n_from_same_ip desc"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • $label, $ip_address: $n_from_same_ip\n" +} + + +ns_write " +
    + +Now let's have a look at anonymous duplicate votes from the same IP +address. + +
      +" + +set selection [ns_db select $db "select + pc.label, + puc.ip_address, + count(*) as n_from_same_ip, + round(24*date_num_days(max(puc.choice_date) - min(puc.choice_date)),2) as n_hours_apart +from poll_choices pc, poll_user_choices puc +where pc.choice_id = puc.choice_id +and pc.poll_id = $poll_id +and user_id is null +group by pc.label, puc.ip_address +having count(*) > 1 +order by n_from_same_ip desc"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • $label, $ip_address: $n_from_same_ip, $n_hours_apart hours apart\n" +} + +ns_write " +
    + +If you want to quickly eliminate the ballot-stuffers, you can set a +threshold of how many duplicate rows is too many and have the system +nuke them all: + +
    +
    +[export_form_vars poll_id] +Pick a threshold: + + +
    +
    + +[ad_admin_footer] +" + Index: web/openacs/www/admin/poll/one-poll.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/poll/one-poll.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/poll/one-poll.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,162 @@ +# one-poll.tcl,v 3.0 2000/02/06 03:26:59 ron Exp +# one-poll.tcl -- show info(e) about a single poll + +# markd@arsdigita.com + +set_form_variables + +# expects poll_id + +ad_maybe_redirect_for_registration + +set db [ns_db gethandle] + +set selection [ns_db 1row $db " +select name, description, start_date, end_date, require_registration_p + from polls + where poll_id = $poll_id +"] + +set_variables_after_query + + +ReturnHeaders + +ns_write " +[ad_admin_header "One Poll: $name"] +

    One Poll: $name

    + +[ad_admin_context_bar [list "/admin/poll" Polls] One] + +
    + + + +

    Choices for this poll

    + +

    +

      +" + +set count [database_to_tcl_string $db " +select count(*) + from poll_choices + where poll_id = $poll_id +"] + +set choice_id [database_to_tcl_string $db "select poll_choice_id_sequence.nextval from dual"] + + +ns_write " +
      +[export_form_vars poll_id choice_id count choice_id] + + +" + + + +# construct a list of numbers so we can easily present a choice +# of ordering values + +set order_list [list] +set loop_limit [expr $count + 1] + +for { set i 1 } { $i <= $loop_limit } { incr i } { + lappend order_list $i +} + + +# if we have existing items, make a table of a pop-up to +# determine ordering. The names are of the form +# order_$choice_id, and a regexp pulls out the choice ID +# in the page that handles this POST. + +if { $count > 0 } { + + set selection [ns_db select $db " +select choice_id, label + from poll_choices + where poll_id = $poll_id + order by sort_order +"] + + + # don't use the absolute values of the sort_order, since they may + # not necessarily be in sequential order. + + set i 1 + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + ns_write " + + + + +
      + $label (delete) \n +" + incr i + } + +} else { + + # yeah, the page generated by this is a little ugly. + + ns_write " +
      + You haven't defined any choices for this poll yet. +" +} + +ns_db releasehandle $db + +ns_write " + +
      + + + +
      +   + + +
      + +
      + +

      + +

    + +

    +[ad_admin_footer] +" + Index: web/openacs/www/admin/poll/poll-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/poll/poll-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/poll/poll-delete-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,19 @@ +# poll-delete-2.tcl,v 3.0 2000/02/06 03:27:01 ron Exp +# poll-delete-2.tcl -- remove a poll from the database, including votes + +set_form_variables + +# expects poll_id + +set db [ns_db gethandle] + +ns_db dml $db "begin transaction" + +ns_db dml $db "delete from poll_user_choices where poll_id = $poll_id" +ns_db dml $db "delete from poll_choices where poll_id = $poll_id" +ns_db dml $db "delete from polls where poll_id = $poll_id" + +ns_db dml $db "end transaction" + +ns_returnredirect index.tcl + Index: web/openacs/www/admin/poll/poll-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/poll/poll-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/poll/poll-delete.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,59 @@ +# poll-delete.tcl,v 3.0 2000/02/06 03:27:02 ron Exp +# poll-delete.tcl +# +# ask for confirmation of deletion of poll + +set_form_variables +# expects poll_id + + +# random preliminaries + +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +ad_maybe_redirect_for_registration + +# get display stuff + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select name, description +from polls +where poll_id = $poll_id"] + +set_variables_after_query + +set n_votes [database_to_tcl_string $db "select count(*) from poll_user_choices where poll_id = $poll_id"] + +ns_db releasehandle $db + +ns_return 200 text/html "[ad_admin_header "Confirm Poll Deletion: $name"] + +

    Confirm Poll Deletion: $name

    + +[ad_admin_context_bar [list "/admin/poll" Polls] Delete] + +
    + +You have asked to delete poll $name ($description). + +

    + +Deleting the poll will delete all $n_votes votes as well. + +

    + +

    +[ad_admin_footer] +" Index: web/openacs/www/admin/poll/poll-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/poll/poll-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/poll/poll-edit-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,96 @@ +# poll-edit-2.tcl,v 3.0 2000/02/06 03:27:03 ron Exp +# poll-edit-2.tcl -- commit changes to a poll + +set_the_usual_form_variables +# expects poll_id name, description, start_date, end_date, require_registration_p + + +# expects poll_id name, description, start_date, end_date, require_registration_p + + +# random preliminaries + +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set user_id [ad_verify_and_get_user_id] +ad_maybe_redirect_for_registration + +# sanity check + +set exception_count 0 +set exception_text "" + +if { ![info exists poll_id] || [empty_string_p $poll_id] } { + incr exception_count + append exception_text "

  • poll_id is missing. This could mean there's a problem in our software" +} + +if { ![info exists name] || [empty_string_p $name] } { + incr exception_count + append exception_text "
  • Please supply a poll name" +} + +if { ![info exists description] || [empty_string_p $description] } { + incr exception_count + append exception_text "
  • Please supply a description" +} + + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + + +# prep the date and checkbox inputs + +ns_dbformvalue [ns_getform] start_date date start_date +ns_dbformvalue [ns_getform] end_date date end_date + +if { ![info exists require_registration_p] || ($require_registration_p != "t") } { + set require_registration_p "f" +} + + +# now update it + +set update_sql " +update polls set + name = '$QQname', + description = '$QQdescription', + start_date = '$start_date', + end_date = '$end_date', + require_registration_p = '$require_registration_p' +where + poll_id = $poll_id +" + +set db [ns_db gethandle] + +if [catch { ns_db dml $db $update_sql } errmsg ] { + ns_return 200 text/html " +[ad_admin_header "Error updating poll"] +

    Error while updating a poll

    +
    +There was an error in updating the poll. Here is +what the database returned: +

    +

    +$errmsg
+
    +[ad_admin_footer] +" + return +} + +# Update the memoized value + +util_memoize_flush "poll_info_internal $poll_id" + +# redirect back to the index + +ns_returnredirect "index.tcl" + Index: web/openacs/www/admin/poll/poll-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/poll/poll-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/poll/poll-edit.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,93 @@ +# poll-edit.tcl,v 3.0 2000/02/06 03:27:05 ron Exp +# poll-edit.tcl -- present the form to edit a single poll + +set_form_variables + +# expects poll_id + + +# random preliminaries + +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set user_id [ad_verify_and_get_user_id] +ad_maybe_redirect_for_registration + + +set db [ns_db gethandle] + +set selection [ns_db 1row $db " +select name, description, start_date::date as start_date, end_date::date as end_date, require_registration_p + from polls + where poll_id = $poll_id +"] + +set_variables_after_query + + +if { $require_registration_p == "t" } { + set checked_text "CHECKED" +} else { + set checked_text "" +} + +ReturnHeaders + +ns_write " +[ad_admin_header "Edit Poll: $name"] +

    Edit Poll: $name

    +[ad_admin_context_bar [list "/admin/poll" Polls] Edit] +
    +

    + +

    + +[export_form_vars poll_id] + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    Poll Name
    Poll Description
    Start Date [ad_dateentrywidget start_date $start_date]
    End Date [ad_dateentrywidget end_date $end_date]
     
    Require Registration
    + +

    +

    + +
    +
    + +

    +[ad_admin_footer] +" + Index: web/openacs/www/admin/poll/poll-new-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/poll/poll-new-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/poll/poll-new-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,94 @@ +# poll-new-2.tcl,v 3.0 2000/02/06 03:27:06 ron Exp +# poll-new-2.tcl -- add a new poll to the database + +set_the_usual_form_variables +# expects poll_id name, description, start_date, end_date, require_registration_p + +# random preliminaries + +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set user_id [ad_verify_and_get_user_id] +if { $user_id == 0 } { + ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode [ns_conn url]]" + return +} + + +# sanity check + +set exception_count 0 +set exception_text "" + +if { ![info exists poll_id] || [empty_string_p $poll_id] } { + incr exception_count + append exception_text "

  • poll_id is missing. This could mean there's a problem in our software" +} + +if { ![info exists name] || [empty_string_p $name] } { + incr exception_count + append exception_text "
  • Please supply a poll name" +} + +if { ![info exists description] || [empty_string_p $description] } { + incr exception_count + append exception_text "
  • Please supply a description" +} + + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + + +# prep the date and checkbox inputs + +ns_dbformvalue [ns_conn form] start_date date start_date +ns_dbformvalue [ns_conn form] end_date date end_date + +if { ![info exists require_registration_p] || ($require_registration_p != "t") } { + set require_registration_p "f" +} + + + +# now actually put it into the database + +set insert_sql " +insert into polls + (poll_id, name, description, + start_date, end_date, require_registration_p) +values + ($poll_id, '$QQname', '$QQdescription', + '$start_date', '$end_date', '$require_registration_p') +" + +set db [ns_db gethandle] + +if [catch { ns_db dml $db $insert_sql } errmsg ] { + ns_return 200 text/html " +[ad_admin_header "Error inserting poll"] +

    Error in inserting a poll

    +
    +There was an error in inserting the poll. Here is +what the database returned: +

    +

    +$errmsg
+
    +[ad_admin_footer] +" + return +} + + +# redirect to a page where they can enter the poll +# questions + +ns_returnredirect "one-poll.tcl?[export_url_vars poll_id]" + + Index: web/openacs/www/admin/poll/poll-new.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/poll/poll-new.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/poll/poll-new.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,79 @@ +# poll-new.tcl,v 3.0 2000/02/06 03:27:07 ron Exp +# poll-new.tcl -- prompt for information about a new poll. + +# random preliminaries + +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + + +set user_id [ad_verify_and_get_user_id] +ad_maybe_redirect_for_registration + +# get the poll_id + +set db [ns_db gethandle] + +set poll_id [database_to_tcl_string $db "select poll_id_sequence.nextval from dual"] + +ns_db releasehandle $db + + +ns_return 200 text/html " + +[ad_admin_header "New Poll"] +

    New Poll

    +[ad_admin_context_bar [list "/admin/poll" Polls] New] +
    + +
    + +[export_form_vars poll_id] + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    Poll Name
    Poll Description
    Start Date [ad_dateentrywidget start_date]
    End Date [ad_dateentrywidget end_date]
     
    Require Registration
    + +

    +

    + +
    +
    + +

    + +[ad_admin_footer] +" + Index: web/openacs/www/admin/poll/votes-from-one-ip.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/poll/votes-from-one-ip.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/poll/votes-from-one-ip.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,83 @@ +# votes-from-one-ip.tcl,v 3.0 2000/02/06 03:27:09 ron Exp +# votes-from-one-ip.tcl +# +# by philg@mit.edu on October 25, 1999 +# +# shows the admin what has been happening from one IP address + +set_the_usual_form_variables + +# poll_id, ip_address + +set db [ns_db gethandle] + +set selection [ns_db 1row $db " +select name, description, start_date, end_date, require_registration_p + from polls + where poll_id = $poll_id +"] + +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "Votes from $ip_address"] + +

    Votes from $ip_address

    + +[ad_admin_context_bar [list "/admin/poll" Polls] [list "one-poll.tcl?[export_url_vars poll_id]" "One"] [list "integrity-stats.tcl?[export_url_vars poll_id]" "Integrity Statistics"] "One IP Address"] + +
    + +These are votes from $ip_address in \"$name\". First, let's try +translating the address to a hostname.... +" + +with_catch errmsg { + set hostname [ns_hostbyaddr $ip_address] +} { + set hostname $ip_address +} + +ns_write "$hostname + +(if this is just the number again, that means the hostname could not +be found.) + +

    + +

      + +" + +set selection [ns_db select $db "select + pc.label, + to_char(puc.choice_date,'YYYY-MM-DD HH24:MI:SS') as choice_time, + puc.user_id, + users.first_names, + users.last_name +from poll_choices pc, poll_user_choices puc, users +where puc.user_id = users.user_id(+) +and pc.choice_id = puc.choice_id +and pc.poll_id = $poll_id +and puc.ip_address = '$ip_address' +order by puc.choice_date"] + +set items "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append items "
    • $choice_time: $label" + if [empty_string_p $user_id] { + append items "--anonymous" + } else { + append items "--$first_names $last_name" + } +} + +ns_write "$items + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/portals/add-manager-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/portals/add-manager-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/portals/add-manager-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,41 @@ +# add-manager-2.tcl,v 3.1 2000/03/01 08:44:59 yon Exp +# add-manager-2.tcl +# +# adds a person to the list of super administrators +# +# by aure@arsdigita.com and dh@arsdigita.com +# +# Last modified: 10/8/1999 + +set_the_usual_form_variables +# user_id_from_search +# first_names_from_search +# last_names_from_search +# email_from_search + + +set db [ns_db gethandle] +# get group_id for super users +set group_id [database_to_tcl_string $db "select group_id + from user_groups + where group_name = 'Super Administrators' + and group_type = 'portal_group'"] + + +set user_id [ad_verify_and_get_user_id] +ad_maybe_redirect_for_registration + +# check if this person is already an administrator of this group +set check_result [database_to_tcl_string $db "select +case when ad_user_has_role_p ( $user_id_from_search, $group_id, 'administrator' )= 'f' then 0 else 1 end +from dual"] + +if { $check_result == 0 } { + ns_db dml $db " + insert into user_group_map + (user_id, group_id, role, mapping_user, mapping_ip_address) + values + ($user_id_from_search, $group_id, 'administrator', $user_id, '[ns_conn peeraddr]') " +} + +ns_returnredirect index.tcl Index: web/openacs/www/admin/portals/add-manager.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/portals/add-manager.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/portals/add-manager.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,68 @@ +# add-manager.tcl,v 3.0.4.1 2000/03/24 01:38:01 aure Exp +# add-manager.tcl +# +# standard ACS promt for email or name of proposed super administrator +# +# by aure@arsdigita.com and dh@arsdigita.com +# +# Last modified: 10/8/1999 + + +set db [ns_db gethandle] + +# get group_id +set group_id [database_to_tcl_string_or_null $db "select group_id + from user_groups + where group_name = 'Super Administrators' + and group_type = 'portal_group'"] + +if [empty_string_p $group_id] { + ad_return_error "No Super Administrators group" "You need to set up a \"Super Administrators\" group (of type \"portal_group\") before you can use the system." + return +} + +set group_name [portal_group_name $db $group_id] + + +# set variables for user-search.tcl +set custom_title "Add $group_name" + +# set the target for user-search.tcl in a dynamic so that this page +# can be moved to any server +regsub "manager" [ns_conn url] "manager-2" target + +# ---------------------------------------- +# serve the page + +ns_return 200 text/html "[ad_admin_header "Add Administrator"] + +

    Add Administrator

    + +[ad_admin_context_bar [list index.tcl "Portals Admin"] "Add Administrator"] + +
    + +
    +[export_form_vars target custom_title] + +Enter either the last name or email of the proposed manager: +

    + + + + + + + + + + + + + +
    Email:
    or Last name:
    + +

    + +[ad_admin_footer] +" Index: web/openacs/www/admin/portals/delete-manager-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/portals/delete-manager-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/portals/delete-manager-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,39 @@ +# delete-manager-2.tcl,v 3.0 2000/02/06 03:27:13 ron Exp +# delete-manager-2.tcl +# +# delete a super user from the portals system +# +# by aure@arsdigita.com and dh@arsdigita.com +# +# Last modified: 10/8/1999 + +set_the_usual_form_variables +# admin_id + + +if {![info exists admin_id]} { + ns_returnredirect index.tcl + return +} + + +set db [ns_db gethandle] +set user_id [ad_verify_and_get_user_id] +ad_maybe_redirect_for_registration + +set group_id [database_to_tcl_string $db "select group_id + from user_groups + where group_name = 'Super Administrators' + and group_type = 'portal_group'"] + + +# delete the administrator +ns_db dml $db " + delete from user_group_map + where user_id=$admin_id + and group_id=$group_id + and role='administrator'" + +ns_returnredirect index.tcl + + Index: web/openacs/www/admin/portals/delete-manager.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/portals/delete-manager.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/portals/delete-manager.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,71 @@ +# delete-manager.tcl,v 3.1 2000/03/01 08:45:00 yon Exp +# delete-manager.tcl +# +# list of super administrators, clicking on one deletes him +# +# by aure@arsdigita.com and dh@arsdigita.com +# +# Last modified: 10/8/1999 + + + +set db [ns_db gethandle] +set user_id [ad_verify_and_get_user_id] +ad_maybe_redirect_for_registration + +# get the group_id for Super Administrators +set group_id [database_to_tcl_string $db "select group_id + from user_groups + where group_name = 'Super Administrators' + and group_type = 'portal_group'"] + +set group_name [portal_group_name $db $group_id] + +set title "[ad_parameter SystemName portals]: Delete Administrator of [string toupper $group_name]" + +# --------------------------------------- +set administrator_list [database_to_tcl_list_list $db " + select user_id, first_names, last_name + from users + where ad_group_member_p ( user_id, $group_id ) = 't' + order by last_name"] + +# done with the database +ns_db releasehandle $db + + +set admin_list "Choose Super Administrator to delete:
      " +set admin_count 0 +foreach administrator $administrator_list { + set name "[lindex $administrator 1] [lindex $administrator 2]" + set person_id [lindex $administrator 0] + set admin_id $person_id + append admin_list "\n
    • $name" + incr admin_count +} +append admin_list "
    " +if {$admin_count == 0} { + set admin_list "There are currently no Super Administrators" +} + +# -------------------------------------- +# serve the page + +ns_return 200 text/html " +[ad_admin_header "$title"] + +

    $title

    + +[ad_admin_context_bar [list index.tcl "Portals Admin"] "Remove Administrator"] + +
    + +

    +$admin_list + +[ad_admin_footer]" + + + + + Index: web/openacs/www/admin/portals/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/portals/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/portals/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,100 @@ +# index.tcl,v 3.2 2000/03/04 23:08:18 aure Exp +# index.tcl +# +# Main index page for the site owner administration of the portals system. +# A site owner can create new portals and change the super administrators of +# the system +# +# by aure@arsdigita.com and dh@arsdigita.com +# +# Last modified: 10/8/1999 + +set db [ns_db gethandle] + +set user_id [ad_verify_and_get_user_id] +ad_maybe_redirect_for_registration +# -------------------------------------- +# make a list of the super administrators + +set selection [ns_db select $db "select u.first_names||' '||u.last_name as name, u.user_id + from users u, user_groups ug + where ug.group_name = 'Super Administrators' + and ug.group_type = 'portal_group' + and ad_group_member_p ( u.user_id, ug.group_id ) = 't' + order by u.last_name "] + +set super_list "" +set super_count 0 + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + # name, user_id + append super_list "

  • $name\n" +} + +# -------------------------------------- + +# make a list of all the portals + +set selection [ns_db select $db "select group_name + from user_groups + where group_type = 'portal_group' + and group_name <> 'Super Administrators' + order by group_name"] + +set portal_count 0 +set portal_list "" +while {[ns_db getrow $db $selection ]} { + set_variables_after_query + # group_name + + append portal_list "
  • $group_name" + incr portal_count +} + +# ---------------------------------------- +# get the group type for the Super Administrator group. + +set group_type "portal_group" + +# done with database +ns_db releasehandle $db + +#---------------------------------------------------------- +# serve the page +ns_return 200 text/html "[ad_admin_header "Portals Admin"] + +

    Portals Admin

    + +[ad_admin_context_bar "Portals Admin"] + +
    + +Documentation: /doc/portals.html +

    +

    +The daily administration is done by the portal managers at /portals/admin. Make sure you are in the Super Administrator list before visiting. +

    +The portal-wide Super Administrators: +

      +$super_list +
    +Add or Remove a Super Administrator. +

    + +The available portals: +

      +$portal_list +
    +Portal administration assignments and creation of new portals is done at /admin/ug/group-type-new.tcl. +[ad_admin_footer] +" + + + + + + + + + Index: web/openacs/www/admin/press/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/press/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/press/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,94 @@ +# Administration for the press module +# +# Author: ron@arsdigita.com, December 1999 +# +# index.tcl,v 3.0.4.1 2000/03/15 20:38:22 aure Exp +# ----------------------------------------------------------------------------- + +set db [ns_db gethandle] + +# Build the list of defined templates + +set selection [ns_db select $db " +(select t.template_id, + t.template_name, + t.template_adp, + count(p.template_id) as template_usage +from press_templates t, press p +where t.template_id = p.template_id +group by t.template_id, t.template_name, t.template_adp) +union +(select t.template_id, + t.template_name, + t.template_adp, + 0 as template_usage +from press_templates t +where 0=(select count(*) from press where press.template_id=t.template_id)) +order by t.template_name"] + +set avail_count 0 +set avail_list "" +while {[ns_db getrow $db $selection]} { + set_variables_after_query + + # PG 6.5 hack (BMA) + if {$template_id == ""} { + continue + } + + incr avail_count + append avail_list " +

    +

  • $template_name + (used $template_usage time[expr {$template_usage != 1 ? "s" : ""}]) +   + edit" + + if {$template_usage == 0 && $template_id > 1} { + append avail_list \ + " | delete" + } + + append avail_list " +

    + [press_coverage_preview $template_adp]" +} + +ns_db releasehandle $db + +if {$avail_count == 0} { + set avail_template_list " + There are no press coverage templates in the system." +} else { + set avail_template_list " +

    You may edit any of the following templates:

    +
      + $avail_list +
    " +} + +# ----------------------------------------------------------------------------- +# Ship it out + +ns_return 200 text/html " +[ad_admin_header "Press Administration"] + +

    Press Administration

    + +[ad_admin_context_bar "Press"] + +
    + +Documentation: /doc/press.html
    +User pages: /press/
    +Maintain press coverage: /press/admin/ + +

    $avail_template_list

    + +

    +

    +

    + +[ad_admin_footer]" Index: web/openacs/www/admin/press/template-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/press/template-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/press/template-add-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,27 @@ +# Insert a new template +# +# Author: ron@arsdigita.com, December 1999 +# +# template-add-2.tcl,v 3.0.4.2 2000/03/17 23:56:41 tzumainn Exp +# ----------------------------------------------------------------------------- + +ad_page_variables { + {template_name} + {template_adp} +} + +set db [ns_db gethandle] + +ns_db dml $db " +insert into press_templates + (template_id, + template_name, + template_adp) +values + (nextval('press_template_id_sequence'), + '[DoubleApos $template_name]', + '[DoubleApos $template_adp]')" + +# Redirect back to the templates page + +ns_returnredirect "" Index: web/openacs/www/admin/press/template-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/press/template-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/press/template-add.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,67 @@ +# Add a new press release template +# +# Author: ron@arsdigita.com, December 1999 +# +# template-add.tcl,v 3.0.4.1 2000/03/15 20:39:18 aure Exp +# ----------------------------------------------------------------------------- + +# Grab the site-default template to initialize this template + +set db [ns_db gethandle] +set default [database_to_tcl_string $db " +select template_adp from press_templates where template_id=1"] + +ns_db releasehandle $db + +# Now write out the form... + +ns_return 200 text/html " +[ad_admin_header "Add a Template"] + +

    Add a Template

    + +[ad_admin_context_bar [list "" "Press"] "Add a Template"] + +
    + +
    + + + + + + + + + + + + + +
    Template Name: +
    Template ADP: +
    +
    + +

    Instructions

    + +

    Enter an ADP fragment to specify a press release template. You can +refer to the following variables: + +

    +
    <%=\$publication_name%> +
    Name of the publication +
    <%=\$publication_date%> +
    When the article was published (date or description) +
    <%=\$article_title%> +
    Name of the article +
    <%=\$article_pages%> +
    Page reference for the article +
    <%=\$abstract%> +
    Abstract or summary of the article +
    + +[ad_admin_footer]" + + + Index: web/openacs/www/admin/press/template-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/press/template-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/press/template-delete-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,30 @@ +# Delete a template +# +# Author: ron@arsdigita.com, January 2000 +# +# template-delete-2.tcl,v 3.0.4.1 2000/03/15 20:40:35 aure Exp +# ----------------------------------------------------------------------------- + +ad_page_variables {template_id} + +set db [ns_db gethandle] + +# Verify (again) that this template is not being used + +set count [database_to_tcl_string $db " +select count(*) from press where template_id=$template_id"] + +if {$count > 0} { + ad_return_complaint 1 "
  • The template you selected is in use by + $count press items" + return +} + +# Delete the template + +ns_db dml $db "delete from press_templates where template_id=$template_id" + +# Redirect to the main admin page + +ns_returnredirect "" + Index: web/openacs/www/admin/press/template-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/press/template-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/press/template-delete.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,69 @@ +# Delete a template (confirmation page) +# +# Author: ron@arsdigita.com, January 2000 +# +# template-delete.tcl,v 3.0.4.1 2000/03/15 20:40:14 aure Exp +# ----------------------------------------------------------------------------- + +ad_page_variables {template_id} + +set db [ns_db gethandle] + +# Get the template info + +set selection [ns_db 1row $db " +select template_name, template_adp +from press_templates +where template_id=$template_id"] + +if {[empty_string_p $selection]} { + ad_return_complaint 1 "
  • The template you selected does not exist" + return +} else { + set_variables_after_query +} + +# Verify that this template is not being used + +set count [database_to_tcl_string $db " +select count(*) from press where template_id=$template_id"] + +if {$count > 0} { + ad_return_complaint 1 "
  • The template you selected is in use by + $count press items" + return +} + +# Verify that they're not trying to delete the site-wide default + +if {$template_id == 1} { + ad_return_complaint 1 "
  • You cannot delete the site-wide default" + return +} + +ns_db releasehandle $db + +# Now put up a confirmation page just to make sure + +ns_return 200 text/html " +[ad_admin_header "Delete a template"] + +

    Delete a Template

    + +[ad_admin_context_bar [list "" "Press"] "Delete a Template"] + +
    + +

    Please confirm that you want to permanently delete the +template \"$template_name\": + +

    +[press_coverage_preview $template_adp] +
    + +

    +

    +
    +
    + +[ad_admin_footer]" Index: web/openacs/www/admin/press/template-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/press/template-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/press/template-edit-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,26 @@ +# Update a template +# +# Author: ron@arsdigita.com, December 1999 +# +# template-edit-2.tcl,v 3.0.4.1 2000/03/15 20:42:34 aure Exp +# ----------------------------------------------------------------------------- + +ad_page_variables { + {template_id} + {template_name} + {template_adp} +} + +set db [ns_db gethandle] + +ns_db dml $db " +update press_templates +set template_name = '$template_name', + template_adp = '$template_adp' +where template_id = $template_id" + +ns_db releasehandle $db + +# Redirect back to the templates page + +ns_returnredirect "" Index: web/openacs/www/admin/press/template-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/press/template-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/press/template-edit.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,79 @@ +# Edit a template +# +# Author: ron@arsdigita.com, December 1999 +# +# template-edit.tcl,v 3.0.4.1 2000/03/15 20:40:59 aure Exp +# ----------------------------------------------------------------------------- + +ad_page_variables {template_id} + + +# Get the template information from the database + +set db [ns_db gethandle] + +set selection [ns_db 1row $db " +select template_name, template_adp +from press_templates +where template_id=$template_id"] +set_variables_after_query + +ns_db releasehandle $db + +# Note that template_id = 1 is special - it's the site-wide default +# template. Administrators can edit this template but they cannot +# rename it. + +set template_form " +
    +" + +if {$template_id == 1} { + append template_form " + [export_form_vars template_id template_name] + + + + + " +} else { + append template_form " + [export_form_vars template_id] +
    Template Name:Site-wide default template
    + + + + " +} + +append template_form " + + + + + + + + +
    Template Name:
    Template ADP: +
    +
    " + +# ----------------------------------------------------------------------------- +# Ship out the form + +ns_return 200 text/html " +[ad_admin_header "Edit a Template"] + +

    Edit a Template

    + +[ad_admin_context_bar [list "" "Press"] "Edit a Template"] + +
    + +$template_form + +[ad_admin_footer]" + + + Index: web/openacs/www/admin/press/template-preview.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/press/template-preview.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/press/template-preview.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,100 @@ +# Preview a template +# +# Author: ron@arsdigita.com, December 1999 +# +# template-preview.tcl,v 3.0.4.2 2000/03/17 23:55:48 tzumainn Exp +# ----------------------------------------------------------------------------- + +ad_page_variables { + {target} + {template_id 0} + {template_name} + {template_adp} +} + +set db [ns_db gethandle] + +# Pre-processing + +set template_name [string trim $template_name] +set template_adp [string trim $template_adp] + +# Build a preview of the template + +set preview [press_coverage_preview $template_adp] + +# NOTE: AOLserver 2.x does not throw exceptions for ns_adp_parse, so +# we can't check for a parsing error from here. In AOLserver 3.0 +# you can test for an error using the following: +# +# if {[ns_adp_exception] != "ok"} { +# incr error_count +# append error_list "
  • You're ADP generated a parsing error" +# } + +# ----------------------------------------------------------------------------- +# Error checking + +set error_count 0 +set error_list "" + +if {[empty_string_p $template_name]} { + incr error_count + append error_list "
  • You must provide a template name\n" +} + +if {[empty_string_p $template_adp]} { + incr error_count + append error_list "
  • You must provide the template ADP code\n" +} + +if {[string length $template_adp] > 4000} { + incr error_count + append error_list "
  • Your template is too long (4000 characters max)" +} + +# Check for name conflicts + +if {0 != [database_to_tcl_string $db " +select count(*) from press_templates +where template_id != $template_id +and template_name = '[DoubleApos $template_name]'"]} { + incr error_count + append error_list "
  • Your template name conflicts with an existing template\n" +} + +if {$error_count > 0} { + ad_return_complaint $error_count $error_list + return +} + +# Done with the database + +ns_db releasehandle $db + +# ----------------------------------------------------------------------------- +# Ship it out + +ns_return 200 text/html " +[ad_admin_header "Preview"] + +

    Preview

    + +[ad_admin_context_bar [list "" "Press"] "Template Preview"] + +
    + +

    The following preview shows what press items formatted using the +template $template_name will look like: + +

    +$preview +
    + +
    +[export_form_vars template_id template_name template_adp] +
    +
    +
    + +[ad_admin_footer]" Index: web/openacs/www/admin/prototype/changes.txt =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/prototype/changes.txt,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/prototype/changes.txt 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,45 @@ +Changes to the original code made by David Rodriguez (dvr@arsdigita.com). + (Note: Some of the line numbers below are no longer + accurate since I changed the code). + +1) Modified returncode.tcl and returncodeall.tcl to create +directories if they don't exist before saving code. + +2) I think line 595 in tableinfo-3.tcl was unneeded. It printed +a "" to the screen. Commented out the line {ns_write \""} + +3) solicit_info would say "Please enter the the prompt text..." +(notice the two copies of "the"). Fixed. + +4) There were some TEXTAREAS with empty space between . Removed those. + +5) In code_for_textbox, a small textbox (SIZE=10) wouldn't be enclosed +with 's. Fixed. + +6) Add an extra space after the # in the list of needed variables. +Fixed line 351, 759, 572, 632 in tableinfo3.tcl + +7) modified a bunch of the code so it would have spaces where we +want the (so the resulting HTML would look nicer) + +8) Modified returncode.tcl and returncodeall.tcl to overwrite +any files in the way. + +9) Changed the $backlink stuff. Now uses the Yahoo-style navbar. + +10) created a proc max_col_length that queries the database +to determine the maximum allowed length for a column. We use +this information to set the MAXLENGTH of any INPUT TYPE=TEXT .. +box. Used in handle_textbox and code_for_textbox. Added some upvar's +in other procs so these functions can get access to $table_name + +11) on add-2.tcl and edit-2.tcl, added pieces of code +that checks to see if variables are too long. I don't know +how to determine if the variable coming in is coming from a TEXTAREA, +so I check the maximum length of the column, and if it's longer +than 200, assume that it's coming from a textarea, and therefore +needs to be checked. + +12) Killed the form at the top of tableinfo-3.tcl that led +to the edit pages. Wasn't needed. Index: web/openacs/www/admin/prototype/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/prototype/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/prototype/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,55 @@ +# index.tcl,v 3.0 2000/02/06 03:27:26 ron Exp +set db [ns_db gethandle] + +#we aren't going to do much with this besides pass it on +#set user_id [ad_verify_and_get_user_id] +#if {[string compare $user_id 0] == 0} { +# ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode [ns_conn url]?[ns_conn query]]" +#} + +ReturnHeaders + +ns_write " + + +Prototype Pages + + + + +

    Generate Prototype pages for a Table

    + +
    +Confused? Read about how to use this module.
    +Intrigued? Get a copy for yourself. + +

    Pick a Table

    + +
    + +Please tell us the name of the table:
    + +

    +Or choose a table from this list:
    +[ns_htmlselect -sort Table [ns_table list $db]] +

    +
    +Please tell us a base directory name for the tcl files you wish to create:
    +[ns_info pageroot]/
    \n +Please tell us a base filename for the pages you wish to create:
    +
    \n +(for instance, if you choose authors for a base
    filename you +will get an option to be returned,
    among others, +the code for authors-add.tcl) " + + +ns_write "

    + +

    +
    +
    rfrankel@athena.mit.edu
    + + + +" + Index: web/openacs/www/admin/prototype/returncode.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/prototype/returncode.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/prototype/returncode.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,58 @@ +# returncode.tcl,v 3.0 2000/02/06 03:27:27 ron Exp +#expected variable is one of +#code_list mycode_add mycode_add_insert mycode_edit mycode_edit_insert +#also definitely base_name and base_dir_name and whattodo +set_the_usual_form_variables 0 +ReturnHeaders text/plain + +if [info exists code_list] { + set mycode $code_list +} +if [info exists mycode_add] { + set mycode $mycode_add +} +if [info exists mycode_add_insert] { + set mycode $mycode_add_insert +} +if [info exists mycode_edit] { + set mycode $mycode_edit +} +if [info exists mycode_edit_insert] { + set mycode $mycode_edit_insert +} + +if [string match $whattodo "Save code"] { + set directory [ns_info pageroot] + append directory "/$base_dir_name" + set filename "/$directory/$base_name" + if {[string first ".." $filename] != -1} { + ns_write "#We're sorry, but for security reasons we \n" + ns_write "#will not attempt to save this file,\n" + ns_write "#because we have detected a \"..\" in the filename\n" + ns_write "#$filename. \n\n" + } else { + # we might need to make the directory + if ![file exists $directory] { + if [catch {ns_mkdir $directory} errmsg] { + ns_write "# Tried to make $directory, but failed with message: $errmsg\n"; + } else { + ns_write "# created directory $directory\n" + } + } + if [catch {set filetosavein [open $filename w]} errmsg] { + ns_write "#There was an error in opening $filename.\n" + ns_write "#The error message was: \n# $errmsg\n\n" + } else { + puts $filetosavein $mycode + ns_write "#$base_name saved successfully \n#in $filename.\n\n" + } + } +} + + +#set roundonequote [ns_quotehtml $mycode] +#regsub -all "amp;" $roundonequote "" roundtwoquote +#set roundthreequote "" +#append roundthreequote "
    " $roundtwoquote "
    " + +ns_write "$mycode" \ No newline at end of file Index: web/openacs/www/admin/prototype/returncodeall.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/prototype/returncodeall.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/prototype/returncodeall.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,64 @@ +# returncodeall.tcl,v 3.0 2000/02/06 03:27:29 ron Exp +#expected variable is all of +#mycode_list mycode_add mycode_add_insert mycode_edit mycode_edit_insert +#also definitely base_file_name and base_dir_name and whattodo +set_the_usual_form_variables 0 + + +ReturnHeaders + +ns_write " + +[ad_admin_header "Saving the $base_file_name module"] + +

    Saving the $base_file_name module.

    + +part of the Prototype Builder + +
    +

    Attempting to save the files...

    " + + +if {[string first ".." $base_dir_name] != -1} { + ns_write "We're sorry, but for security reasons we \n" + ns_write "will not attempt to save these file,\n" + ns_write "because we have detected a \"..\" in the directoryname\n" + ns_write "$base_dir_name. \n\n

    " +} else { + # we might need to make the directory + + set directory [ns_info pageroot] + set directory "$directory/$base_dir_name" + if ![file exists $directory] { + if [catch {ns_mkdir $directory} errmsg] { + ns_write "

    Tried to make $directory, but failed with me\ +ssage: $errmsg

    \n"; + } else { + ns_write "

    created directory $directory

    \n" + } + } + foreach filetype \ + {-list.tcl -add.tcl -add-2.tcl -view.tcl -edit.tcl -edit-2.tcl} { + set filename "$directory/$base_file_name$filetype" + set varname mycode + switch -- $filetype { + -list.tcl {append varname _list} + -add.tcl {append varname _add} + -add-2.tcl {append varname _add_insert} + -view.tcl {append varname _view} + -edit.tcl {append varname _edit} + -edit-2.tcl {append varname _edit_insert} + } + if [catch {set filetosavein [open $filename w]} errmsg] { + ns_write "There was an error in opening $filename.\n
    " + ns_write "The error message was: \n $errmsg\n\n

    " +} else { + puts $filetosavein [set $varname] + ns_write "$base_file_name$filetype saved successfully \nin $filename.\n\n

    " +} } } + +ns_write "

    If everything went well, you can now go to the front +page of the module you just created.

    + +[ad_admin_footer]" + Index: web/openacs/www/admin/prototype/tableinfo-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/prototype/tableinfo-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/prototype/tableinfo-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,101 @@ +# tableinfo-2.tcl,v 3.0 2000/02/06 03:27:30 ron Exp +#It is slightly complicated which variables we expect from tableinfo +#First, we are getting (for sure) a list_of_cols and table_name +#Second, we are definitely getting list_name_plural and list_name_sing +#base_file_name and base_dir_name +#page_head back_phrase, back_link and back_text. +#Next, primary_key, creation_date, creation_user and row_name +# whose values are either "none" or one of the columns +# also there may be a sequence name in seq_name +#Next, for each column in the list of columns, we are getting +# ${column}_error_action and ${column}_form_type +# which may have values "none" or any of a number of options +set_the_usual_form_variables + +#list_of_cols, table_name, list_name_plural, list_name_sing, base_file_name, base_dir_name, page_head, back_phrase, back_link, back_text, primary_key, creation_date, creation_user, row_name, ${column}_error_action, ${column}_form_type for each column in list_of_cols + +ReturnHeaders + +ns_write " +[ad_header \"Finish\"] + +

    Finish Building the Page

    + +
    + +
    " + +set html_uk [column_select $list_of_cols "unique_key"] +set html_vr [column_select $list_of_cols "visible_row"] +if {![string compare $primary_key "none"]||\ + ![string compare $row_name "none"]} { + set list_for_select [concat "none" $list_of_cols] + ns_write "

    We need some more information about the columns:

    " + if {![string compare $primary_key "none"]} { + ns_write "You did not identify an integer primary key.
    We must have + a column that uniqely identifies a row.
    + (but it doesn't necessarily have to be an integer).

    + Please enter an identifying column:  $html_uk

    " + } + if {![string compare $row_name "none"]} { + ns_write "You did not identify a column that contains the + name of the object.
    We must have a column we will use to + list all the rows in the table.

    + Please enter a column that can represent the rows:  $html_vr

    " + } +} + +ns_write "

    Refine the Information about each Column:

    " + +# First we need to go through all our columns and separate +# them into three categories: the special ones, which get passed on +# the ones about which we need more information, and the ones we ignore +# The ones we need more info will be put in list_ord_cols. +# Also make an array of form_types for all the ordinary columns to +# be used later. Same for error_action. + +set list_ord_cols {} +foreach column $list_of_cols { + set special_list "$primary_key $creation_date $creation_user" + set index [check_special $column $special_list] + if {$index == 0} { + set form_var $column + append form_var "_form_type" + set form_type($column) [set $form_var] + set error_var $column + append error_var "_error_action" + set error_action($column) [set $error_var] + if [string compare [set $form_var] "none"] { + lappend list_ord_cols $column + ns_write "[export_form_vars $form_var $error_var]" + } + } +} + +foreach column $list_ord_cols { + ns_write "[solicit_info $column $form_type($column)]" + ns_write "[solicit_error_info \ + $column $error_action($column) $form_type($column)]" + } + +ns_write " +[export_form_vars list_of_cols list_ord_cols table_name user_id ] +[export_form_vars page_head back_phrase back_link back_text] +[export_form_vars row_name list_name_plural list_name_sing] +[export_form_vars primary_key creation_date creation_user seq_name] +[export_form_vars base_file_name base_dir_name] +

    +

    + +
    +
    + + +

    +

    +
    rfrankel@athena.mit.edu
    + + +" + + Index: web/openacs/www/admin/prototype/tableinfo-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/prototype/tableinfo-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/prototype/tableinfo-3.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,1060 @@ +# tableinfo-3.tcl,v 3.0 2000/02/06 03:27:31 ron Exp +set_the_usual_form_variables + +#list_of_cols, table_name, list_ord_cols, base_file_name, list_name_plural,list_name_sing, base_file_name, base_dir_name, page_head, back_phrase, back_link, back_text, primary_key, creation_date, creation user, row_name, seq_name, unique_key, visible_row, ${column}_error_action, ${column}_form_type,${column}_prompt_text, ${column}_extra_info, ${column}_ei_two, ${column}_ei_three + +#It is slightly complicated which variables we expect from tableinfo-2 +#First, we are getting (for sure) a list_of_cols and table_name +#also, a list_ord_cols, and a base_file_name +#Second, we are definitely getting list_name_plural and list_name_sing +#base_file_name and base_dir_name +#page_head back_phrase, back_link and back_text. +#Next, primary_key, creation_date, creation_user and row_name +# whose values are either "none" or one of the columns +# also there may be a sequence name in seq_name +# Or if no primary key, we should get unique_key +# Similarly, if no row_name, we should get visible_row +#Next, for each column in the list of columns, we are getting +# ${column}_error_action and ${column}_form_type +# ${column}_prompt_text, ${column}_extra_info +# maybe also ${column}_ei_two and ${column}_ei_three +# which may have values "none" or any of a number of options + + +# I want a list of all the variables I got so I can export them again +set list_all_vars {} +set form [ns_getform] +set form_size [ns_set size $form] +set form_counter_i 0 +while {$form_counter_i<$form_size} { + lappend list_all_vars [ns_set key $form $form_counter_i] + incr form_counter_i +} + +#set up the variables that will contain the code for the return +#pages. +set code_list "" +set code_add "" +set code_add_insert "" +set code_edit "" +set code_edit_insert "" + +#Check whether we got a primary key or row name. Correct if not. +set exception_count 0 +set exception_text "" +set primary_key_not_integer_flag 0 +set row_name_not_official 0 +if {![string compare $primary_key "none"]} { + if {![string compare $unique_key "none"]} { + #Problem -- neither primary key nor unique key + incr exception_count + append exception_text "We must have a unique key for our row!
    " + } else { + set primary_key $unique_key + set primary_key_not_integer_flag 1 + } +} + +if {![string compare $row_name "none"]} { + if {![string compare $visible_row "none"]} { + #Problem -- neither primary key nor unique key + incr exception_count + append exception_text "We must have a column we can display!
    " + } else { + set row_name $visible_row + set row_name_not_official 1 + } +} + +if {$exception_count>0} { + ad_return_complaint $exception_count $exception_text + return +} + + +ReturnHeaders + +ns_write " + +[ad_header \"$page_head\"] + +

    Generated Code

    + +by the Prototype tool + +
    +" +#

    All the $list_name_plural

      + + +set count 0 +set db [ns_db gethandle] +set list_of_names [database_to_tcl_list_list $db \ + "select $row_name, $primary_key from $table_name"] +set list_for_export [lappend list_all_vars name_of_object key_for_object] +foreach pair $list_of_names { + incr count + set name_of_object [lindex $pair 0] + set key_for_object [lindex $pair 1] +# ns_write "
    • $name_of_object
      \n" +# if {$count>50} { +# ns_write "
    • We are only listing the first fifty values here." +# break +# } +} +#ns_write "

    Add a $list_name_sing

    " +# +#ns_write " +# +#
    " +# +set my_html "\n" +#ns_write "
    \n" +foreach column $list_ord_cols { + set form_var $column + append form_var "_form_type" + set form_type($column) [set $form_var] + set prompt_var $column + append prompt_var "_prompt_text" + set prompt_text($column) [set $prompt_var] + set eione_var $column + append eione_var "_extra_info" + if ![info exists $eione_var] {set $eione_var ""} + set extra_info($column) [set $eione_var] + set eitwo_var $column + append eitwo_var "_ei_two" + if ![info exists $eitwo_var] {set $eitwo_var ""} + set ei_two($column) [set $eitwo_var] + set eithree_var $column + append eithree_var "_ei_three" + if ![info exists $eithree_var] {set $eithree_var ""} + set ei_three($column) [set $eithree_var] + set error_var $column + append error_var "_default" + + ## Special date processing. This is terribly ugly, but can't be helped + if ![string compare [set $form_var] "date"] { + #we are of type date. This requires special processing +# ns_write "\n" + append my_html "\n" +# #nasty awful cluge. This sets default to now if none specified. + if ![info exists $error_var] {set $error_var "now"} + if ![string compare [set $error_var] "now"] { +# ns_write "\n\n" + append my_html {\n\n" + } else { + # We have to set a default value for the date. + set exception_count 0 + set exception_text "" + if [catch { ns_dbformvalue \ + [ns_conn form] $error_var date entry_date } errmsg] { + incr exception_count + append exception_text " +
  • Please enter a valid date for the entry date" + } + #ns_write "Entry Date:$entry_date
    " + #ns_write "Error Message:$errmsg
    " + if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return + } + +# ns_write "
    • \n\n" + append my_html {\n\n" + } + } else { + + if ![info exists $error_var] {set $error_var ""} +# ns_write "[make_form $column [set $form_var] [set $prompt_var] [set $eione_var] [set $eitwo_var] [set $eithree_var] [set $error_var]]" + append my_html "[make_form $column [set $form_var] [set $prompt_var] [set $eione_var] [set $eitwo_var] [set $eithree_var] [set $error_var]]" + + } +} +#ns_write "
    [set $prompt_var]
    [set $prompt_var][philg_dateentrywidget_default_to_today $column]
    [philg_dateentrywidget_default_to_today } + append my_html "$column\]
    [philg_dateentrywidget [set $error_var] $entry_date]
    [philg_dateentrywidget } + append my_html "$column $entry_date\]
    \n" +append my_html "\n" + +###################################################### +# Now echo this for returning as code to a list page # + +append code_list "#Code for ${base_file_name}-list.tcl\n\n" + +#append code_list {set user_id [ad_verify_and_get_user_id] +#if } "{" {[string compare $user_id 0] == 0 } "} " +#append code_list "{\n ns_returnredirect \n " +#append code_list {/register/index.tcl?return_url=[ns_urlencode [ns_conn url]?[ns_conn query]]} +#append code_list "\" \n}" +#append code_list "\n\n" + +append code_list "ReturnHeaders\n" + +append code_list "ns_write \"" +append code_list {[ad_header} " \"$page_head\" " {]} + +append code_list "\n

    $page_head

    \n + +\[ad_context_bar_ws \[list \"$back_link\" \"$back_text\"\] \"List $list_name_plural\"\] + +
    \n +

    All the $list_name_plural

    \n
      \"\n" + +append code_list " +set db \[ns_db gethandle\] +set sql_query \"select $row_name, $primary_key from $table_name\" +set selection \[ns_db select \$db \$sql_query\] + +set counter 0 +while \{ \[ns_db getrow \$db \$selection\] \} \{ + set_variables_after_query + incr counter + ns_write \"
    • \$$row_name
      \" +\} + +if \{ \$counter == 0 \} \{ + ns_write \"
    • There are no $list_name_plural in the database right now.

      \" +\} + +ns_write \"

    • Add a $list_name_sing

    \n" + +append code_list "\[ad_footer\]\"" + +# End of code generation for list page # +###################################################### + +###################################################### +# Now echo this for returning as code to add page # + +#Page to get data from user for insert into $table_name +#This file should be called ${base_file_name}-add.tcl\n\n" +set code_add "#Code for ${base_file_name}-add.tcl\n\n" + +#append code_add {set user_id [ad_verify_and_get_user_id] +#if } "{" {[string compare $user_id 0] == 0 } "} " +#append code_add "{\n " {ns_returnredirect \"} "\n" +#append code_add {/register/index.tcl?return_url=[ns_urlencode [ns_conn url]?[ns_conn query]]} +#append code_add "\" \n}" +#append code_add "\n\n" + +append code_add "ad_maybe_redirect_for_registration\n" + +append code_add {set db [ns_db gethandle]} +#now echo for my record +append code_add "\nReturnHeaders \n + +ns_write \" +\[ad_header \"Add a $list_name_sing\"\] + +

    Add a $list_name_sing

    + +\[ad_context_bar_ws \[list \"$back_link\" \"$back_text\"\] \"Add a $list_name_sing\"\] + +
    + + \n\n" + +append code_add "$my_html" + +#Finish up the page for the mycode_add to be shown to the user +#append code_add "\n" {[export_form_vars user_id]} "\n" + +if {[info exists seq_name]&&![empty_string_p $seq_name]} { + append code_add "" +} else { + if {!$primary_key_not_integer_flag } { + #The primary key is an integer but we don't have a sequence. + #Should I do something here? + } else { + #In this case we don't even have an integer primary key + #Is there anything we can do to provide double-click protection? + } +} + + +append code_add " +

    +

    + +
    +
    +

    \n" +append code_add {[ad_footer]"} + + +# End of code generation for add page # +###################################################### + +###################################################### +# Now build the code for the insert page # + +# Some information I need to know to build code +set list_of_checks {} +set list_selectradio {} +foreach column $list_ord_cols { + switch $form_type($column) { + checkbox { + lappend list_of_checks $column + } + radiobutton { + lappend list_selectradio $column + } + select { + lappend list_selectradio $column + } + boolean { + lappend list_selectradio $column + } + default {} + } +} + +set code_add_insert {#This is not done yet! Don't expect it to work!} +set code_add_insert "#This file should be called ${base_file_name}-add-2.tcl\n" +#append code_add_insert "\n#Target for ${base_file_name}-add.tcl" +#append code_add_insert "\n#The expected variables are " +#append code_add_insert "[join $list_ord_cols ", "]\n" +#append code_add_insert "#Also user_id, the id of the user found on add page\n" + + +#if {[info exists seq_name]&&![empty_string_p $seq_name]} { +#append code_add_insert "#And $primary_key, the sequence value generated on add page\n" +#} + + +if {$list_of_checks != {}} { +append code_add_insert\ + "\n#Special processing for checkbuttons." +} + +foreach column $list_of_checks { + append code_add_insert\ + "\n#The expected variable here is $column\n" + set list_var "list_of_" + append list_var $column "s" + set list_of($column) $list_var + + append code_add_insert "if \{\[ns_conn form \] == " + append code_add_insert "\"\" \} \{\n" + append code_add_insert " set $list_var \"\"\n" + append code_add_insert "\} else \{\n " + append code_add_insert "set $list_var \[" + append code_add_insert "nmc_GetCheckboxValues \[ns_conn form" + append code_add_insert "\] $column\]\n" + append code_add_insert "\}\n\n" +} + +#echo for code_add_insert returned to user +append code_add_insert {set_the_usual_form_variables} + + +append code_add_insert "\n\n# [join $list_ord_cols ", "]" + +if {[info exists seq_name]&&![empty_string_p $seq_name]} { +append code_add_insert ", $primary_key\n" +} else { +append code_add_insert "\n" +} + +append code_add_insert "set user_id \[ad_get_user_id\]\n" +foreach column $list_of_checks { + append code_add_insert\ + "\n\n#Now set the checkbutton variable $column to the proper values \n" + append code_add_insert "set $column \$$list_of($column)\n" + append code_add_insert \ + "set QQ$column \[DoubleApos \$$list_of($column)\]\n" +} + +#Safeguard against errors caused by unselected radios or selects +if {$list_selectradio != {}} { + append code_add_insert\ + "\n#Radiobuttons and selects may give us trouble if none are selected" + append code_add_insert\ + "\n#The columns that might cause trouble are [join $list_selectradio ", "]" +} + +foreach column $list_selectradio { + append code_add_insert "\nif !\[info exists $column\] \{\n" + append code_add_insert " set $column \"\"\n" + append code_add_insert " set QQ$column \"\"\n" + append code_add_insert "\}" +} + +append code_add_insert\ + "\n\n#Now check to see if the input is good as directed by the page designer" +append code_add_insert "\n\n" {set exception_count 0} "\n" +append code_add_insert "set exception_text \"\"\n" + +foreach column $list_ord_cols { + set action_var $column + append action_var "_error_action" + + ## Special date processing. This is terribly ugly, but can't be helped + set form_var $column + append form_var "_form_type" + if ![string compare [set $form_var] "date"] { + #we always need to check and complain when getting dates + append code_add_insert\ + "\n\n# it doesn't matter what instructions we got,\n" + append code_add_insert\ + "# since $column is of type date and thus must be checked.\n" + append code_add_insert "if \[catch \{ ns_dbformvalue \[ns_conn form\] $column date $column \} errmsg\] \{ + incr exception_count + append exception_text \"

  • Please enter a valid date for the entry date.\" +\}" + } else { + switch [set $action_var] { + complain { + #put error-checking information in returned code + append code_add_insert\ + "\n\n# we were directed to return an error for $column\n" + append code_add_insert {if} " \{" + append code_add_insert {![info exists } + append code_add_insert "$column] || " + append code_add_insert {[empty_string_p $} + append code_add_insert \ + "[set column]]\} \{\n incr exception_count\n" + + set error_var $column + append error_var "_exception_text" + if {[info exists $error_var]&&![empty_string_p [set $error_var]]} { + append code_add_insert " append exception_text" + append code_add_insert " \"" + append code_add_insert \ + "
  • [philg_quote_double_quotes [set $error_var]]" + append code_add_insert "
    \"\n" "\} " + } else { + append code_add_insert\ + " append exception_text \"
  • You did not enter " + append code_add_insert \ + "a value for $column.
    \"\n\} " + } + + } + fixit { + set error_var $column + append error_var "_default" + if {[info exists $error_var]&&![empty_string_p [set $error_var]]} { + #put error-checking information in returned code + append code_add_insert\ + "\n\n# we were directed to set a default for $column\n" + append code_add_insert {if} " {" + append code_add_insert {![info exists } + append code_add_insert "$column\] ||" + append code_add_insert {[empty_string_p $} + append code_add_insert "[set column]\]\} \{\n " + append code_add_insert " set $column [set $error_var]" + append code_add_insert " \n set QQ$column " + append code_add_insert {[DoubleApos } + append code_add_insert "[set $error_var]] \n}" + } else { + } + } + default { + } + } +} +} + +# The code that checks if all the variables are shorter +# than the max length of the column + + +foreach element $list_ord_cols { + set max_length [max_col_length $table_name $element] + if {$max_length > 200} { + append code_add_insert " +if \{\[string length \$$element\] > $max_length\} \{ + incr exception_count + append exception_text \"
  • \\\"$element\\\" is too long\\n\" +\} +" +} +} + +#Finish the error-checking entry into code_add_insert variable +append code_add_insert "\nif" " {" {$exception_count } "> 0} " "{\n" +append code_add_insert " ad_return_complaint " {$exception_count $exception_text} "\n" +append code_add_insert " return\n" "}\n" + +append code_add_insert "\n# So the input is good --" + +append code_add_insert "\n# Now we'll do the insertion in the $table_name table.\n" + +append code_add_insert {set db [ns_db gethandle]} "\n" + +#append code_add_insert {ns_db dml $db \"begin transaction\"} +#append code_add_insert {ns_db dml $db} + +#Now build my update statement +set insert_list {} +set insert_val_list {} + + +if {[info exists seq_name]&&![empty_string_p $seq_name]} { + lappend insert_list $primary_key + lappend insert_val_list "\$$primary_key" +} + + +if {[string compare $creation_date "none"]} { + lappend insert_list $creation_date + lappend insert_val_list sysdate +} + +if {[string compare $creation_user "none"]} { + lappend insert_list "$creation_user" + lappend insert_val_list "\$user_id" +} + +foreach column $list_ord_cols { + ## Special date processing. This is terribly ugly, but can't be helped + set form_var $column + append form_var "_form_type" + if ![string compare [set $form_var] "date"] { + lappend insert_list $column + lappend insert_val_list "to_date('\$$column','YYYY-MM-DD')" + } else { + #a normal column; should be user submitted info in column var + lappend insert_list $column + lappend insert_val_list "'\$QQ$column'" + } + } + +set insert_string [join $insert_list ", "] +set insert_val_string [join $insert_val_list ", "] + + +append code_add_insert {if [catch } "{" +append code_add_insert {ns_db dml $db} +append code_add_insert " \"insert into $table_name + ($insert_string) + values + ($insert_val_string)\"" +append code_add_insert " } errmsg] {\n" +append code_add_insert "\n # Oracle choked on the insert" + +if {[info exists seq_name]&&![empty_string_p $seq_name]} { + + append code_add_insert "\n" { if } "\{ " {[} + append code_add_insert { database_to_tcl_string $db "select count(*) from } + append code_add_insert "$table_name where $primary_key = " + append code_add_insert "\$$primary_key\"\] == 0" + append code_add_insert " \} \{ \n\n " + append code_add_insert {# there was an error with the insert other than a duplication} "\n" + + } + +append code_add_insert " " {ad_return_error "Error in insert" "We were unable to do your insert in the database. +Here is the error that was returned: +

    +

    +
    +$errmsg
+
    +
    " + return + } } + +if {[info exists seq_name]&&![empty_string_p $seq_name]} { + append code_add_insert "\n\} " +} + +append code_add_insert "\n" +#append code_add_insert {ns_db dml $db \"end transaction\"} + +append code_add_insert {ns_returnredirect } +append code_add_insert "${base_file_name}-list.tcl" + + +# End of code generation for insert (add-2) page # +###################################################### + +###################################################### +# Now build the code for the view page # +set selectlist [join $list_ord_cols ", "] + +set code_view "#This file should be called ${base_file_name}-view.tcl" +append code_view "\n#Called from ${base_file_name}-list.tcl\n" +#append code_view "\n#The expected variables are " +#append code_view "$primary_key, the id of the row we wish to view" "\n" +#append code_view "#Also user_id, the id of the current user.\n" + +append code_view {set_the_usual_form_variables} "\n\n" + +append code_view "# $primary_key\n\n" + +append code_view "set db \[ns_db gethandle\] +set selection \[ns_db 1row \$db \" + select $selectlist + from $table_name + where $primary_key='\[DoubleApos \$$primary_key\]'\"\] +set_variables_after_query + +#now we have the values from the database." + +append code_view "\n\nReturnHeaders + +ns_write \" +\[ad_header \"View the entry for \$$row_name\"\] + +

    View the entry for \$$row_name

    + +\[ad_context_bar_ws \[list \"$back_link\" \"$back_text\"\] \"View a $list_name_sing\"\] + +
    \n\n" + +# Make the report: + +# I think this was a bug -- dvr +# ns_write \"" + +append code_view "\n" +foreach column $list_ord_cols { + append code_view "[make_report $column $form_type($column)\ + $prompt_text($column) $extra_info($column) $ei_two($column)\ + $ei_three($column)]" +} + +append code_view "
    " + +#Finish up the page for the mycode_view to be shown to the user + +append code_view " + +

    \n" +append code_view "\[ad_footer\]\"" + + +# End of code generation for view page # +###################################################### + +set selectlist [join $list_ord_cols ", "] + +###################################################### +# Now build the code for the edit page # + +set code_edit "#This file should be called ${base_file_name}-edit.tcl" +append code_edit "\n#Called from ${base_file_name}-list.tcl\n" +#append code_edit "\n#The expected variables are " +#append code_edit "$primary_key, the id of the row we wish to edit" "\n" +#append code_edit "#Also user_id, the id of the current user.\n" + +append code_edit {set_the_usual_form_variables} "\n\n" + +append code_edit "# $primary_key\n\n" + +append code_edit "ad_maybe_redirect_for_registration\n" +append code_edit "set db \[ns_db gethandle\] +if {\[catch \{set selection \[ns_db 1row \$db \" + select $selectlist + from $table_name + where $primary_key=\$$primary_key\"\]} errmsg\]} { + ad_return_error \"Error in finding the data\" \"We encountered an error in querying the database for your object. +Here is the error that was returned: +

    +

    +
    +\$errmsg
+
    +
    \" + return +} + + +set_variables_after_query + +#now we have the values from the database." + +append code_edit "\n\nReturnHeaders + +ns_write \" +\[ad_header \"Edit the entry for \$$row_name\"\] + +

    Edit the entry for \$$row_name

    + +\[ad_context_bar_ws \[list \"$back_link\" \"$back_text\"\] \"Edit a $list_name_sing\"\] + +
    + +
    +\[export_form_vars $primary_key\]\" + +# Make the forms: + +ns_write \"" +append code_edit "\n" +foreach column $list_ord_cols { + append code_edit "[make_form_code $column $form_type($column)\ + $prompt_text($column) $extra_info($column) $ei_two($column)\ + $ei_three($column)]" +} +append code_edit "
    " + +#Finish up the page for the mycode_edit to be shown to the user + +append code_edit " +

    +

    + +
    +
    +

    \n" +append code_edit "\[ad_footer\]\"" + + +# End of code generation for edit page # +###################################################### + +###################################################### +# Now build the code for the insert page # + +# Some information I need to know to build code +set list_of_checks {} +set list_selectradio {} +foreach column $list_ord_cols { + switch $form_type($column) { + checkbox { + lappend list_of_checks $column + } + radiobutton { + lappend list_selectradio $column + } + select { + lappend list_selectradio $column + } + boolean { + lappend list_selectradio $column + } + default {} + } +} + + +set code_edit_insert "#This file should be called ${base_file_name}-edit-2.tcl\n" +#append code_edit_insert "\n#Target for ${base_file_name}-edit.tcl" +#append code_edit_insert "\n#The expected variables are " +#append code_edit_insert "[join $list_ord_cols ", "]\n" +#append code_edit_insert "#and user_id, the id of the user found on add page\n" + + +#if {[info exists seq_name]&&![empty_string_p $seq_name]} { +#append code_edit_insert \ +# "#And $primary_key, the key of the object we are editing\n" +#} + + + +if {$list_of_checks != {}} { +append code_edit_insert\ + "\n\n#Special processing for checkbuttons." +} + +foreach column $list_of_checks { + append code_edit_insert\ + "\n#The expected variable here is $column\n" + set list_var "list_of_" + append list_var $column "s" + set list_of($column) $list_var + + append code_edit_insert "if \{\[ns_conn form \] == " + append code_edit_insert "\"\" \} \{\n" + append code_edit_insert " set $list_var \"\"\n" + append code_edit_insert "\} else \{\n " + append code_edit_insert "set $list_var \[" + append code_edit_insert "nmc_GetCheckboxValues \[ns_conn form" + append code_edit_insert "\] $column\]\n" + append code_edit_insert "\}\n\n" +} + +#echo for code_edit_insert returned to user +append code_edit_insert {set_the_usual_form_variables} + +append code_edit_insert "\n\n# [join $list_ord_cols ", "]" + +if {[info exists seq_name]&&![empty_string_p $seq_name]} { +append code_edit_insert ", $primary_key\n" +} else { +append code_edit_insert "\n" +} +append code_edit_insert "set user_id \[ad_get_user_id\]\n" + +foreach column $list_of_checks { + append code_edit_insert\ + "\n\n#Now set the checkbutton variable $column to the proper values \n" + append code_edit_insert "set $column \$$list_of($column)\n" + append code_edit_insert \ + "set QQ$column \[DoubleApos \$$list_of($column)\]\n" +} + +#Safeguard against errors caused by unselected radios or selects +if {$list_selectradio != {}} { + append code_edit_insert\ + "\n#Radiobuttons and selects may give us trouble if none are selected" + append code_edit_insert\ + "\n#The columns that might cause trouble are [join $list_selectradio ", "]" +} + +foreach column $list_selectradio { + append code_edit_insert "\nif !\[info exists $column\] \{\n" + append code_edit_insert " set $column \"\"\n" + append code_edit_insert " set QQ$column \"\"\n" + append code_edit_insert "\}" +} + +append code_edit_insert\ + "\n\n#Now check to see if the input is good as directed by the page designer" +append code_edit_insert "\n\n" {set exception_count 0} "\n" +append code_edit_insert "set exception_text \"\"" + +foreach column $list_ord_cols { + set action_var $column + append action_var "_error_action" + + ## Special date processing. This is terribly ugly, but can't be helped + set form_var $column + append form_var "_form_type" + if ![string compare [set $form_var] "date"] { + #we always need to check and complain when getting dates + append code_edit_insert\ + "\n\n# it doesn't matter what instructions we got,\n" + append code_edit_insert\ + "# since $column is of type date and thus must be checked.\n" + append code_edit_insert "if \[catch \{ ns_dbformvalue \[ns_conn form\] $column date $column \} errmsg\] \{ + incr exception_count + append exception_text \"

  • Please enter a valid date for the entry date.\" +\}" + } else { + switch [set $action_var] { + complain { + #put error-checking information in returned code + append code_edit_insert\ + "\n\n# we were directed to return an error for $column\n" + append code_edit_insert {if} " \{" + append code_edit_insert {![info exists } + append code_edit_insert "$column] ||" + append code_edit_insert {[empty_string_p $} + append code_edit_insert \ + "[set column]]\} \{\n incr exception_count\n" + + set error_var $column + append error_var "_exception_text" + if {[info exists $error_var]&&![empty_string_p [set $error_var]]} { + append code_edit_insert " append exception_text" + append code_edit_insert " \"" + append code_edit_insert \ + "
  • [philg_quote_double_quotes [set $error_var]]" + append code_edit_insert "
    \"\n" "\} " + } else { + append code_edit_insert\ + " append exception_text \"
  • You did not enter " + append code_edit_insert \ + "a value for $column.
    \"\n\} " + } + + } + fixit { + set error_var $column + append error_var "_default" + if {[info exists $error_var]&&![empty_string_p [set $error_var]]} { + #put error-checking information in returned code + append code_edit_insert\ + "\n\n# we were directed to set a default for $column\n" + append code_edit_insert {if} " {" + append code_edit_insert {![info exists } + append code_edit_insert "$column] ||" + append code_edit_insert {[empty_string_p $} + append code_edit_insert "[set column]]\} \{\n " + append code_edit_insert " set $column \"[set $error_var]" + append code_edit_insert "\" \n set QQ$column " + append code_edit_insert {[DoubleApos } + append code_edit_insert "\"[set $error_var]\"] \n}" + } else { + } + } + default { + } + } +} +} + +# The code that checks if all the variables are shorter +# than the max length of the column + +foreach element $list_ord_cols { + set max_length [max_col_length $table_name $element] + if {$max_length > 200} { + append code_edit_insert " +if \{\[string length \$$element\] > $max_length\} \{ + incr exception_count + append exception_text \"
  • \\\"$element\\\" is too long\\n\" +\} +" +} +} + + +#Finish the error-checking entry into code_edit_insert variable +append code_edit_insert "\nif" " {" {$exception_count } "> 0} " "{\n" +append code_edit_insert " ad_return_complaint " {$exception_count $exception_text} "\n" +append code_edit_insert " return\n" "}\n" + +append code_edit_insert "\n# So the input is good --" + +append code_edit_insert "\n# Now we'll do the update of the $table_name table.\n" + +append code_edit_insert {set db [ns_db gethandle]} "\n" + +#append code_edit_insert {ns_db dml $db \"begin transaction\"} +#append code_edit_insert {ns_db dml $db} + +#Now build my update statement +set the_sets {} + +if {[string compare $creation_date "none"]} { + lappend the_sets "$creation_date = sysdate" +} + +if {[string compare $creation_user "none"]} { + lappend the_sets "$creation_user = \$user_id" +} + +foreach column $list_ord_cols { + ## Special date processing. This is terribly ugly, but can't be helped + set form_var $column + append form_var "_form_type" + if ![string compare [set $form_var] "date"] { + lappend the_sets "$column = to_date('\$$column','YYYY-MM-DD')" + } else { + #a normal column; should be user submitted info in column var + lappend the_sets "$column = '\$QQ$column'" + } + } + +set set_string [join $the_sets ", "] + +append code_edit_insert {if [catch } "{" +append code_edit_insert {ns_db dml $db} +append code_edit_insert " \"update $table_name + set $set_string + where $primary_key = '\$$primary_key'\"" +append code_edit_insert " } errmsg] {\n" +append code_edit_insert "\n# Oracle choked on the update\n" + +append code_edit_insert " " {ad_return_error "Error in update" +"We were unable to do your update in the database. Here is the error that was returned: +

    +

    +
    +$errmsg
+
    +
    " + return +} } + +append code_edit_insert "\n\n" +#append code_edit_insert {ns_db dml $db \"end transaction\"} + +append code_edit_insert {ns_returnredirect } +append code_edit_insert "${base_file_name}-list.tcl" + + +# End of code generation for insert (add-2) page # +###################################################### + +set mycode_list [philg_quote_double_quotes $code_list] +set mycode_add [philg_quote_double_quotes $code_add] +set mycode_add_insert [philg_quote_double_quotes $code_add_insert] +set mycode_view [philg_quote_double_quotes $code_view] +set mycode_edit [philg_quote_double_quotes $code_edit] +set mycode_edit_insert [philg_quote_double_quotes $code_edit_insert] + +#ns_write " +#

    +#

    +# +#
    +# +# +#

    +#

    +#

    Retrieve code for These Pages

    " + +set dirlen [string length $base_dir_name] +ns_write "Code will be saved under the webroot + (that is, [ns_info pageroot])
    + in the directory and file shown below. +You may edit the directory name if you wish. +
    " +set base_name ${base_file_name}-list.tcl +ns_write "/$base_name:     +   +   + +[export_form_vars base_name] +
    +
    " +set base_name ${base_file_name}-add.tcl +ns_write "/$base_name:     +   +   + +[export_form_vars base_name] +
    +
    " +set base_name ${base_file_name}-add-2.tcl +ns_write "/$base_name: +   +   + +[export_form_vars base_name] +
    +
    " +set base_name ${base_file_name}-view.tcl +ns_write "/$base_name:     +   +   + +[export_form_vars base_name] +
    +
    " +set base_name ${base_file_name}-edit.tcl +ns_write "/$base_name:     +   +   + +[export_form_vars base_name] +
    +
    " +set base_name ${base_file_name}-edit-2.tcl +ns_write "/$base_name: +   +   + +[export_form_vars base_name] +
    +
    " +ns_write "Or save all the code in :   +   + + + + + + +[export_form_vars base_file_name] +
    +After saving, you may go to the front +page of the new module. +

    + + +

    +
    rfrankel@athena.mit.edu
    + + +" + Index: web/openacs/www/admin/prototype/tableinfo-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/prototype/tableinfo-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/prototype/tableinfo-edit.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,374 @@ +# tableinfo-edit.tcl,v 3.0 2000/02/06 03:27:33 ron Exp +#It is slightly complicated which variables we expect from tableinfo +#First, we are getting (for sure) a list_of_cols and table_name +#also, a list_ord_cols, a user_id and a base_file_name +#Second, we are definitely getting list_name_plural and list_name_sing +#page_head back_phrase, back_link and back_text. +#Next, primary_key, creation_date, creation_user and row_name +# whose values are either "none" or one of the columns +# also there may be a sequence name in seq_name +#Next, for each column in the list of columns, we are getting +# ${column}_error_action and ${column}_form_type +# ${column}_prompt_text, ${column}_extra_info +# maybe also ${column}_ei_two and ${column}_ei_three +# which may have values "none" or any of a number of options +set_the_usual_form_variables + +# I want a list of all the variables I got so I can look at them +set list_all_vars {} +set form [ns_getform] +set form_size [ns_set size $form] +set form_counter_i 0 +while {$form_counter_i<$form_size} { + lappend list_all_vars [ns_set key $form $form_counter_i] + incr form_counter_i +} + +ReturnHeaders + +ns_write " +[ad_header "Edit a $list_name_sing"] + +

    Edit a $list_name_sing

    + +
    + +
    " + +set selectlist [join $list_ord_cols ", "] +set db [ns_db gethandle] +set selection [ns_db 1row $db "select $selectlist from $table_name where $primary_key='[DoubleApos $key_for_object]'"] +set_variables_after_query +#now each column is set to its value in the database + +ns_write "\n" +foreach column $list_ord_cols { + set form_var $column + append form_var "_form_type" + set form_type($column) [set $form_var] + set prompt_var $column + append prompt_var "_prompt_text" + set prompt_text($column) [set $prompt_var] + set eione_var $column + append eione_var "_extra_info" + if ![info exists $eione_var] {set $eione_var ""} + set extra_info($column) [set $eione_var] + set eitwo_var $column + append eitwo_var "_ei_two" + if ![info exists $eitwo_var] {set $eitwo_var ""} + set ei_two($column) [set $eitwo_var] + set eithree_var $column + append eithree_var "_ei_three" + if ![info exists $eithree_var] {set $eithree_var ""} + set ei_three($column) [set $eithree_var] + ns_write "[make_edit_form $column $form_type($column) $prompt_text($column) \ + $extra_info($column) $ei_two($column) $ei_three($column) [set $column] \ + $selection]" +} +ns_write "
    \n" + +###################################################### +# Now build the code for the edit page # + +set code_edit "#This file should be called ${base_file_name}-edit.tcl" +append code_edit "\n#Called from ${base_file_name}-list.tcl" +append code_edit "\n#The expected variables are " +append code_edit "key_for_object, the id of the row we wish to edit" "\n" +append code_edit "#Also user_id, the id of the current user.\n" + +append code_edit {set_the_usual_form_variables} + +append code_edit "\n\nReturnHeaders + +ns_write " +[ad_header "Edit a $list_name_sing"] + +

    Edit a $list_name_sing

    + +
    + +"\n\n" + +append code_edit "set db [ns_db gethandle] +set selection [ns_db 1row $db " + select $selectlist + from $table_name + where $primary_key='[DoubleApos $key_for_object]'"] +set_variables_after_query + +#now we have the values from the database. Make the forms: + +ns_write "" +foreach column $list_ord_cols { + append code_edit "[make_form_code $column $form_type($column)\ + $prompt_text($column) $extra_info($column) $ei_two($column)\ + $ei_three($column)]" +} + +#Finish up the page for the mycode_edit to be shown to the user +append code_edit "\n" {[export_form_vars user_id key_for_object]} "\n" + +append code_edit " +

    +

    + +
    +
    +

    \n" +append code_edit {[ad_footer]"} + + + +# End of code generation for edit page # +###################################################### + +###################################################### +# Now build the code for the insert page # + +# Some information I need to know to build code +set list_of_checks {} +set list_selectradio {} +foreach column $list_ord_cols { + switch $form_type($column) { + checkbox { + lappend list_of_checks $column + } + radiobutton { + lappend list_selectradio $column + } + select { + lappend list_selectradio $column + } + boolean { + lappend list_selectradio $column + } + default {} + } +} + +set code_edit_insert {#This is not done yet! Don't expect it to work!} +set code_edit_insert "#This file should be called ${base_file_name}-edit-2.tcl" +append code_edit_insert "\n#Target for ${base_file_name}-edit.tcl" +append code_edit_insert "\n#The expected variables are " +append code_edit_insert "[join $list_ord_cols ", "]\n" +append code_edit_insert "#and user_id, the id of the user found on add page\n" + + +if {[info exists seq_name]&&![empty_string_p $seq_name]} { +append code_edit_insert \ + "#And key_for_object, the key of the object we are editing\n" +} + +if {$list_of_checks != {}} { +append code_edit_insert\ + "\n\n#Special processing for checkbuttons." +} + +foreach column $list_of_checks { + append code_edit_insert\ + "\n#The expected variable here is $column\n" + set list_var "list_of_" + append list_var $column "s" + set list_of($column) $list_var + + append code_edit_insert "if {[ns_conn form ] == " + append code_edit_insert """ } {\n" + append code_edit_insert " set $list_var ""\n" + append code_edit_insert "} else {\n " + append code_edit_insert "set $list_var [" + append code_edit_insert "nmc_GetCheckboxValues [ns_conn form" + append code_edit_insert "] $column]\n" + append code_edit_insert "}\n\n" +} + +#echo for code_edit_insert returned to user +append code_edit_insert {set_the_usual_form_variables} + +foreach column $list_of_checks { + append code_edit_insert\ + "\n\n#Now set the checkbutton variable $column to the proper values \n" + append code_edit_insert "set $column $$list_of($column)\n" + append code_edit_insert \ + "set QQ$column [DoubleApos $$list_of($column)]\n" +} + +#Safeguard against errors caused by unselected radios or selects +if {$list_selectradio != {}} { + append code_edit_insert\ + "\n\n#Radiobuttons and selects may give us trouble if none are selected" + append code_edit_insert\ + "\n#The columns that might cause trouble are [join $list_selectradio ", "]" +} + +foreach column $list_selectradio { + append code_edit_insert "\nif ![info exists $column] {\n" + append code_edit_insert " set $column ""\n" + append code_edit_insert " set QQ$column ""\n" + append code_edit_insert "}" +} + +append code_edit_insert\ + "\n\n#Now check to see if the input is good as directed by the page designer" +append code_edit_insert "\n\n" {set error_flag 0} "\n" +append code_edit_insert {set error_message ""} + +foreach column $list_ord_cols { + set action_var $column + append action_var "_error_action" + + ## Special date processing. This is terribly ugly, but can't be helped + set form_var $column + append form_var "_form_type" + if ![string compare [set $form_var] "date"] { + #we always need to check and complain when getting dates + append code_edit_insert\ + "\n\n# it doesn't matter what instructions we got,\n" + append code_edit_insert\ + "# since $column is of type date and thus must be checked.\n" + append code_edit_insert "if [catch { ns_dbformvalue [ns_conn form] $column date $column } errmsg] { + incr error_flag + append error_message "

  • Please enter a valid date for the entry date" +}" + } else { + switch [set $action_var] { + complain { + #put error-checking information in returned code + append code_edit_insert\ + "\n\n# we were directed to return an error for $column\n" + append code_edit_insert {if} " {" + append code_edit_insert {![info exists } + append code_edit_insert "$column] ||" + append code_edit_insert {[empty_string_p $} + append code_edit_insert \ + "[set column]]} {\n incr error_flag\n" + + set error_var $column + append error_var "_error_message" + if {[info exists $error_var]&&![empty_string_p [set $error_var]]} { + append code_edit_insert " append error_message" + append code_edit_insert " "" + append code_edit_insert \ + "[philg_quote_double_quotes [set $error_var]]" + append code_edit_insert "!
    "\n" "} " + } else { + append code_edit_insert\ + " append error_message "You did not enter " + append code_edit_insert \ + "a value for $column!
    "\n} " + } + + } + fixit { + set error_var $column + append error_var "_default" + if {[info exists $error_var]&&![empty_string_p [set $error_var]]} { + #put error-checking information in returned code + append code_edit_insert\ + "\n\n# we were directed to set a default for $column\n" + append code_edit_insert {if} " {" + append code_edit_insert {![info exists } + append code_edit_insert "$column] ||" + append code_edit_insert {[empty_string_p $} + append code_edit_insert "[set column]]} {\n " + append code_edit_insert " set $column "[set $error_var]" + append code_edit_insert "" \n set QQ$column " + append code_edit_insert {[DoubleApos } + append code_edit_insert ""[set $error_var]"] \n}" + } else { + } + } + default { + } + } +} +} + + +#Finish the error-checking entry into code_edit_insert variable +append code_edit_insert "\n\nif" " {" {$error_flag } "> 0} " "{\n" +append code_edit_insert " ad_return_complaint " {$error_flag $error_message} "\n" +append code_edit_insert " return\n" "}\n" + +append code_edit_insert "\n# So the input is good --" + +append code_edit_insert "\n# Now we'll do the update of the $table_name table.\n" + +append code_edit_insert {set db [ns_db gethandle]} "\n" + +#append code_edit_insert {ns_db dml $db "begin transaction"} +#append code_edit_insert {ns_db dml $db} + +#Now build my update statement +set the_sets {} + +if {[string compare $creation_date "none"]} { + lappend the_sets "$creation_date = sysdate" +} + +if {[string compare $creation_user "none"]} { + lappend the_sets "$creation_user = $user_id" +} + +foreach column $list_ord_cols { + ## Special date processing. This is terribly ugly, but can't be helped + set form_var $column + append form_var "_form_type" + if ![string compare [set $form_var] "date"] { + lappend the_sets "$column = to_date('$$column','YYYY-MM-DD')" + } else { + #a normal column; should be user submitted info in column var + lappend the_sets "$column = '$QQ$column'" + } + } + +set set_string [join $the_sets ", \n "] + +append code_edit_insert {if [catch } "{" +append code_edit_insert {ns_db dml $db} +append code_edit_insert " "update $table_name + set $set_string + where $primary_key = '$key_for_object'"" +append code_edit_insert " } errmsg] {\n" +append code_edit_insert "\n# Oracle choked on the update\n" + +append code_edit_insert " " {ad_return_error "Error in update +" "We were unable to do your update in the database. +Here is the error that was returned: +

    +

    +
    +$errmsg
+
    +
    " + return +} } + +append code_edit_insert "\n\n" +#append code_edit_insert {ns_db dml $db "end transaction"} + +append code_edit_insert {ns_returnredirect } +append code_edit_insert "${base_file_name}-edit.tcl?[export_url_vars " +append code_edit_insert "key_for_object user_id]" + + +# End of code generation for insert (add-2) page # +###################################################### + +set mycode_edit [ns_quotehtml $code_edit] +set mycode_edit_insert [ns_quotehtml $code_edit_insert] + +ns_write " +

    +

    + +
    + + +

    + +

    +
    rfrankel@athena.mit.edu
    + + +" + Index: web/openacs/www/admin/prototype/tableinfo.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/prototype/tableinfo.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/prototype/tableinfo.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,164 @@ +# tableinfo.tcl,v 3.0 2000/02/06 03:27:34 ron Exp +# comes from index.tcl +set_the_usual_form_variables + +#table_name, Table, base_file_name, base_dir_name + +set db [ns_db gethandle] +# verify entry (is this bad? AOL server docs warn against "table exists" +# in any case, check first that any input at all has been given. +# also, if no input in the text entry, look for entry in the select box +set error_flag 0 +set error_message "" + +if [empty_string_p $table_name] { + if ![info exists Table] { + incr error_flag + set error_message "You did not enter a table name" + } else { + set table_name $Table + } +} + +if {![info exists base_file_name]||[empty_string_p $base_file_name]} { + incr error_flag + set error_message "You did not enter a filename" +} + +if {$error_flag>0} { + ad_return_complaint $error_flag $error_message + return +} + +if ![ns_table exists $db $table_name] { + incr error_flag + set error_message "The table named $table_name does not exist in the database" +} + +if {$error_flag>0} { + ad_return_complaint $error_flag $error_message + return +} + +# Find a list of the names of the columns +set num_cols [ns_column count $db $table_name] +set counter 0 +set list_of_cols {} +set list_of_types {} +while {$counter < $num_cols} { + set col_name [ns_column name $db $table_name $counter ] + set col_type [ns_column typebyindex $db $table_name $counter] + lappend list_of_cols $col_name + lappend list_of_types $col_type + incr counter +} + +set var_list [join $list_of_cols] +set html_pk [column_select $list_of_cols \"primary_key\"] +set html_na [column_select $list_of_cols \"row_name\"] +set html_cu [column_select $list_of_cols \"creation_user\"] +set html_cd [column_select $list_of_cols \"creation_date\"] + +ReturnHeaders + +ns_write " +[ad_header "Specify Information About the Desired Pages"] + +

    Build A Page (first of two pages)

    + +
    +
    +

    Specify Information About the Desired Page:

    +

    General Information:

    + +Do you want to specify a title for your main page?
    +

    + +Please fill in these phrases for the list page:
    +All the : +

    • Add a .
    + +Please fill in element for the Yahoo-style navbar: + +

    Your workspace: +<a href=""></a> + +

    Pick Special Columns:

    + +Is one of your columns a integer primary key? $html_pk +
    • If so, is there an associated sequence name? +
    +

    + +Does one of your columns specify a pretty name for this row? $html_na +

    + +Does one of your columns specify a creation date of this row? $html_cd +

    + +Does one of your columns specify the user who created this row? $html_cu +

    + +

    Specify Data About Column Entry Forms:

    +What kind of form do you want to use to input into each column? +

    + +" + +foreach column $list_of_cols { + set column_html [column_form $column] + ns_write "$column_html" + } + +ns_write " +
    ColumnType of Form
    + +

    Specify Data about Error Messages

    +What should be done if the user fails to input any data? + +

    + +" + +foreach column $list_of_cols { + set column_html [column_form_error $column] + ns_write "$column_html" + } + +ns_write " +
    ColumnAction to take upon failing to recieve form data.
    + +[export_form_vars list_of_cols table_name base_dir_name base_file_name] + +

    +

    + +
    +
    + +

    + + +

    +
    rfrankel@athena.mit.edu
    + + + + +" + + +# set prompt_var $column +# append prompt_var "_prompt_text" +# append select_html "" +# append select_html "" +# append select_html "" + +#Do you want to specify a title for your list page?
    +#

    + +#Do you want to specify a title for your add page?
    +#

    + +#Do you want to specify a title for your edit page?
    +#

    Index: web/openacs/www/admin/pull-down-menus/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/pull-down-menus/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/pull-down-menus/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,73 @@ +# /admin/pull-down-menus/index.tcl +# +# Author: aure@arsdigita.com, February 2000 +# +# Presents a list of all the pdm_menus and gives the option to add a new menu. +# +# index.tcl,v 1.1.2.1 2000/03/16 05:33:06 aure Exp +# ----------------------------------------------------------------------------- + +set page_title "Pull-Down Menu Administration" + +set html " +[ad_admin_header $page_title] + +

    $page_title

    + +[ad_admin_context_bar "Pull-Down Menus"] + +
    + +Documentation: /doc/pull-down-menus.html + +

    Available menus: + +

      " + +set db [ns_db gethandle] + +# select information about all of the menus in the system +set selection [ns_db select $db " +select p.menu_id, + menu_key, + default_p, + pdm_count_n_items(menu_id) as number_of_items +from pdm_menus p +order by p.menu_key"] + +set count 0 + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + + if {$default_p == "t"} { + set default_text "(default)" + } else { + set default_text "" + } + + append html " +
    • $menu_key + ($number_of_items items) $default_text" + incr count +} + +ns_db releasehandle $db + +if {$count == 0} { + append html "There are no pull-down menus in the database." +} + +append html " +

      +

    • Add a new pull-down menu +
    +[ad_admin_footer]" + +ns_return 200 text/html $html + + + + + + Index: web/openacs/www/admin/pull-down-menus/item-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/pull-down-menus/item-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/pull-down-menus/item-add-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,109 @@ +# /admin/pull-down-menus/item-add-2.tcl +# +# by aure@caltech.edu +# +# 2000-02-18 +# +# item-add-2.tcl,v 1.1.2.1 2000/03/16 05:33:07 aure Exp + + +ad_page_variables { + {menu_id} + {parent_key ""} + {label "" qq} + {url "" qq} +} + +# ----------------------------------------------------------------------------- +# Error Checking + +set exception_text "" +set exception_count 0 + +if [empty_string_p $label] { + incr exception_count + append exception_text "
  • You must provide an item label" +} + +if {$exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +# ----------------------------------------------------------------------------- + +set db [ns_db gethandle] + +# Get the sort_key for the parent of this page + +if [empty_string_p $parent_key] { + # we're adding a top-level item for the menu, so get the + # current maximum sort key + + set max_sort_key [database_to_tcl_string $db " + select max(sort_key) + from pdm_menu_items + where length(sort_key) = 2"] + + if [empty_string_p $max_sort_key] { + set next_sort_key "00" + } else { + set key_length [string length $max_sort_key] + set next_sort_key [format "%0${key_length}d" \ + [expr [string trimleft $max_sort_key 0]+1]] + } +} else { + # we're adding a subitem, so grab the maximum sort key among + # all the children for this parent + + set max_sort_key [database_to_tcl_string $db " + select max(sort_key) + from pdm_menu_items + where sort_key like '${parent_key}__'"] + + if [empty_string_p $max_sort_key] { + # parent has no children - this is the first one + set next_sort_key "${parent_key}00" + } else { + # new key will be the same length + set key_length [string length $max_sort_key] + + # make sure adding a new child won't overflow the keys + set max_sort_key [string trimleft $max_sort_key 0] + if {[expr $max_sort_key % 100]==99} { + ad_return_complaint 1 " +
  • You cannot have more than 100 subitems in any item." + return + } else { + set next_sort_key [format "%0${key_length}d" [expr $max_sort_key+1]] + } + } +} + +# Insert this item into the database + +#set item_id [database_to_tcl_string $db \ +# "select pdm_item_id_sequence.nextval from dual"] + +set item_id [db_sequence_nextval $db pdm_item_id_sequence] + +ns_db dml $db " +insert into pdm_menu_items + ( item_id, + menu_id, + label, + sort_key, + url) +values + ( $item_id, + $menu_id, + '$QQlabel', + '$next_sort_key', + '$QQurl' +)" + + +ns_returnredirect "items?menu_id=$menu_id" + + + Index: web/openacs/www/admin/pull-down-menus/item-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/pull-down-menus/item-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/pull-down-menus/item-add.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,63 @@ +# /admin/pull-down-menus/item-add.tcl +# +# Author: aure@caltech.edu +# +# Add an item to the menu +# +# item-add.tcl,v 1.1.2.1 2000/03/16 05:33:07 aure Exp +# ----------------------------------------------------------------------------- + +ad_page_variables { + {menu_id} + {parent_key ""} +} + +set db [ns_db gethandle] + +if [empty_string_p $parent_key] { + set parent_label "Top" +} else { + set parent_label [database_to_tcl_string $db " + select label as parent_label + from pdm_menu_items + where menu_id = $menu_id + and sort_key = '$parent_key'"] +} + +set title "Add Item" + +ns_db releasehandle $db + +# ----------------------------------------------------------------------------- + +ns_return 200 text/html "[ad_header_with_extra_stuff $title] + +

    Add Item Under $parent_label

    + +[ad_context_bar_ws [list "" "Pull-Down Menu"] $title] + +
    + +
    + +[export_form_vars menu_id parent_key] + + + + + + + + + + + + + + +
    Label:
    URL (optional):
    +
    + +

    If the URL is left blank, the menu item will only be used as a place holder for other items. + +[ad_admin_footer]" Index: web/openacs/www/admin/pull-down-menus/item-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/pull-down-menus/item-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/pull-down-menus/item-delete-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,16 @@ +# admin/pull-down-menus/item-delete-2.tcl +# +# Author: aure@arsdigita.com, Feb 2000 +# +# item-delete-2.tcl,v 1.1.2.1 2000/03/16 05:33:07 aure Exp + +ad_page_variables { + {item_id} + {menu_id} +} + +set db [ns_db gethandle] + +ns_db dml $db "delete from pdm_menu_items where item_id = $item_id" + +ns_returnredirect "items?menu_id=$menu_id" \ No newline at end of file Index: web/openacs/www/admin/pull-down-menus/item-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/pull-down-menus/item-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/pull-down-menus/item-delete.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,39 @@ +# admin/pdm/item-delete.tcl +# +# Author: aure@arsdigita.com, Feb 2000 +# +# item-delete.tcl,v 1.1.2.1 2000/03/16 05:33:08 aure Exp + +ad_page_variables { + {item_id} +} + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db " + select label, i.menu_id, menu_key + from pdm_menu_items i, pdm_menus p + where i.item_id = $item_id + and p.menu_id = i.menu_id"] + +set_variables_after_query + +ns_db releasehandle $db + +ns_return 200 text/html " +[ad_header_with_extra_stuff "Delete Menu Item: $menu_key"] +[ad_pdm $menu_key 5 5] +

    Delete Menu Item: $label

    +[ad_admin_context_bar [list "" "Pull-Down Menus"] [list "pdm-edit?menu_id=$menu_id" $menu_key] [list "item-edit?item_id=$item_id" $label] "Delete"] +
    + +Do you really want to delete \"$label\" from menu: \"$menu_key\"? + +
    +[export_form_vars menu_id item_id] +
    + +
    +
    +[ad_admin_footer]" + Index: web/openacs/www/admin/pull-down-menus/item-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/pull-down-menus/item-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/pull-down-menus/item-edit-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,26 @@ +# /admin/pull-down-menus/item-edit-2.tcl +# +# by aure@caltech.edu +# +# 2000-02-18 +# +# item-edit-2.tcl,v 1.1.2.1 2000/03/16 05:33:08 aure Exp + +ad_page_variables { + {item_id} + {menu_id} + {label} + {url ""} +} + +set db [ns_db gethandle] + +ns_db dml $db " +update pdm_menu_items +set label = '[DoubleApos $label]', + url = '[DoubleApos $url]' +where item_id = $item_id" + +ns_returnredirect "items?menu_id=$menu_id" + + Index: web/openacs/www/admin/pull-down-menus/item-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/pull-down-menus/item-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/pull-down-menus/item-edit.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,130 @@ +# /admin/pull-down-menus/item-edit.tcl +# +# by aure@arsdigita.com +# +# 2000-02-18 +# +# Allows the user the edit the parameters for a item +# +# item-edit.tcl,v 1.1.2.2 2000/03/25 21:44:43 aure Exp +# ----------------------------------------------------------------------------- + +ad_page_variables {item_id menu_id} + +set page_title "Edit Item" + +# ----------------------------------------------------------------------------- + +set db [ns_db gethandle] + +# Get the data for this item + +set selection [ns_db 1row $db " +select label, + url, + menu_id, + sort_key as root_key +from pdm_menu_items +where item_id = $item_id"] +set_variables_after_query + +# Get this item's parent + +set parent_key [string range $root_key 0 [expr [string length $root_key]-3]] + +set selection [ns_db 0or1row $db " +select label as parent_title, + item_id as parent_id +from pdm_menu_items +where sort_key = '$parent_key' +and menu_id = $menu_id"] + +if [empty_string_p $selection] { + set item_parent "Top Level" +} else { + set_variables_after_query + set item_parent " + $parent_title" +} + +# Get the list of children + +set selection [ns_db select $db " +select item_id as child_id, + label as child_title, + sort_key as child_key, + length(sort_key)-[string length $root_key]-2 as depth +from pdm_menu_items +where item_id <> $item_id +and menu_id = $menu_id +and sort_key like '${root_key}%' +order by child_key"] + +set count 0 +set item_children "" +while {[ns_db getrow $db $selection]} { + incr count + set_variables_after_query + append item_children "[pdm_indentation $depth] + $child_title
    " +} + +if {$count == 0} { + set item_children "None" +} + +# ----------------------------------------------------------------------------- + +ns_return 200 text/html " +[ad_header_with_extra_stuff $page_title] + +

    $page_title

    + + +[ad_context_bar_ws [list "" "Pull-Down Menu"] $page_title] +
    + +
    + +[export_form_vars item_id menu_id] + + + + + + + + + + + + + + + + + + +
    Label:
    URL:
    + +
    + +

    Parent

    +
      +$item_parent +
    +

    Subitems

    +
      +$item_children +
    +

    Extreme Actions

    + +[ad_admin_footer]" + + + + + + Index: web/openacs/www/admin/pull-down-menus/item-move-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/pull-down-menus/item-move-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/pull-down-menus/item-move-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,168 @@ +# /admin/pull-down-menus/item-move-2.tcl +# +# by aure@caltech.edu +# +# 2000-02-18 +# +# item-move-2.tcl,v 1.1.2.1 2000/03/16 05:33:08 aure Exp + +ad_page_variables { + {item_id} + {menu_id} + {parent_id ""} + {move ""} +} + + +# --------------------------------------------------------------- + +# There are two things we could be doing on this page. We might be moving +# a item to a new parent or we might be moving it up or down. We split +# these into two procs. + +proc new_parent {item_id menu_id parent_id} { + + set db [ns_db gethandle] + + if { [empty_string_p $parent_id] } { + set parent_key "" + } else { + set parent_key [database_to_tcl_string $db " + select sort_key from pdm_menu_items where item_id = $parent_id"] + } + + set num [database_to_tcl_string_or_null $db " + select max(sort_key) from pdm_menu_items + where sort_key like '${parent_key}__'"] + + # find the proper sort_key for the next subitem to this parent + + set len [string length $num] + + # avoid TCL's octal predilections + set temp [string trimleft $num 0] + if {[empty_string_p $temp]} { + set temp 0 + } + + if { [empty_string_p $num] } { + # first subitem + set num "${parent_key}00" + } elseif { [expr ${temp}%100] == 99 } { + ad_return_complaint 1 "
  • You cannot have more than 100 subitems in any item.\n" + return + } else { + incr temp + # don't forget to pad with any zeros we chopped off + set num [format "%0${len}d" $temp] + } + + # now move the item and all its children + + set sort_key [database_to_tcl_string $db " + select sort_key + from pdm_menu_items + where item_id = $item_id"] + set len [string length $sort_key] + if { [catch { + ns_db dml $db " + update pdm_menu_items + set sort_key = '$num' || substr(sort_key, $len + 1) + where sort_key like '$sort_key%'" + } error_msg] } { + + ns_db releasehandle $db + ad_return_complaint 1 "
  • A database error occurred. Make sure you + start from the main administation page.\n$error_msg\n" + + return + + } else { + + ns_db releasehandle $db + ns_returnredirect "items?menu_id=$menu_id" + return + + } +} + + + +proc move_item {item_id menu_id move} { + + set db [ns_db gethandle] + ns_db dml $db "begin transaction" + + set sort_key [database_to_tcl_string $db " + select sort_key + from pdm_menu_items + where item_id = $item_id"] + + regexp {(.*)[0-9][0-9]} $sort_key match prefix + + # find the right item to swap with + + if { $move == "up" } { + set temp [database_to_tcl_string_or_null $db " + select max(sort_key) + from pdm_menu_items + where sort_key like '${prefix}__' + and sort_key < '$sort_key'"] + } elseif { $move == "down" } { + set temp [database_to_tcl_string_or_null $db " + select min(sort_key) + from pdm_menu_items + where sort_key like '${prefix}__' + and sort_key > '$sort_key'"] + } else { + ad_returncomplaint 1 "
  • This page was not called with the correct + form variables.\n" + ns_db dml $db "end transaction" + ns_db releasehandle $db + return + } + + # juggle the sort_keys to achieve the swap + + if { ![empty_string_p $temp] } { + set len [string length $sort_key] + # length(sort_key) = length(temp) + + ns_db dml $db "update pdm_menu_items + set sort_key = '-1' || substr(sort_key, $len + 1) + where sort_key like '$sort_key%'" + + ns_db dml $db "update pdm_menu_items + set sort_key = '$sort_key' || substr(sort_key, $len + 1) + where sort_key like '$temp%'" + + ns_db dml $db "update pdm_menu_items + set sort_key = '$temp' || substr(sort_key, 3) + where sort_key like '-1%'" + + set new_id [database_to_tcl_string $db " + select item_id + from pdm_menu_items + where sort_key = '$temp'"] + } else { + set new_id $item_id + } + + ns_db dml $db "end transaction" + ns_db releasehandle $db + ns_returnredirect "items?menu_id=$menu_id" + return + +} + + +# ------------------------------------------------------------------- + +# main body + +if ![empty_string_p $move ] { + move_item $item_id $menu_id $move +} else { + new_parent $item_id $menu_id $parent_id +} + Index: web/openacs/www/admin/pull-down-menus/item-move.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/pull-down-menus/item-move.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/pull-down-menus/item-move.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,102 @@ +# /admin/pull-down-menus/item-move.tcl +# +# by aure@caltech.edu +# +# 2000-02-18 +# +# item-move.tcl,v 1.1.2.1 2000/03/16 05:33:08 aure Exp + +ad_page_variables {item_id} + +set page_title "Move Item" + +set db [ns_db gethandle] + +# get the current item and pdm information +set selection [ns_db 1row $db " + select item_id as root_id, + sort_key as root_key, + pdm_menus.menu_id, + pdm_menus.menu_key + from pdm_menu_items, pdm_menus + where item_id = $item_id + and pdm_menu_items.menu_id=pdm_menus.menu_id"] +set_variables_after_query + +set selection [ns_db select $db " +select item_id, + label, + sort_key +from pdm_menu_items +where menu_id = $menu_id +order by sort_key"] + +set item_depth 0 +set item_list "" + +while {[ns_db getrow $db $selection]} { + + set_variables_after_query + + # Note that we can only descend by a unit amount, but we can + # acscend by an arbitrary amount. + + if { [string length $sort_key] > $item_depth } { + append item_list "
      \n" + incr item_depth 2 + } elseif {[string length $sort_key] < $item_depth} { + while { [string length $sort_key] < $item_depth } { + append item_list "
    \n" + incr item_depth -2 + } + } + + # A item can only be moved to higher parts of the tree, so + # check so see if the current item is a child of the one we're + # moving + + if {[regexp "^$root_key" $sort_key match] } { + append item_list "
  • $label\n" + } else { + append item_list " +
  • + $label\n" + } +} + +# Make sure we get back to zero depth + +while {$item_depth > 0} { + append item_list "\n" + incr item_depth -2 +} + +ns_db releasehandle $db + +# ----------------------------------------------------------------------------- + +ns_return 200 text/html " +[ad_header_with_extra_stuff "$page_title" [ad_pdm $menu_key 5 5] [ad_pdm_spacer $menu_key]] + +

    $page_title

    + +[ad_admin_context_bar [list "" "Pull-Down Menus"] [list "pdm-edit?menu_id=$menu_id" $menu_key] $page_title] + +
    + +

    Click on the item that you would like to move \"$label\" +under, or on \"Top\" to make it a top level item. + +

    +Top +

    +$item_list +

    +

    +

    + +[ad_admin_footer]" + + + + Index: web/openacs/www/admin/pull-down-menus/items.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/pull-down-menus/items.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/pull-down-menus/items.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,123 @@ +# /admin/pull-down-menus/items.tcl +# +# Author: aure@arsdigita.com, February 2000 +# +# Shows the menu items and allows the administrator +# to add, edit, delete, or arrange items +# +# items.tcl,v 1.1.2.1 2000/03/16 05:33:09 aure Exp +# ----------------------------------------------------------------------------- + +ad_page_variables {menu_id} + +set title "Edit Items" + +set db [ns_db gethandle] + +# Get ALL of the items from the pdm_menus table. Generally select * is a +# no-no, but in this case we really need everything and the list would +# be huge if we typed it all out. + +set selection [ns_db 0or1row $db " + select * + from pdm_menus + where menu_id = $menu_id"] +set_variables_after_query + +# If there aren't any items just redirect back to the index page + +if [empty_string_p $selection] { + ns_returnredirect "" + return +} + +set page_content " + +[ad_header_with_extra_stuff "Pull-Down Menus: $title" [ad_pdm $menu_key 5 5] [ad_pdm_spacer $menu_key]] + +

    $title

    + +[ad_admin_context_bar [list "" "Pull-Down Menu"] $menu_key] + +
    + +Pull-Down Menu outline:

    + + + + + +" + +set selection [ns_db select $db " +select n1.item_id, n1.label, n1.sort_key, n1.url, + (select count(*) + from pdm_menu_items n2 + where menu_id = $menu_id + and n2.sort_key like substr(n1.sort_key,0,length(n1.sort_key)-2)||'__' + and n2.sort_key > n1.sort_key) as more_children_p +from pdm_menu_items n1 +where menu_id = $menu_id +order by n1.sort_key"] + +set count 0 + +while {[ns_db getrow $db $selection]} { + incr count + + set_variables_after_query + + if {[expr $count % 2]==0} { + set color "#eeeeee" + } else { + set color "white" + } + + set depth [expr [string length $sort_key]-2] + append page_content " + + " + + if {$more_children_p != 0} { + append page_content " + " + } else { + append page_content "" + } + + append page_content " + " + + if {$depth < 3} { + append page_content " + " + } else { + append page_content "" + } + append page_content "" +} + +append page_content " +
    Top         Add a top-level item
    [pdm_indentation $depth]$label      + swap with next  move  + add subitem 
    + +

    Extreme Actions

    + + +[ad_admin_footer]" + +# release the database handle + +ns_db releasehandle $db + +# serve the page + +ns_return 200 text/html $page_content + + Index: web/openacs/www/admin/pull-down-menus/one.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/pull-down-menus/one.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/pull-down-menus/one.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,119 @@ +# one.tcl +# +# Shows the pdm items and allows the administrator +# to add, edit, delete, or arrange items +# +# by aure@arsdigita.com +# +# one.tcl,v 1.1.2.1 2000/03/16 05:33:09 aure Exp + +set user_id [ad_verify_and_get_user_id] +ad_maybe_redirect_for_registration + +set title "Pull-Down Menu System Administration" + +proc pdm_spacer {depth} { + set spacer "" + for {set i 0} {$i < $depth} {incr i} { + append spacer "  " + } + return $spacer +} + +# returns 1 if the given sort_key is the highest leaf node, i.e. the +# given not has no siblings with higher sort_keys; returns 0 +# otherwise. + +proc pdm_last_child_p {sort_key_list sort_key} { + set key_length [string length $sort_key] + set key_next [format "%0${key_length}d" [expr [string trimleft $sort_key 0]+1]] + + # the given sort_key is the last child if the search comes back + # with -1 (no such key in the list) + + return [expr [lsearch $sort_key_list $key_next] == -1] +} + +proc pdm_toc_local {db} { + + # get all of the items + + set selection [ns_db select $db " + select n1.item_id, n1.label, n1.sort_key, n1.url, + (select count(*) + from pdm_menu_items n2 + where n2.sort_key like substr(n1.sort_key,0,length(n1.sort_key)-2)||'__' + and n2.sort_key > n1.sort_key) as more_children_p + from pdm_menu_items n1 + order by n1.sort_key"] + + set count 0 + set toc "" + while {[ns_db getrow $db $selection]} { + incr count + + set_variables_after_query + + if {[expr $count % 2]==0} { + set color "#eeeeee" + } else { + set color "white" + } + + append toc " + + + + " + } + + append toc " + + + + + + +
    [pdm_spacer [expr [string length $sort_key]-2]]$label" + + if {$more_children_p != 0} { + append toc " + + swap with next |" + } + + append toc " + + move | + + + add subitem +
     
    Add a top-level item +
    " + + return $toc +} + +# ----------------------------------------------------------------------------- + +set db [ns_db gethandle] + +ns_return 200 text/html " + +[ad_header_with_extra_stuff "Pull-Down Menus: $title"] + +[ad_pdm "default" 10 5] +  +

    $title

    + +[ad_admin_context_bar $title] + +
    + +

    Contents

    + +[pdm_toc_local $db] + +[ad_admin_footer]" + Index: web/openacs/www/admin/pull-down-menus/pdm-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/pull-down-menus/pdm-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/pull-down-menus/pdm-add-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,173 @@ +# /admin/pull-down-menus/pdm-add-2.tcl +# +# Author: aure@caltech.edu, Feb 2000 +# +# pdm-add-2.tcl,v 1.1.2.1 2000/03/16 05:33:09 aure Exp +# ----------------------------------------------------------------------------- + +ad_page_variables { + {menu_id} + {menu_key} + {default_p} + {orientation} + {x_offset} + {y_offset} + {element_height} + {element_width} + {main_menu_font_style ""} + {sub_menu_font_style ""} + {sub_sub_menu_font_style ""} + {main_menu_bg_img_url ""} + {main_menu_bg_color ""} + {main_menu_hl_img_url ""} + {main_menu_hl_color ""} + {sub_menu_bg_img_url ""} + {sub_menu_bg_color ""} + {sub_menu_hl_img_url ""} + {sub_menu_hl_color ""} + {sub_sub_menu_bg_img_url ""} + {sub_sub_menu_bg_color ""} + {sub_sub_menu_hl_img_url ""} + {sub_sub_menu_hl_color ""} +} + +# ----------------------------------------------------------------------------- +# Error checking + +set exception_text "" +set exception_count 0 + +if [empty_string_p $menu_key] { + incr exception_count + append exception_text "
  • You must provide a name for the menu.\n" +} + +# A help proc to check for valid integers + +proc valid_integer_p {n} { + if {[empty_string_p $n] || [regexp {[^0-9]+} $n match]} { + return 0 + } else { + return 1 + } +} + +if ![valid_integer_p $x_offset] { + incr exception_count + append exception_text " +
  • Distance from the left of the display area is not a valid integer" +} + +if ![valid_integer_p $y_offset] { + incr exception_count + append exception_text " +
  • Distance from the top of the display area is not a valid integer" +} + +if ![valid_integer_p $element_height] { + incr exception_count + append exception_text " +
  • Element height is not a valid integer" +} + +if ![valid_integer_p $element_width] { + incr exception_count + append exception_text " +
  • Element width is not a valid integer" +} + +# use the database to check for uniqueness conflicts with menu_key + +set db [ns_db gethandle] +set menu_key_conflict_menu_id [database_to_tcl_string_or_null $db " + select menu_id + from pdm_menus + where menu_key = '[DoubleApos $menu_key]'"] + +if {![empty_string_p $menu_key_conflict_menu_id]} { + incr exception_count + append exception_text "
  • Your name conflicts with the existing menu + \"$menu_key\"\n" +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return 0 +} + +# ----------------------------------------------------------------------------- +# Done error checking. Insert the new menu into the database and +# redirect to the admin page. + +set double_click_p [database_to_tcl_string $db " +select count(*) +from pdm_menus +where menu_id = $menu_id"] + +if {!$double_click_p} { + + ns_db dml $db "begin transaction" + + # reset all other menus to false if this one will be set true + if {$default_p == "t"} { + ns_db dml $db "update pdm_menus set default_p = 'f'" + } + + ns_db dml $db " + insert into pdm_menus ( + menu_id, + menu_key, + default_p, + orientation, + x_offset, y_offset, + element_height, + element_width, + main_menu_font_style, + sub_menu_font_style, + sub_sub_menu_font_style, + main_menu_bg_img_url, + main_menu_bg_color, + main_menu_hl_img_url, + main_menu_hl_color, + sub_menu_bg_img_url, + sub_menu_bg_color, + sub_menu_hl_img_url, + sub_menu_hl_color, + sub_sub_menu_bg_img_url, + sub_sub_menu_bg_color, + sub_sub_menu_hl_img_url, + sub_sub_menu_hl_color + ) values ( + $menu_id, + '$QQmenu_key', + '$default_p', + '$orientation', + $x_offset, + $y_offset, + $element_height, + $element_width, + [ns_dbquotevalue $main_menu_font_style string], + [ns_dbquotevalue $sub_menu_font_style string], + [ns_dbquotevalue $sub_sub_menu_font_style string], + [ns_dbquotevalue $main_menu_bg_img_url string], + [ns_dbquotevalue $main_menu_bg_color string], + [ns_dbquotevalue $main_menu_hl_img_url string], + [ns_dbquotevalue $main_menu_hl_color string], + [ns_dbquotevalue $sub_menu_bg_img_url string], + [ns_dbquotevalue $sub_menu_bg_color string], + [ns_dbquotevalue $sub_menu_hl_img_url string], + [ns_dbquotevalue $sub_menu_hl_color string], + [ns_dbquotevalue $sub_sub_menu_bg_img_url string], + [ns_dbquotevalue $sub_sub_menu_bg_color string], + [ns_dbquotevalue $sub_sub_menu_hl_img_url string], + [ns_dbquotevalue $sub_sub_menu_hl_color string] + )" + + ns_db dml $db "end transaction" +} + +ns_returnredirect "" + + + + Index: web/openacs/www/admin/pull-down-menus/pdm-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/pull-down-menus/pdm-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/pull-down-menus/pdm-add.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,124 @@ +# /admin/pull-down-menus/pdm-add.tcl +# +# Author: aure@caltech.edu, Feb 2000 +# +# Page to add a new pdm to the system +# +# pdm-add.tcl,v 1.1.2.2 2000/03/18 00:12:29 michael Exp +# ----------------------------------------------------------------------------- + +set db [ns_db gethandle] + +# get the next available menu_id to pass to the processing form +# for double click protection + +set menu_id [database_to_tcl_string $db "select pdm_menu_id_sequence.nextval from dual"] + +ns_db releasehandle $db + +set title "Create New Pull-Down Menu" + +ns_return 200 text/html " +[ad_admin_header $title] + +

    $title

    + +[ad_admin_context_bar [list "" "Pull-Down Menu"] "Create New"] + +
    + +
    +[export_form_vars menu_id] + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    Name:
    Make this the default menu:No     + Yes
    Orientation:Horizonal     + Vertical (a bit crude currently)
    Distance from top of display area: pixels
    Distance from left of display area: pixels
    Element Height: pixels
    Element Width: pixels
    All of the following are optional:
     
    Main Menu Font Style:
     
    Sub Menu Font Style:
     
    Second Level Font Style:
    Background Image URLBackground Color
    Main Menu Default:e.g. #ffffff
    Main Menu Highlight:
    Sub Menu Default:
    Sub Menu Highlight:
    Second Level Menu Default:
    Second Level Menu Highlight:
    + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/pull-down-menus/pdm-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/pull-down-menus/pdm-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/pull-down-menus/pdm-delete-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,18 @@ +# /admin/pull-down-menus/pdm-delete-2.tcl +# +# Author: aure@arsdigita.com, Feb 2000 +# +# pdm-delete-2.tcl,v 1.1.2.1 2000/03/16 05:33:09 aure Exp +# ----------------------------------------------------------------------------- + +ad_page_variables {menu_id} + +set db [ns_db gethandle] + +ns_db dml $db "begin transaction" +ns_db dml $db "delete from pdm_menu_items where menu_id = $menu_id" +ns_db dml $db "delete from pdm_menus where menu_id = $menu_id" +ns_db dml $db "end transaction" + +ns_returnredirect "" + Index: web/openacs/www/admin/pull-down-menus/pdm-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/pull-down-menus/pdm-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/pull-down-menus/pdm-delete.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,55 @@ +# /admin/pull-down-menus/pdm-delete.tcl +# +# Author: aure@arsdigita.com, Feb 2000 +# +# pdm-delete.tcl,v 1.2.2.1 2000/03/16 05:33:09 aure Exp +# ----------------------------------------------------------------------------- + +ad_page_variables {menu_id} + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db " + select menu_key, default_p, count(item_id) as number_to_delete + from pdm_menu_items i, pdm_menus n + where n.menu_id = $menu_id + and n.menu_id = i.menu_id(+) + group by menu_key, default_p"] +set_variables_after_query + +ns_db releasehandle $db + +# Make sure they're not trying to delete the default! + +if {$default_p == "t"} { + ad_return_complaint 1 "
  • You cannot delete the default + menu. Choose another menu as the default first." + return +} + + +if {$menu_key == "admin"} { + ad_return_complaint 1 "
  • You cannot delete the admin + menu. Rename this menu if you want to delete it." + return +} + + +ns_return 200 text/html " +[ad_header_with_extra_stuff "Delete Pull-Down Menu: $menu_key" [ad_pdm $menu_key 5 5] [ad_pdm_spacer $menu_key]] + +

    Delete Pull-Down Menu: $menu_key

    + +[ad_admin_context_bar [list "" "Pull-Down Menu"] [list "pdm-edit?menu_id=$menu_id" $menu_key] "Delete"] + +
    + +Do you really want to delete \"$menu_key\" and its $number_to_delete items? +
    +[export_form_vars menu_id] +
    + +
    +
    + +[ad_admin_footer]" Index: web/openacs/www/admin/pull-down-menus/pdm-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/pull-down-menus/pdm-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/pull-down-menus/pdm-edit-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,142 @@ +# admin/pdm/pdm-edit-2.tcl +# +# Author: aure@caltech.edu, Feb 2000 +# +# pdm-edit-2.tcl,v 1.1.2.1 2000/03/16 05:33:10 aure Exp +# ----------------------------------------------------------------------------- + +ad_page_variables { + {menu_id} + {menu_key} + {default_p} + {orientation} + {x_offset} + {y_offset} + {element_height} + {element_width} + {main_menu_font_style ""} + {sub_menu_font_style ""} + {sub_sub_menu_font_style ""} + {main_menu_bg_img_url ""} + {main_menu_bg_color ""} + {main_menu_hl_img_url ""} + {main_menu_hl_color ""} + {sub_menu_bg_img_url ""} + {sub_menu_bg_color ""} + {sub_menu_hl_img_url ""} + {sub_menu_hl_color ""} + {sub_sub_menu_bg_img_url ""} + {sub_sub_menu_bg_color ""} + {sub_sub_menu_hl_img_url ""} + {sub_sub_menu_hl_color ""} +} + +# ----------------------------------------------------------------------------- +# Error checking + +set exception_text "" +set exception_count 0 + +if [empty_string_p $menu_key] { + incr exception_count + append exception_text "
  • You must provide a menu_key for the pdm.\n" +} + +# A help proc to check for valid integers + +proc valid_integer_p {n} { + if {[empty_string_p $n] || [regexp {[^0-9]+} $n match]} { + return 0 + } else { + return 1 + } +} + +if ![valid_integer_p $x_offset] { + incr exception_count + append exception_text " +
  • Distance from the left of the display area is not a valid integer" +} + +if ![valid_integer_p $y_offset] { + incr exception_count + append exception_text " +
  • Distance from the top of the display area is not a valid integer" +} + +if ![valid_integer_p $element_height] { + incr exception_count + append exception_text " +
  • Element height is not a valid integer" +} + +if ![valid_integer_p $element_width] { + incr exception_count + append exception_text " +
  • Element width is not a valid integer" +} + +# use the database to check for uniqueness conflicts with menu_key + +set db [ns_db gethandle] +set menu_key_conflict_menu_id [database_to_tcl_string_or_null $db " + select menu_id + from pdm_menus + where menu_key = '[DoubleApos $menu_key]' + and menu_id <> $menu_id"] + +if {![empty_string_p $menu_key_conflict_menu_id]} { + incr exception_count + append exception_text "
  • Your name conflicts with the existing menu + \"$menu_key\"\n" +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return 0 +} + + +# ----------------------------------------------------------------------------- +# Done error checking. Insert the new pdm into the database and +# redirect to the admin page. + +ns_db dml $db "begin transaction" + +# reset all other menus to false if this one will be set true +if {$default_p == "t"} { + ns_db dml $db "update pdm_menus set default_p = 'f'" +} + +ns_db dml $db " + update pdm_menus + set menu_key = '[DoubleApos $menu_key]', + default_p = '$default_p', + orientation = '$orientation', + x_offset = $x_offset, + y_offset = $y_offset, + element_height = $element_height, + element_width = $element_width, + main_menu_font_style = [ns_dbquotevalue $main_menu_font_style string], + sub_menu_font_style = [ns_dbquotevalue $sub_menu_font_style string], + sub_sub_menu_font_style = [ns_dbquotevalue $sub_sub_menu_font_style string], + main_menu_bg_img_url = [ns_dbquotevalue $main_menu_bg_img_url string], + main_menu_bg_color = [ns_dbquotevalue $main_menu_bg_color string], + main_menu_hl_img_url = [ns_dbquotevalue $main_menu_hl_img_url string], + main_menu_hl_color = [ns_dbquotevalue $main_menu_hl_color string], + sub_menu_bg_img_url = [ns_dbquotevalue $sub_menu_bg_img_url string], + sub_menu_bg_color = [ns_dbquotevalue $sub_menu_bg_color string], + sub_menu_hl_img_url = [ns_dbquotevalue $sub_menu_hl_img_url string], + sub_menu_hl_color = [ns_dbquotevalue $sub_menu_hl_color string], + sub_sub_menu_bg_img_url = [ns_dbquotevalue $sub_sub_menu_bg_img_url string], + sub_sub_menu_bg_color = [ns_dbquotevalue $sub_sub_menu_bg_color string], + sub_sub_menu_hl_img_url = [ns_dbquotevalue $sub_sub_menu_hl_img_url string], + sub_sub_menu_hl_color = [ns_dbquotevalue $sub_sub_menu_hl_color string] + where menu_id = $menu_id" + +ns_db dml $db "end transaction" + +ns_returnredirect "pdm-edit?menu_id=$menu_id" + + + Index: web/openacs/www/admin/pull-down-menus/pdm-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/pull-down-menus/pdm-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/pull-down-menus/pdm-edit.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,149 @@ +# admin/pdm/pdm-edit.tcl +# +# Author: aure@caltech.edu, Feb 2000 +# +# Page to add a new pdm to the system +# +# pdm-edit.tcl,v 1.1.2.1 2000/03/16 05:33:10 aure Exp +# ----------------------------------------------------------------------------- + +ad_page_variables {menu_id} + +set db [ns_db gethandle] + +# get the next available menu_id to pass to the processing form +# for double click protection + +set selection [ns_db 0or1row $db " + select * + from pdm_menus + where menu_id = $menu_id"] +set_variables_after_query + +ns_db releasehandle $db + +if {$default_p == "t"} { + set default_question [export_form_vars default_p] +} else { + set default_question " + + Make this the default menu: + No     + Yes + " +} + +if {$orientation == "horizontal"} { + set h_checked "checked" + set v_checked "" +} else { + set h_checked "" + set v_checked "checked" +} + +set title "Edit Pull-Down Menu: $menu_key" + +ns_return 200 text/html " +[ad_header_with_extra_stuff $title [ad_pdm $menu_key 5 5] [ad_pdm_spacer $menu_key]] + +

    $title

    + +[ad_admin_context_bar [list "" "Pull-Down Menu"] [list "items?menu_id=$menu_id" $menu_key] "Edit Parameters"] + +
    + +
    +[export_form_vars menu_id] + + + + + + + + $default_question + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    Name:
    Orientation:Horizonal     + Vertical (a bit crude currently)
    Distance from top of display area: pixels
    Distance from left of display area: pixels
    Element Height: pixels
    Element Width: pixels
    All of the following are optional: +
     
    Main Menu Font Style:
     
    Sub Menu Font Style:
     
    Second Level Font Style:
    Background Image URLBackground Color
    Main Menu Default:e.g #ffffff
    Main Menu Highlight:
    Sub Menu Default:
    Sub Menu Highlight:
    Second Level Menu Default:
    Second Level Menu Highlight:
    + +
    + +[ad_admin_footer]" + + + Index: web/openacs/www/admin/referer/all-from-foreign.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/referer/all-from-foreign.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/referer/all-from-foreign.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,46 @@ +# all-from-foreign.tcl,v 3.0 2000/02/06 03:27:36 ron Exp +set_the_usual_form_variables + +# foreign_url + +ReturnHeaders + +ns_write "[ad_admin_header "from $foreign_url"] + +

    from + + +[ns_quotehtml $foreign_url] + +

    + +[ad_admin_context_bar [list "index.tcl" "Referrals"] "From One Foreign URL"] + + +
    + +
      + +" +set db [ns_db gethandle] + +set selection [ns_db select $db "select entry_date, sum(click_count) as n_clicks from referer_log +where foreign_url = '$QQforeign_url' +group by entry_date +order by entry_date desc"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
    • $entry_date : + +$n_clicks +" +} + +ns_write " +
    + +[ad_admin_footer] +" + + Index: web/openacs/www/admin/referer/all-to-local.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/referer/all-to-local.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/referer/all-to-local.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,47 @@ +# all-to-local.tcl,v 3.0 2000/02/06 03:27:37 ron Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +# local_url + +ReturnHeaders + +ns_write "[ad_admin_header "Referrals to $local_url"] + +

    Referrals to + + +[ns_quotehtml $local_url] + +

    + +[ad_admin_context_bar [list "index.tcl" "Referrals"] "To One Local URL"] + +
    + +
      + +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select entry_date, sum(click_count) as n_clicks +from referer_log +where local_url = '$QQlocal_url' +group by entry_date +order by entry_date desc"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
    • $entry_date : + +$n_clicks +" +} + +ns_write " +
    +[ad_admin_footer] +" + + Index: web/openacs/www/admin/referer/apply-to-old-data.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/referer/apply-to-old-data.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/referer/apply-to-old-data.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,176 @@ +# apply-to-old-data.tcl,v 3.0 2000/02/06 03:27:38 ron Exp +proc_doc util_translate_tcl_glob_to_sql_like_pattern {glob_pattern} "Attempts to translate a Tcl glob pattern to a SQL LIKE pattern. Only works if the GLOB is just alphanumerics plus * or ?. Returns empty string if it can't succeed." { + set regexps [list {\]} {\[} {\\}] + foreach regexp $regexps { + if [regexp $regexp $glob_pattern] { + return "" + } + } + regsub -all {\*} $glob_pattern "%" glob_pattern + regsub -all {\?} $glob_pattern "_" glob_pattern + return $glob_pattern +} + +# apply-to-old-data.tcl +# by philg@mit.edu on 2/27/1999 + +# this procedures takes a GLOB pattern and applies it to the old +# data in referer_log + +set_the_usual_form_variables + +# glob_pattern, simulate_p (pointing into referer_log_glob_patterns) + +if { [info exists simulate_p] && !$simulate_p } { + # we're not simulating + set title "Applying GLOB Pattern to referer_log" + set working_headline "Applying" + set db_conns [ns_db gethandle [philg_server_default_pool] 2] + set db [lindex $db_conns 0] + set db_sub [lindex $db_conns 1] + set apply_option "" +} else { + set title "Simulating the application of GLOB Pattern to referer_log" + set working_headline "Simulating" + set db [ns_db gethandle] + set apply_option "

    +

    +
    +[export_form_vars glob_pattern] + + +
    +" +} + + +ReturnHeaders + +ns_write "[ad_admin_header $title] + +

    $title

    + +in the referral tracking of [ad_system_name] administration + +
    + +" + + +set selection [ns_db 1row $db "select * +from referer_log_glob_patterns +where glob_pattern = '$QQglob_pattern'"] + +set_variables_after_query + + +ns_write " +
      +
    • glob_pattern: \"$glob_pattern\" +
    • canonical_foreign_url: \"$canonical_foreign_url\" +

      +

    • search_engine_name: \"$search_engine_name\" +
    • search_engine_regexp: \"$search_engine_regexp\" +
    + +

    $working_headline

    + +" + +set sql_like_pattern [util_translate_tcl_glob_to_sql_like_pattern $glob_pattern] + +if ![empty_string_p $sql_like_pattern] { + # we don't have to go through entire log + set query "select oid as rowid, local_url, foreign_url, entry_date, click_count, to_char(entry_date,'YYYY-MM-DD HH24:MI:SS') as entry_date_timestamp +from referer_log +where foreign_url <> '[DoubleApos $canonical_foreign_url]' +and foreign_url like '[DoubleApos $sql_like_pattern]'" +} else { + set query "select oid as rowid, local_url, foreign_url, entry_date, click_count, to_char(entry_date,'YYYY-MM-DD HH24:MI:SS') as entry_date_timestamp +from referer_log +where foreign_url <> '[DoubleApos $canonical_foreign_url]'" +} + + +ns_write " + +We're going to run + +
    +
    
+$query
+
    +
    + + +If you applied this glob pattern to legacy data, here's what would +happen.. + +

    + +

      + +" + +set selection [ns_db select $db $query] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if {[string match $glob_pattern $foreign_url]} { + ns_write "
    • $entry_date: from $foreign_url to $local_url.\n" + # reset the flag for code below + set query_string "" + if {![empty_string_p $search_engine_name] && [regexp $search_engine_regexp $foreign_url match encoded_query_string]} { + set query_string [ns_urldecode $encoded_query_string] + # remove the pluses + regsub -all {\+} $query_string { } query_string + ns_write "We think the query string was \"$query_string\"\n" + } + } + if { [info exists simulate_p] && !$simulate_p } { + # we're not simulating + ns_db dml $db_sub "begin transaction" + ns_write "
      We're deleting this row from referer_log...\n" + ns_db dml $db_sub "delete from referer_log where oid = '[DoubleApos $rowid]'" + ns_write "done. We're going to increment the count for the canonical URL..." + # let's now register the referral under the canonical URL + set update_sql "update referer_log set click_count = click_count + 1 +where local_url = '[DoubleApos $local_url]' +and foreign_url = '[DoubleApos $canonical_foreign_url]' +and trunc(entry_date) = '$entry_date'" + ns_db dml $db_sub $update_sql + set n_rows [ns_pg ntuples $db_sub] + if { $n_rows == 0 } { + # there wasn't already a row there + ns_write "done, but it didn't have any effect. There wasn't already a row in the database. So we're inserting one..." + set insert_sql "insert into referer_log (local_url, foreign_url, entry_date, click_count) +values +('[DoubleApos $local_url]', '[DoubleApos $canonical_foreign_url]', '$entry_date', 1)" + ns_db dml $db_sub $insert_sql + ns_write "done." + + } else { + ns_write "done. There was already a row in the database." + } + if {![empty_string_p $query_string] && ![empty_string_p $search_engine_name]} { + # we got a query string on this iteration + ns_write " Inserting a row into query_strings... " + ns_db dml $db_sub "insert into query_strings +(query_date, query_string, search_engine_name) +values +(to_date('$entry_date_timestamp','YYYY-MM-DD HH24:MI:SS'), '[DoubleApos $query_string]', '[DoubleApos $search_engine_name]')" + ns_write " done." + } + + ns_db dml $db_sub "end transaction" + } + ns_write "\n\n

      \n\n" +} + +ns_write " +

    + +$apply_option + +[ad_admin_footer] +" Index: web/openacs/www/admin/referer/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/referer/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/referer/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,40 @@ +# index.tcl,v 3.0 2000/02/06 03:27:39 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Referrals to [ad_system_name]"] + +

    Referrals to [ad_system_name]

    + +[ad_admin_context_bar "Referrals"] + +
    + +
      + + +
    • last + days + + + +

      + +

    • from search engines + +
    + +

    Advanced

    + + +
    +Lumping patterns are useful when you want to lump all referrals from a +particular site together under one rubric. This is particularly +useful in the case of referrals from search engines. +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/referer/main-report.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/referer/main-report.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/referer/main-report.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,100 @@ +# main-report.tcl,v 3.0 2000/02/06 03:27:40 ron Exp +# we assume that a publisher is here because he or she wants to see +# what are the most important foreign URLs generating referrals to +# this site. So the default is to order results by n_clicks desc + +set_the_usual_form_variables 0 + +# n_days (default is "all" if not specified) +# optional minimum +# optional order_by + +if { ![info exists order_by] || $order_by == "n_clicks" } { + set order_by_columns "n_clicks desc, foreign_url, local_url" +} else { + set order_by_columns "foreign_url, local_url" +} + +# let's try to set up some reasonable minimums + +if { ![info exists minimum] } { + # no minimum specified + if { ([info exists n_days] && $n_days == 1) && ([ad_parameter TrafficVolume] == "small")} { + # no minimum + set minimum 1 + } else { + if { [ad_parameter TrafficVolume] == "small" } { + set minimum 2 + } else { + # not a small site + if { ([info exists n_days] && $n_days < 7) } { + set minimum 3 + } else { + # more than 7 days on a non-small site + set minimum 10 + } + } + } +} + +if { [info exists minimum] } { + set having_clause "\nhaving sum(click_count) >= $minimum" +} else { + set having_clause "" +} + +if { ![info exists n_days] || $n_days == "all" } { + set query "select local_url, foreign_url, sum(click_count) as n_clicks +from referer_log +group by local_url, foreign_url $having_clause +order by $order_by_columns" +} elseif { $n_days > 1 } { + set query "select local_url, foreign_url, sum(click_count) as n_clicks +from referer_log +where entry_date::date > sysdate()::date - $n_days +group by local_url, foreign_url $having_clause +order by $order_by_columns" +} else { + # just one day, so we don't have to group by + if { [info exists minimum] } { + set and_clause "\nand click_count >= $minimum" + } else { + set and_clause "" + } + set query "select local_url, foreign_url, click_count as n_clicks +from referer_log +where entry_date::date > sysdate()::date - 1 $and_clause +order by $order_by_columns" +} + +ReturnHeaders + +ns_write "[ad_admin_header "Referrals from foreign URLs to [ad_system_name]"] + +

    Referrals from foreign URLs

    + +[ad_admin_context_bar [list "index.tcl" "Referrals"] "Main Report"] + + +
    + + + +[ad_admin_footer] +" Index: web/openacs/www/admin/referer/mapping-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/referer/mapping-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/referer/mapping-add-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,51 @@ +# mapping-add-2.tcl,v 3.0 2000/02/06 03:27:41 ron Exp +set_the_usual_form_variables + +# everything for referer_log_glob_patterns + +set exception_count 0 +set exception_text "" + +if { ![info exists glob_pattern] || [empty_string_p $glob_pattern] } { + incr exception_count + append exception_text "
  • Please enter a pattern to use to lump URL's together." +} +if { ![info exists canonical_foreign_url] || [empty_string_p $canonical_foreign_url] } { + incr exception_count + append exception_text "
  • Please enter a URL to group the matches under." +} + + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + + +set db [ns_db gethandle] + +ns_set delkey $form submit + +set insert_statement [util_prepare_insert $db referer_log_glob_patterns glob_pattern $glob_pattern [ns_conn form]] + +if [catch { ns_db dml $db $insert_statement } errmsg] { + set n_already [database_to_tcl_string $db "select count(*) from referer_log_glob_patterns where glob_pattern = '$QQglob_pattern'"] + if { $n_already > 0 } { + ad_return_error "There is already a mapping for $glob_pattern" "There is already a mapping for the pattern \"$glob_pattern\". +If you didn't hit submit twice by mistake, then perhaps +what you want to do is +
    +$errmsg
+
    + +" + } + return +} + +ns_returnredirect "mapping.tcl" + + Index: web/openacs/www/admin/referer/mapping-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/referer/mapping-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/referer/mapping-add.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,100 @@ +# mapping-add.tcl,v 3.0 2000/02/06 03:27:43 ron Exp +# +# /admin/referer/mapping-add.tcl +# +# by philg@mit.edu in 1998 +# +# serves a form to the site administrator; takes no action +# + +ns_return 200 text/html "[ad_admin_header "Add Lumping Pattern"] +

    Add Lumping Pattern

    + +[ad_admin_context_bar [list "index.tcl" "Referrals"] [list "mapping.tcl" "Lumping Patterns"] "Add"] + +
    + +
    + +Referer headers matching the pattern: (Example: http://www.altavista.com*)
    +

    + +will be lumped together in reports under the URL: (Example: http://www.altavista.com)
    + +
    +

    + +Note: lumping is done using the Tcl GLOB facility. The basic idea is +that * matches 0 or more characters, so \"*photo.net*\" would match +any referral coming from a server with photo.net in its hostname, e.g., +\"db.photo.net\". + +

    + +If what you're trying to do is lump together referrals from a search +engine, you probably also want to fill in these additional fields. If +you are successful, not only will the ArsDigita Community System +record the referrals but it will also capture the query strings and +store them in the database. So, for example, you would be able to see +that users of Lycos are coming to this site looking for information on +\"Nikon history\" or that users of AltaVista queried for \"supermodels +on rollerskates\" and were sent here. + +

    + +Name of search engine: +
    +(this is for reports, e.g., \"AltaVista\") + +

    + +Tcl Regular Expression to pull out query string: + + +

    + +Explaining REGEXPs is beyond the scope of this document. There is a +comprehensive book on the subject: Mastering Regular +Expressions (Friedl 1997; O'Reilly). The idea is that you give +the computer to figure out which part of the referer header contains +the string typed. + +

    + +Here's an example log entry: + +

    + +139.134.23.10 - - \[28/Nov/1998:19:05:16 -0500\] \"GET /WealthClock HTTP/1.0\" 200 3609 http://www.altavista.com/cgi-bin/query?pg=q&kl=XX&q=how+Bill+Gates+began&search=Search \"Mozilla/2.0 (compatible; MSIE 3.0; Windows 95) via NetCache version NetApp Release 3.2.1R1D12: Wed Oct 28 08:37:31 PST 1998\" + +
    + +The referer header is + +
    + +http://www.altavista.com/cgi-bin/query?pg=q&kl=XX&q=how+Bill+Gates+began&search=Search + +
    + +It looks like the query string starts with a q= and ends +with either a space or an ampersand. A regular expression to match +this would be + +
    + +q=(\[^& \]+) + +
    + +

    + + +

    + +
    +
    + + +[ad_admin_footer] +" Index: web/openacs/www/admin/referer/mapping-change-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/referer/mapping-change-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/referer/mapping-change-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,43 @@ +# mapping-change-2.tcl,v 3.0 2000/02/06 03:27:44 ron Exp +set_the_usual_form_variables + +# glob_pattern (database key), new_glob_pattern, +# canonical_foreign_url, search_engine_name, search_engine_regexp + + +set exception_count 0 +set exception_text "" + + +if { ![info exists glob_pattern] || [empty_string_p $glob_pattern] } { + incr exception_count + append exception_text "
  • Please enter a pattern to use to lump URL's together." +} +if { ![info exists canonical_foreign_url] || [empty_string_p $canonical_foreign_url] } { + incr exception_count + append exception_text "
  • Please enter a URL to group the matches under." +} + + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + + +set db [ns_db gethandle] + +if { [string match "*delete*" [string tolower $submit]] } { + # user asked to delete + ns_db dml $db "delete from referer_log_glob_patterns where glob_pattern= '$QQglob_pattern'" +} else { + ns_db dml $db "update referer_log_glob_patterns +set glob_pattern='$QQnew_glob_pattern', +canonical_foreign_url='$QQcanonical_foreign_url', +search_engine_name = '$QQsearch_engine_name', +search_engine_regexp = '$QQsearch_engine_regexp' +where glob_pattern= '$QQglob_pattern'" +} + +ns_returnredirect "mapping.tcl" + Index: web/openacs/www/admin/referer/mapping-change.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/referer/mapping-change.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/referer/mapping-change.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,96 @@ +# mapping-change.tcl,v 3.0 2000/02/06 03:27:46 ron Exp +set_the_usual_form_variables + +# glob_pattern + +ReturnHeaders + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select canonical_foreign_url, search_engine_name, search_engine_regexp from referer_log_glob_patterns where glob_pattern = '$QQglob_pattern'"] +set_variables_after_query + +ns_write "[ad_admin_header "Edit Lumping Pattern"] + +

    Edit a Lumping Pattern

    + +in the     referral tracking section +of [ad_system_name] administration + +
    + +
    +[export_form_vars glob_pattern] + +Referer headers matching the pattern: (Example: http://www.altavista.com*)
    + + +

    + + +will be lumped together in reports under the URL: (Example: http://www.altavista.com)
    + + +

    + +If you are trying lump together referrals from a search +engine, you probably also want to fill in these additional fields. +

    +Name of search engine:
    +
    +(this is for reports, e.g., \"AltaVista\") + +

    + +Tcl Regular Expression to pull out query string: +
    + + +

    + +Explaining REGEXPs is beyond the scope of this document. There is a +comprehensive book on the subject: Mastering Regular +Expressions (Friedl 1997; O'Reilly). The idea is that you give +the computer to figure out which part of the referer header contains +the string typed. + +

    + +Here's an example log entry: + +

    + +139.134.23.10 - - \[28/Nov/1998:19:05:16 -0500\] \"GET /WealthClock HTTP/1.0\" 200 3609 http://www.altavista.com/cgi-bin/query?pg=q&kl=XX&q=how+Bill+Gates+began&search=Search \"Mozilla/2.0 (compatible; MSIE 3.0; Windows 95) via NetCache version NetApp Release 3.2.1R1D12: Wed Oct 28 08:37:31 PST 1998\" + +
    + +The referer header is + +
    + +http://www.altavista.com/cgi-bin/query?pg=q&kl=XX&q=how+Bill+Gates+began&search=Search + +
    + +It looks like the query string starts with a q= and ends +with either a space or an ampersand. A regular expression to match +this would be + +
    + +q=(\[^& \]+) + +
    + +

    + +

    + + + + +
    + +[ad_admin_footer] +" + Index: web/openacs/www/admin/referer/mapping.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/referer/mapping.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/referer/mapping.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,67 @@ +# mapping.tcl,v 3.0 2000/02/06 03:27:48 ron Exp +set_form_variables 0 + +ReturnHeaders + +ns_write "[ad_admin_header "Referral lumping patterns"] + +

    Referral lumping patterns

    + +[ad_admin_context_bar [list "index.tcl" "Referrals"] "Lumping Patterns"] + +
    + +
      + +" + +set db [ns_db gethandle] +set selection [ns_db select $db "select oid as rowid, rlgp.* +from referer_log_glob_patterns rlgp +order by glob_pattern +"] + + +set counter 0 +while {[ns_db getrow $db $selection]} { + set_variables_after_query + incr counter + set description "" + + append description "
    • We map URLs matching +
        +
      • $glob_pattern +to +
      • $canonical_foreign_url +
      \n" + if {[string length $search_engine_name] > 0} { + append description "We think that this is search engine called \"$search_engine_name\"." + if {[string length $search_engine_regexp] > 0} { + append description " We look for the string that the user typed with the Regexp \"$search_engine_regexp\"." + } + } + append description "
      edit +| +simulate +| +apply to legacy data (destructive) + +

      +" + ns_write "$description\n" +} + +if { $counter == 0 } { + ns_write "no lumping patterns currently installed" +} + +ns_write " + +

      + +

    • Add lumping pattern +
    + +[ad_admin_footer] +" + Index: web/openacs/www/admin/referer/one-foreign-one-day.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/referer/one-foreign-one-day.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/referer/one-foreign-one-day.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,47 @@ +# one-foreign-one-day.tcl,v 3.0 2000/02/06 03:27:50 ron Exp +set_the_usual_form_variables + +# foreign_url, query_date + +ReturnHeaders + +ns_write "[ad_admin_header "$query_date : from $foreign_url"] + +

    from + + +[ns_quotehtml $foreign_url] + +

    + + +[ad_admin_context_bar [list "index.tcl" "Referrals"] [list "all-from-foreign.tcl?[export_url_vars foreign_url]" "From One Foreign URL"] "Just $query_date"] + + +
    + +
      + +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select local_url, click_count +from referer_log +where foreign_url = '[DoubleApos $foreign_url]' +and entry_date = '$query_date' +order by local_url"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
    • to $local_url : $click_count\n" +} + +ns_write " +
    + +[ad_admin_footer] +" + + + Index: web/openacs/www/admin/referer/one-local-one-day.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/referer/one-local-one-day.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/referer/one-local-one-day.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,37 @@ +# one-local-one-day.tcl,v 3.0 2000/02/06 03:27:51 ron Exp +set_the_usual_form_variables + +# local_url, query_date + +ReturnHeaders + +ns_write "[ad_admin_header "$query_date : Referrals to $local_url"] + +

    Referrals to $local_url on $query_date +

    + +[ad_admin_context_bar [list "index.tcl" "Referrals"] [list "all-to-local.tcl?[export_url_vars local_url]" "To One Local URL"] "Just $query_date"] + +
    + +
      + +" +set db [ns_db gethandle] + +set selection [ns_db select $db "select foreign_url, click_count +from referer_log +where local_url = '$QQlocal_url' +and entry_date = '$query_date' +order by foreign_url"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
    • from $foreign_url : $click_count\n" +} + +ns_write " +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/referer/one-url-pair.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/referer/one-url-pair.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/referer/one-url-pair.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,68 @@ +# one-url-pair.tcl,v 3.0 2000/02/06 03:27:52 ron Exp +set_the_usual_form_variables + +# local_url, foreign_url + +# we end up quoting the HTML because sometimes this stuff gets into the +# database with weird bogosities from broken pages and tolerant browsers + +ReturnHeaders + +ns_write "[ad_admin_header "[ns_quotehtml $foreign_url] -> [ns_quotehtml $local_url]"] + +

    + + +[ns_quotehtml $foreign_url] + + + -> + + +[ns_quotehtml $local_url] + +

    + +[ad_admin_context_bar [list "index.tcl" "Referrals"] "One URL Pair"] + +
    + +
      + +" +set db [ns_db gethandle] + +set selection [ns_db select $db "select entry_date, click_count +from referer_log +where local_url = '$QQlocal_url' +and foreign_url = '$QQforeign_url' +order by entry_date desc"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
    • $entry_date : $click_count\n" +} + +ns_write " +
    + +

    Still not satisfied?

    + +The ArsDigita Community System software can build you a report of + + + + +[ad_admin_footer] +" + + Index: web/openacs/www/admin/referer/search-engine-one-one-month.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/referer/search-engine-one-one-month.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/referer/search-engine-one-one-month.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,57 @@ +# search-engine-one-one-month.tcl,v 3.0 2000/02/06 03:27:53 ron Exp +# one search engine, one month + +set_the_usual_form_variables + +# search_engine_name, query_year, query_month + +ReturnHeaders + +ns_write "[ad_admin_header "$search_engine_name: $query_month/$query_year"] + +

    $search_engine_name referrals in $query_month/$query_year

    + +[ad_admin_context_bar [list "index.tcl" "Referrals"] [list "search-engines.tcl" "Search Engine Statistics"] "One Month"] + +
    + +
      + +" + +set db [ns_db gethandle] + +set first_of_month "$query_year-$query_month-01" + +set selection [ns_db select $db " +select query_string +from query_strings +where search_engine_name = '$QQsearch_engine_name' +and query_date between '$first_of_month' and add_months('$first_of_month',1) +order by upper(query_string)"] + +set items "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append items "
    • $query_string\n" +} + +ns_write $items + +ns_write " + +
    + + + +Note: Referrals from public search engines are identified by patterns recorded in the +referer_log_glob_patterns table, maintained at +/admin/referer/mapping.tcl. The statistics +on these pages do not include searches done by users locally (i.e., with tools running +on this server). + + + +[ad_admin_footer] +" Index: web/openacs/www/admin/referer/search-engine-one.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/referer/search-engine-one.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/referer/search-engine-one.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,66 @@ +# search-engine-one.tcl,v 3.0 2000/02/06 03:27:54 ron Exp +set_the_usual_form_variables + +# search_engine_name + +ReturnHeaders + +ns_write "[ad_admin_header "$search_engine_name"] + +

    $search_engine_name Referrals to [ad_system_name]

    + +[ad_admin_context_bar [list "index.tcl" "Referrals"] [list "search-engines.tcl" "Search Engine Statistics"] "One Search Engine"] + +
    + +
    + + + + + +" + +set db [ns_db gethandle] +set selection [ns_db select $db " +select + to_char(query_date,'YYYY') as query_year, + to_char(query_date,'MM') as query_month, + count(*) as n_searches +from query_strings +where search_engine_name = '$QQsearch_engine_name' +group by to_char(query_date,'YYYY'), to_char(query_date,'MM') +order by query_year, query_month"] + +set table_rows "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append table_rows " + + +" +} + +ns_write " +$table_rows + +
    Month + Total Referrals +
    $query_month/$query_year + $n_searches +
    +
    + + + +Note: Referrals from public search engines are identified by patterns recorded in the +referer_log_glob_patterns table, maintained at +/admin/referer/mapping.tcl. The statistics +on these pages do not include searches done by users locally (i.e., with tools running +on this server). + + + +[ad_admin_footer] +" Index: web/openacs/www/admin/referer/search-engines.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/referer/search-engines.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/referer/search-engines.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,66 @@ +# search-engines.tcl,v 3.0 2000/02/06 03:27:55 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Search Engine Referrals to [ad_system_name]"] + +

    Search Engine Referrals to [ad_system_name]

    + +[ad_admin_context_bar [list "index.tcl" "Referrals"] "Search Engine Statistics"] + +
    + +
    + + + + +" + +set db [ns_db gethandle] +set selection [ns_db select $db " +select + search_engine_name, + count(*) as n_searches, + min(query_date) as earliest, + max(query_date) as latest +from query_strings +where search_engine_name is not null +group by search_engine_name +order by n_searches desc"] + +set table_rows "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append table_rows " + + +" +} + +ns_write " +$table_rows + +
    Search Engine + Total Referrals + From + To +
    $search_engine_name + $n_searches + [util_AnsiDatetoPrettyDate $earliest] + [util_AnsiDatetoPrettyDate $latest] +
    +
    + + + +Note: Referrals from public search engines are identified by patterns recorded in the +referer_log_glob_patterns table, maintained at +/admin/referer/mapping.tcl. The statistics +on these pages do not include searches done by users locally (i.e., with tools running +on this server). + + + +[ad_admin_footer] +" Index: web/openacs/www/admin/registry/by-date.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/registry/by-date.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/registry/by-date.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,43 @@ +# by-date.tcl,v 3.0 2000/02/06 03:27:56 ron Exp +proc philg_capitalize { in_string } { + append out_string [string toupper [string range $in_string 0 0]] [string tolower [string range $in_string 1 [string length $in_string]]] +} + +set db [ns_db gethandle] + +set selection [ns_db select $db "select stolen_id, posted, manufacturer, model +from stolen_registry +order by posted desc"] + +ReturnHeaders + +ns_write "[ad_admin_header "All Entries By Date"] + +

    All Entries By Date

    + +[ad_admin_context_bar [list "index.tcl" "Registry"] "Entries"] + +
    +
      +" + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + + ns_write "
    • $posted $manufacturer $model\n" +} + +ns_write "
    \n" + +ns_write " +or + +
    +Search by full text query: +
    +

    +Note: this searches through names, email addresses, stories, manufacturers, models, and +serial numbers. + +[ad_admin_footer] +" Index: web/openacs/www/admin/registry/by-user.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/registry/by-user.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/registry/by-user.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,51 @@ +# by-user.tcl,v 3.0 2000/02/06 03:27:57 ron Exp +proc philg_capitalize { in_string } { + append out_string [string toupper [string range $in_string 0 0]] [string tolower [string range $in_string 1 [string length $in_string]]] +} + +set db [ns_db gethandle] + +set selection [ns_db select $db "select + u.first_names, u.last_name, u.user_id, count(*) count, max(posted) last_posted + FROM stolen_registry s, users u +where u.user_id = s.user_id +group by u.first_names, u.last_name, u.user_id +order by count desc"] + +ReturnHeaders + +ns_write "[ad_admin_header "Stolen Equipment Registry Users"] + +

    Stolen Equipment Registry Users

    + +[ad_admin_context_bar [list "index.tcl" "Registry"] "Entries"] + +
    + + \[ View all entries sorted by date \] + +
      +" + +while {[ns_db getrow $db $selection]} { + + set_variables_after_query + + ns_write "
    • $first_names $last_name ($count, most recent on [util_AnsiDatetoPrettyDate $last_posted])" + +} + +ns_write "
    \n" + +ns_write " +or + +
    +Search by full text query: +
    +

    +Note: this searches through names, email addresses, stories, manufacturers, models, and +serial numbers. + +[ad_admin_footer] +" Index: web/openacs/www/admin/registry/data-model.sql =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/registry/data-model.sql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/registry/data-model.sql 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,51 @@ +-- +-- Table definitions for stolen equipment registry +-- + +-- +-- Copyright 1996 Philip Greenspun (philg@mit.edu) +-- + +-- updated December 7, 1997 for Oracle + +create sequence stolen_registry_sequence start with 300; + +create table stolen_registry ( + stolen_id integer not null primary key, + name varchar(100), + email varchar(100), + password varchar(30), -- in case user wants to edit + additional_contact_info varchar(400), + manufacturer varchar(50), -- e.g., 'Nikon' + model varchar(100), -- e.g., 'N90s' + serial_number varchar(100), + value numeric(9,2), + recovered_p char(1) default 'f' check(recovered_p in ('f','t')), + recovered_by_this_service_p char(1) default 'f' check(recovered_by_this_service_p in ('f','t')), + posted date, + story varchar(3000), -- optional, free text + deleted_p char(1) default 'f' check(deleted_p in ('f','t')) +); + +create view stolen_registry_upper as +select upper(manufacturer) as manufacturer from stolen_registry; + +create view stolen_registry_for_context (stolen_id, deleted_p, recovered_p, manufacturer, model, serial_number, indexedtext) +as +select stolen_id, deleted_p, recovered_p, manufacturer, model, serial_number, serial_number || ' ' || name || ' ' || email || ' ' || manufacturer || ' ' || model || ' ' || story from stolen_registry; + +begin + ctx_ddl.create_policy ( + policy_name => 'p_stolen_registry', + colspec => 'stolen_registry_for_context.indexedtext' , + textkey => 'stolen_registry_for_context.stolen_id' ); +end; +/ + +execute ctx_ddl.create_index('p_stolen_registry'); + + +-- in the good old Illustra days +--create index stolen_registry_pls_index on stolen_registry using pls +--( serial_number, name, email, manufacturer, model, story ); + Index: web/openacs/www/admin/registry/delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/registry/delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/registry/delete.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,9 @@ +# delete.tcl,v 3.0 2000/02/06 03:27:59 ron Exp +set_form_variables +# stolen_id, manufacturer + +set db [ns_db gethandle] + +ns_db dml $db "delete from stolen_registry where stolen_id = $stolen_id" + +ns_returnredirect "search-one-manufacturer.tcl?manufacturer=[ns_urlencode $manufacturer]" Index: web/openacs/www/admin/registry/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/registry/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/registry/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,50 @@ +# index.tcl,v 3.0 2000/02/06 03:28:00 ron Exp +proc philg_capitalize { in_string } { + append out_string [string toupper [string range $in_string 0 0]] [string tolower [string range $in_string 1 [string length $in_string]]] +} + +set db [ns_db gethandle] + +set selection [ns_db select $db "select initcap(upper(manufacturer)) as manufacturer,count(*) as count +from stolen_registry +group by upper(manufacturer) +order by upper(manufacturer)"] + +ReturnHeaders + +ns_write "[ad_admin_header "Stolen Equipment Registry Admininistration"] + +

    Stolen Equipment Registry Administration

    + +[ad_admin_context_bar "Registry"] + +
    + + \[ View all entries sorted by date  |  + View all entries by user \] + + + +
      +" + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
    • $manufacturer ($count)" + +} + +ns_write "
    \n" + +ns_write " +or + +
    +Search by full text query: +
    +

    +Note: this searches through names, email addresses, stories, manufacturers, models, and +serial numbers. + +[ad_admin_footer] +" Index: web/openacs/www/admin/registry/one-case.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/registry/one-case.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/registry/one-case.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,67 @@ +# one-case.tcl,v 3.0 2000/02/06 03:28:01 ron Exp +set_form_variables + +# stolen_id is the only one + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select stolen_id, + additional_contact_info, manufacturer, model, serial_number, + value, recovered_p, recovered_by_this_service_p, posted, + story, s.deleted_p, u.email, u.first_names, u.last_name +from stolen_registry s, users u +where stolen_id=$stolen_id +and u.user_id = s.user_id"] + +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "$manufacturer $model $serial_number"] + +

    $manufacturer $model

    + +[ad_admin_context_bar [list "index.tcl" "Registry"] "One Entry"] + + +
    + +serial number $serial_number

    + +" + +if { $story != "" } { + + ns_write "

    Story

    + +$story + +" + +} + +ns_write "

    Contact

    +Reported on $posted by $first_names $last_name ($email)" + +if { $additional_contact_info != "" } { + + ns_write ", who may also be reached at 
    +$additional_contact_info
+
    " + +} + +ns_write " +
      +
    • Delete this post + +

      +

      + +
    • + +
    + + +[ad_admin_footer] +" Index: web/openacs/www/admin/registry/search-one-manufacturer.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/registry/search-one-manufacturer.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/registry/search-one-manufacturer.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,53 @@ +# search-one-manufacturer.tcl,v 3.0 2000/02/06 03:28:03 ron Exp +proc philg_capitalize { in_string } { + append out_string [string toupper [string range $in_string 0 0]] [string tolower [string range $in_string 1 [string length $in_string]]] +} + +set_the_usual_form_variables +# manufacturer + +set db [ns_db gethandle] + +if { $manufacturer == "" } { + set where_clause "manufacturer is null" +} else { + set where_clause "upper(manufacturer) = upper('$QQmanufacturer')" +} + +set selection [ns_db select $db "select stolen_id,sr.* +from stolen_registry sr +where $where_clause +order by model"] + +set pretty_manufacturer [philg_capitalize $manufacturer] + +ReturnHeaders + +ns_write "[ad_admin_header "$pretty_manufacturer Entries"] + +

    $pretty_manufacturer Entries

    + +[ad_admin_context_bar [list "index.tcl" "Registry"] "One Manufacturer"] + + +
    + +
      \n" + +while {[ns_db getrow $db $selection]} { + + set_variables_after_query + # can't use the obvious $serial_number == "" because Tcl + # is so stupid about numbers + if { ![string match "" $serial_number] } { + ns_write "
    • $model, serial number $serial_number" + } else { + ns_write "
    • $model, no serial number provided" + } + +} + +ns_write "
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/registry/search-one-user.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/registry/search-one-user.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/registry/search-one-user.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,47 @@ +# search-one-user.tcl,v 3.0 2000/02/06 03:28:04 ron Exp +proc philg_capitalize { in_string } { + append out_string [string toupper [string range $in_string 0 0]] [string tolower [string range $in_string 1 [string length $in_string]]] +} + +set_the_usual_form_variables +# user_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select first_names, last_name from users where user_id = $user_id"] +set_variables_after_query + +set selection [ns_db select $db "select stolen_id,sr.* +from stolen_registry sr +where user_id = $user_id +order by manufacturer, model"] + +ReturnHeaders + +ns_write "[ad_admin_header "Entries for $first_names $last_name"] + +

    Entries for $first_names $last_name

    + +[ad_admin_context_bar [list "index.tcl" "Registry"] "One User"] + +
    + +
      \n" + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + set pretty_manufacturer [philg_capitalize $manufacturer] + + # can't use the obvious $serial_number == "" because Tcl + # is so stupid about numbers + if { ![string match "" $serial_number] } { + ns_write "
    • $pretty_manufacturer $model, serial number $serial_number" + } else { + ns_write "
    • $pretty_manufacturer $model, no serial number provided" + } + +} + +ns_write "
    \n" + +ns_write [ad_admin_footer] Index: web/openacs/www/admin/registry/search-pls.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/registry/search-pls.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/registry/search-pls.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,75 @@ +# search-pls.tcl,v 3.0 2000/02/06 03:28:05 ron Exp +set use_context_p 0 + +set_the_usual_form_variables + +# query_string is the only one + +set db [ns_db gethandle] + +if $use_context_p { + regsub -all { +} $query_string "," query_string_for_ctx + regsub -all {,+} $query_string_for_ctx "," query_string_for_ctx + + set sql "select stolen_id, manufacturer, model, serial_number +from stolen_registry_for_context +where contains (indexedtext, '\$([DoubleApos $query_string_for_ctx])', 10) > 0 +and deleted_p <> 't' +and recovered_p <> 't' +order by score(10) desc" + +} else { + # if the user put in commas, replace with spaces + regsub -all {,+} [string trim $QQquery_string] " " final_query_string + set sql "select pseudo_contains (indexedtext, '$final_query_string') as the_score, stolen_id, manufacturer, model, serial_number +from stolen_registry_for_context +where pseudo_contains (indexedtext, '$final_query_string') > 0 +and deleted_p <> 't' +and recovered_p <> 't' +order by 1 desc" +} + +ReturnHeaders + +ns_write "[ad_admin_header "Full Text Search Results"] + +

    Search Results for \"$query_string\"

    + +[ad_admin_context_bar [list "index.tcl" "Registry"] "Search Results"] + + +
    + +
      +" + +if [catch { set selection [ns_db select $db $sql] } errmsg] { + + ns_write "Ooops! Some kind of problem with our database: +
      +$errmsg +
      +

      + +In the meantime, you can always search by manufacturer from the preceding page." + +} else { + # the PLS query actually succeeded (miracles do occur) + while {[ns_db getrow $db $selection]} { + set_variables_after_query + if [empty_string_p $serial_number] { + set serial_number "No serial number provided" + } + ns_write "

    • $manufacturer $model, serial number $serial_number" + } + + + +} + +ns_write " + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/registry/search.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/registry/search.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/registry/search.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,60 @@ +# search.tcl,v 3.0 2000/02/06 03:28:07 ron Exp +proc philg_capitalize { in_string } { + append out_string [string toupper [string range $in_string 0 0]] [string tolower [string range $in_string 1 [string length $in_string]]] +} + +set db [ns_db gethandle] + +set selection [ns_db select $db "select initcap(upper(manufacturer)) as manufacturer,count(*) as count +from stolen_registry +group by upper(manufacturer) +order by upper(manufacturer)"] + +ReturnHeaders + +ns_write " + + +Search Stolen Equipment Registry + + + +

    Search

    + +the Stolen Equipment Registry + +
    + +Pick a manufacturer... + +
      +" + +while {[ns_db getrow $db $selection]} { + + set_variables_after_query + + ns_write "
    • $manufacturer ($count)" + +} + +ns_write "
    \n" + +ns_write " +or + +
    +Search by full text query: +
    +

    +Note: this searches through names, email addresses, stories, manufacturers, models, and +serial numbers. + +

    + + +
    photo.net@martigny.ai.mit.edu + + + +" Index: web/openacs/www/admin/registry/update-manufacturer.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/registry/update-manufacturer.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/registry/update-manufacturer.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,9 @@ +# update-manufacturer.tcl,v 3.0 2000/02/06 03:28:08 ron Exp +set_the_usual_form_variables +# stolen_id, manufacturer + +set db [ns_db gethandle] + +ns_db dml $db "update stolen_registry set manufacturer = '$manufacturer' where stolen_id = $stolen_id" + +ns_returnredirect "one-case.tcl?stolen_id=$stolen_id" \ No newline at end of file Index: web/openacs/www/admin/robot-detection/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/robot-detection/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/robot-detection/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,73 @@ +# index.tcl,v 3.0 2000/02/06 03:28:10 ron Exp +# Created by michael@yoon.org, 05/27/1999 +# +# Lists all registered robots and enables the site admin +# to refresh the list. + +ReturnHeaders + +set page_title "Web Robot Detection" + +ns_write "[ad_admin_header $page_title] + +

    $page_title

    + +[ad_admin_context_bar "Robot Detection"] + +
    + +Documentation: /doc/robot-detection.html + +

    Configuration Settings

    + +The current configuration settings are: + +
    +WebRobotsDB=[ad_parameter WebRobotsDB robot-detection]
+"
+
+set patterns [ad_parameter_all_values_as_list FilterPattern robot-detection]
+
+if [empty_string_p $patterns] {
+    ns_write "**** no filter patterns spec'd; system is disabled ****\n"
+} else {
+    ns_write "FilterPattern=[join  "\nFilterPattern="]"
+}
+
+ns_write "RedirectURL=[ad_parameter RedirectURL robot-detection]
+
    + +

    Known Robots

    + +

    + +Courtesy of the Web Robots Database, +this installation of the ACS can recognize the following robots: + +

      +" + +set counter 0 +set db [ns_db gethandle] +set selection [ns_db select $db "select robot_name, robot_details_url from robots order by robot_name"] +while {[ns_db getrow $db $selection]} { + incr counter + set_variables_after_query + if ![empty_string_p $robot_details_url] { + ns_write "
    • $robot_name\n" + } else { + ns_write "
    • $robot_name\n" + } +} + +if {0 == $counter} { + ns_write "
    • no robots registered\n"; +} + +ns_write "

      +

    • refresh list from the Web Robots Database +
    + +[ad_admin_footer] +" + Index: web/openacs/www/admin/robot-detection/refresh-robot-list.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/robot-detection/refresh-robot-list.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/robot-detection/refresh-robot-list.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,15 @@ +# refresh-robot-list.tcl,v 3.0 2000/02/06 03:28:11 ron Exp +# +# refresh-robot-list.tcl +# +# Created by michael@yoon.org, 05/27/1999 +# + +set db [ns_db gethandle] + +if [catch { ad_replicate_web_robots_db $db } errmsg] { + ad_return_error "Database Error" $errmsg + return +} + +ns_returnredirect "index.tcl" Index: web/openacs/www/admin/searches/by-location.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/searches/by-location.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/searches/by-location.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,54 @@ +# by-location.tcl,v 3.0 2000/02/06 03:28:13 ron Exp +set_the_usual_form_variables + +# location (either a search engine name or a subsection) + +ReturnHeaders + +ns_write "[ad_admin_header "User searches in $location"] + +

    User searches in $location

    + +[ad_admin_context_bar [list "index.tcl" "User Searches"] "One Location"] + + +
    +
      " + + +set db [ns_db gethandle] + +set selection [ns_db select $db " +select query_date, query_string, +users.user_id, users.first_names, users.last_name, +case when subsection is null then search_engine_name else subsection end as location, +case when n_results is null then '' else ' - ' || n_results || ' results' end as n_results_string +from query_strings, users +where query_strings.user_id = users.user_id +and (subsection = '$QQlocation' or search_engine_name='$QQlocation') +union +select query_date, query_string, +null as user_id, null as first_names, null as last_name, +case when subsection is null then search_engine_name else subsection end as location, +case when n_results is null then '' else ' - ' || n_results || ' results' end as n_results_string +from query_strings +where not exists (select * from users + where query_strings.user_id = users.user_id) +and (subsection = '$QQlocation' or search_engine_name='$QQlocation') +order by lower(query_string) asc"] + +set items "" +while {[ns_db getrow $db $selection]} { + set_variables_after_query + append items "
    • $query_date: $query_string" + if ![empty_string_p $user_id] { + append items " $first_names $last_name " + } + append items $n_results_string +} + +ns_write $items + +ns_write "
    +[ad_admin_footer] +" Index: web/openacs/www/admin/searches/by-word-aggregate.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/searches/by-word-aggregate.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/searches/by-word-aggregate.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,39 @@ +# by-word-aggregate.tcl,v 3.0 2000/02/06 03:28:15 ron Exp +set_the_usual_form_variables 0 + +# minimum (optional) + +if { ![info exists minimum] || [empty_string_p $minimum] } { + set minimum 10 +} + +ReturnHeaders + +ns_write "[ad_admin_header "User Searches - word summary"] + +

    User Searches - word summary

    + +[ad_admin_context_bar [list "index.tcl" "User Searches"] "Summary by Word"] + +
    + +Query strings we've seen a minimum of $minimum times: + +
      +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select query_string, count(query_string) as num_searches from query_strings +group by query_string +having count(query_string) >= $minimum +order by count(query_string) desc"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
    • $query_string: $num_searches" +} + +ns_write "
    +[ad_admin_footer] +" Index: web/openacs/www/admin/searches/by-word.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/searches/by-word.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/searches/by-word.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,53 @@ +# by-word.tcl,v 3.0 2000/02/06 03:28:17 ron Exp +set_the_usual_form_variables + +# query_string + +ReturnHeaders + +ns_write "[ad_admin_header "Searches for the word $query_string"] + +

    Searches for the word $query_string

    + +[ad_admin_context_bar [list "index.tcl" "User Searches"] "One Query"] + +
    +
      " + +set db [ns_db gethandle] +set selection [ns_db select $db " +select query_date, query_string, +users.user_id, users.first_names, users.last_name, +case when subsection is null then search_engine_name else subsection end as location, +case when n_results is null then '' else ' - ' || n_results || ' results' end as n_results_string +from query_strings, users +where query_strings.user_id = users.user_id +and query_strings.query_string = '$QQquery_string' +union +select query_date, query_string, +null as user_id, null as first_names, null as last_name, +case when subsection is null then search_engine_name else subsection end as location, +case when n_results is null then '' else ' - ' || n_results || ' results' end as n_results_string +from query_strings +where not exists (select * from users + where query_strings.user_id = users.user_id) +and query_strings.query_string = '$QQquery_string' +order by query_date desc"] + +set items "" +while {[ns_db getrow $db $selection]} { + set_variables_after_query + append items "
    • $query_date: +$location +" + if ![empty_string_p $user_id] { + append items " $first_names $last_name " + } + append items $n_results_string +} + +ns_write $items + +ns_write "
    +[ad_admin_footer] +" Index: web/openacs/www/admin/searches/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/searches/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/searches/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,28 @@ +# index.tcl,v 3.0 2000/02/06 03:28:18 ron Exp +ReturnHeaders +ns_write "[ad_admin_header "User Searches"] + +

    User Searches

    + +[ad_admin_context_bar "User Searches"] + +
    + + + +

    Expensive Queries (may take a long time)

    + +[ad_admin_footer] +" Index: web/openacs/www/admin/searches/location-list.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/searches/location-list.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/searches/location-list.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,59 @@ +# location-list.tcl,v 3.0 2000/02/06 03:28:19 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "User Searches - locations"] + +

    User Searches - locations

    + +[ad_admin_context_bar [list "index.tcl" "User Searches"] "Distinct Locations"] + + +
    + +Search query strings come from two sources. First, we capture strings +entered on the site in local search engines, e.g., when a user +searches the classified ads or a bboard forum. Second, we are +sometimes able to harvest query strings from HTTP referer headers when +a user visits [ad_system_name] from a public Internet search engine (e.g., +AltaVista). + +

    [ad_system_name] subsections

    +
      +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select subsection +from query_strings +where subsection is not null +group by subsection +order by upper(subsection)"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
    • $subsection" +} + +ns_write "
    +

    Search engines

    +
      " + +set selection [ns_db select $db "select search_engine_name +from query_strings +where search_engine_name is not null +group by search_engine_name +order by upper(search_engine_name)"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
    • $search_engine_name" +} + +ns_write " +
    + +To add search engines, visit the URL lumping section of the +referer logging admin pages. + +[ad_admin_footer] +" Index: web/openacs/www/admin/searches/recent.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/searches/recent.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/searches/recent.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,56 @@ +# recent.tcl,v 3.0 2000/02/06 03:28:21 ron Exp +set_form_variables + +# num_days + +ReturnHeaders + +ns_write "[ad_admin_header "Searches in the last $num_days days"] + +

    Searches in the last $num_days days

    + +[ad_admin_context_bar [list "index.tcl" "User Searches"] "Last $num_days days"] + +
    +
      " + + +set db [ns_db gethandle] + +set selection [ns_db select $db " +select query_date, query_string, +users.user_id, users.first_names, users.last_name, +case when subsection is null then search_engine_name else subsection end as location, +case when n_results is null then '' else ' - ' || n_results || ' results' end as n_results_string +from query_strings, users +where query_strings.user_id = users.user_id +and sysdate()::date - query_date::date < $num_days +union +select query_date, query_string, +null as user_id, null as first_names, null as last_name, +case when subsection is null then search_engine_name else subsection end as location, +case when n_results is null then '' else ' - ' || n_results || ' results' end as n_results_string +from query_strings +where not exists (select * from users + where query_strings.user_id = users.user_id) +and sysdate()::date - query_date::date < $num_days +order by query_date desc"] + +set items "" +while {[ns_db getrow $db $selection]} { + set_variables_after_query + append items "
    • $query_date: +$query_string +($location) +" + if ![empty_string_p $user_id] { + append items " $first_names $last_name " + } + append items "$n_results_string\n" +} + +ns_write $items + +ns_write "
    +[ad_admin_footer] +" Index: web/openacs/www/admin/searches/results-none.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/searches/results-none.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/searches/results-none.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,53 @@ +# results-none.tcl,v 3.0 2000/02/06 03:28:23 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "User searches with 0 results"] + +

    User searches with 0 results

    + +[ad_admin_context_bar [list "index.tcl" "User Searches"] "Failures"] + +
    +
      +" + +set db [ns_db gethandle] + +set selection [ns_db select $db " +select query_date, query_string, +users.user_id, users.first_names, users.last_name, +case when subsection is null then search_engine_name else subsection end as location +from query_strings, users +where query_strings.user_id = users.user_id +and n_results = 0 +and subsection is not null +union +select query_date, query_string, +null as user_id, null as first_names, null as last_name, +case when subsection is null then search_engine_name else subsection end as location +from query_strings +where not exists (select * from users + where query_strings.user_id = users.user_id) +and n_results = 0 +and subsection is not null +order by lower(query_string) asc"] + +set items "" +while {[ns_db getrow $db $selection]} { + set_variables_after_query + append items "
    • $query_date: +$query_string +($location) +" + if ![empty_string_p $user_id] { + append items " $first_names $last_name " + } + append items "\n" +} + +ns_write $items + +ns_write "
    +[ad_admin_footer] +" + Index: web/openacs/www/admin/searches/word-list.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/searches/word-list.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/searches/word-list.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,52 @@ +# word-list.tcl,v 3.0 2000/02/06 03:28:25 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "User Searches - words"] + +

    User Searches - words

    + +recorded by the search tracking of [ad_system_name] administration + +
    + +

    Searched words

    +
      " + +set db [ns_db gethandle] + +set selection [ns_db select $db "select query_string +from query_strings +group by query_string +order by lower(query_string) asc"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
    • $query_string" +} + +ns_write "
    +[ad_admin_footer] +" + + + + + + + + + + + + + + + + + + + + + + + Index: web/openacs/www/admin/spam/bulkmail-mailer.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/spam/bulkmail-mailer.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/spam/bulkmail-mailer.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,18 @@ +# bulkmail-mailer.tcl,v 3.0 2000/02/06 03:29:58 ron Exp +# bulkmail-mailer.tcl +# +# hqm@arsdigita.com +# +# enable or disable the use of bulkmail module for sending of email from the spam system. +# +# If disabled, we revert to ns_sendmail (slower, and no bounce handling) +# + +# form vars: +# enable_p enable or disable outgoing user of bulkmail + +set_the_usual_form_variables + +spam_set_use_bulkmail_p $enable_p + +ns_returnredirect "index.tcl" \ No newline at end of file Index: web/openacs/www/admin/spam/cancel-spam.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/spam/cancel-spam.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/spam/cancel-spam.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,47 @@ +# cancel-spam.tcl,v 3.0 2000/02/06 03:30:00 ron Exp +# cancel-spam.tcl +# +# hqm@arsdigita.com +# +# Cancel a scheduled spam +set_the_usual_form_variables + +# spam_id + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select sh.from_address, sh.title, sh.body, sh.user_class_description, send_date, to_char(sh.creation_date,'YYYY-MM-DD HH24:MI:SS') as creation_time, sh.n_sent, users.user_id, users.first_names || ' ' || users.last_name as user_name, users.email, sh.status +from spam_history sh, users +where sh.creation_user = users.user_id +and sh.spam_id = $spam_id"] + +if { $selection == "" } { + ad_return_error "Couldn't find spam" "Could not find an old spam with an id of $spam_id" + return +} + +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "$title"] + +

    $title

    + +[ad_admin_context_bar [list "index.tcl" "Spamming"] "Old Spam"] + +
    +
    +" + +if {[string compare $status "unsent"] != 0} { +ns_write "This spam has already been sent or cancelled, you cannot cancel it." +} else { + ns_db dml $db "delete from spam_history where spam_id = $spam_id" + ns_write "Spam ID $spam_id, \"$title\", scheduled for $send_date has been cancelled." +} + +ns_write "
    +

    +[ad_admin_footer] +" Index: web/openacs/www/admin/spam/delete-newsletter-group.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/spam/delete-newsletter-group.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/spam/delete-newsletter-group.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,50 @@ +# delete-newsletter-group.tcl,v 1.1.4.1 2000/02/03 09:33:51 ron Exp +# delete-newsletter-group.tcl +# +# hqm@arsdigita.com +# +# Delete a user group of type newsletter + +set_the_usual_form_variables + +# form vars: +# gid group id to delete +# + +set db [ns_db gethandle] + +# let's double check it's a newsletter group + +set newsletter_p [database_to_tcl_string $db "select count(group_id) +from user_groups where lower(group_type) = 'newsletter' +and group_id = $gid"] + +if {$newsletter_p == 0} { + ad_return_complaint 1 "Group id $gid is not a newsletter group type, you may not delete it." + return +} + +with_transaction $db { + set group_name [database_to_tcl_string $db "select group_name from user_groups where group_id = $gid"] + + # get the user class associated with this group + set class_id [database_to_tcl_string $db "select user_class_id from user_classes where lower(sql_description) = 'members of [DourbleApos $group_name] group'"] + + # delete references to user class from the spam_history table (constraint violation otherwise) + ns_db dml $db "delete from spam_history where user_class_id = $class_id" + + # remove the user class associated with this group + ns_db dml $db "delete from user_classes where group_id = $gid" + + # remove the group aux table info for the group + ns_db dml $db "delete from newsletter_info where group_id = $gid" + + # remove the group itself + ns_db dml $db "delete from user_groups where group_id = $gid" +} { + ad_return_error "Error deleting group" $errmsg + return +} + +set msg "Group $group_name deleted" +ns_returnredirect "view-modify-newsletters.tcl?[export_url_vars msg]" \ No newline at end of file Index: web/openacs/www/admin/spam/delete-spam-file-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/spam/delete-spam-file-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/spam/delete-spam-file-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,23 @@ +# delete-spam-file-2.tcl,v 3.2 2000/03/08 07:40:17 hqm Exp +# delete-spam-file-2.tcl +# +# hqm@arsdigita.com +# +# confirmed delete of a file from dropzone + +set_the_usual_form_variables +# form vars: +# filename + +set clean_filename [spam_sanitize_filename $filename] +set path [spam_file_location $clean_filename] + +# copy the tmp file to the drop zone +if {[catch {ns_unlink $path} errmsg]} { + ReturnHeaders + ns_write "error deleting file using ns_unlink $path: $errmsg" +} else { + ns_returnredirect "show-daily-spam.tcl" +} + + Index: web/openacs/www/admin/spam/delete-spam-file.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/spam/delete-spam-file.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/spam/delete-spam-file.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,36 @@ +# delete-spam-file.tcl,v 3.2 2000/03/08 07:39:58 hqm Exp +# delete-spam-file.tcl +# +# hqm@arsdigita.com +# +# confirm delete of a file from dropzone + +set_the_usual_form_variables +# form vars: +# filename + +ReturnHeaders + +set clean_filename [spam_sanitize_filename $filename] +set path [spam_file_location $clean_filename] + +append pagebody "[ad_admin_header "Confirm Delete Spam File $clean_filename"] + +[ad_admin_context_bar [list "index.tcl" "Spam"] "Delete Spam File"] + +

    +

    +Do you really want to delete spam file: $clean_filename? +

    + + +[export_form_vars filename] +

    +
    + + +

    +[ad_admin_footer]" + +ns_write $pagebody + Index: web/openacs/www/admin/spam/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/spam/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/spam/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,123 @@ +# index.tcl,v 3.2.2.2 2000/03/15 06:23:46 hqm Exp +# index.tcl +# +# hqm@arsdigita.com +# +# View/schedule spams + +set_the_usual_form_variables 0 + +#maybe +ReturnHeaders + +append pagebody "[ad_admin_header "Spamming"] + +

    Spamming

    + +[ad_admin_context_bar "Spamming"] + +
    +

    +" + +set calendar_details [ns_set create calendar_details] + +set db [ns_db gethandle] + +if {![info exists date] || [empty_string_p $date]} { + set date [database_to_tcl_string $db "select sysdate from dual"] +} + +append pagebody "

    +

    The time is now [database_to_tcl_string $db "select to_char(sysdate,'MM-DD-YYYY HH24:MI:SS') from dual"]

    +
    +" + + +# get all the spams for this month +# this query goes a little beyond for simplicity + +set selection [ns_db select $db "select sh.spam_id, sh.title, sh.status, substr(sh.body_plain,0,100) as beginning_of_body, sh.user_class_description, sh.send_date, send_date as julian_date, users.user_id, users.first_names || ' ' || users.last_name as user_name, users.email +from spam_history sh, users +where sh.creation_user = users.user_id +and send_date::date > ('$date'::date - timespan_days(31))::date +and send_date::date < ('$date'::date + timespan_days(31))::date +order by send_date desc"] + +set count 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + incr count + ns_set put $calendar_details $julian_date "$title($status) - $beginning_of_body
    " +} + +set next_month_template "(next)" +set prev_month_template "(prev)" + +append pagebody "[calendar_basic_month -calendar_details $calendar_details -next_month_template $next_month_template -prev_month_template $prev_month_template -date $date] + + + +

    + +" + +append pagebody " +

    +

    Debugging Switches

    +
      +" + +set email_enabled_p [spam_email_sending_p] + +if {$email_enabled_p == 1} { + append pagebody "
    • Spam email sending is enabled. Click here to disable" +} else { + append pagebody "
    • Spam email sending is disabled. Click here to enable" +} + +set daemon_enabled_p [spam_daemon_active_p] + +if {$daemon_enabled_p == 1} { + append pagebody "
    • Dropzone scanner daemon is enabled. Click here to disable" +} else { + append pagebody "
    • Dropzone scanner daemon is disabled. Click here to enable" +} + +set bulkmail_enabled_p [spam_use_bulkmail_p] + +if {$bulkmail_enabled_p == 1} { + append pagebody "
    • Sending spam using bulkmail module is enabled. Click here to switch to use ns_sendmail" +} else { + append pagebody "
    • Sending spam using ns_sendmail is enabled. Click here to switch to use bulkmail module" +} + +append pagebody "

    • Force spam daemon to run queue now" + +append pagebody "

    • Monitor bulkmail threads" + +append pagebody " +
    + +Documentation for the spam system is available here. +

    +How to suspend and resume a mailing +

    + +[ad_admin_footer] +" + +ns_write $pagebody Index: web/openacs/www/admin/spam/modify-daily-spam.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/spam/modify-daily-spam.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/spam/modify-daily-spam.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,35 @@ +# modify-daily-spam.tcl,v 3.0 2000/02/06 03:30:05 ron Exp +# modify-daily-spam.tcl +# +# hqm@arsdigita.com +# +# Modify daily spam table + +set_the_usual_form_variables + +set iter 0 + +set db [ns_db gethandle] + +with_transaction $db { + ns_db dml $db "delete from daily_spam_files" + + while {[info exists user_class_id_$iter]} { + if {[empty_string_p [set file_prefix_$iter]] || [empty_string_p [set subject_$iter]]} { + # ignore entries with null strings + } else { + set user_class_name [database_to_tcl_string $db "select name from user_classes where user_class_id = [set user_class_id_$iter]"] + if {![info exists template_p_$iter]} { + set template_p_$iter "f" + } + ns_db dml $db "insert into daily_spam_files (from_address, target_user_class_id, user_class_description, subject, file_prefix, template_p) +values ([ns_dbquotevalue [set from_address_$iter]], [set user_class_id_$iter], [ns_dbquotevalue $user_class_name], [ns_dbquotevalue [set subject_$iter]],[ns_dbquotevalue [set file_prefix_$iter]],[ns_dbquotevalue [set template_p_$iter]])" + } + incr iter + } +} { + ns_returnerror 500 "Error in updating daily_spam_files table: $errmsg" + return +} + +ns_returnredirect "show-daily-spam.tcl" \ No newline at end of file Index: web/openacs/www/admin/spam/old.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/spam/old.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/spam/old.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,113 @@ +# old.tcl,v 3.1.2.2 2000/04/04 15:09:12 carsten Exp +# old.tcl +# +# hqm@arsdigita.com +# +# Show details of a spam from the database + +set_the_usual_form_variables + +# spam_id + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select to_char(sh.begin_send_time,'YYYY-MM-DD HH24:MI:SS') as begin_send_time,to_char(sh.finish_send_time,'YYYY-MM-DD HH24:MI:SS') as finish_time, sh.from_address, sh.title, sh.body_plain, sh.body_html, sh.body_aol, sh.user_class_description, to_char(sh.send_date,'YYYY-MM-DD HH24:MI:SS') as send_date, to_char(sh.creation_date,'YYYY-MM-DD HH24:MI:SS') as creation_time, sh.n_sent, users.user_id, users.first_names || ' ' || users.last_name as user_name, users.email, sh.status, sh.last_user_id_sent, to_char(sysdate-sh.begin_send_time) as nmins_running, to_char(sh.finish_send_time-sh.begin_send_time) as nmins_completed, sh.finish_send_time +from spam_history sh, users +where sh.creation_user = users.user_id +and sh.spam_id = $spam_id"] + +if { $selection == "" } { + ad_return_error "Couldn't find spam" "Could not find an old spam with an id of $spam_id" + return +} + +set_variables_after_query + +if {[string compare $status "unsent"] == 0} { +set cancel_spam_option "

    +" +} else { + set cancel_spam_option "" +} + +if { $nmins_running == 0 || [empty_string_p $nmins_running] || + $nmins_completed == 0 || [empty_string_p $nmins_completed] } { + set n_per_min 0 +} else { + if {![empty_string_p $finish_send_time]} { + set n_per_min [expr $n_sent / ( $nmins_completed * 24 * 60)] + } else { + set n_per_min [expr $n_sent / ( $nmins_running * 24 * 60)] + } +} + + +ReturnHeaders + +ns_write "[ad_admin_header "$title"] + +

    $title

    + +[ad_admin_context_bar [list "index.tcl" "Spamming"] "Old Spam"] + +
    + +
      +
    • requested send date: $send_date +
    • actual send start time: $begin_send_time +
    • finish time: $finish_time +
    • the time now is [database_to_tcl_string $db "select to_char(sysdate,'YYYY-MM-DD HH24:MI:SS') from dual"] +
    • status: $status +
    • number sent: $n_sent ($n_per_min msgs/min) +
    • class: users who $user_class_description +
    • last_user_id_sent: $last_user_id_sent +
    • send from: \"$from_address\" (admin logged in was $user_name ($email)) + +
    • subject: $title +
    +Set status manually to sent + || sending + || interrupted +|| unsent +

    + + + + + + + +" +if {[info exists body_html] && ![empty_string_p $body_html]} { + ns_write " + +" +} + +if {[info exists body_aol] && ![empty_string_p $body_aol]} { + ns_write " + +" +} + + +ns_write " +
    Plain Text Message: +
    [ns_quotehtml $body_plain]
    +
    HTML Message: +$body_html +
    AOL Message: +$body_aol +
    + + + + + +$cancel_spam_option +

    +[ad_admin_footer] +" Index: web/openacs/www/admin/spam/run-spam-daemon.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/spam/run-spam-daemon.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/spam/run-spam-daemon.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,38 @@ +# run-spam-daemon.tcl,v 3.0 2000/02/06 03:30:08 ron Exp +# run-spam-daemon.tcl +# +# hqm@arsdigita.com +# +# manually invoke the spam daemon (it is normally scheduled to run once an hour) +# + +ReturnHeaders + + +ns_write "[ad_admin_header "Invoke Spam Daemon Manually "] + +

    Invoking spam daemon manually

    + +[ad_admin_context_bar [list "index.tcl" "Spam"] "Manually Run Spam Daemon"] + + +
    +

    + +" + + +ns_write "Invoking send_scheduled_spam_messages interactively. +

    This may run for a long time if one or more large jobs are queued... +

    +

    "
+
+send_scheduled_spam_messages
+
+ns_write "
    +Done. +

    +Return to spam admin index page +[ad_admin_footer] + +" \ No newline at end of file Index: web/openacs/www/admin/spam/send-spam-now.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/spam/send-spam-now.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/spam/send-spam-now.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,6 @@ +# send-spam-now.tcl,v 3.0 2000/02/06 03:30:09 ron Exp + +ReturnHeaders +ns_write "running spam queue" +send_scheduled_spam_messages +ns_write "

    done" Index: web/openacs/www/admin/spam/set-daemon-state.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/spam/set-daemon-state.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/spam/set-daemon-state.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,15 @@ +# set-daemon-state.tcl +# +# hqm@arsdigita.com +# +# enable or disable the dropzone scanner daemon +# + +# form vars: +# enable_p enable or disable outgoing email + +set_the_usual_form_variables + +spam_set_daemon_active $enable_p + +ns_returnredirect "index.tcl" \ No newline at end of file Index: web/openacs/www/admin/spam/set-spam-sending.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/spam/set-spam-sending.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/spam/set-spam-sending.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,17 @@ +# set-spam-sending.tcl,v 3.1 2000/03/07 11:23:18 hqm Exp +# set-spam-sending.tcl +# +# hqm@arsdigita.com +# +# enable or disable the actual sending of email from the spam system. +# This is a way to halt the sending of any more email, if you need to. +# + +# form vars: +# enable_p enable or disable outgoing email + +set_the_usual_form_variables + +spam_set_email_sending $enable_p + +ns_returnredirect "index.tcl" \ No newline at end of file Index: web/openacs/www/admin/spam/set-spam-status.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/spam/set-spam-status.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/spam/set-spam-status.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,14 @@ +# set-spam-status.tcl +# +# hqm@arsdigita.com +# +# force spam into a specific state + +set_the_usual_form_variables + +# spam_id,status + +set db [ns_db gethandle] +ns_db dml $db "update spam_history set status = '$status' where spam_id = $spam_id" + +ns_returnredirect "old.tcl?spam_id=$spam_id" Index: web/openacs/www/admin/spam/show-daily-spam.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/spam/show-daily-spam.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/spam/show-daily-spam.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,141 @@ +# show-daily-spam.tcl,v 3.4 2000/03/08 07:38:40 hqm Exp +# show-daily-spam.tcl +# +# hqm@arsdigita.com +# +# Show list of daily spam file locations + +ReturnHeaders + +append pagebody "[ad_admin_header "List Daily Spam Files"] + +

    Daily Spam File Locations

    + +[ad_admin_context_bar [list "index.tcl" "Spam"] "List Daily Spam Files"] + +
    +

    +Spam files to look for in drop-zone directory \"[spam_file_location ""]\". +

    +To delete an entry, just enter an empty string for the filename and subject, and press the Modify button. +

    +'From address' is optional; if left blank, the default spam system from-address will be used. + +

    +Documentation for the spam system is available here. +

    + +" + +set db_conns [ns_db gethandle [philg_server_default_pool] 2] +set db [lindex $db_conns 0] +set db_sub [lindex $db_conns 1] + +set entries_header " +User Class +Subject +Filename +From address +Frequency +Template? + + +" + +set entries "" + +set selection [ns_db select $db "select * from daily_spam_files"] + +set iter 0 + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append entries " + + + + +" + + +if {! [info exists frequency_$iter] } { + set frequency_$iter "weekly" +} + +append entries "" + + +append entries "" +if {[string match $template_p "t"]} { + append entries "" +} else { + append entries "" +} +append entries "" + + +append entries " + +" + incr iter +} + +append pagebody " +

    +" + +if {![empty_string_p $entries]} { + append pagebody "$entries_header + $entries" +} + +append pagebody " + +$entries_header + + + + + + +
    Add new daily spam
    + + +
    + + +
    +" + +append pagebody "

    Contents of the dropzone directory [spam_file_location ""]

    " + +set file_items "" +# list the contents of the dropzone directory +# it would be nice to sort on the reverse of the filenames +set files [lsort -ascii [glob -nocomplain [spam_file_location "*"]]] +foreach path $files { + set file [file tail $path] + append file_items "$filedelete" +} + +if {[empty_string_p $file_items]} { + append pagebody "no files in drop zone
    " +} else { + append pagebody "$file_items
    " +} + + + +append pagebody " +

    +[ad_admin_footer]" + +ns_write $pagebody Index: web/openacs/www/admin/spam/spam-add-from-file-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/spam/spam-add-from-file-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/spam/spam-add-from-file-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,117 @@ +# spam-add-from-file-2.tcl,v 3.0 2000/02/06 03:30:15 ron Exp +# spam-add-from-file.tcl +# +# hqm@arsdigita.com +# +# Compose a spam to be scheduled to be sent to a user class + +set_the_usual_form_variables 0 + +#maybe html_p +# path_plain, path_html, path_aol + +set path_plain [spam_file_location $path_plain] +set path_html [spam_file_location $path_html] +set path_aol [spam_file_location $path_aol] + +if {[info exists template_p] && [string match $template_p "t"]} { + set template_pretty "Yes" +} else { + set template_p "f" + set template_pretty "No" +} + + +ReturnHeaders + +append pagebody "[ad_admin_header "Send spam from file(s)"] + +

    Spam

    + +[ad_admin_context_bar [list "index.tcl" "Spam"] "Send spam from file(s)"] + +
    +

    +" + +set db [ns_db gethandle] + +# generate unique key here so we can handle the "user hit submit twice" case +set spam_id [database_to_tcl_string $db "select spam_id_sequence.nextval from dual"] + + +append pagebody " + +

    + + + +[export_form_vars template_p] +" + +append pagebody " +Plain Text File: $path_plain" + +if { ![file readable $path_plain] || ![file isfile $path_plain] } { + append pagebody " File not found or not readable!" +} + + +append pagebody "
    +HTML Source File: $path_html" + +if { ![file readable $path_html] || ![file isfile $path_html]} { + append pagebody " File not found or not readable!" +} + +append pagebody "
    +AOL Source File: $path_aol +" + +if { ![file readable $path_aol] || ![file isfile $path_aol] } { + append pagebody " File not found or not readable!" +} + + + +append pagebody " + + + + + + + + + + + + + + + +" + + +append pagebody " +
    User Class:
    Scheduled Send Date:[_ns_dateentrywidget "send_date"]
    Scheduled Send Time: [_ns_timeentrywidget "send_date"]
    Template?$template_pretty
    From:
    Subject:
    + + + + +
    Message (plain text): +
    [ns_quotehtml [read_file_as_string $path_plain]]
    +
    Message (html): +[read_file_as_string $path_html] +
    Message (AOL): +[read_file_as_string $path_aol] +
    + +

    + +[ad_admin_footer]" + + +ns_write $pagebody \ No newline at end of file Index: web/openacs/www/admin/spam/spam-add-from-file.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/spam/spam-add-from-file.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/spam/spam-add-from-file.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,86 @@ +# spam-add-from-file.tcl,v 3.0 2000/02/06 03:30:16 ron Exp +# spam-add-from-file.tcl +# +# hqm@arsdigita.com +# +# Compose a spam to be scheduled to be sent to a user class + +set_the_usual_form_variables 0 + +#maybe html_p + +ReturnHeaders + +append pagebody "[ad_admin_header "Send spam from file(s)"] + +

    Spam

    + +[ad_admin_context_bar [list "index.tcl" "Spam"] "Send spam from file(s)"] + +
    +

    +" + +set db [ns_db gethandle] + + +set userclass_options [db_html_select_value_options $db "select user_class_id, name from user_classes order by name"] + + +if {[empty_string_p $userclass_options]} { + ns_write "$pagebody +Sorry, there are no user-classes defined yet, and you need to specify a user-class as the target of a spam. You can define user-classes from the /admin/users menu. +

    + [ad_admin_footer]" + return +} + + + +# generate unique key here so we can handle the "user hit submit twice" case +set spam_id [database_to_tcl_string $db "select spam_id_sequence.nextval from dual"] + + + +append pagebody " + +

    + + + + + + + + + + + + + + + + + + + + + + +
    User Class:
    Scheduled Send Date:[_ns_dateentrywidget "send_date"]
    Scheduled Send Time: [_ns_timeentrywidget "send_date"]
    From:
    Subject:
    Enter file names in directory [spam_file_location ""]
    +example: welcome-new-user.txt
    Filename (plain text mesg):
    Filename (HTML msg):
    Filename (AOL msg):
    Is this message a Tcl Template?
    + + + + + +
    + +

    + +[ad_admin_footer]" + + +ns_write $pagebody \ No newline at end of file Index: web/openacs/www/admin/spam/spam-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/spam/spam-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/spam/spam-add.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,90 @@ +# spam-add.tcl,v 3.3 2000/03/09 10:25:09 hqm Exp +# spam-add.tcl +# +# hqm@arsdigita.com +# +# Compose a spam to be scheduled to be sent to a user class + +set_the_usual_form_variables 0 + +#maybe html_p + +ReturnHeaders + +ns_write "[ad_admin_header "Add a spam"] + +

    Spam

    + +[ad_admin_context_bar [list "index.tcl" "Spam"] "Add a spam"] + +
    +

    +" + +set db [ns_db gethandle] + +# generate unique key here so we can handle the "user hit submit twice" case +set spam_id [database_to_tcl_string $db "select spam_id_sequence.nextval from dual"] + +set userclass_options [db_html_select_value_options $db "select user_class_id, name from user_classes order by name"] + +if {[empty_string_p $userclass_options]} { + ns_write "Sorry, there are no user-classes defined yet, and you need to specify a user-class as the target of a spam. You can define user-classes from the /admin/users menu. +

    + [ad_admin_footer]" + return +} + + +ns_write " + +

    + + + + + + + + + + + + + +" + + +if {[info exists html_p] && [string compare $html_p "t"] == 0} { + ns_write " +" +} + +ns_write " + + + + +
    User Class
    Scheduled Send Date:[_ns_dateentrywidget "send_date"]
    Scheduled Send Time: [_ns_timeentrywidget "send_date"]
    From:
    Subject:
    Message (plain text): + +
    Message (html): + +
    Message (AOL): + +
    Is this message a Tcl Template?
    If so, make sure you have put backslashes before any \$ or \[\]'s characters if you don't want them to be evaluated as Tcl commands.
    + +

    +

    + + + +
    + +
    +

    + +[ad_admin_footer]" + + Index: web/openacs/www/admin/spam/spam-confirm.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/spam/spam-confirm.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/spam/spam-confirm.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,168 @@ +# spam-confirm.tcl,v 3.4.2.1 2000/03/30 15:26:26 carsten Exp +# spam-confirm.tcl +# +# hqm@arsdigita.com +# +# A good thing to do before sending out 100,000 emails: +# ask user to confirm the outgoing spam before queuing it. +# + +set_the_usual_form_variables + +# spam_id, from_address, subject, +# message, (optional) message_html, message_aol +# maybe send_date +# +# if from_file_p=t, then get message texts from default filesystem location +# +# +# maybe: users_sql_query The SQL needed to get the list of target users +# users_description English descritpion of target users +# or else user_class_id, which can be passed to ad_user_class_query to generate a SQL query. +# +# maybe: template_p If == 't', then run subst on the message subject and body. A scary +# prospect, but spam can only be created by site admins anyhow) + +set db [ns_db gethandle] + +set admin_user_id [ad_verify_and_get_user_id] +ad_maybe_redirect_for_registration + +if {[info exists from_file_p] && [string compare $from_file_p "t"] == 0} { + set message [get_spam_from_filesystem "plain"] + set message_html [get_spam_from_filesystem "html"] + set message_aol [get_spam_from_filesystem "aol"] +} + +set exception_count 0 +set exception_text "" + +if {[catch {ns_dbformvalue [ns_conn form] send_date datetime send_date} errmsg]} { + incr exception_count + append exception_text "

  • Please make sure your date is valid." +} + + +# Generate the SQL query from the user_class_id, if supplied +if {[info exists user_class_id] && ![empty_string_p $user_class_id]} { + set users_sql_query [ad_user_class_query [ns_getform]] + regsub {from users} $users_sql_query {from users_spammable users} users_sql_query + + set class_name [database_to_tcl_string $db "select name from user_classes where user_class_id = $user_class_id "] + + set sql_description [database_to_tcl_string $db "select sql_description from user_classes where user_class_id = $user_class_id "] + set users_description "$class_name: $sql_description" +} + +if { ![philg_email_valid_p $from_address] } { + incr exception_count + append exception_text "
  • The From address is invalid." +} + + +if {$exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +ns_dbformvalue [ns_conn form] send_date datetime send_date + +if {[info exists template_p] && [string match $template_p "t"]} { + set template_pretty "Yes" +} else { + set template_p "f" + set template_pretty "No" +} + +ReturnHeaders + +append pagebody "[ad_admin_header "Confirm sending spam"] + +[ad_admin_context_bar [list "index.tcl" "Spam"] "confirm sending a spam"] + +
    + +

    Confirm Sending Spam

    + +The following spam will be queued for delivery: + + +

    +" + + + +# strips ctrl-m's, makes linebreaks at >= 80 cols when possible, without +# destroying urls or other long strings +set message [spam_wrap_text $message 80] + +append pagebody " + +

    + +
    + + + + + + + + + + + +" +if {[info exists message_html] && ![empty_string_p $message_html]} { + append pagebody " + +" +} + +if {[info exists message_aol] && ![empty_string_p $message_aol]} { + append pagebody " + +" +} + + +append pagebody " +
    User Class: $users_description +
    Date: $send_date
    From:$from_address
    Template?$template_pretty
    Subject:$subject
    Plain Text Message: +
    [ns_quotehtml $message]
    +
    HTML Message: +$message_html +
    AOL Message: +$message_aol +
    + +
    +
    + + +
    + +[export_form_vars users_sql_query users_description spam_id from_address subject message message_html message_aol send_date template_p] +
    +

    + +The SQL query will be +

    $users_sql_query
    +" + +# MAC: Apparently Postgres doesn't accept this type of construct, though +# amazingly enough Solid does. Go figure. So, since we are interested +# in the number of rows, not any of the individual columns, we'll just +# do a select count(*) and pick up the rest of the SQL beginning with the +# from clause in users_sql_query + +#set count_users_query "select count(*) from ($users_sql_query)" +set count_users_query "select count(*) [string range $users_sql_query [string first "from users" [string tolower $users_sql_query]] end]" +set total_users [database_to_tcl_string $db $count_users_query] + +append pagebody " +and will send email to $total_users users. +[ad_admin_footer]" + + +ns_write $pagebody Index: web/openacs/www/admin/spam/spam.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/spam/spam.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/spam/spam.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,153 @@ +# spam.tcl,v 3.2 2000/03/08 08:56:44 hqm Exp +# spam.tcl +# +# hqm@arsdigita.com +# +# Queues an outgoing spam message to a group of users, +# by adding it to the spam_history table + +set_the_usual_form_variables + +ns_log Notice "spam.tcl: entering page" + +# spam_id, from_address, subject, +# message (optionally message_html, message_aol) +# maybe send_date +# from_file_p +# template_p +# +# users_sql_query The SQL needed to get the list of target users +# users_description English descritpion of target users + +set admin_user_id [ad_verify_and_get_user_id] +ad_maybe_redirect_for_registration + +# Strip all ^M's out of any itneractively entered text message. +# This is because Windows browsers insist on inserting CRLF at +# the end of each line of a TEXTAREA. +if {[info exists message]} { + regsub -all "\r" $message "" message_stripped +} + +if {[info exists from_file_p] && [string compare $from_file_p "t"] == 0} { + set message [get_spam_from_filesystem "plain"] + set message_html [get_spam_from_filesystem "html"] + set message_aol [get_spam_from_filesystem "aol"] +} + +if {[info exists template_p] && [string match $template_p "t"]} { +} else { + set template_p "f" +} + +if {![info exists send_date]} { + set send_date "" +} + +if {![info exists message_html]} { + set message_html "" +} + +if {![info exists message_aol]} { + set message_aol "" +} + +set exception_count 0 +set exception_text "" + +if {[empty_string_p $subject] && [empty_string_p $message_stripped] && [empty_string_p $message_html] && [empty_string_p $message_aol]} { + incr exception_count + append exception_text "
  • The contents of your message and subject line is the empty string. You must send something in the message body" +} + + +if {$exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +set db [ns_db gethandle] + +if [catch { ns_db dml $db "insert into spam_history +(spam_id, template_p, from_address, title, body_plain, body_html, body_aol, user_class_description, user_class_query, send_date, creation_date, creation_user, creation_ip_address, status) +values +($spam_id, '$template_p', '$QQfrom_address', '$QQsubject', '[DoubleApos $message_stripped]', '[DoubleApos $message_html]', '[DoubleApos $message_aol]', '[DoubleApos $users_description]', [ns_dbquotevalue $users_sql_query], coalesce(to_date('$send_date', 'YYYY-MM-DD HH24:MI:SS'), sysdate()), sysdate(), $admin_user_id, '[DoubleApos [ns_conn peeraddr]]', 'unsent')" } errmsg] { + + # choked; let's see if it is because + if { [database_to_tcl_string $db "select count(*) from spam_history where spam_id = $spam_id"] > 0 } { + ns_return 200 text/html "[ad_admin_header "Double Click?"] + +

    Double Click?

    + +
    + +This spam has already been sent. Perhaps you double clicked? In any +case, you can check the progress of this spam on +the history page. + +[ad_admin_footer]" + } else { + ad_return_error "Ouch!" "The database choked on your insert: +
    +$errmsg +
    +" + } + return +} + + +ReturnHeaders + +append pagebody "[ad_admin_header "Spamming users who $users_description"] + +

    Spamming Users

    + +[ad_admin_context_bar [list "index.tcl" "Spamming"] "Spam Execution"] + +
    + +Class description: users who $users_description. + +

    + +Query to be used: + +

    +$users_sql_query
+
    + +

    + +Message to be sent: + +

      +
    • from: $from_address +
    • subject: $subject +
    • send on: $send_date +
    • body: 
      $message_stripped
      + +
    + +" + + +append pagebody " + + +Queued for delivery by the spam sending daemon. +

    + +[ad_admin_footer] +" +ns_write $pagebody + +ns_conn close +ns_db releasehandle $db + + +ns_log Notice "spam.tcl: calling spam queue sweeper $spam_id now from interactive spam.tcl page" +send_scheduled_spam_messages +ns_log Notice "spam.tcl: spam $spam_id sent" + + Index: web/openacs/www/admin/spam/stop-spam.html =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/spam/stop-spam.html,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/spam/stop-spam.html 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,21 @@ +Stopping and starting a mailing +

    Stopping and starting a mailing

    + +To stop the mail going out, click on the "disable spam email sending" link on the +Spam Admin homepage. + +

    + +To make sure a mailing doesn't get restarted when the server restarts, +set it to the "sent" state, by clicking on the mailing in the +calendar, and selecting the state manually on its web page. +

    +To restart a mailing: +

      +
    • Set the message to the "interrupted" state manually +
    • Re-enable the email sending, from the spam admin page +
    • The spam daemon will resume within twenty minutes or so, or you +can force the spam daemon to run the queue by clicking on the "force daemon to run the queue" link on the admin page. +
    + + Index: web/openacs/www/admin/spam/upload-file-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/spam/upload-file-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/spam/upload-file-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,63 @@ +# File: /admin/spam/upload-file-2.tcl +# Date: 02/06/2000 +# Contact: hqm@ai.mit.edu +# Purpose: +# +# Upload a message file to the spam drop zone + +ad_page_variables { + {path ""} + clientfile +} + +# clientfile as a multipart file upload +# path as target filename (may be blank, in which case we should use clientfile) + +set db [ns_db gethandle] + +set exception_count 0 +set exception_text "" + +# let's first check to see if this user is authorized to attach +set user_id [ad_verify_and_get_user_id] +ad_maybe_redirect_for_registration + +if { ![info exists clientfile] || [empty_string_p $clientfile] } { + append exception_text "
  • Please specify a file to upload\n" + incr exception_count +} else { + # this stuff only makes sense to do if we know the file exists + set tmp_filename [ns_queryget clientfile.tmpfile] + + if {[empty_string_p $path]} { + set path $clientfile + } + + # strip off the any slashes, backslashes, semis, or sequences of more than one '.' + set path_clean [spam_sanitize_filename $path] + + set absolute_path [spam_file_location $path_clean] + + + set n_bytes [file size $tmp_filename] + + if { $n_bytes == 0 } { + append exception_text "
  • Your file is zero-length. Either you attempted to upload a zero length file, a file which does not exist, or something went wrong during the transfer.\n" + incr exception_count + } +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +# copy the tmp file to the drop zone +if {[catch {ns_cp $tmp_filename $absolute_path} errmsg]} { + ReturnHeaders + ns_write "error copying file using ns_cp $tmp_filename $absolute_path: $errmsg" +} else { + ns_returnredirect "show-daily-spam.tcl" +} + + Index: web/openacs/www/admin/spam/upload-file.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/spam/upload-file.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/spam/upload-file.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,57 @@ +# File: /admin/spam/upload-file.tcl +# Date: 02/06/2000 +# Contact: hqm@ai.mit.edu +# Purpose: +# +# Upload a message file to the spam drop zone + +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +# assign necessary data for insert +set user_id [ad_verify_and_get_user_id] +ad_maybe_redirect_for_registration + +set originating_ip [ns_conn peeraddr] + +set db [ns_db gethandle] + +ReturnHeaders + +append pagebody "[ad_admin_header "Upload Spam Message File to Drop Zone"] + +

    Upload Spam File to Drop Zone

    + +[ad_admin_context_bar [list "index.tcl" "Spam"] "Upload Spam File to Drop Zone"] + +
    + + + + +
    +
    +Upload a notification (spam) file to the drop zone at +[spam_file_location ""].

    + You may leave \"remote file\" blank below to +give the file the same name as it has on your local machine. +

    + + + + +
    Local file: +
    +Use the \"Browse...\" button to locate your file, then click \"Open\".
    To remote file (in dropzone):
    +

    + + +
    +[ad_footer] +" + +ns_write $pagebody + + Index: web/openacs/www/admin/spam/view-modify-newsletters.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/spam/view-modify-newsletters.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/spam/view-modify-newsletters.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,80 @@ +# view-modify-newsletters.tcl,v 1.1.4.1 2000/02/03 09:34:07 ron Exp +# view-modify-newsletters.tcl +# +# hqm@arsdigita.com +# +# List all newsletter groups, sorted by category, and offer button to +# delete them (the ACS user-groups admin page has no options to delete a group). + +ReturnHeaders + +append pagebody "[ad_admin_header "List Newsletter Groups"] + +

    List Newsletter Groups

    + +[ad_admin_context_bar [list "index.tcl" "Spam"] "List Newsletter Groups"] + +
    +

    +Below is a list of all groups of type Newsletter, sorted by category. +

    + +" + +set db_conns [ns_db gethandle [philg_server_default_pool] 1] +set db [lindex $db_conns 0] + +append pagebody " + + + + + + + + +" + +set selection [ns_db select $db "select newsletter_info.*, user_groups.*, +(select count(user_id) from user_group_map where user_group_map.group_id = user_groups.group_id) as nmembers + from user_groups, newsletter_info + where lower(group_type) = 'newsletter' +and newsletter_info.group_id = user_groups.group_id"] + +set iter 0 + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if {($iter % 2) == 0} { + set bgcolor "bgcolor=\#ECECEC" + } else { + set bgcolor "" + } + + append pagebody " + + + + + + + + + +" + incr iter +} + +append pagebody " +
    CategoryGroup Name# MembersShort DescriptionLong DescriptionModifyDelete
    $category$group_name$nmembers$short_description$long_descriptioneditdelete
    +" + + +append pagebody " +

    +

    +[ad_admin_footer]" + +ns_write $pagebody \ No newline at end of file Index: web/openacs/www/admin/spam/view-spam-file.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/spam/view-spam-file.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/spam/view-spam-file.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,58 @@ +# view-spam-file.tcl +# +# hqm@arsdigita.com +# +# view a file in the dropzone + +set_the_usual_form_variables +# form vars: +# filename + +ReturnHeaders + +set clean_filename [spam_sanitize_filename $filename] +set path [spam_file_location $clean_filename] + +append pagebody "[ad_admin_header "View Drop Zone Spam File $clean_filename"] + +

    View Drop Zone Spam File: $clean_filename

    + +[ad_admin_context_bar [list "index.tcl" "Spam"] "View Drop Zone File"] + +
    +

    +View spam file $path +

    +Delete? +

    +" + + +append pagebody " +Raw Text From File: $path" + +if { ![file readable $path] || ![file isfile $path] } { + append pagebody " File not found or not readable!" +} else { + set fd [open $path] + set content [read $fd] + close $fd + set quoted_content [ns_quotehtml $content] + append pagebody "

    \n$quoted_content\n
    " +} + + +append pagebody "
    " + +if {[string match "*-html*" $path] || [string match "*-aol*" $path]} { + append pagebody "

    How it appears in HTML

    " + append pagebody $content +} + + +append pagebody " +
    +

    +[ad_admin_footer]" + +ns_write $pagebody Index: web/openacs/www/admin/static/example.html =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/example.html,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/static/example.html 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,183 @@ + + + + + + + +Collapsable Lists: Clear Example + + +

    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +
    + + Index: web/openacs/www/admin/static/false.gif =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/false.gif,v diff -u Binary files differ Index: web/openacs/www/admin/static/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/static/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,106 @@ +# index.tcl,v 3.0 2000/02/06 03:30:22 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Static Content"] + +

    Static Content

    + +[ad_admin_context_bar "Static Content"] + + +
    + +
    +Search through titles, URLs: + +
    + + + +

    Index Exclusion

    + +You can exclude some or all of the static pages from the index by +entering patterns that match the URL or page title of a static page. + +
      + +" + +set db [ns_db gethandle] +set selection [ns_db select $db "select * +from static_page_index_exclusion +order by upper(pattern)"] + +set items "" +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append items "
    • $pattern\n" +} + + +ns_write "$items + +

      + +

    • Add a pattern + +

      + +

    • Run all patterns + + +
    + +" + + + + +set selection [ns_db 1row $db "select + count(*) as n_pages, + sum(case when index_p='t' then 1 else 0 end) as n_indexed_pages, + sum(length(page_body)) as n_bytes +from static_pages"] +set_variables_after_query + +ns_write " + +

    Statistics

    + +
      +
    • number of pages: $n_pages ($n_indexed_pages to be indexed) +
    • total bytes: $n_bytes + +
    + +A static page is one that sits in the file system, e.g., +\"foobar.html\". This is by way of contrast with content that is pulled +from the relational database, e.g., +\"/bboard/q-and-a-fetch-msg.tcl?msg_id=000OQP\". Static pages are fast +and reliable. Static pages are editable with all kinds of standard +tools. The main problem with static pages is that the RDBMS doesn't know +when a static page has been added to the site. Until you sync the database +with the file system, you won't be able to collect comments, links, etc. on +the new page. + +[ad_admin_footer] +" Index: web/openacs/www/admin/static/link-check.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/link-check.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/static/link-check.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,188 @@ +# link-check.tcl,v 3.1 2000/02/29 04:39:18 jsc Exp +# link-check.tcl + +# AOLserver link verifier +# this program crawls through all of your Web content and finds the dead links +# it should simply be placed in "link-check.tcl" somewhere accessible through an +# AOLserver 2.2 (2.1 might work also but no guarantees). Request the URL and it +# will grind through the Web content. + +# Copyright Jin Choi (jsc@arsdigita.com) and Philip Greenspun (philg@mit.edu) +# distributed under the GNU General Public License + +global webroot +global httproot +global debug_link_checker +global running_on_wimpy_machine + +set debug_link_checker 0 +# if you set this to 1 then the checker will sleep for 1 second periodically +# thus giving Web service a chance +set running_on_wimpy_machine [ad_parameter WimpyMachineP machine 1] + +# webroot, httproot + +# webroot is the Unix fully qualified path +set webroot [ns_info pageroot] +set httproot [ns_conn location] + +proc check_file {f} { + ns_write "
  • $f\n
      \n" + set stream [open $f] + set content [read $stream] + close $stream + foreach url [ns_hrefs $content] { + # we only want to check http: and relative refs + if { [regexp -nocase "^mailto:" $url] || (![regexp -nocase "^http:" $url] && [regexp {^[^/]+:} $url]) || [regexp "^\\#" $url] } { + # it was a mailto or an ftp:// or something (but not http://) + # else that http_open won't like (or just plain #foobar) + # ns_write "
    • skipping $url because it doesn't look like HTTP:// or relative ref\n" + continue + } + + # strip off any trailing #foo section directives to browsers + regexp {^(.*/?[^/]+)\#[^/]+$} $url dummy url + if [catch { set response [check_link $f $url] } errmsg ] { + # we got an error (probably a dead server) + set response "probably the foreign server isn't responding at all" + } + if {$response == 404 || $response == 405 || $response == 500 } { + # we should try again with a full GET + # because a lot of program-backed servers return 404 for HEAD + # when a GET works fine + if [catch { set response [check_link $f $url 1] } errmsg] { + set response "probably the foreign server isn't responding at all" + } + } + if { $response != 200 && $response != 302 } { + ns_write "
    • $url: $response\n" + } + } + ns_write "
    \n" +} + + + +proc walk_tree {dir procedure seen_already_cache {pattern {.*}}} { + upvar $seen_already_cache seen + global debug_link_checker + global running_on_wimpy_machine + + # do this so that pwd works (so that we can avoid infinite loops) + cd $dir + + set canonical_dirname [pwd] + if [info exists seen($canonical_dirname)] { + if { $debug_link_checker == 1 } { + ns_write "walk_tree: skipping directory $canonical_dirname (already seen)
    " + } + return + } + + set seen($canonical_dirname) 1 + + if { $debug_link_checker == 1 } { + ns_write "walk_tree: checking out directory $dir
    \n" + } + foreach f [glob -nocomplain $dir/*] { + if [file readable $f] { + if [file isdirectory $f] { + if { $running_on_wimpy_machine == 1 } { + # we sleep for one second in order to not trash Web service + ns_sleep 1 + } + walk_tree $f $procedure seen $pattern + } else { + if {[file isfile $f]} { + if {[ns_info winnt]} { + set match [regexp -nocase $pattern $f] + } else { + set match [regexp $pattern $f] + } + if $match { + $procedure $f + } + } + } + } + } +} + + +## Assumes url is a URL valid for use with ns_httpopen +proc get_http_status {url {use_get_p 0} {timeout 30}} { + if $use_get_p { + set http [ns_httpopen GET $url "" $timeout] + } else { + set http [ns_httpopen HEAD $url "" $timeout] + } + # philg changed these to close BOTH rfd and wfd + set rfd [lindex $http 0] + set wfd [lindex $http 1] + close $rfd + close $wfd + set headers [lindex $http 2] + set response [ns_set name $headers] + set status [lindex $response 1] + ns_set free $headers + return $status +} + +proc check_link {base_file reference_inside_href {use_get_p 0}} { + # base_file is the full file system path where the + # HTML was found; reference_inside_href is the string + # that was inside the + +Testing Links at $httproot + + +

    Testing Links

    + +at $httproot + +
    + +All HTML files: +
      +" + +set seen_already_cache() 0 +walk_tree $webroot check_file seen_already_cache {\.html$} + + +ns_write "
    +
    Jin S. Choi
    +" Index: web/openacs/www/admin/static/list.js =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/list.js,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/static/list.js 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,215 @@ +var _id = 0, _pid = 0, _lid = 0, _pLayer; +var _mLists = new Array(); +document.lists = _mLists; +var isNav4, isIE4; +if (parseInt(navigator.appVersion.charAt(0)) >= 4) { + isNav4 = (navigator.appName == "Netscape") ? true : false; + isIE4 = (navigator.appName.indexOf("Microsoft") != -1) ? true : false; +} +function List(visible, width, height, bgColor) { + this.setIndent = setIndent; + this.addItem = addItem; + this.addList = addList; + this.build = build; + this.rebuild = rebuild; + this.setFont = _listSetFont; + this._writeList = _writeList; + this._showList = _showList; + this._updateList = _updateList; + this._updateParent = _updateParent; + this.onexpand = null; this.postexpand = null; + this.lists = new Array(); // sublists + this.items = new Array(); // layers + this.types = new Array(); // type + this.strs = new Array(); // content + this.x = 0; + this.y = 0; + this.visible = visible; + this.id = _id; + this.i = 18; + this.space = true; + this.pid = 0; + this.fontIntro = false; + this.fontOutro = false; + this.width = width || 350; + this.height = height || 22; + this.parLayer = false; + this.built = false; + this.shown = false; + this.needsUpdate = false; + this.needsRewrite = false; + this.parent = null; + this.l = 0; + if(bgColor) this.bgColor = bgColor; + else this.bgColor = null; + _mLists[_id++] = this; +} +function _listSetFont(i,j) { + this.fontIntro = i; + this.fontOutro = j; +} +function setIndent(indent) { this.i = indent; if(this.i < 0) { this.i = 0; this.space = false; } } +function setClip(layer, l, r, t, b) { + if(isNav4) { + layer.clip.left = l; layer.clip.right = r; + layer.clip.top = t; layer.clip.bottom = b; + } else { + layer.style.pixelWidth = r-l; + layer.style.pixelHeight = b-t; + layer.style.clip = "rect("+t+","+r+","+b+","+l+")"; + } +} +function _writeList() { + self.status = "List: Writing list..."; + var layer, str, clip; + for(var i = 0; i < this.types.length; i++) { + layer = this.items[i]; + if(isNav4) layer.visibility = "hidden"; + else layer.style.visibility = "hidden"; + str = ""; + if(isNav4) layer.document.open(); + str += ""; + if(this.types[i] == "list") { + str += ""; + _pid++; + } else if(this.space) + str += ""; + if(this.l>0 && this.i>0) str += ""; + str += "
      "; + if(this.fontIntro) str += this.fontIntro; + str += this.strs[i]; + if(this.fontOutro) str += this.fontOutro; + str += "
    "; + if(isNav4) { + layer.document.writeln(str); + layer.document.close(); + } else layer.innerHTML = str; + if(this.types[i] == "list" && this.lists[i].visible) + this.lists[i]._writeList(); + } + this.built = true; + this.needsRewrite = false; + self.status = ''; +} +function _showList() { + var layer; + for(var i = 0; i < this.types.length; i++) { + layer = this.items[i]; + setClip(layer, 0, this.width, 0, this.height-1); + var bg = layer.oBgColor || this.bgColor; + if(isIE4) { + if((bg == null) || (bg == "null")) bg = ""; + layer.style.backgroundColor = bg; + } else layer.document.bgColor = bg; + if(this.types[i] == "list" && this.lists[i].visible) + this.lists[i]._showList(); + } + this.shown = true; + this.needsUpdate = false; +} +function _updateList(pVis, x, y) { + var currTop = y, layer; + for(var i = 0; i < this.types.length; i++) { + layer = this.items[i]; + if(this.visible && pVis) { + if(isNav4) { + layer.visibility = "visible"; + layer.top = currTop; + layer.left = x; + } else { + layer.style.visibility = "visible"; + layer.style.pixelTop = currTop; + layer.style.pixelLeft = x; + } + currTop += this.height; + } else { + if(isNav4) layer.visibility = "hidden"; + else layer.style.visibility = "hidden"; + } + if(this.types[i] == "list") { + if(this.lists[i].visible) { + if(!this.lists[i].built || this.lists[i].needsRewrite) this.lists[i]._writeList(); + if(!this.lists[i].shown || this.lists[i].needsUpdate) this.lists[i]._showList(); + if(isNav4) layer.document.images[0].src = "true.gif"; + else eval('document.images._img'+this.lists[i].id+'.src = "true.gif"'); + } else { + if(isNav4) layer.document.images[0].src = "false.gif"; + else eval('document.images._img'+this.lists[i].id+'.src = "false.gif"'); + } + if(this.lists[i].built) + currTop = this.lists[i]._updateList(this.visible && pVis, x, currTop); + } + } + return currTop; +} +function _updateParent(pid, l) { + var layer; + if(!l) l = 0; + this.pid = pid; + this.l = l; + for(var i = 0; i < this.types.length; i++) + if(this.types[i] == "list") + this.lists[i]._updateParent(pid, l+1); +} +function expand(i) { + _mLists[i].visible = !_mLists[i].visible; + if(_mLists[i].onexpand != null) _mLists[i].onexpand(_mLists[i].id); + _mLists[_mLists[i].pid].rebuild(); + if(_mLists[i].postexpand != null) _mLists[i].postexpand(_mLists[i].id); +} +function build(x, y) { + this._updateParent(this.id); + this._writeList(); + this._showList(); + this._updateList(true, x, y); + this.x = x; this.y = y; +} +function rebuild() { this._updateList(true, this.x, this.y); } +function addItem(str, bgColor, layer) { + var testLayer = false; + if(!document.all) document.all = document.layers; + if(!layer) { + if(isIE4 || !this.parLayer) testLayer = eval('document.all.lItem'+_lid); + else { + _pLayer = this.parLayer; + testLayer = eval('_pLayer.document.layers.lItem'+_lid); + } + if(testLayer) layer = testLayer; + else { + if(isNav4) { + if(this.parLayer) layer = new Layer(this.width, this.parLayer); + else layer = new Layer(this.width); + } else return; + } + } + if(bgColor) layer.oBgColor = bgColor; + this.items[this.items.length] = layer; + this.types[this.types.length] = "item"; + this.strs[this.strs.length] = str; + _lid++; +} +function addList(list, str, bgColor, layer) { + var testLayer = false; + if(!document.all) document.all = document.layers; + if(!layer) { + if(isIE4 || !this.parLayer) testLayer = eval('document.all.lItem'+_lid); + else { + _pLayer = this.parLayer; + testLayer = eval('_pLayer.document.layers.lItem'+_lid); + } + if(testLayer) layer = testLayer; + else { + if(isNav4) { + if(this.parLayer) layer = new Layer(this.width, this.parLayer); + else layer = new Layer(this.width); + } else return; + } + } + if(bgColor) layer.oBgColor = bgColor; + this.lists[this.items.length] = list; + this.items[this.items.length] = layer; + this.types[this.types.length] = "list"; + this.strs[this.strs.length] = str; + list.parent = this; + _lid++; +} \ No newline at end of file Index: web/openacs/www/admin/static/page-summary.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/page-summary.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/static/page-summary.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,216 @@ +# page-summary.tcl,v 3.0 2000/02/06 03:30:24 ron Exp +# +# /admin/static/page-summary.tcl +# +# by philg@mit.edu in ancient times (mid-1998?) +# +# display everything that we know about a page, +# list related links and comments, +# display the users who've viewed it +# + +set_form_variables + +# page_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db " + select page_title, url_stub, draft_p, obsolete_p, accept_comments_p, accept_links_p, inline_comments_p, inline_links_p, index_p, last_updated, users.user_id, users.first_names, users.last_name +from static_pages sp, users +where sp.original_author = users.user_id +and sp.page_id = $page_id +union + select page_title, url_stub, draft_p, obsolete_p, accept_comments_p, accept_links_p, inline_comments_p, inline_links_p, index_p, last_updated, null, null, null +from static_pages sp +where not exists (select * from users + where sp.original_author = users.user_id) +and sp.page_id = $page_id + "] +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "$url_stub"] + +

    $url_stub

    + +[ad_admin_context_bar [list "index.tcl" "Static Content"] "One Page"] + +
    +
      +" + +if ![empty_string_p $page_title] { + ns_write "
    • Title: \"$page_title\"\n" +} + +ns_write " + +
    • user page: $url_stub +" + +if ![empty_string_p $user_id] { + ns_write "
    • original_author: $first_names $last_name\n" +} + +if ![empty_string_p $last_updated] { + ns_write "
    • last updated: [util_AnsiDatetoPrettyDate $last_updated]\n" +} + +ns_write " +
    • Accept Comments? $accept_comments_p (toggle) + +
    • Inline Comments? $inline_comments_p (toggle) + +
    • Accept Links? $accept_links_p (toggle) + +
    • Inline Links? $inline_links_p (toggle) + +
    • Include in Site-wide Index? $index_p (toggle) + + +
    +" + + +set selection [ns_db select $db " +select links.link_title, links.link_description, links.url, links.status, posting_time, +users.user_id, first_names || ' ' || last_name as name +from static_pages sp, links, users +where sp.page_id = links.page_id +and users.user_id = links.user_id +and links.page_id = $page_id +union +select links.link_title, links.link_description, links.url, links.status, posting_time, +users.user_id, first_names || ' ' || last_name as name +from links, users +where not exists (select * from static_pages sp + where sp.page_id = links.page_id) +and users.user_id = links.user_id +and links.page_id = $page_id +order by posting_time asc"] + +set items "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + set old_url $url + append items "
  • [util_AnsiDatetoPrettyDate $posting_time]: +$link_title " + if { $status != "live" } { + append items "($status)" + set extra_option "\n    restore to live status" + } else { + set extra_option "" + } + append items "- $link_description +
    +-- posted by $name +    edit +    delete +    blacklist +$extra_option +

    +" +} + +if ![empty_string_p $items] { + ns_write "

    Related links

    +(sweep) +
      +$items +
    +" +} + + +# we fill in the page table columns in case the page is not in the database + +set selection [ns_db select $db " +select comments.page_id, posting_time, comments.comment_id,comments.message, comments.comment_type, comments.rating, users.user_id, first_names || ' ' || last_name as name, client_file_name, html_p, file_type, original_width, original_height, caption +from static_pages sp, comments_not_deleted comments, users +where sp.page_id = comments.page_id +and users.user_id = comments.user_id +and comments.page_id = $page_id +union +select comments.page_id, posting_time, comments.comment_id,comments.message, comments.comment_type, comments.rating, users.user_id, first_names || ' ' || last_name as name, client_file_name, html_p, file_type, original_width, original_height, caption +from comments_not_deleted comments, users +where not exists (select * from static_pages sp + where page_id = comments.page_id) +and users.user_id = comments.user_id +and comments.page_id = $page_id +order by comment_type, posting_time asc"] + + +set items "" +set last_comment_type "" +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $last_comment_type != $comment_type } { + append items "

    $comment_type

    \n" + set last_comment_type $comment_type + } + append items "
  • [util_AnsiDatetoPrettyDate $posting_time]: " + if { ![empty_string_p $rating] } { + append items "$rating -- " + } + append items " +[format_static_comment $comment_id $client_file_name $file_type $original_width $original_height $caption $message $html_p] +
    +-- $name +     edit     delete +
    +
    +" +} + +if ![empty_string_p $items] { + ns_write "

    Page Comments

    +
      +$items +
    +" +} + +set n_deleted_comments [database_to_tcl_string $db "select count(*) +from comments +where page_id = $page_id +and deleted_p = 't'"] + +if { $n_deleted_comments > 0 } { + ns_write "There are $n_deleted_comments deleted comments on this page.

    " +} + +set selection [ns_db select $db "select users.user_id, email, first_names || ' ' || last_name as name, page_title, url_stub +from static_pages, user_content_map, users +where static_pages.page_id = user_content_map.page_id +and users.user_id = user_content_map.user_id +and user_content_map.page_id = $page_id +order by last_name"] + + +ns_write " +Users who +have viewed the page $page_title +when they were logged into +the site. +

      " + +set count 0 + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + incr count + ns_write "
    • $name ($email)\n" +} + +ns_write " +
    +" + + + +ns_write " +[ad_admin_footer] +" Index: web/openacs/www/admin/static/philg-tree.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/philg-tree.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/static/philg-tree.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,19 @@ +# philg-tree.tcl,v 3.0 2000/02/06 03:30:25 ron Exp +set db [ns_db gethandle] + +set selection [ns_db select $db "select page_id, url_stub, page_title, accept_comments_p, accept_links_p from static_pages order by url_stub"] + +ReturnHeaders + +set count 0 +set whole_page "" +while { [ns_db getrow $db $selection] } { + set_variables_after_query + incr count + if { [expr $count%100] == 0 } { + append whole_page "$url_stub
    " + } +} + +ns_write $whole_page + Index: web/openacs/www/admin/static/resize.js =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/resize.js,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/static/resize.js 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,21 @@ +/** + * resize.js 0.3 970811 + * by gary smith + * js component for "reloading page onResize" + */ + +if(!window.saveInnerWidth) { + window.onresize = resize; + window.saveInnerWidth = window.innerWidth; + window.saveInnerHeight = window.innerHeight; +} + +function resize() { + if (saveInnerWidth < window.innerWidth || + saveInnerWidth > window.innerWidth || + saveInnerHeight > window.innerHeight || + saveInnerHeight < window.innerHeight ) + { + window.history.go(0); + } +} Index: web/openacs/www/admin/static/search.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/search.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/static/search.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,49 @@ +# search.tcl,v 3.0 2000/02/06 03:30:26 ron Exp +set_the_usual_form_variables 0 + +# query_string, optional order_by + +if { ![info exists order_by] || [empty_string_p $order_by] || $order_by == "url" } { + set option "order by title" + set order_by_clause "url_stub, upper(rtrim(ltrim(page_title)))" +} elseif { $order_by == "title" } { + set option "order by URL" + set order_by_clause "upper(rtrim(ltrim(page_title))), url_stub" +} + +ReturnHeaders + +ns_write "[ad_admin_header "Static Pages matching \"$query_string\""] + +

    Static Pages matching \"$query_string\"

    + +[ad_admin_context_bar [list "index.tcl" "Static Content"] "Search Results"] + + +
    + +$option + +
      +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select page_id, rtrim(ltrim(page_title,' \n'),' \n') as page_title, url_stub +from static_pages +where draft_p <> 't' +and (upper(page_title) like upper('%$QQquery_string%') + or upper(url_stub) like upper('%$QQquery_string%')) +order by $order_by_clause"] + + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
    • $url_stub ($page_title)\n" +} + +ns_write " +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/static/static-files.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/static-files.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/static/static-files.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,91 @@ +# static-files.tcl,v 3.0 2000/02/06 03:30:27 ron Exp +set db [ns_db gethandle] + +set selection [ns_db select $db "select url_stub from static_pages order by url_stub"] + + +ReturnHeaders + +ns_write " + + + + + + + + +
    +" + + +for { set i 0 } { $i < $dir_counter } { incr i } { + ns_write "
    \n" +} + +ns_write " + +" \ No newline at end of file Index: web/openacs/www/admin/static/static-pages.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/static-pages.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/static/static-pages.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,58 @@ +# static-pages.tcl,v 3.0 2000/02/06 03:30:28 ron Exp +set_the_usual_form_variables 0 + +# optional order_by, suppress_unindexed_p + +if { ![info exists order_by] || [empty_string_p $order_by] || $order_by == "url" } { + set option "order by title" + set order_by_clause "url_stub, upper(rtrim(ltrim(page_title)))" +} elseif { $order_by == "title" } { + set option "order by URL" + set order_by_clause "upper(rtrim(ltrim(page_title))), url_stub" +} + +if { ![info exists suppress_unindexed_p] || !$suppress_unindexed_p } { + set help_table [help_upper_right_menu [list "static-pages.tcl?suppress_unindexed_p=1&[export_url_vars order_by]" "suppress unindexed pages"]] + set suppress_unindexed_p_clause "" +} else { + # don't show pages that aren't indexed + set help_table [help_upper_right_menu [list "static-pages.tcl?suppress_unindexed_p=0&[export_url_vars order_by]" "show unindexed pages"]] + set suppress_unindexed_p_clause "\nand index_p <> 'f'" +} + +ReturnHeaders + +ns_write "[ad_admin_header "Static Pages"] + +

    Static Pages

    + +[ad_admin_context_bar [list "index.tcl" "Static Content"] "All Pages"] + + +
    + +$help_table + +$option + +
      +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select page_id, rtrim(ltrim(page_title,' \n'),' \n') as page_title, url_stub +from static_pages +where draft_p <> 't' $suppress_unindexed_p_clause +order by $order_by_clause"] + + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
    • $url_stub ($page_title)\n" +} + +ns_write " +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/static/static-syncer-ns-set.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/static-syncer-ns-set.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/static/static-syncer-ns-set.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,144 @@ +# static-syncer-ns-set.tcl,v 3.0 2000/02/06 03:30:30 ron Exp +# static-pages-syncer.tcl + +# this program crawls through all of your Web content and finds pages to +# stuff into the static_pages table + +# Copyright Jin Choi (jsc@arsdigita.com) and Philip Greenspun (philg@mit.edu) +# distributed under the GNU Public License + +# modified to use ns_set instead of Tcl globals + +# modified November 6, 1999 to check the ad.ini file +# for exclusion patterns +# modified December 27, 1999 by philg to check the ad.ini +# file for IncludeRegexp (part of a grand scheme to make +# .adp files take advantage of comments and links) + +proc ad_running_on_wimpy_machine_p {} { + return 0 +} + +proc ad_debug_static_page_syncer_p {} { + return 0 +} + +proc ad_check_file_for_sync {f db} { + ns_log Notice "ad_check_file_for_sync called with \"$f\" and \"$db\"" + set url_stub [string range $f [string length [ns_info pageroot]] [expr [string length $f] -1]] + ns_write "
  • $url_stub\n" + set stream [open $f] + set content [read $stream] + close $stream + # we don't want to mess with zero length files, esp. since they + # cause the Oracle driver to cough up an error + if { [string length $content] == 0 } { + ns_write " ... is zero length; not touching database." + return + } + if { ![regexp -nocase {(.*)} $content match page_title] } { + set page_title "untitled document at $url_stub" + } + ns_write "([ns_quotehtml $page_title])\n" + set n_rows_already [database_to_tcl_string $db "select count(*) as n_rows_already from static_pages where url_stub = '[DoubleApos $url_stub]'"] + if { $n_rows_already == 0 } { + ns_write "... not in database. Preparing to stuff..." + ns_db dml $db "insert into static_pages (page_id, url_stub, page_title, page_body) +values (nextval('page_id_sequence'), [db_postgres_doubleapos_null_sql $url_stub], [db_postgres_doubleapos_null_sql $page_title], '[string range [DoubleApos $content] 0 4000]')" + + ns_write "done!" + } else { + ns_write "... already in database." + } +} + +# we'll have an include pattern that is a REGEXP (single) +# and an exclude_patterns which is a Tcl list of GLOB patterns + +# the procedure must take two arguments, a filename and a database connection + +# seen_already_cache is an ns_set + +proc walk_tree {db dir procedure seen_already_cache {include_pattern {.*}} {exclude_patterns ""}} { + # do this so that pwd works (so that we can avoid infinite loops) + cd $dir + + set canonical_dirname [pwd] + if { [ns_set find $seen_already_cache $canonical_dirname] != -1 } { + # already exists + if [ad_debug_static_page_syncer_p] { + ns_write "walk_tree: skipping directory $canonical_dirname (already seen)
    " + } + return + } + + # mark this directory as having been seen + ns_set cput $seen_already_cache $canonical_dirname 1 + + if [ad_debug_static_page_syncer_p] { + ns_write "walk_tree: checking out directory $dir
    \n" + } + foreach f [glob -nocomplain $dir/*] { + if [file readable $f] { + if [file isdirectory $f] { + if [ad_running_on_wimpy_machine_p] { + # we sleep for one second in order to not trash Web service + ns_sleep 1 + } + walk_tree $db $f $procedure $seen_already_cache $include_pattern $exclude_patterns + } elseif [file isfile $f] { + # the file is not a symlink + set match [regexp $include_pattern $f] + set excluded_p 0 + foreach pattern $exclude_patterns { + if { [string match $pattern $f] } { + set excluded_p 1 + break + } + } + if { $match && !$excluded_p } { + $procedure $f $db + } + } + } + } +} + +ReturnHeaders + +ns_write " + +Syncing Pages at [ns_conn location] + + +

    Syncing Pages

    + +[ad_admin_context_bar [list "index.tcl" "Static Content"] "Syncing Static Pages"] + + +
    + +All HTML files: +
      +" + +# exclusion patterns +set exclude_patterns [list] + +foreach pattern [ad_parameter_all_values_as_list "ExcludePattern" "static"] { + lappend exclude_patterns "[ns_info pageroot]$pattern" +} + +set db [ns_db gethandle] + +# the include_pattern regexp defaults to .htm and .html +set inclusion_regexp [ad_parameter IncludeRegexp "static" {\.html?$}] + +ns_write "$inclusion_regexp

      " + +walk_tree $db [ns_info pageroot] ad_check_file_for_sync [ns_set new] $inclusion_regexp $exclude_patterns + +ns_write "

    +
    philg@mit.edu
    + +" Index: web/openacs/www/admin/static/static-usage.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/static-usage.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/static/static-usage.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,64 @@ +# static-usage.tcl,v 3.0 2000/02/06 03:30:31 ron Exp +# +# /admin/static/static-usage.tcl +# +# by philg@mit.edu in late 1998? +# +# summarize page views by registered users +# +# (modified November 6, 1999 to be able to sort by number of views) +# + +set_the_usual_form_variables 0 + +# order_by (optional) + +if { ![info exists order_by] || $order_by == "url" } { + set help_table [help_upper_right_menu [list "static-usage.tcl?order_by=page_views" "order by page views"]] + set order_by_clause "url_stub, upper(page_title)" +} else { + set help_table [help_upper_right_menu [list "static-usage.tcl?order_by=url" "order by url"]] + set order_by_clause "page_views desc, url_stub, upper(page_title)" +} + +ReturnHeaders + +ns_write "[ad_admin_header "Static Pages"] + +

    Static Usage

    + +[ad_admin_context_bar [list "index.tcl" "Static Content"] "Usage"] + +
    + +$help_table + +This is a listing of the number of users who +have viewed each page when they were logged into +the site. Duplicate page views by the same user +are not counted. + +
      +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select static_pages.page_id, url_stub, page_title, count(user_id) as page_views +from static_pages, user_content_map +where static_pages.page_id = user_content_map.page_id +group by static_pages.page_id, url_stub, page_title +order by $order_by_clause"] + +set items "" +while {[ns_db getrow $db $selection]} { + set_variables_after_query + append items "
    • $url_stub - $page_views\n" +} + +ns_write $items + +ns_write " +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/static/toggle-accept-comments-p.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/toggle-accept-comments-p.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/static/toggle-accept-comments-p.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,10 @@ +# toggle-accept-comments-p.tcl,v 3.0 2000/02/06 03:30:32 ron Exp +set_the_usual_form_variables + +# page_id + +set db [ns_db gethandle] + +ns_db dml $db "update static_pages set accept_comments_p = logical_negation(accept_comments_p) where page_id = $page_id" + +ns_returnredirect "page-summary.tcl?[export_url_vars page_id]" Index: web/openacs/www/admin/static/toggle-accept-links-p.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/toggle-accept-links-p.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/static/toggle-accept-links-p.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,10 @@ +# toggle-accept-links-p.tcl,v 3.0 2000/02/06 03:30:33 ron Exp +set_the_usual_form_variables + +# page_id + +set db [ns_db gethandle] + +ns_db dml $db "update static_pages set accept_links_p = logical_negation(accept_links_p) where page_id = $page_id" + +ns_returnredirect "page-summary.tcl?[export_url_vars page_id]" Index: web/openacs/www/admin/static/toggle-index-p.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/toggle-index-p.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/static/toggle-index-p.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,13 @@ +# toggle-index-p.tcl,v 3.0 2000/02/06 03:30:34 ron Exp +set_the_usual_form_variables + +# page_id + +set db [ns_db gethandle] + +ns_db dml $db "update static_pages +set index_p = logical_negation(index_p), + index_decision_made_by = 'human' +where page_id = $page_id" + +ns_returnredirect "page-summary.tcl?[export_url_vars page_id]" Index: web/openacs/www/admin/static/toggle-inline-comments-p.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/toggle-inline-comments-p.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/static/toggle-inline-comments-p.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,10 @@ +# toggle-inline-comments-p.tcl,v 3.0 2000/02/06 03:30:35 ron Exp +set_the_usual_form_variables + +# page_id + +set db [ns_db gethandle] + +ns_db dml $db "update static_pages set inline_comments_p = logical_negation(inline_comments_p) where page_id = $page_id" + +ns_returnredirect "page-summary.tcl?[export_url_vars page_id]" Index: web/openacs/www/admin/static/toggle-inline-links-p.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/toggle-inline-links-p.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/static/toggle-inline-links-p.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,10 @@ +# toggle-inline-links-p.tcl,v 3.0 2000/02/06 03:30:36 ron Exp +set_the_usual_form_variables + +# page_id + +set db [ns_db gethandle] + +ns_db dml $db "update static_pages set inline_links_p = logical_negation(inline_links_p) where page_id = $page_id" + +ns_returnredirect "page-summary.tcl?[export_url_vars page_id]" Index: web/openacs/www/admin/static/tree-view.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/tree-view.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/static/tree-view.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,130 @@ +# tree-view.tcl,v 3.0 2000/02/06 03:30:37 ron Exp +set_the_usual_form_variables +# open_directories +# comma separated list of directories which are open + +proc open_dirs_minus {open_dir_list dir_to_remove} { + # Takes a list of open directories, removes any which have + # dir_to_remove as a prefix, returns a concatenated string of + # directories separated by commas + + set retlist {} + foreach dir $open_dir_list { + if { ![string match "${dir_to_remove}*" $dir] } { + lappend retlist $dir + } + } + return [join $retlist ","] +} + +proc open_dirs_plus {open_dir_list dir_to_add} { + # Takes a list of open directories, adds dir_to_add, + # and returns a concatenated string of directories separated by commas + lappend open_dir_list $dir_to_add + return [join $open_dir_list ","] +} + +# Count up the number of slashes in path. +proc indent_level {path} { + regsub -all {[^/]+} $path "" slashes + return [string length $slashes] +} + +proc indent_string {path} { + set n [indent_level $path] + set retstr "" + for { set i 0 } { $i < $n } { incr i } { + append retstr "       " + } + return $retstr +} + + +# Print out a line for a directory. +# action is "close" or "open" +proc dirlink {dir path open_dirs action} { + if { $action == "open" } { + set href "tree-view.tcl?open_directories=[ns_urlencode [open_dirs_plus $open_dirs $path]]" + } else { + set href "tree-view.tcl?open_directories=[ns_urlencode [open_dirs_minus $open_dirs $path]]" + } + + return "[indent_string $path]$dir
    \n" +} + + +# Returns prefix, subdir, or exact depending on whether the path +# is a prefix, a subdirectory of, or an exact match of any open directory. +proc directory_display_code {path open_directories} { + foreach dir $open_directories { + if { [string compare $dir $path] == 0 } { + return "exact" + } + } + foreach dir $open_directories { + if { [string match "${path}/*" $dir] } { + return "prefix" + } + } + foreach dir $open_directories { + if { [regexp "$dir/\[^/\]+\$" $path] } { + return "subdir" + } + } + return "none" +} + +set open_dirs [split $open_directories ","] + +set db [ns_db gethandle] + +set selection [ns_db select $db "select page_id, url_stub, page_title, accept_comments_p, accept_links_p from static_pages order by url_stub"] + +ReturnHeaders + +# set seen [ns_set new] +set seen() "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + set path_elements [split $url_stub "/"] + + # For each of the directory elements, if we haven't seen it + # before and it should be displayed, write out a line for it. + set curpath "" + set n [expr [llength $path_elements] - 1] + set display_code "" + + for {set i 1} {$i < $n} {incr i} { + set dir [lindex $path_elements $i] + set newpath "$curpath/$dir" + + # set display_code [ns_set get $seen $newpath] + if { [info exists seen($newpath)] } { + set display_code $seen($newpath) + } else { + set display_code [directory_display_code $newpath $open_dirs] + + # ns_set put $seen $newpath $display_code + set seen($newpath) $display_code + + if { $display_code == "prefix" || $display_code == "exact" } { + # close it if clicked. + ns_write "[dirlink $dir $newpath $open_dirs close]\n" + } elseif { $display_code == "subdir" || $i == 1 } { + # display it. + ns_write "[dirlink $dir $newpath $open_dirs open]\n" + } else { + break + } + } + + set curpath $newpath + } + + if { $display_code == "exact" || $n == 1 } { + set file [lindex $path_elements $n] + ns_write "[indent_string $url_stub]$file \"$page_title\"
    \n" + } +} \ No newline at end of file Index: web/openacs/www/admin/static/true.gif =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/true.gif,v diff -u Binary files differ Index: web/openacs/www/admin/static/exclusion/README.txt =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/exclusion/README.txt,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/static/exclusion/README.txt 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,6 @@ +This directory is for pages that maintain the contents of +static_page_index_exclusion table, defined in +/doc/sql/community-core.sql + +-- philg@mit.edu on November 6, 1999 + Index: web/openacs/www/admin/static/exclusion/add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/exclusion/add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/static/exclusion/add-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,21 @@ +# add-2.tcl,v 3.0 2000/02/06 03:30:38 ron Exp +# +# /admin/static/exclusion/add-2.tcl +# +# by philg@mit.edu on November 6, 1999 +# +# inserts a row into the static_page_index_exclusion table +# + +set_the_usual_form_variables + +# match_field, like_or_regexp, pattern, pattern_comment + +set db [ns_db gethandle] + +ns_db dml $db "insert into static_page_index_exclusion +(exclusion_pattern_id, match_field, like_or_regexp, pattern, pattern_comment, creation_user, creation_date) +values +([db_sequence_nextval_sql static_page_index_excl_seq], '$QQmatch_field', '$QQlike_or_regexp', '$QQpattern', '$QQpattern_comment', [ad_verify_and_get_user_id], [db_sysdate])" + +ns_returnredirect "/admin/static/" Index: web/openacs/www/admin/static/exclusion/add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/exclusion/add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/static/exclusion/add.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,57 @@ +# add.tcl,v 3.0 2000/02/06 03:30:40 ron Exp +# +# /admin/static/exclusion/add.tcl +# +# by philg@mit.edu on November 6, 1999 +# +# form to add an index exclusion pattern for static pages on a site +# (takes no action) + +ns_return 200 text/html "[ad_admin_header "Add an Exclusion Pattern"] + +

    Add an Exclusion Pattern

    + +[ad_admin_context_bar [list "../index.tcl" "Static Content"] "Add Exclusion Pattern"] + +
    + + +
    +
    + + + + + + + +
    match field + +
    matching method + +
    the pattern itself +
    + (with LIKE, % is a wildcard matching 0 or more characters; _ (underscore) is a wildcard matching exactly 1 character.) +
    comment +
    + (an optional note to your fellow maintainers; you can explain why you want some pages excluded) + +
    +
    +
    + +
    +
    + +Note that currently REGEXP matching isn't supported. Also, the +PAGE_BODY field (an Oracle CLOB type) isn't supported. + +[ad_admin_footer] +" Index: web/openacs/www/admin/static/exclusion/delete-one-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/exclusion/delete-one-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/static/exclusion/delete-one-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,10 @@ +# delete-one-2.tcl,v 3.0 2000/02/06 03:30:41 ron Exp +set_form_variables +# exclusion_pattern_id + +set db [ns_db gethandle] + +ns_db dml $db "delete from static_page_index_exclusion +where exclusion_pattern_id = $exclusion_pattern_id" + +ns_returnredirect "../index.tcl" Index: web/openacs/www/admin/static/exclusion/delete-one.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/exclusion/delete-one.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/static/exclusion/delete-one.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,49 @@ +# delete-one.tcl,v 3.0 2000/02/06 03:30:42 ron Exp +# +# /admin/static/exclusion/delete-one.tcl +# +# by jsc@arsdigita.com on November 6, 1999 +# +# Confirmation page for pattern deletion. +# + +set_form_variables +# exclusion_pattern_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select first_names, last_name, exc.* +from static_page_index_exclusion exc, users u +where u.user_id = exc.creation_user +and exc.exclusion_pattern_id = $exclusion_pattern_id"] + +set_variables_after_query + +ns_return 200 text/html "[ad_admin_header "Delete Pattern"] + +

    Delete Pattern

    + +[ad_admin_context_bar [list "../index.tcl" "Static Content"] [list "one-pattern.tcl?[export_url_vars exclusion_pattern_id]" "One Exclusion Pattern"] "Delete Pattern"] + +
    + +
    +[export_form_vars exclusion_pattern_id] + +
    + + + + + + + + +
    Field$match_field
    Pattern Type$like_or_regexp
    Pattern$pattern
    Comment$pattern_comment
    Creation User$first_names $last_name
    Creation Date$creation_date
    +
    + +
    + + +[ad_admin_footer] +" Index: web/openacs/www/admin/static/exclusion/exclude.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/exclusion/exclude.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/static/exclusion/exclude.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,63 @@ +# exclude.tcl,v 3.0 2000/02/06 03:30:44 ron Exp +# +# /admin/static/exclusion/exclude.tcl +# +# by philg@mit.edu on November 6, 1999 +# +# run the exclusion patterns and generate a report for the user +# of what got excluded +# +# we could do this all in one huge Oracle statement +# but we'd rather do it one pattern at a time and report +# the number of rows updated +# +# we don't update any rows where the indexing decision was made +# by a human + +ReturnHeaders + +ns_write "[ad_admin_header "Running Exclusion Patterns"] + +

    Running Exclusion Patterns

    + +[ad_admin_context_bar [list "../index.tcl" "Static Content"] "Running Exclusion Pattern"] + +
    + +
      + +" + +set db [ns_db gethandle] + +set patterns_list [database_to_tcl_list_list $db "select exclusion_pattern_id, match_field, like_or_regexp, pattern, pattern_comment, creation_date, u.user_id, u.first_names || ' ' || u.last_name as users_full_name +from static_page_index_exclusion spie, users u +where spie.creation_user = u.user_id +order by upper(pattern)"] + +foreach sublist $patterns_list { + set exclusion_pattern_id [lindex $sublist 0] + set match_field [lindex $sublist 1] + set like_or_regexp [lindex $sublist 2] + set pattern [lindex $sublist 3] + set pattern_comment [lindex $sublist 4] + set creation_date [lindex $sublist 5] + set user_id [lindex $sublist 6] + set users_full_name [lindex $sublist 7] + set sql "update static_pages +set index_p = 'f' +where lower($match_field) LIKE lower('[DoubleApos $pattern]') +and index_p <> 'f' +and index_decision_made_by = 'robot'" + ns_write "
    • Going to execute \n\n
      $sql
      \n\n ... " + ns_db dml $db $sql + set n_rows_touched [ns_pg ntuples $db] + ns_write "$n_rows_touched rows updated.\n" +} + +ns_write " + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/static/exclusion/one-pattern.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/exclusion/one-pattern.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/static/exclusion/one-pattern.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,50 @@ +# one-pattern.tcl,v 3.0 2000/02/06 03:30:46 ron Exp +# +# /admin/static/exclusion/one-pattern.tcl +# +# by jsc@arsdigita.com on November 6, 1999 +# +# form to display all information about an exclusion pattern +# including facility to test run the pattern to see what matches +# and to delete it. + + +set_form_variables +# exclusion_pattern_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select first_names, last_name, exc.* +from static_page_index_exclusion exc, users u +where u.user_id = exc.creation_user +and exc.exclusion_pattern_id = $exclusion_pattern_id"] + +set_variables_after_query + +ns_return 200 text/html "[ad_admin_header "One Exclusion Pattern"] + +

    One Exclusion Pattern

    + +[ad_admin_context_bar [list "../index.tcl" "Static Content"] "One Exclusion Pattern"] + +
    + +
    + + + + + + + +
    Field$match_field
    Pattern Type$like_or_regexp
    Pattern$pattern
    Comment$pattern_comment
    Creation User$first_names $last_name
    Creation Date$creation_date
    +
    + + + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/static/exclusion/test-pattern.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/static/exclusion/test-pattern.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/static/exclusion/test-pattern.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,77 @@ +# test-pattern.tcl,v 3.0 2000/02/06 03:30:48 ron Exp +# +# /admin/static/exclusion/one-pattern.tcl +# +# by jsc@arsdigita.com on November 6, 1999 +# +# Show all static pages which would be affected by this comment. +# + + +set_form_variables +# exclusion_pattern_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select match_field, like_or_regexp, pattern +from static_page_index_exclusion +where exclusion_pattern_id = $exclusion_pattern_id"] + +set_variables_after_query + +if { $like_or_regexp != "like" } { + ad_return_error "Not implemented" "$like_or_regexp patterns not yet implemented." + return +} + +set selection [ns_db select $db "select url_stub, page_title, index_p +from static_pages +where $match_field like '$pattern' +order by index_p, url_stub"] + +set excluded_results "" +set included_results "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + if { $index_p == "t" } { + append included_results "
  • $url_stub ($page_title)\n" + } else { + append excluded_results "
  • $url_stub ($page_title)\n" + } +} + +if { [empty_string_p $included_results] } { + set included_results "None" +} + +if { [empty_string_p $excluded_results] } { + set excluded_results "None" +} + +ns_return 200 text/html "[ad_admin_header "Pattern Test"] + +

    Pattern Test

    + +[ad_admin_context_bar [list "../index.tcl" "Static Content"] [list "one-pattern.tcl?[export_url_vars exclusion_pattern_id]" "One Exclusion Pattern"] "Pattern Test"] + +
    + +Pages matching \"$pattern\" on $match_field using [string toupper $like_or_regexp] match: + +

    Already Excluded Pages

    +
      +$excluded_results +
    + +

    Pages That Would Be Excluded

    +
      +$included_results +
    + + +[ad_admin_footer] +" + + Index: web/openacs/www/admin/survsimp/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/survsimp/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/survsimp/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,47 @@ +# +# /admin/survsimp/index.tcl +# +# by raj@alum.mit.edu, February 9, 2000 +# +# survey administration page for site wide administration +# + + +set page_content "[ad_admin_header "Simple Survey System (Site Wide Admin)"] + +

    Simple Survey System Site Wide Administration

    + +[ad_context_bar_ws_or_index "Simple Survey Site Wide Admin"] + +
    + +
      + +" +set db [ns_db gethandle] + +set selection [ns_db select $db "select survey_id, name, enabled_p +from survsimp_surveys"] + +set disabled_header_written_p 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + set enable "Enable" + set disable "Disable" + if { $enabled_p == "f" } { + set enable "Enable" + set disable "Disable" + } + append page_content "
    • $name: $enable $disable" + +} + +append page_content " +
    +[ad_footer] +" + + +ns_db releasehandle $db + +ns_return 200 text/html $page_content Index: web/openacs/www/admin/survsimp/survey-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/survsimp/survey-toggle.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/survsimp/survey-toggle.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,29 @@ +# +# /admin/survsimp/survey-toggle.tcl +# +# by raj@alum.mit.edu, February 9, 2000 +# +# toggle(enable/disable) a single survey +# + +ad_page_variables { + survey_id + enabled_p +} + +set db [ns_db gethandle] + +if {$enabled_p == "f"} { + set enabled_p "t" +} else { + set enabled_p "f" +} + +ns_db dml $db " + update survsimp_surveys + set enabled_p = '$enabled_p' + where survey_id = $survey_id" + +ns_db releasehandle $db + +ns_returnredirect "" Index: web/openacs/www/admin/ticket/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ticket/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ticket/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,4 @@ +# index.tcl,v 3.0 2000/02/06 03:30:49 ron Exp +# All admin now in /ticket/admin/ +ns_returnredirect "/ticket/admin/" + Index: web/openacs/www/admin/ticket/project-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ticket/project-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ticket/project-delete-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,39 @@ +set_form_variables 0 + +# project_id + +set db_list [ns_db gethandle main 2] +set db [lindex $db_list 0] +set sdb [lindex $db_list 1] + + +if { [ticket_user_admin_p $db] != 1} { + ns_returnredirect "index.tcl" + return +} + + +# Delete all tickets in the project + +set selection [ns_db select $db "select msg_id +from ticket_issues +where +project_id = $project_id"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_db dml $sdb "delete from ticket_changes where msg_id = $msg_id" + ns_db dml $sdb "delete from ticket_issue_assignments where msg_id = $msg_id" + ns_db dml $sdb "delete from ticket_xrefs where from_ticket = $msg_id or to_ticket = $msg_id" + ns_db dml $sdb "delete from ticket_issue_responses where response_to = $msg_id" + ns_db dml $sdb "delete from ticket_issue_notifications where msg_id = $msg_id" + ns_db dml $sdb "delete from ticket_issues where msg_id = $msg_id" +} + + +# delete the project +ns_db dml $db "delete from ticket_assignments where project_id = $project_id" +ns_db dml $db "delete from ticket_projects where project_id = $project_id" + +ns_returnredirect "project-manage.tcl" + Index: web/openacs/www/admin/ticket/project-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ticket/project-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ticket/project-delete.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,85 @@ +set_form_variables +# project_id + +set user_id [ad_get_user_id] +set db [ticket_getdbhandle] + +if { [ticket_user_admin_p $db] != 1} { + ns_returnredirect "index.tcl" + return +} + +# If there are any tickets, then we must refuse to delete the project + +ReturnHeaders + +set project_title [database_to_tcl_string $db "select title +from ticket_projects where project_id = $project_id"] + +ns_write "[ad_admin_header "Delete Project $project_title"] +

    Delete Project $project_title

    +" + +ns_write "[ad_context_bar_ws_or_index "/pvt/home/index.tcl" [list "/admin/ticket/index.tcl" "Ticket Tracker"] $project_title]" + +ns_write "
    " +set selection [ns_db select $db "select ticket_issues.msg_id, one_line, +ticket_priorities.name as priority_name, deadline, close_date, status +from ticket_issues, ticket_priorities +where +ticket_issues.project_id = $project_id +and ticket_priorities.priority = ticket_issues.priority +order by ticket_priorities.priority desc , posting_time"] + +set target "/admin/ticket/project-delete.tcl" + +set count 0 +set last_priority "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $priority_name != $last_priority } { + if { $last_priority != "starting" } { + ns_write "\n" + } + set last_priority $priority_name + ns_write "

    $priority_name

    \n
      \n" + } + ns_write "
    • #$msg_id " + ns_write "[clean_up_html $one_line]" + if { $deadline != "" } { + ns_write " ($deadline)" + } + ns_write "" + if { $close_date != "" } { + ns_write " \[closed\]" + } + + if { [string compare $status "fixed waiting approval"] == 0 } { + ns_write "    (fixed waiting approval)" + } + + if { [string compare $status "need clarification"] == 0 } { + ns_write "    (need clarification)" + } + + ns_write "\n" + incr count +} + + +ns_write " +
      +Warning: If you delete this project, all of the tickets which belong to +it will be deleted as well! + +
      +
      + +
      +
      +" + +ns_write " +[ad_admin_footer] +" Index: web/openacs/www/admin/ticket/project-manage.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ticket/project-manage.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ticket/project-manage.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,31 @@ +# present list of projects, which can be viewed, deleted + +set user_id [ad_get_user_id] +set db [ticket_getdbhandle] + +ReturnHeaders + +ns_write "[ad_admin_header "Delete Projects"] + +

      Delete Projects

      + +[ad_admin_context_bar [list "/admin/ticket/index.tcl" "Ticket Tracker Admin"] "Delete Projects"] +
      +" + +set selection [ns_db select $db "select project_id, title +from ticket_projects order by title"] + +ns_write "
        \n" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
      • $title   delete" + ns_write "\n" +} + +ns_write " +
      + +[ad_admin_footer] +" Index: web/openacs/www/admin/ticket/delete/delete-ticket-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ticket/delete/delete-ticket-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ticket/delete/delete-ticket-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,22 @@ +set_form_variables 0 + +# msg_id + +set db [ticket_getdbhandle] + + +ns_db dml $db "delete from ticket_changes where msg_id = $msg_id" +ns_db dml $db "delete from ticket_issue_assignments where msg_id = $msg_id" + +ns_db dml $db "delete from ticket_xrefs where from_ticket = $msg_id or to_ticket = $msg_id" + +ns_db dml $db "delete from ticket_issue_responses where response_to = $msg_id" + +ns_db dml $db "delete from ticket_issue_notifications where msg_id = $msg_id" + +ns_db dml $db "delete from ticket_issues where msg_id = $msg_id" + +set deleted_msg_id $msg_id + +ns_returnredirect "index.tcl?[export_url_vars deleted_msg_id]" + Index: web/openacs/www/admin/ticket/delete/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ticket/delete/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ticket/delete/index.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,74 @@ +set_form_variables 0 + +# deleted_msg_id [optional] + +set user_id [ad_verify_and_get_user_id] +set db [ticket_getdbhandle] + +ReturnHeaders + +ns_write "[ad_admin_header "Delete Ticket(s)"] + +

      Delete Tickets

      + +[ad_admin_context_bar [list "/admin/ticket/index.tcl" "Ticket Tracker Admin"] "Delete Ticket(s)"] + +
      +

      Delete Tickets

      +Note: deleting a ticket will cause it to be completely removed from the database. +You should think twice about doing this. It is really only appropriate for +bogus tickets, such as those created during debugging. +

      +" + +if {[info exists deleted_msg_id] && ![empty_string_p $deleted_msg_id]} { + ns_write "Deleted ticket #$deleted_msg_id

      " +} + +set selection [ns_db select $db "select ticket_issues.msg_id, one_line, +ticket_priorities.name as priority_name, deadline, close_date, status, title +from ticket_issues, ticket_priorities, ticket_projects +where ticket_projects.project_id = ticket_issues.project_id +and ticket_priorities.priority = ticket_issues.priority +order by ticket_projects.title, ticket_issues.msg_id"] + +set count 0 +set title "" +set last_title "" +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if {$title != $last_title} { + ns_write "

      $title

      " + set last_title $title + } + ns_write "
    • #$msg_id " + ns_write "[clean_up_html $one_line]" + if { $deadline != "" } { + ns_write " ($deadline)" + } + ns_write "" + if { $close_date != "" } { + ns_write " \[closed\]" + } + + if { [string compare $status "fixed waiting approval"] == 0 } { + ns_write "    (fixed waiting approval)" + } + + if { [string compare $status "need clarification"] == 0 } { + ns_write "    (need clarification)" + } + + ns_write " delete" + ns_write "\n" + incr count +} + +if { $count == 0 } { + ns_write "No issues

      " +} + + +ns_write " +[ad_admin_footer] +" Index: web/openacs/www/admin/ug/action-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/action-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/action-add.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,22 @@ +# action-add.tcl,v 3.0 2000/02/06 03:28:27 ron Exp +set_the_usual_form_variables + +# group_id, action + +set exception_count 0 +set exception_text "" + +if { ![info exists action] && [empty_string_p $action] } { + incr exception_count + append exception_text "

    • Please type in a action" +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text +} + +set db [ns_db gethandle] + +ad_user_group_action_add $db $group_id $action + +ns_returnredirect "group.tcl?group_id=$group_id" Index: web/openacs/www/admin/ug/action-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/action-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/action-delete.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,13 @@ +# action-delete.tcl,v 3.0 2000/02/06 03:28:28 ron Exp +set_the_usual_form_variables + +# group_id, action + +set db [ns_db gethandle] + +ns_db dml $db "delete from user_group_actions +where group_id = $group_id +and action = '$QQaction'" + +ns_returnredirect "group.tcl?group_id=$group_id" + Index: web/openacs/www/admin/ug/action-role-map.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/action-role-map.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/action-role-map.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,14 @@ +# action-role-map.tcl,v 3.0 2000/02/06 03:28:29 ron Exp +set_the_usual_form_variables + +# group_id, role, action + + +set db [ns_db gethandle] + +# insert the row if it was not there +ns_db dml $db "insert into user_group_action_role_map (group_id, role, action, creation_user, creation_ip_address) select $group_id, '$QQrole', '$QQaction', [ad_get_user_id], '[DoubleApos [ns_conn peeraddr]]' from dual where not exists (select role from user_group_action_role_map where group_id = $group_id and role = '$QQrole' and action = '$QQaction')" + + +ns_returnredirect "group.tcl?group_id=$group_id" + Index: web/openacs/www/admin/ug/action-role-unmap.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/action-role-unmap.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/action-role-unmap.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,15 @@ +# action-role-unmap.tcl,v 3.0 2000/02/06 03:28:31 ron Exp +set_the_usual_form_variables + +# group_id, role, action + + +set db [ns_db gethandle] + +ns_db dml $db "delete from +user_group_action_role_map +where group_id = $group_id +and role = '$QQrole' and action = '$QQaction'" + +ns_returnredirect "group.tcl?group_id=$group_id" + Index: web/openacs/www/admin/ug/admin-email-alert-policy-update.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/admin-email-alert-policy-update.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/admin-email-alert-policy-update.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,15 @@ +# admin-email-alert-policy-update.tcl,v 3.0 2000/02/06 03:28:32 ron Exp +# Toggle the flag which sends email to admin when a user applies for +# group membership. +# +# Form variables: +# group_id the id of the group + + +set_form_variables + +set db [ns_db gethandle] + +ns_db dml $db "update user_groups set email_alert_p = logical_negation(email_alert_p) where group_id = $group_id" + +ns_returnredirect "group.tcl?[export_url_vars group_id]" Index: web/openacs/www/admin/ug/approved-p-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/approved-p-toggle.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/approved-p-toggle.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,11 @@ +# approved-p-toggle.tcl,v 3.0 2000/02/06 03:28:33 ron Exp +set_the_usual_form_variables + +# group_id + +set db [ns_db gethandle] + +ns_db dml $db "update user_groups set approved_p = logical_negation(approved_p) where group_id = $group_id" + +ns_returnredirect "group.tcl?group_id=$group_id" + Index: web/openacs/www/admin/ug/existence-public-p-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/existence-public-p-toggle.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/existence-public-p-toggle.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,11 @@ +# existence-public-p-toggle.tcl,v 3.0 2000/02/06 03:28:34 ron Exp +set_the_usual_form_variables + +# group_id + +set db [ns_db gethandle] + +ns_db dml $db "update user_groups set existence_public_p = logical_negation(existence_public_p) where group_id = $group_id" + +ns_returnredirect "group.tcl?group_id=$group_id" + Index: web/openacs/www/admin/ug/field-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/field-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/field-add-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,121 @@ +# field-add-2.tcl,v 3.0 2000/02/06 03:28:35 ron Exp +set_the_usual_form_variables + +# group_type, column_name, pretty_name, column_type, column_actual_type +# column_extra, after (optional) + +set exception_count 0 +set exception_text "" + +# DRB: Do some sanity checking, at least! + +if { ![info exists column_name] || [empty_string_p $column_name] } { + incr exception_count + append exception_text "
    • Please type in a column name" +} + +if { ![info exists column_actual_type] || [empty_string_p $column_actual_type] } { + incr exception_count + append exception_text "
    • Please type in a column actual type" +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + + +set db [ns_db gethandle] + +set table_name [ad_user_group_helper_table_name $group_type] + +set alter_sql "alter table $table_name add column $column_name $column_actual_type $column_extra" + +if { [exists_and_not_null after] } { + set sort_key [expr $after + 1] + set update_sql "update user_group_type_fields +set sort_key = sort_key + 1 +where group_type = '$QQgroup_type' +and sort_key > $after" +} else { + set sort_key 1 + set update_sql "" +} + +# DRB: I think this code's pretty ugly. The only error a user gets +# if they enter a duplicate field is due to the "alter table" failing. +# The alter table MUST preceed the insert and update because there +# are no uniqueness constraints on "user_group_type_fields". + +set insert_sql "insert into user_group_type_fields (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) +values +( '$QQgroup_type', '$QQcolumn_name', '$QQpretty_name','$QQcolumn_type', '$QQcolumn_actual_type', [ns_dbquotevalue $column_extra text], $sort_key)" + +with_transaction $db { + ns_db dml $db $alter_sql + if { ![empty_string_p $update_sql] } { + ns_db dml $db $update_sql + } + ns_db dml $db $insert_sql +} { + # an error + ad_return_error "Database Error" "Error while trying to customize $group_type. + +Tried the following SQL: + +
      +
      +$alter_sql
+$update_sql
+$insert_sql    
+
      +
      + +and got back the following: + +
      +
      +$errmsg
+
      +
      + +[ad_admin_footer]" + return +} + +# database stuff went OK +ns_return 200 text/html "[ad_admin_header "Field Added"] + +

      Field Added

      + +to the $pretty_name group type + +
      + +The following action has been taken: + +
        + +
      • a column called \"$column_name\" has been added to the +table $table_name in the database. The sql was +

        + +

        +$alter_sql +
        + + +

        + +

      • a row has been added to the SQL table user_group_type_fields +reflecting that + +
          + +
        • this field has the pretty name (for user interface) of \"$pretty_name\" + +
        +
      + +[ad_admin_footer] +" Index: web/openacs/www/admin/ug/field-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/field-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/field-add.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,63 @@ +# field-add.tcl,v 3.0 2000/02/06 03:28:36 ron Exp +set_the_usual_form_variables + +# group_type, after (optional) + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select * +from user_group_types +where group_type = '$QQgroup_type'"] + +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "Add a field to $pretty_name"] + +

      Add a field

      + +to the $pretty_name group type + +
      + +
      +[export_form_vars group_type after] + +Column Actual Name: +
      +no spaces or special characters except underscore + +

      + +Column Pretty Name: + +

      + + +Column Type: [ad_user_group_column_type_widget] +

      + +Column Actual Type: +(used to feed Oracle, e.g., char(1) instead of boolean) + + +

      + +If you're a database wizard, you might want to add some +extra SQL, such as \"not null\"
      +Extra SQL: + +

      + +(note that you can only truly add not null columns when the table is +empty, i.e., before anyone has entered the contest) + +

      + + + +

      + +[ad_admin_footer] +" Index: web/openacs/www/admin/ug/field-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/field-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/field-delete-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,60 @@ +# field-delete-2.tcl,v 3.0 2000/02/06 03:28:37 ron Exp +set_the_usual_form_variables + +# group_type, column_name + +#DRB Yuck. In Postgres, we can't drop columns from a table. +#I've come up with a gross kludge - generate a dummy name +#and rename the "deleted" column to that. Since it's deleted +#from user_group_type_fields the user won't be able to make +#use of it. As long as inserts explicitly names the columns +#to be inserted, this should work, though it's ugly. + +#We could write a script to create a temp copy, then drop the +#table and rebuild it without the deleted columns if people care. + +#This has to be done stand-alone and after a dump, though, because +#drop table can't be rolled back and a crash would leave it missing. + +set db [ns_db gethandle] + +set table_name [ad_user_group_helper_table_name $group_type] + +set new_name "%" +append new_name [database_to_tcl_string $db "\ + select nextval('user_group_deleted_seq')"] + +with_transaction $db { + ns_db dml $db "delete from user_group_type_fields +where group_type = '$QQgroup_type' +and column_name = '$QQcolumn_name'" + ns_db dml $db "alter table $table_name + rename $column_name to \"$new_name\"" +} { + ad_return_error "Deletion Failed" "We were unable to pseudo-drop the column $column_name from user group type $group_type due to a database error: +
      +$errmsg
+
      +" + return +} + +ns_return 200 text/html "[ad_admin_header "Field Removed"] + +

      Field Removed

      + +from the $group_type group type + +
      + +The following action has been taken: + +
        + +
      • the column \"$column_name\" was removed from the table +$table_name. +
      • a row was removed from the table user_group_type_fields. +
      + +[ad_admin_footer] +" Index: web/openacs/www/admin/ug/field-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/field-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/field-delete.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,27 @@ +# field-delete.tcl,v 3.0 2000/02/06 03:28:38 ron Exp +set_the_usual_form_variables +# group_type, column_name, group_type_pretty_name + +set db [ns_db gethandle] + +ns_return 200 text/html "[ad_admin_header "Delete Field From User Group Type"] + +

      Delete Column $column_name

      + +from the $group_type_pretty_name group type + +
      + +
      +[export_form_vars group_type column_name] + +Do you really want to remove this field from this group type, and all +[database_to_tcl_string $db "select count(*) from user_groups where group_type = '$QQgroup_type'"] groups of this type? +

      +You may not be able to undo this action. +

      + +
      + +[ad_admin_footer] +" Index: web/openacs/www/admin/ug/field-swap.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/field-swap.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/field-swap.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,28 @@ +# field-swap.tcl,v 3.0 2000/02/06 03:28:39 ron Exp +# Swaps two sort keys for group_type, sort_key and sort_key + 1. + +set_the_usual_form_variables +# group_type, sort_key + +set db [ns_db gethandle] + +set next_sort_key [expr $sort_key + 1] + +with_catch errmsg { + ns_db dml $db "update user_group_type_fields +set sort_key = + case when sort_key = $sort_key then $next_sort_key + when sort_key = $next_sort_key then $sort_key + end +where group_type = '$QQgroup_type' +and sort_key in ($sort_key, $next_sort_key)" + + ns_returnredirect "group-type.tcl?group_type=[ns_urlencode $group_type]" +} { + ad_return_error "Database error" "A database error occured while trying +to swap your user group fields. Here's the error: +
      +$errmsg
+
      +" +} Index: web/openacs/www/admin/ug/group-admin-permissions-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-admin-permissions-toggle.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-admin-permissions-toggle.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,13 @@ +# group-admin-permissions-toggle.tcl,v 3.0 2000/02/06 03:28:40 ron Exp +# Form variables: +# group_id the id of the group + + +set_form_variables + +set db [ns_db gethandle] + +ns_db dml $db "update user_groups set group_admin_permissions_p = logical_negation(group_admin_permissions_p) where group_id = $group_id" + + +ns_returnredirect "group.tcl?[export_url_vars group_id]" Index: web/openacs/www/admin/ug/group-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-delete-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,167 @@ +# group-delete-2.tcl,v 3.0 2000/02/06 03:28:41 ron Exp +set_the_usual_form_variables + +# group_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select group_name, group_type +from user_groups +where group_id = $group_id"] +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "Deleting $group_name"] + +

      Deleting $group_name

      + +one of the groups in +[ad_system_name] administration + +
      + +" + +ns_db dml $db "begin transaction" + +ns_write "
        + +
      • Deleting the user-group mappings for groups of this type... + +" + +# user doesn't really need to hear about this +ns_db dml $db "delete from user_group_map_queue where group_id = $group_id" + +ns_db dml $db "delete from user_group_map where group_id = $group_id" + +ns_write "[ns_pg ntuples $db] rows deleted.\n" + +ns_write "
      • Deleting group type specific fields... " + +# fix to check that the helper table exists (BMA) +if {[ns_table exists $db [ad_user_group_helper_table_name $group_type]]} { + ns_db dml $db "delete from [ad_user_group_helper_table_name $group_type] where group_id = $group_id" + + ns_write "[ns_pg ntuples $db] rows deleted.\n" +} + +ns_write "
      • Deleting group specific member fields... " + +ns_db dml $db "delete from user_group_member_fields where group_id = $group_id" + +ns_write "[ns_pg ntuples $db] rows deleted.\n" + +ns_write "
      • Deleting group permissions... " + +ns_db dml $db "delete from user_group_roles where group_id = $group_id" + +ns_write "[ns_pg ntuples $db] rows deleted.\n" + +ns_write "
      • Deleting permission mappings... " + +ns_db dml $db "delete from user_group_action_role_map where group_id = $group_id" + +ns_write "[ns_pg ntuples $db] rows deleted.\n" + +ns_write "
      • Deleting group actions... " + +ns_db dml $db "delete from user_group_actions where group_id = $group_id" + +ns_write "[ns_pg ntuples $db] rows deleted.\n" + +ns_write "
      • Deleting $group_name content section links... " + +ns_db dml $db " +delete from content_section_links +where from_section_id in (select section_id + from content_sections + where scope='group' + and group_id=$group_id) +or to_section_id in (select section_id + from content_sections + where scope='group' + and group_id=$group_id) +" + +ns_write "[ns_pg ntuples $db] rows deleted.\n" + +ns_write "
      • Deleting $group_name content section files... " + +ns_db dml $db " +delete from content_files +where section_id in (select section_id + from content_sections + where scope='group' + and group_id=$group_id) +" + +ns_write "[ns_pg ntuples $db] rows deleted.\n" + +ns_write "
      • Deleting $group_name content sections... " + +ns_db dml $db " +delete from content_sections +where scope='group' +and group_id=$group_id +" + +ns_write "[ns_pg ntuples $db] rows deleted.\n" + +ns_write "
      • Deleting $group_name faqs... " + +ns_db dml $db " +delete from faqs +where scope='group' +and group_id=$group_id +" + +ns_write "[ns_pg ntuples $db] rows deleted.\n" + +ns_write "
      • Deleting $group_name logo... " + +ns_db dml $db " +delete from page_logos +where scope='group' +and group_id=$group_id +" + +ns_write "[ns_pg ntuples $db] rows deleted.\n" + +ns_write "
      • Deleting $group_name css... " + +ns_db dml $db " +delete from css_simple +where scope='group' +and group_id=$group_id +" +ns_write "[ns_pg ntuples $db] rows deleted.\n" + +ns_write "
      • Deleting $group_name downloads ... " + +ns_db dml $db " +delete from downloads +where scope='group' +and group_id=$group_id +" +ns_write "[ns_pg ntuples $db] rows deleted.\n" + +ns_write "
      • Deleting this group... " + +ns_db dml $db "delete from user_groups where group_id = $group_id" + +ns_write "[ns_pg ntuples $db] rows deleted.\n" + + +ns_write "
      • Committing changes...." + +ns_db dml $db "end transaction" + +ns_write " + +
      + +[ad_admin_footer] +" + Index: web/openacs/www/admin/ug/group-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-delete.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,45 @@ +# group-delete.tcl,v 3.0 2000/02/06 03:28:43 ron Exp +set_the_usual_form_variables + +# group_id + +set db [ns_db gethandle] + +set group_name [database_to_tcl_string $db "select group_name +from user_groups +where group_id = $group_id"] + +ReturnHeaders + +ns_write "[ad_admin_header "Delete group_name"] + +

      Delete $group_name

      + +one of the groups in +[ad_system_name] administration + +
      + +You are telling the system to + +
        +
      • remove the $group_name group +
      • remove all the user-group mappings for this gruop (of which there are currently [database_to_tcl_string $db "select count(*) +from user_groups ug, user_group_map ugm +where ug.group_id = ugm.group_id +and ug.group_id = $group_id"]) + +
      + +

      + + +

      + +[export_form_vars group_id] + + +
      + +[ad_admin_footer] +" Index: web/openacs/www/admin/ug/group-info-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-info-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-info-edit-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,33 @@ +# group-info-edit-2.tcl,v 3.0 2000/02/06 03:28:45 ron Exp +set_the_usual_form_variables + +# group_id, group_name + +set db [ns_db gethandle] + +set group_type [database_to_tcl_string $db "select group_type, group_name +from user_groups where group_id = $group_id"] + +set helper_table_name [ad_user_group_helper_table_name [DoubleApos $group_type]] + +# let's use the utilities.tcl procedure util_prepare_insert +# for this we need to produce an ns_conn form-style structure + +set helper_fields [ns_set new] + +foreach helper_column [database_to_tcl_list $db "select column_name from user_group_type_fields where group_type = '[DoubleApos $group_type]'"] { + if [info exists $helper_column] { + ns_set put $helper_fields $helper_column [set $helper_column] + } +} + +if { [ns_set size $helper_fields] > 0 } { + set update_for_helper_table [util_prepare_update $db $helper_table_name group_id $group_id $helper_fields] + + ns_db dml $db $update_for_helper_table +} + + + +ns_returnredirect "group.tcl?group_id=$group_id" + Index: web/openacs/www/admin/ug/group-info-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-info-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-info-edit.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,73 @@ +# /admin/ug/group-info-edit.tcl +# +# author/creation date unknown +# +# group-info-edit.tcl,v 3.0.4.1 2000/03/17 18:51:43 aure Exp + +ad_page_variables {group_id} + +set user_id [ad_get_user_id] +if {$user_id == 0} { + ns_returnredirect /register.tcl?return_url=[ns_urlencode "/admin/ug/group.tcl?[export_url_vars group_id]"] + return +} + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select group_type, group_name +from user_groups where group_id = $group_id"] +set_variables_after_query + +set info_table_name [ad_user_group_helper_table_name $group_type] + + +set page_content "[ad_admin_header "Edit $group_name"] + +

      Edit information

      + +for $group_name + +
      +
      +[export_form_vars group_id] +" + +if [ns_table exists $db $info_table_name] { + set selection [ns_db 0or1row $db "select * from $info_table_name where group_id = $group_id"] + if { $selection != "" } { + set_variables_after_query + } +} + set selection [ns_db select $db "select column_name, pretty_name, column_type from user_group_type_fields where group_type = '[DoubleApos $group_type]' order by sort_key"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + # ns_write "\n" + append page_content "\n" + } + + + +append page_content " +
      $pretty_name
      $pretty_name [ad_user_group_type_field_form_element $column_name $column_type [set $column_name]]
      +

      +

      + +
      +
      + + +[ad_admin_footer] +" + +# release the database handle +ns_db releasehandle $db + +# serve the page +ns_return 200 text/html $page_content + + + + + + Index: web/openacs/www/admin/ug/group-member-field-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-member-field-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-member-field-add-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,75 @@ +# group-member-field-add-2.tcl,v 3.0 2000/02/06 03:28:48 ron Exp +set_the_usual_form_variables + +# group_id, field_name, column_type, after (optional) + +set db [ns_db gethandle] + +#DRB: The view this page uses in the Oracle implemenation can't be defined in +#Postgres 6.5 because it contains a union. + +set selection [ns_db 0or1row $db "\ + select 1 + where + exists (select * + from user_group_type_member_fields ugtmf, user_groups ug + where ug.group_id = $group_id + and ug.group_type = ugtmf.group_type + and ugtmf.field_name = '$QQfield_name') or + exists (select * + from user_group_member_fields ugmf + where ugmf.group_id = $group_id and + ugmf.field_name = '$QQfield_name')"] + + +if { $selection != "" } { + ns_db flush $db + ad_return_complaint 1 "Either this group or its group type already has a field named \"$field_name\"." + return +} + +if { [exists_and_not_null after] } { + set sort_key [expr $after + 1] + set update_sql "update user_group_member_fields +set sort_key = sort_key + 1 +where group_id = $group_id +and sort_key > $after" +} else { + set sort_key 1 + set update_sql "" +} + +set insert_sql "insert into user_group_member_fields (group_id, field_name, field_type, sort_key) +values +( $group_id, '$QQfield_name', '$QQcolumn_type', $sort_key)" + +set group_name [database_to_tcl_string $db "select group_name from user_groups where group_id = $group_id"] + +with_transaction $db { + if { ![empty_string_p $update_sql] } { + ns_db dml $db $update_sql + } + ns_db dml $db $insert_sql +} { + # an error + ad_return_error "Database Error" "Error while trying to customize group $group_name. + +Database error message was: +
      +
      +$errmsg
+
      +
      +" + return +} + +# database stuff went OK +ns_return 200 text/html "[ad_admin_header "Member Field Added"] + +

      Member Field Added

      + +to the $group_name group + +[ad_admin_footer] +" Index: web/openacs/www/admin/ug/group-member-field-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-member-field-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-member-field-add.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,40 @@ +# group-member-field-add.tcl,v 3.0 2000/02/06 03:28:50 ron Exp +set_the_usual_form_variables + +# group_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select group_name +from user_groups +where group_id = $group_id"] + +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "Add a member field to $group_name"] + +

      Add a member field

      + +to the $group_name group + +
      + +
      +[export_form_vars group_id after] + +Field Name: + +

      + +Column Type: [ad_user_group_column_type_widget] + +

      + + + +

      + +[ad_admin_footer] +" Index: web/openacs/www/admin/ug/group-member-field-swap.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-member-field-swap.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-member-field-swap.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,26 @@ +# group-member-field-swap.tcl,v 3.0 2000/02/06 03:28:51 ron Exp +# Swaps two sort keys for group_id, sort_key and sort_key + 1. + +set_the_usual_form_variables +# group_id, sort_key + +set db [ns_db gethandle] + +set next_sort_key [expr $sort_key + 1] + +with_catch errmsg { + ns_db dml $db "update user_group_member_fields + set sort_key = case when sort_key=$sort_key then $next_sort_key + when sort_key=$next_sort_key then $sort_key end +where group_id = $group_id +and sort_key in ($sort_key, $next_sort_key)" + + ns_returnredirect "group.tcl?group_id=$group_id" +} { + ad_return_error "Database error" "A database error occured while trying +to swap your user group fields. Here's the error: +
      +$errmsg
+
      +" +} Index: web/openacs/www/admin/ug/group-module-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-module-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-module-add-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,61 @@ +# group-module-add-2.tcl,v 3.0 2000/02/06 03:28:53 ron Exp +# File: /admin/ug/group-module-add-2.tcl +# Date: 12/31/99 +# Contact: tarik@arsdigita.com +# Purpose: adding a module to the group + +set_the_usual_form_variables +# module_key, group_id, section_id + +set db [ns_db gethandle] + +set return_url "group.tcl?[export_url_vars group_id]" + +if [catch { + set section_key [database_to_tcl_string $db " + select uniq_group_module_section_key('$QQmodule_key', $group_id) from dual"] + + ns_db dml $db " + insert into content_sections + (section_id, section_key, section_pretty_name, scope, group_id, section_type, module_key, + requires_registration_p, visibility, enabled_p) + select $section_id, '[DoubleApos $section_key]', pretty_name, 'group', $group_id, + section_type_from_module_key(module_key), module_key, 'f', 'public', 't' + from acs_modules where module_key='$QQmodule_key' + " +} errmsg] { + # Oracle choked on the insert + + # detect double click + set selection [ns_db 0or1row $db " + select section_id + from content_sections + where section_id=$section_id"] + + if { ![empty_string_p $selection] } { + # it's a double click, so just redirct the user to the index page + set_variables_after_query + ns_returnredirect $return_url + return + } + + ad_return_error "Error in insert" "We were unable to do your insert in the database. + Here is the error that was returned: +

      +

      + 
      +    $errmsg
+
      +
      " + return +} + +ns_returnredirect $return_url + + + + + + + + Index: web/openacs/www/admin/ug/group-module-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-module-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-module-add.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,72 @@ +# group-module-add.tcl,v 3.0 2000/02/06 03:28:54 ron Exp +# File: /admin/ug/group-module-add.tcl +# Date: 12/31/99 +# Contact: tarik@arsdigita.com +# Purpose: adding a module to the group + +set_the_usual_form_variables +# group_id + +ReturnHeaders + +set page_title "Add Module" + +set db [ns_db gethandle] +set group_name [database_to_tcl_string $db "select group_name from user_groups where group_id=$group_id"] +set section_id [database_to_tcl_string $db "select content_section_id_sequence.nextval from dual"] + + +ns_write " +[ad_admin_header $page_title] +

      $page_title

      +[ad_admin_context_bar [list "group.tcl?[export_url_vars group_id]" "$group_name"] $page_title] +
      +" +set selection [ns_db select $db " +select module_key, pretty_name +from acs_modules +where supports_scoping_p='t' +and module_key not in (select module_key + from content_sections + where scope='group' and group_id=$group_id + and (section_type='system' or section_type='admin'))"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + lappend name_list $pretty_name + lappend key_list $module_key +} + +append html " +
      +[export_form_vars section_id group_id] + + + +
      Module[ns_htmlselect -labels $name_list module_key $key_list]
      + +

      +

      + +
      +
      +

      +" + +ns_write " +

      +$html +
      +[ad_scope_admin_footer] +" + + + + + + + + + + Index: web/openacs/www/admin/ug/group-module-remove-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-module-remove-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-module-remove-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,55 @@ +# group-module-remove-2.tcl,v 3.0 2000/02/06 03:28:56 ron Exp +# File: /admin/ug/group-module-remove-2.tcl +# Date: 01/01/2000 +# Contact: tarik@arsdigita.com +# Purpose: removes association between module and the group + +set_the_usual_form_variables +# group_id, module_key, confirm_button + +set return_url "group.tcl?group_id=$group_id" + +if { [string compare $confirm_button yes]!=0 } { + ns_returnredirect $return_url + return +} + +set db [ns_db gethandle] + +ns_db dml $db "begin transaction" + +ns_db dml $db " +delete from content_section_links +where from_section_id=(select section_id + from content_sections + where scope='group' + and group_id=$group_id + and module_key='$QQmodule_key') +or to_section_id=(select section_id + from content_sections + where scope='group' + and group_id=$group_id + and module_key='$QQmodule_key') +" + +ns_db dml $db " +delete from content_files +where section_id=(select section_id + from content_sections + where scope='group' + and group_id=$group_id + and module_key='$QQmodule_key') +" + +ns_db dml $db " +delete from content_sections +where scope='group' +and group_id=$group_id +and module_key='$QQmodule_key' +" + +ns_db dml $db "end transaction" + +ns_returnredirect $return_url + + Index: web/openacs/www/admin/ug/group-module-remove.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-module-remove.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-module-remove.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,40 @@ +# group-module-remove.tcl,v 3.0 2000/02/06 03:28:57 ron Exp +# File: /admin/ug/group-module-remove.tcl +# Date: 01/01/2000 +# Contact: tarik@arsdigita.com +# Purpose: confirmation page for removing association between module and the group + +set_the_usual_form_variables +# group_id, module_key + +set db [ns_db gethandle] +set group_name [database_to_tcl_string $db " +select group_name from user_groups where group_id=$group_id"] + +set page_title "Remove Module" + +ns_return 200 text/html " +[ad_admin_header $page_title] +

      $page_title

      +[ad_admin_context_bar [list "/admin/ug/" "Group Administration"] \ + [list "group.tcl?group_id=$group_id" "$group_name Administration"] \ + "Confirm Module Removal"] +
      +
      +

      Confirm Module Removal

      + +
      Warning: +Removing module implies that users of $group_name will not be able to use this module. +
      +
      Are you sure you want to proceed ? +
      +[export_form_vars group_id module_key] + +[ad_space 5] +
      +
      +[ad_footer] +" + + + Index: web/openacs/www/admin/ug/group-name-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-name-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-name-edit-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,24 @@ +# group-name-edit-2.tcl,v 3.0 2000/02/06 03:28:58 ron Exp +# +# group-name-edit-2.tcl +# +# actually updates the group_name column in the user_groups table +# + +set_the_usual_form_variables + +# group_id, group_name + +if [empty_string_p $QQgroup_name] { + ad_return_complaint 1 "
    • you shouldn't rename a group to the empty string! Please type a name." + return +} + +set db [ns_db gethandle] + +ns_db dml $db "update user_groups +set group_name = '$QQgroup_name' +where group_id = $group_id" + +ns_returnredirect "group.tcl?group_id=$group_id" + Index: web/openacs/www/admin/ug/group-name-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-name-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-name-edit.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,42 @@ +# group-name-edit.tcl,v 3.0 2000/02/06 03:29:00 ron Exp +set_the_usual_form_variables + +# group_id + + +set user_id [ad_get_user_id] +if {$user_id == 0} { + ns_returnredirect /register.tcl?return_url=[ns_urlencode "/admin/ug/group.tcl?[export_url_vars group_id]"] + return +} + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select ug.*, first_names, last_name +from user_groups ug, users u +where group_id = $group_id +and ug.creation_user = u.user_id"] +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "Rename $group_name"] + +

      Rename $group_name

      + +[ad_admin_context_bar [list "index.tcl" "User Groups"] [list "group-type.tcl?[export_url_vars group_type]" "One Group Type"] [list "group.tcl?group_id=$group_id" "One Group"] "Rename"] + +
      + +
      +[export_form_vars group_id] +New Name: +

      +

      + +
      +
      + + +[ad_admin_footer] +" Index: web/openacs/www/admin/ug/group-shortname-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-shortname-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-shortname-edit-2.tcl 17 Apr 2001 14:05:09 -0000 1.1 @@ -0,0 +1,24 @@ +# group-shortname-edit-2.tcl,v 3.0 2000/02/06 03:29:02 ron Exp +# +# group-shortname-edit-2.tcl +# +# actually updates the short_name column in the user_groups table +# + +set_the_usual_form_variables + +# group_id, short_name + +if [empty_string_p $QQshort_name] { + ad_return_complaint 1 "
    • you shouldn't change shortname of a group to the empty string! Please type a shortname." + return +} + +set db [ns_db gethandle] + +ns_db dml $db "update user_groups +set short_name = '$QQshort_name' +where group_id = $group_id" + +ns_returnredirect "group.tcl?group_id=$group_id" + Index: web/openacs/www/admin/ug/group-shortname-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-shortname-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-shortname-edit.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,42 @@ +# group-shortname-edit.tcl,v 3.0 2000/02/06 03:29:03 ron Exp +set_the_usual_form_variables + +# group_id + + +set user_id [ad_get_user_id] +if {$user_id == 0} { + ns_returnredirect /register.tcl?return_url=[ns_urlencode "/admin/ug/group.tcl?[export_url_vars group_id]"] + return +} + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select ug.*, first_names, last_name +from user_groups ug, users u +where group_id = $group_id +and ug.creation_user = u.user_id"] +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "Edit Shortname $short_name"] + +

      Edit Shortname $short_name

      + +[ad_admin_context_bar [list "index.tcl" "User Groups"] [list "group-type.tcl?[export_url_vars group_type]" "One Group Type"] [list "group.tcl?group_id=$group_id" "One Group"] "Edit Shortname"] + +
      + +
      +[export_form_vars group_id] +New Shortname: +

      + + + +

      + + +[ad_admin_footer] +" Index: web/openacs/www/admin/ug/group-type-all-members.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-type-all-members.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-type-all-members.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,77 @@ +# group-type-all-members.tcl,v 3.0 2000/02/06 03:29:04 ron Exp +set_the_usual_form_variables + +# group_type + +set user_id [ad_get_user_id] +if {$user_id == 0} { + ns_returnredirect /register.tcl?return_url=[ns_urlencode "/admin/ug/group.tcl?[export_url_vars group_type]"] + return +} + + + + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select * from user_group_types where group_type = '$QQgroup_type'"] + +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "$pretty_name"] + +

      $pretty_name

      + +one of the group types in +[ad_system_name] administration + +
      + +
        +" + +# Note that here the only reason we grab parent_name is to order by it +# to force children beneath their parent while keeping the top nodes alphabetical +set selection [ns_db select $db \ + "select ug.group_id, ug.group_name, ug.registration_date, ug.approved_p, + user_groups_number_members(ug.group_id) as n_members, + user_group_hierarchy_level(ug.group_id, 0, 0) as level, + user_group_name_from_id(ug.parent_group_id) as parent_name + from user_groups ug + where group_type = '$QQgroup_type' + and user_group_hierarchy_level(ug.group_id, 0, 0) is not null + order by user_group_hierarchy_sortkey(ug.group_id, 0, '')"] + +set html "" +set current_level 1 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $level > $current_level } { + append html "
          \n" + incr current_level + } elseif { $level < $current_level } { + append html "
        \n" + set current_level [expr $current_level - 1] + } + append html "
      • $group_name ($n_members [util_decode $n_members 1 member members])" + if { $approved_p == "f" } { + append html " not approved" + } + append html "\n" +} +if { [exists_and_not_null level] && $level <= $current_level } { + append html "
      \n" +} +if { [empty_string_p $html] } { + set html "
    • None\n" +} + +ns_db releasehandle $db + +ns_write " +$html +
    +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ug/group-type-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-type-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-type-delete-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,175 @@ +# group-type-delete-2.tcl,v 3.0 2000/02/06 03:29:06 ron Exp +set_the_usual_form_variables + +# group_type + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select * from user_group_types where group_type = '$QQgroup_type'"] + +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "Deleting $pretty_name"] + +

    Deleting $pretty_name

    + +one of the group types in +[ad_system_name] administration + +
    + +" + +ns_db dml $db "begin transaction" + +ns_write "
      + +
    • Deleting the user-group mappings for groups of this type... + +" + +# user doesn't really need to hear about this +ns_db dml $db "delete from user_group_map_queue where group_id in (select group_id from user_groups where group_type = '$QQgroup_type')" + +ns_db dml $db "delete from user_group_map where group_id in (select group_id from user_groups where group_type = '$QQgroup_type')" + +ns_db dml $db " +delete from content_section_links +where from_section_id in (select section_id + from content_sections + where scope='group' + and user_group_group_type(group_id)='$QQgroup_type') +or to_section_id in (select section_id + from content_sections + where scope='group' + and user_group_group_type(group_id)='$QQgroup_type') +" + +ns_db dml $db " +delete from content_files +where section_id in (select section_id + from content_sections + where scope='group' + and user_group_group_type(group_id)='$QQgroup_type') +" + +ns_db dml $db " +delete from content_sections +where scope='group' +and user_group_group_type(group_id)='$QQgroup_type' +" + +ns_write "[ns_pg ntuples $db] rows deleted.\n" + +ns_write " + +
    • Deleting the groups of this type... + +" + +ns_write "
    • Deleting groups faqs... " + +ns_db dml $db " +delete from faqs +where scope='group' +and user_group_group_type(group_id)='$QQgroup_type' +" + +ns_write "[ns_pg ntuples $db] rows deleted.\n" + +ns_write "
    • Deleting groups logos... " + +ns_db dml $db " +delete from page_logos +where scope='group' +and user_group_group_type(group_id)='$QQgroup_type' +" + +ns_write "[ns_pg ntuples $db] rows deleted.\n" + +ns_write "
    • Deleting groups css... " + +ns_db dml $db " +delete from css_simple +where scope='group' +and user_group_group_type(group_id)='$QQgroup_type' +" +ns_write "[ns_pg ntuples $db] rows deleted.\n" + +ns_write "
    • Deleting groups address books... " + +ns_db dml $db " +delete from address_book +where scope='group' +and user_group_group_type(group_id)='$QQgroup_type' +" +ns_write "[ns_pg ntuples $db] rows deleted.\n" + +ns_write "
    • Deleting groups downloads ... " + +ns_db dml $db " +delete from downloads +where scope='group' +and user_group_group_type(group_id)='$QQgroup_type' +" +ns_write "[ns_pg ntuples $db] rows deleted.\n" + +ns_db dml $db "delete from user_groups where group_type = '$QQgroup_type'" + +ns_write "[ns_pg ntuples $db] rows deleted. + +
    • Deleting rows about which extra fields to store for this kind of group... +" + +ns_db dml $db "delete from user_group_type_fields where group_type = '$QQgroup_type'" + +ns_write "[ns_pg ntuples $db] rows deleted." + +ns_write "
    • Deleting any group type specific member fields... " + +ns_db dml $db "delete from user_group_type_member_fields where group_type = '$QQgroup_type'" + +ns_write "[ns_pg ntuples $db] rows deleted." + +ns_write " +
    • Removing the modules associated with $pretty_name ... +" + +ns_db dml $db " +delete from user_group_type_modules_map +where group_type='$QQgroup_type' +" + +ns_write "[ns_pg ntuples $db] rows deleted." + +ns_write " +
    • Deleting the row from the user_group_types table... +" + +ns_db dml $db "delete from user_group_types where group_type = '$QQgroup_type'" + +ns_write "[ns_pg ntuples $db] rows deleted. + +
    • Committing changes.... +" + +set info_table_name "${QQgroup_type}_info" + +if [ns_table exists $db [string tolower $info_table_name]] { + ns_write " +
    • Deleting the special table to hold group info... +" + ns_db dml $db "drop table $info_table_name" + ns_write "done.\n" +} + +ns_db dml $db "end transaction" + +ns_write " + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ug/group-type-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-type-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-type-delete.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,49 @@ +# group-type-delete.tcl,v 3.0 2000/02/06 03:29:07 ron Exp +set_the_usual_form_variables + +# group_type + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select * from user_group_types where group_type = '$QQgroup_type'"] + +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "Delete $pretty_name"] + +

    Delete $pretty_name

    + +one of the group types in +[ad_system_name] administration + +
    + +This is not an action to be taken lightly. You are telling the system to + +
      +
    • remove the $pretty_name group type +
    • remove all the groups of this type (of which there are currently [database_to_tcl_string $db "select count(*) from user_groups where group_type = '$QQgroup_type'"]) +
    • remove all the user-group mappings for groups of this type (of which there are currently [database_to_tcl_string $db "select count(*) +from user_groups ug, user_group_map ugm +where ug.group_id = ugm.group_id +and ug.group_type = '$QQgroup_type'"]) + + +
    + +

    + + +

    +
    +[export_form_vars group_type] + +
    +
    + + + +[ad_admin_footer] +" Index: web/openacs/www/admin/ug/group-type-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-type-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-type-edit-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,132 @@ +# group-type-edit-2.tcl,v 3.0 2000/02/06 03:29:09 ron Exp +set_the_usual_form_variables + +# group_type, plus all the other group type variables from the form +# group_type_module_id (necessary for insertion of content-sections module +# into content_sections table in the case group_module_administration is enabling or full) + +set db [ns_db gethandle] +set update_statement [util_prepare_update $db user_group_types group_type $group_type [ns_getform]] + +set return_url "group-type.tcl?[export_url_vars group_type]" + +if [catch { + ns_db dml $db "begin transaction" + + # this updates the user_group_types table per data entered in the form + ns_db dml $db $update_statement + + if { $group_module_administration=="full" } { + # we are giving full module administration to the groups + # in this case we shouldn't have any group_type to module mappings, + # so that we can guarantee constistency in module mappings in the case + # module administration is switched to enabling or none + ns_db dml $db " + delete from user_group_type_modules_map where group_type='$QQgroup_type' + " + } + + if { $group_module_administration=="full" || $group_module_administration=="enabling" } { + # if group_module_administration is full or enabling we want to make sure that content-sections + # module is installed (otherwise, group_module_administration doesn't make sense) + + set module_key "content-sections" + set QQmodule_key [DoubleApos $module_key] + + ns_db dml $db " + insert into user_group_type_modules_map + (group_type_module_id, group_type, module_key) + select $group_type_module_id, '$QQgroup_type', '$QQmodule_key' + from dual where not exists (select 1 from user_group_type_modules_map + where group_type='$QQgroup_type' and module_key='$QQmodule_key') + " + + set selection [ns_db 1row $db " + select pretty_name as module_pretty_name, section_type_from_module_key(module_key) as section_type + from acs_modules where module_key='$QQmodule_key'"] + set_variables_after_query + + # select all the groups of this group type, which don't have this module already installed + set selection [ns_db select $db " + select content_sections.group_id as module_existing_group_id + from content_sections, user_groups + where content_sections.scope='group' + and content_sections.group_id=user_groups.group_id + and user_groups.group_type='$QQgroup_type' + and module_key='$QQmodule_key' for update"] + + set existing_module_groups_counter 0 + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + lappend existing_module_groups_list $module_existing_group_id + incr existing_module_groups_counter + } + + if { $existing_module_groups_counter > 0 } { + set existing_modules_sql "and group_id not in ([join $existing_module_groups_list ", "])" + } else { + set existing_modules_sql "" + } + + set selection [ns_db select $db " + select group_id as insert_group_id, + uniq_group_module_section_key('$QQmodule_key', group_id) as insert_section_key + from user_groups + where group_type='$QQgroup_type' + $existing_modules_sql for update"] + + set insertion_sql_list [list] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + lappend insertion_sql_list " + insert into content_sections + (section_id, scope, section_type, requires_registration_p, visibility, group_id, + section_key, module_key, section_pretty_name, enabled_p) + values + (nextval('content_section_id_sequence'), 'group', '[DoubleApos $section_type]', 'f', 'public', $insert_group_id, + '[DoubleApos $insert_section_key]', '$QQmodule_key', '[DoubleApos $module_pretty_name]', 't') + " + } + + foreach insertion_sql $insertion_sql_list { + ns_db dml $db $insertion_sql + } + } + + ns_db dml $db "end transaction" +} errmsg] { + # Oracle choked on the insert + ns_db dml $db "abort transaction" + + # detect double click + set selection [ns_db 0or1row $db " + select 1 + from user_group_type_modules_map + where group_type_module_id= $group_type_module_id"] + + if { ![empty_string_p $selection] } { + # it's a double click, so just redirect the user to the index page + ns_returnredirect $return_url + return + } + + ns_log Error "[info script] choked. Oracle returned error: $errmsg" + + ad_return_error "Error in insert" " + We were unable to do your insert in the database. + Here is the error that was returned: +

    +

    + 
    +    $errmsg
+
    +
    " + return +} + +ns_returnredirect $return_url + + + Index: web/openacs/www/admin/ug/group-type-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-type-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-type-edit.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,71 @@ +# group-type-edit.tcl,v 3.0 2000/02/06 03:29:11 ron Exp +# File: /admin/ug/group-type-edit.tcl +# Date: 22/12/99 +# Contact: tarik@arsdigita.com +# Purpose: editing user group type properties + +set_the_usual_form_variables + +# group_type + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select * from user_group_types where group_type = '$QQgroup_type'"] +set group_type_module_id [database_to_tcl_string $db " +select group_type_modules_id_sequence.nextval from dual"] + +set_variables_after_query + +ns_return 200 text/html " +[ad_admin_header "Edit $pretty_name"] +

    Edit $pretty_name

    +one of the group types in +[ad_system_name] administration +
    + +
    +
    +[export_form_vars group_type group_type_module_id] + + + + + + + + + + + + + + + +
    Pretty Name + +
    Plural Version of Name + +
    Approval Policy +[ns_htmlselect -labels { "Open: Users can create groups of this type" \ + "Wait: Users can suggest groups" \ + "Closed: Only administrators can create groups" }\ + approval_policy {open wait closed} $approval_policy] +
    Default New Member Policy +[eval "ns_htmlselect -labels \{\"Open: Users will be able to join $pretty_plural\" \ + \"Wait: Users can apply to join $pretty_plural\" \ + \"Closed: Only administrators can put users in $pretty_plural\" \} \ + default_new_member_policy \{open wait closed\} $default_new_member_policy"] +
    Group Module Administration +[ns_htmlselect -labels {Complete "Enabling/Disabling" None} \ + group_module_administration \ + {full enabling none} \ + $group_module_administration] +
    + +

    +

    + +
    +
    +[ad_admin_footer] +" Index: web/openacs/www/admin/ug/group-type-member-field-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-type-member-field-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-type-member-field-add-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,92 @@ +# group-type-member-field-add-2.tcl,v 3.0 2000/02/06 03:29:12 ron Exp +set_the_usual_form_variables + +# group_type, field_name, column_type, after (optional) + +set db [ns_db gethandle] + + +#DRB This query breaks Postgres, I've split it in two and used the +#occasion to give a more specific error message. + +#set n_fields_with_this_name [database_to_tcl_string $db "select count(*) +#from (select 1 +#from user_group_type_member_fields +#where group_type = '$QQgroup_type' +#and field_name = '$QQfield_name' +#union +#select 1 +#from user_group_member_fields +#where group_id in (select group_id from user_groups where group_type = '$QQgroup_type') +#and field_name = '$QQfield_name')"] + +set n_fields_with_this_name [database_to_tcl_string $db "select count(*) + from user_group_type_member_fields + where group_type = '$QQgroup_type' and field_name = '$QQfield_name'"] + +if { $n_fields_with_this_name > 0 } { + ad_return_complaint 1 "This group type already has a field named \"$field_name\"." + return +} + +set n_fields_with_this_name [database_to_tcl_string $db "select count(*) + from user_group_member_fields + where group_id = + (select group_id from user_groups where group_type = 'QQgroup_type') + and field_name = '$QQfield_name'"] + +if { $n_fields_with_this_name > 0 } { + ad_return_complaint 1 "One of this group type's groups already has a field named \"$field_name\"." + return +} + + +if { $n_fields_with_this_name > 0 } { + ad_return_complaint 1 "Either this group type or one of its groups already has a field named \"$field_name\"." + return +} + +if { [exists_and_not_null after] } { + set sort_key [expr $after + 1] + set update_sql "update user_group_type_member_fields +set sort_key = sort_key + 1 +where group_type = '$QQgroup_type' +and sort_key > $after" +} else { + set sort_key 1 + set update_sql "" +} + +set insert_sql "insert into user_group_type_member_fields (group_type, field_name, field_type, sort_key) +values +( '$QQgroup_type', '$QQfield_name', '$QQcolumn_type', $sort_key)" + + +with_transaction $db { + if { ![empty_string_p $update_sql] } { + ns_db dml $db $update_sql + } + ns_db dml $db $insert_sql +} { + # an error + ad_return_error "Database Error" "Error while trying to customize $group_type. + +Database error message was: +
    +
    +$errmsg
+
    +
    +" + return +} + +# database stuff went OK +ns_return 200 text/html "[ad_admin_header "Member Field Added"] + +

    Member Field Added

    + +to the [database_to_tcl_string $db "select pretty_name from user_group_types where group_type = '$QQgroup_type'"] group type + +[ad_admin_footer] +" Index: web/openacs/www/admin/ug/group-type-member-field-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-type-member-field-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-type-member-field-add.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,40 @@ +# group-type-member-field-add.tcl,v 3.0 2000/02/06 03:29:13 ron Exp +set_the_usual_form_variables + +# group_type + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select * +from user_group_types +where group_type = '$QQgroup_type'"] + +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "Add a member field to $pretty_name"] + +

    Add a member field

    + +to the $pretty_name group type + +
    + + +[export_form_vars group_type after] + +Field Name: + +

    + +Column Type: [ad_user_group_column_type_widget] + +

    + + + + + +[ad_admin_footer] +" Index: web/openacs/www/admin/ug/group-type-member-field-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-type-member-field-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-type-member-field-delete-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,67 @@ +# group-type-member-field-delete-2.tcl,v 3.0 2000/02/06 03:29:14 ron Exp +set_the_usual_form_variables + +# group_type, field_name + +set db [ns_db gethandle] + +set table_name [ad_user_group_helper_table_name $group_type] + +with_transaction $db { + + set ugmfm_count [database_to_tcl_string $db "select count(*) +from user_group_member_field_map +where field_name = '$QQfield_name'"] + + set ugtmf_count [database_to_tcl_string $db "select count(*) +from user_group_type_member_fields +where group_type = '$QQgroup_type' +and field_name = '$QQfield_name'"] + + ns_db dml $db "delete from user_group_member_field_map +where field_name = '$QQfield_name'" + ns_db dml $db "delete from user_group_type_member_fields +where group_type = '$QQgroup_type' +and field_name = '$QQfield_name'" + +} { + ad_return_error "Deletion Failed" "We were unable to drop the column $field_name from user group type $group_type due to a database error: +

    +$errmsg
+
    +" + return +} + +ns_return 200 text/html "[ad_admin_header "Field Removed"] + +

    Field Removed

    + +from the $group_type group type + +
    + +The following actions were performed: + +
      +" +if {$ugtmf_count == 1} { + ns_write " +
    • $ugtmf_count row removed from the table user_group_type_member_fields." +} else { + ns_write " +
    • $ugtmf_count rows removed from the table user_group_type_member_fields." +} +if {$ugmfm_count == 1} { + ns_write " +
    • $ugmfm_count row removed from the table user_group_member_field_map." +} else { + ns_write " +
    • $ugmfm_count rows removed from the table user_group_member_field_map." +} +ns_write " + +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ug/group-type-member-field-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-type-member-field-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-type-member-field-delete.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,27 @@ +# group-type-member-field-delete.tcl,v 3.0 2000/02/06 03:29:15 ron Exp +set_the_usual_form_variables +# group_type, field_name, group_type_pretty_name + +set db [ns_db gethandle] + +ns_return 200 text/html "[ad_admin_header "Delete Field From User Group Type"] + +

    Delete Column $field_name

    + +from the $group_type_pretty_name group type + +
    + +
    +[export_form_vars group_type field_name] + +Do you really want to remove this field from this group type, and all +[database_to_tcl_string $db "select count(*) from user_groups where group_type = '$QQgroup_type'"] groups of this type? +

    +You may not be able to undo this action. +

    + +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/ug/group-type-member-field-swap.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-type-member-field-swap.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-type-member-field-swap.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,28 @@ +# group-type-member-field-swap.tcl,v 3.0 2000/02/06 03:29:16 ron Exp +# Swaps two sort keys for group_type, sort_key and sort_key + 1. + +set_the_usual_form_variables +# group_type, sort_key + +set db [ns_db gethandle] + +set next_sort_key [expr $sort_key + 1] + +with_catch errmsg { + ns_db dml $db "update user_group_type_member_fields +set sort_key = + case when sort_key = $sort_key then $next_sort_key + when sort_key = $next_sort_key then $sort_key + end +where group_type = '$QQgroup_type' +and sort_key in ($sort_key, $next_sort_key)" + + ns_returnredirect "group-type.tcl?group_type=[ns_urlencode $group_type]" +} { + ad_return_error "Database error" "A database error occured while trying +to swap your user group fields. Here's the error: +
    +$errmsg
+
    +" +} Index: web/openacs/www/admin/ug/group-type-module-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-type-module-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-type-module-add-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,125 @@ +# group-type-module-add-2.tcl,v 3.0 2000/02/06 03:29:18 ron Exp +# File: /admin/ug/group-type-module-add-2.tcl +# Date: 22/12/99 +# Contact: tarik@arsdigita.com +# Purpose: associates module with the group type + +set_the_usual_form_variables +# group_type_module_id, group_type, module_key +# maybe return_url + +if { ![info exists return_url] } { + set return_url "group-type.tcl?group_type=[ns_urlencode $group_type]" +} + +set exception_text "" +set exception_count 0 + +set db_conns [ns_db gethandle [philg_server_default_pool] 2] +set db [lindex $db_conns 0] +set db_sub [lindex $db_conns 1] + +if [catch { + ns_db dml $db "begin transaction" + + ns_db dml $db " + insert into user_group_type_modules_map + (group_type_module_id, group_type, module_key) + values + ($group_type_module_id, '$QQgroup_type', '$QQmodule_key') + " + + set selection [ns_db 1row $db " + select pretty_name as module_pretty_name, section_type_from_module_key(module_key) as section_type + from acs_modules where module_key='$QQmodule_key'"] + set_variables_after_query + + # select all the groups of this group type, which don't have this module already installed + set selection [ns_db select $db " + select content_sections.group_id as module_existing_group_id + from content_sections, user_groups + where content_sections.scope='group' + and content_sections.group_id=user_groups.group_id + and user_groups.group_type='$QQgroup_type' + and module_key='$QQmodule_key' for update"] + + set existing_module_groups_counter 0 + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + lappend existing_module_groups_list $module_existing_group_id + incr existing_module_groups_counter + } + + if { $existing_module_groups_counter > 0 } { + set existing_modules_sql "and group_id not in ([join $existing_module_groups_list ", "])" + } else { + set existing_modules_sql "" + } + + set selection [ns_db select $db " + select group_id as insert_group_id, + uniq_group_module_section_key('$QQmodule_key', group_id) as insert_section_key + from user_groups + where group_type='$QQgroup_type' + $existing_modules_sql for update"] + + set insertion_sql_list [list] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + lappend insertion_sql_list " + insert into content_sections + (section_id, scope, section_type, requires_registration_p, visibility, group_id, + section_key, module_key, section_pretty_name, enabled_p) + values + (nextval('content_section_id_sequence'), 'group', '[DoubleApos $section_type]', 'f', 'public', $insert_group_id, + '[DoubleApos $insert_section_key]', '$QQmodule_key', '[DoubleApos $module_pretty_name]', 't') + " + } + + foreach insertion_sql $insertion_sql_list { + ns_db dml $db $insertion_sql + } + + + ns_db dml $db "end transaction" + +} errmsg] { + # Oracle choked on the insert + ns_db dml $db "abort transaction" + + # detect double click + set selection [ns_db 0or1row $db " + select 1 + from user_group_type_modules_map + where group_type_module_id= $group_type_module_id"] + + if { ![empty_string_p $selection] } { + # it's a double click, so just redirect the user to the index page + ns_returnredirect $return_url + return + } + + ns_log Error "[info script] choked. Oracle returned error: $errmsg" + + ad_return_error "Error in insert" " + We were unable to do your insert in the database. + Here is the error that was returned: +

    +

    + 
    +    $errmsg
+
    +
    " + return +} + +ns_returnredirect $return_url + + + + + + + Index: web/openacs/www/admin/ug/group-type-module-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-type-module-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-type-module-add.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,82 @@ +# group-type-module-add.tcl,v 3.0 2000/02/06 03:29:19 ron Exp +# File: /admin/ug/group-type-module-add.tcl +# Date: 22/12/99 +# Contact: tarik@arsdigita.com +# Purpose: associates module with the group type + +set_the_usual_form_variables +# group_type + +ReturnHeaders + +set exception_count 0 +set exception_text "" + +set db [ns_db gethandle] + +set group_type_pretty_name [database_to_tcl_string $db " +select pretty_name as group_type_pretty_name +from user_group_types +where group_type='$QQgroup_type'"] + +set group_type_module_id [database_to_tcl_string $db " +select group_type_modules_id_sequence.nextval from dual"] + +set selection [ns_db select $db " +select module_key, pretty_name +from acs_modules +where supports_scoping_p='t' +and module_key not in (select module_key + from user_group_type_modules_map + where group_type='$QQgroup_type')"] + +if { [empty_string_p $selection] } { + incr exception_count + append exception_text " + No modules available for adding. All modules supporting scoping have already been associated with $group_type_pretty_name. + " + ad_return_complaint $exception_count $exception_text + return +} + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + lappend module_name_list $pretty_name + lappend module_key_list $module_key +} + +append modules_html " +Select Module +[ad_space 2] [ns_htmlselect -labels $module_name_list module_key $module_key_list] +" + + +ns_write " +[ad_admin_header "Add a module to $group_type_pretty_name group type"] +

    Add Module

    +to the $group_type_pretty_name group type +
    +" + +append html " + +[export_form_vars group_type group_type_module_id] + +$modules_html +
    + +
    + +
    +" + +ns_write " +
    +$html +
    +[ad_admin_footer] +" + + + Index: web/openacs/www/admin/ug/group-type-module-remove-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-type-module-remove-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-type-module-remove-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,70 @@ +# group-type-module-remove-2.tcl,v 3.0 2000/02/06 03:29:21 ron Exp +# File: /admin/ug/group-type-module-remove-2.tcl +# Date: 22/12/99 +# Contact: tarik@arsdigita.com +# Purpose: removes association between module and the group type + +set_the_usual_form_variables +# group_type, module_key, confirm_button + +set return_url "group-type.tcl?group_type=[ns_urlencode $group_type]" + +if { [string compare $confirm_button yes]!=0 } { + ns_returnredirect $return_url + return +} + +set db [ns_db gethandle] + +ns_db dml $db "begin transaction" + +ns_db dml $db " +delete from user_group_type_modules_map +where group_type='$QQgroup_type' and module_key='$QQmodule_key' +" + +ns_db dml $db " +delete from content_section_links +where from_section_id in (select section_id + from content_sections + where scope='group' + and user_group_group_type(group_id)='$QQgroup_type' + and module_key='$QQmodule_key') +or to_section_id in (select section_id + from content_sections + where scope='group' + and user_group_group_type(group_id)='$QQgroup_type' + and module_key='$QQmodule_key') +" + +ns_db dml $db " +delete from content_files +where section_id in (select section_id + from content_sections + where scope='group' + and user_group_group_type(group_id)='$QQgroup_type' + and module_key='$QQmodule_key') +" + +ns_db dml $db " +delete from content_sections +where scope='group' +and user_group_group_type(group_id)='$QQgroup_type' +and module_key='$QQmodule_key' +" + +if { $module_key=="content-sections" } { + # special case: if we are removing content-sections module, we want to make sure + # that group_module_administration is set to none, becase full and enabling group_module_administration + # don't make sense if content-sections module is not installed + ns_db dml $db " + update user_group_types set group_module_administration='none' where group_type='$QQgroup_type' + " +} + +ns_db dml $db "end transaction" + +ns_returnredirect $return_url + + + Index: web/openacs/www/admin/ug/group-type-module-remove.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-type-module-remove.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-type-module-remove.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,40 @@ +# group-type-module-remove.tcl,v 3.0 2000/02/06 03:29:22 ron Exp +# File: /admin/ug/group-type-module-remove.tcl +# Date: 22/12/99 +# Contact: tarik@arsdigita.com +# Purpose: confirmation page for removing association between module and the group type + +set_the_usual_form_variables +# group_type, module_key + +set db [ns_db gethandle] +set group_type_pretty_name [database_to_tcl_string $db " +select pretty_name from user_group_types where group_type='$QQgroup_type'"] + +set page_title "Remove Module" + +ns_return 200 text/html " +[ad_admin_header $page_title] +

    $page_title

    +[ad_admin_context_bar [list "/admin/ug/" "Group Administration"] \ + [list "group-type.tcl?group_type=[ns_urlencode $group_type]" "$group_type_pretty_name Administration"] \ + "Confirm Module Removal"] +
    +
    +

    Confirm Module Removal

    + +
    Warning: +Removing module implies that user groups of this type will not be able to use this module. +
    +
    Are you sure you want to proceed ? +
    +[export_form_vars group_type module_key] + +[ad_space 5] +
    +
    +[ad_footer] +" + + + Index: web/openacs/www/admin/ug/group-type-new-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-type-new-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-type-new-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,54 @@ +# group-type-new-2.tcl,v 3.0 2000/02/06 03:29:24 ron Exp +# File: /admin/ug/group-type-new.tcl +# Date: 22/12/99 +# Contact: tarik@arsdigita.com +# Purpose: adding new user group + +set_the_usual_form_variables +# everything for user_group_type + +set exception_text "" +set exception_count 0 + +if { [info exists group_type] && ![empty_string_p $group_type] && [regexp {[^a-zA-Z0-9_]} $group_type] } { + append exception_text "
  • You can't have spaces, dashes, slashes, quotes, or colons in a group type. It has to be just alphanumerics and underscores." + incr exception_count +} + +if { [info exists group_type] && ![empty_string_p $group_type] && [string length $group_type] > 20 } { + append exception_text "
  • You can't have a group type longer than 20 characters." + incr exception_count +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +set db [ns_db gethandle] + +# set insert_sql [util_prepare_insert $db "user_group_types" "group_type" $group_type [ns_conn form]] +# POSTGRES hack +set insert_sql "insert into user_group_types (group_type, pretty_name, pretty_plural, approval_policy, group_module_administration) values ('$QQgroup_type', '$QQpretty_name', '$QQpretty_plural', '$QQapproval_policy', '$QQgroup_module_administration')" +set helper_table "create table [ad_user_group_helper_table_name $group_type] ( + group_id integer primary key references user_groups +)" + +if [catch { ns_db dml $db "begin transaction" + ns_db dml $db $insert_sql + ns_db dml $db $helper_table + ns_db dml $db "end transaction" + } errmsg] { + ad_return_error "insert failed" "Insertion of your group type in the database failed. Here's what the RDBMS had to say: +
    +
    +$errmsg
+
    +
    +You should back up, edit the form to fix whatever problem is mentioned +above, and then resubmit. +" + return +} + +ns_returnredirect "group-type.tcl?group_type=[ns_urlencode $group_type]" Index: web/openacs/www/admin/ug/group-type-new.adp =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-type-new.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-type-new.adp 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,43 @@ +<%=[ad_admin_header "Define Group Type"]%> + +

    Define Group Type

    + +<%=[ad_admin_context_bar [list "index.tcl" "User Groups"] "New Group Type"]%> + +
    + +
    + + + + + + + + + +
    Group type + +(no special characters; this will be part of a SQL table name) +
    Pretty Name + +(e.g., "Hospital") +
    Pretty Plural + +(e.g., "Hospitals") +
    Approval Policy + + +
    +
    +
    + +
    + + + +<%=[ad_admin_footer]%> Index: web/openacs/www/admin/ug/group-type-new.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-type-new.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-type-new.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,59 @@ +# group-type-new.tcl,v 3.0 2000/02/06 03:29:26 ron Exp +# File: /admin/ug/group-type-new.tcl +# Date: 22/12/99 +# Contact: tarik@arsdigita.com +# Purpose: adding new user group + +ns_return 200 text/html " +[ad_admin_header "Define Group Type"] +

    Define Group Type

    +[ad_admin_context_bar [list "index.tcl" "User Groups"] "New Group Type"] +
    + + + + + + + + + + + + + + + + + + + +
    Group Type + +(no special characters; this will be part of a SQL table name) +
    Pretty Name + +(e.g., \"Hospital\") +
    Pretty Plural + +(e.g., \"Hospitals\") +
    Approval Policy + + +
    Group Module Administration +[ns_htmlselect -labels {Complete "Enabling/Disabling" None} \ + group_module_administration \ + {full enabling none} \ + none] +
    + +
    +
    + +
    +[ad_admin_footer] +" Index: web/openacs/www/admin/ug/group-type.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group-type.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group-type.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,262 @@ +# group-type.tcl,v 3.0 2000/02/06 03:29:27 ron Exp +# File: /admin/ug/group-type.tcl +# Date: 22/12/99 +# Contact: tarik@arsdigita.com +# Purpose: main page displaying information about the group type + +set_the_usual_form_variables + +# group_type + +ns_log Debug "group type = $group_type" + +set db [ns_db gethandle] + +set selection [ns_db 1row $db " +select group_type, pretty_name as group_type_pretty_name, pretty_plural, approval_policy, default_new_member_policy, + group_module_administration +from user_group_types where group_type = '$QQgroup_type'"] + +set_variables_after_query + +ReturnHeaders + +ns_write " +[ad_admin_header "$group_type_pretty_name"] +

    $group_type_pretty_name

    +[ad_admin_context_bar [list "index.tcl" "User Groups"] "One Group Type"] +
    +" + +#DRB: Oracle version does a "count(1)" now, but when query is empty 6.5 +#dies. Don't know about 7.0 + +set n_members [database_to_tcl_string $db "select count(*) from user_groups where group_type = '$QQgroup_type'"] + +if { $n_members == 0 } { + append group_members_html "there are currently no user groups of this type" +} elseif { $n_members < 20 } { + # let's just list them + set selection [ns_db select $db " + select ug.group_id, ug.group_name, ug.registration_date, ug.approved_p, + user_group_count_group_map(ug.group_id) + user_groups_number_submembers(ug.group_id) as n_members, + user_groups_number_subgroups(ug.group_id) as n_subgroups + from user_groups ug + where group_type = '$QQgroup_type' + order by upper(group_name)"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + set n_members "$n_members [util_decode $n_members 1 member members]" + set n_subgroups "$n_subgroups [util_decode $n_subgroups 1 "subgroup" "subgroups"]" + + append group_members_html "
  • $group_name ($n_members, $n_subgroups)" + if { $approved_p == "f" } { + append group_members_html " not approved" + } + append group_members_html "\n" + } +} else { + append group_members_html "
  • show all $n_members\n" +} + +set return_url "/admin/ug/group-type.tcl?[export_url_vars group_type]" + +append group_members_html " +
    +
    +
  • create a new $group_type_pretty_name +" + +ns_write " +

    User groups in $group_type_pretty_name

    +
      +$group_members_html +
    +" + +append properties_html " +
  • Pretty Name: \"$group_type_pretty_name\" (plural: \"$pretty_plural\") +
  • Approval Policy (how new groups get created): $approval_policy +
  • Default New Member Policy (how users will join groups of this type): $default_new_member_policy +
  • Group Module Administration: + [ad_decode $group_module_administration full Complete enabling "Enabling/Disabling" none None undefined] +
    +
    +(edit) +" + +ns_write " +

    Properties of this type of group

    +
      +$properties_html +
    +" + + +set module_available_p [database_to_tcl_string $db " +select count(*) +from acs_modules +where supports_scoping_p='t' +and module_key not in (select module_key + from user_group_type_modules_map + where group_type='$QQgroup_type')"] + + + +if { [string compare $group_module_administration enabling]==0 || \ + [string compare $group_module_administration none]==0 } { + + set selection [ns_db select $db " + select ugtm.module_key, ugtm.group_type_module_id, am.pretty_name as module_pretty_name + from user_group_type_modules_map ugtm, acs_modules am + where ugtm.group_type='$QQgroup_type' + and ugtm.module_key=am.module_key + "] + + set module_counter 0 + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + append modules_table_html " +
  • $module_pretty_name + (remove) + " + + incr module_counter + } + + if { $module_counter == 0 } { + append modules_table_html " + no modules are associated with this group type + " + } + + append modules_html " + + $modules_table_html + + " + if { $module_available_p } { + append modules_html " +

    +

  • add module + " + } +} else { + append modules_html " + Groups of this type are granted complete module administration. Modules can be associated with the groups only on the group level. + " +} + +ns_write " +

    Modules associated with groups in $group_type_pretty_name

    +
      +$modules_html +
    +" + +append data_html " + +" +set number_of_fields [database_to_tcl_string $db "select count(*) from user_group_type_fields where group_type = '$QQgroup_type'"] + +set selection [ns_db select $db "select * from user_group_type_fields where group_type = '$QQgroup_type' +order by sort_key"] + +set counter 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + incr counter + + if { $counter == $number_of_fields } { + append data_html "
    $column_name ($pretty_name), $column_actual_type ($column_type) $column_extra\[ insert after | delete \]\n" + } else { + append data_html "
    $column_name ($pretty_name), $column_actual_type ($column_type) $column_extra\[ insert after | swap with next | delete \]\n" + } +} + +if { $counter == 0 } { + append data_html " +
    no group-specific data currently collected + " +} + +append data_html " +
    +

    " + +if { $counter == 0 } { + append data_html " +

  • add a field +" +} + +ns_write " +

    Data that we collect for this type of group

    +
      +$data_html +
    +" + +append user_data_html " + +" + +set number_of_fields [database_to_tcl_string $db "select count(*) from user_group_type_member_fields where group_type = '$QQgroup_type'"] + +set selection [ns_db select $db "select field_name, field_type, sort_key +from user_group_type_member_fields +where group_type = '$QQgroup_type' +order by sort_key"] + +set counter 0 + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + incr counter + + if { $counter == $number_of_fields } { + append user_data_html "
    $field_name ($field_type)\[ insert after \] | delete \]\n" + } else { + append user_data_html "
    $field_name ($field_type)\[ insert after | swap with next \] | delete \]\n" + } +} + +if { $counter == 0 } { + append user_data_html " +
    No group-type-specific member data currently collected. + " +} + +append user_data_html " +
    +

    " + +if { $counter == 0 } { +append user_data_html " +

  • add a field +" +} + +ns_write " +

    Data that we collect for each user of this type of group

    +
      +$user_data_html +
    +" + +append extreme_html " + +[export_form_vars group_type] + +
    • +" +ns_write " +

    Extreme Actions

    +
      +$extreme_html +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ug/group.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/group.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/group.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,491 @@ +# group.tcl,v 3.1.2.1 2000/03/16 20:57:46 dh Exp +set_the_usual_form_variables +# group_id + +ad_maybe_redirect_for_registration +set user_id [ad_get_user_id] + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select ug.*, first_names, last_name, +parent_group_id, user_group_name_from_id(parent_group_id) as parent_group_name +from user_groups ug, users u +where group_id = $group_id +and ug.creation_user = u.user_id"] + +if { [empty_string_p $selection] } { + ad_return_error "Group doesn't exists" "The specified group doesn't exist. Please back up to select a new group" + return +} +set_variables_after_query + +ReturnHeaders + +if { [empty_string_p $parent_group_id] } { + set context_bar [ad_admin_context_bar [list "index.tcl" "User Groups"] [list "group-type.tcl?[export_url_vars group_type]" "One Group Type"] "One Group"] +} else { + set context_bar [ad_admin_context_bar [list "index.tcl" "User Groups"] [list "group-type.tcl?[export_url_vars group_type]" "One Group Type"] [list group.tcl?group_id=$parent_group_id "One Group"] "One Subgroup"] + +} + + +ns_write " +[ad_admin_header $group_name] +

    $group_name

    +$context_bar +
    +" + +if { $approved_p == "f" } { + append properties_html " +
    + this group is awaiting approval + (approve right now) +
    + " +} + +append properties_html " +
      +
    • Group name: $group_name (edit) +
    • Group short name: $short_name (edit) +
    • Group type: $group_type +
    • Existence Public? [util_PrettyBoolean $existence_public_p] +" + +set subgroup_html "" +if { ![empty_string_p $parent_group_id] } { + append properties_html "
    • Parent group: $parent_group_name\n" +} else { + # Look for subgroups since this group isn't a subgroup + if { [empty_string_p $parent_group_id] } { + set subgroup_html " +

      Subgroups

      +
        +" + + set selection [ns_db select $db \ + "select ug.group_id as subgroup_id, group_name as subgroup_name, ug.registration_date, + ug.approved_p, count(user_id) as n_members, + upper(group_name) + from user_groups ug, user_group_map ugm + where parent_group_id=$group_id + and ug.group_id=ugm.group_id + group by ug.group_id, group_name, ug.registration_date, ug.approved_p + union + select ug.group_id as subgroup_id, group_name as subgroup_name, ug.registration_date, + ug.approved_p, 0 as n_members, + upper(group_name) + from user_groups ug + where parent_group_id=$group_id and + not exists (select 1 from user_group_map ugm + where ug.group_id=ugm.group_id) + group by ug.group_id, group_name, ug.registration_date, ug.approved_p + order by upper(group_name)"] + + set counter 0 + while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $subgroup_name != "" } { + incr counter + set num_members "$n_members [util_decode $n_members 1 member members]" + append subgroup_html "
      • $subgroup_name ($num_members)\n" + } + } + + if { $counter == 0 } { + append subgroup_html "
      • There are no subgroups\n" + } + + set return_url "/admin/ug/group.tcl?[export_url_vars group_id]" + append subgroup_html "

      • add a subgroup +
      + " + } +} + + +ns_write " +

      + +

    • Created by $first_names $last_name on [util_AnsiDatetoPrettyDate $registration_date] + +
    • +New Member Policy: +[export_form_vars group_id] + +

      +

      + +
    • +Group Spam Policy: + +[export_form_vars group_id] + +

      +

      + +
    • Send email to admins on new membership request: [util_PrettyBoolean $email_alert_p] +(Toggle) +

      + +

    • Use the multi-role permission system: [util_PrettyBoolean $multi_role_p] +(Toggle) +

      +" + +# determine if there are any special helper tables +set li_edit_link "" +set info_table_name [ad_user_group_helper_table_name $group_type] + +ns_log Notice "info table name = $info_table_name, exist = [ns_table exists $db $info_table_name]" + +if [ns_table exists $db $info_table_name] { + set selection [ns_db 0or1row $db "select * from $info_table_name where group_id = $group_id"] + + if { $selection == "" } { + append properties_html "we have no supplemental information on this group" + } else { + set set_variables_after_query_i 0 + set set_variables_after_query_limit [ns_set size $selection] + while {$set_variables_after_query_i<$set_variables_after_query_limit} { + append properties_html "

    • [ns_set key $selection $set_variables_after_query_i]: [ns_set value $selection $set_variables_after_query_i]\n" + incr set_variables_after_query_i + } + } + set li_edit_link "
    • Edit" +} else { + append properties_html "

    • we have no supplemental information on this group" +} + +append properties_html " +

      +$li_edit_link +

    • Download or spam members +
    +" +ns_write $properties_html + +set module_available_p [database_to_tcl_string $db " +select count(*) +from acs_modules +where supports_scoping_p='t' +and module_key not in (select module_key + from content_sections + where scope='group' and group_id=$group_id + and (section_type='system' or section_type='admin'))"] + + +set group_module_administration [database_to_tcl_string $db " +select group_module_administration from user_group_types where group_type=user_group_group_type($group_id)"] + +set selection [ns_db select $db " +select module_key, pretty_name_from_module_key(module_key) as module_pretty_name +from content_sections +where scope='group' and group_id=$group_id +and (section_type='system' or section_type='admin')"] + + +if { [string compare $group_module_administration full]==0 } { + + set module_counter 0 + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + append modules_table_html " + + $module_pretty_name + [ad_space 2]remove + + " + + incr module_counter + } + + if { $module_counter == 0 } { + append modules_table_html " + no modules are associated with this group + " + } + + append modules_html " +

    Modules associated with groups in $group_name

    +
      + + $modules_table_html +
      +

      + " + if { $module_available_p } { + append modules_html " +

    • add module + " + } + append modules_html " +
    + " +} else { + set module_counter 0 + while { [ns_db getrow $db $selection] } { + set_variables_after_query + + append modules_list_html " +
  • $module_pretty_name + " + + incr module_counter + } + + if { $module_counter == 0 } { + append modules_list_html " +
  • no modules are associated with this group + " + } + + append modules_html " +

    Modules associated with this group

    +
      + $modules_list_html +

      + This group has [ad_decode $group_module_administration enabling "only enabling/disabling" "no"] module administration privileges. + Modules can be added to or removed from the group only on the group type level. +

    + " +} + +ns_write $modules_html + +append group_type_fields_html " +

    Member Fields From Group Type

    + +
      +" + +set selection [ns_db select $db " +select field_name, field_type +from user_group_type_member_fields +where group_type = '[DoubleApos $group_type]' +order by sort_key"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + append group_type_fields_html "
    • $field_name ($field_type)\n" +} + +append group_type_fields_html "

      +

      + +

    • go to the user group type page to edit +
    +" + +ns_write $group_type_fields_html + +append group_fields_html " +

    Member Fields From Group

    + + +" + +set number_of_fields [database_to_tcl_string $db "select count(*) from user_group_member_fields where group_id = $group_id"] + +set selection [ns_db select $db "select field_name, field_type, sort_key +from user_group_member_fields +where group_id = $group_id +order by sort_key"] + +set counter 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + incr counter + + if { $counter == $number_of_fields } { + append group_fields_html "
    $field_name ($field_type)\[ insert after \]\n" + } else { + append group_fields_html "
    $field_name ($field_type)\[ insert after | swap with next \]\n" + } +} + +if { $counter == 0 } { + append group_fields_html "
    No group-type-specific member data currently collected. +

    +

    " +} + + +append group_fields_html "
    \n" + +ns_write $group_fields_html + +#set selection [ns_db select $db "select queue.user_id, first_names || ' ' || last_name as name, to_char(queue_date, 'Mon-dd-yyyy') as queue_date +#from user_group_map_queue queue, users +#where queue.user_id = users.user_id +#and group_id = $group_id +#order by queue_date asc +#"] + +# Postgres hack +set selection [ns_db select $db "select queue.user_id, first_names || ' ' || last_name as name, queue_date +from user_group_map_queue queue, users +where queue.user_id = users.user_id +and group_id = $group_id +order by queue_date asc +"] + + +set counter 0 +while { [ns_db getrow $db $selection] } { + if { $counter == 0 } { + append members_html "

    Users who have asked for membership

    + " +} + +append members_html " +$subgroup_html + +" + + +append members_html " +

    Group Members

    +
      +" + +# let's look for members + +set selection [ns_db select $db "select map.user_id, map.role, first_names || ' ' || last_name as name +from user_group_map map, users +where map.user_id = users.user_id +and group_id = $group_id +order by role, last_name, first_names"] + +set counter 0 +set last_role "" +while { [ns_db getrow $db $selection] } { + set_variables_after_query + incr counter + if { $role != $last_role } { + set last_role $role + append members_html "

      Role: $role

      " + } + append members_html "
    • $name     | remove\n" +} + +if { $counter == 0 } { + append members_html "no members found" +} + +append members_html " +

      +

    • add a member in a role +
    " + +ns_write $members_html + + +if { [string compare $multi_role_p "t"] == 0} { + append permissions_html " +

    Permissions

    + Note: users with the role \"administrator\" have full authorization. +

    " + + append role_table_title "" + set actions_list [database_to_tcl_list $db "select action from user_group_actions where group_id = $group_id"] + set roles_list [database_to_tcl_list $db "select role from user_group_roles where group_id = $group_id"] + + + append role_table "" + + set actions_with_mapping "" + + foreach role $roles_list { + set allowed_actions_for_role [database_to_tcl_list $db "select action from user_group_action_role_map where group_id = $group_id and role='[DoubleApos $role]'"] + if { [string compare [llength $allowed_actions_for_role] 0 ] == 0 } { + append role_table "" + } else { + append role_table "" + } + foreach action $actions_list { + if {[lsearch $allowed_actions_for_role $action] == -1} { + append role_table "" + } else { + lappend actions_with_mapping $action + append role_table "" + } + } + append role_table "" + } + + append role_table " +
    Role \\\\ Action
    $role (delete)
    $roleDeniedAllowed
    " + + foreach action $actions_list { + if {[lsearch $actions_with_mapping $action] == -1 } { + append role_table_title "$action (delete)" + } else { + append role_table_title "$action" + } + } + + append role_table_title "" + + append permissions_html " + $role_table_title + $role_table +

    +

    + [export_form_vars group_id] + Add a role: + +
    +

    +

    + Add an action: + [export_form_vars group_id] + +
    + +

    + Can group administrators control permission information? [util_PrettyBoolean $group_admin_permissions_p] (Toggle) + " + + ns_write $permissions_html +} + +append extreme_html " +

    Extreme Actions

    + +
    +
    +[export_form_vars group_id] + +
    +
    " + +ns_write " +$extreme_html +[ad_admin_footer] +" + + + + + + + + + Index: web/openacs/www/admin/ug/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/index.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,44 @@ +# index.tcl,v 3.0 2000/02/06 03:29:29 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "User Group Administration"] + +

    User Group Administration

    + +[ad_admin_context_bar "User Groups"] + +
    + +Currently, the system is able to handle the following types of groups: + +
      + +" +set db [ns_db gethandle] + +#DRB since there are no outer joins, I created a helper function +#and simplified. + +set selection [ns_db select $db "select ugt.group_type, ugt.pretty_name, user_group_count_groups(ugt.group_type) as n_groups +from user_group_types ugt +order by upper(ugt.pretty_name)"] + +set count 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + incr count + ns_write "
    • $pretty_name (number of groups defined: $n_groups)\n" +} + +if { $count == 0 } { + ns_write "no group types currently defined" +} + +ns_write "

      + +

    • Define a new group type + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ug/member-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/member-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/member-add-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,127 @@ +# member-add-2.tcl,v 3.1 2000/02/26 09:07:22 markc Exp +set_the_usual_form_variables + +# group_id, user_id_from_search, maybe role,return_url + +set db [ns_db gethandle] + +set old_role_list [database_to_tcl_list $db " + select + role + from + user_group_map + where + user_id = $user_id_from_search + and group_id = $group_id +"] + +set name [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id = $user_id_from_search"] +set selection [ns_db 1row $db "select group_name, multi_role_p from user_groups where group_id = $group_id"] +set_variables_after_query + + +if {[info exists role] && ![empty_string_p $role]} { + set title "Add $name as $role" +} else { + set title "Specify Role and Any Extra Fields for $name" +} + +ReturnHeaders + +ns_write "[ad_admin_header "$title"] + +

    $title

    + +in $group_name + +
    + +
    +[export_form_vars group_id user_id_from_search return_url] + +" + +if { [llength $old_role_list] > 0 } { + + ns_write " +Warning: $name already has the role: [join $old_role_list ", "], which will not be replaced by this operation.

    +" +} + +if { [info exists role] && ![empty_string_p $role] } { + ns_write "[export_form_vars role]" +} else { + + if { [string compare $multi_role_p "t"] == 0 } { + set existing_roles [database_to_tcl_list $db "select role from user_group_roles where group_id = $group_id"] + if {[lsearch $existing_roles "administrator"] == -1 } { + lappend existing_roles "administrator" + } + if { [llength $existing_roles] > 0 } { + ns_write "

    " + } else { + set existing_roles [database_to_tcl_list $db "select distinct role from user_group_map where group_id = $group_id"] + if {[lsearch $existing_roles "administrator"] == -1 } { + lappend existing_roles "administrator" + } + if {[lsearch $existing_roles "all"] == -1 } { + lappend existing_roles "all" + } + + ns_write " + + + + " + } +} + + +# Additional fields + +set selection [ns_db select $db "select group_id, field_name, field_type +from all_member_fields_for_group +where group_id = $group_id +order by sort_key"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write " +" +} + + +ns_write " +
    Role + " + } + ns_write "
    Existing role + +
    or
    + Define a new role for this group: + + +
    $field_name +[ad_user_group_type_field_form_element $field_name $field_type] +
    +

    + +

    + +
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ug/member-add-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/member-add-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/member-add-3.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,63 @@ +# member-add-3.tcl,v 3.1 2000/02/26 09:07:00 markc Exp +set_the_usual_form_variables + +# group_id, user_id_from_search, one or more of role, existing_role, new_role +# all the info for extra member fields +# Maybe return_url + +set dbs [ns_db gethandle main 2] +set db [lindex $dbs 0] +set sub_db [lindex $dbs 1] + +set mapping_user [ad_get_user_id] + +set mapping_ip_address [ns_conn peeraddr] + +if ![info exists role] { + # we weren't just given a role so let's look at the user's choice + if { [info exists existing_role] && ![empty_string_p $existing_role] } { + set role $existing_role + } elseif { [info exists new_role] && ![empty_string_p $new_role] } { + set role $new_role + } else { + ad_return_error "No role specified" "We couldn't figure out what role this new member is supposed to have; either you didn't choose one or there is a bug in our software." + return + } +} + + +with_transaction $db { + + + ns_db dml $db "insert into user_group_map (group_id, user_id, role, mapping_user, mapping_ip_address) select $group_id, $user_id_from_search, '[DoubleApos $role]', $mapping_user, '$mapping_ip_address' from dual" + + # Extra fields + set sub_selection [ns_db select $sub_db "select field_name from all_member_fields_for_group where group_id = $group_id"] + while { [ns_db getrow $sub_db $sub_selection] } { + set_variables_after_subquery + if { [exists_and_not_null $field_name] } { + ns_db dml $db "insert into user_group_member_field_map +(group_id, user_id, field_name, field_value) +values ($group_id, $user_id_from_search, '[DoubleApos $field_name]', [ns_dbquotevalue [set $field_name]])" + } + } + +} { + ad_return_error "Database Error" "Error while trying to insert user into a user group. + +Database error message was: +
    +
    +$errmsg
+
    +
    + +[ad_admin_footer]" + return +} + +if { [exists_and_not_null return_url] } { + ns_returnredirect $return_url +} else { + ns_returnredirect "group.tcl?group_id=$group_id" +} Index: web/openacs/www/admin/ug/member-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/member-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/member-add.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,52 @@ +# member-add.tcl,v 3.0 2000/02/06 03:29:33 ron Exp +set_the_usual_form_variables + +# group_id, maybe role,return_url + +set user_id [ad_get_user_id] + +# we will want to record who was logged in when this person was added +# so let's force admin to register + +if {$user_id == 0} { + ns_returnredirect "/register.tcl?return_url=[ns_urlencode "/admin/ug/member-add.tcl?[export_url_vars group_id role return_url]"]" + return +} + +set db [ns_db gethandle] + +ReturnHeaders + +ns_write "[ad_admin_header "Add Member"] + +

    Add Member

    + +" + +set group_name [database_to_tcl_string $db "select group_name from user_groups where group_id = $group_id"] + +ns_write "to $group_name + +
    + +Locate your new member by + +
    +[export_entire_form] + + + + + + +
    Email address:
    or by
    Last name:
    + +

    + +

    + +
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ug/member-remove-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/member-remove-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/member-remove-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,21 @@ +# member-remove-2.tcl,v 3.1 2000/02/26 07:32:25 markc Exp +set_the_usual_form_variables + +# group_id, user_id, role +# return_url (optional) + +set db [ns_db gethandle] + +ns_db dml $db " + delete from + user_group_map + where + user_id = $user_id and + group_id = $group_id and + role = '$role'" + +if { [exists_and_not_null return_url] } { + ns_returnredirect $return_url +} else { + ns_returnredirect "group.tcl?[export_url_vars group_id]" +} \ No newline at end of file Index: web/openacs/www/admin/ug/member-remove.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/member-remove.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/member-remove.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,65 @@ +# member-remove.tcl,v 3.1 2000/02/26 07:29:11 markc Exp +set_the_usual_form_variables + +# group_id, user_id, role + +set db [ns_db gethandle] + + +set selection [ns_db 0or1row $db " + select + first_names || ' ' || last_name as name, + group_name + from + users, + user_group_map, + user_groups + where + users.user_id = $user_id + and user_group_map.user_id = users.user_id + and user_groups.group_id = user_group_map.group_id + and user_group_map.group_id = $group_id and + user_group_map.role = '$role' +"] + + +ReturnHeaders + +if { $selection == "" } { +ns_write " +[ad_admin_header "User could not be found in the specified role."] +

    User could not be found in the specified role.

    +
    +The user could not be removed from the role because he or she is no longer in it. +[ad_admin_footer] +" +return + +} +set_variables_after_query + +ns_write "[ad_admin_header "Really remove $name from the role \"$role?\""] + +

    Remove $name from the role \"$role\"

    + +in $group_name + +
    + +
    + + +
    +
    +[export_form_vars group_id] + +
    +    		 +
    +[export_form_vars group_id user_id role] + +
    +
    +
    +[ad_admin_footer] +" Index: web/openacs/www/admin/ug/membership-grant.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/membership-grant.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/membership-grant.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,16 @@ +# membership-grant.tcl,v 3.1 2000/02/26 09:15:17 markc Exp +set_form_variables + +# user_id, group_id + +set db [ns_db gethandle] + +ns_db dml $db "begin transaction" + +ns_db dml $db "insert into user_group_map (user_id, group_id, mapping_ip_address, role, mapping_user) select user_id, group_id, ip_address, 'member', [ad_get_user_id] from user_group_map_queue where user_id = $user_id and group_id = $group_id and not exists (select user_id from user_group_map where user_id = $user_id and group_id = $group_id and role = 'member')" + +ns_db dml $db "delete from user_group_map_queue where user_id = $user_id and group_id = $group_id" + +ns_db dml $db "end transaction" + +ns_returnredirect "group.tcl?[export_url_vars group_id]" \ No newline at end of file Index: web/openacs/www/admin/ug/membership-refuse-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/membership-refuse-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/membership-refuse-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,11 @@ +# membership-refuse-2.tcl,v 3.0 2000/02/06 03:29:39 ron Exp +set_the_usual_form_variables + +# group_id, user_id + +set db [ns_db gethandle] + +ns_db dml $db "delete from user_group_map_queue where +user_id = $user_id and group_id = $group_id" + +ns_returnredirect "group.tcl?[export_url_vars group_id]" \ No newline at end of file Index: web/openacs/www/admin/ug/membership-refuse.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/membership-refuse.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/membership-refuse.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,38 @@ +# membership-refuse.tcl,v 3.0 2000/02/06 03:29:41 ron Exp +set_the_usual_form_variables + +# group_id, user_id + +set db [ns_db gethandle] + +set name [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id = $user_id"] + +set group_name [database_to_tcl_string $db "select group_name from user_groups where group_id = $group_id"] + + +ReturnHeaders + +ns_write "[ad_admin_header "Really refuse $name?"] + +

    Really refuse $name?

    + +as a member in $group_name + +
    + +
    + + +
    +
    +[export_form_vars group_id] + +
    +    		 +
    +[export_form_vars group_id user_id] + +
    +
    +[ad_admin_footer] +" Index: web/openacs/www/admin/ug/multi-role-p-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/multi-role-p-toggle.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/multi-role-p-toggle.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,13 @@ +# multi-role-p-toggle.tcl,v 3.0 2000/02/06 03:29:43 ron Exp +# Form variables: +# group_id the id of the group + + +set_form_variables + +set db [ns_db gethandle] + +ns_db dml $db "update user_groups set multi_role_p = logical_negation(multi_role_p) where group_id = $group_id" + + +ns_returnredirect "group.tcl?[export_url_vars group_id]" Index: web/openacs/www/admin/ug/new-member-policy-update.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/new-member-policy-update.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/new-member-policy-update.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,23 @@ +# new-member-policy-update.tcl,v 3.1 2000/02/26 09:20:38 markc Exp +set_form_variables + +# group_id, new_member_policy + +set db [ns_db gethandle] + +ns_db dml $db "update user_groups set new_member_policy = '$new_member_policy' where group_id = $group_id" + +if { $new_member_policy == "open" } { + # grant everyone in the queue membership + + ns_db dml $db "begin transaction" + + ns_db dml $db "insert into user_group_map (user_id, group_id, mapping_ip_address, role, mapping_user) select user_id, group_id, ip_address, 'member', [ad_get_user_id] from user_group_map_queue where group_id = $group_id and not exists (select user_id from user_group_map where user_group_map.user_id = user_group_map_queue.user_id and group_id = $group_id and role = 'member')" + + ns_db dml $db "delete from user_group_map_queue where group_id = $group_id" + + ns_db dml $db "end transaction" + +} + +ns_returnredirect "group.tcl?[export_url_vars group_id]" \ No newline at end of file Index: web/openacs/www/admin/ug/permission-system-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/permission-system-toggle.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/permission-system-toggle.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,13 @@ +# permission-system-toggle.tcl,v 3.0 2000/02/06 03:29:45 ron Exp +# Form variables: +# group_id the id of the group + + +set_form_variables + +set db [ns_db gethandle] + +ns_db dml $db "update user_groups set advanced_permissions_p = logical_negation(advanced_permissions_p) where group_id = $group_id" + + +ns_returnredirect "group.tcl?[export_url_vars group_id]" Index: web/openacs/www/admin/ug/pick.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/pick.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/pick.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,54 @@ +# pick.tcl,v 3.0 2000/02/06 03:29:46 ron Exp +# reusable page to let an administrator pick a user group to associate +# with some other element in the database + +set_the_usual_form_variables + +# target (ultimate URL where we're heading with group_id set) +# passthrough (Tcl list of form variable names to pass along from caller) +# maybe explanation + +ReturnHeaders + +ns_write "[ad_admin_header "Pick a User Group"] + +

    Pick a User Group

    + +
    + +
      + +" + +if [info exists explanation] { + ns_write "$explanation\n\n

      \n" +} + +set db [ns_db gethandle] + +set selection [ns_db select $db "select ugt.pretty_plural as group_type_headline, ug.group_id, ug.group_type, ug.group_name +from user_groups ug, user_group_types ugt +where ug.group_type = ugt.group_type +order by ug.group_type, upper(group_name)"] + +if { ![info exists passthrough] } { + set passthrough [list] +} +lappend passthrough "group_id" + +set last_group_type_headline "" +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { [string compare $last_group_type_headline $group_type_headline] != 0 } { + ns_write "

      $group_type_headline

      \n\n" + set last_group_type_headline $group_type_headline + } + ns_write "
    • $group_name\n" +} + +ns_write " + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ug/readme.txt =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/readme.txt,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/readme.txt 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,7 @@ +This directory is for administrative scripts that manage groups of +users, both the kinds of groups that may be created (e.g., "hospitals") +and the actual groups (e.g., "Mt. Sinai Hospital"). + +The data model is in /doc/sql/user-groups.sql + + Index: web/openacs/www/admin/ug/role-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/role-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/role-add.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,23 @@ +# role-add.tcl,v 3.0 2000/02/06 03:29:48 ron Exp +set_the_usual_form_variables + +# group_id, role + +set exception_count 0 +set exception_text "" + +if { ![info exists role] && [empty_string_p $role] } { + incr exception_count + append exception_text "
  • Please type in a role" +} + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text +} + +set db [ns_db gethandle] + +ad_user_group_role_add $db $group_id $role + +ns_returnredirect "group.tcl?group_id=$group_id" + Index: web/openacs/www/admin/ug/role-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/role-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/role-delete.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,14 @@ +# role-delete.tcl,v 3.0 2000/02/06 03:29:49 ron Exp +set_the_usual_form_variables + +# group_id, role + +set db [ns_db gethandle] + + +ns_db dml $db "delete from user_group_roles +where group_id = $group_id +and role = '$QQrole'" + +ns_returnredirect "group.tcl?group_id=$group_id" + Index: web/openacs/www/admin/ug/role-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/role-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/role-edit-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,22 @@ +# role-edit-2.tcl,v 3.0 2000/02/06 03:29:51 ron Exp +set_form_variables + +# user_id, group_id, exisiting_role and/or new_role + +if { [info exists new_role] && ![empty_string_p $new_role] } { + set role $new_role +} else { + set role $existing_role +} + +if { ![info exists role] || [empty_string_p $role] } { + ad_return_complaint 1 "
  • Please pick a role." + return +} + +set db [ns_db gethandle] + +ns_db dml $db "update user_group_map set role='[DoubleApos $role]' +where user_id = $user_id and group_id = $group_id" + +ns_returnredirect "group.tcl?[export_url_vars group_id]" \ No newline at end of file Index: web/openacs/www/admin/ug/role-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/role-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/role-edit.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,82 @@ +# role-edit.tcl,v 3.0 2000/02/06 03:29:52 ron Exp +set_the_usual_form_variables + +# group_id, user_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select first_names || ' ' || last_name as name, role, multi_role_p, group_name, group_type +from users, user_group_map, user_groups +where users.user_id = $user_id +and user_group_map.user_id = users.user_id +and user_groups.group_id = user_group_map.group_id +and user_groups.group_id=$group_id"] +set_variables_after_query + +ReturnHeaders + +ns_write "[ad_admin_header "Edit role for $name"] + +

    Edit role for $name

    + +in $group_name + +
    + +
    +[export_form_vars group_id user_id] + + +" +} else { + set existing_roles [database_to_tcl_list $db "select distinct role from user_group_map where group_id = $group_id"] + if {[lsearch $existing_roles "administrator"] == -1 } { + lappend existing_roles "administrator" + } + if {[lsearch $existing_roles "all"] == -1 } { + lappend existing_roles "all" + } + + if { [llength $existing_roles] > 0 } { + ns_write " + + + + " + } +} + + +ns_write " +
    Set Role + +" + +if { [string compare $multi_role_p "t"] == 0 } { + # all groups must have an adminstrator role + set existing_roles [database_to_tcl_list $db "select role from user_group_roles where group_id = $group_id"] + if {[lsearch $existing_roles "administrator"] == -1 } { + lappend existing_roles "administrator" + } + if { [llength $existing_roles] > 0 } { + ns_write " + " + } + ns_write "
    or
    + Define a new role for this group: + + +
    +

    +

    + +
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/ug/spam-policy-update.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/spam-policy-update.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/spam-policy-update.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,14 @@ +# spam-policy-update.tcl,v 3.0 2000/02/06 03:29:53 ron Exp +set_form_variables + +# group_id, spam_policy + +set db [ns_db gethandle] + +ns_db dml $db " +update user_groups +set spam_policy = '$spam_policy' +where group_id = $group_id" + + +ns_returnredirect "group.tcl?[export_url_vars group_id]" \ No newline at end of file Index: web/openacs/www/admin/ug/toggle-approved-p.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/toggle-approved-p.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/toggle-approved-p.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,11 @@ +# toggle-approved-p.tcl,v 3.0 2000/02/06 03:29:55 ron Exp +set_the_usual_form_variables + +# group_id + +set db [ns_db gethandle] + +ns_db dml $db "update user_groups set approved_p = logical_negation(approved_p) where group_id = $group_id" + +ns_returnredirect "group.tcl?group_id=$group_id" + Index: web/openacs/www/admin/ug/toggle-existence-public-p.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/ug/toggle-existence-public-p.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/ug/toggle-existence-public-p.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,11 @@ +# toggle-existence-public-p.tcl,v 3.0 2000/02/06 03:29:57 ron Exp +set_the_usual_form_variables + +# group_id + +set db [ns_db gethandle] + +ns_db dml $db "update user_groups set existence_public_p = logical_negation(existence_public_p) where group_id = $group_id" + +ns_returnredirect "group.tcl?group_id=$group_id" + Index: web/openacs/www/admin/users/action-choose.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/action-choose.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/action-choose.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,219 @@ +# /admin/users/action-choose.tcl +# +# Author: philg@mit.edu in late 1998 +# Modified by: ron@arsdigita.com to confirm with ACS form conventions +# +# Given a class of users, lets site admin pick something to do with +# them. +# +# action-choose.tcl,v 3.6 2000/03/09 10:22:07 hqm Exp + +set_the_usual_form_variables + +# maybe user_class_id (to indicate a previousely-selected class of users) +# maybe a whole host of user criteria +# If description is specified, we display it instead of the results of ad_user_class_description +# -- Passing description hides the sql query which can be good for normal, non-programming, users + +set admin_user_id [ad_verify_and_get_user_id] +ad_maybe_redirect_for_registration + +# we get a form that specifies a class of user + +set user_class_description [ad_user_class_description [ns_conn form]] + +if { ![exists_and_not_null description] } { + set user_description $user_class_description +} else { + set user_description "Users who $description" +} + + +append whole_page "[ad_admin_header $user_description] + +

    Users

    + +[ad_admin_context_bar [list "index.tcl" "Users"] "One Class"] + +
    + +Class description: $user_description. + +

    + +" + +set db [ns_db gethandle] + + +if { [ad_parameter NumberOfUsers] == "small" } { + # we print out all the users + append action_heading "

      " + set query [ad_user_class_query [ns_conn form]] + if [catch {set selection [ns_db select $db $query]} errmsg] { + append "The query +
      +$query +
      +is invalid. +[ad_admin_footer]" + return + } + set count 0 + while { [ns_db getrow $db $selection] } { + set_variables_after_query + incr count + append action_heading "
    • $first_names $last_name ($email)\n" + } + if { $count == 0 } { + append action_heading "no users found meeting these criteria" + } + append action_heading "
    " +} else { + # this is a large community; we just say how many users + # there are in this class + set query [ad_user_class_query_count_only [ns_conn form]] + if [catch {set n_users [database_to_tcl_string $db $query]} errmsg] { + append whole_page "The query +
    +$query +
    +is invalid. +[ad_admin_footer]" + return + } + + append action_heading "There are [util_commify_number $n_users] users in this class." +} + +set sql_description $user_class_description + + +if {![info exists user_class_id] || [empty_string_p $user_class_id]} { + append title_text "
    +[export_form_vars query sql_description] +Save this criteria as: + +
    " +} else { + set selection [ns_db 1row $db "select name, description, sql_description, sql_post_select from user_classes where user_class_id = $user_class_id"] + set_variables_after_query + append title_text " +

    User class: $name

    +
      +
    • Description: $description +
    • SQL description: $sql_description" + +if {[ad_parameter AllowAdminSQLQueries "" 0] == 1} { + append title_text "
    • SQL: select users.* $sql_post_select" +} + +append title_text "
      +edit +
    +

    " +} + + +append whole_page " + +$title_text + +$action_heading + +

    Pick an Action

    + + + +" + +# generate unique key here so we can handle the "user hit submit twice" case +set spam_id [database_to_tcl_string $db "select spam_id_sequence.nextval from dual"] + +# Generate the SQL query from the user_class_id, if supplied, or else from the +# pile of form vars as args to ad_user_class_query + +set users_sql_query [ad_user_class_query [ns_getform]] +regsub {from users} $users_sql_query {from users_spammable users} users_sql_query + +if { [info exists user_class_id] && ![empty_string_p $user_class_id]} { + set class_name [database_to_tcl_string $db "select name from user_classes where user_class_id = $user_class_id "] + set sql_description [database_to_tcl_string $db "select sql_description from user_classes where user_class_id = $user_class_id "] + set users_description "$class_name: $sql_description" +} else { + set users_description $user_description +} + +append whole_page " + +

    Spam Authorized Users in this Group

    + +
    +Note, if you choose to use the Tcl template +option below, then for literal '\$', '\[' and '\]', +you must use \\\$ (\\\$50 million dollars). Otherwise, +our code will think you are trying to substitute a variable like +(\$first_names). +
    + +

    +[export_form_vars spam_id users_sql_query users_description] + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    From: +
    Send Date:[_ns_dateentrywidget "send_date"]
    Send Time:[_ns_timeentrywidget "send_date"]
    Subject:
    Message: + +
    This message is a +Tcl Template
    + +
    + +
    +
    + +[ad_admin_footer] +" + +ns_db releasehandle $db +ns_return 200 text/html $whole_page Index: web/openacs/www/admin/users/alpha.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/alpha.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/alpha.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,44 @@ +# alpha.tcl,v 3.0 2000/02/06 03:30:53 ron Exp +# philg notes that this seems to be dead code as of 9/27/99 +# it was originally written by some MIT Press folks for Cognet + +set_form_variables + +# alpha_key + +if { $alpha_key == "" } { + set description "all users" +} else { + set description "users whose last name begins with $alpha_key" +} + +ReturnHeaders + +ns_write "[ad_admin_header $description] + +

    $description

    + +part of the [ad_system_name] users admin area +
    + +
      + +" + +set db [ns_db gethandle] + +set selection [ns_db select $db "select user_id, first_names, last_name, email +from users +where last_name like '$alpha_key\%' +order by upper(last_name), upper(first_names)"] + +set deleted_flag 0 +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
    • $first_names $last_name ($email)\n" +} + +ns_write " +
    +[ad_admin_footer] +" Index: web/openacs/www/admin/users/approve-email.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/approve-email.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/approve-email.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,54 @@ +# approve-email.tcl,v 3.1 2000/03/09 00:01:32 scott Exp +set admin_user_id [ad_verify_and_get_user_id] + +if { $admin_user_id == 0 } { + ns_returnredirect /register.tcl?return_url=[ns_urlencode "/admin/users/awaiting-approval.tcl"] + return +} + +set_the_usual_form_variables + +# user_id + +set db [ns_db gethandle] +set selection [ns_db 1row $db "select first_names || ' ' || last_name as name, user_state, email_verified_date, email from users where user_id = $user_id"] +set_variables_after_query + + +append whole_page "[ad_admin_header "Approving email for $name"] + +

    Approving email for $name

    + +[ad_admin_context_bar [list "index.tcl" "Users"] "Approve one"] + +
    + +" + + +if { $user_state == "need_email_verification" } { + ns_db dml $db "update users +set approved_date = sysdate(), user_state = 'authorized', +approving_user = $admin_user_id +where user_id = $user_id" + + ns_sendmail "$email" "[ad_parameter NewRegistrationEmailAddress "" [ad_system_owner]]" "Welcome to [ad_system_name]" "Your email in [ad_system_name] has been approved. Please return to [ad_parameter SystemUrl]." + +} elseif { $user_state == "need_email_verification_and_admin_approv" } { + + ns_db dml $db "update users +set approved_date = sysdate(), user_state = 'need_admin_approval', +approving_user = $admin_user_id +where user_id = $user_id" + +} + + + +append whole_page " +Done. + +[ad_admin_footer] +" +ns_db releasehandle $db +ns_return 200 text/html $whole_page Index: web/openacs/www/admin/users/approve.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/approve.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/approve.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,66 @@ +# approve.tcl,v 3.1 2000/03/09 00:01:33 scott Exp +set admin_user_id [ad_verify_and_get_user_id] + +if { $admin_user_id == 0 } { + ns_returnredirect /register.tcl?return_url=[ns_urlencode "/admin/users/awaiting-approval.tcl"] + return +} + +set_the_usual_form_variables + +# user_id + +set db [ns_db gethandle] +set selection [ns_db 1row $db "select first_names || ' ' || last_name as name, user_state, email_verified_date, email from users where user_id = $user_id"] +set_variables_after_query + +append whole_page "[ad_admin_header "Approving $name"] + +

    Approving $name

    + +[ad_admin_context_bar [list "index.tcl" "Users"] [list "awaiting-approval.tcl" "Approval"] "Approve One"] + +
    + +" + + +if { $user_state == "need_admin_approv" } { + ns_db dml $db "update users +set approved_date = sysdate(), user_state = 'authorized', +approving_user = $admin_user_id +where user_id = $user_id" + +} elseif { $user_state == "need_email_verification_and_admin_approv" } { + + ns_db dml $db "update users +set approved_date = sysdate(), user_state = 'need_email_verification', +approving_user = $admin_user_id +where user_id = $user_id" + +} elseif { $user_state == "rejected" } { + + if {[ad_parameter RegistrationRequiresEmailVerificationP "" 0] && $email_verified_date == ""} { + ns_db dml $db "update users +set approved_date = sysdate(), user_state = 'need_email_verification', +approving_user = $admin_user_id +where user_id = $user_id" + } else { + ns_db dml $db "update users +set approved_date = sysdate(), user_state = 'authorized', +approving_user = $admin_user_id +where user_id = $user_id" + } +} +ns_db releasehandle $db + + +ns_sendmail "$email" "[ad_parameter NewRegistrationEmailAddress "" [ad_system_owner]]" "Welcome to [ad_system_name]" "Your membership to [ad_system_name] has been approved. Please return to [ad_parameter SystemUrl]." + + +append whole_page " +Done. + +[ad_admin_footer] +" +ns_return 200 text/html $whole_page Index: web/openacs/www/admin/users/awaiting-approval.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/awaiting-approval.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/awaiting-approval.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,2 @@ +# awaiting-approval.tcl,v 3.0 2000/02/06 03:30:58 ron Exp + Index: web/openacs/www/admin/users/basic-info-update-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/basic-info-update-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/basic-info-update-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,80 @@ +# basic-info-update-2.tcl,v 3.0 2000/02/06 03:30:59 ron Exp +set_the_usual_form_variables + +# user_id, first_names, last_name, email, url, screen_name + +set db [ns_db gethandle] + +set exception_text "" +set exception_count 0 + +if { ![info exists first_names] || $first_names == "" } { + append exception_text "
  • You need to type in a first name\n" + incr exception_count +} + + +if { ![info exists last_name] || $last_name == "" } { + append exception_text "
  • You need to type in a last name\n" + incr exception_count +} + + +if { ![info exists email] || $email == "" } { + append exception_text "
  • You need to type in an email address\n" + incr exception_count +} + + +if { [database_to_tcl_string $db "select count(user_id) from users where upper(email) = '[string toupper $QQemail]' and user_id <> $user_id"] > 0 } { + append exception_text "
  • the email $email is already in the database\n" + incr exception_count +} + + +if {![empty_string_p $screen_name]} { + # screen name was specified. + set sn_unique_p [database_to_tcl_string $db " + select count(*) from users where screen_name='$screen_name' and user_id != $user_id"] + if {$sn_unique_p != 0} { + append exception_text "
  • The screen name you have selected is already taken.\n" + incr exception_count + } +} + + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + + + +if {[empty_string_p $screen_name]} { + set sql "update users + set first_names = '$QQfirst_names', + last_name = '$QQlast_name', + email = '$QQemail', + url = '$QQurl', + screen_name=null + where user_id = $user_id" +} else { + set sql "update users + set first_names = '$QQfirst_names', + last_name = '$QQlast_name', + email = '$QQemail', + url = '$QQurl', + screen_name='$screen_name' + where user_id = $user_id" +} + +if [catch { ns_db dml $db $sql } errmsg] { + ad_return_error "Ouch!" "The database choked on our update: +
    +$errmsg +
    +" +} else { + ns_returnredirect "one.tcl?user_id=$user_id" +} + Index: web/openacs/www/admin/users/basic-info-update.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/basic-info-update.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/basic-info-update.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,56 @@ +# basic-info-update.tcl,v 3.1 2000/03/09 00:01:33 scott Exp +set_the_usual_form_variables + +# user_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db " +select first_names, + last_name, + email, + url, + screen_name +from users +where user_id=$user_id"] + +set_variables_after_query + +ns_db releasehandle $db + +append whole_page " +[ad_admin_header "Update Basic Information"] + +

    Update Basic Information

    + +for $first_names $last_name + +
    + +
    +[export_form_vars user_id] + + + + + + + + + + +
    Name: +
    email address: +
    Personal URL: +
    Screen name: +
    + +
    +
    +
    + +
    + +[ad_admin_footer] +" +ns_return 200 text/html $whole_page Index: web/openacs/www/admin/users/become.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/become.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/become.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,49 @@ +# become.tcl,v 3.1 2000/02/23 22:46:54 jsalz Exp +# File: /admin/users/become.tcl +# Date: Thu Jan 27 04:57:59 EST 2000 +# Location: 42��21'N 71��04'W +# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA +# Author: mobin@mit.edu (Usman Y. Mobin) +# Purpose: Let's administrator become any user. + +set_form_variables +# user_id + +set return_url [ad_pvt_home] + +set db [ns_db gethandle] + +# Get the password and user ID +# as of Oracle 8.1 we'll have upper(email) constrained to be unique +# in the database (could do it now with a trigger but there is really +# no point since users only come in via this form) + +set selection [ns_db 0or1row $db "select password from users where user_id=$user_id"] + +if {$selection == ""} { + ad_return_error "Couldn't find user $user_id" "Couldn't find user $user_id." + return +} + +set_variables_after_query + + +# just set a session cookie +set expire_state "s" + + +# note here that we stuff the cookie with the password from Oracle, +# NOT what the user just typed (this is because we want log in to be +# case-sensitive but subsequent comparisons are made on ns_crypt'ed +# values, where string toupper doesn't make sense) + +ad_user_login $db $user_id +ns_returnredirect $return_url +#ns_returnredirect "/cookie-chain.tcl?cookie_name=[ns_urlencode ad_auth]&cookie_value=[ad_encode_id $user_id $password]&expire_state=$expire_state&final_page=[ns_urlencode $return_url]" + + + + + + + Index: web/openacs/www/admin/users/contact-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/contact-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/contact-edit-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,22 @@ +# contact-edit-2.tcl,v 3.0 2000/02/06 03:31:03 ron Exp +set_the_usual_form_variables + +# user_id and everything in user_contract + +set db [ns_db gethandle] + + +set num_rows [database_to_tcl_string $db "select count(user_id) +from users_contact where user_id = $user_id"] + +ns_set delkey [ns_getform] submit + + +if {$num_rows == 0} { + ns_db dml $db [util_prepare_insert $db users_contact user_id $user_id [ns_getform]] +} else { + ns_db dml $db [util_prepare_update $db users_contact user_id $user_id [ns_getform]] +} + + +ns_returnredirect "one.tcl?[export_url_vars user_id]" \ No newline at end of file Index: web/openacs/www/admin/users/contact-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/contact-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/contact-edit.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,94 @@ +# contact-edit.tcl,v 3.1 2000/03/09 00:01:33 scott Exp +set_the_usual_form_variables + +# user_id + +if [info exists user_id_from_search] { + set user_id $user_id_from_search +} + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select first_names, last_name from users where user_id = $user_id"] + +if [empty_string_p $selection] { + ad_return_complaint 1 "
  • We couldn't find user #$user_id; perhaps this person was nuke?" + return +} + +set_variables_after_query + +append whole_page "[ad_admin_header "Contact information for $first_names $last_name"] + +

    Contact information for $first_names $last_name

    + +" + +append whole_page "

    + +[ad_admin_context_bar [list "index.tcl" "Users"] [list "one.tcl?[export_url_vars user_id]" "One User"] "Demographic Information"] + + +

    + +" +set selection [ns_db 0or1row $db "select * from users_contact where user_id = $user_id"] + +if {![empty_string_p $selection]} { + set_variables_after_query +} else { + set ha_state "" + set ha_country_code "" + set wa_state "" + set wa_country_code "" +} + + + +append whole_page " + +[export_form_vars user_id] + + + + + + + + + + + + + + + + + + + +
    Home phone
    Work phone
    Cell phone
    Pager +
    Fax +
    Aim Screen Name
    ICQ Number
    Home address
    +
    +
    Home City
    Home State +[state_widget $db $ha_state ha_state] +
    Home Country +[country_widget $db $ha_country_code ha_country_code] +
    Home Postal Code + +
    Work City
    Work State[state_widget $db $wa_state wa_state]
    Work Postal Code
    Work Country +[country_widget $db $wa_country_code wa_country_code] +
    + +
    + +
    +
    • + +[ad_admin_footer] +" + + +ns_db releasehandle $db +ns_return 200 text/html $whole_page Index: web/openacs/www/admin/users/delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/delete-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,49 @@ +# delete-2.tcl,v 3.0 2000/02/06 03:31:05 ron Exp +set admin_user_id [ad_verify_and_get_user_id] + +if { $admin_user_id == 0 } { + ns_returnredirect /register.tcl?return_url=[ns_urlencode "/admin/users/"] + return +} + +set_the_usual_form_variables + +# user_id, optional banned_p, banning_note +# return_url (optional) + +set db [ns_db gethandle] + +set user_name [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id = $user_id"] + + +if { [info exists banned_p] && $banned_p == "t" } { + ns_db dml $db "update users +set banning_user = $admin_user_id, + banned_date = sysdate(), + banning_note = '$QQbanning_note', + user_state = 'banned' +where user_id = $user_id" + set action_report "has been banned." +} else { + ns_db dml $db "update users set deleted_date=sysdate(), +deleting_user = $admin_user_id, +user_state = 'deleted' +where user_id = $user_id" + set action_report "has been marked \"deleted\"." +} + +if { [exists_and_not_null return_url] } { + ns_returnredirect $return_url + return +} + +ns_return 200 text/html "[ad_admin_header "Account deleted"] + +

    Account Deleted

    + +
    + +$user_name $action_report. + +[ad_admin_footer] +" Index: web/openacs/www/admin/users/delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/delete.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,56 @@ +# delete.tcl,v 3.0 2000/02/06 03:31:07 ron Exp +# +# /admin/users/delete.tcl +# +# present a form that will let an admin mark a user's account deleted +# (or ban the user) +# +# by philg@mit.edu late in 1998 +# + +set_form_variables + +# user_id +# return_url (optional) + +set admin_user_id [ad_verify_and_get_user_id] + +if { $admin_user_id == 0 } { + ns_returnredirect /register.tcl?return_url=[ns_urlencode "/admin/users/delete.tcl?user_id=$user_id"] + return +} + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select first_names, last_name from users where user_id = $user_id"] +set_variables_after_query + +ns_return 200 text/html "[ad_admin_header "Deleting $first_names $last_name"] + +

    Deleting $first_names $last_name

    + +
    + +You have two options here: + +
      + +
    • just mark the account deleted +(as if the user him or herself had unsubscribed) + +

      + +

    • +[export_form_vars return_url] + +[export_form_vars user_id] + +
      +reason: +
      + +
    + + +[ad_admin_footer] +" Index: web/openacs/www/admin/users/demographic-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/demographic-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/demographic-edit.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,44 @@ +# demographic-edit.tcl,v 3.1 2000/03/09 00:01:34 scott Exp +set_the_usual_form_variables + +# user_id + +if [info exists user_id_from_search] { + set user_id $user_id_from_search +} + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select first_names, last_name from users where user_id = $user_id"] + +if [empty_string_p $selection] { + ad_return_complaint 1 "
  • We couldn't find user #$user_id; perhaps this person was nuke?" + return +} + +set_variables_after_query + +append whole_page "[ad_admin_header "Demographic information for $first_names $last_name"] + +

    Demographic information for $first_names $last_name

    + +" + +append whole_page "

    + +[ad_admin_context_bar [list "index.tcl" "Users"] [list "one.tcl?[export_url_vars user_id]" "One User"] "Demographic Information"] + + +

    + +" + +set selection [ns_db 0or1row $db "select * from users_contact where user_id = $user_id"] + + + +append whole_page " +[ad_admin_footer] +" +ns_db releasehandle $db +ns_return 200 text/html $whole_page Index: web/openacs/www/admin/users/email-changed-password.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/email-changed-password.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/email-changed-password.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,21 @@ +# email-changed-password.tcl,v 3.0 2000/02/06 03:31:10 ron Exp +# email-changed-password.tcl +# +# hqm@arsdigita.com +# +# form vars: user_id, password +# +# emails the user their new password + + +set_the_usual_form_variables + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select email, password from users where user_id = $user_id"] + +set_variables_after_query + +ns_sendmail "$email" "[ad_parameter NewRegistrationEmailAddress]" "Your password for [ad_system_name] has been changed" "Your password for [ad_system_name] ([ad_parameter SystemURL]) has been changed. Your new password is $password." + +ns_returnredirect "one.tcl?[export_url_vars user_id]" Index: web/openacs/www/admin/users/in-category.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/in-category.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/in-category.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,44 @@ +# in-category.tcl,v 3.1 2000/03/09 00:01:34 scott Exp +set_form_variables + +# category_id + + +set db [ns_db gethandle] +set selection [ns_db 1row $db "select unique category from categories where category_id='$category_id'"] +set_variables_after_query + +append whole_page " +$category Users + +

    CogNet Users Interested in +$category

    + +
      " + + +set selection [ns_db select $db "select u.* +from users u, users_interests ui, categories c +where u.user_id = ui.user_id +and ui.category_id = c.category_id +and c.category_id = '$category_id' +order by u.last_name, u.first_names"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + append whole_page "
    • $first_names $last_name ($email)\n" +} + + +append whole_page " + +
    + + +
    philg@mit.edu
    + + + +" +ns_db releasehandle $db +ns_return 200 text/html $whole_page Index: web/openacs/www/admin/users/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/index.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,346 @@ +# /admin/users/index.tcl +# +# by a bunch of folks including philg@mit.edu and teadams@arsdigita.com +# +# modified by philg on October 30, 1999 to cache the page +# (sequentially scanning through users and such was slowing it down) +# +# modified by aure@caltech.edu on February 4, 2000 to make the page more +# user friendly +# +# we define this procedure here in the file because we don't care if +# it gets reparsed; it is RDBMS load that was slowing stuff down. We also +# want programmers to have an easy way to edit this page. +# +# index.tcl,v 3.3.2.1 2000/03/15 15:54:25 seb Exp + + +proc next_color {bg_color} { + if {$bg_color=="#eeeeee"} { + set bg_color "#f5f5f5" + } else { + set bg_color "#eeeeee" + } + uplevel "set bgcolor $bg_color" + return $bg_color +} + +proc ad_admin_users_index_dot_tcl_whole_page {} { + + set bgcolor "#f5f5f5" + + set whole_page "" + # sadly the rest of the file isn't properly indented + # because I was too lazy. + +append whole_page "[ad_admin_header "Users"] + +

    Users

    + +[ad_admin_context_bar "Users"] + +
    + +
      +
    • total users: +" + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select + count(*) as n_users, + sum(case when user_state='deleted' then 1 else 0 end) as n_deleted_users, + max(registration_date) as last_registration +from users +where email not in ('anonymous', 'system')"] + +set_variables_after_query + +if { $n_users < 200 } { + set complete_users "$n_users" +} else { + set complete_users [util_commify_number $n_users] +} + +append whole_page "$complete_users ($n_deleted_users deleted). Last registration on [util_AnsiDatetoPrettyDate $last_registration] (history). + +" + +if [mv_enabled_p] { + append whole_page "
    • expensive users +" +} + +set state_list "" +set selection [ns_db select $db "select count(user_state) +as num_in_state, user_state +from users +group by user_state"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + set user_state_num($user_state) $num_in_state +} + + +if {[ad_parameter RegistrationRequiresApprovalP "" 0] && [info exists user_state_num(need_admin_approv)]} { + lappend state_list "need_admin_approv ($user_state_num(need_admin_approv))" +} + +if {[ad_parameter RegistrationRequiresApprovalP "" 0] && [ad_parameter RegistrationRequiresEmailVerificationP "" 0] && [info exists user_state_num(need_email_verification_and_admin_approv)]} { + lappend state_list "need_email_verification_and_admin_approv ($user_state_num(need_email_verification_and_admin_approv))" +} + +if {[ad_parameter RegistrationRequiresEmailVerificationP "" 0] && [info exists user_state_num(need_email_verification)]} { + lappend state_list "need_email_verification ($user_state_num(need_email_verification))" +} + +if [info exists user_state_num(authorized)] { + lappend state_list "authorized ($user_state_num(authorized))" +} + +if [info exists user_state_num(banned)] { + lappend state_list "banned ($user_state_num(banned))" +} + +if [info exists user_state_num(deleted)] { + lappend state_list "deleted ($user_state_num(deleted))" +} + +append whole_page " +
    • Users in state: [join $state_list " | "] +

      +" + +set selection [ns_db 1row $db " +select + sum(session_count) as total_sessions, + sum(repeat_count) as total_repeats +from session_statistics"] +set_variables_after_query +if [empty_string_p $total_sessions] { + set total_sessions 0 +} +if [empty_string_p $total_repeats] { + set total_repeats 0 +} + +set spam_count [database_to_tcl_string $db " +select sum(n_sent) from spam_history"] +if [empty_string_p $spam_count] { + set spam_count 0 +} + +append whole_page " + +

      + +

    • registered sessions: by days since last login +
    • total sessions (includes unregistered users): +[util_commify_number $total_sessions] ([util_commify_number $total_repeats] repeats) + +
      + +
    • Quick search: +
      • + + +
    • Add a user + +

      + +

    • Review spam history +([util_commify_number $spam_count] sent) + +

      + + +

      +
    • Previously defined user class: + +
      • +
    +

    Pick a user class

    +
      + + + + + + + + +" + + +if [ad_parameter InternationalP] { + # there are some international users + append whole_page " +" +} + +# POSTGRES problems here. DRB: worked in PG7.0, I'll try cast +# to see if that gets us by 6.5. +# Casting to varchar works better (BMA). + +if [ad_parameter SomeAmericanReadersP] { + append whole_page "" + } + + +append whole_page " + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
      Customer state: +
      Interest:
      Country: +
      State: +
      Group: + +
      Sex: +
      Age: + + +
      +over years +
      +under years +
      + +
      Registration date: + + +
      +over days ago +
      +under days ago +
      +
      Last login: + + +
      +over days ago +
      +under days ago +
      +
      Number of visits: + + +
      +less than +
      +more than +
      +
      Last name starts with: + +
      Email starts with: +
        +Join the above criteria by and or +
      + +
      +
    +" + +if {[ad_parameter AllowAdminSQLQueries "" 0] == 1} { + append whole_page "
    +

    Select by SQL

    +
    +select users.*
    +
    +example: from users where user_id < 1000 +
    + +
    +
    +
    " +} + +append whole_page " + +[ad_style_bodynote "For fluidity of administrations, this page is cached in RAM for 15 minutes. Thus the numbers you see above may be up to 15 minutes out of date."] + +[ad_admin_footer]" +} + +ns_return 200 text/html [util_memoize "ad_admin_users_index_dot_tcl_whole_page" 5] Index: web/openacs/www/admin/users/nuke-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/nuke-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/nuke-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,151 @@ +# nuke-2.tcl,v 3.0.4.3 2000/03/16 18:22:24 lars Exp +set_form_variables + +# user_id + +set db [ns_db gethandle] + +# Uncomment this when there's a real orders table or system in place! +# set selection [ns_db 0or1row $db "select count(*) as n_orders +# from user_orders where user_id = $user_id"] +# set_variables_after_query +set n_orders 0 + +# Don't nuke anyone who pays us money ... +if { $n_orders > 0 } { + ad_return_error "Can't Nuke a Paying Customer" "We can't nuke a paying customer because to do so would screw up accounting records." + return +} + +# have no mercy on the freeloaders + +# if this fails, it will probably be because the installation has +# added tables that reference the users table + +with_transaction $db { + + # bboard system + ns_db dml $db "delete from bboard_email_alerts where user_id=$user_id" + ns_db dml $db "delete from bboard_thread_email_alerts where user_id = $user_id" + + # deleting from bboard is hard because we have to delete not only a user's + # messages but also subtrees that refer to them + bboard_delete_messages_and_subtrees_where $db "user_id=$user_id" + + # let's do the classifieds now + ns_db dml $db "delete from classified_auction_bids where user_id=$user_id" + ns_db dml $db "delete from classified_ads where user_id=$user_id" + ns_db dml $db "delete from classified_email_alerts where user_id=$user_id" + ns_db dml $db "delete from general_comments + where on_which_table = 'neighbor_to_neighbor' + and on_what_id in (select neighbor_to_neighbor_id + from neighbor_to_neighbor + where poster_user_id = $user_id)" + ns_db dml $db "delete from neighbor_to_neighbor where poster_user_id = $user_id" + # now the calendar + ns_db dml $db "delete from calendar where creation_user=$user_id" + # contest tables are going to be tough + set all_contest_entrants_tables [database_to_tcl_list $db "select entrants_table_name from contest_domains"] + foreach entrants_table $all_contest_entrants_tables { + ns_db dml $db "delete from $entrants_table where user_id = $user_id" + } + + # spam history + ns_db dml $db "delete from spam_history where creation_user=$user_id" + ns_db dml $db "update spam_history set last_user_id_sent = NULL + where last_user_id_sent=$user_id" + + # calendar + ns_db dml $db "delete from calendar_categories where user_id=$user_id" + + # sessions + ns_db dml $db "delete from sec_sessions where user_id=$user_id" + ns_db dml $db "delete from sec_login_tokens where user_id=$user_id" + + # general stuff + ns_db dml $db "delete from general_comments where user_id=$user_id" + ns_db dml $db "delete from comments where user_id=$user_id" + ns_db dml $db "delete from links where user_id=$user_id" + ns_db dml $db "delete from chat_msgs where creation_user=$user_id" + ns_db dml $db "delete from query_strings where user_id=$user_id" + ns_db dml $db "delete from user_curriculum_map where user_id=$user_id" + ns_db dml $db "delete from user_content_map where user_id=$user_id" + ns_db dml $db "delete from user_group_map where user_id=$user_id" + + # ticket tracker + ns_db dml $db "update ticket_projects set default_assignee=NULL where default_assignee=$user_id" + ns_db dml $db "update ticket_issues set user_id=NULL where user_id=$user_id" + ns_db dml $db "update ticket_issues set closed_by=NULL where closed_by=$user_id" + ns_db dml $db "update ticket_issues set fixed_by=NULL where fixed_by=$user_id" + ns_db dml $db "update ticket_issues set last_modified_by=NULL where last_modified_by=$user_id" + ns_db dml $db "delete from ticket_assignments where user_id=$user_id" + ns_db dml $db "delete from ticket_issue_user_interest_map where user_id=$user_id" + ns_db dml $db "delete from ticket_issue_assignments where user_id=$user_id" + ns_db dml $db "delete from ticket_issue_responses where user_id=$user_id" + ns_db dml $db "delete from ticket_issue_notifications where user_id=$user_id" + + # todo + ns_db dml $db "delete from todo_user_preferences where user_id=$user_id" + ns_db dml $db "delete from todo_items where list_id in (select list_id from todo_lists where user_id=$user_id)" + ns_db dml $db "delete from todo_items where assigned_by=$user_id" + ns_db dml $db "delete from todo_list_user_map where user_id=$user_id" + ns_db dml $db "delete from todo_list_user_map where list_id in (select list_id from todo_lists where user_id=$user_id)" + ns_db dml $db "delete from todo_list_user_group_map where list_id in (select list_id from todo_lists where user_id=$user_id)" + ns_db dml $db "delete from todo_lists where user_id=$user_id" + + # Notifications + ns_db dml $db "delete from user_notifications where user_id=$user_id" + ns_db dml $db "delete from user_notification_prefs where user_id=$user_id" + ns_db dml $db "delete from user_notification_interest_map where user_id=$user_id" + + # core tables + ns_db dml $db "delete from users_interests where user_id=$user_id" + ns_db dml $db "delete from users_charges where user_id=$user_id" + ns_db dml $db "update users_demographics set referred_by = null where referred_by = $user_id" + ns_db dml $db "delete from users_demographics where user_id=$user_id" + ns_db dml $db "delete from users_preferences where user_id=$user_id" + ns_db dml $db "delete from users_contact where user_id=$user_id" + ns_db dml $db "delete from users where user_id=$user_id" +} { + + set detailed_explanation "" + + if {[ regexp {integrity constraint \([^.]+\.([^)]+)\)} $errmsg match constraint_name]} { + + set selection [ns_db select $db "select table_name from user_constraints + where constraint_name='[DoubleApos $constraint_name]'"] + + if {[ns_db getrow $db $selection]} { + set_variables_after_query + set detailed_explanation "

    + It seems the table we missed is $table_name." + } + } + + ad_return_error "Failed to nuke" "The nuking of user $user_id failed. Probably this is because your installation of the ArsDigita Community System has been customized and there are new tables that reference the users table. Complain to your programmer! + +$detailed_explanation + +

    + +For good measure, here's what the database had to say... + +

    +
    +$errmsg
+
    +
    " + return +} + +ns_return 200 text/html "[ad_admin_header "Done"] + +

    Done

    + +
    + +We've nuked user $user_id. You can return +to user administration now. + +[ad_admin_footer] +" Index: web/openacs/www/admin/users/nuke.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/nuke.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/nuke.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,52 @@ +# nuke.tcl,v 3.1.2.1 2000/03/15 17:06:18 lars Exp +set_form_variables + +# user_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select first_names, last_name +from users +where user_id = $user_id"] +set_variables_after_query + +ns_db releasehandle $db + +ReturnHeaders + +ns_write "[ad_admin_header "Nuke $first_names $last_name"] + +

    Confirm Nuking $first_names $last_name

    + +[ad_admin_context_bar [list "index.tcl" "Users"] [list "one.tcl?[export_url_vars user_id]" "One User"] "Nuke user"] + +
    + +Confirm the nuking of $first_names $last_name + +

    + +First, unless $first_names $last_name is a test user, you should +probably delete this user +instead. Deleting marks the user deleted but leaves intact his or +her contributions to the site content. + +

    + +Nuking is a violent irreversible action. You are instructing the +system to remove the user and any content that he or she has +contributed to the site. This is generally only appropriate in the +case of test users and, perhaps, dishonest people who've flooded a +site with fake crud. + +

    + +

    +
    + + +
    +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/users/one.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/one.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/one.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,180 @@ +# one.tcl,v 3.1 2000/03/09 00:01:35 scott Exp +# +# /admin/users/one.tcl +# +# rewritten by philg@mit.edu on October 31, 1999 +# makes heavy use of procedures in /tcl/ad-user-contributions-summary.tcl +# +# modified by mobin January 27, 2000 5:08 am + +set_the_usual_form_variables + +# user_id, maybe user_id_from_search + +if [info exists user_id_from_search] { + set user_id $user_id_from_search +} + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select users.*, + case when screen_name is null then '< none set up >' else screen_name end as screen_name, + user_demographics_summary(user_id) as demographics_summary from users where user_id=$user_id"] + +if [empty_string_p $selection] { + ad_return_complaint 1 "
  • We couldn't find user #$user_id; perhaps this person was nuked?" + return +} + +set_variables_after_query + +append whole_page "[ad_admin_header "$first_names $last_name"] + +

    $first_names $last_name

    + +" + +if ![empty_string_p $demographics_summary] { + append whole_page "$demographics_summary" +} + +append whole_page "

    + +[ad_admin_context_bar [list "index.tcl" "Users"] "One User"] + + +

    + +" + +append whole_page " + +
      +
    • Name: $first_names $last_name (edit) +
    • Email: $email +(edit) +
    • Screen name: $screen_name (edit) +
    • User ID: $user_id +
    • Registration date: [util_AnsiDatetoPrettyDate $registration_date] +" + +if { [info exists registration_ip] && ![empty_string_p $registration_ip] } { + append whole_page "from $registration_ip\n" +} + +if { ![empty_string_p $last_visit] } { + append whole_page "
    • Last visit: $last_visit\n" +} + +if { ![empty_string_p $portrait_upload_date] } { + append whole_page "
    • Portrait: $portrait_client_file_name\n" +} + + +append whole_page " +
    • User state: $user_state" + +set user_finite_state_links [ad_registration_finite_state_machine_admin_links $user_state $user_id] + +append whole_page " + ([join $user_finite_state_links " | "]) +
    " + +# it looks like we should be doing 0or1row but actually +# we might be in an ACS installation where users_demographics +# isn't used at all + +set contact_info [ad_user_contact_info $db $user_id "site_admin"] + +if ![empty_string_p $contact_info] { + append whole_page "

    Contact Info

    \n\n$contact_info\n +" +} else { + append whole_page "

    Contact Info

    \n\n$contact_info\n +" +} + + +if ![catch { set selection [ns_db 1row $db "select + ud.*, + u.first_names as referring_user_first_names, + u.last_name as referring_user_last_name +from users_demographics ud, users u +where ud.user_id = $user_id +and ud.referred_by = u.user_id +UNION +select ud.*, + NULL as referring_user_first_names, + NULL as referring_user_last_name +from users_demographics ud +where ud.user_id = $user_id +and 0= (select count(*) from users u where ud.referred_by = u.user_id)"] } ] { + # the table exists and there is a row for this user + set demographic_items "" + for {set i 0} {$i<[ns_set size $selection]} {incr i} { + set varname [ns_set key $selection $i] + set varvalue [ns_set value $selection $i] + if { $varname != "user_id" && ![empty_string_p $varvalue] } { + append demographic_items "
  • $varname: $varvalue\n" + } + } + if ![empty_string_p $demographic_items] { + append whole_page "

    Demographics

    \n\n
      $demographic_items
    \n" + + } +} + + + +if ![catch { set selection [ns_db select $db "select c.category +from categories c, users_interests ui +where ui.user_id = $user_id +and c.category_id = ui.category_id"] } ] { + # tables exist + set category_items "" + while {[ns_db getrow $db $selection]} { + set_variables_after_query + append category_items "
  • $category\n" + } + if ![empty_string_p $category_items] { + append whole_page "

    Interests

    \n\n
      \n\n$category_items\n\n
    " + } +} + +append whole_page [ad_summarize_user_contributions $db $user_id "site_admin"] + +append whole_page " + +

    Administrative Actions

    + + + +[ad_admin_footer] +" +ns_db releasehandle $db +ns_return 200 text/html $whole_page Index: web/openacs/www/admin/users/password-update-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/password-update-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/password-update-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,72 @@ +# password-update-2.tcl,v 3.0 2000/02/06 03:31:18 ron Exp +set_the_usual_form_variables + +# first_names, last_name, user_id, password_old, password_1, password_2 + +set db [ns_db gethandle] + +set exception_text "" +set exception_count 0 + +if { ![info exists password_1] || [empty_string_p $password_1] } { + append exception_text "
  • You need to type in a password\n" + incr exception_count +} + +if { ![info exists password_2] || [empty_string_p $password_2] } { + append exception_text "
  • You need to confirm the password that you typed. (Type the same thing again.) \n" + incr exception_count +} + + +if { [string compare $password_2 $password_1] != 0 } { + append exception_text "
  • Your passwords don't match! Presumably, you made a typo while entering one of them.\n" + incr exception_count +} + + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + + +# If we are encrypting passwords in the database, do it now. +if [ad_parameter EncryptPasswordsInDBP "" 0] { + set QQpassword_1 [philg_quote_double_quotes [ns_crypt $password_1 [ad_crypt_salt]]] +} + +set sql "update users set password = '$QQpassword_1' where user_id = $user_id" + +if [catch { ns_db dml $db $sql } errmsg] { + ad_return_error "Ouch!" "The database choked on our update: +
    +$errmsg +
    +" +} else { + + + set offer_to_email_new_password_link "" + if {[ad_parameter EmailChangedPasswordP "" 1]} { + set offer_to_email_new_password_link "Send user new password by email" + } + + ns_return 200 text/html "[ad_admin_header "Password Updated"] + +

    Password Updated

    + +in [ad_site_home_link] + +
    + +You must inform the user of their new password as there is currently no +other way for the user to find out. + +You can return to $first_names $last_name + +

    $offer_to_email_new_password_link + +[ad_admin_footer] +" +} Index: web/openacs/www/admin/users/password-update.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/password-update.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/password-update.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,42 @@ +# password-update.tcl,v 3.1 2000/03/09 00:01:35 scott Exp +set_the_usual_form_variables + +# user_id + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select first_names, last_name, email, url from users where user_id=$user_id"] +set_variables_after_query + +ns_db releasehandle $db + +append whole_page " +[ad_admin_header "Update Password"] + +

    Update Password

    + +for $first_names $last_name in [ad_site_home_link] + +
    + +
    + + +[export_form_vars user_id first_names last_name] + + + + +
    New Password: +
    Confirm: +
    + +
    +
    +
    + +
    + +[ad_admin_footer] +" +ns_return 200 text/html $whole_page Index: web/openacs/www/admin/users/portrait-erase.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/portrait-erase.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/portrait-erase.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,40 @@ +# portrait-erase.tcl,v 3.0 2000/02/06 03:31:21 ron Exp +# +# /admin/users/portrait-erase.tcl +# +# by philg@mit.edu on September 28, 1999 (his friggin' 36th birthday) +# +# erase's a user's portrait (NULLs out columns in the database) +# +# the key here is to null out portrait_upload_date, which is +# used by pages to determine portrait existence +# + +set_the_usual_form_variables + +# user_id + +ad_maybe_redirect_for_registration + +set admin_user_id [ad_verify_and_get_user_id] + +set db [ns_db gethandle] + +if ![ad_administration_group_member $db "site_wide" "" $admin_user_id] { + ad_return_error "Unauthorized" "You're not a member of the site-wide administration group" + return +} + + +ns_db dml $db "update users +set portrait = NULL, + portrait_comment = NULL, + portrait_client_file_name = NULL, + portrait_file_type = NULL, + portrait_file_extension = NULL, + portrait_original_width = NULL, + portrait_original_height = NULL, + portrait_upload_date = NULL +where user_id = $user_id" + +ns_returnredirect "one.tcl?user_id=$user_id" Index: web/openacs/www/admin/users/portrait.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/portrait.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/portrait.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,78 @@ +# portrait.tcl,v 3.0 2000/02/06 03:31:22 ron Exp +# +# /admin/users/portrait.tcl +# +# by philg@mit.edu on September 26, 1999 +# +# offers an admin the option to delete a user's portrait + +set_the_usual_form_variables + +# user_id + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select + first_names, + last_name, + portrait_upload_date, + portrait_comment, + portrait_original_width, + portrait_original_height, + portrait_client_file_name +from users +where user_id=$user_id"] + +if [empty_string_p $selection] { + ad_return_error "Portrait Unavailable" "We couldn't find a portrait (or this user)" + return +} + +set_variables_after_query + +if [empty_string_p $portrait_upload_date] { + ad_return_complaint 1 "
  • You shouldn't have gotten here; we don't have a portrait on file for this person." + return +} + +if { ![empty_string_p $portrait_original_width] && ![empty_string_p $portrait_original_height] } { + set widthheight "width=$portrait_original_width height=$portrait_original_height" +} else { + set widthheight "" +} + +ns_return 200 text/html "[ad_admin_header "Portrait of $first_names $last_name"] + +

    Portrait of $first_names $last_name

    + +[ad_admin_context_bar [list "one.tcl?[export_url_vars user_id]" "One User"] "Portrait"] + +
    + +
    +
    + +
    + +
    + + +
    +
    + +
      +
    • Comment: +
      +$portrait_comment +
      +
    • Uploaded: [util_AnsiDatetoPrettyDate $portrait_upload_date] +
    • Original Name: $portrait_client_file_name + +

      + +

    • erase + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/users/quota-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/quota-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/quota-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,56 @@ +# quota-2.tcl,v 3.0 2000/02/06 03:31:23 ron Exp +set_the_usual_form_variables + +# user_id, new_quota + +set db [ns_db gethandle] + +set exception_text "" +set exception_count 0 + +set special_p [database_to_tcl_string $db " +select count(*) from users_special_quotas +where user_id=$user_id"] + +if {$special_p == 0} { + + if {[empty_string_p $new_quota]} { + ns_returnredirect "one.tcl?user_id=$user_id" + return + } else { + set sql " + insert into users_special_quotas + (user_id, max_quota) + values + ($user_id, $new_quota) + " + } + +} else { + + if {[empty_string_p $new_quota]} { + set sql " + delete from users_special_quotas + where user_id=$user_id + " + } else { + set sql " + update users_special_quotas + set max_quota = $new_quota + where user_id = $user_id + " + } + + +} + +if [catch { ns_db dml $db $sql } errmsg] { + ad_return_error "Ouch!" "The database choked on our update: +
    +$errmsg +
    +" +} else { + ns_returnredirect "one.tcl?user_id=$user_id" +} + Index: web/openacs/www/admin/users/quota.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/quota.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/quota.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,118 @@ +# quota.tcl,v 3.1 2000/03/09 00:01:36 scott Exp +# File: /admin/users/quota.tcl +# Date: Thu Jan 27 03:57:32 EST 2000 +# Location: 42��21'N 71��04'W +# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA +# Author: mobin@mit.edu (Usman Y. Mobin) +# Purpose: User Quota Management + +set_the_usual_form_variables + +# user_id + +set db [ns_db gethandle] + +# set selection [ns_db 1row $db " +# select users.first_names as first_names, +# users.last_name as last_name, +# users_special_quotas.max_quota as max_quota +# from users_special_quotas, users +# where users_special_quotas.user_id(+) = users.user_id +# and users.user_id=$user_id"] + +#DRB: Postgres version + +set selection [ns_db 1row $db " +select users.first_names as first_names, + users.last_name as last_name, + users_special_quotas.max_quota as max_quota +from users_special_quotas, users +where users_special_quotas.user_id = users.user_id +and users.user_id=$user_id +union +select users.first_names as first_names, + users.last_name as last_name, + null as max_quota +from users +where users.user_id=$user_id + and not exists (select 1 from users_special_quotas + where users_special_quotas.user_id = users.user_id)"] + +set_variables_after_query + +# Checking for site-wide administration status +set admin_p [ad_administrator_p $db $user_id] + +set sql " +select (select count(*) * [ad_parameter DirectorySpaceRequirement users] + from users_files + where directory_p='t' + and owner_id=$user_id) + + (select sum(case when file_size is null then 0 else 1 end) + from users_files + where directory_p='f' + and owner_id=$user_id) as quota_used, + case when (select count(*) from + users_special_quotas + where user_id=$user_id) = 0 + then [ad_parameter [ad_decode $admin_p \ + 0 NormalUserMaxQuota \ + 1 PrivelegedUserMaxQuota \ + PrivelegedUserMaxQuota] users] + else + (select max_quota from + users_special_quotas + where user_id=$user_id) end * power(2,20) as quota_max +" + +# Extract results from the query +set selection [ns_db 1row $db $sql] + +# This will assign the variables their appropriate values +# based on the query. +set_variables_after_query + + +set puny_mortal_quota [ad_parameter NormalUserMaxQuota users] +set macho_mortal_quota [ad_parameter PrivelegedUserMaxQuota users] + +append whole_page " +[ad_admin_header "User Webspace Quota"] + +

    User Webspace Quota

    + +for $first_names $last_name + +
    + +Max Quota : [util_commify_number $quota_max] bytes
    +Quota Used: [util_commify_number $quota_used] bytes
    + + +[export_form_vars user_id] + + + + + + + + + + + + + + +
    Normal Quota (megabytes):$puny_mortal_quota (default for normal users)
    Priveleged Quota (megabytes):$macho_mortal_quota (default for priveleged users)
    Give Special Quota (megabytes): (leave blank to give default quota)
    + +
    +
    +
    + +
    + +[ad_admin_footer] +" +ns_db releasehandle $db +ns_return 200 text/html $whole_page Index: web/openacs/www/admin/users/registration-history.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/registration-history.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/registration-history.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,52 @@ +# registration-history.tcl,v 3.1 2000/03/09 00:01:36 scott Exp +# +# /admin/users/registration-history.tcl +# +# by philg@mit.edu, January 1999 +# (substantially modified on October 30, 1999 to turn it into a graph) +# +# displays a table of number of registrations by month +# + + +append whole_page "[ad_admin_header "User Registration History"] + +

    Registration History

    + +[ad_admin_context_bar [list "index.tcl" "Users"] "Registration History"] + +
    + +
    + +" + +set db [ns_db gethandle] + +# we have to query for pretty month and year separately because Oracle pads +# month with spaces that we need to trim + +set selection [ns_db select $db "select to_char(registration_date,'YYYYMM') as sort_key, date_part('Month',registration_date) as pretty_month, date_part('Year',registration_date) as pretty_year, count(*) as n_new +from users +where registration_date is not null +group by to_char(registration_date,'YYYYMM'), date_part('Month',registration_date), date_part('Year',registration_date) +order by 1"] + +set accumulated_sublists [list] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + set drilldown_url "action-choose.tcl?registration_during_month=$sort_key" + lappend accumulated_sublists [list $pretty_month $pretty_year $n_new $drilldown_url] +} + +ns_db releasehandle $db + +append whole_page " +[gr_sideways_bar_chart -non_percent_values_p "t" -compare_non_percents_across_categories "t" -display_scale_p "f" -display_values_p "t" $accumulated_sublists] + +
    + +[ad_admin_footer] +" +ns_return 200 text/html $whole_page Index: web/openacs/www/admin/users/reject.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/reject.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/reject.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,40 @@ +# reject.tcl,v 3.1 2000/03/09 00:01:36 scott Exp +set admin_user_id [ad_verify_and_get_user_id] + +if { $admin_user_id == 0 } { + ns_returnredirect /register.tcl?return_url=[ns_urlencode "/admin/users/awaiting-approval.tcl"] + return +} + +set_the_usual_form_variables + +# user_id + +set db [ns_db gethandle] +set selection [ns_db 1row $db "select first_names || ' ' || last_name as name, user_state from users where user_id = $user_id"] +set_variables_after_query + + +append whole_page "[ad_admin_header "Rejecting $name"] + +

    Rejecting $name

    + +[ad_admin_context_bar [list "index.tcl" "Users"] [list "awaiting-approval.tcl" "Approval"] "Approve One"] + +
    + +" + +ns_db dml $db "update users +set rejected_date = sysdate(), user_state = 'rejected', +rejecting_user = $admin_user_id +where user_id = $user_id" + + +append whole_page " +Done. + +[ad_admin_footer] +" +ns_db releasehandle $db +ns_return 200 text/html $whole_page Index: web/openacs/www/admin/users/search.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/search.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/search.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,137 @@ +# admin/users/search.tcl +# +# Reusable page for searching for a user by email or last_name. +# Returns to "target" with user_id_from_search, first_names_from_search, +# last_name_from_search, and email_from_search, and passing along all +# form variables listed in "passthrough". +# +# search.tcl,v 3.4 2000/03/09 00:01:36 scott Exp +# ----------------------------------------------------------------------------- + + +set_the_usual_form_variables +# email or last_name (search strings) +# also accept "keyword" (for looking through both) +# target (URL to return to) +# passthrough (form variables to pass along from caller) +# limit_to_users_in_group_id (optional argument that limits our search to users in the specified group id. +# (Note that we allow limit_to_users_in_group_id to be a comma separated list... to allow searches within +# multiple groups) + +# Check input. +set exception_count 0 +set exception_text "" + +if [info exists keyword] { + # this is an administrator + if { [empty_string_p $keyword] } { + incr exception_count + append exception_text "
  • You forgot to type a search string!\n" + } +} else { + # from one of the user pages + if { (![info exists email] || $email == "") && (![info exists last_name] || $last_name == "") } { + incr exception_count + append exception_text "
  • You must specify either an email address or last name to search for.\n" + } + + if { [info exists email] && [info exists last_name] && $email != "" && $last_name != "" } { + incr exception_count + append exception_text "
  • You can only specify either email or last name, not both.\n" + } + + if { ![info exists target] || $target == "" } { + incr exception_count + append exception_text "
  • Target was not specified. This shouldn't have happened, +please contact the administrator +and let them know what happened.\n" + } +} + +if { $exception_count != 00 } { + ad_return_complaint $exception_count $exception_text + return +} + +if { [info exists keyword] } { + set search_clause "lower(email) like '%[string tolower $QQkeyword]%' or lower(first_names || ' ' || last_name) like '%[string tolower $QQkeyword]%'" + set search_text "name or email matching \"$keyword\"" +} elseif { [info exists email] && $email != "" } { + set search_text "email \"$email\"" + set search_clause "lower(email) like '%[string tolower $QQemail]%'" +} else { + set search_text "last name \"$last_name\"" + set search_clause "lower(last_name) like '%[string tolower $QQlast_name]%'" +} + +if { ![info exists passthrough] } { + set passthrough_parameters "" +} else { + set passthrough_parameters "&[export_entire_form_as_url_vars $passthrough]" +} + + +if { [exists_and_not_null limit_to_users_in_group_id] } { +set query "select distinct u.user_id as user_id_from_search, + u.first_names as first_names_from_search, u.last_name as last_name_from_search, + u.email as email_from_search, u.user_state +from users u, user_group_map ugm +where u.user_id=ugm.user_id +and ugm.group_id in ($limit_to_users_in_group_id) +and $search_clause" + +} else { +set query "select user_id as user_id_from_search, + first_names as first_names_from_search, last_name as last_name_from_search, + email as email_from_search, user_state +from users +where $search_clause" +} + + +set db [ns_db gethandle] + +# We are limiting the search to one group - display that group's name +if { [exists_and_not_null limit_to_users_in_group_id] && ![regexp {[^0-9]} $limit_to_users_in_group_id] } { + set group_text " in [database_to_tcl_string $db "select group_name from user_groups where group_id=$limit_to_users_in_group_id"]" +} else { + set group_text "" +} + +set selection [ns_db select $db $query] + + + +append whole_page "[ad_admin_header "User Search$group_text"] +

    User Search$group_text

    +for $search_text +
    +
      +" + +set i 0 + +set user_items "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + append user_items "
    • $first_names_from_search $last_name_from_search ($email_from_search)\n" + incr i + if { $user_state != "authorized" } { + set user_finite_state_links [ad_registration_finite_state_machine_admin_links $user_state $user_id_from_search] + append user_items "$user_state [join $user_finite_state_links " | "] \n" + } +} + +if { $i == 0 } { + append whole_page "
    • No users found.\n" +} else { + append whole_page $user_items +} + +append whole_page "
    +[ad_admin_footer] +" +ns_db releasehandle $db +ns_return 200 text/html $whole_page Index: web/openacs/www/admin/users/session-history.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/session-history.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/session-history.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,60 @@ +# session-history.tcl,v 3.1 2000/03/09 00:01:36 scott Exp + +append whole_page "[ad_admin_header "Session History"] + +

    Session History

    + +[ad_admin_context_bar [list "index.tcl" "Users"] "Session History"] + + +
    + +
    + + + + + +" + +set db [ns_db gethandle] + +# we have to query for pretty month and year separately because Oracle pads +# month with spaces that we need to trim + +set selection [ns_db select $db "select date_part('Year',entry_date)||date_part('Month',entry_date) as sort_key, date_part('Month', entry_date) as pretty_month, date_part('Year',entry_date) as pretty_year, sum(session_count) as total_sessions, sum(repeat_count) as total_repeats +from session_statistics +group by date_part('Year',entry_date)||date_part('Month',entry_date), date_part('Month',entry_date) , date_part('Year',entry_date) +order by 1"] + +set last_year "" +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $last_year != $pretty_year } { + if { ![empty_string_p $last_year] } { + # insert a line break + append whole_page "\n" + } + set last_year $pretty_year + } + append whole_page " + + + +" +} + +append whole_page " +
    MonthTotal SessionsRepeat Sessions +
     
    $pretty_month $pretty_year +[util_commify_number $total_sessions][util_commify_number $total_repeats]
    +
    + +[ad_style_bodynote "Note: we distinguish between a repeat and a new session by seeing +whether the last_visit cookie is set. The new session figures are +inflated to the extent that users have disabled cookies."] + +[ad_admin_footer] +" +ns_db releasehandle $db +ns_return 200 text/html $whole_page Index: web/openacs/www/admin/users/sessions-one-month.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/sessions-one-month.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/sessions-one-month.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,56 @@ +# sessions-one-month.tcl,v 3.1 2000/03/09 00:01:37 scott Exp +set_the_usual_form_variables + +# pretty_month, pretty_year + + +append whole_page "[ad_admin_header "Sessions in $pretty_month, $pretty_year"] + +

    $pretty_month $pretty_year

    + +[ad_admin_context_bar [list "index.tcl" "Users"] [list "session-history.tcl" "Session History"] "One Month"] + +
    + +
    + + + + + +" + +set db [ns_db gethandle] +set selection [ns_db select $db "select + entry_date, + to_char(entry_date,'FMDD') as day_number, + session_count, + repeat_count +from session_statistics +where date_part('Month',entry_date) = '$QQpretty_month' +and date_part('Year',entry_date) = '$QQpretty_year' +order by entry_date"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append whole_page " + + +" +} + +append whole_page " + +
    Date + Sessions + Repeats +
    $pretty_month $day_number + [util_commify_number $session_count] + [util_commify_number $repeat_count] +
    +
    + +[ad_admin_footer] +" +ns_db releasehandle $db +ns_return 200 text/html $whole_page Index: web/openacs/www/admin/users/sessions-registered-summary.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/sessions-registered-summary.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/sessions-registered-summary.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,66 @@ +# sessions-registered-summary.tcl,v 3.1 2000/03/09 00:01:37 scott Exp +# +# sessions-registered-summary.tcl +# +# by philg@mit.edu sometime in 1999 +# +# displays a table of number of users who haven't logged in +# for X days + +set_the_usual_form_variables 0 + +# go_beyond_60_days_p (optional; default is to limit to 60 days) + + +append whole_page "[ad_admin_header "Registered Sessions"] + +

    Registered Sessions

    + +[ad_admin_context_bar [list "index.tcl" "Users"] "Registered Sessions"] + + +
    + +
    + + + + + +" + +set db [ns_db gethandle] + +# we have to query for pretty month and year separately because Oracle pads +# month with spaces that we need to trim + +set selection [ns_db select $db "select round(date_part('days',sysdate()-last_visit) + date_part('hours',sysdate()-last_visit)/24) as n_days, count(*) as n_sessions, count(second_to_last_visit) as n_repeats +from users +where last_visit is not null +group by round(date_part('days',sysdate()-last_visit) + date_part('hours',sysdate()-last_visit)/24) +order by 1"] + +set table_rows "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $n_days > 60 && (![info exists go_beyond_60_days_p] || !$go_beyond_60_days_p) } { + append table_rows "\n" + append table_rows "\n" + ns_db flush $db + break + } + append table_rows "\n" +} + +ns_db releasehandle $db + +append whole_page "$table_rows +
    N Days Since Last VisitTotal SessionsRepeat Sessions +
     
    go beyond 60 days...
    $n_days$n_sessions$n_repeats
    + +
    + +[ad_admin_footer] +" +ns_return 200 text/html $whole_page Index: web/openacs/www/admin/users/unban.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/unban.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/unban.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,19 @@ +# unban.tcl,v 3.0 2000/02/06 03:31:37 ron Exp +set_form_variables + +# user_id + +set db [ns_db gethandle] + +ns_db dml $db "update users set user_state = 'authorized' where user_id = $user_id" + +ns_return 200 text/html "[ad_admin_header "Account resurrected"] + +

    Account Resurrected

    + +
    + +[database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id = $user_id"] has been marked \"not deleted\". + +[ad_admin_footer] +" Index: web/openacs/www/admin/users/undelete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/undelete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/undelete.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,19 @@ +# undelete.tcl,v 3.0 2000/02/06 03:31:38 ron Exp +set_form_variables + +# user_id + +set db [ns_db gethandle] + +ns_db dml $db "update users set user_state = 'authorized' where user_id = $user_id" + +ns_return 200 text/html "[ad_admin_header "Account resurrected"] + +

    Account Resurrected

    + +
    + +[database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id = $user_id"] has been marked \"not deleted\". + +[ad_admin_footer] +" Index: web/openacs/www/admin/users/user-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/user-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/user-add-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,150 @@ +# user-add-2.tcl,v 3.1 2000/03/09 00:01:37 scott Exp +set_the_usual_form_variables + +set admin_user_id [ad_verify_and_get_user_id] + +if { $admin_user_id == 0 } { + ns_returnredirect /register.tcl?return_url=[ns_urlencode "/admin/users/"] + return +} + +# email first_names last_name, user_id + +# Error Count and List +set exception_count 0 +set exception_text "" + +# Check input + +if {![info exists user_id] || [empty_string_p $user_id] } { + incr exception_count + append exception_text "
  • Your browser dropped the user_id variable or something is wrong with our code.\n" +} + +set db [ns_db gethandle] + +if {![info exists email] || ![philg_email_valid_p $email]} { + incr exception_count + append exception_text "
  • The email address that you typed doesn't look right to us. Examples of valid email addresses are +
      +
    • Alice1234@aol.com +
    • joe_smith@hp.com +
    • pierre@inria.fr +
    +" +} else { + + set email_count [database_to_tcl_string $db "select count(email) +from users where upper(email) = '[string toupper $QQemail]' +and user_id <> $user_id"] + + # note, we dont' produce an error if this is a double click + if {$email_count > 0} { + incr exception_count + append exception_text "$email was already in the database." + } + +} + + +if {![info exists first_names] || [empty_string_p $first_names]} { + incr exception_count + append exception_text "
  • You didn't enter a first name." +} + +if {![info exists last_name] || [empty_string_p $last_name]} { + incr exception_count + append exception_text "
  • You didn't enter a last name." +} + +# We've checked everything. +# If we have an error, return error page, otherwise, do the insert + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + +set password [ad_generate_random_string] +set QQpassword [DoubleApos $password] + +# If we are encrypting passwords in the database, convert +if [ad_parameter EncryptPasswordsInDBP "" 0] { + set QQpassword_for_database [DoubleApos [ns_crypt $password [ad_crypt_salt]]] +} else { + set QQpassword_for_database $QQpassword +} + +set insert_statement "insert into users +(user_id,email,password,first_names,last_name,registration_date,registration_ip, user_state) +values +($user_id,'$QQemail','$QQpassword_for_database','$QQfirst_names','$QQlast_name', sysdate(), '[ns_conn peeraddr]', 'authorized')" + + +if [catch { ns_db dml $db $insert_statement } errmsg] { + # if it was not a double click, produce an error + if { [database_to_tcl_string $db "select count(user_id) from users where user_id = $user_id"] == 0 } { + ad_return_error "Insert Failed" "We were unable to create your user record in the database. Here's what the error looked like: +
    +
    +$errmsg
+
    +
    " +return + } +} + +set administration_name [database_to_tcl_string $db "select +first_names || ' ' || last_name from users where user_id = $admin_user_id"] + + +append whole_page "[ad_admin_header "Add a user"] + +

    Add a user

    + +[ad_admin_context_bar [list "index.tcl" "Users"] "Notify added user"] + +
    + +$first_names $last_name has been added to [ad_system_name]. +Edit the message below and hit \"Send Email\" to +notify this user. + +

    + +[export_form_vars email first_names last_name user_id] +Message: + +

    + + + +

    + +

    + + + +
    + +
    • +

    + + +[ad_admin_footer] +" +ns_db releasehandle $db +ns_return 200 text/html $whole_page Index: web/openacs/www/admin/users/user-add-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/user-add-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/user-add-3.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,41 @@ +# user-add-3.tcl,v 3.1 2000/03/09 00:01:37 scott Exp +set_the_usual_form_variables + +# email, message, first_names, last_name, user_id + + +set admin_user_id [ad_verify_and_get_user_id] + +if { $admin_user_id == 0 } { + ns_returnredirect /register.tcl?return_url=[ns_urlencode "/admin/users/"] + return +} + + +append whole_page "[ad_admin_header "Email sent"] + +

    Email sent

    + +[ad_admin_context_bar [list "index.tcl" "Users"] "New user notified"] + +
    +" + +set db [ns_db gethandle] +set admin_email [database_to_tcl_string $db "select email from +users where user_id = $admin_user_id"] + +ns_sendmail "$email" "$admin_email" "You have been added as a user to [ad_system_name] at [ad_parameter SystemUrl]" "$message" + +append whole_page " +$first_names $last_name has been notified. +

    +

    + +[ad_admin_footer] +" +ns_db releasehandle $db +ns_return 200 text/html $whole_page Index: web/openacs/www/admin/users/user-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/user-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/user-add.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,42 @@ +# user-add.tcl,v 3.1 2000/03/09 00:01:37 scott Exp +set admin_user_id [ad_verify_and_get_user_id] + +if { $admin_user_id == 0 } { + ns_returnredirect /register.tcl?return_url=[ns_urlencode "/admin/users/"] + return +} + + +append whole_page "[ad_admin_header "Add a user"] + +

    Add a user

    + +[ad_admin_context_bar [list "index.tcl" "Users"] "Add user"] + +
    " + +set db [ns_db gethandle] + +# generate unique key here so we can handle the "user hit s" case +set user_id [database_to_tcl_string $db "select user_id_sequence.nextval from dual"] + +append whole_page " +
    +[export_form_vars user_id] + + + +
    Email:
    Full Name:
    +

    +

    + +
    + +
    +

    + + +[ad_admin_footer] +" +ns_db releasehandle $db +ns_return 200 text/html $whole_page Index: web/openacs/www/admin/users/user-class-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/user-class-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/user-class-add.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,23 @@ +# user-class-add.tcl,v 3.0 2000/02/06 03:31:44 ron Exp +set_the_usual_form_variables + +# sql_description, query, name, +# maybe return_url + +set db [ns_db gethandle] + +set user_class_id [database_to_tcl_string $db "select user_class_id_seq.nextval from dual"] + +regexp -nocase {^select[^=><-]*(from.*)} $query match sql_post_select + +if {![info exists sql_post_select] || [empty_string_p $sql_post_select]} { + ad_return_complaint 1 "

  • Your query does not start with select clause or does not contain \"from\"." + return +} + +ns_db dml $db "insert into user_classes (user_class_id, name, sql_description, +sql_post_select) select $user_class_id, '$QQname', '$QQsql_description', '[DoubleApos $sql_post_select]' +from dual where not exists +(select 1 from user_classes where name = '$QQname')" + +ns_returnredirect "action-choose.tcl?[export_url_vars user_class_id]" Index: web/openacs/www/admin/users/user-class-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/user-class-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/user-class-edit-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,38 @@ +# user-class-edit-2.tcl,v 3.0 2000/02/06 03:31:48 ron Exp +set_the_usual_form_variables + +# user_class_id, description, sql_description, sql_post_select, name +# maybe return_url + +set exception_text "" +set exception_count 0 + +if {[string length $description] > 4000} { + incr exception_count + append exception_text "
  • Please limit your description to 4000 characters." +} + +if {[string length $sql_description] > 4000} { + incr exception_count + append exception_text "
  • Please limit your sql description to 4000 characters." +} + +if {[string length $sql_post_select] > 4000} { + incr exception_count + append exception_text "
  • Please limit your sql to 4000 characters." +} + +if {$exception_count > 1} { + ad_return_complaint $exception_count $exception_text + return +} + +set db [ns_db gethandle] + +ns_db dml $db "update user_classes set name = '$QQname', +sql_description = '$QQsql_description', +sql_post_select = '$QQsql_post_select', +description = '$QQdescription' +where user_class_id = $user_class_id" + +ns_returnredirect "action-choose.tcl?[export_url_vars user_class_id]" Index: web/openacs/www/admin/users/user-class-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/user-class-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/user-class-edit.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,41 @@ +# user-class-edit.tcl,v 3.0 2000/02/06 03:31:49 ron Exp +set_the_usual_form_variables + +# user_class_id + +set db [ns_db gethandle] +set selection [ns_db 1row $db "select name, +sql_description, sql_post_select, description +from user_classes +where user_class_id = $user_class_id"] +set_variables_after_query + +ns_return 200 text/html " +[ad_admin_header "Edit $name"] + +

    Edit $name

    + + +[ad_admin_context_bar [list "index.tcl" "Users"] [list "action-choose.tcl?[export_url_vars user_class_id]" "$name" ] "Edit"] + +
    + +
    +[export_form_vars user_class_id] + + + + + + + + +
    Name:
    Description:
    SQL description:User who
    SQL: +select users(*)
    + +
    +
    + +
    +
    +[ad_admin_footer]" \ No newline at end of file Index: web/openacs/www/admin/users/view-csv.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/view-csv.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/view-csv.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,47 @@ +# view-csv.tcl,v 3.1 2000/03/09 00:01:37 scott Exp +# +# view-csv.tcl +# +# by philg@mit.edu on October 30, 1999 +# +# returns a comma-separated values file where each row is one +# user in a class (designated by the args); this CSV file is +# suitable for importation into any standard spreadsheet program +# + +ad_maybe_redirect_for_registration + +set admin_user_id [ad_verify_and_get_user_id] + +# we get a form that specifies a class of user, plus maybe an order_by +# spec + +set description [ad_user_class_description [ns_conn form]] + + +set db [ns_db gethandle] + +set new_set [ns_set copy [ns_conn form]] +ns_set put $new_set include_contact_p 1 +ns_set put $new_set include_demographics_p 1 + +set query [ad_user_class_query $new_set] +append ordered_query $query "\n" "order by upper(last_name),upper(first_names), upper(email)" + +set selection [ns_db select $db $ordered_query] +set count 0 + +set csv_rows "" + +while { [ns_db getrow $db $selection] } { + set_csv_variables_after_query + incr count + # make sure not to put any spaces after the commas or Excel + # will treat the " as part of the field! + append csv_rows "$QEQQemail,$QEQQlast_name,$QEQQfirst_names\n" +} + +append whole_page $csv_rows + +ns_db releasehandle $db +ns_return 200 text/plain $whole_page Index: web/openacs/www/admin/users/view-verbose.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/view-verbose.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/view-verbose.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,86 @@ +# view-verbose.tcl,v 3.1 2000/03/09 00:01:37 scott Exp +# +# view-verbose.tcl +# +# by teadams@mit.edu and philg@mit.edu in ancient times (1998?) +# +# displays an HTML page with a list of the users in a class +# + +ad_page_variables { + order_by +} + +set admin_user_id [ad_verify_and_get_user_id] + +if { $admin_user_id == 0 } { + ns_returnredirect /register.tcl?return_url=[ns_urlencode "/admin/users/"] + return +} + +# we get a form that specifies a class of user, plus maybe an order_by +# spec + +set description [ad_user_class_description [ns_conn form]] + + +append whole_page "[ad_admin_header "Users who $description"] + +

    Users

    + +who $description among all users of [ad_system_name] + +
    + +" + +if { $order_by == "email" } { + set order_by_clause "order by upper(email),upper(last_name),upper(first_names)" + set option "sort by name" +} else { + set order_by_clause "order by upper(last_name),upper(first_names), upper(email)" + set option "sort by email address" +} + + +set db [ns_db gethandle] + +# we print out all the users all of the time +append whole_page " + +$option + +
      " + +set new_set [ns_set copy [ns_conn form]] +ns_set put $new_set include_contact_p 1 +ns_set put $new_set include_demographics_p 1 + +set query [ad_user_class_query $new_set] +append ordered_query $query "\n" $order_by_clause + +set selection [ns_db select $db $ordered_query] +set count 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + incr count + append whole_page "
    • $first_names $last_name ($email)" + if ![empty_string_p $demographics_summary] { + append whole_page ", $demographics_summary" + } + if ![empty_string_p $contact_summary] { + append whole_page ", $contact_summary" + } + append whole_page "\n" +} + +if { $count == 0 } { + append whole_page "no users found meeting these criteria" +} + +append whole_page "
    + +[ad_admin_footer] +" +ns_db releasehandle $db +ns_return 200 text/html $whole_page Index: web/openacs/www/admin/users/view.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/view.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/view.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,81 @@ +# view.tcl,v 3.1 2000/03/09 00:01:38 scott Exp + +ad_page_variables { + {order_by "email"} + {special ""} +} + +set admin_user_id [ad_verify_and_get_user_id] + +if { $admin_user_id == 0 } { + ns_returnredirect /register.tcl?return_url=[ns_urlencode "/admin/users/"] + return +} + +# we get a form that specifies a class of user, plus maybe an order_by +# spec + +set description [ad_user_class_description [ns_conn form]] + + +append whole_page "[ad_admin_header "Users who $description"] + +

    Users

    + +[ad_admin_context_bar [list "index.tcl" "Users"] "View Class"] + + +
    + +Class description: users who $description. + +

    + + +" + +if { $order_by == "email" } { + set order_by_clause "order by upper(email),upper(last_name),upper(first_names)" + set option "sort by name" +} else { + set order_by_clause "order by upper(last_name),upper(first_names), upper(email)" + set option "sort by email address" +} + + +set db [ns_db gethandle] + +# we print out all the users all of the time +append whole_page " + +$option + +

      " + +set query [ad_user_class_query [ns_conn form]] +append ordered_query $query "\n" $order_by_clause + +set selection [ns_db select $db $ordered_query] +set count 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + incr count + append whole_page "
    • $first_names $last_name ($email) \n" + + if {$user_state == "need_email_verification_and_admin_approv" || $user_state == "need_admin_approv"} { + append whole_page "$user_state Approve | Reject" + } + +} + +if { $count == 0 } { + append whole_page "no users found meeting these criteria" +} + +append whole_page "
    + +[ad_admin_footer] +" +ns_db releasehandle $db +ns_return 200 text/html $whole_page Index: web/openacs/www/admin/users/merge/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/merge/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/merge/index.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,35 @@ +# index.tcl,v 3.0 2000/02/06 03:31:53 ron Exp +ReturnHeaders + +ns_write "[ad_admin_header "Merge Users"] + +

    Merge Users

    + +
    + +This is a good place to be if you're interested in undoing the damage +done when the same person registers twice with two different email +addresses. + +

    + +It is particularly useful for situations where you've installed the +ArsDigita Community System on top of legacy systems that are keyed by +email address. In fact, it was written for http://photo.net/photo/ +where user-contributed content was keyed by email address for four +years (hence there were many users who'd flowed through three or four +email addresses in that time). + +

    + +Start by looking at all users + +

    + +[ad_admin_footer] +" Index: web/openacs/www/admin/users/merge/merge-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/merge/merge-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/merge/merge-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,215 @@ +# merge-2.tcl,v 3.2 2000/03/09 00:01:38 scott Exp +set_the_usual_form_variables + +# source_user_id, target_user_id + +# push all of source_user_id's content into target_user_id and drop +# the source_user + +set db_conns [ns_db gethandle [philg_server_default_pool] 2] +set db [lindex $db_conns 0] +set db_sub [lindex $db_conns 1] + +set selection [ns_db 1row $db "select email as source_user_email, first_names as source_user_first_names, last_name as source_user_last_name, registration_date as source_user_registration_date, last_visit as source_user_last_visit +from users +where user_id = $source_user_id"] +set_variables_after_query + +set selection [ns_db 1row $db "select email as target_user_email, first_names as target_user_first_names, last_name as target_user_last_name, registration_date as target_user_registration_date, last_visit as target_user_last_visit +from users +where user_id = $target_user_id"] +set_variables_after_query + + +append whole_page "[ad_admin_header "Merging $source_user_email into $target_user_email"] + +

    Merging

    + +$source_user_email into $target_user_email + +
    + +All of the content contributed by User ID $source_user_id +($source_user_first_names $source_user_last_name; $source_user_email) +will be reattributed to User ID $target_user_id +($target_user_first_names $target_user_last_name; $target_user_email). + +

    + +Then we will drop User ID $source_user_id. + +

    + +

    + +All of this happens inside an RDBMS transaction. If +there is an error during any part of this process, the database is +left untouched. + +
    + +
      + +" + +ns_db dml $db "begin transaction" + +# let's just delete portals stuff + +ns_db dml $db "delete from portal_table_page_map +where page_id in (select page_id from portal_pages where user_id = $source_user_id)" + +ns_db dml $db "delete from portal_pages where user_id = $source_user_id" + +append whole_page "
    • Deleted [ns_pg ntuples $db] rows from the portal pages table.\n" + + +ns_db dml $db "update bboard set user_id = $target_user_id where user_id = $source_user_id" + +append whole_page "
    • Updated [ns_pg ntuples $db] rows in the bboard table.\n" + +ns_db dml $db "update chat_msgs set creation_user = $target_user_id where creation_user = $source_user_id" + +append whole_page "
    • Updated [ns_pg ntuples $db] from rows in the chat table.\n" + +ns_db dml $db "update chat_msgs set recipient_user = $target_user_id where recipient_user = $source_user_id" + +append whole_page "
    • Updated [ns_pg ntuples $db] to rows in the chat table.\n" + + +ns_db dml $db "update classified_ads set user_id = $target_user_id where user_id = $source_user_id" + +append whole_page "
    • Updated [ns_pg ntuples $db] rows in the classified ads table.\n" + +ns_db dml $db "update classified_email_alerts set user_id = $target_user_id where user_id = $source_user_id" + +append whole_page "
    • Updated [ns_pg ntuples $db] rows in the classified email alerts table.\n" + +ns_db dml $db "update comments set user_id = $target_user_id where user_id = $source_user_id" + +append whole_page "
    • Updated [ns_pg ntuples $db] rows in the comments table.\n" + +ns_db dml $db "update neighbor_to_neighbor set poster_user_id = $target_user_id where poster_user_id = $source_user_id" + +append whole_page "
    • Updated [ns_pg ntuples $db] rows in the neighbor to neighbor table.\n" + +ns_db dml $db "update links set user_id = $target_user_id where user_id = $source_user_id" + +append whole_page "
    • Updated [ns_pg ntuples $db] rows in the links table.\n" + +# don't want to violate the unique constraint, so get rid of duplicates first +ns_db dml $db "delete from user_content_map +where user_id = $source_user_id +and page_id in (select page_id from user_content_map where user_id = $target_user_id)" + +ns_db dml $db "update user_content_map +set user_id = $target_user_id +where user_id = $source_user_id" + +append whole_page "
    • Updated [ns_pg ntuples $db] rows in the user_content_map table.\n" + +# let's do the same thing for the user_curriculum_map +ns_db dml $db "delete from user_curriculum_map +where user_id = $source_user_id +and curriculum_element_id in (select curriculum_element_id from user_curriculum_map where user_id = $target_user_id)" + +ns_db dml $db "update user_curriculum_map +set user_id = $target_user_id +where user_id = $source_user_id" + +append whole_page "
    • Updated [ns_pg ntuples $db] rows in the user_curriculum_map table.\n" + +# now we have to do the same thing for the poll system + +ns_db dml $db "delete from poll_user_choices +where (choice_id, user_id) in (select choice_id, user_id + from poll_user_choices + where user_id = $target_user_id)" + + +ns_db dml $db "update poll_user_choices +set user_id = $target_user_id +where user_id = $source_user_id" + +append whole_page "
    • Updated [ns_pg ntuples $db] rows in the poll_user_choices table.\n" + + +ns_db dml $db "update query_strings set user_id = $target_user_id where user_id = $source_user_id" + +append whole_page "
    • Updated [ns_pg ntuples $db] rows in the query_strings table.\n" + + +foreach entrants_table_name [database_to_tcl_list $db_sub "select entrants_table_name from contest_domains"] { + ns_db dml $db "update $entrants_table_name set user_id = $target_user_id where user_id = $source_user_id" + append whole_page "
    • Updated [ns_pg ntuples $db] rows in the $entrants_table_name table.\n" +} + +ns_db dml $db "update calendar set creation_user = $target_user_id where creation_user = $source_user_id" +append whole_page "
    • Updated [ns_pg ntuples $db] rows in the calendar table.\n" + +ns_db dml $db "update general_comments set user_id = $target_user_id where user_id = $source_user_id" + +append whole_page "
    • Updated [ns_pg ntuples $db] rows in the general_comments table.\n" + +ns_db dml $db "update stolen_registry set user_id = $target_user_id where user_id = $source_user_id" + +append whole_page "
    • Updated [ns_pg ntuples $db] rows in the stolen_registry table.\n" + +# **** this must be beefed up so that we drop rows that would result +# **** in a duplicate mapping +# jeez -- just how lazy can you get? -- markc + +ns_db dml $db " + update + user_group_map map + set + user_id = $target_user_id + where + user_id = $source_user_id and + not exists ( + select * from + user_group_map + where + user_id = $target_user_id and + group_id = map.group_id and + role = map.role + ) +" + + + +append whole_page "
    • Updated [ns_pg ntuples $db] rows in the user_group_map table.\n" + +# delete the duplicate mappings that we didn't transfer to the target user id + +ns_db dml $db "delete from user_group_map where user_id = $source_user_id" + + +ns_db dml $db "delete from email_log where user_id = $source_user_id" + +ns_db dml $db "delete from users_preferences where user_id = $source_user_id" +ns_db dml $db "delete from users_interests where user_id = $source_user_id" +ns_db dml $db "delete from user_requirements where user_id = $source_user_id" +ns_db dml $db "delete from users_demographics where user_id = $source_user_id" +ns_db dml $db "delete from users_contact where user_id = $source_user_id" + +# before we kill off old user, let's update registration date of new user + +ns_db dml $db "update users +set registration_date = (select min(registration_date) from users where user_id in ($target_user_id, $source_user_id)) +where user_id = $target_user_id" + +ns_db dml $db "delete from users where user_id = $source_user_id" + +ns_db dml $db "end transaction" + +append whole_page " +
    + +Done. + +[ad_admin_footer] +" +ns_db releasehandle $db +ns_db releasehandle $db_sub +ns_return 200 text/html $whole_page Index: web/openacs/www/admin/users/merge/merge-from-search.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/merge/merge-from-search.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/merge/merge-from-search.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,14 @@ +# merge-from-search.tcl,v 3.0 2000/02/06 03:31:56 ron Exp +# +# merge-from-search.tcl +# +# by philg@mit.edu on October 30, 1999 +# +# exists to redirect to merge.tcl after /user-search.tcl +# or /admin/users/search.tcl + +set_the_usual_form_variables + +# u1, user_id_from_search + +ns_returnredirect "merge.tcl?u1=$u1&u2=$user_id_from_search" Index: web/openacs/www/admin/users/merge/merge.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/merge/merge.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/merge/merge.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,159 @@ +# merge.tcl,v 3.1 2000/03/09 00:01:39 scott Exp +set_the_usual_form_variables + +# u1, u2 (two user IDs) + +set db [ns_db gethandle] + +set selection [ns_db 1row $db "select email as u1_email, first_names as u1_first_names, last_name as u1_last_name, registration_date as u1_registration_date, last_visit as u1_last_visit +from users +where user_id = $u1"] +set_variables_after_query + +set selection [ns_db 1row $db "select email as u2_email, first_names as u2_first_names, last_name as u2_last_name, registration_date as u2_registration_date, last_visit as u2_last_visit +from users +where user_id = $u2"] +set_variables_after_query + + +append whole_page "[ad_admin_header "Merge $u1_email with $u2_email"] + +

    Merge

    + +$u1_email with $u2_email + +
    + + + + + + + + + + + + + + + + + + + + +" + +append whole_page " + + + +
      +$u1_email +$u2_email +
    Name: +$u1_first_names $u1_last_name +$u2_first_names $u2_last_name +
    Complete Record: +User ID $u1 +User ID $u2 +
    Registered: +[util_AnsiDatetoPrettyDate $u1_registration_date] +[util_AnsiDatetoPrettyDate $u2_registration_date] +
    Last Visit: +[util_AnsiDatetoPrettyDate $u1_last_visit] +[util_AnsiDatetoPrettyDate $u2_last_visit] +
    BBoard Activity: +" + +set selection [ns_db 1row $db "select max(posting_time) as u1_most_recent,count(*) as u1_n_postings from bboard where user_id = $u1"] +set_variables_after_query +if { $u1_n_postings > 0 } { + set u1_most_recent " through [util_AnsiDatetoPrettyDate $u1_most_recent]" +} else { + set u1_most_recent "" +} + +set selection [ns_db 1row $db "select max(posting_time) as u2_most_recent,count(*) as u2_n_postings from bboard where user_id = $u2"] +set_variables_after_query + +if { $u2_n_postings > 0 } { + set u2_most_recent " through [util_AnsiDatetoPrettyDate $u2_most_recent]" +} else { + set u2_most_recent "" +} +append whole_page "$u1_n_postings $u1_most_recent +$u2_n_postings $u2_most_recent +
    Classified Activity: +" + +set selection [ns_db 1row $db "select max(posted) as u1_most_recent,count(*) as u1_n_postings from classified_ads where user_id = $u1"] +set_variables_after_query +if { $u1_n_postings > 0 } { + set u1_most_recent " through [util_AnsiDatetoPrettyDate $u1_most_recent]" +} else { + set u1_most_recent "" +} + +set selection [ns_db 1row $db "select max(posted) as u2_most_recent,count(*) as u2_n_postings from classified_ads where user_id = $u2"] +set_variables_after_query + +if { $u2_n_postings > 0 } { + set u2_most_recent " through [util_AnsiDatetoPrettyDate $u2_most_recent]" +} else { + set u2_most_recent "" +} +append whole_page "$u1_n_postings $u1_most_recent +$u2_n_postings $u2_most_recent +
    Comment Activity: +" + +set selection [ns_db 1row $db "select max(posting_time) as u1_most_recent,count(*) as u1_n_postings from comments where user_id = $u1"] +set_variables_after_query +if { $u1_n_postings > 0 } { + set u1_most_recent " through [util_AnsiDatetoPrettyDate $u1_most_recent]" +} else { + set u1_most_recent "" +} + +set selection [ns_db 1row $db "select max(posting_time) as u2_most_recent,count(*) as u2_n_postings from comments where user_id = $u2"] +set_variables_after_query + +if { $u2_n_postings > 0 } { + set u2_most_recent " through [util_AnsiDatetoPrettyDate $u2_most_recent]" +} else { + set u2_most_recent "" +} +append whole_page "$u1_n_postings $u1_most_recent +$u2_n_postings $u2_most_recent +
    Neighbor Activity: +" + +set selection [ns_db 1row $db "select max(posted) as u1_most_recent,count(*) as u1_n_postings from neighbor_to_neighbor where poster_user_id = $u1"] +set_variables_after_query +if { $u1_n_postings > 0 } { + set u1_most_recent " through [util_AnsiDatetoPrettyDate $u1_most_recent]" +} else { + set u1_most_recent "" +} + +set selection [ns_db 1row $db "select max(posted) as u2_most_recent,count(*) as u2_n_postings from neighbor_to_neighbor where poster_user_id = $u2"] +set_variables_after_query + +if { $u2_n_postings > 0 } { + set u2_most_recent " through [util_AnsiDatetoPrettyDate $u2_most_recent]" +} else { + set u2_most_recent "" +} +append whole_page "$u1_n_postings $u1_most_recent +$u2_n_postings $u2_most_recent +
     
    Take Action! +---> +<--- +
    + +[ad_admin_footer] +" +ns_db releasehandle $db +ns_return 200 text/html $whole_page Index: web/openacs/www/admin/users/merge/one-class.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/merge/one-class.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/merge/one-class.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,70 @@ +# one-class.tcl,v 3.1 2000/03/09 00:01:39 scott Exp +set_the_usual_form_variables + +# we get a form that specifies a class of user, plus maybe an order_by +# spec + +set db [ns_db gethandle] + +set description [ad_user_class_description [ns_getform]] + +# we have to delete order_by from the form or the export_entire_form_as_url_vars +# below won't work + +ns_set delkey [ns_getform] order_by + +if { $order_by == "email" } { + set order_by_clause "upper(email), upper(last_name), upper(first_names)" + set option "sort by last name | sort by first name" +} elseif { $order_by == "first_names" } { + set order_by_clause "upper(first_names), upper(last_name), upper(email)" + set option "sort by email | sort by last name" +} else { + set order_by_clause "upper(last_name), upper(first_names), upper(email)" + set option "sort by email | sort by first name" +} + + + +append whole_page "[ad_admin_header "Candidates for Merger"] + +

    Candidates for Merger

    + +among $description ordered by $order_by + +
    + +$option + +
      + +" + +set query [ad_user_class_query [ns_conn form]] +append ordered_query $query "\n" "order by $order_by_clause" + +set selection [ns_db select $db $ordered_query] + +set last_id "" +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append whole_page "
    • " + if { $order_by == "email" } { + append whole_page "$email ($first_names $last_name)" + } else { + append whole_page "$first_names $last_name ($email)" + } + if ![empty_string_p $last_id] { + append whole_page " merge with above\n" + } + set last_id $user_id +} + +append whole_page " + +
    + +[ad_admin_footer] +" +ns_db releasehandle $db +ns_return 200 text/html $whole_page Index: web/openacs/www/admin/users/merge/readme.txt =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/merge/readme.txt,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/merge/readme.txt 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,2 @@ +This directory is for scripts used to merge one user into another (e.g., +if the same person registered twice with two different email addresses). Index: web/openacs/www/admin/users/merge/users-all.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/users/merge/users-all.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/users/merge/users-all.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,54 @@ +# users-all.tcl,v 3.1 2000/03/09 00:01:39 scott Exp +set_the_usual_form_variables + +# order_by + +append whole_page "[ad_admin_header "Candidates for Merger"] + +

    Candidates for Merger

    + +ordered by $order_by + +
    + +
      + +" + +set db [ns_db gethandle] + +if { $order_by == "email" } { + set order_by_clause "upper(email), upper(last_name), upper(first_names)" +} elseif { $order_by == "first_names" } { + set order_by_clause "upper(first_names), upper(last_name), upper(email)" +} else { + set order_by_clause "upper(last_name), upper(first_names), upper(email)" +} + +set selection [ns_db select $db "select user_id, first_names, last_name, email +from users +order by $order_by_clause"] + +set last_id "" +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append whole_page "
    • " + if { $order_by == "email" } { + append whole_page "$email ($first_names $last_name)" + } else { + append whole_page "$first_names $last_name ($email)" + } + if ![empty_string_p $last_id] { + append whole_page " merge with above\n" + } + set last_id $user_id +} + +append whole_page " + +
    + +[ad_admin_footer] +" +ns_db releasehandle $db +ns_return 200 text/html $whole_page Index: web/openacs/www/admin/webmail/domain-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/webmail/domain-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/webmail/domain-add-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,12 @@ +# domain-add-2.tcl +# Create new domain. +# Written by jsc@arsdigita.com. + +ad_page_variables {full_name short_name} + +set db [ns_db gethandle] + +ns_db dml $db "insert into wm_domains (short_name, full_domain_name) + values ('$QQshort_name', '$QQfull_name')" + +ns_returnredirect "index.tcl" \ No newline at end of file Index: web/openacs/www/admin/webmail/domain-add-user-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/webmail/domain-add-user-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/webmail/domain-add-user-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,39 @@ +# domain-add-user-2.tcl +# Assign email address to ACS user. +# Written by jsc@arsdigita.com. + + +ad_page_variables {username short_name} + +set db [ns_db gethandle] + +set full_domain_name [database_to_tcl_string $db "select full_domain_name +from wm_domains +where short_name = '$QQshort_name'"] + +ns_db releasehandle $db + +ns_return 200 text/html "[ad_admin_header "Specify Recipient"] +

    $full_domain_name

    + +
    + +Specify recipient who will receive email sent to $username@$full_domain_name: + +
    + + +[export_form_vars username short_name] + +Email: +

    +or +

    +Last Name: + +

    + +
    + +[ad_admin_footer] +" \ No newline at end of file Index: web/openacs/www/admin/webmail/domain-add-user-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/webmail/domain-add-user-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/webmail/domain-add-user-3.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,41 @@ +# domain-add-user-3.tcl +# Create various qmail files and insert information into data model for creating a user. +# Written by jsc@arsdigita.com. + +ad_page_variables {username short_name user_id_from_search} + +set db [ns_db gethandle] + + +with_transaction $db { + ns_db dml $db "insert into wm_email_user_map (email_user_name, domain, user_id) + values ('$QQusername', '$QQshort_name', $user_id_from_search)" + + # If this is the first email account for this user, create his INBOX. + if { [database_to_tcl_string $db "select count(*) +from wm_mailboxes +where creation_user = $user_id_from_search + and name = 'INBOX'"] == 0 } { + ns_db dml $db "insert into wm_mailboxes (mailbox_id, name, creation_user, creation_date, uid_validity) + values (nextval('wm_mailbox_id_sequence'), 'INBOX', $user_id_from_search, sysdate(), 0)" + } + + # Create alias file for this user. + set alias_fp [open "[ad_parameter AliasDirectory webmail "/home/nsadmin/qmail/alias"]/.qmail-$short_name-$username" w 0644] + puts $alias_fp [ad_parameter QueueDirectory webmail "/home/nsadmin/qmail/queue/"] + close $alias_fp +} { + set full_domain_name [database_to_tcl_string $db "select full_domain_name +from wm_domains +where short_name = '$QQshort_name'"] + ad_return_error "Error Creating Email Account" "An error occured while +trying to create the email account for $username@$full_domain_name: +
    +$errmsg
+
    +" + return +} + + +ns_returnredirect "domain-one.tcl?[export_url_vars short_name]" Index: web/openacs/www/admin/webmail/domain-add-user.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/webmail/domain-add-user.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/webmail/domain-add-user.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,30 @@ +# domain-add-user.tcl +# Present form for adding a new user. +# Written by jsc@arsdigita.com. + +ad_page_variables {short_name} + +set db [ns_db gethandle] + +set full_domain_name [database_to_tcl_string $db "select full_domain_name +from wm_domains +where short_name = '$QQshort_name'"] + +ns_db releasehandle $db + +ns_return 200 text/html "[ad_admin_header "Add User"] +

    $full_domain_name

    + +[ad_admin_context_bar [list "index.tcl" "WebMail Admin"] [list "domain-one.tcl?[export_url_vars short_name]" "One Domain"] "Create Account"] + +
    + +Create a new account in this domain: + + +[export_form_vars short_name] +Email address: @$full_domain_name +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/webmail/domain-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/webmail/domain-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/webmail/domain-add.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,39 @@ +# domain-add.tcl +# Add a new mail domain. +# Written by jsc@arsdigita.com. + +ns_return 200 text/html "[ad_admin_header "Add a Domain"] +

    Add a Domain

    + +[ad_admin_context_bar [list "index.tcl" "WebMail Admin"] "Add Domain"] + + +
    + +
    + +Short name should be a short, descriptive name made up only of lower case letters + (no spaces or punctuation). Example: arsdigita. + +

    + +Short Name: + +

    + +The domain name should be a fully qualified domain name to which mail will get sent. +DNS and qmail must be set up separately to handle mail for this domain. +Example: arsdigita.com. + +

    + +Domain Name: + +

    + +
    + +
    + +[ad_admin_footer] +" Index: web/openacs/www/admin/webmail/domain-one.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/webmail/domain-one.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/webmail/domain-one.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,53 @@ +# domain-one.tcl +# Display users for one mail domain. +# Written by jsc@arsdigita.com. + + +ad_page_variables {short_name} + +set db [ns_db gethandle] + +set full_domain_name [database_to_tcl_string $db "select full_domain_name +from wm_domains +where short_name = '$QQshort_name'"] + +set selection [ns_db select $db "select email_user_name, u.user_id, first_names || ' ' || last_name as full_user_name +from wm_email_user_map eum, users u +where eum.domain = '$QQshort_name' +and eum.user_id = u.user_id +order by email_user_name"] + +set results "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + append results "
  • $email_user_name@$full_domain_name: $full_user_name\n" +} + +if { [empty_string_p $results] } { + set results "
  • No users.\n" +} + +set full_domain_name [database_to_tcl_string $db "select full_domain_name +from wm_domains +where short_name = '$QQshort_name'"] + +ns_db releasehandle $db + +ns_return 200 text/html "[ad_admin_header "One Domain"] +

    $full_domain_name

    + +[ad_admin_context_bar [list "index.tcl" "WebMail Admin"] "One Domain"] + +
    + +
      +[export_form_vars short_name] +$results +

      +Add a user +

    + +[ad_admin_footer] +" Index: web/openacs/www/admin/webmail/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/admin/webmail/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/admin/webmail/index.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,44 @@ +# /admin/webmail/index.tcl +# Display list of mail domains we handle on this server. +# Written by jsc@arsdigita.com. + +set db [ns_db gethandle] + +set selection [ns_db select $db "select short_name, full_domain_name +from wm_domains +order by short_name"] + +set results "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + + append results "
  • $full_domain_name\n" +} + +if { [empty_string_p $results] } { + set results "
  • No domains currently handled.\n" +} + +ns_db releasehandle $db + +ns_return 200 text/html "[ad_admin_header "WebMail Administration"] +

    WebMail Administration

    + +[ad_admin_context_bar "WebMail Admin"] + +
    + +Domains we handle email for: + + + +

    +administer common errors + +[ad_admin_footer] +" Index: web/openacs/www/ads/arsdigita.gif =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/ads/arsdigita.gif,v diff -u Binary files differ Index: web/openacs/www/ads/readme.txt =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/ads/readme.txt,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/ads/readme.txt 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1 @@ +this directory is for banner ads served by the /adserver code Index: web/openacs/www/ads/scorecard.gif =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/ads/scorecard.gif,v diff -u Binary files differ Index: web/openacs/www/adserver/adhref.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/adserver/adhref.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/adserver/adhref.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,80 @@ +# adhref.tcl,v 3.0 2000/02/06 03:32:01 ron Exp +# adimg.tcl +# +# at this point mostly by philg@mit.edu +# last edited November 24, 1999 to address a concurrency problem +# +# this page +# finds the target URL that corresponds to the banner we displayed +# sends bytes back to the browser instructing the browser to redirect to that URL +# closes the TCP connection to the user +# while this thread is still alive, logs the clickthrough +# (optionally this page will not log the clickthrough, e.g., +# if this is invoked from the /admin directory) + +set_the_usual_form_variables 0 + +# adv_key, maybe suppress_logging_p + +if { ![info exists adv_key] || $adv_key==""} { + ns_returnredirect [ad_parameter DefaultTargetUrl adserver "/"] + return +} + +set db [ns_db gethandle] + +set target_url [database_to_tcl_string_or_null $db "select target_url +from advs +where adv_key = '$QQadv_key'"] + +if { $target_url == "" } { + ns_returnredirect [ad_parameter DefaultTargetUrl adserver "/"] + return +} + +ns_returnredirect $target_url + +if { [info exists suppress_logging_p] && $suppress_logging_p == 1 } { + return +} + +ns_conn close + +# we've returned to the user but let's keep this thread alive to log + +set update_sql "update adv_log +set click_count = click_count + 1 +where adv_key = '$QQadv_key' +and entry_date = trunc(sysdate())" + +ns_db dml $db $update_sql + +set n_rows [ns_pg ntuples $db] + +if { $n_rows == 0 } { + # there wasn't already a row there + # let's be careful in case another thread is executing concurrently + # on the 10000:1 chance that it is, we might lose an update but + # we won't generate an error in the error log and set off all the server + # monitor alarms + set insert_sql "insert into adv_log +(adv_key, entry_date, click_count) +select '$QQadv_key', trunc(sysdate()), 1 +from dual +where 0 = (select count(*) + from adv_log + where adv_key='$QQadv_key' + and entry_date = trunc(sysdate()))" + ns_db dml $db $insert_sql +} + +if [ad_parameter DetailedPerUserLoggingP adserver 0] { + set user_id [ad_get_user_id] + if { $user_id != 0 } { + # we know who this user is + ns_db dml $db "insert into adv_user_map +(user_id, adv_key, event_time, event_type) +values +($user_id, '$QQadv_key', sysdate(), 'c')" + } +} Index: web/openacs/www/adserver/adimg.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/adserver/adimg.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/adserver/adimg.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,112 @@ +# adimg.tcl,v 3.0 2000/02/06 03:32:03 ron Exp +# adimg.tcl +# +# at this point mostly by philg@mit.edu +# last edited November 24, 1999 to address a concurrency problem +# +# this page +# tries to find an image file to serve to the user +# serves it +# closes the TCP connection to the user +# while this thread is still alive, logs the ad display +# + +set_the_usual_form_variables 0 + +# adv_key, maybe suppress_logging_p + +set display_default_banner_p 0 + +if { ![info exists adv_key] || $adv_key == "" } { + set display_default_banner_p 1 +} else { + set db [ns_db gethandle] + + set selection [ns_db 0or1row $db "SELECT adv_filename as ad_filename_stub, local_image_p +FROM advs +WHERE adv_key = '$QQadv_key'"] + + if { $selection == "" } { + set display_default_banner_p 1 + } else { + set_variables_after_query + } +} + +if { $display_default_banner_p } { + append default_banner_filename [ns_info pageroot] [ad_parameter DefaultAd adserver] + if [file isfile $default_banner_filename] { + ns_returnfile 200 [ns_guesstype $default_banner_filename] $default_banner_filename + } else { + # we're really in bad shape; no default file exists and + # we don't have an adv_key + ns_log Error "adimg.tcl didn't get an ad key AND no default file exists" + ad_notify_host_administrator "define a default ad!" "Define a default banner ad in [ad_system_name]; someone is requesting ads without an adv_key" + } + return +} + +if {$local_image_p == "t"} { + # image lives in the local filesystem + append ad_filename [ns_info pageroot] $ad_filename_stub +} else { + # image lives on a remote server, so adv_filename is really a URL. + set ad_filename $ad_filename_stub +} + + +# Should we check for the existence of the ad on the remote host? For now, we don't +if { $ad_filename_stub == "" || ($local_image_p == "t" && ![file isfile $ad_filename]) } { + ns_log Error "Didn't find ad: $ad_filename" + append default_banner_filename [ns_info pageroot] [ad_parameter DefaultAd adserver] + if [file isfile $default_banner_filename] { + ns_returnfile 200 [ns_guesstype $default_banner_filename] $default_banner_filename + } else { + # we're really in bad shape; no row exists and + # we don't have an adv_key + ns_log Error "adimg.tcl didn't find an ad matching \"$adv_key\" AND no default file exists" + ad_notify_host_administrator "define a default ad!" "Define a default banner ad in [ad_system_name]; someone is requesting ads with an invalid adv_key of \"$adv_key\"" + } + return +} + +if {$local_image_p == "t"} { + # return the file + + # the no-cache stuff ensures that Netscape browser users never get a + # cached IMG with a new target + + ns_returnfile 200 "[ns_guesstype $ad_filename]\nPragma: no-cache" $ad_filename +} else { + # let the remote server provide the image + ns_returnredirect $ad_filename +} + +if { [info exists suppress_logging_p] && $suppress_logging_p == 1 } { + return +} + +# we've returned to the user but let's keep this thread alive to log + +ns_conn close + +ns_db dml $db "update adv_log +set display_count = display_count + 1 +where adv_key='$QQadv_key' +and entry_date = trunc(sysdate())" + +set n_rows [ns_pg ntuples $db] + +if { $n_rows == 0 } { + # there wasn't a row in the database; we can't just do the obvious insert + # because another thread might be executing concurrently + ns_db dml $db "insert into adv_log +(adv_key, entry_date, display_count) +select '$QQadv_key', trunc(sysdate()), 1 +from dual +where 0 = (select count(*) + from adv_log + where adv_key='$QQadv_key' + and entry_date = trunc(sysdate()))" +} + Index: web/openacs/www/adserver/adtest.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/adserver/adtest.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/adserver/adtest.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,18 @@ +# adtest.tcl,v 3.0 2000/02/06 03:32:04 ron Exp +ReturnHeaders + +ns_write " + +Adserver Test Page + + +

    Ad Server Test Page

    +

    You should see an ad below: + +
    + +[adserver_get_ad_html "test"] + + + +" Index: web/openacs/www/bannerideas/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bannerideas/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bannerideas/index.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,28 @@ +# index.tcl,v 3.0 2000/02/06 03:32:07 ron Exp +ReturnHeaders + +ns_write "[ad_header "Banner Ideas"] + +

    Banner Ideas

    + +[ad_context_bar_ws_or_index "All Banner Ideas"] + +
    + +" + +set db [banner_ideas_gethandle] + +set selection [ns_db select $db "select idea_id, intro, more_url, picture_html +from bannerideas"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write [bannerideas_present $idea_id $intro $more_url $picture_html] +} + + +ns_write " + +[ad_footer] +" Index: web/openacs/www/bannerideas/more.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bannerideas/more.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bannerideas/more.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,20 @@ +# more.tcl,v 3.0 2000/02/06 03:32:08 ron Exp +set_the_usual_form_variables + +# idea_id, more_url + +validate_integer idea_id $idea_id + +ns_returnredirect $more_url + +ns_conn close + +# we're offline as far as the user is concerned but let's log the click + +set db [banner_ideas_gethandle] + +ns_db dml $db "update bannerideas +set clickthroughs = clickthroughs + 1 +where idea_id = $idea_id" + + Index: web/openacs/www/bboard/add-alert-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/add-alert-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/add-alert-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,88 @@ +# add-alert-2.tcl,v 3.0 2000/02/06 03:32:09 ron Exp +set_the_usual_form_variables + +# topic, topic_id, frequency, maybe keywords + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +if { [bboard_get_topic_info] == -1 } { + return +} + + +ad_get_user_info + + +set exception_text "" +set exception_count 0 + +# we should add some tests for various things here + +if { $exception_count > 0 } { + ad_return_complaint $exception_count $exception_text + return +} + +set extra_columns "" +set extra_values "" +set keyword_user_report_line "" +if { [info exists keywords] && $keywords != "" } { + # we have a keyword-limited search + set extra_columns ", keywords" + set extra_values ", '$QQkeywords'" + set keyword_user_report_line "
  • Keywords: \"$keywords\"" +} + +set insert_sql "insert into bboard_email_alerts ( user_id, topic_id, frequency $extra_columns ) +values +( $user_id, $topic_id, '$QQfrequency' $extra_values )" + +if [catch { ns_db dml $db $insert_sql } errmsg] { + # something went wrong + ad_return_error "Insert failed" "We failed to insert your into our system. + +

    + +Here was the bad news from the database: + +

    +$errmsg +
    + +This probably shouldn't have happened. +" + return +} + +# database insert went OK + + + +ns_return 200 text/html "[bboard_header "Alert Added"] + +

    Alert Added

    + +for $first_names $last_name in the [bboard_complete_backlink $topic_id $topic $presentation_type] + +
    + +
      + +
    • Topic: $topic +
    • Address to notify: $email +
    • Frequency: $frequency +$keyword_user_report_line + +
    + +Remember that you can disable your alert at any time by returning to + +the add alert page and using the \"edit alerts\" feature. + +[bboard_footer] +" + Index: web/openacs/www/bboard/add-alert.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/add-alert.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/add-alert.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,157 @@ +# add-alert.tcl,v 3.0 2000/02/06 03:32:11 ron Exp +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set_the_usual_form_variables + +# topic_id, topic + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +#check for the user cookie + +set user_id [ad_get_user_id] + +ad_maybe_redirect_for_registration + +if { [bboard_get_topic_info] == -1 } { + return +} + + + +set keyword_limit_option "" +if { [bboard_pls_blade_installed_p] == 1 } { + set keyword_limit_option "2: Decide if you want to limit your notification by keyword

    + +Keywords: (separate by spaces) + +

    + +\[Note: if you type anything here, you will only get notified +when a posting matches at least one of the keywords. +Keywords are matched against the subject line, message body, author +name, and author email address. \] + + +

    + +" +} + + +ReturnHeaders + +ns_write "[bboard_header "Add Alert"] + +

    Add an Alert

    + +[ad_context_bar_ws_or_index [list "index.tcl" [bboard_system_name]] [list [bboard_raw_backlink $topic_id $topic $presentation_type 0] $topic] "Add Alert"] + + +
    + +" + + +# our topic variable is about to get bashed +set current_topic $topic +set current_topic_id $topic_id + +# let's first see if this person has any existing alerts + +set selection [ns_db select $db "select bea.*, bea.oid as rowid, bboard_topics.topic +from bboard_email_alerts bea, bboard_topics +where bea.user_id = $user_id +and bboard_topics.topic_id = bea.topic_id +order by frequency"] + +set counter 0 +while {[ns_db getrow $db $selection]} { + set_variables_after_query + incr counter + if { $valid_p == "f" } { + # alert has been disabled for some reason + set status "Disabled" + set action "Re-enable" + } else { + # alert is enabled + set status "Enabled" + set action "Disable" + } + if { [bboard_pls_blade_installed_p] == 1 } { + append existing_alert_rows "$status$action$topic$frequency\"$keywords\"\n" + } else { + append existing_alert_rows "$status$action$topic$frequency\n" + } + +} + +if { $counter > 0 } { + set keyword_header "" + if { [bboard_pls_blade_installed_p] == 1 } { + set keyword_header "Keywords" + } + ns_write "

    Your existing alerts

    + +
    + +$keyword_header + +$existing_alert_rows +
    StatusActionTopicFrequency
    +
    +" +} + + +ns_write " + +

    Add a new alert

    + +If you'd like to keep up with this forum but don't want to check the +Web page all the time, then this forum will come to you! By filling +out this form, you can ask for email notification of new postings that +fit your interests. + +

    + +

    + + + +1: How often would you like to be notified via email? + +

    + + Instantly (as soon as a posting is made) +
    +or... +
    + + Daily + Monday and Thursday + Weekly + +

    + +$keyword_limit_option + +

    + + + +
    + +
    + + + +[bboard_footer] +" Index: web/openacs/www/bboard/add-new-topic-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/add-new-topic-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/add-new-topic-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,99 @@ +# add-new-topic-2.tcl,v 3.0 2000/02/06 03:32:12 ron Exp +# add-new-topic-2.tcl +# +# process a new topic form submission +# hqm@arsdigita.com + +# we expect to see: +# topic, user_id_from_search, presentation_type, moderation_policy, +# private_p, notify_of_new_postings_p +# bboard_group +set_the_usual_form_variables + +# IE will BASH ¬ + +set notify_of_new_postings_p $iehelper_notify_of_new_postings_p +set QQnotify_of_new_postings_p $QQiehelper_notify_of_new_postings_p + + +set db [ns_db gethandle] + +if {![bboard_users_can_add_topics_p] && [bboard_check_any_admin_role] == -1} { + return +} + + +set exception_text "" +set exception_count 0 + +if { ![info exists topic] || $topic == "" } { + append exception_text "
  • You must enter a topic name" + incr exception_count +} + +if { [info exists topic] && [string match {*\"*} $topic] } { + append exception_text "
  • Your topic name can't include string quotes. It makes life too difficult for this collection of software." + incr exception_count +} + +if { $exception_count> 0 } { + ad_return_complaint $exception_count $exception_text + return 0 +} + + +# +++ UNFINISHED CODE +#+ We need to figure out how to deal with the new access model - +# what values do we set for: +# read_access +# write_access +# users_can_initiate_threads_p +# +# these default to reasonable things now, but we need to allow the user to configure them + +with_transaction $db { + set topic_id [database_to_tcl_string $db "select bboard_topic_id_sequence.nextval from dual"] + ns_db dml $db "insert into bboard_topics (topic_id,topic,primary_maintainer_id,presentation_type,moderation_policy,notify_of_new_postings_p) +values +($topic_id,'$QQtopic',$user_id_from_search,'$QQpresentation_type','$QQmoderation_policy','$QQnotify_of_new_postings_p')" + + # create the administration group for this topic + ad_administration_group_add $db "Administration Group for $topic BBoard" "bboard" $topic_id "/bboard/admin-home.tcl?[export_url_vars topic topic_id]" + + # add the current user as an administrator + ad_administration_group_user_add $db $user_id_from_search "administrator" "bboard" $topic_id + + } { ad_return_error "Topic Not Added" "The database rejected the addition of discussion topic \"$topic\". Here was +the error message: +
    +$errmsg
+
    +" + return 0 +} + + + +# the database insert went OK + + +ReturnHeaders + +append pagebody "[bboard_header "Topic Added"] + +

    Topic Added

    + +There is now a discussion group for \"$topic\" in +[bboard_system_name] + +

    + +

    +Visit the admin page +for $topic. +

    + + +[bboard_footer]" + +ns_write $pagebody Index: web/openacs/www/bboard/add-new-topic.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/add-new-topic.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/add-new-topic.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,128 @@ +# add-new-topic.tcl,v 3.0 2000/02/06 03:32:14 ron Exp +set db [ns_db gethandle] + +set user_id [ad_verify_and_get_user_id] + +ad_maybe_redirect_for_registration + +if {!([bboard_users_can_add_topics_p] || [ad_administrator_p $db])} { + ad_return_error "You are not allowed to add topics" "Sorry, you are + not allowed to add discussion group topics on this server." +} + +ReturnHeaders + +ns_write "[bboard_header "Add New Topic"] + +

    Add New Topic

    + +[ad_context_bar_ws [list "index.tcl" "BBoard"] "Add Topic"] + +
    + +
    + + + + +

    The Most Important Things

    + +What do you want to call your forum? The topic name that you choose +will appear in the alphabetical listing on the [bboard_system_name] +home page. It will appear on pages visible to users. It will appear +in URLs. If you want to let other people link directly to your forum, +they'll need to include this. So it is probably best to pick some +short and descriptive, e.g., \"darkroom technique\". The software +adds words like \"Q&A\" and \"forum\" so don't include those in your +topic name. + +

    + +New Topic Name: + +

    +

    Maintainer

    +

    +Search for a user to be primary administrator of this domain by
    + + + + +
    Email address:
    or by
    Last name:
    +

    + +

    User Group This Topic Is Associated With

    +

    +A topic can be associated with one or more user groups. The topic can be made private +to members of these groups only, or the topic can be made publicly visible and readable. +Select the primary group this topic belongs to below. Other groups can be added later. +

    +
    + + Private To Group(s) +
    +

    + + +

    How this BBoard is presented to users

    + +You have to choose whether or not this is primarily a Q&A +forum or a threads-based discussion group. The user interfaces +interoperate, i.e., a posting made a user in the Q&A interface will be +seen in the threads interface and vice versa. But my software still +needs to know whether this is primarily threads or Q&A. For example, +if a user signs up for email alerts, this program will send out email +saying \"come back to the forum at http://...\". The \"come back +URL\" is different for Q&A and threads. + +
      +
    • threads - classical USENET style +
    • Q&A - questions and all answers appear on one page, use for discussion groups that tend to have short messages/responses +
    • Editorial - question and answers appear on separate pages, answers are collasped by subject line as a default, use for discussion groups that tend to have longer messages/responses +
    + +

    + +
    + +(note: I personally greatly prefer the Q&A interface; if people liked +threads, they'd have stuck with USENET.) + +

    Moderation Type

    + +What moderation category does this fall under? + + +

    Notification

    + +If your forum is inactive, you'll probably want this system to send +the primary maintainer email every time someone adds a posting of any kind (new top-level +question or reply). If you're getting 50 new postings/day then you'll +probably want to disable this feature + +

    + +Notify me of all new postings? + Yes No + +

    +

    + + + + + +
    + +[ad_admin_footer] +" Index: web/openacs/www/bboard/admin-bozo-pattern-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-bozo-pattern-add-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-bozo-pattern-add-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,27 @@ +# admin-bozo-pattern-add-2.tcl,v 3.0 2000/02/06 03:32:27 ron Exp +set_the_usual_form_variables + +# topic, topic_id, the_regexp, scope, message_to_user, creation_comment + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + + +ns_db dml $db "insert into bboard_bozo_patterns +(topic_id, the_regexp, scope, message_to_user, creation_date, creation_user, creation_comment) +values +($topic_id, '$QQthe_regexp', '$QQscope', '$QQmessage_to_user', sysdate(), [ad_verify_and_get_user_id], [ns_dbquotevalue $creation_comment text])" + + +ns_returnredirect "admin-home.tcl?[export_url_vars topic topic_id]" Index: web/openacs/www/bboard/admin-bozo-pattern-add.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-bozo-pattern-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-bozo-pattern-add.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,99 @@ +# admin-bozo-pattern-add.tcl,v 3.0 2000/02/06 03:32:29 ron Exp +set_the_usual_form_variables + +# topic, topic_id + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + +# cookie checks out; user is authorized + +if [catch {set selection [ns_db 0or1row $db "select bt.*,u.email as maintainer_email, u.first_names || ' ' || u.last_name as maintainer_name, presentation_type + from bboard_topics bt, users u + where bt.topic_id = $topic_id + and bt.primary_maintainer_id = u.user_id"]} errmsg] { + [bboard_return_cannot_find_topic_page] + return +} +# we found the data we needed +set_variables_after_query + + +ReturnHeaders + +ns_write " + +Add Bozo Pattern to $topic + + + +

    Add Bozo Pattern

    + +for $topic + +
    + +
    +[export_form_vars topic topic_id] + + + + + + + + + + + + + +
    Regular Expression + + (lowercase) +
    Scope + +
    Message to User + +
    Comment to other administrators
    (optional) +     		+
    + +

    +

    + +
    + +
    + +
    +
    + + +
    + +Note: the regular expression should be in Tcl format. If you just +want to match for a particular word, you need only type that word. If +you want something fancier, you probably have to read + +Mastering Regular Expressions (Friedl; O'Reilly) + +
    + +[bboard_footer] +" Index: web/openacs/www/bboard/admin-bozo-pattern-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-bozo-pattern-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-bozo-pattern-delete.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,28 @@ +# admin-bozo-pattern-delete.tcl,v 3.0 2000/02/06 03:32:31 ron Exp +set_the_usual_form_variables + +# topic, topic_id the_regexp + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + +# cookie checks out; user is authorized + +ns_db dml $db "delete from bboard_bozo_patterns +where topic_id = $topic_id +and the_regexp = '$QQthe_regexp'" + +ns_returnredirect "admin-home.tcl?[export_url_vars topic topic_id]" + + Index: web/openacs/www/bboard/admin-bozo-pattern-edit-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-bozo-pattern-edit-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-bozo-pattern-edit-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,30 @@ +# admin-bozo-pattern-edit-2.tcl,v 3.0 2000/02/06 03:32:32 ron Exp +set_the_usual_form_variables + +# topic, topic_id, the_regexp, the_regexp_old, scope, message_to_user, creation_comment + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + + +ns_db dml $db "update bboard_bozo_patterns set +the_regexp = '$QQthe_regexp', +scope = '$QQscope', +message_to_user = '$QQmessage_to_user', +creation_comment = [ns_dbquotevalue $creation_comment text] +where topic_id = $topic_id +and the_regexp = '$QQthe_regexp_old'" + +ns_returnredirect admin-bozo-pattern.tcl?[export_url_vars topic topic_id the_regexp] + + Index: web/openacs/www/bboard/admin-bozo-pattern-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-bozo-pattern-edit.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-bozo-pattern-edit.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,115 @@ +# admin-bozo-pattern-edit.tcl,v 3.0 2000/02/06 03:32:33 ron Exp +set_the_usual_form_variables +# topic_id, topic, the_regexp + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + +# cookie checks out; user is authorized + +if [catch {set selection [ns_db 0or1row $db "select bt.*,u.email as maintainer_email, u.first_names || ' ' || u.last_name as maintainer_name, presentation_type + from bboard_topics bt, users u + where bt.topic_id=$topic_id + and bt.primary_maintainer_id = u.user_id"]} errmsg] { + [bboard_return_cannot_find_topic_page] + return +} +# we found the data we needed +set_variables_after_query + + +# get the regexp information +set the_regexp_old $the_regexp + +set selection [ns_db 0or1row $db "select scope, +message_to_user, creation_comment +from bboard_bozo_patterns +where topic_id=$topic_id +and the_regexp = '$QQthe_regexp'"] + +if [empty_string_p $selection] { + ad_return_error "No expression $the_regexp" "\"$the_regexp\" +is not a regular expression in the topic $topic. Perhaps +it was edited or deleted." + return +} else { + set_variables_after_query +} + +ReturnHeaders + +ns_write " + +Edit Bozo Pattern \"$the_regexp\" in $topic + + + +

    Edit Bozo Pattern \"$the_regexp\"

    + +in $topic + +
    + +
    +[export_form_vars topic topic_id the_regexp_old] + + + + + + + + + + + + + +
    Regular Expression + + (lowercase) +
    Scope + [bt_mergepiece "" $selection] +
    Message to User + +
    Comment to other administrators
    (optional) +     		+
    + +

    +

    + +
    + +
    + +
    +
    +
    + +
    + +Note: the regular expression should be in Tcl format. If you just +want to match for a particular word, you need only type that word. If +you want something fancier, you probably have to read + +Mastering Regular Expressions (Friedl; O'Reilly) + +
    + +[bboard_footer] +" Index: web/openacs/www/bboard/admin-bozo-pattern.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-bozo-pattern.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-bozo-pattern.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,83 @@ +# admin-bozo-pattern.tcl,v 3.0 2000/02/06 03:32:34 ron Exp +set_the_usual_form_variables +# topic_id, topic, the_regexp + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + +# cookie checks out; user is authorized + +if [catch {set selection [ns_db 0or1row $db "select bt.*,u.email as maintainer_email, u.first_names || ' ' || u.last_name as maintainer_name, presentation_type + from bboard_topics bt, users u + where bt.topic_id=$topic_id + and bt.primary_maintainer_id = u.user_id"]} errmsg] { + [bboard_return_cannot_find_topic_page] + return +} +# we found the data we needed +set_variables_after_query + +set selection [ns_db 1row $db "select bbp.*, first_names, last_name +from bboard_bozo_patterns bbp, users +where bbp.creation_user = users.user_id +and topic_id = $topic_id +and the_regexp = '$QQthe_regexp'"] +set_variables_after_query + +ReturnHeaders + +ns_write " + +Bozo Pattern in $topic: $the_regexp + + + +

    $the_regexp

    + +a bozo pattern +for $topic + +
    + +
      +
    • Regular Expression: \"$the_regexp\" +
    • Where we look: $scope +
    • What we say to users who run afoul of this regexp: +
      +$message_to_user +
      +
    • Why this was created: +
      +$creation_comment +
      +
      +-- $first_names $last_name, [util_AnsiDatetoPrettyDate $creation_date] +
      + +
    + +If you don't like this bozo pattern, you can + + + + +[bboard_footer] +" Index: web/openacs/www/bboard/admin-bulk-delete-by-email-or-ip.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-bulk-delete-by-email-or-ip.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-bulk-delete-by-email-or-ip.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,135 @@ +# admin-bulk-delete-by-email-or-ip.tcl,v 3.0 2000/02/06 03:32:36 ron Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +# topic, deletion_ids, msg_ids, email or originating_ip + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + + + +bboard_get_topic_info + +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + ns_returnredirect /register.tcl?return_url=[ns_urlencode "[bboard_hardwired_url_stub]admin-home.tcl?[export_url_vars topic topic_id]"] + return +} + + +if {[bboard_admin_authorization] == -1} { + return +} + + +# cookie checks out; user is authorized + + +if { [info exists email] } { + set class "same email address" +} elseif { [info exists originating_ip] } { + set class "same ip address" +} else { + ns_return 200 text/html "neither email nor IP address specified; something wrong with your browser or my code" + return +} + +set deletion_ids [util_GetCheckboxValues [ns_conn form] deletion_ids] +set QQdeletion_ids [DoubleApos $deletion_ids] + +if { $QQdeletion_ids == 0 } { + ns_return 200 text/html " + +No messages selected + + + +

    No messages selected

    + +
    + +Either there is a bug in my code or you didn't check any boxes for +messages to be deleted. + +
    +
    [bboard_system_owner]
    + +" + return + +} + +ReturnHeaders + +ns_write " + +Deleting threads in $topic + + + +

    Deleting Threads

    + +with the $class in the $topic question and answer forum + +
    + + +" + +ns_write "
      \n" + +foreach msg_id $QQdeletion_ids { + set selection [ns_db 1row $db "select sort_key, one_line, topic as msg_topic, email as msg_email, originating_ip as msg_originating_ip +from bboard, users +where users.user_id = bboard.user_id +and msg_id = '$msg_id'"] + set_variables_after_query + if { $topic != $msg_topic } { + ns_write "
    • skipping $one_line because its topic ($msg_topic) does not match that of the bboard you're editing; this is probably a bug in my software\n" + } + if { [info exists email] && ( $msg_email != $email ) } { + ns_write "
    • skipping $one_line because its email address ($msg_email) does not match that of the other messages you're supposedly deleting; this is probably a bug in my software\n" + } + if { [info exists originating_ip] && ( $msg_originating_ip != $originating_ip ) } { + ns_write "
    • skipping $one_line because its originating IP address ($msg_originating_ip) does not match that of the other messages you're supposedly deleting; this is probably a bug in my software\n" + } + ns_write "
    • working on \"$one_line\" and its dependents... \n" + set dependent_key_form [dependent_sort_key_form $sort_key] + + with_transaction $db { + + if {[bboard_file_uploading_enabled_p]} { + set list_of_files_to_delete [database_to_tcl_list $db "select filename_stub from bboard_uploaded_files where msg_id IN (select msg_id from bboard where msg_id='$msg_id' or sort_key like '$dependent_key_form')"] + + ns_db dml $db "delete from bboard_uploaded_files where msg_id IN (select msg_id from bboard where msg_id='$msg_id' or sort_key like '$dependent_key_form')" + # ADD THE ACTUAL DELETION OF FILES + if { [llength $list_of_files_to_delete] > 0 } { + ns_atclose "bboard_delete_uploaded_files $list_of_files_to_delete" + } + } + + ns_db dml $db "delete from bboard_thread_email_alerts where thread_id = '$msg_id'" + + ns_db dml $db "delete from bboard +where msg_id = '$msg_id' +or sort_key like '$dependent_key_form'" + + ns_write "success! (killed message plus [expr [ns_pg ntuples $db] - 1] dependents)\n" + } { + ns_write "failed. Database choked up \"$errmsg\"\n" + } +} + +ns_write " + +
    + +[bboard_footer] +" Index: web/openacs/www/bboard/admin-bulk-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-bulk-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-bulk-delete.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,120 @@ +# admin-bulk-delete.tcl,v 3.0 2000/02/06 03:32:37 ron Exp +set_form_variables + +# msg_id, deletion_ids (we get the topic_id by querying the message) + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +set selection [ns_db 1row $db "select topic_id from bboard_topics where +topic_id = (select topic_id from bboard where msg_id = '$QQmsg_id')"] + +set_variables_after_query + + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + + + +# OK, user is authorized to edit the root message +# let's check the messages to be deleted + +set deletion_ids [util_GetCheckboxValues [ns_conn form] deletion_ids] +set QQdeletion_ids [DoubleApos $deletion_ids] + +if { $deletion_ids == 0 } { + ad_return_error "No messages selected" "Either there is a bug in my code or you didn't check any boxes for +messages to be deleted." + return +} + +set sort_keys [database_to_tcl_list $db "select sort_key +from bboard +where msg_id in ('[join $QQdeletion_ids "','"]')"] + +foreach sort_key $sort_keys { + if { [string first "." $sort_key] == -1 } { + # there is no period in the sort key so this is the start of a thread + set thread_start_msg_id $sort_key + } else { + # strip off the stuff before the period + regexp {(.*)\..*} $sort_key match thread_start_msg_id + } + if { $thread_start_msg_id != $msg_id } { + ad_return_return "bug in my software" "and/or someone has been tampering with the deletion_ids + +

    + +The offending sort_key was \"$sort_key\" whose thread_start_id I thought was +\"$thread_start_msg_id\" and this did not match \"$msg_id\". + +

    + + + + + + +
    sort keysdeletion ids +
    +$sort_keys + + +$deletion_ids + +
    + +

    + +One of the messages to be deleted doesn't seem to be part of the +thread that you were just editing. This is probably a bug in my code. +But I'm still not going to do the deletion because it is too much of a +security risk. +" + return + } +} + +# we're authorized for all the submessages too + +with_transaction $db { + +if {[bboard_file_uploading_enabled_p]} { + set list_of_files_to_delete [database_to_tcl_list $db "select filename_stub from bboard_uploaded_files where msg_id IN ('[join $QQdeletion_ids "','"]')"] + + ns_db dml $db "delete from bboard_uploaded_files where msg_id in ('[join $QQdeletion_ids "','"]')" + + # ADD THE ACTUAL DELETION OF FILES + if { [llength $list_of_files_to_delete] > 0 } { + ns_atclose "bboard_delete_uploaded_files $list_of_files_to_delete" + } +} + + ns_db dml $db "delete from bboard_thread_email_alerts where thread_id in ('[join $QQdeletion_ids "', '"]')" + +ns_db dml $db "delete from bboard where msg_id in ('[join $QQdeletion_ids "','"]')" +} { +} + +ns_return 200 text/html " + +Success + + + +

    Success

    + +
    + +[llength $deletion_ids] message(s) have been removed from the database. + +[bboard_footer]" Index: web/openacs/www/bboard/admin-categorize.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-categorize.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-categorize.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,143 @@ +# admin-categorize.tcl,v 3.0 2000/02/06 03:32:38 ron Exp +ad_page_variables { + topic_id + topic +} +page_validation { + set topic_id [validate_integer "Topic ID" $topic_id] +} + +# topic + +if { ![bboard_check_cookie $topic 1] } { + ns_returnredirect "admin-challenge.tcl?[export_url_vars topic topic_id]" + return +} + +# cookie checks out; user is authorized + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +if [catch {set selection [ns_db 0or1row $db "select distinct * from bboard_topics where topic_id=$topic_id"]} errmsg] { + [bboard_return_cannot_find_topic_page] + return +} +# we found the data we needed +set_variables_after_query + +set raw_form_vars "Present Categorized? + Yes + No + +Days Considered New (for how many days a question should show up as \"New\" rather than in its category) +Order in which to present new questions? + Oldest on top + Newest on top + +Ask User to Categorize? + Yes + No + +Allow Users to Add New Categories? + Yes + No +Use Interest Level System? + Yes + No +Policy Statement + +Users Can Initiate Threads? + Yes + No +(you only want to set this to No if you are using this software to collect categorized stories rather than true Q&A) + + +" +set merged_form [bt_mergepiece $raw_form_vars $selection] + +ReturnHeaders + +ns_write " + +Categorization for $topic + + + +

    Categorization for \"$topic\"

    + +a Q&A forum in [bboard_system_name] + +

    + +\[ user page (Q&A) | + +in-line Admin Q&A \] + +

    + +

    Categorization Information about this Q&A Forum

    + +
    + + + +$merged_form +
    + + + +
    + +
    + +

    Delete and Categorize Threads

    + +" + +# we only want the question + +set categories [database_to_tcl_list $db "select distinct category, upper(category) from bboard_q_and_a_categories where topic_id = $topic_id order by 2"] + +set selection [ns_db select $db "select msg_id, one_line, sort_key, category from bboard +where topic_id = $topic_id +and refers_to is null +order by sort_key desc"] + +while {[ns_db getrow $db $selection]} { + + set_variables_after_query + ns_write "
    +DELETE + +$one_line\n" + ns_write "
    " + ns_write "
    + + +New: +
    " + + ns_write "
    \n" +} + +ns_write " +[bboard_footer] +" Index: web/openacs/www/bboard/admin-community-pick.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-community-pick.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-community-pick.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,111 @@ +# admin-community-pick.tcl,v 3.0 2000/02/06 03:32:40 ron Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables +page_validation { + set n_positions [validate_integer "N Postings" n_postings] +} + +# topic, topic_id, n_postings, start_date, end_date, n_winners + + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + + +# cookie checks out; user is authorized + + +ReturnHeaders + +ns_write " + +Picking random participants in $topic forum + + + +

    Pick random participants in $topic forum

    + +(main admin page) + +
    + +Querying the database for participants who've made at least +$n_postings postings between $start_date and $end_date... + +

    + +

      + +" + +if { $n_postings < 2 } { + set sql "select distinct bboard.user_id, email, upper(email) as upper_email, count(bboard.user_id) as how_many_posts +from bboard, users +where bboard.user_id = users.user_id +and topic_id = $topic_id +and posting_time >= to_date('$QQstart_date','YYYY-MM-DD') +and posting_time <= to_date('$QQend_date','YYYY-MM-DD') +group by bboard.user_id, email +order by upper_email" +} else { + set sql "select distinct email, upper(email) as upper_email, count(*) as how_many_posts +from bboard, users +and topic_id = $topic_id +and posting_time >= to_date('$QQstart_date','YYYY-MM-DD') +and posting_time <= to_date('$QQend_date','YYYY-MM-DD') +and bboard.user_id = users.user_id +group by email +having count(*) >= $n_postings +order by upper_email" +} + +set selection [ns_db select $db $sql] + +set last_upper_email "" +set distinct_emails [ns_set new distinct_emails] + +# let's build up an ns_set so that we don't give unfair advantage +# to people who vary their capitalization + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $last_upper_email != $upper_email } { + ns_set put $distinct_emails $email $how_many_posts + } + set last_upper_email $upper_email +} + +set n_users [ns_set size $distinct_emails] + +if { $n_users < $n_winners } { + ns_write "You asked for $n_winners winners but there are only $n_users distinct people who meet the date and number of postings constraints." +} else { + # enough people + # seed the random number generator + randomInit [ns_time] + for {set i 1} {$i <= $n_winners} {incr i} { + # we'll have winner_numbers between 0 and 1-$n_contestants + set winning_index [randomRange [ns_set size $distinct_emails]] + set winner_email_address [ns_set key $distinct_emails $winning_index] + set winner_n_postings [ns_set value $distinct_emails $winning_index] + ns_write "
    • picked $winner_email_address ($winner_n_postings postings)\n" + ns_set delete $distinct_emails $winning_index + } +} + + + +ns_write "
    + +[bboard_footer] +" Index: web/openacs/www/bboard/admin-community-spam.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-community-spam.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-community-spam.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,102 @@ +# admin-community-spam.tcl,v 3.0 2000/02/06 03:32:41 ron Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables +page_validation { + set n_positions [validate_integer "N Postings" n_postings] +} + +# topic, n_postings, start_date, end_date, from_address, subject, message + +# we substituted wrap=hard instead +# set message [wrap_string $message] + + + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + + +ReturnHeaders + +ns_write " + +Spamming participants in $topic forum + + + +

    Spamming participants in $topic forum

    + +(main admin page) + +
    + +Proceeding to spam the participants who've made at least $n_postings +postings between $start_date and $end_date... + +
    +From: $from_address
+Subject: $subject
+---- body ---
+$message
+
    + +
      + +" + +if { $n_postings < 2 } { + set sql "select distinct bboard.user_id, count(bboard.user_id) as how_many_posts, upper(email) as upper_email,email +from bboard, users +where bboard.user_id = users.user_id +and topic_id = $topic_id +and posting_time >= to_date('$QQstart_date','YYYY-MM-DD') +and posting_time <= to_date('$QQend_date','YYYY-MM-DD') +group by bboard.user_id, email +order by upper_email" +} else { + set sql "select distinct bboard.user_id, email, upper(email) as upper_email, count(bboard.user_id) as how_many_posts +from bboard, users +where bboard.user_id = users.user_id +and topic_id = $topic_id +and posting_time >= to_date('$QQstart_date','YYYY-MM-DD') +and posting_time <= to_date('$QQend_date','YYYY-MM-DD') +group by bboard.user_id, email +having count(*) >= $n_postings +order by upper_email" +} + +set selection [ns_db select $db $sql] + +set last_upper_email "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $last_upper_email == $upper_email } { + # we've already sent to this guy + ns_write "
    • skipping $email because it looks like a capitalization variant of the the above address\n" + } else { + if [catch { ns_sendmail $email $from_address $subject $message } errmsg] { + ns_write "Trouble sending to $email: $errmsg\n" + } else { + ns_write "
    • sent to $email\n" + } + } + set last_upper_email $upper_email +} + +ns_write "
    + +[bboard_footer] +" + + Index: web/openacs/www/bboard/admin-community-view.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-community-view.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-community-view.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,130 @@ +# admin-community-view.tcl,v 3.0 2000/02/06 03:32:43 ron Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables +page_validation { + set n_positions [validate_integer "N Postings" n_postings] +} + +# topic, topic_id, n_postings, hairy AOLserver widgets for start_date, end_date + +# pull out start_date, end_date (ANSI format that will make Oracle hurl) + +ns_dbformvalue [ns_conn form] start_date date start_date +ns_dbformvalue [ns_conn form] end_date date end_date + + + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + + +ReturnHeaders + +ns_write " + +Participants in $topic forum + + + +

    Participants in $topic forum

    + +(main admin page) + +
    + +Here are the participants who've made at least $n_postings postings +between $start_date and $end_date... + +
      + +" + +if { $n_postings < 2 } { + set sql "select distinct upper(email) as none, email, count(*) as how_many_posts +from bboard , users +where bboard.user_id = users.user_id +and topic_id = $topic_id +and posting_time >= to_date('$QQstart_date','YYYY-MM-DD') +and posting_time <= to_date('$QQend_date','YYYY-MM-DD') +group by email +order by upper(email)" +} else { + set sql "select distinct upper(email) as none, email, count(*) as how_many_posts +from bboard, users +where topic_id = $topic_id +and posting_time >= to_date('$QQstart_date','YYYY-MM-DD') +and posting_time <= to_date('$QQend_date','YYYY-MM-DD') +and bboard.user_id = users.user_id +group by email +having count(*) >= $n_postings +order by upper(email)" +} + +set selection [ns_db select $db $sql] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
    • $email ($how_many_posts)\n" +} + +ns_write "
    + +

    + +

    Spam

    + +You can send them all an email message... + +
    +[export_form_vars topic topic_id start_date end_date n_postings] + +From address: + +

    + +Subject Line: + +

    + +Message: + + +

    +

    + +
    +
    + +

    Contest

    + +In case you are giving away prizes to people who participate in this +forum, we've provided the following random choice software. It will +select at random N of the above users. + +

    + +

    +[export_form_vars topic topic_id start_date end_date n_postings] + +How many winners: +

    +

    + +
    +
    + +[bboard_footer] +" Index: web/openacs/www/bboard/admin-delete-and-view-threads.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-delete-and-view-threads.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-delete-and-view-threads.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,102 @@ +# admin-delete-and-view-threads.tcl,v 3.0 2000/02/06 03:32:45 ron Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +# topic, topic_id + + + + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +# cookie checks out; user is authorized + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + + +proc compute_msg_level { sort_key } { + + set period_pos [string first "." $sort_key] + + if { $period_pos == -1 } { + + # no period, primary level + + return 0 + + } else { + + set n_more_levels [expr ([string length $sort_key] - ($period_pos + 1))/2] + + return $n_more_levels + + } + + +} + +ReturnHeaders + +ns_write " + +Delete and View Threads for $topic + + + +

    Delete and View Threads for \"$topic\"

    + +a discussion group in [bboard_system_name] + +

    + +Personally, I don't find this interface as useful as the + +admin Q&A + +but to each his own... + +

    + +

    Those Threads

    + +
    "
+
+set selection [ns_db select $db "select msg_id, one_line, sort_key from bboard
+where topic_id = $topic_id
+order by sort_key desc"]
+
+while {[ns_db getrow $db $selection]} {
+
+    set_variables_after_query
+
+    set n_spaces [expr 3 * [compute_msg_level $sort_key]]
+
+    if { $n_spaces == 0 } {
+
+	set pad ""
+
+    } else {
+
+	set pad [format "%*s" $n_spaces " "]
+
+    }
+
+    ns_write "DELETE $pad$one_line\n"
+
+}
+
+ns_write "
    + + +" Index: web/openacs/www/bboard/admin-delete-category.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-delete-category.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-delete-category.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,110 @@ +# admin-delete-category.tcl,v 3.0 2000/02/06 03:32:48 ron Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +# topic, category, rowid + +if { ![bboard_check_cookie $topic 1] } { + ns_returnredirect "admin-challenge.tcl?[export_url_vars topic topic_id]" + return +} + +# cookie checks out; user is authorized + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +set exception_text "" +set exception_count 0 + +if { [database_to_tcl_string $db "select count(*) from bboard where topic_id=$topic_id and category = '$QQcategory'"] != 0 } { + append exception_text "
  • You can't delete categories with live threads!" + incr exception_count +} + + +if { $exception_count> 0 } { + if { $exception_count == 1 } { + set problem_string "a problem" + set please_correct "it" + } else { + set problem_string "some problems" + set please_correct "them" + } + ns_return 200 text/html "[bboard_header "Problem Deleting Category"] + +

    Problem Deleting Category

    + +
    + +We had $problem_string deleting $category: + +
      + +$exception_text + +
    + +Please back up using your browser, correct $please_correct, +and resubmit your form. + +

    + +Thank you. + +[bboard_footer]" + +return 0 + +} + +set sql "delete from bboard_q_and_a_categories where topic_id=$topic_id and rowid = '$QQrowid'" + +if [catch {ns_db dml $db $sql} errmsg] { + ns_return 500 text/html "[bboard_header "Category Not Deleted"] + +

    Category Not Deleted

    + +
    + +The database rejected the deletion of (\"$topic\",\"$category\"). Here was +the error message: + +
    +$errmsg
+
    + +[bboard_footer]" + +return 0 + +} + +# the database operation went OK + +ns_return 200 text/html "[bboard_header "$category Deleted"] + +

    $category Deleted

    + +from \"$topic\" in +[bboard_system_name] + +
    + +If you've read Philip +Greenspun's book on Web publishing then you'll appreciate the SQL: + +
    +$sql
+
    + +If you're just trying to get some work done, you'll probably want to +return to the edit categories page. + + +[bboard_footer]" + Index: web/openacs/www/bboard/admin-edit-categories.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-edit-categories.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-edit-categories.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,87 @@ +# admin-edit-categories.tcl,v 3.0 2000/02/06 03:32:49 ron Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +# topic, topic_id + + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + + + +# cookie checks out; user is authorized + + +if [catch {set selection [ns_db 0or1row $db "select distinct * from bboard_topics where topic_id=$topic_id"]} errmsg] { + [bboard_return_cannot_find_topic_page] + return +} +# we found the data we needed +set_variables_after_query + +ReturnHeaders + +ns_write "[bboard_header "Edit categories for $topic"] + +

    Edit Categories for \"$topic\"

    + +
      +" + + +set selection [ns_db select $db "select cats.oid as rowid, cats.category, + sum(case when cats.category=b.category and + cats.topic_id=b.topic_id then 1 else 0 end) as n_threads + from bboard_q_and_a_categories cats, bboard b + where cats.topic_id=$topic_id + and b.refers_to is null + and (b.topic_id is null or b.topic_id = $topic_id) + group by cats.oid, cats.category + order by cats.category"] + +set counter 0 +while {[ns_db getrow $db $selection]} { + set_variables_after_query + incr counter + if { $n_threads == 0 } { + ns_write "
    • $category ($n_threads threads) + delete\n" + } else { + ns_write "
    • $category ($n_threads threads)\n" + } +} + +if { $counter == 0 } { + ns_write "no categories defined" +} + +ns_write " + +
    + +Note: Categories with 1 or more threads are presented on the top level +Q&A page. Categories with 0 threads are presented to users posting +new questions (if you've enabled solicitation of categories from +users). They are presented on the top level page only for +category-centric bboards. + +

    + +Right now, I think I'm only going to let you delete categories with +zero threads. If you want to kill off a category, please delete or +recategorize the threads that are underneath it. Someday when I'm +feeling smarter, I'll add an option to rename a category and all the +threads underneath. + +[bboard_footer]" Index: web/openacs/www/bboard/admin-edit-msg-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-edit-msg-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-edit-msg-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,83 @@ +# admin-edit-msg-2.tcl,v 3.0 2000/02/06 03:32:50 ron Exp +set_the_usual_form_variables + +# msg_id, one_line, message, html_p + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +set selection [ns_db 1row $db "select bboard_topics.topic, bboard.topic_id, users.first_names || ' ' || users.last_name as name, users.email +from bboard, users, bboard_topics +where bboard.user_id = users.user_id +and bboard_topics.topic_id = bboard.topic_id +and msg_id = '$QQmsg_id'"] +set_variables_after_query + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + +ns_db dml $db "begin transaction" + +# is this usgeospatial? +if { [info exists usgeospatial_p] } { + set other_columns "epa_region = '$QQepa_region', +usps_abbrev = '$QQusps_abbrev', +fips_county_code = '$QQfips_county_code', +" +} else { + set other_columns "" +} + +ns_db dml $db "update bboard +set one_line = '$QQone_line', +html_p='$QQhtml_p', +$other_columns +message = '$QQmessage' +where msg_id = '$QQmsg_id'" + +ns_db dml $db "end transaction" + +ReturnHeaders +ns_write " + +\"$one_line\" updated + + + +

    Message $one_line

    + +Updated in the database - +(main admin page) + + + +
    + +
      +
    • subject line: $one_line +
    • from: $name ($email) +" + +if { [info exists usgeospatial_p] } { + ns_write "
    • EPA Region: $epa_region +
    • USPS: $usps_abbrev +
    • FIPS: $fips_county_code +" +} + +ns_write "
    • message: [util_maybe_convert_to_html $message $html_p] +
    + + + + +[bboard_footer] + +" Index: web/openacs/www/bboard/admin-edit-msg-2.tcl.bk =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-edit-msg-2.tcl.bk,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-edit-msg-2.tcl.bk 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,73 @@ +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +# msg_id, one_line, message + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +set selection [ns_db 1row $db "select topic, users.first_names || ' ' || users.last_name as name, users.email +from bboard, users +where bboard.user_id = users.user_id +and msg_id = '$msg_id'"] +set_variables_after_query + +set QQtopic [DoubleApos $topic] + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + +ns_db dml $db "begin transaction" + +if { [string length $QQmessage] < 4000 } { + ns_db dml $db "update bboard +set one_line = '$QQone_line', +message = '$QQmessage' +where msg_id = '$msg_id'" +} else { + ns_ora clob_dml "update bboard +set one_line = '$QQone_line', +email = '$QQemail', +name = '$QQname', +message = empty_clob() +where msg_id = '$msg_id' +returning messsage into :one" $message +} + +ns_db dml $db "end transaction" + +ns_return 200 text/html " + +\"$one_line\" updated + + + +

    Message $one_line

    + +Updated in the database - +(main admin page) + + + +
    + +
      +
    • subject line: $one_line +
    • from: $name ($email) +
    • message: $message +
    + + + + +[bboard_footer] + +" Index: web/openacs/www/bboard/admin-edit-msg.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-edit-msg.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-edit-msg.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,89 @@ +# admin-edit-msg.tcl,v 3.0 2000/02/06 03:32:52 ron Exp +set_form_variables + +# msg_id is the key + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +set selection [ns_db 1row $db "select bboard.*, users.email, users.first_names || ' ' || users.last_name as name, bboard_topics.topic +from bboard, users, bboard_topics +where users.user_id = bboard.user_id +and bboard_topics.topic_id = bboard.topic_id +and msg_id = '$QQmsg_id'"] +set_variables_after_query + +set QQtopic [DoubleApos $topic] + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + +# find out if this is usgeospatial +set presentation_type [database_to_tcl_string $db "select presentation_type from bboard_topics where topic_id=$topic_id"] + +ReturnHeaders +ns_write " + +Edit \"$one_line\" + + + +

    Edit \"$one_line\"

    + +(main admin page) +
    + +
    + + + + + + + + + +" + +if {$presentation_type == "usgeospatial"} { + ns_write " + + + + +" +} + +# we have to quote this in case it contains a TEXTAREA itself +ns_write " + + +
    Subject Line
    Poster Email Address: $email
    Poster Full Name: $name
    EPA Region
    USPS
    FIPS
    TRI ID
    Message + +
    Text above is: +
    + + + + +

    + +

    + + + + +
    + +
    + +[bboard_footer]" Index: web/openacs/www/bboard/admin-expired-threads-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-expired-threads-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-expired-threads-delete.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,91 @@ +# admin-expired-threads-delete.tcl,v 3.0 2000/02/06 03:32:53 ron Exp +set_the_usual_form_variables + +# topic, topic_id + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + +# we found subject_line_suffix at least +set_variables_after_query + +ReturnHeaders + +ns_write " + +Deleting expired threads in $topic + + + +

    Expired Threads

    + +in the $topic question and answer forum + +
    + + +" + +set threads_to_nuke [database_to_tcl_list_list $db "select msg_id, one_line, sort_key +from bboard +where topic_id = $topic_id +and sysdate()::date - posting_time::date >= expiration_days +and refers_to is null +order by sort_key $q_and_a_sort_order"] + +ns_write "
      \n" + +set counter 0 + +foreach elt $threads_to_nuke { + incr counter + set msg_id [lindex $elt 0] + set one_line [lindex $elt 1] + set sort_key [lindex $elt 2] + ns_write "
    • working on \"$one_line\" and its dependents... \n" + set dependent_key_form [dependent_sort_key_form $sort_key] + set dependent_ids [database_to_tcl_list $db "select msg_id from bboard where sort_key like '$dependent_key_form'"] + + with_transaction $db { + + if {[bboard_file_uploading_enabled_p]} { + set list_of_files_to_delete [database_to_tcl_list $db "select filename_stub from bboard_uploaded_files where msg_id IN ('[join $dependent_ids "','"]')"] + + ns_db dml $db "delete from bboard_uploaded_files where msg_id in ('$msg_id', '[join $dependent_ids "','"]' )" + + # ADD THE ACTUAL DELETION OF FILES + if { [llength $list_of_files_to_delete] > 0 } { + ns_atclose "bboard_delete_uploaded_files $list_of_files_to_delete" + } + } + + ns_db dml $db "delete from bboard_thread_email_alerts where thread_id in ( '$msg_id','[join $dependent_ids "','"]' )" + + ns_db dml $db "delete from bboard where msg_id in ( '$msg_id','[join $dependent_ids "','"]' )" + ns_write "success! (killed [llength $dependent_ids] dependents)\n" + } { + ns_write "failed. Database choked up \"$errmsg\"> + } +} + +if { $counter == 0 } { + ns_write "there are no expired threads right now; so none were deleted" +} + +ns_write " + +
    + + +[bboard_footer] +" Index: web/openacs/www/bboard/admin-expired-threads.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-expired-threads.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-expired-threads.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,77 @@ +# admin-expired-threads.tcl,v 3.0 2000/02/06 03:32:55 ron Exp +set_the_usual_form_variables + +# topic, topic_id + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + + +ReturnHeaders + +ns_write " + +Expired threads in $topic + + + +

    Expired Threads

    + +in the $topic question and answer forum + +
    + + +" + +set sql "select to_char(posting_time,'YYYY-MM-DD') as posting_date, msg_id, one_line, sort_key, email, first_names || ' ' || last_name as name, interest_level +from bboard, users +where bboard.user_id = users.user_id +and topic_id = $topic_id +and sysdate()::date - posting_time::date >= expiration_days +and refers_to is null +order by sort_key $q_and_a_sort_order" + + +set selection [ns_db select $db $sql] + +ns_write "
      \n" + +set counter 0 +while {[ns_db getrow $db $selection]} { + set_variables_after_query + incr counter + ns_write "
    • $posting_date: $one_line +
      +from $name ($email)\n" + if { $q_and_a_use_interest_level_p == "t" } { + if { $interest_level == "" } { set interest_level "NULL" } + ns_write " -- interest level $interest_level" + } +} + +if { $counter == 0 } { + ns_write "there are no expired threads right now" +} + +ns_write " + +
    + +The only thing that you can do with these is nuke them all. If you +want to preserve a thread, click on it and reset its expiration days +to be blank and/or enough to take it off this list. + +[bboard_footer] +" Index: web/openacs/www/bboard/admin-home.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-home.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-home.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,505 @@ +# admin-home.tcl,v 3.0 2000/02/06 03:32:46 ron Exp +set_the_usual_form_variables + +# topic, topic_id + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return +} + +if {[bboard_admin_authorization] == -1} { + return +} + + +# cookie checks out; user is authorized + + +if [catch {set selection [ns_db 0or1row $db "select bt.*,u.email as maintainer_email, u.first_names || ' ' || u.last_name as maintainer_name, presentation_type + from bboard_topics bt, users u + where bt.topic_id=$topic_id + and bt.primary_maintainer_id = u.user_id"]} errmsg] { + [bboard_return_cannot_find_topic_page] + return +} +# we found the data we needed +set_variables_after_query + +set threads_checked "" +set q_and_a_checked "" +set ed_com_checked "" +set usgeospatial_checked "" +switch $presentation_type { + threads { set threads_checked " CHECKED" } + q_and_a { set q_and_a_checked " CHECKED" } + ed_com { set ed_com_checked " CHECKED" } + usgeospatial { set usgeospatial_checked " CHECKED" } +} + +ReturnHeaders + +ns_write " + +BBoard Admin for $topic + + + +

    Administration for \"$topic\"

    + +a discussion group in [bboard_system_name] + +
    + +

    Daily Tasks

    + + + +

    Community

    + +This software can help you view, spam, count, or randomly select (for +contests) the people who participate in your forum. + +

    + +Pick out the readers who've posted at least + +

    +[export_form_vars topic topic_id] + times + +between + +[_ns_dateentrywidget start_date] + +and + +[_ns_dateentrywidget end_date] + +

    +

    + +
    +
    + +

    Bozo Filters

    + +You can instruct this system to automatically reject postings that +match certain patterns. For example, at photo.net we want to refuse +postings that contain the string \"aperature\". Invariably, people +who can't spell \"aperture\" turn out to be idiots. + +" + +# Branimir: bugfix: We need to save the result of the previous query +# because we'll need it +set selection_saved [ns_set copy $selection] + +set selection [ns_db select $db "select * +from bboard_bozo_patterns +where topic_id = $topic_id +order by upper(the_regexp)"] + +set bozo_items "" +while { [ns_db getrow $db $selection] } { + set_variables_after_query + append bozo_items "
  • $the_regexp\n" +} + +if [empty_string_p $bozo_items] { + set bozo_items "there aren't any bozo patterns associated with this forum right now" +} + +ns_write " + +

    How this BBoard is presented to users

    + +Remember that although this bboard runs from a purpose-built DB-backed +Web server, it is designed to look like it is part of the original +static Web service. The pages will be displayed with your email +address at the bottom, and a link back to your static server. (If you +want more customization, you'll just have to read Philip Greenspun's +book on Web service design). + +
    +[export_form_vars topic topic_id] + + +

    + +The most important thing is the backlink URL, i.e., the URL for +your server. This will be offered by my server as a link +back to you. Make sure you have the full \"http://\" in front, e.g., +\"http://gardenhosestoday.com\". + +

    + +Backlink: + +

    + +You probably don't want the Q&A forum page saying \"this is associated +with http://complicated-domain.com/bunch-of-dirs/foobar.html\". So +put in a title for the above URL, e.g., \"Garden Hose Magazine\". + +

    + +Backlink Title: + +

    + + +Primary Maintainer: [database_to_tcl_string $db "select first_names || ' ' || last_name || ' ' || '(' || email || ')' from users where user_id = $primary_maintainer_id"] + +(update) + +
    +(note: messages from the above email address will be displayed first in a Q&A forum thread, even if the maintainer was not the first person to answer) + +

    + +

    Presentation Type

    + +You have to choose whether or not this is primarily a Q&A +forum, a threads-based discussion group, or an editorial stlye. +The user interfaces interoperate, i.e., a posting made a user in +the Q&A interface will be seen in the threads interface and vice versa. +But my software still needs to know whether this is primarily threads, Q&A +or editorial. For example, +if a user signs up for email alerts, this program will send out email +saying \"come back to the forum at http://...\". The \"come back +URL\" is different for Q&A and threads. + +
      +
    • threads - classical USENET style +
    • Q&A - questions and all answers appear on one page, use for discussion groups that tend to have short messages/responses +
    • Editorial - question and answers appear on separate pages, answers are collasped by subject line as a default, use for discussion groups that tend to have longer messages/responses +
    • US Geospatial +
    + +

    + + +
    + +(note: I personally greatly prefer the Q&A interface; if people liked +threads, they'd have stuck with USENET.) + + +

    How Threads are Presented

    + +Whenever postings are displayed in a \"one line summary\" form, you +can choose to have this server add email address, name, and/or posting +date to each line in the summary. + +

    + +Subject Line Suffix: +
    +(legal values are blank, \"name\", \"email\", \"date\", separated by spaces) + +

    + +Q&A threads are presented as a list. You can choose either

    +" + +if { $q_and_a_sort_order == "asc" } { + ns_write " Oldest on top + Newest on top +"} else { + ns_write " Oldest on top + Newest on top +" +} + +ns_write " + +

    Categorization

    + +After a Q&A forum has collected a few thousand messages, it becomes +tough for users to find archived threads, even when the software is +running on a server with a full-text search engine. Categorization +lets you support browsing as well as searching. As the administrator, +you are always able to recategorize messages and define new +categories. If you want less work and don't mind a little chaos, then +you can allow users to categorize their own questions (they get a +select menu when they post a new question). If you don't mind a lot +of chaos, you can allow users to define new categories. + +

    + +" + +set raw_form_vars "Present Categorized? + Yes + No + + +

    + + +Ask User to Categorize? + Yes + No + +

    + +Allow Users to Add New Categories? + Yes + No + +

    + +Remember that new questions will always be presented on top for +however many days you specify, even if they are categorized. After +the \"days considered new\" period has lapsed, a question will show up +underneath a category heading. + +

    + +Days Considered New: + +

    + +If your forum becomes extremely popular, you might want to trim down +the top-level page so that it shows only the subject lines for new +messages. For older messages, all you see are the category names and +a count of how many messages are in that category. + +

    + +Show only the categories (and a count) on the top level page? + Yes + No +" + +# (Branimir: bugfix: we have to use selection_saved as bozo filters +# query has overwritten the original selection) +set merged_form [bt_mergepiece $raw_form_vars $selection_saved] + +ns_write "$merged_form + +

    + +Note: all the categorization stuff is ignored in the threads (frames) +interface. + +

    + +Once you've set up categorization, you can add categories in the Q&A +admin pages (while looking at threads), or you can take an overall +look in the edit categories page. + +

    Interest Level

    + +After a Q&A forum has collected a few tens of thousands of +messages, it becomes tough for users to find interesting threads, even +when you have categorization turned on. For example, in my photo.net +forum someone asked what the \"QC\" meant in a Nikon 135 QC lens, +which was manufactured in the early 1970s. I don't want to delete it, +because someone three years from now might search for \"Nikon QC\" and +find it useful. But I don't want it cluttering up my Nikon category +where the majority of readers are using modern equipment. So I +enabled my interest level system. As the administrator, you can rate +things on a scale from 0 to 10. Anything 3 or below is deemed +\"uninteresting\" and separated from the other threads in a category. +In the long run, I'll probably add an option for users to see the +threads that the administrator has specifically marked interesting (8 +or higher?). Remember that you don't have to mark each thread. +Threads without a number are still considered \"interesting\". + +

    + +Use Interest Level System? +" + +if { $q_and_a_use_interest_level_p == "t" } { + ns_write " Yes + No" } else { + ns_write " Yes + No" +} + + +ns_write " + +

    Policy

    + +If you choose, you can explain to users what this forum is supposed to +be for. An \"About\" link will be added to the top level page. For +example, if you're using this software for tech support, you could say +\"You can expect a response within 24 hours from one of the following +people:\". If you're running a contest (see below) then you could use +this message to explain how frequently winners are chosen and what are +the possible prizes. + +

    + + + +

    Discouraging Users from Posting

    + +Sometimes you can have too much of a good thing. When your site is +young, you'll be eager for all kinds of posts (at least I was). But +after 100,000 messages, you'll get sick of repeats. So you can put in +a little canned message encouraging users to check your site's static +content and/or a search engine before posting a question. Note that +if this system is running on a machine with a full-text search engine +installed as part of the RDBMS then a \"search the forum\" link is +offered by default to everyone. + +

    + + + + +

    Notification

    + +If your forum is inactive, you'll probably want this system to send +you email every time someone adds a posting of any kind (new top-level +question or reply). If you're getting 50 new postings/day then you'll +probably want to disable this feature + +

    + +Notify me of all new postings? + +" + +if { $notify_of_new_postings_p == "t" } { + ns_write " Yes No " +} else { + ns_write " Yes No " +} + + +ns_write "

    + +Note that users can use the alerts feature to get instant notification +of all postings themselves. The From: header in this case is set to +that of the person who contributed the new posting. If users who've +added alerts lose their email account, then this can generate a lot of +bounced email. In this case, as the administrator, you'll want to view all +the alerts and disable the ones you think are causing bounces. + +

    +

    + + + +
    + +
    + + + +

    Things that you can't do (well, not from here)

    + +
      + +
    • you cannot change the topic name because it is used as a database +key in the bboard messages table. + +
    • you can't delete a topic. That's too great a security risk. You have to +send email to [bboard_system_owner] +if you want to kill a topic. + + +
    + + +

    Weird stuff

    + +This is a section of parameters for people who are using my software +in unintended ways (i.e., not really as a forum at all). For example, +someone wanted to put up a service with a fixed set of threads, e.g., +one for each U.S. state. Users would be free to add any message they +wanted underneath any of the threads set up by the administrator (oh +yes, this works by removing the +Ask a Question +link from the top level page). + +

    + +

    +[export_form_vars topic topic_id] + +Allow Users to initiate threads? + +" + +if { $users_can_initiate_threads_p == "f" } { + ns_write " Yes + No" +} else { + ns_write " Yes + No" } + +ns_write " +

    +

    + + + +
    + +
    + +" + +if [ad_parameter FileUploadingEnabledP bboard 0] { + ns_write " +

    File/Image Uploading

    + +The server is configured to permit user uploads of images and other +files. Essentially a user can attach an arbitrary file to a message +or, in the case of an image, have it displayed in-line with the message. + +
    +[export_form_vars topic topic_id] + +Types of files you anticipate: + +
    +
    +
    + +
    +
    +" +} + +ns_write " + +[bboard_footer] +" Index: web/openacs/www/bboard/admin-q-and-a-all.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-q-and-a-all.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-q-and-a-all.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,80 @@ +# admin-q-and-a-all.tcl,v 3.0 2000/02/06 03:32:56 ron Exp +set_the_usual_form_variables + +# topic required + +if ![msie_p] { + set target_window "target=admin_bboard_window" +} else { + set target_window "" +} + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + + +set sql "select msg_id, one_line, sort_key, email, first_names || ' ' || last_name as name, interest_level +from bboard, users +where bboard.user_id = users.user_id +and topic_id = $topic_id +and refers_to is null +order by sort_key $q_and_a_sort_order" + +set selection [ns_db select $db $sql] + +ReturnHeaders + +ns_write " + +Administer $topic by Question + + + +

    Administer $topic

    + +by question" + +if { $backlink != "" || $backlink_title != "" } { + + ns_write " associated with +$backlink_title." + +} + +ns_write " + +
    + +
      + +" + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
    • $one_line +
      +from $name ($email)\n" + if { $q_and_a_use_interest_level_p == "t" } { + if { $interest_level == "" } { set interest_level "NULL" } + ns_write " -- interest level $interest_level" + } + +} + +ns_write " + +
    + +[bboard_footer] +" Index: web/openacs/www/bboard/admin-q-and-a-category-list.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-q-and-a-category-list.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-q-and-a-category-list.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,60 @@ +# admin-q-and-a-category-list.tcl,v 3.0 2000/02/06 03:32:58 ron Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +# topic, topic_id required + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + +ReturnHeaders + +ns_write " + +Question Categories + + + +

    Question Categories

    + +in the $topic Q&A forum + +
    + +
      + +" + +# may someday need "and category <> ''" + +set selection [ns_db select $db "select category, count(*) as n_threads +from bboard +where refers_to is null +and topic_id = $topic_id +and category is not null +and category <> 'Don''t Know' +group by category +order by 1"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
    • $category ($n_threads)\n" +} + +ns_write " +

      +

    • Uncategorized +
    + +[bboard_footer] +" Index: web/openacs/www/bboard/admin-q-and-a-fetch-msg.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-q-and-a-fetch-msg.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-q-and-a-fetch-msg.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,326 @@ +# admin-q-and-a-fetch-msg.tcl,v 3.0 2000/02/06 03:32:59 ron Exp +ad_page_variables { + {msg_id} +} +page_validation { + bboard_validate_msg_id $msg_id +} + +# msg_id is the key +# make a copy because it is going to get overwritten by +# some subsequent queries + +set this_msg_id $msg_id + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if [bboard_file_uploading_enabled_p] { + set selection [ns_db 0or1row $db " +select + posting_time as posting_date, + bboard.*, + bboard_topics.topic, + users.email, + users.first_names || ' ' || users.last_name as name, + buf.bboard_upload_id, + buf.file_type, + buf.n_bytes, + buf.client_filename, + buf.caption, + buf.original_width, + buf.original_height +from bboard, bboard_topics, users, bboard_uploaded_files buf +where bboard_topics.topic_id = bboard.topic_id +and bboard.user_id = users.user_id +and bboard.msg_id = buf.msg_id +and bboard.msg_id = '$msg_id' +union +select + posting_time as posting_date, + bboard.*, + bboard_topics.topic, + users.email, + users.first_names || ' ' || users.last_name as name, + NULL as bboard_upload_id, + NULL as file_type, + NULL as n_bytes, + NULL as client_filename, + NULL as caption, + NULL as original_width, + NULL as original_height +from bboard, bboard_topics, users +where bboard_topics.topic_id = bboard.topic_id +and bboard.user_id = users.user_id +and not exists (select msg_id from bboard_uploaded_files where msg_id='$msg_id') +and bboard.msg_id = '$msg_id'"] +} else { + set selection [ns_db 0or1row $db "select to_char(posting_time,'YYYY-MM-DD') as posting_date,bboard.*, users.first_names || ' ' || users.last_name as name, users.email, bboard_topics.topic +from bboard, users, bboard_topics +where users.user_id = bboard.user_id +and bboard.topic_id = bboard_topics.topic_id +and msg_id = '$msg_id'"] +} + +if { $selection == "" } { + # message was probably deleted + ns_return 200 text/html "Couldn't find message $msg_id. Probably it was deleted by the forum maintainer." + return +} + +set_variables_after_query +# now we know the topic for this message, make sure the user is +# authorized + + +set QQtopic [DoubleApos $topic] + + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + + + +set this_one_line $one_line + +# now variables like $message and $topic are defined + + + +if { $originating_ip != "" } { + set contributed_by "Asked by $name ($email) +from +$originating_ip on [util_AnsiDatetoPrettyDate $posting_date]." +} else { + set contributed_by "Asked by $name ($email) on [util_IllustraDatetoPrettyDate $posting_date]." +} + +# find out if this is usgeospatial +set presentation_type [database_to_tcl_string $db "select presentation_type from bboard_topics where topic_id = $topic_id"] + +ReturnHeaders + +ns_write " + +$one_line + + + + +

    $one_line

    + +" + +if { $presentation_type == "usgeospatial" } { + ns_write "in the $topic $presentation_type forum" +} else { + ns_write "in the $topic $presentation_type forum" +} + +ns_write "
    + + +
    + +Thread title: + +
    +

    + +" + +if { $presentation_type == "usgeospatial" } { + ns_write "asked in the $topic ($epa_region : $usps_abbrev : $fips_county_code : $tri_id) $presentation_type Forum +" +} else { + ns_write "asked in the $topic $presentation_type Forum +" +} + +ns_write "

    + +

      + +
    • DELETE ENTIRE THREAD + +" + +if { $q_and_a_use_interest_level_p == "t" } { + ns_write "
      + +
    • Interest Level: + +
      • +" + +} + +ns_write " +
      + +
    • Expiration Days: + +
      • +" + + +if { $q_and_a_categorized_p == "t" } { + set categories [database_to_tcl_list $db "select distinct category, upper(category) from bboard_q_and_a_categories where topic_id = $topic_id order by 2"] + lappend categories "Define New Category" + ns_write "
    • + +
      " + +} + +ns_write " + +
    + +
    + +
    + + + + + +
    +
    +" + +if { [info exists bboard_upload_id] && [info exists file_type] && ![empty_string_p $bboard_upload_id] && $file_type == "photo" && $n_bytes > 0 } { + # ok, we have a photo; the question is how big is it + if [empty_string_p $original_width] { + # we don't know how big it is so it probably wasn't a JPEG or GIF + ns_write "
    (undisplayable image: $caption -- $client_filename)
    " + } elseif { $original_width < 512 } { + ns_write "
    \n\n
    $caption\n
    \n
    " + } else { + ns_write "
    ($caption -- $original_height x $original_width $file_type)
    " + } +} + +ns_write "[util_maybe_convert_to_html $message $html_p] +
    + +$contributed_by +" + +if { [info exists bboard_upload_id] && [info exists file_type] && ![empty_string_p $bboard_upload_id] && $file_type != "photo" } { + ns_write "
    Attachment: $client_filename\n" +} + +ns_write "    		 +DELETE
    +EDIT +
    +" + + +set selection [ns_db select $db "select email <> '$maintainer_email' as not_maintainer_p, to_char(posting_time,'YYYY-MM-DD') as posting_date,bboard.*, users.first_names || ' ' || users.last_name as name, users.email +from bboard, users +where bboard.user_id = users.user_id +and root_msg_id = '$msg_id' +and msg_id <> '$msg_id' +order by not_maintainer_p, sort_key"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + if { $email == "" } { + if { $originating_ip == "" } { + set contributed_by "anonymously answered on [util_IllustraDatetoPrettyDate $posting_date]." } else { + set contributed_by "anonymously answered +from $originating_ip +on [util_IllustraDatetoPrettyDate $posting_date]." + } + } else { + if { $originating_ip == "" } { + set contributed_by "Answered by $name ($email) on [util_IllustraDatetoPrettyDate $posting_date]." + } else { + set contributed_by "Answered by $name ($email) +from $originating_ip +on [util_IllustraDatetoPrettyDate $posting_date]." + } +} + set this_response "" + if { $one_line != $this_one_line && $one_line != "Response to $this_one_line" } { + # new subject + append this_response "

    $one_line

    \n" + } + append this_response " + + +
    +
    +[util_maybe_convert_to_html $message $html_p] +
    +$contributed_by +    		 +DELETE
    +EDIT

    + bulk delete +

    +" + lappend responses $this_response +} + +if { [info exists responses] } { + # there were some + ns_write "

    Answers

    +[join $responses "
    "] +" +} + + +ns_write " + +

    + + + +
    +" + +if { $presentation_type == "usgeospatial" } { + ns_write "Contribute an answer to \"$this_one_line\" +" +} else { + ns_write "Contribute an answer to \"$this_one_line\" +" +} + +ns_write " + +
    +

    + + + +[bboard_footer] + +" + Index: web/openacs/www/bboard/admin-q-and-a-new-answers.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-q-and-a-new-answers.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-q-and-a-new-answers.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,69 @@ +# admin-q-and-a-new-answers.tcl,v 3.0 2000/02/06 03:33:01 ron Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +# topic required + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + +# we found subject_line_suffix at least +set_variables_after_query + +ReturnHeaders + +ns_write " + +$topic Recent Answers + + + +

    Recent Answers

    + +in the $topic Q&A forum + +
    + +
      +" + +set sql "select bnah.root_msg_id,count(*) as n_new,max(bnah.posting_time) as max_posting_time, to_char(max(bnah.posting_time),'YYYY-MM-DD') as max_posting_date, bboard.one_line as subject_line +from bboard_new_answers_helper bnah, bboard +where sysdate()::date - bnah.posting_time::date < 7 +and bnah.root_msg_id = bboard.msg_id +and bnah.topic_id = $topic_id +group by root_msg_id, bboard.one_line +order by max_posting_time desc" + +set selection [ns_db select $db $sql] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + if { $n_new == 1 } { + set answer_phrase "answer, " + } else { + set answer_phrase "answers, last " + } + ns_write "
    • $subject_line ($n_new new $answer_phrase on [util_IllustraDatetoPrettyDate $max_posting_date])" + +} + +ns_write " + +
    + +[bboard_footer] +" + Index: web/openacs/www/bboard/admin-q-and-a-new-messages.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-q-and-a-new-messages.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-q-and-a-new-messages.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,71 @@ +# admin-q-and-a-new-messages.tcl,v 3.0 2000/02/06 03:33:02 ron Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +# topic required + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + +ReturnHeaders + +ns_write " + +$topic Recent Postings + + + +

    Recent Postings

    + +in the $topic Q&A forum (sorted by time rather than by thread) + +

    + +(covers last $q_and_a_new_days days) + +

    + + +
      +" + +set sql "select msg_id, one_line, sort_key, email, first_names || ' ' || last_name as name, originating_ip, interest_level, posting_time, substr(sort_key,1,6) as root_msg_id +from bboard, users +where bboard.user_id = users.user_id +and topic_id = $topic_id +and sysdate()::date - posting_time::date <= $q_and_a_new_days +order by sort_key desc" + +set selection [ns_db select $db $sql] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + if { $originating_ip == "" } { + set ip_stuff "" + } else { + set ip_stuff "$originating_ip" + } + ns_write "
    • $posting_time: $one_line from $name +($email) +$ip_stuff" + +} + +ns_write " + +
    + +[bboard_footer] +" + Index: web/openacs/www/bboard/admin-q-and-a-one-category.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-q-and-a-one-category.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-q-and-a-one-category.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,90 @@ +# admin-q-and-a-one-category.tcl,v 3.0 2000/02/06 03:33:04 ron Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +# topic, topic_id, category required + +# we're just looking at the uninteresting postings now + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + + +ReturnHeaders + +ns_write " + +$category threads in $topic + + + +

    $category Threads

    + +in the     $topic question and answer forum + +
    + + +" + +if { $category != "uncategorized" } { + set category_clause "and category = '$QQcategory'" +} else { + set category_clause "and (category is NULL or category = '' or category = 'Don''t Know')" +} + + +set sql "select msg_id, one_line, sort_key, email, first_names || ' ' || last_name as name, interest_level, bboard_uninteresting_p(interest_level) as uninteresting_p +from bboard, users +where bboard.user_id = users.user_id +and topic_id = $topic_id +$category_clause +and refers_to is null +order by uninteresting_p, sort_key $q_and_a_sort_order" + +set selection [ns_db select $db $sql] + +ns_write "
      \n" + +set uninteresting_header_written 0 +while {[ns_db getrow $db $selection]} { + set_variables_after_query + if { $uninteresting_p == "t" && $uninteresting_header_written == 0 } { + set uninteresting_header_written 1 + ns_write "
    +

    Uninteresting Threads

    + + +
      +" + } + ns_write "
    • $one_line +
      +from $name ($email)\n" + if { $q_and_a_use_interest_level_p == "t" } { + if { $interest_level == "" } { set interest_level "NULL" } + ns_write " -- interest level $interest_level" + } +} + +# let's assume there was at least one posting + +ns_write " + +
    + + +[bboard_footer] +" Index: web/openacs/www/bboard/admin-q-and-a-prompt-for-new-category.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-q-and-a-prompt-for-new-category.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-q-and-a-prompt-for-new-category.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,71 @@ +# admin-q-and-a-prompt-for-new-category.tcl,v 3.0 2000/02/06 03:33:07 ron Exp +ad_page_variables { + {msg_id} +} +page_validation { + bboard_validate_msg_id $msg_id +} + + +# msg_id + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +set selection [ns_db 0or1row $db "select distinct t.topic, b.topic_id, b.one_line from bboard b, bboard_topics t where b.topic_id=t.topic_id and b.msg_id = '$msg_id'"] + +if { $selection == "" } { + # message was probably deleted + ns_return 200 text/html "Couldn't find message $msg_id. Probably it was deleted by the forum maintainer." + return +} + +set_variables_after_query + +ns_log Notice "--$topic_id $topic $msg_id" + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return +} + + +ReturnHeaders +ns_write " + +Add a new category + + + +

    Add a new category

    + +to the $topic forum + +

    +(for $one_line) + +

    + +
    + + +New Category Name: +
    + +For reference, here are the existing categories: +
      +" + +set categories [database_to_tcl_list $db "select distinct category, upper(category) from bboard_q_and_a_categories where topic_id = $topic_id order by 2"] +foreach choice $categories { + ns_write "
    • $choice\n" +} + +ns_write "
    + +[bboard_footer]" Index: web/openacs/www/bboard/admin-q-and-a-search-form.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-q-and-a-search-form.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-q-and-a-search-form.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,46 @@ +# admin-q-and-a-search-form.tcl,v 3.0 2000/02/06 03:33:05 ron Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +# topic required + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + +set search_submit_button "" +if { [msie_p] == 1 } { + set search_submit_button "" +} + +set_variables_after_query + +ns_return 200 text/html " + +Search $topic Q&A + + + +

    Search

    + +the $topic Q&A forum + +
    +
    + + +Full Text Search: +$search_submit_button +
    + +[bboard_footer]" Index: web/openacs/www/bboard/admin-q-and-a-search-pls.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-q-and-a-search-pls.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-q-and-a-search-pls.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,76 @@ +# admin-q-and-a-search-pls.tcl,v 3.0 2000/02/06 03:33:08 ron Exp +set_form_variables +set_form_variables_string_trim_DoubleAposQQ + +# query_string, topic + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + + + +ReturnHeaders + +ns_write " + +Search Results + + + +

    Messages matching \"$query_string\"

    + +in the $topic forum. + +
    +\[ Ask New Question \] + +
      +" + +regsub -all { +} $query_string "," query_string_for_ctx +regsub -all {,+} $query_string_for_ctx "," query_string_for_ctx + +set selection [ns_db select $db "select msg_id, sort_key, one_line, first_names || ' ' || last_name as name, email +from bboard, users +where bboard.user_id = users.user_id +and contains (indexed_stuff, '\$([DoubleApos $query_string_for_ctx])', 10) > 0 +and topic_id=$topic_id +order by score(10) desc"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + if { [string first "." $sort_key] == -1 } { + # there is no period in the sort key so this is the start of a thread + set thread_start_msg_id $sort_key + } else { + # strip off the stuff before the period + regexp {(.*)\..*} $sort_key match thread_start_msg_id + } + ns_write "
    • $one_line +
      +from $name ($email)\n" +} + +ns_write " +
    + +
    + + +New Search: +
    + +[bboard_footer] +" Index: web/openacs/www/bboard/admin-q-and-a-search.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-q-and-a-search.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-q-and-a-search.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,76 @@ +# admin-q-and-a-search.tcl,v 3.0 2000/02/06 03:33:09 ron Exp +set_form_variables +set_form_variables_string_trim_DoubleAposQQ + +# query_string, topic + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + + + +ReturnHeaders + +ns_write " + +Search Results + + + +

    Messages matching \"$query_string\"

    + +in the $topic forum. + +
    +\[ Ask New Question \] + +
      +" + +regsub -all { +} $query_string "," query_string_for_ctx +regsub -all {,+} $query_string_for_ctx "," query_string_for_ctx + +set selection [ns_db select $db "select msg_id, sort_key, one_line, first_names || ' ' || last_name as name, email +from bboard, users +where bboard.user_id = users.user_id +and contains (indexed_stuff, '\$([DoubleApos $query_string_for_ctx])', 10) > 0 +and topic_id=$topic_id +order by score(10) desc"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + if { [string first "." $sort_key] == -1 } { + # there is no period in the sort key so this is the start of a thread + set thread_start_msg_id $sort_key + } else { + # strip off the stuff before the period + regexp {(.*)\..*} $sort_key match thread_start_msg_id + } + ns_write "
    • $one_line +
      +from $name ($email)\n" +} + +ns_write " +
    + +
    + + +New Search: +
    + +[bboard_footer] +" Index: web/openacs/www/bboard/admin-q-and-a-unanswered.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-q-and-a-unanswered.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-q-and-a-unanswered.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,69 @@ +# admin-q-and-a-unanswered.tcl,v 3.0 2000/02/06 03:33:10 ron Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +# topic required + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + + + +ReturnHeaders + +ns_write " + +$topic Unanswered Questions + + + +

    Unanswered Questions

    + +in the $topic Q&A forum + +
    + +
      +" + +# we want only top level questions that have no answers + +set sql "select msg_id, one_line, sort_key, email, first_names || ' ' || last_name as name, interest_level +from bboard bbd1, users +where topic_id = $topic_id +and bbd1.user_id = users.user_id +and 0 = (select count(*) from bboard bbd2 where bbd2.refers_to = bbd1.msg_id) +and refers_to is null +order by sort_key $q_and_a_sort_order" + +set selection [ns_db select $db $sql] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
    • $one_line +
      +from $name ($email)\n" + if { $q_and_a_use_interest_level_p == "t" } { + if { $interest_level == "" } { set interest_level "NULL" } + ns_write " -- interest level $interest_level" + } +} + +ns_write " + +
    + +[bboard_footer] +" + Index: web/openacs/www/bboard/admin-q-and-a.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-q-and-a.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-q-and-a.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,113 @@ +# admin-q-and-a.tcl,v 3.0 2000/02/06 03:33:11 ron Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +# topic_id required + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + +# the administrator can always post a new question + +set ask_a_question "Post a New Question |" + +if { $policy_statement != "" } { + set about_link "| About" +} else { + set about_link "" +} + +if { [bboard_pls_blade_installed_p] } { + set top_menubar "\[ $ask_a_question +Search | +Unanswered Questions | +New Answers +$about_link +\]" +} else { + set top_menubar "\[ $ask_a_question +Unanswered Questions | +New Answers +$about_link + \]" +} + +set sql "select msg_id, one_line, sort_key, email,first_names || ' ' || last_name as name, interest_level +from bboard, users +where users.user_id = bboard.user_id +and topic = '$QQtopic' +and refers_to is null +order by sort_key $q_and_a_sort_order" + +set sql "select msg_id, one_line, sort_key, email,first_names || ' ' || last_name as name, interest_level +from bboard, users +where users.user_id = bboard.user_id +and topic_id = $topic_id +and refers_to is null +and sysdate()::date - posting_time::date < $q_and_a_new_days +order by sort_key $q_and_a_sort_order" + +set selection [ns_db select $db $sql] + +ReturnHeaders + +ns_write " + +Administer $topic by Question + + + +

    Administer $topic

    + +by question (one of the options from the admin home page for this topic) + +
    + +$top_menubar + +

    New Questions

    + + +
      + +" + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
    • $one_line +
      +from ($name)\n" + if { $q_and_a_use_interest_level_p == "t" } { + if { $interest_level == "" } { set interest_level "NULL" } + ns_write " -- interest level $interest_level" + } + +} + +ns_write " + +
    + +

    Other Groups of Questions

    + + + +" +ns_write " + +[bboard_footer] +" Index: web/openacs/www/bboard/admin-update-expiration-days.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-update-expiration-days.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-update-expiration-days.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,33 @@ +# admin-update-expiration-days.tcl,v 3.0 2000/02/06 03:33:12 ron Exp +set_form_variables +set_form_variables_string_trim_DoubleAposQQ + +# msg_id is the key, expiration_days + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +set topic_id [database_to_tcl_string $db "select topic_id from bboard where msg_id = '$QQmsg_id'"] + + +if {[bboard_get_topic_info] == -1} { + return +} + +if {[bboard_admin_authorization] == -1} { + return +} + + + +# we're authorized + +if { $expiration_days == "" } { set expiration_days "NULL" } + +ns_db dml $db "update bboard set expiration_days = $expiration_days where msg_id = '$QQmsg_id'" + +ns_returnredirect "admin-q-and-a-fetch-msg.tcl?msg_id=$msg_id" Index: web/openacs/www/bboard/admin-update-interest-level.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-update-interest-level.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-update-interest-level.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,29 @@ +# admin-update-interest-level.tcl,v 3.1 2000/02/21 13:16:26 bdolicki Exp +set_form_variables +set_form_variables_string_trim_DoubleAposQQ + +# msg_id is the key, interest_level + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +set topic_id [database_to_tcl_string $db "select distinct topic_id from bboard where msg_id = '$QQmsg_id'"] + + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + +# we're authorized + +ns_db dml $db "update bboard set interest_level = [ns_dbquotevalue $interest_level number] where msg_id = '$QQmsg_id'" + +ns_returnredirect "admin-q-and-a-fetch-msg.tcl?msg_id=$msg_id" Index: web/openacs/www/bboard/admin-update-one-line.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-update-one-line.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-update-one-line.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,26 @@ +# admin-update-one-line.tcl,v 3.0 2000/02/06 03:33:15 ron Exp +set_form_variables +set_form_variables_string_trim_DoubleAposQQ + +# msg_id is the key, one_line + +set db [bboard_db_gethandle] + +set topic_id [database_to_tcl_string $db "select distinct topic_id from bboard where msg_id = '$QQmsg_id'"] + +bboard_get_topic_info + + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + +# we're authorized + +ns_db dml $db "update bboard set one_line = '$QQone_line' where msg_id = '$QQmsg_id'" + +ns_returnredirect "admin-q-and-a-fetch-msg.tcl?msg_id=$msg_id" Index: web/openacs/www/bboard/admin-update-primary-maintainer-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-update-primary-maintainer-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-update-primary-maintainer-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,41 @@ +# admin-update-primary-maintainer-2.tcl,v 3.0 2000/02/06 03:33:16 ron Exp +set_the_usual_form_variables + +# topic_id, user_id_from_search + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + +ns_db dml $db "update bboard_topics set primary_maintainer_id = $user_id_from_search where topic_id = $topic_id" + +ReturnHeaders + +ns_write " + +Updated primary maintainer for $topic + + + +

    Primary maintainer updated

    + +for \"$topic\" + +
    + +New Maintainer: [database_to_tcl_string $db "select first_names || ' ' || last_name || ' ' || '(' || email || ')' +from users +where user_id = $user_id_from_search"] + +[ad_admin_footer] +" + Index: web/openacs/www/bboard/admin-update-primary-maintainer.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-update-primary-maintainer.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-update-primary-maintainer.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,56 @@ +# admin-update-primary-maintainer.tcl,v 3.0 2000/02/06 03:33:17 ron Exp +set_the_usual_form_variables + +# topic, topic_id + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + +ReturnHeaders + +ns_write " + +Change primary maintainer for $topic + + + +

    Change primary maintainer

    + +for \"$topic\" + +
    + +Current Maintainer: [database_to_tcl_string $db "select first_names || ' ' || last_name || ' ' || '(' || email || ')' +from users +where user_id = $primary_maintainer_id"] + +

    + +Search for a new user to be primary administrator of this forum by
    +

    +[export_form_vars topic topic_id] + + + + + + +
    Email address:
    or by
    Last name:
    +
    + +
    +
    + +[ad_admin_footer] +" + Index: web/openacs/www/bboard/admin-update-topics-table.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-update-topics-table.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-update-topics-table.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,151 @@ +# admin-update-topics-table.tcl,v 3.1 2000/02/19 23:38:04 bdolicki Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +if {[bboard_get_topic_info] == -1} { + return +} + +if {[bboard_admin_authorization] == -1} { + return +} + +set selection [ns_db 1row $db "select u.email as maintainer_email, u.first_names || ' ' || u.last_name as maintainer_name +from bboard_topics t, users u +where topic_id=$topic_id +and t.primary_maintainer_id = u.user_id"] + +set_variables_after_query + +# cookie checks out; user is authorized + +set exception_text "" +set exception_count 0 + +if { [info exists maintainer_name] && $maintainer_name == "" } { + append exception_text "
  • You can't have a blank Maintainer Name. The system uses this information to generate part of the user interface" + incr exception_count +} + +if { [info exists maintainer_email] && $maintainer_email == "" } { + append exception_text "
  • You can't have a blank Maintainer Email address. The system uses this information to generate part of the user interface" + incr exception_count +} + +if { $exception_count> 0 } { + if { $exception_count == 1 } { + set problem_string "a problem" + set please_correct "it" + } else { + set problem_string "some problems" + set please_correct "them" + } + ns_return 200 text/html " + +Problem Updating Topic + + +

    Problem Updating Topic

    + +
    + +We had $problem_string updating your topic: + +
      + +$exception_text + +
    + +Please back up using your browser, correct $please_correct, +and resubmit your form. + +

    + +Thank you. + +[bboard_footer] +" + +return 0 + +} + +# we have to treat the textarea stuff specially (some browsers give us a blank line or two) + +#if { [info exists policy_statement] && ![regexp {[A-Za-z]} $policy_statement] } { +# # we have the form variable but there are no alpha characters in it +# ns_set update [ns_conn form] policy_statement "" +#} + +#if { [info exists pre_post_caveat] && ![regexp {[A-Za-z]} $pre_post_caveat] } { + # we have the form variable but there are no alpha characters in it +# ns_set update [ns_conn form] pre_post_caveat "" +#} + + +set sql [util_prepare_update $db bboard_topics "topic_id" $topic_id [ns_conn form]] + + +if [catch {ns_db dml $db $sql} errmsg] { + ns_return 200 text/html " + +Topic Not Updated + + + +

    Topic Not Updated

    + +
    + +The database rejected the update of discussion topic \"$topic\". Here was +the error message: + +
    +$errmsg
+
    + +[bboard_footer]" +return 0 + +} + +# the database insert went OK + +set selection [ns_db 1row $db "select distinct * from bboard_topics where topic_id=$topic_id"] +set_variables_after_query + +ns_return 200 text/html " + +Topic Updated + + + +

    Topic Updated

    + +\"$topic\" updated in +[bboard_system_name] + +
    + +If you've read Philip +Greenspun's book on Web publishing then you'll appreciate the SQL: + +
    +$sql
+
    + +

    + +Remember to link to the user Q&A page from your public pages and bookmark +the +admin page after you return there. + +[bboard_footer]" Index: web/openacs/www/bboard/admin-update-uploads-anticipated.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-update-uploads-anticipated.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-update-uploads-anticipated.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,28 @@ +# admin-update-uploads-anticipated.tcl,v 3.0 2000/02/06 03:33:19 ron Exp +ad_page_variables { + uploads_anticipated + topic_id +} +page_validation { + set topic_id [validate_integer "Topic ID" $topic_id] +} + +# topic, uploads_anticipated + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +set primary_maintainer_id [database_to_tcl_string $db "select primary_maintainer_id from bboard_topics where topic_id = $topic_id"] + +if {[bboard_admin_authorization] == -1} { + return} + +ns_db dml $db "update bboard_topics +set uploads_anticipated = [ns_dbquotevalue $uploads_anticipated] +where topic_id = $topic_id" + +ns_returnredirect "admin-home.tcl?[export_url_vars topic topic_id]" Index: web/openacs/www/bboard/admin-usgeospatial-all.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-usgeospatial-all.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-usgeospatial-all.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,81 @@ +# admin-usgeospatial-all.tcl,v 3.0 2000/02/06 03:33:23 ron Exp +set_the_usual_form_variables + +# topic required + +if ![msie_p] { + set target_window "target=admin_bboard_window" +} else { + set target_window "" +} + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + + +set sql "select bboard.*, facility, email, first_names || ' ' || last_name as name, interest_level +from bboard, users, rel_search_fac +where bboard.user_id = users.user_id +and topic_id = $topic_id +and refers_to is null +and bboard.tri_id = rel_search_fac.tri_id(+) +order by sort_key $q_and_a_sort_order" + +set selection [ns_db select $db $sql] + +ReturnHeaders + +ns_write " + +Administer $topic by Question + + + +

    Administer $topic

    + +by question" + +if { $backlink != "" || $backlink_title != "" } { + + ns_write " associated with +$backlink_title." + +} + +ns_write " + +
    + +
      + +" + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
    • $one_line ($epa_region : $usps_abbrev : $fips_county_code : $tri_id : $facility) +
      +from $name ($email)\n" + if { $q_and_a_use_interest_level_p == "t" } { + if { $interest_level == "" } { set interest_level "NULL" } + ns_write " -- interest level $interest_level" + } + +} + +ns_write " + +
    + +[bboard_footer] +" Index: web/openacs/www/bboard/admin-usgeospatial-by-region.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-usgeospatial-by-region.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-usgeospatial-by-region.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,64 @@ +# admin-usgeospatial-by-region.tcl,v 3.0 2000/02/06 03:33:24 ron Exp +set_the_usual_form_variables + +# topic required + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +bboard_get_topic_info + +ReturnHeaders + +ns_write "[bboard_header "Pick a Region"] + +

    Pick a region

    + +for the $topic forum in Discussion Forums section of +[ad_system_name] + +
    +" + +set region_text "
      \n" +set selection [ns_db select $db "select epa_region, usps_abbrev, description +from bboard_epa_regions +order by epa_region, usps_abbrev"] + + +# Construct the string to display at the bottom for "Ten Geographic Regions" +# as "region_text". +# Also set the region descriptions as region{n}_desc. + +# We do this up here instead of writing everything out immediately so we only +# have to go to the database once for this information. + +set last_region "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $epa_region != $last_region } { + if { ![empty_string_p $last_region] } { + append region_text ")\n" + } + set last_region $epa_region + set region${epa_region}_desc $description + set region${epa_region}_url "usgeospatial-2.tcl?[export_url_vars topic epa_region]" + append region_text "
    • Region $epa_region: $description (" + } + append region_text "$usps_abbrev " +} +append region_text "
    " + + +ns_write " +

    Ten Geographic Regions

    +$region_text +" + +ns_write " +[bboard_footer] +" Index: web/openacs/www/bboard/admin-usgeospatial-new-messages.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-usgeospatial-new-messages.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-usgeospatial-new-messages.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,71 @@ +# admin-usgeospatial-new-messages.tcl,v 3.0 2000/02/06 03:33:26 ron Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +# topic required + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + +ReturnHeaders + +ns_write " + +$topic Recent Postings + + + +

    Recent Postings

    + +in the $topic Q&A forum (sorted by time rather than by thread) + +

    + +(covers last $q_and_a_new_days days) + +

    + + +
      +" + +set sql "select bboard.*, facility, email, first_names || ' ' || last_name as name, originating_ip, interest_level, posting_time, substr(sort_key,1,6) as root_msg_id +from bboard, users, rel_search_fac +where bboard.user_id = users.user_id +and topic = $topic_id +and sysdate()::date - posting_time::date < $q_and_a_new_days +and bboard.tri_id = rel_search_fac.tri_id(+) +order by sort_key desc" + +set selection [ns_db select $db $sql] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + if { $originating_ip == "" } { + set ip_stuff "" + } else { + set ip_stuff "$originating_ip" + } + ns_write "
    • $posting_time: $one_line ($epa_region : $usps_abbrev : $fips_county_code : $tri_id : $facility) from $name +($email) +$ip_stuff" + +} + +ns_write " + +
    + +[bboard_footer] +" Index: web/openacs/www/bboard/admin-usgeospatial-one-region.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-usgeospatial-one-region.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-usgeospatial-one-region.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,82 @@ +# admin-usgeospatial-one-region.tcl,v 3.0 2000/02/06 03:33:27 ron Exp +set_the_usual_form_variables + +# topic required + +if ![msie_p] { + set target_window "target=admin_bboard_window" +} else { + set target_window "" +} + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + + +set sql "select bboard.*, facility, email, first_names || ' ' || last_name as name, interest_level +from bboard, users, rel_search_fac +where bboard.user_id = users.user_id +and epa_region = '$QQepa_region' +and topic_id = $topic_id +and refers_to is null +and bboard.tri_id = rel_search_fac.tri_id(+) +order by sort_key $q_and_a_sort_order" + +set selection [ns_db select $db $sql] + +ReturnHeaders + +ns_write " + +Administer $topic by Region + + + +

    Administer $topic

    + +by region" + +if { $backlink != "" || $backlink_title != "" } { + + ns_write " associated with +    $backlink_title." + +} + +ns_write " + +
    + +
      + +" + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + ns_write "
    • $one_line ($epa_region : $usps_abbrev : $fips_county_code : $tri_id : $facility) +
      +from $name ($email)\n" + if { $q_and_a_use_interest_level_p == "t" } { + if { $interest_level == "" } { set interest_level "NULL" } + ns_write " -- interest level $interest_level" + } + +} + +ns_write " + +
    + +[bboard_footer] +" Index: web/openacs/www/bboard/admin-usgeospatial-pick-a-region.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-usgeospatial-pick-a-region.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-usgeospatial-pick-a-region.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,59 @@ +# admin-usgeospatial-pick-a-region.tcl,v 3.0 2000/02/06 03:33:28 ron Exp +set_the_usual_form_variables + +# topic required + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +bboard_get_topic_info + +ReturnHeaders + +ns_write "[bboard_header "Pick a Region"] + +

    Pick a region

    + +for the $topic forum in Discussion Forums section of +[ad_system_name] + +
    +" + +set region_text "
      \n" +set selection [ns_db select $db "select epa_region, usps_abbrev, description +from bboard_epa_regions +order by epa_region, usps_abbrev"] + + +# Construct the string to display at the bottom for "Ten Geographic Regions" +# as "region_text". + +# We do this up here instead of writing everything out immediately so we only +# have to go to the database once for this information. + +set last_region "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $epa_region != $last_region } { + if { ![empty_string_p $last_region] } { + append region_text ")\n" + } + set last_region $epa_region + append region_text "
    • Region $epa_region: $description (" + } + append region_text "$usps_abbrev " +} +append region_text "
    " + + +ns_write " +

    Ten Geographic Regions

    +$region_text +" + +ns_write "[bboard_footer]" Index: web/openacs/www/bboard/admin-usgeospatial.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-usgeospatial.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-usgeospatial.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,112 @@ +# admin-usgeospatial.tcl,v 3.0 2000/02/06 03:33:30 ron Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +# topic required + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + + + + + + +# the administrator can always post a new question + +set ask_a_question "Post a New Message |" + +if { $policy_statement != "" } { + set about_link "| About" +} else { + set about_link "" +} + +if { [bboard_pls_blade_installed_p] } { + set top_menubar "\[ $ask_a_question +Search +$about_link +\]" +} else { + set top_menubar "\[ $ask_a_question +$about_link + \]" +} + +set sql "select bboard.*, facility, users.email, users.first_names || ' ' || users.last_name as name, interest_level +from bboard, users, rel_search_fac +where users.user_id = bboard.user_id +and topic_id = $topic_id +and refers_to is null +and posting_time > (sysdate() - $q_and_a_new_days) +and bboard.tri_id = rel_search_fac.tri_id(+) +order by sort_key $q_and_a_sort_order" + +set selection [ns_db select $db $sql] + +ReturnHeaders + +ns_write " + +Administer $topic by Question + + + +

    Administer $topic

    + +by question (one of the options from the admin home page for this topic) + +
    + +$top_menubar + +

    New Threads

    + + +
      + +" + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + + ns_write "
    • $one_line ($epa_region : $usps_abbrev : $fips_county_code : $tri_id : $facility) +
      +from ($name)\n" + if { $q_and_a_use_interest_level_p == "t" } { + if { $interest_level == "" } { set interest_level "NULL" } + ns_write " -- interest level $interest_level" + } + +} + +ns_write " + +
    + +

    Other Groups of Posts

    + + + +" +ns_write " + +[bboard_footer] +" Index: web/openacs/www/bboard/admin-view-alerts.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-view-alerts.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-view-alerts.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,91 @@ +# admin-view-alerts.tcl,v 3.0 2000/02/06 03:33:31 ron Exp +set_form_variables +set_form_variables_string_trim_DoubleAposQQ + +# topic + + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return +} + + +# cookie checks out; user is authorized + +ReturnHeaders + +set keyword_header "" +if { [bboard_pls_blade_installed_p] == 1 } { + set keyword_header "Keywords" +} + +ns_write " +Alerts for $topic + + + +

    Alerts for $topic

    + +in [bboard_system_name] + +
    + + +$keyword_header + +" + + +set selection [ns_db select $db "select bea.*, bea.rowid, +valid_p = 'f' as not_valid_p, +upper(email) as upper_email, email +from bboard_email_alerts bea, users +where bea.user_id = users.user_id +and topic_id = $topic_id +order by not_valid_p, upper_email"] + +set seen_any_enabled_p 0 +set seen_disabled_p 0 + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + if { $valid_p == "f" } { + # we're into the disabled section + if { $seen_any_enabled_p && !$seen_disabled_p } { + if { [bboard_pls_blade_installed_p] == 1 } { + ns_write "\n" + } else { + ns_write "\n" + } + set seen_disabled_p 1 + } + set action "Re-enable" + } else { + # alert is enabled + set seen_any_enabled_p 1 + set action "Disable" + } + if { [bboard_pls_blade_installed_p] == 1 } { + ns_write "\n" + } else { + ns_write "\n" + } + +} + +ns_write " + +
    EmailActionFrequency
    -- Disabled Alerts --
    -- Disabled Alerts --
    $email$action$frequency\"$keywords\"
    $email$action$frequency
    + +[bboard_footer] +" Index: web/openacs/www/bboard/admin-view-one-email.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-view-one-email.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-view-one-email.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,86 @@ +# admin-view-one-email.tcl,v 3.0 2000/02/06 03:33:33 ron Exp +# look at the postings for one email address (i.e., one user) + +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +# topic, email + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + + +# cookie checks out; user is authorized + + + +ReturnHeaders + +ns_write " + +Postings by $email in the $topic forum + + + +

    Postings by $email in the $topic forum

    + +(main admin page) + +
    + +
    + + + +
      + +" + +set selection [ns_db select $db "select one_line, sort_key, msg_id, posting_time as posting_date +from bboard, users +where bboard.user_id = users.user_id +and topic_id=$topic_id +and email = '$QQemail' +order by sort_key desc"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { [string first "." $sort_key] == -1 } { + # there is no period in the sort key so this is the start of a thread + set thread_start_msg_id $sort_key + } else { + # strip off the stuff before the period + regexp {(.*)\..*} $sort_key match thread_start_msg_id + } + ns_write " + + +
      +
    • $one_line ($posting_date) +
      		•  + +
      +" +} + +ns_write "
    + +
    + + +
    + +[bboard_footer] +" Index: web/openacs/www/bboard/admin-view-one-ip.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/admin-view-one-ip.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/admin-view-one-ip.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,100 @@ +# admin-view-one-ip.tcl,v 3.0 2000/02/06 03:33:34 ron Exp +# look at the postings for one email address (i.e., one user) + +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +# topic, originating_ip + +set db [bboard_db_gethandle] + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return} + + + + + +# cookie checks out; user is authorized + + + + +ReturnHeaders + +ns_write " + +Postings from $originating_ip in the $topic forum + + + +

    Postings from $originating_ip

    + +in the $topic forum + +
    + +Doing a reverse DNS now: $originating_ip maps to ... + +" + +ns_write "[ns_hostbyaddr $originating_ip] + +

    + +(note: if you just get the number again, that means the hostname could +not be found.) + +

    + +

    + + + + +
      + +" + +set selection [ns_db select $db "select one_line, sort_key, msg_id, to_char(posting_time,'YYYY-MM-DD HH24:MI:SS') as posting_date, email, first_names || ' ' || last_name as name +from bboard, users +where bboard.user_id = users.user_id +and topic_id = $topic_id +and originating_ip = '$QQoriginating_ip' +order by sort_key desc"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { [string first "." $sort_key] == -1 } { + # there is no period in the sort key so this is the start of a thread + set thread_start_msg_id $sort_key + } else { + # strip off the stuff before the period + regexp {(.*)\..*} $sort_key match thread_start_msg_id + } + ns_write " + + +
      +
    • $name ($email) on $posting_date: $one_line +
      		•  + +
      +" +} + +ns_write "
    + +
    + + +
    + + +[bboard_footer] + +" Index: web/openacs/www/bboard/alert-disable.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/alert-disable.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/alert-disable.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,39 @@ +# alert-disable.tcl,v 3.0 2000/02/06 03:33:35 ron Exp +ad_maybe_redirect_for_registration +set user_id [ad_get_user_id] + +set_the_usual_form_variables + +# rowid + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if [catch {ns_db dml $db "update bboard_email_alerts +set valid_p = 'f' +where oid = '$QQrowid' and user_id=$user_id"} errmsg] { + ad_return_error "Error Disabling Alert" "Here's what the database barfed up: + +
    +$errmsg +
    +" +} else { + # success + ns_return 200 text/html "[bboard_header "Success"] + +

    Success!

    + +disabling your email alert in [bboard_system_name] + + +
    + +There isn't really a whole lot more to say... + +[bboard_footer]" +} Index: web/openacs/www/bboard/alert-reenable.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/alert-reenable.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/alert-reenable.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,38 @@ +# alert-reenable.tcl,v 3.0 2000/02/06 03:33:36 ron Exp +ad_maybe_redirect_for_registration +set user_id [ad_get_user_id] + +set_the_usual_form_variables + +# rowid + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if [catch {ns_db dml $db "update bboard_email_alerts set valid_p = 't' where oid = '$QQrowid' and user_id=$user_id"} errmsg] { + ad_return_error "Error Re-Enabling Alert" "Here's what the database barfed up: + +
    +$errmsg +
    +" +} else { + # success + ns_return 200 text/html "[bboard_header "Success"] + +

    Success!

    + +re-enabling your email alert in [bboard_system_name] + + +
    + +There isn't really a whole lot more to say... + + +[bboard_footer]" +} Index: web/openacs/www/bboard/big-image.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/big-image.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/big-image.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,62 @@ +# big-image.tcl,v 3.0 2000/02/06 03:33:37 ron Exp +ad_page_variables { + bboard_upload_id +} +page_validation { + set bboard_upload_id [validate_integer "BBoard Upload ID" $bboard_upload_id] +} + +# bboard_upload_id + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select buf.msg_id, caption, original_width, original_height, bboard.sort_key +from bboard_uploaded_files buf, bboard +where bboard.msg_id = buf.msg_id +and bboard_upload_id=$bboard_upload_id"] + +if { $selection == "" } { + ad_return_error "Couldn't find image" "Couldn't find image. Perhaps it has been deleted by the moderator?" + return +} + +set_variables_after_query + +if { [string first "." $sort_key] == -1 } { + # there is no period in the sort key so this is the start of a thread + set thread_start_msg_id $sort_key +} else { + # strip off the stuff before the period + regexp {(.*)\..*} $sort_key match thread_start_msg_id +} + +set selection [ns_db 1row $db "select topic_id, topic, presentation_type +from bboard_topics +where topic_id = (select topic_id from bboard where msg_id = '$msg_id')"] +set_variables_after_query + +ns_db releasehandle $db + +if { ![empty_string_p $original_width] && ![empty_string_p $original_height] } { + set extra_img_tags "width=$original_width height=$original_height" +} else { + set extra_img_tags "" +} + +ns_return 200 text/html "[bboard_header "One BBoard Photo"] + +

    $caption

    + +[ad_context_bar_ws_or_index [list "index.tcl" [bboard_system_name]] [list [bboard_raw_backlink $topic_id $topic $presentation_type 0] $topic] [list [bboard_msg_url $presentation_type $thread_start_msg_id $topic_id] "One Thread"] "Big Image"] + +
    + +
    + +

    $caption

    +
    + + + + +" Index: web/openacs/www/bboard/cc.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/cc.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/cc.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,182 @@ +# cc.tcl,v 3.0 2000/02/06 03:33:21 ron Exp +ad_page_variables { + key + topic_id +} +page_validation { + set topic_id [validate_integer "Topic ID" $topic_id] +} + +# topic, topic_id, key (category) + +set category $key +set QQcategory $QQkey + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if [catch {set selection [ns_db 1row $db "select distinct * from bboard_topics where topic_id = $topic_id"]} errmsg] { + bboard_return_cannot_find_topic_page + return +} +# we found subject_line_suffix at least +set_variables_after_query + +ReturnHeaders + +ns_write " + +$category threads in $topic + + + +

    $category Threads

    + +in the $topic question and answer forum + +
    + + +" + +if { $category != "uncategorized" } { + set category_clause "and category = '$QQcategory'" +} else { + # **** NULL/'' problem, needs " or category = '' " + set category_clause "and (category is NULL or category = 'Don''t Know')" +} + + +set sql "select msg_id, one_line, sort_key, email, first_names || ' ' || last_name as name, bboard_uninteresting_p(interest_level) as uninteresting_p +from bboard, users +where topic_id = $topic_id +$category_clause +and refers_to is null +and users.user_id = bboard.user_id +order by uninteresting_p, sort_key $q_and_a_sort_order" + +set selection [ns_db select $db $sql] + +ns_write "
      \n" + +set uninteresting_header_written 0 +set counter 0 +while {[ns_db getrow $db $selection]} { + set_variables_after_query + incr counter + if { $uninteresting_p == "t" && $uninteresting_header_written == 0 } { + set uninteresting_header_written 1 + ns_write "
    +

    Uninteresting Threads

    + +(or at least the forum moderator thought they would only be of interest to rare individuals; truly worthless threads get deleted altogether) +
      +" + } + set display_string "$one_line" + if { $subject_line_suffix == "name" && $name != "" } { + append display_string " ($name)" + } elseif { $subject_line_suffix == "email" && $email != "" } { + append display_string " ($email)" + } + ns_write "
    • $display_string\n" + +} + +ns_write " + +
    + +" + +set headers [ns_conn headers] +if { $headers == "" || ![regexp {LusenetEmail=([^;]*).*$} [ns_set get $headers Cookie] {} LusenetEmail] } { + set default_email "" +} else { + set default_email $LusenetEmail +} +if { $headers == "" || ![regexp {LusenetName=([^;]*).*$} [ns_set get $headers Cookie] {} LusenetName] } { + set default_name "" +} else { + set default_name $LusenetName +} + +if { $counter == 0 } { + ns_write "There hasn't been any discussion yet. + +

    You can be the one to start the discussion

    + +(of $key) + +" } else { + + ns_write "

    You can ask a new question

    + +(about $key) + +" +} + +ns_write "

    + +

    + + + +[export_form_vars topic topic_id] + + + + + + + + + + + + +
    Your Email Address
    Your Full Name
    Subject Line
    (summary of question)
    Notify Me of Responses
    (via email) +    		 Yes + No + +
    Message
    (full question)    		enter in box below, then press submit +
    + + + + + +

    + +

    + + + + +
    + +
    +" + + + +ns_write " + +[bboard_footer] +" + +# *** here we want an [ns_conn close] but it didn't make 2.2b2 + +# let's see if we need to put this into the categories table + +if { $counter == 0 && [database_to_tcl_string $db "select count(*) from bboard_q_and_a_categories where topic_id = $topic_id and category = '$QQkey'"] == 0 } { + # catch to trap the primary key complaint from Oracle + catch { ns_db dml $db "insert into bboard_q_and_a_categories (topic_id, category) +values +($topic_id,'$QQkey')" } +} Index: web/openacs/www/bboard/company-search.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/company-search.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/company-search.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,105 @@ +# company-search.tcl,v 3.0 2000/02/06 03:33:38 ron Exp +set_the_usual_form_variables + +# query_string + +# poke around the company synonym table + +set db [ns_db gethandle] + +# if { ![get_personalization_info "*"] } { +# # we don't know who this person is +# set prefer_text_only_p [score_get_user_graphics_default] +# } +set prefer_text_only_p t + +ReturnHeaders + +ns_write "[score_header_value "Search Results for: \"$query_string\""]\n" + +if {$prefer_text_only_p == "t"} { + ns_write "

    Search Results for: \"$query_string\"

    + +in [score_system_name] + +
    + +
      +" +} + +# reuse score_chem_name_match_score from the chemicals search, as it +# seems like a useful metric +set selection [ns_db select $db "SELECT distinct + f.tri_id, f.facility, f.city, f.st, p.edf_parent, + score_chem_name_match_score(upper(f.facility), upper('$QQquery_string')) as match_score +FROM + rel_edf_parent p, rel_search_fac f, bboard +WHERE + f.tri_id = p.tri_id(+) + and (upper(f.facility) like upper('%$QQquery_string%') + or upper(p.edf_parent) like upper('%$QQquery_string%')) + and f.tri_id = bboard.tri_id +ORDER BY + score_chem_name_match_score(upper(f.facility), upper('$QQquery_string')), + score_chem_name_match_score(upper(p.edf_parent), upper('$QQquery_string'))"] + + +set count 0 +set last_match_score "" +set first_iteration_p 1 +set tris_found [list] +while { [ns_db getrow $db $selection] } { + set_variables_after_query + incr count + lappend tris_found $tri_id + if $first_iteration_p { + ns_write "

      Messages have been posted about the following facilities

      \n" + } + if { $last_match_score != $match_score && !$first_iteration_p } { + ns_write "\n\n

      \n\n" + } + ns_write "

    • $facility ($city, $st)" + set last_match_score $match_score + set first_iteration_p 0 +} + +if { $count == 0 } { + ns_write "Sorry, no one has posted any messages about facilities matching your search.\n" + set already_found_exclusion "" +} else { + set already_found_exclusion "and f.tri_id not in ('[join $tris_found "','"]')" +} + +# let's try searching for facilities period +set selection [ns_db select $db "SELECT distinct + f.tri_id, f.facility, f.city, f.st, p.edf_parent, + score_chem_name_match_score(upper(f.facility), upper('$QQquery_string')) as match_score +FROM + rel_edf_parent p, rel_search_fac f +WHERE + f.tri_id = p.tri_id(+) + $already_found_exclusion + and (upper(f.facility) like upper('$QQquery_string%') + or upper(f.facility) like upper('% $QQquery_string%') + or upper(p.edf_parent) like upper('$QQquery_string%') + or upper(p.edf_parent) like upper('% $QQquery_string%')) +ORDER BY + score_chem_name_match_score(upper(f.facility), upper('$QQquery_string')), + score_chem_name_match_score(upper(p.edf_parent), upper('$QQquery_string')), + st, city"] + while { [ns_db getrow $db $selection] } { + set_variables_after_query + append facility_matches "
    • $facility ($city, $st)\n" + } + if [info exists facility_matches] { + ns_write "

      Start a discussion on one of the following facilities

      +(go to the Take Action section of a facility report and join an on-line discussion) + +

      +$facility_matches" + } + +if {$prefer_text_only_p == "t"} { + ns_write "

    [score_footer_value]" +} Index: web/openacs/www/bboard/confirm.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/confirm.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/confirm.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,203 @@ +# confirm.tcl,v 3.0 2000/02/06 03:33:40 ron Exp +# confirm.tcl +# +# display a confirmation page for new news postings +# philg@arsdigita.com + +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set user_id [ad_verify_and_get_user_id] +if { $user_id == 0 } { + ns_returnredirect "/register/index.tcl" + return +} + +set_the_usual_form_variables + +set db [ns_db gethandle] +if {[bboard_get_topic_info] == -1} { + return +} + +# message, one_line, notify, html_p +# topic, topic_id are hidden vars +# q_and_a_p is an optional variable, if set to "t" then this is from +# the Q&A forum version +# refers_to is "NEW" or a msg_id (six characters) + +set exception_text "" +set exception_count 0 + +if { ![info exists one_line] || [empty_string_p $one_line] } { + append exception_text "
  • You need to type a subject line\n" + incr exception_count +} + +if { ![info exists message] || [empty_string_p $message] } { + append exception_text "
  • You need to type a message; there is no \"Man/woman of Few Words Award\" here. \n" + incr exception_count +} + + +if {$exception_count > 0} { + ad_return_complaint $exception_count $exception_text + return +} + +set presentation_type [database_to_tcl_string $db "select presentation_type from bboard_topics where topic_id = $topic_id"] + +ReturnHeaders + +ns_write "[bboard_header "Confirm"] + +

    Confirm

    + +[ad_context_bar_ws_or_index [list "index.tcl" [bboard_system_name]] [list [bboard_raw_backlink $topic_id $topic $presentation_type 0] $topic] "Confirm Posting"] + +
    + +
    +Subject: $one_line +
    +
    + +" + +if { [info exists html_p] && $html_p == "t" } { + ns_write "$message +
    + +Note: if the story has lost all of its paragraph breaks then you +probably should have selected \"Plain Text\" rather than HTML. Use +your browser's Back button to return to the submission form. +" + +} else { + ns_write "[util_convert_plaintext_to_html $message] + + +Note: if the story has a bunch of visible HTML tags then you probably +should have selected \"HTML\" rather than \"Plain Text\". Use your +browser's Back button to return to the submission form. " +} + + +if {![bboard_file_uploading_enabled_p] || [empty_string_p $uploads_anticipated]} { + set extra_form_tag "" + set extra_form_contents "" +} elseif { [bboard_file_uploading_enabled_p] && $uploads_anticipated == "images" } { + set extra_form_tag "enctype=multipart/form-data" + set extra_form_contents " +
    + + + + + + + + +
    You may upload an image with this posting.
    +Filename + + +
    +(on your local hard drive) +
    +Caption + +
      + +
    +Note: GIF and JPEG images are the only ones that can be displayed by most browsers. So if the file you're uploading doesn't end in .jpg, .jpeg, or .gif it probably won't be viewable by most users. + +
    +
    +
    +

    " +} elseif { [bboard_file_uploading_enabled_p] && $uploads_anticipated == "files" } { + set extra_form_tag "enctype=multipart/form-data" + set extra_form_contents " + +

    + +You may upload a file with this posting: + + + +

    " +} elseif { [bboard_file_uploading_enabled_p] && $uploads_anticipated == "images_or_files" } { + set extra_form_tag "enctype=multipart/form-data" + set extra_form_contents " +

    + + + + +
    +You may upload a file or image with this posting: +
    +if this is an image, you can indicate +that by typing in a caption: +

    +Note: GIF and JPEG images are the only ones that can be displayed by most browsers. So if the file you're uploading doesn't end in .jpg, .jpeg, or .gif it probably won't be viewable by most users. + +

    +
    +

    " +} else { + ns_write "Oops! We're confronted with uploads_anticipated of \"$uploads_anticipated\". + +

    + +We don't know what to do with this. +[bboard_footer] +" + return +} + +# we will pass the entire form forward to the next +# page. THerefore, we must delete urgent_p from ns_conn form +# so it doesn't get sent twice + +ns_set delkey [ns_conn form] urgent_p +if ![info exists urgent_p] { + set urgent_p "f" +} + +ns_write " + +

    +[export_entire_form] +$extra_form_contents +" + +if { $refers_to == "NEW" && [ad_parameter UrgentMessageEnabledP "bboard" 0] } { + ns_write " +

    +You can elect to mark this message urgent. For + [ad_parameter DaysConsideredUrgent bboard] +days after posting, your question will be put in front of other users. + +

    + +Is this really urgent? + +" + +} else { + ns_write "[export_form_vars urgent_p]\n" +} + +ns_write "

    + +
    +
    + + + +" Index: web/openacs/www/bboard/contributions.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/contributions.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/contributions.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,67 @@ +# contributions.tcl,v 3.0 2000/02/06 03:33:41 ron Exp +ad_page_variables { + user_id +} +page_validation { + set user_id [validate_integer "User ID" $user_id] +} + +set current_user_id [ad_verify_and_get_user_id] + +# user_id + +# displays the contibutions of this member to the bboard + +set db [bboard_db_gethandle] + +set selection [ns_db 0or1row $db "select first_names, last_name from users where user_id = $user_id"] +if { $selection == "" } { + ns_return 200 text/html "can't figure this user in the database" + return +} + +set_variables_after_query + +ReturnHeaders + +ns_write "[bboard_header "$first_names $last_name"] + +

    $first_names $last_name

    + +as a contributor to the discussion forums in +[ad_system_name] +
    + +
      +" + +set selection [ns_db select $db "select one_line, msg_id, posting_time, sort_key, bboard_topics.topic, bboard_topics.topic_id, presentation_type +from bboard, bboard_topics +where bboard.user_id = $user_id +and bboard.topic_id = bboard_topics.topic_id +and bboard_user_can_view_topic_p($current_user_id,bboard.topic_id)='t' +order by posting_time asc"] + +set n_rows_found 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + incr n_rows_found + if { [string first "." $sort_key] == -1 } { + # there is no period in the sort key so this is the start of a thread + set thread_start_msg_id $sort_key + } else { + # strip off the stuff before the period + regexp {(.*)\..*} $sort_key match thread_start_msg_id + } + ns_write "
    • [util_AnsiDatetoPrettyDate $posting_time]: $one_line\n" +} + +if { $n_rows_found == 0 } { + ns_write "no contributions found" +} + +ns_write " +
    + +[bboard_footer] +" Index: web/openacs/www/bboard/custom-q-and-a-fetch.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/custom-q-and-a-fetch.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/custom-q-and-a-fetch.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,198 @@ +# custom-q-and-a-fetch.tcl,v 3.0 2000/02/06 03:33:43 ron Exp +set_the_usual_form_variables + +# key, topic, topic_id + +# custom_sort_key is defined to be unique + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +set selection [ns_db 0or1row $db "select to_char(posting_time,'Month DD, YYYY') as posting_date,bboard.*, users.user_id as poster_id, users.first_names || ' ' || users.last_name as name +from bboard, users +where bboard.user_id = users.user_id +and msg_id = '$QQmsg_id'"] + +if { $selection == "" } { + # *** this needs to be patched to look at ad_get_user_id + # there ain't no message like this + if [catch {set selection [ns_db 1row $db "select distinct * from bboard_topics where topic_id=$topic_id"]} errmsg] { + bboard_return_cannot_find_topic_page + return + } + set_variables_after_query + set headers [ns_conn headers] + if { $headers == "" || ![regexp {LusenetEmail=([^;]*).*$} [ns_set get $headers Cookie] {} LusenetEmail] } { + set default_email "" + } else { + set default_email $LusenetEmail + } + if { $headers == "" || ![regexp {LusenetName=([^;]*).*$} [ns_set get $headers Cookie] {} LusenetName] } { + set default_name "" + } else { + set default_name $LusenetName + } + + ReturnHeaders + ns_write "[bboard_header "No Discussion Yet"] + +

    No Discussion Yet

    + +of $key in the $topic Q&A Forum + +
    + +$custom_sort_not_found_text + +
    + +

    You can be the one to start the discussion

    + +
    + + + + + + + + + + + + + + + +" + +# think about writing a category SELECT + + if { $q_and_a_categorized_p == "t" && $q_and_a_solicit_category_p == "t" } { + set categories [database_to_tcl_list $db "select distinct category, upper(category) from bboard_q_and_a_categories where topic_id = $topic_id order by 2"] + set html_select "" + ns_write "\n" +} + +ns_write " + + + +
    Your Email Address
    Your Full Name
    Subject Line
    (summary of question)
    Category\n$html_select\n(this helps build the FAQ archives)
    Notify Me of Responses
    (via email) +    		 Yes + No + +
    Message
    (full question)    		enter in textarea below, then press submit +
    + + + + + +

    + +

    + + + + +
    + +
    + + +
    + +
    $maintainer_email
    + + + +" + return +} + +set_variables_after_query +set this_msg_id $msg_id +set this_one_line $one_line + +# now variables like $message and $topic are defined + +if [catch {set selection [ns_db 1row $db "select distinct * from bboard_topics where topic=$topic_id"]} errmsg] { + bboard_return_cannot_find_topic_page + return +} +set_variables_after_query + + +set contributed_by "Asked by $name ($email) on [util_IllustraDatetoPrettyDate $posting_date]." + +ReturnHeaders + +ns_write " + +$one_line + + + +

    $one_line

    + +asked in the $topic Q&A Forum + +
    + +
    +$message +
    + +$contributed_by +" + + +set selection [ns_db select $db "select email <> '$maintainer_email' as not_maintainer_p, to_char(posting_time,'YYYY-MM-DD') as posting_date,bboard.* +from bboard +where root_msg_id = '$QQmsg_id' +and msg_id <> '$QQmsg_id' +order by not_maintainer_p, sort_key"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + if { $email == "" } { + set contributed_by "anonymously answered on [util_IllustraDatetoPrettyDate $posting_date]." + } else { + set contributed_by "Answered by $name ($email) on [util_IllustraDatetoPrettyDate $posting_date]." +} + set this_response "" + if { $one_line != $this_one_line && $one_line != "Response to $this_one_line" } { + # new subject + append this_response "

    $one_line

    \n" + } + append this_response "
    +$message +
    +$contributed_by" + lappend responses $this_response +} + +if { [info exists responses] } { + # there were some + ns_write "

    Answers

    +[join $responses "
    "] +" +} + + +ns_write " + +
    +Contribute an answer to \"$this_one_line\" + +[bboard_footer] +" + Index: web/openacs/www/bboard/default-main.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/default-main.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/default-main.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,83 @@ +# default-main.tcl,v 3.1 2000/02/23 01:49:39 bdolicki Exp +set_the_usual_form_variables + +# topic + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return +} + +# we found the data we needed +set_variables_after_query + +ReturnHeaders + +ns_write " + +Default + + + +" + +if { $users_can_initiate_threads_p != "f" } { + ns_write " +\[ +Post New Message +\] + +

    " +} + +ns_write " + +

    $topic

    + +Click on a subject line above to see the full message that corresponds +to it. + +" + +if { [bboard_pls_blade_installed_p] } { + + ns_write "
    + + +Full Text Search: +
    " +} + + +set user_id [ad_verify_and_get_user_id] + +switch $user_id { + 0 { set administrator_p 0 } + default { + if { $user_id == $primary_maintainer_id } { + set administrator_p 1 + } else { + set administrator_p [bboard_user_is_admin_for_topic $db $user_id $topic_id] + } + } +} + +if { $administrator_p == 0 } { + ns_write "This forum is maintained by $maintainer_name. " +} else { + ns_write "Administrator page" +} + +ns_write "

    If you want to follow this discussion by email, + +click here to add an alert. + + +[bboard_footer] +" Index: web/openacs/www/bboard/delete-msg.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/delete-msg.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/delete-msg.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,165 @@ +# delete-msg.tcl,v 3.1 2000/02/14 09:00:46 bdolicki Exp +ad_page_variables { + {msg_id} +} +page_validation { + bboard_validate_msg_id $msg_id +} + +# msg_id is the key + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +# DRB: aD broke this by removing bboard.notify, probably didn't notice because +# the probably didn't do a DROP COLUMN on the bboard table. Also, "notify" +# is a PG keyword so previously I'd used "notify_p" anyway. +# SCC: notfiy is from a different table in 3.2.0. + +set selection [ns_db 1row $db "select bboard_topics.topic, bboard.one_line, bboard.message, bboard.html_p, bboard.sort_key, bboard.user_id as miscreant_user_id, users.email, bboard.topic_id +from bboard, users, bboard_topics +where bboard.user_id = users.user_id +and bboard_topics.topic_id = bboard.topic_id +and msg_id = '$msg_id'"] +set_variables_after_query + +set thread_id [string range $sort_key 0 5] + +set notify [database_to_tcl_string $db "select CASE WHEN count(*) = 0 then 'f' else 't' END from bboard_thread_email_alerts where thread_id='$thread_id'"] + +if { [bboard_get_topic_info] == -1 } { + return +} + + +set admin_user_id [ad_verify_and_get_user_id] + +if {$admin_user_id == 0} { + ns_returnredirect /register.tcl?return_url=[ns_urlencode "[bboard_hardwired_url_stub]admin-q-and-a-fetch-msg.tcl?msg_id=$msg_id"] + return +} + +if { ![bboard_user_is_admin_for_topic $db $admin_user_id $topic_id] } { + ad_return_error "Unauthorized" "We think you aren't authorized to delete messages" + return +} + +set authenticated_user_email_address [database_to_tcl_string $db "select email from users where user_id = $admin_user_id"] + + +set dependent_key_form [dependent_sort_key_form $sort_key] + +set dependent_ids [database_to_tcl_list $db "select msg_id from bboard where sort_key like '$dependent_key_form'"] + +set n_dependents [llength $dependent_ids] + +set deletion_list [lappend dependent_ids $msg_id] + + + +if { $notify == "f" } { + set notify_warning "

    +Warning: this user has turned off notification; +he or she might not have been emailed any responses. +
    + +

    " +} else { + set notify_warning "" +} + +if [ad_parameter EnabledP "member-value"] { + # we're doing the member value thing, but first we have to figure + # out if this was a top-level question or an answer + if { [bboard_compute_msg_level $sort_key] == 0 } { + # a question + set duplicate_wad [mv_create_user_charge $miscreant_user_id $admin_user_id "question_dupe" $msg_id [ad_parameter QuestionDupeRate "member-value"]] + set off_topic_wad [mv_create_user_charge $miscreant_user_id $admin_user_id "question_off_topic" $msg_id [ad_parameter QuestionOffTopicRate "member-value"]] + set options [list [list "" "Don't charge user"] [list $duplicate_wad "Duplicate or other mistake"] [list $off_topic_wad "Off topic (did not read forum policy)"]] + } else { + # it was an answer + set mistake_wad [mv_create_user_charge $miscreant_user_id $admin_user_id "answer_mistake" $msg_id [ad_parameter AnswerMistakeRate "member-value"]] + set wrong_wad [mv_create_user_charge $miscreant_user_id $admin_user_id "answer_wrong" $msg_id [ad_parameter AnswerWrongRate "member-value"]] + set options [list [list "" "Don't charge user"] [list $mistake_wad "Mistake of some kind, e.g., duplicate posting"] [list $wrong_wad "Wrong or misleading answer"]] + } + set member_value_section "

    Charge this user for his sins?

    + +
    +
    +
    " +} else { + set member_value_section "" +} + +ns_return 200 text/html "[ad_admin_header "Confirm Delete"] + +

    Confirm Delete

    + +
    + +$notify_warning + +Are you sure you want to delete + +
    + +

    Subject

    + +$one_line (from $email) + +

    Message

    + +[util_maybe_convert_to_html $message $html_p] + +
    + +and its $n_dependents dependent messages from the bulletin +board? + +
    + +[export_form_vars topic topic_id] + + + +$member_value_section + + + +

    + +If you want, you can explain to $email why you're deleting his or her +thread: + +

    + +From: + +

    + + + + + +

    + +[ad_footer] +" Index: web/openacs/www/bboard/do-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/do-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/do-delete.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,103 @@ +# do-delete.tcl,v 3.0 2000/02/06 03:33:47 ron Exp +# +# /bboard/do-delete.tcl +# +# deletes a msg (or set of messages) from a bulletin board +# and any associated attachments; used only by the administrator +# +# by philg@mit.edu in ancient times (1995) and ported +# + +set_form_variables + +# topic, topic_id, submit_button, explanation, explanation_from, explanation_to, +# deletion_list is the key + +# user_charge is optional and, if it is present, we will charge the +# user after we're done with our deletions + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +set QQtopic [DoubleApos $topic] + + +if {[bboard_get_topic_info] == -1} { + return +} + +if {[bboard_admin_authorization] == -1} { + return +} + +ns_db dml $db "begin transaction" + +if {[bboard_file_uploading_enabled_p]} { + set list_of_files_to_delete [database_to_tcl_list $db "select filename_stub from bboard_uploaded_files where msg_id in ( '[join $deletion_list "','"]' )"] + + ns_db dml $db "delete from bboard_uploaded_files where msg_id in ( '[join $deletion_list "','"]' )" + + # ADD THE ACTUAL DELETION OF FILES + if { [llength $list_of_files_to_delete] > 0 } { + ns_atclose "bboard_delete_uploaded_files $list_of_files_to_delete" + } +} + +ns_db dml $db "delete from bboard_thread_email_alerts where thread_id in ( '[join $deletion_list "','"]' )" + +set delete_sql "delete from bboard where msg_id in ( '[join $deletion_list "','"]' )" + +if [catch { ns_db dml $db $delete_sql} errmsg] { + + ns_db dml $db "abort transaction" + # something went a bit wrong during the delete + ad_return_error "error deleting messages" "Error deleting messages. This should never have happened. Here was the message: +
    +
+$errmsg
+
+
    +" } else { + + ns_db dml $db "end transaction" + + ReturnHeaders + ns_write "[ad_admin_header "Deletion Successful"] + +

    Deletion successful.

    +
    + +The thread you picked has been removed from the discussion. You can +return to the +administration home page for \"$topic\"" + + if { [string first "Email" $submit_button] != -1 } { + # we have to send some email + ns_write "

    ... sending email to $explanation_to (from $explanation_from) ..." + if [catch { ns_sendmail $explanation_to $explanation_from "your thread has been deleted" $explanation } errmsg] { + ns_write " failed sending mail: 

    \n$errmsg\n
    " + } else { + # mail was sent + ns_write "... completed sending mail" + } + } + + if { [info exists user_charge] && ![empty_string_p $user_charge] } { + ns_write "

    ... adding a user charge: +

    +[mv_describe_user_charge $user_charge] +
    +... " + mv_charge_user $db $user_charge + ns_write "Done." + } + + ns_write " + +[ad_footer] +" + +} Index: web/openacs/www/bboard/ed-com-msg.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/ed-com-msg.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/ed-com-msg.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,82 @@ +# ed-com-msg.tcl,v 3.0 2000/02/06 03:33:48 ron Exp +ad_page_variables { + {msg_id} +} +page_validation { + bboard_validate_msg_id $msg_id +} + +# msg_id is the key +# make a copy because it is going to get overwritten by +# some subsequent queries + +set this_msg_id $msg_id + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select to_char(posting_time,'Month DD, YYYY') as posting_date,bboard.*, users.user_id as poster_id, users.first_names || ' ' || users.last_name as name +from bboard, users +where bboard.user_id = users.user_id +and msg_id = '$msg_id'"] + +if { $selection == "" } { + # message was probably deleted + ns_return 200 text/html "Couldn't find message $msg_id. Probably it was deleted by the forum maintainer." + return +} + +set_variables_after_query +set this_one_line $one_line + +# now variables like $message are defined + +if [catch {set selection [ns_db 1row $db "select bt.*, u.email as maintainer_email +from bboard_topics bt, users u +where bt.topic='[DoubleApos $topic]' +and bt.primary_maintainer_id = u.user_id"]} errmsg] { + bboard_return_cannot_find_topic_page + return +} +set_variables_after_query + +ReturnHeaders + +ns_write "[bboard_header "$one_line"] + +

    $one_line

    + +by [ad_present_user $poster_id $name] on $posting_date in +$topic + +
    " + + +set num_responses [database_to_tcl_string $db "select count(*) from bboard +where root_msg_id = '$msg_id'"] + +ns_write " + + + + +
    " + if { $num_responses != 1 } { + ns_write " + View commentary" + } else { + ns_write " + Submit your comment" + } +ns_write " +
    " + +ns_write " +
    +[util_maybe_convert_to_html $message $html_p] +
    + + +

    + +[bboard_footer]" + Index: web/openacs/www/bboard/ed-com-response.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/ed-com-response.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/ed-com-response.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,172 @@ +# ed-com-response.tcl,v 3.0 2000/02/06 03:33:50 ron Exp +ad_page_variables { + msg_id + viewing_msg_id +} +page_validation { + bboard_validate_msg_id $msg_id +} + +# msg_id is the key +# make a copy because it is going to get overwritten by +# some subsequent queries + +# maybe, viewing_msg_id, which is either the msg_id for the message that +# will be expanded or all, which means they all will be expanded + +# we are going to get responses to this message +set this_msg_id $msg_id +set db [ns_db gethandle] + +if ![info exists viewing_msg_id] { + set viewing_msg_id "" +} + +set selection [ns_db 0or1row $db "select bboard.one_line, bboard.topic_id, +bboard_topics.topic +from bboard, bboard_topics +where bboard.msg_id = '$msg_id' and bboard.topic_id = bboard_topics.topic_id"] + +if { $selection == "" } { + # message was probably deleted + ns_return 200 text/html "Couldn't find message $msg_id. Probably it was deleted by the forum maintainer." + return +} + +set_variables_after_query +set this_one_line $one_line + +# now variable $topic_id is defined +set QQtopic_id [DoubleApos $topic_id] +if {[bboard_get_topic_info] == -1} { + return +} + + +# number of responses to the original editorial + +set num_responses [database_to_tcl_string $db "select count(*) from bboard +where root_msg_id = '$msg_id'"] + + +set max_expand_response_num 3 + +# compute the expand/contract link + +set change_view "" + +if { $viewing_msg_id == "all" && $num_responses > $max_expand_response_num } { + set change_view "Contract responses

    " +} elseif {$num_responses > $max_expand_response_num} { + set change_view "Expand all responses

    " +} + +ReturnHeaders + +ns_write "[bboard_header "Commentary on $one_line"] + + + + + +
    +

    Commentary

    + on $one_line in $topic +     		$change_view +
    + +

    + +" + + +# get all the info about the responses + +set selection [ns_db select $db "select email <> '$maintainer_email' as not_maintainer_p, to_char(posting_time,'Month DD, YYYY') as posting_date, bboard.*, +users.user_id as replyer_user_id, +users.first_names || ' ' || users.last_name as name, users.email +from bboard, users +where users.user_id = bboard.user_id +and sort_key like '$msg_id%' +and msg_id <> '$msg_id' +order by not_maintainer_p, sort_key"] + +# flag to determine if the output should be in a list or not + +set list_output_p "" + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + + # if there are 3 or less responses or viewing_msg_id is all, print the full text + if { $num_responses <= $max_expand_response_num || $viewing_msg_id == "all"} { + set this_response "" + if { $one_line != $this_one_line && $one_line != "Response to $this_one_line" } { + # new subject + append this_response "

    $one_line

    \n" + } + append this_response "
    +[util_maybe_convert_to_html $message $html_p] +
    +
    +-- [ad_present_user $replyer_user_id $name], $posting_date +
    +" + append responses $this_response + + } elseif { $viewing_msg_id != $msg_id } { + + # if there are more than 3 responses and viewing_msg_id is not all, + # give an itemized list of reponses, with the message with a msg_id + # of viewing_msg_id expanded + set list_output_p "t" + set this_response "
  • " + if { $one_line != $this_one_line && $one_line != "Response to $this_one_line" } { + # new subject + append this_response "$one_line " + } else { + append this_response "Contribution " + } + + append this_response " by $name ($posting_date).
    " + append responses $this_response + } else { + # viewing_msg_id = msg_id, so print the whole response + set this_response "

    " + set contributed_by "Contributed by $name on $posting_date." + + + if { $one_line != $this_one_line && $one_line != "Response to $this_one_line" } { + # new subject + append this_response "

    $one_line

    \n" + } + append this_response "
    + $message +
    + $contributed_by" + append responses $this_response + append responses "

    " + } +} + + +if { [info exists responses] } { + # there were some + if {$list_output_p == "t" } { + ns_write "

    Responses

    +
      +$responses +
    +

    " + } else { + ns_write "

    Contributions

    +$responses +

    " + } +} + +ns_write " +Respond to \"$this_one_line\" + +[bboard_footer] +" Index: web/openacs/www/bboard/edit-alerts.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/edit-alerts.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/edit-alerts.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,66 @@ +# edit-alerts.tcl,v 3.0 2000/02/06 03:33:51 ron Exp +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +ad_get_user_info + +# now $email is set + +set keyword_header "" +if { [bboard_pls_blade_installed_p] == 1 } { + set keyword_header "Keywords" +} + +ReturnHeaders + +ns_write "[bboard_header "Edit Alerts for $email"] + +

    Edit Alerts for $email

    + +[ad_context_bar_ws_or_index [list "index.tcl" [bboard_system_name]] "Edit Alerts"] + +
    + +
    + + +$keyword_header + +" + + + +set selection [ns_db select $db "select bea.*,rowid +from bboard_email_alerts bea +where user_id = $user_id +order by frequency"] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + if { $valid_p == "f" } { + # alert has been disabled for some reason + set status "Disabled" + set action "Re-enable" + } else { + # alert is enabled + set status "Enabled" + set action "Disable" + } + if { [bboard_pls_blade_installed_p] == 1 } { + ns_write "\n" + } else { + ns_write "\n" + } + +} + +ns_write " + +
    StatusActionTopicFrequency
    $status$action$topic$frequency\"$keywords\"
    $status$action$topic$frequency
    +
    + +[bboard_footer] +" Index: web/openacs/www/bboard/fetch-msg.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/fetch-msg.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/fetch-msg.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,84 @@ +# fetch-msg.tcl,v 3.0 2000/02/06 03:33:52 ron Exp +ad_page_variables { + {msg_id} +} +page_validation { + bboard_validate_msg_id $msg_id +} + +# msg_id is the key + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +set selection [ns_db 1row $db "select days_since_posted(posting_time),bboard.*, email, first_names || ' ' || last_name as name, bboard_topics.topic, +users.user_id as poster_user_id +from bboard, bboard_topics, users +where bboard.user_id = users.user_id +and bboard_topics.topic_id = bboard.topic_id +and msg_id = '$msg_id'"] + +set_variables_after_query + +# now variables like $message and topic are defined + +set QQtopic [DoubleApos $topic] +if {[bboard_get_topic_info] == -1} { + return +} + + + +switch $days_since_posted { + + 0 { set age_string "today" } + + 1 { set age_string "yesterday" } + + default { set age_string "$days_since_posted days ago" } + +} + + +ns_return 200 text/html " + +$one_line + + + + +\[ +Post New Message | +Post Reply to this One | +Send Private Email to $name | +Help +\] + +

    + +

    $one_line

    + +from $name + +
    + +[util_maybe_convert_to_html $message $html_p] + +
    + +(posted $age_string) + +

    + +\[ +Previous | +Next + +\] + +[bboard_footer] +" Index: web/openacs/www/bboard/help.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/help.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/help.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,42 @@ +# help.tcl,v 3.0 2000/02/06 03:33:53 ron Exp +set_the_usual_form_variables + +# topic required + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +if {[bboard_get_topic_info] == -1} { + return +} + +ns_return 200 text/html "[bboard_header "Help for the $topic Forum"] + +

    Help

    + +for the $topic forum +in [ad_system_name] + +
    + +

    How this System Works

    + +This bboard software was written by +Philip Greenspun +and the design choices are described in +his book on Web publishing. The intent is to combine the best of both the Web and the email worlds. + +

    + +We use the Web to collect a permanent categorized and indexed record +of the discussion. We use email to notify people when someone has +posted a response to a question. We use email also to send instant +notifications or periodic summaries of forum activity (you can request +to be notified if you'd like to follow the forum via email). + +[bboard_footer] +" Index: web/openacs/www/bboard/image.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/image.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/image.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,17 @@ +# image.tcl,v 3.0 2000/02/06 03:33:54 ron Exp +ad_page_variables { + bboard_upload_id +} +page_validation { + set bboard_upload_id [validate_integer "BBoard Upload ID" $bboard_upload_id] +} + +# bboard_upload_id + +set db [ns_db gethandle] + +set filename [database_to_tcl_string $db "select filename_stub from bboard_uploaded_files where bboard_upload_id=$bboard_upload_id"] + +set filename [bboard_file_path]/$filename + +ns_returnfile 200 [ns_guesstype $filename] $filename Index: web/openacs/www/bboard/index.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/index.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,108 @@ +# index.tcl,v 3.2 2000/03/01 08:45:03 yon Exp +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +# we successfully opened the database + +set user_id [ad_get_user_id] + + +append whole_page "[bboard_header "Welcome to [bboard_system_name]"] + +[ad_decorate_top "

    Welcome to [bboard_system_name]

    + +[ad_context_bar_ws_or_index [bboard_system_name]] +" [ad_parameter IndexPageDecoration bboard]] + +
    + +[ad_decorate_side] + +sort by activity + +
      +" + +set moderation_policy_sort_key 1 +foreach moderation_policy [bboard_moderation_policy_order] { + append decode_internals "'[DoubleApos $moderation_policy]',$moderation_policy_sort_key," + incr moderation_policy_sort_key +} + +#DRB: decode_internals case needs POSTGRES porting, still. +if ![info exists decode_internals] { + set order_by "upper(topic)" +} else { + # add one last integer at the end + # POSTGRES + # set order_by "decode(moderation_policy,null,0,$decode_internals$moderation_policy_sort_key) asc, upper(topic)" + set order_by "bboard_mod_pol_number(moderation_policy), upper(topic)" +} + +set selection [ns_db select $db "select moderation_policy, topic, topic_id, presentation_type +from bboard_topics +where (active_p = 't' or active_p is null) +and (bboard_topics.group_id is null + or ad_group_member_p ( $user_id, bboard_topics.group_id ) = 't' ) +order by $order_by"] + +set last_moderation_policy "" +set first_iteration_p 1 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $last_moderation_policy != $moderation_policy } { + if !$first_iteration_p { + append whole_page "\n\n
    \n\n" + } + append whole_page "

    [bboard_moderation_title $moderation_policy]

    \n\n
      \n\n" + set last_moderation_policy $moderation_policy + } + set first_iteration_p 0 + append whole_page "
    • [bboard_complete_backlink $topic_id $topic $presentation_type]\n" +} + +set n_groups [database_to_tcl_string $db "select count(group_id) from user_group_map where user_id = $user_id"] + +if {$n_groups > 0 && [bboard_users_can_add_topics_p]} { + append whole_page "

      + +

    • Add New Topic (i.e., add a new discussion board) +" +} + +if { $first_iteration_p == 0 } { + # moderation policy titles were used + append whole_page "
    " +} + +append whole_page " + + + +" + + +if { [bboard_pls_blade_installed_p] || [bboard_openacs_search_installed_p] } { + set search_server [ad_parameter BounceQueriesTo site-wide-search ""] + append whole_page " +You can search through all of the +messages on all of the bulletin boards in this system. +
    +Full Text Search: + +
    +

    +" + +} + +append whole_page " +[bboard_footer] +" + +ns_db releasehandle $db + +ns_return 200 text/html $whole_page Index: web/openacs/www/bboard/insert-msg.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/insert-msg.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/insert-msg.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,738 @@ +# insert-msg.tcl,v 3.4.4.2 2000/04/09 16:28:15 bdolicki Exp +# Insert a new message into bboard +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +ad_handle_spammers + +# bboard_already_notified_p +# Returns 1 if the user is already queued to be emailed. 0 if not. + +# "to_email" is the email address of the user receiving the email +# "email_queue" is a list of ns_set id's + +# The target email address for the alert is associated with the +# "to" key of each ns_set in $email_queue + +# This proc compares "to_email" with all the +# values in the "to" key of each ns_set in email_queue and +# returns 1 if there is a match, or 0 if not + +proc bboard_already_notified_p { to_email email_queue } { + foreach email $email_queue { + if { [string compare $to_email [ns_set get $email to]] == 0 } { + # email matched + return 1 + } + } + # we've search all the ns_sets and have not found a match + return 0 +} + + +# Returns ns_set specifying a message to be sent to a user somewhere +# regarding a new message posting on the bboard. We enqueue everything +# so that the production thread can release the database handle and not +# bring down the Web server if the mail transfer agent is down. + +proc bboard_build_email_queue_entry {to from subject body user_message {extra_headers ""}} { + set email_ns_set [ns_set create email_queue_entry] + ns_set put $email_ns_set to $to + ns_set put $email_ns_set from $from + ns_set put $email_ns_set subject $subject + ns_set put $email_ns_set body $body + ns_set put $email_ns_set user_message $user_message + if ![empty_string_p $extra_headers] { + ns_set put $email_ns_set extraheaders $extra_headers + } + return $email_ns_set +} + +# we use notify_if_requested_build to build up a list +# of emails to be sent to users who previously posted +# a message in this thread + +# Returns email queue (list of ns_sets) + +proc notify_if_requested_build { db thread_start_msg_id from subject_line body } { + set email_queue [list] + set selection [ns_db select $db "select ua.email, ea.oid as rowid +from bboard_thread_email_alerts ea, users_alertable ua +where ea.thread_id = '$thread_start_msg_id' +and ea.user_id = ua.user_id"] + + while { [ns_db getrow $db $selection] } { + set_variables_after_query + set shut_up_url "[bboard_url_stub]shut-up.tcl?row_id=[ns_urlencode $rowid]" + + set customized_body "$body + +------------- + +If you are no longer interested in this thread, simply go to the +following URL and you will no longer get these notifications: + +$shut_up_url + +------------- + +Note: this message was sent by a robot. + +" + set email_queue_entry [bboard_build_email_queue_entry $email $from $subject_line $customized_body "

  • sent a note to $email, who asked to be notified of responses.\n"] + lappend email_queue $email_queue_entry + } + + return $email_queue +} + +ad_page_variables { + message + one_line + notify + html_p + {topic_id ""} + {topic ""} + {custom_sort_key_p "f"} + {custom_sort_solicit_p "f"} + {custom_sort_key_type ""} + {custom_sort_key_pretty ""} + {presentation_type ""} + {category ""} + refers_to + {tri_id ""} + {epa_region ""} + {upload_file ""} + {usgeospatial_p "f"} + {urgent_p ""} + {caption ""} +} + +# topic_id and topic will be validated and reset by +# bboard_get_topic_info + +# body, one_line, notify, html_p +# topic_id, topic are hidden vars +# q_and_a_p is an optional variable, if set to "t" then this is from +# the Q&A forum version +# refers_to is "NEW" or a msg_id (six characters) + +# we MAY get an image or other file along with this msg, which means +# we'd get the file name in "upload_file" and can get out the temp file +# with ns_queryget + +# we're going to need to subquery for instant keyword matching +# and/or looking around for state and county from tri_id + +set db_pools [ns_db gethandle [philg_server_default_pool] 2] +set db [lindex $db_pools 0] +set db_sub [lindex $db_pools 1] + +if {[bboard_get_topic_info] == -1} { + return +} + +set return_url [bboard_raw_backlink $topic_id $topic $presentation_type 1] + +if { $presentation_type == "usgeospatial" } { + if { $refers_to == "NEW" } { + if { [info exists tri_id] && ![empty_string_p $tri_id] } { + # we have a tri_id, have to look up epa region + set selection [ns_db 1row $db_sub "select st as usps_abbrev, sema_zip as zip_code, fips_county_code from rel_search_fac where tri_id = '$QQtri_id'"] + set_variables_after_query + set epa_region [database_to_tcl_string $db_sub "select epa_region from bboard_epa_regions where usps_abbrev = '$usps_abbrev'"] + } + # we'll send them back to the region level + set full_anchor "the $topic (Region $epa_region) forum" + } else { + # a reply, try to send them back to their thread + set full_anchor [bboard_usgeospatial_about_link $db $refers_to] + } +} else { + set full_anchor "$topic forum" +} + +## I moved the helper functions into defs.tcl + +# check the user input first + +set exception_text "" +set exception_count 0 + +if { ![info exists one_line] || [empty_string_p $one_line] } { + append exception_text "
  • You need to type a subject line\n" + incr exception_count +} + +if { ![info exists message] || [empty_string_p $message] } { + append exception_text "
  • You need to type a message; there is no \"Man/woman of Few Words Award\" here. \n" + incr exception_count +} + +set selection [ns_db select $db "select the_regexp, scope, message_to_user +from bboard_bozo_patterns +where topic_id = $topic_id"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $scope == "one_line" || $scope == "both" } { + # let's check the subject line for this regexp + if [regexp -nocase $the_regexp $one_line] { + incr exception_count + append exception_text "
  • $message_to_user\n" + # you can only be a bozo once + break + } + } + if { $scope == "message" || $scope == "both" } { + if [regexp -nocase $the_regexp $message] { + incr exception_count + append exception_text "
  • $message_to_user\n" + # you can only be a bozo once + break + } + } +} + +#DRB: Note that the equality check on message has a magic number equal +#to the PG blocksize. This should be removed when the no-limit V7.1 +#text type becomes available. + +if { [string length $QQmessage] < 4000 } { + # For now, we only check for duplicates if the message is shorter + # than 4000 bytes. + + if [catch { set n_previous [database_to_tcl_string $db " + select count(*) from bboard + where topic_id = $topic_id + and one_line = '$QQone_line' + and substr(message, 1, 8000) = substr('$QQmessage', 1, 8000)"]} errmsg] { + ns_log Notice "failed trying to look up previous posting: $errmsg" + } else { + # lookup succeeded + if { $n_previous > 0 } { + incr exception_count + append exception_text "
  • There are already $n_previous messages in the database with the same subject line and body. Perhaps you already posted this? Here are the messages: +
      +" + set selection [ns_db select $db " +select u.first_names, u.last_name, u.email, bb.posting_time +from bboard bb, users u +where bb.user_id= u.user_id +and bb.topic_id = $topic_id +and bb.one_line = '$QQone_line' +and substr(message, 1, 8000) = substr('$QQmessage', 1, 8000)"] + while {[ns_db getrow $db $selection]} { + set_variables_after_query + append exception_text "
    • $posting_time by $first_names $last_name ($email)\n" + } + append exception_text "
    +If you are sure that you also want to post this message, then back up and change at least one character in the subject or message area, then resubmit." + + } + } +} + +if { $exception_count> 0 } { + ad_return_complaint $exception_count $exception_text + return 0 +} + + +# if we get here, the user input checked OK + +# before we overwrite all of these user inputs, let's cat them +# together so that we can do instant keyword-specific alerts + +#check for the user cookie +set user_id [ad_verify_and_get_user_id] +if { $user_id == 0 } { + ns_returnredirect "/register/index.tcl" + return +} + +# for people who are looking for a user's name or email, +# we need to get this from the users table +set selection [ns_db 1row $db "select first_names, last_name, email +from users +where user_id=$user_id"] +set_variables_after_query + +set name "$first_names $last_name" + +set indexed_stuff "$name $email $one_line $message" + +ReturnHeaders + +ns_write "[bboard_header "Inserting Message"] + +

    Inserting Message

    + +into the $full_anchor + +
    + +We're going to try the insert now... + +

    + +" + +with_transaction $db { + # this will grab the exclusive lock on the msg_id_generator table + # that will keep another copy of this same script from doing anything + # more than waiting here. + + set last_id [ns_set value [ns_db 1row $db "select last_msg_id from msg_id_generator for update"] 0] + + set new_id [increment_six_char_digits $last_id] + + ns_db dml $db "update msg_id_generator set last_msg_id = '$new_id'" + + if { $refers_to == "NEW" } { + # this is a new message + + set sort_key $new_id + set QQfinal_refers_to "NULL" + } else { + # we are referring to some older message + + set QQfinal_refers_to "'$QQrefers_to'" + set sort_key_of_referred_to_msg [database_to_tcl_string $db "select distinct sort_key from bboard where msg_id = '$QQrefers_to'"] + set new_sort_key_form [new_sort_key_form $sort_key_of_referred_to_msg] + set highest_current_sort_key_at_this_level [database_to_tcl_string $db "select max(sort_key) from bboard where sort_key like '$new_sort_key_form'"] + set sort_key [new_sort_key $sort_key_of_referred_to_msg $highest_current_sort_key_at_this_level] + } + + + # sometimes an optional $category variable is included + if { [info exists category] && $category != "" } { + set category_target ",category" + set category_value ",'$QQcategory'" + } else { + set category_target "" + set category_value "" + } + + # sometimes an optional custom_sort_key and custom_sort_key_pretty + if { ([info exists custom_sort_key] && $custom_sort_key != "") || ($custom_sort_key_p == "t" && $custom_sort_solicit_p == "t" && $custom_sort_key_type == "date") } { + # there was a form var called "custom_sort_key" or we're looking + # for a magically encoded date + set custom_target ",custom_sort_key" + if { $custom_sort_key_type == "date" } { + # have to decode from widget + ns_dbformvalue [ns_conn form] custom_sort_key date custom_sort_key + } + set custom_value ",'[DoubleApos $custom_sort_key]'" + if { [info exists custom_sort_key_pretty] && $custom_sort_key_pretty != "" } { + append custom_target ",custom_sort_key_pretty" + append custom_value ",'$QQcustom_sort_key_pretty'" + } + } else { + set custom_target "" + set custom_value "" + } + + set usgeospatial_target "" + set usgeospatial_value "" + if { $presentation_type == "usgeospatial" } { + if { ![info exists usgeospatial_p] || $usgeospatial_p != "t" } { + # we only want to accept postings from a specially + # constructed form + ns_write "

    Sorry

    + +We're sorry but you've somehow managed to post to a geospatialized +forum without using the requisite form. This is almost certainly +our programming error. Please send us email to let us know how you +got here. + + [bboard_footer]" + + # stop execution of this thread + return + } + if { $refers_to == "NEW" } { + if { [info exists tri_id] && ![empty_string_p $tri_id] } { + # we have a tri_id, let's fill out everything else from + # that (i.e., look up region, state, usps_abbrev, zip) + set selection [ns_db 1row $db_sub "select st as usps_abbrev, sema_zip as zip_code, fips_county_code from rel_search_fac where tri_id = '$QQtri_id'"] + set_variables_after_query + set epa_region [database_to_tcl_string $db_sub "select epa_region from bboard_epa_regions where usps_abbrev = '$usps_abbrev'"] + set usgeospatial_target ", epa_region, usps_abbrev, fips_county_code, zip_code, tri_id" + set usgeospatial_value ", [ns_dbquotevalue $epa_region integer], [ns_dbquotevalue $usps_abbrev text], [ns_dbquotevalue $fips_county_code text], [ns_dbquotevalue $zip_code text], [ns_dbquotevalue $tri_id text]" + } else { + set usgeospatial_target ", epa_region, usps_abbrev" + set usgeospatial_value ", $epa_region, '$QQusps_abbrev'" + if [info exists fips_county_code] { + append usgeospatial_target ", fips_county_code" + append usgeospatial_value ", '$QQfips_county_code'" + } + if [info exists zip_code] { + append usgeospatial_target ", zip_code" + append usgeospatial_value ", '$QQzip_code'" + } + } + } else { + # this is a reply + # pull all the geospatial columns from the preceding row + set selection [ns_db 1row $db_sub "select epa_region, usps_abbrev, fips_county_code, zip_code, tri_id from bboard where msg_id = '$QQrefers_to'"] + set_variables_after_query + set usgeospatial_target ", epa_region, usps_abbrev, fips_county_code, zip_code, tri_id" + set usgeospatial_value ", [ns_dbquotevalue $epa_region integer], [ns_dbquotevalue $usps_abbrev text], [ns_dbquotevalue $fips_county_code text], [ns_dbquotevalue $zip_code text], [ns_dbquotevalue $tri_id text]" + } + } + + set urgent_p_target "" + set urgent_p_value "" + if { [info exists urgent_p] && ![empty_string_p $urgent_p] } { + set urgent_p_target ", urgent_p" + set urgent_p_value ", '$QQurgent_p'" + } + + # to provide some SPAM-proofing, we record the IP address + set originating_ip [ns_conn peeraddr] + + # Work around inability of Oracle to handle string literals > 4k + + ns_db dml $db "insert into bboard (user_id,msg_id,refers_to,root_msg_id,topic_id,originating_ip,one_line,message,html_p,sort_key,posting_time${category_target}${custom_target}${usgeospatial_target}${urgent_p_target}) + values ($user_id,'$new_id',$QQfinal_refers_to, '[string range $sort_key 0 5]', $topic_id,'$originating_ip','$QQone_line','$QQmessage', '$QQhtml_p','$sort_key',sysdate()${category_value}${custom_value}${usgeospatial_value}${urgent_p_value})" + + # Insert thread notifications + if { $notify == "t" } { + # (bran Feb 13 2000) + set notify_thread_id [string range $sort_key 0 5] + # Check for existing notifications for same thread. + set n_alerts [database_to_tcl_string $db "select count(*) +from bboard_thread_email_alerts +where thread_id = '$notify_thread_id' +and user_id = $user_id"] + if { $n_alerts == 0 } { + ns_db dml $db "insert into bboard_thread_email_alerts (thread_id, user_id) values ('$notify_thread_id', $user_id)" + } + } + + # Handle image uploading + if {[bboard_file_uploading_enabled_p] && [info exists upload_file] && ![empty_string_p $upload_file]} { + set tmp_filename [ns_queryget upload_file.tmpfile] + set new_upload_id [database_to_tcl_string $db "select bboard_upload_id_sequence.nextval from dual"] + set local_filename [bboard_generate_upload_filename $new_id $new_upload_id $upload_file] + set full_local_path "[bboard_file_path]/$local_filename" + ns_log Notice "Received $upload_file for upload; going to try to put it in $full_local_path" + set n_bytes [file size $tmp_filename] + if { $n_bytes > 0 } { + # we have a real image + ns_cp $tmp_filename $full_local_path + if { [info exists caption] && ![empty_string_p $caption] } { + # we have a photo + set extra_uf_columns ", caption" + set extra_uf_values ", [ns_dbquotevalue $caption text]" + set file_type "photo" + } else { + set extra_uf_columns "" + set extra_uf_values "" + set file_type "not a photo" + } + # make sure to lowercase it so we don't have to + # deal with JPG and JPEG + set file_extension [string tolower [file extension $upload_file]] + # remove the first . from the file extension + regsub "\." $file_extension "" file_extension + set what_aolserver_told_us "" + if { $file_extension == "jpeg" || $file_extension == "jpg" } { + catch { set what_aolserver_told_us [ns_jpegsize $full_local_path] } + } elseif { $file_extension == "gif" } { + catch { set what_aolserver_told_us [ns_gifsize $full_local_path] } + } + # the AOLserver jpegsize command has some bugs where the height comes + # through as 1 or 2 + if { ![empty_string_p $what_aolserver_told_us] && [lindex $what_aolserver_told_us 0] > 10 && [lindex $what_aolserver_told_us 1] > 10 } { + set original_width [lindex $what_aolserver_told_us 0] + set original_height [lindex $what_aolserver_told_us 1] + } else { + set original_width "" + set original_height "" + } + # strip off the C:\directories... crud and just get the file name + # (branimir 2000/04/09) + # For some reason the earlier regexp {([^//\]+)$} doesn't + # work any more in Tcl 8.2. The new {([^//\\]+)$} works + # everywhere. + if ![regexp {([^//\\]+)$} $upload_file match client_filename] { + # couldn't find a match + set client_filename $upload_file + } + + ns_db dml $db "insert into bboard_uploaded_files (bboard_upload_id, msg_id, file_type, file_extension, n_bytes, client_filename, filename_stub$extra_uf_columns,original_width,original_height) + values ($new_upload_id, '$new_id', '$file_type', '$file_extension', $n_bytes, '[DoubleApos $client_filename]', '/$local_filename'$extra_uf_values,[ns_dbquotevalue $original_width number],[ns_dbquotevalue $original_height number])" + } + } + } { + # something went a bit wrong during the insert + ns_write "

    Ouch!!

    + +Here was the bad news from the database: +
    +
+$errmsg $refers_to
+
+
    + +Don't quit your browser. You might be able to resubmit your posting +five or ten minutes from now. + + [bboard_footer] +" + return + } + + ns_write "

    Success!!

    + +Your posting is now in the database. + +One of the big points of this software is to support collaboration +using the best mix of Web and email. Now that we've done the Web part, +we will notify the people who have requested an +email alert. +You may move to a different url if you don't want to wait for this process +to complete. +

    +

      +
    • Generating alerts... +

      +" + + # email_queue is a list; each elementof the list is an ns_set + # containing information about an email to be sent + + # The keys in each ns_set: + # to: to email + # from: from email + # subject: subject heading + # body: body + # user_message: message to output to the Web user about this email + # extraheaders: ns_set containing header name/content pairs for ns_sendmail + + set email_queue [list] + # the WRAP=HARD in our form's TEXTAREA should have wrapped but + # let's make sure (in case user's browser wasn't being nice to us) + # also, let's try to + if { $html_p == "t" } { + set message_wrapped [wrap_string [util_striphtml $message]] + } else { + set message_wrapped [wrap_string $message] + } + + if { $notify_of_new_postings_p == "t" } { + # administrator has requested notification of every new posting + set maintainer_body "$name ($email) added a message to the $topic bboard: + +Subject: $one_line + +$message_wrapped + +---------- + +If you want to delete the message, come to the administration page: + + [bboard_url_stub]admin-home.tcl?[export_url_vars topic topic_id] + +" + set email_queue_entry [bboard_build_email_queue_entry $maintainer_email $email $one_line $maintainer_body "

    • sent email to the forum maintainer: $maintainer_email"] + lappend email_queue $email_queue_entry + } else { + ns_write "
    • the forum maintainer ($maintainer_email) must be busy because he/she has disabled email notification of new postings\n\n

      \n\n" + } + + if { $refers_to != "NEW" } { + + # try to send email to all the previous posters + + # set up top, conditionally +# set return_url "[bboard_url_stub]main-frame.tcl?[export_url_vars topic topic_id]" + + set from "$email" + if { ![regexp {Response} $one_line] } { + set subject_line "Response to your posting: $one_line" + } else { + set subject_line $one_line + } + #(bran Feb 19 2000 adding link to bring people directly to the thread) + set msg_id [string range $sort_key 0 5] + set body "$name ($email) responded to a message you +requested notification for in the $topic bboard: + +Subject: $one_line + +$message_wrapped + +----------------- + +To post a response, come back to the bulletin board at + +[bboard_url_stub]q-and-a-fetch-msg.tcl?[export_url_vars msg_id topic_id topic] + +" + + set email_queue [notify_if_requested_build $db [string range $sort_key 0 5] $from $subject_line $body] + + } + + # now we have to deal with all of the people who've requested instant notification of new postings + + # comment this out to avoid an AOLserver/Hearst mailer bug + # set from "$name <$email>" + set from $email + if { [string length $topic] < 10 } { + set subject_line "$topic forum: $one_line" + } else { + set subject_line "$one_line" + } + set msg_id [string range $sort_key 0 5] + set body " +$message_wrapped + +--------- + +To post a response, come back to the forum at + +[bboard_url_stub]q-and-a-fetch-msg.tcl?[export_url_vars msg_id topic_id topic] + + (which is also the place to go if you want to edit your alerts and +stop these robotically sent messages) + +" + + # **** Null/empty string problem for "keywords" (Oracle 9?) + set selection [ns_db select $db "select distinct bboard_email_alerts.user_id,bboard_email_alerts.oid as rowid, email from bboard_email_alerts, users_alertable +where topic_id=$topic_id +and frequency='instant' +and valid_p = 't' +and keywords is null +and bboard_email_alerts.user_id = users_alertable.user_id"] + + while {[ns_db getrow $db $selection]} { + set_variables_after_query + if { ![bboard_already_notified_p $email $email_queue] } { + # user hasn't been queued recieved the note yet + set customized_body "$body + +If you are annoyed by this message then just enter the following URL +into a browser and you'll disable the alert that generated this mail: + + [bboard_hardwired_url_stub]alert-disable.tcl?rowid=[ns_urlencode $rowid] +" + + set extraheaders [ns_set create extraheaders] + ns_set put $extraheaders Reply-To $from + # MAC: extra RFC 2369-style headers + ns_set put $extraheaders List-Post "<[bboard_url_stub]q-and-a-fetch-msg.tcl?[export_url_vars msg_id topic_id topic]>" + ns_set put $extraheaders List-Unsubscribe "<[bboard_hardwired_url_stub]alert-disable.tcl?rowid=[ns_urlencode $rowid]>" + ns_set put $extraheaders List-Owner "" + + lappend email_queue [bboard_build_email_queue_entry $email [bboard_sender_email] $subject_line $customized_body "

    • sent a note to $email \n" $extraheaders] + } + } + + set selection [ns_db select $db "select distinct bboard_email_alerts.user_id, keywords, bboard_email_alerts.oid as rowid, email +from bboard_email_alerts, users_alertable +where topic_id=$topic_id +and frequency='instant' +and valid_p = 't' +and keywords is not null +and users_alertable.user_id = bboard_email_alerts.user_id"] + + while {[ns_db getrow $db $selection]} { + set_variables_after_query + set keyword_list [split $keywords " "] + set found_p 0 + foreach word $keyword_list { + # turns out that "" is never found in a search, so we + # don't really have to special case $word == "" + if { $word != "" && [string first [string toupper $word] [string toupper $indexed_stuff]] != -1 } { + # found it! + set found_p 1 + } + } + if { $found_p == 1 && ![bboard_already_notified_p $email $email_queue] } { + # word is found and user hasn't been + # queued to receive the email yet + set customized_body "$body + +If you are annoyed by this message then just enter the following URL +into a browser and you'll disable the alert that generated this mail: + + [bboard_hardwired_url_stub]alert-disable.tcl?rowid=[ns_urlencode $rowid] +" + + set extraheaders [ns_set create extraheaders] + ns_set put $extraheaders Reply-To $from + # MAC: extra RFC 2369-style headers + ns_set put $extraheaders List-Post "<[bboard_url_stub]q-and-a-fetch-msg.tcl?[export_url_vars msg_id topic_id topic]>" + ns_set put $extraheaders List-Unsubscribe "<[bboard_hardwired_url_stub]alert-disable.tcl?rowid=[ns_urlencode $rowid]>" + ns_set put $extraheaders List-Owner "" + + lappend email_queue [bboard_build_email_queue_entry $email [bboard_sender_email] $subject_line $customized_body "
    • sent a note to $email \n" $extraheaders] + } + } + + # we release the database handle in case the mailer is down; we + # don't want other threads to block waiting for a db handle tied + # down by us + ns_db releasehandle $db + + # send out the email + + if { ![philg_development_p] } { + foreach email $email_queue { + with_catch errmsg { + ns_sendmail [ns_set get $email to] [ns_set get $email from] [ns_set get $email subject] [ns_set get $email body] [ns_set get $email extraheaders] + # we succeeding sending this particular piece of mail + ns_write [ns_set get $email user_message] + } { + # email failed, let's see if it is because mail + # service is completely wedged on this box + if { [string first "timed out" errmsg] != -1 } { + # looks like we couldn't even talk to mail server + # let's just give up and return so that this thread + # doesn't have around for 10 minutes + ns_log Notice "timed out sending email; giving up on email alerts. Here's what ns_sendmail returned:\n$errmsg" + ns_write "
    + +Something is horribly wrong with the email handler on this computer so +we're giving up on sending any email notifications. Your posting +will be enshrined in the database, of course. + + [bboard_footer]" + return + } else { + ns_write "Something is horribly wrong with +the email handler on this computer so +we're giving up on sending any email notifications. Your posting +will be enshrined in the database, of course. + + +

    +

    +
    +$errmsg
+
    +
    " + return + } + } + } + } + + # we're done processing the email queue + ns_write " +

    + +We're all done with the email notifications now. If any of these +folks typed in a bogus/misspelled/obsolete email address, you may get a +bounced message in your inbox. + +[bboard_footer] +" + Index: web/openacs/www/bboard/main-frame.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/main-frame.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/main-frame.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,71 @@ +# main-frame.tcl,v 3.0 2000/02/06 03:33:59 ron Exp +set_form_variables + +# topic_id, topic required +# feature_msg_id, start_msg_id optional + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +if { [info exists feature_msg_id] && $feature_msg_id != "" } { + set main_url "fetch-msg.tcl?msg_id=$feature_msg_id" + set subject_url_appendage "&feature_msg_id=$feature_msg_id" +} else { + # no featured msg + set main_url "default-main.tcl?[export_url_vars topic topic_id]" + set subject_url_appendage "" +} + +if { [info exists start_msg_id] && $start_msg_id != "" } { + set subject_url "subject.tcl?[export_url_vars topic topic_id]&start_msg_id=$start_msg_id" +} else { + # no featured msg + set subject_url "subject.tcl?[export_url_vars topic topic_id]" +} + +append subject_url $subject_url_appendage + +# if we got here, that means the cookie checked + +ns_return 200 text/html " + + + + + +$topic BBoard + + + + + + + + + + + + + + + + +This bulletin board system can only be used with a frames-compatible +browser. + +

    + +Perhaps you should consider running Netscape 2.0 or later? + + + + + + + + + +" Index: web/openacs/www/bboard/msg-urgent-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/msg-urgent-toggle.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/msg-urgent-toggle.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,18 @@ +# msg-urgent-toggle.tcl,v 3.0 2000/02/06 03:34:00 ron Exp +ad_page_variables { + msg_id + return_url +} +page_validation { + bboard_validate_msg_id $msg_id +} + +# msg_id, return_url + +set user_id [ad_verify_and_get_user_id] +set db [ns_db gethandle] + +ns_db dml $db "update bboard set urgent_p = logical_negation(urgent_p) where +msg_id = '$msg_id' and bboard.user_id = $user_id" + +ns_returnredirect $return_url Index: web/openacs/www/bboard/next.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/next.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/next.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,58 @@ +# next.tcl,v 3.0 2000/02/06 03:34:02 ron Exp +ad_page_variables { + msg_id + topic_id +} +page_validation { + bboard_validate_msg_id $msg_id + set topic_id [validate_integer "Topic ID" $topic_id] +} + +# msg_id is the key, topic_id + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +set selection [ns_db select $db "select msg_id, sort_key +from bboard +where sort_key > (select sort_key from bboard where msg_id = '$msg_id') +and topic_id = $topic_id +order by sort_key"] + +# get one row + +ns_db getrow $db $selection + +set next_msg_id [ns_set value $selection 0] + +# we don't want the rest of the rows + +ns_db flush $db + +if { $next_msg_id != "" } { + + ns_returnredirect "fetch-msg.tcl?msg_id=$next_msg_id" + +} else { + + # no msg to return + + ns_return 200 text/html " + +End of BBoard + + + +

    No Next Message

    + +You've read the last message in the $topic BBoard. + + + +" + +} Index: web/openacs/www/bboard/ns-perm-enhancements.text =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/ns-perm-enhancements.text,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/ns-perm-enhancements.text 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,18 @@ +alter table bboard_topics add column ns_perm_group text; +-- should be a text column because in case the user changes +-- the group we don't want to just blithely delete +alter table bboard_topics add column ns_perm_group_added_for_this_forum text; + +alter table bboard_topics add column q_and_a_primary_p boolean; + +------ + +added to defs.tcl + +proc bboard_use_ns_perm_authorization_p {} { + return 1 +} + +---------- + +new versions of admin-home, add-new-topic, add-new-topic-2 Index: web/openacs/www/bboard/policy.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/policy.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/policy.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,48 @@ +# policy.tcl,v 3.0 2000/02/06 03:34:03 ron Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +# topic required + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +if {[bboard_get_topic_info] == -1} { + return} + + + + + +ns_return 200 text/html "[bboard_header "About the $topic Forum"] + +

    About the $topic Forum

    + +[ad_context_bar_ws_or_index [list "index.tcl" [bboard_system_name]] [list [bboard_raw_backlink $topic_id $topic $presentation_type 0] $topic] "Policy"] + + +
    + +$policy_statement + +

    How this System Works

    + +This bboard software was written by +Philip Greenspun +and the design choices are described in +his real dead trees book on Web publishing. The intent is to combine the best of both the Web and the email worlds. + +

    + +We use the Web to collect a permanent categorized and indexed record +of the discussion. We use email to notify people when someone has +posted a response to a question. We use email also to send instant +notifications or periodic summaries of forum activity (you can request +to be notified if you'd like to follow the forum via email). + +[bboard_footer] +" Index: web/openacs/www/bboard/post-new.html =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/post-new.html,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/post-new.html 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,39 @@ + + +Post New Message + + + +

    Post a New Message

    + +into the Bulletin Board + +
    + +
    + + + + + + + + + + + + + + + +
    Your Email Address
    Your Full Name
    Subject Line
    Message
    Notify Me of Responses
    (via email) +    		 Yes + No +
    + + + +
    + + + Index: web/openacs/www/bboard/post-new.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/post-new.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/post-new.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,104 @@ +# post-new.tcl,v 3.1 2000/02/23 01:49:39 bdolicki Exp +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set_the_usual_form_variables + +# topic + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +if {[bboard_get_topic_info] == -1} { + return +} + + + + + +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + ns_returnredirect /register.tcl?return_url=[ns_urlencode "[bboard_partial_url_stub]post-new.tcl?[export_url_vars topic topic_id]"] + return +} + + +if { [bboard_pls_blade_installed_p] } { + set search_option "Note: before you post a new question, you might want to make sure that it hasn't already been asked and answered... +
    + + +Full Text Search: +
    + + +$pre_post_caveat + +
    +" +} else { + set search_option "$pre_post_caveat" +} + +ns_return 200 text/html " + +Post New Message + + + +

    Post a New Message

    + +into the $topic bboard + +
    + +$search_option + + +
    + + + + + + + + + + + + + + + + + +
    Subject Line
    Notify Me of Responses
    (via email) +    		 Yes + No +
    Message
    		enter in textarea below, then press submit +
    + +
    Text above is: +
    +

    + +

    + + + + +
    + +
    + +[bboard_footer] +" Index: web/openacs/www/bboard/post-reply-form.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/post-reply-form.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/post-reply-form.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,80 @@ +# post-reply-form.tcl,v 3.1 2000/02/13 15:24:02 bdolicki Exp +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set form_refers_to [ns_set get [ns_conn form] refers_to] +set QQform_refers_to [DoubleApos $form_refers_to] + +# we can't just use set_form_variables because that would set +# "refers_to" which is about to be overwritten by the db query + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + + +set selection [ns_db 1row $db "select first_names || ' ' || last_name as name, bboard.*, bboard_topics.topic +from bboard, users, bboard_topics +where users.user_id = bboard.user_id +and bboard_topics.topic_id = bboard.topic_id +and msg_id = '$QQform_refers_to'"] + +set_variables_after_query + + +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + ns_returnredirect /register.tcl?return_url=[ns_urlencode "[bboard_partial_url_stub]post-reply-frame.tcl?refers_to=[ns_urlencode $form_refers_to]"] + return +} + + +ns_return 200 text/html " + +Post Reply + + + +

    Post a Reply

    + +to \"$one_line\" from $name + +

    + +in the $topic bboard + +

    + +
    + +[export_form_vars topic topic_id] + + + + + + + + + + + + +
    Subject Line
    Message
    Notify Me of Responses
    (via email) +    		 Yes + No +
    Text above is:
    + + + +
    + +[bboard_footer] +" Index: web/openacs/www/bboard/post-reply-frame.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/post-reply-frame.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/post-reply-frame.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,44 @@ +# post-reply-frame.tcl,v 3.0 2000/02/06 03:34:07 ron Exp +set_form_variables + +# refers_to + +ns_return 200 text/html " + + + + + +Bulletin Board System + + + + + + + + + + + + + + + + +This bulletin board system can only be used with a frames-compatible +browser. + +

    + +Perhaps you should consider running Netscape 2.0? + + + + + + + + + +" Index: web/openacs/www/bboard/post-reply-top.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/post-reply-top.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/post-reply-top.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,40 @@ +# post-reply-top.tcl,v 3.0 2000/02/06 03:34:09 ron Exp +ad_page_variables { + refers_to +} + +# refers_to is the key + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +set selection [ns_db 1row $db "select first_names || ' ' || last_name as name, email, bboard.* +from bboard, users +where bboard.user_id = users.user_id +and msg_id = '$QQrefers_to'"] + +set_variables_after_query + +# now variables like $message are defined + +ns_return 200 text/html " + +$one_line + + + +

    $one_line

    + +from $name ($email) + +
    + +$message + + + +" Index: web/openacs/www/bboard/prev.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/prev.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/prev.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,58 @@ +# prev.tcl,v 3.0 2000/02/06 03:34:10 ron Exp +ad_page_variables { + msg_id + {topic_id ""} + {topic ""} +} +page_validation { + bboard_validate_msg_id $msg_id + set topic_id [validate_integer "Topic ID" $topic_id] +} + +# topic_id, msg_id + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +set selection [ns_db select $db "select msg_id, sort_key +from bboard +where sort_key < (select sort_key from bboard where msg_id = '$msg_id') +and topic_id = $topic_id +order by sort_key desc"] + +# get one row + +ns_db getrow $db $selection + +set prev_msg_id [ns_set value $selection 0] + +# we don't want the rest of the rows + +ns_db flush $db + +if { $prev_msg_id != "" } { + + ns_returnredirect "fetch-msg.tcl?msg_id=$prev_msg_id" + +} else { + + # no msg to return + + ns_return 200 text/html " + +End of BBoard + + + +

    No Previous Message

    + +You've read the first message in the $topic BBoard. + +[bboard_footer] +" + +} Index: web/openacs/www/bboard/q-and-a-fetch-msg.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/q-and-a-fetch-msg.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/q-and-a-fetch-msg.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,254 @@ +# /www/bboard/q-and-a-fetch-msg.tcl +# +# displays one thread (question and answer) +# +# by philg@mit.edu back in 1995 +# +# q-and-a-fetch-msg.tcl,v 3.0.4.2 2000/03/18 02:06:43 ron Exp + +ad_page_variables { + {msg_id ""} +} + +# msg_id + +if { ![info exists msg_id] || [empty_string_p $msg_id] } { + ad_return_complaint 1 "
  • You've asked for a bboard posting but didn't specify a message ID. We think that you're probably a search engine robot. Holler if you aren't." + return +} + +page_validation { + bboard_validate_msg_id $msg_id +} + +# msg_id is the key +# make a copy because it is going to get overwritten by +# some subsequent queries + +set this_msg_id $msg_id + +set db [bboard_db_gethandle] + +if [bboard_file_uploading_enabled_p] { + set query "select posting_time as posting_date, + bboard.msg_id, + bboard.topic_id, + bboard_topics.topic, + bboard.one_line, + bboard.message, + bboard.html_p, + users.user_id as poster_id, + users.first_names || ' ' || users.last_name as name, + buf.bboard_upload_id, + buf.file_type, + buf.n_bytes, + buf.client_filename, + buf.caption, + buf.original_width, + buf.original_height + from bboard, users, bboard_uploaded_files buf, bboard_topics + where bboard.user_id = users.user_id + and bboard_topics.topic_id= bboard.topic_id + and bboard.msg_id = buf.msg_id + and bboard.msg_id = '$msg_id' + union select posting_time as posting_date, + bboard.msg_id, + bboard.topic_id, + bboard_topics.topic, + bboard.one_line, + bboard.message, + bboard.html_p, + users.user_id as poster_id, + users.first_names || ' ' || users.last_name as name, + null, null, null, null, null, null, null + from bboard, users, bboard_topics + where bboard.user_id = users.user_id + and bboard_topics.topic_id= bboard.topic_id + and bboard.msg_id = '$msg_id' + and not exists (select * from bboard_uploaded_files buf + where bboard.msg_id = buf.msg_id)" +} else { + set query "select posting_time as posting_date,bboard.*, bboard_topics.topic,users.user_id as poster_id, users.first_names || ' ' || users.last_name as name, html_p +from bboard, bboard_topics, users +where bboard.user_id = users.user_id and + bboard.topic_id = bboard_topics.topic_id +and msg_id = '$msg_id'" +} + +set selection [ns_db 0or1row $db $query] + +if { $selection == "" } { + # message was probably deleted + ns_return 200 text/html "Couldn't find message $msg_id. Probably it was deleted by the forum maintainer." + return +} + +set_variables_after_query +set this_one_line $one_line + +# now variables like $message and $topic are defined + +set QQtopic [DoubleApos $topic] +if {[bboard_get_topic_info] == -1} { + return +} + + +if [catch {set selection [ns_db 1row $db "select bt.*, u.email as maintainer_email +from bboard_topics bt, users u +where bt.topic_id=$topic_id +and bt.primary_maintainer_id = u.user_id"]} errmsg] { + bboard_return_cannot_find_topic_page + return +} +set_variables_after_query + + +# Present thread alert link in upper right if they are logged in and have not +# already asked for an alert, or are not logged in. Otherwise give stop notification link. +set user_id [ad_get_user_id] +if { [ad_parameter EnableThreadEmailAlerts bboard 1] && !$user_id || ![database_to_tcl_string $db "select count(*) +from bboard_thread_email_alerts where user_id = $user_id + and thread_id = '$this_msg_id'"] } { + set thread_alert_link [help_upper_right_menu [list "q-and-a-thread-alert.tcl?thread_id=$this_msg_id" "Notify me of new responses"]] + } else { + set thread_alert_link [help_upper_right_menu [list "q-and-a-thread-unalert.tcl?thread_id=$this_msg_id" "Stop notifying me of new responses"]] +} + +append whole_page "[bboard_header $one_line] + +

    $one_line

    + +[ad_context_bar_ws_or_index [list "index.tcl" [bboard_system_name]] [list [bboard_raw_backlink $topic_id $topic $presentation_type 0] $topic] "One Thread"] + + +
    +$thread_alert_link + +
    +" + +if { [info exists bboard_upload_id] && [info exists file_type] && ![empty_string_p $bboard_upload_id] && $file_type == "photo" && $n_bytes > 0 } { + # ok, we have a photo; the question is how big is it + if [empty_string_p $original_width] { + # we don't know how big it is so it probably wasn't a JPEG or GIF + append whole_page "
    (undisplayable image: $caption -- $client_filename)
    " + } elseif { $original_width < 512 } { + append whole_page "
    \n\n
    $caption\n
    \n
    " + } else { + append whole_page "
    ($caption -- $original_height x $original_width $file_type)
    " + } +} + +append whole_page "[util_maybe_convert_to_html $message $html_p] +
    +
    +-- [ad_present_user $poster_id $name], [util_AnsiDatetoPrettyDate $posting_date] +" + +if { [info exists bboard_upload_id] && [info exists file_type] && ![empty_string_p $bboard_upload_id] && $file_type != "photo" } { + append whole_page "
    Attachment: $client_filename\n" +} + +append whole_page " + + +
    + +" + +if [bboard_file_uploading_enabled_p] { + set extra_select ", buf.bboard_upload_id, client_filename, file_type, buf.n_bytes, buf.caption, buf.original_width, buf.original_height" + set extra_table ", bboard_uploaded_files buf" + set extra_and_clause "\nand bboard.msg_id = buf.msg_id +union +select users.email<>'$maintainer_email' as not_maintainer_p, posting_time as posting_date, bboard.*, +users.user_id as replyer_user_id, +users.first_names || ' ' || users.last_name as name, users.email, +null, null, null, null, null, null, null +from bboard, users +where users.user_id = bboard.user_id +and bboard.root_msg_id = '$msg_id' +and bboard.msg_id <> '$msg_id' +and not exists (select * from bboard_uploaded_files buf + where bboard.msg_id=buf.msg_id) +" +} else { + set extra_select "" + set extra_table "" + set extra_and_clause "" +} + +set selection [ns_db select $db "select users.email<>'$maintainer_email' as not_maintainer_p, posting_time as posting_date, bboard.*, +users.user_id as replyer_user_id, +users.first_names || ' ' || users.last_name as name, users.email $extra_select +from bboard, users $extra_table +where users.user_id = bboard.user_id +and bboard.root_msg_id = '$msg_id' +and bboard.msg_id <> '$msg_id' +$extra_and_clause +order by sort_key"] + +## BMA hack +## above, I took out the order by not_maintainer_p which +## is Philip's way of always being the first t comment. I don't want that. + + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + set this_response "" + if { $one_line != $this_one_line && $one_line != "Response to $this_one_line" } { + # new subject + append this_response "

    $one_line

    \n" + } + append this_response "
    " + + if { [info exists bboard_upload_id] && [info exists file_type] && ![empty_string_p $bboard_upload_id] && $file_type == "photo" && $n_bytes > 0 } { + # ok, we have a photo; the question is how big is it + if [empty_string_p $original_width] { + # we don't know how big it is, so it probably wasn't a JPEG or GIF + append this_response "
    (undisplayable image: $caption -- $client_filename)
    " + } elseif { $original_width < 512 } { + append this_response "
    \n\n
    $caption\n
    \n
    " + } else { + append this_response "
    ($caption -- $original_height x $original_width $file_type)
    " + } + } + + append this_response "[util_maybe_convert_to_html $message $html_p] +
    +
    +-- [ad_present_user $replyer_user_id $name], [util_AnsiDatetoPrettyDate $posting_date] +" + if { [info exists bboard_upload_id] && [info exists file_type] && ![empty_string_p $bboard_upload_id] && $file_type != "photo" } { + append this_response "
    Attachment: $client_filename\n" + } + append this_response "\n\n
    \n\n" + lappend responses $this_response +} + +if { [info exists responses] } { + # there were some + append whole_page "

    Answers

    +[join $responses "
    "] +" +} + + +append whole_page " +
    + +
    + + +
    + +
    + + + +" + +ns_db releasehandle $db + +ns_return 200 text/html $whole_page Index: web/openacs/www/bboard/q-and-a-new-answers.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/q-and-a-new-answers.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/q-and-a-new-answers.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,91 @@ +# q-and-a-new-answers.tcl,v 3.0 2000/02/06 03:34:13 ron Exp +# q-and-a-new-answers.tcl +# +# by philg@mit.edu back in 1995 +# + +# this will either display answers new since a last visit or +# simply ones new within the last week (if there is no obvious last visit) + +set_the_usual_form_variables + +# topic (required) + +set db [ns_db gethandle] + +if {[bboard_get_topic_info] == -1} { + return +} + + +set headers [ns_conn headers] +set cookie [ns_set get $headers Cookie] + +set second_to_last_visit [ad_second_to_last_visit_ut] + +if {![info exists second_to_last_visit] || [empty_string_p $second_to_last_visit]} { + set title "postings in the last seven days" + set explanation "" + set query_time_limit "(sysdate() - 7)::datetime" +} else { + set title "postings since your last visit" + set explanation "These are discussions in which there has been a contribution since your last visit, which we think was [ns_fmttime $second_to_last_visit "%x %X %Z"]" + set query_time_limit "'[ns_fmttime $second_to_last_visit "%x %X %Z"]'::datetime" +} + + +ReturnHeaders + +ns_write "[bboard_header "$topic $title"] + +

    $title

    + +[ad_context_bar_ws_or_index [list "index.tcl" [bboard_system_name]] [list [bboard_raw_backlink $topic_id $topic $presentation_type 0] $topic] "New Postings"] + + +
    + +$explanation +
      +" + +set rest_of_page "" + +set sql "select bnah.root_msg_id,count(*) as n_new,max(bnah.posting_time) as max_posting_time, to_char(max(bnah.posting_time),'YYYY-MM-DD') as max_posting_date, bboard.one_line as subject_line +from bboard_new_answers_helper bnah, bboard +where bnah.posting_time > $query_time_limit +and bnah.root_msg_id = bboard.msg_id +and bnah.topic_id = $topic_id +group by bnah.root_msg_id, bboard.one_line +order by max_posting_time desc" + +set selection [ns_db select $db $sql] +set counter 0 + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + incr counter + if { $n_new == 1 } { + set answer_phrase "answer, " + } else { + set answer_phrase "answers, last " + } + append rest_of_page "
    • $subject_line ($n_new new $answer_phrase on [util_AnsiDatetoPrettyDate $max_posting_date])" + +} + +if { $counter == 0 } { + append rest_of_page "

      ... it seems that there haven't been +any new responses." +} + +append rest_of_page " + +

    + +[bboard_footer] +" + +ns_db releasehandle $db + +ns_write $rest_of_page Index: web/openacs/www/bboard/q-and-a-one-category.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/q-and-a-one-category.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/q-and-a-one-category.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,73 @@ +# q-and-a-one-category.tcl,v 3.0 2000/02/06 03:34:14 ron Exp +set_the_usual_form_variables + +# topic, category required + +# we're just looking at the uninteresting postings now + +set db [ns_db gethandle] + +if {[bboard_get_topic_info] == -1} { + return} + +set moby_string "[bboard_header "$category threads in $topic"] + +

    $category Threads

    + +[ad_context_bar_ws_or_index [list "index.tcl" [bboard_system_name]] [list "q-and-a.tcl?topic=[ns_urlencode $topic]" $topic] "One Category"] + + +
    + +
      +" + +if { $category != "uncategorized" } { + set category_clause "and category = '$QQcategory'" +} else { + # **** NULL/'' problem, needs " or category = '' " + set category_clause "and (category is NULL or category = 'Don''t Know')" +} + + + +set sql "select urgent_p, msg_id, one_line, sort_key, posting_time, email, first_names || ' ' || last_name as name, users.user_id as poster_id, bboard_uninteresting_p(interest_level) as uninteresting_p +from bboard, users +where bboard.user_id = users.user_id +and topic_id = $topic_id +and refers_to is null +$category_clause +order by uninteresting_p, sort_key $q_and_a_sort_order" + +set selection [ns_db select $db $sql] + +set uninteresting_header_written 0 + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + + if { $uninteresting_p == "t" && $uninteresting_header_written == 0 } { + set uninteresting_header_written 1 + append moby_string " +

      Uninteresting Threads

      + +(or at least the forum moderator thought they would only be of interest to rare individuals; truly worthless threads get deleted altogether) + +

      + +" + } + append moby_string "

    • $one_line [bboard_one_line_suffix $selection $subject_line_suffix]\n" + +} + +# let's assume there was at least one posting + +append moby_string " +
    +[bboard_footer] +" + +ns_db releasehandle $db + +ns_return 200 text/html $moby_string Index: web/openacs/www/bboard/q-and-a-post-new.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/q-and-a-post-new.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/q-and-a-post-new.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,159 @@ +# q-and-a-post-new.tcl,v 3.1 2000/02/23 01:49:39 bdolicki Exp +# q-and-a-post-new.tcl +# +# philg@arsdigita.com +# updated 1999 hqm@arsdigita.com +# + +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set_the_usual_form_variables + +# topic_id, topic + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +if {[bboard_get_topic_info] == -1} { + return +} + +#check for the user cookie + +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + ns_returnredirect /register.tcl?return_url=[ns_urlencode "[bboard_partial_url_stub]q-and-a-post-new.tcl?[export_url_vars topic_id topic]"] + return +} + +# we know who this is + +if { ![empty_string_p $policy_statement] } { + set policy_link "
  • read the forum policy\n" +} else { + set policy_link "" +} + +if { [bboard_pls_blade_installed_p] } { + set search_server [ad_parameter BounceQueriesTo site-wide-search ""] + set search_option "Before you post a new question, you might want to + +
      +$policy_link +
    • + + +search to see if it has been asked and answered: +[submit_button_if_msie_p] +
      +
    + + +$pre_post_caveat + +
    +" +} else { + if ![empty_string_p $policy_link] { + set search_option "Before you post a new question, you might want to + +
      +$policy_link +
    +$pre_post_caveat +" + } else { + set search_option "$pre_post_caveat" + } +} + +ReturnHeaders + +ns_write "[bboard_header "Post New Message"] + +

    Post a New Message

    + +[ad_context_bar_ws_or_index [list "index.tcl" [bboard_system_name]] [list [bboard_raw_backlink $topic_id $topic $presentation_type 0] $topic] "Start New Thread"] + +
    + +$search_option + +
    +[philg_hidden_input q_and_a_p t] +[philg_hidden_input topic $topic] +[philg_hidden_input topic_id $topic_id] +[philg_hidden_input refers_to NEW] + + + + + + +" + +# think about writing a category SELECT + +if { $q_and_a_categorized_p == "t" && $q_and_a_solicit_category_p == "t" } { + set categories [database_to_tcl_list $db "select distinct category, upper(category) from bboard_q_and_a_categories where topic_id = $topic_id order by 2"] + set html_select "" + ns_write "\n" +} + +if { $custom_sort_key_p == "t" && $custom_sort_solicit_p == "t" } { + ns_write " +\n" + if { $custom_sort_solicit_pretty_p == "t" } { + ns_write "" + } +} + +ns_write " + + + + + + +
    Subject Line
    (summary of question)
    Category\n$html_select\n(this helps build the FAQ archives)
    This is a special bulletin board where the top level page presents messages according to a custom sort key: \"$custom_sort_key_name\"
    $custom_sort_key_name" + # need to put in a widget + if { $custom_sort_key_type == "date" } { + ns_write [_ns_dateentrywidget custom_sort_key] + } else { + ns_write "" + } + ns_write "
    $custom_sort_pretty_name $custom_sort_pretty_explanation
    Notify Me of Responses + Yes + No + +
    Message
    + +
    Text above is: +
    + +

    + +

    + + + + +
    + +
    +" + +ns_write " +[bboard_footer] +" Index: web/openacs/www/bboard/q-and-a-post-reply-form.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/q-and-a-post-reply-form.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/q-and-a-post-reply-form.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,116 @@ +# q-and-a-post-reply-form.tcl,v 3.0 2000/02/06 03:34:17 ron Exp +# q-and-a-post-reply-form.tcl +# +# philg@arsdigita.com, hqm@arsdigita.com +# + +ad_page_variables { + refers_to +} + +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set form_refers_to $refers_to + +# we can't just use set_form_variables because that would set +# "refers_to" which is about to be overwritten by the db query + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + ns_returnredirect /register.tcl?return_url=[ns_urlencode "[bboard_partial_url_stub]q-and-a-post-reply-form.tcl?refers_to=$form_refers_to"] + return +} + +set selection [ns_db 0or1row $db "select users.user_id, users.first_names || ' ' || users.last_name as name, +bboard.topic_id, bboard_topics.topic, bboard.category, bboard.one_line, bboard.message, bboard.html_p +from bboard, users, bboard_topics +where bboard_topics.topic_id = bboard.topic_id +and users.user_id = bboard.user_id +and msg_id = '$form_refers_to'"] + +if { $selection == "" } { + # message was probably deleted + ns_return 200 text/html "Couldn't find message $form_refers_to. Probably the message to which you are currently trying to reply has deleted by the forum maintainer." + return +} + + +set_variables_after_query + +if [catch {set selection [ns_db 1row $db "select distinct * from bboard_topics where topic_id=$topic_id"]} errmsg] { + bboard_return_cannot_find_topic_page + return +} +set_variables_after_query + + + +ReturnHeaders + +ns_write "[bboard_header "Post Answer"] + + +

    Post an Answer

    + +[ad_context_bar_ws_or_index [list "index.tcl" [bboard_system_name]] [list [bboard_raw_backlink $topic_id $topic $presentation_type 0] $topic] "Post Answer"] + +
    + +

    Original question

    + +
    +Subject: $one_line +
    +
    +[util_maybe_convert_to_html $message $html_p] +
    +
    +-- [ad_present_user $user_id $name] +
    + +

    Your Response

    + +
    +
    +[export_form_vars topic topic_id category] + + + + + +Subject: +
    + + +

    + + +Answer: + +
    + + + +

    +The above text is: + + +

    +

    + +
    +
    +
    + + +" Index: web/openacs/www/bboard/q-and-a-search-form.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/q-and-a-search-form.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/q-and-a-search-form.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,42 @@ +# q-and-a-search-form.tcl,v 3.1 2000/02/23 01:49:39 bdolicki Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +# topic_id, topic required + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +if {[bboard_get_topic_info] == -1} { + return +} + + +set search_submit_button "" +if { [msie_p] == 1 } { + set search_submit_button "" +} + +set_variables_after_query + +set search_server [ad_parameter BounceQueriesTo site-wide-search ""] + + +ns_return 200 text/html "[bboard_header "Search $topic Q&A"]\ + +

    Search

    + +[ad_context_bar_ws_or_index [list "index.tcl" [bboard_system_name]] [list [bboard_raw_backlink $topic_id $topic $presentation_type 0] $topic] "Search"] + +
    +
    + + +Full Text Search: +$search_submit_button +
    + +[bboard_footer]" Index: web/openacs/www/bboard/q-and-a-search.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/q-and-a-search.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/q-and-a-search.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,137 @@ +# q-and-a-search.tcl,v 3.1 2000/02/23 01:49:39 bdolicki Exp +ad_return_if_another_copy_is_running + +set_the_usual_form_variables + +# query_string, topic, topic_id + +# If we're doing the dual server thing and the user still got here somehow, +# bounce them over to the search server. +set search_server [ad_parameter BounceQueriesTo site-wide-search ""] +if { ![empty_string_p $search_server] } { + ns_returnredirect "$search_server/bboard/q-and-a-search.tcl?[export_entire_form_as_url_vars]" + return +} + + +if { ![info exists query_string] || $query_string == "" } { + # probably using MSIE + ns_return 200 text/html "[bboard_header "Missing Query"] + +

    Missing Query

    + +
    + +Either you didn't type a query string or you're using a quality Web +browser like Microsoft Internet Explorer 3.x (which neglects to +pass user input up the server). + +[bboard_footer] +" + return +} + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return +} + + +set results_base_url [ad_parameter BounceResultsTo site-wide-search ""] + +# we ask for all the top level messages + +ReturnHeaders + +ns_write "[bboard_header "Search Results"] + +

    Messages matching \"$query_string\"

    + +[ad_context_bar_ws_or_index [list "$results_base_url/bboard/index.tcl" [bboard_system_name]] [list "$results_base_url/bboard/[bboard_raw_backlink $topic_id $topic $presentation_type 0]" $topic] "Search Results"] + +
    + +
      +" + +if { [bboard_pls_blade_installed_p] } { + ns_write "Sorry, PLS is not yet supported by OpenACS
      " + [bboard_footer] + return +} elseif { [bboard_openacs_search_installed_p] } { + regsub -all {,+} [string trim $QQquery_string] " " final_query_string + + set sql " + select rank_for_search('$final_query_string', + email || first_names || last_name || one_line || message::text) as the_score, + case when bboard.refers_to is null then 1 else 0 end, + bboard.*, users.first_names || ' ' || users.last_name as name, users.email + from bboard, users, bboard_topics + where rank_for_search('$final_query_string', email || first_names || last_name || one_line || message::text) > 0 + and bboard.user_id = users.user_id + and (active_p = 't' or active_p is null) + and (bboard_topics.moderation_policy is null or bboard_topics.moderation_policy != 'private') + and bboard_topics.topic_id = '$QQtopic_id' + and bboard.topic_id = bboard_topics.topic_id + order by 1 desc, 2 desc" + + set selection [ns_db select $db $sql] +} + +set counter 0 + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + incr counter + if { ![info exists max_score] } { + # first iteration, this is the highest score + set max_score $the_score + } + + if { [ad_search_results_cutoff $counter $the_score $max_score] } { + ns_db flush $db + break + } + + if { [string first "." $sort_key] == -1 } { + # there is no period in the sort key so this is the start of a thread + set thread_start_msg_id $sort_key + } else { + # strip off the stuff before the period + regexp {(.*)\..*} $sort_key match thread_start_msg_id + } + set display_string $one_line + if { $subject_line_suffix == "name" } { + append display_string " ($name)" + } elseif { $subject_line_suffix == "email" } { + append display_string " ($email)" + } + ns_write "
    • $the_score: $display_string\n" +} + + +set user_id [ad_get_user_id] +ad_record_query_string $query_string $db $topic $counter $user_id + + +if { $counter == 0 } { + ns_write "
    • sorry, but no messages matched this query; remember that your query string should be space-separated words without plurals (since we're just doing simple stupid keyword matching)\n" +} + +ns_write " +
    + +
    +[export_form_vars topic topic_id] +New Search: +
    + +[bboard_footer] +" + Index: web/openacs/www/bboard/q-and-a-thread-alert.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/q-and-a-thread-alert.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/q-and-a-thread-alert.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,23 @@ +# q-and-a-thread-alert.tcl,v 3.0 2000/02/06 03:34:20 ron Exp +ad_page_variables { + thread_id +} +page_validation { + bboard_validate_msg_id $thread_id +} +# thread_id + +set user_id [ad_verify_and_get_user_id] +if { $user_id == 0 } { + set return_url "/bboard/q-and-a-thread-alert.tcl?[export_url_vars thread_id]" + ns_returnredirect "/register/index.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +ns_db dml $db "insert into bboard_thread_email_alerts (thread_id, user_id) +values ('$thread_id', $user_id)" + +ns_returnredirect "q-and-a-fetch-msg.tcl?msg_id=[ns_urlencode $thread_id]" + Index: web/openacs/www/bboard/q-and-a-thread-unalert.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/q-and-a-thread-unalert.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/q-and-a-thread-unalert.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,24 @@ +# q-and-a-thread-unalert.tcl,v 1.1.2.1 2000/03/18 00:47:33 bcameros Exp +ad_page_variables { + thread_id +} +page_validation { + bboard_validate_msg_id $thread_id +} +# thread_id + +set user_id [ad_verify_and_get_user_id] +if { $user_id == 0 } { + set return_url "/bboard/q-and-a-thread-alert.tcl?[export_url_vars thread_id]" + ns_returnredirect "/register/index.tcl?[export_url_vars return_url]" + return +} + +set db [ns_db gethandle] + +ns_db dml $db "delete from bboard_thread_email_alerts +where thread_id='$thread_id' + and user_id=$user_id" + +ns_returnredirect "q-and-a-fetch-msg.tcl?msg_id=[ns_urlencode $thread_id]" + Index: web/openacs/www/bboard/q-and-a-unanswered.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/q-and-a-unanswered.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/q-and-a-unanswered.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,67 @@ +# q-and-a-unanswered.tcl,v 3.0 2000/02/06 03:34:22 ron Exp +# q-and-a-unanswered.tcl +# +# by philg@mit.edu in 1995 +# +# returns a listing of the threads that haven't been answered, +# sorted by descending date + +set_the_usual_form_variables + +# topic (required) + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return +} + + +ReturnHeaders + +ns_write "[bboard_header "$topic Unanswered Questions"] + +

    Unanswered Questions

    + +[ad_context_bar_ws_or_index [list "index.tcl" [bboard_system_name]] [list [bboard_raw_backlink $topic_id $topic $presentation_type 0] $topic] "Unanswered Questions"] + +
    + +
      +" + +set rest_of_page "" + +# we want only top level questions that have no answers + +set sql "select urgent_p, msg_id, one_line, sort_key, posting_time, bbd1.user_id as poster_id, users.email, users.first_names || ' ' || users.last_name as name +from bboard bbd1, users +where bbd1.user_id = users.user_id +and topic_id = $topic_id +and 0 = (select count(*) from bboard bbd2 where bbd2.refers_to = bbd1.msg_id) +and refers_to is null +order by sort_key $q_and_a_sort_order" + +set selection [ns_db select $db $sql] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + append rest_of_page "
    • $one_line [bboard_one_line_suffix $selection $subject_line_suffix]\n" + +} + +append rest_of_page " + +
    + +[bboard_footer] +" + +ns_db releasehandle $db + +ns_write $rest_of_page Index: web/openacs/www/bboard/q-and-a-uninteresting.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/q-and-a-uninteresting.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/q-and-a-uninteresting.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,110 @@ +# q-and-a-uninteresting.tcl,v 3.0 2000/02/06 03:34:23 ron Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +# topic required + +# we're just looking at the uninteresting postings now + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return +} + + +ReturnHeaders + +ns_write "[bboard_header "Uninteresting $topic Threads"] + +

    Uninteresting Threads

    + +in the $topic question and answer forum + +
    + + +" + +if { $q_and_a_categorized_p == "t" } { + # we present "interest_level == NULL" on the top page + set sql "select msg_id, one_line, sort_key, email, users.first_names || ' ' || users.last_name as name, category, category = '' as uncategorized_p +from bboard, users +where bboard.user_id = users.user_id +and topic_id = $topic_id +and refers_to is null +and interest_level < [bboard_interest_level_threshold] +order by uncategorized_p, category, sort_key $q_and_a_sort_order" + set selection [ns_db select $db $sql] + + set last_category "there ain't no stinkin' category with this name" + set first_category_flag 1 + + while {[ns_db getrow $db $selection]} { + set_variables_after_query + if { $category != $last_category } { + set last_category $category + if { $first_category_flag != 1 } { + # we have to close out a
      + ns_write "\n
    \n" + } else { + set first_category_flag 0 + } + if { $category == "" } { + set pretty_category "Uncategorized" + } else { + set pretty_category $category + } + ns_write "

    $pretty_category

    + +
      +" + } + set display_string "$one_line" + if { $subject_line_suffix == "name" } { + append display_string " ($name)" + } elseif { $subject_line_suffix == "email" } { + append display_string " ($email)" + } + ns_write "
    • $display_string\n" +} +} else { + # not categorized + set sql "select msg_id, one_line, sort_key, email, users.first_names || ' ' || users.last_name as name +from bboard, users +where bboard.user_id = users.user_id +and topic_id = $topic_id +and refers_to is null +and interest_level < [bboard_interest_level_threshold] +order by sort_key $q_and_a_sort_order" + set selection [ns_db select $db $sql] + +ns_write "
        \n" + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + set display_string "$one_line" + if { $subject_line_suffix == "name" && $name != "" } { + append display_string " ($name)" + } elseif { $subject_line_suffix == "email" && $email != "" } { + append display_string " ($email)" + } + ns_write "
      • $display_string\n" + +} +} + +# let's assume there was at least one section + +ns_write " + +
      + + +[bboard_footer] +" Index: web/openacs/www/bboard/q-and-a-update-category.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/q-and-a-update-category.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/q-and-a-update-category.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,117 @@ +# q-and-a-update-category.tcl,v 3.0 2000/02/06 03:34:24 ron Exp +ad_page_variables { + msg_id + category + {new_category_p "f"} +} +page_validation { + bboard_validate_msg_id $msg_id +} + +# msg_id, category, maybe new_category_p + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +set topic_id [database_to_tcl_string $db "select distinct topic_id from bboard where msg_id = '$msg_id'"] + + +if {[bboard_get_topic_info] == -1} { + return} + +if {[bboard_admin_authorization] == -1} { + return +} + + + +# cookie checks out; user is authorized + +if { $category == "Define New Category" } { + ns_returnredirect "admin-q-and-a-prompt-for-new-category.tcl?msg_id=$msg_id" + return +} + +if { [info exists new_category_p] && $new_category_p == "t" } { + if [catch {ns_db dml $db "insert into bboard_q_and_a_categories (topic_id, category) values ($topic_id,'$QQcategory')"} errmsg] { + # something went wrong + ns_return 200 text/html " + +New Category Not Updated + + + +

      New Category Not Updated

      + +
      + +The database rejected the addition of the new category \"$category\". +Here was the error message: + +
      +$errmsg
+
      + +If you see \"integrity constraint\" somewhere in the message, it +probably means that topic_id $topic already has a category called \"$category\" +and you did not need to add it. + +
      +
      [bboard_system_owner]
       + + +" + return +} +} + +# if we got here, it means the new category was added successfully +# and/or there was no need to add a category + +if [catch {ns_db dml $db "update bboard set category = '$QQcategory' where msg_id = '$msg_id' "} errmsg] { + # something went wrong + ns_return 500 text/html " + +Update Failed + + + +

      Update Failed

      + +
      + +The database rejected the categorization of msg $msg_id. +Here was the error message: + +
      +$errmsg
+
      + +This is probably some kind of bug in this software. + +
      +
      [bboard_system_owner]
       + + +" + return +} +# if we got here, it means that we did everything right + + +ns_return 200 text/html " + +Done + + + +

      Done

      + +
      + +Message $msg_id categorized. + +[bboard_footer]" Index: web/openacs/www/bboard/q-and-a.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/q-and-a.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/q-and-a.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,272 @@ +# q-and-a.tcl,v 3.1 2000/02/23 01:49:39 bdolicki Exp +# q-and-a.tcl +# +# philg@arsdigita.com +# hqm@arsdigita.com +# +# top-level page for displaying a forum in Q&A format +# + +set_the_usual_form_variables + +# form vars: +# topic_id, topic + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +if { [bboard_get_topic_info] == -1 } { + return +} + + +set menubar_options [list] + +set user_id [ad_verify_and_get_user_id] + +# see if the user is an admin for any of the groups this topic belongs to +if {[bboard_user_is_admin_for_topic $db $user_id $topic_id]} { + set administrator_p 1 +} else { + set administrator_p 0 +} + +if $administrator_p { + lappend menubar_options "Administer" +} + +if { $users_can_initiate_threads_p != "f" } { + lappend menubar_options "Ask a Question" +} + +if { [bboard_pls_blade_installed_p] || [bboard_openacs_search_installed_p] } { + lappend menubar_options "Search" +} + +lappend menubar_options "Unanswered Questions" + +lappend menubar_options "New Answers" + +if { ![empty_string_p $policy_statement] } { + lappend menubar_options "About" +} + + + +append whole_page "[bboard_header "$topic Top Level"] + +

      $topic

      + +[ad_context_bar_ws_or_index [list "index.tcl" [bboard_system_name]] $topic] + +
      + +\[ [join $menubar_options " | "] \] + +" + +if { $q_and_a_categorized_p == "t" && (![info exists category_centric_p] || $category_centric_p == "f")} { + append whole_page " + +

      New Questions

      + + +
        + +" +} else { + append whole_page " + +
          + +" +} + +# this is not currently used, moderation should be turned on with certain +# moderation_policies in case we add more + + +set approved_clause "" +if { $q_and_a_categorized_p == "t" } { + set sql "select urgent_p, msg_id, one_line, sort_key, posting_time, email, first_names || ' ' || last_name as name, users.user_id as poster_id +from bboard, users +where topic_id = $topic_id $approved_clause +and bboard.user_id = users.user_id +and refers_to is null +and posting_time > (sysdate() - $q_and_a_new_days)::date +order by sort_key $q_and_a_sort_order" +} elseif { [info exists custom_sort_key_p] && $custom_sort_key_p == "t" } { + set sql "select urgent_p, msg_id, one_line, sort_key, posting_time, email, first_names || ' ' || last_name as name, custom_sort_key, custom_sort_key_pretty, users.user_id as poster_id +from bboard, users +where topic_id = $topic_id $approved_clause +and refers_to is null +and bboard.user_id = users.user_id +order by custom_sort_key $custom_sort_order" } else { + set sql "select urgent_p, msg_id, one_line, sort_key, posting_time, email, first_names || ' ' || last_name as name, users.user_id as poster_id +from bboard, users +where topic_id = $topic_id $approved_clause +and bboard.user_id = users.user_id +and refers_to is null +order by sort_key $q_and_a_sort_order +" +} + + +if { ![info exists category_centric_p] || $category_centric_p == "f" } { + # we're not only doing categories + set selection [ns_db select $db $sql] + + while {[ns_db getrow $db $selection]} { + set_variables_after_query + if { [info exists custom_sort_key_p] && $custom_sort_key_p == "t" } { + if { $custom_sort_key_pretty != "" } { + set prefix "${custom_sort_key_pretty}: " + } elseif { $custom_sort_key != "" } { + set prefix "${custom_sort_key}: " + } else { + set prefix "" + } + append whole_page "
        • ${prefix}$one_line [bboard_one_line_suffix $selection $subject_line_suffix]\n" + } else { + append whole_page "
        • $one_line [bboard_one_line_suffix $selection $subject_line_suffix]\n" + } + + } +} + +append whole_page " + +
        +         + +" + +if { $q_and_a_categorized_p == "t" } { + if { $q_and_a_show_cats_only_p == "t" } { + append whole_page "

        Older Messages (by category)

        \n\n
          \n" + # this is a safe operation because $topic has already been verified to exist + # in the database (i.e., it won't contain anything naughty for the eval in memoize) + append whole_page [util_memoize "bboard_compute_categories_with_count $topic_id" 300] + append whole_page "

          +

        • Uncategorized +
        " + } elseif { [info exists category_centric_p] && $category_centric_p == "t" } { + # this is for 6.001 forums where every message must be under + # a category + set sql "select category from +bboard_q_and_a_categories +where topic_id = $topic_id +order by 1" + set selection [ns_db select $db $sql] + set counter 0 + append whole_page "
          " + while {[ns_db getrow $db $selection]} { + set_variables_after_query + incr counter + append whole_page "
        • $category\n" + } + if { $counter == 0 } { + append whole_page "nobody is using this forum yet" + } + append whole_page "
        " + } else { + # we now have to present the older messages + # (if uncategorized, the query above was enough to get everything) + if { $q_and_a_use_interest_level_p == "t" } { + set interest_clause "and (interest_level is NULL or interest_level >= [bboard_interest_level_threshold])\n" + } else { + # not restricting by interest level + set interest_clause "" + } + set sql "select msg_id, one_line, sort_key, posting_time, email, first_names || ' ' || last_name as name, category, (category is null or category = 't') as uncategorized_p, users.user_id as poster_id +from bboard, users +where topic_id = $topic_id +and bboard.user_id = users.user_id +and refers_to is null +$interest_clause +and posting_time <= (sysdate() - $q_and_a_new_days)::date +order by uncategorized_p, category, sort_key $q_and_a_sort_order" + set selection [ns_db select $db $sql] + + set last_category "there ain't no stinkin' category with this name" + set first_category_flag 1 + + while {[ns_db getrow $db $selection]} { + set_variables_after_query + if { $category != $last_category } { + set last_category $category + if { $first_category_flag != 1 } { + # we have to close out a
          + append whole_page "\n
        \n" + } else { + set first_category_flag 0 + } + if { $category == "" } { + set pretty_category "Uncategorized" + } else { + set pretty_category $category + } + append whole_page "

        $pretty_category

        + +
          +" + } + + append whole_page "
        • $one_line [bboard_one_line_suffix $selection $subject_line_suffix]\n" +} + +# let's assume there was at least one section + +append whole_page "\n
        \n" + +} +# done showing the extra stuff for categorized bboard +} + +if { [bboard_pls_blade_installed_p] || [bboard_openacs_search_installed_p] } { + + set search_submit_button "" + if { [msie_p] == 1 } { + set search_submit_button "" + } + + set search_server [ad_parameter BounceQueriesTo site-wide-search ""] + + append whole_page "
        + + +Full Text Search: +$search_submit_button +
        " + +# if { $q_and_a_use_interest_level_p == "t" && $q_and_a_show_cats_only_p == "f" } { +# append whole_page "Note: the full-text search engine looks through more messages than you see above. Old postings that have been deemed \"not of general interest\" are not presented above, but they are available to the full text search engine. If you want to see what you're missing, you can get +# a whole page of uninteresting postings. +#

        +# " +# } + +} + +append whole_page " + +This forum is maintained by $maintainer_name. +You can get a summary of the forum's age and content from +the statistics page. + +

        + +If you want to follow this discussion by email, + +click here to add an alert. + + +[bboard_footer] +" + +ns_db releasehandle $db + +ns_return 200 text/html $whole_page Index: web/openacs/www/bboard/redirect-for-sws.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/redirect-for-sws.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/redirect-for-sws.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,33 @@ +# Target page for redirecting results of a site wide search query. + +ad_page_variables { + {msg_id} +} +page_validation { + bboard_validate_msg_id $msg_id +} + +# msg_id + +set db [ns_db gethandle] +if { $db == "" } { + ad_return_error_page + return +} + +set selection [ns_db 1row $db "select presentation_type, sort_key, bboard_topics.topic_id, bboard_topics.topic +from bboard, bboard_topics +where bboard.msg_id = '$msg_id' +and bboard_topics.topic_id = bboard.topic_id"] + +set_variables_after_query + +if { [string first "." $sort_key] == -1 } { + # there is no period in the sort key so this is the start of a thread + set thread_start_msg_id $sort_key +} else { + # strip off the stuff before the period + regexp {(.*)\..*} $sort_key match thread_start_msg_id +} + +ns_returnredirect [bboard_msg_url $presentation_type $thread_start_msg_id $topic_id $topic] Index: web/openacs/www/bboard/sample-questions.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/sample-questions.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/sample-questions.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,80 @@ +# sample-questions.tcl,v 3.0 2000/02/06 03:34:30 ron Exp +set edf_management_blather {

        Sample Questions to Ask Companies About Pollution Prevention

        + +Pollution prevention means not creating waste in the first place and +reducing the use of toxic chemicals as inputs into business +operations. Pollution prevention is different from "pollution +control" or "waste management" (including recycling, treatment, +burning, and disposal), which are less preferred methods to protect +the environment. These strategies only stop waste chemicals from +entering the environment after they have been +unintentionally created. + +

        + +The five sample questions on pollution prevention can help you +distinguish between real reductions in pollution and reductions which +only occur on paper, and can help you gain additional information +about facility environmental practices and performance. Feel free to +edit the questions before posting them for a company to respond. + +

        + +

          +
        1. What toxic chemicals does your facility use or produce that it does not report to TRI , and has your facility switched to these chemicals since 1988? +

          +

        2. Were TRI reductions a result of calculating or measuring releases in a different manner, having other facilities perform operations formerly performed on-site, or a decline in production? Please explain. +

          +

        3. Do you have a pollution prevention plan, or an equivalent document identifying changes that will be made to improve plant efficiency and reduce use of toxic chemicals, with a summary that you will share with the public? +

          +

        4. Does your facility use materials accounting (i.e., input-output calculations) to identify pollution prevention opportunities? +

          +

        5. I am interested in how your total waste generation to air, water, and land relates to your production. Is the total production-related waste (TPRW) per unit produced declining? Please provide annual numbers (TPRW, units produced, and define the units used). +

          +

        + +

        Sample Questions to Ask Companies about an Unusual Event Such as a Spill or a Stack Release

        + +The two sample questions about an unusual event will enable you to see +if a company has an acceptable explanation for an accident or other +event, and whether it has a system in place to investigate problems +and prevent them in the future. Begin your questioning by describing +the event, including what occurred, when it occurred, and where, being +as specific as possible. Feel free to edit the questions before +posting them for a company to respond. + +
          +
        1. Please explain what happened, and why. + +
        2. What actions are being taken, or have been taken, to prevent this +event from happening again? + +
        + +} + +set_the_usual_form_variables + +# topic required + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +bboard_get_topic_info + +ReturnHeaders + +ns_write "[bboard_header "Sample Questions"] + +

        Sample Questions

        + +for the [bboard_complete_backlink $topic_id $topic $presentation_type] + +
        + +$edf_management_blather + +[bboard_footer]" Index: web/openacs/www/bboard/search-default-main.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/search-default-main.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/search-default-main.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,41 @@ +# search-default-main.tcl,v 3.1 2000/02/23 01:49:39 bdolicki Exp +set_form_variables +set_form_variables_string_trim_DoubleAposQQ + +# query_string, topic + +ns_return 200 text/html " + +Search Results Default Main + + + +

        Search Results

        + +from looking through + +the \"$topic\" BBoard + +for \"$query_string\" + +
        + +The full text index covers the subject line, body, email address, and +name fields of each posting. + +

        + + +If the results above aren't what you had in mind, then you can refine +your search... + +

        + +

        + + +Full Text Search: +
        + +[bboard_footer] +" Index: web/openacs/www/bboard/search-entire-system.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/search-entire-system.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/search-entire-system.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,119 @@ +# search-entire-system.tcl,v 3.1 2000/02/20 10:57:29 ron Exp +set_the_usual_form_variables +# query_string + +set user_id [ad_verify_and_get_user_id] + +if { ![info exists query_string] || $query_string == "" } { + # probably using MSIE + ns_return 200 text/html "[bboard_header "Missing Query"] + +

        Missing Query

        + +
        + +Either you didn't type a query string or you're using a quality Web +browser like Microsoft Internet Explorer 3.x (which neglects to +pass user input up the server). + +[bboard_footer] +" + return +} + +# If we're doing the dual server thing and the user still got here somehow, +# bounce them over to the search server. +set search_server [ad_parameter BounceQueriesTo site-wide-search ""] +if { ![empty_string_p $search_server] } { + ns_returnredirect "$search_server/bboard/search-entire-system.tcl?[export_entire_form_as_url_vars]" + return +} + + + +set db [ns_db gethandle] +if { $db == "" } { + ad_return_error_page + return +} + + +# we ask for all the top level messages + +ReturnHeaders + +ns_write "[bboard_header "Search Results"] + +

        Messages matching \"$query_string\"

        + +[ad_context_bar_ws_or_index [list "index.tcl" [bboard_system_name]] "Search Results"] + +
        + +
          + +" + +if { [bboard_pls_blade_installed_p] } { + ns_write "Not yet implemented with postgres. +

        +[bboard_footer] +" + return +} elseif { [bboard_openacs_search_installed_p] } { + regsub -all {,+} [string trim $QQquery_string] " " final_query_string + + set sql " + select rank_for_search('$final_query_string', + email || first_names || last_name || one_line || message::text) as the_score, + case when bboard.refers_to is null then 1 else 0 end, + bboard.*, users.first_names || ' ' || users.last_name as name, users.email, bboard_topics.presentation_type, bboard_topics.topic + from bboard, users, bboard_topics + where rank_for_search('$final_query_string', email || first_names || last_name || one_line || message::text) > 0 + and bboard.user_id = users.user_id + and (active_p = 't' or active_p is null) + and (bboard_topics.moderation_policy is null or bboard_topics.moderation_policy != 'private') + and bboard_topics.topic_id = bboard.topic_id + order by 1 desc, 2 desc" + set selection [ns_db select $db $sql] +} + +set counter 0 + +set results_base_url [ad_parameter BounceResultsTo site-wide-search ""] + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + incr counter + if { ![info exists max_score] } { + # first iteration, this is the highest score + set max_score $the_score + } + if { [ad_search_results_cutoff $counter $the_score $max_score] } { + ns_db flush $db + break + } + if { [string first "." $sort_key] == -1 } { + # there is no period in the sort key so this is the start of a thread + set thread_start_msg_id $sort_key + } else { + # strip off the stuff before the period + regexp {(.*)\..*} $sort_key match thread_start_msg_id + } + + ns_write "

      • $the_score: $one_line +(topic: $topic) +" +} + + +ad_record_query_string $query_string $db "entire bboard" $counter $user_id + +if { $counter == 0 } { + ns_write "
      • sorry, but no messages matched this query; remember that your query string should be space-separated words without plurals (since we're just doing simple stupid keyword matching)\n" +} + +ns_write " +
      +[bboard_footer] +" Index: web/openacs/www/bboard/search-pls-default-main.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/search-pls-default-main.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/search-pls-default-main.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,40 @@ +# search-pls-default-main.tcl,v 3.1 2000/02/23 01:49:39 bdolicki Exp +set_form_variables +set_form_variables_string_trim_DoubleAposQQ + +# query_string, topic + +ns_return 200 text/html " + +Search Results Default Main + + + +

      Search Results

      + +from looking through + +the \"$topic\" BBoard + +for \"$query_string\" + +
      + +The full text index covers the subject line, body, email address, and +name fields of each posting. + +

      + + +If the results above aren't what you had in mind, then you can refine +your search... + +

      + +

      + + +Full Text Search: +
      + +[bboard_footer]" Index: web/openacs/www/bboard/search-pls-subject.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/search-pls-subject.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/search-pls-subject.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,95 @@ +# search-pls-subject.tcl,v 3.0 2000/02/06 03:34:35 ron Exp +set_form_variables +set_form_variables_string_trim_DoubleAposQQ + +set user_id [ad_verify_and_get_user_id] + +# query_string, topic + +if { ![info exists query_string] || $query_string == "" } { + # probably using MSIE + ns_return 200 text/html "[bboard_header "Missing Query"] + +

      Missing Query

      + +
      + +Either you didn't type a query string or you're using a quality Web +browser like Microsoft Internet Explorer 3.x (which neglects to +pass user input up the server). + +[bboard_footer] +" + return +} + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + + + +# we ask for all the top level messages + +ReturnHeaders + +ns_write " + +Search Results + + + +Messages matching \"$query_string\" + +
      +"
+ad_context_query_string
+
+
+if [catch {set selection [ns_db select $db "select *
+from bboard
+where contains (indexed_stuff, '\$($query_string_for_ctx)', 10) > 0
+and topic_id = $topic_id
+and bboard_user_can_view_topic_p($user_id, $topic_id) = 't'
+order by score(10) desc"]} errmsg] {
+
+    ns_write "
+[ad_return_context_error $errmsg]
+[bboard_footer]"
+    return
+
+}
+
+set counter 0
+
+while {[ns_db getrow $db $selection]} {
+    incr counter
+
+    set_variables_after_query
+    if { [string first "." $sort_key] == -1 } {
+	# there is no period in the sort key so this is the start of a thread
+	set thread_start_msg_id $sort_key
+    } else {
+	# strip off the stuff before the period
+	regexp {(.*)\..*} $sort_key match thread_start_msg_id
+    }
+    ns_write "$one_line (view entire thread)\n"
+}
+
+ns_write "
+
      + + +" + +# let's cut the user free + +ns_conn close + +# but we keep the thread alive to log the query + +ad_record_query_string $query_string $db "bboard-$topic" $counter $user_id + Index: web/openacs/www/bboard/search-pls.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/search-pls.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/search-pls.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,50 @@ +# search-pls.tcl,v 3.0 2000/02/06 03:34:36 ron Exp +# this is for the whole frame + +set_form_variables + +# query_string, topic + +ns_return 200 text/html " + + + + + +$topic Search Results + + + + + + + + + + + + + + + + +This bulletin board system can only be used with a frames-compatible +browser. + +

      + +Perhaps you should consider running Netscape 2.0 or later? + + + + + + + + + +" + + + + Index: web/openacs/www/bboard/search-subject.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/search-subject.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/search-subject.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,101 @@ +# search-subject.tcl,v 3.0 2000/02/06 03:34:37 ron Exp +set_form_variables +set_form_variables_string_trim_DoubleAposQQ + +set user_id [ad_verify_and_get_user_id] + +# query_string, topic + +if { ![info exists query_string] || $query_string == "" } { + # probably using MSIE + ns_return 200 text/html "[bboard_header "Missing Query"] + +

      Missing Query

      + +
      + +Either you didn't type a query string or you're using a quality Web +browser like Microsoft Internet Explorer 3.x (which neglects to +pass user input up the server). + +[bboard_footer] +" + return +} + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return +} + + + +# we ask for all the top level messages + +ReturnHeaders + +ns_write " + +Search Results + + + +Messages matching \"$query_string\" + +
      +"
+
+regsub -all {,+} [string trim $QQquery_string] " " final_query_string
+
+if [catch {set selection [ns_db select $db "select /*+ INDEX(bboard bboard_for_one_category) */ bboard_contains(email, first_names || last_name, one_line, message,'$final_query_string') as the_score, bboard.*
+from bboard, users
+where bboard_contains(email, first_names || last_name, one_line, message,'$final_query_string') > 0
+and bboard.user_id = users.user_id
+and topic_id = $topic_id
+and bboard_user_can_view_topic_p($user_id,$topic_id) = 't'
+order by 1 desc"]} errmsg] {
+
+    ns_write "There aren't any results because something about
+your query string has made Oracle Context unhappy:
+
+$errmsg
+
+In general, ConText does not like special characters.  It does not like
+to see common words such as \"AND\" or \"a\" or \"the\".  
+I haven't completely figured this beast out.
+
+Back up and try again!
+
+
      +[bboard_footer]" + return + +} + +set counter 0 + +while {[ns_db getrow $db $selection]} { + incr counter + + set_variables_after_query + if { [string first "." $sort_key] == -1 } { + # there is no period in the sort key so this is the start of a thread + set thread_start_msg_id $sort_key + } else { + # strip off the stuff before the period + regexp {(.*)\..*} $sort_key match thread_start_msg_id + } + ns_write "$one_line (view entire thread)\n" +} + +ns_write " + + + +" Index: web/openacs/www/bboard/search.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/search.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/search.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,44 @@ +# search.tcl,v 3.0 2000/02/06 03:34:39 ron Exp +# this is for the whole frame + +set_form_variables + +# query_string, topic + +ns_return 200 text/html " + + + + + +$topic Search Results + + + + + + + + + + + + + + +This bulletin board system can only be used with a frames-compatible +browser. + +

      + +Perhaps you should consider running Netscape 2.0 or later? + + + + + + + + + +" \ No newline at end of file Index: web/openacs/www/bboard/shut-up.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/shut-up.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/shut-up.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,69 @@ +# shut-up.tcl,v 3.2 2000/02/16 23:41:30 bdolicki Exp +ad_page_variables { + {rowid QQ} +} + +# row_id is the key + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +# In case a forgotten-to-be-urlencoded "+" expands to a space... +regsub " " $row_id "+" row_id + +set sql "delete from bboard_thread_email_alerts +where rowid = '$QQrow_id'" + +with_transaction $db { + ns_db dml $db $sql +} { + ns_return 200 text/html " + +Database Update Failed + + + +

      Database Update Failed

      +Error trying to update the database. Email to [bboard_system_owner] please. Here was the message: +
      +
+$errmsg
+
+
      + +

      + +Which resulted from the following SQL: + +

      + + +$sql + + +" + return +} + + ns_return 200 text/html " + +Database Update Complete + + + +

      Database Update Complete

      + +
      + +Here was the SQL: + +

      + +$sql + + +[bboard_footer] +" Index: web/openacs/www/bboard/sort-by-n-messages.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/sort-by-n-messages.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/sort-by-n-messages.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,71 @@ +# sort-by-n-messages.tcl,v 3.3 2000/03/01 08:45:04 yon Exp +proc bboard_active_discussions_items {} { + set user_id [ad_get_user_id] + set items "" + set db [ns_db gethandle] + set selection [ns_db select $db "select bt.topic,bt.topic_id, bt.presentation_type, count(msg_id) as n_messages, max(posting_time) as latest_posting +from bboard_topics bt, bboard b +where bt.topic_id = b.topic_id +and (bt.group_id is null or ad_group_member_p ( $user_id, bt.group_id ) = 't' ) +group by bt.topic,bt.topic_id, bt.presentation_type +having count(msg_id) > 30 +order by count(msg_id) desc"] + + while {[ns_db getrow $db $selection]} { + set_variables_after_query + append items "

    • [bboard_complete_backlink $topic_id $topic $presentation_type] ($n_messages; latest on [util_AnsiDatetoPrettyDate $latest_posting])\n" + } + ns_db releasehandle $db + return $items +} + +proc bboard_n_new_messages {} { + set items "" + set db [ns_db gethandle] + set n_new [database_to_tcl_string $db "select count(*) +from bboard +where sysdate()::date - posting_time::date <= 1"] + ns_db releasehandle $db + return $n_new +} + +ReturnHeaders + +ns_write "[bboard_header "Active Discussions in [bboard_system_name]"] + +[ad_decorate_top "

      Active Discussions

      + +[ad_context_bar_ws_or_index [list "index.tcl" [bboard_system_name]] "Active Discussions"] +" [ad_parameter ActivePageDecoration bboard]] + +
      + +Total messages posted in last 24 hours: +[util_memoize bboard_n_new_messages 3600] + +
        +[bboard_active_discussions_items] +
      + +" + +# Can't memoize this right now because some topics are private! +# [util_memoize bboard_active_discussions_items 3600] + +if { [bboard_pls_blade_installed_p] } { + + ns_write "You can search through all of the +messages on all of the bulletin boards in this system. +
      +Full Text Search: +
      + +

      + +Note: this does not search through discussions that are private and protected +by a user password. +" + +} + +ns_write [bboard_footer] Index: web/openacs/www/bboard/statistics.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/statistics.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/statistics.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,121 @@ +# statistics.tcl,v 3.0 2000/02/06 03:34:43 ron Exp +set_the_usual_form_variables 0 + +# topic and topic_id (optional), show_total_bytes_p (optional (takes a long time)) + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if { ![info exists topic_id] || [empty_string_p $topic_id] } { + set page_title "[bboard_system_name] Statistics" + set page_headline $page_title + set where_clause "" + set and_clause "" + set context_bar "[ad_context_bar_ws_or_index [list "index.tcl" [bboard_system_name]] "Statistics"]" + set calendar_html [calendar_small_month -day_number_template "\$day_number"] +} else { + # security check (BMA, spec'ed by aD) + validate_integer topic_id $topic_id + + set page_title "$topic Statistics" + set page_headline "Statistics for the $topic Forum" + if { [bboard_get_topic_info] == -1 } { + # bboard_get_topic_info will have returned an error page + return + } + set where_clause "\nwhere topic_id = $topic_id" + set and_clause "\nand topic_id = $topic_id" + set context_bar "[ad_context_bar_ws_or_index [list "index.tcl" [bboard_system_name]] [list [bboard_raw_backlink $topic_id $topic $presentation_type 0] $topic] "Statistics"]" + set calendar_html [calendar_small_month -day_number_template "\$day_number"] +} + +if { ![info exists show_total_bytes_p] || !$show_total_bytes_p } { + set kbytes_item "" +} else { + set kbytes_item ", round(sum(char_length(message))/1000) as n_kbytes" +} + +ReturnHeaders + +ns_write "[bboard_header $page_title] + +

      $page_headline

      + +$context_bar + +
      + + + + + + + +
      + +
        +" + +set selection [ns_db 1row $db "select max(posting_time) as max_date, min(posting_time) as min_date, count(*) as n_msgs $kbytes_item +from bboard $where_clause"] + +set_variables_after_query + +ns_write " +
      • First message: $min_date +
      • Most recent posting: $max_date +
      • Number of archived messages: $n_msgs +(view by day) +" + +if [info exists n_kbytes] { + # we queried for it + ns_write "\n
      • Number of kbytes: $n_kbytes\n" +} else { + ns_write "\n
      • If you don't mind waiting for a few seconds, you can +ask +for a report including total number of bytes in the messages\n" +} + +ns_write " + +
      + +      		 + +$calendar_html + +
      + + +Note that these data do not include messages that were deleted (or +marked for expiration) by the forum moderator. + +

      Active Contributors

      + +
        + +" + +set selection [ns_db select $db "select bboard.user_id, first_names, last_name, count(*) as n_contributions +from bboard, users +where bboard.user_id = users.user_id $and_clause +group by bboard.user_id, first_names, last_name +having count(*) > round($n_msgs/200,0) +order by n_contributions desc"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + set complete_anchor "$first_names $last_name" + ns_write "
      • $complete_anchor ($n_contributions)\n" +} + +ns_write " +
      + +[bboard_footer] +" Index: web/openacs/www/bboard/subject.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/subject.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/subject.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,75 @@ +# subject.tcl,v 3.0 2000/02/06 03:34:45 ron Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +# topic_id, topic required +# start_msg_id is optional (used to show start of thread) +# feature_msg_id is optional (used to highlight a msg) + +set db [ns_db gethandle] + +if {[bboard_get_topic_info] == -1} { + return} + + +if { [info exists start_msg_id] && $start_msg_id != "" } { + set sql "select msg_id, one_line, sort_key, email, first_names || ' ' || last_name as name +from bboard , users +where users.user_id = bboard.user_id +and topic_id = $topic_id +and msg_id >= '$QQstart_msg_id' +order by sort_key" +} else { + set sql "select msg_id, one_line, sort_key, email, first_names || ' ' || last_name as name +from bboard, users +where users.user_id = bboard.user_id +and topic_id = $topic_id +order by sort_key" +} + +ReturnHeaders + +ns_write " + +Subject Window for $topic + + +
      "
+
+set selection [ns_db select $db $sql]
+
+set counter 0
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+
+    set n_spaces [expr 3 * [bboard_compute_msg_level $sort_key]]
+    if { $n_spaces == 0 } {
+	set pad ""
+    } else {
+	set pad [format "%*s" $n_spaces " "]
+    }
+
+    if { [info exists feature_msg_id] && $feature_msg_id == $msg_id } {
+	set display_string "$one_line"
+    } else {
+	set display_string "$one_line"
+    }
+
+    if { $subject_line_suffix == "name" } {
+	append display_string "  ($name)"
+    } elseif { $subject_line_suffix == "email" } {
+	append display_string "  ($email)"
+    }
+    ns_write "$pad$display_string\n"
+
+}
+
+if { $counter == 0 } {
+    ns_write "there have been no messages posted to this forum"
+}
+
+ns_write "
      + + +" Index: web/openacs/www/bboard/threads-by-day.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/threads-by-day.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/threads-by-day.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,78 @@ +# threads-by-day.tcl,v 3.0 2000/02/06 03:34:46 ron Exp +# threads-by-date.tcl +# +# shows number of threads in a forum initiated on a particular day, +# either all or limit to last 60 days +# +# by philg@mit.edu on June 26, 1999 + +set_the_usual_form_variables + +# topic required, all_p is optional + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if { [bboard_get_topic_info] == -1 } { + return +} + +ReturnHeaders + +ns_write "[bboard_header "$topic new threads by day"] + +

      New Threads by Day

      + +[ad_context_bar_ws_or_index [list "index.tcl" [bboard_system_name]] [list [bboard_raw_backlink $topic_id $topic $presentation_type 0] $topic] "Threads by Day"] + +
      + +Forum: $topic + +
        +" + +set selection [ns_db select $db "select trunc(posting_time) as kickoff_date, count(*) as n_msgs +from bboard +where topic_id = $topic_id +and refers_to is null +group by trunc(posting_time) +order by 1 desc"] + +set n_rows 0 +while { [ns_db getrow $db $selection] } { + set_variables_after_query + incr n_rows + if { ![info exists all_p] || !$all_p } { + # we might have to cut off after 60 days + if { $n_rows > 60 } { + append items "

        +... +

        +(list entire history) +" + ns_db flush $db + break + } + } + append items "

      • [util_AnsiDatetoPrettyDate $kickoff_date]: $n_msgs\n" +} + +if { $n_rows == 0 } { + ns_write "there haven't been any postings to this forum (or all have been deleted by the moderators)" +} else { + ns_write $items +} + +ns_write " +
      + +These counts do not reflect threads that were deleted by the forum +moderator(s). + +[bboard_footer] +" Index: web/openacs/www/bboard/threads-one-day-across-system.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/threads-one-day-across-system.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/threads-one-day-across-system.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,74 @@ +# threads-one-day-across-system.tcl,v 3.0 2000/02/06 03:34:47 ron Exp +# /bboard/threads-one-day-across-system.tcl +# +# by philg@mit.edu on October 8, 1999 +# + + +set_the_usual_form_variables + +# kickoff_date, maybe julian_date + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +if { [info exists julian_date] && ![empty_string_p $julian_date] } { + set kickoff_date [calendar_convert_julian_to_ansi $julian_date] + set QQkickoff_date [DoubleApos $kickoff_date] +} + +set pretty_date [util_AnsiDatetoPrettyDate $kickoff_date] + +ReturnHeaders + +ns_write "[bboard_header "Threads started on $pretty_date"] + +

      Threads started on $pretty_date

      + +[ad_context_bar_ws_or_index [list "index.tcl" [bboard_system_name]] [list "statistics.tcl" "Statistics"] [list "threads-by-day.tcl?[export_url_vars kickoff_date]" "Threads by Day"] "One Day"] + +
      + +
        + +" + +set selection [ns_db select $db "select bboard.topic, msg_id, one_line, sort_key, email, first_names || ' ' || last_name as name, users.user_id as poster_id, bboard_topics.presentation_type +from bboard, users, bboard_topics +where bboard.user_id = users.user_id +and bboard.topic = bboard_topics.topic +and refers_to is null +and bboard_topics.restricted_p = 'f' +and bboard_topics.restrict_to_workgroup_p = 'f' +and trunc(posting_time) = '$QQkickoff_date' +order by upper(bboard_topics.topic), sort_key"] + +set items "" +set n_rows 0 +set last_topic "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + incr n_rows + if { $topic != $last_topic } { + set last_topic $topic + append items "\n

        $topic

        \n" + } + append items "
      • $one_line ($name)\n" +} + +if { $n_rows == 0 } { + ns_write "no new threads were started on $pretty_date" +} else { + ns_write $items +} + +ns_write " + +
      + +[bboard_footer] +" Index: web/openacs/www/bboard/threads-one-day.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/threads-one-day.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/threads-one-day.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,71 @@ +# threads-one-day.tcl,v 3.0 2000/02/06 03:34:48 ron Exp +set_the_usual_form_variables + +# topic_id, topic, kickoff_date, maybe julian_date + +# security check (BMA, spec'ed by ad) +validate_integer topic_id $topic_id + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +if { [bboard_get_topic_info] == -1 } { + return +} + + +if { [info exists julian_date] && ![empty_string_p $julian_date] } { + set kickoff_date [calendar_convert_julian_to_ansi $julian_date] +} + +set pretty_date [util_AnsiDatetoPrettyDate $kickoff_date] + +ReturnHeaders + +ns_write "[bboard_header "$topic threads started on $pretty_date"] + +

      Threads started on $pretty_date

      + +[ad_context_bar_ws_or_index [list "index.tcl" [bboard_system_name]] [list [bboard_raw_backlink $topic_id $topic $presentation_type 0] $topic] [list "threads-by-day.tcl?[export_url_vars topic topic_id kickoff_date]" "Threads by Day"] "One Day"] + +
      + +Forum: $topic + +
        + +" + +set approved_clause "" +set selection [ns_db select $db "select msg_id, one_line, sort_key, email, first_names || ' ' || last_name as name, users.user_id as poster_id +from bboard, users +where topic_id = $topic_id $approved_clause +and bboard.user_id = users.user_id +and refers_to is null +and trunc(posting_time) = '[DoubleApos $kickoff_date]' +order by sort_key"] + +set items "" +set n_rows 0 + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + incr n_rows + append items "
      • $one_line ($name)\n" +} + +if { $n_rows == 0 } { + ns_write "no new threads were started on $pretty_date" +} else { + ns_write $items +} + +ns_write " + +
      + +[bboard_footer] +" Index: web/openacs/www/bboard/update-topic-categorization.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/update-topic-categorization.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/update-topic-categorization.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,95 @@ +# update-topic-categorization.tcl,v 3.0 2000/02/06 03:34:50 ron Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +# topic, q_and_a_categorized_p, q_and_a_solicit_category_p +# q_and_a_categorization_user_extensible_p, q_and_a_new_days, +# bunch of other new ones + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +if {[bboard_get_topic_info] == -1} { + return +} + +set update_sql [util_prepare_update $db bboard_topics topic $topic [ns_conn form]] + +if [catch {ns_db dml $db $update_sql} errmsg] { + ns_return 200 text/html " + +Topic Not Updated + + + +

      Topic Not Updated

      + +
      + +The database rejected the update of discussion topic \"$topic\". Here was +the error message: + +
      +$errmsg
+
      + +
      +
      [bboard_system_owner]
       + + +" +return 0 + +} + +# the database insert went OK + +set selection [ns_db 1row $db "select distinct * from bboard_topics where topic_id = $topic_id"] +set_variables_after_query + +ReturnHeaders + +ns_write " + +Topic Updated + + + +

      Topic Updated

      + +\"$topic\" updated in +[bboard_system_name] + +
      + +
        +" + +if { $q_and_a_categorized_p == "t" } { + ns_write "
      • When offered to users in Q&A forum format, this topic will be categorized. I.e., new questions will be presented chronologically on top but older questions will be sorted by category.\n" +} else { + ns_write "
      • When offered to users in Q&A forum format, this topic will not be categorized. I.e., all questions will be presented chronologically.\n" +} + +ns_write "
      • The definition of a \"new\" question will be \"posted within the last $q_and_a_new_days days.\"\n" + +if { $q_and_a_solicit_category_p == "t" } { + ns_write "
      • When users post a question, this system will ask them to suggest a category for the question.\n" +} else { + ns_write "
      • When users post a question, this system will not ask them to suggest a category for the question; the administrator (i.e., you) will have to hand-categorize all the questions.\n" +} + +if { $q_and_a_categorization_user_extensible_p == "t" } { + ns_write "
      • Users will be allowed to suggest new categories.\n" +} else { + ns_write "
      • Users will not be allowed to suggest new categories.\n" +} + +ns_write " + +
      + +[bboard_footer]" Index: web/openacs/www/bboard/update-topic.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/update-topic.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/update-topic.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,180 @@ +# update-topic.tcl,v 3.0 2000/02/06 03:34:51 ron Exp +set_form_variables_string_trim_DoubleAposQQ +set_form_variables + +page_validation { + validate_integer $topic_id +} + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +set exception_text "" +set exception_count 0 + +if { ![info exists maintainer_name] || $maintainer_name == "" } { + append exception_text "
    • You must enter a Maintainer Name. The system uses this information to generate part of the user interface" + incr exception_count +} + +if { ![info exists maintainer_email] || $maintainer_email == "" } { + append exception_text "
    • You must enter a Maintainer Email address. The system uses this information to generate part of the user interface" + incr exception_count +} + +if { ![info exists admin_password] || $admin_password == "" } { + append exception_text "
    • You must enter an administration password. Otherwise any random person from the Internet would be able to delete all of the messages on the bboard, restrict it so that users couldn't get into the bboard, etc." + incr exception_count +} + +if { $exception_count> 0 } { + if { $exception_count == 1 } { + set problem_string "a problem" + set please_correct "it" + } else { + set problem_string "some problems" + set please_correct "them" + } + ns_return 200 text/html " + +Problem Updating Topic + + +

      Problem Updating Topic

      + +
      + +We had $problem_string updating your topic: + +
        + +$exception_text + +
      + +Please back up using your browser, correct $please_correct, +and resubmit your form. + +

      + +Thank you. + +

      + +
      [bboard_system_owner]
       + + + +" + +return 0 + +} + +# no exceptions found + +set extra_set "" + +if { [bboard_use_ns_perm_authorization_p] == 1 && [info exists ns_perm_group] } { + if { $ns_perm_group == {Do Not Use ns_perm} } { + set extra_set ",\nns_perm_group = NULL" + } else { + set extra_set ",\nns_perm_group = '$QQns_perm_group'" + } +} + +if [catch {ns_db dml $db "update bboard_topics +set backlink = '$QQbacklink', +backlink_title = '$QQbacklink_title', +admin_password = '$QQadmin_password', +user_password = '$QQuser_password', +maintainer_name = '$QQmaintainer_name', +maintainer_email = '$QQmaintainer_email', +subject_line_suffix = '$QQsubject_line_suffix', +pre_post_caveat = '$QQpre_post_caveat', +notify_of_new_postings_p = '$QQnotify_of_new_postings_p', +presentation_type = '$QQpresentation_type' $extra_set +where topic_id = $topic_id"} errmsg] { + ns_return 200 text/html " + +Topic Not Updated + + + +

      Topic Not Updated

      + +
      + +The database rejected the update of discussion topic \"$topic\". Here was +the error message: + +
      +$errmsg
+
      + +
      +
      [bboard_system_owner]
       + + +" +return 0 + +} + +# the database insert went OK + +set selection [ns_db 1row $db "select distinct * from bboard_topics where topic_id = $topic_id"] +set_variables_after_query + +if { $notify_of_new_postings_p == "t" } { + set notify_blurb "Maintainer will be notified via email every time there is a new posting" +} else { + set notify_blurb "Maintainer will not be notified of new postings" +} + +if { [bboard_use_ns_perm_authorization_p] == 1 && $user_password != "" } { + if { $ns_perm_group != "" } { + set authorization_line "
    • this is a private group, open only to those who know the user password and members of the \"$ns_perm_group\" ns_perm group" + } else { + # private but not using ns_perm + set authorization_line "
    • this is a private group, open only to those who know the user password" + } +} else { + set authorization_line "" +} + +ns_return 200 text/html " + +Topic Updated + + + +

      Topic Updated

      + +\"$topic\" updated in +[bboard_system_name] + +
      + +
        +
      • Backlink: $backlink_title +
      • Maintainer: $maintainer_name ($maintainer_email) +
      • Admin Password: \"$admin_password\" +
      • User Password: \"$user_password\" +$authorization_line +
      • What to add after the Subject line: \"$subject_line_suffix\" +
      • $notify_blurb +
      + + + + +Remember to link to the user page from your public pages and bookmark +the +admin page after you return there. + +[bboard_footer]" Index: web/openacs/www/bboard/uploaded-file.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/uploaded-file.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/uploaded-file.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,25 @@ +# uploaded-file.tcl,v 3.0 2000/02/06 03:34:52 ron Exp +ad_page_variables { + {bboard_upload_id} +} + +page_validation { + validate_integer $bboard_upload_id +} + +# bboard_upload_id + +set db [ns_db gethandle] + +set filename [database_to_tcl_string_or_null $db "select filename_stub +from bboard_uploaded_files +where bboard_upload_id=$bboard_upload_id"] + +if [empty_string_p $filename] { + ad_return_error "Not Found" "This file might be associated with a thread that was deleted by the forum moderator" + return +} + +set filename [bboard_file_path]/$filename + +ns_returnfile 200 [ns_guesstype $filename] $filename Index: web/openacs/www/bboard/urgent-requests.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/urgent-requests.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/urgent-requests.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,50 @@ +# urgent-requests.tcl,v 3.0 2000/02/06 03:34:53 ron Exp +set_form_variables 0 + +if {![info exists skip_first]} { + set skip_first 0 +} + +# archived_p + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +if {[info exist archived_p] && $archived_p == "t"} { + set title "Archived Urgent Requests" +} else { + set title "Urgent Requests" + set archived_p "f" +} + +set user_id [ad_verify_and_get_user_id] + +ReturnHeaders + +ns_write "[bboard_header $title] + +

      $title

      + +[ad_context_bar_ws $title] + +
      +[ad_decorate_side] + +" + +# let's do the urgent messages first, if necessary + + set urgent_items [bboard_urgent_message_items $db $archived_p 3 50000 $skip_first] + if ![empty_string_p $urgent_items] { + ns_write "
        $urgent_items
      \n" + } + +ns_write " + +
      +

      +[bboard_footer] +" Index: web/openacs/www/bboard/usgeospatial-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/usgeospatial-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/usgeospatial-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,187 @@ +# usgeospatial-2.tcl,v 3.0 2000/02/06 03:34:54 ron Exp +set_the_usual_form_variables + +ad_page_variables { + {topic ""} + {topic_id ""} + {epa_region} +} + +page_validation { + validate_integer "EPA Region" $epa_region + # topic and topic_id will be taken care of by bboard_get_topic_info + # call. +} + +# topic, topic_id, epa_region + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return +} + + +set menubar_items [list] + +if { $users_can_initiate_threads_p != "f" } { + lappend menubar_items "Start a New Thread" +} + +# Ulla designed this in, but philg took it out +# lappend menubar_items "Top of Forum" + + +if { $policy_statement != "" } { + lappend menubar_items "About" +} + + +if { [bboard_pls_blade_installed_p] } { + lappend menubar_items "Search" +} + +lappend menubar_items "Help" + + +set top_menubar [join $menubar_items " | "] + +set states_in_region [join [database_to_tcl_list $db "select usps_abbrev +from bboard_epa_regions +where epa_region = $epa_region"] ", "] + +ReturnHeaders + +ns_write "[bboard_header "$topic region $epa_region"] + +

      Region $epa_region ($states_in_region)

      + +" + +if { ![info exists blather] || $blather == "" } { + # produce a stock header + ns_write "part of the $topic forum in [ad_system_name]" +} else { + ns_write $blather +} + +ns_write " + +
      + +\[$top_menubar\] + +" + +# this is not currently used, moderation should be turned on with certain +# moderation_policies in case we add more + + +set approved_clause "" + +set sql "select msg_id, one_line, sort_key, email, first_names || ' ' || last_name as name, users.user_id as poster_id, +bboard.usps_abbrev, bboard.fips_county_code, rel_search_st.state_name, rel_search_co.fips_county_name as county_name, facility, rel_search_fac.city +from bboard, users, rel_search_st, rel_search_co, rel_search_fac +where bboard.user_id = users.user_id +and bboard.usps_abbrev = rel_search_st.state +and bboard.fips_county_code = rel_search_co.fips_county_code(+) +and bboard.tri_id = rel_search_fac.tri_id(+) +and topic_id = $topic_id $approved_clause +and epa_region = $epa_region +order by state_name, county_name, facility, sort_key +" + + +set selection [ns_db select $db $sql] + +set last_state_name "" +set state_counter 1 +set last_county_name "" +set county_counter "A" +set last_facility_name "" +set facility_counter 1 +set last_new_subject "" +while {[ns_db getrow $db $selection]} { + set_variables_after_query + if { $state_name != $last_state_name } { + set state_link "$state_name" + ns_write "

      \n${state_counter}. $state_link
      \n" + set last_state_name $state_name + incr state_counter + # have to reset the county counter + set last_county_name "" + set county_counter "A" + set last_facility_name "" + } + if { $county_name != $last_county_name } { + if ![empty_string_p $county_name] { + ns_write "[usgeo_n_spaces 7]${county_counter}. $county_name COUNTY
      \n" + } else { + ns_write "[usgeo_n_spaces 7]${county_counter}. STATE-WIDE
      \n" + } + set last_county_name $county_name + set county_counter [lindex [increment_char_digit $county_counter] 0] + # reset the facility counter + set facility_counter 1 + set last_facility_name "" + } + + if { $facility != $last_facility_name } { + if ![empty_string_p $facility] { + ns_write "[usgeo_n_spaces 10]${facility_counter}. $facility ($city)
      \n" + } else { + ns_write "[usgeo_n_spaces 10]${facility_counter}. COUNTY-WIDE
      \n" + } + incr facility_counter + set last_facility_name $facility + } + + if { $one_line == "Response to $last_new_subject" } { + set display_string "Response" + } else { + set last_new_subject $one_line + set display_string $one_line + } + if { $subject_line_suffix == "name" && $name != "" } { + append display_string " ($name)" + } elseif { $subject_line_suffix == "email" && $email != "" } { + append display_string " ($email)" + } + # let's set the indentation for the msg + # right now, we indent them all the same (plus some extra for threading) + if [empty_string_p $last_county_name] { + set indentation [usgeo_n_spaces 14] + } else { + set indentation [usgeo_n_spaces 14] + } + # let's add indentation for threading + append indentation [usgeo_n_spaces [expr 3 * [bboard_compute_msg_level $sort_key]]] + if { [string first "." $sort_key] == -1 } { + # there is no period in the sort key so this is the start of a thread + set thread_start_msg_id $sort_key + } else { + # strip off the stuff before the period + regexp {(.*)\..*} $sort_key match thread_start_msg_id + } + ns_write "$indentation$display_string
      \n" +} + +ns_write " + +

      + +This forum is maintained by $maintainer_name ($maintainer_email). + +

      + +If you want to follow this discussion by email, + +click here to add an alert. + +[bboard_footer] +" Index: web/openacs/www/bboard/usgeospatial-fetch-msg.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/usgeospatial-fetch-msg.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/usgeospatial-fetch-msg.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,160 @@ +# usgeospatial-fetch-msg.tcl,v 3.0 2000/02/06 03:34:55 ron Exp +ad_page_variables { + {msg_id} +} +page_validation { + bboard_validate_msg_id $msg_id +} + +# msg_id is the key +# make a copy because it is going to get overwritten by +# some subsequent queries + +set this_msg_id $msg_id + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select to_char(posting_time,'Month DD, YYYY') as posting_date,bboard.*, users.user_id as poster_id, users.first_names || ' ' || users.last_name as name, bboard.tri_id, facility, fips_county_name, rel_search_st.state_name, city +from bboard, users, rel_search_fac, rel_search_co, rel_search_st +where bboard.user_id = users.user_id +and bboard.tri_id = rel_search_fac.tri_id(+) +and bboard.fips_county_code = rel_search_co.fips_county_code(+) +and bboard.usps_abbrev = rel_search_st.state +and msg_id = '$msg_id'"] + +if { $selection == "" } { + # message was probably deleted + ns_return 200 text/html "Couldn't find message $msg_id. Probably it was deleted by the forum maintainer." + return +} + +set_variables_after_query +set this_one_line $one_line + + +# now variables like $message and $topic are defined + +set QQtopic [DoubleApos $topic] + +if {[bboard_get_topic_info] == -1} { + return +} + +set contributed_by "-- $name, $posting_date." + +if { ![empty_string_p $tri_id] && ![empty_string_p $facility] } { + set facility_link "about $facility" +} else { + set facility_link "" +} + +if { ![empty_string_p $tri_id] && ![empty_string_p $facility] } { + # we have a facility + set about_text $facility + set about_link "$facility ($city)" +} elseif { ![empty_string_p $zip_code] } { + set about_text "Zip Code $zip_code" + set about_link "Zip Code $zip_code" +} elseif { ![empty_string_p $fips_county_code] } { + set about_text "$fips_county_name County" + set about_link "$fips_county_name County" +} elseif { ![empty_string_p $usps_abbrev] } { + set about_text "$state_name" + set about_link "$state_name" +} + +ReturnHeaders + +ns_write "[bboard_header $about_text] + +

      Discussion

      + +about $about_link in the $topic (Region $epa_region) forum +in [ad_system_name] +
      + +

      $one_line

      +
      +$message +

      +$contributed_by +
      +" + +set QQtopic [DoubleApos $topic] +bboard_get_topic_info + +set selection [ns_db select $db "select email <> '$maintainer_email' as not_maintainer_p, to_char(posting_time,'Month DD, YYYY') as posting_date, bboard.*, +users.user_id as replyer_user_id, +users.first_names || ' ' || users.last_name as name, users.email +from bboard, users +where users.user_id = bboard.user_id +and root_msg_id = '$msg_id' +and msg_id <> '$msg_id' +order by not_maintainer_p, sort_key"] + + +while {[ns_db getrow $db $selection]} { + set_variables_after_query + set contributed_by "-- $name, $posting_date" + + set this_response "" + if { $one_line != $this_one_line && $one_line != "Response to $this_one_line" } { + # new subject + append this_response "

      $one_line

      \n" + } else { + append this_response "

      \n" + } + append this_response "
      +$message +
      +
      +$contributed_by +
      +" + lappend responses $this_response +} + +if { [info exists responses] } { + # there were some + ns_write "[join $responses "\n\n"]\n" +} + + +ns_write " + +
      +
      + +
      +
      + + +
      +
      + +  +  +  + +or start a new thread about + +Region $epa_region : +$state_name + +" + +if ![empty_string_p $fips_county_code] { + ns_write ": $fips_county_name County" + +} + +if ![empty_string_p $facility] { + set force_p "t" + ns_write ": $facility" +} + +ns_write " + +[bboard_footer] +" Index: web/openacs/www/bboard/usgeospatial-one-county.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/usgeospatial-one-county.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/usgeospatial-one-county.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,149 @@ +# usgeospatial-one-county.tcl,v 3.0 2000/02/06 03:34:57 ron Exp +set_the_usual_form_variables + +# topic, fips_county_code + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return +} + + + +set selection [ns_db 1row $db "select fips_county_name, state as usps_abbrev from rel_search_co where fips_county_code = '$QQfips_county_code'"] +set_variables_after_query + +set selection [ns_db 1row $db "select state_name, epa_region from bboard_epa_regions where usps_abbrev = '$usps_abbrev'"] +set_variables_after_query + +set menubar_items [list] + +if { $users_can_initiate_threads_p != "f" } { + lappend menubar_items "Start a New Thread" +} + +# Ulla designed this in, but philg took it out +# lappend menubar_items "Top of Forum" + + +if { $policy_statement != "" } { + lappend menubar_items "About" +} + + +if { [bboard_pls_blade_installed_p] } { + lappend menubar_items "Search" +} + +lappend menubar_items "View County Environmental Release" + + +set top_menubar [join $menubar_items " | "] + +ReturnHeaders + +ns_write "[bboard_header "$topic : $fips_county_name County"] + +

      $fips_county_name County

      + +" + +if { ![info exists blather] || $blather == "" } { + # produce a stock header + ns_write "part of the $topic (Region $epa_region) forum in [ad_system_name]" +} else { + ns_write $blather +} + +ns_write " + +
      + +\[$top_menubar\] + +
      +
      + +" + +# this is not currently used, moderation should be turned on with certain +# moderation_policies in case we add more + + +set approved_clause "" + +set sql "select msg_id, one_line, sort_key, email, first_names || ' ' || last_name as name, users.user_id as poster_id, facility, bboard.tri_id, city +from bboard, users, rel_search_fac +where bboard.user_id = users.user_id +and bboard.tri_id = rel_search_fac.tri_id(+) +and topic_id = $topic_id $approved_clause +and bboard.fips_county_code = '$QQfips_county_code' +order by facility, sort_key +" + + +set selection [ns_db select $db $sql] + +set last_facility_name "" +set facility_counter 1 +set last_new_subject "" +while {[ns_db getrow $db $selection]} { + set_variables_after_query + if { $facility != $last_facility_name } { + if ![empty_string_p $facility] { + set facility_link "$facility ($city)" + ns_write "[usgeo_n_spaces 10]${facility_counter}. $facility_link
      \n" + } else { + ns_write "[usgeo_n_spaces 10]${facility_counter}. COUNTY-WIDE
      \n" + } + incr facility_counter + set last_facility_name $facility + } + + if { $one_line == "Response to $last_new_subject" } { + set display_string "Response" + } else { + set last_new_subject $one_line + set display_string $one_line + } + if { $subject_line_suffix == "name" && $name != "" } { + append display_string " ($name)" + } elseif { $subject_line_suffix == "email" && $email != "" } { + append display_string " ($email)" + } + # let's set the indentation for the msg + # right now, we indent them all the same (plus some extra for threading) + set indentation [usgeo_n_spaces 14] + # let's add indentation for threading + append indentation [usgeo_n_spaces [expr 3 * [bboard_compute_msg_level $sort_key]]] + if { [string first "." $sort_key] == -1 } { + # there is no period in the sort key so this is the start of a thread + set thread_start_msg_id $sort_key + } else { + # strip off the stuff before the period + regexp {(.*)\..*} $sort_key match thread_start_msg_id + } + ns_write "$indentation$display_string
      \n" +} + +ns_write " + +

      + +This forum is maintained by $maintainer_name ($maintainer_email). + +

      + +If you want to follow this discussion by email, + +click here to add an alert. + + +[bboard_footer] +" Index: web/openacs/www/bboard/usgeospatial-one-facility.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/usgeospatial-one-facility.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/usgeospatial-one-facility.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,138 @@ +# usgeospatial-one-facility.tcl,v 3.0 2000/02/06 03:34:58 ron Exp +set_the_usual_form_variables + +# topic, tri_id + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + +if {[bboard_get_topic_info] == -1} { + return +} + + +set selection [ns_db 1row $db "select * from rel_search_fac where tri_id = '$QQtri_id'"] +set_variables_after_query + +set has_response_p [database_to_tcl_string_or_null $db "select display_p from facility_response where tri_id = '$QQtri_id'"] + +set menubar_items [list] + +if { $users_can_initiate_threads_p != "f" } { + lappend menubar_items "Start a New Thread" +} + +# Ulla designed this in, but philg took it out +# lappend menubar_items "Top of Forum" + + +if { $policy_statement != "" } { + lappend menubar_items "About" +} + + +if { [bboard_pls_blade_installed_p] } { + lappend menubar_items "Search" +} + +lappend menubar_items "View Facility Environmental Release Report" + +if { $has_response_p == "t" } { + lappend menubar_items "View Facility Response" +} + + +set top_menubar [join $menubar_items " | "] + +set epa_region [database_to_tcl_string $db "select epa_region from bboard_epa_regions where usps_abbrev = '$st'"] + +ReturnHeaders + +ns_write "[bboard_header "$topic : $facility"] + +

      $facility ($city, $st)

      + +" + +if { ![info exists blather] || $blather == "" } { + # produce a stock header + ns_write "part of the $topic (Region $epa_region) forum in [ad_system_name]" +} else { + ns_write $blather +} + +ns_write " + +
      + +\[$top_menubar\] + +
      +
      + +" + +# this is not currently used, moderation should be turned on with certain +# moderation_policies in case we add more + + +set approved_clause "" + +set sql "select msg_id, one_line, sort_key, email, first_names || ' ' || last_name as name, users.user_id as poster_id +from bboard, users +where bboard.user_id = users.user_id +and topic_id = $topic_id $approved_clause +and bboard.tri_id = '$QQtri_id' +order by sort_key +" + + +set selection [ns_db select $db $sql] + +set last_new_subject "" +while {[ns_db getrow $db $selection]} { + set_variables_after_query + if { $one_line == "Response to $last_new_subject" } { + set display_string "Response" + } else { + set last_new_subject $one_line + set display_string $one_line + } + if { $subject_line_suffix == "name" && $name != "" } { + append display_string " ($name)" + } elseif { $subject_line_suffix == "email" && $email != "" } { + append display_string " ($email)" + } + # let's set the indentation for the msg + # right now, we indent them all the same (plus some extra for threading) + set indentation [usgeo_n_spaces 14] + # let's add indentation for threading + append indentation [usgeo_n_spaces [expr 3 * [bboard_compute_msg_level $sort_key]]] + if { [string first "." $sort_key] == -1 } { + # there is no period in the sort key so this is the start of a thread + set thread_start_msg_id $sort_key + } else { + # strip off the stuff before the period + regexp {(.*)\..*} $sort_key match thread_start_msg_id + } + ns_write "$indentation$display_string
      \n" +} + +ns_write " + +

      + +This forum is maintained by $maintainer_name ($maintainer_email). + +

      + +If you want to follow this discussion by email, + +click here to add an alert. + + +[bboard_footer] +" Index: web/openacs/www/bboard/usgeospatial-one-state.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/usgeospatial-one-state.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/usgeospatial-one-state.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,168 @@ +# usgeospatial-one-state.tcl,v 3.0 2000/02/06 03:34:59 ron Exp +set_the_usual_form_variables + +# topic, usps_abbrev + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return +} + + + + +set selection [ns_db 1row $db "select state_name, epa_region from bboard_epa_regions where usps_abbrev = '$QQusps_abbrev'"] +set_variables_after_query + +set menubar_items [list] + +if { $users_can_initiate_threads_p != "f" } { + lappend menubar_items "Start a New Thread" +} + +# Ulla designed this in, but philg took it out +# lappend menubar_items "Top of Forum" + + +if { $policy_statement != "" } { + lappend menubar_items "About" +} + + +if { [bboard_pls_blade_installed_p] } { + lappend menubar_items "Search" +} + +lappend menubar_items "Help" + +lappend menubar_items "View State Environmental Release Report" + +set top_menubar [join $menubar_items " | "] + +ReturnHeaders + +ns_write "[bboard_header "$topic : $state_name"] + +

      $state_name

      + +" + +if { ![info exists blather] || $blather == "" } { + # produce a stock header + ns_write "part of the $topic (Region $epa_region) forum in [ad_system_name]" +} else { + ns_write $blather +} + +ns_write " + +
      + +\[$top_menubar\] + +
      +
      + +" + +# this is not currently used, moderation should be turned on with certain +# moderation_policies in case we add more + + +set approved_clause "" + +set sql "select msg_id, one_line, sort_key, email, first_names || ' ' || last_name as name, users.user_id as poster_id, +bboard.fips_county_code, rel_search_co.fips_county_name as county_name, facility, rel_search_fac.city +from bboard, users, rel_search_co, rel_search_fac +where bboard.user_id = users.user_id +and bboard.fips_county_code = rel_search_co.fips_county_code(+) +and bboard.tri_id = rel_search_fac.tri_id(+) +and topic_id = $topic_id $approved_clause +and usps_abbrev = '$QQusps_abbrev' +order by state_name, county_name, facility, sort_key +" + + +set selection [ns_db select $db $sql] + +set last_county_name "" +set county_counter "A" +set last_facility_name "" +set facility_counter 1 +set last_new_subject "" +while {[ns_db getrow $db $selection]} { + set_variables_after_query + if { $county_name != $last_county_name } { + if ![empty_string_p $county_name] { + set county_link "$county_name COUNTY" + ns_write "[usgeo_n_spaces 7]${county_counter}. $county_link
      \n" + } else { + ns_write "[usgeo_n_spaces 7]${county_counter}. STATE-WIDE
      \n" + } + set last_county_name $county_name + set county_counter [lindex [increment_char_digit $county_counter] 0] + # reset the facility counter + set facility_counter 1 + set last_facility_name "" + } + + if { $facility != $last_facility_name } { + if ![empty_string_p $facility] { + ns_write "[usgeo_n_spaces 10]${facility_counter}. $facility ($city)
      \n" + } else { + ns_write "[usgeo_n_spaces 10]${facility_counter}. COUNTY-WIDE
      \n" + } + set last_facility_name $facility + } + + if { $one_line == "Response to $last_new_subject" } { + set display_string "Response" + } else { + set last_new_subject $one_line + set display_string $one_line + } + if { $subject_line_suffix == "name" && $name != "" } { + append display_string " ($name)" + } elseif { $subject_line_suffix == "email" && $email != "" } { + append display_string " ($email)" + } + # let's set the indentation for the msg + # right now, we indent them all the same (plus some extra for threading) + if [empty_string_p $last_county_name] { + set indentation [usgeo_n_spaces 14] + } else { + set indentation [usgeo_n_spaces 14] + } + # let's add indentation for threading + append indentation [usgeo_n_spaces [expr 3 * [bboard_compute_msg_level $sort_key]]] + if { [string first "." $sort_key] == -1 } { + # there is no period in the sort key so this is the start of a thread + set thread_start_msg_id $sort_key + } else { + # strip off the stuff before the period + regexp {(.*)\..*} $sort_key match thread_start_msg_id + } + ns_write "$indentation$display_string
      \n" +} + +ns_write " + +

      + +This forum is maintained by $maintainer_name ($maintainer_email). + +

      + +If you want to follow this discussion by email, + +click here to add an alert. + + +[bboard_footer] +" Index: web/openacs/www/bboard/usgeospatial-post-new-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/usgeospatial-post-new-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/usgeospatial-post-new-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,63 @@ +# usgeospatial-post-new-2.tcl,v 3.0 2000/02/06 03:35:00 ron Exp +set_the_usual_form_variables + +# topic, epa_region, usps_abbrev + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return +} + + +set full_state_name [database_to_tcl_string $db "select state_name from rel_search_st where state = '$QQusps_abbrev'"] + +ReturnHeaders + +ns_write "[bboard_header "Pick a county in $full_state_name"] + +

      Pick a County

      + +so that you can add a thread to +the $topic (region $epa_region) forum. + +
      + + + + +[bboard_footer] +" Index: web/openacs/www/bboard/usgeospatial-post-new-3.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/usgeospatial-post-new-3.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/usgeospatial-post-new-3.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,94 @@ +# usgeospatial-post-new-3.tcl,v 3.0 2000/02/06 03:35:01 ron Exp +set_the_usual_form_variables + +# topic, epa_region, usps_abbrev, fips_county_code (optional) + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return +} + + +#check for the user cookie + +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + ns_returnredirect /register.tcl?return_url=[ns_urlencode "[bboard_partial_url_stub]usgeospatial-post-new-3.tcl?[export_url_vars topic epa_region usps_abbrev fips_county_code]"] + return +} + +# we know who this is + +if [info exists fips_county_code] { + append pretty_location [database_to_tcl_string $db "select fips_county_name from rel_search_co where fips_county_code = '$QQfips_county_code'"] " County, " [database_to_tcl_string $db "select state_name from rel_search_st where state = '$QQusps_abbrev'"] +} else { + set pretty_location [database_to_tcl_string $db "select state_name from rel_search_st where state = '$QQusps_abbrev'"] +} + +set menubar_items [list] +lappend menubar_items "Search" + +lappend menubar_items "Help" + +set top_menubar [join $menubar_items " | "] + +ReturnHeaders + +ns_write "[bboard_header "Post New Message"] + +

      Post a New Message

      + +about $pretty_location into the $topic (region $epa_region) forum. + +
      + +\[$top_menubar\] + +
      +
      + + +
      +[export_form_vars topic epa_region usps_abbrev fips_county_code] + +[philg_hidden_input usgeospatial_p t] +[philg_hidden_input refers_to NEW] + + + + + + + +
      Subject Line
      Notify Me of Responses + Yes + No + +
      Message 
      + +
      + + +
      + + +

      + +

      + + + + +
      + +
      + +[bboard_footer] +" Index: web/openacs/www/bboard/usgeospatial-post-new-county.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/usgeospatial-post-new-county.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/usgeospatial-post-new-county.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,21 @@ +# usgeospatial-post-new-county.tcl,v 3.0 2000/02/06 03:35:03 ron Exp +set_the_usual_form_variables + +# fips_county_code, topic + +# this always redirects to state "see what's there" +# or a state "add new posting" form if there isn't anything there + +set db [ns_db gethandle] + +set n_existing [database_to_tcl_string $db "select count(*) from bboard where fips_county_code = '$QQfips_county_code'"] + +if { $n_existing > 0 } { + ns_returnredirect "usgeospatial-one-county.tcl?[export_url_vars topic]&fips_county_code=[ns_urlencode $fips_county_code]" +} else { + set usps_abbrev [database_to_tcl_string $db "select state from rel_search_co where fips_county_code='$QQfips_county_code'"] + set epa_region [database_to_tcl_string $db "select epa_region from bboard_epa_regions where usps_abbrev = '$usps_abbrev'"] + ns_returnredirect "usgeospatial-post-new-3.tcl?[export_url_vars topic epa_region usps_abbrev fips_county_code]" +} + + Index: web/openacs/www/bboard/usgeospatial-post-new-state.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/usgeospatial-post-new-state.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/usgeospatial-post-new-state.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,18 @@ +# usgeospatial-post-new-state.tcl,v 3.0 2000/02/06 03:35:04 ron Exp +set_the_usual_form_variables + +# usps_abbrev, topic + +# this always redirects to state "see what's there" +# or a state "add new posting" form if there isn't anything there + +set db [ns_db gethandle] + +set n_existing [database_to_tcl_string $db "select count(*) from bboard where usps_abbrev = '$QQusps_abbrev'"] + +if { $n_existing > 0 } { + ns_returnredirect "usgeospatial-one-state.tcl?[export_url_vars topic usps_abbrev]" +} else { + set epa_region [database_to_tcl_string $db "select epa_region from bboard_epa_regions where usps_abbrev = '$usps_abbrev'"] + ns_returnredirect "usgeospatial-post-new-2.tcl?[export_url_vars topic usps_abbrev epa_region]" +} Index: web/openacs/www/bboard/usgeospatial-post-new-tri.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/usgeospatial-post-new-tri.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/usgeospatial-post-new-tri.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,103 @@ +# usgeospatial-post-new-tri.tcl,v 3.0 2000/02/06 03:35:07 ron Exp +set_the_usual_form_variables + +# Security check +if {[bboard_get_topic_info] == -1} { + return +} + +# tri_id, topic, force_p (option) + +# unless force_p exists and is true, let's first figure out if there +# are any existing discussions about this facility, if so, we redirect +# them out to a county page if not, they just stat a new thread here + +set db [ns_db gethandle] + +if { ![info exists force_p] || $force_p == 0 } { + set n_existing [database_to_tcl_string $db "select count(*) from bboard where topic_id = $topic_id and tri_id = '$QQtri_id'"] + + if { $n_existing > 0 } { + ns_returnredirect "usgeospatial-one-facility.tcl?[export_url_vars topic tri_id]" + return + } +} + + +#check for the user cookie + +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + ns_returnredirect /register.tcl?return_url=[ns_urlencode "[bboard_partial_url_stub]usgeospatial-post-new-tri.tcl?[export_url_vars topic tri_id]"] + return +} + +set menubar_items [list] +lappend menubar_items "Search" + +lappend menubar_items "Help" + +lappend menubar_items "Sample Questions" + +set top_menubar [join $menubar_items " | "] + +set selection [ns_db 0or1row $db "select rsf.*, epa.epa_region +from Rel_Search_Fac rsf, bboard_epa_regions epa +where tri_id = '$QQtri_id' +and rsf.st = epa.usps_abbrev"] + +set_variables_after_query + +ReturnHeaders + +ns_write "[bboard_header $facility] + +

      Post a New Message

      + +about $facility into the $topic (Region $epa_region) forum. + +
      + +\[$top_menubar\] + +
      +
      + +
      +[export_form_vars topic tri_id] + +[philg_hidden_input usgeospatial_p t] +[philg_hidden_input refers_to NEW] + + + + + + + +
      Subject Line
      Notify Me of Responses + Yes + No + +
      Message 
      + +
      + + + +
      + +

      + +

      + + + + +
      + +
      + + +[bboard_footer]" Index: web/openacs/www/bboard/usgeospatial-post-new-zip.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/usgeospatial-post-new-zip.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/usgeospatial-post-new-zip.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,41 @@ +# usgeospatial-post-new-zip.tcl,v 3.0 2000/02/06 03:35:08 ron Exp +set_the_usual_form_variables + +# zip_code, topic + +# this always redirects to either county or state "see what's there" +# or a county "add new posting" form if there isn't anything there + +set db [ns_db gethandle] + +set selection [ns_db 0or1row $db "select distinct geo_area_id, geo_area_type from cmy_search_zip where sema_zip = '$QQzip_code'"] + +if [empty_string_p $selection] { + ns_returnredirect "usgeospatial.tcl?[export_url_vars topic]" + return +} + +set_variables_after_query + +if { $geo_area_type == "fips_state_code" } { + set usps_abbrev [database_to_tcl_string $db "select state from rel_search_st where fips_state_code = '$geo_area_id'"] + set n_existing [database_to_tcl_string $db "select count(*) from bboard where usps_abbrev = '$usps_abbrev'"] + if { $n_existing > 0 } { + ns_returnredirect "usgeospatial-one-state.tcl?[export_url_vars topic usps_abbrev]" + } else { + set epa_region [database_to_tcl_string $db "select epa_region from bboard_epa_regions where usps_abbrev = '$usps_abbrev'"] + ns_returnredirect "usgeospatial-post-new-2.tcl?[export_url_vars topic usps_abbrev epa_region]" + } +} else { + # county code + set n_existing [database_to_tcl_string $db "select count(*) from bboard where fips_county_code = '$geo_area_id'"] + if { $n_existing > 0 } { + ns_returnredirect "usgeospatial-one-county.tcl?[export_url_vars topic]&fips_county_code=[ns_urlencode $geo_area_id]" + } else { + set usps_abbrev [database_to_tcl_string $db "select state from rel_search_co where fips_county_code='$geo_area_id'"] + set epa_region [database_to_tcl_string $db "select epa_region from bboard_epa_regions where usps_abbrev = '$usps_abbrev'"] + set fips_county_code $geo_area_id + ns_returnredirect "usgeospatial-post-new-3.tcl?[export_url_vars topic epa_region usps_abbrev fips_county_code]" + } +} + Index: web/openacs/www/bboard/usgeospatial-post-new.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/usgeospatial-post-new.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/usgeospatial-post-new.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,62 @@ +# usgeospatial-post-new.tcl,v 3.0 2000/02/06 03:35:09 ron Exp +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +ad_page_variables { + {topic ""} + {topic_id ""} + {epa_region} +} + +page_validation { + validate_integer "EPA Region" $epa_region + # topic and topic_id will be taken care of by bboard_get_topic_info + # call. +} + +# topic, epa_region + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return +} + + +ReturnHeaders + +ns_write "[bboard_header "Pick a state in region $epa_region"] + +

      Pick a State

      + +so that you can add a thread to +the $topic (region $epa_region) forum. + +
      + +
        +" + +set selection [ns_db select $db "select state_name, usps_abbrev +from bboard_epa_regions +where epa_region = $epa_region +order by upper(state_name)"] + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + ns_write "
      • $state_name\n" +} + +ns_write " +
      + + +[bboard_footer] +" Index: web/openacs/www/bboard/usgeospatial-post-reply-form.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/usgeospatial-post-reply-form.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/usgeospatial-post-reply-form.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,122 @@ +# usgeospatial-post-reply-form.tcl,v 3.0 2000/02/06 03:35:10 ron Exp + +ad_page_variables { + refers_to +} +page_validation { + bboard_validate_msg_id $refers_to +} + +if {[ad_read_only_p]} { + ad_return_read_only_maintenance_message + return +} + +set form_refers_to $refers_to + +# we can't just use set_form_variables because that would set +# "refers_to" which is about to be overwritten by the db query + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +set user_id [ad_verify_and_get_user_id] + +if {$user_id == 0} { + + ns_returnredirect /register.tcl?return_url=[ns_urlencode "[bboard_partial_url_stub]usgeospatial-post-reply-form.tcl?refers_to=$form_refers_to"] + return +} + + +set selection [ns_db 0or1row $db "select users.first_names || ' ' || users.last_name as name, bboard.*, users.* from bboard, users +where users.user_id = bboard.user_id +and msg_id = '$form_refers_to'"] + +if { $selection == "" } { + # message was probably deleted + ns_return 200 text/html "Couldn't find message $msg_id. Probably the message to which you are currently trying to reply has deleted by the forum maintainer." + return +} + + +set_variables_after_query + +if [catch {set selection [ns_db 1row $db "select distinct * from bboard_topics where topic='[DoubleApos $topic]'"]} errmsg] { + bboard_return_cannot_find_topic_page + return +} +set_variables_after_query + + + +ReturnHeaders + +ns_write "[bboard_header "Respond"] + +

      Respond

      + +to \"$one_line\" + +

      + +in the $topic (region $epa_region) forum + +

      + +

      Original Posting

      + +$message + +

      + +from $name ($email) + +

      + +
      + + + +One-line summary of response

      +

      + +
      +

      + + + + + + + + +
      Response  
      + +

      + +

      + + + +
      + +

      + +

      + +
      +
      +" + +set QQtopic [DoubleApos $topic] +bboard_get_topic_info + +ns_write " + +[bboard_footer] +" Index: web/openacs/www/bboard/usgeospatial-search-form.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/usgeospatial-search-form.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/usgeospatial-search-form.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,43 @@ +# usgeospatial-search-form.tcl,v 3.1 2000/02/23 01:49:39 bdolicki Exp +set_the_usual_form_variables + +# topic required + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return +} + + +set search_submit_button "" +if { [msie_p] == 1 } { + set search_submit_button "" +} + +set_variables_after_query + +ns_return 200 text/html "[bboard_header "Search $topic forum"] + +

      Search

      + +the $topic forum in [ad_system_name] + +
      +
      +[export_form_vars topic topic_id] +Full Text Search: +$search_submit_button +
      + +

      + +(separate keywords by spaces) + +[bboard_footer] +" Index: web/openacs/www/bboard/usgeospatial-search.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/usgeospatial-search.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/usgeospatial-search.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,137 @@ +# usgeospatial-search.tcl,v 3.1 2000/02/23 01:49:40 bdolicki Exp +set_the_usual_form_variables + +# query_string, topic + +if { ![info exists query_string] || $query_string == "" } { + # probably using MSIE + ns_return 200 text/html "[bboard_header "Missing Query"] + +

      Missing Query

      + +
      + +Either you didn't type a query string or you're using a Web browser +like Microsoft Internet Explorer 3.x (which neglects to pass user +input up the server). + +[bboard_footer] +" + return +} + +set db [bboard_db_gethandle] + +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return +} + + +# we ask for all the top level messages + +ReturnHeaders + +ns_write "[bboard_header "Search Results"] + +

      Messages matching \"$query_string\"

      + +in the $topic forum in [ad_system_name] + +
      + +
        +" +# if the user put in commas, replace with spaces + +regsub -all {,+} [string trim $QQquery_string] " " final_query_string + +if [catch {set selection [ns_db select $db "select /*+ INDEX(bboard bboard_for_one_category) */ bboard_contains(email, first_names || last_name, one_line, message,'$final_query_string') as the_score, bboard.*, rel_search_st.state as usps_abbrev, rel_search_st.state_name, rel_search_co.fips_county_name as county_name, facility +from bboard, users, rel_search_st, rel_search_co, rel_search_fac +where bboard_contains(email, first_names || last_name, one_line, message,'$final_query_string') > 0 +and bboard.usps_abbrev = rel_search_st.state +and bboard.fips_county_code = rel_search_co.fips_county_code(+) +and bboard.tri_id = rel_search_fac.tri_id(+) +and bboard.user_id = users.user_id +and topic_id = $topic_id +order by 1 desc"]} errmsg] { + ns_write "Ouch! Our query made Oracle unhappy: +
        +$errmsg
+
        +
      +[bboard_footer]" + return +} + +set counter 0 +while {[ns_db getrow $db $selection]} { + set_variables_after_query + incr counter + if { ![info exists max_score] } { + # first iteration, this is the highest score + set max_score $the_score + } + if { ($counter > 25) && ($the_score < [expr 0.3 * $max_score] ) } { + # we've gotten more than 25 rows AND our relevance score + # is down to 30% of what the maximally relevant row was + ns_db flush $db + break + } + if { ($counter > 50) && ($the_score < [expr 0.5 * $max_score] ) } { + # take a tougher look + ns_db flush $db + break + } + if { ($counter > 100) && ($the_score < [expr 0.8 * $max_score] ) } { + # take a tougher look yet + ns_db flush $db + break + } + if { [string first "." $sort_key] == -1 } { + # there is no period in the sort key so this is the start of a thread + set thread_start_msg_id $sort_key + } else { + # strip off the stuff before the period + regexp {(.*)\..*} $sort_key match thread_start_msg_id + } + set display_string $one_line + if { $subject_line_suffix == "name" } { + append display_string " ($name)" + } elseif { $subject_line_suffix == "email" } { + append display_string " ($email)" + } + set about_string "" + if { ![empty_string_p $facility] } { + set about_string "$facility in $county_name County, $usps_abbrev" + } elseif ![empty_string_p $county_name] { + set about_string "$county_name County, $usps_abbrev" + } elseif ![empty_string_p $state_name] { + set about_string $state_name + } + if ![empty_string_p $about_string] { + set about_string "
              (about $about_string)      " + } + ns_write "
    • $the_score: $display_string $about_string\n" +} + +if { $counter == 0 } { + ns_write "
    • sorry, but no messages matched this query; remember that your query string should be space-separated words without plurals (since we're just doing simple stupid keyword matching)\n" +} + +ns_write " +
    + +
    +[export_form_vars topic topic_id] +New Search: +
    + +[bboard_footer] +" + Index: web/openacs/www/bboard/usgeospatial.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/usgeospatial.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/usgeospatial.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,180 @@ +# usgeospatial.tcl,v 3.0 2000/02/06 03:35:13 ron Exp +set_the_usual_form_variables + +# topic, topic_id required + +set db [bboard_db_gethandle] +if { $db == "" } { + bboard_return_error_page + return +} + + +if {[bboard_get_topic_info] == -1} { + return +} + + + +ReturnHeaders + +ns_write "[bboard_header "Pick a Region"] + +

    Pick a region

    + +for the $topic forum in Discussion Forums section of +[ad_system_name] + +
    +

    Where Do You Live?

    +

    + In order to help you zero in on your community, we have organized the discussion areas + around Ten Geographic Regions. Simply click on your region below. + You will then be able to read current messages, respond to a message, or post a new + message about your state, county or any polluting company that Scorecard covers. + +

    +" + + +set region_text "

      \n" +set selection [ns_db select $db "select round(epa_region::float), usps_abbrev, description +from bboard_epa_regions +order by epa_region, usps_abbrev"] + + +# Construct the string to display at the bottom for "Ten Geographic Regions" +# as "region_text". +# Also set the region descriptions as region{n}_desc. + +# We do this up here instead of writing everything out immediately so we only +# have to go to the database once for this information. + +set last_region "" + +while { [ns_db getrow $db $selection] } { + set_variables_after_query + if { $epa_region != $last_region } { + if { ![empty_string_p $last_region] } { + append region_text ")\n" + } + set last_region $epa_region + set region${epa_region}_desc $description + set region${epa_region}_url "usgeospatial-2.tcl?[export_url_vars topic topic_id epa_region]" + append region_text "
    • Region $epa_region: $description (" + } + append region_text "$usps_abbrev " +} +append region_text "
    " + + +ns_write " + \"US + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    + + +
    + +

    Ten Geographic Regions

    +$region_text + +[bboard_footer] +" Index: web/openacs/www/bboard/graphics/forums_map.gif =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/graphics/forums_map.gif,v diff -u Binary files differ Index: web/openacs/www/bboard/text/exs.txt =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/text/exs.txt,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/text/exs.txt 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,22 @@ +Examples + + SAMPLE QUESTIONS FOR YOU TO ASK COMPANIES ABOUT POLLUTION PREVENTION +

    +

      +
    1. What toxic chemicals does your facility use or produce that it does not report to TRI , and has your facility switched to these chemicals since 1988? +

      +

    2. Were TRI reductions a result of calculating or measuring releases in a different manner, having other facilities perform operations formerly performed on-site, or a decline in production? Please explain. +

      +

    3. Do you have a pollution prevention plan, or an equivalent document identifying changes that will be made to improve plant efficiency and reduce use of toxic chemicals, with a summary that you will share with the public? +

      +

    4. Does your facility use materials accounting (i.e., input-output calculations) to identify pollution prevention opportunities? +

      +

    5. I am interested in how your total waste generation to air, water, and land relates to your production. Is the total production-related waste (TPRW) per unit produced declining? Please provide annual numbers (TPRW, units produced, and define the units used). +

      +

    +

    + SAMPLE QUESTIONS TO ASK COMPANIES ABOUT AN UNUSUAL EVENT SUCH AS A SPILL OR A STACK RELEASE +

    +1. Please explain what happened, and why. +

    +2. What actions are being taken, or have been taken, to prevent this event from happening again? \ No newline at end of file Index: web/openacs/www/bboard/text/sampquests.txt =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bboard/text/sampquests.txt,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bboard/text/sampquests.txt 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,16 @@ +Sample Questions + +

    +Pollution prevention means not creating waste in the first place and reducing the use of toxic chemicals as inputs into business operations. Pollution prevention is different from "pollution control" or "waste management" (including recycling, treatment, burning, and disposal), which are less preferred methods to protect the environment. These strategies only stop waste chemicals from entering the environment after they have been unintentionally created. +

    +The five sample questions on pollution prevention can help you distinguish between real reductions in pollution and reductions which only occur on paper, and can help you gain additional information about facility environmental practices and performance. Feel free to edit the questions before posting them for a company to respond. +

    +

    +The two sample questions about an unusual event will enable you to see if a company has an acceptable explanation for an accident or other event, and whether it has a system in place to investigate problems and prevent them in the future. Begin your questioning by describing the event, including what occurred, when it occurred, and where, being as specific as possible. Feel free to edit the questions before posting them for a company to respond. + + + Index: web/openacs/www/bookmarks/create-folder-2.tcl =================================================================== RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/create-folder-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ web/openacs/www/bookmarks/create-folder-2.tcl 17 Apr 2001 14:05:10 -0000 1.1 @@ -0,0 +1,68 @@ +# +# /bookmarks/create-folder-2.tcl +# +# create a folder to store bookmarks in +# +# by aure@arsdigita.com and dh@arsdigita.com +# +# create-folder-2.tcl,v 3.0.4.2 2000/03/28 16:41:54 carsten Exp +# +set_the_usual_form_variables +# ad_page_variables { +# local_title +# parent_id +# bookmark_id +# return_url +#} + +set user_id [ad_verify_and_get_user_id] +if { $user_id == 0 } { + ns_returnredirect "/register/index?return_url=[ns_urlencode [ns_conn url]]" + return +} + +if {![info exists parent_id]} { + set parent_id "null" +} + +if {[empty_string_p $local_title]} { + set local_title "unnamed" +} + +set db [ns_db gethandle] + +ns_db dml $db "begin transaction" + + +set insert " +insert into bm_list +(bookmark_id, owner_id, local_title, parent_id, creation_date, folder_p, closed_p) +values +($bookmark_id, $user_id, [db_postgres_doubleapos_null_sql $local_title]', [ns_dbquotevalue $parent_id], sysdate(), 't', 'f') +" +if [catch {ns_db dml $db $insert} errmsg] { +# check and see if this was a double click + set dbclick_p [database_to_tcl_string $db "select count(*) from bm_list where bookmark_id=$bookmark_id"] + if {$dbclick_p == "1"} { + ns_returnredirect $return_url + return + } else { + ad_return_complaint 1 "
  • There was an error making this insert into the database. + 
    $errmsg"
+	return 
+    }
+}
+
+bm_set_hidden_p $db $user_id
+bm_set_in_closed_p $db $user_id
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect $return_url
+
+
+
+
+
+
+
Index: web/openacs/www/bookmarks/create-folder.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/create-folder.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/bookmarks/create-folder.tcl	17 Apr 2001 14:05:10 -0000	1.1
@@ -0,0 +1,64 @@
+#
+# /bookmarks/create-folder.tcl
+#
+# create a folder to store bookmarks in
+#
+# by aure@arsdigita.com and dh@arsdigita.com, June 199
+#
+# create-folder.tcl,v 3.0.4.2 2000/03/16 03:09:50 tina Exp
+#
+
+ad_page_variables {return_url}
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+set bookmark_id [database_to_tcl_string $db "
+    select bm_bookmark_id_seq.nextval from dual"]
+
+set title "Create Folder"
+
+set page_content "
+[ad_header "$title"]
+
+
    $title
    
+
+[ad_context_bar_ws [list $return_url [ad_parameter SystemName bm]] $title]
+
+
    
+
    
+[export_form_vars bookmark_id return_url]
+
+
+
+  
+  
+
+
+  
+  
+
+
+  
+  
+
+
+
    Input Folder Name:
    Place in folder:  
+  [bm_folder_selection $db $user_id $bookmark_id]
    
+
+[bm_footer]"
+
+# Release the database handle
+ns_db releasehandle $db
+
+# serve the page
+ns_return 200 text/html $page_content
+
+
+
+
+
+
+
Index: web/openacs/www/bookmarks/delete-bookmark-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/delete-bookmark-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/bookmarks/delete-bookmark-2.tcl	17 Apr 2001 14:05:10 -0000	1.1
@@ -0,0 +1,77 @@
+# delete-bookmark-2.tcl,v 3.0 2000/02/06 03:35:17 ron Exp
+# delete-bookmark-2.tcl
+#
+# actually deletes a bookmark
+#
+# by aure@arsdigita.com and dh@arsdigita.com
+
+set_the_usual_form_variables
+
+# bookmark_id, return_url
+
+validate_integer bookmark_id $bookmark_id
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+# start error-checking
+set exception_text ""
+set exception_count 0
+
+if { ![info exists bookmark_id] || [empty_string_p $bookmark_id] } {
+    incr exception_count
+    append exception_text "
  • No bookmark was specified"
+}
+
+# make sure that the user owns the bookmark
+set  ownership_query "
+        select count(*)
+        from   bm_list
+        where  owner_id=$user_id
+        and bookmark_id=$bookmark_id"
+set ownership_test [database_to_tcl_string $db $ownership_query]
+
+if {$ownership_test==0} {
+    incr exception_count
+    append exception_text "
  • You can not edit this bookmark"
+}
+
+# return errors
+if { $exception_count> 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+set sql_child_delete "
+    delete from bm_list 
+    where bookmark_id in (select      bookmark_id
+                          from        bm_list
+			  connect by  prior bookmark_id = parent_id
+			  start with  parent_id = $bookmark_id)
+    or bookmark_id = $bookmark_id"
+
+if [catch {ns_db dml $db $sql_child_delete} errmsg] {
+    ad_return_error "Ouch!" "The database chocked on our delete:
+
    
+
    +$errmsg
+
    
+
    
+"
+    return
+}
+
+# send the browser back to the url it was at before the editing process began
+ns_returnredirect $return_url
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/bookmarks/delete-bookmark.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/delete-bookmark.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/bookmarks/delete-bookmark.tcl	17 Apr 2001 14:05:10 -0000	1.1
@@ -0,0 +1,99 @@
+# delete-bookmark.tcl,v 3.0.4.1 2000/03/17 17:40:38 aure Exp
+# delete-bookmark.tcl
+#
+# the delete utility of the bookmarks system
+#
+# by dh@arsdigita.com and aure@arsdigita.com
+
+set_the_usual_form_variables 
+
+# bookmark_id, return_url
+
+validate_integer bookmark_id $bookmark_id
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+# start error-checking
+set exception_text ""
+set exception_count 0
+
+if {(![info exists bookmark_id])||([empty_string_p $bookmark_id])} {
+    incr exception_count
+    append exception_text "
  • No bookmark was specified"
+}
+
+# make sure that the user owns the bookmark
+set  ownership_query "
+        select count(*)
+        from   bm_list
+        where  owner_id=$user_id
+        and bookmark_id=$bookmark_id"
+set ownership_test [database_to_tcl_string $db $ownership_query]
+
+if {$ownership_test==0} {
+    incr exception_count
+    append exception_text "
  • You can not edit this bookmark"
+}
+
+# return errors
+if { $exception_count> 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+set local_title [database_to_tcl_string $db "select local_title from bm_list where bookmark_id=$bookmark_id"]
+
+set title "Delete \"$local_title\""
+
+set whole_page "
+[ad_header $title ]
+
     $title 
    
+[ad_context_bar_ws [list $return_url [ad_parameter SystemName bm]] [list edit-bookmark.tcl?[export_url_vars bookmark_id] Edit Bookmark] "Delete"]
+
    
+"
+
+set folder_p [database_to_tcl_string $db "select folder_p from bm_list where bookmark_id = $bookmark_id"]
+
+if {$folder_p=="t"} { 
+    
+    set count_query "
+    select count(*)
+    from   bm_list
+    connect by prior bookmark_id=parent_id
+    start with parent_id = $bookmark_id
+    "
+    
+    set number_to_delete [database_to_tcl_string $db $count_query]
+    
+    append whole_page " 
+    Removing this folder will result in deleting $number_to_delete subfolders and/or bookmarks. 
    "
+}
+
+append whole_page "Are you sure you want to delete \"$local_title\"?
    "
+
+
+append whole_page " 
+    
    
+     
    
+     
+     
    
+     [export_form_vars bookmark_id return_url] 
+    
    
+    [bm_footer]
+    "
+
+ns_return 200 text/html $whole_page
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/bookmarks/delete-dead-links.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/delete-dead-links.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/bookmarks/delete-dead-links.tcl	17 Apr 2001 14:05:10 -0000	1.1
@@ -0,0 +1,52 @@
+# delete-dead-links.tcl,v 3.0 2000/02/06 03:35:20 ron Exp
+# delete-dead-links.tcl
+#
+# deletes all occurrences of bookmarks with a dead url
+#
+# by aure@arsdigita.com
+
+set_the_usual_form_variables 
+
+# deleteable_link
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+# get the deleteable links from the form
+if {[exists_and_not_null deleteable_link]} {
+    catch {nmc_GetCheckboxValues [ns_conn form] {deleteable_link}} deleteable_link
+    # deleteable_link is a list
+    set QQdeleteable_link [list]
+    foreach link $deleteable_link {
+	lappend QQdeleteable_link [ns_dbquotevalue $link]
+    }
+    
+    set QQdeleteable_link_string [join $QQdeleteable_link ","]
+} else {
+    ad_return_complaint 1 "You forgot to check off any links."
+    return
+}
+
+set db [ns_db gethandle]
+
+set sql_delete "
+    delete from bm_list
+    where owner_id = $user_id
+    and url_id in ($QQdeleteable_link_string)"
+
+# Note: This may break with a huge deleteable_link list, but it is somewhat
+# unlikely that someone will have that many dead links and even more unlikely
+# that they will check that many checkboxes on the previous page 
+
+if [catch {ns_db dml $db $sql_delete} errmsg] {
+    ns_return 200 text/html "Error
+    
    Error
    
+    
    
+    We encountered an error while trying to process this DELETE:
+    
    $errmsg
    
+    [bm_footer]
+    "
+    return
+}
+
+ns_returnredirect $return_url
Index: web/openacs/www/bookmarks/edit-bookmark-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/edit-bookmark-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/bookmarks/edit-bookmark-2.tcl	17 Apr 2001 14:05:10 -0000	1.1
@@ -0,0 +1,113 @@
+# edit-bookmark-2.tcl,v 3.0 2000/02/06 03:35:21 ron Exp
+# edit-bookmark-2.tcl
+#
+# edit a bookmark in your bookmark list
+#
+# by aure@arsdigita.com and dh@arsdigita.com
+
+set_the_usual_form_variables
+
+# local_title, complete_url, bookmark_id, parent_id, return_url
+
+validate_integer bookmark_id $bookmark_id
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+# start error-checking
+set exception_text ""
+set exception_count 0
+
+if {(![info exists bookmark_id])||([empty_string_p $bookmark_id])} {
+    incr exception_count
+    append exception_text "
  • No bookmark was specified"
+}
+
+# make sure that the user owns the bookmark
+set  ownership_query "
+        select count(*)
+        from   bm_list
+        where  owner_id=$user_id
+        and bookmark_id=$bookmark_id"
+set ownership_test [database_to_tcl_string $db $ownership_query]
+
+if {$ownership_test==0} {
+    incr exception_count
+    append exception_text "
  • You can not edit this bookmark"
+}
+
+# return errors
+if { $exception_count> 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+if { ![info exists parent_id] || [empty_string_p $parent_id] } {
+    set parent_id "null"
+}
+
+
+ns_db dml $db "begin transaction"
+
+# if the bookmark to edit is a folder, complete_url won't be defined
+if ![info exists complete_url] {
+
+    # this is a folder so edit its name
+    set sql_update "
+         update  bm_list
+         set     local_title = '[DoubleApos $local_title]',
+                 private_p = '$private_p',
+                 parent_id = $parent_id
+         where   owner_id = $user_id
+         and     bookmark_id = $bookmark_id"
+    ns_db dml $db $sql_update
+
+} else {
+
+    # entry is a bookmark - need to update both name and url
+
+    set host_url [bm_host_url $complete_url]
+    
+    # check to see if we already have the url in our database
+    set url_query "select url_id
+                   from   bm_urls
+                   where  complete_url = '[DoubleApos $complete_url]'"
+    set url_id [database_to_tcl_string_or_null  $db $url_query]
+    
+    # if we don't have the url, then insert the url into the database
+    if {[empty_string_p $url_id]} { 
+	set url_id [database_to_tcl_string $db "select bm_url_id_seq.nextval from dual"]
+	ns_db dml $db "    
+	insert into bm_urls 
+	(url_id, host_url, complete_url)
+	values
+	($url_id, '[DoubleApos $host_url]', '[DoubleApos $complete_url]')"
+    }
+                    
+# have added the url if needed - now just update the name
+
+    set sql_update "
+        update  bm_list
+        set     local_title = '[DoubleApos $local_title]',
+                url_id = $url_id,
+                private_p = '$private_p',
+                parent_id = $parent_id
+        where   bookmark_id = $bookmark_id"
+
+    ns_db dml $db $sql_update
+}
+
+
+bm_set_hidden_p $db $user_id
+bm_set_in_closed_p $db $user_id
+
+ns_db dml $db "end transaction"
+
+# send the user back to where they came from before editing began
+ns_returnredirect $return_url
+
+
+
+
Index: web/openacs/www/bookmarks/edit-bookmark.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/edit-bookmark.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/bookmarks/edit-bookmark.tcl	17 Apr 2001 14:05:10 -0000	1.1
@@ -0,0 +1,154 @@
+# edit-bookmark.tcl,v 3.0.4.2 2000/03/28 16:41:55 carsten Exp
+# edit-bookmark.tcl
+#
+# edit a bookmark in your bookmark list
+#
+# by aure@arsdigita.com and dh@arsdigita.com
+
+set_the_usual_form_variables
+
+# bookmark_id, return_url
+ 
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+# start error-checking
+set exception_text ""
+set exception_count 0
+
+if {(![info exists bookmark_id])||([empty_string_p $bookmark_id])} {
+    incr exception_count
+    append exception_text "
  • No bookmark was specified"
+}
+
+# This conditional is needed to catch JavaScript when the user clicks on the folder by his name
+if {$bookmark_id=="undefined"} {
+    ns_returnredirect $return_url
+}
+# make sure that the user owns the bookmark
+set  ownership_query "
+        select count(*)
+        from   bm_list
+        where  owner_id=$user_id
+        and bookmark_id=$bookmark_id"
+set ownership_test [database_to_tcl_string $db $ownership_query]
+
+if {$ownership_test==0} {
+    incr exception_count
+    append exception_text "
  • You can not edit this bookmark"
+}
+
+# return errors
+if { $exception_count> 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+set page_title "Edit Bookmark"
+
+set page_content "
+[ad_header $page_title ]
+
     $page_title 
    
+[ad_context_bar_ws [list $return_url [ad_parameter SystemName bm]] $page_title]
+
    
+"
+
+set bm_info_query "
+        select coalesce(local_title, url_title) as title, complete_url, folder_p,
+               parent_id, private_p, bookmark_id, hidden_p
+        from   bm_list,bm_urls
+        where  bookmark_id=$bookmark_id
+        and    owner_id=$user_id
+        and    bm_list.url_id=bm_urls.url_id(+)"
+
+set selection [ns_db 1row $db $bm_info_query]
+ 
+set_variables_after_query
+
+# begin the form and table
+append page_content "
    "
+ 
+# if the bookmark that is being edited is a real bookmark, ie. not a folder
+if {$folder_p=="f"} {
+    append page_content "
+     
+       
+      
+    "
+}
+
+append page_content "
+  
+  
+
+
+  
+  
+
+  
+  
+
+
+  
+  
+  
+
+"
+
+# write the appropriate words on the delete submit button
+if {$folder_p=="t"} {
+    set delete_text "Delete folder and all its contents"
+} else {
+    set delete_text "Delete this bookmark"
+}
+
+# write out a link for deleting the bookmark, a link is used instead of a submit button
+# to keep within the ACS style guidelines of having one submit button per page
+append page_content "
+
+  
+  
+
+
    URL:
    Title:
    Parent Folder:[bm_folder_selection $db $user_id $bookmark_id]
    Privacy:"
+
+# place the appropriate radio buttons given the privacy setting of the bookmark
+if {$private_p=="f" } {
+    append page_content "
+     Public 
     
+     Private  "
+} else {
+    append page_content "
+     Public 
     
+     Private"
+}
+
+# alert the user that public/private settings will mean nothing 
+# if the bookmark is within a private folder
+if { ![empty_string_p $parent_id] && $hidden_p == "t" } {
+    append page_content "
    (At least one parent folder is private - so this file will always be hidden from the public)"
+}
+
+# ending the form (note that /form is purposely put between /td and /tr to avoid any unnecessary
+# implied paragraph breaks
+append page_content "
+  
    [export_form_vars bookmark_id return_url]
    Severe Actions:$delete_text
    "
+
+# put a footer on the page
+append page_content "[bm_footer]"
+
+# release the database handle before serving the page
+ns_db releasehandle $db 
+
+# serve the page
+ns_return 200 text/html $page_content 
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/bookmarks/export.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/export.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/bookmarks/export.tcl	17 Apr 2001 14:05:10 -0000	1.1
@@ -0,0 +1,41 @@
+# export.tcl,v 3.0.4.1 2000/03/17 17:40:38 aure Exp
+set user_id [ad_verify_and_get_user_id]
+if { $user_id == 0 } {
+    ns_returnredirect "/register/index?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+set title "Export Bookmarks"
+
+set html "[ad_header "$title"]
+
+
    $title
    
+
+[ad_context_bar_ws "index.tcl [ad_parameter SystemName bm]" "$title"]
+
+
    
+
+
    Export bookmarks to Netscape-style bookmark.htm file
    
+
+Clicking on the link below will deliver your bookmarks file in a
+traditional Netscape format... that page choose File...Save As and
+then save the file as 
+
+C:\\Program Files\\Netscape\\Users\\your_name\\bookmark.htm
+
+
+
    
+
+ bookmark.htm
+
    
+
+(Alternatively, you may right click on the above link 
+and choose \"Save Target As...\" or \"Save Link As...\")
+
+[bm_footer]
+
+"
+
+ns_return 200 text/html $html
+
Index: web/openacs/www/bookmarks/import-from-netscape.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/import-from-netscape.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/bookmarks/import-from-netscape.tcl	17 Apr 2001 14:05:10 -0000	1.1
@@ -0,0 +1,176 @@
+# /bookmarks/import-from-netscape.tcl
+#
+# imports bookmarks from the Netscape standard bookmark.htm file
+#
+# by aure@arsdigit.com, June 1999
+#
+# import-from-netscape.tcl,v 3.0.4.1 2000/03/15 05:25:28 aure Exp
+
+ad_page_variables {
+    upload_file
+    bookmark_id
+    return_url
+}
+
+validate_integer bookmark_id $bookmark_id
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set page_title "Importing Your Bookmarks"
+
+# We return headers so that we can show progress, importing can take a while
+
+ReturnHeaders
+
+ns_write "
+[ad_header $page_title]
+
+
     $page_title 
    
+
+[ad_context_bar_ws [list $return_url [ad_parameter SystemName bm]] $page_title ]
+
+
    
+
      
+"
+
+# read contents of the uploaded file up to the maximum number of bytes
+# specified in the .ini file
+set max_bytes [ad_parameter MaxNumberOfBytes bm]
+set contents [read [open [ns_queryget upload_file.tmpfile r]] $max_bytes]
+
+# set flags to be used parsing the input file.
+set folder_list [list "NULL"]
+set parent_id "NULL"
+
+# split the input file 'contents' on returns and rename it 'lines'
+set lines [split $contents "\n"]
+
+# connect to the default pool and start a transaction.
+set db [ns_db gethandle]
+
+foreach line $lines {
+
+    set depth [expr [llength $folder_list]-1]
+   
+    # checks if the line represents a folder
+    if {[regexp {]*>([^<]*)} $line match local_title]} {
+
+	if {[string length $local_title] > 499} {
+	    set local_title "[string range $local_title 0 496]..."
+	}
+	set insert "
+	insert into bm_list
+	(bookmark_id, owner_id, local_title, parent_id, folder_p, creation_date)
+	values
+	($bookmark_id,$user_id, [db_postgres_doubleapos_null_sql $local_title]', $parent_id, 't', sysdate())
+	"
+
+	lappend folder_list $bookmark_id
+	set parent_id $bookmark_id
+
+	if [catch {ns_db dml $db $insert} errmsg] {
+	    # if it was not a double click, produce an error
+	    if { [database_to_tcl_string $db "select count(bookmark_id) from bm_list where bookmark_id = $bookmark_id"] == 0 } {
+		ad_return_complaint 1 "We were unable to create your user record in the database.  Here's what the error looked like:
+
      
+
      +$errmsg
+
      
+
      "
+return 
+             } else { 
+	    # assume this was a double click
+	    ns_returnredirect $return_url
+	     }
+	 } else {
+	    set bookmark_id [database_to_tcl_string $db "select bm_bookmark_id_seq.nextval from dual"]
+	    ns_write "
    •  Inserting \"$local_title\""
+	} 
+
+    }
+
+    # check if the line ends the current folder
+    if {[regexp {} $line match]} {
+	set folder_depth [expr [llength $folder_list]-2]
+	if {$folder_depth<0} {
+	    set folder_depth 0
+	}
+	set folder_list [lrange $folder_list 0 $folder_depth]
+	set parent_id [lindex $folder_list $folder_depth]
+    }
+
+    # check if the line is a url
+    if {[regexp -nocase {
      ]*>([^<]*)} $line match complete_url local_title]} {
+
+	set host_url [bm_host_url $complete_url]
+
+	if { [empty_string_p $host_url] } {
+	    continue
+	}
+
+	# check to see if we already have the url in our database
+	set url_query "select url_id
+	               from   bm_urls
+                       where  complete_url='[DoubleApos $complete_url]'"
+	set url_id [database_to_tcl_string_or_null  $db $url_query]
+
+	# if we don't have the url, then insert the url into the database
+	if {[empty_string_p $url_id]} { 
+	    set url_id [database_to_tcl_string $db "select bm_url_id_seq.nextval from dual"]
+	    ns_db dml $db "    
+	    insert into bm_urls 
+	    (url_id, host_url, complete_url)
+	    values
+	    ($url_id, '[DoubleApos $host_url]', '[DoubleApos $complete_url]')
+	    "
+	}
+
+	set insert "
+	insert into bm_list
+	(bookmark_id, owner_id, url_id, local_title, parent_id, creation_date)
+	values
+	($bookmark_id, $user_id, $url_id, [db_postgres_doubleapos_null_sql $local_title]', $parent_id, sysdate())
+	"	
+
+	if [catch {ns_db dml $db $insert} errmsg] {
+	    # if it was not a double click, produce an error
+	    if { [database_to_tcl_string $db "select count(bookmark_id) from bm_list where bookmark_id = $bookmark_id"] == 0 } {
+		ad_return_complaint 1 "We were unable to create your user record in the database.  Here's what the error looked like:
+
      
+
      +$errmsg
+
      
+
      "
+return 
+             } else { 
+	    # assume this was a double click
+	    ns_returnredirect $return_url
+	     }
+	 } else {
+	    set bookmark_id [database_to_tcl_string $db "select bm_bookmark_id_seq.nextval from dual"]
+	    ns_write "
    •  Inserting \"$local_title\""
+
+	} 
+    }
+}
+
+# call the procedure which sets the 'hidden_p' column in the 'bm_list' table
+# this determines if a given bookmark/folder is somewhere inside a private folder.
+bm_set_hidden_p $db $user_id
+
+# same as above, but this sets the closed_p and in_closed_p columns
+bm_set_in_closed_p $db $user_id
+
+ns_write "
     Done!  Click to continue.
+[bm_footer]"
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/bookmarks/import-from-shortcut.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/import-from-shortcut.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/bookmarks/import-from-shortcut.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,82 @@
+# /bookmarks/import-from-shortcut.tcl
+#
+# a utility to grab info from shortcut
+#
+# by aure@arsdigita.com, June 1999
+#
+# import-from-shortcut.tcl,v 3.0.4.1 2000/03/15 05:23:58 aure Exp
+
+ad_page_variables {
+    upload_file
+    return_url
+}
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set contents [read [open [ns_queryget upload_file.tmpfile r]]]
+
+set folder_list 0
+set parent_id 0
+set lines [split $contents "\n"]
+
+set db [ns_db gethandle]
+
+set bookmark_id [database_to_tcl_string $db "
+select bm_bookmark_id_seq.nextval from dual"]
+
+# release the database handle
+ns_db releasehandle $db 
+
+set directory ""
+
+regexp {([^\\]*).url} $upload_file match local_title
+regexp {([^\\]*)\\[^\\]*.url} $upload_file match directory 
+
+foreach line $lines {
+    regexp {URL=([^ ]*)[ ]*} $line  match complete_url
+}
+
+set title "Choose Folder for \"$local_title\""
+
+ns_return 200 text/html "[ad_header "$title"]
+
+
    $title
    
+
+[ad_context_bar_ws "$return_url [ad_parameter SystemName bm]" [list "import" "Import"] "$title"]
+
+
    
+
+You will be adding: 
+
+If this is correct, choose which folder to place the bookmark in:
+
      
+
+
+
+
+
+
      
+
+
+[export_form_vars local_title complete_url bookmark_id return_url]
+
+[bm_folder_selection $db $user_id $bookmark_id]
+
      
+
+
      
+
    
+
+[bm_footer]"
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/bookmarks/import.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/import.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/bookmarks/import.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,108 @@
+# /bookmarks/import.tcl
+#
+# by aure@arsdita.com and dh.arsdigita.com, June 1999
+#
+# static html page for importing bookmarks in a variety of ways
+#
+# although this is mostly static html, we need it to be in tcl
+# for setting the return_url and grabbing the next bookmark_id
+# from the database
+#
+# import.tcl,v 3.0.4.2 2000/03/15 05:22:00 aure Exp
+
+ad_page_variables {return_url}
+
+# (return_url is needed because this page could be called from either the 
+# index page or the javascript window and we need to eventually send the 
+# user back to the right place)
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+# we grab the bookmark_id now for double click protection
+set bookmark_id [database_to_tcl_string $db "
+select bm_bookmark_id_seq.nextval from dual"]
+
+# release the database handle
+ns_db releasehandle $db 
+
+set page_title "Add/Import Bookmarks"
+
+ns_return 200 text/html "
+[ad_header $page_title]
+
+
    $page_title
    
+
+[ad_context_bar_ws [list $return_url [ad_parameter SystemName bm]] $page_title]
+
+
    
+
+
    Add manually
    
+Insert the URL below.  If you leave the title blank, we will 
+attempt to get the title from the web site.  
+
+
    
+[export_form_vars return_url]
+
+
+
+   
+   
+
+
+   
+   
+
+
+   
+   
+
+
    URL:
    Title (Optional):
    
+   
+   
+   
    
+
    
+
+
    Import multiple bookmarks from Netscape-style bookmark.htm file
    
+
+
    
+[export_form_vars bookmark_id return_url]
+Use the browse button to locate your bookmark.htm file 
+(the default location for Netscape users is 
+c:\\Program Files\\Netscape\\Users\\your_name\\bookmark.htm )
    
+
+Bookmarks File: 
+
+
+
     
+
+Note: For Internet Explorer users, you may convert your favorites into a 
+bookmarks.htm file using favtool.exe, a free tool 
+created by Microsoft to solve this problem.
+
+
    
+
+
    Import one bookmark from IE shortcut file
    
+
+
    
+[export_form_vars return_url]
+Use the browse button to locate an IE favorites shortcut 
+(the default directory for these files  is c:\\Windows\\Favorites\\)
    
+Favorite Shortcut: 
+
+
+
    
+
+[bm_footer]"
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/bookmarks/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/bookmarks/index.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,168 @@
+# /bookmarks/index.tcl
+#
+# Front page to the bookmarks system
+#
+# by aure@arsdigita.com and dh@arsdigita.com, June 1999
+#
+# index.tcl,v 3.0.4.1 2000/03/15 04:54:31 aure Exp
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+set page_title [ad_parameter SystemName bm]
+
+# get generic display parameters from the .ini file
+set folder_bgcolor [ad_parameter FolderBGColor bm]
+set bookmark_bgcolor [ad_parameter BookmarkBGColor bm]
+set folder_decoration [ad_parameter FolderDecoration bm]
+set hidden_decoration [ad_parameter HiddenDecoration bm]
+set dead_decoration [ad_parameter DeadDecoration bm]
+
+set edit_anchor "edit"
+
+# the javascript function that spawns the bookmark window
+set javascript "
+
+"
+
+# display header and list of user options 
+set page_content "
+[ad_header $page_title $javascript]
+
+
     $page_title 
    
+
+[ad_context_bar_ws $page_title ]
+
+
    
+\[Add / Import |
+ Export |
+ Create New Folder |
+ Check Links |
+ Javascript version |
+ View public bookmarks \] 
    "
+
+set name [database_to_tcl_string $db "select first_names || ' ' || last_name as name from users where user_id = $user_id"]
+
+append page_content "
+
+
+
+    
+
+
    ${folder_decoration}Bookmarks for $nameClose/Open All Folders
    "
+
+set bookmark_query "
+    select   bookmark_id, 
+             bm_list.url_id, 
+             coalesce(local_title, url_title) as bookmark_title, 
+             hidden_p, 
+             complete_url,  
+             last_live_date, 
+             last_checked_date, 
+             folder_p, 
+             closed_p, 
+             length(parent_sort_key)*8 as indent_width 
+    from     bm_list, bm_urls
+    where    owner_id = $user_id
+    and      in_closed_p = 'f'
+    and      bm_list.url_id = bm_urls.url_id(+)
+    order by parent_sort_key || local_sort_key"
+
+set selection [ns_db select $db $bookmark_query]
+
+set bookmark_count 0
+set bookmark_list ""
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    # decoration refers to color and font of the associated text
+    set decoration ""
+
+    # make private links appear as defined in the .ini file
+    if {$hidden_p == "t"} {
+	append decoration $hidden_decoration
+    }
+
+    # make dead links appear  as defined in the .ini file
+    if {$last_checked_date != $last_live_date} {
+	append decoration $dead_decoration
+    }
+    
+    # make folder titles appear  as defined in the .ini file
+    if {$folder_p == "t"} {
+	append decoration $folder_decoration
+    } 
+
+    # dropping apostrophes and quotation marks from the javascript title
+    # that will be used in the fancy edit link below
+    regsub -all {'|"} $bookmark_title {} javascript_title
+
+    # this fancy edit link shows "Edit foo" in the status bar
+    set edit_link "$edit_anchor"
+
+
+    # define url, background color, and image depending on whether we are display a bookmark or folder
+    if {$folder_p == "f"} {
+	set url $complete_url
+	set bgcolor $bookmark_bgcolor
+	set image "pics/ftv2doc.gif"
+    } else {
+	set bgcolor $folder_bgcolor
+	set url "toggle-open-close?[export_url_vars bookmark_id]"
+
+	# different images for whether or not the folder is open
+	if {$closed_p == "t"} {
+	    set image "pics/ftv2folderclosed.gif"
+	} elseif {$closed_p == "f" } {
+	    set image "pics/ftv2folderopen.gif"
+	}
+    }
+
+    append bookmark_list "
+    
+    
+    
+    
+    
+    
+    
+    
    $decoration[string trim $bookmark_title]$edit_link
    "
+    
+    incr bookmark_count
+}
+
+# write the bookmarks if there are any to show
+if {$bookmark_count!=0} {
+    append page_content "$bookmark_list"
+} else {
+    append page_content "You don't have any bookmarks stored in the database. 
    "
+}
+
+append page_content "
    
+ Search bookmarks for: 
    
+
    
+Key to bookmark display:
+
+
+
+
+
+
+
+
    •  $hidden_decoration Private or hidden files or folders appear like this.
    •  $dead_decoration Unreachable links appear like this. These links may not be completely dead, but they were unreachable by our server on last attempt.
    "
+
+# Add a footer
+append page_content "[bm_footer]"
+
+# release the database handle
+ns_db releasehandle $db 
+
+# serve the page
+ns_return 200 text/html $page_content 
Index: web/openacs/www/bookmarks/insert-one-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/insert-one-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/bookmarks/insert-one-2.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,96 @@
+# /bookmarks/insert-one-2.tcl
+#
+# by aure@arsdigita.com and dh@arsdigita.com, June 1999
+#
+#  inserts a single bookmark into the bookmark system.
+#
+#  Details: 
+#   1 splits the 'complete_url' to get the 'host_url'
+#   2 checks if 'complete_url' and implicitly 'host_url' are  already in bm_urls  
+#            if not,  inserts them into the table 
+#   3 inserts the corresponding 'pretty_title', 'bookmark_id', 'parent_id' (along with user_id) 
+#     into bm_list
+#
+# insert-one-2.tcl,v 3.0.4.2 2000/03/18 00:09:11 cnk Exp
+
+ad_page_variables {
+    parent_id
+    complete_url
+    local_title
+    bookmark_id
+    return_url
+}
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+# split the url to get the host_url
+set host_url [bm_host_url $complete_url]
+
+# check if the 'complete_url' is already in bm_urls
+set sql_count_urls "
+    select count(*)
+    from   bm_urls
+    where  complete_url = '$QQcomplete_url' "
+
+set n_complete_urls [database_to_tcl_string $db $sql_count_urls]
+
+# if this url isn't already in the database, get the next 'url_id' and insert the url (complete and host)
+# with it.
+# if it is already in the database just get the corresponding 'url_id' 
+
+if {$n_complete_urls == "0"} {
+
+    set url_id [database_to_tcl_string $db "select bm_url_id_seq.nextval from dual"]
+    ns_db dml $db "
+        insert  into  bm_urls
+        (url_id, host_url, complete_url)
+        values
+        ($url_id,'[DoubleApos $host_url]','$QQcomplete_url') "
+
+} else {
+
+    set url_id [database_to_tcl_string $db "select url_id from bm_urls where complete_url='$QQcomplete_url'"]
+
+}
+   
+set insert "
+    insert into bm_list
+    (bookmark_id, owner_id, url_id, local_title, parent_id, creation_date)
+    values
+    ($bookmark_id, $user_id, $url_id,'[db_postgres_doubleapos_null_sql $local_title]', [ns_dbquotevalue $parent_id], sysdate())"
+
+if [catch {ns_db dml $db $insert} errmsg] {
+    # check and see if this was a double click
+
+    set dbclick_p [database_to_tcl_string $db "select count(*) from bm_list where bookmark_id=$bookmark_id"]
+
+    if {$dbclick_p == "1"} {
+
+	ns_returnredirect $return_url
+	return
+
+    } else {
+
+	ad_return_complaint 1 "
  •  There was an error making this insert into the database. $errmsg"
+	return 
+
+    }
+}
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect $return_url
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/bookmarks/insert-one.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/insert-one.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/bookmarks/insert-one.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,117 @@
+# /bookmarks/insert-one.tcl
+#
+# finds title information and give s the user folder placement options
+#
+# by dh@arsdigita.com and aure@arsdigita.com, June 1999
+#
+# insert-one.tcl,v 3.0.4.2 2000/03/15 05:29:10 aure Exp
+
+ad_page_variables {
+    complete_url
+    local_title
+    return_url
+}
+
+set user_id [ad_verify_and_get_user_id]
+if { $user_id == 0 } {
+    ns_returnredirect "/register/index?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+# check that the 'complete_url' isn't blank
+if {[empty_string_p $complete_url]} {
+    set title "Missing URL"
+    ns_return 200 text/html  "[ad_header $title] 
+    
    $title
    
+
+    [ad_context_bar_ws [list $return_url [ad_parameter SystemName bm]] [list "import" "Add"] $title]
+    
    
+    You left the URL field empty - to add link you must enter a URL.
+    [bm_footer]"
+
+    return
+}
+
+# see if 'complete_url' is missing the protocol (ie https:// ) - if so set complete_url "http://$complete_url"
+
+if { ![regexp {^[^:\"]+://} $complete_url] } {
+    set complete_url "http://$complete_url"
+}
+
+if {[empty_string_p $local_title]} {
+    if {[catch {ns_httpget $complete_url 10} url_content]} {
+	set errmsg "
+	We're sorry but we can not detect a title for this bookmark,
+	the URL is unreachable. 
     If you still want to add this bookmark now,
+	press \[Back\] on your browser and check the URL or type in a title.
+	"
+    } else {
+	regexp -nocase {([^<]*)} $url_content match local_title
+	if {[empty_string_p $local_title]} {
+	    set errmsg "
+	    We're sorry but we can not detect a title for this bookmark,
+	    the host does not provide one.  
    If you still want to add this 
+	    bookmark now,
+	    press \[Back\] on your browser and check the URL or type in a title.
+            "
+	}
+    }
+}
+
+set title "Inserting \"[string trim $local_title]\""
+
+set page_content "[ad_header $title]
+
+
    $title
    
+
+[ad_context_bar_ws [list $return_url [ad_parameter SystemName bm]] [list "import" "Add"] $title]
+
+
    "
+
+set db [ns_db gethandle]
+
+# get the next bookmark_id (used as primary key in bm_list)
+set bookmark_id [database_to_tcl_string $db "select bm_bookmark_id_seq.nextval from dual"]
+
+if {[empty_string_p $local_title]} {
+    append page_content $errmsg
+} else {
+
+    append page_content "
+    
+    You will be adding: 
+    
+    
    
+    [export_form_vars local_title complete_url bookmark_id return_url]
+    
+    If this is correct, choose which folder to place the bookmark in:
+    
      
+    
+    
+    
+    
+    
      
+    [bm_folder_selection $db $user_id $bookmark_id]
+    
      
+    
+    
      
+    
+    
    "
+}
+
+append page_content "
+[bm_footer]"
+
+ns_return 200 text/html $page_content
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/bookmarks/live-check.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/live-check.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/bookmarks/live-check.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,173 @@
+# /bookmarks/live-check.tcl
+#
+# checks all links and gets an error code for each
+#
+# by aure@arsdigita.com, June 1999
+#
+# live-check.tcl,v 3.0.4.1 2000/03/15 06:23:15 aure Exp
+
+ad_page_variables {return_url}
+
+# note this should be included in the ACS procs somewhere
+proc get_http_status {url {use_get_p 0} {timeout 30}} { 
+    if $use_get_p {
+	set http [ns_httpopen GET $url "" $timeout] 
+    } else {
+	set http [ns_httpopen HEAD $url "" $timeout] 
+    }
+    # philg changed these to close BOTH rfd and wfd
+    set rfd [lindex $http 0] 
+    set wfd [lindex $http 1] 
+    close $rfd
+    close $wfd
+    set headers [lindex $http 2] 
+    set response [ns_set name $headers] 
+    set status [lindex $response 1] 
+    ns_set free $headers
+    return $status
+}
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+# return headers to spool out this slowly generating page
+ReturnHeaders
+
+set page_title "Checking Your Bookmarks"
+
+ns_write "
+[ad_header $page_title ]
+
+
     $page_title 
    
+
+[ad_context_bar_ws [list $return_url [ad_parameter SystemName bm]] $page_title ]
+
+
    
+
+Links that aren't reachable will appear with a checkbox in front of them and the words NOT FOUND after the link.  If you want to delete these links, simply click the checkbox and then the \"Delete selected links\" button at the bottom of the page.  
+
+
    "
+
+set db [ns_db gethandle]
+
+set sql_query "
+    select unique bm_list.url_id, local_title, complete_url
+    from   bm_list, bm_urls
+    where  owner_id = $user_id
+    and    bm_list.url_id = bm_urls.url_id"
+set check_list [database_to_tcl_list_list $db $sql_query]
+
+# releasing the database here because checking all of someone's bookmarks could tie
+# up the database for a long time
+ns_db releasehandle $db
+
+if [empty_string_p $check_list] {
+    ns_write "you have no bookmarks to check.
+
    
+[ad_footer]"
+return
+}
+
+set dead_count 0
+
+foreach check_set $check_list {
+    set url_id [lindex $check_set 0]
+    set local_title [lindex $check_set 1]
+    set complete_url [lindex $check_set 2]
+
+    # we only want to check http:
+    if { [regexp -nocase "^mailto:" $complete_url] ||  [regexp -nocase "^file:" $complete_url] || (![regexp -nocase "^http:" $complete_url] && [regexp {^[^/]+:} $complete_url]) || [regexp "^\\#" $complete_url] } {
+	# it was a mailto or an ftp:// or something (but not http://)
+	# else that http_open won't like (or just plain #foobar)
+
+	ns_write "
+	
+	
+	
+	
+	
+	
     Skipping $local_title....
    "
+	
+	continue
+    } 
+   
+    
+    # strip off any trailing #foo section directives to browsers
+    regexp {^(.*/?[^/]+)\#[^/]+$} $complete_url dummy complete_url
+    if [catch { set response [get_http_status $complete_url 2] } errmsg ] {
+	# we got an error (probably a dead server)
+	set response "probably the foreign server isn't responding at all"
+    }
+    if {$response == 404 || $response == 405 || $response == 500 } {
+	# we should try again with a full GET 
+	# because a lot of program-backed servers return 404 for HEAD
+	# when a GET works fine
+	if [catch { set response [get_http_status $complete_url 2] } errmsg] {
+	    set response "probably the foreign server isn't responding"
+	} 
+    }
+
+    set checked_pair $url_id
+    if { $response != 200 && $response != 302 } {
+	lappend checked_pair " "
+	ns_write "
+	
+	
+	
+	
    
+	$local_title.... NOT FOUND
    \n"
+	incr dead_count
+    } else {
+	lappend checked_pair ", last_live_date=sysdate"
+	ns_write "
+	
+	
+	
+	
+	
+	
    $local_title.... FOUND
    \n"
+    }
+    lappend checked_list $checked_pair
+}
+
+
+set db [ns_db gethandle]
+
+foreach checked_pair $checked_list {
+    set url_id [lindex $checked_pair 0]
+    set last_live_clause [lindex $checked_pair 1]
+
+    # this does many database updates instead of just one
+    ns_db dml $db "
+	update bm_urls 
+	set    last_checked_date = sysdate$last_live_clause
+	where  url_id = $url_id"
+}
+
+ns_write " Done! Click to continue"
+
+if {$dead_count>0} {
+
+    ns_write "
+    or 
+    [export_form_vars return_url]
+    
    "
+
+}
+
+ns_write "[bm_footer]"
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/bookmarks/mass-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/mass-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/bookmarks/mass-delete.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,8 @@
+# mass-delete.tcl,v 3.0 2000/02/06 03:35:33 ron Exp
+set db [ns_db gethandle]
+set user_id [ad_verify_and_get_user_id]
+
+ns_db dml $db "delete from bm_list where owner_id = $user_id "
+
+ns_returnredirect index.tcl
+
Index: web/openacs/www/bookmarks/most-popular-public.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/most-popular-public.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/bookmarks/most-popular-public.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,83 @@
+# most-popular-public.tcl,v 3.0 2000/02/06 03:35:36 ron Exp
+# /bookmarks/most-popular-public.tcl
+#
+# prints a report of the most popular hosts and urls in the system
+#
+# by philg@mit.edu on November 7, 1999
+#
+# copied from /admin/bookmarks/most-popular.tcl but limited 
+# to public_p
+#
+
+
+set title "Most Popular Public Bookmarks"
+set max_hosts 10
+set max_urls 20
+
+
+set html "[ad_header $title]
+
+
    $title
    
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Bookmarks"]  [list "public-bookmarks.tcl" "Public"] $title]
+
+
    
+
+
    Most Popular Hosts
    
+
+
      
+"
+
+set db [ns_db gethandle main]
+
+# -- get the most popular hosts -----------
+set selection [ns_db select $db "select host_url, count(*) as n_bookmarks
+from bm_urls, bm_list
+where bm_urls.url_id = bm_list.url_id
+and bm_list.private_p <> 't'
+group by host_url
+order by n_bookmarks desc"]
+
+set counter 0
+while {[ns_db getrow $db $selection] && $counter < $max_hosts} {
+    incr counter
+    set_variables_after_query
+
+    regsub {^http://([^/]*)/?} $host_url {\1} hostname
+    append html "
    • $n_bookmarks: $hostname"
+}
+if {$counter==$max_hosts} {
+    ns_db flush $db
+}
+
+# -- get the most popular urls ----------------
+append html "
    \n\n
    Most Popular URLs
    \n\n
      \n"
+
+set selection [ns_db select $db "select complete_url, url_title, count(*) as n_bookmarks
+from bm_urls, bm_list
+where bm_urls.url_id = bm_list.url_id
+and bm_list.private_p <> 't'
+group by complete_url, url_title
+order by n_bookmarks desc"]
+
+set counter 0
+while {[ns_db getrow $db $selection] && $counter < $max_urls} {
+    incr counter
+    set_variables_after_query
+    if [empty_string_p $url_title] {
+	set url_title $complete_url
+    }
+    append html "
    • $n_bookmarks: $url_title"
+}
+if {$counter==$max_urls} {
+    ns_db flush $db
+}
+
+append html "
    [ad_footer  ]"
+
+ns_db releasehandle $db
+
+# --serve the page ------------------------
+ns_return 200 text/html $html
+
+
Index: web/openacs/www/bookmarks/one-host-public.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/one-host-public.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/bookmarks/one-host-public.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,56 @@
+# one-host-public.tcl,v 3.0 2000/02/06 03:35:37 ron Exp
+# /bookmarks/one-host-public.tcl
+#
+# all the (public) URLs that start with a particular host
+#
+# philg@mit.edu on November 7, 1999
+# 
+
+set_the_usual_form_variables
+
+# url
+
+set db [ns_db gethandle]
+
+set html "[ad_header "Bookmarks for $url"]
+
    Bookmarks for $url
    
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Bookmarks"]  [list "public-bookmarks.tcl" "Public"] [list "most-popular-public.tcl" "Most Popular"] "One URL"]
+
+
    
+
+
      
+"
+
+set selection [ns_db select $db "select u.first_names || ' ' || u.last_name as name, complete_url
+from users u, bm_list bml, bm_urls bmu
+where u.user_id = bml.owner_id
+  and bml.url_id = bmu.url_id
+  and bml.private_p <> 't'
+  and bmu.host_url = '$QQurl'
+order by name"]
+
+
+set old_name ""
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    if { $old_name != $name } {
+	append html "
      $name
      \n"
+	set old_name $name
+    }
+
+    append html "
    • $complete_url\n"
+}
+
+append html "
    
+
+[ad_admin_footer]
+"
+
+ns_db releasehandle $db
+
+
+# --serve the page -----------
+ns_return 200 text/html $html
Index: web/openacs/www/bookmarks/public-bookmarks-for-one-user.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/public-bookmarks-for-one-user.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/bookmarks/public-bookmarks-for-one-user.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,118 @@
+# public-bookmarks-for-one-user.tcl,v 3.0.4.1 2000/03/15 08:12:58 aure Exp
+# public-bookmarks.tcl
+#
+# show other people's bookmarks
+#
+# by dh@arsdigita.com and aure@arsdigita.com
+#
+# fixed on November 7, 1999 by philg@mit.edu to release
+# database handle and also call correct context bar
+
+set_the_usual_form_variables 0
+
+# viewed_user_id
+
+validate_integer viewed_user_id $viewed_user_id
+
+set title "Show public bookmarks"
+
+# get generic display parameters from the .ini file
+set folder_bgcolor [ad_parameter FolderBGColor bm]
+set bookmark_bgcolor [ad_parameter BookmarkBGColor bm]
+set folder_decoration [ad_parameter FolderDecoration bm]
+set dead_decoration [ad_parameter DeadDecoration bm]
+
+set db [ns_db gethandle]
+
+# Get the bookmarks' owner's name.
+set name [database_to_tcl_string_or_null $db "select first_names || ' ' || last_name
+from users
+where user_id = $viewed_user_id"]
+
+if { $name == "" } {
+    ns_returnredirect public-bookmarks.tcl
+    return
+}
+
+set title "$name's bookmarks"
+set html "
+[ad_header $title ]
+
+
     $title 
    
+
+[ad_context_bar_ws_or_index [list "index.tcl" [ad_parameter SystemName bm]] [list "public-bookmarks.tcl" "Public Bookmarks"] "For one user"]
+
+
+
    
+
+[help_upper_right_menu [list "/shared/community-member.tcl?user_id=$viewed_user_id" "community member page for $name"]]
+
    
+"
+
+append bookmark_html "
    $name's Bookmarks
    "
+
+# get the bookmarks from the database and parse the output to reflect the folder stucture
+# - in doing so determine if a given element (bookamrk/folder) is in a private folder.
+
+set sql_query "
+        select   bookmark_id, bm_list.url_id, folder_p,
+                 coalesce(local_title, url_title) as bookmark_title, complete_url, 
+                 last_live_date, last_checked_date, length(parent_sort_key)*8 as indent_width 
+        from     bm_list, bm_urls
+        where    owner_id=$viewed_user_id
+        and      bm_list.url_id=bm_urls.url_id(+)
+        and      hidden_p='f'
+        order by parent_sort_key || local_sort_key
+        "
+
+set selection [ns_db select $db $sql_query]
+
+set bookmark_count 0
+set bookmark_list ""
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    # decoration refers to color and font of the associated text
+    set decoration ""
+
+    # make dead links appear  as definied in the .ini file
+    if {$last_checked_date!=$last_live_date} {
+	append decoration $dead_decoration
+    }
+    
+    # make folder titles appear  as definied in the .ini file
+    if {$folder_p=="t"} {
+	append decoration $folder_decoration
+    } 
+
+    # define url, background color, and image depending on whether we are display a bookmark or folder
+    if {$folder_p=="f"} {
+	set link ""
+	set bgcolor $bookmark_bgcolor
+	set image "pics/ftv2doc.gif"
+    } else {
+	set link ""
+	set bgcolor $folder_bgcolor
+	set image "pics/ftv2folderopen.gif"
+    }
+
+    append bookmark_list "
+      
+        
+          
+          
+          
+        
+      
    $link$link$decoration[string trim $bookmark_title]
    "
+    
+    incr bookmark_count
+}
+
+
+append html "$bookmark_list [bm_footer]"
+
+ns_db releasehandle $db 
+
+# serve the page
+ns_return 200 text/html $html 
Index: web/openacs/www/bookmarks/public-bookmarks.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/public-bookmarks.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/bookmarks/public-bookmarks.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,73 @@
+# public-bookmarks.tcl,v 3.0 2000/02/06 03:35:40 ron Exp
+# public-bookmarks.tcl
+#
+# show other people's bookmarks
+#
+# by dh@arsdigita.com and aure@arsdigita.com
+#
+# modified by philg@mit.edu on November 7, 1999
+# to include a link to the most popular, release the 
+# database handle, etc.
+
+set title "Public Bookmarks"
+
+set db [ns_db gethandle]
+
+
+set whole_page "
+[ad_header $title ]
+
+
     $title 
    
+
+[ad_context_bar_ws_or_index [list "index.tcl" [ad_parameter SystemName bm]] $title]
+
+
    "
+
+set sql_query "
+select  first_names, last_name, owner_id as viewed_user_id, count(bookmark_id) as number_of_bookmarks
+from    users, bm_list
+where   user_id=owner_id
+and     hidden_p='f'
+group by first_names, last_name, owner_id
+order by number_of_bookmarks desc"
+
+set selection [ns_db select $db $sql_query]
+set user_count 0
+set user_list ""
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr user_count            
+    append user_list "
  • $first_names $last_name ($number_of_bookmarks)\n"
+}
+
+if { $user_count > 0 } {
+    append whole_page "
+
+Look at the most popular bookmarks:  summarized by URL
+
+
    
+
+or
+
+
    
+
+Choose a user whose public bookmarks you would like to view:
+
+
      
+$user_list
+
    
+"
+} else {
+    append whole_page "There are no users in this system with public bookmarks"
+}
+
+append whole_page [bm_footer]
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $whole_page
+
+
+
+
Index: web/openacs/www/bookmarks/search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/bookmarks/search.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,142 @@
+# search.tcl,v 3.0 2000/02/06 03:35:34 ron Exp
+# search.tcl
+#
+# the "not very bright" search engine for the bookmarks system
+#
+# by aure@arsdigita.com
+
+set_the_usual_form_variables
+
+# search_text, return_url
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+if [empty_string_p $QQsearch_text] {
+    ad_return_complaint 1 "
  • please enter a search string"
+    return
+}
+
+if [regexp {^%+$} $QQsearch_text] {
+    ad_return_complaint 1 "
  • please search for more than just a wildcard."
+    return
+}
+
+set db [ns_db gethandle]
+
+set page_title "Search for  \"$search_text\""
+
+set search_pattern "'%[string toupper $QQsearch_text]%'"
+
+set html "
+[ad_header  $page_title ]
+
     $page_title 
    
+[ad_context_bar_ws [list $return_url [ad_parameter SystemName bm]] $page_title ]
+
    
+"
+
+# this select gets all your bookmarks that match your request
+set sql_query "
+        select   bookmark_id, complete_url,
+                 coalesce(local_title, url_title) as title, meta_keywords, meta_description
+        from     bm_list, bm_urls
+        where    owner_id = $user_id 
+        and      folder_p = 'f'
+        and      bm_list.url_id=bm_urls.url_id 
+        and      (upper(local_title) like $search_pattern
+        or       upper(url_title) like $search_pattern
+        or       upper(complete_url) like $search_pattern
+        or       upper(meta_keywords) like $search_pattern
+        or       upper(meta_description) like $search_pattern)
+        order by title
+        "
+
+set selection [ns_db select $db $sql_query]
+set bookmark_count 0
+set bookmark_html ""
+
+while {[ns_db getrow $db $selection]} {
+
+    set_variables_after_query
+
+    incr bookmark_count
+
+    append bookmark_html "
+    $title
    " 
+
+}
+
+if {$bookmark_count!=0} {
+    append html "Here are your bookmarks that match your search:
+    
       $bookmark_html
    "
+} else {
+    append html  "
    We couldn't find any matches among your bookmarks.
    \n"
+}
+
+
+# thie query searches across other peoples not hidden bookmarks (for
+# which hidden_p='f')
+
+set sql_query "
+        select   distinct complete_url,
+                 coalesce(local_title, url_title) as title, meta_keywords, meta_description, folder_p
+        from     bm_list, bm_urls
+        where    owner_id <> $user_id
+        and      private_p = 'f'
+        and      hidden_p='f'
+        and      folder_p='f' 
+        and      bm_list.url_id=bm_urls.url_id 
+        and      (upper(local_title) like $search_pattern
+        or       upper(url_title) like $search_pattern
+        or       upper(complete_url) like $search_pattern
+        or       upper(meta_keywords) like $search_pattern
+        or       upper(meta_description) like $search_pattern)
+        order by title
+        "
+
+set selection [ns_db select $db $sql_query]
+set bookmark_count 0
+set bookmark_html ""
+
+while {[ns_db getrow $db $selection]} {
+
+    set_variables_after_query
+
+    incr bookmark_count
+
+    if {$folder_p=="f"} {
+	regsub " " $complete_url "%20" complete_url
+	append bookmark_html "
+	$title
    " 
+    } else {
+	append bookmark_html " $title 
    " 
+}
+ 
+}
+
+if {$bookmark_count!=0} {
+    append html "Here are other people's bookmarks that match your search:
+    
       $bookmark_html
    "
+} else {
+    append html  "Your search returned zero matches in other bookmark lists."
+}
+
+
+append html "
+
+Done. Click to continue.
+
    
+
+[bm_footer]" 
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $html
+
+
+
+
+
+
+
+
Index: web/openacs/www/bookmarks/toggle-open-close.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/toggle-open-close.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/bookmarks/toggle-open-close.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,57 @@
+# /bookmarks/toggle-open-close.tcl
+#
+# opens or closes folders in the bookmarks system
+#
+# dh@arsdigita.com and aure@arsdigita.com, June 1999
+#
+# toggle-open-close.tcl,v 3.0.4.2 2000/03/28 16:41:55 carsten Exp
+
+ad_page_variables {
+    {bookmark_id ""}
+    {action ""}
+}
+ 
+validate_integer bookmark_id $bookmark_id
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+# note, we do not do error checking for this script because anybody messing with 
+# the arguments in the url won't be able to do much, we have the owner_id=$user_id
+# check in each of the sql updates instead, so instead of doing extra checks at 
+# the top of this script, we have additional constraints in the sql, which we 
+# think is better.
+
+set db [ns_db gethandle]
+
+ns_db dml $db "begin transaction"
+
+
+if { [string compare $action "open_all"] == 0 } {
+    ns_db dml $db "update bm_list set closed_p = 'f' where owner_id = $user_id"
+} elseif { [string compare $action "close_all"] == 0 } {
+    ns_db dml $db "update bm_list set closed_p = 't' where owner_id = $user_id"
+} else {
+    # determine current state of folder (closed/open)
+
+    set closed_p [database_to_tcl_string $db "
+	select closed_p from bm_list where bookmark_id = $bookmark_id"]
+    
+    if { $closed_p == "t" } {
+	ns_db dml $db "
+	    update bm_list
+            set    closed_p = 'f'
+            where  bookmark_id = $bookmark_id and owner_id = $user_id"
+    } else {
+	ns_db dml $db "
+	    update bm_list
+            set    closed_p = 't'
+            where  bookmark_id = $bookmark_id and owner_id = $user_id"
+    }
+}
+
+bm_set_in_closed_p $db $user_id
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect ""
Index: web/openacs/www/bookmarks/top-frame.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/top-frame.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/bookmarks/top-frame.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,26 @@
+
+
+
+
+
    
+
    
+
+
+
+
+
+
    Add/ImportExportNew Folder
    
+
+
+
+
+
+
+
+
+
    RefreshMainSearch 
       
+
    
\ No newline at end of file
Index: web/openacs/www/bookmarks/tree-dynamic.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/tree-dynamic.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/bookmarks/tree-dynamic.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,88 @@
+# tree-dynamic.tcl,v 3.0 2000/02/06 03:35:43 ron Exp
+# tree-dynamic.tcl
+#
+# Javascript tree data builder
+#
+# by aure@arsdigita.com
+
+
+set user_id [ad_verify_and_get_user_id]
+
+# time
+# we get this time variable only so that certain browser (internet explorer, for instance)
+# will not try to cache this page
+
+# get generic display parameters from the .ini file
+set folder_decoration [ad_parameter FolderDecoration bm]
+set hidden_decoration [ad_parameter HiddenDecoration bm]
+set dead_decoration [ad_parameter DeadDecoration bm]
+
+set db [ns_db gethandle]
+
+set name_query "select first_names||' '||last_name as name 
+               from   users 
+               where  user_id=$user_id"
+set name [database_to_tcl_string $db $name_query]
+
+append js "
+USETEXTLINKS = 1
+aux0 = gFld(\"Bookmarks for $name\",\"\")
+"
+
+
+set sql_query "
+        select   bookmark_id, bm_list.url_id, 
+                 local_title, hidden_p, 
+                 last_live_date, last_checked_date,
+                 parent_id, complete_url, folder_p
+        from     bm_list, bm_urls
+        where    owner_id=$user_id
+        and      bm_list.url_id=bm_urls.url_id(+)
+        order by parent_sort_key || local_sort_key
+        "
+
+set selection [ns_db select $db $sql_query]
+set bookmark_count 0
+set bookmark_html ""
+set folder_list 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr bookmark_count
+
+    # decoration refers to color and font of the associated text
+    set decoration ""
+
+    # make private links appear as definied in the .ini file
+    if {$hidden_p=="t"} {
+	append decoration $hidden_decoration
+    }
+
+    # make dead links appear  as definied in the .ini file
+    if {$last_checked_date!=$last_live_date} {
+	append decoration $dead_decoration
+    }
+    
+    # make folder titles appear  as definied in the .ini file
+    if {$folder_p=="t"} {
+	append decoration $folder_decoration
+    }
+
+    # javascript version requires the top folder to have id "0"
+    if [empty_string_p $parent_id] {
+	set parent_id 0
+    }
+
+    if {$folder_p=="t"} {
+	append js "aux$bookmark_id = insFld(aux$parent_id, gFld(\"[philg_quote_double_quotes [string trim $local_title]]\", \"$decoration\", $bookmark_id))\n"
+    } else {
+	append js "aux$bookmark_id = insDoc(aux$parent_id, gLnk(1, \"[philg_quote_double_quotes [string trim $local_title]]\",\"[string trim [philg_quote_double_quotes $complete_url]]\",\"$decoration\", $bookmark_id))\n"
+    }
+}
+
+
+ns_return 200 text/html "$js"
+
+
+
+
Index: web/openacs/www/bookmarks/tree-frame.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/tree-frame.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/bookmarks/tree-frame.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,20 @@
+# tree-frame.tcl,v 3.0 2000/02/06 03:35:44 ron Exp
+ReturnHeadersNoCache
+
+ns_write "
+
+
+
+
+
+
+
+
+
+
+
+
+
+"
\ No newline at end of file
Index: web/openacs/www/bookmarks/tree-static.js
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/tree-static.js,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/bookmarks/tree-static.js	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,473 @@
+// You are free to copy the "Folder-Tree" script as long as you  
+// keep this copyright notice: 
+// Script found in: http://www.geocities.com/Paris/LeftBank/2178/ 
+// Author: Marcelino Alves Martins (martins@hks.com) December '97. 
+//**************************************************************** 
+ 
+//Log of changes: 
+//       17 Feb 98 - Fix initialization flashing problem with Netscape
+//       
+//       27 Jan 98 - Root folder starts open; support for USETEXTLINKS; 
+//                   make the ftien4 a js file 
+//       
+ 
+ 
+// Definition of class Folder 
+// ***************************************************************** 
+ 
+function Folder(folderDescription, hreference, decoration, key) //constructor 
+{ 
+  //constant data 
+  this.desc = folderDescription 
+  this.hreference = hreference 
+  this.decoration = decoration
+  this.key = key
+  this.id = -1   
+  this.navObj = 0  
+  this.iconImg = 0  
+  this.nodeImg = 0  
+  this.isLastNode = 0 
+ 
+  //dynamic data 
+  this.isOpen = true 
+  this.iconSrc = "pics/ftv2folderopen.gif"   
+  this.children = new Array 
+  this.nChildren = 0 
+ 
+  //methods 
+  this.initialize = initializeFolder 
+  this.setState = setStateFolder 
+  this.addChild = addChild 
+  this.createIndex = createEntryIndex 
+  this.hide = hideFolder 
+  this.display = display 
+  this.renderOb = drawFolder 
+  this.totalHeight = totalHeight 
+  this.subEntries = folderSubEntries 
+  this.outputLink = outputFolderLink 
+} 
+ 
+function setStateFolder(isOpen) 
+{ 
+  var subEntries 
+  var totalHeight 
+  var fIt = 0 
+  var i=0 
+ 
+  if (isOpen == this.isOpen) 
+    return 
+ 
+  if (browserVersion == 2)  
+  { 
+    totalHeight = 0 
+    for (i=0; i < this.nChildren; i++) 
+      totalHeight = totalHeight + this.children[i].navObj.clip.height 
+      subEntries = this.subEntries() 
+    if (this.isOpen) 
+      totalHeight = 0 - totalHeight 
+    for (fIt = this.id + subEntries + 1; fIt < nEntries; fIt++) 
+      indexOfEntries[fIt].navObj.moveBy(0, totalHeight) 
+  }  
+  this.isOpen = isOpen 
+  propagateChangesInState(this) 
+} 
+ 
+function propagateChangesInState(folder) 
+{   
+  var i=0 
+ 
+  if (folder.isOpen) 
+  { 
+    if (folder.nodeImg) 
+      if (folder.isLastNode) 
+        folder.nodeImg.src = "pics/ftv2mlastnode.gif" 
+      else 
+	  folder.nodeImg.src = "pics/ftv2mnode.gif" 
+    folder.iconImg.src = "pics/ftv2folderopen.gif" 
+    for (i=0; i 0) 
+    auxEv = "" 
+  else 
+    auxEv = "" 
+ 
+  if (level>0) 
+    if (lastNode) //the last 'brother' in the children array 
+    { 
+      this.renderOb(leftSide + auxEv + "") 
+      leftSide = leftSide + ""  
+      this.isLastNode = 1 
+    } 
+    else 
+    { 
+      this.renderOb(leftSide + auxEv + "") 
+      leftSide = leftSide + "" 
+      this.isLastNode = 0 
+    } 
+  else 
+    this.renderOb("") 
+   
+  if (nc > 0) 
+  { 
+    level = level + 1 
+    for (i=0 ; i < this.nChildren; i++)  
+    { 
+      if (i == this.nChildren-1) 
+        this.children[i].initialize(level, 1, leftSide) 
+      else 
+        this.children[i].initialize(level, 0, leftSide) 
+      } 
+  } 
+} 
+ 
+function drawFolder(leftSide) 
+{ 
+  if (browserVersion == 2) { 
+    if (!doc.yPos) 
+      doc.yPos=8 
+    doc.write("") 
+  } 
+   
+  doc.write("") 
+  doc.write("")  
+  doc.write("
    ") 
+  doc.write(leftSide) 
+  this.outputLink() 
+  doc.write("") 
+  doc.write("") 
+  if (USETEXTLINKS) 
+  { 
+    this.outputLink() 
+	if (this.id>0)
+	{
+		doc.write(""+this.decoration+this.desc + " (edit)")
+	} else {
+		doc.write(""+this.decoration+this.desc + "")
+	}
+
+  } 
+  else 
+    doc.write(this.desc) 
+  doc.write("
    ") 
+   
+  if (browserVersion == 2) { 
+    doc.write("    ") 
+  } 
+ 
+  if (browserVersion == 1) { 
+    this.navObj = doc.all["folder"+this.id] 
+    this.iconImg = doc.all["folderIcon"+this.id] 
+    this.nodeImg = doc.all["nodeIcon"+this.id] 
+  } else if (browserVersion == 2) { 
+    this.navObj = doc.layers["folder"+this.id] 
+    this.iconImg = this.navObj.document.images["folderIcon"+this.id] 
+    this.nodeImg = this.navObj.document.images["nodeIcon"+this.id] 
+    doc.yPos=doc.yPos+this.navObj.clip.height 
+  } 
+} 
+ 
+function outputFolderLink() 
+{ 
+  if (this.hreference) 
+  { 
+    doc.write(" 0) 
+      doc.write("onClick='javascript:clickOnFolder("+this.id+")'") 
+    doc.write(">") 
+  } 
+  else 
+//    doc.write("") 
+  doc.write("")   
+} 
+ 
+function addChild(childNode) 
+{ 
+  this.children[this.nChildren] = childNode 
+  this.nChildren++ 
+  return childNode 
+} 
+ 
+function folderSubEntries() 
+{ 
+  var i = 0 
+  var se = this.nChildren 
+ 
+  for (i=0; i < this.nChildren; i++){ 
+    if (this.children[i].children) //is a folder 
+      se = se + this.children[i].subEntries() 
+  } 
+ 
+  return se 
+} 
+ 
+ 
+// Definition of class Item (a document or link inside a Folder) 
+// ************************************************************* 
+ 
+function Item(itemDescription, itemLink, decoration, key) // Constructor 
+{ 
+  // constant data 
+  this.desc = itemDescription 
+  this.link = itemLink 
+  this.decoration = decoration
+  this.key = key
+  this.id = -1 //initialized in initalize() 
+  this.navObj = 0 //initialized in render() 
+  this.iconImg = 0 //initialized in render() 
+  this.iconSrc = "pics/ftv2doc.gif" 
+ 
+  // methods 
+  this.initialize = initializeItem 
+  this.createIndex = createEntryIndex 
+  this.hide = hideItem 
+  this.display = display 
+  this.renderOb = drawItem 
+  this.totalHeight = totalHeight 
+} 
+ 
+function hideItem() 
+{ 
+  if (browserVersion == 1) { 
+    if (this.navObj.style.display == "none") 
+      return 
+    this.navObj.style.display = "none" 
+  } else { 
+    if (this.navObj.visibility == "hiden") 
+      return 
+    this.navObj.visibility = "hiden" 
+  }     
+} 
+ 
+function initializeItem(level, lastNode, leftSide) 
+{  
+  this.createIndex() 
+ 
+  if (level>0) 
+    if (lastNode) //the last 'brother' in the children array 
+    { 
+      this.renderOb(leftSide + "") 
+      leftSide = leftSide + ""  
+    } 
+    else 
+    { 
+      this.renderOb(leftSide + "") 
+      leftSide = leftSide + "" 
+    } 
+  else 
+    this.renderOb("")   
+} 
+ 
+function drawItem(leftSide) 
+{ 
+  if (browserVersion == 2) 
+    doc.write("") 
+     
+  doc.write("") 
+  doc.write("
    ") 
+  doc.write(leftSide) 
+  doc.write("") 
+  doc.write("") 
+  doc.write("") 
+  doc.write("") 
+  if (USETEXTLINKS) 
+    doc.write("" +this.decoration + this.desc + " (edit)")
+  else 
+    doc.write(this.desc) 
+  doc.write("
    ") 
+   
+  if (browserVersion == 2) 
+    doc.write("    ") 
+ 
+  if (browserVersion == 1) { 
+    this.navObj = doc.all["item"+this.id] 
+    this.iconImg = doc.all["itemIcon"+this.id] 
+  } else if (browserVersion == 2) { 
+    this.navObj = doc.layers["item"+this.id] 
+    this.iconImg = this.navObj.document.images["itemIcon"+this.id] 
+    doc.yPos=doc.yPos+this.navObj.clip.height 
+  } 
+} 
+ 
+ 
+// Methods common to both objects (pseudo-inheritance) 
+// ******************************************************** 
+ 
+function display() 
+{ 
+  if (browserVersion == 1) 
+    this.navObj.style.display = "block" 
+  else 
+    this.navObj.visibility = "show" 
+} 
+ 
+function createEntryIndex() 
+{ 
+  this.id = nEntries 
+  indexOfEntries[nEntries] = this 
+  nEntries++ 
+} 
+ 
+// total height of subEntries open 
+function totalHeight() //used with browserVersion == 2 
+{ 
+  var h = this.navObj.clip.height 
+  var i = 0 
+   
+  if (this.isOpen) //is a folder and _is_ open 
+    for (i=0 ; i < this.nChildren; i++)  
+      h = h + this.children[i].totalHeight() 
+ 
+  return h 
+} 
+ 
+ 
+// Events 
+// ********************************************************* 
+ 
+function clickOnFolder(folderId) 
+{ 
+  var clicked = indexOfEntries[folderId] 
+ 
+  if (!clicked.isOpen) 
+    clickOnNode(folderId) 
+ 
+  return  
+ 
+  if (clicked.isSelected) 
+    return 
+} 
+ 
+function clickOnNode(folderId) 
+{ 
+  var clickedFolder = 0 
+  var state = 0 
+ 
+  clickedFolder = indexOfEntries[folderId] 
+  state = clickedFolder.isOpen 
+ 
+  clickedFolder.setState(!state) //open<->close  
+} 
+ 
+function initializeDocument() 
+{ 
+  if (doc.all) 
+    browserVersion = 1 //IE4   
+  else 
+    if (doc.layers) 
+      browserVersion = 2 //NS4 
+    else 
+      browserVersion = 0 //other 
+ 
+  aux0.initialize(0, 1, "") 
+  aux0.display()
+  
+  if (browserVersion > 0) 
+  { 
+    doc.write(" ") 
+ 
+    // close the whole tree 
+    clickOnNode(0) 
+    // open the root folder 
+    clickOnNode(0) 
+  } 
+} 
+ 
+// Auxiliary Functions for Folder-Treee backward compatibility 
+// ********************************************************* 
+ 
+function gFld(description, decoration, key, hreference) 
+{ 
+  folder = new Folder(description, hreference, decoration, key) 
+  return folder 
+} 
+ 
+function gLnk(target, description, linkData, decoration, key) 
+{ 
+  fullLink = "" 
+ 
+  if (target==0) 
+  { 
+    fullLink = "'"+linkData+"' target=\"basefrm\"" 
+  } 
+  else 
+  { 
+    if (target==1) 
+       fullLink = "'"+linkData+"' target=target_frame" 
+    else 
+       fullLink = "'"+linkData+"' target=\"basefrm\"" 
+  } 
+ 
+  linkItem = new Item(description, fullLink, decoration, key)   
+  return linkItem 
+} 
+ 
+function insFld(parentFolder, childFolder) 
+{ 
+  return parentFolder.addChild(childFolder) 
+} 
+ 
+function insDoc(parentFolder, document) 
+{ 
+  parentFolder.addChild(document) 
+} 
+ 
+// Global variables 
+// **************** 
+ 
+USETEXTLINKS = 1
+indexOfEntries = new Array 
+nEntries = 0 
+doc = document 
+browserVersion = 0 
+selectedFolder=0
Index: web/openacs/www/bookmarks/tree.css
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/tree.css,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/bookmarks/tree.css	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,3 @@
+BODY {background-color: white}
+A {text-decoration: none; color: #0000bb}
+A:hover {text-decoration: underline}
Index: web/openacs/www/bookmarks/tree.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/tree.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/bookmarks/tree.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,14 @@
+
+
+
+ Your Bookmarks 
+
+
+    
+      
+      
+    
+
+
+
+
Index: web/openacs/www/bookmarks/pics/docqmark.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/pics/docqmark.gif,v
diff -u
Binary files differ
Index: web/openacs/www/bookmarks/pics/folderqmark.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/pics/folderqmark.gif,v
diff -u
Binary files differ
Index: web/openacs/www/bookmarks/pics/ftv2blank.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/pics/ftv2blank.gif,v
diff -u
Binary files differ
Index: web/openacs/www/bookmarks/pics/ftv2doc.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/pics/ftv2doc.gif,v
diff -u
Binary files differ
Index: web/openacs/www/bookmarks/pics/ftv2folderclosed.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/pics/ftv2folderclosed.gif,v
diff -u
Binary files differ
Index: web/openacs/www/bookmarks/pics/ftv2folderopen.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/pics/ftv2folderopen.gif,v
diff -u
Binary files differ
Index: web/openacs/www/bookmarks/pics/ftv2lastnode.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/pics/ftv2lastnode.gif,v
diff -u
Binary files differ
Index: web/openacs/www/bookmarks/pics/ftv2link.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/pics/ftv2link.gif,v
diff -u
Binary files differ
Index: web/openacs/www/bookmarks/pics/ftv2mlastnode.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/pics/ftv2mlastnode.gif,v
diff -u
Binary files differ
Index: web/openacs/www/bookmarks/pics/ftv2mnode.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/pics/ftv2mnode.gif,v
diff -u
Binary files differ
Index: web/openacs/www/bookmarks/pics/ftv2node.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/pics/ftv2node.gif,v
diff -u
Binary files differ
Index: web/openacs/www/bookmarks/pics/ftv2plastnode.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/pics/ftv2plastnode.gif,v
diff -u
Binary files differ
Index: web/openacs/www/bookmarks/pics/ftv2pnode.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/pics/ftv2pnode.gif,v
diff -u
Binary files differ
Index: web/openacs/www/bookmarks/pics/ftv2vertline.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/pics/ftv2vertline.gif,v
diff -u
Binary files differ
Index: web/openacs/www/bookmarks/pics/spacer.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/bookmarks/pics/spacer.gif,v
diff -u
Binary files differ
Index: web/openacs/www/calendar/archives.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/archives.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/archives.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,54 @@
+# archives.tcl,v 3.1 2000/03/11 09:03:12 aileen Exp
+# File:     /calendar/archives.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope all group_member registered
+
+set page_title "[ad_parameter SystemName calendar "Calendar"] Archives"
+
+ReturnHeaders
+
+ns_write "
+[ad_scope_header $page_title $db]
+[ad_scope_page_title $page_title $db]
+from [ad_site_home_link]
+
+
    
+[ad_scope_navbar]
+
+    
+
+[ad_scope_footer]
+"
+
+
Index: web/openacs/www/calendar/comment-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/comment-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/comment-add-2.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,77 @@
+# comment-add-2.tcl,v 3.1 2000/03/11 09:03:02 aileen Exp
+# File:     /calendar/comment-add-2.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables 0
+# calendar_id, content, comment_id, html_p
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+validate_integer calendar_id $calendar_id
+validate_integer comment_id $comment_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope all group_member registered
+
+# check for bad input
+if { ![info exists content] || [empty_string_p $content] } {
+    ad_scope_return_complaint 1 "
  • the comment field was empty" $db
+    return
+}
+
+set title [database_to_tcl_string $db "select title from calendar where calendar_id=$calendar_id"]
+
+ReturnHeaders
+
+ns_write "
+[ad_scope_header "Confirm comment on $title" $db ]
+[ad_scope_page_title "Confirm comment" $db]
+[ad_scope_context_bar_ws_or_index [list "index.tcl?[export_url_scope_vars]" [ad_parameter SystemName calendar "Calendar"]] [list "item.tcl?[export_url_scope_vars calendar_id]" "One Item"] "Confirm Comment"]
+
+
+
    
+[ad_scope_navbar]
+
+The following is your comment as it would appear on the page $title.
+If it looks incorrect, please use the back button on your browser to return and
+correct it.  Otherwise, press \"Continue\".
+
    
+
    "
+
+if { [info exists html_p] && $html_p == "t" } {
+    ns_write "$content
+
    
+Note: if the story has lost all of its paragraph breaks then you
+probably should have selected \"Plain Text\" rather than HTML.  Use
+your browser's Back button to return to the submission form.
+"
+} else {
+    ns_write "[util_convert_plaintext_to_html $content]
+
+
+Note: if the story has a bunch of visible HTML tags then you probably
+should have selected \"HTML\" rather than \"Plain Text\".  Use your
+browser's Back button to return to the submission form.  " 
+}
+
+
+ns_write "
    
+
    
+
+
    
+[export_form_scope_vars content calendar_id comment_id html_p]
+
    
+[ad_scope_footer]
+"
Index: web/openacs/www/calendar/comment-add-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/comment-add-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/comment-add-3.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,68 @@
+# comment-add-3.tcl,v 3.1 2000/03/11 09:02:53 aileen Exp
+# File:     /calendar/comment-add-3.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables 0
+# calendar_id, content, comment_id, content, html_p
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+validate_integer calendar_id $calendar_id
+validate_integer comment_id $comment_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope all group_member registered
+
+# check for bad input
+if { ![info exists content] || [empty_string_p $content] } {
+    ad_scope_return_complaint 1 "
  • the comment field was empty" $db
+    return
+}
+
+# user has input something, so continue on
+
+# assign necessary data for insert
+set user_id [ad_verify_and_get_user_id]
+set originating_ip [ns_conn peeraddr]
+
+if { [ad_parameter CommentApprovalPolicy calendar] == "open"} {
+    set approved_p "t"
+} else {
+    set approved_p "f"
+}
+
+set one_line_item_desc [database_to_tcl_string $db "select title from calendar where calendar_id = $calendar_id"]
+
+if [catch { 
+    ad_general_comment_add $db $comment_id "calendar" $calendar_id $one_line_item_desc $content $user_id $originating_ip $approved_p $html_p ""
+} errmsg] {
+      # Oracle choked on the insert
+    if { [database_to_tcl_string $db "select count(*) from general_comments where comment_id = $comment_id"] == 0 } {
+  	# there was an error with comment insert other than a duplication
+	ad_scope_return_error "Error in inserting comment" "We were unable to insert your comment in the database.  Here is the error that was returned:
+	
    
+	
    
+	
    +	$errmsg
+	
    
+	
    " $db
+	return
+    }
+}
+
+# either we were successful in doing the insert or the user hit submit
+# twice and we don't really care
+
+ns_returnredirect "item.tcl?calendar_id=$calendar_id"
Index: web/openacs/www/calendar/comment-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/comment-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/comment-add.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,71 @@
+# comment-add.tcl,v 3.1 2000/03/11 09:03:21 aileen Exp
+# File:     /calendar/comment-add.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_form_variables 0
+# calendar_id
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+validate_integer calendar_id $calendar_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope all group_member registered
+
+set selection [ns_db 0or1row $db "select c.*
+from calendar c, calendar_categories cc
+where c.calendar_id = $calendar_id
+and c.category_id=cc.category_id
+and [ad_scope_sql cc]"]
+
+
+if { $selection == "" } {
+    ad_scope_return_error "Can't find calendar item" "Can't find calendar item $calendar_id" $db
+    return
+}
+
+set_variables_after_query
+
+# take care of cases with missing data
+
+ReturnHeaders
+
+ns_write "
+[ad_scope_header "Add a comment to $title" $db]
+[ad_scope_page_title "Add a Comment to $title" $db]
+[ad_scope_context_bar_ws_or_index [list "index.tcl?[export_url_scope_vars]" [ad_parameter SystemName calendar "Calendar"]] [list "item.tcl?[export_url_scope_vars calendar_id]" "One Item"] "Add Comment"]
+
+
    
+[ad_scope_navbar]
+
+
    
+[util_maybe_convert_to_html $body $html_p]
+
    
+What comment  would you like to add to this item?
    
+
    
+Text above is
+
+
    
+
    
+
+
    
+[export_form_scope_vars calendar_id]
+
+
    
+
+
    
+[ad_scope_footer]
+"
Index: web/openacs/www/calendar/comment-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/comment-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/comment-edit-2.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,88 @@
+# comment-edit-2.tcl,v 3.1 2000/03/11 09:02:43 aileen Exp
+# File:     /calendar/comment-edit-2.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_form_variables 0
+# comment_id
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+validate_integer comment_id $comment_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope all group_member registered
+
+# check for bad input
+if  {![info exists content] || [empty_string_p $content] } { 
+    ad_scope_return_complaint 1 "
  • the comment field was empty" $db
+    return
+}
+
+set user_id [ad_get_user_id]
+
+set selection [ns_db 1row $db "
+select title, calendar_id, general_comments.user_id as comment_user_id
+from calendar, general_comments
+where comment_id = $comment_id
+and calendar.calendar_id = general_comments.on_what_id"]
+set_variables_after_query
+
+# check to see if ther user was the orginal poster
+if {$user_id != $comment_user_id} {
+    ad_scope_return_complaint 1 "
  • You can not edit this entry because you did not post it" $db
+    return
+}
+
+ReturnHeaders
+
+ns_write "
+[ad_scope_header "Verify comment on $title" $db]
+
    Verify comment
    
+on $title
+
    
+[ad_scope_navbar]
+
+The following is your comment as it would appear on the page $title.
+If it looks incorrect, please use the back button on your browser to return and
+correct it.  Otherwise, press \"Continue\".
+
    
+
+
    "
+
+
+if { [info exists html_p] && $html_p == "t" } {
+    ns_write "$content
+
    
+Note: if the story has lost all of its paragraph breaks then you
+probably should have selected \"Plain Text\" rather than HTML.  Use
+your browser's Back button to return to the submission form.
+"
+} else {
+    ns_write "[util_convert_plaintext_to_html $content]
+
+
+Note: if the story has a bunch of visible HTML tags then you probably
+should have selected \"HTML\" rather than \"Plain Text\".  Use your
+browser's Back button to return to the submission form.  " 
+}
+
+ns_write "
    
+
    
+
+[export_form_scope_vars comment_id content html_p]
+
    
+
+[ad_scope_footer]
+"
Index: web/openacs/www/calendar/comment-edit-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/comment-edit-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/comment-edit-3.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,73 @@
+# comment-edit-3.tcl,v 3.1 2000/03/11 09:02:32 aileen Exp
+# File:     /calendar/comment-edit-3.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables 0
+# comment_id, content, html_p
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+validate_integer comment_id $comment_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope all group_member registered
+
+
+# check for bad input
+if  {![info exists content] || [empty_string_p $content] } { 
+    ad_scope_return_complaint 1 "
  • the comment field was empty" $db
+    return
+}
+
+# user has input something, so continue on
+
+set user_id [ad_verify_and_get_user_id]
+
+set selection [ns_db 1row $db "select calendar_id, general_comments.user_id as comment_user_id
+from calendar, general_comments
+where comment_id = $comment_id
+and calendar.calendar_id = general_comments.on_what_id"]
+set_variables_after_query
+
+
+# check to see if ther user was the orginal poster
+if {$user_id != $comment_user_id} {
+    ad_scope_return_complaint 1 "
  • You can not edit this entry because you did not post it" $db
+    return
+}
+
+if [catch { ns_db dml $db "begin transaction" 
+            # insert into the audit table
+            ns_db dml $db "insert into general_comments_audit
+(comment_id, user_id, ip_address, audit_entry_time, modified_date, content)
+select comment_id, user_id, '[ns_conn peeraddr]', sysdate(), modified_date, content from general_comments where comment_id = $comment_id"
+            ns_db dml $db "update general_comments
+set content = '[DoubleApos $content]', html_p = '$html_p'
+where comment_id = $comment_id"
+            ns_db dml $db "end transaction" } errmsg] {
+
+	# there was some other error with the comment update
+	ad_scope_return_error "Error updating comment" "We couldn't update your comment. Here is what the database returned:
+
    
+
    
+
    +$errmsg
+
    
+
    
+" $db
+return
+}
+
+ns_returnredirect "item.tcl?[export_url_scope_vars calendar_id]"
Index: web/openacs/www/calendar/comment-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/comment-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/comment-edit.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,71 @@
+# comment-edit.tcl,v 3.1 2000/03/11 09:02:19 aileen Exp
+# File:     /calendar/comment-edit.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_form_variables 0
+# comment_id
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+validate_integer comment_id $comment_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope all group_member registered
+
+
+set selection [ns_db 1row $db "
+select gc.comment_id, gc.content, gc.html_p as comment_html_p, gc.user_id as comment_user_id, c.title, c.body, c.calendar_id, c.html_p as calendar_html_p
+from general_comments gc, calendar c
+where comment_id = $comment_id
+and c.calendar_id = gc.on_what_id"]
+
+set_variables_after_query
+
+#check for the user cookie
+set user_id [ad_get_user_id]
+
+
+# check to see if ther user was the orginal poster
+if {$user_id != $comment_user_id} {
+    ad_scope_return_complaint 1 "
  • You can not edit this entry because you did not post it" $db
+    return
+}
+ReturnHeaders
+
+ns_write "
+[ad_scope_header "Edit comment on $title" $db]
+
    Edit comment 
    
+on $title
+
    
+[ad_scope_navbar]
+
+
    
+[util_maybe_convert_to_html $body $calendar_html_p]
+
    
+Edit your comment on the above item.
    
+
    
+Text above is
+
+
    
+
+
    
+[export_form_scope_vars comment_id]
+
    
+
    
+[ad_scope_footer]
+"
+
Index: web/openacs/www/calendar/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/index.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,107 @@
+# index.tcl,v 3.1 2000/03/11 09:03:32 aileen Exp
+# File:     /calendar/index.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  calendar main page
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+  
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+  
+ad_scope_error_check
+  
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope all group_member registered
+  
+set page_title [ad_parameter SystemName calendar "Calendar"]
+  
+ReturnHeaders
+  
+ns_write "
+[ad_scope_header $page_title $db]
+[ad_scope_page_title $page_title $db]
+[ad_scope_context_bar_ws_or_index [ad_parameter SystemName calendar "Calendar"]]
+
+
    
+[ad_scope_navbar]
+  
      
+  "
+  
+  set selection [ns_db select $db "select *
+ from calendar c, calendar_categories cc
+ where sysdate() < c.expiration_date
+ and c.approved_p = 't'
+ and c.category_id=cc.category_id
+ and [ad_scope_sql cc]
+ order by c.start_date, c.creation_date"]
+  
+set counter 0
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+    if { $counter >= [ad_parameter MaxEventsOnIndexPage calendar] } {
+  		ns_db flush $db
+		ns_write "
    •  ... \n"
+		break
+    }
+    ns_write "
    • $title\n"
+}
+
+if { $counter == 0 } {
+    ns_write "there are no upcoming events"
+}
+
+if { [ad_parameter ApprovalPolicy calendar] == "open"} {
+    ns_write "
      \n
    • post an item\n"
+} elseif { [ad_parameter ApprovalPolicy calendar] == "wait"} {
+    ns_write "
      \n
    • suggest an item\n"
+}
+
+ns_write "
    
+
+"
+
+if { $counter >= [ad_parameter MaxEventsOnIndexPage calendar] } {
+    # there are some extra events; offer events by category
+    ns_write "For events farther in the future, choose a category to see a complete list:
+
+
      
+"
+
+
+set selection [ns_db select $db "
+select c.category_id, cc.category, count(*) as n_events
+from calendar c, calendar_categories cc
+where sysdate() < c.expiration_date
+and c.approved_p = 't'
+and c.category_id=cc.category_id
+and [ad_scope_sql cc]
+group by c.category_id, cc.category"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    ns_write "
    • $category ($n_events)\n"
+}
+
+ns_write "
    
+"
+}
+
+if { [database_to_tcl_string $db "
+select count(*) 
+from calendar c, calendar_categories cc 
+where sysdate() > c.expiration_date
+and c.category_id=cc.category_id
+and [ad_scope_sql cc]"] > 0 } {
+    ns_write "To dig up information on an event that you missed, check 
+the archives."
+}
+
+ns_write "
+[ad_scope_footer]
+"
+
Index: web/openacs/www/calendar/item.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/item.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/item.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,113 @@
+# item.tcl,v 3.1 2000/03/11 09:02:04 aileen Exp
+# File:     /calendar/item.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+# calendar_id
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+validate_integer calendar_id $calendar_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+
+
+set selection [ns_db 0or1row $db "
+select c.*, first_names, last_name
+from calendar c, users u
+where calendar_id = $calendar_id
+and u.user_id = c.creation_user"]
+
+if { $selection == "" } {
+    ad_scope_return_error "Can't find calendar item" "Can't find calendar item $calendar_id " $db
+    return
+}
+
+set_variables_after_query
+
+set user_id [ad_scope_authorize $db $scope all group_member registered]
+
+ReturnHeaders
+
+ns_write "
+[ad_scope_header "$title" $db]
+[ad_scope_page_title $title $db]
+[ad_scope_context_bar_ws_or_index [list "index.tcl?[export_url_scope_vars]" [ad_parameter SystemName calendar "Calendar"]] "One Item"]
+
+
    
+[ad_scope_navbar]
+
+
    
+[util_maybe_convert_to_html $body $html_p]
+
    
+
+
      
+
    • 
+"
+
+if { $start_date == $end_date } {
+    ns_write "Date:  [util_AnsiDatetoPrettyDate $start_date]\n"
+} else {
+    ns_write "Dates:  [util_AnsiDatetoPrettyDate $start_date] through [util_AnsiDatetoPrettyDate $end_date]\n"
+}
+
+if ![empty_string_p $event_url] {
+    ns_write "
    • Web: $event_url\n"
+}
+
+if ![empty_string_p $event_email] {
+    ns_write "
    • Email: $event_email\n"
+}
+
+ns_write "
    
+
+Contributed by $first_names $last_name.
+
+"
+
+# see if there are any comments on this item
+set selection [ns_db select $db "
+select comment_id, content, comment_date, first_names || ' ' || last_name as commenter_name, users.user_id as comment_user_id, html_p as comment_html_p from
+general_comments, users
+where on_what_id= $calendar_id 
+and on_which_table = 'calendar'
+and general_comments.approved_p = 't'
+and general_comments.user_id = users.user_id"]
+
+set first_iteration_p 1
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    if $first_iteration_p {
+	ns_write "
    Comments
    \n"
+	set first_iteration_p 0
+    }
+    ns_write "
    \n[util_maybe_convert_to_html $content $comment_html_p]\n"
+
+    # if the user posted the comment, they are allowed to edit it
+    if {$user_id == $comment_user_id} {
+        ns_write "

    -- you (edit your comment)"
+    } else {
+	ns_write "

    -- $commenter_name"
+    }
+    ns_write "
    "
+}
+
+if { [ad_parameter SolicitCommentsP calendar] == 1 } {
+
+    ns_write "
+
    
+Add a comment
+
    
+"
+}
+
+ns_write "
+[ad_scope_footer]
+"
\ No newline at end of file
Index: web/openacs/www/calendar/monthly.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/monthly.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/monthly.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,91 @@
+# monthly.tcl,v 3.0 2000/02/06 03:35:54 ron Exp
+set_the_usual_form_variables 0
+
+# maybe date
+
+set page_title [ad_parameter SystemName calendar "Calendar"]
+
+ReturnHeaders
+
+ns_write "[ad_header $page_title]
+
+
    $page_title
    
+
+[ad_context_bar_ws "Calendar"]
+
+
    
+
+"
+
+set db [ns_db gethandle]
+set calendar_details [ns_set create calendar_details]
+
+ if {![info exists date] || [empty_string_p $date]} {
+    set date [database_to_tcl_string $db "select sysdate from dual"]
+}
+
+# get all the calandar entries for this month 
+
+set selection [ns_db select $db "select calendar.title, 
+calendar.calendar_id, to_char(start_date,'J') as julian_start_date, 
+to_char(end_date,'J') as julian_end_date  from calendar
+where to_char(start_date, 'YYYY') = to_char(to_date('$date'::varchar,'YYYY-MM-DD'::varchar),'YYYY') 
+and to_char(start_date, 'MM') = to_char(to_date('$date'::varchar,'YYYY-MM-DD'::varchar),'MM') 
+and approved_p = 't'"]
+
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    for {set x $julian_start_date} {$x <= $julian_end_date} {incr x} {
+	ns_set put $calendar_details $x "$title\n 
    "
+    }
+}
+
+
+#### We include special calendar information for intranet enabled 
+#### acs installations that have requested vacations to be in the calendar
+
+if { [ad_parameter IntranetEnabledP intranet 0] && [ad_parameter DisplayVacationsOnCalendar intranet 0] } {
+    set absence_types [ad_parameter AbsenceTypes pvt "sick travel vacation"]
+    set vacation_key "
    KEY:"
+    foreach a_type $absence_types {
+	append vacation_key "$a_type ([string range $a_type 0 0])"
+    }
+
+    ns_write "$vacation_key
    "
+
+    set selection [ns_db select $db "select users.first_names || ' ' || substr(last_name, 0,2) as name, email, (case when substr(vacation_type,0,2) is null then 'v' else substr(vacation_type,0,2) end) as vt, vacation_type, users.user_id , to_char(start_date,'J'::varchar) as julian_start_date, 
+to_char(end_date,'J'::varchar) as julian_end_date  
+from user_vacations, users
+where users.user_id = user_vacations.user_id
+and ((to_char(start_date, 'YYYY'::varchar) = to_char(to_date('$date'::varchar,'YYYY-MM-DD'::varchar), 'YYYY'::varchar) 
+and to_char(start_date, 'MM'::varchar) = to_char(to_date('$date'::varchar,'YYYY-MM-DD'::varchar), 'MM'::varchar)) or ((to_char(end_date, 'YYYY'::varchar) = to_char(to_date('$date'::varchar,'YYYY-MM-DD'::varchar), 'YYYY'::varchar) 
+and to_char(end_date, 'MM'::varchar) = to_char(to_date('$date'::varchar,'YYYY-MM-DD'::varchar), 'MM'::varchar))))"]
+
+
+    while { [ns_db getrow $db $selection] } {
+	set_variables_after_query
+	for {set x $julian_start_date} {$x <= $julian_end_date} {incr x} {
+	    ns_set put $calendar_details $x "[set name] ($vt) "
+	}
+    }
+}
+
+
+set prev_month_template "< \$prev_month_name"
+set next_month_template "\$next_month_name >"
+
+ns_write "[calendar_basic_month -calendar_details $calendar_details  -next_month_template $next_month_template -prev_month_template $prev_month_template -date $date -prev_next_links_in_title 1 -fill_all_days 0]
+"
+
+if { [ad_parameter ApprovalPolicy calendar] == "open"} {
+    ns_write "
    \npost an item\n"
+} elseif { [ad_parameter ApprovalPolicy calendar] == "wait"} {
+    ns_write "
    \nsuggest an item\n"
+}
+
+
+ns_write "
+[calendar_footer]
+"
+
Index: web/openacs/www/calendar/one-category.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/one-category.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/one-category.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,78 @@
+# one-category.tcl,v 3.0 2000/02/06 03:35:55 ron Exp
+#one-category.tcl
+#Written by Caroline@arsdigita.com Jan 2000.
+#for some reason this page was called but did not exist.
+#prints out all items for a category.
+
+
+set_the_usual_form_variables
+#category_id
+
+validate_integer category_id $category_id
+
+set db [ns_db gethandle]
+
+set category [database_to_tcl_string $db "select category from calendar_categories where category_id=$category_id"]
+
+
+set page_title "$category"
+
+ReturnHeaders
+
+ns_write "[ad_header $page_title]
+
+[ad_context_bar_ws_or_index [list "index.tcl" [ad_parameter SystemName calendar "Calendar"]] "$category"]
+
+
    $page_title
    
+
    
+
      
+
+"
+
+
+set selection [ns_db select $db "select 
+calendar_id,
+title,
+to_char(start_date,'Month DD, YYYY') as pretty_start_date,
+to_char(start_date,'J') as j_start_date 
+from calendar c
+where sysdate < expiration_date
+and category_id=$category_id
+and approved_p = 't'
+order by start_date, creation_date"]
+
+set counter 0
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+
+       ns_write "
    • $title ($pretty_start_date)\n"
+   }
+   
+   if { $counter == 0 } {
+       ns_write "there are no upcoming events"
+   }
+
+   if { [ad_parameter ApprovalPolicy calendar] == "open"} {
+       ns_write "
      \n
    • post an item\n"
+   } elseif { [ad_parameter ApprovalPolicy calendar] == "wait"} {
+       ns_write "
      \n
    • suggest an item\n"
+   }
+
+  if { [database_to_tcl_string $db "select count(*) from calendar where sysdate > expiration_date"] > 0 } {
+     ns_write "
    • To dig up information on an event that you missed, check 
+ the archives."
+ }
+
+ns_write "
+
    
+[calendar_footer]
+"
+
+
+
+
+
+
+
+
Index: web/openacs/www/calendar/post-new-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/post-new-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/post-new-2.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,144 @@
+# post-new-2.tcl,v 3.2 2000/03/11 09:03:51 aileen Exp
+# File:     /calendar/post-new-2.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  at this point, we know what kind of event is being described
+#           and can potentially do something with that information
+# x 
+
+set_the_usual_form_variables 0
+# category
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope all group_member registered
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+if { [ad_parameter ApprovalPolicy calendar] == "open"} {
+    set verb "Post"
+} elseif { [ad_parameter ApprovalPolicy calendar] == "wait"} {
+    set verb "Suggest"
+} else {
+    ns_returnredirect "index.tcl?[export_url_scope_vars]"
+    return
+}
+
+ReturnHeaders
+
+ns_write "
+[ad_scope_header "$verb $category Item" $db]
+
    $verb $category Item
    
+[ad_scope_context_bar_ws_or_index [list "index.tcl?[export_url_scope_vars]" [ad_parameter SystemName calendar "Calendar"]] "$verb Item"]
+
+
    
+[ad_scope_navbar]
+
+
    
+[export_form_scope_vars category]
+
    The title
    
+
+Remember that in a list of events, users will only see the title.  So
+try to make the title as descriptive as possible, e.g.,
+\"[ad_parameter TitleExample calendar "Ansel Adams show at Getty
+Center in Los Angeles, March 1-June 15"]\".  
+
+
    
+
+Title: 
+
+
    Full Description
    
+
+This information will be visible to a user who has clicked on a title.
+Make sure to include event hours, e.g., \"10 am to 4 pm\" and
+directions to the event.
+
+
    
+
+
+
+
    
+
+Text above is 
+
+
+"
+
+ns_write "
+
+
    Dates
    
+
+To ensure that users get relevant and accurate information, the
+software is programmed to show only events that are in the future.
+Furthermore, these events are sorted by the time that they start.  So
+an event that happens next week is given more prominence than an event
+that happens next year.  Make sure that you get these right!
+
+
    
+
+
+
    Event Start Date[philg_dateentrywidget start_date [database_to_tcl_string $db "select sysdate + [ad_parameter DaysFromPostingToStart calendar 30] from dual"]]
+
    Event End Date[philg_dateentrywidget end_date [database_to_tcl_string $db "select sysdate + [ad_parameter DaysFromPostingToStart calendar 30] + [ad_parameter DaysFromStartToEnd calendar 0] from dual"]]
+
    
+
+
+
    Additional contact information
    
+
+If there are Internet sources for additional information about this
+event, enter a URL and/or email address below.
+
+
    
+
+
+
+
+
    Url
+
    Contact Email
+
    
+
+"
+
+if [ad_parameter EventsHaveLocationsP calendar 1] {
+    ns_write "
    Event Location
    
+
+If this event can be said to occur in one location, then please tell
+us where it is.  This will help our software give special prominence
+to events that are geographically close to a particular user.
+
+
    
+
+Note that this information is not shown to users but only used by our
+computer programs. The description above should contain information
+about where to find the event.
+
+
    
+
+
+"
+    if [ad_parameter InternationalP] {
+	ns_write "\n"
+    }
+    if [ad_parameter SomeAmericanReadersP] {
+	ns_write "\n"
+	ns_write " \n"
+    }
+    ns_write "
    Country[country_widget $db]
    State[state_widget $db]
    US Zip Code (5 digits)
    \n"
+}
+
+ns_write "
+
+
    
+
+
+
    
+
+
    
+
    
+[ad_scope_footer]
+"
+ 
Index: web/openacs/www/calendar/post-new-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/post-new-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/post-new-3.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,182 @@
+# post-new-3.tcl,v 3.1 2000/03/11 09:03:43 aileen Exp
+# File:     /calendar/item.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  give the user a chance to confirm his or her posting
+#           this is where we expect most entry errors to be caught
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables 0
+# title, body, AOLserver ns_db magic vars that can be 
+# kludged together to form release_date and expiration_date
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope all group_member registered
+
+set creation_ip_address [ns_conn peeraddr]
+
+set exception_count 0
+set exception_text ""
+
+if [catch  { ns_dbformvalue [ns_conn form] start_date date start_date
+             ns_dbformvalue [ns_conn form] end_date date end_date } errmsg] {
+    incr exception_count
+    append exception_text "
  • Please make sure your dates are valid."
+} else {
+
+    # we assume that the event ends at the very end of the end_date
+    # we have to do the bogus 1000* and then rounding because of Stupid Oracle
+    # driver truncation errors (doesn't like big fractions)
+    set expire_laterthan_future_p [database_to_tcl_string $db "select date_part('epoch','$end_date 11:59:59'::datetime - '$start_date'::datetime)  from dual"]
+    if {$expire_laterthan_future_p <= 0} {
+	incr exception_count
+	append exception_text "
  • Please make sure the end date is later than the start date."
+    }
+}
+
+# now start_date and end_date are set
+
+
+if { ![info exists title] || [empty_string_p $title] } {
+    incr exception_count
+    append exception_text "
  • Please enter a title."
+}
+if { ![info exists body] || [empty_string_p $body] } {
+    incr exception_count
+    append exception_text "
  • Please enter the full event description."
+}
+
+if ![info exists country_code] {
+    set country_code "NULL"
+}
+
+if ![info exists usps_abbrev] {
+    set usps_abbrev "NULL"
+}
+
+if ![info exists zip_code] {
+    set zip_code "NULL"
+}
+
+if { [info exists event_email] && ![empty_string_p $event_email] && ![philg_email_valid_p $event_email] } {
+    incr exception_count
+    append exception_text "
  • The event contact email address that you typed doesn't look right to us.  Examples of valid email addresses are 
+
      
+
    • Alice1234@aol.com
+
    • joe_smith@hp.com
+
    • pierre@inria.fr
+
    
+"
+}
+
+if {$exception_count > 0} { 
+    ad_scope_return_complaint $exception_count $exception_text $db
+    return
+}
+
+
+set calendar_id [database_to_tcl_string $db "select calendar_id_sequence.nextval from dual"]
+
+ReturnHeaders
+
+ns_write "
+
+[ad_scope_header "Confirm" $db]
+[ad_scope_page_title "Confirm" $db]
+[ad_scope_context_bar_ws_or_index [list "index.tcl?[export_url_scope_vars]" [ad_parameter SystemName calendar "Calendar"]] "Confirm"]
+
+
    
+[ad_scope_navbar]
+
+
    What viewers of a summary list will see
    
+
+
    
+$title
+
    
+
+
    The full description
    
+
+
    
+
+"
+
+if { [info exists html_p] && $html_p == "t" } {
+    ns_write "$body
+
    
+
+Note: if the description has lost all of its paragraph breaks then you
+probably should have selected \"Plain Text\" rather than HTML.  Use
+your browser's Back button to return to the submission form.
+"
+
+} else {
+    ns_write "[util_convert_plaintext_to_html $body]
+
+
+Note: if the description has a bunch of visible HTML tags then you probably
+should have selected \"HTML\" rather than \"Plain Text\".  Use your
+browser's Back button to return to the submission form.  " 
+}
+
+
+ns_write "
+
+
    Dates
    
+
+
      
+
    • will start on [util_AnsiDatetoPrettyDate $start_date]
+
    • will end on [util_AnsiDatetoPrettyDate $end_date]
+
    
+
+
    Contact Information
    
+
+Here's where we will tell readers to go for more information:
+
+
      
+
    • Email: "
+
+if { ![info exists event_email] || [empty_string_p $event_email] } {
+    ns_write "no address supplied"
+} else {
+    ns_write $event_email
+}
+
+ns_write "
    • Url: "
+
+if { [info exists event_url] && ![philg_url_valid_p $event_url] } {
+    # not an exception but user did not type a valid URL (presumably left it blank)
+    ns_write "no URL supplied"
+} else {
+    ns_write "$event_url\n"
+}
+
+ns_write "
+
+
+
    
+
+
+
    
+[export_form_scope_vars calendar_id category]
+[export_entire_form]
+
    
+
+
    
+
    
+
+
+[ad_scope_footer]"
+
+
Index: web/openacs/www/calendar/post-new-4.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/post-new-4.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/post-new-4.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,164 @@
+# post-new-4.tcl,v 3.1 2000/03/11 08:55:44 aileen Exp
+# File:     /calendar/item.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  actually do the insert into the calendar table
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+# category, calendar_id, title, body, AOLserver ns_db magic vars that can be 
+# kludged together to form release_date and expiration_date
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+set user_id [ad_verify_and_get_user_id]
+
+validate_integer calendar_id $calendar_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope all group_member registered
+
+set creation_ip_address [ns_conn peeraddr]
+
+set exception_count 0
+set exception_text ""
+
+if [catch  { ns_dbformvalue [ns_conn form] start_date date start_date
+             ns_dbformvalue [ns_conn form] end_date date end_date } errmsg] {
+    incr exception_count
+    append exception_text "
  • Please make sure your dates are valid."
+} else {
+
+       # we assume that the event ends at the very end of the end_date
+    # we have to do the bogus 1000* and then rounding because of Stupid Oracle
+    # driver truncation errors (doesn't like big fractions)
+    set expire_laterthan_future_p [database_to_tcl_string $db "select date_part('epoch',('$end_date 11:59:59'::datetime - '$start_date'::datetime))  from dual"]
+    if {$expire_laterthan_future_p <= 0} {
+	incr exception_count
+	append exception_text "
  • Please make sure the end date is later than the start date."
+    }
+}
+
+# now start_date and end_date are set
+
+if { ![info exists title] || $title == ""} {
+    incr exception_count
+    append exception_text "
  • Please enter a title."
+}
+if { ![info exists body] || $body == "" } {
+    incr exception_count
+    append exception_text "
  • Please enter the full story."
+}
+
+if { [info exists event_email] && ![empty_string_p $event_email] && ![philg_email_valid_p $event_email] } {
+    incr exception_count
+    append exception_text "
  • The event contact email address that you typed doesn't look right to us.  Examples of valid email addresses are 
+
      
+
    • Alice1234@aol.com
+
    • joe_smith@hp.com
+
    • pierre@inria.fr
+
    
+"
+}
+
+if { [info exists event_url] && ![philg_url_valid_p $event_url] } {
+    set event_url ""
+}
+
+if {$exception_count > 0} { 
+    ad_scope_return_complaint $exception_count $exception_text $db
+    return
+}
+
+# if SomeAmericanReadersP is set to 0 in the ad.ini file, 
+# usps_abbrev, zip_code won't be set
+
+if ![info exists usps_abbrev] {
+    set usps_abbrev ""
+}
+
+if ![info exists zip_code] {
+    set zip_code ""
+}
+
+# Bug fix (BMA)
+# If there are no international users, the country_code is not there, so we set it to us.
+if {![info exists country_code]} {
+    set country_code "us"
+}
+
+if { [ad_parameter ApprovalPolicy calendar] == "open" || $scope=="user"} {
+    set approved_p "t"
+} else {
+    set approved_p "f"
+}
+
+set category_id [database_to_tcl_string $db "
+select category_id
+from calendar_categories 
+where category='$QQcategory'
+and [ad_scope_sql]"]
+
+if [catch { ns_db dml $db "insert into calendar
+(calendar_id, category_id, title, body, html_p, approved_p, 
+start_date, end_date, 
+creation_date, expiration_date,
+creation_user, creation_ip_address,
+event_url, event_email, 
+country_code, usps_abbrev, zip_code)
+values
+($calendar_id, $category_id, '$QQtitle', '$QQbody', '$html_p', '$approved_p', 
+'$start_date', '$end_date  11:59:59'::datetime, 
+sysdate(), '$end_date 11:59:59'::datetime + [ad_parameter DaysFromEndToExpiration calendar 3],
+$user_id, '$creation_ip_address', 
+[ns_dbquotevalue $event_url text],[ns_dbquotevalue $event_email text],
+[ns_dbquotevalue $country_code text],[ns_dbquotevalue $usps_abbrev text],[ns_dbquotevalue $zip_code text] )" } errmsg] {
+    # insert failed; let's see if it was because of duplicate submission
+    if {[database_to_tcl_string $db "select count(*) from calendar where calendar_id = $calendar_id"] == 0 } {
+	ns_log Error "/calendar/post-new-3.tcl choked:  $errmsg"
+ 	ad_scope_return_error "Insert Failed" "The Database did not like what you typed.  This is probably a bug in our code.  Here's what the database said:
+
    
+
    +$errmsg
+
    
+
    
+" $db
+        return
+    }
+    # we don't bother to handle the cases where there is a dupe submission
+    # because the user should be thanked or redirected anyway
+}
+
+if { [ad_parameter ApprovalPolicy calendar] == "open" || $scope=="user"} {
+    ns_returnredirect "index.tcl?[export_url_scope_vars]"
+} else {
+    ns_return 200 text/html "
+[ad_scope_header "Thank you" $db]
+[ad_scope_page_title "Thank You" $db]
+[ad_scope_context_bar_ws_or_index [list "index.tcl?[export_url_scope_vars]" [ad_parameter SystemName calendar "Calendar"]] "Thank you"]
+
+
    
+[ad_scope_navbar]
+
+Your submission will be reviewed by 
+[ad_parameter SystemOwner calendar [ad_system_owner]].
+
+[ad_scope_footer]"
+}
+
+
+
+
+
+
+
Index: web/openacs/www/calendar/post-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/post-new.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/post-new.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,58 @@
+# post-new.tcl,v 3.1 2000/03/11 08:59:40 aileen Exp
+# File:     /calendar/post_new.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  this page exists to solicit from the user what kind of an event
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope all group_member registered
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+ReturnHeaders
+ns_write "
+[ad_scope_header "Pick Category" $db]
+[ad_scope_page_title "Pick Category" $db]
+[ad_scope_context_bar_ws_or_index [list "index.tcl?[export_url_scope_vars]" "Calendar"] "Pick Category"]
+
+
    
+[ad_scope_navbar]
+
+
      
+"
+
+
+set counter 0
+foreach category [database_to_tcl_list $db "
+select category
+from calendar_categories
+where enabled_p = 't'
+and [ad_scope_sql]"] {
+    incr counter
+    ns_write "
    • $category\n"
+}
+
+if { $counter == 0 } {
+    ns_write "no event categories are currently defined; this is an
+error in system configuration and you should complain to 
+[calendar_system_owner]"
+}
+
+ns_write "
+
    
+[ad_scope_footer]
+"
+ 
Index: web/openacs/www/calendar/admin/categories.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/admin/categories.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/admin/categories.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,92 @@
+# categories.tcl,v 3.0 2000/02/06 03:36:01 ron Exp
+# File:     /calendar/admin/categories.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  lists all categories
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+# maybe contact_info_only, maybe order_by
+
+ad_scope_error_check
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope admin group_admin none
+
+ReturnHeaders
+
+ns_write "
+[ad_scope_admin_header "Calendar categories" $db]
+[ad_scope_admin_page_title "Categories" $db ]
+[ad_scope_admin_context_bar [list "index.tcl?[export_url_scope_vars]" "Calendar"] "Categories"]
+
+
    
+
+
      
+
+"
+
+set selection [ns_db select $db "
+select category_id, category, enabled_p 
+from calendar_categories
+where [ad_scope_sql]
+order by enabled_p desc"]
+
+set counter 0
+set enabled_headline_shown_p 0
+set disabled_headline_shown_p 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+    if { $enabled_headline_shown_p == 0 && $enabled_p == "t" } {
+	ns_write "
      Categories in which users can post
      
+
        "
+	set enabled_headline_shown_p 1
+    } 
+
+    if { $disabled_headline_shown_p == 0 && $enabled_p == "f" } {
+	ns_write "
      
+
      Disabled Categories
      
+
        "
+	set disabled_headline_shown_p 1
+    } 
+
+    ns_write "
      • $category\n"
+}
+
+if { $counter == 0 } {
+    ns_write "no event categories are currently defined"
+}
+
+
+set category_id [database_to_tcl_string $db "select calendar_category_id_sequence.nextval from dual" ]
+
+ns_write "
+
        
+
      • 
+[export_form_scope_vars category_id]
+Add a category:
+
+
+
        
+
      
+
+
      
+
+Typical categories for a site like photo.net 
+might include \"Workshops\", \"Museum Exhibitions\", \"Lectures\".  
+Any kind of thing that you might want to know about long in advance.
+
+
    
+[ad_scope_admin_footer]
+"
+ 
+
+
+
+
Index: web/openacs/www/calendar/admin/category-change.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/admin/category-change.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/admin/category-change.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,64 @@
+# category-change.tcl,v 3.0 2000/02/06 03:36:02 ron Exp
+# File:     /calendar/admin/category-change.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  changes calendar category
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+# category_id, category_new
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+ad_scope_error_check
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope admin group_admin none
+
+
+set exception_count 0
+set exception_text ""
+
+if { ![info exists category_new] || [empty_string_p $category_new] } {
+    incr exception_count
+    append exception_text "
  • Please enter a category."
+}
+
+
+if {$exception_count > 0} { 
+    ad_scope_return_complaint $exception_count $exception_text $db
+    return
+}
+
+
+set category_new_id [database_to_tcl_string $db "
+select category_id 
+from calendar_categories 
+where category = '$QQcategory_new'
+and [ad_scope_sql] "]
+
+
+if [catch { ns_db dml $db "
+    update calendar
+    set category_id=$category_new_id
+    where category_id = $category_id
+    "  } errmsg] {
+
+    # there was some other error with the category
+    ad_scope_return_error "Error updating category" "We couldn't update your category. Here is what the database returned:
+
    
+
    
+
    +$errmsg
+
    
+
    
+" $db
+return
+}
+
+
+ns_returnredirect "category-one.tcl?[export_url_scope_vars]&category_id=[ns_urlencode $category_new_id]"
+
+
Index: web/openacs/www/calendar/admin/category-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/admin/category-delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/admin/category-delete-2.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,36 @@
+# category-delete-2.tcl,v 3.0 2000/02/06 03:36:03 ron Exp
+# File:     /calendar/admin/category-delete-2.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  category deletion target page
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+# category_id
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+ad_scope_error_check
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope admin group_admin none
+
+# see if there are any calendar entries
+
+set num_category_entries [database_to_tcl_string $db "
+select count(calendar_id) from calendar where category_id=$category_id"]
+
+if {$num_category_entries > 0} {
+
+  ns_db dml $db "update calendar_categories set enabled_p ='f' where category_id=$category_id"
+
+} else {
+
+    ns_db dml $db "delete from calendar_categories where category_id=$category_id"
+
+}
+
+ns_returnredirect "categories.tcl?[export_url_scope_vars]"
+
Index: web/openacs/www/calendar/admin/category-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/admin/category-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/admin/category-delete.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,87 @@
+# category-delete.tcl,v 3.0 2000/02/06 03:36:04 ron Exp
+# File:     /calendar/admin/category-delete.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  category deleteion page
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables 0
+# category_id
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+ad_scope_error_check
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope admin group_admin none
+
+# see if there are any calendar entries
+
+set num_category_entries [database_to_tcl_string $db "
+select count(calendar_id) from calendar where category_id=$category_id"]
+
+if { $num_category_entries == 0 } {
+
+    # no calendar entries, so just delete
+    ns_returnredirect "category-delete-2.tcl?[export_url_scope_vars]&category_id=[ns_urlencode $category_id]"
+    return
+}
+
+set category [database_to_tcl_string $db "
+select category
+from calendar_categories
+where category_id=$category_id"]
+
+ReturnHeaders
+ns_write "
+[ad_scope_admin_header "Delete Category $category" $db]
+
    Delete 
    
+category  $category
+
    
+
+
+
+There are entries in the database that currently are categories with the category $category. 
+
    
+Would you like to:
+
    
+Leave these items with category $category
+
+
    
+or change the category to one of the following:
+
    
+
      
+"
+set counter 0
+foreach category_new [database_to_tcl_list $db "
+select category as category_new 
+from calendar_categories 
+where category <> '$category' 
+and [ad_scope_sql]
+and enabled_p <> 'f'"] {
+
+    incr counter
+    ns_write "
    • $category_new\n
+"
+}
+
+if { $counter == 0 } {
+    ns_write "no event categories are currently defined; this is an
+error in system configuration and you should complain to 
+[calendar_system_owner]"
+}
+
+ns_write "
+
+
    
+
+[ad_scope_admin_footer]
+"
+ 
Index: web/openacs/www/calendar/admin/category-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/admin/category-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/admin/category-edit.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,80 @@
+# category-edit.tcl,v 3.0 2000/02/06 03:36:05 ron Exp
+# File:     /calendar/admin/category-edit.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  category edit page
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+# category_id, category_new
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+ad_scope_error_check
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope admin group_admin none
+
+
+set exception_count 0
+set exception_text ""
+
+if { ![info exists category_new] || [empty_string_p $category_new] } {
+    incr exception_count
+    append exception_text "
  • Please enter a category."
+}
+
+
+if {$exception_count > 0} { 
+    ad_scope_return_complaint $exception_count $exception_text $db
+    return
+}
+
+
+set category [database_to_tcl_string $db "
+select category 
+from calendar_categories 
+where category_id = $category_id
+and [ad_scope_sql] "]
+
+
+if { $category == $QQcategory_new } {
+    ns_returnredirect "category-one.tcl?[export_url_scope_vars ]&category_id=[ns_urlencode $category_id]"
+    return
+}
+
+if [catch { ns_db dml $db "begin transaction" 
+
+    ns_db dml $db "
+    update calendar_categories 
+    set category = '$QQcategory_new'
+    where category_id = $category_id"
+
+    # if a new row was not updated, make sure that the exisitng entry is enabled
+    if { [ns_pg ntuples $db] == 0 } {
+	ns_db dml $db "
+	update calendar_categories 
+	set enabled_p = 't' 
+	where category_id = $category_id"
+    } 
+
+    ns_db dml $db "end transaction" } errmsg] {
+
+    # there was some other error with the category
+    ad_scope_return_error "Error updating category" "We couldn't update your category. Here is what the database returned:
+
    
+
    
+
    +$errmsg
+
    
+
    
+" $db
+return
+}
+
+
+ns_returnredirect "category-one.tcl?[export_url_scope_vars]&category_id=[ns_urlencode $category_id]"
+
+
Index: web/openacs/www/calendar/admin/category-enable-toggle.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/admin/category-enable-toggle.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/admin/category-enable-toggle.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,26 @@
+# category-enable-toggle.tcl,v 3.0 2000/02/06 03:36:06 ron Exp
+# File:     /calendar/admin/category-enable-toggle.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  enables/disables a category
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+# category_id
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+ad_scope_error_check
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope admin group_admin none
+
+ns_db dml $db "
+update calendar_categories 
+set enabled_p = logical_negation(enabled_p) 
+where category_id = $category_id"
+
+ns_returnredirect "category-one.tcl?[export_url_scope_vars category_id]"
+
Index: web/openacs/www/calendar/admin/category-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/admin/category-new.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/admin/category-new.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,69 @@
+# category-new.tcl,v 3.0 2000/02/06 03:36:07 ron Exp
+# File:     /calendar/admin/category-new.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  creates new caegory
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+# category_new , category_id
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+ad_scope_error_check
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope admin group_admin none
+
+set exception_count 0
+set exception_text ""
+
+if { ![info exists category_new] || [empty_string_p $category_new] } {
+    incr exception_count
+    append exception_text "
  • Please enter a category."
+}
+
+
+set category_exists_p [database_to_tcl_string $db "
+select count(*)
+from calendar_categories
+where category = '$QQcategory_new'
+and [ad_scope_sql] "]
+
+if { $category_exists_p } {
+    incr exception_count
+    append exception_text "
  • Category $QQcategory_new already exists. Please enter a new category."
+}
+
+if {$exception_count > 0} { 
+    ad_scope_return_complaint $exception_count $exception_text $db
+    return
+}
+
+if [catch {
+    # add the new category
+    ns_db dml $db "
+    insert into calendar_categories 
+    (category_id, category, [ad_scope_cols_sql]) 
+    values
+    ($category_id,'$QQcategory_new', [ad_scope_vals_sql])" 
+
+} errmsg] {
+
+    # there was some other error with the category
+    ad_scope_return_error "Error inserting category" "We couldn't insert your category. Here is what the database returned:
+
    
+
    
+
    +$errmsg
+
    
+
    
+" $db
+return
+}
+
+
+ns_returnredirect "category-one.tcl?[export_url_scope_vars]&category_id=[ns_urlencode $category_id]"
+
Index: web/openacs/www/calendar/admin/category-one.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/admin/category-one.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/admin/category-one.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,93 @@
+# category-one.tcl,v 3.0 2000/02/06 03:36:08 ron Exp
+# File:     /calendar/admin/category-one.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  shows one category
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+# category_id
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+ad_scope_error_check
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope admin group_admin none
+
+set category [database_to_tcl_string $db "
+select category
+from calendar_categories 
+where category_id=$category_id "]
+ 
+
+ReturnHeaders
+
+ns_write "
+[ad_scope_admin_header "Category $category" $db]
+[ad_scope_admin_page_title "Category $category" $db]
+[ad_scope_admin_context_bar [list "index.tcl?[export_url_scope_vars]" "Calendar"] [list "categories.tcl?[export_url_scope_vars]" "Categories"] "One Category"]  
+
+
    
+
+
      
+"
+
+set selection [ns_db select $db "
+select calendar.*, expired_p(expiration_date) as expired_p
+from calendar
+where  category_id = $category_id
+order by expired_p, creation_date desc"]
+
+set counter 0 
+set expired_p_headline_written_p 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    incr counter 
+    if { $expired_p == "t" && !$expired_p_headline_written_p } {
+	ns_write "
      Expired Calendar Items
      \n"
+	set expired_p_headline_written_p 1
+    }
+    ns_write "
    • [util_AnsiDatetoPrettyDate $start_date] - [util_AnsiDatetoPrettyDate $end_date]: $title"
+    if { $approved_p == "f" } {
+	ns_write "  not approved"
+    }
+    ns_write "\n"
+}
+
+ns_write "
+
+
      
+
+
    • Add an item
+
+
      
+
+
    • 
+
+
      
+Change this category name:
+[export_form_scope_vars category_id]
+
+
+
      "
+
+set category_enabled_p [database_to_tcl_string $db "
+select enabled_p from calendar_categories where category_id=$category_id"]
+
+if {$category_enabled_p == "t"} {
+    ns_write "
    •  Delete this category"
+} else {
+    ns_write "
    •  Allow users to post to this category"
+}
+ns_write "
    
+[ad_scope_admin_footer]
+"
+
+
+
+
+
+
Index: web/openacs/www/calendar/admin/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/admin/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/admin/index.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,69 @@
+# index.tcl,v 3.0 2000/02/06 03:36:09 ron Exp
+# File:     /calendar/admin/index.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  calendar main page
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+ad_scope_error_check
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope admin group_admin none
+
+
+ReturnHeaders
+
+ns_write "
+[ad_scope_admin_header "Calendar Administration" $db]
+[ad_scope_admin_page_title "Calendar Administration" $db]
+[ad_scope_admin_context_bar "Calendar"]
+
+
    
+
+
      
+"
+
+set selection [ns_db select $db "
+select c.*, expired_p(c.expiration_date) as expired_p
+from calendar c , calendar_categories cc
+where c.category_id=cc.category_id
+and [ad_scope_sql cc]
+order by expired_p, c.creation_date desc"]
+
+set counter 0 
+set expired_p_headline_written_p 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    incr counter 
+    if { $expired_p == "t" && !$expired_p_headline_written_p } {
+	ns_write "
      Expired Calendar Items
      \n"
+	set expired_p_headline_written_p 1
+    }
+    ns_write "
    • [util_AnsiDatetoPrettyDate $start_date] - [util_AnsiDatetoPrettyDate $end_date]: $title"
+    if { $approved_p == "f" } {
+	ns_write "  not approved"
+    }
+    ns_write "\n"
+}
+
+ns_write "
+
+
      
+
+
    • add an item
+
+
      
+
+
    • categories
+
+
    
+
+[ad_scope_admin_footer]
+"
+
Index: web/openacs/www/calendar/admin/item-category-change-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/admin/item-category-change-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/admin/item-category-change-2.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,29 @@
+# item-category-change-2.tcl,v 3.0 2000/02/06 03:36:10 ron Exp
+# File:     /calendar/admin/item-category-change-2.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  changes category of one item
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+# calendar_id,  category
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+ad_scope_error_check
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope admin group_admin none
+
+set category_id [database_to_tcl_string $db "
+select category_id 
+from calendar_categories
+where category = '$QQcategory'
+and [ad_scope_sql] "]
+
+ns_db dml $db "update calendar set category_id=$category_id where calendar_id=$calendar_id"
+
+ns_returnredirect "item.tcl?[export_url_scope_vars calendar_id]"
+
Index: web/openacs/www/calendar/admin/item-category-change.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/admin/item-category-change.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/admin/item-category-change.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,54 @@
+# item-category-change.tcl,v 3.0 2000/02/06 03:36:11 ron Exp
+# File:     /calendar/admin/item-category-change.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  changes category of one item
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+set_the_usual_form_variables 0
+# calendar_id
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+ad_scope_error_check
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope admin group_admin none
+
+
+set title [database_to_tcl_string $db "select title from calendar
+where calendar_id = $calendar_id"]
+
+ReturnHeaders
+ns_write "
+[ad_scope_admin_header "Pick New Category for $title" $db]
+[ad_scope_admin_page_title "Pick new category for $title" $db]  
+[ad_scope_admin_context_bar [list "index.tcl?[export_url_scope_vars]" "Calendar"] [list "item.tcl?[export_url_scope_vars calendar_id]" "One Item"] "Pick Category"]
+
    
+
+
      
+"
+
+set counter 0
+foreach category [database_to_tcl_list $db "
+select category 
+from calendar_categories 
+where enabled_p = 't'
+and [ad_scope_sql]"] {
+    incr counter
+    ns_write "
    • $category\n"
+}
+
+ns_write "
+
+
    
+
+[ad_scope_admin_footer]
+"
+ 
Index: web/openacs/www/calendar/admin/item.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/admin/item.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/admin/item.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,136 @@
+# item.tcl,v 3.0 2000/02/06 03:36:12 ron Exp
+# File:     /calendar/admin/item.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  shows one calendar item
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+# calendar_id
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+# maybe contact_info_only, maybe order_by
+
+ad_scope_error_check
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope admin group_admin none
+
+set return_url [ns_urlencode [ns_conn url]?calendar_id=$calendar_id]
+
+set selection [ns_db 0or1row $db "
+select title, body, html_p, calendar.approved_p, start_date, end_date, expiration_date, category_id, event_url, event_email, creation_user, creation_date, first_names, last_name
+from calendar, users 
+where calendar_id = $calendar_id
+and users.user_id = creation_user"]
+
+if { $selection == "" } {
+    ad_scope_return_error "Can't find calendar item" "Can't find news item $calendar_id" $db
+    return
+}
+
+set_variables_after_query
+
+set category [database_to_tcl_string $db "
+select category 
+from calendar_categories
+where category_id = $category_id "]
+
+ReturnHeaders
+
+ns_write "
+[ad_scope_admin_header "$title" $db]
+[ad_scope_admin_page_title "$title" $db ]
+[ad_scope_admin_context_bar [list "index.tcl?[export_url_scope_vars]" "Calendar"] "One Item"]
+
+
    
+
+
      
+
    • Category: $category (Change)
+
+
      
+
    • Status:  
+"
+
+if {$approved_p == "t" } {
+    ns_write "Approved (Revoke)"
+} else {
+    ns_write "Awaiting approval (Approve)"
+}
+
+ns_write "
+
    • Start Date: [util_AnsiDatetoPrettyDate $start_date]
+
    • End Date: [util_AnsiDatetoPrettyDate $end_date]
+
    • Expires: [util_AnsiDatetoPrettyDate $expiration_date]
+
    • Submitted by: $first_names $last_name"
+
+
+if ![empty_string_p $event_url] {
+    ns_write "
    • Web: $event_url\n"
+}
+
+if ![empty_string_p $event_email] {
+    ns_write "
    • Email: $event_email\n"
+}
+
+ns_write "
    
+
+
    Body
    
+
+
    
+[util_maybe_convert_to_html $body $html_p]
+
    
+
    
+
    
+[export_form_scope_vars]
+
+
+
    
+
+
    
+
+"
+
+# see if there are any comments on this item
+set selection [ns_db select $db "
+select comment_id, content, comment_date, first_names || ' ' || last_name as commenter_name, users.user_id as comment_user_id, html_p as comment_html_p, general_comments.approved_p as comment_approved_p from
+general_comments, users
+where on_what_id = $calendar_id 
+and on_which_table = 'calendar'
+and general_comments.user_id = users.user_id"]
+
+set first_iteration_p 1
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    if $first_iteration_p {
+	ns_write "
    Comments
    \n"
+	set first_iteration_p 0
+    }
+    ns_write "
+
+
+
    \n[util_maybe_convert_to_html $content $comment_html_p]\n"
+    ns_write "

    -- $commenter_name"
+    ns_write "
    
+    		"
+
+    # print out the approval status if we are using the approval system
+    if { [ad_parameter CommentApprovalPolicy calendar] != "open"} {
+	if {$comment_approved_p == "t" } {
+	    ns_write "Revoke approval"
+	} else {
+	    ns_write "Approve"
+	}
+	    ns_write "
    "
+    }
+
+ns_write "edit
+
    
+delete
+
    "
+}
+
+ns_write "[ad_scope_admin_footer]"
+
Index: web/openacs/www/calendar/admin/post-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/admin/post-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/admin/post-edit-2.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,128 @@
+# post-edit-2.tcl,v 3.0 2000/02/06 03:36:13 ron Exp
+# File:     /calendar/admin/post-edit-2.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  edits one calendar item
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set user_id [ad_get_user_id]
+if { $user_id == 0 } {
+    ns_returnredirect "/register/index.tcl?[export_url_scope_vars]"
+    return
+}
+
+set_the_usual_form_variables 0
+# category_id, calendar_id, title, body, AOLserver ns_db magic vars that can be 
+# kludged together to form release_date and expiration_date
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+ad_scope_error_check
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope admin group_admin none
+
+set exception_count 0
+set exception_text ""
+
+if [catch  { ns_dbformvalue [ns_conn form] start_date date start_date
+             ns_dbformvalue [ns_conn form] end_date date end_date } errmsg] {
+    incr exception_count
+    append exception_text "
  • Please make sure your dates are valid."
+
+} else {
+
+    # we assume that the event ends at the very end of the end_date
+    # we have to do the bogus 1000* and then rounding because of Stupid Oracle
+    # driver truncation errors (doesn't like big fractions)
+    set expire_laterthan_future_p [database_to_tcl_string $db "select date_part('epoch', '$end_date  11:59:59'::datetime -'$start_date'::datetime)"]
+    if {$expire_laterthan_future_p <= 0} {
+	incr exception_count
+	append exception_text "
  • Please make sure the end date is later than the start date."
+    }
+}
+
+# now start_date and end_date are set
+
+if { ![info exists title] || $title == ""} {
+    incr exception_count
+    append exception_text "
  • Please enter a title."
+}
+if { ![info exists body] || $body == "" } {
+    incr exception_count
+    append exception_text "
  • Please enter the full story."
+}
+
+if { [ad_parameter InternationalP] && ![info exists country_code] } {
+    incr exception_count
+    append exception_text "
  • Please select the country"
+} else { 
+    set country_code "" 
+}
+
+if { [ad_parameter SomeAmericanReadersP] && ![info exists usps_abbrev] } {
+    incr exception_count
+    append exception_text "
  • Please select the state"
+} else {  
+    set usps_abbrev ""  
+}
+
+if ![info exists zip_code] {
+    set zip_code ""
+}
+
+if { [info exists event_email] && ![empty_string_p $event_email] && ![philg_email_valid_p $event_email] } {
+    incr exception_count
+    append exception_text "
  • The event contact email address that you typed doesn't look right to us.  Examples of valid email addresses are 
+
      
+
    • Alice1234@aol.com
+
    • joe_smith@hp.com
+
    • pierre@inria.fr
+
    
+"
+}
+
+if { [info exists event_url] && ![philg_url_valid_p $event_url] } {
+    set event_url ""
+}
+
+if {$exception_count > 0} { 
+    ad_scope_return_complaint $exception_count $exception_text $db
+    return
+}
+
+
+if [catch { ns_db dml $db "update calendar
+set category_id = $category_id, title='$QQtitle', 
+body='$QQbody', html_p='$html_p',
+start_date = '$start_date', end_date = '$end_date  11:59:59'::datetime,
+expiration_date= '$end_date  11:59:59'::datetime + [ad_parameter DaysFromEndToExpiration calendar 3],
+event_url = [ns_dbquotevalue $event_url text], 
+event_email = [ns_dbquotevalue $event_email text], 
+country_code = [ns_dbquotevalue $country_code text], 
+usps_abbrev = [ns_dbquotevalue $usps_abbrev text], 
+zip_code = [ns_dbquotevalue $zip_code text]
+where calendar_id = $calendar_id"
+} errmsg] {
+    # update failed; let's see if it was because of duplicate submission
+    ns_log Error "/calendar/admin/post-edit-2.tcl choked:  $errmsg"
+    ad_scope_return_error "Update Failed" "The Database did not like what you typed.  This is probably a bug in our code.  Here's what the database said:
+
    
+
    +$errmsg
+
    
+
    
+" $db
+    return
+}
+
+
+ns_returnredirect "item.tcl?[export_url_scope_vars calendar_id]"
+
Index: web/openacs/www/calendar/admin/post-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/admin/post-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/admin/post-edit.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,156 @@
+# post-edit.tcl,v 3.0 2000/02/06 03:36:14 ron Exp
+# File:     /calendar/admin/post-edit.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  edits one calendar item
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_form_variables 0
+
+# calendar_id
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+ad_scope_error_check
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope admin group_admin none
+
+set selection [ns_db 0or1row $db "
+select title, body, html_p, approved_p, start_date, end_date, expiration_date, case when event_url is null then 'http://' else event_url end as event_url, event_email, country_code, usps_abbrev, zip_code, category_id 
+from calendar
+where calendar_id = $calendar_id"]
+
+if { $selection == "" } {
+    ad_scope_return_error "Can't find calendar item" "Can't find news item $calendar_id" $db
+    return
+}
+
+set_variables_after_query
+
+
+ReturnHeaders
+ns_write "
+[ad_scope_admin_header "edit $title" $db]
+[ad_scope_admin_page_title "Edit item $title" $db]  
+[ad_scope_admin_context_bar [list "index.tcl?[export_url_scope_vars]" "Calendar"] [list "item.tcl?[export_url_scope_vars calendar_id]" "One Item"] "Edit"]
+
    
+
+
    
+
    The title
    
+
+Remember that in a list of events, users will only see the title.  So
+try to make the title as descriptive as possible, e.g.,
+\"[ad_parameter TitleExample calendar "Ansel Adams show at Getty
+Center in Los Angeles, March 1-June 15"]\".  
+
+
    
+
+Title: 
+
+
    Full Description
    
+
+This information will be visible to a user who has clicked on a title.
+Make sure to include event hours, e.g., \"10 am to 4 pm\" and
+directions to the event.
+
+
    
+
+
+
+
    
+
+Text above is 
+
+
+
+
    Dates
    
+
+To ensure that users get relevant and accurate information, the
+software is programmed to show only events that are in the future.
+Furthermore, these events are sorted by the time that they start.  So
+an event that happens next week is given more prominence than an evetn
+that happens next year.  Make sure that you get these right!
+
+
    
+
+
+
    Event Start Date[philg_dateentrywidget start_date $start_date]
+
    Event End Date[philg_dateentrywidget end_date $end_date]
+
    
+
+
+
    Additional contact information
    
+
+If there are Internet sources for additional information about this
+event, enter a URL and/or email address below.
+
+
    
+
+
+
+
+
    Url
+
    Contact Email
+
    
+
+"
+
+if [ad_parameter EventsHaveLocationsP calendar 1] {
+    ns_write "
    Event Location
    
+
+If this event can be said to occur in one location, then please tell
+us where it is.  This will help our software give special prominence
+to events that are geographically close to a particular user.
+
+
    
+
+Note that this information is not shown to users but only used by our
+computer programs. The description above should contain information
+about where to find the event.
+
+
    
+
+
+"
+    if [ad_parameter InternationalP] {
+	if {$country_code == "us"} {
+	  ns_write "\n"
+	} else {
+	  ns_write "\n"
+	}
+    }
+
+    if [ad_parameter SomeAmericanReadersP] {
+	ns_write "\n"
+	ns_write " (5 digits)\n"
+    }
+    ns_write "
    Country[country_widget $db]
    Country[country_widget $db $country_code]
    State[state_widget $db $usps_abbrev]
    US Zip Code
    \n"
+}
+
+ns_write "
+
+
    
+
+
+
    
+
+
    
+[export_form_scope_vars category_id calendar_id]
+
    
+[ad_scope_admin_footer]
+"
+
+
+
+
+
Index: web/openacs/www/calendar/admin/post-new-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/admin/post-new-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/admin/post-new-2.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,140 @@
+# post-new-2.tcl,v 3.0 2000/02/06 03:36:16 ron Exp
+# File:     /calendar/admin/post-new-2.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  adds new calendar item
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables 0
+# category
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+ad_scope_error_check
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope admin group_admin none
+
+set verb "Post"
+ 
+ReturnHeaders
+ns_write "
+[ad_scope_admin_header "$verb $category Item" $db]
+[ad_scope_admin_page_title "$verb $category Item" $db]
+[ad_scope_admin_context_bar [list "index.tcl?[export_url_scope_vars]" "Calendar"] "$verb Item"]
+
+
    
+
+
    
+
    The title
    
+
+Remember that in a list of events, users will only see the title.  So
+try to make the title as descriptive as possible, e.g.,
+\"[ad_parameter TitleExample calendar "Ansel Adams show at Getty
+Center in Los Angeles, March 1-June 15"]\".  
+
+
    
+
+Title: 
+
+
    Full Description
    
+
+This information will be visible to a user who has clicked on a title.
+Make sure to include event hours, e.g., \"10 am to 4 pm\" and
+directions to the event.
+
+
    
+
+
+
+
    
+
+Text above is 
+
+
+"
+
+set calendar_id [database_to_tcl_string $db "select calendar_id_sequence.nextval from dual"]
+
+ns_write "
+
+
    Dates
    
+
+To ensure that users get relevant and accurate information, the
+software is programmed to show only events that are in the future.
+Furthermore, these events are sorted by the time that they start.  So
+an event that happens next week is given more prominence than an evetn
+that happens next year.  Make sure that you get these right!
+
+
    
+
+
+
    Event Start Date[philg_dateentrywidget start_date [database_to_tcl_string $db "select sysdate + [ad_parameter DaysFromPostingToStart calendar 30] from dual"]]
+
    Event End Date[philg_dateentrywidget end_date [database_to_tcl_string $db "select sysdate + [ad_parameter DaysFromPostingToStart calendar 30] + [ad_parameter DaysFromStartToEnd calendar 0] from dual"]]
+
    
+
+
+
    Additional contact information
    
+
+If there are Internet sources for additional information about this
+event, enter a URL and/or email address below.
+
+
    
+
+
+
+
+
    Url
+
    Contact Email
+
    
+
+"
+
+if [ad_parameter EventsHaveLocationsP calendar 1] {
+    ns_write "
    Event Location
    
+
+If this event can be said to occur in one location, then please tell
+us where it is.  This will help our software give special prominence
+to events that are geographically close to a particular user.
+
+
    
+
+Note that this information is not shown to users but only used by our
+computer programs. The description above should contain information
+about where to find the event.
+
+
    
+
+
+"
+    if [ad_parameter InternationalP] {
+	ns_write "\n"
+    }
+    if [ad_parameter SomeAmericanReadersP] {
+	ns_write "\n"
+	ns_write " (5 digits)\n"
+    }
+    ns_write "
    Country[country_widget $db]
    State[state_widget $db]
    US Zip Code
    \n"
+}
+
+ns_write "
+
+
    
+
+
+
    
+
+
    
+[export_form_scope_vars category calendar_id]
+
    
+[ad_scope_admin_footer]
+"
+ 
Index: web/openacs/www/calendar/admin/post-new-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/admin/post-new-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/admin/post-new-3.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,138 @@
+# post-new-3.tcl,v 3.0 2000/02/06 03:36:17 ron Exp
+# File:     /calendar/admin/post-new-3.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  adds new calendar item
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set user_id [ad_get_user_id]
+
+set_the_usual_form_variables 0
+# calendar_id, title, body, AOLserver ns_db magic vars that can be 
+# kludged together to form release_date and expiration_date
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+ad_scope_error_check
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope admin group_admin none
+
+set creation_ip_address [ns_conn peeraddr]
+
+set exception_count 0
+set exception_text ""
+
+if [catch  { ns_dbformvalue [ns_conn form] start_date date start_date
+             ns_dbformvalue [ns_conn form] end_date date end_date } errmsg] {
+    incr exception_count
+    append exception_text "
  • Please make sure your dates are valid."
+} else {
+
+    # we assume that the event ends at the very end of the end_date
+    # we have to do the bogus 1000* and then rounding because of Stupid Oracle
+    # driver truncation errors (doesn't like big fractions)
+    set expire_laterthan_future_p [database_to_tcl_string $db "select date_part('epoch', '$end_date  11:59:59'::datetime -'$start_date'::datetime)"]
+    if {$expire_laterthan_future_p <= 0} {
+	incr exception_count
+	append exception_text "
  • Please make sure the end date is later than the start date."
+    }
+}
+
+# now start_date and end_date are set
+
+if { ![info exists title] || $title == ""} {
+    incr exception_count
+    append exception_text "
  • Please enter a title."
+}
+if { ![info exists body] || $body == "" } {
+    incr exception_count
+    append exception_text "
  • Please enter the full story."
+}
+
+if { [ad_parameter InternationalP] && ![info exists country_code] } {
+    incr exception_count
+    append exception_text "
  • Please select the country"
+} else { 
+    set country_code ""
+}
+
+if { [ad_parameter SomeAmericanReadersP] && ![info exists usps_abbrev] } {
+    incr exception_count
+    append exception_text "
  • Please select the state"
+} else { 
+    set usps_abbrev "" 
+}
+
+if ![info exists zip_code] {
+    set zip_code ""     
+}
+
+if { [info exists event_email] && ![empty_string_p $event_email] && ![philg_email_valid_p $event_email] } {
+    incr exception_count
+    append exception_text "
  • The event contact email address that you typed doesn't look right to us.  Examples of valid email addresses are 
+
      
+
    • Alice1234@aol.com
+
    • joe_smith@hp.com
+
    • pierre@inria.fr
+
    
+"
+}
+
+if { [info exists event_url] && ![philg_url_valid_p $event_url] } {
+    set event_url ""
+}
+
+if {$exception_count > 0} { 
+    ad_scope_return_complaint $exception_count $exception_text $db
+    return
+}
+
+set approved_p "t"
+
+set category_id [database_to_tcl_string $db "
+select category_id 
+from calendar_categories 
+where category='$QQcategory'
+and [ad_scope_sql] "]
+
+if [catch { ns_db dml $db "insert into calendar
+(calendar_id, category_id, title, body, html_p, approved_p, 
+start_date, end_date, 
+creation_date, expiration_date,
+creation_user, creation_ip_address,
+event_url, event_email, 
+country_code, usps_abbrev, zip_code)
+values
+($calendar_id, $category_id, '$QQtitle', '$QQbody', '$html_p', '$approved_p', 
+'$start_date', '$end_date  11:59:59'::datetime, 
+sysdate(), '$end_date 11:59:59'::datetime + [ad_parameter DaysFromEndToExpiration calendar 3],
+$user_id, '$creation_ip_address',
+[ns_dbquotevalue $event_url text],[ns_dbquotevalue $event_email text],
+[ns_dbquotevalue $country_code text],[ns_dbquotevalue $usps_abbrev text],[ns_dbquotevalue $zip_code text])" } errmsg] {
+    # insert failed; let's see if it was because of duplicate submission
+    if {[database_to_tcl_string $db "select count(*) from calendar where calendar_id = $calendar_id"] == 0 } {
+	ns_log Error "/calendar/post-new-3.tcl choked:  $errmsg"
+	ad_scope_return_error "Insert Failed" "The Database did not like what you typed.  This is probably a bug in our code.  Here's what the database said:
+
    
+
    +$errmsg
+
    
+
    
+" $db
+        return
+    }
+    # we don't bother to handle the cases where there is a dupe submission
+    # because the user should be thanked or redirected anyway
+}
+
+
+ns_returnredirect "item.tcl?[export_url_scope_vars calendar_id]"
+
Index: web/openacs/www/calendar/admin/post-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/admin/post-new.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/admin/post-new.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,57 @@
+# post-new.tcl,v 3.0 2000/02/06 03:36:20 ron Exp
+# File:     /calendar/admin/post-new.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  this page exists to solicit from the user what kind of an event
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set user_id [ad_get_user_id]
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+ad_scope_error_check
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope admin group_admin none
+
+ReturnHeaders
+ns_write "
+[ad_scope_admin_header "Pick Category" $db]
+[ad_scope_admin_page_title "Pick Category" $db]
+[ad_scope_admin_context_bar [list "index.tcl?[export_url_scope_vars]" "Calendar"] "Pick Category"]
+
+
    
+
+
      
+"
+set counter 0
+foreach category [database_to_tcl_list $db "
+select category 
+from calendar_categories 
+where enabled_p = 't'
+and [ad_scope_sql]"] {
+    incr counter
+    ns_write "
    • $category\n"
+}
+
+if { $counter == 0 } {
+    ns_write "no event categories are currently defined; you'll have to visit
+the categories page and define some."
+}
+
+ns_write "
+
+
    
+
+[ad_scope_admin_footer]
+"
+ 
Index: web/openacs/www/calendar/admin/toggle-approved-p.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/calendar/admin/toggle-approved-p.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/calendar/admin/toggle-approved-p.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,23 @@
+# toggle-approved-p.tcl,v 3.0 2000/02/06 03:36:21 ron Exp
+# File:     /calendar/admin/toggle-approved-p.tcl
+# Date:     1998-11-18
+# Contact:  philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  aproves/dispproves calendar item
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_form_variables 0
+# calendar_id
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+ad_scope_error_check
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope admin group_admin none
+
+ns_db dml $db "update calendar set approved_p = logical_negation(approved_p) where calendar_id = $calendar_id"
+
+ns_returnredirect "item.tcl?[export_url_scope_vars calendar_id]"
+
Index: web/openacs/www/chat/bounced-from-private-room.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/bounced-from-private-room.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/bounced-from-private-room.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,52 @@
+# bounced-from-private-room.tcl,v 3.0 2000/02/06 03:36:22 ron Exp
+# File:     /chat/bounced-from-private-room.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+
+# this page explains to user why he was bounced 
+# and links him over to the group user page if he wants 
+# to apply for membership
+
+# Note: if page is accessed through /groups pages then group_id and group_vars_set 
+#       are already set up in the environment by the ug_serve_section. group_vars_set 
+#       contains group related variables (group_id, group_name, group_short_name, 
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+
+# chat_room_id 
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+validate_integer chat_room_id $chat_room_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope registered group_member none
+
+set selection [ns_db 1row $db "select cr.pretty_name, cr.group_id as private_group_id, ug.group_name
+from chat_rooms cr , user_groups ug
+where cr.chat_room_id = $chat_room_id
+and cr.group_id = ug.group_id"]
+
+set_variables_after_query
+
+ns_return 200 text/html "
+
+[ad_scope_header "Private Room" $db]
+[ad_scope_page_title "Private Room" $db]
+[ad_scope_context_bar_ws_or_index [list "index.tcl?[export_url_scope_vars]" [chat_system_name]] "Private Room"]
+
+
    
+
+The chat room \"$pretty_name\" is private.  You have to be a member of
+$group_name
+to participate.
+
+
+[ad_scope_footer]
+"
+
+
Index: web/openacs/www/chat/chat.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/chat.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/chat.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,55 @@
+# chat.tcl,v 3.0.4.1 2000/03/24 02:38:28 aure Exp
+# File:     /chat/chat.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+
+# this page will be the most frequently requested in the entire ACS
+# it must be super efficient
+# it must not query the RDBMS except in unusual cases (e.g., private chat) 
+
+# Note: if page is accessed through /groups pages then group_id and group_vars_set 
+#       are already set up in the environment by the ug_serve_section. group_vars_set 
+#       contains group related variables (group_id, group_name, group_short_name, 
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+
+# chat_room_id, n_rows (has three possible values, "short", "medium", "long"; we do 
+# this for caching)
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+validate_integer chat_room_id $chat_room_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+set user_id [ad_scope_authorize $db $scope registered group_member none]
+ns_db releasehandle $db
+
+if { ![info exists n_rows] || [empty_string_p $n_rows] || ($n_rows != "long" && $n_rows != "short" && $n_rows != "medium") } {
+    set n_rows "short"
+}
+
+set private_group_id [chat_room_group_id $chat_room_id]
+
+if { ![empty_string_p $private_group_id] && ![ad_user_group_member_cache $private_group_id $user_id]} {
+    ns_returnredirect "bounced-from-private-room.tcl?[export_url_scope_vars chat_room_id]"
+    return
+}
+
+# make sure that these are integers before passing them
+# to memoize, which does an eval 
+validate_integer "chat_room_id" $chat_room_id
+# validate_integer "n_rows" $n_rows
+
+ns_return 200 text/html [util_memoize "chat_entire_page $chat_room_id $n_rows"]
+
+
+
+
+
+
+
+
Index: web/openacs/www/chat/create-room-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/create-room-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/create-room-2.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,60 @@
+# create-room-2.tcl,v 3.0 2000/02/06 03:36:24 ron Exp
+# File:     /chat/create-room-2.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  creates a new chat room
+
+# Note: if page is accessed through /groups pages then group_id and group_vars_set 
+#       are already set up in the environment by the ug_serve_section. group_vars_set 
+#       contains group related variables (group_id, group_name, group_short_name, 
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+
+set_the_usual_form_variables 0
+
+# pretty_name, maybe group_id, moderated_p
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+set user_id [ad_scope_authorize $db $scope registered group_member none]
+
+set exception_count 0 
+set exception_text ""
+
+if {[empty_string_p $pretty_name]} {
+    incr exception_count
+    append exception_text "
  • Please name your new chat room."
+}
+
+if {$exception_count > 0} {
+    ad_scope_return_complaint $exception_count $exception_text $db
+    return
+}
+
+
+ns_db dml $db "begin transaction"
+
+set chat_room_id [database_to_tcl_string $db "select chat_room_id_sequence.nextval from dual"]
+
+ns_db dml $db "insert into chat_rooms
+(chat_room_id, pretty_name, moderated_p, [ad_scope_cols_sql])
+values
+($chat_room_id, '$QQpretty_name', '$moderated_p', [ad_scope_vals_sql])"
+
+# regardless of whether or not this person wants to moderate, we'll make an 
+# admin group
+ad_administration_group_add $db "$QQpretty_name Moderator" chat $chat_room_id "/chat/moderate.tcl?[export_url_scope_vars chat_room_id]" "f"
+
+# if this person is going to moderate 
+if { $moderated_p == "t" } {
+    ad_administration_group_user_add $db $user_id "administrator" "chat" $chat_room_id
+}
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "/chat/chat.tcl?[export_url_scope_vars chat_room_id]"
+
Index: web/openacs/www/chat/create-room.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/create-room.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/create-room.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,69 @@
+# create-room.tcl,v 3.1 2000/03/01 08:45:05 yon Exp
+# File:     /chat/create-room.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  creates a new chat room
+
+# Note: if page is accessed through /groups pages then group_id and group_vars_set 
+#       are already set up in the environment by the ug_serve_section. group_vars_set 
+#       contains group related variables (group_id, group_name, group_short_name, 
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+set user_id [ad_scope_authorize $db $scope registered group_member none]
+
+ReturnHeaders
+
+set title "Create a Room"
+
+ns_write "
+
+[ad_scope_header "$title" $db]
+[ad_scope_page_title "$title" $db]
+[ad_scope_context_bar_ws [list "index.tcl?[export_url_scope_vars]" [chat_system_name]] "$title"]
+
+
    
+
    
+[export_form_scope_vars]
+
+
+
+
+
+
+
+
    
+Room Name: 
    
+Limit to Members of this Group:
+
    
+Moderation Policy:
+
    
+
+
+
    
+[ad_scope_footer]
+"
+
+
Index: web/openacs/www/chat/enter-room.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/enter-room.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/enter-room.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,47 @@
+# enter-room.tcl,v 1.3.2.1 2000/02/03 09:45:11 ron Exp
+# File:     /chat/enter-room.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  enters into a  chat room
+
+# Note: if page is accessed through /groups pages then group_id and group_vars_set 
+#       are already set up in the environment by the ug_serve_section. group_vars_set 
+#       contains group related variables (group_id, group_name, group_short_name, 
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+
+set_the_usual_form_variables 0
+
+# chat_room_id
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+validate_integer chat_room_id $chat_room_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+set user_id [ad_scope_authorize $db $scope registered group_member none]
+
+chat_post_system_note $db "has entered the room" $user_id $chat_room_id
+switch $scope {
+    public {
+	if { [ad_administration_group_member $db chat $chat_room_id $user_id] } {
+	    ns_returnredirect moderate.tcl?[export_url_scope_vars chat_room_id]
+	} else {
+	    ns_returnredirect chat.tcl?[export_url_scope_vars chat_room_id]
+	}
+    }
+    group {
+	set moderated_p [database_to_tcl_string $db "select moderated_p from chat_rooms where
+	chat_room_id = $chat_room_id"]
+	if { ($moderated_p == "t") && ([ad_permission_p $db "" "" "" $user_id $group_id]==1)} {
+	    # this chat is moderated and I am an administrator for this group.
+	    ns_returnredirect moderate.tcl?[export_url_scope_vars chat_room_id]
+	} else {
+	    ns_returnredirect chat.tcl?[export_url_scope_vars chat_room_id]
+	}
+    }
+}
+
Index: web/openacs/www/chat/exit-room.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/exit-room.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/exit-room.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,33 @@
+# exit-room.tcl,v 3.0 2000/02/06 03:36:28 ron Exp
+# File:     /chat/exit-room.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  exits a  chat room
+
+# Note: if page is accessed through /groups pages then group_id and group_vars_set 
+#       are already set up in the environment by the ug_serve_section. group_vars_set 
+#       contains group related variables (group_id, group_name, group_short_name, 
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+
+# chat_room_id, newlocation
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+validate_integer chat_room_id $chat_room_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+set user_id [ad_scope_authorize $db $scope registered group_member none]
+
+chat_post_system_note $db "has left the room" $user_id $chat_room_id
+    
+ns_returnredirect $newlocation
+
+
+
+
+
Index: web/openacs/www/chat/history-one-day.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/history-one-day.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/history-one-day.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,74 @@
+# history-one-day.tcl,v 3.0 2000/02/06 03:36:29 ron Exp
+# File:     /chat/history-one-day.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+
+# we don't memoize a single day of chat history; we assume that not
+# too many folks are interested in any given day for a particular chat
+# room
+
+set_the_usual_form_variables
+
+# chat_room_id, the_date 
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+validate_integer chat_room_id $chat_room_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+set user_id [ad_scope_authorize $db $scope registered group_member none]
+
+set private_group_id [chat_room_group_id $chat_room_id]
+
+if { ![empty_string_p $private_group_id] && ![ad_user_group_member_cache $private_group_id $user_id]} {
+    ns_returnredirect "bounced-from-private-room.tcl?[export_url_scope_vars chat_room_id]"
+    return
+}
+
+set selection [ns_db 0or1row $db "select pretty_name
+from chat_rooms
+where chat_room_id = $chat_room_id"]
+
+if { $selection == "" } {
+    ad_scope_return_error "Room deleted" "We couldn't find the chat room you tried to enter. It was probably deleted by the site administrator." $db
+    return
+}
+
+set_variables_after_query
+
+set selection [ns_db select $db "select to_char(creation_date, 'HH24:MI:SS') as time, coalesce(msg_bowdlerized, msg) as filtered_msg, first_names, last_name, creation_user
+from chat_msgs, users
+where chat_msgs.creation_user = users.user_id
+and chat_room_id = $chat_room_id
+and chat_msgs.approved_p = 't'
+and trunc(creation_date) = '$QQthe_date'
+and system_note_p <> 't'
+order by creation_date"]
+
+set items ""
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query 
+    set filtered_msg [ns_quotehtml $filtered_msg]
+    append items "$first_names $last_name ($time) $filtered_msg
    \n"
+}
+
+ns_return 200 text/html "
+
+[ad_scope_header "[util_AnsiDatetoPrettyDate $the_date]: $pretty_name" $db]
+[ad_scope_page_title [util_AnsiDatetoPrettyDate $the_date] $db]
+[ad_scope_context_bar_ws_or_index [list "index.tcl?[export_url_scope_vars]" [chat_system_name]] [list "chat.tcl?[export_url_scope_vars chat_room_id]" "One Room"] [list "history.tcl?[export_url_scope_vars chat_room_id]" "History"] "One Day"]
+
+
    
+
+$pretty_name on [util_AnsiDatetoPrettyDate $the_date]:
+
+
      
+
+$items
+
+
    
+
+[ad_scope_footer]
+"
Index: web/openacs/www/chat/history.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/history.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/history.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,39 @@
+# history.tcl,v 3.0 2000/02/06 03:36:30 ron Exp
+# File:     /chat/history.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  lists history of a chat room
+
+# Note: if page is accessed through /groups pages then group_id and group_vars_set 
+#       are already set up in the environment by the ug_serve_section. group_vars_set 
+#       contains group related variables (group_id, group_name, group_short_name, 
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+
+# chat_room_id
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+validate_integer chat_room_id $chat_room_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+set user_id [ad_scope_authorize $db $scope registered group_member none]
+ns_db releasehandle $db
+
+set private_group_id [chat_room_group_id $chat_room_id]
+
+if { ![empty_string_p $private_group_id] && ![ad_user_group_member_cache $private_group_id $user_id]} {
+    ns_returnredirect "bounced-from-private-room.tcl?[export_url_scope_vars chat_room_id]"
+    return
+}
+
+# throw an error if this isn't an integer
+validate_integer "chat_room_id" $chat_room_id
+
+ns_return 200 text/html [util_memoize "chat_history $chat_room_id" [ad_parameter RoomPropertiesCacheTimeout chat 600]]
+
+
Index: web/openacs/www/chat/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/index.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,93 @@
+# /chat/index.tcl
+#
+# by aure@arsdigita.com, April 1999
+# 
+# modified by philg@mit.edu, ahmeds@arsdigita.com
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set 
+#       are already set up in the environment by the ug_serve_section. group_vars_set 
+#       contains group related variables (group_id, group_name, group_short_name, 
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and 
+#       group_navbar_list)
+#
+# index.tcl,v 3.4.2.1 2000/03/30 12:36:18 carsten Exp
+
+# this command should be replaced ad_page_variables but it can't because
+# ad_scope depends on existence of variables
+set_the_usual_form_variables 0
+
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+set user_id [ad_scope_authorize $db $scope registered group_member none]
+
+set title [chat_system_name]
+
+set page_content "[ad_scope_header $title $db]"
+
+if { $scope == "public" } {
+
+    append page_content "
+    [ad_decorate_top "
    $title
    
+    [ad_scope_context_bar_ws $title]" [ad_parameter DefaultDecoration chat]]"
+
+} else {
+
+    append page_content "
+    [ad_scope_page_title $title $db]
+    [ad_scope_context_bar_ws_or_index "Chat"]"
+
+}
+
+append page_content "
+
    
+
      
+
    •  Join current room:
        "
+
+set room_query "
+select distinct pretty_name, 
+       chat_room_id 
+from   chat_rooms
+where  active_p = 't'
+and    (group_id is null or ad_group_member_p($user_id, group_id) = 't')
+and    [ad_scope_sql chat_rooms] 
+order by pretty_name"
+
+set selection [ns_db select $db $room_query]
+
+set room_list ""
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query 
+    append room_list  "
+    
      • $pretty_name"
+}
+
+if {[empty_string_p $room_list]} {
+    set room_list "No rooms available"
+}
+
+append page_content "
+$room_list
+
      "
+
+if [ad_parameter UsersCanCreateRoomsP chat] {
+    append page_content "
      
+    
    •  Create a new room"
+}
+
+append page_content "
+
    
+[ad_scope_footer]"
+
+# release the database handle
+ns_db releasehandle $db
+
+# serve the page
+ns_return 200 text/html $page_content
+
+
Index: web/openacs/www/chat/invite.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/invite.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/invite.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,60 @@
+# invite.tcl,v 3.0 2000/02/06 03:36:33 ron Exp
+# File:     /chat/invite.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com, philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  invites buddies to the chat room
+
+# Note: if page is accessed through /groups pages then group_id and group_vars_set 
+#       are already set up in the environment by the ug_serve_section. group_vars_set 
+#       contains group related variables (group_id, group_name, group_short_name, 
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+
+# email, chat_room_id
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+validate_integer chat_room_id $chat_room_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+set user_id [ad_scope_authorize $db $scope registered group_member none]
+
+if ![philg_email_valid_p $email] {
+    ad_scope_return_complaint 1 "
  • What you entered (\"$email\") doesn't look like a valid email address to us.
+  Examples of valid email addresses are 
+
      
+
    • Alice1234@aol.com
+
    • joe_smith@hp.com
+
    • pierre@inria.fr
+
    
+" $db
+    return
+}
+
+set from_email [database_to_tcl_string $db "select email from users where user_id=$user_id"]
+set from_name [database_to_tcl_string $db "select first_names||' '||last_name as whole_name from users where user_id=$user_id"]
+
+set chat_room_name [database_to_tcl_string $db "select pretty_name from chat_rooms where chat_room_id=$chat_room_id"]
+
+set subject "You are invited to join \"$chat_room_name\""
+
+set message "
+
+Please join me in the chat room \"$chat_room_name\":
+
+[ad_parameter SystemURL]/chat/enter-room.tcl?[export_url_scope_vars]&chat_room_id=$chat_room_id
+
+Hope to see you there!
+
+-- $from_name
+"
+
+ns_sendmail $email $from_email $subject $message
+
+ns_returnredirect "chat.tcl?[export_url_scope_vars chat_room_id]"
+
+
Index: web/openacs/www/chat/js-chat-rows.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/js-chat-rows.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/js-chat-rows.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,40 @@
+# js-chat-rows.tcl,v 3.0 2000/02/06 03:36:35 ron Exp
+# File:     /chat/js-chat-rows.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+
+# this page will be the most frequently requested in the entire ACS
+# it must be super efficient
+# it must not query the RDBMS except in unusual cases (e.g., private chat) 
+
+# Note: if page is accessed through /groups pages then group_id and group_vars_set 
+#       are already set up in the environment by the ug_serve_section. group_vars_set 
+#       contains group related variables (group_id, group_name, group_short_name, 
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+
+# chat_room_id
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+validate_integer chat_room_id $chat_room_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+set user_id [ad_scope_authorize $db $scope registered group_member none]
+ns_db releasehandle $db
+
+set private_group_id [chat_room_group_id $chat_room_id]
+
+if { ![empty_string_p $private_group_id] && ![ad_user_group_member_cache $private_group_id $user_id]} {
+    ns_returnredirect "bounced-from-private-room.tcl?[export_url_scope_vars chat_room_id]"
+    return
+}
+
+# throw an error if this isn't a pure integer
+validate_integer "chat_room_id" $chat_room_id
+ns_return 200 text/html [util_memoize "chat_js_entire_page $chat_room_id"]
+
Index: web/openacs/www/chat/js-chat.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/js-chat.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/js-chat.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,66 @@
+# js-chat.tcl,v 3.1 2000/02/06 03:41:39 bcassels Exp
+# File:     /chat/js-chat.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+
+# this page isn't particularly efficient but we think it is okay because 
+# it isn't called every two seconds; only the chat rows subframe is
+
+# Note: if page is accessed through /groups pages then group_id and group_vars_set 
+#       are already set up in the environment by the ug_serve_section. group_vars_set 
+#       contains group related variables (group_id, group_name, group_short_name, 
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+
+# chat_room_id
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+validate_integer chat_room_id $chat_room_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope registered group_member none
+
+set user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+set selection [ns_db 0or1row $db "select pretty_name, group_id as private_group_id, moderated_p 
+from chat_rooms 
+where chat_room_id=$chat_room_id"]
+
+if { $selection == "" } {
+    ad_scope_return_error "Room deleted" "We couldn't find chat room $chat_room_id.  It was probably deleted by the site administrator." $db
+    return -code return
+}
+
+set_variables_after_query
+
+if {[empty_string_p $private_group_id] || [ad_user_group_member $db $private_group_id $user_id]} {
+    ReturnHeaders
+
+
+    ns_write "
+	
+	
+	[chat_system_name]: $pretty_name
+	
+	
+	
+	
+	
+	
+	
+	<html>
+	<body bgcolor=yellow>
+	This version of chat requires a modern browser.
+	</body>
+	</html>"
+} else {
+    ns_returnredirect index.tcl?[export_url_scope_vars]
+}
+
Index: web/openacs/www/chat/js-form-good.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/js-form-good.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/js-form-good.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,53 @@
+# js-form-good.tcl,v 3.0 2000/02/06 03:36:37 ron Exp
+# File:     /chat/js-form-good.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+
+# Note: if page is accessed through /groups pages then group_id and group_vars_set 
+#       are already set up in the environment by the ug_serve_section. group_vars_set 
+#       contains group related variables (group_id, group_name, group_short_name, 
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+
+# chat_room_id
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+validate_integer chat_room_id $chat_room_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope registered group_member none
+ns_db releasehandle $db
+
+ReturnHeaders
+
+ns_write "
+<script language=javascript>
+function SubmitForm() {
+    document.hidden.msg.value=document.visible.msg.value;
+    document.hidden.submit();
+    document.visible.msg.value=\"\";
+    document.visible.msg.focus();
+}
+</script>
+<center><table><tr>
+
+<form name=visible>
+<td valign=top align=right>Chat:</td><td><textarea wrap=physical name=msg rows=2 cols=20></textarea></td><td valign=top>
+<a  href='javascript:SubmitForm();'> <img src=/chat/post-message.gif width=96 height=25 border=0></a>
+</td>
+</tr>
+</table>
+</form>
+<form name=hidden target=chat_rows method=post action=js-post-message.tcl>
+<input type=hidden name=msg>
+[export_form_scope_vars chat_room_id]
+</form>
+
+"
+
+
Index: web/openacs/www/chat/js-form-oneliner.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/js-form-oneliner.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/js-form-oneliner.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,47 @@
+# js-form-oneliner.tcl,v 3.0 2000/02/06 03:36:39 ron Exp
+# Note: if page is accessed through /groups pages then group_id and group_vars_set 
+#       are already set up in the environment by the ug_serve_section. group_vars_set 
+#       contains group related variables (group_id, group_name, group_short_name, 
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+
+# chat_room_id
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+validate_integer chat_room_id $chat_room_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope registered group_member none
+ns_db releasehandle $db
+
+ReturnHeaders
+
+ns_write "
+<script language=javascript>
+function SubmitForm() {
+    document.hidden.msg.value=document.visible.msg.value;
+    document.hidden.submit();
+    document.visible.msg.value=\"\";
+    document.visible.msg.focus();
+}
+</script>
+<center>
+
+<form name=visible onSubmit=\"javascript:SubmitForm()\">
+Chat: <input name=msg size=30></textarea></td><td valign=top>
+<input type=submit value=Post>
+[export_form_scope_vars chat_room_id]
+</form>
+<form name=hidden target=chat_rows method=post action=js-post-message.tcl>
+<input type=hidden name=msg>
+[export_form_scope_vars chat_room_id]
+</form>
+
+"
+
+
Index: web/openacs/www/chat/js-form.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/js-form.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/js-form.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,65 @@
+# js-form.tcl,v 3.1 2000/02/14 19:51:04 bcassels Exp
+## File:     /chat/js-form.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+
+# Note: if page is accessed through /groups pages then group_id and group_vars_set 
+#       are already set up in the environment by the ug_serve_section. group_vars_set 
+#       contains group related variables (group_id, group_name, group_short_name, 
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+
+# chat_room_id
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+validate_integer chat_room_id $chat_room_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope registered group_member none
+ns_db releasehandle $db
+
+ns_return 200 text/html "
+<html>
+<script language=javascript>
+function SubmitForm() {
+    document.hidden.msg.value=document.visible.msg.value;
+    document.hidden.submit();
+    document.visible.msg.reset();
+    document.visible.msg.focus();
+}
+</script>
+<body bgcolor=white onLoad=\"document.visible.msg.focus()\">
+<center>
+
+<form name=visible>
+<table>
+
+<tr>
+<td valign=top>
+<textarea wrap=physical name=msg rows=2 cols=30></textarea>
+</td>
+
+<td valign=top><input type=button value=\"Post\" onClick=\"SubmitForm()\">
+[export_form_scope_vars chat_room_id]
+</td>
+
+<td valign=top>
+</td>
+</tr>
+</table>
+</form>
+
+<form name=hidden target=chat_rows method=post action=js-post-message.tcl>
+<input type=hidden name=msg>
+[export_form_scope_vars chat_room_id]
+</form>
+</body>
+</html>
+"
+
+
Index: web/openacs/www/chat/js-message-chat-rows.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/js-message-chat-rows.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/js-message-chat-rows.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,57 @@
+# js-message-chat-rows.tcl,v 3.0 2000/02/06 03:36:42 ron Exp
+# File:     /chat/js-message-chat-rows.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+
+# Note: if page is accessed through /groups pages then group_id and group_vars_set 
+#       are already set up in the environment by the ug_serve_section. group_vars_set 
+#       contains group related variables (group_id, group_name, group_short_name, 
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+
+# chatter_id
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+validate_integer chatter_id $chatter_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope registered group_member none
+ns_db releasehandle $db
+
+ReturnHeaders
+
+set time_user_id [chat_last_personal_post $chatter_id]
+set last_time [lindex $time_user_id 0]
+set last_poster [lindex $time_user_id 1]
+
+set html "
+<script>
+var last_time='$last_time';
+var last_poster='$last_poster';
+</script>
+<body bgcolor=white>
+"
+
+if {[ad_parameter MostRecentOnTopP chat]} {
+    append html "
+    <a name=most_recent></a>
+    "
+}
+
+append html "
+[chat_get_personal_posts $chatter_id]
+"
+
+if {![ad_parameter MostRecentOnTopP chat]} {
+    append html "
+    <a name=most_recent></a>
+    "
+}
+ns_write $html
+
+
Index: web/openacs/www/chat/js-message-form.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/js-message-form.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/js-message-form.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,63 @@
+# js-message-form.tcl,v 3.0 2000/02/06 03:36:43 ron Exp
+# File:     /chat/js-message-form.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+
+# Note: if page is accessed through /groups pages then group_id and group_vars_set 
+#       are already set up in the environment by the ug_serve_section. group_vars_set 
+#       contains group related variables (group_id, group_name, group_short_name, 
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+
+# chatter_id
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+validate_integer chatter_id $chatter_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope registered group_member none
+ns_db releasehandle $db
+
+ReturnHeaders
+
+ns_write "
+<script language=javascript>
+function SubmitForm() {
+    document.hidden.msg.value=document.visible.msg.value;
+    document.hidden.submit();
+    document.visible.msg.value=\"\";
+    document.visible.msg.focus();
+}
+</script>
+<center>
+
+<form name=visible>
+<table>
+
+<tr>
+<td valign=top>
+<textarea wrap=physical name=msg rows=2 cols=30></textarea>
+</td>
+
+<td valign=top><input type=button value=\"Post\" onClick=\"SubmitForm()\">
+[export_form_scope_vars chatter_id]
+</td>
+
+<td valign=top>
+</td>
+</tr>
+</table>
+</form>
+
+<form name=hidden target=chat_rows method=post action=js-message-post-message.tcl>
+<input type=hidden name=msg>
+[export_form_scope_vars chatter_id]
+</form>
+"
+
+
Index: web/openacs/www/chat/js-message-post-message.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/js-message-post-message.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/js-message-post-message.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,34 @@
+# js-message-post-message.tcl,v 3.0 2000/02/06 03:36:44 ron Exp
+# File:     /chat/js-message-post-message.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+
+# Note: if page is accessed through /groups pages then group_id and group_vars_set 
+#       are already set up in the environment by the ug_serve_section. group_vars_set 
+#       contains group related variables (group_id, group_name, group_short_name, 
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+
+# msg, chatter_id
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+validate_integer chatter_id $chatter_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+set user_id [ad_scope_authorize $db $scope registered group_member none]
+
+chat_post_personal_message $db $QQmsg $user_id $chatter_id
+
+ns_returnredirect js-message-chat-rows.tcl?[export_url_scope_vars chatter_id]&#most_recent
+
+
+
+
+
+
+
Index: web/openacs/www/chat/js-message-refresh.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/js-message-refresh.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/js-message-refresh.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,42 @@
+# js-message-refresh.tcl,v 3.0 2000/02/06 03:36:45 ron Exp
+# File:     /chat/js-message-refresh.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+
+# Note: if page is accessed through /groups pages then group_id and group_vars_set 
+#       are already set up in the environment by the ug_serve_section. group_vars_set 
+#       contains group related variables (group_id, group_name, group_short_name, 
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+
+# chatter_id
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+validate_integer chatter_id $chatter_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope registered group_member none
+ns_db releasehandle $db
+
+set time_user_id [chat_last_personal_post $chatter_id]
+set last_time [lindex $time_user_id 0]
+set last_poster [lindex $time_user_id 1]
+
+ReturnHeaders
+
+ns_write "
+<meta http-equiv=\"Refresh\" content=\"[ad_parameter CacheTimeout chat]\">
+<script language=javascript>
+var newest_poster='$last_poster'
+var newest_time='$last_time'
+function load_new () {
+    if(newest_time!=top.chat_rows.last_time || newest_poster!=top.chat_rows.last_poster) top.frames\[1\].location = 'js-message-chat-rows.tcl?[export_url_scope_vars chatter_id]';
+}
+</script>
+<body bgcolor=white onLoad=\"load_new()\">
+"
\ No newline at end of file
Index: web/openacs/www/chat/js-message.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/js-message.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/js-message.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,70 @@
+# js-message.tcl,v 3.0 2000/02/06 03:36:46 ron Exp
+# File:     /chat/js-message.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+
+# Note: if page is accessed through /groups pages then group_id and group_vars_set 
+#       are already set up in the environment by the ug_serve_section. group_vars_set 
+#       contains group related variables (group_id, group_name, group_short_name, 
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+
+# chatter_id
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+validate_integer chatter_id $chatter_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+set user_id [ad_scope_authorize $db $scope registered group_member none]
+
+set pretty_name [database_to_tcl_string $db "select first_names||' '||last_name from users where user_id=$chatter_id"]
+ns_log Notice "CHATTER: $pretty_name"
+ns_db releasehandle $db
+
+ReturnHeaders
+
+
+if {[ad_parameter MostRecentOnTopP chat]} {
+    ns_write "
+    <html>
+    <head>
+    <title>Chat: $pretty_name</title>
+    </head>
+    <frameset rows=\"100,*,0\" frameborder=no border=0 framespacing=0>
+    <frame name=form marginwidth=10 marginheight=0  src=\"js-message-form.tcl?[export_url_scope_vars chatter_id]\">
+    <frame name=chat_rows marginwidth=10 marginheight=0 src=\"js-message-chat-rows.tcl?[export_url_scope_vars chatter_id]#most_recent\">
+    <frame name=refresh marginwidth=0 marginheight=0 src=\"js-message-refresh.tcl?[export_url_scope_vars chatter_id]\">
+    </frameset>
+    <noframes>
+    <html>
+    <body bgcolor=yellow>
+    This version of chat requires a modern browser.
+    </body>
+    </html>
+    "
+} else {
+    ns_write "
+    <html>
+    <head>
+    <title>Chat: $pretty_name</title>
+    </head>
+    <frameset rows=\"*,100,0\" frameborder=no border=0 framespacing=0>
+    <frame name=chat_rows marginwidth=10 marginheight=0 src=\"js-message-chat-rows.tcl?[export_url_scope_vars chatter_id]#most_recent\">
+    <frame name=form marginwidth=10 marginheight=0 src=\"js-message-form.tcl?[export_url_scope_vars chatter_id]\">
+    <frame name=refresh marginwidth=0 marginheight=0 src=\"js-message-refresh.tcl?[export_url_scope_vars chatter_id]\">
+    </frameset>
+    <noframes>
+    <html>
+    <body bgcolor=yellow>
+    This version of chat requires a modern browser.
+    </body>
+    </html>
+    "
+}
+    
+
Index: web/openacs/www/chat/js-post-message.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/js-post-message.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/js-post-message.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,40 @@
+# js-post-message.tcl,v 3.0 2000/02/06 03:36:47 ron Exp
+# File:     /chat/js-post-message.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+
+# Note: if page is accessed through /groups pages then group_id and group_vars_set 
+#       are already set up in the environment by the ug_serve_section. group_vars_set 
+#       contains group related variables (group_id, group_name, group_short_name, 
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+
+# msg, chat_room_id
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+validate_integer chat_room_id $chat_room_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+set user_id [ad_scope_authorize $db $scope registered group_member none]
+
+if { ![info exists QQmsg] || [empty_string_p $QQmsg] } {
+    ns_returnredirect "js-chat-rows.tcl?[export_url_scope_vars chat_room_id]&#most_recent"
+    return
+}
+
+
+chat_post_message $db $QQmsg $user_id $chat_room_id
+
+ns_returnredirect js-chat-rows.tcl?[export_url_scope_vars chat_room_id]&#most_recent
+
+
+
+
+
+
+
Index: web/openacs/www/chat/js-refresh.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/js-refresh.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/js-refresh.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,40 @@
+# js-refresh.tcl,v 3.0 2000/02/06 03:36:48 ron Exp
+# File:     /chat/js-referesh.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+
+# Note: if page is accessed through /groups pages then group_id and group_vars_set 
+#       are already set up in the environment by the ug_serve_section. group_vars_set 
+#       contains group related variables (group_id, group_name, group_short_name, 
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+
+# chat_room_id
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+validate_integer chat_room_id $chat_room_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope registered group_member none
+ns_db releasehandle $db
+
+ReturnHeaders
+
+set last_post_id [chat_last_post $chat_room_id]
+
+ns_write "
+<meta http-equiv=\"Refresh\" content=\"[ad_parameter JavaScriptRefreshInterval chat 5]\">
+<script language=javascript>
+var newest_post=$last_post_id;
+
+function load_new () {
+    if (newest_post != top.chat_rows.last_post) top.chat_rows.location = 'js-chat-rows.tcl?[export_url_scope_vars chat_room_id]&random=$last_post_id';
+}
+</script>
+<body bgcolor=white onLoad=\"load_new()\">
+"
\ No newline at end of file
Index: web/openacs/www/chat/message.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/message.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/message.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,80 @@
+# message.tcl,v 3.0 2000/02/06 03:36:49 ron Exp
+# File:     /chat/message.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+
+# Note: if page is accessed through /groups pages then group_id and group_vars_set 
+#       are already set up in the environment by the ug_serve_section. group_vars_set 
+#       contains group related variables (group_id, group_name, group_short_name, 
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+
+# chatter_id
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+validate_integer chatter_id $chatter_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+set user_id [ad_scope_authorize $db $scope registered group_member none]
+
+set pretty_name [database_to_tcl_string $db "select first_names||' '||last_name from users where user_id=$chatter_id"]
+
+set html "
+[ad_scope_header "$pretty_name" $db]
+<script runat=client>
+function helpWindow(file) {
+    window.open(file,'ACSchatWindow','toolbar=no,location=no,directories=no,status=no,scrollbars=yes,resizable=yes,copyhistory=no,width=450,height=480')
+}
+</script>
+
+[ad_scope_page_title $pretty_name $db]
+[ad_scope_context_bar [list "/pvt/home.tcl" "Your Workspace"] [list "index.tcl?[export_url_scope_vars]" [chat_system_name]] "$pretty_name"]
+
+<hr>
+"
+
+set formhtml "
+<form method=post action=post-personal-message.tcl>
+<table><tr><td valign=top align=right>
+Chat:</td><td> <textarea wrap name=msg rows=2 cols=30></textarea>
+[export_form_scope_vars chatter_id]
+</td><td valign=top> <a href=message.tcl?[export_url_scope_vars chatter_id]>See new messages without posting</a><br>
+<a href=index.tcl?[export_url_scope_vars]>Exit this room</a>
+</td>
+</tr>
+<tr><td></td><td><input type=submit value=\"Send message\"></td></tr></table>
+</form>
+"
+
+if {[ad_parameter MostRecentOnTopP chat]} {
+    append html $formhtml
+    set formhtml ""
+}
+
+set chat_rows [chat_get_personal_posts $chatter_id]
+ns_db releasehandle $db
+
+ReturnHeaders
+ns_write "
+$html
+<ul>
+$chat_rows
+</ul>
+$formhtml
+</ul>
+
+<a href=\"javascript:helpWindow('js-message.tcl?[export_url_scope_vars chatter_id]')\">Open javascript version of this room</a>
+
+</ul>
+
+[ad_scope_footer]
+"
+
+
+
+
Index: web/openacs/www/chat/moderate-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/moderate-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/moderate-2.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,69 @@
+# moderate-2.tcl,v 1.3.2.2 2000/02/03 09:45:36 ron Exp
+# File:     /chat/moderate-2.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+
+# Note: if page is accessed through /groups pages then group_id and group_vars_set 
+#       are already set up in the environment by the ug_serve_section. group_vars_set 
+#       contains group related variables (group_id, group_name, group_short_name, 
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+
+# moderateXXXXX, ids, chat_room_id
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+validate_integer chat_room_id $chat_room_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+set user_id [ad_scope_authorize $db $scope registered group_member none]
+
+set private_group_id [chat_room_group_id $chat_room_id]
+
+if { ![empty_string_p $private_group_id] && ![ad_user_group_member_cache $private_group_id $user_id]} {
+    ns_returnredirect "bounced-from-private-room.tcl?[export_url_scope_vars chat_room_id]"
+    return
+}
+switch $scope {
+    public {
+	if { ![ad_administration_group_member $db chat $chat_room_id $user_id] } {
+	    ad_scope_return_error "Not Moderator" "You are not a moderator for this chat room." $db
+	    return
+	}
+    }
+    group {
+	if { ![ad_permission_p $db "" "" "" $user_id $group_id]==1 } {
+	    ad_scope_return_error "Not Moderator" "You are not a moderator for this chat room." $db
+	    return
+	}
+    }
+}
+
+
+foreach chat_msg_id $ids {
+    validate_integer chat_msg_id $chat_msg_id
+
+    set new_approved_p [expr $[set dummy "moderate$chat_msg_id"]]
+    ns_db dml $db "update chat_msgs 
+set approved_p='$new_approved_p' 
+where chat_msg_id = $chat_msg_id
+and chat_room_id = $chat_room_id"
+}
+
+util_memoize_flush "chat_entire_page $chat_room_id short"
+util_memoize_flush "chat_entire_page $chat_room_id medium"
+util_memoize_flush "chat_entire_page $chat_room_id long"
+util_memoize_flush "chat_js_entire_page $chat_room_id"
+
+util_memoize "chat_entire_page $chat_room_id short"
+util_memoize "chat_entire_page $chat_room_id medium"
+util_memoize "chat_entire_page $chat_room_id long"
+util_memoize "chat_js_entire_page $chat_room_id"
+
+ns_returnredirect moderate.tcl?[export_url_scope_vars chat_room_id]
+
+
Index: web/openacs/www/chat/moderate.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/moderate.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/moderate.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,208 @@
+# moderate.tcl,v 1.4.2.2 2000/02/03 09:45:38 ron Exp
+# File:     /chat/moderate.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+
+# Note: if page is accessed through /groups pages then group_id and group_vars_set 
+#       are already set up in the environment by the ug_serve_section. group_vars_set 
+#       contains group related variables (group_id, group_name, group_short_name, 
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+# this page will be the most frequently requested in the entire ACS
+# it must be super efficient
+# it must not query the RDBMS except in unusual cases (e.g., private chat) 
+
+set_the_usual_form_variables
+
+# chat_room_id, n_rows (has three possible values, "short", "medium", "long"; we do 
+# this for caching)
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+validate_integer chat_room_id $chat_room_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+set user_id [ad_scope_authorize $db $scope registered group_member none]
+
+if { ![info exists n_rows] || [empty_string_p $n_rows] } {
+    set n_rows "short"
+}
+
+
+set private_group_id [chat_room_group_id $chat_room_id]
+
+if { ![empty_string_p $private_group_id] && ![ad_user_group_member_cache $private_group_id $user_id]} {
+    ns_returnredirect "bounced-from-private-room.tcl?[export_url_scope_vars chat_room_id]"
+    return
+}
+
+switch $scope {
+    public {
+	if { ![ad_administration_group_member $db chat $chat_room_id $user_id] } {
+	    ad_scope_return_error "Not Moderator" "You are not a moderator for this chat room." $db
+	    return
+	}
+    }
+    group {
+	if { ![ad_permission_p $db "" "" "" $user_id $group_id]==1 } {
+	    ad_scope_return_error "Not Moderator" "You are not a moderator for this chat room." $db
+	    return
+	}
+    }
+}
+
+# Get room info
+set selection [ns_db 0or1row $db "select pretty_name, moderated_p
+from chat_rooms
+where chat_room_id = $chat_room_id"]
+
+if { $selection == "" } {
+    ad_scope_return_error "Room deleted" "We couldn't find the chat room you tried to enter. It was probably deleted by the site administrator." $db
+    return
+}
+
+set_variables_after_query
+
+if { ![empty_string_p $moderated_p] && $moderated_p == "t" } {
+    set button_text "submit message to moderator"
+} else {
+    set button_text "post message"
+}
+
+set html "
+[ad_scope_header "$pretty_name" $db]
+<script runat=client>
+function helpWindow(file) {
+    window.open(file,'ACSchatWindow','toolbar=no,location=no,directories=no,status=no,scrollbars=yes,resizable=yes,copyhistory=no,width=450,height=480')
+}
+</script>
+[ad_scope_page_title "$pretty_name" $db]
+[chat_scope_context_bar_ws_or_index  $chat_room_id [list "exit-room.tcl?[export_url_scope_vars chat_room_id]&newlocation=index.tcl" [chat_system_name]] "Moderation" ]
+<hr>"
+
+set formhtml "<form method=post action=post-message-by-moderator.tcl>
+Chat: <input name=msg size=40>
+<input type=submit value=\"$button_text\">
+[export_form_scope_vars chat_room_id]
+<P>
+</form>
+
+"
+
+if {[ad_parameter MostRecentOnTopP chat]} {
+    append html $formhtml
+    set formhtml ""
+}
+
+set moderation_rows ""
+
+
+switch $scope {
+    public {
+	set moderator [ad_administration_group_member $db chat $chat_room_id $user_id]
+    }
+    group {
+	if { [ad_permission_p $db "" "" "" $user_id $group_id]==1 } {
+	    set moderator 1
+	}
+    }
+}
+
+if { $moderator } {
+    set moderation_rows [chat_get_posts_to_moderate $chat_room_id]
+}
+
+
+
+set selection [ns_db select $db "select distinct user_id as chatter_id, first_names, last_name
+from chat_msgs, users
+where chat_msgs.creation_user = users.user_id
+and chat_room_id = $chat_room_id
+and creation_date > sysdate - .006944
+and chat_msgs.approved_p = 't'
+order by last_name"]
+
+    set chatters [list]
+
+    set private_chat_enabled_p [ad_parameter PrivateChatEnabledP chat 1]
+    while { [ns_db getrow $db $selection] } {
+	set_variables_after_query
+
+	if { $private_chat_enabled_p } {
+	    lappend chatters "<a href=/shared/community-member.tcl?[export_url_vars]&user_id=$chatter_id>$first_names $last_name</a> (<a target=newwindow href=message.tcl?[export_url_scope_vars]&chatter_id=$chatter_id>private chat</a>)"
+	} else {
+	    lappend chatters "<a href=/shared/community-member.tcl?[export_url_vars]&user_id=$chatter_id>$first_names $last_name</a>"
+	}
+    }
+
+    set refresh_list [list "<a href=moderate.tcl?[export_url_scope_vars chat_room_id n_rows]>Refresh</a>"]
+
+    switch -- $n_rows {
+	"short" {
+	    set posts [chat_get_posts $db $chat_room_id [ad_parameter NShortMessages chat 25]]
+	    set more_posts_p [lindex $posts 0]
+	    set chat_rows [lindex $posts 1]
+	    if { $more_posts_p } {
+		lappend refresh_list "<a href=\"moderate.tcl?[export_url_scope_vars chat_room_id]&n_rows=medium\">More Messages</a>"
+	    }
+	}
+	
+	"medium" {
+	    set posts [chat_get_posts $db $chat_room_id [ad_parameter NMediumMessages chat 50]]
+	    set more_posts_p [lindex $posts 0]
+	    set chat_rows [lindex $posts 1]
+	    lappend refresh_list "<a href=\"moderate.tcl?[export_url_scope_vars chat_room_id]&n_rows=short\">Fewer Messages</a>"
+	    if { $more_posts_p } {
+		lappend refresh_list "<a href=\"moderate.tcl?[export_url_scope_vars chat_room_id]&n_rows=long\">More Messages</a>"
+	    }
+	}
+	"long" {
+	    set chat_rows [lindex [chat_get_posts $db $chat_room_id [ad_parameter NLongMessages chat 75]] 1]
+	    lappend refresh_list "<a href=\"moderate.tcl?[export_url_scope_vars chat_room_id]&n_rows=medium\">Fewer Messages</a>"
+	}
+    }
+
+    ns_db releasehandle $db
+
+    if { [ad_parameter ExposeChatHistoryP chat 1] } {
+	set history_link "<li><a href=\"history.tcl?[export_url_scope_vars chat_room_id]\">View old messages</a>"
+    } else {
+	set history_link ""
+    }
+
+    ns_return 200 text/html "$html
+<div align=right>
+\[ [join $refresh_list " | "] \]
+</div>
+
+<ul>
+$moderation_rows
+
+$chat_rows
+</ul>
+
+$formhtml
+<p>
+
+<ul>
+<form action=invite.tcl method=post>
+[export_form_scope_vars chat_room_id]
+<li>Invite a friend - Email: <input name=email size=15><input type=submit value=invite>
+</form> 
+
+$history_link
+<li><a href=\"javascript:helpWindow('js-chat.tcl?[export_url_scope_vars chat_room_id]')\">JavaScript Version</a><br>
+<li><a href=exit-room.tcl?[export_url_scope_vars chat_room_id]&newlocation=index.tcl>Exit this room</a>
+</ul>
+
+<p>
+
+Chatters who posted messages within the last ten minutes:
+<ul>
+[join $chatters ", "]
+</ul>
+
+[ad_scope_footer]"
Index: web/openacs/www/chat/post-message-by-moderator.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/post-message-by-moderator.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/post-message-by-moderator.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,35 @@
+# post-message-by-moderator.tcl,v 3.0 2000/02/06 03:36:53 ron Exp
+# File:     /chat/post-message-by-moderator.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+
+# Note: if page is accessed through /groups pages then group_id and group_vars_set 
+#       are already set up in the environment by the ug_serve_section. group_vars_set 
+#       contains group related variables (group_id, group_name, group_short_name, 
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+
+# msg, chat_room_id
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+validate_integer chat_room_id $chat_room_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+set user_id [ad_scope_authorize $db $scope registered group_member none]
+
+chat_post_message $db $QQmsg $user_id $chat_room_id
+
+ns_returnredirect moderate.tcl?[export_url_scope_vars chat_room_id]
+
+
+
+
+
+
+
+
Index: web/openacs/www/chat/post-message.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/post-message.gif,v
diff -u
Binary files differ
Index: web/openacs/www/chat/post-message.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/post-message.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/post-message.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,40 @@
+# post-message.tcl,v 3.0 2000/02/06 03:36:55 ron Exp
+# File:     /chat/post-message.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+
+# Note: if page is accessed through /groups pages then group_id and group_vars_set 
+#       are already set up in the environment by the ug_serve_section. group_vars_set 
+#       contains group related variables (group_id, group_name, group_short_name, 
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+
+# msg, chat_room_id, n_rows 
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+validate_integer chat_room_id $chat_room_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+set user_id [ad_scope_authorize $db $scope registered group_member none]
+
+if { ![info exists QQmsg] || [empty_string_p $QQmsg] } {
+    ns_returnredirect chat.tcl?[export_url_scope_vars chat_room_id n_rows]
+    return
+}
+
+chat_post_message $db $QQmsg $user_id $chat_room_id
+
+ns_returnredirect chat.tcl?[export_url_scope_vars chat_room_id n_rows]
+
+
+
+
+
+
+
+
Index: web/openacs/www/chat/post-personal-message.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/post-personal-message.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/post-personal-message.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,35 @@
+# post-personal-message.tcl,v 3.0 2000/02/06 03:36:56 ron Exp
+# File:     /chat/post-personal-message.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+
+# Note: if page is accessed through /groups pages then group_id and group_vars_set 
+#       are already set up in the environment by the ug_serve_section. group_vars_set 
+#       contains group related variables (group_id, group_name, group_short_name, 
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+
+# msg, chatter_id
+# maybe scope, maybe scope related variables (owner_id, group_id, on_which_group, on_what_id)
+# note that owner_id is the user_id of the user who owns this module (when scope=user)
+
+validate_integer chatter_id $chatter_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+set user_id [ad_scope_authorize $db $scope registered group_member none]
+
+chat_post_personal_message $db $QQmsg $user_id $chatter_id
+
+ns_returnredirect message.tcl?[export_url_scope_vars chatter_id]
+
+
+
+
+
+
+
+
Index: web/openacs/www/chat/admin/create-room-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/admin/create-room-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/admin/create-room-2.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,51 @@
+# create-room-2.tcl,v 1.3.2.1 2000/02/03 09:20:13 ron Exp
+# File:     admin/chat/create-room-2.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  creates a new chat room
+
+set_the_usual_form_variables
+
+# pretty_name, maybe group_id, moderated_p, expiration_days, active_p
+
+ad_maybe_redirect_for_registration
+
+set exception_count 0 
+set exception_text ""
+
+if {[empty_string_p $pretty_name]} {
+    incr exception_count
+    append exception_text "<li>Please name your chat room."
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+set db [ns_db gethandle]
+
+ns_db dml $db "begin transaction"
+
+set chat_room_id [database_to_tcl_string $db "select chat_room_id_sequence.nextval from dual"]
+
+if {![info exists group_id] || [empty_string_p $group_id] } {
+    set group_id ""
+    set scope_val "public"
+} else {
+    set scope_val "group"
+}
+
+
+ns_db dml $db "insert into chat_rooms
+(chat_room_id, pretty_name, group_id, scope, moderated_p, expiration_days, active_p)
+values
+($chat_room_id, '$QQpretty_name', [db_null_sql $group_id], '$scope_val', '$moderated_p', '$expiration_days', '$active_p')"
+
+# create a new admin group within this transaction
+ad_administration_group_add $db "$pretty_name Moderation" chat $chat_room_id "/chat/moderate.tcl?chat_room_id=$chat_room_id" "f"
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "one-room.tcl?[export_url_vars chat_room_id]"
Index: web/openacs/www/chat/admin/create-room.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/admin/create-room.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/admin/create-room.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,63 @@
+# create-room.tcl,v 1.4.2.1 2000/02/03 09:20:14 ron Exp
+# File:     admin/chat/create-room.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  creates a new chat room
+
+set_the_usual_form_variables 0
+
+# bug fix (BMA)
+if {![info exists scope]} {
+    set scope public
+}
+
+set db [ns_db gethandle]
+
+set user_id [ad_scope_authorize $db $scope admin group_admin none]
+ReturnHeaders
+
+set title "Create a Room"
+
+ns_write "
+[ad_scope_admin_header "$title" $db]
+[ad_scope_admin_page_title $title $db]
+[ad_scope_admin_context_bar [list "index.tcl" Chat] $title]
+<hr>
+<form action=\"create-room-2.tcl\" method=POST>
+[export_form_scope_vars]
+<table><tr><td align=right>
+Room Name:</td><td> <input name=pretty_name size=35></td>
+</tr>
+<tr>
+<td align=right>
+Expire messages after </td><td><input type=text name=expiration_days value=\"\" size=4> days (or leave blank to archive messages indefinitely)
+</td></tr>
+<tr><td align=right>
+Active?</td>
+<td>
+<select name=active_p>
+    <option value=f>No</option>
+    <option value=t selected>Yes</option>
+</select>
+(pick \"No\" if you want to wait before launching this publicly)
+</td></tr>
+<tr><td align=right>
+Moderated?</td>
+<td><select name=moderated_p><option value=f selected>No</option>
+<option value=t>Yes</option>
+</select>
+</td></tr>
+</table>
+<P>
+<center>
+<input type=submit value=Create>
+</center>
+</form>
+
+[ad_scope_admin_footer]
+"
+
+
+
+
+
Index: web/openacs/www/chat/admin/delete-messages-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/admin/delete-messages-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/admin/delete-messages-2.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,17 @@
+# delete-messages-2.tcl,v 1.1.2.3 2000/02/03 09:20:16 ron Exp
+# File:     admin/chat/delete-messages-2.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  deletes messages of a chat room
+
+set_the_usual_form_variables
+
+# chat_room_id
+
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+set user_id [ad_scope_authorize $db $scope admin group_admin none]
+ns_db dml $db "delete from chat_msgs where chat_room_id=$chat_room_id"
+
+ns_returnredirect "one-room.tcl?[export_url_scope_vars chat_room_id]"
Index: web/openacs/www/chat/admin/delete-messages.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/admin/delete-messages.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/admin/delete-messages.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,44 @@
+# delete-messages.tcl,v 1.2.2.2 2000/02/03 09:20:17 ron Exp
+# File:     admin/chat/delete-messages.tcl
+# Date:     2000-01-31
+# Contact:  aure@arsdigita.com 
+# Purpose:  deletes a chat room's emssages
+
+set_the_usual_form_variables
+
+# chat_room_id 
+
+set db [ns_db gethandle]
+set user_id [ad_scope_authorize $db $scope admin group_admin none]
+set selection [ns_db 0or1row $db "select * from chat_rooms where chat_room_id = $chat_room_id"]
+
+if { $selection == "" } {
+    ad_return_error "Not Found" "Could not find chat_room $chat_room_id"
+    return
+}
+
+set_variables_after_query
+
+ReturnHeaders 
+
+ns_write "
+[ad_scope_admin_header "Confirm deletion of messages in $pretty_name" $db]
+[ad_scope_admin_page_title "Confirm deletion of messages in $pretty_name" $db]
+[ad_scope_admin_context_bar [list "index.tcl" Chat] [list "one-room.tcl?[export_url_scope_vars chat_room_id]" "One Room"] "Confirm Deletion"]
+
+<hr>
+
+Are you sure that you want to delete [database_to_tcl_string $db "select count(*) from chat_msgs where chat_room_id = $chat_room_id"] messages from $pretty_name?
+
+<p>
+
+<center>
+<form method=GET action=\"delete-messages-2.tcl\">
+[export_form_scope_vars chat_room_id]
+<input type=submit value=\"Yes, I'm sure\">
+</form>
+</center>
+
+
+[ad_admin_footer]
+"
Index: web/openacs/www/chat/admin/delete-room-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/admin/delete-room-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/admin/delete-room-2.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,32 @@
+# delete-room-2.tcl,v 1.2.2.1 2000/02/03 09:20:18 ron Exp
+# File:     admin/chat/delete-room-2.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  deletes a chat room
+
+set_the_usual_form_variables
+
+# chat_room_id
+
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+set user_id [ad_scope_authorize $db $scope admin group_admin none]
+
+ns_db dml $db "begin transaction"
+
+# delete the admin group we were using for moderation
+
+set admin_group_id [ad_administration_group_id $db chat $chat_room_id]
+if ![empty_string_p $admin_group_id] {
+    ns_db dml $db "delete from user_group_map_queue where group_id = $admin_group_id"
+    ns_db dml $db "delete from user_group_map where group_id = $admin_group_id"
+}
+
+ns_db dml $db "delete from chat_msgs where chat_room_id=$chat_room_id"
+
+ns_db dml $db "delete from chat_rooms where chat_room_id=$chat_room_id"
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "index.tcl?[export_url_scope_vars]"
Index: web/openacs/www/chat/admin/delete-room.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/admin/delete-room.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/admin/delete-room.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,46 @@
+# delete-room.tcl,v 1.2.2.1 2000/02/03 09:20:19 ron Exp
+# File:     admin/chat/delete-room.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  deletes a chat room
+
+set_the_usual_form_variables
+
+# chat_room_id 
+
+set db [ns_db gethandle]
+
+set user_id [ad_scope_authorize $db $scope admin group_admin none]
+set selection [ns_db 0or1row $db "select * from chat_rooms where chat_room_id = $chat_room_id"]
+
+if { $selection == "" } {
+    ad_return_error "Not Found" "Could not find chat_room $chat_room_id"
+    return
+}
+
+set_variables_after_query
+
+ReturnHeaders 
+
+ns_write "
+[ad_scope_admin_header "Confirm deletion of $pretty_name" $db]
+[ad_scope_admin_page_title $pretty_name $db]
+[ad_scope_admin_context_bar [list "index.tcl" Chat] [list "one-room.tcl?[export_url_vars chat_room_id]" "One Room"] "Confirm Deletion"]
+
+<hr>
+
+Are you sure that you want to delete $pretty_name (and its 
+[database_to_tcl_string $db "select count(*) from chat_msgs where chat_room_id = $chat_room_id"] messages)?
+
+<p>
+
+<center>
+<form method=GET action=\"delete-room-2.tcl\">
+[export_form_scope_vars chat_room_id]
+<input type=submit value=\"Yes, I'm sure\">
+</form>
+</center>
+
+
+[ad_scope_admin_footer]
+"
Index: web/openacs/www/chat/admin/edit-room.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/admin/edit-room.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/admin/edit-room.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,53 @@
+# edit-room.tcl,v 1.3.2.1 2000/02/03 09:20:20 ron Exp
+# File:     admin/chat/edit-room.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  edits properties of a chat room
+
+set_the_usual_form_variables
+
+# pretty_name, maybe group_id, moderated_p, user_id_from_search, expiration_days, active_p
+
+ad_maybe_redirect_for_registration
+
+set exception_count 0 
+if {[empty_string_p $pretty_name]} {
+    incr exception_count
+    append exception_text "<li>Please give this chat room a name."
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+set db [ns_db gethandle]
+
+if { [empty_string_p $group_id] } {
+    set scope_sql "group_id = null,
+                   scope = 'public', "
+} else {
+    set scope_sql "group_id = $group_id,
+                   scope = 'group', "
+}
+
+ns_db dml $db "update chat_rooms
+set pretty_name='$QQpretty_name', 
+moderated_p='$moderated_p',
+$scope_sql
+active_p='$active_p',
+expiration_days= [ns_dbquotevalue $expiration_days number]
+where chat_room_id=$chat_room_id"
+
+ns_returnredirect "one-room.tcl?[export_url_scope_vars chat_room_id]"
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/chat/admin/expire-messages.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/admin/expire-messages.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/admin/expire-messages.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,41 @@
+# expire-messages.tcl,v 1.2.2.1 2000/02/03 09:20:21 ron Exp
+# File:     admin/chat/expire-messages.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  expires messages of a chat room
+
+set_the_usual_form_variables
+
+# chat_room_id
+
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+set expiration_days [database_to_tcl_string $db "select expiration_days from chat_rooms where chat_room_id=$chat_room_id"]
+
+if {[empty_string_p $expiration_days]} {
+    ad_return_complaint 1 "You haven't set expiration_days so we
+couldn't possibly delete any messages"
+    return
+}
+
+ns_db dml $db "delete from chat_msgs 
+where chat_room_id = $chat_room_id
+and creation_date < sysdate()-$expiration_days"
+
+set n_rows_deleted [ns_pg ntuples $db]
+
+ns_return 200 text/html "[ad_admin_header "$n_rows_deleted rows were deleted"]
+
+<h2>$n_rows_deleted rows deleted</h2>
+
+[ad_admin_context_bar [list "index.tcl" Chat] [list "one-room.tcl?[export_url_vars chat_room_id]" "One Room"] "Deleted Expired Messages"]
+
+<hr>
+
+[ad_admin_footer]
+"
+
+
+
Index: web/openacs/www/chat/admin/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/admin/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/admin/index.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,93 @@
+# index.tcl,v 1.2.2.1 2000/02/03 09:20:23 ron Exp
+# File:     admin/chat/index.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  admin chat main page
+
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (group_id)
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+set local_user_id [ad_scope_authorize $db $scope admin group_admin none]
+
+
+ReturnHeaders
+
+set title "Chat System"
+
+ns_write "
+[ad_scope_admin_header $title $db]
+[ad_scope_admin_page_title $title $db]
+[ad_scope_admin_context_bar $title]
+
+<hr>
+
+<ul>
+<h4>Active chat rooms</h4>
+"
+
+
+# only filter by group if the scope is set accordingly
+if {$scope=="group"} {
+    set where_group "
+	and chat_rooms.group_id = $group_id
+	and scope = 'group'"
+} else {
+    set where_group ""
+}
+
+set selection [ns_db select $db "
+  select chat_rooms.chat_room_id, chat_rooms.pretty_name, chat_rooms.active_p, 
+    count(chat_msg_id) as n_messages, max(chat_msgs.creation_date) as most_recent_date
+  from chat_rooms, chat_msgs
+  where chat_rooms.chat_room_id = chat_msgs.chat_room_id  $where_group
+  group by chat_rooms.chat_room_id, chat_rooms.pretty_name, chat_rooms.active_p
+  union
+  select chat_rooms.chat_room_id, chat_rooms.pretty_name, chat_rooms.active_p, 
+    0::integer as n_messages, NULL as most_recent_date
+  from chat_rooms
+  where 0=(select count(*) from chat_msgs where chat_room_id=chat_rooms.chat_room_id)
+  $where_group
+  group by chat_rooms.chat_room_id, chat_rooms.pretty_name, chat_rooms.active_p
+  order by chat_rooms.active_p desc, upper(chat_rooms.pretty_name)"]
+
+
+set count 0
+set inactive_title_shown_p 0
+set room_items ""
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { $active_p == "f" } {
+	if { $inactive_title_shown_p == 0 } {
+	    # we have not shown the inactive title yet
+	    if { $count == 0 } {
+		append room_items "<li>No active chat rooms"
+	    }
+	    set inactive_title_shown_p 1
+	    append room_items "<h4>Inactive chat rooms</h4>"
+	}
+    }
+	
+    append room_items "<li><a href=\"one-room.tcl?[export_url_vars chat_room_id]\">$pretty_name</a>\n"
+    if { $n_messages == 0 } {
+	append room_items " (no messages)\n"
+    } else {
+	append room_items " ($n_messages; most recent on $most_recent_date)\n"
+    }
+    incr count
+}
+
+
+ns_write "
+$room_items
+
+<p><a href=create-room.tcl>Create a new room</a>
+
+</ul>
+
+[ad_admin_footer]
+"
Index: web/openacs/www/chat/admin/msgs-for-user.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/admin/msgs-for-user.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/admin/msgs-for-user.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,60 @@
+# msgs-for-user.tcl,v 1.2.2.1 2000/02/03 09:20:24 ron Exp
+# File:     admin/chat/msgs-for-user.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+
+set_the_usual_form_variables
+# user_id
+
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select first_names || ' ' || last_name as username
+from users
+where user_id = $user_id"]
+
+set_variables_after_query
+
+set selection [ns_db select $db "select cr.pretty_name, cm.msg, u.first_names || ' ' || u.last_name as recipient
+from chat_rooms cr, chat_msgs cm, users u
+where creation_user = $user_id
+and cm.chat_room_id = cr.chat_room_id(+)
+and cm.recipient_user = u.user_id(+)
+and cm.system_note_p = 'f'
+order by cr.pretty_name, u.first_names, u.last_name, cm.creation_date"]
+
+set msgs ""
+set last_chat_room ""
+set last_recipient " "
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    
+    if { ![empty_string_p $pretty_name] && $last_chat_room != $pretty_name } {
+	append msgs "<h4>Messages in $pretty_name room</h4>\n"
+	set last_chat_room $pretty_name
+    }
+    if { ![empty_string_p $recipient] && $recipient != $last_recipient } {
+	append msgs "<h4>Messages to $recipient</h4>\n"
+	set last_recipient $recipient
+    }
+    
+    append msgs "<li>$msg\n"
+}
+
+ns_return 200 text/html "[ad_admin_header "Messages By $username"]
+
+<h2>Messages By $username</h2>
+
+[ad_admin_context_bar [list "index.tcl" "Chat System"] "Messages By $username"]
+
+<hr>
+
+<ul>
+$msgs
+</ul>
+
+[ad_admin_footer]
+"
Index: web/openacs/www/chat/admin/one-room.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/chat/admin/one-room.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/chat/admin/one-room.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,186 @@
+# one-room.tcl,v 1.3.2.1 2000/02/03 09:20:25 ron Exp
+# File:     admin/chat/one-room.tcl
+# Date:     1998-11-18
+# Contact:  aure@arsdigita.com,philg@mit.edu, ahmeds@arsdigita.com
+# Purpose:  shows one chat room
+
+set_the_usual_form_variables
+# chat_room_id
+
+set db [ns_db gethandle]
+
+if { [database_to_tcl_string $db "select count(*) from chat_rooms where chat_room_id = $chat_room_id"] == 0 } {
+    ad_return_error "Not Found" "Could not find chat_room $chat_room_id"
+    return
+}
+
+set selection [ns_db 1row $db "
+    select pretty_name, scope, group_id, expiration_days, active_p, moderated_p
+    from chat_rooms
+    where chat_room_id = $chat_room_id "]
+
+set_variables_after_query
+
+ad_scope_error_check
+
+ad_scope_authorize $db $scope admin group_admin none
+
+if { $scope=="group" } {
+    set short_name [database_to_tcl_string $db "select short_name
+                                                from user_groups
+                                                where group_id = $group_id"]    
+}
+
+if { $scope == "public" } {
+    set userpage_url_string "/chat/chat.tcl?chat_room_id=$chat_room_id&scope=$scope"
+} else {
+    set userpage_url_string "/groups/$short_name/chat/chat.tcl?chat_room_id=$chat_room_id&scope=$scope&group_id=$group_id" 
+}
+
+
+ReturnHeaders 
+
+ns_write "
+
+[ad_scope_admin_header "$pretty_name" $db]
+[ad_scope_admin_page_title $pretty_name $db]
+[ad_scope_admin_context_bar [list "index.tcl" Chat] "One Room"]
+
+<hr>
+
+User page:  <a href=\"$userpage_url_string\">$userpage_url_string</a>
+
+
+"
+
+if [empty_string_p $expiration_days] {
+    set n_expired_msgs 0
+    set expired_select_item ""
+} else {
+    set expired_select_item ", sum(case when sysdate() > (creation_date + timespan_days($expiration_days)) then 1 else 0 end) as n_expired_msgs"
+}
+
+set selection [ns_db 1row $db "select min(creation_date) as min_date, max(creation_date) as max_date, count(*) as n_messages, count(distinct creation_user) as n_users $expired_select_item
+from chat_msgs
+where chat_room_id = $chat_room_id"]
+
+set_variables_after_query
+
+ns_write "
+<ul>
+<li>oldest message:  $min_date
+<li>newest message:  $max_date
+<li>total messages: $n_messages (from $n_users distinct users)
+</ul>
+
+<h3>Properties</h3>
+
+<form action=\"edit-room.tcl\" method=post>
+[export_form_scope_vars chat_room_id]
+<table>
+<tr>
+    <td align=right>Room Name:</td>
+    <td><input name=pretty_name size=35 value=\"[philg_quote_double_quotes $pretty_name]\"></td>
+</tr>
+   <tr>
+    <td align=right>Expire messages after</td>
+    <td><input type=text name=expiration_days value=\"$expiration_days\" size=4> days (or leave blank to archive messages indefinitely)</td>
+</tr>
+<tr>
+    <td align=right>Active?</td>
+    <td><select name=active_p>
+"
+if {$active_p=="t"} {
+    ns_write "
+    <option value=f>No</option>
+    <option value=t selected>Yes</option>
+    "
+} else {
+    ns_write "
+    <option value=f selected>No</option>
+    <option value=t>Yes</option>
+    "
+}
+
+ns_write "
+</select>
+</td>
+</tr>
+<tr>
+<td align=right>Moderation Policy:</td>
+    <td><select name=moderated_p>
+"
+if {$moderated_p=="t"} {
+    ns_write "
+    <option value=f>Unmoderated</option>
+    <option value=t selected>Moderated</option>
+    "
+} else {
+    ns_write "
+    <option value=f selected>Unmoderated</option>
+    <option value=t>Moderated</option>
+    "
+}
+
+ns_write "
+</select>
+</td>
+<tr><td></td><td><input type=submit value=Update></td></tr>
+</table>
+</form>
+<!-- <h3>Moderators</h3> -->
+"
+
+# set group_id [ad_administration_group_id $db chat $chat_room_id]
+# set selection [ns_db select $db "select users.user_id as moderator_id, first_names, last_name
+# from users, user_group_map
+# where group_id=$group_id 
+# and users.user_id = user_group_map.user_id"]
+
+#set moderators ""
+#while {[ns_db getrow $db $selection]} {
+#    set_variables_after_query
+#    lappend moderators "<a href=\"/admin/users/one.tcl?user_id=$moderator_id\">$first_names $last_name</a>"
+#}
+
+#set moderators [join $moderators ", "]
+
+#if {[empty_string_p $moderators]} {
+#    set moderators "none"
+#}
+
+#ns_write "
+#Current Moderator(s):
+#$moderators
+#
+#<center>
+#<form method=GET action=\"/admin/ug/group.tcl\">
+#[export_form_scope_vars]
+#<input type=submit value=\"Add/Remove Moderators\">
+#</form>
+#</center>
+#
+#<h3>Extreme Actions</h3>
+#<ul>
+#"
+
+if { $n_expired_msgs > 0 } {
+    ns_write "<li> <a href=expire-messages.tcl?[export_url_scope_vars chat_room_id]>Deleted expired messages</a> ($n_expired_msgs)\n"
+}
+
+ns_write "
+<li> <a href=delete-messages.tcl?[export_url_scope_vars chat_room_id]>Delete all messages from this room</a>
+
+<li><a href=delete-room.tcl?[export_url_scope_vars chat_room_id]>Delete this room</a>
+</ul>
+
+[ad_scope_admin_footer]
+"
+
+
+
+
+
+
+
+
Index: web/openacs/www/comments/add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/comments/add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/comments/add.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,51 @@
+# add.tcl,v 3.0 2000/02/06 03:37:09 ron Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_form_variables
+# page_id
+
+validate_integer page_id $page_id
+
+set db [ns_db gethandle]
+
+# page information
+# if there is no title, we use the url stub
+# if there is no author, we usre the system administrator
+
+set selection [ns_db 1row $db "select  coalesce(page_title,url_stub) as page_title, url_stub, coalesce(user_email(original_author),'[ad_system_owner]') as email,
+user_full_name(original_author) as name
+from static_pages
+where page_id = $page_id"]
+set_variables_after_query
+ns_db releasehandle $db
+
+ns_return 200 text/html "[ad_header "Add a comment to $page_title" ]
+
+<h2>Add a comment</h2>
+
+to <a href=\"$url_stub\">$page_title</a>
+<hr>
+I just want to say whether I liked this page or not:
+<a href=\"rating-add.tcl?page_id=$page_id\">Add a rating</a>.
+<p>
+
+I have an alternative perspective to contribute that
+will be of interest to other readers of this page two or three years
+from now:  <a href=\"persistent-add.tcl?page_id=$page_id\">Add a persistent comment</a>.
+
+<p>
+
+This page did not answer a question I expected it to answer: <a href=\"question-ask.tcl?page_id=$page_id\">Ask a question</a>.
+
+<p>
+
+I just want to send some email: <a
+href=\"mailto:$email\">Send email to author or maintainer</a>.
+
+[ad_footer]
+"
+
+
Index: web/openacs/www/comments/comment-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/comments/comment-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/comments/comment-add.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,179 @@
+# comment-add.tcl,v 3.0 2000/02/06 03:37:11 ron Exp
+#
+# comment-add.tcl
+#
+# by teadams@mit.edu in mid-1998
+#
+# enhanced by philg@mit.edu January 21, 2000
+# to check for naughty HTML
+# 
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+
+validate_integer page_id $page_id
+
+# page_id, message, comment_type, page_id, comment_id
+# maybe rating, maybe html_p
+
+if { [info exists html_p] && $html_p == "t" && ![empty_string_p [ad_check_for_naughty_html $message]] } {
+    ad_return_complaint 1 "<li>[ad_check_for_naughty_html $message]\n"
+    return
+}
+
+set originating_ip [ns_conn peeraddr]
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+set already_submitted_p 0
+
+if [catch { ns_db dml $db "insert into comments
+(comment_id,page_id, user_id, comment_type, message, rating, originating_ip, posting_time, html_p)
+values ($comment_id,$page_id, $user_id, '$QQcomment_type', '[DoubleApos $message]', '[export_var rating]', '$originating_ip', sysdate(), [db_postgres_null_sql [export_var html_p]]) " } errmsg] {
+
+    if { [database_to_tcl_string $db "select count(comment_id) from comments where comment_id = $comment_id"] > 0 } {
+	# the comment was already there; user must have double clicked
+	set already_submitted_p 1
+    } else {
+	# there was some other error with the comment insert
+	ad_return_error "Error in inserting comment" " There was an 
+error in inserting your comment into the database.
+Here is what the database returned:
+<p>
+<pre>
+$errmsg
+</pre>
+
+Don't quit your browser. The database may just be busy.
+You might be able to resubmit your posting five or ten minutes from now.
+"
+    return
+    }
+}   
+
+# comment is submitted, find out the page information
+# if there is no title, we use the url stub
+# if there is no author, we use the system owner
+
+set selection [ns_db 1row $db "select coalesce(page_title,url_stub) as page_title, url_stub,  coalesce(user_email(original_author),'[ad_system_owner]') as author_email
+from static_pages
+where page_id = $page_id"]
+
+set_variables_after_query
+
+set selection [ns_db 1row $db "select first_names || ' ' || last_name as name, email from users where user_id = $user_id"]
+set_variables_after_query	    
+
+ns_db releasehandle $db
+
+switch $comment_type {
+	
+    "unanswered_question" {
+	set subject  "question about $url_stub" 
+	set email_body  "
+$name ($email) asked a question about
+[ad_url]$url_stub
+($page_title):
+		
+QUESTION: 
+
+[wrap_string $message]
+"
+        set confirm_body "Your question, as appears below, has been recorded and will be considered for page modifications or new site content."
+    }
+    
+    "alternative_perspective" {
+	set subject "comment on $url_stub"  
+	set email_body "
+$name ($email) gave an alternative perspective on
+[ad_url]$url_stub
+($page_title):
+		
+[wrap_string $message]
+"
+        set confirm_body "Your comment, as it appears below, has been added and will be seen as part of the <a href=\"$url_stub\">$page_title</a> page."
+     }
+		
+     "rating" {
+	 set subject  "$url_stub rated $rating"
+	 set email_body  "
+$name ($email) rated
+[ad_url]$url_stub
+($page_title)
+	     
+RATING: $rating
+
+[wrap_string $message]
+"
+         set confirm_body "Your rating of \"<b>$rating</b>\" has been submitted along with the comment below and will be considered for page modifications or new site content."
+    }
+}
+
+if { [info exists html_p] && $html_p == "t" } {
+    set message_for_presentation $message
+} else {
+    set message_for_presentation [util_convert_plaintext_to_html $message]
+}
+
+
+ns_return 200 text/html "[ad_header "Comment submitted"]
+
+<h2>Comment submitted</h2>
+
+to <a href=\"$url_stub\">$page_title</a>
+
+<hr> 
+$confirm_body
+<p>
+<blockquote>
+$message_for_presentation
+</blockquote>
+<p>
+Return to  <a href=\"$url_stub\">$page_title</a>
+
+<P>
+
+Alternatively, you can attach a
+file to your comment.  This file can be a document, a photograph, or
+anything else on your desktop computer.
+
+<form enctype=multipart/form-data method=POST action=\"upload-attachment.tcl\">
+[export_form_vars comment_id url_stub]
+<blockquote>
+<table>
+<tr>
+<td valign=top align=right>Filename: </td>
+<td>
+<input type=file name=upload_file size=20><br>
+<font size=-1>Use the \"Browse...\" button to locate your file, then click \"Open\".</font>
+</td>
+</tr>
+<tr>
+<td valign=top align=right>Caption</td>
+<td><input size=30 name=caption>
+<br>
+<font size=-1>(leave blank if this isn't a photo)</font>
+</td>
+</tr>
+</table>
+<p>
+<center>
+<input type=submit value=\"Upload\">
+</center>
+</blockquote>
+</form>
+
+[ad_footer]"
+
+
+# Send the author email if necessary
+
+if { [send_author_comment_p $comment_type add] && !$already_submitted_p } {
+    # send email if necessary    
+    catch { ns_sendmail $author_email $email $subject $email_body }
+}
Index: web/openacs/www/comments/comment-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/comments/comment-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/comments/comment-delete.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,45 @@
+# comment-delete.tcl,v 3.0 2000/02/06 03:37:12 ron Exp
+ad_page_variables {
+    comment_id
+    page_id 
+    submit
+}
+
+validate_integer "comment_id" $comment_id
+validate_integer "page_id" $page_id
+
+# comment_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select url_stub,coalesce(page_title, url_stub) as page_title
+from static_pages
+where static_pages.page_id = $page_id"]
+
+set_variables_after_query
+
+if { [regexp -nocase "delete" $submit] } {
+ 
+    #user would like to delete
+
+    ns_db dml $db "delete from comments where comment_id=$comment_id"
+   
+    ns_return 200 text/html "[ad_header "Comment Deleted"]
+    
+<h2>Comment Deleted</h2>
+
+<hr>
+<p>
+Return to  <a href=\"$url_stub\">$page_title</a>
+<p>
+[ad_footer]"
+return
+
+} else {
+    # user would like to cancel
+    ns_returnredirect $url_stub
+    return
+}
+
+
+
Index: web/openacs/www/comments/comment-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/comments/comment-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/comments/comment-edit.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,131 @@
+# comment-edit.tcl,v 3.0 2000/02/06 03:37:14 ron Exp
+#
+# /comments/comment-edit.tcl
+# 
+# by teadams@mit.edu in mid-1998
+#
+# actually updates the comments table (comments on static pages)
+#
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+set_the_usual_form_variables
+
+validate_integer page_id $page_id
+validate_integer comment_id $comment_id
+
+# page_id, message, comment_type, comment_id
+# maybe rating, maybe html_p
+
+if { [info exists html_p] && $html_p == "t" && ![empty_string_p [ad_check_for_naughty_html $message]] } {
+    ad_return_complaint 1 "<li>[ad_check_for_naughty_html $message]\n"
+    return
+}
+
+# get the user_id
+set user_id [ad_verify_and_get_user_id]
+set db [ns_db gethandle]
+
+if [catch { ns_db dml $db "update  comments set  message = '[DoubleApos $message]', rating='[export_var rating]', posting_time = sysdate(), html_p=[db_postgres_null_sql [export_var html_p]] where comment_id = $comment_id  and user_id=$user_id" } errmsg] {
+	# there was an error with the comment update
+	ad_return_error "Error in updating comment" "
+There was an error in updating your comment in the database.
+Here is what the database returned:
+<p>
+<pre>
+$errmsg
+</pre>
+
+Don't quit your browser. The database may just be busy.
+You might be able to resubmit your posting five or ten minutes from now."
+
+}
+
+# page information
+# if there is no title, we use the url stub
+# if there is no author, we use the system owner
+
+set selection [ns_db 1row $db "select coalesce(page_title,url_stub) as page_title, url_stub,  coalesce(user_email(original_author),'[ad_system_owner]') as author_email
+from static_pages
+where page_id = $page_id"]
+
+set_variables_after_query
+
+set selection [ns_db 1row $db "select first_names || ' ' || last_name as name, email from users where user_id = $user_id"]
+set_variables_after_query
+ns_db releasehandle $db
+
+switch $comment_type {
+	
+    "unanswered_question" {
+	set subject  "edited question about $url_stub" 
+	set email_body  "
+$name ($email) edited a question about 
+[ad_url]$url_stub
+($page_title):
+		
+QUESTION: 
+
+[wrap_string $message]
+"
+        set confirm_body "Your modified question, as it appears below, has been recorded and will be considered for page modifications or new site content."
+    }
+    
+    "alternative_perspective" {
+	set subject "edited comment on $url_stub"
+	set email_body "$name ($email) edited an alternative perspective on
+[ad_url]$url_stub
+($page_title):
+		
+[wrap_string $message]
+"
+        set confirm_body "Your modified comment, as it appears below, has been added and will be seen as part of the <a href=\"$url_stub\">$page_title</a> page."
+     }
+		
+     "rating" {
+	 set subject  "modified rating for $url_stub (to $rating)"  
+	 set email_body  "
+$name ($email) modified rating of
+[ad_url]$url_stub
+($page_title)
+	     
+RATING: $rating
+
+[wrap_string $message]
+"
+         set confirm_body "Your modified rating of <b>$rating</b> has been submitted along with the comment below and will be considered for page modifications or new site content."
+    }
+}
+
+if { [info exists html_p] && $html_p == "t" } {
+    set message_for_presentation $message
+} else {
+    set message_for_presentation [util_convert_plaintext_to_html $message]
+}
+
+ns_return 200 text/html "[ad_header "Comment modified"]
+
+<h2>Comment modified</h2>
+
+on  <a href=\"$url_stub\">$page_title</a>.
+
+<hr> 
+$confirm_body
+<p>
+<blockquote>
+$message_for_presentation
+</blockquote>
+<p>
+Return to  <a href=\"$url_stub\">$page_title</a>
+[ad_footer]"
+
+# Send the author email is necessary
+
+if [send_author_comment_p $comment_type "edit"] {
+    # send email if necessary    
+    catch { ns_sendmail $author_email $email $subject $email_body }
+}
Index: web/openacs/www/comments/for-one-page.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/comments/for-one-page.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/comments/for-one-page.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,101 @@
+# for-one-page.tcl,v 3.0 2000/02/06 03:37:15 ron Exp
+#
+# /comments/for-one-page.tcl
+#
+# by philg@mit.edu back in mid-1998
+#
+# displays all the comments associated with a particular .html page
+# 
+
+set_the_usual_form_variables
+
+validate_integer page_id $page_id
+
+# url_stub or page_id
+
+set user_id [ad_get_user_id]
+set db [ns_db gethandle]
+
+if { [info exists page_id] && ![empty_string_p $page_id] } {
+    set selection [ns_db 0or1row $db "select coalesce(page_title,url_stub) as page_title, url_stub 
+from static_pages 
+where page_id = $page_id
+and accept_comments_p = 't'"]
+} else {
+    set selection [ns_db 0or1row $db "select page_id, coalesce(page_title,url_stub) as page_title, url_stub 
+from static_pages where url_stub = '$QQurl_stub'
+and accept_comments_p = 't'"]
+}
+
+if { $selection == "" } {
+    # this page isn't registered in the database 
+    # or comments are not allowed so we can't
+    # accept comments on it or anything
+
+    ns_return 200 text/html "[ad_header "Can not accept comments."]
+
+<h3> Can not accept comments </h3>
+
+for this page.
+
+<hr>
+
+This <a href =\"/\">[ad_system_name]</a> page is not set up to accept comments.
+
+[ad_footer]"
+    ns_log Notice "Someone grabbed $url_stub but we weren't able to offer for-one-page.tcl because this page isn't registered in the db"
+    return    
+}
+
+# there was a commentable page in the database
+set_variables_after_query
+
+ReturnHeaders
+ns_write "[ad_header "Reader's comments on $page_title"]
+
+<h3>Reader's Comments</h3>
+
+on <a href=\"$url_stub\">$page_title</a>
+
+<hr>"
+
+set selection [ns_db select $db "select comments.comment_id, comments.page_id, comments.user_id as poster_user_id, users.first_names || ' ' || users.last_name as user_name, message, posting_time, html_p
+from static_pages sp, comments_not_deleted comments, users
+    where sp.page_id = comments.page_id
+and comments.user_id = users.user_id
+and comments.page_id = $page_id
+and comments.comment_type = 'alternative_perspective'
+order by posting_time"]
+
+set at_least_one_comment_found_p 0
+
+set comment_bytes ""
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    set at_least_one_comment_found_p 1
+    append comment_bytes "<blockquote>
+[util_maybe_convert_to_html $message $html_p]
+<br><br>
+    "
+    if { $user_id == $poster_user_id} {
+	# the user wrote the message, so let him/her edit it
+	append comment_bytes  "-- <A HREF=\"/shared/community-member.tcl?user_id=$poster_user_id\">$user_name</a> 
+(<A HREF=\"/comments/persistent-edit.tcl?comment_id=$comment_id\">edit your comment</a>)
+"
+    } else {
+	# the user did not write it, link to the community_member page
+	append comment_bytes "-- <A HREF=\"/shared/community-member.tcl?user_id=$poster_user_id\">$user_name</a>"
+    }
+    append comment_bytes ", [util_AnsiDatetoPrettyDate $posting_time]\n</blockquote>\n"
+}
+
+ns_db releasehandle $db
+ns_write $comment_bytes
+
+if !$at_least_one_comment_found_p {
+	ns_write "<p>There have been no comments so far on this page.\n"
+}
+
+ns_write "<center>
+<a href=\"/comments/add.tcl?[export_url_vars page_id]\">Add a comment</a>
+</center>"
Index: web/openacs/www/comments/image-attachment.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/comments/image-attachment.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/comments/image-attachment.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,44 @@
+# image-attachment.tcl,v 3.0 2000/02/06 03:37:16 ron Exp
+# Present a pretty page with caption and image info with an IMG tag.
+# This page should only get called for image attachments; any other
+# attachments should be sent directly to 
+# /comments/attachment/[comment_id]/[filename]
+
+# Stolen from general_comments.
+
+set_the_usual_form_variables
+# comment_id
+
+validate_integer comment_id $comment_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select url_stub, coalesce(page_title, url_stub) as page_title, file_type, caption, original_width, original_height, client_file_name, users.user_id, users.first_names, users.last_name, users.email
+from comments, users, static_pages
+where comment_id = $comment_id
+and users.user_id = comments.user_id
+and static_pages.page_id = comments.page_id"]
+
+set_variables_after_query
+
+ns_return 200 text/html "[ad_header "Image Attachment"]
+
+<h2>Image Attachment</h2>
+
+for comment on <a href=\"$url_stub\">$page_title</a>
+
+<hr>
+
+<center>
+<i>$caption</i>
+<p>
+<img src=\"attachment/$comment_id/$client_file_name\" width=$original_width height=$original_height>
+</center>
+
+<hr>
+<a href=\"/shared/community-member.tcl?user_id=$user_id\">$first_names $last_name</a>
+</body>
+</html>
+"
+
+
Index: web/openacs/www/comments/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/comments/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/comments/index.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,55 @@
+# index.tcl,v 3.0 2000/02/06 03:37:17 ron Exp
+set_the_usual_form_variables 0
+
+# optional:  show_page_title_p
+
+set title "Comments by page"
+set and_clause ""
+set order_by "n_comments desc"
+if { [info exists show_page_title_p] && $show_page_title_p } {
+	set options "<a href=\"index.tcl?only_unanswered_questions_p=0&show_page_title=0\">hide page title</a>"
+} else {
+	set options "<a href=\"index.tcl?only_unanswered_questions_p=0&show_page_title_p=1\">show page title</a>"
+}
+
+ReturnHeaders
+
+ns_write "[ad_header $title]
+
+<h2>$title</h2>
+
+in [ad_site_home_link]
+
+<hr>
+
+$options
+
+<ul>
+"
+
+set db [ns_db gethandle]
+
+set selection [ns_db select $db "select static_pages.page_id, page_title, url_stub, count(user_id) as n_comments
+from static_pages, comments_not_deleted comments
+where static_pages.page_id = comments.page_id 
+and comment_type = 'alternative_perspective'
+group by static_pages.page_id, page_title, url_stub
+order by $order_by"]
+
+set items ""
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    
+    append items "<li><A HREF=\"for-one-page.tcl?page_id=$page_id\">$url_stub ($n_comments)</a>\n"
+    if { [info exists show_page_title_p] && $show_page_title_p && ![empty_string_p $page_title]} {
+	append items "-- $page_title\n"
+    }
+}
+
+ns_write $items
+
+ns_write "
+</ul>
+
+[ad_footer]
+"
Index: web/openacs/www/comments/one.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/comments/one.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/comments/one.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,32 @@
+# one.tcl,v 3.0 2000/02/06 03:37:18 ron Exp
+set_form_variables
+# comment_id
+
+validate_integer comment_id $comment_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select coalesce(page_title, 'untitled page') as page_title, p.page_id, message, first_names, last_name, posting_time, c.user_id
+from comments c, static_pages p, users u
+where c.comment_id = $comment_id
+and c.page_id = p.page_id
+and c.user_id = u.user_id"]
+
+set_variables_after_query
+
+ns_return 200 text/html "[ad_header "One Comment"]
+
+<h2>One Comment</h2>
+
+on <a href=\"/search/static-page-redirect.tcl?page_id=$page_id\">$page_title</a>
+
+<hr>
+
+<blockquote>
+$message
+</blockquote>
+
+-- <a href=\"/shared/community-member.tcl?user_id=$user_id\">$first_names $last_name</a> ($posting_time)
+
+[ad_footer]
+"
Index: web/openacs/www/comments/persistent-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/comments/persistent-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/comments/persistent-add-2.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,81 @@
+# persistent-add-2.tcl,v 3.0 2000/02/06 03:37:19 ron Exp
+#
+# /comments/persistent-add-2.tcl
+#
+# written in mid-1998 by teadams@mit.edu
+#
+# enhanced January 21, 2000 by philg@mit.edu 
+# to check for naughty HTML 
+#
+
+set_form_variables
+
+# page_id, message, comment_type,  html_p
+
+validate_integer page_id $page_id
+
+# check for bad input
+if { ![info exists message] || [empty_string_p $message] } {
+    ad_return_complaint 1 "<li>please type a comment!"
+    return
+}
+
+if { $html_p == "t" && ![empty_string_p [ad_check_for_naughty_html $message]] } {
+    ad_return_complaint 1 "<li>[ad_check_for_naughty_html $message]\n"
+    return
+}
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select coalesce(page_title,url_stub) as page_title, url_stub
+from static_pages
+where page_id = $page_id"]
+set_variables_after_query
+
+set whole_page ""
+
+append whole_page "[ad_header "Confirm comment on <i>$page_title</i>" ]
+
+<h2>Confirm comment</h2>
+
+on <a href=\"$url_stub\">$page_title</a>
+<hr>
+
+The following is your comment as it would appear on the page <i>$page_title</i>.
+If it looks incorrect, please use the back button on your browser to return and
+correct it.  Otherwise, press \"Proceed\".
+<p>
+<blockquote>"
+
+if { [info exists html_p] && $html_p == "t" } {
+    append whole_page "$message
+</blockquote>
+<p>
+Note: if the comment has lost all of its paragraph breaks then you
+probably should have selected \"Plain Text\" rather than HTML.  Use
+your browser's Back button to return to the submission form.
+"
+} else {
+    append whole_page "[util_convert_plaintext_to_html $message]
+</blockquote> 
+<p>
+Note: if the comment has a bunch of visible HTML tags then you probably
+should have selected \"HTML\" rather than \"Plain Text\".  Use your
+browser's Back button to return to the submission form. "
+}
+
+set comment_id [database_to_tcl_string $db "select comment_id_sequence.nextval from dual"]
+
+append whole_page "<form action=comment-add.tcl method=post>
+[export_form_vars message comment_type page_id comment_id html_p]
+<center>
+<input type=submit name=submit value=\"Proceed\">
+</center>
+</form>
+
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $whole_page
Index: web/openacs/www/comments/persistent-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/comments/persistent-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/comments/persistent-add.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,45 @@
+# persistent-add.tcl,v 3.0 2000/02/06 03:37:20 ron Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_form_variables
+# page_id
+
+validate_integer page_id $page_id
+
+set user_id [ad_get_user_id]
+if {$user_id == 0} {
+    ns_returnredirect /register.tcl?return_url=[ns_urlencode  /comments/persistent-add.tcl?[export_url_vars page_id]]
+}
+
+set db [ns_db gethandle]
+set selection [ns_db 1row $db "select  coalesce(page_title,url_stub) as page_title, url_stub 
+from static_pages
+where page_id = $page_id"]
+set_variables_after_query
+ns_db releasehandle $db
+
+ns_return 200 text/html "[ad_header "Add a comment to $page_title" ]
+
+<h2>Add a comment</h2>
+to <a href=\"$url_stub\">$page_title</a>
+<hr>
+
+What comment or alternative perspective
+would you like to add to this page?<br>
+<form action=persistent-add-2.tcl method=post>
+[export_form_vars page_id comment_id]
+<textarea name=message cols=70 rows=10 wrap=soft></textarea><br>
+<input type=hidden name=comment_type value=alternative_perspective>
+<br>
+Text above is
+<select name=html_p><option value=f>Plain Text<option value=t>HTML</select>
+<p>
+<center>
+<input type=submit name=submit value=\"Proceed\">
+</center>
+</form>
+[ad_footer]
+"
Index: web/openacs/www/comments/persistent-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/comments/persistent-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/comments/persistent-edit-2.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,124 @@
+# persistent-edit-2.tcl,v 3.0 2000/02/06 03:37:21 ron Exp
+#
+# /comments/persistent-edit-2.tcl
+#
+# by teadams@mit.edu in mid-1998
+#
+# this is a verification page; the real work is 
+# done by comment-edit.tcl (for editing) or
+# comment-delete.tcl (deletion)
+#
+# updated January 22, 2000 by philg@mit.edu
+# to look for naughty HTML
+# 
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_form_variables
+# page_id, message, comment_type, comment_id, submit, html_p
+
+validate_integer page_id $page_id
+validate_integer comment_id $comment_id
+
+# check for bad input
+if { (![info exists message] || [empty_string_p $message]) && [regexp -nocase "delete" $submit] } {
+    ad_return_complaint 1 "<li>please type a comment!"
+    return
+}
+
+if { [info exists html_p] && $html_p == "t" && ![empty_string_p [ad_check_for_naughty_html $message]] } {
+    ad_return_complaint 1 "<li>[ad_check_for_naughty_html $message]\n"
+    return
+}
+
+set db [ns_db gethandle]
+set selection [ns_db 1row $db "select static_pages.url_stub, coalesce(page_title, url_stub) as page_title 
+from static_pages
+where page_id = $page_id"]
+set_variables_after_query
+ns_db releasehandle $db
+
+ReturnHeaders
+
+if { [info exists html_p] && $html_p == "t" } {
+    set pretty_message $message
+} else {
+    set pretty_message [util_convert_plaintext_to_html $message]
+}
+
+if {  [regexp -nocase "delete" $submit] } {
+    #user wants to delete the comment
+    ns_write "[ad_header "Verify comment deletion on <i>$page_title</i>" ]
+
+<h2>Verify comment deletion</h2>
+
+on <a href=\"$url_stub\">$page_title</a>
+<hr>
+
+You have asked to delete the following comment  on the page <i>$page_title</i>.
+<p>
+
+<blockquote>
+$pretty_message
+</blockquote>
+
+<form action=comment-delete.tcl method=post>
+[export_form_vars comment_id page_id]
+<center>
+<input type=submit name=submit value=\"Delete Comment\">
+<input type=submit name=submit value=\"Cancel\">
+</center>
+</form>"
+
+} else {
+    # user wants to edit the comment
+    ns_write "[ad_header "Verify comment on <i>$page_title</i>" ]
+
+<h2>Verify comment</h2>
+
+on <a href=\"$url_stub\">$page_title</a>
+<hr>
+
+The following is your comment as it would appear on the page <i>$page_title</i>.
+If it looks incorrect, please use the back button on your browser to return and
+correct it.  Otherwise, press \"Proceed\".
+<p>
+
+<blockquote>
+$pretty_message
+</blockquote>"
+
+
+    if { [info exists html_p] && $html_p == "t" } {
+	ns_write "<p>
+Note: if the comment has lost all of its paragraph breaks then you
+probably should have selected \"Plain Text\" rather than HTML.  Use
+your browser's Back button to return to the submission form.
+"
+    } else {
+	ns_write "<p>
+Note: if the comment has a bunch of visible HTML tags then you probably
+should have selected \"HTML\" rather than \"Plain Text\".  Use your
+browser's Back button to return to the submission form. "
+    }
+
+    ns_write "
+<form action=comment-edit.tcl method=post>
+[export_form_vars message html_p page_id comment_id]
+<input type=hidden name=comment_type value=alternative_perspective>
+<center>
+<input type=submit name=submit value=\"Proceed\">
+</center>
+</form>"
+}
+
+ns_write "[ad_footer]"
+
+
+
+
+
+
Index: web/openacs/www/comments/persistent-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/comments/persistent-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/comments/persistent-edit.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,59 @@
+# persistent-edit.tcl,v 3.0 2000/02/06 03:37:22 ron Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_form_variables
+# comment_id
+
+validate_integer comment_id $comment_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select comments.comment_id, comments.page_id, comments.message, static_pages.url_stub, coalesce(page_title,  url_stub) as page_title, html_p, user_id as comment_user_id
+from comments, static_pages
+where comments.page_id = static_pages.page_id 
+and comment_id = $comment_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "No comment found"  "Comment $comment_id is not in the database.  Perhaps it was already deleted." 
+    return
+} else {
+    set_variables_after_query
+    ns_db releasehandle $db
+}
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $comment_user_id != $user_id } {
+    ad_return_error "Unauthorized" "You are not allowed to edit a comment you did not enter"
+    return
+}
+
+
+ns_return 200 text/html "[ad_header "Edit comment on $page_title" ]
+
+<h2>Edit comment</h2>
+
+on <a href=\"$url_stub\">$page_title</a>
+<hr>
+
+<form action=persistent-edit-2.tcl method=post>
+[export_form_vars page_id comment_id]
+<input type=hidden name=comment_type value=alternative_perspective>
+Edit your comment or alternative perspective.<br>
+<textarea name=message cols=50 rows=5 wrap=soft>[philg_quote_double_quotes $message]</textarea><br>
+<br>
+Text above is
+<select name=html_p>
+[ad_generic_optionlist {"Plain Text" "HTML"} {"f" "t"} $html_p]
+</select>
+<p>
+<center>
+<input type=submit name=submit value=\"Submit Changes\">
+<input type=submit name=submit value=\"Delete Comment\">
+</center>
+</form>
+[ad_footer]
+"
Index: web/openacs/www/comments/question-ask.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/comments/question-ask.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/comments/question-ask.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,43 @@
+# question-ask.tcl,v 3.0 2000/02/06 03:37:23 ron Exp
+set_form_variables
+
+# page_id
+
+validate_integer page_id $page_id
+
+#check for the user cookie
+set user_id [ad_get_user_id]
+
+if {$user_id == 0} {
+    ns_returnredirect /register.tcl?return_url=[ns_urlencode  /comments/question-ask.tcl?[export_url_vars page_id]] 
+}
+
+set db [ns_db gethandle]
+set selection [ns_db 1row $db "select static_pages.url_stub, coalesce(page_title,  url_stub) as page_title
+from static_pages
+where page_id = $page_id"]
+
+set_variables_after_query
+set comment_id [database_to_tcl_string $db "select comment_id_sequence.nextval from dual"]
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "[ad_header "Document a question about $page_title" ]
+
+<h2>Document a question</h2>
+
+about <a href=\"$url_stub\">about $page_title</a>
+
+<hr>
+What unanswered question were you expecting this page to answer?<br>
+<form action=comment-add.tcl method=post>
+<input type=hidden name=comment_type value=unanswered_question>
+<textarea name=message cols=50 rows=5 wrap=soft></textarea><br>
+[export_form_vars page_id comment_id]
+<p>
+<center>
+<input type=submit name=submit value=\"Proceed\">
+</center>
+</form>
+[ad_footer]
+"
Index: web/openacs/www/comments/rating-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/comments/rating-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/comments/rating-add.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,42 @@
+# rating-add.tcl,v 3.0 2000/02/06 03:37:24 ron Exp
+set_form_variables
+
+# page_id
+
+validate_integer page_id $page_id
+
+# check for the user cookie
+set user_id [ad_get_user_id]
+set rating_list {0 1 2 3 4 5 6 7 8 9 10}
+
+if {$user_id == 0} {
+    ns_returnredirect /register.tcl?return_url=[ns_urlencode  /comments/rating-add.tcl?[export_url_vars page_id]] 
+}
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select static_pages.url_stub, coalesce(page_title,  url_stub) as page_title 
+from static_pages
+where page_id = $page_id"]
+set_variables_after_query
+
+set comment_id [database_to_tcl_string $db "select comment_id_sequence.nextval from dual"]
+ns_db releasehandle $db
+
+ns_return 200 text/html "[ad_header "Rate $page_title" ]
+<h2>Rate</h2>
+<a href=\"$url_stub\">$page_title</a>
+<hr>
+<form action=comment-add.tcl method=post>
+[export_form_vars page_id comment_id]
+Rating:
+<select name=rating>
+[ad_generic_optionlist $rating_list $rating_list]
+</select><p>
+Why did you give it this rating?<br>
+<textarea name=message cols=50 rows=5 wrap=soft></textarea><br>
+<input type=submit name=submit value=\"Submit Rating\">
+<input type=hidden name=comment_type value=rating>
+</form>
+[ad_footer]
+"
Index: web/openacs/www/comments/upload-attachment.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/comments/upload-attachment.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/comments/upload-attachment.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,103 @@
+# upload-attachment.tcl,v 3.0 2000/02/06 03:37:25 ron Exp
+# 
+# upload-attachment.tcl
+#
+# by jsc@arsdigita.com on September 8, 1999, stolen
+# from the general comments version.
+#
+# adds (or replaces) an attachment to a comment
+# 
+
+set_the_usual_form_variables
+
+# comment_id, url_stub, caption plus upload_file as a multipart file upload
+
+validate_integer comment_id $comment_id
+
+# let's first check to see if this user is authorized to attach
+
+set db [ns_db gethandle]
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set comment_owner_id [database_to_tcl_string $db "select user_id from comments where comment_id = $comment_id"]
+
+if { $user_id != $comment_owner_id } {
+    ad_return_error "Unauthorized" "Ouch.  We think that you're not authorized to attach a file to this comment.  Unless you've been playing around with the HTML, this is probably our programming bug."
+    return
+}
+
+# user is authorized
+
+set exception_text ""
+set exception_count 0
+
+if { ![info exists upload_file] || [empty_string_p $upload_file] } {
+    append exception_text "<li>Please specify a file to upload\n"
+    incr exception_count
+} else {
+    # this stuff only makes sense to do if we know the file exists
+    set tmp_filename [ns_queryget upload_file.tmpfile]
+
+    set file_extension [string tolower [file extension $upload_file]]
+
+    # remove the first . from the file extension
+    regsub {\.} $file_extension "" file_extension
+
+    set guessed_file_type [ns_guesstype $upload_file]
+
+    set n_bytes [file size $tmp_filename]
+
+    # strip off the C:\directories... crud and just get the file name
+    if ![regexp {([^/\\]+)$} $upload_file match client_filename] {
+	# couldn't find a match
+	set client_filename $upload_file
+    }
+
+    if { ![empty_string_p [ad_parameter MaxAttachmentSize "comments"]] && $n_bytes > [ad_parameter MaxAttachmentSize "comments"] } {
+	append exception_text "<li>Your file is too large.  The publisher of [ad_system_name] has chosen to limit attachments to [util_commify_number [ad_parameter MaxAttachmentSize "comments"]] bytes.\n"
+	incr exception_count
+    }
+
+    if { $n_bytes == 0 } {
+	append exception_text "<li>Your file is zero-length. Either you attempted to upload a zero length file, a file which does not exist, or something went wrong during the transfer.\n"
+	incr exception_count
+    }
+}
+
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+set what_aolserver_told_us ""
+if { $file_extension == "jpeg" || $file_extension == "jpg" } {
+    catch { set what_aolserver_told_us [ns_jpegsize $tmp_filename] }
+} elseif { $file_extension == "gif" } {
+    catch { set what_aolserver_told_us [ns_gifsize $tmp_filename] }
+}
+
+# the AOLserver jpegsize command has some bugs where the height comes 
+# through as 1 or 2 
+if { ![empty_string_p $what_aolserver_told_us] && [lindex $what_aolserver_told_us 0] > 10 && [lindex $what_aolserver_told_us 1] > 10 } {
+    set original_width [lindex $what_aolserver_told_us 0]
+    set original_height [lindex $what_aolserver_told_us 1]
+} else {
+    set original_width ""
+    set original_height ""
+}
+
+ns_ora blob_dml_file $db "update comments 
+set attachment = empty_blob(),
+    client_file_name = '[DoubleApos $client_filename]',
+    file_type = '[DoubleApos $guessed_file_type]',
+    file_extension = '[DoubleApos $file_extension]',
+    caption = '$QQcaption',
+    original_width = [ns_dbquotevalue $original_width number],
+    original_height = [ns_dbquotevalue $original_height number]
+where comment_id = $comment_id
+returning attachment into :1" $tmp_filename
+
+ns_returnredirect $url_stub
Index: web/openacs/www/contest/entry-form.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/contest/entry-form.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/contest/entry-form.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,113 @@
+# entry-form.tcl,v 3.5 2000/03/12 20:01:33 markd Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+
+# either domain_id or domain (for backwards compatibitility)
+
+set db [ns_db gethandle]
+
+if { ![info exists domain_id] && [info exists domain] } {
+    set domain_id [database_to_tcl_string_or_null $db "select domain_id from contest_domains where domain='$QQdomain'"]
+    set QQdomain_id [DoubleApos $domain_id]
+}
+
+
+# test for integrity
+
+if { [empty_string_p $domain_id] } {
+    ad_return_error "Serious problem with the previous form" "Either the previous form didn't say which of the contests in [ad_site_home_link]
+or the domain_id variable was set wrong or something."
+    return
+}
+
+
+set user_id [ad_get_user_id]
+
+if {$user_id == 0} {
+   ns_returnredirect "/register.tcl?return_url=[ns_urlencode "/contest/entry-form.tcl?[export_url_vars domain_id domain]"]"
+    return
+}
+
+
+# get out variables to create entry form
+
+set selection [ns_db 0or1row $db "select cd.*, users.email as maintainer_email
+from contest_domains cd, users
+where domain_id = '$QQdomain_id'
+and cd.maintainer = users.user_id"]
+
+if { $selection == "" } {
+    ad_return_error "Failed to find contest" "We couldn't find a contest with a domain_id of \"$domain_id\"."
+    return
+}
+set_variables_after_query
+
+set the_page "[ad_header $pretty_name]
+
+<h2>$pretty_name</h2>
+
+in [ad_site_home_link]
+
+<hr>
+
+$blather
+
+
+
+<center>
+<h2>Enter Contest</h2>
+
+<form method=POST action=\"process-entry.tcl\">
+[export_form_vars domain_id]
+
+"
+
+set selection [ns_db select $db "select * from contest_extra_columns where domain_id = '$QQdomain_id'"]
+set n_rows_found 0
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    incr n_rows_found
+ 
+    if { $column_type == "boolean" } {
+ 	append table_rows "<tr><th>$column_pretty_name<td>
+	<select name=$column_actual_name>
+	<option value=\"t\">Yes
+	<option value=\"f\">No
+	</select>"
+    } else {
+ 	append table_rows "<tr><th>$column_pretty_name<td><input type=text name=$column_actual_name size=30>"
+    }
+    
+    if [regexp -nocase {not null} $column_extra_sql] {
+	append table_rows " &nbsp; (required)"
+    }
+    append table_rows "</tr>\n"
+}
+
+if { $n_rows_found != 0 } {
+    append the_page "<table>\n$table_rows\n</table>\n"
+}
+
+append the_page "
+
+<p>
+
+<center>
+<input type=submit value=\"Submit Entry\">
+</center>
+</form>
+
+</center>
+
+[ad_footer $maintainer_email]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $the_page
+
Index: web/openacs/www/contest/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/contest/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/contest/index.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,39 @@
+# index.tcl,v 3.2 2000/03/10 20:00:54 markd Exp
+
+set the_page "[ad_header "All [ad_system_name] Contests"]
+
+<h2>Contests</h2>
+
+at [ad_site_home_link]
+
+<hr>
+
+<ul>
+"
+
+set db [ns_db gethandle]
+
+set selection [ns_db select $db "select domain_id, home_url, pretty_name
+from contest_domains
+where sysdate() between start_date and end_date
+order by upper(pretty_name)"]
+
+set counter 0
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter 
+    append the_page "<li><a href=\"entry-form.tcl?[export_url_vars domain_id]\">$pretty_name</a>\n"
+}
+
+if { $counter == 0 } {
+    append the_page "there are no live contests at present"
+}
+
+append the_page "</ul>
+
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $the_page
Index: web/openacs/www/contest/process-entry.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/contest/process-entry.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/contest/process-entry.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,107 @@
+# process-entry.tcl,v 3.3 2000/03/10 20:59:02 markd Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+
+# domain_id then possibly a bunch of user-defined stuff 
+
+set db [ns_db gethandle]
+
+if { ![info exists domain_id] && [info exists domain] } {
+    set domain_id [database_to_tcl_string_or_null $db "select domain_id from contest_domains where domain='$QQdomain'"]
+    set QQdomain_id [DoubleApos $domain_id]
+}
+
+# test for integrity
+
+if { ![info exists domain_id] || $domain_id == "" || [set selection [ns_db 0or1row $db "select * from contest_domains where domain_id = '$QQdomain_id'"]] == "" } {
+    ad_return_error "Serious problem with the previous form" "Either the previous form didn't say which of the contests in [ad_site_home_link]
+or the domain_id variable
+was set wrong or something."
+    return
+}
+
+set user_id [ad_get_user_id]
+
+if {$user_id == 0} {
+   ns_returnredirect "/register.tcl?return_url=[ns_urlencode "/contest/entry-form.tcl?[export_url_vars domain_id]"]"
+    return
+}
+
+# if we got here, that means there was a domain_id in the database
+# matching the input
+
+set_variables_after_query
+
+set exception_text ""
+set exception_count 0
+
+# put in some from the user-defined forms maybe
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# if we got here, it means that the user input mostly checked
+
+# we have to add the entry_date and user_id to the ns_set 
+
+ns_set put [ns_conn form] entry_date [database_to_tcl_string $db "select sysdate from dual"]
+ns_set put [ns_conn form] user_id $user_id
+
+# we have to take out domain because we used it to figure out which table
+
+ns_set delkey [ns_conn form] domain_id
+ns_set delkey [ns_conn form] domain
+
+set sql [util_prepare_insert_no_primary_key $db $entrants_table_name [ns_conn form]]
+
+if [catch { ns_db dml $db $sql } errmsg] {
+    ad_return_error "Problem Adding Entry" "The database didn't accept your insert.
+
+<p>
+
+Here was the message:
+<blockquote>
+<pre>
+$errmsg
+</pre>
+</blockquote>"} else {
+    # insert was successful 
+    if { ![empty_string_p $post_entry_url] } {
+	ns_returnredirect $post_entry_url
+    } else {
+	# no custom page
+	set the_page "[ad_header "Entry Successful"]
+
+<h2>Entry Successful</h2>
+to  <a href=\"$home_url\">$pretty_name</a>
+<hr>
+
+The information that you typed has been recorded in the database.
+Note that while this software will be happy to accept further
+submissions from you, in the end winners are chosen from
+<em>distinct</em> entrants.  For example, if the drawing is held
+monthly, entering N more times during the same month will not improve
+your odds of winning a prize.  You'd have to wait until the next month
+to enter again if you want your entry to have any effect.
+"
+       set maintainer_email [database_to_tcl_string $db "select email from users where user_id = $maintainer"]
+       append the_page [ad_footer $maintainer_email]
+       ns_return 200 text/html $the_page
+    }
+    # insert worked but we might still have to send email
+    ns_conn close
+    # we've closed the connection, so user isn't waiting
+    if { $notify_of_additions_p == "t" } {
+	# maintainer says he wants to know
+	# wrap in a catch so that a mailer problem doesn't result in user seeing an error
+	set selection [ns_db 1row $db "select email as user_email, first_names || ' ' || last_name as name from users where user_id = $user_id"]
+	set_variables_after_query
+	catch { ns_sendmail $maintainer_email $user_email "$user_email ($name) entered the $domain contest"  "$user_email ($name) entered the $domain contest" }
+    }
+}
Index: web/openacs/www/curriculum/clickthrough.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/curriculum/clickthrough.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/curriculum/clickthrough.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,40 @@
+# clickthrough.tcl,v 3.0 2000/02/06 03:37:33 ron Exp
+#
+# /www/curriculum/clickthrough.tcl 
+#
+# by philg@mit.edu on October 6, 1999
+#
+# records the user's action in clicking on an element in the curriculum 
+# bar
+# 
+# updates the user's curriculum bar cookie and then redirects
+# if the user is logged in, adds a row to the user_curriculum_map table
+
+set_the_usual_form_variables
+
+# curriculum_element_id
+
+validate_integer curriculum_element_id $curriculum_element_id
+
+set db [ns_db gethandle]
+
+set destination_url [database_to_tcl_string $db "select url from curriculum where curriculum_element_id = $curriculum_element_id"]
+
+set cookie [ns_set get [ns_conn headers] Cookie]
+if { [regexp {CurriculumProgress=([^;]+)} $cookie {} input_cookie] } {
+    set new_cookie_value [curriculum_progress_cookie_value $input_cookie $curriculum_element_id]
+    ns_set put [ns_conn outputheaders] "Set-Cookie" "CurriculumProgress=$new_cookie_value; path=/; expires=Fri, 01-Jan-2010 01:00:00 GMT"
+}
+
+set user_id [ad_get_user_id]
+
+if { $user_id != 0 } {
+    ns_db dml $db "insert into user_curriculum_map (user_id, curriculum_element_id, completion_date)
+select $user_id, $curriculum_element_id, sysdate
+from dual
+where not exists (select 1 from user_curriculum_map 
+                  where user_id = $user_id
+                  and curriculum_element_id = $curriculum_element_id)"
+}
+
+ns_returnredirect $destination_url
Index: web/openacs/www/curriculum/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/curriculum/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/curriculum/index.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,79 @@
+# index.tcl,v 3.0 2000/02/06 03:37:35 ron Exp
+# /curriculum/index.tcl
+#
+# by philg@mit.edu on October 6, 1999
+#
+# explains to the user why the publisher has established
+# a curriculum and offers links to all the elements
+
+if { [ad_get_user_id] != 0 } {
+    set new_cookie [curriculum_sync]
+    if ![empty_string_p $new_cookie] {
+	ns_set put  [ns_conn outputheaders] "Set-Cookie" "CurriculumProgress=$new_cookie; path=/; expires=Fri, 01-Jan-2010 01:00:00 GMT"
+    }
+}
+
+# don't cache this page in case user is coming back here to check
+# progress bar 
+ReturnHeadersNoCache
+
+ns_write "[ad_header "Curriculum" ]
+
+<h2>Curriculum</h2>
+
+[ad_context_bar_ws_or_index "Curriculum"]
+
+<hr>
+
+The publisher of [ad_system_name] has decided that new users wanting
+to improve their skills ought to read the following items:
+
+<ol>
+
+"
+
+set db [ns_db gethandle]
+
+set selection [ns_db select $db "select curriculum_element_id, one_line_description, full_description
+from curriculum
+order by element_index"] 
+
+set counter 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    incr counter
+    append items "<li><a href=\"clickthrough.tcl?[export_url_vars curriculum_element_id]\">$one_line_description</a>\n"
+    if ![empty_string_p $full_description] {
+	append items "<blockquote><font size=-1>$full_description</font></blockquote>\n"
+    }
+}
+
+if { $counter == 0 } {
+    ns_write "<li>There are no curriculum elements in the database right now.<p>"
+} else {
+    ns_write $items
+}
+
+ns_write "
+
+</ol>
+
+The curriculum bar at the bottom of each page shows what you've read.
+Once you've gotten through all items, the bar will disappear (i.e.,
+you've graduated).  How does the server know?  Your progress is kept
+in a browser cookie.  So if you use this service from a friend's
+computer, your progress won't be recorded unless you've logged in.
+
+<p>
+
+Options:
+
+<ul>
+<li><a href=\"start-over.tcl\">start over</a> (erase history)
+
+</ul>
+
+<p>
+
+
+[ad_footer]"
Index: web/openacs/www/curriculum/start-over.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/curriculum/start-over.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/curriculum/start-over.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,21 @@
+# start-over.tcl,v 3.0 2000/02/06 03:37:36 ron Exp
+#
+# /curriculum/start-over.tcl
+#
+# by philg@mit.edu on October 7, 1999
+#
+# erases curriculum history cookie and also deletes from database
+# 
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id != 0 } {
+    set db [ns_db gethandle] 
+    ns_db dml $db "delete from user_curriculum_map where user_id = $user_id"
+    ns_db releasehandle $db
+}
+
+# write the "start" cookie
+ns_set put [ns_conn outputheaders] "Set-Cookie" "CurriculumProgress=[curriculum_progress_cookie_value]; path=/; expires=Fri, 01-Jan-2010 01:00:00 GMT"
+
+ns_returnredirect "index.tcl"
Index: web/openacs/www/custom-sections/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/custom-sections/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/custom-sections/index.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,91 @@
+# index.tcl,v 3.0 2000/02/06 03:37:38 ron Exp
+# File:     /custom-sections/index.tcl
+# Date:     12/28/99
+# Contact:  ahmeds@arsdigita.com
+# Purpose:  this serves the custom section index page 
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+# section_id 
+
+validate_integer section_id $section_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope all all none
+
+set selection [ns_db 1row $db "
+select body, html_p, section_pretty_name
+from content_sections
+where section_id=$section_id"]
+
+set_variables_after_query
+
+set page_title $section_pretty_name
+
+ReturnHeaders
+
+append html "
+[ad_scope_header $page_title $db]
+[ad_scope_page_title $page_title $db]
+[ad_scope_context_bar_ws "$page_title"]
+<hr>
+[ad_scope_navbar]
+"
+
+set selection [ns_db select $db "
+select file_name, page_pretty_name
+from content_files
+where section_id=$section_id
+and file_type='text/html'
+order by file_name
+"]
+    
+set page_counter 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append page_links " 
+    <li><a href=\"$file_name\">$page_pretty_name</a>
+    <br> "
+    
+    incr page_counter
+}
+
+ns_db releasehandle $db    
+
+if { $page_counter==0 } {
+    append html "
+    <p>
+    "     
+} else {
+    append html "
+    <p>
+    <ul>
+    $page_links
+    </ul>
+    <p>
+	"
+}
+
+if { ![empty_string_p $body] } {    
+    append html "
+    [util_maybe_convert_to_html $body $html_p]	
+    "
+}
+
+ns_write "
+$html
+[ad_scope_footer ]
+"
+
+
+
+
+
+
Index: web/openacs/www/custom-sections/file/get-binary-file.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/custom-sections/file/get-binary-file.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/custom-sections/file/get-binary-file.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,38 @@
+# get-binary-file.tcl,v 3.0 2000/02/06 03:37:39 ron Exp
+# File:     /custom-sections/sereve-binary-file.tcl
+# Date:     12/28/99
+# Contact:  ahmeds@arsdigita.com
+# Purpose:  this serves a custom section image 
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+# content_file_id 
+
+validate_integer content_file_id $content_file_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope all all none
+
+set mime_type [database_to_tcl_string $db "
+select file_type
+from content_files
+where content_file_id=$content_file_id
+"]
+
+ReturnHeaders $mime_type
+
+ns_ora write_blob $db "
+select binary_data
+from content_files
+where content_file_id=$content_file_id
+"
+
+
Index: web/openacs/www/custom-sections/file/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/custom-sections/file/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/custom-sections/file/index.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,53 @@
+# index.tcl,v 3.0 2000/02/06 03:37:40 ron Exp
+# File:     /custom-sections/index.tcl
+# Date:     12/28/99
+# Contact:  ahmeds@arsdigita.com
+# Purpose:  this serves the custom section index page 
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+# content_file_id 
+
+validate_integer content_file_id $content_file_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope all all none
+
+set selection [ns_db 1row $db "
+select page_pretty_name, body, html_p
+from content_files
+where content_file_id=$content_file_id
+"]
+
+set_variables_after_query
+
+ReturnHeaders
+
+append html "
+[ad_scope_header $page_pretty_name $db]
+[ad_scope_page_title $page_pretty_name $db]
+[ad_scope_context_bar_ws "$page_pretty_name"]
+<hr>
+[ad_scope_navbar]
+"   
+append html "
+<br><br>
+<blockquote>
+<h2>$page_pretty_name</h2>
+[util_maybe_convert_to_html $body $html_p]
+</blockquote>
+<p>
+"
+
+ns_write "
+$html
+[ad_scope_footer ]
+"
+
Index: web/openacs/www/custom-sections/file/serve-binary-file.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/custom-sections/file/serve-binary-file.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/custom-sections/file/serve-binary-file.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,57 @@
+# serve-binary-file.tcl,v 3.0 2000/02/06 03:37:41 ron Exp
+# File:     /custom-sections/serve-binary-file.tcl
+# Date:     12/28/99
+# Contact:  ahmeds@arsdigita.com
+# Purpose:  this serves a custom section image 
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+# content_file_id 
+
+validate_integer content_file_id $content_file_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope all all none
+
+ReturnHeaders
+
+set page_title "View Image"
+
+ns_write "
+[ad_scope_admin_header $page_title $db]
+[ad_scope_page_title $page_title $db]
+[ad_scope_context_bar_ws "$page_title"]
+
+<hr>
+[ad_scope_navbar]
+"
+
+set file_name [database_to_tcl_string $db "
+select file_name 
+from content_files 
+where content_file_id = $content_file_id"]
+
+append html "
+
+<center>
+<h3>$file_name</h3>
+<img src=\"/custom-sections/file/get-binary-file.tcl?[export_url_scope_vars content_file_id]\" ALT=$file_name border=1>
+</center>
+"
+
+ns_db releasehandle $db
+
+ns_write "
+<blockquote>
+$html
+</blockquote>
+[ad_scope_admin_footer]
+"
+
Index: web/openacs/www/directory/browse.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/directory/browse.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/directory/browse.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,81 @@
+# browse.tcl,v 3.1 2000/03/10 20:18:48 flattop Exp
+# modified 3/10/00 by flattop@arsdigita.com
+# cleaned up the code
+
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode "/directory/"]"
+    return
+}
+
+set where_clauses [list "priv_name <= [ad_privacy_threshold]"]
+
+if [ad_parameter UserBrowsePageLimitedToNotNullUrlP directory 1] {
+    lappend where_clauses "url is not null"
+    set list_headline "Your fellow users (only those who've given us personal homepage addresses):"
+} else {
+    set list_headline "Your fellow users:"
+}
+
+set simple_page_headline "<h2>Users</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "User Directory"] "Browse"]
+"
+
+if ![empty_string_p [ad_parameter BrowsePageDecoration directory]] {
+    set page_headline "<table cellspacing=10><tr><td>[ad_parameter BrowsePageDecoration directory]<td>$simple_page_headline</tr></table>"
+} else {
+    set page_headline $simple_page_headline
+}
+
+ReturnHeaders
+
+ns_write "
+[ad_header "[ad_system_name] Users"]
+
+$page_headline
+
+<hr>
+
+$list_headline
+
+<ul>
+
+"
+
+set db [ns_db gethandle]
+
+set selection [ns_db select $db "select user_id, first_names, last_name, email, priv_email, url
+from users
+where [join $where_clauses " and "]
+order by upper(last_name), upper(first_names), upper(email)"]
+
+
+set list_items ""
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append list_items "<li><a href=\"/shared/community-member.tcl?user_id=$user_id\">$first_names $last_name</a>"
+    if { $priv_email <= [ad_privacy_threshold] } {
+	append list_items " (<a href=\"mailto:$email\">$email</a>)"
+    }
+    if ![empty_string_p $url] {
+	append list_items ":  <a href=\"$url\">$url</a>"
+    }
+    append list_items "\n"
+}
+
+ns_db releasehandle $db 
+
+ns_write "$list_items
+</ul>
+
+
+[ad_style_bodynote "Note: The only reason you are seeing this page at all is that you
+are a logged-in authenticated user of [ad_system_name]; this
+information is not available to tourists.  If you want to change 
+or augment your own listing, visit [ad_pvt_home_link]."]
+
+[ad_footer]
+"
Index: web/openacs/www/directory/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/directory/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/directory/index.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,83 @@
+# index.tcl,v 3.0 2000/02/06 03:37:44 ron Exp
+#
+# /directory/index.tcl
+#
+# by philg@mit.edu in early 1999
+# 
+# let's users search and browse for each other
+# also gives access to users with uploaded portraits
+#
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode "/directory/"]"
+    return
+}
+
+set simple_headline "<h2>Directory</h2>
+
+[ad_context_bar_ws_or_index "User Directory"]
+"
+
+if ![empty_string_p [ad_parameter IndexPageDecoration directory]] {
+    set full_headline "<table cellspacing=10><tr><td>[ad_parameter IndexPageDecoration directory]<td>$simple_headline</tr></table>"
+} else {
+    set full_headline $simple_headline
+}
+
+ReturnHeaders
+
+ns_write "
+[ad_header "[ad_system_name] Directory"]
+
+$full_headline
+
+<hr>
+
+Look up a fellow user:
+
+<p>
+
+
+<blockquote>
+
+<form method=GET action=\"lookup.tcl\">
+
+<table>
+<tr><td>Whose last name begins with<td><input type=text name=last_name size=20></tr>
+<tr><td>Whose email address begins with<td><input type=text name=email size=20></tr>
+
+</table>
+
+
+<center>
+<input type=submit value=\"Search\">
+</center>
+
+</form>
+
+</blockquote>
+
+"
+
+if {[ad_parameter ProvideUserBrowsePageP directory 1] && [ad_parameter NumberOfUsers "" medium] != "large" } {
+    ns_write "To get a feel for the community, you might want to simply 
+<ul>
+<li><a href=\"browse.tcl\">browse the [ad_system_name] directory</a>
+<li>or <a href=\"portrait-browse.tcl\">look at user-uploaded portraits</a>
+</ul>
+<p>
+
+"
+}
+
+ns_write "
+
+[ad_style_bodynote "Note: The only reason you are seeing this page at all is that you
+are a logged-in authenticated user of [ad_system_name]; this
+information is not available to tourists.  If you want to upload
+a picture of yourself, visit [ad_pvt_home_link]."]
+
+[ad_footer]
+"
Index: web/openacs/www/directory/lookup.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/directory/lookup.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/directory/lookup.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,105 @@
+# lookup.tcl,v 3.1 2000/03/10 20:29:12 flattop Exp
+# /directory/lookup.tcl
+#
+# diplays all the users that match either last name or email
+#
+# modified by flattop@arsdigita.com
+#  - got rid of set_the_usual_form_variables (1/28/00)
+#  - don't ns_write after each row (3/10/00)
+
+ad_page_variables { {email {}} {last_name {}} }
+
+# just in case user press a space bar in text box
+set email [string trim $email]
+set last_name [string trim $last_name]
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode "/directory/"]"
+    return
+}
+
+if { ![empty_string_p $last_name] && [empty_string_p $email] } {
+    # we have a last name fragment but not an email address
+    set description "whose last names begin with \"$last_name\""
+    set where_clause "upper(last_name) like '[DoubleApos [string toupper $last_name]]%'"
+    set order_by "upper(last_name), upper(first_names), upper(email)"
+} elseif  { ![empty_string_p $email] && [empty_string_p $last_name] } {
+    # we have an email fragment but not a last name
+    set description "whose email address begins with \"$email\""
+    set where_clause "upper(email) like '[DoubleApos [string toupper $email]]%'"
+    set order_by "upper(email), upper(last_name), upper(first_names)"
+} elseif { ![empty_string_p $last_name] && ![empty_string_p $email] } {
+    set description "whose email address begins with \"$email\" OR whose last name begins with \"$last_name\""
+    set where_clause "upper(email) like '[DoubleApos [string toupper $email]]%' or upper(last_name) like '[DoubleApos [string toupper $last_name]]%'"
+    set order_by "upper(last_name), upper(first_names), upper(email)"
+} else {
+    # we've got neither
+    ad_return_complaint 1 "<li>please type a query string in one of the boxes."
+    return
+}
+
+set simple_headline "<h2>Users</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "User Directory"] "One Class"]
+
+"
+
+if ![empty_string_p [ad_parameter SearchResultsDecoration directory]] {
+    set full_headline "<table cellspacing=10><tr><td>[ad_parameter SearchResultsDecoration directory]<td>$simple_headline</tr></table>"
+} else {
+    set full_headline $simple_headline
+}
+
+
+ReturnHeaders
+
+ns_write "
+[ad_header "Users $description"]
+
+$full_headline
+
+<hr>
+
+Class:  users $description
+"
+
+set db [ns_db gethandle]
+
+set selection [ns_db select $db "select user_id, first_names, last_name, email
+from users
+where $where_clause
+order by $order_by"]
+
+set list_items ""
+set list_count 0
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    incr list_count
+    if { ![empty_string_p $first_names] || ![empty_string_p $last_name] } {
+	set full_name "$first_names $last_name"
+    } else {
+	set full_name "name unknown"
+    }
+    append list_items "<li><a href=\"/shared/community-member.tcl?user_id=$user_id\">$full_name</a> (<a href=\"mailto:$email\">$email</a>)\n"
+}
+
+ns_db releasehandle $db 
+
+if { $list_count == 0 } {
+    set list_items "<li>There are currently no matches in the database."
+}
+
+ns_write "
+<ul>
+$list_items
+</ul>
+
+<i>Note: The only reason you are seeing this page at all is that you
+are a logged-in authenticated user of [ad_system_name]; this
+information is not available to tourists.</i>
+
+[ad_footer]
+"
Index: web/openacs/www/directory/portrait-browse.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/directory/portrait-browse.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/directory/portrait-browse.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,148 @@
+# portrait-browse.tcl,v 3.0 2000/02/06 03:37:46 ron Exp
+# 
+# portrait-browse.tcl
+#
+# by philg@mit.edu on September 27, 1999
+# 
+# a registration-required page that shows the portraits 
+# of all the users in the system who have uploaded them
+#
+# we have dimension controls on top to toggle "recent"|"all"
+# and some kind of order-by control 
+# and some kind of text list (with links), thumbnails, full-size
+# control
+
+ad_maybe_redirect_for_registration
+
+set_the_usual_form_variables 0 
+
+# optional text_picture_dim, recent_all_dim, order_by 
+
+if { ![info exists text_picture_dim] || [empty_string_p $text_picture_dim] } {
+    set text_picture_dim "links"
+}
+
+if { ![info exists recent_all_dim] || [empty_string_p $recent_all_dim] } {
+    set recent_all_dim "recent"
+}
+
+switch $text_picture_dim {
+    links  { set text_picture_bar "links | 
+<a href=\"portrait-browse.tcl?text_picture_dim=thumbnails&[export_ns_set_vars url text_picture_dim]\">thumbnails</a> |
+<a href=\"portrait-browse.tcl?text_picture_dim=full_size&[export_ns_set_vars url text_picture_dim]\">full-size</a>" }
+    thumbnails  { set text_picture_bar "<a href=\"portrait-browse.tcl?text_picture_dim=links&[export_ns_set_vars url text_picture_dim]\">links</a> |
+thumbnails |
+<a href=\"portrait-browse.tcl?text_picture_dim=full_size&[export_ns_set_vars url text_picture_dim]\">full-size</a>" }
+    full_size  { set text_picture_bar "<a href=\"portrait-browse.tcl?text_picture_dim=links&[export_ns_set_vars url text_picture_dim]\">links</a> |
+<a href=\"portrait-browse.tcl?text_picture_dim=thumbnails&[export_ns_set_vars url text_picture_dim]\">thumbnails</a> |
+full-size" }
+}
+
+switch $recent_all_dim {
+    recent { set recent_all_bar "recent |
+<a href=\"portrait-browse.tcl?recent_all_dim=all&[export_ns_set_vars url recent_all_dim]\">all</a>"
+             set order_by_clause "order by portrait_upload_date desc" }
+    all { set recent_all_bar "<a href=\"portrait-browse.tcl?recent_all_dim=recent&[export_ns_set_vars url recent_all_dim]\">recent</a> |
+all" 
+         set order_by_clause "order by upper(last_name), upper(first_names), upper(email)" }
+}
+
+ReturnHeaders
+
+ns_write "
+[ad_header "[ad_system_name] Portrait Gallery"]
+
+<h2>Portrait Gallery</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "User Directory"] "Portrait Gallery"]
+
+<hr>
+
+<table width=100%>
+<tr>
+<td align=left>
+$text_picture_bar
+<td align=right>
+$recent_all_bar
+</table>
+
+<blockquote>
+<table>
+<tr><th>Name<th>Email<th>Image</tr>
+
+"
+
+set db [ns_db gethandle]
+
+set selection [ns_db select $db "select user_id, first_names, last_name, email, priv_email,
+portrait_upload_date, portrait_original_width, portrait_original_height, portrait_client_file_name,
+portrait_thumbnail_width, portrait_thumbnail_height
+from users
+where portrait_upload_date is not null
+$order_by_clause"]
+
+
+set rows ""
+set count 0 
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    incr count
+    if { $count > 50 && $recent_all_dim == "recent" } {
+	# they only wanted to see the recent ones 
+	ns_db flush $db
+	break
+    }
+    append rows "<tr>
+<td valign=top>
+<a href=\"/shared/community-member.tcl?user_id=$user_id\">$first_names $last_name</a>
+</td>
+<td valign=top>
+"
+    if { $priv_email <= [ad_privacy_threshold] } {
+	append rows "<a href=\"mailto:$email\">$email</a>"
+    } else {
+	# email address is not available
+	append rows "N/A"
+    }
+    append rows "</td>"
+    # try to put the portrait in there
+    if { $text_picture_dim == "links" } {
+	append rows "<td valign=top>
+<a href=\"/shared/portrait.tcl?[export_url_vars user_id]\">$portrait_client_file_name</a>
+</td>
+"
+    } elseif { $text_picture_dim == "thumbnails" } {
+	# **** this should really be smart and look for the actual thumbnail
+	# but it isn't and just has the browser smash it down to a fixed width
+	append rows "<td valign=top>
+<a href=\"/shared/portrait.tcl?[export_url_vars user_id]\"><img width=200 src=\"/shared/portrait-bits.tcl?[export_url_vars user_id]\"></a>
+</td>
+"
+    } else { 
+	# must be the full thing
+	if { ![empty_string_p $portrait_original_width] && ![empty_string_p $portrait_original_height] } {
+	    set widthheight "width=$portrait_original_width height=$portrait_original_height"
+	} else {
+	    set widthheight ""
+	}
+	append rows "<td valign=top>
+<a href=\"/shared/portrait.tcl?[export_url_vars user_id]\"><img $widthheight src=\"/shared/portrait-bits.tcl?[export_url_vars user_id]\"></a>
+</td>
+"
+    }
+    append rows "</tr>\n"
+}
+
+ns_db releasehandle $db 
+
+ns_write "$rows
+</table>
+</blockquote>
+
+[ad_style_bodynote "Note: The only reason you are seeing this page at all is that you
+are a logged-in authenticated user of [ad_system_name]; this
+information is not available to tourists.  If you want to change 
+or augment your own listing, visit [ad_pvt_home_link]."]
+
+[ad_footer]
+"
Index: web/openacs/www/display/get-complete-css.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/display/get-complete-css.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/display/get-complete-css.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,26 @@
+# get-complete-css.tcl,v 3.0 2000/02/06 03:37:48 ron Exp
+# File:     /css/get-complete-css.tcl
+# Date:     22/12/99
+# Contact:  tarik@arsdigita.com
+# Purpose:  gets css from the database and returns the css file
+#           this file uses css_complete table
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+ns_return 200 text/css [css_generate_complete_css $db]
+
+
+
+
+
+
+
Index: web/openacs/www/display/get-logo.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/display/get-logo.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/display/get-logo.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,37 @@
+# get-logo.tcl,v 3.0 2000/02/06 03:37:49 ron Exp
+# File:     /css/get-logo.tcl
+# Date:     12/27/99
+# Contact:  tarik@arsdigita.com
+# Purpose:  gets logo from the database and returns the appropiate image file
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (user_id, group_id)
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+
+set mime_type [database_to_tcl_string $db "
+select logo_file_type
+from page_logos
+where [ad_scope_sql]
+"]
+
+ReturnHeaders $mime_type
+
+ns_pg blob_write $db \
+[database_to_tcl_string $db "
+select lob
+from page_logos
+where [ad_scope_sql]
+"]
+
+
+
+
Index: web/openacs/www/display/get-simple-css.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/display/get-simple-css.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/display/get-simple-css.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,88 @@
+# get-simple-css.tcl,v 3.0 2000/02/06 03:37:50 ron Exp
+# File:     /css/get-simple-css.tcl
+# Date:     22/12/99
+# Contact:  tarik@arsdigita.com
+# Purpose:  gets css from the database and returns the css file
+#           this file uses css_simple table
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "
+select css_bgcolor, css_textcolor, css_unvisited_link, css_visited_link, css_link_text_decoration, css_font_type
+from css_simple
+where [ad_scope_sql]
+"]
+
+if { [empty_string_p $selection] } {
+    # initialize background color to white
+    ns_return 200 text/css "BODY { background-color: white }
+    "
+    return
+}    
+
+set_variables_after_query
+
+if { ![empty_string_p $css_bgcolor] } {
+    set style_bgcolor "background-color: $css_bgcolor"
+}
+
+if { ![empty_string_p $css_textcolor] } {
+    set style_textcolor "color: $css_textcolor"
+}
+
+if { ![empty_string_p $css_unvisited_link] } {
+    set style_unvisited_link "color: $css_unvisited_link"
+}
+
+if { ![empty_string_p $css_visited_link] } {
+    set style_visited_link "color: $css_visited_link"
+}
+
+if { ![empty_string_p $css_link_text_decoration] } {
+    set style_link_text_decoration "text-decoration: $css_link_text_decoration"
+}
+
+if { ![empty_string_p $css_font_type] } {
+    set style_font_type "font-family: $css_font_type"
+}
+
+set a_string [join [css_list_existing style_link_text_decoration style_unvisited_link] "; "]
+append css [ad_decode $a_string "" "" "A { $a_string }\n"]
+
+set a_hover_string  [join [css_list_existing style_link_text_decoration] "; "]
+append css [ad_decode $a_hover_string "" "" "A:hover { $a_hover_string }\n"]
+
+set a_visited_string [join [css_list_existing style_visited_link style_link_text_decoration] "; "]
+append css [ad_decode $a_visited_string "" "" "A:visited { $a_visited_string }\n"]
+
+set font_string [join [css_list_existing style_font_type style_textcolor] "; "]
+if { ![empty_string_p $font_string] } {
+    append css "P  { $font_string }
+UL { $font_string }
+H1 { $font_string }
+H2 { $font_string }
+H3 { $font_string }
+H4 { $font_string }
+TH { $font_string }
+TD { $font_string }
+BLOCKQUOTE{ $font_string }
+"
+}
+
+set body_string [join [css_list_existing style_bgcolor style_textcolor style_font_type] "; "]
+append css [ad_decode $body_string "" "" "BODY { $body_string }"]
+
+ns_db releasehandle $db 
+ns_return 200 text/css $css
+
+
Index: web/openacs/www/doc/README-NSV.txt
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/README-NSV.txt,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/README-NSV.txt	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,206 @@
+
+
+New NSV Interface:
+------------------
+January, 2000
+
+
+The new nsv interface of AOLserver 3.0 was added to provide a high
+performance, more flexible alternative to ns_share.  The model is
+similar to the existing (and undocumented) ns_var command but uses an
+array syntax and includes more features.
+
+
+Basics:
+-------
+
+The following commands currently make up the nsv interface:
+
+    	nsv_get - get key value 
+    	nsv_exists - check key existence
+    	nsv_set - set key value
+    	nsv_append - append value
+    	nsv_lappend - append value as list element
+    	nsv_incr - increment and return value
+    	nsv_unset - unset a value
+    	nsv_array - manage nsv arrays
+
+Commands for the most part mirror the cooresponding Tcl command for
+ordinary variables.  Basically, to set a value, simply use the nsv_set
+command:
+
+	nsv_set myarray foo $value
+
+and to get a value, simply use the nsv_get command:
+
+	set value [nsv_get myarray foo]
+
+
+
+Migrating From ns_share:
+------------------------
+
+Migrating from ns_share is straightforward.  If your init.tcl included
+commands such as:
+
+	ns_share myshare
+	set myshare(lock) [ns_mutex create]
+
+use instead:
+
+	nsv_set myshare lock [ns_mutex create]
+
+In your procedures, instead of:
+
+	proc myproc {} {
+		ns_share myshare
+
+		ns_mutex lock $myshare(lock)
+		...
+
+use:
+
+	proc myproc {} {
+		ns_mutex lock [nsv_get myshare lock]
+		...
+
+and within an ADP page, instead of:
+
+	<%
+	ns_share myshare
+	ns_puts $myshare(key1)
+	%>
+
+	<%=$myshare(key2)%>
+
+use:
+
+	<%
+	ns_puts [nsv_get myshare key1]
+	%>
+
+	<%=[nsv_get myshare key2]%>
+
+
+Notice that, unlike ns_share, no command is required to define the
+shared array.  The first attempt at setting the variable through any
+means will automaticaly create the array.  Also notice that only arrays
+are supported.  However, to migrate from ns_share you can simply package
+up all existing ns_share scalars into a single array with a short name,
+perhaps just ".". For example, if you had:
+
+	ns_share mylock myfile
+	set myfile /tmp/some.file
+	set mylock [ns_mutex create]
+
+you can use:
+
+	nsv_set . myfile /tmp/some.file
+	nsv_set . mylock [ns_mutex create]
+
+
+Multithreading Features:
+------------------------
+
+One advantages of nsv is built in interlocking for thread safety.
+For example, consider a case of a "increment-by-one" unique id system.
+Here's the ns_share solution:
+
+	ns_share ids
+	set ids(lock) [ns_mutex create]
+	set ids(next) 0
+
+	proc nextid {} {
+		ns_share ids
+
+		ns_mutex lock $ids(lock)
+		set next [incr ids(next)]
+		ns_mutex unlock $ids(lock)
+		return $next
+	}
+
+and here's an nsv solution:
+
+	nsv_set ids next 0
+
+	proc nextid {} {
+		return [nsv_incr ids next]
+	}
+
+Note that the nsv solution does not need a mutex as the nsv_incr command
+is internally interlocked.
+
+
+Compatibility with Tcl Arrays:
+------------------------------
+
+Another useful feature of nsv is the nsv_array command which works much
+like the Tcl array command.  This can be used to import and export values
+from ordinary Tcl arrays.  For example, to copy from Tcl use:
+
+	nsv_array set meta [array get tmpmeta]
+
+and to copy to Tcl use:
+
+	array set metacopy [nsv_array get meta]
+
+As with all other nsv command, nsv_array is atomic and no explicit
+locking is required.  This feature can be used to contruct a new nsv
+array by first filling up an ordinary temporary Tcl array via some time
+consuming process and then swapping it into place as above.  While the
+new temporary array is being constructed, other threads can access the
+old array without delay or inconsistant data.  You can even reset a
+complete nsv array in one step with "reset".  For example, instead of:
+
+	ns_share lock meta
+	set lock [ns_mutex create]
+
+	ns_mutex lock $lock
+	unset meta
+	array set meta [array get tmpmeta]
+	ns_mutex unlock $lock
+
+you can simply use:
+
+	nsv_array reset meta [array get tmpmeta]
+
+The reset option will flush and then reset all values atomically,
+eliminating the need for the explicit lock.
+
+Other options for the nsv_array command include:
+
+	nsv_array exists array - test existance of array
+	nsv_array size array - return # of elements in array
+	nsv_array names array - return keys of array
+
+
+Configuration:
+--------------
+
+The nsv system uses a common multithreading technique to reduce the
+potential for lock contention which is to split the locks to acheive
+finer grained locking.  This technique groups arrays randomly into
+buckets and only the arrays within a particular bucket share a lock.
+The number of buckets to be used can be configured by setting the
+"nsvbuckets" tcl parameters, e.g.:
+
+	[ns/server/server1/tcl]
+	nsvbuckets=20
+
+The default is 8 which should be reasonalbe.  Note that you can monitor
+the lock contention, if any, by enabling mutex metering:
+
+	[ns/threads]
+	mutexmetering=on
+
+and then viewing the results of "ns_info locks" command after the server
+has been running for some time.  The nsv locks all have names of the
+form "nsv:##".  If you find many lock attempts which did not successed
+immediately, try increasing nsvbuckets.
+
+
+Feedback:
+---------
+
+Please send any feedback, including ideas for additional features,
+to feedback@aolserver.com.
Index: web/openacs/www/doc/abstract-url.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/abstract-url.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/abstract-url.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,164 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Abstract URL System</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Abstract URL System</h2>
+
+a layer underneath the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a> and <a href="mailto:jsalz@mit.edu">Jon Salz</a>
+
+<hr>
+
+<ul>
+<li>procedures: in tcl/ad-abstract-url.tcl
+</ul>
+
+<h3>The Problem</h3>
+
+The main engineering ideas behind the ArsDigita Community System are (1)
+data models, (2) sequences of URLs that lead up to transactions, and (3)
+the specifications for those transactions.
+
+<p>
+
+We need to increase the amount of abstraction in specifying
+the URLs.
+
+<p>
+
+Right now (February 2000), we happen to use AOLserver and one of the
+following kinds of pages:
+
+<ul>
+<li>a .html file
+<li>a .tcl file
+<li>a .adp template 
+<li>a .spec file that implies further evaluation of templates
+<li>a lot of files containing things like JPEGs or videos where there is
+no practical opportunity for interpretation by the server
+</ul>
+
+Think about it: when the SAP guys started up in 1972 they probably did a
+of of things for which they are now sorry.  In 30 years we will probably
+still have some vestiges of our data model and workflow.  But the
+specific languages and systems being used today will likely change.  In
+fact, we've already talked about building version fo the ACS that (a)
+run inside Oracle using their embedded Java Web server, (b) run with
+Microsoft Active Server Pages, (c) run inside Apache mod_perl.  If a
+publisher swaps out AOLserver for one of these other systems or if we,
+in an ACS version upgrade, swap in .spec templating for .tcl, why should
+the user have to update his bookmarks?
+
+<h3>The Solution</h3>
+
+We register a procedure that
+will, given a URL with no extension, dig around in the file system to
+find the right actual files to deliver/execute.  This is analogous to
+what AOLserver already does when it gets a directory name.  There is
+also an Apache module that does some of this (see 
+<a href="http://www.apache.org/docs/content-negotiation.html">http://www.apache.org/docs/content-negotiation.html</a>).  Here's an example of the
+algorithm:
+
+<ol>
+<li>is there a .spec file, indicating usage of the super-whizzy
+templating system?  If so, evaluate it.  If not, proceed to next step.
+
+<li>is there a .tcl file, indicating old-style code or code that will
+look for a .adp template?  If so, evaluate it.  If not, proceed to next
+step.
+
+<li>does the user's session indicate that he or she wants WML for a
+wireless device?  If so, try to find a .wml file and serve it.  If no
+session info or no .wml file, proceed to next step.
+
+<li>look for a .html file
+
+<li>look for a .txt file
+
+<li>look for a .jpeg
+
+<li>look for a .gif
+
+</ol>
+
+Right now we implement a subset of this.
+The current algorithm (sure to be enhanced in the near future as we
+add support for scoping and rethink templates) is as follows:
+
+<ol>
+<li>If the URL specifies a directory but doesn't have a trailing slash,
+append a slash to the URL and redirect (just like AOLserver would).
+<li>If the URL specifies a directory and does have a trailing slash,
+append "index" to the URL (so we'll search for an <tt>index.*</tt> file
+in the filesystem).
+<li>If the file corresponding to the requested URL exists (probably because the
+user provided the extension), just deliver the file.
+<li>Find a file in the file system with the provided URL as the root (i.e.,
+some file exists which is the URL plus some extension). Give precedence to
+extensions specified in the <tt>ExtensionPrecedence</tt> parameter in the
+<tt>abstract-url</tt> configuration section (in the order provided there).
+If such a file exists, deliver it.
+<li>The requested resource doesn't exist - return a 404 Not Found.
+</ol>
+
+We are likely to add some steps at the very beginning of this to perform
+scoping, e.g., check if the URL begins with a group name (and optional group type),
+and if so set scope variables in the environment and munge the URL accordingly.
+
+<p>Note that we perform a lookup even if a URL with an extension is
+provided. This is so we can eventually perform content negotation even within the
+content-type domain, e.g., serve up a document in French (<tt>foobar.html.fr</tt>)
+or the King's English (<tt>foobar.html.en.uk</tt>) as opposed to the
+default Yankeespeak (<tt>foobar.html</tt> or <tt>foobar.html.en.us</tt>) depending
+on the browser's <tt>Accept-Language</tt> setting.
+
+<p>Open questions:
+
+<ul>
+<li>Is there any value in abstracting URLs for big ugly binary files
+such as JPEG, video, PowerPoint, Word docs, etc.? (I think so - this
+enables us to change resource types more easily [i.e., replace GIFs with
+JPEGs or Word documents with HTML files], which is a primary goal of
+this system in the first place. Our ultimate goal should be the removal
+of <i>all</i> extensions from URLs throughout ACS. -JS)
+
+<li>Is it worth caching all of these file system probes? (My gut reaction
+is that it is not; caching will take place in the OS's file system layer anyway,
+and it would be tricky [although not <i>that</i> tricky] to properly support
+the addition/removal of files from the file system without explicitly flushing
+the caches. In any case, caching is not part of the current implementation
+although it could certainly be added in a future version. -JS)
+</ul>
+
+Minor Benefits:
+
+<ul>
+
+<li>Tim Berners-Lee will be happy; he doesn't like to see extensions in
+URLs
+ 
+<li>People who are language bigots and prefer (Perl|Java|Lisp|C) to Tcl
+will not be put off by the mere URLs
+
+</ul>
+
+
+
+
+
+<hr>
+
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+<a href="mailto:jsalz@mit.edu"><address>jsalz@mit.edu</address></a>
+</body>
+</html>
+
+
+
+
+
+
+
Index: web/openacs/www/doc/acceptance-test.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/acceptance-test.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/acceptance-test.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,856 @@
+<html>
+<!--AD_DND-->
+<!-- acceptance-test.html,v 3.1.2.34 2000/03/29 09:54:12 carsten Exp -->
+<head>
+<title>Acceptance Test</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+
+<h2>Acceptance Test</h2>
+
+for the <a href=index.html>Arsdigita Community System</a> 
+by <a href="http://teadams.com">Tracy Adams</a>
+<hr>
+
+Use this to test an ACS installation. Going through these steps is also
+a good way to learn the major features of Arsdigita Community System
+administration.
+
+<p>
+
+<h3>Installation</h3>
+You should ensure the database has been properly configured and that your
+AOLserver installation will actually start.<br>
+Suggested method:
+<ul>
+<li>Open up a sqlplus session as the Oracle user your AOLserver will connect
+as.  We want to ensure we've completed the installation step of adding
+NLS_DATE_FORMAT = "YYYY-MM-DD" to the Oracle instance init file.  Make sure the date format is set correctly.
+<blockquote><pre><code>
+SQL> select to_date('1-1-2000', 'MM-DD-YYYY') as y2k from dual ;
+
+Y2K
+----------
+2000-01-01
+</code></pre></blockquote>
+
+<p>
+If the date did not read "2000-01-01" that installation step failed.
+
+<li>Next, make sure that the step of feeding Oracle the data model works.  In the same sqlplus session, make sure the <code>country_codes</code>, <code>counties</code>, and <code>states</code> tables were loaded:
+
+<blockquote><pre><code>
+SQL> select table_name from user_tables where lower(table_name) in ('country_codes', 'states', 'counties') ;
+
+TABLE_NAME
+------------------------------
+COUNTIES 
+COUNTRY_CODES
+STATES
+</code></pre></blockquote>
+
+<p>
+
+If these three tables do not show up, we failed to properly feed Oracle the
+data model.
+
+<li>Spot-check that database objects created in <code>.../doc/sql</code> exist.
+
+<li>If you installed site-wide-search make sure the im_convert PL/SQL proc is there.  This procedure converts a search string into a form interMedia understands to perform the search.
+<blockquote><pre><code>
+
+SQL> select im_convert('foo bar') from dual ;
+
+IM_CONVERT('FOOBAR')
+--------------------------------------------------------------------------------
+( { foo } NEAR { bar })*2.0,about(   foo     bar  )
+
+
+</code></pre></blockquote>
+
+If this is not what you see, then you likely failed to properly feed Oracle
+the data model.
+
+<li>Unless you have specified port numbers for both the ns_sock and ns_ssl (if
+applicable) modules that are greater than 1024, you will need 
+<code>sudo</code> permissions or root access for the following command.
+As <code>root</code> make sure your server will start
+<blockquote><code><pre>
+/webroot/aol30/bin/nsd -fc /webroot/aol30/<yourservername>.ini -r /webroot
+</pre></code></blockquote>
+<p>
+The <code>-f</code> option runs the server in the foreground, so you can easily see any errors that may have occurred when the server was run.  If you see any errors indicating the failure of a virtual server to start, this step failed.
+
+</ul>
+
+<h3>Registration</h3>
+You should test basic registration and the login process. <br>
+Suggested method:
+<ul>
+<li> Go to /pvt/home.tcl
+<li> Walk through registering as a new user
+<li> Go back to /pvt/home.tcl and "Log out"
+<li> Go back to /pvt/home.tcl again and log in as the same user
+</ul>
+
+<h3>User Administration</h3>
+You should test adding a user, searching for users, modifying user data, banning or deleting a user, and spamming a class of users. <br>
+Suggested method:
+<ul>
+<li> Go to /admin/users
+<li> Create a test user
+<li> Search for a class of users (which includes the test user)
+<li> View the list of matching users and edit the user data for the new test user
+<li> Spam a (small) group of users.
+<li> Delete the test user
+<li> Ban the test user
+<li> Nuke the test user
+</ul>
+
+<h3>Bboard System</h3>
+You should test setting up a bboard, posting a message, alerts, and searching.<br>
+Suggested method:
+<ul>
+<li> Create a test bboard
+<li> Sign up for an instantaneous alert
+<li> Post a message
+<li> Respond to your message
+<li> Search for your message (Note that you must wait for the index to be rebuilt before you'll actually see your new posting. Or you can do it manually by going to SQL*Plus and typing <code>alter index sws_ctx_index rebuild parameters('sync')</code>.)
+<li> Deactivate the test bboard (you can leave it for later testing)
+</ul>
+<h3>Classified Ads</h3>
+You should test setting up a domain, posting/editing and ad, alerts, hot auctions and searching.<br>
+Suggested Method:<br>
+<ul>
+<li>Go to /admin/gc and create a domain.  Make sure you add a least one category.
+<li> Go to /gc and add an instant alert.
+<li> Post an ad.
+<li> Edit your ad.
+<li> Place a bid on the ad.
+<li> Search for your ad.
+<li> Deactivate your domain (you can leave it for later testing).
+</ul>
+
+<h3>Download</h3>
+You should test adding new downloads, upload versions of existing downloads, adding rules to all versions/specific version of a download, edit/remove download data, download a file, view download history.
+<br>
+Suggested Method:<br>
+<ul>
+<li>Add a new download
+<li>Upload a new version of the download
+<li>Add a rule to the download
+<li>Edit the download data
+<li>Go to user pages and download the version
+<li>Go back to admin pages and view the download history
+<li>Remove the version
+<li>Remove the whole download
+</ul>
+
+<H3>User searchers</h3>
+The searches you made in the bboard and classified ads should have been 
+logged.  View the user searches section in the admin pages to verify.
+
+<h3>News</h3>
+You should test story posting, story approval, and story editing (for both site-wide and group scope). You can also test the interface into the general comments module.
+<br>
+Suggested Method:<br>
+<ul>
+<li> Add a story
+<li> Approve the story in the admin pages (depends on policy)
+<li> Add a comment to the story 
+<li> Approve the comment in the admin pages (depends on policy)
+<li> Revoke approval for the story in the admin pages. The story should not appear the user pages.
+</ul>
+<h3>Calendar</h3>
+You should test adding an event, approving events, and  adding comments.<br>
+Suggested Method:
+<ul>
+<li> Add a category through the admin pages
+<li> Add an event through the user pages
+<li> Approve the event (depends on policy)
+<li> Comment on the event
+<li> Approve comment (depends on policy)
+<li> Revoke approval on the news story so the item does not show up
+</ul>
+<h3>Curriculum</h3>
+<ul>
+<li> Turn on curriculum in the parameters file.
+<li> Create some curriculum items from the site-wide admin pages
+<li> View the curriculum and visit some of the pages.
+<li> Make the curriculum disappear by visiting all the pages
+<li> Visit /curriculum to turn it back on again and to view the reasons.
+</ul>
+<h3>Neighbor to Neighbor</h3>
+You should test creating a domain and subcategory, adding and approving a posting, adding and adding and approving a comment, and searching.
+Suggested Method:
+<ul>
+<li> Create a domain
+<li> Create a subcategory
+<li> Add a posting
+<li> Approve the posting (depends on policy)
+<li> Add a comment
+<li> Approve the comment (depends on policy)
+<li> Search for posting
+<li> Inactivate the domain (you can leave it for later testing)
+</ul>
+<H3>Stolen equipment registry</h3>
+You should test adding and entry, adding a comment, and searching.
+<br>
+Suggested method:
+<ul>
+<li> Add an entry
+<li> Add a comment
+<li> Approve the comment (depends on policy)
+<li> Search
+<li> Delete the entry using the the admin pages
+</ul>
+
+<h3>HTML Comments and Related Links</h3>
+You should test syncing the html pages with the database, adding/editing comments, adding/editing related links.
+<br>
+Suggested method:<br>
+<ul>
+<li> Create a test html file
+<li> Sync the database with the system
+<li> Add, then edit a comment on your test page.
+<li> Add, then edit a comment on your test page.
+<li> Delete the comment and link from the admin pages.
+</ul>
+
+<h3>Referrals</h3>
+You should test that referral tracking is working.
+<br>
+Suggested method:<br>
+<ul>
+<li> Link to your server from another site.  
+<li> View the admin pages for referrals.  You should see the foreign referral, but no local ones.
+</ul>
+<h3>Clickthroughs</h3>
+You should test that clickthroughs are logging.<br>
+Suggested Method:
+<ul>
+<li> Create a valid clickthrough test link
+<li> Click on the link and then verify that is was tracked
+</ul>
+<h3>Ad Server</h3>
+You should test that you can insert and view ads.<br>
+Suggested Method:
+<ul>
+<li> Add an ad in the admin pages
+<li> View the ad the the user pages
+</ul>
+<h3>Contest System</h3>
+You should test setting up a contest, contest entry, modifying contest parameters, and voting.<br>
+Suggested method:<br>
+<ul>
+<li> Create a current contest.  Add some customized columns.  
+<li> Verify that you can add a contest entry from the user pages. 
+<li> Edit the domain parameters and verify the changes.
+</ul>
+<h3>Ticket Tracker</h3>
+You should test adding users, creating a project, and creating an issue.<br>
+Suggested path:
+<ul>
+<li> Add a user to the Ticket Administration
+<li> as that user create a new project and feature area
+<li> Add an issue
+<li> Close the issue
+<li> Add and remove an assigned user (as the ticket administrator user)
+<li> Add a watch on a ticket (via the link at the bottom of the page)
+<li> Check that the watch shows up on /pvt/alerts.tcl
+<li> Add a comment on a ticket
+</ul>
+
+<h3>Chat</h3>
+    <ul>
+    <li> Go to /admin/chat/ and create a public chat room
+    <li> Go to /chat/ and enter the room
+    <li> Log in to /chat/ as a different user on a different browser
+    <li> Open up the javascript version on both browsers and have a nice chat
+    <li> Delete all the messages from the room
+    <li> Delete the room
+    </ul>
+
+<h3>File-Storage</h3>
+    <ul>
+    <li> Upload a URL and a file (.gif, .jpg or .doc)
+    <li> Set read permission for an arbitrary user and a group
+    <li> Upload a new version of the file, and check that the permissions
+	 got copied
+    <li> Create a folder
+    <li> Edit the file to move it into the new folder
+    <li> Download the file (checking the MIME type)
+    <li> In the "Shared Document Tree", click on a folder containing files
+	 and subfolders. Check the layout, and the links for files and folders
+    <li> Go to your "Personal Document Tree" and upload a file, 
+	 giving it permissions that make it unviewable to the public
+    <li> Upload another file and make it viewable to a specific user
+    <li> Upload a third file and make it viewable to a specific group
+    <li> Log in as the user you just specified and check if you can read the last
+	 two uploaded documents (using "All public files"; make sure the user
+	 is a member of the above group)
+    <li> Check that the "Go to" list only shows trees for which you have either
+	 write permission, or which contain files you can read (site-wide
+	 administrators can read all files - so be sure to also test this as
+	 a normal user)
+    <li> Delete a file in the shared and in your personal document tree
+    <li> Do the same as above for /admin/file-storage
+    </ul>
+
+<h3>Bookmarks</h3>
+    <ul>
+    <li> Add one bookmark manually by URL only
+    <li> Create a new folder and a subfolder
+    <li> Edit the bookmark by
+        <ul>
+        <li>changing its name
+        <li>changing its location to the new folder
+        <li>making it private
+        </ul>
+    <li> Make the folder private and check if its contents
+	 are marked as private, too
+    <li> Click on a folder and subfolder to open/close them
+    <li> Delete (through edit) the folder, thereby deleting 
+         the bookmarks as well
+    <li> Import bookmarks from a Netscape bookmarks.html file
+    <li> View the Javascript version
+    <li> Check validity the links and delete some dead links
+    </ul>
+
+<h3>Portals</h3>
+    <ul>
+    <li> Define a group type <code>portal_group</code>.  
+    <li> Create two groups of this type.  Each of these groups will have its own
+portal.  
+    <li> Create a group called "Super Administrators" of type "portal_group"
+    <li> Add yourself as a <code>Super Administrator</code> from the <code>/admin/portals</code> page.  
+    <li> Create tables from <code>/portals/admin/</code> 
+    <li> Lay out the portal pages by masquerading as an administrator
+of the various portal groups
+    <li> View the resultant user page
+    </ul>
+
+<h3>Pull-Down Menus</h3>
+    <ul>
+    <li> Upon installation you should have two pull-down menus predefined, if not load them with <code> sqlplus user/password < pdm-data.sql</code>
+    <li> View one of these pull-down menus by clicking from /admin/pull-down-menus
+    <li> Go to /admin/pull-down-menus and create a new pull-down menu filling in only the necessary fields
+    <li> Go to the new pull-down menu and a top level item and a child of that item
+    <li> Delete the test pull-down menu
+    </ul>
+
+<h3>Address Book</h3>
+You should test adding, editing, viewing and searching for a contact.<br>
+Suggested path:
+<ul>
+<li> Add a contact
+<li> View a contact
+<li> Edit a contact
+<li> Search for the contact
+</ul>
+
+<h3>Directory</h3>
+You should test searching and browsing the directory.<br>
+Suggested path:
+<ul>
+<li> Search by last name, then email, and then both (try apostrophe)
+<li> Click on browse
+<li> Click on "look at user-uploaded portraits 
+</ul>
+
+<h3>Glossary</h3>
+You should test definition entry, editing, approval, and deletion.
+<br>
+Suggested Method:<br>
+<ul>
+<li> Add a definition
+<li> Approve the definition in the admin pages (depends on policy)
+<li> Edit the definition from the user pages (depends on policy)
+<li> Edit the definition from the admin pages
+<li> Delete the definition in the admin pages. 
+The definition should no longer appear.
+</ul>
+
+<h3>General Links</h3>
+You should test link entry, rating, editing, approval, and deletion.
+<br>
+Suggested Method:<br>
+<ul>
+<li> Create a test page that calls <code>ad_general_links_list</code>
+<li> Add a link from the test page
+<li> Go to user index page
+<li> Add a link from the user index page
+<li> Approve/reject a link in the admin pages (depends on policy)
+<li> Edit a link from the admin pages
+<li> Delete a link in the admin pages. 
+The definition should no longer appear.
+</ul>
+
+<h3>Polls</h3>
+You should test poll entry, editing, voting, and reporting.
+<br>
+Suggested Method:<br>
+<ul>
+<li> Go to /admin/poll and add a new poll.
+<li> Add some poll choices.  Move them around.
+<li> Go to /poll.  Make sure the poll is there and has the proper choices.
+<li> Vote.  Check the results.
+<li> Edit the poll.  Revisit the poll and make sure the changes appear.
+<li> Delete the poll.
+</ul>
+
+<h3>User groups</H3>
+You should test links to sections, group membership and group spamming.
+<br>
+Suggested Method:<br>
+<ul>
+<li>Make sure links to group modules and sections are working on both group public and group admin pages.
+<li>Add and remove a member of a group, change member's role, change new member policy, toggle option to send email to administrators on new membership request.
+<li>Change group spam policy to open, wait and closed, and try sending spams to  group members and administrators from both the admin and the user pages, view, for wait policy, approve and disapprove emails that are waiting, view email history from both admin and user pages.
+</ul>
+
+<h3>General Permissions</h3>
+Run the <a href="/admin/acceptance-tests/gp-acceptance-test">automated
+acceptance test</a>. This tests all PL/SQL functions against the data
+model.
+
+<h3>Press</h3>
+You should test adding, viewing, editing, and deleting a press item: 
+
+<ul>
+<li>Go to /press/admin/ and add a new low-priority press item
+<li>Verify that the item shows up with the correct number of days left
+for display 
+<li>Go to /press/ and make sure the item is formatted correctly  
+<li>Go to /admin/press/ and add a new template to the system
+<li>Verify that the template is displayed correctly
+<li>Go to /press/admin/, select your test item, and then select your
+template to display it
+<li>Delete the item
+<li>Delete the template
+</ul>
+
+<h3>FAQ</h3>
+<ul>
+<li>As site-wide admin:
+<ul>
+ <li>Go to /admin/faq/ 
+ <li>Create a public FAQ
+ <li>Create a private FAQ for Group X
+ <ul>
+  <li>Visit /admin/ug/index.tcl and make sure that the group_type of which group X is a member is associated with the FAQ module.
+ </ul>
+ <li>Visit /faq/ and click on the public faq
+ <li>Click on Maintain this FAQ 
+ <li>Add questions, edit questions, swap questions, insert after..
+ <li>Edit the FAQ name
+</ul>
+<li>As a simple user: 
+ <ul>
+ <li>Go to /faq/
+ <li>Visit the public FAQ
+ </ul>
+<li>As an administrator for Group X
+ <ul>
+ <li>Visit /groups/X/faq/
+ <li>Perform the same tests on the private FAQ that you did on the public one
+ </ul> 
+</ul>
+
+<h3>Events</h3>
+You should make sure that you can create an event, register for it, and
+review registrations.<br>
+Suggested method:
+<ul>
+ <li>Create a venue
+ <li>Create an activity
+ <li>Create an event for that activity
+ <li>Add organizers to that event
+ <li>Register for an event
+ <li>Cancel a registration
+ <li>Review order histories
+</ul>
+
+<h3>Template System</h3>
+
+<p>Go to a number of pages under <code>/ecommerce/</code> and make
+sure they get displayed with uniform style, e.g. <pre>
+  index.tcl
+   -> product-search.tcl
+  shopping-cart.tcl
+  gift-certificate-order.tcl
+  gift-certificate-order-2.tcl
+   -> gift-certificate-order-3.tcl
+       -> gift-certificate-order-4.tcl
+</pre>
+(The style is defined in
+<code>/web/<em>yourservername</em>/tcl/ecommerce-styles.tcl</code>).
+
+<p>Note: this is the old template system, documented in <a
+href="style.html">style.html</a>; the new one by <a href =
+"http://www.arsdigita.com/intranet/users/view.tcl?user_id=86" >Karl
+Goldstein</a> is not included in the ACS.
+
+<h3>Categorization and User Profiling</h3>
+
+You should be able to add categories, define their positions in
+category hierarchy and, as registered user, choose content
+categories you're interested in.
+
+<ul>
+    <li>Add new category 'scratch1' through category admin pages <a href="/admin/categories/">/admin/categories/</a>
+    <li>Add subcategory 'scratch2' of 'scratch1'
+    <li>Try to nuke category 'scratch1', system should return
+        proper error message
+    <li>Edit parentage of 'scratch2', remove link to parent 'scratch1'
+    <li>Edit parentage of 'scratch1' and make it child of 'scratch2'
+    <li>See if the categories are placed properly in hierarchy tree view
+
+    <p>
+    <li>In <a href="/pvt/home.tcl">/pvt/home.tcl</a> both categories should
+        show up, check 'scratch1', update interest,
+	then check 'scratch2' and update interests again
+    <li>User interest changes should be reflected in user admin pages as
+        well
+
+    <p>
+    <li>When tired of playing, nuke both scratch categories in proper
+        order.
+</ul>
+
+<h3>Graphing</h3>
+
+Stick this into a .tcl file and then access it with your browser:
+
+<blockquote>
+<pre>
+set legend [list "1997" "1998" "1999" "2000"]
+
+set subcategory_category_and_value_list [list [list "Dog" "Favorite Animal" [list "45" "47" "40" "45"]] \
+                [list "Cat" "Favorite Animal" [list "20" "21" "19" "21"]] \
+                [list "Other" "Favorite Animal" [list "35" "32" "41" "34"]] \
+		[list "Pizza" "Favorite Food" [list "34" "33" "35" "35"]] \
+		[list "Chocolate" "Favorite Food" [list "24" "25" "24" "25"]] \
+		[list "Other" "Favorite Food" [list "42" "42" "41" "40"]]]
+               
+
+ns_return 200 text/html "&lt;font face=arial size=+2&gt;Madrona Elementary School Annual Poll Results&lt;/font&gt;
+&lt;p&gt;
+[gr_sideways_bar_chart -legend $legend $subcategory_category_and_value_list]
+"
+</pre>
+</blockquote>
+It should produce a lovely four-color bar chart!
+
+
+<h3>Ecommerce</h3>
+
+After you have completed the setup tasks in <a href="ecommerce-technical.html">Technical Details of the Ecommerce Module</a>, here are some good tests of the things most likely to be broken:
+
+<ul>
+<li>Go to http://yourserver/ecommerce/ .  If the page is broken, it's because the data model wasn't automatically loaded with the rest of the ACS (the ecommerce data model is omitted intentionally to save publishers who aren't doing ecommerce from having a gigantic number of unused tables).  Solution: load the two files ecommerce.sql and ecommerce-plsql.sql with <code>sqlplus scott/tiger &lt; ecommerce.sql</code> (same for ecommerce-plsql.sql).  If you get an error while loading the data model, it may mean that you're not using Oracle 8i (required).
+
+<li>Go to https://yourservername/admin/ecommerce/products/add.tcl (or http:// instead of https:// if you don't have SSL) and try to add a product without a picture.  If you get an error on add-2.tcl, it's probably because the directory to hold auxiliary product info cannot be created.
+Make sure the directory (specified by the parameters EcommerceDataDirectory and ProductDataDirectory) exists.  By default, this is /web/yourserver/data/ecommerce/product/ .  Also make sure the permissions are correctly set (AOLserver has to be able to create new directories inside of this directory).
+
+<li>Now try to add a product <i>with</i> a picture.  If it can't be created, that may mean that ImageMagick is not installed or is not at the expected path (/usr/local/bin/convert).
+
+<li>Go to the customer service submodule  (https://yourserver/admin/ecommerce/customer-service/ -- or http:// instead of https:// if you don't have SSL) and add an interaction (if you get an error on interaction-add-2.tcl, that may mean the zip_codes table hasn't been loaded).   Use the email address of an existing user.  All the other information can be garbage.  Return to the main customer service admin page and find the issue you just created (look under Customer Service Issues).  When you're viewing the issue, click Send Email at the top.  Try sending email.  Possible problem #1: spell checker doesn't exist.  Solution: install spell checker (tools module).  Possible problem #2: can't send email.  Solution: install qmail on your machine.
+
+<li>Go to http://yourserver/ecommerce/ and click on one of the products you just added.  Add it to your shopping cart and try to check out (using a real credit card).  If all has gone well, you will never see finalize-order.tcl (you'll be redirected immediately to thank-you.tcl), but if you get an error on finalize-order.tcl that may mean that CyberCash has not been correctly set up.
+
+</ul>
+
+Once all this is working, you can further test your system:
+
+<ul>
+<li>Follow the setup instructions in
+<a href="ecommerce-setup.html">Setup of the Ecommerce Module</a>
+<li>Go to the user pages at http://yourserver/ecommerce/ and place
+orders, write reviews of products, join mailing lists, view your
+account, etc.
+<li>Return to the admin pages and do some maintenance (see <a href="ecommerce-operation.html">Operation of the Ecommerce Module</a> for details).
+</ul>
+
+<h3>Display Module</h3>
+Test cascaded style sheet settings and uploading of a logo
+<ul>
+<li>changing background color
+<li>changing body text color
+<li>changing color of the links
+<li>changing color of the visited links
+<li>changing the font type
+<li>changing links display (underlined, non-underlined, ...)
+<li>uploading logo
+<li>enabling and disabling logo
+</ul>
+
+<h3>General Comments</h3>
+Test tcl procedures used for adding comments to pages and test
+general comments admin pages
+<ul>
+<li>adding a comment using <code>ad_general_comment_add</code>
+<li>updating a comment using <code>ad_general_comment_update</code>
+<li>displaying general comments using <code>ad_general_comments_summary</code> 
+  and <code>ad_general_comments_summary_sorted</code>
+<li>approving/disapproving a comment through admin pages
+<li>editing a comment through admin pages
+<li>deleting a comment through admin pages
+<li>using dimensions on admin pages (sections, approving/disapproving, number of days)
+</ul>
+
+<h3>Help</h3>
+Make sure that help links work and that appropriate .help files are used
+
+<h3>Content Sections</h3>
+Test content section admin pages
+
+<ul>
+<li>add a static section
+<li>add a module (for groups having a complete module administration)
+<li>add a custom sections (for groups having custom section module installed
+<li>edit section properties (section key, section pretty name, sort
+key, help, intro)  
+<li>enable/disable sections
+<li>test view links on content-sections index page
+<li>section navigation (make sure that correct navigation bars are generated)
+</ul>
+
+<h3>New modules</h3>
+
+ Systematically go through each option making sure:
+<ul>
+<li> Instructions and page flow make sense
+<li> Page layout is standard
+<li> All inserts are immune to double clicks
+<li> Links are all valid
+<li> Everything is spelled correctly   
+<li> You can't type in data that will cause errors. Try ', ", and blank entries
+</ul>
+
+<h3>Intranet</h3>
+Suggested Method:<br>
+<ul>
+  <li> <b>Setup</b>
+  <ul>
+    <li> Set IntranetEnabledP=1 in the server .ini file and restart your web server
+    <li> Create an account for yourself
+    <li> goto /intranet - should be denied access.
+    <li> Log in as a site-wide administrator
+    <li> Add yourself as an employee (from Employee Administration)
+    <li> Go back to employee administration and add yourself as an Intranet Administrator
+    <li> Go to the admin user group page for intranet. Add news and address-book as modules associated with groups in intranet.
+    <li> Log in as yourself - should be automatically redirected to intranet workspace
+  </ul>
+  
+  <p><li> <b>Testing</b>
+  <ul>
+    <li> Add an office. Add yourself to that office and make yourself the primary contact. Email the office.
+    <li> Add a partner. Add a contact to and a correspondence with that partner. Spam people working with the partner.
+    <li> Add a procedure.
+    <li> Add a customer (Make sure it's marked as current).
+    <li> Add a project.
+    <li> Create a ticket tracker from the project page.
+    <li> Remove yourself from the project.
+    <li> Go back to your workspace. Make sure your customer shows up.
+    <li> Move your customer from current to past state.
+    <li> Click on status report. Make sure customer status change shows up.
+    <li> Click on "Your public information" and make sure your office comes up.
+    <li> Log some hours. 
+    <li> Add an office absence.  Edit it.  Remove it.
+    <li> Upload a portrait of yourself.
+    <li> Edit your public information.
+    <li> Edit your h.r. information.
+    <li> Change your password, log out and back in.
+    <li> Add a couple of new users and make them employees from Employee Administration.
+    <li> Create one or two direct reports by setting the users' supervisor id's to you.
+    <li> Create some direct reports for your direct reports.
+    <li> Check the org chart from your workspace.
+  </ul>
+</ul>
+
+<h3>Data Pipeline</h3>
+Data Pipeline will be fully exercised by the Intranet module.
+
+<h3>Simple Survey</h3>
+You should test creating a new survey, editing a survey, enabling a survey, 
+responding to a survey and viewing responses.
+
+<ul>
+  <li> Creating a new survey:
+    <ul> 
+    <li> log in as a simple survey administrator
+    <li> go to /survsimp/admin/ and create a new survey
+    </ul>
+
+  <li> Editing a survey:
+    <ul> 
+    <li> log in as a simple survey administrator
+    <li> go to /survsimp/admin/ and select the survey to edit
+    <li> edit description
+    <li> add new categories
+    <li> insert new questions
+    <li> change question properties: active/inactive, response required/not required,
+    order (swap with previous)
+    <li> delete a question; repeat this step after having responded to the survey
+    and viewed the responses
+    <li> go to /survsimp/ and check that the new survey isn't listed
+    </ul>
+
+  <li> Enabling a survey:
+    <ul> 
+    <li> log in as a site-wide administrator
+    <li> go to /admin/survsimp/
+    <li> enable the survey
+    </ul>
+
+  <li> Responding to a survey:
+    <ul> 
+    <li> log in as a regular user
+    <li> go to /survsimp/
+    <li> check that the new survey is now listed and select it
+    <li> submit responses
+    <li> respond again to the same survey and check your previous responses
+    </ul>
+
+  <li> Viewing responses:
+    <ul> 
+    <li> log in as a simple survey administrator
+    <li> go to /survsimp/admin/
+    <li> select the survey to check
+    <li> view responses by user and summary of responses and check that your 
+    responses were correctly inserted
+    </ul>
+</ul>
+
+<h3>WimpyPoint</h3>
+
+<ul>
+<li>Go to /wp and create a new, public presentation. Select "I'll provide my own" as the style.
+<li>Create a fancy style with wacky colors. Verify that the color picker widgets work
+properly.
+<li>Add an image. Verify that clicking on the image filename displays the image.
+<li>Go to the list of presentations. Verify that the presentation shows up.
+<li>Edit the presentation. Add several slides with some attachments. Return to the
+main editing page for your presentation by clicking your presentation's title in the
+navigation bar.
+<li>Click <i>Show presentation, viewing comments from collaborators and "edit" links</i>.
+Make a comment or two.
+<li>Log out. Go to http://<i>yourservername.com</i>/wp/ and view your presentation.
+<li>Log back in. Click <i>Edit the presentation properties</i>, change a thing or
+two, and save your changes.
+<li>Bulk copy slides from one of your presentations into the current presentation,
+and from a presentation belonging to another user. (Just follow onscreen prompts.)
+Verify that the slides were properly added.
+<li>Create a ZIP file containing several images (GIF, JPG, or PNG). Upload the
+batch, verifying that the slides were properly added.
+<li>Change the order of slides in the presentation.
+<li>Click <i>Change people who can view/edit this presentation</i> and:
+  <ul>
+    <li>Make the presentation private.
+    <li>Invite an ACS user to view and make changes to the presentation.
+    <li>Invite a non-ACS user to administer the presentation (decide who gets to
+view/edit it.)
+  </ul>
+  Ensure that both users receive emails, and that following the instructions in
+  the emails gives them appropriate access to the presentation.
+<li>Freeze the current slide set. Make a change to a slide. View the previous
+(frozen) version of the presentation, ensuring that the change is not apparent
+here. View the current version of the presentation, ensuring that the change <i>is</i>
+apparent here. Revert to the original version of the presentation, ensuring that
+the change has disappeared.
+<li>Log out, ensuring that the public cannot see the (now-private) presentation.
+<li>Log back in and delete the presentation.
+</ul>
+
+<h3>CRM</h3>
+<ul>
+<li>Go to the admin page and add at least two states.
+<li>Add some transitions. Try to pick conditions so that it will be
+true for at least some people. Example: Users who have had some
+activity in the last month: 0 < activity_since(user_id,
+add_months(sysdate, -1)).
+<li>Run the state machine a few times and see if any users move around
+from state to state.
+</ul>
+
+<h3>Referer Module</h3>
+<ul>
+<li>Make sure the referer parameter section of the server.ini file is set up correctly.
+<li>Go to some other web server, create a page with a link to the
+server you are testing on. Click on that link a few times.
+<li>Go to the referer admin page and see if your clicks were recorded.
+(Note: there's a cutoff so referers with only a few counts don't show. 
+If you select a report for one day only, three clicks on the referring link should do the trick).
+</ul>
+
+<h3>Member Value Module</h3>
+<ul>
+<li>Make sure the member value parameter section of the server.ini file is switched on .
+<li>Go to a page which supports member value (e.g. delete a bboard message).
+<li>Execute the page (e.g. actually delete a bboard message and charge the user for it).
+<li>Go to admin pages, member value. Look at expensive users and all charges. If your charge shows up there, fine, otherwise it's broken (aka this document is badly written).
+<li>Make sure you switch the parameter off again after testing.
+<li>If you stumble across an error on other pages related to member value, please inform the module owner, as he has no clue where the calls to member value are and will be used, as this is and will be the responsibility of every single module owner (this being a meta system).
+</ul>
+
+<h3>Education Module</h3>
+<ul>
+<li>Go to /admin/education/ and create a new department.
+<li>Go to the admin page of your new department.
+<li>Add a user to the deparment.
+<li>Add a subject to the department.
+<li>Go to the admin page for the subject.
+<li>Add a class under the subject.
+<li>Go to the class's admin page.
+<li>Upload a syllabus.
+<li>Add an assignment.
+<li>Add lecture notes.
+<li>Go to the permissions page and make sure that there are values under
+the roles (e.g. where it says Singular and Plural, there should be four
+roles there).  If there are not, then the trigger that creates those roles
+were not created properly.
+</ul>
+
+<h3>Glassroom</h3>
+<ul>
+<li>Add one each of: logbook entry, software module, procedure, service,
+    host, certificate, domain
+<li>From /glassroom, 'view' each entry by clicking on it's entry
+    in each section (i.e. logbook, software modules, etc.) You should
+    have a successful view of each page, then just back arrow to /glassroom.
+<li>There is no /admin/glassroom section, and no delete function, so
+    go into sqlplus and delete the entries from the glassroom tables.
+</ul>
+
+<a name="robot"><h3>Robot Detection</h3></a>
+
+In order to test the Robot Detection package, we need to be able to
+request URLs from the site with a <code>User-Agent</code> that is
+listed in the <code>robots</code> table and see for ourselves that the
+results are as expected.
+
+<p>
+
+The simplest approach to testing this is to add a
+<code>FilterPattern</code> into the
+<code>[ns/server/<em>yourservername</em>/acs/robot-detection]</code>
+section of the parameters file and to add a record into
+<code>robots</code> that matches a web browser program and use that
+browser to access the site. The following SQL works for Microsoft
+Internet Explorer 4.01 on Windows NT:
+
+<pre>
+insert into robots(robot_id, robot_name, robot_details_url, robot_useragent)
+values('msie4', 'Microsoft Internet Explorer 4.0 (for testing purposes only)',
+'http://www.microsoft.com/ie/', 'Mozilla/4.0 (compatible; MSIE 4.01; Windows NT)');
+</pre>
+
+Just be sure to delete this row when you go into production!
+
+<p>
+<hr>
+<a href="http://teadams.com"><address>teadams@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/ad-partner.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/ad-partner.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/ad-partner.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,212 @@
+  <html>
+<head>
+  <title>Partner Co-Branding</title> 
+</head>
+<body bgcolor=white>
+<h2>Partner Co-Branding</h2>
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="mailto:mbryzek@arsdigita.com">Michael Bryzek</a>
+
+<hr>
+
+<blockquote>
+
+
+
+<ul>
+<li>User-accessible directory:  None (It's transparent to users)
+<li>Site administrator directory:  <a href="/admin/partner/">/admin/partner/</a>
+<li>data model :  <a href="/doc/sql/display-sql.tcl?url=/doc/sql/ad-partner.sql">/doc/sql/ad-partner.sql</a>
+<li>Tcl procs:  /tcl/ad-partner.tcl
+</ul>
+
+<B>Public demonstrations: </b>
+  <ul>
+
+    <li> <a href=http://www.guidestar.org/gs/search>GuideStar Search</a>
+    <li> <a href=http://www.guidestar.org/aol/search>GuideStar Search</a>  (co-branded for AOL's <a href=http://www.helping.org>helping.org</a>)
+    <li> <a href=http://www.guidestar.org/schwab/search>GuideStar Search</a>  (co-branded for Schwab's <a href=http://www.schwabcharitable.org/>www.shwabcharitable.org</a>)
+
+  </ul>
+
+<h3>What is Co-Branding?</h3>
+Co-branding refers to the ability to make one page maintain full functionality while swapping in a
+new look-and-feel. Co-Branding must be easy to do - that is, we do not want to maintain duplicate
+files for every single co-brand partner... one file should be able to generate multiple look-and-feels
+with no modification to the single file.
+
+
+<h3>The Big Picture</h3>
+Many sites market their functionality to other websites - sometimes for money, but always to generate
+more traffic. A lot of the big sites on the web will only partner with your puny-in-comparison web
+service if you provide them with your site functionality but maintain the look-and-feel of their
+website. 
+<p>
+The brute force method to doing this is to use the <a href=style.html>ad-style</a> system and
+create a separate adp file for every single page you want to co-brand, and for every partner you
+want to support. This quickly gets out-of-hand if you support more than a couple partners and more
+than a couple pages.
+<p>
+This partner module lets you co-brand directories, as opposed to individual files, on a 
+partner-by-partner basis. And, once the files in a directory have been set-up to support co-branding,
+adding another partner takes almost no time at all (about 30 minutes to 4 hours depending on the 
+complexity of the new partner's html templates and the quality of their html). That's the point - in
+30 minutes, you can co-brand an entire directory for a new partner. If that directory contains 100 files,
+you've added templates to 100 files at a rate of 20 seconds per page - that's pretty efficient.
+<p>
+Co-branding works by separating a page into three components:
+<ol> 
+  <li> <b>The Header</b>: This refers to the top and left side of the page including, for example,
+       top graphics, left menu bars, etc.
+  <li> <b>Page Contents</b>: This refers to the actual contents of the page - the functionality, 
+       the features,
+       results of database queries etc. For co-branding to work with the ad-partner module, the
+       Page Contents must be shared by all partners (If you need custom page contents for individual 
+       pages, the <a href=style.html>ad-style</a> system is for you.
+  <li> <b>The Footer</b>: This refers to the bottom and right side of the page including.
+</ol>
+
+<h3>The Medium-Sized Picture</h3>
+For each directory that you want to cobrand, you add a new "partner" through the 
+<a href=/admin/partner/>Partner Manager</a>. Each partner has some default properties associated 
+with it, such as what fonts to use, what colors to use, etc. The most important property is the 
+Partner Cookie - ad-partner is cookie based. When you add a partner, you specify the name of the
+cookie you want to use to uniquely identify that partner. When the aolserver starts-up, it registers
+each of the partner-cookies to redirect requests for any url with starting with that cookie to a procedure
+that sets a user cookie (named ad_partner) and redirects to whatever page was specified after the cookie.
+
+<p>
+For example, with GuideStar.org, we have 3 partners:
+<ul>
+  <li> GuideStar (cookie=gs): <a href=http://www.guidestar.org/gs/search>http://www.guidestar.org/gs/search</a>
+  <li> AOL (cookie=aol): <a href=http://www.guidestar.org/aol/search>http://www.guidestar.org/aol/search</a>
+  <li> Schwab (cookie=schwab): <a href=http://www.guidestar.org/schwab/search>http://www.guidestar.org/schwab/search</a>
+</ul>
+Note that the final page no longer has the cookie in it! 
+
+<p>
+By using the cookie system, we avoid having to register procs or think about how we create links
+on our pages - it's all taken care of behind-the-scenes.
+
+<h3>Using ad-partner</h3>
+If your version of acs includes ad-partner, you'll need not configure anything to create your first
+co-branded page as ad-partner comes with a default profile set up for ArsDigita look and feel.
+In fact, the entire <a href=/admin/partner>/admin/partner</a> directory uses the partner system
+to generate it's own look and feel even though it is not necessary. (ad-partner frees you from ever 
+having to think about page headers and footers while you write your pages).
+<p> 
+To Create your first ad-partner page, simply put the following .tcl file anywhere in your file tree:
+<pre>
+ReturnHeaders
+set page_title "My first co-branded page"
+set context_bar [ad_context_bar [list "/index.tcl" "Home"] "Test Page"]
+ns_write "
+[ad_partner_header]
+I just wanted to see what it's like to work with ad-partner
+[ad_partner_footer]
+"
+</pre>
+And that's it! 
+
+<p><b>How this page is processed</b>
+<br>
+The call to ad_partner_header triggers the following sequence of events:
+<ol>
+  <li> We look at your current url and query the view ad_partner_header_procs to look
+       for tcl procedures that have been registered for that url. Note that we do not 
+       require a db handle to be passed as the db handle is only used if necessary.
+  <li> If we don't find any tcl procedures, we try the parent directory. Eventually we 
+       come to the root directory "/" for which ad-partner already registered two procedures
+       (Check the installation script for ad-partner)
+  <li> ad-partner memoizes the list of procedures to run for your current url to avoid hitting 
+       the database next time you request the same url.
+  <li> ad-partner runs the list of procedures, in the order specified (check out the Partner Manager
+       to see the order). These procedures simple call [ad_header $title] (note title is grabbed
+       from your calling environment) and append some additional html to the result.
+  <li> The html string is returned.
+</ol>
+We process the rest of the page as usual, and then reach the call to ad_partner_footer, which triggers
+the same sequence of events as for ad_partner_header, except we use the view ad_partner_footer_procs.
+
+<p>
+To co-brand an existing acs file with:
+<ol>
+  <li> Use the Partner Manager to register the tcl procedures to run for a given directory
+  <li> Replace ad_header with ad_partner_header
+  <li> Replace ad_footer with ad_partner_footer
+</ol>
+
+Note: There is another way to return co-branded pages, which I prefer:
+<pre>
+set page_title "My first co-branded page"
+set context_bar [ad_context_bar [list "/index.tcl" "Home"] "Test Page"]
+set page_body "I just wanted to see what it's like to work with ad-partner"
+ns_return 200 text/html [ad_partner_return_template]
+</pre>
+ad_partner_return_template simply looks for $page_body and then generates
+the appropriate page. This way of using the partner system has the added benefit that you can
+release your database handle(s) before returning any html (just be sure the page loads quickly 
+or else your users will look at a blank screen!).
+
+<h3>Under the hood</h3>
+
+<b>Parameters File:</b>
+<pre>
+[ns/server/vs/acs/partner]
+; what is the name of the default partner cookie?
+CookieDefault=ad
+; All the variables we want to collect  (Any variables added here
+; must still be manually added to the data model.)
+; Each line of Variable= contains a pipe separated pair of 
+; name_of_column in ad_partner | what to display on the add/edit forms
+Variable=partner_name|Partner Name
+Variable=partner_cookie|Partner Cookie
+Variable=default_font_face|Default Font Face
+Variable=default_font_color|Default Font Color
+Variable=title_font_face|Title Font Face
+Variable=title_font_color|Title Font Color
+</pre>
+
+Note that except for group_id, all variables should be listed in the parameters file.
+We separate group_id to make a nice select box on the UI to easily tie a set of partner
+parameters to a user_group.
+
+<p><b>Accessing variables defined in the Partner Manager</b>
+All the variables you create using the Partner Manager can be accessed in tcl with this call:
+<pre>
+[ad_partner_var name_of_column]
+</pre>
+ad_partner_var memoizes the result to make retrieving partner variables fast.
+<p>
+Because we use fonts so often, there are two helper procedures to make getting font definitions
+easy:
+<pre>
+proc_doc ad_partner_default_font { {props ""} } {Returns an html font tag with the default font face and default font color filled in from the partner database. If props is nonempty, it is simply included in the font statement} {
+
+    set html "&lt;font face=\"[ad_partner_var default_font_face]\" color=\"[ad_partner_var default_font_color]\""
+    if { ![empty_string_p $props] } {
+	append html " $props"
+    }
+    return "$html&gt;"
+}
+
+proc_doc ad_partner_title_font { {props ""} } {Returns an html font tag with the default font face and default font color filled in from the partner database. If props is nonempty, it is simply included in the font statement} {
+    set html "&lt;font face=\"[ad_partner_var title_font_face]\" color=\"[ad_partner_var title_font_color]\""
+    if { ![empty_string_p $props] } {
+	append html " $props"
+    }
+    return "$html&gt;"
+}
+
+</pre>
+
+I don't think there is anything particularly interesting about the 
+<a href=/doc/sql/display-sql.tcl?url=/doc/sql/ad-partner.sql>Data Model</a> so I've left it in it's own file.
+
+
+
+
+</blockquote>
+<hr size=1>
+<i>written by <a href=mailto:mbryzek@arsdigita.com>mbryzek@arsdigita.com</a> in January 2000</i>
+</body></html>
Index: web/openacs/www/doc/address-book.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/address-book.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/address-book.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,41 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Address Book system</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Address Book system</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://eveander.com/">Eve Andersson</a>
+
+<hr>
+
+<ul>
+<li>User-accessible directory:  <a href="/pvt/address-book/">/pvt/address-book/</a>
+<li>Site administrator directory:  <a href="/admin/address-book/">/admin/address-book/</a>
+<li>data model :  <a href="/doc/sql/display-sql.tcl?url=/doc/sql/address-book.sql">/doc/sql/address-book.sql</a>
+<li>Tcl procs:  /tcl/address-book-defs.tcl
+</ul>
+
+
+This is a really simple address book which also does birthday
+reminders.  Although the RemindMe service does birthday reminders
+beautifully, I find it convenient to have the birthdays along with 
+the other information about people in my address book, so I might
+as well send out the reminders with this module instead of making
+the user key the birthday information both here and in RemindMe.
+
+<p>
+
+This module, which contains nothing remotely fancy, has lots of
+room for improvement, for instance, categorization of people 
+(personal vs. business) or other ways of browsing records.  It also
+should have ways to share records in the standard ACS way:  public,
+group, and private ownership.
+
+<hr>
+<a href="http://eveander.com/"><address>eveander@arsdigita.com</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/adserver.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/adserver.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/adserver.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,86 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>/adserver system</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>/adserver system</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+<ul>
+<li>User-accessible directory:  none 
+<li>Site administrator directory:  <a href="/admin/adserver/">/admin/adserver/</a>
+<li>data model :  <a href="/doc/sql/display-sql.tcl?url=/doc/sql/adserver.sql">/doc/sql/adserver.sql</a>
+
+</ul>
+
+
+Remember that the underlying rationale for the ad server is set forth in
+<a href="http://photo.net/wtr/thebook/community.html">Chapter 3 of "the
+book"</a>.
+
+<P>
+
+GIF or JPEG files for ads are stored in /ads.   References look like 
+
+<blockquote>
+<pre>
+&lt;a href="/adserver/adhref.tcl?adv_key=pfizer"&gt;
+&lt;img src="/adserver/adimg.tcl?adv_key=pfizer"&gt;
+&lt;/a&gt;
+</pre>
+</blockquote>
+
+<p>
+
+If the ad server gets confused, it tries to always serve up something to
+fill the space.  It looks for <code>[ad_parameters DefaultAd
+adserver]</code> and <code>[ad_parameters DefaultTargetUrl adserver]</code>.
+If it can't find those, it notifies the site administrator to define
+them.
+
+<p>
+
+The major feature of the adserver not covered by the book is that there
+is a notion of ad groups.  For example, if there are four ads that you'd
+like a user to see in sequence, you can make them part of a group and
+then make all the pages in a section of a site reference that group.  
+The page need only call <code>adv_ad_from_group</code> with the
+<code>group_key</code> as an argument and it will get back a reference
+to the next appropriate ad from that group.
+
+
+<blockquote>
+<pre>
+-- this is for publishers who want to rotate ads within a group
+
+create table adv_groups (
+	group_key	varchar(30) not null primary key,
+	pretty_name	varchar(50)
+);
+
+-- these will rotate in the order spec'd (ascending, e.g., 0, 1, 2...) 
+-- unless rotation_order is always NULL or is the same integer
+-- in which case the order will be determined by however Oracle feels like
+-- giving us the rows
+
+create table adv_group_map (
+	group_key	not null references adv_groups,
+	adv_key		not null references advs,
+	rotation_order	integer,
+	primary key (group_key,adv_key)
+);
+</pre>
+</blockquote>
+
+
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/aolserver3.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/aolserver3.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/aolserver3.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,103 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Upgrading an ACS installation to AOLserver 3.0</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Upgrading an ACS installation to AOLserver 3.0</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="mailto:markd@arsdigita.com">Mark Dalrymple</a>
+
+<hr>
+
+<h3>Configuration Changes</h3>
+
+<blockquote>
+
+AOLserver 3 removed a lot of functionality from AOLserver 2.3.3 that
+ACS depends on.  We've either copied implementions from our AOLserver 2.3.3
+installation or reimplemented them from scratch.
+
+<p>
+
+You'll need to have <a href=???>000-aolserver-3-specific.tcl</a> in your
+tcl library, which is in <code>/tcl</code> in a typical ACS installation.
+
+<p>
+
+You'll also need to have the newer 2.0 or later version of the ArsDigita
+<a href="http://arsdigita.com/free-tools/oracle-driver.html">Oracle Driver</a>
+
+<p>
+
+Tcl page support is also needed.  You can either pick up 
+<a href="http://www.dqd.com/~mayoff/aolserver/">Rob Mayoff's
+Tcl page module</a>, which is a C-based add-on which includes caching
+of tcl pages, or the original <a href=???>file.tcl</a>.
+<i>??? Maybe just include file.tcl's guts in 000-aolserver-3-specific.tcl ???</i>
+
+</blockquote>
+
+
+<h3>Inittab Changes</h3>
+
+<blockquote>
+
+If you have more than one AOLserver process which has the same
+server name (e.g. photonet.ini has a server named photonet, and
+photonet-dev.ini also calls its server photonet), you need to 
+<strong>not</strong> use the <code>-k</code> (kill) option
+in inittab.  AOLserver 3 stores the process ID (pid) in 
+<code>log/nspid.servername</code>.  If there's two servers with
+the same server name, they'll end up trying to kill each other.
+(need more coherent explanation of why)
+
+</blockquote>
+
+
+
+<h3>.ini Changes</h3>
+
+<blockquote>
+
+
+To make ns_register_adptag work (which includes things like
+<code>&lt;codeexample&gt;</code> defined in
+<code>teaching-defs.tcl</code>) you'll need to have this configuration
+file entry:
+
+<blockquote><pre>
+[ns/server/photonet/adp/parsers]
+fancy=.adp
+</pre></blockquote>
+
+By default, AOLserver 3 uses the plain ADP parser which doesn't support
+things like streaming, the &lt;script&gt; tag, and registerested ADP
+tags.  The fancy parser adds these back in.
+
+<p>
+
+To make your log files roll in a Y2K compliant fashion, be sure you
+have a <code>rollfmt</code> which uses <code>%Y</code> (4 digit year)
+and not <code>%y</code> (2 digit year):
+
+<blockquote><pre>
+[ns/server/photonet/module/nslog]
+RollFmt=<strong>%Y</strong>-%m-%d-%H:%M
+</pre></blockquote>
+
+<p>
+
+You no longer need to suppy a <code>systemScope=on</code> entry in
+the <code>[ns/threads]</code> section.
+
+</blockquote>
+
+
+<hr>
+
+<a href=mailto:markd@arsdigita.com><address>markd@arsdigita.com</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/architecture-install.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/architecture-install.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/architecture-install.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,494 @@
+<html>
+<!--AD_DND-->
+<HEAD><TITLE>ArsDigita Server Architecture Setup Instructions</TITLE></HEAD>
+<BODY bgcolor=#ffffff text=#000000>
+<h2>ArsDigita Server Architecture Setup Instructions</h2>
+by <A href="http://teadams.com">Tracy Adams</a> and <A href="http://haverkamp.com">Greg Haverkamp</a>, a companion to 
+<a href="http://photo.net/wtr/arsdigita-server-architecture.html">ArsDigita Server Architecture</a>
+
+<hr>
+<ul>
+<li>bug reports: <a href="mailto:acs-bugs@arsdigita.com">acs-bugs@arsdigita.com</a>
+<li>philosophy:  
+<a href="http://photo.net/wtr/arsdigita-server-architecture.html">ArsDigita Server Architecture</a>
+</ul>
+
+This document describes the installation procedures for a server conforming to the ArsDigita Server Architecture.
+
+<h3>Prerequisites</h3>
+
+This document assumes you have a server preconfigured with the following:
+<ul>
+<li>Oracle 8 (or higher)
+<li>AOLserver
+<li><a href="http://www.arsdigita.com/free-tools/oracle-driver.html">ArsDigita Oracle driver for AOLserver</a>
+<li>A working MTA (Mail Transfer Agent) that is willing to relay from all IP addresses on the machine.
+</ul>
+
+<h3>Checklist for a properly installed ArsDigita Server Architecture</h3>
+<ul>
+<li> Web site responding
+<li> Nightly database exports succeeding
+<li> Machine backups are being performed
+<li> KeepAlive sends alerts and restarts server when the virtual server is down or can't reach the database
+<li> Uptime sends alerts when outside connectivity to machine fails
+<li> Staff server is properly installed
+<li> Reporte is producing log reports
+<li> WatchDog is monitoring server log  (not necessary if you use
+Cassandracle inside ACS)
+<li> Cassandrix is monitoring disk space conditions
+<li> Cassandracle is monitoring the Oracle server (not necessary if you 
+use Cassandracle inside ACS)
+<li> MTA Monitor is monitoring the mail server 
+<li> Development server is being utilized
+</ul>
+
+<h3>Installation steps</h3>
+
+All ArsDigita services are given a unique name.  Throughout the rest of this document, we will be using <i>service_name</i> as the name of the service.  You will want to replace instances of <i>service_name</i> with the real name of the service you're creating.
+
+
+<ol>
+<li>Decide on the <b>physical machine</b> for your web service.  <i>Your team leader should know this.</i>
+<li>Setup a system account for your use when working on the system. 
+<p>
+<i>This requires root access to the machine. One team member should be in charge of root commands.</i>
+<ul>
+  <li>Connect to the machine as <code>root</code> using <code>ssh</code>:
+  <blockquote><code>ssh -l root machine_name</code></blockquote>
+  <li>Using <code>useradd</code>, create your account with primary group <code>arsdigit</code> and secondary group <code>dba</code>
+    <blockquote>
+    <code>
+    <pre>
+    useradd -g arsdigit -G dba -m username
+    </pre>
+    </code>
+    <p>
+    (see <code>man useradd</code> for more details about this step.)
+    </blockquote>
+  <li>Select a password for your account
+    <blockquote>
+    <code>
+    <pre>
+    passwd username
+    </pre>
+    </code>
+    </blockquote>
+</ul>
+
+<li>Prepare Oracle for ACS
+  <ul>
+    <li>Connect to oracle using <code>svrmgrl</code> <p>
+    <b>Note: you must be in the <code>dba</code> group to use <code>svrmgrl</code></b> (this should have been accomplished in step 2.)
+    <blockquote> 
+    <code><pre>
+    $ svrmgrl
+    
+    Oracle Server Manager Release 3.1.5.0.0 - Production
+    
+    (c) Copyright 1997, Oracle Corporation.  All Rights Reserved.
+
+    Oracle8i Enterprise Edition Release 8.1.5.0.0 - Production
+    With the Partitioning and Java options
+    PL/SQL Release 8.1.5.0.0 - Production
+
+    SVRMGR> connect internal
+    Connected.
+    </pre></code>
+    </blockquote>
+    <li>Find where the tablespaces are stored
+<blockquote><code><pre>
+SVRMGR>  select file_name from dba_data_files;
+</pre></code></blockquote>
+Example results:
+<blockquote><code><pre>
+/ora8/m01/app/oracle/oradata/ora8/system01.dbf
+/ora8/m01/app/oracle/oradata/ora8/oemrep01.dbf
+/ora8/m01/app/oracle/oradata/ora8/rbs01.dbf
+/ora8/m01/app/oracle/oradata/ora8/temp01.dbf
+/ora8/m01/app/oracle/oradata/ora8/users01.dbf
+/ora8/m01/app/oracle/oradata/ora8/indx01.dbf
+/ora8/m01/app/oracle/oradata/ora8/drsys01.dbf
+/ora8/m02/oradata/ora8/jsc01.dbf
+</pre></code></blockquote>
+<li>Using the above output, you should determine where to store your tablespace.  As a general rule, you'll want to store your tablespace on a mount point (the <code>m0<i>n</i></code> subdirectories in the above listing) separate from the Oracle system data files. In this example, we'll use <code>/ora8/m02/oradata/ora8/</code>.
+     <li> Create a tablespace for the service.  It is important that
+the tablespace can <code>autoextend</code>.  This allows the tablespace's storage capacity to grow as the size of the data grows.
+<blockquote><pre><code>
+SVRMGR> create tablespace <i>service_name</i> datafile '/ora8/m02/oradata/ora8/<i>service_name</i>01.dbf' size
+50m autoextend on default storeage ( pctincrease 0);
+</code></pre></blockquote>
+    <li> Create a database user for this service. Give the user access to the tablespace and rights to connect. (Substitute <code>database_password</code> with the appropriate password.)
+<blockquote><code><pre>
+SVRMGR> create user <i>service_name</i> identified by <i>database_password</i> default tablespace <i>service_name</i>
+temporary tablespace temp quota unlimited on <i>service_name</i>;
+
+SVRMGR> grant connect, resource, ctxapp to <i>service_name</i>;
+
+</code></pre></blockquote>
+
+   <li> Run "sqlplus <i>service-name</i>" to make sure your Oracle user works correctly. (Very bad things can happen to Oracle if AOLServer repeated tries to connect with a misconfigured Oracle account).
+<P>
+   <li> <b>Transfer data:</b> If you are moving the service from one location to another, export code for the old database and import into the new.
+<blockquote>
+To export:�
+<code><pre>
+exp <i>service_name</i>/<i>database_password</i> file=foo.dmp consistent=y full=y
+</pre></code>
+<p>
+To  import:
+<code><pre>
+imp <i>service_name</i>/<i>database_password</i> file=foo.dmp [fromuser=olduser touser=<i>service_name</i>]
+</pre></code>
+</blockquote>
+
+    <li>Should it become necessary to rebuild a tablespace from scratch, you can use the <code>drop user</code> command with the <code>cascade</code> option.  This command will drop the user and every database object the user owns.
+<blockquote><code>drop user <i>service_name</i> cascade </code>
+<p>If this does not work because svrmgrl "cannot drop a user that is currently connected", make sure to kill the AOLserver using this user.  If it still does not work, do:
+<p>
+<code> select username, sid, serial# from v$session where username='<i>service_name</i>'; </code> <p>
+and then 
+<p>
+<code>alter system kill session '<i>sid</i>,<i>serial#</i>';</code>
+<p>
+where <i>sid</i> and <i>serial#</i> are replaced with the corresponding values for the open session.
+<p><b>Use with caution!</b><p>
+If you feel the need to delete <i>everything</i> related to the service, you can also issue the following:
+<code><pre>
+drop tablespace <i>service_name</i> including contents ;
+</pre></code>
+</ul>
+</ul>
+<li>Set up <b>nightly Oracle exports</b>
+<p>
+<ul>
+<li> Find out if oracle exports are running on the machine.
+<blockquote>
+<code>
+crontab -l | grep export-oracle
+</code>
+</blockquote>
+You should see a line similar to the following:
+<blockquote>
+<code>
+0 23 * * * /usr/local/sbin/export-oracle
+</code>
+</blockquote>
+
+If you don't see it, you should add it:
+<blockquote><code><pre>EDITOR=emacs crontab -e</pre></code></blockquote>
+
+<li>Make sure <code>/usr/local/sbin/export-oracle</code> has the correct environmental variables.<p>
+Compare the settings in <code>/usr/local/sbin/export-oracle</code> with:
+<blockquote>
+<code><pre>
+# su -l oracle
+Sun Microsystems Inc.   SunOS 5.6       Generic August 1997
+$ env
+HOME=/home/oracle
+HZ=
+LD_LIBRARY_PATH=/ora8/m01/app/oracle/product/8.1.5/lib:/usr/lib:/lib:/usr/openwin/lib
+LOGNAME=oracle
+ORACLE_BASE=/ora8/m01/app/oracle
+ORACLE_HOME=/ora8/m01/app/oracle/product/8.1.5
+ORACLE_SID=ora8
+ORACLE_TERM=vt100
+ORAENV_ASK=NO
+PATH=/ora8/m01/app/oracle/product/8.1.5/bin:/ora8/m01/app/oracle/product/8.1.5/bin:/usr/local/bin:/sbin:/bin:/usr/sbin:/usr/bin:/usr/local/sbin:/usr/ccs/bin:/usr/ucb:/usr/dt/bin:/usr/openwin/bin:/usr/local/bin:/usr/sbin
+SHELL=/bin/sh
+TERM=vt100
+TZ=US/Eastern
+</pre></code>
+</blockquote>
+
+<li>Choose a location for the dump files and modify <code>/usr/local/sbin/export-oracle</code> accordingly.  Your complete <code>export_oracle</code> file should look something like this:
+<blockquote>
+<code><pre>
+#!/bin/sh
+HOME=/home/oracle
+HZ=
+LD_LIBRARY_PATH=/ora8/m01/app/oracle/product/8.1.5/lib:/usr/lib:/lib:/usr/openwin/lib
+LOGNAME=oracle
+ORACLE_BASE=/ora8/m01/app/oracle
+ORACLE_HOME=/ora8/m01/app/oracle/product/8.1.5
+ORACLE_SID=ora8
+ORACLE_TERM=vt100
+ORAENV_ASK=NO
+PATH=/ora8/m01/app/oracle/product/8.1.5/bin:/ora8/m01/app/oracle/product/8.1.5/bin:/usr/local/bin:/sbin:/bin:/usr/sbin:/usr/bin:/usr/local/sbin:/usr/ccs/bin:/usr/ucb:/usr/dt/bin:/usr/openwin/bin:/usr/local/bin:/usr/sbin
+SHELL=/bin/sh
+TERM=vt100
+TZ=US/Eastern
+
+exportdir=/<i>export_root</i>/oracle-exports
+file=$exportdir/oraexport-<i>service_name</i>.dmp
+mv -f $file.gz $file.old.gz
+exp <i>service_name</i>/<i>database_password</i> file=$file owner=<i>service_name</i> consistent=Y
+gzip $file
+</pre></code>
+</blockquote>
+</ul>
+
+
+<li>Set up the <b>Arsdigita Community System</b> on your virtual server
+<ul>
+<li>Alot an IP address
+<ol>
+ <li> Find out which of the system's IP addresses aren't being used by another service (ignoring <code>localhost</code> (<code>127.0.0.1</code>): 
+<blockquote><code><pre>
+netstat -in | awk '{ print $4 }' | xargs -i% sh -c 'if [ `grep % /home/nsadmin/*.ini > /dev/null` $? -eq "1" ]; then echo %; fi'
+</pre></code></blockquote> 
+ <li> Select the first of the available IP addresses for your service.  Once you create the appropriate .ini file with the IP address, you should notify your syadmin that you have claimed this IP. 
+(ArsDigitans should do this by adding a ticket to the sysadmin ticket tracker on the intranet.)
+</ol>
+<li>Using <a href="/install/service-name.ini">service-name.ini</a> as a template,  follow the steps under <a href="#installing">Installing a virtual server</a>.   Follow the <a href="installation.html">Arsdigita Community System</a> where it says to install your service.
+
+<li>To prepare for <b>high volume</b>.
+<ul>
+<li> Make sure your AOLServer is configured to use all the machines processors. For multi-processor Solaris boxes,  include the following block in the <code>/home/nsadmin/service-name.ini</code> file:
+<blockquote>
+<pre>
+[ns/threads]
+; use more than 1 processor (Solaris)
+SystemScope=on
+</pre>
+</blockquote>
+
+<p>
+Note: If you have a single processor machine, <code>SystemScope=off</code> is more efficient.
+<p>
+<li>If you use adp pages, configure AOLServer to store parsed versions.
+<blockquote>
+<pre>
+[ns/server/service_name/modules]
+...
+nscache=nscache.so
+
+
+[ns/server/service_name/module/nscache]
+...
+CacheADP=on
+</pre>
+</blockquote>
+
+
+<li>It is tempting to increase the <code>MaxThreads</code> 
+parameter to get more performance.  Increasing this beyond 50
+causes more thrashing or more pages waiting for database
+handles. (AOL does some tuning on this parameter and generally
+settles on numbers between 8 and 75).
+
+
+<li>It is tempting to increase the number of database handles
+in your main pool.  Increasing beyond 8-12 can do more harm than
+good.  The Oracle client library running inside the AOLServer 
+process does not handle large number of connections efficiently.
+(It uses locks instead of more efficient multi-threading techniques). 
+
+
+<li>Look for handle-hogging pages.  These usually appear
+frequently and with long wait times on the bottom of monitor.tcl.
+<p>
+On handle-hogging pages (ie, intermedia searching), you don't
+want to tie up all your Oracle handles and deny service to everyone else.
+On these pages, you want to:
+<ul>
+<li> Obtain the handle as late as possible and release the handle
+as early as possible.
+<li> If possible, use only 1 handle from the pool.
+<li> Refrain from sending email when holding a handle.
+<li> Limit the number of times this page can run simultaneously.
+For example:
+
+<blockquote>
+<pre>
+if ![ad_return_if_another_copy_is_running 6] {
+    ns_log Notice "foo.tcl out of handles"
+    return
+}
+</pre>
+</blockquote>
+
+</ul>
+
+<li>If you have done the above and are still limited by db
+handles, you a limited by the ability of Oracle's client library
+to manage connections.  Symptoms:
+<ul>
+<li> monitor.tcl shows that all db-backed pages are backing up 
+<li> Oracle is not overloaded.  The nsd processes might be taking
+a large percentage of the machine's load or the CPU usage might
+not be high.
+</ul> 
+
+You can still get more hits out of the machine by
+<ul>
+<li>Adding another AOLServer process pointed at the same page root.
+<li>Configure DNS to do a round robin.
+</ul>
+
+<li>Host graphics on a separate machine.
+<li>Consider caching graphics
+
+<blockquote>
+<pre>
+[ns/server/service_name/modules]
+...
+nscache=nscache.so
+
+
+[ns/server/service_name/module/nscache]
+...
+CacheStatic=on
+</pre>
+</blockquote>
+
+<font color=red>Careful!</font>: 
+On a db-backed web site, you want to make sure the entire
+database is stored in RAM.  Caching graphics can be 
+counterproductive if it interferes with query performance.
+
+<li>Use multiple machines (see <a target=other href=http://photo.net/wtr/arsdigita-server-architecture.html>ArsDigita Server Architecture</a>)
+
+</ul>
+
+</ul>
+<li>Set up <b><a href=http://arsdigita.com/free-tools/keepalive.html>Keepalive</a></b>.
+<p> 
+Keepalive is a virtual server located on the same physical machine as your service.  It watches your service, notifies you of problems, and restarts it should it go down.  All the services on the same machine share the same <code>keepalive</code>.
+<p>
+If keepalive does not exist on your machine, you will have to install another virtual server on your machine.
+<ul>
+<li>Keepalive listens to port 1997.  Because this should not conflict with any other service, you may re-use an IP address used by another service.
+<li>Follow the directions for <a href="#installing">Installing a virtual server</a>. Use <a href="/install/keepalive.ini">keepalive.ini</a> as a template.  Since keepalive does not use Oracle, you can run <code> /home/nsadmin/bin/nsd</code> instead of <code>/home/nsadmin/bin/nsd-oracle</code>
+<li> To install the service, follow the <a href=http://arsdigita.com/free-tools/keepalive.html>Keepalive installation instructions</a>. 
+</ul> 
+<p>Once the Keepalive service is running, you need to test it:
+<ul>
+  <li> Test that keepalive is monitoring your service by moving <code>/web/service_name/SYSTEM/dbtest.tcl</code>
+  <blockquote><code><pre>
+  mv /web/<i>service_name</i>/SYSTEM/dbtest.tcl /web/<i>serice_name</i>/SYSTEM/dbtest.tcl.moved
+  </pre></code></blockquote>
+  <li> Fix  <code>/web/service_name/SYSTEM/dbtest.tcl</code> by moving it back
+  <blockquote><code><pre>
+  mv /web/<i>service_name</i>/SYSTEM/dbtest.tcl.moved /web/<i>serice_name</i>/SYSTEM/dbtest.tcl
+  </pre></code></blockquote>
+</ul>
+
+
+<li> Sign up for <b><a href=http://uptime.arsdigita.com/uptime/about.tcl>Uptime</a></b><br>
+If the machine on which your service runs is down, the keepalive service on your machine will be down as well. Uptime resides on a separate server and sends alerts when your server can not be reached.  You should use the forms at <a href="http://uptime.arsdigita.com/uptime/">Uptime</a> to register alerts for the URL <code>http://service_domain/SYSTEM/uptime.txt</code>.  You'll want alerts to be sent to the following:
+<ul>
+<li> All the people involved with your service
+<li> noc@arsdigita.com
+</ul>
+
+You should break your montoring page to make sure Uptime sends an alert. 
+Then return the page to normal.
+
+
+<li>Set up <a href=http://photo.net/doc/glassroom.html>Glassroom</a> to maintain the information required to run the service and the ticket tracker. 
+<p>
+ The Glassroom for the service will be on a separate machine and has a domain staff.<i>service_name</i> domain.  The ticket tracker and glassroom modules should be run on this server. Glassroom is built on top of an ACS installation.
+<p>
+<li> Put the domain name for the main and staff servers in the nameservers.  One team member should be in charge of nameserver updates.
+
+<li>Set up <a href=http://arsdigita.com/free-tools/watchdog.html>Watchdog</a> to monitor your logs for errors.
+
+<p>Watchdog is virtual server located on the same machine as your service.  It watches your log files and will notify you of tcl errors.
+<p>
+If watchdog does not exist on your machine, you will have to install another virtual server on your machine:
+<ul>
+<li>Watchdog listens to port 1998.  Because this should not conflict with any other service, you may re-use an IP address used by another service.
+<li>Follow the directions for <a href="#installing">installing a virtual server</a>. Use <a href="/install/watchdog.ini">watchdog.ini</a> as a template.   Since watchdog does not use Oracle, you can run <code> /home/nsadmin/bin/nsd</code> instead of <code>/home/nsadmin/bin/nsd-oracle</code>
+<li> To install the service, follow the <a href="http://arsdigita.com/free-tools/watchdog.html">Watchdog installation instructions</a>
+</ul> 
+<p>
+If Watchdog is installed on your machine, add your service:
+<ul>
+<li> Look at <code>/home/nsadmin/watchdog.ini</code> to locate the domain and port for Watchdog on this machine
+<li> Visit Watchdog to add your service
+<li> Create some tcl bugs and verify that you receive notifications.  You can force Watchdog to act immediate by accessing <code>test.tcl</code> under the Watchdog server.
+</ul>
+
+<li>Set up <b>Reporte</b> to generate server log reports.
+  <ul>
+    <li> If Reporte does not exist for your server, use the <a href=http://arsdigita.com/free-tools/reporte.html>Installation Guide</a>
+    <li> Install a new service to Report
+  </ul>
+
+<li>Set up <b>Rollover</b>, which will keep the size of the error logs under control.
+  <ul>
+    <li>Follow the directions for <a href="#installing">installing a virtual server</a> to create a virtual server for Rollover.
+    <li>Configure <code>/web/rollover/tcl/rollover-list-of-systems.tcl</code> as appropriate for your installation.
+  </ul>
+
+<li>Set up <b>Cassandrix</b> to montor the Unix machine the server sits on. <a href="mailto:rolf@arsdigita.com">Rolf</a> insists this will be done shortly.
+
+<li>Set up <b>Cassandracle</b> to monitor the Oracle tranactions your website performs. http://arsdigita.com/free-tools/cassandracle.html
+  <ul>
+    <li>Follow the directions for <a href="#installing">installing a virtual server</a> to create a virtual server for Cassandracle.
+    <li>Create a <code>cassandracle</code> user.
+    <li>Grant the <code>cassandracle</code> user <code>connect, resource</code> and <code>dba</code> privileges.
+      <blockquote><code><pre>
+      grant connect, resource, dba to cassandracle
+      </pre></code></blockquote>
+  </ul>
+
+<li>Set up <b>ArsDigita MTA monitor</b> - this email monitor. Branimir is working on this.
+<li><b>Development server </b>
+<ul>
+<li> Run the development server on the same machine/ip unless there is a reason not to.  Use port 8080 for http, port 8443 for https.
+<li> Set up an Oracle user (if needed) 
+<li> Set up another virtual server.  This development server should be at the same IP as the running web service.
+
+</ul>
+
+
+</ol>
+
+<a name=installing><h3> Installing a virtual server</h3></a>
+<ol>
+<li>Create /home/nsadmin/<i>service_name</i>.ini owned by <code>nsadmin</code>.  Template ini files are listed in the above directions. Make the following substitutions as appropriate:
+<ul>
+<li> If your virtual server uses the database, substitute the service's database password with <i>database_password</i>.
+<li> Substitute the email of the person in charge of the server for service_email
+<li> Substitute the service's IP address for <code>service_ip_address</code>
+<li> Substitute the service's domain (e.g., photo.net) for <code>service_domain</code>
+<li>If you do not want to  use ftp on your server, delete the <code>[ns/server/service_name/module/nsftp]</code> section and the line <code>nsftp=nsftp.so</code> in the <code>[ns/server/service_name/modules]</code> section.
+</ul>
+<li> Prepare the <code>servers/<i>service_name</i></code>.  
+This directory and all the files must be owned by nsadmin.  
+You can do this via one of the folowing methods:
+<ul>
+<li> Copy another service's directory or
+<li> Copy the AOLserver template files
+<blockquote><pre><code>
+cp -pr /home/nsadmin/modules/nssetup/template1/ /home/nsadmin/servers/<i>service_name</i>
+</code></pre></blockquote>
+</ol>
+<i>Note: If you start with the template, the nsadmin password for the service will be blank and you will have to aquire cert.pem and key.pem from another location.</i>
+<li> Install your service in <code>/web/<i>service_name</i></code>
+<li> Execute <code>/home/nsadmin/bin/nsd-oracle -c /home/nsadmin/servername.ini</code> to test out your server setup. View your error log to make sure the service is starting without any problems. Attempt to connect to the service from a web browser.
+<li> Log into the /NS/Admin pages.  Assign an nsadmin password if it is blank.
+<li>Ensure that your service automatically starts on boot (or any other time the service dies):
+<p>
+<b>This requires root and deals with sensitive files that can break every service on the machine.</b> One member
+from a team should be in charge of this step.
+<p>
+<ul>
+<li>Open <code>/etc/inittab </code> for editing.
+<li>Copy an existing nsd line for a web service.  If one doesn't exist, use this example as a template:
+<blockquote><code><pre>
+nss:234:respawn:/home/nsadmin/bin/nsd-oracle -i -c /home/nsadmin/<i>service_name</i>.ini
+</pre></code></blockquote>
+<li>Make sure the first field is unique.
+<li><font color=red>Important:</font> Make sure there is a newline at the end of the file.  If there is not a newline at the end of the file, the system may suffer catastrophic failures.
+<li> Use <code>/sbin/init q</code> to start the server. 
+<li> <font color=red>Important:</font> See if it works by killing your nsd process.  The process should be restarted by the system.  If this doesn't work, you have probabably destroyed all the services on the machine.
+</ul>
+</ul>
+<hr>
+<a href=\"mailto:gregh@arsdigita.com\"><address>gregh@arsdigita.com</address></a>
+<a href=\"mailto:teadams@mit.edu\"><address>teadams@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/arsdigita-faq.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/arsdigita-faq.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/arsdigita-faq.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,300 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>ArsDigita Community System FAQ</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>ArsDigita Community System FAQ</h2>
+
+by <a href="http://teadams.com">Tracy Adams</a> (inspired by 
+<a href=http://www.alexium.com/wab/arsdigita.html>John Lowry's The ArsDigita Platform</a>)
+<hr>
+
+<ul>
+
+<li><a href=arsdigita-faq.html#free_db_enhancers>I have a site made of
+static html pages.  How can I add some collaboration features without
+setting up my own machine?</a>
+
+<li><a href=arsdigita-faq.html#infrastructure>I would like to use the ArsDigita Community System. How do I set up the basic infrastructure (Unix/Linux, Oracle, and AOLServer)?</a>
+
+<li> <a href=arsdigita-faq.html#architecture_install>I have a machine with Unix/Linux, Oracle and AOLServer installed.  How do  I install the ArsDigita Community System and the ArsDigita Server Architecture?</a>
+
+<li><a href=arsdigita-faq.html#acs_docs>Where can I find ArsDigita Community System documentation?</a>
+
+<li><a href=arsdigita-faq.html#bboard>I am stuck. Where can I ask a question?</a>
+
+<li> <a href=arsdigita-faq.html#teaching>What teaching and training is available? How can I sign up?</a>
+
+<li><a href=arsdigita-faq.html#resources>What resources are available for learning and reference?</a>
+
+<li> <a href=arsdigita-faq.html#ticket>Where do I make feature suggestions, 
+report bugs, and look for patches?</a>
+
+<li><a href=arsdigita-faq.html#isps>What ISPs and independent developers
+support the ArsDigita Community System?</a>
+
+<li><a href=arsdigita-faq.html#contribute>How can I contribute to the development of ArsDigita Community System?</a>
+
+<li> <a href=arsdigita-faq.html#company>Where can I learn about ArsDigita, the company?</a>
+
+<li> <a href=arsdigita-faq.html#employment>How can I work at ArsDigita?</a>
+</ul>
+
+<a name=free_db_enhancers>
+
+<h4>I have a site made of static html pages.  How can I add some
+collaboration features without setting up my own machine?</h4>
+
+Some of the basic ArsDigita Community System modules are
+available as free services.  Just sign up for on of them
+by filling out a form.  
+<ul>
+<li><a target=faq_example href=http://www.greenspun.com/spam/index.tcl>Spam</a> will allow you to maintain mailing lists
+<li><a  target=faq_example href=http://www.greenspun.com/bboard/>LUSENET</a> will run a discussion group for you
+<li><a  target=faq_example href=http://www.greenspun.com/boohoo/index.tcl>BooHoo link manager</a> will allow your users to post related links
+<li><a  target=faq_example href=http://www.greenspun.com/com/home.html>Loquacious</a> will allow your users to post comments
+<li><a  target=faq_example href=http://www.greenspun.com/click/>clickthrough.net</a> will track how many people  follow links from your site to sites that you recommend
+<li><a  target=faq_example href=http://uptime.arsdigita.com/uptime/>Uptime</a> will monitor your server and notify you when it is unreachable
+<li><a  target=faq_example href=http://arsdigita.com/voxpopuli/>Vox Populi</a> will allow you to add polls to your site
+<li><a  target=faq_example href=http://arsdigita.com/telegraph/>Telegraph</a> will allow forms on your site to send email
+</ul>
+
+</ul>
+
+See also: <a target=faq_example href=http://photo.net/wtr/collaboration.html>Adding collaboration to a Web Site</a> without buying or maintaining an RDBMS and <a target=faq_example href=http://www.greenspun.com>Free Services For Web Publishers</a>
+
+<a name=infrastructure>
+<h4>I would like to use the ArsDigita Community System. How do I set up the basic infrastructure?</h4>
+
+To use the ArsDigita Community System, you need a computer
+with Unix or Linux, Oracle, AOLServer and the Oracle driver for AOLServer
+installed.
+<p>
+Sean Yamamoto's 
+<a target=faq_example href="http://members.home.net/seanyama/linux/acs-on-linux.html">Building an RDBMS-backed Linux Web Server</a>
+provides the following guides for those taking the Linux (free) route:
+<ul>
+<li><a target=faq_example href="http://members.home.net/seanyama/linux/linux-achiever.html">Installing Red Hat Linux on a PC</a> - Version 5.2 for Intel</li>
+<li><a target=faq_example href="http://members.home.net/seanyama/linux/aolserver.html">Installing AOLserver web server software</a> - Version 2.3.3</li>
+<li><a target=faq_example href="http://members.home.net/seanyama/linux/oracle8.html">Installing Oracle8 database software</a> - Version 8.0.5 Standard Edition</li>
+<li><a target=faq_example href="http://members.home.net/seanyama/linux/aD-driver.html">Compiling and configuring the ArsDigita Oracle8 database driver for AOLserver</a> - Version 1.0.3</li>
+</ul>
+Nathan Wallace's guides:
+<ul>
+<li><a target=faq_example href=http://www.e-gineer.com/e-gineer/instructions/install-oracle805-on-redhat5x.phtml>Installing Oracle 8.0.5 on Red Hat Linux 5.x</a>
+<li><a target=faq_example href=http://www.e-gineer.com/e-gineer/instructions/install-aolserver233-on-redhat5x.phtml>Installing AOLserver 2.3.3 on Red Hat Linux 5.x</a>
+</ul>
+Other resources:
+<ul>
+<li><a target=faq_example href=http://jordan.fortwayne.com/oracle/index.html>Oracle 8.0.5 on RedHat Linux 6.1/6.0/5.2</a> (Fort Wayne Newspapers)
+<li><a target=faq_example href=http://technet.oracle.com/tech/linux/index.htm>Oracle 8i on RedHat Linux 6.1</a> (Oracle Technet, registration required)
+</ul>
+
+<a name=architecture_install>
+
+<h4>I have a machine with Unix/Linux, Oracle and AOLServer installed.  How do  I install the ArsDigita Community System and the ArsDigita Server Architecture?</h4>
+
+The <a target=faq_example href=http://photo.net/doc/architecture-install.html>ArsDigita Server Architecture Setup Instructions</a> will step you through installing
+the <a target=faq_example href=http://photo.net/wtr/thebook/community.html>ArsDigita Community System</a>
+and the <a target=faq_example href=http://photo.net/wtr/arsdigita-server-architecture.html>ArsDigita Server Architecture</a>
+<p>
+Along this process, you will use the following guides
+<ul>
+<li><a target=faq_example href=http://photo.net/doc/installation.html>ArsDigita Community System Installation</a>
+<li><a target=faq_example href=http://photo.net/doc/acceptance-test.html>ArsDigita Community System Acceptance Test</a>
+<li><a target=faq_example href=http://arsdigita.com/free-tools/keepalive.html>Keepalive Installation</a>
+<li><a target=faq_example href=http://uptime.arsdigita.com/uptime/about.tcl>Uptime Installation</a>
+<li><a target=faq_example href=http://photo.net/doc/glassroom.html>Glassroom Installation</a>
+<li><a target=faq_example href=http://arsdigita.com/free-tools/watchdog.html>WatchDog Installation</a>
+<li><a target=faq_example href=http://arsdigita.com/free-tools/reporte.html>Reporte Installation</a>
+<li><a target=faq_example href=http://photo.net/wtr/asa-audit.html>ArsDigita Server Architecture Audit</a>
+</ul>
+<p>
+When upgrading, you should <a target=faq_example href=http://photo.net/wtr/thebook/utilities.txt>grab the latest utilities.tcl</a> file.
+
+<a name=acs_docs>
+<h4>Where can I find ArsDigita Community System documentation?</h4>
+
+<ul>
+<li><a target=faq_example href=http://photo.net/doc/>ArsDigita Community System Documentation</a>
+<li><a target=faq_example href=http://photo.net/wtr/using-the-acs.html#getting>Getting the software</a>
+<li><a target=faq_example href=http://photo.net/wtr/thebook/community.html>Scalable Systems for Online Communities</a>
+<li><a target=faq_example href=http://photo.net/wtr/using-the-acs.html>Using the ArsDigita Community System</a>
+<li> <a  target=faq_example href=http://photo.net/doc/installation.html>ArsDigita Community System Installation</a>
+<li><a  target=faq_example href=http://photo.net/doc/developers.html>Developers Guide</a>
+<li><a  target=faq_example href=http://photo.net/doc/procs.tcl>Documented Procedures</a>
+<li><a  target=faq_example href=http://photo.net/doc/version-history.html>Version History</a>
+<li><a target=faq_example href=http://photo.net/ticket>Feature requests and bug reports</a>
+</ul>
+
+
+<a name=teaching>
+<h4>What teaching and training is available? How can I sign up?</h4>
+
+
+<ul>
+<li>The <a target=faq_example href=http://photo.net/teaching/one-day-web.html>One day web course</a> will be offered in several cities. (<a target=faq_example href=http://register.photo.net>Latest schedule and registration</a>)
+
+<li> <a target=faq_example
+href=http://photo.net/teaching/one-day-acs.html>ArsDigita Community
+System Conventions</a> are held quarterly in Cambridge and San
+Franscisco. (<a target=faq_example href=http://register.photo.net>Latest
+schedule and registration</a>)
+
+<li>We conduct <a target=inside_example href=http://photo.net/teaching/boot-camp.html>3-5 week boot camps</a> covering the core skills needed to install, configure and extend the ArsDigita Community System and the ArsDigita Server Architecture. These are available to people who:
+<ol>
+<li>are planning to do something for a non-profit organization
+<li>are willing to commit their time to  support or extend the ArsDigita 
+Community System and its community
+<li>are MIT students
+<li>are considering employment at ArsDigita
+</ol>
+If interested, please mail your application (reason you want to attend, resume, and plans
+for using ACS) to <a href=mailto:teadams@mit.edu>teadams@mit.edu</a>.
+
+<li><a target=faq_example href=http://photo.net/teaching/one-term-web.html>Software Engineering for Web Applications</a>
+is taught by ArsDigita at MIT and Caltech.  Students cover several problem sets and then complete
+a <a target=faq_example href=http://6916.lcs.mit.edu/project-gallery.html>gallery of student projects</a>. Materials for this course may be used at other Universities or for other programs at no charge.
+</ul>
+
+See also: <a target=faq_example href=http://photo.net/teaching/>Teaching</a>
+<a name=resources>
+<h4>What resources are available for learning and reference?</h3>
+
+Free teaching material from ArsDigita
+<ul>
+<li><a target=faq_example href="/wtr/thebook/">Philip and Alex's Guide to
+Web Publishing</a>
+
+<li><a target=faq_example  href="/sql/">SQL for Web Nerds</a> (tutorial for the SQL
+language; links into online Oracle docs for completeness)
+
+<li><a target=faq_example href="http://6916.lcs.mit.edu/manuals/tcl/">Tcl for Web Nerds</a>
+(tutorial for the Tcl language; in rough shape right now and you might
+consider using the Welch book (below))
+<li><a target=faq_example href=/doc/common-errors.html>Common errors</a> made by database backed web developers
+<li><a target=faq_example href=http://photo.net/wtr/oracle-tips.html>Tips for using Oracle</a> 
+<p>
+
+<li><a  target=faq_example href="http://photo.net/teaching/psets/ps1/ps1.adp">Problem Set 1</a> 
+(basic db-backed Web sites; AOLserver, Tcl, SQL) 
+<a target=faq_example href=http://photo.net/bboard/q-and-a.tcl?topic=Problem%20Set%201>Question and answer forum</a>
+
+<li><a  target=faq_example href="http://photo.net/teaching/psets/ps2/ps2.adp">Problem Set 2</a>  
+(extending the ArsDigita Community System, Web sites to support
+collaboration)
+<a target=faq_example href=http://photo.net/bboard/q-and-a.tcl?topic=Problem%20Set%202>Question and answer forum</a>
+
+<li><a  target=faq_example href="http://photo.net/teaching/psets/ps3/ps3.adp">Problem Set 3</a>
+(content management)
+<a target=faq_example href=http://photo.net/bboard/q-and-a.tcl?topic=Problem%20Set%203>Question and answer forum</a>
+
+<li>coming soon:  two more psets
+
+<li>coming soon:  project ideas 
+
+<p>
+
+<li><a target=faq_example href="http://photo.net/teaching/manuals/usermanual/">Using the
+LCS Web/db computing facility</a> (helps your sysadmin/dbadmin set up
+the server and then helps students get through the mechanics of logging
+in, connecting to Oracle, etc.)
+</ul>
+<p>
+Other online resources
+<ul>
+<li><a target=faq_example href=http://www.aolserver.com>AOLServer Documentation</a>
+<li><a target=faq_example href=http://hojohn.photo.net/ora8doc>Oracle Documentation</a>
+<li><a target=faq_example href=http://sdss.fnal.gov:8000/dss/doc/www/tcl/tcl.commands.html>Tcl Quick Reference Manual</a>
+</ul>
+<p>
+Recommended purchases
+<ul>
+
+<li><a  target=faq_example
+href="http://www.amazon.com/exec/obidos/ISBN=1565922603/photonetA/">Unix
+Power Tools</a> (helps students with the mechanics of the Unix shell and
+Emacs)
+
+<li><a  target=faq_example
+href="http://www.amazon.com/exec/obidos/ISBN=007882396X/photonetA/">
+Oracle 8: The Complete Reference</a> (more concise than the online
+Oracle docs)
+
+<li><a  target=faq_example
+ href="http://www.amazon.com/exec/obidos/ISBN=0136168302/photonetA/">Practical
+Programming in Tcl and Tk</a> (Brent Welch 1997; Prentice-Hall;)
+
+<li><a  target=faq_example
+href="http://www.amazon.com/exec/obidos/ISBN=0961392126/photonetA/">Visual
+Explanations : Images and Quantities, Evidence and Narrative</a> (Edward
+Tufte 1997; Graphics Press; order directly by calling (800) 822-2454) - general design principles
+
+
+</ul>
+<a name=bboard>
+<h4>I am stuck. Where can a ask a question?</h4>
+
+<ul>
+<li><a target=faq_example href=http://photo.net/bboard/q-and-a.tcl?topic=Problem%20Set%201>Problem set 1 questions</a>
+
+<li><a target=faq_example href=http://photo.net/bboard/q-and-a.tcl?topic=Problem%20Set%202>Problem set 2 questions</a>
+
+<li>
+<a target=faq_example href=http://photo.net/bboard/q-and-a.tcl?topic=Problem%20Set%203>Problem set 3 questions</a>
+
+<li><a target=faq_example href=http://photo.net/bboard/q-and-a.tcl?topic=web/db>Database backed web site </a> discussion forum
+
+</ul>
+
+
+<a name=ticket>
+<h4> Where do I make feature suggestions, report bugs, and look for code patches?</h4>
+
+Use our <a target=faq_example href=http://photo.net/ticket>online ticket tracking system</a> 
+(part of ACS).
+
+<a name=isps>
+<h4>What ISPs and independent developers
+support the ArsDigita Community System?</h4>
+
+(aside from ArsDigita.com)
+
+<ul>
+<li><a target=faq_example href=http://www.furfly.net>Furfly</a> 
+offers ACS-based services and hosting.
+
+<li><a target=faq_example href=http://www.alexium.com>John Lowry</a> has written a few modules.
+<li><a target=faq_example href=http://acs.lavsa.com/>Sebastian Skracic</a> has made an InterBase port
+</ul>
+
+We know that this list isn't complete; send email to Tracy to add
+yourself.
+
+<a name=contribute>
+<h4>How can I contribute to the development of the ArsDigita Community System</h4>
+
+Please contact <a href=mailto://teadams@mit.edu>teadams@mit.edu</a> if you would like to contribute. We need:
+<ul>
+<li>ACS buddies: Many interested users need a little help with the first installation and initial questions.
+
+<li>Module experts: We need experts for both existing and modules in development to suggest extensions, test new releases, write documentation and answers questions.
+
+<li>Module creators: <a target=faq_example href=http://www.alexium.com>John Lowry</a> has already created and publicized new modules.
+<li>Teachers: Use our <a href=arsdigita-faq.html#teaching>teaching materials</a> to teach your company, friends, or at a University.
+</ul>
+<a name=company>
+<h4>Where can I learn about ArsDigita, the company?</h4>
+See <a target=faq_example href=http://arsdigita.com>arsdigita.com</a>
+
+<a name=employment>
+<h4>How can I work at ArsDigita?</h4>
+See <a target=faq_example href=http://arsdigita.com/jobs.html>Job Openings</a>.
+</ul>
+
+<hr>
+<a href="http://teadams.com"><address>teadams@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/audit.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/audit.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/audit.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,231 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Audit Trail Package</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Audit Trail Package</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="mailto:jkoontz@arsdigita.com">Jesse Koontz</a>
+
+<hr>
+
+<ul>
+<li>example: ecommerce admin directory
+<a href="/admin/ecommerce/">/admin/ecommerce/</a>
+
+<li>data model:  examples in
+<a href="/doc/sql/display-sql.tcl?url=/doc/sql/ecommerce.sql">/doc/sql/ecommerce.sql</a>
+
+<li>procedures:  /tcl/ad-audit-trail.tcl
+<li>Audit site: <a href="/admin/ecommerce/audit-tables.tcl">/admin/ecommerce/audit-tables.tcl</a>
+<li>Display table: <a href="/admin/ecommerce/audit-table.tcl">/admin/ecommerce/audit-table.tcl</a>
+<li>Display record: <a href="/admin/ecommerce/audit.tcl">/admin/ecommerce/audit.tcl</a>
+</ul>
+
+<h3>The Big Picture</h3>
+
+When you have more than one person updating information in a table, you
+want to record all the values of a row over time.  This package gives
+you (1) a standard way of naming tables and triggers in Oracle, (2) two
+Tcl procedures (<code>ad_audit_trail</code> and 
+<code>ad_audit_trail_for_table</code>) that helps you display the old 
+values of a row, including highlighting particular changed columns, (3)
+a Tcl procedure (<code>ad_audit_delete_row</code>) that simplifies the
+logging of a deleted row, and (4) an example user interface (
+<code>audit-tables.tcl</code>, <code>audit-table.tcl</code>, <code>audit.tcl</code>) to retrieve and display audit histories.
+
+<h3>Steps for Auditing a Table</h3>
+
+We record old information in a separate audit table (see 
+<a href="http://photo.net/sql/triggers.html">the triggers chapter of 
+<cite>SQL for Web Nerds</cite></a> for more explanation of this idea).
+
+<p>
+
+We distinguish between the on-line transaction processing (OLTP) tables
+that are used in the minute-by-minute operation of the server and the
+audit tables.
+
+<p>
+
+Here are the steps to add audit trails:
+
+<ul>
+
+<li>Decide which OLTP tables need auditing. Three fields must be added to
+each OLTP table to save information about who was making changes, what
+IP address they were using, and the date they made the changes.
+
+<blockquote>
+<pre>
+create table ec_products (
+        product_id              integer not null primary key,
+        product_name            varchar(200),
+        one_line_description    varchar(400),
+
+        ...
+
+        -- the user ID and IP address of the last modifier of the product
+<font color=red>        last_modified           date not null,
+        last_modifying_user     not null references users,
+        modified_ip_address     varchar(20) not null</font>
+);
+</pre>
+</blockquote>
+
+<li>Create one audit table for each OLTP table that is being audited.
+By convention, this table should be named by adding an "_audit" suffix
+to the OLTP table name.
+The audit table has all the columns of the main table, with the same
+data types but no integrity constraints.  Also add a flag to indicate
+that an audit entry is for a deleted row in the OLTP table.
+
+<blockquote>
+<pre>
+create table ec_products<font color=red>_audit</font> as
+   select * from ec_products where 1 = 0;
+
+alter table ec_products<font color=red>_audit</font> add (
+        delete_p    char(1) default('f') check (delete_p in ('t','f'))
+);
+</pre>
+</blockquote>
+
+<li>Add one update trigger for each OLTP table.
+<blockquote>
+<pre>
+create or replace trigger ec_products_audit_tr
+before update or delete on ec_products
+for each row
+begin
+        insert into ec_products_audit (
+        product_id, product_name, 
+        one_line_description, 
+
+        ...
+
+        last_modified,
+        last_modifying_user, modified_ip_address
+        ) values (
+        :old.product_id, :old.product_name, 
+        :old.one_line_description, 
+
+        ...
+
+        :old.last_modified,
+        :old.last_modifying_user, :old.modified_ip_address
+        );
+end;
+/
+show errors
+</pre>
+</blockquote>
+
+Note that it is not possible to automatically populate the audit table on
+deletion because we need the IP address of the deleting user.
+
+<li>Change any .tcl script that deletes rows from an audited table.  It
+should call <code>ad_audit_delete_row</code> with args key list, column 
+name list, and audit_table_name. This procedure calls 
+<code>ad_get_user_id</code> and <code>ns_conn peeraddr</code> and records
+the user_id and IP address of the user deleting the row.
+
+<blockquote>
+<pre><code>
+ns_db dml $db "begin transaction"
+ns_db dml $db "delete from ec_products where product_id=$product_id"
+ad_audit_delete_row $db [list $product_id] [list product_id] ec_products_audit
+ns_db dml $db "end transaction"
+</code></pre>
+</blockquote>
+
+<li>Insert a call to <code>ad_audit_trail</code> in an admin page to
+show the changes made to a key. Insert a call to <code>ad_audit_trail_for_table</code> to show the changes made to an entire table over a specified period of time.
+
+<li> <em>optionally</em> define two views to provide "user friendly"
+audits.  Look at the 
+<a href="/doc/sql/display-sql.tcl?url=/doc/sql/ticket.sql">ticket
+tracker data model</a> tables <code>ticket_pretty</code> and
+<code>ticket_pretty_audit</code> for an example.  This has the
+benefit of decoding the meaningless integer ID's and highlighting potential data 
+integrity violations.
+</ul>
+
+<h3>Reference</h3>
+
+Audit columns:
+
+<ul>
+<li><b>last_modified</b> The date the row was last changed.
+<li><b>last_modifying_user</b> The ID of the user who last changed the row.
+<li><b>modified_ip_address</b> The IP Address the change request came from.
+<li><b>delete_p</b> The true/false tag that indicates the audit table entry is recording information on the user who deleted a row.
+</ul>
+
+Arguments for 
+<a href="proc-one.tcl?proc_name=ad_audit_trail_for_table"><code>ad_audit_trail_for_table</code></a>
+
+<ul>
+
+Returns an audit trail across an entire table, (multiple keys).
+<p>
+
+<li><b>db</b> Database handle.
+<li><b>main_table_name</b> Table that holds the main record. If sent an empty string as main_table_name, ad_audit_trail assumes that the audit_table_name has all current records.
+<li><b>audit_table_name</b> Table that holds the audit records.
+<li><b>id_column</b> Column name of the primary key in audit_table_name and main_table_name.
+<li><b>start_date</b> (optional) ANSI standard time to begin viewing records.
+<li><b>end_date</b> (optional) ANSI standard time to stop viewing records.
+<li><b>audit_url</b> (optional) URL of a tcl page that would display the full audit history of an record. Form variables for that page: id id_column main_table_name and audit_table_name.
+<li><b>restore_url</b> (optional) (future improvement) <i>URL of a tcl page that would restore a given record to the main table. Form variables for the page: id id_column main_table_name audit_table_name and rowid.</i>
+
+</ul>
+
+Arguments for 
+<a href="proc-one.tcl?proc_name=ad_audit_trail"><code>ad_audit_trail</code></a>
+
+<ul>
+
+Returns an audit trail of a single key in a table.
+<p>
+
+<li><b>db</b> Database handle.
+<li><b>id_list</b> List of ids representing the unique record you are processing.
+<li><b>audit_table_name</b> Table that holds the audit records.
+<li><b>main_table_name</b> Table that holds the main record. If sent an empty string as main_table_name, ad_audit_trail assumes that the audit_table_name has all current records.
+<li><b>id_column_list</b> Column names of the unique key in audit_table_name and main_table_name.
+<li><b>columns_not_reported</b> (optional)
+Tcl list of column names in audit_table_name and main_table
+ that you don't want displayed.
+<li><b>start_date</b> (optional) ANSI standard time to begin viewing records.
+<li><b>end_date</b> (optional) ANSI standard time to stop viewing records.
+<li><b>restore_url</b> (optional) (future improvement)<i>URL of a tcl page that would restore a given record to the main table. Form variables for the page:  id id_column main_table_name audit_table_name and rowid.</i>
+
+</ul>
+
+Arguments for <a href="proc-one.tcl?proc_name=ad_audit_delete_row"><code>ad_audit_delete_row</code></a>
+
+<ul>
+
+Creates a row in the audit table to log when, who, and from what IP address a row was deleted.
+<p>
+
+<li><b>db</b> Database handle.
+<li><b>id_list</b> Tcl list of the ids specifying the unique record you are processing. (Or the list of ID's in the case of a map table.)
+<li><b>id_column_list</b> Tcl list of the column names of the unique key in audit_table_name.
+<li><b>audit_table_name</b> Table that holds the audit records.
+
+
+</ul>
+
+<h3>Future Improvements</h3>
+
+The ad_audit_trail and ad_audit_trail_for_table procedures could be extended to restore previous values. The restore_url would be a pointer to a script that could restore an old row to the main table. The script would need to query the data dictionary for the columns of the audit and main tables. It might also require the user to confirm if a current record would be overwritten by the restore option.
+
+<hr>
+<address><a href="mailto:jkoontz@arsdigita.com">jkoontz@arsdigita.com</a></address></a>
+</body>
+</html>
Index: web/openacs/www/doc/bannerideas.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/bannerideas.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/bannerideas.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,159 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Banner Ideas</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Banner Ideas</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+<ul>
+<li>User-accessible directory:  <a href="/bannerideas/">/bannerideas/</a>
+<li>Site administrator directory:  <a href="/admin/bannerideas/">/admin/bannerideas/</a>
+<li>data model :  <a href="/doc/sql/display-sql.tcl?url=/doc/sql/bannerideas.sql">/doc/sql/bannerideas.sql</a>
+<li>Tcl procs:  /tcl/ad-bannerideas.tcl 
+
+</ul>
+
+<h3>The Big Idea</h3>
+
+A banner idea is something that you can place randomly on pages enticing
+readers to click to a different, potentially unrelated page.  How is
+that different from a banner ad?  A banner <em>idea</em> 
+
+<ul>
+
+<li>is typically programmed to appear at the bottom of a page, rather
+than at the top
+
+<li>has an arbitrarily long text introduction to the idea 
+
+<li>can carry a good-sized photo as an additional enticement
+
+</ul>
+
+Why use banner ideas?  If you have a bunch of users working themselves
+into a rut in a particular corner of your site, you can use banner ideas
+to show them the interesting content on other parts of the site.  For
+example, on photo.net, I use these to try to get people to go from 
+the boring classified system <a
+href="http://photo.net/gc/">http://photo.net/gc/</a>.
+
+<h3>Under the Hood</h3>
+
+As a developer, all that you have to do is call
+<code>bannerideas_random</code> and include the result in your page
+output.
+
+<p>
+
+Note that when a user clicks the "more" link from a banner idea, the
+click is logged in the <code>clickthroughs</code> column of the
+<code>bannerideas</code> table.
+
+<p>
+
+To save wear and tear on the database, the banner ideas are pulled from
+the database and cached in RAM for one hour (by default).
+
+<h3>The Future</h3>
+
+We keep a set of keywords associated with each banner idea.  Suppose
+that the banner ideas are being placed below a discussion forum thread.
+The right thing to do would be to look at the words used in the
+discussion and pick a banner idea that was related to the thread.  
+
+
+<h3>Sociology</h3>
+
+I built the banner ideas system in order to test my theory that human
+beings will accept, without complaint, an unlimited amount of
+commercialization.  That one can stuff flashing banner ads in every
+corner of a page and nobody will comment.  The other side of my theory
+was that unfamiliar ideas would drive people crazy.
+
+<p>
+
+I tested this theory by putting crass animated banner ads at the top of
+some pages in <a href="http://greenspun.com/bboard/">the LUSENET system
+at greenspun.com</a>.  I put banner ideas at the bottom of other pages
+and also put them into classified ads at photo.net.  The result?  Not a
+single complaint about the garish commercial-ish banner ads.  Huge
+volumes of email complaining about the ideas.  
+
+<p>
+
+Here's one from someone who has concluded that photo.net was started to
+be some sort of commercial trading post:
+
+<blockquote><pre>
+You're photo.net site is great, I have been using it for a long time and
+have bought/sold many many items. I also enjoy the equipment reviews and
+travel pics.
+
+Please take the following in a friendly manner, and as a request from
+someone who obviously thinks differently than yourself.
+
+Recently you began adding small "ads" at the bottom of other people's
+ads. Some of the ads you have posted are very offensive to me and I
+would greatly object to them appearing along with one of my ads. The two
+I saw today include references to a God that created man-man, man-woman,
+and woman-woman couples. To me it is blasphemy, and dangerous to a young
+mind, like my son's who I allow to peruse your site. The other ad seemed
+to promote anti-social behaviour, encouraging one to have fewer
+"transactions" with others.
+
+I love your site, but if these ads continue I will be forced to use
+other avenues such as ebay to enjoy my photo buying/selling habits. 
+
+Again, thanks for a great site, but let's keep it free from these very
+personal opinions....
+</pre></blockquote>
+
+(this author was referring to an excerpt from Aristophanes in
+<a href="http://photo.net/samantha/"><cite>Travels with Samantha</cite></a>
+and a reference to <a
+href="http://photo.net/philg/litigation/philosophy.html">my avoiding
+litigation article</a>)
+
+<p>
+
+Here's another one from a railroad group:
+
+<blockquote><pre>
+However, some members of our group feel that a portion of the material 
+being presented is a little too controversial to expose to people who 
+are expecting to see only railroad content.  We are not out to advocate 
+any positions one way or another, just talk about trains.  For example, 
+someone reported a message pointing to a militia Web page.  It's fine 
+with us that militia groups have Web sites, but we figure people visit 
+our site to take a time out from such weighty issues.  We would prefer 
+for people to locate those on their own.
+</pre></blockquote>
+
+This was provoked by a reference to <a
+href="http://photo.net/wtr/thebook/community.html">the community chapter
+of <cite>Philip and Alex's Guide to Web Publishing</cite></a>, which
+uses the Michigan Milita to make the point that most organizations spend
+most of their time on education, even if they wouldn't be thought of as
+primarily educational in nature.
+
+<p>
+
+I think my theory holds up.  A lot of folks can't stand unfamiliar
+ideas!  What I did not expect is how much difficulty many people have in
+reading comprehension.  The most virulent complaints were from people
+who had simply misunderstood the banner idea or the linked-to article.
+This can't be a matter simply of literacy because the same people were
+perfectly capable of writing a grammatical multi-paragraph complaint.
+
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/bboard-revision.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/bboard-revision.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/bboard-revision.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,94 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>plan to revise the /bboard system</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+
+<h2>revision plan for the /bboard system</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+We want to rewrite the /bboard system so that 
+
+<ul>
+
+<li>we switch from a varchar primary key to an integer (part of a
+general ACS-wide move to simple integer primary keys); retaining the
+old sort_key system, though, and also preserving the legacy keys in a
+separate column so that people can still point to threads
+
+<li>let's increase the number of chars used at any one level to 4 (from
+2).  This will address the needs of sites like cnn.com where they don't
+use threading and have a gazillion responses to the same top-level
+question
+
+<li>we have soft-delete by the moderators (thread disappears from the
+moderated version but is still in the database) and a mode where new
+questions require approval before they go live in the moderated version
+("don't show this to anyone until at least one moderator has said it was
+okay")
+
+<li>we use <a href="abstract-url.html">the abstract URL system</a>
+
+<li>(to support the edu module and MIT Sloan School) scoping of bboards
+by roles within a group (so that a bboard can be for professors and TAs
+in a class but not students)
+
+<li>(related to above) make sure that the bboard system works with the
+group scoping stuff (subcommunities)
+
+<li>some additional abstraction in the database at the PL/SQL level,
+e.g., a function that answers the question "Can User 17 read Bboard
+Topic #32?"
+
+<li>a more sensible approach to this "featured", unmoderated, etc. stuff
+(template it!) on the home page (and don't show people bboards in which
+they are prohibited from reading))
+
+<li>an actually useful threaded interface for bboards with 100,000
+postings
+
+<li>maybe some abstraction out of the USgeospatial stuff (we should be
+able to tie discussions to arbitrary other objects in the database,
+using on_which_table, on_what_id style of pointing)
+
+</ul>
+
+<h3>Email Fixes</h3>
+
+<ul>
+<li>take out the control-Ms
+<li>From header should say "Joe Smith via photo.net bboard
+&lt;joes@foobar.com&gt;"
+
+<li>the email notifications should have a link not just to the overall
+bboard but to the individual thread
+
+<li>correctly set References: and In-Reply-To: headers so that a mail
+reader can display these as threads
+
+<li>(hard and make it configurable) inbound email gets posted to the
+bboard in the right place
+
+
+</ul>
+
+
+<h3>Bug Fixes</h3>
+
+<ul>
+
+<li>the Q&amp;A admin pages should not warn you that a user has turned
+off notification when in fact there is a thread alert
+
+</ul>
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/bboard.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/bboard.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/bboard.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,135 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>/bboard system</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>/bboard system</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+<ul>
+<li>User directory:  <a href="/bboard/">/bboard/</a>
+<li>Admin directory:  message deletion, etc., is handling by
+admin-*.html scripts within the user directory; heavy duty stuff such as
+creating a new bboard or adding a maintainer is done at
+<a href="/admin/bboard/">/admin/bboard/</a>
+
+<li>data model :  <a href="/doc/sql/display-sql.tcl?url=/doc/sql/bboard.sql">/doc/sql/bboard.sql</a>
+
+
+</ul>
+
+The discussion software supports the following kinds of user interfaces,
+all of which query and insert to the same <code>bboard</code> table.
+Currently the system supports:
+
+<ul>
+<li>Q&A format, developed for the <a
+href="http://photo.net/photo/">photo.net</a> site and one of the most
+refined interfaces
+
+<li>Editorial-commentary format, developed for <a
+href="http://cognet.mit.edu/">cognet.mit.edu</a>.  This is suitable for
+when the publisher has longish thought-provoking editorials.  Readers
+then submit commentary on this.  A big advantage of this format is that
+the user interface isn't festooned with the words "question" and
+"answer". 
+
+<li>US-geospatial format, developed for <a
+href="http://scorecard.org">scorecard.org</a>.  This allows messages to
+be tagged with a zip code, county, or state.  So you can look at
+discussion nation-wide, in a region, or limited to a zip code.
+
+<li>original threads interface.  This is a lot like USENET and it
+doesn't scale very well as the discussion accumulates threads.
+
+</ul>
+
+<h3>File upload</h3>
+
+Users can upload one file in association with any message.  This was
+developed to facilitate photo uploading.  There is only one extra table
+defined for 
+
+<blockquote>
+<pre><code>
+create sequence bboard_upload_id_sequence;
+
+create table bboard_uploaded_files (
+	bboard_upload_id	integer primary key,
+	msg_id			not null references bboard,
+	file_type		varchar(100),	-- e.g., "photo"
+	file_extension		varchar(50), 	-- e.g., "jpg"
+	-- can be useful when deciding whether to present all of something
+	n_bytes			integer,
+	-- generally the filename will be "*msg_id*-*upload_id*.extension"
+	-- where the extension was the originally provided (so 
+	-- that ns_guesstype will work)
+	filename_stub		varchar(200) not null,
+	-- fields that only make sense if this is an image
+	caption			varchar(4000),
+	-- will be null if the photo was small to begin with
+	thumbnail_stub		varchar(200),
+	original_width		integer,
+	original_height		integer
+);
+</code></pre>
+</blockquote>
+
+<h3>Permissions Model</h3>
+
+[The bboard module was upgraded around time of version 2.1 to use the
+comon ACS user/groups administrative API]
+
+<p>
+
+Goal: To allow per-group bboards, and to use the new ACS permissions
+system to control user and administrative access to the bboards.
+
+<p>
+Each bboard topic is now associated with an administrative group,
+created using ad_administration_group_add, with "bboard" as the module
+and the topic_id as the sub-module. Any users who have been added to
+the corresponding administration group by
+ad_administration_group_user_add will have administrative access to
+the topic. They can access the bboard/admin-xxx pages, and moderate
+discussions on the topic.
+
+<h4>Public and Private Bboards</h4>
+
+There is a new read and write permissions model for topics. A topic
+has "read-access" and "write-access" permissions.
+
+<pre>
+Read-access := any | public | group
+
+ any    :=  topic may be viewed by any user of the system
+ public :=  topic may only be view by a registered user of the system
+ group  :=  topic may only be viewed by members of the topic's group(s)
+
+Write-access :=  public | group
+
+ public := any registered user may post a message or reply
+ group  := only members of the topic's group(s) may post or reply to messages
+
+</pre>
+
+<!-- Added by Branimir -->
+<h4>Urgent requests</h4>
+<ul>
+ <li>data model: an additional column <tt>urgent_p</tt> which says if 
+the posting is urgent or not
+ <li>parameters: <tt>UrgentMessageEnabledP=<i>[0|1]</i></tt>, <tt>DaysConsideredUrgent=<i>number-of-days</i></tt> in
+the <tt>bboard</tt> section of the config file.
+
+</ul>
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/bookmarks.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/bookmarks.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/bookmarks.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,121 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Bookmarks System</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Bookmarks System</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="mailto:dh@caltech.edu">David Hill</a> and  <a href="http://aure.com/">Aurelius Prochazka</a>
+
+<hr>
+
+<ul>
+<li> User-accessible directory: <a href="/bookmarks/">/bookmarks/</a>
+<li> Adminstration directory: <a href="/admin/bookmarks/">/admin/bookmarks/</a> (must use https://)
+<li> data model: <a href="/doc/sql/display-sql.tcl?url=/doc/sql/bookmarks.sql">/doc/sql/bookmarks.sql</a>
+<li> procedures: /tcl/bookmarks-defs.tcl
+</ul>
+
+<h3> The Big Idea </h3>
+
+People working together may find it useful to share bookmarks with each
+other.  In addition, someone who moves around from computer to computer
+may find it useful to store bookmarks on a central server rather than on
+individual desktop machines.
+
+<h3> Parameters</h3>
+
+<blockquote>
+<pre>
+; for the ACS Bookmarks System
+[ns/server/yourservername/acs/bm]
+; optional, defaults to main site owner 
+SystemOwner=philg@mit.edu
+; main page title
+SystemName=Bookmarks System
+; text decoration for dead links
+DeadDecoration=&lt;i&gt;
+; text decoration for folders
+FolderDecoration=&lt;b&gt;
+; text decoration for bookmarks invisible to the public
+HiddenDecoration=&lt;font color=#bb0000&gt;
+; background color of folders
+FolderBGColor=#f3f3f3
+; background color of files
+BookmarkBGColor=#ffffff
+; size of largest bookmarks file permissible to upload
+MaxNumberOfBytes=2000000
+</pre>
+</blockquote>
+
+<h3> Function-by-function Spec </h3>
+
+Here is a list of functions for a complete bookmark system:
+
+<ol>
+<li>Upload from Netscape-style bookmarks file
+
+<li>Upload from IE individual file bookmark, files, or URLs<li> Download
+(export) Bookmarks (i.e., show in Netscape form)
+
+<li> Download (export) Bookmarks (i.e., show in Netscape form)
+<li>Check URL on input
+<li>Check URLs regularly or on demand
+<li>Search bookmark URLs, titles, meta tags
+<li>Organize bookmarks with folders (create folder, move bookmark, delete
+folder)
+<li>Spawn a small window in which to keep bookmarks
+<p>
+<li>List most popular URLs, hosts
+<li>Allowing public viewing of a users bookmarks by others
+</ol>
+Some of these functions like importing and checking bookmarks can take a long time, so in this module there is extensive use of <code>ReturnHeaders ... ns_write "..."</code> which streams out to the user to show that progress is being made.
+<p>
+
+The idea of storing bookmarks on the Internet rather than on your hard
+drive is not a new one.  Several sites already serve this purpose:
+
+<UL><LI><A HREF="http://bookmarks.yahoo.com/">Yahoo! Bookmarks</A>
+<LI><A HREF="http://www.bookmarkbox.com">Bookmark Box</A> 
+<LI><A HREF="http://www.bookmarksplus.com">BookmarksPlus</A> 
+<LI><A HREF="http://www.markwebsite.com/">Mark Web Site</A> 
+<LI><A HREF="http://murl.com/">murl.com</A> 
+<LI><A HREF="http://www.mybookmarks.com">MyBookmarks</A> 
+<LI><A HREF="http://www.clickmarks.com">Clickmarks</A> 
+</ul>
+
+However, this is ALL the sites really provide, whereas with ACS a
+person's bookmarks become part of a user profile that includes 
+contributions across all modules.
+
+<h3>Our data model</h3>
+
+This system is built on two tables, one that holds the URLs and
+URL-specific information, and another that indicates which users have
+bookmarked which URLs.  Folders are treated the same as
+bookmarks, with a folder_p column set to 't' and no URL information.
+Each bookmark or folder has a parent_id that references a folder in the
+same table or is NULL indicating that it is a top level item.
+
+
+<h3> Limitations </h3> <ul> <li> The javascript folder system is pretty
+slow, but instead of trying to optimize it, we introduced the ability
+open/close folders on the regular html page.  <li> You can't move
+bookmarks around within a folder, just to a position at the end of
+another folder, so organization is somewhat limited.  </ul>
+
+<h3> Future enhancements</h3>
+<ul>
+<li>Ability to correlate your bookmarks with other users with similar interests
+<li>Ability to sort bookmarks by Title, URL, date added/modified
+<li>Ability to manually reorder bookmarks within a folder. Currently, they
+always appear in the order in which they were added.
+</ul>
+<hr>
+<a href="mailto:aure@arsdigita.com"><address>aure@arsdigita.com</address></a>
+</body>
+</html>
+ 
Index: web/openacs/www/doc/bulkmail.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/bulkmail.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/bulkmail.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,298 @@
+<title>Configuring Systems To Use The Bulkmail Module</title>
+
+<body>
+<h1>Configuring Systems To Use The Bulkmail Module</h1>
+
+<h2>Configure qmail servers</h2>
+
+A set of qmail servers should be configured on multiple ports and/or hosts
+in order to serve outgoing mail connections from an AOLserver running the bulkmail module.
+
+<p>
+[instructions here for configuring qmail to listen on N TCP ports]
+
+<p>
+[instructions should include what config files need to be set to
+allow mail relaying, plus how to configure test mailers which deliver
+all mail to a local filesystem]
+
+</h2>Configuring qmail bounce handling for use with the
+Bulkmail module</h2>
+
+For each mailer host, qmail configuration files need to be
+edited as follows:
+
+<h3>Bounce handling for <FONT COLOR=GREEN>hostname.com</FONT> (i.e., away.com)</h3>
+
+In <tt>/var/qmail/alias</tt> the following files need to be created
+or modified:
+
+<ul>
+<li>
+Create the file <tt>/var/qmail/alias/.qmail-<FONT COLOR=GREEN>hostname</FONT>-email-return-default</tt>
+containing the line
+<pre>
+|touch "/web/<FONT COLOR=GREEN>hostname</FONT>/mail/bounce/$EXT4@`date +%Y%mm%dd%HH%MM%SS`"
+</pre>
+
+<p>
+<li>Edit the file <tt>/var/qmail/control/rcpthosts</tt> to contain the line
+
+<pre>
+<FONT COLOR=GREEN>hostname.com</FONT>
+</pre>
+<p>
+
+<li>Edit the file <tt>/var/qmail/control/virtualdomains</tt> to contain the line
+<pre>
+<FONT COLOR=GREEN>hostname.com</FONT>:alias-<FONT COLOR=GREEN>hostname</FONT>
+</pre>
+
+</ul>
+
+Then in your AOLServer /web/<font color=green>hostname</font>/parameters/<font color=green>hostname</font>.ini file, set 
+the following params in the <b><tt>bulkmail</tt></b> section.
+
+<pre>
+[ns/server/<FONT COLOR=GREEN>hostname</FONT>/acs/bulkmail]
+; the template for the bounce (sender) address
+BulkmailSenderAddress=email-return-$key_code@<FONT COLOR=GREEN>hostname.com</FONT>
+
+; the template for the reply-to address
+BulkmailReplyAddress=email-reply-$key_code@<FONT COLOR=GREEN>hostname.com</FONT>
+
+
+</pre>
+
+<h3>Restart the qmail send process</h3>
+On the mailer host(s) restart the qmail process with a HUP signal.
+
+<pre>
+as root:
+ps -ef | grep qmail-send | grep -v grep | perl -n -a -e 'print "kill -HUP $F[1]\n"' | bash
+
+</pre>
+
+ man -M /var/qmail/man dot-qmail
+
+<pre>
+p: You need to cd to /service, and then issue a '/usr/local/bin/svc -d <instance>' where instance is qmail, qmail2 or qmail3
+
+</pre>
+
+<h3>Automatic handling of unsubscribe requests</h3>
+
+The VERP tags used in bounce handling on outgoing mail in the return-path can
+also be used to do double duty in the reply-to address system, to make it easier
+to handle unsubscribe requests generated by users hitting "reply" to the bulkmail
+message they receive. The <code>email-reply-$key_code</code> above can be used to
+trigger a script which runs on any mail to the address "email-reply-XXXXXX@<FONT COLOR=GREEN>hostname.com</FONT>".
+
+
+
+An example unsubscribe perl script is shown below. 
+
+The script below should be invoked via the following qmail alias file:
+
+Create the file <tt>/var/qmail/alias/.qmail-<FONT COLOR=GREEN>hostname</FONT>-email-reply-default</tt>
+containing the line
+<pre>
+|/web/yourserver/bin/unsubscribe-user.pl "$EXT4"
+</pre>
+
+This will ensure that the script gets passed the VERP code if there is one
+that the message was generated with, which is the most reliable way to figure out
+the user_id (and email address) the mail was sent to in the first place.
+<p>
+
+
+<pre>
+#!/usr/local/bin/perl
+#
+# Unsubscribe the user or users in an email message from all newsletters
+#
+# hqm@ai.mit.edu
+#
+# If bulkmail VERP keycode arg is supplied, that user is unsubscribed, otherwise
+# parses out the From header and unsubscribes the user from all newsletters
+# (actually, removes them from any group of type 'newsletter').
+#
+# Args: (optional) bulkmail encoded VERP key containing user_id
+# and raw message body on stdin
+
+# Oracle access
+$ENV{'ORACLE_HOME'} = "/ora8/m01/app/oracle/product/8.1.6";
+$ENV{'LD_LIBRARY_PATH'} = "/ora8/m01/app/oracle/product/8.1.6/lib:/lib:/usr/lib";
+$ENV{'ORACLE_BASE'} = "/ora8/m01/app/oracle";
+$ENV{'ORACLE_SID'} = "ora8";
+
+$VERP_code        = shift;
+
+$mailer = "/var/qmail/bin/qmail-inject";
+
+use DBI;
+use Mail::Address;
+require Mail::Send;
+
+################################################################
+# Global Definitions
+
+# For sending email error message replies back to member
+$mailer = "/usr/lib/sendmail";
+$return_address = "webmaster\@hostname.com";
+$maintainer = "webmaster\@hostname.com";
+$an_system_url = "http://www.hostname.com";
+
+
+$DEBUG = 1;
+$debug_logfile = "/web/yourwebserver/log/unsubscribe.log"; 
+
+
+
+if ($DEBUG) {
+    open (LOG, "&gt;&gt;$debug_logfile");
+    debug("================================================================\n");
+    debug(`/bin/date`);
+}
+
+
+$db_datasrc = 'dbi:Oracle:';
+$db_user = 'YOURDBUSER;
+$db_passwd = 'YOURDBPASSWD';
+
+#################################################################
+## Snarf down incoming msg on STDIN
+#################################################################
+
+# extract From: header
+while (&lt;&gt;) {
+    $in_header =   1  .. /^$/;
+    if ($in_header) {
+	if (/^From:.*([\s&lt;]\S+\@\S+[&gt;\s])/ || /^Subject:.*([\s&lt;]\S+\@\S+[&gt;\s])/) {
+	    $line = $1;
+	    @from = Mail::Address-&gt;parse($line);
+	    $from_address = $from[0]-&gt;address;
+	    last;
+	}
+    }
+}
+    
+debug("VERP code = $VERP_code\n");
+
+# open the database connection
+$dbh = DBI-&gt;connect($db_datasrc, $db_user, $db_passwd)
+  || die "Couldn't connect to database";
+$dbh-&gt;{AutoCommit} = 1;
+
+if ($VERP_code eq "") {
+    $user_id = get_user_id_from_email($from_address);
+} else {
+    $user_id = decode_verp_key($VERP_code);
+}
+
+debug("user id = $user_id\n");
+
+if ($user_id ne "") {
+    $real_email = get_email_from_user_id($user_id);
+    $err = unsubscribe_user($user_id);
+    debug("unsubscribing user_id $user_id, email=$real_email, err=$err\n");
+    if ($err eq "") {
+	send_email($real_email, $return_address,
+		   "Unsubscribed $real_email from hostname.com newsletters",
+		   "The account with email address $real_email has been unsubscribed from all newsletters on hostname.com.\n");
+    } else {
+	send_email($real_email, $return_address,
+		   "Error unsubscribing from hostname.com newsletters",
+		   "There was an error processing your unsubscribe request. Please contact webmaster\@hostname.com. It would be helpful to forward an original copy of the newsletter you are trying to unsubscribe from.
+
+Thank you.
+\n");
+    }
+}
+
+# All done
+
+$dbh-&gt;disconnect;
+if ($DEBUG) { close LOG; }
+
+sub debug () {
+    my ($msg) = @_;
+    print LOG $msg;
+}
+
+# Remove user from all newsletters
+# args: user_id
+sub unsubscribe_user () {
+  my ($id) = @_;
+  $query = "delete from user_group_map 
+            where user_id = $id and
+            group_id in (select group_id from user_groups where group_type = 'newsletter')";
+  $sth= $dbh-&gt;prepare($query) || return $dbh-&gt;errstr;
+  $sth-&gt;execute || return $dbh-&gt;errstr;
+  $sth-&gt;finish;
+  return;
+}
+
+# take an email addr, return a user_id
+sub get_user_id_from_email () {
+    my ($email) = @_;
+    # SQL quotify
+    ($QQemail = $email) =~ s/\'/''/g;
+    $h = $dbh-&gt;prepare(qq[SELECT user_id FROM users
+			  WHERE lower(email) = lower('$QQemail')]);
+    if (!$h-&gt;execute()) {
+	die "Unable to execute query in send_error_reply:\n" . $dbh-&gt;errstr;
+    }
+    $id = $h-&gt;fetchrow;
+    $h-&gt;finish;
+    return ($id);
+}
+
+
+sub get_email_from_user_id () {
+    my ($id) = @_;
+    $h = $dbh-&gt;prepare(qq[SELECT email FROM users
+			  WHERE user_id = $id]);
+    if (!$h-&gt;execute()) {
+	die "Unable to execute query in send_error_reply:\n" . $dbh-&gt;errstr;
+    }
+    $email = $h-&gt;fetchrow;
+    $h-&gt;finish;
+    return ($email);
+}
+
+
+
+
+################################################################
+# decode_verp_key(key)
+#
+# Decode the user_id from a bulkmail VERP key
+#
+#
+################################################################
+#  regexp -nocase {([0-9]+)A([0-9]+)B([0-9]+)} $user_content match bulkmail_id user_id time
+
+sub decode_verp_key () {
+  my ($key) = @_;
+  my ($bulkmail_id,$user_id,$nstime);
+
+# key was generated by /tcl/bulkmail-utils.tcl
+  ($bulkmail_id, $user_id, $nstime) =
+      ($key =~ /^(\d+)A(\d+)B(\d+)C(\d+)$/i);
+  
+  return ($user_id);
+}
+
+
+################################################################
+# send_email (recipient, sender, subject, body)
+################################################################
+
+sub send_email () {
+    my ($recipient, $sender, $subject, $body) = @_;
+    open(MAIL, "|$mailer $recipient -f$sender") || die "Cannot open: '$mailer'\n";
+    print MAIL "To: $recipient\nFrom: $sender\nSubject: $subject\n\n$body\n";
+    close(MAIL);
+}
+</pre>
\ No newline at end of file
Index: web/openacs/www/doc/calendar-widget.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/calendar-widget.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/calendar-widget.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,327 @@
+<html>
+<head>
+<!--AD_DND-->
+<title>Calendar Widget Package</title>
+</head>
+<body bgcolor=#ffffff text=#000000>
+
+<h2>Calendar Widget Package</h2>
+
+part of the <a href=index.html>ArsDigita Community System</a> 
+by <a href="http://www.haverkamp.com">Greg Haverkamp</a>
+
+<hr>
+
+<ul>
+
+<li>User directory:  none
+<li>Admin directory:  none
+
+<li>data model:  none
+
+<li>procedures:  all within /tcl/ad-calendar-widget.tcl
+
+</ul>
+
+This package helps you display calender-based data.
+It produces both large monthly calendars with daily details and small
+monthly "outline" calendars.  Make sure you update your
+<code>utilities.tcl</code> file 
+from <a href="http://photo.net/wtr/thebook/utilities.txt">http://photo.net/wtr/thebook/utilities.txt</a>.  This package relies upon the presence
+of <code>ad_proc</code> to give us Common Lisp-style keyword args.
+
+<p>
+
+When formatting hyperlinks from day numbers, Julian dates are used.  A Julian
+date is the number of days since 4712 B.C.  The benefit of using Julian dates
+is that they make it very easy to do calendar date calculations.  To make it
+easy to convert back to ANSI dates, the helper procedure 
+<code>calendar_convert_julian_to_ansi</code> is provided.  To obtain a 
+Julian date from Oracle, use <code>to_char</code> with a the 'J' format
+option.  For example, to obtain today's Julian date:
+
+  <blockquote>
+  <code><pre>
+  select to_char(sysdate, 'J') from dual
+  </pre></code>
+  </blockquote>
+
+<p>
+
+All of the color parameters are standard HTML colors.  You can specify
+either recognized color names, or you can use the more specific hex color
+values.  The names "white" and "black" are used in the code as defaults.
+However, you could use "#ffffff" or "#000000", respectively, if you prefer.
+
+<h3>Procedures:</h3>
+
+<ul>
+<li><code>calendar_basic_month</code>
+  <blockquote>
+  This is the basis of all of the other calendar types.  Use this if you want to produce a large calendar with daily details.
+  </blockquote>
+<li><code>calendar_small_month</code>
+  <blockquote>
+  Creates small, detail-free calendars.  It might be useful in
+  date-selection situations, or for general overview calendars.  This is used
+  as the basis for all of the other small-calendar procedures.
+  </blockquote>
+<li><code>calendar_prev_current_next</code>
+  <blockquote>
+  Creates a three-wide table of small calendars.  The left calendar is
+  the month prior to the passed-in date, the middle calendar is the month of
+  the supplied date, and the right calendar is the month following the 
+  passed in date.
+  </blockquote>
+<li><code>calendar_small_year</code>
+  <blockquote>
+  Forms a twelve-calendar display of twelve months, beginning the first
+  of the passed-in month.
+  </blockquote>
+<li><code>calendar_small_calendar_year</code>
+  <blockquote>
+  Forms a twelve-calendar display of the calendar year of the passed in
+  month.
+  </blockquote>
+</ul>
+
+<h3>Parameters:</h3>
+
+<ul>
+<li><code>calendar_details</code>
+  <blockquote>
+  This is an <code>ns_set</code> that holds the daily details for the
+  calendar.  Each key is the Julian date of the day, and the values are
+  strings representing the details.
+  <p>
+  You can add multiple values for each Julian date key. When the calendar is
+  rendered, it will fetch the values for all entries matching the appropriate
+  Julian date.
+  <p>
+  <i>Default</i>: no data
+  </blockquote>
+<li><code>date</code>
+  <blockquote>
+  A truncated ANSI format ('YYYY-MM-DD'), used to represent the desired 
+  reference date for each procedure.  It's actual use may vary by procedure.
+  <p>
+  <i>Default</i>: current database date (fetched via sysdate)
+  </blockquote>
+<li><code>days_of_week</code>
+  <blockquote>
+  A list specifying the day-of-week headings in the calendar.  This needs to
+  always start on Sunday.
+  <p>
+  <i>Defaults</i>: 
+    <ul>
+    <li><code>calendar_basic_month</code>: "Sunday Monday Tuesday Wednesay Thursday Friday Saturday"
+    <li>All small calendars: "S M T W T F S"
+    </ul>
+  </blockquote>
+<li><code>large_calendar_p</code>
+  <blockquote>
+  Specifies if this is a large (with daily details) or a small (no daily 
+  details) calendar.
+  <p>
+  <i>Defaults</i>:
+    <ul>
+    <li><code>calendar_basic_month</code>: 1
+    <li>All small calendars: 0
+    </ul>
+  </blockquote>
+<li><code>master_bgcolor</code>
+  <blockquote>
+  The background color of the entire calendar.
+  <p>
+  <i>Default</i>: "black"
+  </blockquote>
+<li><code>header_bgcolor</code>
+  <blockquote>
+  The background color of the master header (the month section of the 
+  calendar.)
+  <p>
+  <i>Default</i>: "black"
+  </blockquote>
+<li><code>header_text_color</code>
+  <blockquote>
+  The text color for the master header (the text used to display the month.)
+  <p>
+  <i>Default</i>: "white"
+  </blockquote>
+<li><code>header_text_size</code>
+  <blockquote>
+  The size of the month/year header, as passed to the "size" parameter of
+  an HTML font tag. 
+  <p>
+  <i>Defaults</i>:
+    <ul>
+    <li><code>calendar_basic_month</code>: "+2"
+    <li>All small calendars: "+1"
+    </ul>
+  </blockquote>
+<li><code>day_number_template</code>
+  <blockquote>
+  This template allows formatting or linking from the day number displayed
+  on the calendar.  Using the Tcl <code>subst</code> command, two variables
+  are substituted in the template.  The first is the Julian date of the appropriate
+  day.  The second is the day of the month.
+  <p>
+  For example, a <code>day_number_template</code> to show a relatively
+  plain, unlinked day number might look like:
+    <blockquote>
+    <code><pre>
+    &lt;!--$julian_date--&gt;&lt;font size=1&gt;$day_number&lt;/font&gt;
+    </pre></code>
+    </blockquote>
+  Here is an example from the ACS /bboard system:
+    <blockquote>
+    <code><pre>
+    &lt;a href=\"threads-one-day.tcl?topic=[ns_urlencode $topic]&julian_date=\$julian_date\"&gt;&lt;font size=-1&gt;\$day_number&lt;/font&gt;&lt;/a&gt;
+
+    </pre></code>
+    </blockquote>
+
+  <p>
+  <i>Default</i>: "&lt;!--%d--&gt;&lt;font size=1&gt;%d&lt;/font&gt;"
+  </blockquote>
+<li><code>day_header_size</code>
+  <blockquote>
+  The font size of the day header (the day of the week.)
+  <p>
+  <i>Default</i>:
+    <ul>
+    <li><code>calendar_basic_month</code>: 2
+    <li>All small calendars: 1
+    </ul>
+  </blockquote>
+<li><code>day_header_bgcolor</code>
+  <blockquote>
+  The background color of the day header row.
+  <p>
+  <i>Default</i>: "#666666" (this is a dark gray)
+  </blockquote>
+<li><code>calendar_width</code>
+  <blockquote>
+  The table width of calendar's master table.  Alternatives can be specified
+  either as a percentage of the page's width (e.g., -calendar_width "50%") or 
+  in absolute width (e.g., -calendar_width 100)
+  <p>
+  <i>Default</i>:
+    <ul>
+    <li><code>calendar_basic_month</code>: "100%"
+    <li>All small calendars: 0
+    </ul>
+  </blockquote>
+<li><code>day_bgcolor</code>
+  <blockquote>
+  The background color of each day cell.
+  <p>
+  <i>Default</i>: "#DDDDDD" (this is a light gray)
+  </blockquote>
+<li><code>day_text_color</code>
+  <blockquote>
+  The color of the days' details text.
+  <p>
+  <i>Default</i>: "white"
+  </blockquote>
+<li><code>empty_bgcolor</code>
+  <blockquote>
+  The background color to give empty cells (those before the first and after
+  the last days of the month.)
+  <p>
+  <i>Default</i>: "white"
+  </blockquote>
+<li><code>next_month_template</code>
+  <blockquote>
+  Use this to specify the hyperlink format to do a next-month link at the
+  bottom of a calendar.  This will be processed by <code>format</code>,
+  which will be inserting a string.
+  <p>
+  For example, to link to a page called <code>month-show.tcl</code> which
+  expects the variable <code>date</code>, you could use the following:
+    <blockquote>
+    <code><pre>
+    &lt;a href="month-show.tcl?date=$ansi_date"&gt;Next month&lt;/a&gt;
+    </pre></code>
+    </blockquote>
+  This will insert a date in ANSI format (first day of next month, e.g.,
+  1999-07-01 if you call it during display of a calendar for June 1999).
+  <p>
+  <i>Default</i>: ""
+  </blockquote>
+<li><code>prev_month_template</code>
+  <blockquote>
+  See <code>next_month_template</code>.  <code>$ansi_date</code> will be 
+  last day of previous month, e.g.,
+  1999-05-31 if you call it during display of a calendar for June 1999
+  <p>
+  <i>Default</i>: ""
+  </blockquote>
+<li><code>width</code>
+  <blockquote>
+  Used only by <code>calendar_small_year</code> and
+  <code>calendar_small_calendar_year</code>
+  <p>
+  Specifies the number of calendars-wide the displays are made.
+  <p>
+  <i>Default</i>: 2
+  </blockquote>
+</ul>
+
+<h3>Examples</h3>
+
+<ul>
+<li>Display this month, with details.  Previous and next month links send
+to <code>month-show.tcl</code>.
+  <blockquote>
+  Assuming the current month is June 1999, June 10, 1999 will show details.
+  June 10, 1999, is Julian date 2451340.
+  <code><pre>
+  set calendar_details [ns_set create calendar_details]
+  set day_details "&lt;font size=-1&gt;&lt;b&gt;Tasks&lt;/b&gt;&lt;ul&gt;&lt;li&gt;shower&lt;li&gt;shave&lt;/ul&gt;&lt;b&gt;Appointments&lt;/b&gt;&lt;br&gt;- See the Prez&lt;/font&gt;"
+  ns_set put $calendar_details "2451340" $day_details
+
+  set next_month_template "(&lt;a href=\"month-show.tcl?date=\$calendar_details\"&gt;next&lt;/a&gt;)"
+  set prev_month_template "(&lt;a href=\"month-show.tcl?date=\$calendar_details\"&gt;prev&lt;/a&gt;)"
+
+  ns_write "[calendar_basic_month -calendar_details $calendar_details -day_number_template $day_number_template -next_month_template $next_month_template -prev_month_template $prev_month_template]"
+  </pre></code>
+  </blockquote>
+<li>A small calendar of this month, with the days having aqua-marine as a
+background color.  (Aqua-marine has a hex value of 00FFFF.)
+  <blockquote>
+  <code><pre>
+  ns_write "[calendar_small_month -day_bgcolor "#00FFFF"]"
+  </pre></code>
+  </blockquote>
+<li>Last, this, and next months, using French days as the headers.
+  <blockquote>
+  <code><pre>
+  ns_write "[calendar_prev_current_next -days_of_week "D L M M J V S"]"
+  </pre></code>
+  </blockquote>
+<li>One year from the start of the current month using defaults, which will
+yield 6 rows by 2 columns.  
+  <blockquote>
+  <code><pre>
+  ns_write "[calendar_small_year]"
+  </pre></code>
+  </blockquote>
+<li>One year, starting 4/1/2000, 4 wide.
+  <blockquote>
+  <code><pre>
+  ns_write "[calendar_small_year -date "2000-04-01" -width 4 ]"
+  </pre></code>
+  </blockquote>
+</ul>
+
+<hr>
+
+<address>
+<a href="mailto:gregh@arsdigita.com">gregh@arsdigita.com</a>
+</address>
+</body>
+</html>
+
+
+
Index: web/openacs/www/doc/calendar.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/calendar.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/calendar.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,115 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Calendar</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Calendar</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+<ul>
+<li>User-accessible directory:  <a href="/calendar/">/calendar/</a>
+<li>Site administrator directory:  <a href="/admin/calendar/">/admin/calendar/</a>
+<li>Group administrator directory:  <a href="/calendar/admin">/calendar/admin</a>
+<li>data model :  <a href="/doc/sql/display-sql.tcl?url=/doc/sql/calendar.sql">/doc/sql/calendar.sql</a>
+<li>Tcl procs:  /tcl/calendar-defs.tcl 
+
+</ul>
+
+<h3>The Big Idea</h3>
+
+A site like photo.net might want to offer a calendar of upcoming
+events.  This has nothing to do with displaying things in a
+wall-calendar style format, as provided by <a
+href="calendar-widget.html">the calendar widget</a>.  In fact, a
+calendar of upcoming events is usually better presented as a list.  
+
+<p>
+
+What distinguishes /calendar from /news is that items may be categorized
+and the display at a large site might be personalized to a user's
+country, state, or zip code.  Also, if there are too many items to
+display comfortably, the non-expired events coming up soonest get
+displayed.
+
+<p>
+
+See <a href="http://www.harpcolumn.com">www.harpcolumn.com</a> for a 
+good running example that distinguishes /news from /calendar.
+
+
+<h3>Under the Hood</h3>
+
+The data model is simple:
+
+<blockquote>
+<pre><code>
+
+
+create sequence calendar_category_id_sequence start with 1 ;
+
+create table calendar_categories (
+	category_id	integer primary key,
+	-- if scope=public, this is the address book the whole system
+        -- if scope=group, this is the address book for a particular group
+ 	scope           varchar(20) not null,
+	group_id	references user_groups,
+	category	varchar(100) not null,
+	enabled_p	char(1) default 't' check(enabled_p in ('t','f')),
+	constraint calendar_category_scope_check check ((scope='group' and group_id is not null) or
+       							(scope='public')),
+	constraint calendar_category_unique_check unique(scope, category, group_id)	
+);
+
+create index calendar_categories_group_idx on calendar_categories ( group_id );
+
+create sequence calendar_id_sequence start with 1;
+
+create table calendar (
+	calendar_id	integer primary key,
+	category_id	not null references calendar_categories,
+	title		varchar(100) not null,
+	body		varchar(4000) not null,
+	-- is the body in HTML or plain text (the default)
+	html_p			char(1) default 'f' check(html_p in ('t','f')),
+	start_date	date not null,  -- first day of the event
+	end_date	date not null,  -- last day of the event (same as start_date for single-day events)
+	expiration_date	date not null,  -- day to stop including the event in calendars, typically end_date
+	event_url	varchar(200),  -- URL to the event
+	event_email	varchar(100),  -- email address for the event
+	-- for events that have a geographical location
+	country_code	references country_codes(iso),
+	-- within the US
+	usps_abbrev	references states,
+	-- we only want five digits
+	zip_code	varchar(10),
+	approved_p	char(1) default 'f' check(approved_p in ('t','f')),
+	creation_date	date not null,
+	creation_user		not null references users(user_id),
+	creation_ip_address	varchar(50) not null
+);
+
+</code></pre>
+</blockquote>
+
+Comments are handled by <a href="general-comments.html">the general comments facility</a>.
+
+<h3>Related Modules</h3>
+
+The <a href="news.html">/news module</a> is better for generation
+announcements (e.g., press releases from companies).
+
+<p>
+
+The <a href="bboard.html">/bboard system</a> is better if you want to
+support lively discussion and archive the exchanges.
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/changelog.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/changelog.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/changelog.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,109 @@
+<title>pre-release change log</title>
+<body>
+<h1>ACS pre-release change log</h1>
+<pre>
+
+July 15, 1999 -- hqm@arsdigita.com
+
++ Ticket tracker - 
+  
+   + the ticket tracker was changed to meet HP's requests - there are some improvements
+     in the UI, and the interface for "public" users is now very similar to that of ticket
+     admin group members - the only difference at the moment is that public members
+     cannot create new projects, nor assign users to tickets. 
+
+     Tracy's flag (LinkTicketToUserGroupP) is being ignored right now, but I will
+      be adding support back for it soon, so we might as well leave it in the param file
+     for the moment. 
+
+     I still need to add a param which controls whether access to modify ticket status
+     and other fields is read-only or not for public users. Right now, public users *can*
+     modify ticket status.
+
+
+
+
+
++ handling of passwords:
+
+  Added a link to the 
+
+  + EmailForgottenPassword (default true)
+
+  If user enters bad password:
+    parameter flag, EmailForgottenPasswordP, which controls whether
+    the "email-password.tcl" link is enabled. It's value defaults to true
+    if omitted from the .ini file.
+
+    If EncryptPasswordsInDBP is true, then we need to generate a new 
+    random password to mail back to the user.
+
+  + EmailChangedPasswordP (default true)
+
+  When the admin changes a user's password, this param controls whether
+  the new password is emailed back to the the user. 
+
+
++ Added option to encrypt passwords in database. Controlled by setting
+.ini param EncryptPasswordsInDBP to 1:
+
+[ns/server/yourservername/acs]
+EncryptPasswordsInDBP=1
+
+
+Note: If you set this flag when upgrading an existing site, you must run
+the tcl proc encrypt_db_passwords <b>once and only once</b> to encrypt
+all existing user passwords in place in the database.
+
+
++ Added option to RestrictToSSL to restrict to SSL with 128 bit keys only
+
+[ns/server/yourservername/acs]
+AllowOnly128BitSSL=1
+
+Tracy Adams (teadams@arsdigita.com) - July 17, 1999
+
++ Took out reference to CNN in /register/awaiting-approval.html
+
++ registration finite state mached - July 17, 1999
+
+-- Added /register/banned-user.tcl to be the landing page for banned users
+-- Modified the logic in /register/user-login.tcl to go the correct page depending on the user's state
+-- Added ad_approval_system_inuse_p to ad-admin.tcl.  This proc returns 1 if there an approval system in use
+-- Modified /register/awaiting-approval.tcl to work for the aprroved_p = "" state (approved_p = "" should be treated as approved_p = "f")
+-- Added /register/banned_user.tcl
+
+
+alter table users add (
+   approved_date         date,
+   approving_note        varchar(4000),
+   deleted_date          date,
+   deleting_user         integer references users(user_id),
+   deleting_note         varchar(4000),
+   banned_date           date,
+   rejected_date         date,
+   rejecting_user        integer references users(user_id),
+   rejecting_note        varchar(4000),
+   email_verified_date   date,
+   user_state            varchar(100) check(user_state in ('need_email_verification_and_admin_approv', 'need_admin_approv', 'need_email_verification', 'rejected', 'authorized', 'banned', 'deleted')));
+
+
+these columns in the user table are now are obsolete
+approved_p
+deleted_p
+banned_p
+
+--- added ad_generate_random_string to ad-security.tcl
+
+--- added RegistartionProvidesRandomPasswordP to an.ini.  
+--- If RegistrationProvidesRandomPasswordP = 1, the user is
+--- sent a random password
+--- added EmailRandomPasswordP to an.ini.  If EmailRandomPasswordP is 1,
+a random password is generated when the user asks for a new password.
+--- changed EVERY file in /register to use a finite state machine for registration state
+--- rearranged an.ini to include registration specific things together
+--- removed ad_encrypt_passwords_in_db - using a separate tcl proc for acs parames is only used for legacy (made changes throughout the encryption code to call ad_paramete instead)
+-- modified ad_verify_and_get_user_id to use the registration finite state machine
+-- modified users_active and users_new in /doc/sql/community-core.sql to use the finite state machine.  These views now limit to authorized users.
+</pre>
+
Index: web/openacs/www/doc/chat.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/chat.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/chat.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,438 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Chat</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Chat</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+<ul>
+<li>User-accessible directory:  <a href="/chat/">/chat/</a>
+<li>Site administrator directory:  <a href="/admin/chat/">/admin/chat/</a>
+<li>Group administrator directory:  <a href="/chat/admin">/chat/admin/</a>
+<li>data model :  <a href="/doc/sql/display-sql.tcl?url=/doc/sql/chat.sql">/doc/sql/chat.sql</a>
+<li>Tcl procs:  /tcl/chat-defs.tcl
+</ul>
+
+
+<h3>Why is Chat Useful?</h3>
+
+Why is a chat server useful?  As traditionally conceived, it isn't.  The
+Internet is good at coordinating people who are separated in space
+<em>and time</em>.  If a bunch of folks could all agree to meet at a
+specific time, the telephone would probably be a better way to support
+their interaction.
+
+<p>
+
+The way that commercial chat server vendors pitch their products these
+days is for customer service.  Joe User is presumed to be using a
+computer and his one phone line.  So he can't just pick up the phone and
+call them because he'd have to drop his Internet connection.  Also, a
+customer service person can handle four or five sessions at once if done
+via something like AOL Instant Messenger rather than via the telephone.
+
+<p>
+
+Then why can't companies that want to do 1:1 conversations just use 
+<a href="http://www.aim.aol.com/">AOL
+Instant Messenger (AIM)</a>?  AOL Instant Messenger works best with
+some
+additional software to be installed on the user's machine.  This is free
+software and it shipped with Netscape 4.x and it is certainly available
+to AOL service customers.  But it is not universal and you can't be
+guaranteed that because someone is connecting to your Web site that they
+have the AIM client.  An AIM-compatible Java applet is available.  Since
+a Java applet can only connect to the server from which it was
+downloaded, you must reference this by including a link to 
+<a href="http://toc.oscar.aol.com">http://toc.oscar.aol.com</a>
+(the first thing this page does is execute some JavaScript that bounces
+your browser back one page, so from the user's point of view it looks
+like the Java client just popped up and they never left the real
+publisher's page).
+
+<p>
+
+A second limitation to the "just use AIM" approach for customer service
+is that AIM doesn't provide convenient canned responses.  In theory, you
+might be able to come up with 10 or 15 canned responses that would cover
+50% of the inquiries.  Then the same staff can handle more customers.
+
+<p>
+
+A third limitation to the "just use AIM" approach is that you can't have
+rich content, e.g., in-line images, because AIM is not a Web browser and
+can't render HTML.
+
+<p>
+
+A fourth reasons that AIM isn't adequate is that it is tough to measure
+the effectiveness of your staff.  The conversations aren't centrally
+logged (though your staff could save them individually to disk).  The
+conversations aren't tied to your users table.
+
+<p>
+
+A good example of a company that has addressed many of these issues is 
+<a href="http://www.liveperson.com">liveperson.com</a>.  For $250 per
+customer service agent per month (prices as of April 1999), they will
+just do everything for you on their server farm.  There are a few
+problems with LivePerson:
+
+<ol>
+<li>The information in their database isn't automatically sync'd with
+the information in your database; you'll have two users tables, one on
+their server and one on your server.
+
+<li>They don't solve the "public chat room" problem for those who wish
+to have this; LivePerson is limited to customer service and is best
+thought of as "a more specialized AIM".
+
+</ol>
+
+
+<h3>The Big Idea</h3>
+
+We have our own chat server because 
+
+<ul>
+
+<li>we want our entire system to be integrated; one users table; one
+comprehensive view of what a user has done on our site
+
+<li>we want to be able to create and drop chat rooms in conjunction with
+the creation or dropping of user groups or other publisher-specific
+database structures, e.g., the creation of a class by a teacher.  The
+only practical way to do this is if a chat room is really an Oracle
+table construct of some sort.  Otherwise, we can't do this as a
+transaction (sadly, I'm not sure that we can really accomplish this
+objective if we go with separate tables per chat room since CREATE TABLE
+and DROP TABLE are not rollback-able).
+
+<li>we want something that can be extended and maintained by any
+ArsDigita programmer, i.e., something that requires only AOLserver Tcl
+and Oracle skills
+
+<li>commercial chat servers tend to be unreliable and expensive to
+maintain; they sometimes bring down entire Solaris machines
+
+</ul>
+
+A potential limitation of our system is that Oracle's consistency and
+durability guarantees are expensive.  If we had 50 submissions per
+second and 1000 queries for chatroom updates per second, we would need a
+super huge Unix machine.  In theory, a custom-built chat server ought to
+be capable of higher performance for a given piece of hardware.  In
+practice, the commercial systems aren't programmed properly and they
+crash.  They also get unreliable and slow when, for example, the number
+of chat rooms is large.
+
+<h3>One Table or Many Tables?</h3>
+
+We've had good luck with the /bboard system since 1995.  This uses one
+table to store all the messages, one message per row with a column for
+<code>topic</code>.  This has the virtue of simplicity.  This has the
+virtue of cleanliness in that all the identically structured data in the
+system is in a single table.  This has the virtue of easy searchability
+since Oracle is designed to build indices on one table at a time.  This
+has the virtue of transactionality for creation of bboard topics and
+deletion of bboard topics; no tables are created or dropped when topics
+are created or dropped.
+
+<p>
+
+A bad thing about the one-table structure is fragmentation and lack of
+recovery of disk space when postings are deleted.  For example, suppose
+that you drop an entire bboard topic with 2000 archived messages.  This
+will result in 2000 random deletions from perhaps 1000 Oracle blocks.
+The table won't shrink any, i.e., it will still consume just as many
+disk blocks.  The free space might not even be used on subsequent
+inserts, depending on what percentage of the block is now free.
+According to <cite>Oracle8 Tuning</cite>, page 146, index entries for
+deleted rows aren't reclaimed until you do an <code>alter index
+***index_name*** rebuild</code>.  In practice, it seems that the
+<code>bboard</code> table on photo.net hasn't suffered too badly from
+this problem (after three months).
+
+<p>
+
+Oracle has b-tree indices that are a maximum of four levels deep
+(header, two intermediate levels, leaf nodes).  So you don't get
+<i>O(log n)</i> access time through an index if the table has an
+outrageous number of rows.  The most important thing that we'll want to
+do is query by chat room key and date-time.  If we were to build a
+concatenated index on these values, we'd probably have the header block
+taken up with all the chat room names.  Then the next level would be
+ranges of times for a particular chat room.  Then the third level could
+be more ranges of times.  Then the leaf nodes would point to the rowids
+for specific dates.  This could be pretty darn selective if Oracle is
+smart about building the index.
+
+
+<h3>Archive or not?</h3>
+
+We have to drive the entire system design from a publishing decision:
+are we interested in seeing archives of chat sessions?  If we are, then
+the one-table structure makes a lot more sense.  We'll want to do a
+single SQL query to see everything that a user has contributed.  We'll
+want to do a single SQL query to see how a customer service person is
+doing. 
+
+<p>
+
+A disadvantage of archiving is that it chews up disk space.  Suppose
+we're America Online and 1 million subscribers chat or AIM every day.
+Let's further assume that each person types 50 rows of stuff, 100 bytes
+each.  That means our table will grow by 50 million rows and 5 GB every
+day.  After 20 days, we'll begin to bump up against the billion-row
+table size that data warehouse experts suggest as a practical limit.
+
+<p>
+
+Does that mean we scrap our simple one-table system?  Not yet.
+Designing systems for the highest volume sites is gratifying in a nerd
+ego sense, but it is a mistake if it leads to fewer features for the
+user and the publisher.  Remember that the future is not mass media but
+personalized content and lots of interesting mid-sized communities.
+
+<p>
+
+Let's reconsider a community like photo.net where the public bboards get
+no more than 2000 new messages per day, each one an average of 650
+characters.  That's an average of 1.3 Mbytes of new content every day,
+implying 8000 days before a 9 GB hard drive is filled up and 500,000
+days before we've built a billion-row table.  Obviously this isn't going
+to be a problem to archive indefinitely.  
+
+<p>
+
+Let's look at the photo.net community another way.  We have about 25,000
+daily visits.  Suppose that each of those 25,000 people used a photo.net
+chat or instant messaging service to send as much communication as they
+send via email.  Assume 100 messages per day and 200 bytes per message
+and all 25,000 people participating.  That's 0.5 Gbytes per day.  We
+fill up a modern (April 1999) 36 GB disk drive after two months. 
+
+<p>
+
+So it seems that on popular public sites we won't be able to store
+everything that users type.  At the same time, a real customer's
+interaction with a real customer service person ought to be archived
+forever (so that you can ask questions like "show me how many users who
+talked to Kathy eventually bought an item").
+
+<h3>How do we accomplish pruning and tuning?</h3>
+
+If we can be sure that we always have at least twice as much disk space
+as the chat that we want saved, we can do the following:
+
+<ul>
+<li>assume the live chat table is <code>chat_msgs</code>
+<li>create a table called <code>chat_msgs_new</code>
+<li>select all the stuff we want to save from <code>chat_msgs</code> and
+insert it into <code>chat_msgs_new</code>
+<li>drop any integrity constraints that reference <code>chat_msgs</code>
+<li><code>drop table chat_msgs</code>
+<li><code>alter table chat_msgs_new rename to chat_msgs</code>
+<li>rebuild indices on <code>chat_msgs</code>
+<li>add any integrity constraints that reference <code>chat_msgs</code>
+</ul>
+
+This is a pretty risky operation and we'd want a PL/SQL program to do it
+rather than rely on a human dba.  Chat could be down for as much as an
+hour so we'd want to do it on an early Sunday morning at the beginning
+of each month (or something similar).  We'll need to develop the Tcl
+scripts so that they can say "Chat server is being maintained right now;
+try back in one hour".  The pruning/tuning should be done by an
+AOLserver ns_schedule_proc that (1) sets the maintenance flag, (2)
+executes the PL/SQL proc, (3) resets the maintenance flag.
+
+<p>
+
+Following this operation, the chat table will be as compact as possible.
+
+<h3>Types of chat we need to support</h3>
+
+Public chat rooms.  These are open to everyone in the
+<code>users_active</code> view.  For moderation, we check perms using <a
+href="permissions.html">the permissions package</a> (where module =
+"chat" and submodule = **chat_room_id**).
+
+<P>
+
+Private chat rooms.  These are open to people in particular user
+groups.  We check perms using <a href="permissions.html">the permissions
+package</a>.
+
+<p>
+
+For either kind of chat room, we should support moderated chat.  That is, a
+posting doesn't go live until it has been approved by someone who has
+the "moderator" or "administrator" role in user group associate with a
+private chat room or, in the case of a public chat room, by someone who
+is a member of the appropriate chat moderation group.
+
+<P>
+
+We want to support 1:1 messages for customer support, if nothing else.
+We need one layer on top of this to make sure that users can find an
+appropriate chat partner. For example, if Bill User says that he needs
+support for his widget, the system has to find the least busy authorized
+widget support person and start a 1:1 chat session between Bill and that
+person.
+
+<p>
+
+For public community sites where nothing is being sold or supported, a
+publisher might wish to limit the load on the server from all of this
+1:1 chatting.  In that case, we set an ad.ini file parameter to just
+bounce users over to the AOL Instant Messenger infrastructure.
+
+<h3>Options for the publisher</h3>
+
+Some options are configurable per-room, e.g., 
+
+<ul>
+<li>Is a room moderated?  
+<li>If so, by whom?
+<li>Is a room restricted to users who are members of a particular group?
+<li>Should messages expire after a certain number of days?
+</ul>
+
+The per-system options are configurable in the ad.ini file.  The big
+items:
+
+<ul>
+<li>can users create their own rooms?
+
+<li>do you want the posting form on the top of the page and the most
+recent messages at the top (this is better for users; they won't have to
+scroll down after a refresh to see if there are new messages); or do you
+want the messages to run down chronologically?  (Note that theglobe.com
+and other popular chat systems seem to use the "new messages on top" style.)
+
+<li>do you want to offer users the option of using the system to send
+private messages to each other (not very well supported in version 1.5)?
+
+<li>do you offer users the ability to see the complete history of a chat
+room or is it "use it or lose it" (Our default is to provide this but
+note that many commercial chat systems do not provide history, at least
+not to the users)
+
+
+<li>exactly how many messages should be displayed when users get a chat
+page (starts at "short" and if they click "more messages" they can
+graduate to "medium" or "long")
+
+<li>add a photograph or other graphic in the top left corner of all chat
+pages? 
+
+</ul>
+
+<pre>
+[ns/server/yourservername/acs/chat]
+EnabledP=1
+; SystemName=Chat
+; how long to cache the postings to a room (updates force a cache update
+; so this theoretically could be 5 hours or whatever)
+CacheTimeout=120
+; how long will a room's properties (e.g., private group, moderation) be cached
+RoomPropertiesCacheTimeout=600
+UsersCanCreateRoomsP=0
+; set to 1 if you want most recent postings on top; this is the way that 
+; theglobe.com and other familiar chat systems do it (keeps users from 
+; having to scroll to see new msgs)
+MostRecentOnTopP=1
+; do we want to offer users the option of sending private messages?
+PrivateChatEnabledP=0
+; do we offer users a link to a chat room's history?
+ExposeChatHistoryP=1
+; how many messages to display when users choose short medium or long
+NShortMessages=25
+NMediumMessages=50
+NLongMessages=75
+; show a picture at the index page and in individual rooms?
+DefaultDecoration=&lt;a href="/photo/pcd0865/rachel-mouth-3.tcl"&gt;&lt;img HEIGHT=134 WIDTH=196 src="/photo/pcd0865/rachel-mouth-3.1.jpg" ALT="Mouth."&gt;&lt;/a&gt;
+; how often the javascript version should refresh itself
+JavaScriptRefreshInterval=5
+</pre>
+
+
+<h3>Linking into the system from a static page</h3>
+
+If you want to link into the chat system from a static page elsewhere on
+your site, do it by linking to "enter-room.tcl" rather than the more
+obvious "chat.tcl".  That way other users will see people coming in.
+
+<blockquote>
+<pre><code>
+&lt;a href="/chat/enter-room.tcl?chat_room_id=142"&gt;Chat&lt;/a&gt;
+</code></pre>
+</blockquote>
+
+
+<h3>Ensuring high performance</h3>
+
+Inevitably a system like this will require some polling, either by Java
+clients, HTTP Refresh headers, or JavaScript.  If we have 100 people in
+a chat room and they are all polling every 2 seconds, we don't want to
+have to buy an 8-CPU computer to support 50 queries per second right
+into Oracle.  So we make heavy use of 
+<a
+href="proc-one.tcl?proc_name=util_memoize"><code>util_memoize</code></a>.
+When a new posting is made, we force a cache update with <a
+href="proc-one.tcl?proc_name=util_memoize_flush"><code>util_memoize_flush</code></a>.
+More than 95% of the time, a user is getting 
+results from AOLserver's virtual memory and not from the database.
+
+
+<h3>Why the HTML version can't autorefresh</h3>
+
+The HTML page cannot have a Refresh: header for client-pull autofresh.
+If you did this, the user would be at risk of losing what he or she was
+typing into the post form.
+
+
+<h3>If you care about database performance</h3>
+
+An active chat server is going to result in a fair number of Oracle
+transactions.  You'll at least want to keep chat tables on a new
+separate physical disk drive.  You'll want indices on those tables to
+reside on yet another new disk drive.  Since every disk drive on a 24x7
+server must be mirrored, that means you need four new disk drives to
+implement this module.  
+
+<h3>Practical Experience from photo.net</h3>
+
+We tested the service on photo.net.  Here's a transcript excerpt from
+the first day:
+
+<blockquote>
+<pre><code>
+Justin (06:42:14) Anyone there?
+Justin (06:46:41) alright...I'll assume everyone is asleep. Sleep well. Goodnight.
+Tommy (06:55:33) anyone here?
+Tommy (06:58:09) so this is supposed to be a camera shopping chat room...
+Justin (07:27:04) I'm here.
+Justin (07:28:25) But...I guess you were here...like a half hour ago, so I'm going to take my
+circadain rhythm problem to the donut shop.
+Lim (09:59:23) hi
+Lim (09:59:51) anybody around?
+Eve (10:19:10) Hi there.
+Eve (10:24:14) anybody around? Are you still there Lim?
+</code></pre>
+</blockquote>
+
+Kind of makes you feel that all those long hours spent programming and
+maintaining Unix and Oracle were worthwhile...
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/chunks.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/chunks.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/chunks.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,176 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>The Chunks Module</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Chunks</h2>
+<P>
+
+part of the <A href="/doc/index.html">ArsDigita Community System</A>
+by <a href="http://photo.net/philg/">Philip Greenspun</a><BR>
+<br>
+this module is maintained separately from the rest of OpenACS by <a href="http://www.jamesshannon.com">James Shannon</a>. Go there for more help and bugs and features and whatnot. </P>           
+
+<hr>
+
+<ul>
+<li>User-accessible directory: none 
+<li>Administrator directory:  <A href="/admin/chunks/">/admin/chunks/</A>
+<li>data model : none 
+<li>Tcl procs: /tcl/chunks.tcl</li>    
+
+</ul>
+
+<h3>What's the dilly, yo?</h3>
+
+<p>
+Often times, an organization will want to display dynamic information on the home page or section landing pages. This dynamic information needs to be abbreviated  into a chunk of information to fit into specific space-confined sections of the page. Chunks will do that.
+
+
+<h3>Say what?</h3>
+
+<p>
+Chunks is a fairly simple 'module' of sorts that offers functions that one can call to obtain a list of relatively up to date and concise information perfect for working into a section of another page. A function is also offered that allows for reiterative templating of specific chunks of html.
+<p>
+Since many of these pieces of information are actually collections of other pieces of information(date, title, etc), the functions return a list of lists. The main list holds a predetermined number of sublists, each holding the required information. Alternatively, the <b>reiterate_through_chunk</b> function returns straight html similar to what has been passed in.
+<p>
+Memoize is used to substantially reduce the load placed upon the servers generated by the exact same SQL call every time a page is hit. As such, some information could be up to 2 hours(the default) old. This time limit can be changed and the admin pages offer a way to refresh the cached data.
+
+<p>
+<h3>Up close and personal</h3>
+<p>
+Chunks does not use any of it's own SQL tables as all information that it uses is grabbed from tables owned by other modules.
+<p>
+When one of the functions is called, it uses memoize to store or retrieve the results (depending on how recent the cached information is) of an internal function that is responsible for generating the actual data.
+
+<h3>Using Chunks</h3> 
+
+A variety of functions are offered depending on exactly which module's information is desired.
+<p>
+The most efficient and easy to use function to print formatted content onto a page is <b>reiterate_through_chunk</b>.
+<p>
+<b>reiterate_through_chunk</b> <i>{db_handle, which_chunk, template}</i> -<br>
+&nbsp; &nbsp; Synopsis: returns a templatized and formatted html string for each item gathered by a chunk function<br><br>
+&nbsp; &nbsp; <font size="-1">Configuration: <i>there is no configuration for <b>reiterate_through_chunk</b></i></font><br>
+&nbsp; &nbsp; <font size="-1">Arguments: <br>
+<u>db_handle</u> - a valid database handle<br>
+<u>which_chunk</u> - a single word specifying which set of data from which module should be used. the choice here will make a difference in which variables are available in the template.<br>
+&nbsp; &nbsp; &nbsp; &nbsp; <i>news</i> :: uses the <b>most_recent_news</b> function; sets the variables: news_item_id, title, release_date, body, news_link, and pretty_release_date <br>
+&nbsp; &nbsp; &nbsp; &nbsp; <i>threads</i> :: uses the <b>most_active_threads</b> function; sets the variables: msg_id, count, topic, one_line, body, and msg_link <br>
+&nbsp; &nbsp; &nbsp; &nbsp; <i>calendar</i> :: uses the <b>current_calendar_events</b> function; sets the variables: calendar_id, category, title, body, start_date, end_date, calendar_link, pretty_start_date, pretty_end_date<br>
+&nbsp; &nbsp; &nbsp; &nbsp; <i>classifieds</i> :: uses the <b>most_recent_classifieds</b> function; sets the variables: classified_ad_id, domain, one_line, posted, manufacturer, classified_ad_link, pretty_posted<br>
+&nbsp; &nbsp; &nbsp; &nbsp; <i>active_auctions</i> :: uses the <b>most_active_classified_auctions</b> function; sets the variables: classified_ad_id, domain, one_line, posted, manufacturer, count, classified_ad_link, pretty_posted<br>
+<u>template</u> - the text that will be repeated for each individual item and parsed for the above available variables. Keep in mind to escape quotes and dollar signs passed into <u>template</u><br>
+</font>
+<br>
+&nbsp; &nbsp; <font size="-1">Returns: <i>a string formatted as specified in the template argument(see arguments)</i><br>
+</font>
+<br>
+&nbsp; &nbsp; <font size="-1">Example: try calling [reiterate_through_chunk $db news &quot;&lt;a href=\&quot;\$news_link\&quot;&gt;\$title&lt;/a&gt; (\$pretty_release_date) - \$title&lt;br&gt;&quot;]<br>
+</font>
+<br>
+<br>
+Alternatively, you can use the more detailed functions and then reiterate through the output lists yourself with a for loop.<br><br><br>
+<b>most_recent_news</b> <i>{db_handle}</i> -<br>
+&nbsp; &nbsp; Synopsis: gathers pertinent information about the most recent and active news articles<br><br>
+&nbsp; &nbsp; <font size="-1">Configuration:<i>located in the ad.ini file under [ns/server/servername/acs/chunks]</i><br>
+NewsCacheLength - amount of time(in seconds) to hold the gathered information for before hitting SQL again<br>
+MaxNews - the maximum number of articles to retrieve<br>
+MaxNewsBodyLength - the approximate length that the body will be truncated to(it is actually the first space after the given number).</font><br><br> 
+&nbsp; &nbsp; <font size="-1">Returns:<i>One list containing a variable number of sublists. The sub lists are structured as follows:</i><br>
+sublist[0] - news_item_id :: most useful for linking to the item.tcl page<br>
+sublist[1] - title :: the title of the news item<br>
+sublist[2] - release_date :: the SQL represenation of when the article is to be released<br>
+sublist[3] - body :: the first x characters(see configuration) of the body of the news article<br>
+sublist[4] - html_p :: whether or not the article was entered in html format<br>
+</font>
+<br>
+<P>
+<b>most_active_threads</b> <i>{db_handle}</i> -<br>
+&nbsp; &nbsp; Synopsis: Determines and returns the most recently active threads by counting the number of posts in the last x days<br><br>
+&nbsp; &nbsp; <font size="-1">Configuration:<i>located in the ad.ini file under [ns/server/servername/acs/chunks]</i><br>
+BboardCacheLength - amount of time(in seconds) to hold the gathered information for before hitting SQL again<br>
+MaxBboardThreads - the maximum number of threads to 
+retrieve<BR>
+ MaxMsgBodyLength - the approximate length that the body will be truncated to(it is actually the first space after the given number).</font><FONT 
+size=-1>
+        <br>
+CountOldMessages - the number of days back to 
+take individual messages into consideration (the age of the thread itself does 
+not matter)</FONT><br><br> 
+&nbsp; &nbsp; <font size="-1">Returns:<i>One list containing a variable number of sublists. The sub lists are structured as follow
+s:</i><br>
+sublist[0] - root_msg_id :: the original message in the thread; most useful for linking to the *fetch.tcl page<br>
+sublist[1] - count :: the number of recently posted messages in that thread<br>
+sublist[2] - topic :: the name of the topic that this thread is in<br>
+sublist[3] - 
+one_line :: the subject of the original message in the thread<BR>sublist[4] - 
+body 
+:: the first x characters(see configuration) of the body of the root message
+</font>
+<br></P>
+<P>
+
+<b>current_calendar_events</b> <i>{db_handle}</i> -<br>
+&nbsp; &nbsp; Synopsis: gathers pertinent information about the most current events on the calendar(events that have not ended yet)<br><br>
+&nbsp; &nbsp; <font size="-1">Configuration:<i>located in the ad.ini file under [ns/server/servername/acs/chunks</i><br>
+EventsCacheLength - amount of time(in seconds) to hold the gathered information for before hitting SQL again<br>
+MaxEvents - the maximum number of events to retrieve<br>
+MaxEventBodyLength - the approximate length that the body will be truncated to(it is actually the first space after the given number).</font><br><br>
+&nbsp; &nbsp; <font size="-1">Returns:<i>One list containing a variable number of sublists. The sub lists are structured as follow
+s:</i><br>
+sublist[0] - calendar_id :: most useful for linking to the item.tcl page<br>
+sublist[1] - category :: the category name that this event has been placed in<br>
+sublist[2] - title :: the title of the calendar item<br>
+sublist[3] - body :: the first x characters(see configuration) of the body of the calendar item<br>
+sublist[4] - html_p :: whether or not the body is in html format<br>
+sublist[5] - start_date :: the SQL representation of when this event will/did start<br>
+sublist[6] - end_date 
+:: the SQL representation of when this even will end
+</font>
+<br>
+<b>most_recent_classifieds </b><i>{db_handle}</i> -<br>
+&nbsp; &nbsp; Synopsis: gathers pertinent information about  the most recently posted classified ads<BR><br>
+&nbsp;&nbsp;&nbsp; <font size="-1">Configuration:<i>located in the ad.ini file under [ns/server/servername/acs/chunks</i><br>
+ClassifiedsCacheLength - amount of time(in seconds) to hold the gathered information for before hitting SQL again<br>
+MaxAds - the maximum number of classified ads to retrieve</font><br><br>
+&nbsp;&nbsp;&nbsp; <font size="-1">Returns:<i>One list containing a variable number of sublists. The sub lists are structured as follow
+s:</i><br>
+sublist[0] - classified_ad_id :: most useful for linking to 
+the view-one.tcl page<BR>
+sublist[1] - domain 
+:: the category that the ad has been placed in
+<BR>sublist[2] - one_line :: the 'subject' 
+line of the ad<BR>sublist[3] - posted :: the SQL representation of when this ad 
+was posted<BR>sublist[4] - manufacturer :: the software stores a textual 
+representation of the price in manufacturer</FONT>
+<p>
+<br>
+
+<b>most_active_classified_auctions</b> <i>{db_handle}</i> -<br>
+&nbsp; &nbsp; Synopsis: Determines and returns the most recently active auctions(determined by number of bids in last x days)<br>
+&nbsp; &nbsp; <font size="-1">Configuration: <i>located in the ad.ini file under [ns/server/servername/acs/chunks]</i><br>
+AuctionsCacheLength - amount of time(in seconds) to hold the gathered information for before hitting SQL again<br>
+MaxAuctions - the maximum number of ads to retrieve<br>
+CountOldBids - the number of days back to take bids into consideration</font>
+<br><br>
+&nbsp; &nbsp; <font size="-1">Returns:<i>One list containing a variable number of sublists. The sub lists are structured as follow
+s:</i><br>
+sublist[0] - classified_ad_id :: most useful for linking to the view-one.tcl page<br>
+sublist[1] - domain :: the category that the ad has been placed in<br>
+sublist[2] - one_line :: the 'subject' line of the ad<br>
+sublist[3] - posted :: the SQL representation of when this as was posted<br>
+sublist[4] - manufacturer :: the software stores a textual representation of the price in manufacturer<br>
+sublist[5] - count :: the number of recent bids on this particular ad
+</font>
+<br>
+<br>
+<p>
+A demonstration of the functions at work can be found in the <A href="/admin/chunks/">admin</A> directory.
+<hr>
+<address><A href="mailto:james@jamesshannon.com">james@jshannon.com</A></address>
+
+</body>
+</html>
Index: web/openacs/www/doc/classifieds.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/classifieds.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/classifieds.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,86 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Classifieds</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Classifieds</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+<ul>
+<li>User-accessible directory:  <a href="/gc/">/gc/</a>
+<li>Moderators' directory:  <a href="/gc/admin/">/gc/admin/</a>
+<li>Site administrator directory:  <a href="/admin/gc/">/admin/gc/</a>
+
+<li>data model :  <a href="/doc/sql/display-sql.tcl?url=/doc/sql/classifieds.sql">/doc/sql/classifieds.sql</a>
+<li>Tcl procs:  /tcl/gc-defs.tcl 
+
+</ul>
+
+<h3>The Big Idea</h3>
+
+The ArsDigita Community system contains the photo.net classified ads
+module, which has processed more than 100,000 ads since its inception in
+1996.  The module includes the following features:
+
+<ul>
+
+<li>multiple domains per ACS installation, e.g., photography and travel
+can cooexist
+
+<li>multiple categories per domain, extendable by user or by site
+administrator, depending on configuration
+
+<li>multiple moderators per domain 
+
+<li>auctioning available, configurable by site owner per domain and also
+by user per ad
+
+
+</ul>
+
+<h3>Publishing Decisions</h3>
+
+Via the ad.ini file, you can enforce a lot of publishing decisions,
+e.g., "don't allow anyone to mention eBay" or "how many bids does an ad
+have to get in order to be considered a hot auction?"
+
+<blockquote>
+<pre><code>
+[ns/server/yourservername/acs/gc]
+SystemName=Classifieds
+; SystemOwner=  (defaults to global system owner)
+PartialUrlStub=/gc/
+ProvideLocalSearchP=1
+ProvideEmailAlerts=1
+; send a reminder to people to edit or delete their ads?
+NagAdOwners=1
+HowManyRecentAdsToDisplay=5
+HotAuctionThreshold=2
+; some stuff to deal with annoying photo.net abusers
+; don't let people put the word "reduced" in subject line
+DisallowReducedInSubject=1
+DisallowExclamationPointInSubject=1
+DisallowAllUppercase=1
+DisalloweBay=1
+IncludeBannerIdeasP=1
+IndexPageDecorationTop=
+IndexPageDecorationSide=
+DomainTopDecorationTop=
+HotAuctionsDecoration=
+PlaceAdDecoration=
+PlaceAd2Decoration=
+EditAd2Decoration=
+AddAlertDecoration=
+</code></pre>
+</blockquote>
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/clickthrough.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/clickthrough.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/clickthrough.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,81 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Clickthrough</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Clickthrough</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+
+<ul>
+<li>User-accessible directory:  none
+<li>Site administrator directory:  <a href="/admin/click/">/admin/click/</a>
+<li>data model :  within <a
+href="sql/display-sql.tcl?url=/doc/sql/community-core.sql">/doc/sql/community-core.sql</a>
+<li>Tcl procs:  /tcl/ad-clickthrough.tcl
+</ul>
+
+
+Here's the data model (from <a
+href="sql/display-sql.tcl?url=/doc/sql/community-core.sql">/doc/sql/community-core.sql</a>):
+
+<blockquote>
+<pre><code>
+create table clickthrough_log (
+	local_url	varchar(400) not null,
+	foreign_url	varchar(300) not null,	-- full URL on the foreign server
+	entry_date	date,	-- we count referrals per day
+	click_count	integer default 0
+);
+</code></pre>
+</blockquote>
+
+Note that we key this table by the URL on our server rather than by a
+page ID.  Note further that this local URL does not include the
+beginning / (a legacy from the old days but I guess it is OK). This
+enables page authors to build pages without being aware of the internal
+<code>page_id</code> by which our system might know the comments or
+links associated with a page.  Here's what a link out reference looks
+like:
+
+<blockquote>
+<pre><code>
+&lt;a href="/ct/photo/where-to-buy.html?send_to=http://www.bhphotovideo.com/"&gt;B&H Photo&lt;/a&gt;
+</code></pre>
+</blockquote>
+
+This is a reference on the page <a
+href="http://photo.net/photo/where-to-buy.html">http://photo.net/photo/where-to-buy.html</a>,
+sending readers over to <a href="http://www.bhphotovideo.com/">http://www.bhphotovideo.com/</a>.
+
+<p>
+
+For legacy sites that used to log clickthroughs with my old system,
+there is a parameter in the ad.ini file that lets you specify a custom
+regular expression to permit old-style references that include a realm,
+e.g., 
+
+<blockquote>
+<pre><code>
+&lt;a href="/ct<font color=red>/philg</font>/photo/where-to-buy.html?send_to=http://www.bhphotovideo.com/"&gt;B&H Photo&lt;/a&gt;
+</code></pre>
+</blockquote>
+
+Here's the necessary magic from my ad.ini file:
+
+<blockquote>
+<pre><code>
+[ns/server/photonet/acs/click]
+CustomREGEXP=/ct/philg/(.+)$
+</code></pre>
+</blockquote>
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/common-errors.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/common-errors.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/common-errors.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,446 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Common Errors</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Common Errors</h2>
+
+by database backed website application programmers,
+by <a href="http://teadams.com">Tracy Adams</a>
+
+<p>
+
+(part of the <a href="developers.html">ArsDigita Community System
+Developer's guide</a>)
+
+<hr>
+This document contains common errors and important facts to be aware of when 
+building new ACS pages. The examples use the standard ACS platform (Oracle, AOLserver, Tcl),  but most demonstrate generic issues. Obtaining a sound understanding of these issues is a good exercise in learning the fine points of database backed website design.
+<p>
+<h3>Special characters</h3>
+<ul>
+<li><b>String parameters in a URL must be urlencoded</b><br>
+<blockquote>
+Incorrect:<br>
+ns_write "&lt;a href=\"index.tcl?<font color=red>foo=$foo</font>\"&gt;ACS&lt;/a&gt;"
+<br>
+If foo contains a space, ?, & or another character not valid in an URL parameter, foo will not be defined correctly on the next page.
+<p>
+Solutions:<br>
+Use <code>ns_urlencode</code> to protect an individual string.
+<br>
+ns_write "&lt;a href=\"index.tcl?<font color=red>foo=[ns_urlencode $foo]</font>\"&gt;ACS&lt;/a&gt;"<br>
+<br>
+Use <code>export_url_vars</code> to handle one or more url parameters (<code>export_url_vars</code> also filters out undefined variables).<br>
+
+ns_write "&lt;a href=\"index.tcl?<font color=red>[export_url_vars foo bar]</font>\"&gt;ACS&lt;/a&gt;"
+<p>
+</blockquote>
+Complex case relevant to ACS:<br>
+When you use the <code>return_url</code> parameter to pass a URL through the registration process, both the individual parameters of return_url and the return_url as whole must be urlencoded.  
+<p>
+<blockquote>
+Incorrect:<br>
+ns_returnredirect "/register/index.tcl?return_url=[<font color=red>ns_urlencode</font> "index.tcl?<font color=red>domain=$domain</font>"]"<br>
+<p>
+Correct:<br>
+ns_returnredirect "/register/index.tcl?return_url=[<font color=red>ns_urlencode</font> "index.tcl?<font color=red>[export_url_vars domain]</font>"]"
+</blockquote>
+
+<li><b> Form values (except for textareas) need to be enclosed in doublequotes. The " character within a form value should be replace with &amp;quot;</b>
+<blockquote>
+Incorrect:<br>
+ns_write "&lt;input type=text name=test value=<font color=red>$foo</font>&gt;"
+<br>
+If foo contains a &gt; or ", the value may be cropped or your form may be misdefined.
+<p>
+Correct:<br>
+ns_write "&lt;input type=text name=test value=<font color=red>\"[philg_quote_double_quotes $foo]\"&gt;</font>"
+<p>
+For text fields, the <code>export_form_value</code> is useful. 
+<br>
+ns_write "&lt;input type=text name=test <font color=red>[export_form_value foo]</font>&gt;"
+
+<p>
+One or more hidden variables can be properly output and protected using
+</code>export_form_vars</code>. <br>
+ns_write "<font color=red>[export_form_vars foo bar]</font>"
+</blockquote>
+
+
+<li><b>Textarea values are cropped by &lt;/textarea&gt;</b><br>
+To prevent cropping, the browser must not interpret a  &lt;/textarea&gt;
+in the textarea value as the end of the textarea. One way to do this
+is to replace &lt; with &amp;lt; and &gt; with &amp;gt;. <code>ns_quotehtml</code> will do this for you.
+<blockquote>
+ns_write "&lt;textarea&gt;<font color=red>[ns_quotehtml $foo]</font>&lt;/textarea&gt;"
+</blockquote>
+<li> <b>Values used in a SQL statement need to double quote quotes. ('' must repace ') </b>
+<blockquote>
+The ' is SQL's escape character.
+<p>
+Incorrect:<br>
+ns_db dml $db "insert into foo (string_column) values (<font color=red>'$string_column'</font>)"
+<p>
+
+Solutions:<br>
+If you use <code>set_form_variables_string_trim_DoubleApos</code> or <code> set_the_usual_form_variables</code> to define variables for the keys/value pairs in [ns_conn form], quoted forms of the variables will be defined.
+<p>
+
+Correct:<br>
+<font color=red>set_the_usual_form_variables</font><br>
+ns_db dml $db "insert into foo (string_column) values (<font color=red>'$QQstring_column'</font>)"
+<p>
+Alternatively, you can use <code>DoubleApos</code> or <code>ns_dbquotevalue</code>:
+<br>
+ns_db dml $db "insert into foo (string_column) values (<font color=red>'[DoubleApos $string_column]'</font>)"
+<br>
+or
+<br>
+ns_db dml $db "insert into foo (string_column) values (<font color=red>[ns_dbquotevalue $string_colum]</font>)"
+</blockquote>
+<li><b>Escape special TCL characters with \ </b>
+<blockquote>
+You will often have to escape special TCL characters. ", {, }, [, and ] are the most common examples.
+<p>
+Incorrect:<br>
+ns_write "&lt;a href=<font color=red>"index.tcl"</font>&gt;ACS&lt;/a&gt;"
+<p>
+Correct:<br>
+ns_write "&lt;a href=<font color=red>\"index.tcl\"</font>&gt;ACS&lt;/a&gt;"
+
+</blockquote>
+
+</ul>
+
+<h3>User input</h3>
+
+<ul>
+<li><b>Double clicks</b><br> 
+For any insert, you should always assume the user is going to double click on the submission form. To prevent integrity an constraint or duplicate data, you should generate the sequence id before the insert.  This concept is described in depth in <a href="http://photo.net/wtr/thebook/ecommerce.html">the ecommerce</a> chapter in <a href="http://photo.net/wtr/thebook/">Philip and Alex's Guide to Web Publishing</a>.
+<p>
+<li><b>Bad data</b><br>
+Always consider cases where the user input might be blank, too long, or an incorrect type.  Use Maxlength or the standard user error trapping to handle these cases before they result in a database error or data problems.
+</ul>
+<H3>HTML Tables</h3>
+
+<ul>
+<li><b>Confining data to tables are the worst case for speed</b><br>
+If data is contained in a table, the browser must receive all of the data before it can calculate the table layout and produce any output for the user.  Refraining from table use or breaking up table will give the user a faster experience because data can be presented as it received. The difference can be extremely dramatic.
+<p>
+<li><b>Closing your table tags</b><br>
+Depending on your browser, failure to close your table tags can result in a blank screen.
+
+</ul>
+
+<H3>Cookies and domains</H3>
+<ul>
+<li><b>Domains with the same IP don't always recognize each other's cookies</b><br>
+For example, http://photo.net and http://www.photo.net are the same site.
+However, if a user is at http://photo.net, the server will not recognize a cookie set by a prior visit to http://www.photo.net.
+In addition, most servers (including AOLserver)  may redirect a user to the server's Hostname domain while the user is surfing for various reasons (when redirecting, for example).  The cookie chain files (starting with cookie-chain.tcl) should be used to set cookies on both domains. 
+</ul>
+
+<H3>Infinite Loops</h3>
+<ul>
+<li><b>Infinite loops last until the server is restarted</b><br>
+Threads continue to process even if you leave or stop a page. Common 
+mistakes are failure to increment a counter inside a 
+loop or relying on a comparison that never becomes valid.  
+</ul>
+
+<h3>Case sensitivity</h3>
+<ul>
+
+<li><b>Oracle is case sensitive</b> <br>
+This is important to consider when you want to order by a given column 
+or maintain uniqueness regardless of case, such as the user's email in ACS.
+<p>
+<li> <b>Column names are lower case</b><br>
+ The names of columns returned through the Arsdigita Oracle driver 
+are always lower case.
+</ul>
+
+<H3>Oracle and Nulls</H3>
+<ul>
+<li><b> "IS" must be used instead of "=" for comparison with NULL</b><br>
+<blockquote>
+Incorrect:<br>
+select user_id from users where <font color=red> home_phone = null </font> 
+<p>
+Correct:<br>
+select user_id from users where <font color=red> home_phone is null</font>
+</blockquote>
+The only exception to this rule occurs with update:
+<blockquote>
+update users set <font color=red>home_phone = null</font> where user_id = 10
+</blockquote>
+<li> <b>In Oracle, '' is not equivalent to NULL</b> 
+<blockquote>
+Incorrect.<br>
+set num_users [database_to_tcl_string $db "select count(user_id) from users where <font color=red>url = '$foo'</font>"]
+<p>
+If $foo is "", num_users will always be 0.
+<p>
+Correct:<br>
+set num_users [database_to_tcl_string $db "select count(user_id) from users where  (<font color=red>url = '$foo'
+or ('$foo' is null and url is null)</font>)"]
+</blockquote>
+
+<li><b>Oracle uses 3 way logic</b>
+<p>
+If you wanted to count users that did not visit today:<br>
+<blockquote>
+Incorrect:<br>
+select count(user_id) from users <br>
+where <font color=red>trunc(last_visit) <> trunc(sysdate)</font>
+<p>
+(This would not include users that had a <code>last_visit</code> of null.)
+<p>
+Correct:<br>
+select count(user_id) from users<br> 
+where (<font color=red>trunc(last_visit) <> trunc(sysdate)<br>
+or last_visit is null</font>)
+</blockquote>
+
+
+<i>See <a href="http://photo.net/wtr/oracle-tips.html"</a>Tips for using Oracle</a> for more discussion of this and other Oracle issues.</i>
+</ul>
+<h3>Dates</h3>
+<ul>
+<li><b>Ordering dates by a pretty name</b><br>
+If you use <code>to_char</code> to produce a formatted version of a date column, ordering by this column will order by the alphabetized word, not the sequential date.
+
+<blockquote>
+Incorrect:<br>
+set selection [ns_db select $db "select to_char(posting_time,'Month dd, yyyy') as <font color=red>posting_time</font> 
+from bboard
+order by <font color=red>posting_time</font>"]
+<p>
+Correct:<br>
+set selection [ns_db select $db "select  to_char(posting_time,'Month dd, yyyy') as <font color=red>pretty_posting_time</font> 
+from bboard
+order by <font color=red>posting_time</font>"]
+</blockquote>
+</ul>
+   
+<h3>Concurrency</h3>
+<ul>
+<li><b>Timing issues within one page</b><br>
+ You can still have concurrency bugs even with Oracle if you assume a given page runs in isolation. For example, if you have the following logic:
+<blockquote>
+if { [database_to_tcl_string $db "select count(id) from foo_table where id=$id"] == 0 } {<br>
+&nbsp;&nbsp;&nbsp;&nbsp;ns_db dml $db "insert into foo_table (id) values ($id)"<br>
+}<br>
+</blockquote>
+
+If there are two hits to this page, perhaps due to a double click, you can have the following sequence:
+<ul>
+<li> Page a looks for the row
+<li> Page b looks for the row
+<li> Page a inserts
+<li> Page b inserts 
+</ul>
+<p>
+In these cases, be sure to use select for update to get the appropriate lock.
+<br>
+For example:
+<blockquote>
+ns_db dml $db "<font color=red>begin transaction</font>"<br>
+set selection [ns_db $db 0or1row  "select id from foo_table where id=$id <font color=red>for update of foo_table.id</font>"]<br>
+<p>
+if [empty_string_p $selection] {<br>
+&nbsp;&nbsp;&nbsp;&nbsp;ns_db dml $db "insert into foo_table (id) values ($id)"<br>
+}<br>
+ns_db dml $db "<font color=red>end transaction</font>"
+</blockquote>
+</ul>
+
+<h3>Database Handles</h3>
+<ul>
+<li><b>Handles inside procedures</b><br>
+ To prevent handle deadlocks, AOLServer requires you to release all database handles from a pool before you can allocate another handle from the same pool. 
+<p>To use a database handle in a procedure you should either pass the database handle as a parameter or use the <code>subquery</code> pool.  If you do use the <code>subquery pool</code>, you must release the handles before the procedure returns to avoid clashes with other procedures.
+<p>
+<li><b>Performing queries using an occupied handle</b><br>
+
+If you perform a query and then process each row using a while loop, you should  not perform queries inside the loop with the same database handle. To do  this type of logic, you must retrieve a second handle when you first access the pool. (Note, you should think carefully before performing another query for every row returned by a first query.  It may be far more efficient and scalable to combine the queries into one using joins or a PL/SQL function.)
+
+<blockquote><pre>
+Incorrect:
+<font color=red>set db [ns_db gethandle]</font>
+
+set <font color=red>selection</font> [ns_db select <font color=red>$db</font> "select posting_date, bboard.* 
+from bboard
+where sort_key like '$msg_id%'
+and msg_id <> '$msg_id'
+order by sort_key"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query<r>
+    if $upload_p {
+        set <font color=red>selection</font> [ns_db select <font color=red>$db</font> "select * from bboard_uploaded_files where msg_id='$msg_id'"]<br>
+	<font color=red>set_variables_after_query</font>
+	...code...
+    } else {
+        ...code...
+    }
+}
+
+
+Correct:
+<font color=red>
+set db_conns [ns_db gethandle subquery 2]
+set db [lindex $db_conns 0] 
+set db_sub [lindex $db_conns 1] 
+</font>
+
+set <font color=red>selection</font> [ns_db select <font color=red>$db</font> "select posting_date, bboard.* 
+from bboard
+where sort_key like '$msg_id%'
+and msg_id <> '$msg_id'
+order by sort_key"]
+
+while {[ns_db getrow <font color=red>$db $selection</font>]} {
+    set_variables_after_query
+    if $upload_p {
+        set <font color=red>sub_selection</font> [ns_db select <font color=red>$db_sub</font> "select * from bboard_uploaded_files where msg_id='$msg_id'"]
+	<font color=red>set_variables_after_subquery</font>
+	...code...
+    } else {
+        ...code...
+    }	     
+}	
+</pre>
+</blockquote>
+</ul>
+
+<h3>TCL Confusion</h3>
+<ul>
+<li><b>Confusing SQL and TCL</b><br>
+Remember which language you are using!  For example, "&&" in TCL is often confused with "and" in SQL; "==" is used for equality in TCL, but "=" is used in SQL.
+
+<blockquote>
+Common mistake:<br>
+if { [info exists foo] <font color=red>and</font> ![empty_string_p $foo] } {<br>
+&nbsp;&nbsp;&nbsp;&nbsp;   ns_write "$foo"<br>
+}<br>
+<p>
+Corrected version:<br>
+if { [info exists foo] <font color=red>&&</font> ![empty_string_p $foo] } {<br>
+&nbsp;&nbsp;&nbsp;&nbsp;   ns_write "$foo"<br>
+}<br>
+</blockquote>
+
+<li> <b>Using ns_write after ns_return</b><br>
+<code>ns_return</code> writes a http contentlength header to the connection.  If you break up your output strings and use subsequent calls to <code>ns_write</code>, you will encounter sporadic cases of a pages that do not finish.
+
+<blockquote>
+Incorrect:<br>
+<font color=red>ns_return 200 text/html</font> "This is the first form fragment"<br>
+...tcl code...<br>
+<font color=red>ns_write</font> "This is the second form fragment"<br>
+<p>
+Correct:<br>
+<font color=red>append output_string</font> "This is the first form fragment"<br>
+...tcl code...<br>
+<font color=red>append output_string</font> "This is the second form fragment"<br>
+<font color=red>ns_return 200 text/html</font> $output_string
+<p>
+or
+<p>
+<font color=red>ReturnHeaders<br>
+ns_write</font> "This is the first form fragment."<br>
+...tcl code...<br>
+<font color=red>ns_write</font> "This is the second form fragment."<br>
+</blockquote>
+
+Concatenation may be a more efficient approach for computation and transmission, but using multiple outputs to the connection will produce a streaming effect.  Streaming will allow the user to see some data while the rest is being processed and transmitted and may work better for the user in many cases.
+
+</ul>
+
+<H3>Variables</h3>
+<ul>
+<li><b>Undefined variables</b><br>
+You can not refer to as variable's value, ie $foo, for a variable that is not defined.  Although this seems obvious, this can occur if you 
+<ul>
+<li> Assume a variable was submitted as part of a form. Checkbox and radio buttons that are not checked or selected do not pass their variables to the next page.
+<li> Assume it was obtained as part of a regexp.<br>
+In this example, second_to_last_visit is not necessarily defined.
+<blockquote>
+regexp {~second_to_last-([^;]+)} $cookie match <font color=red>second_to_last_visit</font><br>
+set pretty_second_to_last_visit "[ns_fmttime <font color=red>$second_to_last_visit</font> "%m/%d/%y %r"]"
+</blockquote>
+</ul>
+The function <code>export_var</code> can be used to protect against undefined variables.  For example, <code>export_var foo</code> will return "" if foo is not defined, or foo's value if foo exists.
+<p>
+<li><b>Unsafe string comparison</b><br>
+String comparison using "==" can cause subtle type problems due to the way the TCL intepreter handles types in this case.  A safe way to compare strings is with the string compare statement.    
+
+<blockquote>
+Unsafe:<br>
+if { <font color=red>$foo == "bar"</font> } { <br> 
+&nbsp;&nbsp;&nbsp;...tcl...<br>
+}
+<p>
+Correct: (Note that a exact match with string compare returns a 0.)<br>
+if { <font color=red>[string compare $foo "bar"] == 0</font> } { <br>
+&nbsp;&nbsp;&nbsp;...tcl... <br>
+}
+<p>
+If you just want to see if the variable is empty, use <code>empty_string_p</code><br>
+
+if <font color=red>[empty_string_p $foo]</font>  {<br>
+&nbsp;&nbsp;&nbsp;...tcl...<br>
+}
+
+</blockquote>
+
+
+<p>
+<li><b>Overwriting variables with set_variables_after_query</b><br>
+<code>set_variables_after_query</code> will overwrite any variables that conflict with column names.  A common case of this is when you pass user_id as a form or url variable, and then select the user_id column in a table. Using "select *" is particularly dangerous because changes to the database can break existing pages.
+<p>
+</ul>
+
+<h3>Stupidity</H3>
+
+<ul>
+<li> "Tiny" errors such as a misplaced " or mismatched bracket produce the same
+result as any other error -- a broken page.  Never edit a file
+without rechecking to see if the function still works.
+</ul>
+
+<p>
+
+<hr>
+The following a current problems should be fixed in the future.
+
+
+<h3>AOLServer Problems</h3>
+<ul>
+<li>AOLserver does not handle a urlencoding of the return character correctly.<br>
+For example:
+<blockquote>
+set foo "two<br>
+lines"
+<br>
+ns_write "&lt; a href=index.tcl?foo=[ns_urlencode $foo]"&gt;ACS&lt;/a&gt;
+</blockquote>
+
+If the user clicks to index.tcl, <code>ns_conn form</code> will not contain any data.
+<p>
+<i>This will be fixed in AOLServer 2.3.3.</i>
+
+<p>
+
+<li> AOLserver admin pages do not handle double quotes properly. If you use the AOLserver admin pages to update a row where one of the values contains a ", the field will be inadvertently cropped at the ".
+</ul>
+
+
+<hr>
+<a href="http://teadams.com"><address>teadams@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/contact-manager.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/contact-manager.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/contact-manager.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,114 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Contact Manager</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Contact Manager</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+<ul>
+<li>User-accessible directory:  /contact-manager/
+
+<li>Site administrator directory:  none (only site admin activity is to
+put people in the relevant user group)
+
+<li>data model :  <a href="/doc/sql/display-sql.tcl?url=/doc/sql/contact-manager.sql">/doc/sql/contact-manager.sql</a>
+
+</ul>
+
+<h3>The Big Idea</h3>
+
+As of March 1999, about six ArsDigita clients had come to us with the
+same problem
+
+<ul>
+
+<li>they have a big list of all the entities that they'd like to have
+as customers
+
+<li>they have a bunch of people whose job it is to contact these
+entities and exhort them to become customers; these people use a desktop
+contact manager such as ACT
+
+<li>when the entity is converted into a customer, information about it
+must be rekeyed from ACT into the main Oracle database that sits behind
+their Web site
+
+</ul>
+
+All said "we don't really care if we lose 95% of the features of ACT; we
+want to drive all of our activities from one database."
+
+<p>
+
+So here is a system with 5% of the features of ACT.  It has one killer
+feature, though:  you can tie it to the Oracle table of your choice!
+
+<h3>Stuff we need to keep in the /parameters/ad.ini file</h3>
+
+The Contact Manager system needs to know
+
+<ol>
+<li>to what table am I tied?
+<li>what column holds the primary key?
+<li>what data type is this column ("text" or "number"; we just want to
+know whether we have to wrap values in '' or not)
+<li>what column holds the best short name for an entity?
+<li>singular noun for an entity
+<li>plural noun for entities
+
+<li>how to do a transaction saying "this org is now signed up; they
+don't need to be sold anymore" (the parameter is the name of a PL/SQL
+proc to exec with an argument of the primary key value of the relevant entity) 
+
+<li>how to do a transaction saying "this org isn't worth signing up;
+they don't need to be contacted anymore" (the parameter is the name of a PL/SQL
+proc to exec with an argument of the primary key value)
+
+<li>what goes after an SQL ORDER BY if we want to rank entities by
+descending order of necessity to contact (e.g., for potential customers
+of a bank's VISA card program, you'd have <code>bankrupt_p, income
+desc</code> (rank by bankrupt or not first, then by descending income.))
+
+</ol>
+
+<h3>Stuff we store in Oracle tables</h3>
+
+The one thing that saddens me is that it is going to be impossible to
+spec a referential integrity constraint in the .sql file because we
+don't know in advance to what table the contact manager will be tied.
+However, we can say that we want to keep
+
+<ul>
+<li>date of contact 
+
+<li>who did the contacting (we assume it is person logged into browser;
+i.e., that people record their own contacts)
+
+
+<li>Name of contactee
+
+<li>email address of contactee
+
+
+
+<li>free text note (4000-character long max; not worth using a CLOB)
+
+</ul>
+
+We don't try to keep any fancy structure for things like the phone
+number of the contactee.  This might be annoying for users and it is
+useless because the only thing that this software is really be able to
+do with structured info is sent email (so we want the name for a "Dear
+Foobar" salutation and the email address for the To: header).
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/content-sections.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/content-sections.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/content-sections.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,181 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Content Sections</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Content Sections</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="mailto:tarik@arsdigita.com">Tarik Alatovic </a> and  <a href="mailto:ahmeds@mit.edu/">Sarah Ahmed</a> 
+
+<hr>
+
+<ul>
+<li>Site Wide Administrator directory:  <a href="/admin/content-sections/">/admin/content-sections/</a>
+<li>Group Administrator directory:  <a href="/groups/admin/$group_name/content-sections">/groups/admin/$group_name/content-sections</a>
+<li>data model:  <a href="/doc/sql/display-sql.tcl?url=/doc/sql/community-core.sql">/doc/sql/community-core.sql</a>
+<li>procedures:  in tcl/user-groups-defs.tcl
+
+</ul>
+
+<h3>The Big Picture</h3>
+
+This module allows the site administrator to create and manage different
+content sections of the site. Administration of content sections can be
+done on a site-wide level and a group level. It supports four different
+types of content sections - admin, system, custom and static. System
+sections correspond to one of the system modules of the site, e.g. news,
+bboard etc. Custom sections serve like url directories. So if group
+administrator of group travel at photo.net defines custom section sweden
+(e.g. photo.net/travel/sweden), he will be able to upload files for this
+section (see content_files table) in order to display the file
+photo.net/groups/travel/sweeden/stockholm.html. Details on custom
+sections can be found at <a
+href="/doc/custom-sections.html">/doc/custom-sections.html</a>. Static
+sections serve as html pages and address of html page is specified in
+section_url_stub. If you have file arsdigita.html in your careers
+directory then section_url_stub should be /careers/arsdigita.html. Admin
+sections are system sections that do not have associated public
+pages. They only have administration pages.
+
+<P>
+
+After creating appropriate content sections for the site, the system allows to view/edit/enable/disable the sections. It also allows to link different content sections so as to be shown on the page navigation bar (using ad_scope_navbar).  
+
+<p>
+
+At this stage, we only support creation and administration of system/admin/custom content sections at the group level. Site wide administrator can only create and manage static public pages. 
+
+<h3>The Medium-Sized Picture</h3>
+
+This system consists of three tables. The content_sections table holds information about different content sections; e.g. their scope, type , pretty_name etc. A row in the table would be news,bboard etc.
+
+<blockquote>
+<pre>
+create table content_sections (
+        section_id              integer primary key,
+        -- if scope=public, this is the content sections for the whole system
+        -- if scope=group this is the content sections for particular group
+        -- is scope=user this is the content sections for particular user
+        scope                   varchar(20) not null,
+	-- if section_type=system, this section corresponds to one of the system sections
+	-- such as news, bboard, ...
+	-- if section_type=custom, this section is custom section
+	-- custom sections serve like url directories. so if group administrator of group travel 
+	-- at photo.net defines custom section sweeden (e.g. photo.net/travel/sweeden), he will be 
+	-- able to then to upload files for this section (see content_files table) in order to display
+	-- the file photo.net/groups/travel/sweeden/stockholm.html
+	-- if section_type=static, this section is static section
+	-- static sections serve as html pages and address of html page is specified in section_url_stub
+	-- if you have file arsdigita.html in your carrers directory then section_url_stub should be
+	-- /carrers/arsdigita.html  
+	-- if section_type=admin, this section is system section but does not have associated public pages
+	-- it only has administration pages.
+	section_type                    varchar(20) not null,
+	-- does user have to be registered in order to access this page
+	requires_registration_p	char(1) default 'f' check(requires_registration_p in ('t','f')),
+	-- if visibility=public this content section is viewable by everybody
+	-- if visibility=private this content section is viewable be a user only if scope=user
+	-- or by group members only if scope=group
+	visibility		varchar(20) not null check(visibility in ('private', 'public')),
+        user_id                 references users,
+        group_id                references user_groups,
+        section_key             varchar(30) not null,
+	-- this is used only for system sections
+	-- each system sections is associated with an acs module
+	module_key		references acs_modules,
+        section_url_stub        varchar(200),
+        section_pretty_name     varchar(200) not null,
+        -- if we print lists of sections, where does this go?
+        -- two sections with same sort_key will sort 
+        -- by upper(section_pretty_name)
+        sort_key                integer,
+        enabled_p               char(1) default 't' check(enabled_p in ('t','f')),
+        intro_blurb		varchar(4000),
+        help_blurb      	varchar(4000),
+        index_page_enabled_p    char(1) default 'f' check (index_page_enabled_p in ('t','f')),
+        -- html content for customizing index page (this is used only for content sections of section_type custom)
+        body                    clob,
+        html_p                  char(1) default 'f' check(html_p in ('t','f'))
+);
+
+
+</pre>
+</blockquote>
+
+<P>
+
+The content_files table holds information about different files that belong to a custom section. The files can be of type text/binary.
+
+<blockquote>
+<pre>
+
+create table content_files (
+	content_file_id 	integer primary key,
+	section_id 		references content_sections,
+	-- this will be part of url; should be a-zA-Z and underscore
+	file_name		varchar(30) not null,
+        -- this is a MIME type (e.g., text/html, image/jpeg)	
+        file_type               varchar(100) not null,
+        file_extension          varchar(50),    -- e.g., "jpg"
+	-- if file is text or html we need page_pretty_name, body and html_p
+	page_pretty_name        varchar(200),
+	body			clob,
+	html_p			char(1) default 'f' check(html_p in ('t','f')),
+	-- if the file is attachment we need use binary_data blob( e.g. photo, image)
+	binary_data             blob
+);
+
+
+</pre>
+</blockquote>
+
+<P>
+
+The content_section_links table contains information about links between sections that is used to generate the page navigation bar.
+
+
+<blockquote>
+<pre>
+
+create table content_section_links(
+	section_link_id integer primary key,
+	from_section_id references content_sections,
+	to_section_id references content_sections,
+	constraint content_section_links_unique unique(from_section_id, to_section_id)
+);
+
+</pre>
+</blockquote>
+
+<P>
+
+<h3>Legal Transactions</h3>
+From the group administration pages at <a href="/groups/admin/$group_name/content-sections">/groups/admin/$group_name/content-sections</a> the group administrator can
+<p> 
+<ul>
+<li>Add/View/Edit/Enable/Disable a Static Section
+<li>Add/View/Edit/Enable/Disable a Custom Section
+<li>Add/View/Edit/Enable/Disable a Module
+<li>Set up Link between different sections to be shown in the navigation bar.
+</ul>
+<P>
+
+As mentioned before, the side wide administrator can Add/View/Edit/Enable/Disable a Static Section from <a href="/groups/admin/$group_name/content-sections">/groups/admin/$group_name/content-sections</a>.
+
+<p>
+
+<hr>
+
+<a href=mailto:tarik@arsdigita.com><address>tarik@arsdigita.com</address></a>
+</body>
+</html>
+
+
+
+
+
+
+
Index: web/openacs/www/doc/content-tagging.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/content-tagging.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/content-tagging.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,163 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Content Tagging Package</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Content Tagging Package</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+<ul>
+<li>User directory:  none
+<li>Admin directory:  <a href="/admin/content-tagging/">/admin/content-tagging/</a>
+
+<li>data model:  
+<a href="/doc/sql/display-sql.tcl?url=/doc/sql/content-tagging.sql">/doc/sql/content-tagging.sql</a>
+
+<li>procedures:  /tcl/ad-content-tagging.tcl
+
+</ul>
+
+<h3>The Big Picture</h3>
+
+We want a standardized and efficient way of asking the following kinds
+of questions:
+
+<ul>
+<li>does this document or message contain R-rated words?
+
+<li>does this user-contributed message include photography-related words?
+
+</ul>
+
+Note that this is distinct from categorization of content as implemented
+in the <code>categories, site_wide_category_map</code>, and
+<code>users_interests</code> tables.  This package was original aimed at
+identifying content that includes naughty words.
+
+<h3>The Medium-sized Picture</h3>
+
+Any content on an ACS system can be tagged.  A tag is an integer, and
+its exact length in bits is the maximum size of a Tcl integer.  The tag
+is generated at the time that content is inserted into the
+database (or edited).  In the case of a document that contains 100,000
+words, tagging might be expensive.  So we want to do it once and then
+have many people use it.
+
+<p>
+
+If BowdlerizeP is set to 1 in the ad.ini file, we store a bowdlerized
+version of the content in a separate column, typically with the same
+name as the original column plus a suffix of <code>_bowdlerized</code>.
+For example, in the Chat system, we keep <code>msg</code> and
+<code>msg_bowdlerized</code>.  The <code>_bowdlerized</code> column will
+be NULL unless there was actually some naughtiness in the original.
+Each naughty word will have been replaced with the character string in
+BowdlerizeReplacementPattern ("***" by default).  So applications can
+query with something like
+<blockquote>
+<pre><code>
+select nvl(msg_bowdlerized, msg) as filtered_msg from chat
+</code></pre>
+</blockquote>
+
+<p>
+
+Each user in the community has a mask associated with his account,
+stored in the <code>content_mask</code> column of the
+<code>users_preferences</code> table.  This is an integer, whose maximum
+length is the same as that of the content tags.
+
+<p>
+
+When a user tries to look at a piece of content, his mask is bit-ANDed
+with the content's tag, and if the result is non-zero, further
+investigation is required before the user can see the content; in
+particular, the <code>adct_tag_mask_mismatch</code> procedure 
+is invoked to decide what to do.
+
+<h3>Standard Bits</h3>
+
+Standard interpretation of bits:
+
+<blockquote>
+<table cellpadding=5>
+<tr><th>Bit Pos<th>Interpretation</tr>
+<tr><td align=right>0<td align=right>PG-rated</tr>
+<tr><td align=right>1<td align=right>R-rated</tr>
+<tr><td align=right>2<td align=right>X-rated</tr>
+</table>
+</blockquote>
+
+Note that an X-rated word would carry a bit vector of "111" since it
+raises a problem in all three categories.
+
+<h3>Configuration Parameters</h3>
+
+<pre>
+; for the Naughty Package
+; (PG|R|X)LogP=1 logs the potentially offensive material
+; (PG|R|X)BounceP=1 prevents the offensive material from being posted at all
+; Note that in generally, you can't bounce only PG and X, but not R,
+; the scripts find the lowest allowed naughtiness to bounce or log.
+[ns/server/yourservername/acs/content-tagging]
+; person to notify if something needs attention
+Administrator=naughty-admin@yourserver.com
+; level to which to bowdlerize, P, PG, R, X 
+BowdlerizationLevel=G
+; log into naughty_events table 
+PGLogP=0
+RLogP=1
+XLogP=1
+; prevent this level of stuff from being posted at all 
+PGBounceP=0
+RBounceP=0
+XBounceP=1
+; send email to Administrator
+PGNotifyP=0
+RNotifyP=0
+XNotifyP=1
+CacheTimeout=120
+</pre>
+
+
+
+<h3>Data Model</h3>
+
+<pre><code>
+-- if upgrading from an older version of the ACS
+alter table users_preferences add content_mask integer;
+
+create table content_tags (
+    word               varchar(100) primary key,
+    tag		       integer not null,
+    creation_user      integer not null references users,
+    creation_date      date
+);
+
+-- for cases when users are posting naughty stuff 
+
+create table naughty_events (
+    table_name            varchar(30),
+    the_key               varchar(700),
+    offensive_text        clob,
+    creation_user         integer not null references users,
+    creation_date         date,
+    reviewed_p            char(1) default 'f' check (reviewed_p in ('t','f'))
+);
+
+create table naughty_table_to_url_map (
+    table_name      varchar(30) primary key,
+    url_stub        varchar(200) not null
+);      
+</code></pre>
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/contest.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/contest.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/contest.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,140 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Contests</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Contests</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="mailto:markd@arsdigita.com">Mark Dalrymple</a>
+
+<hr>
+
+<ul>
+<li>User-accessible directory:  <a href="/contest/">/contest/</a>
+<li>Site administrator directory:  <a href="/admin/contest/">/admin/contest/</a>
+
+<li>data model :  <a href="/doc/sql/display-sql.tcl?url=/doc/sql/contest.sql">/doc/sql/contest.sql</a>
+<li>Tcl procs:  /tcl/contest-defs.tcl 
+
+</ul>
+
+<h3>The Big Idea</h3>
+
+People like to get free stuff.  The contest module allows publishers
+to create a doorprize like contest and allows registered users to
+participate in the contest.  Contest can be a simple "visit this 
+page to get entered" or a more complex "please give us some information
+while entering" page.  The publisher can then choose an arbitrary number
+of winners from the pool of contestants.
+
+<h3>Publishing Decisions</h3>
+
+Contests can be simple entry buttons, or they can be forms which
+ask for information.  When you're creating a contest, the admin
+pages provide a customization feature where you can specify
+any extra data to be collected (such as a yes/no question, or
+a text field for free-form commentary).  You can either use
+the automatically generated contest entry page (which looks at
+your customizations and generates the HTML &lt;form&gt; elements)
+or you can create your own page and include some hidden values
+which are used in entry processing.
+
+<h3>Choosing Winners</h3>
+
+When it's time to choose winners, go to the contest management
+page.  You can specify the time range to choose entrants from
+(say from the last month), and the number of unique winners
+to return.  The contest module will grovel through the database
+and return a unique set of results, which you can then do what
+you wish. (send them email, deliver a box of chocolate)
+
+
+<h3>Under the Hood</h3>
+
+There are two primary tables which hold the contest information, and
+a new table is created for each contest to hold any customized
+entry fields.
+
+<p>
+
+<code>contest_domains</code> is the table that holds general information
+about each contest: 
+<blockquote><pre>
+create table contest_domains (
+	domain_id		integer not null primary key,
+	domain			varchar(21) not null unique,
+	-- the unique constraint creates an index for us
+	entrants_table_name	varchar(30),
+	pretty_name		varchar(100) not null,
+	-- where the contest starts
+	home_url	varchar(200),
+	-- arbitrary HTML text that goes at the top of 
+	-- the auto-generated entry form
+	blather		varchar(4000),
+	-- where to send users after they enter
+	-- (if blank, we use a generated form)
+	post_entry_url	varchar(200),
+	maintainer	not null references users(user_id),
+	notify_of_additions_p	char(1) default 'f' check (notify_of_additions_p in ('t', 'f')),  -- send email when a person enters
+	us_only_p		char(1) default 'f' check (us_only_p in ('t', 'f')),
+	start_date		date,	-- these are optional
+	end_date		date
+);
+</pre></blockquote>
+
+In earlier versions of this module, the <code>domain</code> column was
+the primary key.  It has been changed to an integer
+(<code>domain_id</code>) because of performance enhancements to the
+site-wide search.  There is some backwards-compatibility code in the
+contest module that uses the <code>domain</code> column if there is no
+domain_id provided in the form data.
+
+<p>
+
+When a new contest is created, a new row is added to contest_domains,
+and a new table called <code>contest_entrants_$domain</code> (where
+<code>$domain</code> is the value of the domain column).  This new
+<code>entrants</code> table looks like this:
+
+<blockquote><pre>
+create table contest_entrants_whatever (
+	entry_date	date not null,
+	user_id		not null references users
+);
+</pre></blockquote>
+
+We don't really care how many times they enter.  We'll do a "distinct"
+query when choosing the winners.  For contests that allow extra 
+information to be provided by the user, we may want them to be able
+to enter multiple times.
+
+<p>
+
+Now, how is this extra information handled?  When you add a custom
+column to a contest, a row gets added to the table
+<code>contest_extra_columns</code>:
+
+<blockquote><pre>
+create table contest_extra_columns (
+	domain_id		not null references contest_domains,
+	column_pretty_name	varchar(30),
+	column_actual_name	varchar(200) not null,
+	column_type		varchar(200) not null,	-- things like 'boolean' or 'text'
+	column_extra_sql	varchar(200)	-- things like 'not null' or 'default 5'
+);
+</pre></blockquote>
+
+The <code>column_pretty_name</code> is what is displayed to the user,
+while <code>column_actual_name></code> is the name of the column in
+the contest specific <code>contest_entrants_$domain</code> table.
+These new columns get added to the entrants table as the contest
+gets customized. (e.g. at any time)
+
+<hr>
+<a href="mailto:markd@arsdigita.com"><address>markd@arsdigita.com</address></a>
+</body>
+</html>
+
Index: web/openacs/www/doc/crm.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/crm.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/crm.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,118 @@
+<html>
+<head>
+<title>Customer Relationship Management</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Customer Relationship Management</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by Jin Choi
+
+<hr>
+<ul>
+<li>Admin directory: <a href="/admin/crm/">/admin/crm</a> 
+<li>data model:  
+<a href="/doc/sql/display-sql.tcl?url=/doc/sql/crm.sql">/doc/sql/crm.sql</a>
+<li>procedures:   /tcl/crm-defs.tcl
+</ul>
+
+<h3>The Big Picture</h3>
+
+Publishers want to track a relationship with a customer over time by
+classifying them by various metrics such as site activity or buying
+activity. This module provides a way to specify states that a user may
+be in, and a way to specify state transitions based on any metric
+which can be expressed in SQL. This models the progression of a
+relationship better than a static numeric worth value. These states
+can then be used to target actions at particular classes of users.
+
+<p>
+
+An example: an e-commerce site might define the following states:
+<ul>
+<li>raw user: just registered, hasn't really done much yet
+<li>good prospect: has bought one or more thing in the last month
+<li>solid customer: has bought more than 3 things in the last month
+<li>great customer: has bought more than 10 things in the last month
+<li>slipping customer: formerly a solid or great customer, but has fallen
+    under threshold in the past month
+<li>dead user: has not done anything for the last three months
+</ul>
+
+<p>
+
+The transitions might be
+<ul>
+<li>from raw user to good prospect or dead user
+<li>from good prospect to solid customer or dead user
+<li>from solid customer to great customer or slipping customer
+<li>from great customer to slipping customer
+<li>from slipping customer to dead user
+<li>from dead user to good prospect
+</ul>
+
+
+<h3>Under the Hood</h3>
+
+A user's current state and the date it was entered is stored as part of the
+<code>users</code> table:
+
+<blockquote>
+<pre><code>
+crm_state		varchar(50) references crm_states,
+crm_state_entered_date	date, -- when the current state was entered
+</code></pre>
+</blockquote>
+
+<p>
+
+The allowable states are listed in
+<blockquote>
+<pre><code>
+create table crm_states (
+	state_name	varchar(50) not null primary key,
+	description	varchar(1000) not null -- for UI
+);
+</code></pre>
+</blockquote>
+
+<p>
+
+Allowable state transitions are stored in
+<blockquote>
+<pre><code>
+create table crm_state_transitions (
+	state_name	not null references crm_states,
+	next_state	not null references crm_states,
+	triggering_order	integer not null,
+	transition_condition	varchar(500) not null,
+	primary key (state_name, next_state)
+);
+</code></pre>
+</blockquote>
+
+The <code>transition_condition</code> field specifies a SQL fragment
+which will get called as
+
+<blockquote>
+<pre><code>
+update users
+set user_state = **next_state**, crm_state_entered_date = sysdate
+where user_state = **state_name**
+and (**transition_condition**)
+</code></pre>
+</blockquote>
+
+<p>
+
+Periodically (as defined by the parameter
+<code>UpdatePeriodHours</code> in the [ns/server/servername/acs/crm]
+section and defaulting to 24 hours), each
+<code>transition_condition</code> fragment will be run as above, in
+the order specified by <code>triggering_order</code>.
+
+<hr>
+<a href="mailto:jsc@arsdigita.com"><address>jsc@arsdigita.com</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/curriculum.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/curriculum.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/curriculum.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,186 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Curriculum System</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Curriculum System</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+<ul>
+<li>User directory:  <a href="/curriculum/">/curriculum/</a>
+<li>Admin directory:  <a href="/admin/curriculum/element-list.tcl">/admin/curriculum/element-list.tcl</a> 
+<li>data model:  
+<a href="/doc/sql/display-sql.tcl?url=/doc/sql/curriculum.sql">/doc/sql/curriculum.sql</a>
+
+<li>procedures:  /tcl/curriculum.tcl 
+
+</ul>
+
+<h3>The Big Picture</h3>
+
+Surfing the Web can seem like an aimless unproductive activity.  This
+system enables a publisher to establish a curriculum at their site,
+identifying up to a dozen or so important areas of content that they'd
+like a user to visit eventually.
+
+<P>
+
+Suppose that Joe User comes to <a href="http://www.edf.org">www.edf.org</a> hoping to learn something
+about being an environmentalist.  He reads an article or two before
+becoming distracted by another task.  Three months later, Joe User
+returns to www.edf.org to continue his environmentalism education.  He
+can't remember which articles he has read.  The home page has been
+freshened with news so that the links aren't in familiar places.  Joe
+doesn't know what he should read next and, worse, doesn't feel that he
+is progressing toward any goal.
+
+<p>
+
+With this system, Joe can refer to a curriculum bar that is displayed on
+every page grabbed from www.edf.org.  The bar shows a condensed
+description of the articles that Environmental Defense Fund wants
+everyone to read, with little checkboxes by the ones that he has read
+already.  As Joe finishes a section, it is clear from referring to the
+curriculum bar which section to read next.
+
+<h3>Configuration</h3>
+
+<blockquote>
+<pre><code>
+[ns/server/yourserver/acs/curriculum]
+EnabledP=1
+; does ad_footer put this in every dynamic page?
+StickInFooterP=1
+; does ad_serve_html_page put this on every static page?
+StickInStaticPagesP=1
+</code></pre>
+</blockquote>
+
+
+
+<h3>What we need to represent</h3>
+
+We need to store 
+
+<ul>
+<li>the overall objective of the curriculum at this site 
+<li>for each element 
+<ul>
+<li>the URL of the element (can be off the site)
+<li>the position within the curriculum
+<li>a very very short name (one or two words)
+<li>a one-line description for an outline
+<li>a full description of the pedagogical value of this element
+
+</ul>
+
+</ul>
+
+The overall objective is kept in an optional /curriculum/objective.txt
+file.  This contains an HTML fragment that the publisher wants the user
+to see.
+
+<p>
+
+Everything else is in the following table
+
+<blockquote>
+<pre><code>
+create table curriculum (
+	curriculum_element_id	integer primary key,
+	-- 0 is the first element of the course, 8 would be the 9th
+	element_index		integer,
+	url			varchar(200) not null,
+	very_very_short_name	varchar(30) not null,
+	one_line_description	varchar(200) not null,
+	full_description	varchar(4000)
+);
+</code></pre>
+</blockquote>
+
+We record individual user experiences in 
+
+<blockquote>
+<pre><code>
+create table user_curriculum_map (
+	user_id			not null references users,
+	curriculum_element_id	not null references curriculum,
+	completion_date		date default sysdate not null,
+	primary key (user_id, curriculum_element_id)
+);
+</code></pre>
+</blockquote>
+
+You might wonder why we don't use the <code>user_content_map</code>
+table.  We have some good reasons:  (a) the table only records static
+.html page loads, (b) the table is only properly used to record content
+viewed on our server whereas a curriculum may include content from
+foreign sites.
+
+<h3>Registered vs. Non-registered Learners</h3>
+
+The system needs to work for non-registered learners via browser
+cookies.  At the same time, someone who does register ought to be able
+to claim their curriculum progress when logging in from another browser.
+
+
+<h3>Where displayed</h3>
+
+Our canonical location for the curriculum bar is at the bottom of
+the page, just above the HR tag the precedes the signature.  We can get
+this into most .tcl pages by making <code>ad_footer</code> check for the
+publisher's curriculum system settings.  A modification to
+<code>ad_serve_html_page</code> in /tcl/ad-html.tcl suffices to make
+the bar visible on static pages.
+
+<h3>When displayed</h3>
+
+Once a user has completed the curriculum the bar is no longer displayed
+unless the user explicitly clears the curriculum history from the
+/curriculum/ pages.
+
+<h3>Performance</h3>
+
+Anything that can be memoized is, e.g., the elements of the curriculum
+at a site.  Anything that can be pushed into a browser cookie is.  We
+don't want to hit Oracle one extra time for every page load.
+
+
+<h3>Cookies Employed</h3>
+
+For both registered and non-registered users, we keep a browser cookie
+<code>CurriculumProgress</code>.
+
+<P>
+
+This is either a space-separated list of integers (curriculum element
+IDs) or the token "finished".
+
+
+<h3>Filters</h3>
+
+We want to make sure that curriculum progress is recorded even if a user
+does not navigate to sections via the curriculum bar.  So we'll need a
+filter that checks the URL against the curriculum elements and that
+checks the user's CurriculumProgress cookie.  For the curriculum bar to
+be up to date, the filter will have to run before the page is served and
+destructively modify the input header ns_set to make CurriculumProgress
+reflect the current page.
+
+<p>
+
+By default, the filter ought to be run before every .html, .tcl, or .adp
+page served, if the curriculum system is enabled.
+
+
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/custom-sections.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/custom-sections.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/custom-sections.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,80 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Custom Sections</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Custom Sections</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="mailto:tarik@arsdigita.com">Tarik Alatovic </a> and  <a href="mailto:ahmeds@mit.edu/">Sarah Ahmed</a> 
+
+<hr>
+
+<ul>
+<li>Group Administrator directory:  <a href="/groups/admin/$group_name/custom-sections/index.tcl?section_id=$section_id">/groups/admin/$group_name/custom-sections/index.tcl?section_id=$section_id</a>
+<li>data model: <a href="/doc/sql/display-sql.tcl?url=/doc/sql/community-core.sql">/doc/sql/community-core.sql</a>
+<li>procedures:  in tcl/user-groups-defs.tcl
+
+</ul>
+
+<h3>The Big Picture</h3>
+
+This module allows the group administrator to create and manage different custom sections of the site. Custom sections serve like url directories. so if group administrator of group travel at photo.net defines custom section sweden (e.g. photo.net/travel/sweden), he will be able to upload files for this section (see content_files table) in order to display the file photo.net/groups/travel/sweeden/stockholm.html. 
+
+<p>
+
+At this stage, we only support creation and administration of custom sections at the group level. Later, we will augment the system to support site wide administration of custom sections.
+
+<h3>The Medium-Sized Picture</h3>
+
+The system consists of one table. The content_files table holds information about different files that belong to a custom section. The files can be of type text/binary. Note that each content file references a custom section stored in the content_sections table. The documentation on content sections can be found in <a href="/doc/content-sections.html">/doc/content-sections.html</a>
+
+<blockquote>
+<pre>
+
+create table content_files (
+	content_file_id 	integer primary key,
+	section_id 		references content_sections,
+	-- this will be part of url; should be a-zA-Z and underscore
+	file_name		varchar(30) not null,
+        -- this is a MIME type (e.g., text/html, image/jpeg)	
+        file_type               varchar(100) not null,
+        file_extension          varchar(50),    -- e.g., "jpg"
+	-- if file is text or html we need page_pretty_name, body and html_p
+	page_pretty_name        varchar(200),
+	body			clob,
+	html_p			char(1) default 'f' check(html_p in ('t','f')),
+	-- if the file is attachment we need use binary_data blob( e.g. photo, image)
+	binary_data             blob
+);
+
+</pre>
+</blockquote>
+
+<P>
+
+<h3>Legal Transactions</h3>
+From the group administration pages at <a href="/groups/admin/$group_name/custom-sections/index.tcl?section_id=$section_id">/groups/admin/$group_name/custom-sections/index.tcl?section_id=$section_id</a>, the group administrator can
+
+<p> 
+<ul>
+<li>View/Edit the index page of the custom section. It should be noted that a default index page is provided by the system. The administrator has the option of augmenting the page.
+<li>Add/View/Edit/Delete section pages that belongs to the custom section.
+<li>Upload/View/Delete images for the section that can be referenced from any page that belongs to the custom section.
+</ul>
+<P>
+
+<hr>
+
+<a href=mailto:tarik@arsdigita.com><address>tarik@arsdigita.com</address></a>
+</body>
+</html>
+
+
+
+
+
+
+
Index: web/openacs/www/doc/custom.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/custom.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/custom.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,56 @@
+<html>
+<head>
+<!--AD_DND-->
+<title>Custom Software added to this installation</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Custom Software</h2>
+
+added to this installation of the ArsDigita Community System
+
+<hr>
+
+Major new systems, especially those that are highly specific to a site
+and that will never be part of the ArsDigita Community System, should be
+documented here.  Particular attention should be paid to describing the
+hooks into and out of the core ACS software.  This will make it easier
+to upgrade the site to a newer version of the ACS software. For detailed
+guide on how to write an ACS module, take a look at 
+<a href=writing-a-module.html>writing-a-module.html</a>.
+
+<p>
+
+Here's how you add a standalone module to the ACS:
+
+<ul>
+<li>put the SQL data model in /doc/sql/module-name.sql
+<li>put an HTML file explaining how to configure and use the module in
+/doc/module-name.html
+<li>put the user scripts in /module-name/
+<li>put the module administrator scripts in /module-name/admin/
+<li>put the site-wide administrator scripts in /admin/module-name/
+
+<li>put commonly called procedures in the private tcl directory
+(/web/yourdomain/tcl) as module-name-defs.tcl
+
+<li>if your module results in content being posted to the site,
+write a procedure to interface to the <a href="new-stuff.html">new
+stuff</a> system and put it in your defs.tcl file, along with some
+in-line code to add it to the ns_share'd variable 
+<code>ad_new_stuff_module_list</code>
+
+<li>write a procedure to interface to the
+/tcl/ad-user-contributions-summary.tcl system (similar to the new stuff
+system but for stuff you want to show up on the
+/shared/community-member.tcl 
+and /admin/users/one.tcl pages)
+
+
+<li>add a note in this file saying that you've done these things 
+</ul>
+
+
+
+</body>
+</html>
Index: web/openacs/www/doc/data-pipeline.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/data-pipeline.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/data-pipeline.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,245 @@
+<html>
+<head>
+  <title>Data Pipeline</title> 
+</head>
+<body bgcolor=white>
+<h2>Data Pipeline</h2>
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="mailto:oumi@arsdigita.com">Oumung Mehrotra</a>,
+<a href="mailto:mbryzek@arsdigita.com">Michael Bryzek</a>
+
+<hr>
+
+<ul>
+<li>User-accessible directory:  None
+<li>Site administrator directory:  None
+<li>Data model:  None
+<li>Tcl procs:  /tcl/data-pipeline.tcl
+</ul>
+
+<h3>The Big Picture</h3>
+When processing forms with a lot of fields, it is a real pain to write the 
+insert and update sql statements, and to enforce basic validation. It would 
+be nice to have a layer of 
+abstraction that allowed you to not worry about the sql statements and, 
+instead, focus on building the large html form.
+<p>
+It turns out this idea is often good even for small forms. An abstraction
+of the sql statement means changes only need to be made in 1 place - the 
+html form, and not in the add and edit pages.
+
+<h3>The Medium-Sized Picture</h3>
+We want to focus almost all of our effort on creating the html form.
+Data Pipeline is based on the proper naming of html form elements. The 
+structure is:
+<br><dd><code> 
+dp.&lt;table name&gt;.&lt;column name&gt;.&lt;data type&gt;
+</code><br>
+The dp at the start of the field name is used by data_pipeline to identify
+the elements for data pipeline to insert into some table. Data type 
+is an optional argument that defaults to text. 
+<p>
+To process a form, you simply call <code>dp_process</code>. This procedure
+reads all the variables that begin with "dp" from [ns_getform], and generates
+an insert or update statement as appropriate.
+<p>
+Arguments to dp_process (using ad_proc):
+<ul>
+  <li> -db: Specify a database handle. If no database handle is missing, data
+       pipeline gets one from the subquery pool.
+  <p><li> -db_op: Specify the database operation. The default operation is
+       "update_or_insert" which first tries to update the row in question,
+        and if it fails, tries to insert the row. Other valid values for this
+	argument are "update" to only update the row, or "insert" to only
+	insert the row. 
+  <p><li> -where_clause: specify the where_clause to use when updating. This 
+       argument is optional only when db_op is insert. 
+  <p><li> -form_index: If you need to serialize updates to multiple tables (for 
+       example, insert a user before inserting a row into user_group_map), you 
+       can use form_index which specifies an identifier to use with dp in the 
+       html form element name. This will be clear in the example that follows.
+</ul>
+
+<b>Supported data types:</b><br>
+The following data types are currently supported. 
+To be supported means that there is some mechanism to validate input. When 
+validation fails, data-pipeline returns with an ad_return_complaint 
+describing the errors. Note that there is currently no way to specify "not null."
+<ul>
+  <li> int: Returns an error if the specified value has non-digits in it.
+
+  <li> money: Like int, except money allows for commas. 
+
+  <li> year: Value must be exactly 4 digits
+
+  <li> date: Uses ns_buildsqldate to validate the date. Value must be in YYYY-MM-DD format.
+
+  <li> expr: An expression is a string that does not have spaces and that 
+can be inserted into the database without single quotes. A common case is
+inserting sysdate where sysdate is much different from 'sysdate'.
+
+  <li> clob: Data pipeline gracefully handles clobs so you never have to worry
+about the format of the update/insert statement. 
+
+  <li> phone: Returns an error if phone number has fewer than 10 characters. 
+This is obviously very limited but works well for the US.
+
+  <li> email: Returns an error if ![philg_email_valid_p $value]
+</ul>
+
+
+<h3>Example - a signup form</h3>
+
+This example is a bit contrived, but let's say your users fill out the form below. Your data model is:
+<pre>
+create table inquiry_contact (
+       contact_id             integer primary key,
+       name		      varchar(100),
+       phone		      varchar(100),
+       email  	              varchar(200)
+);
+
+create table inquiries (
+       inquiry_id             integer primary key,
+       contact_id             not null references inquiry_contact,
+       comments		      clob
+);
+</pre>
+
+
+
+<table>
+<tr>
+  <th>Appearance</th>
+  <th>HTML</th>
+</tr>
+<tr>
+  <td><hr size=1></td>
+  <td><hr size=1></td>
+</tr>
+<tr><td valign=top>
+
+<form method=post>
+<input type=hidden name=dp.inquiries.inquiry_id.int value=1003>
+<input type=hidden name=dp_c.inquiry_contact.contact_id.int value=123>
+<p>1 Your name:
+<br><dd><input type=text name=dp_c.inquiry_contact.name size=45>
+
+<p>2 Your email address:
+<br><dd><input type=text name=dp_c.inquiry_contact.email.email size=45>
+
+<p>3 Your phone number:
+<br><dd><input type=text name=dp_c.inquiry_contact.phone.phone size=45>
+
+<p>4 Do you have any comments for us?
+<br><dd><textarea name=dp.inquiries.comments.clob cols=45 rows=5 wrap=soft></textarea>
+
+<p><dd><input type=submit></form>
+
+</td><td valign=top><pre>
+
+&lt;form method=post action=signup-2.tcl&gt;
+&lt;input type=hidden name=dp.inquiries.inquiry_id.int value=1003&gt;
+&lt;input type=hidden name=dp_c.inquiry_contact.contact_id.int value=123&gt;
+&lt;p&gt;1 Your name:
+&lt;br&gt;&lt;dd&gt;&lt;input type=text name=dp_c.inquiry_contact.name size=45&gt;
+
+&lt;p&gt;2 Your email address:
+&lt;br&gt;&lt;dd&gt;&lt;input type=text name=dp_c.inquiry_contact.email.email size=45&gt;
+
+&lt;p&gt;3 Your phone number:
+&lt;br&gt;&lt;dd&gt;&lt;input type=text name=dp_c.inquiry_contact.phone.phone size=45&gt;
+
+&lt;p&gt;4 Do you have any comments for us?
+&lt;br&gt;&lt;dd&gt;&lt;textarea name=dp.inquiries.comments.clob cols=45 rows=5 wrap=soft&gt;&lt;/textarea&gt;
+
+&lt;p&gt;&lt;dd&gt;&lt;input type=submit&gt;&lt;/form&gt;
+
+</pre></td></tr>
+</table>
+
+<p>
+Now you want to process the data. Let's say you just want to make sure name is not empty. Here's the tcl script to
+do your error checking and to process the form:
+
+<p>
+<blockquote>
+<pre>
+set_form_variables 0
+# dp variables: contact_id, inquiry_id, name, email, phone, comments
+
+set exception_count 0
+set exception_text ""
+
+if { ![exists_and_not_null dp_c.inquiry_contact.name] } {
+    append exception_text "  &lt;li&gt; Please enter your name"
+    incr exception_count
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+set form_setid [ns_getform]
+
+# Need to create the relation
+ns_set put $form_setid dp.inquiries.contact_id ${dp_c.inquiry_contact.contact_id.int}
+
+set db [ns_db gethandle]
+
+ns_db dml $db "begin transaction"
+
+# update or insert the record in inquiry_contact 
+dp_process -db $db -form_index "_c" -where_clause "contact_id=${dp_c.inquiry_contact.contact_id.int}"
+
+# update or insert the record in inquiries
+dp_process -db $db -where_clause "inquiry_id=${dp.inquiries.inquiry_id.int}"
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect /
+</pre></blockquote>
+
+<p>The sql trace generated would look like:
+
+<pre><blockquote>
+    select count(1) from inquiry_contact where contact_id=123
+    update inquiry_contact set
+        contact_id=123,
+        name='Mike',
+        email='mbryzek@arsdigita.com',
+        phone='555-555-5555'
+    where contact_id=123 
+    insert into inquiry_contact (
+        contact_id,name,email,phone 
+    ) values (
+        123,'Mike','mbryzek@arsdigita.com','555-555-5555' 
+    ) 
+    
+    select count(1) from inquiries where inquiry_id=1003
+    update inquiries set
+        inquiry_id=1003,
+        comments='Nothing to say',
+        contact_id='123'
+    where inquiry_id=1003 
+    insert into inquiries (
+        inquiry_id,comments,contact_id 
+    ) values (
+        1003,'Nothing to say','123' 
+    ) 
+</pre></blockquote>
+<p>
+<b>Things to note:</b> we only use ns_ora clob_dml if the clob you're inserting is indeed longer 
+than 4000 characters. Note that the "select count(1) ...." seems redundant when we could use 
+ns_ora resultrows. Unfortunately, resultrows won't work after [ns_ora clob_dml ...].
+
+
+<h3>Future Enhancements</h3>
+We need to add more datatypes. Namely, better date handling is important and it would be nice
+to incorporate validate_ad_dateentrywidget and the new validate_ procs in the utilities file.
+Also, we'd like to expand the error checking to allow for a way to specify not null.
+
+<hr size=1>
+<i>written by <a href=mailto:mbryzek@arsdigita.com>mbryzek@arsdigita.com</a> in March 2000</i>
+</body></html>
Index: web/openacs/www/doc/developers.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/developers.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/developers.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,731 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Developers Guide</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Developers Guide</h2>
+
+to the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+This document contains general guidelines for building new ACS pages.
+It should used in conjunction with <a href="procs.tcl">the procedure-by-procedure documentation</a>.
+
+
+<h3>Writing a Whole Module</h3>
+
+If you're writing a new module, see the short instructions in <a href="custom.html">/doc/custom.html</a>,
+and a detailed guide in <a href="/doc/writing-a-module.html">/doc/writing-a-module.html</a>.
+
+<h3>Documentation</h3>
+
+Every procedure that you expect to be called externally (i.e., by Tcl
+code that doesn't reside in the same file) should be documented with a
+doc string.  Instead of using <code>proc</code>, you should use
+<code>proc_doc</code>.  This results in <a href="procs.tcl">the
+procedure-by-procedure documentation</a>.  If you're a new programmer,
+you might want to read the <a href="common-errors.html">common errors
+list</a>.
+
+<p>
+
+You call <code>proc_doc</code> with a string in between the args and the body:
+
+<blockquote>
+<pre>
+proc_doc plus2 {x} "returns the result of adding 2 to its argument" {
+    return [expr $x + 2]
+}
+</pre>
+</blockquote>
+
+<h3>Magic Numbers in the Code (Parameters)</h3>
+
+Don't put magic numbers in your code with site-specific stuff, e.g.,
+whether a particular feature is enabled or disabled.  Add a parameter or
+a section, if necessary, to your ad.ini file in the /parameters
+directory.
+
+Instead of 
+
+<blockquote>
+<pre><code>
+proc bboard_users_can_add_topics_p {} {
+    return 0
+}
+</code></pre>
+</blockquote>
+
+do 
+
+<blockquote>
+<pre><code>
+[ns/server/photonet/acs/bboard]
+; can a user start a new bboard
+UserCanAddTopicsP=0
+...
+
+proc bboard_users_can_add_topics_p {} {
+    return [ad_parameter UserCanAddTopicsP bboard]
+}
+</code></pre>
+</blockquote>
+
+<h3>Naming</h3>
+
+If it is a parameter, put it in
+/web/yourdomain/parameters/yourdomain.ini and capitalize words, e.g.,
+"SystemName" (for consistency with AOLserver .ini file).
+
+<p>
+
+If your define a Tcl procedure that is site-specific, name it with a
+prefix that is site-specific.  E.g., the EDF scorecard.org site uses
+"score_".  A site to sell khakis uses "k_".
+
+<p>
+
+If it is a community procedure, name it ad_ and put in somewhere in the
+/tcl directory.
+
+<p>
+
+If it is a utility procedure, name it util_ and put it in the
+/home/nsadmin/modules/tcl/utilities.tcl file.
+
+
+<h3>Naming (files)</h3>
+
+In general, we like to name sequences of forms in the following way:
+
+<ul>
+<li>foo.tcl (or foo.adp) -- presents a form to the user
+<li>foo-2.tcl (or foo-2.adp) -- presents a confirmation page to the user 
+<li>foo-3.tcl (or foo-3.adp) -- actually does the database transaction,
+may redirect rather than present anything to the user
+</ul>
+
+As far as the "foo" goes (the actual name of the file), we like to use
+object-verb.  So you might have "user-update.tcl" for a form that
+updates a record in the <code>users</code> table.  Try not to be
+redundant with the directory name.  So if you have a bunch of scripts in
+a directory called "users", the script to look at one user would just be
+"one.tcl" rather than "user.tcl".
+
+<h3>Naming (columns)</h3>
+
+The following column names are ArsDigita Community System standards.
+<ul>
+<li> creation_date  - date row was created
+<li> creation_user - user_id of the creator
+<li> creation_ip_address - ip address of the creator
+<li> last_modified - date row was last modified
+<li> last_modifying_user - user_id of the user last modifying the row
+<li> modified_ip_address - ip address of the last modifying user
+<li> html_p (t,f) -  is the text in html?
+<li> approved_p (t,f) - is this row approved?
+</ul>
+
+<h3>Style Guide</h3>
+
+Dynamically generated pages should always be signed with an email
+address.  This should be the correct address for a user complaining that
+a page does not contain the correct content.  Thus in general the
+correct footer for a user page will be either <code>ad_footer</code> or
+<code>gc_footer</code> or <code>calendar_footer</code>, etc.  Admin
+pages should end with <code>ad_admin_footer</code>.  Then if the
+webmaster encounters a bug or a page that doesn't do what is needed, he
+or she can complain to a programmer.
+
+<p>
+
+If we're building a system where we can't get any better theories from
+the publisher, we design pages to have the following structure:
+
+<ul>
+<li>title
+
+<li>context bar (Yahoo-style navigation)
+
+<li>HR
+
+<li>out-of-flow options such as help or admin (aligned off to the right,
+just underneath the HR)
+
+<li>the meat of the page
+
+<li>navigation and "more info" options
+
+<li>HR
+
+<li>email address signature 
+
+</ul>
+
+What about smaller style issues?  Here are some general principles we've
+developed so far at ArsDigita:
+
+<ol>
+
+<li>don't smash stuff against the left margin of the page (hard to read,
+esp. on screens crowded with windows); use BLOCKQUOTE or UL/LI tags to
+put a white border between the left edge of the browser and the content
+on the page.  Note that this also applies to tables of info.  BLOCKQUOTE
+then TABLE.
+
+<li>try to have no more than one form button per page and certainly no
+more than one per form.  Some sub-issues:
+
+<ul>
+
+<li>you will never have a RESET or CANCEL button.  A user who mis-mouses
+should not lose typed-in data.  If they change their mind, let them back
+up, navigate away via the context bar, or reload.
+
+<li>a SUBMIT button should never be called "submit".  It should say
+something like "Create Account" or "Proceed" (if a multi-form pipeline)
+or "Search"
+
+<li>the submit button should be centered within the page, underneath the
+table of form inputs
+
+</ul>
+
+<li>speaking of forms, if you have hidden or pass-through variables,
+put them right up at the top of the form immediately underneath the FORM
+tag.
+
+</ol>
+
+<h3>Using the Database Intelligently</h3>
+
+Virtually every page on every site that ArsDigita has ever built (1) is
+generated by a computer program, (2) has access to the relational
+database that sits behind the site.  Take advantage of these facts.
+
+<p>
+
+How?  Follow two principles:
+
+<ol>
+
+<li>Show users as much information as quickly as possible; don't make
+them click down
+
+<li>Don't offer users dead links.
+
+</ol>
+
+These sound obvious but most programmers' instincts are to produce .tcl
+pages that behave like static .html files.  For example, in a bond
+trading site the top-level page might offer links to "portfolio,
+trading, and open orders".  This could have been done with a .html file!
+Instead, why not query Oracle to find out the total value of the
+portfolio (show users as much info as possible)?  Or query Oracle to
+find out if there <em>are</em> any open orders; if there are just a few,
+display them in-line, otherwise don't have a hyperlink anchored with
+"open orders" (show as much info as possible; don't offer dead links).
+
+<p>
+
+In a photography classifieds page, don't show categories that haven't
+any current ads (no dead links) and count up the ads in each category
+for display next to the link (as much info as possible).  Isn't this
+GROUP BY that sequentially scans the classifieds table kind of expensive
+for a top-level page on a non-commercial site?  Sure.  But the solution
+is to use <code>Memoize_for_Awhile</code> to cache results in virtual
+memory.
+
+<p>
+
+Computer time is cheap; user time is precious.  Work the server hard on
+behalf of each and every user.  Support the user with personalization.
+Find out what is going to be down a hyperlink before offering it to the
+user.  Buy extra processors as the community grows.
+
+
+<h3>Give the User Dimensional Controls</h3>
+
+See the /ticket module for how a large body of data may be rendered
+manageable by giving the user several dimensions along which to select.
+
+<h3>Pages that accept user input</h3>
+
+Pages that accept user input should first call ad_read_only_p to make
+sure that the Oracle database isn't being maintained in such a way that
+updates would be lost.  Right at the top of a file that offers the user
+a form or stuff something into the db, put 
+
+<blockquote>
+<pre>
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+</pre>
+</blockquote>
+
+<p>
+
+Systems should be designed so that a user clicking submit twice will not
+result in a duplicate database entry.  The fix is that we generate the
+unique primary key in the form or the approval page (better since it will
+still work if the user reuses the form).  See the ecommerce chapter of
+<a href="http://photo.net/wtr/thebook/">my book</a> for a discussion of
+how this works.  See the news subsystem for a simple implementation
+example.
+
+<p>
+
+Systems should be designed so that they do something sensible with plain
+text and HTML.  Add an "html_p" column to any table that accepts user
+input.  Store the user input in unadulterated form in the database.
+Convert it to HTML on the fly if necessary when displaying (this
+consists of guessing where to stick in &lt;P&gt; tags and quoting
+greater-than or less-than signs).  See the
+news subsystem for an example.
+
+<h3>Pages that are broken</h3>
+
+It is nice to email the host admin if things are wrong, but don't do it
+directly with ns_sendmail; use ad_notify_host_administrator (defined in
+/tcl/ad-monitor.tcl ).  This way, the host admin won't get email more
+than once every 15 minutes.
+
+<h3>Adding an item when some are present</h3>
+
+Suppose that you have a page that has to (1) show a list of some items,
+(2) offer the user the option of adding a new item of the same type as
+the items being displayed.
+
+<P>
+
+Our convention in the ACS is to present the existing items in a list
+(UL).  Then we have a blank line (P tag).  Then we have a new list item
+(LI) with a hyperlinked phrase like "add new item".  
+
+
+<h3>Content that can accept comments</h3>
+
+In general, the purpose of Web content is to attract comments (see
+Chapter 1 of <a href="http://photo.net/wtr/thebook/">my
+book</a> if you aren't convinced).  That means whenever you're
+developing a new application within ACS you should give users the
+ability to contribute comments.  This is already a system feature for
+static pages and the discussion forum.  For miscellaneous areas, such as
+news and calendar, use this table from general_comments.sql:
+
+<blockquote>
+<pre>
+create table general_comments (
+	comment_id		integer primary key,
+	on_what_id		integer not null,
+	on_which_table		varchar(50),
+	user_id			not null references users,
+	comment_date		date,
+	ip_address		varchar(50) not null,
+	modified_date		date,
+	content			clob,
+	approved_p		char(1) default 't' check(approved_p in ('t','f'))
+);
+</pre>
+</blockquote>
+
+Note that it points to other tables via the on_what_id and
+on_which_table columns.
+
+<h3>Email Alerts</h3>
+
+To avoid sending undesired email, use  the  <code>users_alertable</code>  view instead of the <code>users</code> table as a selection pool for generating alerts:
+
+<blockquote>
+<pre>
+create or replace view users_alertable
+as
+select * 
+ from users 
+ where (on_vacation_until is null or 
+        on_vacation_until < sysdate)
+ and (deleted_p is null or deleted_p = 'f')
+ and (email_bouncing_p is null or email_bouncing_p = 'f');
+</pre>
+</blockquote>
+
+
+<h3>Distributing Maintenance</h3>
+
+When distributing maintenance responsibility, use the <a
+href="permissions.html">permissions package</a>.  See the /gc/ module
+for an example of how this package may be used.
+
+<h3>Auditing</h3>
+
+Often a table will need to be audited, particularly if your client
+has hired a number data entry people who are prone to make
+mistakes.  Auditing a table allows you
+to see who made changes, when the changes were made, what
+changed, and the history of all states the data have been in (so
+the data are never lost).
+
+<p>
+
+Auditing a table consists of:
+
+<p>
+
+<ul>
+<li>Adding a few columns to the table to record the time of update
+and the identity of the person making the update.
+<li>Creating a separate audit table that contains all old versions
+of the data in the table.
+<li>Creating a trigger which automatically stuffs a row into the
+audit table whenever the original table is modified.
+</ul>
+
+<p>
+
+The ACS has a number of auditing conventions which you should follow,
+as well as some utility procedures which can be used to display the history
+of all states a table (or set of tables) has been in.  This is documented
+in the <a href="audit.html">Audit Trail Package</a>.
+
+<p>
+
+<h3>Adding Graphics</h3>
+
+If you want to add graphics to your site without performing major
+surgery, the easiest thing to do is add <em>illustrations</em>.  That
+is, put in pictures and drawings to give users a feeling of place.
+Avoid making graphics and buttons part of the user interface.  It will
+make the site hard to use for people on slow links.  It will make it
+harder to maintain the code.  It will make it harder to offer a
+text-only version of the site.
+
+<p>
+
+The two places on photo.net where there are decorations like this are 
+up in the headline (turning it into an HTML table) and also alongside
+lists of stuff.  Procedures that support this are the following:
+
+<ul>
+<li><code><a href="proc-one.tcl?proc_name=ad_decorate_side">ad_decorate_side</a></code> (in /tcl/ad-sidegraphics.tcl) 
+<li><code><a href="proc-one.tcl?proc_name=ad_decorate_top">ad_decorate_top</a></code> (in /tcl/ad-defs.tcl)
+</ul>
+
+See <a
+href="http://photo.net/bboard/">http://photo.net/bboard/</a> for a
+demonstration of both in use.
+
+<h3>Categorization</h3>
+
+Suppose that you want to let each user manage a collection of items on
+the server.  For example, at jobdirect.com, an employer searches among
+tens of thousands of student resumes and can pick out especially
+promising students to save for later scrutiny.  You know that at least
+some users will pick hundreds of students via this mechanism and will
+need some way to organize them.  However, new employer-users won't have
+any students on their "favorites" list and it is unnecessary to expose
+them to categorization machinery as they pick their first favorite
+student.  Suppose that your categorization solution for power users is
+one layer of folders.  When Joe Employer picks his first favorite
+student, should he really be hammered with a message: "You haven't set
+up any folders for favorite students yet.  Please set up a folder first
+and then you can pick favorite students."
+
+<p>
+
+Remember Alan Cooper's adage that "No matter how cool your user
+interface, it would be better if there were less of it."
+
+<p>
+
+We applied this principle on jobdirect.com by suppressing the
+categorization machinery until the employer-user had picked at least 8
+students.  Categorization then appeared as an option when the user was
+viewing his or her list of favorite students (presumably this is the
+only time when the user might have been thinking "hey, this list is
+getting long").  Once the user had elected to switch over to the more
+complex categorization interface, future picks of favorite students
+would result in messages like "Oh, into which folder would you like us
+to put this resume?"
+
+<p>
+
+For the advanced user, given that you're going to have categorization
+you might ask how much is needed.  Users are familiar with the
+hierarchical directory structures in the Windows and Macintosh file
+systems.  Or are they?  Hierarchical file systems were lifted from the
+operating systems of the 1960s and pushed directly into consumer's laps
+without anyone asking the question "Are desktop users in fact able to
+make effective use of this interface directly?"  The programmers who
+built file systems needed an O(log n) retrieval method for files.  A
+tree data structure yields O(log n) retrieval, so a file system has an
+underlying hierarchical structure.  The programmers were too lazy to
+develop any kind of categorization or database scheme on top of the
+hierarchical tree so they just exposed the tree structure directly to
+users.  So let's not invest too much authority in tree-structured file
+systems.
+
+<p>
+
+Even if they have painfully learned to manage a hierarchy of files on
+their desktop, do users want to manage another hierarchy on each Web
+service that they use?
+
+<p>
+
+Do we need elaborate hierarchies?  Consider the user who has 1000 items
+to manage but is very likely to want to work on the 20 selected or
+uploaded in the last month.  Does this user need to wade through 1000
+listings to find the 20 most recent?  No, not if we provide a "sort by
+most recent" option.  Then the user can simply look at the top of the
+page and not scroll down too much.
+
+<p>
+
+Can we survive with only one level of hierarchy?  I think so.
+Especially if 
+
+<ul>
+
+<li>you provide ways to sort by creation or modification date within a
+category
+
+<li>you provide multiple hierarchies (e.g., by project, by subject)
+
+</ul>
+
+
+<h3>Searching -- is scoring better than a naive SQL query?</h3>
+
+Suppose that you're faced with the task of letting the user search
+through some data.  One way to go about this is to give the user the
+ability to type SQL queries.  
+
+<p>
+
+User typing SQL queries?!?!?  Am I insane?  How could a random Web
+surfer be expected to master the profundities of SQL syntax?  
+
+<p>
+
+Thus the average Web developer will typically build an HTML form to
+shield the user from the complexity of SQL <em>while retaining all the
+power of SQL</em>.  This form will have one input for every column in
+the table, perhaps with some ability for a user to specify operators
+(e.g., "less than", "equal to", "starting with").  The form will have a
+select box or radio button set where the user can decide whether he
+wants to AND or OR the criteria.
+
+<p>
+
+This approach shields the user from the trivial <em>syntactic</em>
+complexity of SQL but directly exposes the far more brain-numbing
+<em>semantic</em> complexities of SQL in general and the publisher's
+data model in particular.
+
+<P>
+
+<blockquote>
+
+<b>Bottom Line Principle 1</b>: the first search form that your user sees
+ought to be a single text entry box, just like AltaVista's.  The results
+page can explain how the results were obtained and perhaps offer a link
+to an advanced search form at the bottom (on the presumption that the
+user has scanned all the results and found them inadequate).
+
+</blockquote>
+
+<p>
+
+Let's now consider the case of the user who fills out a multi-input
+search form or types a long phrase into a text search box.  I.e., the
+user has given the server lots of information about his or her
+interests.  What is this user's reward?  Generally fewer results than
+would be delivered to a user who only provided one query word or filled
+in one field in the moby search form.  Compare this to AltaVista, Lycos,
+and other full-text search systems that people use every day.  The more
+words a user gives a public search engine, the more results are returned
+(though oftentimes only the first 20 or 30 are displayed).
+
+<blockquote>
+
+<b>Bottom Line Principle 2</b>: the more information a user gives to
+your server the more results your server should offer to the user.
+
+</blockquote>
+
+<p>
+
+This principle seems dangerous in practice.  What if the user types so
+many words that essentially every item in the database is a match?
+Wouldn't it be better to offer an advanced search form that lets the
+user limit results explicitly.
+
+<p>
+
+Very seldom.  Users are terrible at formulating boolean queries.  Most
+often, they'll come up with a query that matches every row in your
+database or a query that matches none.  You really shouldn't engineer
+software so that it is possible for the server to return a page saying
+"Your query returned zero results."
+
+<p>
+
+What's the way out?  Suppose that you could score every row in the
+database again the user's criteria.  It would then be perfectly
+acceptable to return every row in the database, ranked by descending
+score.  The user need only look at the top of the page and may ignore
+the less relevant results.
+
+<p>
+
+Is this a radical idea?  Hardly.  All the public search engines use it.
+They may return tens of thousands of results if a user supplies a long
+query string but the most relevant ones are printed first.
+
+
+<blockquote>
+
+<b>Bottom Line Principle 3</b>: Scoring and ranking and returning the
+top scoring items is a much better user interface than forcing the user
+into a simplistic binary in/out.
+
+</blockquote>
+
+Suppose that your users are giving you criteria that are more structured
+than free text.  What's a good user interface?  On the search form, ask
+for preferences but provide checkboxes to "absolutely exclude items that
+don't meet this criterium".  On the results page, print items as
+follows:
+
+<blockquote>
+
+<table>
+<tr>
+<td bgcolor=#EEEEEE>
+<font size=-1 face="verdana, arial, helvetica">
+<ul>
+
+<h4>Items that meet all your criteria</h4>
+<li>98: foobar
+<li>92: yow
+<br>
+<br>
+... 
+
+<h4>Items that meet some of your criteria</h4>
+
+<li>83: blatzco
+<li>83: bard 
+<li>82: cookie monster
+<br>
+<br>
+... 
+
+</ul>
+</font>
+</td>
+</tr>
+</table>
+</blockquote>
+
+
+<h3>Warning signs that you don't know SQL</h3>
+
+Most Web programmers suffer from the delusion that they know SQL and
+understand Oracle.  This delusion stems from the euphoria of getting a
+Web page to work.  In reality, most Web programmers are very weak SQL
+developers and the only things that save them are the incredible speed
+of modern computers and the relative paucity of traffic on most Web
+sites.
+
+<p>
+
+Here are some warning signs that you need to get help from a real SQL
+programmer:
+
+<ul>
+<li>you've built a page that uses <code>lock table</code>
+
+<li>you query Oracle for N things and then use Tcl code to filter out
+some that don't fit your criteria for display.  I.e., you don't use all
+of the data that you query from Oracle.  SQL is a very powerful query
+language and, supplemented on occasion with PL/SQL or Java inside the
+database, it is always possible to do your filtering inside Oracle
+rather than dragging data across SQL*Net to filter in Tcl.
+
+<li>you've built a page that queries Oracle for a list of stuff and
+then, for each thing in the list, goes back to Oracle with another
+query.  So if you had 1000 things on the list, you'd go to Oracle a
+total of 1001 times for this page.  This kind of page can almost always
+be slimmed down to 1 single query with an outer JOIN and GROUP BY.  You
+might need to JOIN against an on-the-fly view.  In the worst case you
+might need a PL/SQL procedure.
+
+<li>you've gone into SQL*Plus and <code>set timing on</code> and
+<code>set autotrace trace</code> and find that some of your queries are
+taking more than a fraction of a second and/or requiring full table
+scans.  Online systems should try to get everything done within 1/10th
+of a second.  Remember that if your page takes 1/10th of a second you
+can only serve 10 pages/second per processor.
+
+</ul>
+
+<h3>Sharing data among threads</h3>
+
+The AOLserver <code>ns_share</code> construct is very slow in the Tcl
+8.2 version of AOLserver.  We recommend the use of the much more
+powerful <cod>nsv</code> facility, documented in
+<a href="README-NSV.txt">README-NSV.txt</a>.
+
+<h3>Filters</h3>
+
+Use of <tt>ns_register_filter</tt> is deprecated as of ACS 3.2 - it's been
+replaced with <tt><a href="/doc/proc-one.tcl?proc_name=ad%5fregister%5ffilter">ad_register_filter</a></tt>, a drop-in replacement which supports
+some extra flags. <tt>ad_register_filter</tt>
+provides the following functionality:
+
+<ul>
+  <li><b>Priorities</b> - filters are executed in order of priority (lowest number to highest).
+For instance, the security filter (which must be run before anything else) has a priority of
+1, compared to the default of 10000.
+  <li><b>Monitoring</b> - using <a href="/admin/monitoring/filters.tcl">/admin/monitoring/filters.tcl</a>
+you can see which filters will run for any given request.
+  <li><b>Debugging</b> - invocations of the filter can be logged.
+  <li><b>Error recovery</b> - if a non-critical filter throws an error, subsequent filters will
+still be run (AOLserver's default behavior is to terminate the connection if any filter fails).
+</ul>
+
+<p>To provide this extra flexibility, ACS actually registers a single "&uuml;ber-filter"
+with AOLserver and handles
+filtering itself (in <tt>ad_handle_filter</tt>).
+
+<p>You can use Perl to change all your legacy code to use <tt>ad_register_filter</tt>:
+
+<blockquote><pre>perl -pi -e 's/ns_register_filter/ad_register_filter/g' <i>files-to-process...</i></pre></blockquote>
+
+<h3>Scheduled Processes</h3>
+
+<tt>ns_schedule_proc</tt> is also deprecated as of ACS 3.2 - use 
+<tt><a href="/doc/proc-one.tcl?proc_name=ad%5fschedule%5fproc">ad_schedule_proc</a></tt> instead. <tt>ad_schedule_proc</tt> is <i>almost</i> a drop-in replacement (the
+syntax for flags is slightly different, as the <tt>-thread</tt> and <tt>-once</tt> switches
+require argumens -
+see the <a href="/doc/proc-one.tcl?proc_name=ad%5fschedule%5fproc">documentation</a>. Using <tt>ad_schedule_proc</tt> lets you track which scheduled procedures are
+about to be run and when (view <a href="/admin/monitoring/scheduled-procs.tcl">/admin/monitoring/schedule-procs.tcl</a>).
+
+<p>You can use Perl to change all your legacy code to use <tt>ad_schedule_proc</tt>:
+
+<blockquote><pre>perl -pi -e 's/ns_schedule_proc( -\w+)?/"ad_schedule_proc$1".($1 ? " t" : "")/eg;'` <i>files-to-process...</i></pre></blockquote>
+
+This adds the necessary <tt>t</tt> after the <tt>-thread</tt> or <tt>-once</tt> flag (e.g.,
+converts <tt>ns_schedule_proc -once</tt> to <tt>ad_schedule_proc -once t</tt>).
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/directory.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/directory.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/directory.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,70 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>User Directory</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>User Directory</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="mailto:philg@mit.edu">Philip Greenspun</a> documented by <a href="mailto:walter@arsdigita">Walter McGinnis</a>
+
+<hr>
+<blockquote>
+<ul>
+<li> User-accessible directory: <a href="/directory/">/directory/</a>
+</ul>
+
+<h3> The Big Idea </h3>
+
+<p>The User Directory is a way for users to get a sense of the size and character of the community (as well as find a specific member) by browsing or searching the list of members.
+
+<h3> Parameters</h3>
+
+<p>Developers can decide whether to provide a membership browser page, whether to list the full membership or just those who have submitted a homepage URL, and whether to include an image (and what image) at the top of certain pages.
+<blockquote>
+<pre>
+; for the /directory module wherein users get to look each other up
+[ns/server/yourdomain/acs/directory]
+ProvideUserBrowsePageP=1
+UserBrowsePageLimitedToNotNullUrlP=0
+;the following three parameters set images using an html fragment 
+;for decoration on their corresponding pages
+IndexPageDecoration= an html image tag
+BrowsePageDecoration= an html image tag
+SearchResultsDecoration= an html image tag
+</pre>
+</blockquote>
+
+<h3> What It Does </h3>
+
+<p>When Jane User visits /directory she can search for community members by last name or email address and then follow the results to information about the member of her choice.  She can also browse a list of all members (if the membership is large the developer can limit this list to just members that have submitted a homepage URL) or member portraits.
+
+<p>Relevant ACS Conventions:
+<ul>
+ <li>A linked member name points to the member's public information.
+ <li>Users can email a member by clicking on the member's linked email address.
+</ul>
+<p>/directory contains the following pages:
+
+<dl>
+ <dt>index.tcl</dt>
+  <dd>Where a user can choose between searching for a member or browsing the User Directory or Portrait Gallery.</dd>
+ <dt>lookup.tcl</dt>
+  <dd>Returns a list of members that match the search criteria.</dd>
+ <dt>browse.tcl</dt>
+  <dd>Returns a list of members.</dd>
+ <dt>portrait-browse.tcl</dt>
+  <dd>Returns a list of either members who have recently added portraits or all users who have portraits.  For each member in the list it displays either the associated image file name, thumbnail, or full size portrait.
+</dl>
+
+<!-- <h3> Future enhancements</h3>
+<ul>
+<li>
+</ul> -->
+</blockquote>
+<hr>
+<a href="mailto:walter@arsdigita.com"><address>walter@arsdigita.com</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/display.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/display.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/display.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,133 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Display Settings</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Display Settings</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="mailto:tarik@arsdigita.com">Tarik Alatovic </a> and  <a href="mailto:ahmeds@mit.edu">Sarah Ahmed</a>
+
+<hr>
+
+<ul>
+<li>Site Administrator directory:  <a href="/admin/display/">/admin/display/</a>
+<li>data model:   <a href="/doc/sql/display-sql.tcl?url=/doc/sql/display.sql">/doc/sql/display.sql</a>
+<li>procedures:   base in /tcl/display-defs.tcl
+
+</ul>
+
+<h3>The Big Picture</h3>
+
+This module allows the site administrator to set the most commonly used CSS ( Cascaded Style Sheet) properties and the Logo for the site. It currently employs a simple version of CSS that supports only the options to choose fonts, background color, font color, link color and link underline status. Although it limits how much one can do with css, it should suffice for most practical purposes.
+As explained in the future improvement section, we are working on a data model to support a more complete version of CSS.
+
+<h3>The Medium-Sized Picture</h3>
+
+This system consists of two tables. 
+
+css_simple table holds the css_properties of the site that can be set by the administrators together with the scope information.Using this table makes writing user friendly css forms possible.
+
+<blockquote>
+<pre>
+
+create table css_simple (
+        css_id  		  integer primary key,
+        -- if scope=public, this is the css for the whole system
+        -- if scope=group, this is the css for a particular group
+        -- is scope=user this is the css for particular user
+        scope   	          varchar(20) not null,
+        user_id			  references users,
+        group_id		  references user_groups,
+	css_bgcolor		  varchar(40),
+	css_textcolor		  varchar(40),
+	css_unvisited_link	  varchar(40),
+	css_visited_link	  varchar(40),
+	css_link_text_decoration  varchar(40),
+	css_font_type		  varchar(40)
+);
+
+alter table css_simple add constraint css_simple_scope_unique 
+unique(scope, user_id, group_id);
+
+alter table css_simple add constraint css_simple_data_scope_check check (
+	(scope='group' and group_id is not null and user_id is null) or
+        (scope='user' and user_id is not null and group_id is null) or
+        (scope='public'));
+</pre>
+</blockquote>
+
+<P>
+
+page_logos table stores the log that can be displayed on every page
+
+<blockquote>
+<pre>
+
+create sequence page_logos_id_sequence;
+create table page_logos (
+	logo_id 		integer primary key,
+       	-- if scope=public, this is the system-wide logo
+        -- if scope=group, this is the logo for a particular group
+        -- is scope=user this is the logo for a particular user
+        scope           	varchar(20) not null,
+        user_id			references users,
+        group_id		references user_groups,
+	logo_enabled_p		char(1) default 'f' check(logo_enabled_p in ('t', 'f')),
+	logo_file_type          varchar(100) not null,
+        logo_file_extension     varchar(50) not null,    -- e.g., "jpg"
+	logo			blob not null
+);
+
+alter table page_logos add constraint page_logos_scope_check check (
+	(scope='group' and group_id is not null and user_id is null) or
+        (scope='user' and user_id is not null and group_id is null) or
+        (scope='public'));
+
+alter table page_logos add constraint page_logos_scope_unique 
+unique(scope, user_id, group_id);
+
+</pre>
+</blockquote> 
+
+<h3>Legal Transactions</h3>
+From the Site Administration pages at <a href="/admin/display">/admin/display</a> the site-wide administrator can go to 
+<p>
+<a href="/admin/display/edit-simple-css.tcl">/admin/display/edit-simple-css.tcl</a> in order to set  
+<ul>
+<li>Body Background Color
+<li>Body Text Color
+<li>Links Color
+<li>Visited Links Color
+<li>Choose Font
+<li>Set Links Underlined / Not Underlined 
+</ul>
+<P>
+<a href="/admin/display/upload-logo.tcl">/admin/display/upload-logo.tcl</a> in order to
+<ul>
+<li>Upload a New Logo
+<li>View Current Logo
+<li>Change Current Logo if it exists
+<li>Enable/Disable Current Logo
+</ul> 
+
+<h3>Future Improvements</h3>
+
+Right now, the system only supports a simple version of CSS which restricts the administrator to set style selectors for his/her site. It will be augmented by a more complete version of CSS module which will allow the administrator to set any selector-property-value combination for the site. We are working on a unified version of a data model which will provide the flexibility of the complete version and the easy interface of the simple version.
+
+<p>
+
+<hr>
+
+<a href=mailto:tarik@arsdigita.com><address>tarik@arsdigita.com</address></a>
+</body>
+</html>
+
+
+
+
+
+
+
Index: web/openacs/www/doc/download.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/download.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/download.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,375 @@
+<html>
+<!--AD_DND-->
+<!--download.html,v 3.3.2.2 2000/04/12 09:01:29 ron Exp-->
+<head>
+<title>Download</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Download</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+<br>
+implemented by <a href="mailto:ahmeds@mit.edu">Sarah Ahmed</a> and <a href="http://web.mit.edu/mobin/web">Usman Mobin</a>
+<hr>
+
+<ul>
+<li>User-accessible directory:  <a href="/download/">/download/</a>
+<li>Site administrator directory:  <a href="/admin/download/">/admin/download/</a>
+<li>Group admin pages:  <a href="/download/admin/">/download/admin/</a>
+<li>Data model:  <a href="/doc/sql/display-sql.tcl?url=/doc/sql/download.sql">/doc/sql/download.sql</a>
+<li>Tcl procs:  /tcl/download-defs.tcl 
+<li>Downloadable files:  /web/foobar/download/
+
+</ul>
+
+<h3>The Big Idea</h3>
+
+A publisher of reports or software would like to be able to ask "Who has
+downloaded any version of Bloatware 2000?" or to say "Spam everyone who
+downloaded Bloatware 2000 v2.3 and tell them to upgrade to the new
+exciting 3.0 version".  Note that implicit in the foregoing is that
+users must register before downloading.  A publisher might wish to
+charge for downloading or limit downloading to members of a group.
+
+<p>
+
+You'd think that much of this could be accomplished with our standard
+user-tracking stuff: <code>user_content_map</code> keeps track of which
+users have grabbed which files; the member value system can store
+charges for particular files (prices kept in the
+<code>static_pages</code> table).  Some problems with using these
+modules include the fact that it is tough to annotate or group files in
+<code>static_pages</code> and the member value system is really more
+intended for subscribing users who pay once/month
+
+<h3>The Medium-sized Idea</h3>
+
+For each file to download, we store
+
+<ul>
+<h4>in the <code>downloads</code> table</h4>
+
+ 
+<li>download_id (unique key for a  particular download)
+<li>download pretty name, e.g., "Bloatware 2000"
+<li>directory name, e.g., "bw2000" (valid name for a Unix directory;
+all versions of this download will be kept here)
+<li>group_id (is this download associated with a user group?)
+<li>a description of the item
+
+<h4>in the <code>download_versions</code> table</h4>
+<li>version_id (unique key for a particular version of a particular download)
+<li>download_id (same for all versions of a prticular download)
+<li>version (a number; larger is newer)
+<li>pseudo filename, e.g., "bloatware-2000.23.tar.gz" (what you want it to
+be saved as on the user's desktop)
+<li>release date (don't offer until midnight on this date)
+<li>status (promote, offer_if_asked, removed)
+
+
+</ul>
+
+<h4>Administration Setup</h4>
+<p>
+
+When the administrator decides to add a new downloadable file to 
+the system, first the download directory must be created.  In the 
+current version of the module, this takes the form of the "Add New
+Download" function on the admin pages.  Doing this function only
+creates the directory in which the downloadable files are stored.
+
+<p>
+
+Note that the directory into which the /download/ directory is placed
+(generally /web/server_name/) must be write accessible to nsadmin.
+This can either be accomplished by making the owner nsadmin or changing
+the permissions so that nsadmin has write privileges.  Either way, if
+nsadmin can't write to this directory, an error indicating that "Folder
+<directory_name> could not be created" will result.
+
+<p>
+
+Actually placing the files in that directory is a second and 
+seperate step.  To upload a file to the server, select the
+directory name from the admin screens and then choose "Upload
+New Version" command.  This allows the administrator to place
+a file on the server that is downloadable by users.
+
+<p>
+
+As a side note, if the intended use of the Download Module
+involves documents that can be opened by a program on the 
+receiving machine (e.g. files of type .jgp, .html, .doc,
+.pdf, etc.), then the AOLserver's .ini file (<em>not</em>
+the ACS .ini file)  must be modified
+to make AOLServer aware of these file types.  
+This entry in the .ini file takes the form:
+<pre>
+[ns/server/servername/mimetypes]
+.doc=application/msword
+.ppt=application/powerpoint
+.xls=application/excel
+</pre>
+
+<h4>User View</h4>
+
+<p>
+
+To regular users, the downloadable file is visible based on the 
+assigned name assigned when the download directory was created,
+combined with the version number.  This isn't always the most
+obvious presentation of download filename, and will likely be
+customized by applications that offer other than software
+releases.
+
+<p>
+
+Downloads with a status of "promote" are offered on the top-level
+/download/ page.  Downloads with a status of "offer_if_asked" are
+available on a drill-down page of "/download/one.tcl" where multiple
+versions of the same download may be offered.  Downloads with a status
+of "removed" are only shown to the site or group administrator who has
+the option of changing their status or looking at an old version.
+
+<p>
+
+Users can see all files available for download (even before registration). However, upon actual download request of a file, the system checks the user's registration status and the visibility  (e.g. "all", "registered_users", or "group_members") of the specific file and permits download accordingly (e.g. non_registered users are only allowed to anonymously download files with visibility="all", he is required to login otherwise). 
+
+<h4>Implementation</h4>
+
+<p>
+
+Files and rows are never removed  from the database/system.  If someone wants
+to upload a new copy of version 2.3 of Bloatware 2000, it gets a new
+<code>version_id</code> and the old row is updated with a status of
+"removed".
+
+<p>
+
+We keep a separate table of rules that will allow downloading.  The
+rules can take the following forms:
+
+<ul>
+<li>unregistered users can download any version of download_id 37
+<li>all registered users can download any version of download_id 37
+<li>all registered users can download v2.3 of download_id 37
+<li>members of user_group 2213 can download any version of download_id 37
+(user group membership can be made subject to approval)
+<li>users who have paid $X can download any version of download_id 37
+<li>users who have paid $X can download v2.3 of download_id 37
+<li>users who have paid $Y and who previously paid to download some
+other version of download_id 37 can download v2.3 of download_id 37
+
+</ul>
+
+<h3>Under the Hood</h3>
+
+The files to download are generally stored outside the Web server root
+in a configurable location (by default /web/yourservername/download/).
+We chose not to store the downloads in an Oracle BLOB column.
+Downloads are presumed to be large and may require several minutes to
+transmit to a user with a modem.  If we kept the files in a BLOB, we'd
+have to either copy the data first into a /tmp file or hold onto an
+Oracle connection for the entire download time.  For a typical site
+configured with 8 Oracle connections maximum, this would mean that 8
+simultaneous downloaders could wedge the service.
+
+<p>
+
+We keep metadata in an Oracle table and we use Oracle-generated keys as
+filenames so there is no risk of conflict in the event of concurrent
+updates of files to be downloaded (assuming there is indeed more than
+one site administrator).
+
+<p>
+
+The directory structure bears some mentioning.  An objective is to keep
+this browsable via Emacs and still have some idea of what is going on,
+i.e., one should not have to also look into Oracle to verify what
+versions of what downloads are available.
+
+<p>
+
+<ul>
+<li>/web/yourservicename/download/bw2000/378.file is some version of
+Bloatware 2000, published by the site owner, with version_id in the
+database of 378.  A corresponding file
+/web/foobar/download/bw2000/378.notes contains the latest information
+from Oracle, e.g., what version it is, what the document is called, the
+pseudo filename, etc.  A notes file is only for sysadmins to read.
+The module never makes any use of informaiton in a notes file.
+
+<li>/web/foobar/download/groups/78/8234.html is version 1.0 of 
+"How to turn your cubicle into an 8000-gallon marine fish tank", 
+a document published by user group #78 (subcommunity of saltwater
+aquarium lovers).  /web/foobar/download/groups/78/8234.notes 
+contains ancillary info.
+
+</ul>
+
+<p>
+
+Via clever use of ns_register_proc, analogous to the static file comment
+attachment system (see /tcl/ad-html.tcl), we present URLs to the user
+for final downloading that look like
+/download/files/378/bloatware-2000.tar.gz (/download/files/ trips off
+the ns_register_proc; after that the format is
+/**version_id**/**psuedo-filename**).  This will result in their browser
+defaulting them with a reasonable filename to "save as".
+
+<h3>Deep under the hood</h3>
+
+<pre>
+create sequence download_id_sequence start with 1;
+
+create table downloads (
+	download_id		integer primary key,
+	-- if scope=public, this is a download for the whole system
+        -- if scope=group, this is a download for/from a subcommunity
+        scope           varchar(20) not null,
+	-- will be NULL if scope=public 
+	group_id	references user_groups on delete cascade,
+	-- e.g., "Bloatware 2000"
+	download_name	varchar(100) not null,
+	directory_name	varchar(100) not null,
+	description		varchar(4000),
+	-- is the description in HTML or plain text (the default)
+	html_p			char(1) default 'f' check(html_p in ('t','f')),
+	creation_date		date default sysdate not null,
+	creation_user		not null references users(user_id),
+	creation_ip_address	varchar(50) not null,
+        -- state should be consistent
+	constraint download_scope_check check ((scope='group' and group_id is not null) 
+                                               or (scope='public'))
+);
+
+create index download_group_idx on downloads ( group_id );
+
+create sequence download_version_id_sequence start with 1;
+
+create table download_versions (
+	version_id	integer primary key,
+	download_id	not null references downloads on delete cascade,
+	-- when this can go live before the public
+	release_date	date not null,
+	pseudo_filename	varchar(100) not null,
+	-- might be the same for a series of .tar files, we'll serve
+	-- the one with the largest version_id
+	version		varchar(4000),
+	version_description	varchar(4000),
+	-- is the description in HTML or plain text (the default)
+	version_html_p		char(1) default 'f' check(version_html_p in ('t','f')),
+	status		varchar(30) check (status in ('promote', 'offer_if_asked', 'removed')),
+	creation_date		date default sysdate not null ,
+	creation_user		references users on delete set null,
+	creation_ip_address	varchar(50) not null
+);
+
+create sequence download_rule_id_sequence start with 1;
+
+create table download_rules (
+	rule_id		integer primary key,
+	-- one of the following will be not null
+	version_id	references download_versions on delete cascade,
+	download_id	references downloads on delete cascade,
+	visibility	varchar(30) check (visibility in ('all', 'registered_users', 'purchasers', 'group_members', 'previous_purchasers')),
+	-- price to purchase or upgrade, typically NULL
+	price		number,
+	-- currency code to feed to CyberCash or other credit card system
+	currency	varchar(3) default 'USD' references currency_codes ,
+	constraint download_version_null_check check ( download_id is not null or version_id is not null)
+);
+
+-- PL/SQL proc
+-- returns 't' if a user can download, 'f' if not 
+-- if supplied user_id is NULL, this is an unregistered user and we 
+-- look for rules accordingly
+
+create or replace function download_authorized_p (v_version_id IN integer, v_user_id IN integer)
+     return varchar2
+     IS 
+	v_visibility download_rules.visibility%TYPE;
+	v_group_id downloads.group_id%TYPE;
+	v_return_value varchar(30);
+     BEGIN
+	select visibility into v_visibility
+	from download_rules
+	where version_id = v_version_id;
+	
+	if v_visibility = 'all' 
+	then	
+		return 'authorized';
+	elsif v_visibility = 'group_members' then	
+
+		select group_id into v_group_id
+		from downloads d, download_versions dv
+		where dv.version_id = v_version_id
+		and dv.download_id = d.download_id;
+
+		select decode(count(*),0,'not_authorized','authorized') into v_return_value
+		from user_group_map where user_id = v_user_id 
+		and group_id = v_group_id;
+	
+		return v_return_value;		
+	else
+		select decode(count(*),0,'reg_required','authorized') into v_return_value
+		from users where user_id = v_user_id;
+		
+		return v_return_value;
+	end if; 
+
+     END download_authorized_p;
+/
+show errors
+
+-- history 
+
+create sequence download_log_id_sequence start with 1;
+
+create table download_log (
+	log_id		integer primary key,
+	version_id	not null references download_versions on delete cascade,
+	-- user_id should reference users, but that interferes with
+	-- downloadlog_user_delete_tr below.
+	user_id		references users on delete set null,
+	entry_date	date not null,
+	ip_address	varchar(50) not null,
+	-- keeps track of why people downloaded this
+	download_reasons varchar(4000)
+);
+
+</pre>
+
+<h3>Legal Transactions</h3>
+
+From the <a href="/admin/download/">admin</a> pages, the administrator can 
+
+<ul>
+<li>Add New Downloads
+<li>Upload New Versions
+<li>Add New Rules specific to a particular version/download 
+<li>Edit Download/Version specific data 
+<li>View Download History
+<li>Spam people who downloaded a specific download /version 
+<li>Remove a version / download both from the file storage and database 
+</ul>
+
+From the <a href="/download/">user</a> pages, the user can 
+
+<ul>
+<li>Download a specific version that he/she is allowed to download
+<li>Input reasons for download
+</ul>
+
+<h3>Future Improvements</h3>
+
+We have left the money stuff unimplemented in this version of the download module, although the data 
+model supports"purchaser"/ "previous purchaser" user visibility.
+It could be tied to a future version of the ecommerce module or be standalone.
+
+<hr>
+<a href="ahmeds@mit.edu"><address>ahmeds@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/dw.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/dw.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/dw.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,63 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Data Warehouse Subsystem</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Data Warehouse Subsystem</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+Most of the real work in building a data warehouse is constructing a
+dimensional data model and copying information from your online
+transaction processing (OLTP) data model into the dimensional model.
+This software won't help you with that.  Although I hope to some day
+write about this, for now I will simply refer you to Ralph Kimball's <a
+href="http://www.amazon.com/exec/obidos/ISBN=0471153370/photonetA/"><cite>The
+Data Warehouse Toolkit</cite></a>.
+
+<p>
+
+What this subsystem is designed to do is provide a reasonable user
+interface to ad hoc querying of a single table.  If you have multiple
+tables that need to be JOINed, you could either extend this software a
+bit or build a view that does the JOIN.  If you have a truly large
+database (gigabytes), you might find that performance isn't acceptable.
+In that case, what you need to do is 
+
+<ul>
+<li>get your data into a dimensional model
+<li>build a view that joins the fact table to the dimensions and
+contains everything a user might want to group by, restrict by, or
+aggregate
+<li>see if you can't browbeat your RDBMS into optimizing queries into
+this view so that it doesn't mess with tables that are irrelevant to a
+particular query
+</ul>
+
+Once you've gotten your data into a dimensional model (one fact table
+plus a bunch of dimension tables), the data warehousing module of the
+ACS can help you.  It is also potentially useful if you just want to
+provide ad-hoc query capabilities for a big table that happens to exist
+in your production database.
+
+<p>
+
+The assumption is that this module will keep you from having to buy,
+install, and maintain Seagate Crystal Reports (a truly painful-to-use
+product).
+
+<h3>Installation</h3>
+
+You will almost surely want to go into /tcl/dw-defs.tcl and change
+<code>dw_table_name</code> to return either the right table or view for
+this system or something that depends on which user is logged in.
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/ecommerce-customer-service.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/ecommerce-customer-service.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/ecommerce-customer-service.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,120 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>The Customer Service Submodule of the Ecommerce Module</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>The Customer Service Submodule</h2>
+
+of the <a href="ecommerce.html">Ecommerce Module</a> by <a href="mailto:eveander@arsdigita.com">Eve Andersson</a> of <a href="http://arsdigita.com">ArsDigita</a>
+
+<hr>
+The Customer Service Submodule can be found at 
+<a href="/admin/ecommerce/customer-service/">/admin/ecommerce/customer-service/</a>
+(it is also linked to from the main Ecommerce Administration page).
+
+<p>
+
+<h3>Issues and Interactions</h3>
+
+There are two main concepts underlying the customer service submodule: customer service
+interactions and customer service issues.
+
+<p>
+
+There is a many-to-many relationship between issues and interactions.  During the course
+of one interaction, a customer may bring up any number of issues ("My credit card shows
+a charge for $7.99, but I thought this ant farm was only supposed to cost $6.99 AND,
+while I have you on the phone, I'd like to mention that delivery took three days instead
+of the promised two.").  Furthermore, if an issue is not resolved the first time it is 
+brought up, it might span any number of interactions until it is finally closed.
+
+<p>
+Issues can be categorized either for reporting purposes or so
+that different departments of your company can handle the issues.  Open issues
+are linked to from the front page of the customer service submodule to attract 
+attention.  Whenever email is sent to the customer (either automatically or
+by a customer service rep), an issue is created (or added to, if it is based
+on a previous issue).  This is so that a complete interaction history containing
+all correspondence to and from the customer can be maintained.  All issues created
+due to automatic emails are closed immediately so that they don't get in the way of
+other issues.
+
+<p>
+Small note: the intersection between an issue and an interaction is called an "action"
+(i.e., the part of a specific interaction that deals with a specific issue).  This rarely
+comes up.
+<p>
+
+<h3>Registered Users and Unregistered Users</h3>
+
+As a customer service rep, much of your interaction may be with people who
+have used the site but are not registered users (people don't become registered
+users unless they log in when they order, when they submit product reviews, etc.),
+yet you still want to capture the details of the interaction with as much
+identifying information about them as you can.
+
+<p>
+
+Whenever you record a new interaction, you are asked to enter as much information
+as you can gather (or feel comfortable gathering) about the user.  The system then
+tries to match this person up with either registered users or unregistered people
+who have had interacted previously with customer service.  If no match can be
+made, a new "user identification record" is created.
+
+<p>
+
+Each time you view a user identification record, the system sees if it can
+match that person up with a registered user of the system (in case they
+have registered in the meantime).
+
+<p>
+
+<h3>Sending Email to Customers</h3>
+
+When you're viewing a customer service issue, you can send the customer
+email regarding that issue by clicking "send email" at the top of the page.
+The contents of your email will automatically be added to the customer's
+interaction history and will become part of the record for that customer
+service issue.
+<p>
+If you find yourself using the same phrases over and over again when you
+respond to customers' emails, the <a href="/admin/ecommerce/customer-service/canned-responses.tcl">Canned Response System</a> will be useful
+to you.  You can enter your commonly used phrases once,
+and then whenever you send email you'll
+be able to automatically insert any number of these phrases.
+<p>
+If you want to send email to customers in bulk, then use the
+<a href="/admin/ecommerce/customer-service/spam.tcl">Spam System</a>.
+You can spam users based on what products they've bought, what products
+they've even looked at, by when they've last visited, by how much they've
+spent at your site, by which mailing lists they're signed up for.
+If you're spamming customers that you like, you can
+issue them all gift certificates at the same time.
+<p>
+Your email text is also sent through a spell checker before it is sent
+to the customer.
+
+<p>
+<h3>Picklist Management</h3>
+
+When your customer service data entry people are recording customer
+interactions, you want it to take as little effort as possible.  One
+way to help is to predefine picklists that they can choose from when
+entering data.  With the <a href="/admin/ecommerce/customer-service/picklists.tcl">Picklist Management tool</a>,
+you can specify what goes in what picklist in what order.
+
+<h3>Reports</h3>
+
+Reports and statistics are generated so that you can tell what types
+of issues are occurring most frequently, which customer service reps
+are handing the most interactions, what resources the reps need to use
+most often, etc.  Each report can be filtered and
+sorted in a variety of ways to give you a clear picture of what's
+happening and what can be done to improve efficiency.
+
+<hr>
+<a href="mailto:eveander@arsdigita.com"><address>eveander@arsdigita.com</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/ecommerce-features.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/ecommerce-features.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/ecommerce-features.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,248 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Features of the Ecommerce Module</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Features</h2>
+
+of the <a href="ecommerce.html">Ecommerce Module</a> by <a href="mailto:eveander@arsdigita.com">Eve Andersson</a> of <a href="http://arsdigita.com">ArsDigita</a>
+
+<hr>
+
+Some of the high-level features of the Ecommerce Module:
+
+<p>
+
+<b>Products</b>
+
+<ul>
+
+<li>Products are divided into categories (like books, journals, ...),
+subcategories (computer, fiction, ...), and
+subsubcategories (operating systems, web publishing, ...) which are set
+by the site adminstrator (if desired).  Products
+can belong to as many categories/subcategories/subsubcategories
+as needed.  Users can search by category/subcategory/subsubcategory and the site
+administrator can make product recommendations by category/subcategory/subsubcategory.
+
+<p>
+
+<li>Via simple forms, the site administrator can upload any desired
+information about products either into the Oracle database or into the
+file system.
+Standard product information such as product name, regular price, etc.,
+and admin-defined custom fields are collected in the database.  Pictures
+of the product and other formatted info like sample chapters, for instance, are uploaded into the file system.
+<p>
+
+<li>Users can input comments and ratings of products.  The site administrator
+can choose to: a) allow all comments, b) allow comments after administrator approval, or c) disallow all comments.
+
+<p>
+
+<li>The site administrator can input professional reviews of the products.
+
+<p>
+
+<li>The site administrator can specify whether the product should be
+displayed 
+when the user does a search. For example, they might not want the product
+to display if the product is part of a series or if the product is the hardcover version of a book that also exists in paperback
+
+<p>
+
+<li>Links between products: the site administrator can specify that one
+product always links to other product(s) on the product-display page.
+
+<p>
+
+<li>Products can be listed before they are available for sale.  The site administrator
+decides whether customers are allowed to preorder items or if they are not allowed
+to order until the date that the products become available.
+
+<p>
+
+<li>A product can have a lower, introductory price.  It can also have
+a limited-time sale price, and a limited-time special offer price which is given only to those who have the special
+offer code in their URL.  
+
+<p>
+
+<li>The site administrator determines the geographical regions in which
+tax should be charged.
+
+<p>
+
+<li>Shipping costs are determined by the site administrator as a base cost
++ a certain amount per additional item, or the cost can be
+based on weight.  Additional amounts are charged for express shipping, if
+allowed.
+
+</ul>
+
+<p>
+
+
+<b>Personalization</b>
+
+<ul>
+
+<li>Users are recognized, if possible, when they enter the site
+
+<p>
+
+<li>Users can be placed into user classes (student, publisher, ...)
+either by themselves (with site administrator approval) or by the
+site administrator.
+
+<p>
+
+<li>Members of user classes can be given different views of the
+site, different prices for each product, and different product
+recommendations.
+
+<p>
+
+<li>A user's purchasing history as well as browsing history is
+stored.  Product recommendations can be made based on both
+histories.
+
+<p>
+
+<li>Frequent buyers can be recognized and rewarded
+
+<p>
+
+<li>The site will automatically calculate what other products were
+most popular among people who bought a given product
+
+</ul>
+
+<p>
+
+<b>Ordering</b>
+
+<ul>
+<li>Shopping cart interface: users select items to put into their shopping cart and then go to their cart when they want to "check out".  The shopping cart is editable (similar to Amazon.com)
+
+<p>
+
+<li>If a user is not ready to order yet, they can store their order and
+come back to it later (similar to Dell.com)
+
+<p>
+
+<li>User receives an acknowledgment web page and email when their order
+is confirmed.
+
+<p>
+
+<li>The user can reuse an address for billing or shipping that they
+previously entered on the site and, if the site administrator has 
+chosen to store credit card data, they can reuse previous credit cards.
+
+<p>
+
+<li>The user's credit card is authorized at the time that they confirm
+their order.  The card is billed automatically only after the site administrator
+marks that the order has been shipped.
+
+<p>
+
+<li>The site administrator can issue electronic gift certificates to users.
+
+<p>
+
+<li>The site administrator is able to give refunds to a user if the user returns all or
+part of their order.
+
+<p>
+
+<li>Customers can view their order history and track their packages.
+
+<p>
+
+<li>Customers can purchase gift certificates for other people.  A random claim check is generated at the time of purchase and emailed to the recipient.  The recipient is then able to use their gift certificate when they make purchases on the site (until the certificate expires).
+
+</ul>
+
+
+<b>Community</b>
+
+<ul>
+
+<li>Users can sign up for mailing lists based on the product categories they
+are interested in.
+
+<p>
+
+<li>Most importantly, since the Ecommerce Module is tied in with the rest
+of the ArsDigita Community System, a more complete picture of the customer (Q &amp;
+A forum postings, Classified Ads, etc.) is known than in a stand-alone
+ecommerce system 
+
+</ul>
+
+<b>Customer Service</b>
+
+<ul>
+
+<li>A complete customer service submodule which allows customer service reps to:
+
+   <ul>
+   <li> receive and respond to customer inquiries via email (includes a spell-checker!)
+   <li> record all customer interactions and issues (whether by phone/fax/email/etc.)
+   <li> categorize issues
+   <li> view complete customer interaction and purchase histories
+   <li> send email using the "canned text" system which allows them to automatically insert commonly-used paragraphs into their emails
+   <li> "spam" groups of users based on various criteria (date of last visit, number of purchases, pages they've visited, mailing lists they've signed up for, etc.)
+   <li> edit email templates that the system uses when sending automatic email to users (e.g. "Dear &lt;insert name&gt;, thank you for your order.  We received your order on &lt;insert date&gt;, etc.")
+   <li> view statistics and reports on issues/interactions (e.g. interactions by customer service rep, issues by issue type)
+   </ul>
+
+
+</ul>
+
+<b>Other</b>
+
+<ul>
+<li>Data entered or modified by site administrators is audited,
+so you can see:
+
+  <ul>
+  <li>who made the changes
+  <li>when the changes were made
+  <li>what changed
+  <li>the history of all states the data have been in (so your data are never lost)
+  </ul>
+  
+<p>
+
+<li>All of the user display pages are templated, with templates stored
+in a separate directory from the rest of the site.  This allows
+designers to change the look and feel of the site without
+mucking around in Tcl or SQL code. 
+
+<p>
+
+<li>The system logs potential problems it encounters (e.g. failed credit card
+transactions) and allows site administrators to view the problems and mark them "resolved".
+
+</ul>
+
+<b>What's Coming in the Next Version</b>
+
+<ul>
+<li>Support for multiple retailers. (Includes an extranet for approved retailers
+to upload price and stock information about products they have for sale.)
+<p>
+<li>Integration with the ACS Graphing Package to show colorful sales reports.
+<p>
+<li>An online Help system.
+</ul>
+<hr>
+<a href="mailto:eveander@arsdigita.com"><address>eveander@arsdigita.com</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/ecommerce-for-mbas.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/ecommerce-for-mbas.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/ecommerce-for-mbas.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,162 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Ecommerce Module (explained for MBAs)</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Ecommerce Subsystem (explained for MBAs)</h2>
+
+of the <a href="ecommerce.html">Ecommerce Module documentation</a>
+(this small part of which was written by <a href="http://photo.net/philg/">Philip Greenspun</a>)
+
+<hr>
+
+The big decision:
+
+<ol type=A>
+
+<li>you are the retailer
+
+<li>you send all orders to one retailer
+
+<li>you offer products and send orders to multiple retailers
+
+<li>you let an arbitrary number of retailers come to your site and build
+shops (Yahoo! Store; Amazon Z Shops)
+
+</ol>
+
+ACS supports the first three ways of doing business and will eventually
+support the last one (clone of Yahoo! Store).
+
+
+<h3>High-level features</h3>
+
+If your imagination is limited, you can think of this as "Amazon.com in
+a box".  Is is it impressive to do everything that Amazon does?  Not
+really.  Ecommerce is a fast-moving field.  Packaged software always
+embodies last year's business ideas.  The interesting thing is how
+quickly one can extend an open-source software system to accomodate the
+latest business ideas.
+
+<h3>Feature List</h3>
+
+<blockquote>
+<table cellspacing=3>
+<tr>
+<th>in MBA-speak
+<th>translation for programmers
+</tr>
+<tr>
+<td valign=top>catalog engine
+<td valign=top>Oracle table (<code>ec_products</code>) plus 
+extra tables for mapping to categories, subcategories, and
+subsubcategories; bulk upload from structured data
+</tr>
+<tr>
+<td valign=top>e-recommendation engine
+<td valign=top>Oracle table (<code>ec_product_recommendations</code>)
+ mapping products to categories, subcategories, for everyone or only a
+particular class of user
+</tr>
+<tr>
+<td valign=top>e-review technology
+<td valign=top>Oracle tables for professional reviews and customer-contributed
+reviews
+</tr>
+
+<tr>
+<td valign=top>shopping cart 
+<td valign=top>Oracle tables (<code>ec_user_sessions, ec_orders, ec_items</code>)
+</tr>
+<tr>
+<td valign=top>real-time credit card billing 
+<td valign=top>CyberCash and CyberSource interfaces
+</tr>
+<tr>
+<td valign=top>user tracking
+<td valign=top>log every page view and search
+</tr>
+<tr>
+<td valign=top>integrated customer service (telephone, fax, email, and Web)
+<td valign=top>all interactions logged into same Oracle table; inbound
+<a href="email-handler.html">email handler</a> (Perl script); call
+center staff sit at Web browsers and use the /admin/ecommerce/ pages
+</tr>
+<tr>
+<td valign=top>CRM 
+<td valign=top>write custom rules for <a href="crm.html">standard ACS CRM module</a>
+</tr>
+<tr>
+<td valign=top>intelligent agent
+<td valign=top>Oracle query for "users who bought X also bought Y"
+</tr>
+<tr>
+<td valign=top>content management with visual interface
+<td valign=top>Web forms plus auditing of all changes
+</tr>
+<tr>
+<td valign=top>discounts for different classes of user
+<td valign=top>Example:  MIT Press wants to sell journals
+at different rates for individual, institutional, and student subscriptions
+</tr>
+<tr>
+<td valign=top>cross-sales platform
+<td valign=top>Oracle table of "if you're interested in X, you probably
+also should buy Y"; links are unidirectional
+</tr>
+<tr>
+<td valign=top>object-oriented design
+<td valign=top>per-publisher custom fields table to add arbitrary
+attributes to products
+</tr>
+<tr>
+<td valign=top>intelligent parametric and free-text search engine
+<td valign=top><code>pseudo_contains</code> if you want to have an easy
+Oracle dbadmin life; <code>Contains</code> (Intermedia text) if you
+don't;
+limit to category at user's option
+</tr>
+<tr>
+<td valign=top>gift certificates
+<td valign=top>auditing and mandatory expiration 
+</tr>
+<tr>
+<td valign=top>enterprise-scale e-business solution
+<td valign=top>add more processors to your Oracle server
+</tr>
+<tr>
+<td valign=top>highly scalable transaction engine
+<td valign=top>orders are inserted into Oracle table
+</tr>
+<tr>
+<td valign=top>XML-enabled
+<td valign=top>download free Java XML libraries from Oracle
+</tr>
+
+</table>
+</blockquote>
+
+
+<h3>Bottom line</h3>
+
+If a closed-source ecommerce package doesn't do exactly what you want,
+you're out of business.  If the company behind a closed-source ecommerce
+package goes out of business, so will you.  If the company behind a
+closed-source ecommerce adopts a different "business model", you're
+screwed.  
+
+<p>
+
+If you're even tempted to adopt a commercial ecommerce system from a
+company other than IBM, Oracle or SAP (three enterprise software vendors
+that seem likely to be around for awhile), read the iCat story towards
+the end of <a
+href="http://photo.net/wtr/using-the-acs.html">http://photo.net/wtr/using-the-acs.html</a>
+
+<hr>
+<a href="mailto:philg@mit.edu"><address>philg@mit.edu</address></a>
+</body>
+</html>
+
Index: web/openacs/www/doc/ecommerce-incoming-email.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/ecommerce-incoming-email.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/ecommerce-incoming-email.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,64 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Incoming Email</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Incoming Email</h2>
+
+to the <a href="ecommerce.html">Ecommerce Module</a> by <a href="mailto:eveander@arsdigita.com">Eve Andersson</a> of <a href="http://arsdigita.com">ArsDigita</a>
+
+<hr>
+<ol>
+<b><li>Determine or create the user_identification_id and issue_id as follows.</b>
+    <p>
+    Incoming email will come to an email address either of the form 
+    <code>service-<i>user_identification_id</i>-<i>issue_id</i>@whatever.com</code>
+    or just <code>service@whatever.com</code>.
+    <p>
+    <ul>
+    <li>Case 1: <code>service-<i>user_identification_id</i>-<i>issue_id</i>@whatever.com</code>
+    <p>
+    Do a check to make sure that issue actually belongs to that user (check that issue_id and 
+    user_identification_id match in ec_customer_service_issues).
+      <ul>
+      <li>If so, just reopen the issue if it's closed.
+      <li>If not, they've probably been messing with the numbers in the email address, so just
+          treat it like Case 2.
+      </ul>
+    <p>
+    <li>Case 2: <code>service@whatever.com</code>
+      <ol type=a>
+      <li>Determine the email address from which it came.  See if the email address belongs to a registered user of the system.
+          <ul>
+	  <li>If so, see if there's a user_identification_id with that user_id (only
+	  grab the first one, if it exists, then flush the rest).
+	     <ul>
+	     <li>If so, great, we'll be using that user_identification_id later.
+	     <li>If not, get a new user_identification_id (using ec_user_ident_id_sequence) and create the user_identification record (insert into ec_user_identification (user_identification_id, date_added, user_id) values ($user_identification_id, sysdate, $user_id)).
+	     </ul>
+	  <li>If not, see if the email address belongs to a non-registered user with a past customer service record (i.e. there's a row in ec_user_identification with that email address; only grab the first one, if it exists, then flush the rest)
+	     <ul>
+	     <li>If so, great, we'll be using that user_identification_id later.
+	     <li>If not, insert a new row into ec_user_identification with user_identification_id, date_added, email, and, if you can regexp them out, first_names and last_name filled in.
+	     </ul> 
+	  </ul>
+      Now we have a user_identification_id to use.
+      <p>
+      <li>Create a customer service issue.  Set the issue_id (you'll need it later) to ec_issue_id_sequence.nextval, and then insert into ec_customer_service_issues (issue_id, user_identification_id, open_date) values ($issue_id, $user_identification_id, sysdate).
+      </ol>
+      </ul>
+<p>
+<b><li>Create a new interaction.</b>
+<p>
+Just generate an interaction_id with ec_interaction_id_sequence.  Then insert into ec_customer_serv_interactions (interaction_id, user_identification_id, interaction_date, interaction_originator, interaction_type, interaction_headers) values ($interaction_id, $user_identification_id, sysdate, 'customer', 'email', [the headers from the email]).
+<p>
+<b><li>Create a new action.</b>
+<p>
+insert into ec_customer_service_actions (action_id, issue_id, interaction_id, action_details) values (ec_action_id_sequence.nextval, $issue_id, $interaction_id, [the body of the email])
+</ol>
+<hr>
+<a href="mailto:eveander@arsdigita.com"><address>eveander@arsdigita.com</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/ecommerce-operation.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/ecommerce-operation.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/ecommerce-operation.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,196 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Operation of the Ecommerce Module</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Operation</h2>
+
+of the <a href="ecommerce.html">Ecommerce Module</a> by <a href="mailto:eveander@arsdigita.com">Eve Andersson</a> of <a href="http://arsdigita.com">ArsDigita</a>
+
+<hr>
+Before reading this, make sure that you have read about <a href="ecommerce-setup.html">setting up your ecommerce module</a>.  This document takes up where that one leaves off and covers all the components of operating your on-line shop with the exception of
+<a href="ecommerce-customer-service.html">customer service</a>, which is a submodule
+in itself.
+<p>
+<h3>Orders</h3>
+These are the states that an order can go through:
+<blockquote>
+<pre>
+   +-------- IN_BASKET <----------------+ (if authorization fails --
+   |            |                       | it might also temporarily go
+   |            |                       | into FAILED_AUTHORIZATION
+EXPIRED      CONFIRMED------------------+ before returning to IN_BASKET)
+                |
+          +-----+------------+
+          |                  |    
+ AUTHORIZED_MINUS_AVS   AUTHORIZED_PLUS_AVS
+          |                  |
+          +----+--------+----+
+               |        |
+PARTIALLY_FULFILLED--->FULFILLED
+                          |
+                       RETURNED
+
+</pre>
+</blockquote>
+An order can also be put into the VOID state at any time by the site
+administrator.  (Note: these states are actually stored in all lowercase
+in the database, but it's clearer to use uppercase letters in the
+documentation.)
+<p>
+An order is IN_BASKET when the customer has put items into their shopping
+cart on the site but has not indicated an intent to buy (if they stay
+there too long they go into the EXPIRED state; "too long" is defined in
+the parameters/yourservername.ini file; default is 30 days).  When the customer
+submits their order, the state becomes CONFIRMED.  Only then do we try
+to authorize their credit card.  If the authorization succeeds, the order
+state will be updated to AUTHORIZED_PLUS_AVS or AUTHORIZED_MINUS_AVS.
+AVS stands for Address Verification System (for more information on AVS,
+read the <a href="http://photo.net/wtr/thebook/ecommerce.html">ecommerce
+chapter</a> of Philip &amp; Alex's Guide to Web Publishing.  Because AVS
+is flaky and unreliable, we treat AUTHORIZED_PLUS_AVS orders the same as
+AUTHORIZED_MINUS_AVS orders.  If an order fails, it goes back into the
+IN_BASKET state and the customer is given another chance to enter their
+credit card information.
+<p>
+Problems occur if we don't hear back from CyberCash or if they give us
+a result that is inconclusive.  In cases like this, the order state
+remains in the CONFIRMED state.  A scheduled procedure sweeps the 
+database every once in a while looking for CONFIRMED orders that are
+over 15 minutes old and tries to authorize them.  If the authorization
+succeeds, the order is put into the AUTHORIZED_PLUS_AVS or
+AUTHORIZED_MINUS_AVS state.  If it fails, it is temporarily put into
+the FAILED_AUTHORIZATION state so that it can be taken care of by
+a scheduled procedure which sends out email to the customer saying
+that we couldn't authorize their order and then saves the order for
+them (a saved order is one in the IN_BASKET state with saved_p='t'; it
+can be retrieved easily by the customer later).
+<p>
+Once an order is authorized they are ready to be shipped.  An order
+which has some of its items shipped is PARTIALLY_FULFILLED and orders
+for which a full shipment is made are FULFILLED.  It remains in the
+fulfilled state unless <i>all</i> of the items in the order are returned,
+at which time it becomes financially uninteresting and goes into the
+RETURNED state.
+<p>
+Individual items in an order also go through a series of states:
+
+<blockquote>
+<pre>
+IN_BASKET -----------+
+   |                 |
+TO_BE_SHIPPED     EXPIRED
+   |
+SHIPPED
+   |
+ARRIVED
+   |
+RECEIVED_BACK
+</pre>
+</blockquote>
+
+An item starts out in the IN_BASKET state.  When the order it's in becomes authorized, the item becomes TO_BE_SHIPPED.  Because partial shipments can be made on orders, SHIPPED is a state of the individual items, not of the order.  There is currently no mechanism for
+putting an item into the ARRIVED state but it could be used if you were to set up a
+method of data exchange with FedEx's database to get the actual arrival date and arrival
+detail for each of the packages you ship.  If the customer returns an item to you, it is
+put into the RECEIVED_BACK state.  Like orders, individual items can also be put into the VOID state (e.g. if the customer changes their mind or if you run out of stock before you can ship it).
+
+<p>
+
+OK, so what can you actually do with orders?  You can:
+<ul>
+<li><a href="/admin/ecommerce/orders/by-order-state-and-time.tcl">view them</a>
+<li><a href="/admin/ecommerce/orders/fulfillment.tcl">fulfill them</a>
+<li><a href="/admin/ecommerce/orders/">search for individual orders</a>
+</ul>
+On an individual order, you can:
+<ul>
+<li>add comments to it
+<li>record a shipment
+<li>process a refund
+<li>add items (only if it hasn't shipped yet and if it was paid for using a credit card instead of using a gift certificate)
+<li>change the shipping address
+<li>change the credit card information
+<li>void it
+</ul>
+
+<h3>Gift Certificates</h3>
+
+As you know from <a href="ecommerce-setup.html">setting up your ecommerce module</a>,
+you can configure whether to allow customers to purchase gift certificates for others.
+These are the states that a purchased gift certificate goes through:
+
+<pre>
+                        CONFIRMED
+                            |
+        +-------------------+---------------------+
+        |                   |                     |
+AUTHORIZED_PLUS_AVS   AUTHORIZED_MINUS_AVS   FAILED_AUTHORIZATION
+</pre>
+
+Regardless of whether you allow customers to purchase gift certificates, you
+can always issue gift certificates to your customers.  Gift certificates
+that you issue automatically go into the AUTHORIZED state.
+
+<p>
+
+There are a few fundamental ways in which purchased gift certificates
+differ from assigned gift certificates.  Purchased gift certificates are
+sent to some recipient who may or may not be a registered user of the
+system, along with a claim check.  These gift certificates must be claimed
+upon order checkout in order to be used.  Issued gift certificates, on the
+other hand, are given to registered users of the system and are put
+directly into their gift certificate balance.  There is no need for them
+to be claimed because there is no ambiguity about who the gift certificates
+belong to.
+
+<p>
+
+All gift certificates have an expiration date (this is necessary so that your
+liability has a definite ending point).  A customer's gift certificate 
+balance is equal to the sum of all the unused portions of each non-expired
+gift certificate they own.  When their gift certificate balance is applied
+toward a new order, the gift certificates that expire soonest are the first
+to be applied.
+
+<p>
+Things you can do with gift certificates:
+<ul>
+<li>view <a href="/admin/ecommerce/orders/gift-certificates.tcl">purchased
+gift certificates</a>
+<li>view <a href="/admin/ecommerce/orders/gift-certificates-issued.tcl">issued
+gift certificates</a>
+<li>see your <a href="/admin/ecommerce/orders/revenue.tcl">gift certificate
+liability</a>
+<li>see a customer's gift certificates (find the customer using the customer
+service submodule or <a href="/admin/users/">/admin/users</a>) and void their
+gift certificates or issue them new ones
+</ul>
+<p>
+<h3>Site Upkeep</h3>
+
+Besides the most important task of filling orders, there are some other things
+that need to be done once in a while.
+<p>
+
+Naturally, you'll want to rotate your <a href="/admin/ecommerce/products/recommendations.tcl">product recommendations</a> every so often to keep your site looking fresh, even
+if your product database doesn't change.  You will also need to periodically 
+<a href="/admin/ecommerce/customer-reviews/">approve/disapprove customer reviews</a>
+(if you've set reviews to require approval) and perhaps view
+<a href="/admin/ecommerce/orders/">some reports</a> to make sure everything is
+going as you expected.
+
+<h3>Dealing with Problems</h3>
+
+A <a href="/admin/ecommerce/problems/">log of potential problems</a> is maintained
+by the system when it comes across issues that it is unable to resolve.  These
+problems (hopefully infrequent) will need to be resolved by hand.
+
+<p>
+Continue on to the <a href="ecommerce-customer-service.html">Customer Service Submodule</a>.
+<hr>
+<a href="mailto:eveander@arsdigita.com"><address>eveander@arsdigita.com</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/ecommerce-setup.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/ecommerce-setup.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/ecommerce-setup.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,241 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Setup of the Ecommerce Module</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Setup</h2>
+
+of the <a href="ecommerce.html">Ecommerce Module</a> by <a href="mailto:eveander@arsdigita.com">Eve Andersson</a> of <a href="http://arsdigita.com">ArsDigita</a>
+
+<hr>
+This is intended to be a guide for the content administrators of the site.
+Content administrators are not assumed to have any technical expertise
+(although HTML knowledge is necessary if you want to edit product templates).
+<p>
+These are the basic steps needed to get your ecommerce system up and running.
+Most functions below can be performed using the
+ecommerce administration pages in
+<a href="/admin/ecommerce/">/admin/ecommerce/</a> (must be accessed using HTTPS).
+
+<ol>
+<li>First make sure that the <a href="ecommerce-technical.html">technical setup</a>
+has been taken care of.  Although most of it can be done quickly, the 
+process of setting up a merchant account to accept credit cards can take weeks,
+so don't procrastinate!
+<p>
+You will need to answer the following questions for whomever will be
+editing the parameters/yourservername.ini file.
+If you don't know what some of these
+questions mean, read on.  These should make sense after you've finished
+reading this page.
+<p>
+<ol type=A>
+<li>what units of currency and weight (e.g. USD and lbs) will be used throughout the site
+<li>how many products to display per page when the customer is browsing (default 10)
+<li>whether to allow users to write public comments of the products and, if so, whether the comments need to be approved (by you) before they appear on the site
+<li>whether you want product relationships (e.g. "people who bought product A also bought products B, C, and D") to be calculated and displayed
+<li>regarding user classes (i.e., classes that you might place users in like "publisher" or "student" for purposes of giving discounts or different views of the site): (a) do you want them to know what classes they're in? (b) can they request via the web site to be placed into user classes, and (c) if so, do they automatically become a member of any user class they request to be a part of, or do their requests need to be approved by an administrator first?
+<li>what percentage of the shipping charges should be refunded if a customer returns their purchases
+<li>whether express shipping is available
+<li>whether you want to save credit card data (if so, customers can reuse their credit card with one click; if not, the credit card number is deleted after the order has shipped)
+<li>how large you want the automatically-generated thumbnail images of the products to
+be (you can specify either the width or the height, in pixels; the dimension you don't specify will vary based on the original image's size)
+<li>what product stock messages you want to be able to choose from when adding/editing products (e.g. "Out of Stock", "Usually Ships Within 24 Hours", "Usually Ships Within 2-3 Days", etc.)
+<li>the number of days a user's shopping cart will stay valid before it goes into the 'expired' state
+<li>whether to allow preorders for items that are not yet available
+<li>the email address that will be used for all email sent from the system to the customers
+<li>whether people fulfilling the orders should be alerted if there's a problem reauthorizing a credit card for payment (which happens when orders are shipped) -- you'll want them to be alerted if they're in a position to do anything about the problem (e.g. abort the shipment); otherwise, there's no need to alert them because the problem will still be logged so that someone else can take care of it
+<li>whether customers are allowed to purchase gift certificates for others and, if so, the minimum and maximum amounts of money that the gift certificates can be worth as well as the number of months until the gift certificates expire
+</ol>
+
+<p>
+<li>Set up product categorization (<a href="/admin/ecommerce/cat/">/admin/ecommerce/cat/</a>):
+
+<p>
+
+Product categories, subcategories and subsubcategories are optional,
+but if you intend to offer many products for sale, it is best to think
+about how they should be categorized <i>before</i> you enter any products into
+the database.  The categorization is used when displaying the products and when the
+customer is searching for products.
+
+<p>
+
+Here is an example to help you decide how you want to categorize your
+products.  Say you are a publisher and you are selling a variety of
+books and periodicals.  You may wish to divide your goods into
+two categories: books and periodicals.  The subcategories of books
+will be: fiction, biography, history, science, and so on.  The
+subcategories of periodicals will be: health &amp; fitness, sports,
+news, beauty, and so on.  If you want to go a level deeper, you
+can subdivide science, for instance, into physics, chemistry, biology,
+geology, and so on.
+
+<p>
+
+Another example: say you sell CDs and nothing else.  Then your
+categories can be: classical, rock, jazz, international, etc.
+You will probably not need to use subcategories.
+
+<p>
+
+What if one of your products spans two categories?  That's OK; you are allowed
+to put a product into as many categories (and subcategories and subsubcategories)
+as you like.  So, if you're
+selling the <i>Girl From Ipanema</i> CD, you can put it into both
+the jazz and the international categories so that your customers
+can find it in both places.
+
+<p>
+
+<li>Set up your shipping cost rules (<a href="/admin/ecommerce/shipping-costs/">/admin/ecommerce/shipping-costs/</a>).  The ecommerce module is flexible
+regarding how you charge your customers for shipping.  The <a href="/admin/ecommerce/shipping-costs/">Shipping Costs page</a> in the admin section will lead you
+through it.  Make sure you read the <a href="/admin/ecommerce/shipping-costs/examples.tcl">Shipping Cost Examples page</a>
+if you don't already know how you want to set it up.
+
+<p>
+
+
+<li>Set up your sales tax rules (<a href="/admin/ecommerce/sales-tax/">/admin/ecommerce/sales-tax/</a>).  If your company is located only in
+one or a few states, this will be easy.  On the other hand, if you're
+a Fortune 500 company and you have nexus (i.e. have an office or
+factory or store) in many states, you might want to buy tax tables from
+<a href="http://www.salestax.com/">www.salestax.com</a>.  A fair bit
+of programming would be needed to integrate this data with your
+ecommerce system.  Also if you're not based in the USA, you may need
+to have some programming done to handle the tax for the regions in your country.
+
+<p>
+
+
+<li>Decide if you want to add any custom product fields.  First look at the
+current fields available (<a href="/admin/ecommerce/products/add.tcl">/admin/ecommerce/products/add.tcl</a>) to see if they meet your needs.  The current
+fields are probably sufficient for many types of products.  However, a 
+bookseller may wish to add a custom field to store the ISBN, or someone
+who sells clothing from many manufacturers may wish to add a manufacturers field.
+Custom fields are added at <a href="/admin/ecommerce/products/custom-fields.tcl">/admin/ecommerce/products/custom-fields.tcl</a>.
+
+<p>
+
+<li>Create new product display templates
+(<a href="/admin/ecommerce/templates/">/admin/ecommerce/templates/</a>)
+(unless you're happy with the somewhat minimalist default template).  The
+reason for having product display templates is that you might want to present
+different types of products in different ways (e.g., spring dresses get a
+yellow background page color; winter coats get a blue background page color).
+
+<p>
+
+You can modify the default template that the ecommerce module comes with
+to incorporate your custom product fields, to exclude fields you
+don't use, or just change
+the way it looks to fit whatever design scheme you want to use.  The
+template is written in AOLserver's ADP language, which is just HTML
+with Tcl variables (or commands) inside &lt;% and %&gt; tags.  It is
+extremely easy.  It you can write HTML, you can write ADP.  If you can't,
+you can hire someone cheaply to do it for you.
+
+<p>
+
+You can create as many additional templates as you like.
+You can associate templates with product categories so that every
+product in the "book" category is automatically assigned the
+"book" template by default, although you can always assign any
+template you want to any product you want (so if you have an
+unusual product, you can give it an unusual template).
+
+<p>
+
+<li>Set up user classes (<a href="/admin/ecommerce/user-classes/">/admin/ecommerce/user-classes/</a>).  User classes are groupings of the users, such as
+"student", "retired", "institution", "publisher", etc. They may
+get special prices, different views of the site, or different product
+recommendations.
+
+<p>
+
+Depending on your settings in the ini file, users may or may not be
+able to see which user classes they're a member of (so be careful
+of what you call them!).
+
+<p>
+
+If a user is a member of more than one class and there are special
+prices on the same product for both classes, the user will receive
+whichever price is lowest.
+
+<p>
+
+<li>Enter your products into the database.  This can be done using
+the simple form at <a href="/admin/ecommerce/products/add.tcl">/admin/ecommerce/products/add.tcl</a>.
+
+<p>
+
+However, if you have many products already stored in another database,
+you will not want to enter them one by one.  Instead, export them into
+a CSV file (or a series of CSV files), and manipulate them into the
+formats documented at <a href="/admin/ecommerce/products/upload-utilities.tcl">/admin/ecommerce/products/upload-utilities.tcl</a> so that they can be uploaded
+in bulk.
+
+<p>
+
+<li>After you've added a product, there are a variety of things you can
+do to it, such as:
+  <ul>
+  <li>Add any number of professional reviews.
+  <li>Add "cross-selling links" so that the customer always sees a link
+      to another given product when they're viewing this product, or vice versa.
+  <li>Put the product on sale or create "special offers".
+  </ul>
+
+<p>
+
+<li>Add product recommendations (<a href="/admin/ecommerce/products/recommendations.tcl">/admin/ecommerce/products/recommendations.tcl</a>).  If you have many products subdivided into a number of categories/subcategories/subsubcategories, it's good to include product recommendations in order to make the site more browsable and interesting.
+
+<p>
+
+Recommendations are displayed when the customer is browsing the site, either on the
+home page (if a product is recommended at the top level), or when the
+customer is browsing categories, subcategories, or subsubcategories.
+
+<p>
+
+You can also associate product recommendations with a user class.  E.g.,
+you might only want the book "Improving your GRE Scores" to only be recommended
+to Students.
+
+<p>
+
+<li>Modify the email templates (<a href="/admin/ecommerce/email-templates/">/admin/ecommerce/email-templates/</a>), which are used when the system sends out automatic email
+to customers.  There are seven predefined email templates for email sent out when
+a customer's order is authorized, when a customer's order ships, when a customer
+receives a gift certificate, etc.
+
+<p>
+
+The current templates are functional but should probably be edited to reflect
+your company better.
+
+<p>
+
+<li>The layout for all the pages in your site is created using ADP templates
+which are stored in the directory /web/yourservername/templates/ecommerce/
+(with the exception of product.tcl which, as discussed above, uses a different
+ADP templating system to allow for different templates for different products).
+If you are unhappy with the look of any of the pages in your site, there's
+a good chance that it can be changed simply by editing the corresponding ADP
+template.
+
+</ol>
+
+<p>
+
+That's it for setup!   Of course, your customers won't be very happy
+until you can do things like order fulfillment, so it's time to read about
+<a href="ecommerce-operation.html">operation of your ecommerce site</a>.
+
+<hr>
+<a href="mailto:eveander@arsdigita.com"><address>eveander@arsdigita.com</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/ecommerce-technical.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/ecommerce-technical.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/ecommerce-technical.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,546 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Technical Details of the Ecommerce Module</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Technical Details</h2>
+
+of the <a href="ecommerce.html">Ecommerce Module</a> by <a href="mailto:eveander@arsdigita.com">Eve Andersson</a> of <a href="http://arsdigita.com">ArsDigita</a>
+
+<hr>
+<h3>Setup</h3>
+
+<ul>
+<li>This module requires Oracle 8i.
+<p>
+<li>Install CyberCash by following the instructions for the
+<a href="http://arsdigita.com/free-tools/shoppe.html">ArsDigita Shoppe</a>.
+(Note: it can take a few weeks for your bank and CyberCash to get your
+account ready, so get started on that right away!)
+
+<p>
+
+<li>These are the files in this ACS release that you need to have to run the ecommerce module:
+  <ul>
+  <li>data model in /doc/sql/ecommerce*.sql
+  <li>documentation in /doc/ecommerce*.html
+  <li>scripts in /ecommerce/
+  <li>admin scripts in /admin/ecommerce/
+  <li>ADP templates in /templates/ecommerce/
+  <li>tcl procs in /tcl/ecommerce-*.tcl
+  <li>ecommerce section of .ini file in parameters/
+  <li>ecommerce section of /admin/users/one.tcl
+  <li>a little proc ad_return_warning in ad-defs.tcl
+  </ul>
+
+<p>
+
+Note: this module also relies on you having the tools package, the style package, and the audit tool installed.
+
+<p>
+
+<li>Load the data model into Oracle.
+
+<p>
+
+<li>ImageMagick must be installed in /usr/local/bin/ if you want thumbnails
+to be automatically created.  For information on ImageMagick (which is
+free), see <a href="http://photo.net/wtr/thebook/images.html">Chapter 6:
+Adding Images to Your Site</a> of Philip and Alex's Guide to Web
+Publishing.
+
+<p>
+
+<li>A /web/yoursever/data/ecommerce/product directory is needed to hold the products'
+supporting files (it's outside the web root so that no uploaded supporting files
+can be executed).  The directory has to be writeable by nsadmin.  (You can change the directory by editing EcommerceDataDirectory and ProductDataDirectory in your parameters .ini file.)
+
+<p>
+
+<li>Based on the site owner's publishing decisions, the ecommerce parameters
+in /web/yourserver/parameters/yourserver.ini need to be edited.
+
+<p>
+
+<li>Either find a copy of the <code>zip_codes</code> table to import (ArsDigitans know where
+to find it but unfortunately we can't redistribute it because it's licensed),
+or delete the little bit of code that uses it.
+
+<p>
+
+<li>Qmail must be installed on your system.
+</ul>
+
+<h3>Under the Hood</h3>
+
+This is provided just for your own information.  You may never need
+to know any of it, but it may prove useful if something goes wrong or
+if you want to extend the module.
+
+<ul>
+
+<li><b>Financial Transactions</b>
+<p>
+A financial transaction is inserted whenever a credit card
+authorization to charge or refund is made.  These transactions may
+or may not be carried through to fulfillment.  The specifics:
+<p>
+When an order is placed, an authorization is done for the full
+cost of the order, so a row is inserted into <code>ec_financial_transactions</code>.
+This row has a unique <code>transaction_id</code> and it is tied to the order
+using the <code>order_id</code>.  This isn't captured yet (not until
+the items ship).
+<p>
+When a shipment is made, if it's a full shipment of the order, the
+financial transaction inserted when the order is first placed
+is ready to be captured (<code>to_be_captured_p</code> becomes 't' and the
+system attempts to mark and capture it).
+<p>
+However, if only a partial shipment is made, a new authorization has
+to be made (therefore a new row is inserted into <code>ec_financial_transactions</code>, <code>to_be_captured_p</code> is set to 't' and the
+system attempts to mark and capture it).
+
+<p>
+When a refund is made, a row is also inserted into <code>ec_financial_transactions</code>.
+A refund is only inserted if it is definite that it needs to be captured,
+so there is no need to set <code>to_be_captured_p</code> if <code>transaction_type</code>='refund'.
+<p>
+Scheduled procs go around and do the follow-through (making sure everything
+is marked/settled) for every transaction that needs to be captured.
+<p>
+<b><li>Gift Certificates</b>
+<p>
+Each customer has a gift certificate balance (it may be $0.00), which you
+can determine by calling the PL/SQL function <code>ec_gift_certificate_balance</code>.  Different chunks of a customer's balance may expire at different
+times because every gift certificate that is issued has an expiration date.
+<p>
+When the system applies a customer's gift certificate balance to an order,
+it begins by using the ones that are going to expire the soonest and continues
+chronologically until either the order is completely paid for or until the
+customer's gift certificates run out.  If only part of a gift certificate is
+used, the remaining amount can be used later.
+<p>
+If a customer purchases a gift certificate for someone else, the recipient
+(who may or may not be a registered user of the site) is emailed a claim
+check that they can use to retrieve the gift certificate and have it
+placed in their gift certificate balance.  Note: "retrieving" a gift
+certificate is equivalent to inserting the <code>user_id</code> of the
+owner into <code>ec_gift_certificates</code>.  Retrieved gift certificates
+always belong to registered users because gift certificates can
+only be retrieved during the course of placing an order, at which time
+an unregistered user becomes registered.
+<p>
+Site administrators can issue gift certificates to customers at will.
+In this case, no claim check is generated.  The gift certificate is
+automatically assigned to that <code>user_id</code>.
+<p>
+<b><li>Order States</b>
+<p>
+Order states are discussed in detail in <a href="ecommerce-operation.html">Operation of the Ecommerce Module</a>.  That should be read to understand the
+concepts of order states and item states and to see the finite state machines
+involved.
+<p>
+Below is a very boring diagram of what order state the order should be in
+given the item state of the items in that order.  This diagram only
+covers the order states VOID, PARTIALLY_FULFILLED, FULFILLED, and
+RETURNED.  All other order states are grouped under OTHER.  In all other
+order states, the items are of a uniform item state,
+so it is either quite obvious what the order state will be or it is completely
+independent of what the order state will be.
+<p>
+An "X" in a column implies that there is at least one (possibly many) item
+in that item state.
+<p>
+<table border>
+<tr>
+<th colspan=4>Item State</th><th rowspan=2>Order State</th>
+<tr>
+<th>
+VOID
+</th>
+<th>
+RECEIVED_BACK
+</th>
+<th>
+SHIPPED
+</th>
+<th>
+OTHER
+</th>
+</tr>
+
+<tr>
+<td align=center>
+X
+</td>
+<td align=center>
+X
+</td>
+<td align=center>
+X
+</td>
+<td align=center>
+X
+</td>
+<td align=center>
+PARTIALLY_FULFILLED
+</td>
+</tr>
+
+<tr>
+<td align=center>
+X
+</td>
+<td align=center>
+X
+</td>
+<td align=center>
+X
+</td>
+<td align=center>
+0
+</td>
+<td align=center>
+FULFILLED
+</td>
+</tr>
+
+<tr>
+<td align=center>
+X
+</td>
+<td align=center>
+X
+</td>
+<td align=center>
+0
+</td>
+<td align=center>
+X
+</td>
+<td align=center>
+PARTIALLY_FULFILLED
+</td>
+</tr>
+
+<tr>
+<td align=center>
+X
+</td>
+<td align=center>
+X
+</td>
+<td align=center>
+0
+</td>
+<td align=center>
+0
+</td>
+<td align=center>
+RETURNED
+</td>
+</tr>
+
+<tr>
+<td align=center>
+X
+</td>
+<td align=center>
+0
+</td>
+<td align=center>
+X
+</td>
+<td align=center>
+X
+</td>
+<td align=center>
+PARTIALLY_FULFILLED
+</td>
+</tr>
+
+<tr>
+<td align=center>
+X
+</td>
+<td align=center>
+0
+</td>
+<td align=center>
+0
+</td>
+<td align=center>
+X
+</td>
+<td align=center>
+OTHER
+</td>
+</tr>
+
+<tr>
+<td align=center>
+X
+</td>
+<td align=center>
+0
+</td>
+<td align=center>
+0
+</td>
+<td align=center>
+0
+</td>
+<td align=center>
+VOID
+</td>
+</tr>
+
+
+<tr>
+<td align=center>
+0
+</td>
+<td align=center>
+X
+</td>
+<td align=center>
+X
+</td>
+<td align=center>
+X
+</td>
+<td align=center>
+PARTIALLY_FULFILLED
+</td>
+</tr>
+
+<tr>
+<td align=center>
+0
+</td>
+<td align=center>
+X
+</td>
+<td align=center>
+X
+</td>
+<td align=center>
+0
+</td>
+<td align=center>
+FULFILLED
+</td>
+</tr>
+
+<tr>
+<td align=center>
+0
+</td>
+<td align=center>
+X
+</td>
+<td align=center>
+0
+</td>
+<td align=center>
+X
+</td>
+<td align=center>
+PARTIALLY_FULFILLED
+</td>
+</tr>
+
+<tr>
+<td align=center>
+0
+</td>
+<td align=center>
+X
+</td>
+<td align=center>
+0
+</td>
+<td align=center>
+0
+</td>
+<td align=center>
+RETURNED
+</td>
+</tr>
+
+<tr>
+<td align=center>
+0
+</td>
+<td align=center>
+0
+</td>
+<td align=center>
+X
+</td>
+<td align=center>
+X
+</td>
+<td align=center>
+PARTIALLY_FULFILLED
+</td>
+</tr>
+
+<tr>
+<td align=center>
+0
+</td>
+<td align=center>
+0
+</td>
+<td align=center>
+0
+</td>
+<td align=center>
+X
+</td>
+<td align=center>
+OTHER
+</td>
+</tr>
+
+</table>
+
+<p>
+
+<b><li>Shopping Cart Definitions</b>
+<p>
+
+ <dl>
+ <dt>Shopping Cart</dt>
+ <dd>An IN_BASKET order with the same user_session_id as in the user's cookie.</dd>
+ <dt>Saved Cart</dt>
+ <dd>An IN_BASKET order with the user_id filled in, no user_session_id filled in, and saved_p='t'</dd>
+ <dt>Abandoned Cart</dt>
+ <dd>An IN_BASKET order with saved_p='f' and a user_session_id that doesn't correspond to the user_session_id in anyone's cookie (e.g. the user's cookie expired or they turned cookies off).  There's no way of determining whether a shopping cart has been abandoned.  These are different from expired orders which are automatically put into the order state EXPIRED if they're still IN_BASKET after N days, where N is set in the .ini file)
+ </dl>
+
+<p>
+<b><li>Credit Card Pre-Checking</b>
+<p> 
+Before credit card information is sent out to CyberCash for authorization,
+some checking is done by the module to make sure that the credit card
+number is well-formed (using the procedure <code>ec_creditcard_precheck</code> which can be found in /tcl/ecommerce-credit.tcl).  The procedure checks the length of the credit card number, makes sure
+it starts with the right digit for the card type, and does a LUHN-10
+check (that's a checksum which can't determine whether the number is a
+valid credit card number but which determines whether it's even <i>possible</i>
+for it to be a valid credit card number).
+<p>
+This procedure only encompasses the three most common credit card types:
+MasterCard, Visa, and American Express.  It can quite easily be extended
+to include other credit card types.
+<p>
+<b><li>Automatic Emails</b>
+<p>
+When you install the system, there are 7 automatic emails included that
+are sent to customers in common situations (e.g., "Thank you for your
+order" or "Your order has shipped").  If a site administrator adds a 
+new email template using the admin pages, you will have to create a
+new procedure that does all the variable substitution, the actual
+sending out of the email, etc.  This should be easy.  Just copy any
+one of the 7 autoemail procedures in /tcl/ecommerce-email.tcl (<i>except</i>
+for <code>ec_email_gift_certificate_recipient</code>, which is unusual).
+Then invoke your new procedure anywhere appropriate (e.g. the email that
+says "Thank you for your order" is invoked by calling
+<code>ec_email_new_order $order_id</code> after the order has been
+successfully authorized).
+<p>
+<b><li>Storage of Credit Card Numbers</b>
+<p>
+Credit card numbers are stored until an order is completely fulfilled.
+This is done because a new charge might need to be authorized if a
+partial shipment is made (we are forced to either capture the amount that
+a charge was authorized for or to capture nothing at all - we can't capture any
+amount in between; therefore, we are forced to do a new authorization
+for each amount we are going to charge the user).  A new charge also might
+need to be authorized if a user has asked the site administrator to add
+an item to their order.
+<p>
+If you've decided not to allow customers to reuse their credit cards,
+their credit card data is removed periodically (a few times a day) by
+<code>ec_remove_creditcard_data</code> in
+/tcl/ecommerce-scheduled-procs.tcl (it removes credit card numbers for
+orders that are FULFILLED, RETURNED, VOID, or EXPIRED).
+<p>
+If you've decided to allow customers to reuse their credit cards, their
+credit card information is stored indefinitely.  This is not recommended
+unless you have top-notch, full-time, security-minded system administrators.
+The credit card numbers are not encrypted in the database because there
+isn't much point in doing so; our software would have to decrypt the 
+numbers anyway in order to pass them off to CyberCash, so it would be
+completely trivial for anyone who breaks into the machine to grep for
+the little bit of code that decrypts them.  The ideal thing would be
+if CyberCash were willing to develop a system that uses PGP so that we
+could encrypt credit card numbers immediately, store them, and send them
+to CyberCash at will.  <i>Philip and Alex's Guide to Web Publishing</i> says:
+
+<blockquote>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;What would plug this last hole is for CyberCash to give us a public key. We'd encrypt the consumer's card
+number immediately upon receipt and stuff it into our Oracle database. Then if we needed to retry an
+authorization, we'd simply send CyberCash a message with the encrypted card number. They would decrypt the
+card number with their private key and process the transaction normally. If a cracker broke into our server, the
+handful of credit card numbers in our database would be unreadable without Cybercash's private key. The same
+sort of architecture would let us do reorders or returns six months after an order. <br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;CyberCash has "no plans" to do anything like this. 
+</blockquote>
+Note 1: If you or the company you work for are very powerful or
+influential, perhaps you can put a little fire under CyberCash's bum
+to get them to make that change (Levi's couldn't convince CyberCash
+when we were doing a project for them).  It's not like it would be
+that hard for CyberCash to implement it.
+<p>
+Note 2: The above discussion <i>does not</i> mean that the credit
+card numbers go over the network unencrypted.  CyberCash's closed-source
+software on your machine encrypts the numbers immediately before sending them out.
+<p>
+Note 3: If you want to let your customers reuse their old credit cards,
+you can reduce some of the risk by manually removing old credit card data
+once in a while (at least then there will be fewer numbers in your database for
+the crackers to steal).  To clear out the unnecessary credit card data, just 
+run a procedure like <code>ec_remove_creditcard_data</code> (in
+/tcl/ecommerce-scheduled-procs.tcl) but get rid of the if statement that
+checks whether <code>SaveCreditCardDataP</code> is 0 or 1.
+<p>
+<b><li>Price Calculation</b>
+<p>
+The site administrator can give the same product different prices for 
+different classes of users.  They can also put products on sale over
+arbitrary periods of time (sale prices may be available to all 
+customers or only to ones who have the appropriate <code>offer_code</code>
+in their URL).  
+<p>
+The procedure <code>ec_lowest_price_and_price_name_for_an_item</code> in /tcl/ecommerce-money-computations.tcl determines the lowest price that a given user
+is entitled to receive based on what user classes they're in and what
+<code>offer_code</code>s they came to product.tcl with.  Their <code>offer_code</code>s are stored, along with their <code>user_session_id</code>, in
+<code>ec_user_session_offer_codes</code> (we decided to store this in 
+the database instead of in cookies because it was a slightly more efficient
+method, although either implementation would have worked).  One minor
+complication to this is that if a user saves their shopping cart, we want
+them to get their special offer price, even though they may be coming
+back with a different <code>user_session_id</code>; therefore, upon retrieving saved
+carts, the <code>offer_code</code>s are inserted again into
+<code>ec_user_session_offer_codes</code> with the user's current 
+<code>user_session_id</code> (we had to associate <code>offer_code</code>s
+with <code>user_session_id</code> as opposed to <code>user_id</code>
+because someone with an <code>offer_code</code> shouldn't be prevented
+from seeing the special offer price if they haven't logged in yet).
+</ul>
+
+The above items are just things that I've found myself explaining to
+others or things that I think will be useful for people extending
+this module.  Obviously the bulk of the module's code has not been
+discussed here. If you have any questions, please email me at
+<a href="mailto:eveander@arsdigita.com">eveander@arsdigita.com</a>
+and I will be happy to help you.
+
+<hr>
+<a href="mailto:eveander@arsdigita.com"><address>eveander@arsdigita.com</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/ecommerce.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/ecommerce.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/ecommerce.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,63 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Ecommerce Module</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Ecommerce Subsystem</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://eve.arsdigita.com/">Eve Andersson</a>
+
+<hr>
+
+This module implements all the IT needs for a standard
+business-to-consumer Web service.  Most importantly, it is tightly
+integrated with the rest of the ArsDigita Community System.  This
+enables the site administrator to run a single Oracle query to "find
+users who have participated in the discussion forum on at least ten
+separate occasions but who have not bought anything yet", then spam
+those folks with gift certificates. 
+
+<p>
+
+In addition to the standard shopping cart and real-time credit card billing
+that you'd expect in any ecommerce system, this module provides a customer
+service submodule (call center support), security, user tracking,
+gift certificates, mailing lists, an auditing system, order fulfillment,
+order tracking, special offers, and online reporting, among other features
+detailed in the overview below.
+
+
+<ol>
+<li>Two overviews:  <a href="ecommerce-for-mbas.html">for MBAs</a> | <a href="ecommerce-features.html">feature-by-feature</a>
+<li><a href="ecommerce-setup.html">Setting up your ecommerce site</a>
+<li><a href="ecommerce-operation.html">Operation of your ecommerce site</a>
+<li><a href="ecommerce-customer-service.html">The Customer Service submodule</a>
+<li><a href="ecommerce-technical.html">Technical details</a>
+</ol>
+
+<blockquote>
+<font size=-2 face="verdana, arial, helvetica">
+
+If you just want to sell a handful of items and not build a full online
+community, you're probably better off starting with ArsDigita Shoppe,
+downloadable from 
+<a
+href="http://arsdigita.com/free-tools/shoppe.html">http://arsdigita.com/free-tools/shoppe.html</a>.
+If what you want to sell is conference or course registration, we'll be
+adding those features to the ACS soon but meanwhile we do have the
+source code for <a
+href="http://register.photo.net/">register.photo.net</a>.  This code has
+been used to process thousands of course and marathon registrations. 
+
+</font>
+</blockquote>
+
+
+<hr>
+<a href="mailto:eveander@arsdigita.com"><address>eveander@arsdigita.com</address></a>
+</body>
+</html>
+
Index: web/openacs/www/doc/education-features.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/education-features.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/education-features.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,279 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Education Module</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+
+<h2>Features</h2>
+
+of the <a href="education.html">Education Module</a> 
+by <a href="http://web.mit.edu/randyg/www/">Randy Graebner</a>
+and <a href="mailto:aileen@mit.edu">Aileen Tang</a>
+
+<hr>
+<blockquote>
+
+Some of the high level features of the Education Module:
+
+<p>
+
+<b>Course Management</b>
+<ul>
+
+<p>
+
+<li>Using simple web forms professors can create and administer a
+class without using any HTML.
+
+<p>
+
+<li>Course administrators can make course materials avialable to
+students simply by uploading files.
+
+<p>
+
+<li>Course administrators can grade student homework online, providing
+comments and feedback that the students can see.  In addition, all of
+the graders will be able to input their information into a shared
+grade book thus allowing for automatic grade calculations and
+histograms.
+
+<p>
+
+<li>Permissions can be selectively set the permissions for the
+administration pages.  Thus, a professor can give Teaching Assistants
+permission to add and remove students from the class but not grade the
+assignments.
+
+<p>
+
+<li>Students can self enroll in the class and the professor has the
+ability to limit enrollment or make a class private so that only users
+enrolled in the class can see the class pages and assignments.
+
+<p>
+
+<li>Course administrators can email the only the teaching staff or
+everyone in the class.  All of these emails are archived so that they
+may be references later.
+
+<p>
+
+<li>Every class can have multiple bulletin boards and news sections
+using the build in functionality provided by the ArsDigita Community
+System.
+
+<p>
+
+<li>Classes can be broken down into sections (recitations) and teams.
+These subgroups of can then have their own threaded discussion forums
+and chat rooms.
+
+<p>
+
+<li>Teams can be assigned to projects and can submit progress reports.
+In addition, course administrators can submit team evaluations into
+the grading system.
+
+</ul>
+
+<p>
+
+<b>Departments</b>
+<ul>
+<p>
+<li>Departments can easily create and display a course catalog to
+students and faculty alike.  
+
+<p>
+
+<li>Department administrators
+
+Aggregated course
+         enrollment, course
+         announcements,
+         grades, and course
+         conten
+Personal Tools
+         Editor (Tasks,
+         Calendar,
+         Contacts, etc.)
+
+Course Cataloging
+</ul>
+
+<p>
+
+<b>Personalization</b>
+<ul>
+
+<p>
+
+<li>Users can keep the personal events in the system using the
+calendar, provided as part of the portals system. The calendar allows
+users to enter personal information that will appear on the same
+calendar that contains all of the important datas for all of the
+classes for which the user is subscribed.
+
+<p>
+
+<li>When viewing past assignments, students will see their grades and
+comments left by the grader, if the grader selects the "show student"
+option when filling out the grading form.
+
+<p>
+
+<li>When users log in, they see their customizable portal page.  This
+page is customizable so users can view information about all of their
+classes on the same front page.  This page provides the user with
+easy access to information about their classes as well as important
+information relating the the institute.  
+
+<p>
+
+<li>Users with different roles within the system can be given
+different views of the system.  For instance, when a student logs in
+they will see news about thier classes but when an administrator logs
+in they will see information about when the next faculty meeting is.
+
+</ul>
+
+<b>Community</b>
+<ul>
+
+<li>The teaching staff can privately share documents among themselves
+for review before allowing students to see the document.  This allows
+professors to collaboratively go through many drafts of an assignment
+or its solutions before allowing the studnet to view it.
+
+<p>
+
+<li>The Bulletin Boards and Chat rooms have been set up so that each
+class and recitation can have their own instance.  So, recitations can
+hold discussions on their own bulletin board and entire classes can
+share the chat room to collaborate on assignments or study for tests.
+
+<p>
+
+<li>Users can easily be emailed based on their role within the system.
+For instance, a professor can email the teaching staff or an entire
+class.  Or, the department can email all students taking a class
+within the department.
+
+<p>
+
+<li>Most importantly, since the Education Module is tied in with the
+rest of the ArsDigita Community System, where a more complete view of
+the user can be seen.  For instance, it is possible to view all public
+postings to bulletin boards by a particular user.  In addition, the
+user can make themselves known to other uses by doing anything from
+uploading a picture of themselves into their user profile to creating
+their own personl homepage using the homepage module.
+
+</ul>
+
+<p>
+
+<b>Other</b>
+<ul>
+<li>Auditing of data so you can see:
+    <ul>
+    <li>who made the changes 
+    <li>when the changes were made 
+    <li>what changed 
+    <li>the history of all states the data have been in (so your data are never lost) 
+    </ul>
+</li>
+</ul>
+
+<p>
+
+<b>What's Coming in Future Versions</b>
+<ul>
+
+<li>Multi roled departments so that administrators can easily manage
+their members by lumping them into groups such as secreatries,
+professors, students, and alumni.
+
+<p>
+
+<li>The ability to easily browse and search through classes and subjects.
+
+<p>
+
+<li>Using simple forms, the class administrator will be able to upload
+desired information about students into the Oracle database.  In
+addition, department administrators will be able to perform bulk
+upload of the classes offered during the coming semesters.
+
+<p>
+
+<li>Ability to download the personalized calendar into a palm pilot.
+
+<p>
+
+<li>Ability for professors to upload their own custom HTML pages that
+will interact with the current system (right now, they prof can use
+the homepage module to do this but we would like to provide an easy
+way to tie the two modules together).
+
+<p>
+
+<li>Students and professors alike can search through uploaded course
+material including handouts and presentation.
+
+<p>
+
+<li>Ability for students to privately annotate course material.
+
+<p>
+
+<li>The ability for professors to upload graphics to give each page a
+custom look and feel for the class.
+
+<p>
+
+<li>we hope to tie this module in with the home pages and wimpy point
+modules thus allowing students to create their home page within the
+system as well as allowing professors to link lecture notes directly
+to wimpy point presentations.
+
+<p>
+
+<li>Integration with the <a href="homepage.html">homepage</a> module
+so that students and professors can create personal home pages.  In
+addition, this will provide more freedom for professors when creating
+their class homepage.
+
+<p>
+
+<li>Integration with <a href="wp.html">wimpy point</a> so that
+professors can easily create lectures online.
+
+<p>
+
+<li>Very distant future - the ability to administer exams online.
+
+<p>
+
+<li> and much, much more...if you have any suggestions, please email
+them to us at the addresses below.
+
+</ul>
+
+</blockquote>
+<hr>
+<i>randyg@arsdigita.com</i>,
+<i>aileen@mit.edu</i>
+</body>
+</html>
+
+
+
+
+
+
+
+
Index: web/openacs/www/doc/education.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/education.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/education.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,89 @@
+<html>
+<head>
+<title>Education Module</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+
+<h2>Education Subsystem</h2>
+
+part of the 
+<a href="http://photo.net/doc/index.tcl">ArsDigita Community System</a>
+by 
+<a href="http://web.mit.edu/randyg/www/">Randy Graebner</a>
+and 
+<a href="mailto:aileen@mit.edu">Aileen Tang</a>
+
+<hr>
+
+Note: This module and documentation are not yet complete.  We are
+releasing it so that people may know what is currently available and
+what is coming.  We hope to be making significant improvements to this
+module over the next several incremental releases.  We encourage all
+forms of feedback.  If there are any features that are not currently
+in the system but you would like to see, please feel free to request
+them.
+
+<blockquote>
+
+This module implements all the IT needs for a department or university
+to organize and administer all of its classes online. Most
+importantly, it is tightly integrated with the rest of the ArsDigita
+Community System. This enables the site administrator to run a single
+Oracle query to "find all users who have taken classes A, B, and C",
+then spam them asking if anyone wants to TA a new course.  Or, they can
+say "find all students in danger of failing a class", then notify them
+of the situation.
+
+<p>
+
+In addition to the standard <a href="bboard.html">bulletin board</a>
+and <a href="chat.html">chat room</a> you would expect in any online
+educational system, this provides administrators with the ability to
+see all information about any student or any group of students at any
+given time.  The system provides online homework submission and
+grading, automated grade calculation, and the ability to easily
+monitor students' performance and participation.  In addition, it
+enables instructors to create and manage course Web sites without
+having to know HTML or other programming languages.
+
+<p>
+
+The system provides the student with the ability to view all of their
+classes and assignments on an integrated schedule.  In addition, it
+allows students to easily build a portfolio of their work across
+classes.  Students can customize their calendars and work space using
+extra tables for the <a href="portals.html">portal system</a>.
+
+<p>
+
+Department administrators can collect statistics about classes they
+are offering as well as view information about the students taking
+those classes.  
+
+<p>
+
+The education moudle offers these featurs in addition to many other
+features detailed in the overview below.
+
+<ol>
+<li><a href="education-features.html">Feature-by-feature overview</a>
+<li>Setting up your university
+<li>Operation of your university
+<li>Technical details (for now, you can view the <a href="sql/education.sql">data model</a>)
+
+</ol>
+
+</blockquote>
+<hr>
+<i>randyg@arsdigita.com</i>,
+<i>aileen@mit.edu</i>
+</body>
+</html>
+
+<!--
+Mention that the permissions for files are hierarchical depending on the sort key
+<p>
+Also mention that performance will be pathetic on pages the reference fs_files because of the 
+user_had_row_permission_p function can cause a full table scan.
+-->
Index: web/openacs/www/doc/email-handler.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/email-handler.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/email-handler.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,140 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Email Handler</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+
+<h2>Email Handler</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://hqm.ne.mediaone.net">Henry Minsky</a>
+
+<hr>
+
+<ul>
+<li>User-accessible directory:  none
+<li>Site administrator directory: not currently available
+<li>data model :  <a href="/doc/sql/display-sql.tcl?url=/doc/sql/email-handler.sql">/doc/sql/email-handler.sql</a>
+
+<li>Tcl procs:  /tcl/email-handler.tcl
+<li>Perl procmail script:  <a href="queue-message.pl.txt">/bin/queue-message.pl</a>
+
+</ul>
+
+System dependencies:  you will be in a world of hurt unless you have
+Perl DBI/DBD installed (so that a Perl script on your computer can talk
+to Oracle) and a mailer configured to exec a procedure when mail arrives
+addressed to a particular alias.
+
+<h3>The Big Picture</h3>
+
+You can build a gateway for handling incoming email messages for your application
+using a perl-script called <code>queue-message.pl</code>. <code>queue-message.pl</code> will accept an incoming email message from the mailer and insert its contents into a queue
+table in the database. A procedure can be scheduled to sweep the queue at 
+some interval to process the messages.
+<p>
+<h3>Using the <code>queue-message.pl</code> script</h3>
+
+The script takes a list of command-line arguments, which tell it
+which database to connect to, and a classification tag for the message.
+<p>
+<pre>
+  usage: queue_message.pl db_datasrc db_user db_passwd destaddr
+
+  Inserts the data from stdin into a queue table.
+
+  Assumes the following table and sequence are defined in the db:
+
+    create table incoming_email_queue (
+	    id 		integer primary key,
+	    destaddr	varchar(256),
+	    content		clob,		-- the entire raw message content
+					    -- including all headers
+	    arrival_time	date
+    );
+
+    create sequence incoming_email_queue_sequence;
+
+</pre>
+
+The <code>destaddr</code> field is a string tag which you can assign
+to a message, so that the routine which sweeps the queue can distinguish where
+it came from. You might use this if you had several different mail recipient aliases
+on your system, which all accept messages and put the into the queue.
+<p>
+
+To configure your mailer, you must add a mailer alias which invokes 
+the script. For sendmail, this would be done in the aliases file. For qmail,
+you create a file in the <code>qmail/alias</code> directory with a name
+<code>.qmail-<i>your-alias-here</i></code>.
+ <p>
+Example: You are setting up an email handler for user feedback messages.
+<pre>
+.qmail-ticket-handler:
+|/web/yourwebserver/bin/queue-message.pl dbi:Oracle: yourdbuser yourdbpassword user_feedback
+</pre>
+
+The alias above specified that incoming messages will be piped to the perl script, which will connect to the specified database, and will insert the message with the tag "user_feedback".
+<p>
+
+
+Some guidelines: Try to sure that the <i>from</i> and <i>reply-to</i>
+headers on your outgoing message are <b>not</b> the same as your
+incoming mail handler alias. This will help prevent the possibility of
+nasty mailer loops, in the case where messages may bounce or be returned
+for some reason.
+
+<h3>Scheduled Procedures and Parsing Mail Messages</h3>
+
+The procmail Perl script doesn't do anything except fill 
+the <code>incoming_email_queue</code> Oracle table.  So
+the file <code>/tcl/email-queue.tcl</code> schedules
+the Tcl procedure <code> process_email_queue</code>
+to sweep the queue, and will dispatch on each message tag to a procedure
+which you specify in the email-handler section of ad.ini.
+
+<blockquote>
+<pre>
+[ns/server/photonet/acs/email-queue]
+QueueSweepInterval=300
+; what to do with a new message
+; format is tag|tcl_proc_to_invoke
+DispatchPair=na-support|ticket_process_message
+</pre>
+</blockquote>
+
+
+The example above specifies that tickets with the tag "na-support" will
+be passed to the procedure <code>ticket_process_message</code>.
+The Tcl procedure invoked by the dispatcher is passed two arguments: 
+a database connection,
+and the raw message text. It is up to you to parse or handle the message
+in any way you wish. After the call to your dispatch procedure, the message is
+deleted from the queue.
+
+<h3>Email Handling Utilities</h3>
+Some routines in <code>/tcl/email-utils.tcl</code> will help you
+parse the raw mail message contents in the db. 
+<dl>
+<dt><code>parse_email_message <i>message_body</i></code>
+<dd>returns an ns_set mapping each mail header to its value, as well as
+a key named <i>message_body</i> which contains the message body text.
+<dt> clean_up_html <i>html_text</i>
+<dd> Returns the html_text with all HTML escape characters quoted properly.
+</dl>
+
+<h3>Tips for Oracle 8i Achievers</h3>
+
+Oracle 8i (8.1.5 and later) includes a Java virtual machine.  You are
+thus able to load up a Java email parsing library that will take apart
+the messages in a queue very nicely (presumably more robustly than the
+Tcl kludges in email-utils.tcl).
+
+<hr>
+<a href="mailto:hqm@arsdigita.com">hqm@arsdigita.com</address></a>
+
+
+</body>
+</html>
Index: web/openacs/www/doc/events.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/events.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/events.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,314 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Events Module</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Events</h2>
+
+part of the <a href="/doc/index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a> and Bryan Che
+
+<hr>
+
+<ul>
+<li>User-accessible directory:  <a href="/events/">/events/</a>
+<li>Administrator directory:  <a href="/events/admin/">/events/admin/</a>
+<li>data model :  <a href="/doc/sql/display-sql.tcl?url=/doc/sql/events.sql">/doc/sql/events.sql</a>
+<li>Tcl procs:  /tcl/events-defs.tcl 
+
+</ul>
+
+<h3>The Big Idea</h3>
+
+<p>
+Organizations often present events, such as a lecture series or a social
+gathering.  This software module gives organizations a way to register
+people for events online.
+
+
+<h3>The Medium-sized Idea</h3>
+
+<p>
+Organizations often have a number of set events which they like to
+repeat.  For example, a company may have a certain presentation which it
+makes over and over.  A photoraphy club may hold monthly outings.  A
+marathon race could occur annually.  Therefore, we organize events in
+the following way:
+
+<p>
+Each organization has a series of <i>activities</i> that it holds.  An
+<i>event</i> is a particular instance of an activity--it is the actual
+occurance of an activity.  Each event has an organizer and takes place
+in a physical location and during a certain time.  For example, a
+software company might hold a series of talks as activities:
+<table cellpadding=5>
+<tr align=left><th>Company Talks</th></table>
+<ul>
+ <li>Why you should think our software is the best
+ <li>Why you should do things our way
+ <li>Why the Government should leave us alone and let us innovate
+</ul>
+<p>
+That software company could then present these talks as lecture events:
+<p>
+<table cellpadding=5>
+<tr align=left>
+ <th>Talk (Activity)
+ <th>Lecture Speaker (Event organizer)
+ <th>Lecture Date
+<tr align=left>
+ <td>Why you should think our software is the best
+ <td>billy
+ <td>05-07-2000
+<tr align=left>
+ <td>Why you should think our software is the best
+ <td>stevie
+ <td>08-29-2000
+<tr align=left>
+ <td>Why the Government should leave us alone and let us innovate
+ <td>billy
+ <td>09-10-2000
+</table>
+
+<p>
+Organizations that organize their events using this convention may
+then fully administer and register those events online using this
+module.  
+
+<h3>The Fine-details</h3>
+
+<h4>Activities</h4>
+
+<p>
+An organization is not necessarily an entire company--it can be a
+company department or office or project or any other group of people.
+Therefore, activities are owned by ACS user groups.  Each user group
+represents an organization of people.  An activity also has a creator, a
+name, a description, and a flag indicating if it is available.  Finally,
+an activity can link to a url for more information:
+
+<pre>
+create table events_activities (
+	activity_id	integer primary key,
+	-- activities are owned by user groups
+	group_id	integer references user_groups,
+	user_id		integer references users,
+        creator_id      integer not null references users,
+	short_name	varchar(100) not null,
+	default_price   number default 0 not null,
+	currency	char(3) default 'USD',
+	description	clob,
+        -- Is this activity occurring? If not, we can't assign
+        -- any new events to it.
+        available_p	char(1) default 't' check (available_p in ('t', 'f')),
+        deleted_p	char(1) default 'f' check (deleted_p in ('t', 'f')),
+        detail_url 	varchar(256) -- URL for more details,
+);
+</pre>
+
+<h4>Events</h4>
+<p>
+For each event, we need to track its organizers, its location, and its
+time.  We define the organizers' roles and their responsibilities.  We
+also store extra information that might pertain to that specific event,
+such as refreshemnts or audio/visual information.  In addition, we store
+of which activity this event is an instance.
+
+<pre>
+create table events_events (
+        event_id              integer not null primary key,
+        activity_id	      integer not null references events_activities,
+	venue_id	      integer not null references events_venues,
+	-- the user group that is created for this event's registrants
+	group_id	      integer not null references user_groups,
+	creator_id	      integer not null references users,
+        -- HTML to be displayed after a successful order.
+        display_after         varchar(4000),
+        -- Date and time.
+        start_time            date not null,
+        end_time              date not null,
+	reg_deadline	      date not null,
+        -- An event may have been cancelled.
+        available_p	      char(1) default 't' check (available_p in ('t', 'f')),	
+        deleted_p	      char(1) default 'f' check (deleted_p in ('t', 'f')),
+        max_people	      number,
+	-- can someone cancel his registration?		
+	reg_cancellable_p     char(1) default 't' check (reg_cancellable_p in ('t', 'f')),
+	-- does a registration need approval to become finalized?
+	reg_needs_approval_p  char(1) default 'f' check (reg_needs_approval_p in ('t', 'f')),
+	-- notes for doing av setup
+	av_note		      clob,
+	-- notes for catering
+	refreshments_note     clob,
+	-- extra info about this event
+	additional_note	      clob,
+	-- besides the web, is there another way to register?
+	alternative_reg	      clob,
+        check (start_time < end_time),
+	check (reg_deadline <= start_time)
+);
+
+-- where the events occur
+create table events_venues (
+       venue_id		  integer primary key,
+       venue_name	  varchar(200) not null,
+       address1		  varchar(100),
+       address2		  varchar(100),
+       city		  varchar(100) not null,
+       usps_abbrev	  char(2),
+       postal_code	  varchar(20),
+       iso		  char(2) default 'us' references country_codes,
+       time_zone	  varchar(50),
+       needs_reserve_p	  char(1) default 'f' check (needs_reserve_p in ('t', 'f')),
+       max_people	  number,	
+       description	  clob
+);
+
+</pre>
+
+<p>
+This data model also contains extensions for selling admission to
+events, althought the tcl pages do not currently implement this feature.
+These extensions can tie in with the 
+<a href="/doc/ecommerce.html">ecommerce module</a>.  
+
+<pre>
+create table events_prices (
+    price_id            integer primary key,
+    event_id            integer not null references events_events,
+    -- e.g., "Developer", "Student"
+    description         varchar(100) not null,
+    -- we also store the price here too in case someone doesn't want
+    -- to use the ecommerce module but still wants to have prices
+    price		number not null,
+    -- This is for hooking up to ecommerce.	
+    -- Each product is a different price for this event.  For example,
+    -- student price and normal price products for an event.
+--  product_id          integer references ec_products,
+    -- prices may be different for early, normal, late, on-site
+    -- admission,
+    -- depending on the date
+    expire_date	      date not null,
+    available_date    date not null
+);
+
+</pre>
+
+<p>
+
+
+<h4>Organizers</h4> 
+
+Each event should have at least one organizer.  Organizer are the people
+responsible for various aspects of a particular event.  For example, a
+lecture's organizers might be its speaker, the person in charge of
+audio/visual equipment, and the person in charge of catering.
+
+<pre>
+create table events_organizers_map (
+       event_id		      integer not null references events_events,  
+       user_id		      integer not null references users,
+       role		      varchar(200) default 'organizer' not null,
+       responsibilities	      clob
+);
+</pre>
+
+<h4>Registrations</h4>
+For each person who registers for an event, we record a bunch of
+information.  This helps the organizations understand who is coming to
+their events and why.  It also helps the organization accomodate its
+attendees' needs and group them together.
+
+<p>
+We organize registrations in the following way: a <i>registration</i>
+represents a person who has expressed interest in attending the event.
+There is one registration for each person who wants to attend.
+Registrations can have different states.  For example, a registration
+may be wait-listed because there are already too many registrations for
+a particular event.  Or, a registration may be canceled.
+<p>
+An <i>order</i> is a set of registrations.  Typically, when a person
+registers himself for an event, he will create one order containing his
+single registration.  But, there may be an individual who wishes to
+register multiple people at once.  In that case, the individual would
+make one order containing multiple registrations.  Thus, this data
+model allows people to make multiple registrations.  The tcl pages do
+not yet implement this feature, though.
+
+<pre>
+create table events_orders (
+       order_id		integer not null primary key,
+--       ec_order_id	integer references ec_orders,
+       -- the person who made the order
+       user_id		integer not null references users,
+       paid_p		char(1) default null check (paid_p in ('t', 'f', null)),
+	payment_method	varchar(50),
+	confirmed_date	date,
+	price_charged	number,
+	-- the date this registration was refunded, if it was refunded
+	refunded_date	date,
+	price_refunded	number,	
+       	ip_address	varchar(50) not null
+);
+
+create table events_registrations(
+        -- Goes into table at confirmation time:
+	reg_id		integer not null primary key,
+	order_id	integer not null references events_orders,
+	price_id	integer not null references events_prices,
+	-- the person registered for this reg_id (may not be the person
+	-- who made the order)
+	user_id		integer not null references users,
+	-- reg_states: pending, shipped, canceled, refunded
+	--pending: waiting for approval
+	--shipped: registration all set 
+	--canceled: registration canceled
+	--waiting: registration is wait-listed
+	reg_state	varchar(50) not null check (reg_state in ('pending', 'shipped', 'canceled',  'waiting')),
+	-- when the registration was made
+	reg_date	date,
+	-- when the registration was shipped
+	shipped_date	date,
+	org		varchar(4000),
+	title_at_org	varchar(4000),
+	attending_reason  clob,
+	where_heard	varchar(4000),
+	-- does this person need a hotel?
+        need_hotel_p	char(1) default 'f' check (need_hotel_p in ('t', 'f')),
+	-- does this person need a rental car?
+        need_car_p	char(1) default 'f' check (need_car_p in ('t', 'f')),
+	-- does this person need airfare?
+	need_plane_p	char(1) default 'f' check (need_plane_p in ('t', 'f')),
+	comments	clob
+);
+
+</pre>
+
+<h3>Using Events</h3> 
+
+<p>
+With the events module, organizations can create, edit, and remove
+activities.  They can do the same to events and organizers.  Thus,
+organizations can fully describe and advertise any activity event
+online.
+
+<p>
+Organizations can also obtain information about who is coming to their
+events and spam those attendees.  They can review order histories to see
+how many people registered for a given event and why they came.  In
+addition, they can view order statistics by activity, month, date, and
+order state.  Finally, they can spam their own organizers to remind them
+about their upcoming events.
+
+<p>
+People coming to register online at a site using this module will be
+able to find upcoming activity events and sign up for them.
+
+<p>
+<hr>
+<address><a href="mailto:bryanche@arsdigita.com">bryanche@arsdigita.com</a></address>
+
+</body>
+</html>
Index: web/openacs/www/doc/faq.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/faq.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/faq.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,134 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>FAQ System</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>FAQ System</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="mailto:dh@arsdigita.com">David Hill</a>
+
+<hr>
+
+<ul>
+<li>User directory:  <a href="/faq/">/faq/</a>
+<li>Site Administrator directory:  <a href="/admin/faq/">/admin/faq/</a>
+<li>Per-FAQ Administration directory:  <a href="/faq/admin/">/faq/admin/</a>
+<li>data model:  <a href="/doc/sql/display-sql.tcl?url=/doc/sql/faq.sql">/doc/sql/faq.sql</a> (also see subsection within) 
+<li>procedures:  in tcl/faq-defs.tcl
+
+</ul>
+
+<h3>The Big Picture</h3>
+
+Many sites have a page or series of pages to answer Frequently Asked Questions (FAQ).  We want a simple interface for creating and maintaining FAQs in which the work of FAQ maintainance may be shared by specific people.  A given FAQ can be either puplic and viewed by everyone or restricted so that only  members of a given group may see the FAQ.  
+<P>
+This kind of system is inherently different from the BBoard system in that there are two distinct types of users - those that can only read the FAQ and those who may contribute questions and answers. 
+
+<h3>The Medium-Sized Picture</h3>
+
+This system consists of only two simple tables. And for FAQ maintainance the new group and scoping system is used.
+<P>
+The properties of a FAQ are held in the faqs table: These properties are the name of the faq and who can see the FAQ.
+
+<blockquote>
+<pre>
+create table faqs (
+	faq_id		integer primary key,
+	-- name of the FAQ.
+	faq_name	varchar(250) not null,
+	-- group the viewing may be restriced to 
+	group_id	integer references user_groups,
+	-- permissions can be expanded to be more complex later
+        scope		varchar(20),
+        -- insure consistant state 
+       	constraint faq_scope_check check ((scope='group' and group_id is not null) 
+                                          or (scope='public'))
+);
+</pre>
+</blockquote>
+
+<P>
+The body of a FAQ (questions and answers) are held in the faq_q_and_a table.
+
+<blockquote>
+<pre>
+create table faq_q_and_a (
+	entry_id	integer primary key,
+	-- which FAQ
+	faq_id		integer references faqs not null,
+	question	varchar(4000) not null,
+	answer		varchar(4000) not null,
+        -- determines the order of questions in a FAQ
+	sort_key	integer not null
+);
+</pre>
+</blockquote> 
+
+<h3>Legal Transactions</h3>
+From the Site Administration pages at <a href="/admin/faq">/admin/faq</a> the site-wide administrator can 
+<ul>
+<li>Create a new FAQ: insert a new row in the table faqs 
+<li>Edit the properties of a faq: update a row in the table faqs
+<li>Delete a faq: delete from faq_q_and_a where faq_id=**faq_id** then delete from faqs where faq_id = **faq_id**
+<li>Assign group **X** to the FAQ: The FAQ system must be associated 
+with the group_type for group **X**.  An administrator for group **X** will
+be able to administer the FAQ and only members of group **X** will be able to
+view the FAQ. 
+</ul>
+<P>
+From the Maintainers admin pages at <a href="/faq/admin">/faq/admin</a> or 
+/groups/admin/**X**/faq/ the FAQ maintainers can
+<ul>
+<li>Add a FAQ (for this group)
+<li>Edit a FAQ (for this group)
+<li>Delete a FAQ (for this group)
+<li>Add content to a FAQ: insert a new row in faq_q_and_a
+<li>Edit content in a FAQ: update a row in faq_q_and_a
+<li>Reorder content in a FAQ: update sort_keys in faq_q_and_a
+<li>Delete content from a FAQ: delete a row from faq_q_and_a
+</ul> 
+
+<h3>Acceptance Test</h3>
+<ul>
+<li>As site-wide admin:
+<ul>
+ <li>Go to /admin/faq/ 
+ <li>Create a public FAQ
+ <li>Create a private FAQ for Group X
+ <ul>
+  <li>Visit /admin/ug/index.tcl and make sure that the group_type of which group X is a member is associated with the FAQ module.
+ </ul>
+ <li>Visit /faq/ and click on the public faq
+ <li>Click on Maintain this FAQ 
+ <li>Add questions, edit questions, swap questions, insert after..
+ <li>Edit the FAQ name
+</ul>
+<li>As a simple user: 
+ <ul>
+ <li>Go to /faq/
+ <li>Visit the public FAQ
+ </ul>
+<li>As an administrator for Group X
+ <ul>
+ <li>Visit /groups/X/faq/
+ <li>Perform the same tests on the private FAQ that you did on the public one
+ </ul> 
+</ul>
+<h3>Future Improvements</h3>
+<ul>
+<li>The ablility to have questions and answers appear on separate pages, so that one-faq.tcl could just be the list of questions that each link to a page with just the one question (repeated) and the answer on it.  This would be necessary for a very large faq. The current faq page just uses anchors to link to questions.
+
+<li>Currently all questions and answers are assumed to be html when posted by a faq maintainer, the option of html/text would be nice here.
+
+<li>A restorable audit trail of changes made to a FAQ would also be nice
+</ul>  
+
+<hr>
+
+<a href=mailto:dh@arsdigita.com><address>dh@arsdigita.com</address></a>
+</body>
+</html>
+
Index: web/openacs/www/doc/file-storage.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/file-storage.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/file-storage.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,184 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Community File Storage System</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Community File Storage System</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="mailto:dh@caltech.edu">David Hill</a> and  <a href="http://aure.com/">Aurelius Prochazka</a>
+
+<hr>
+
+<ul>
+<li> User-accessible directory: <a href="/file-storage/">/file-storage/</a>
+<li> Site adminstrator directory: <a href="/admin/file-storage/">/admin/file-storage/</a> (must use https://)
+<li> data model: <a href="/doc/sql/display-sql?url=/doc/sql/file-storage.sql">/doc/sql/file-storage.sql</a>
+<li> procedures: /tcl/file-storage-defs.tcl
+</ul>
+
+<h3>The big picture</h3>
+
+Suppose that a bunch of people need to collaboratively maintain a set of
+documents.  These documents need to be organized in some way but you
+don't want to require the contributors to learn HTML or filter all
+emplacements of files through a Webmaster.
+
+<p>
+
+If you simply give everyone FTP access to a Web-accessible directory,
+you are running some big security risks.  FTP is insecure and passwords
+are transmitted in the clear.  A cracker might sniff a password, upload
+.pl, .tcl, and .adp pages, then grab those URLs from a Web browser.  The
+cracker is now executing arbitrary code on your server with all the
+privileges that you've given your Web server.
+
+<p>
+
+This system allows users to save their files on our server so that they
+may:
+
+<ul>
+   <li> Organize files in a hierarchical directory structure
+   <li> Upload using Web forms, using the file-upload feature of Web
+        browsers (potentially SSL-encrypted)
+   <li> Grab files that are served bit-for-bit by the server, without
+        any risk that a cracker-uploaded file will be executed as code
+   <li>	Retrieve historical versions of a file
+</ul>
+
+
+<h3>Parameters</h3>
+
+<blockquote><pre>
+; for the ACS File-Storage System
+[ns/server/yourserver/acs/fs]
+SystemName=File Storage System
+SystemOwner=file-administrator@yourserver.com
+DefaultPrivacyP=f
+; do you want to maintain a public tree for site wide documents
+PublicDocumentTreeP=1
+MaxNumberOfBytes=2000000
+DatePicture=MM/DD/YY HH24:MI
+HeaderColor=#cccccc
+FileInfoDisplayFontTag=&lt;font face=arial,helvetica size=-1&gt;
+UseIntermediaP=0
+</pre>
+</blockquote>
+
+<h3>Details</h3>
+<ul>
+
+The file-storage system is built around a data model consisting of two
+tables, one for files and a second for versions.  A folder is treated as
+a type of file.  Files are owned by a single user, but may contain
+versions created by authors other than the owner.
+
+<p>
+
+Permissions were only given to files and not folders in order to
+simplify both the code and the user interface i.e. to avoid questions
+like "Why can't any of the people in my group see my files?" answered by
+"Did you notice that someone changed the permissions of the parent of
+the parent of the parent folder of this file?"  However, the system is easy 
+to extend to allow folders to have thier own permissions.
+
+<p>
+
+The permissions are handled by the <a href="general-permissions.html">general permissions</a> system.
+
+<p>
+
+No file or version can be deleted from the database, except by an
+administrator.  Instead, the file is deleted by setting the deleted_p
+flag.
+<p>
+This system supports site-wide, group and individual user document trees.
+
+</ul>
+
+<h3> Full-text Indexing </h3>
+
+If you're running Oracle 8i (8.1.5 or later), you might want to build an
+Intermedia text index (ConText) on the contents of file versions.
+Intermedia incorporates very smart filtering software so that it can
+grab the text from within HTML, PDF, Word, Excel, etc. documents.  It is
+also smart enough to ignore JPEGs and other pure binary formats.
+
+<p>
+
+Steps to using Intermedia:
+
+<ul>
+
+<li>install Intermedia (Oracle dbadmin hell)
+
+<li>get Intermedia's optional "INSO filtering" system to work.  Here's
+what jsc@arsdigita.com had to say about his experience doing this...
+
+<blockquote><pre><code>I got the INSO stuff working. The major holdup was that you have to
+configure listener.ora to have $ORACLE_HOME/ctx/lib in
+LD_LIBRARY_PATH. The docs mumble something about editing listener.ora,
+but a careful perusal of anything having to do with networking setup
+didn't turn up any examples. The networking assistant program has a
+field for "Environment", but when you try to put anything in there, the
+program hits a null pointer exception when you go to save it and doesn't
+write anything. I "solved" this eventually by just symlinking all the
+.so files in ctx/lib into $ORACLE_HOME/lib, which is already in the
+LD_LIBRARY_PATH for the listener.</code></pre></blockquote>
+
+<li>In order to have the interMedia index synchronized whenever
+documents get added or updated, the index must be synchronized (using
+<code>alter index indexname rebuild online parameters
+('sync')</code>), or the ctxsrv process must be run, which updates all
+interMedia indices periodically (<code>ctxsrv -user
+ctxsys/ctxpassword</code>). If using ctxsrv, the shell which starts it
+must have <code>$ORACLE_HOME/ctx/lib</code> as part of LD_LIBRARY_PATH.
+
+<li>uncomment the <code>create index fs_versions_content_idx</code>
+statement in file-storage.sql (and then feed it to Oracle)
+
+<li>set <code>UseIntermediaP=1</code> in your ad.ini file
+
+<li>restart AOLserver (so that it reads the new parameter setting)
+
+</ul>
+
+Warning: Intermedia is a tricky product for users.  The default mode is
+exact phrase matching, which means that the more a user types the fewer
+search results will be returned (a violation of the user interface
+guidelines in <a href="developers.html">developers.html</a>).  So you
+might be letting yourself in for some education of users...
+
+<h3>Future Improvements</h3>
+
+<ul>
+
+<li>Currently the administration section needs considerable work.  Instead of trying to clean /admin/file-storage/ up, we should build a better /file-storage/admin or even allow administrators to do more within /file-storage/.
+
+<p>
+
+<li> Ticket Tracker style column sorting.  We want the ability to sort the contents of each folder by name, author, size, type and last modified.  In addition, the folders should be able to sort among themselves by name.  You should use something very similar to the procedure <a href=http://sloan.arsdigita.com/doc/proc-one?proc_name=ad%5ftable>ad_table</a>.  The procedure that you use will be slightly different because the files will be sorted on a per folder basis instead of on a per table basis.
+
+<p>
+
+<li> Better organization of the folder tree - Make the interface more
+of a Window's style interface.  Add a + type icon next to the folder
+if the folder is open and all of the files in the folder can be seen.
+Add a - icon when the folder is closed and can be expanded.  Clicking
+on the + sends the user back to the same page with the contents of the
+folder to be hidden and the - icon in place of the +.  Clicking on the -
+sends the user back to the same page causing a + to replace the - and
+all of the files in the folder to be shown.  Clicking on the folder
+icon or name should act just as they do now.
+
+<li> Nifty javascript version
+</ul>
+
+<hr>
+<a href="mailto:aure@arsdigita.com"><address>aure@arsdigita.com</address></a>
+</body>
+</html>
+ 
Index: web/openacs/www/doc/general-cleanup.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/general-cleanup.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/general-cleanup.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,170 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>general cleanup</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+
+<h2>general cleanup</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+This document was written on February 28, 2000.  It contains
+miscellaneous things that we want to clean up in the ACS.
+
+<h3>Integer primary keys everywhere</h3>
+
+Jeff Davis claims that our magic scheme for pointing from, say,
+general_comments to other tables, is causing trouble with the Oracle
+query optimizer because it doesn't like to coerce from varchars to
+integers.  There are only a handful of tables that use varchar keys
+(notably bboard) so we should just root out the evil and have done with
+it.  If you think that you might end up breaking links from elsewhere
+on the Web, remember to leave behind a legacy_key column and make the
+scripts appropriately robust.
+
+
+<h3>approved/disapproved/unexamined</h3>
+
+The unexamined life may not be worth living but to better support
+workflow among a group of site admins, we need to make sure that we are
+using three-valued logic consistently:
+
+<ul>
+<li>an item starts with an <code>approved_p</code> column value of NULL
+(unless there is autoapproval configured with an "open" policy in
+ad.ini); this means that nobody has looked at it
+
+<li>an administrator is presented with a bunch of items in this state
+and can push them into "t" or "f" (approved or explicitly disapproved)
+
+<li>we always record by whom approved 
+
+<li>once items are approved or disapproved, they disappear from the
+queue of things to look at (though we will have admin pages for digging
+out all the stuff when necessary)
+
+</ul>
+
+<h3>Push stuff out of /admin/</h3>
+
+We want to be able to delegate admin authority for virtually every
+module.  So the day-to-day admin stuff should be in, for example,
+/neighbor/admin/ rather than /admin/neighbor/.  Anyone with site-wide
+administration privileges ought to be able to work in /neighbor/admin/
+and, if they have site-wide privs, the links anchored by user names
+ought to point to /admin/users/one (so that the site-wide admin can
+actually ban or nuke the user)
+
+<h3>No more incremental ns_writes</h3>
+
+Our customers are using ACS for sites with millions of hits/day.  In
+general, we should not be doing explicit ns_writes while holding a
+database handle.  With rare exceptions, every page should be
+accumulating a string of some sort, releasing the database handle, and
+then ns_return'ing the complete page.
+
+<p>
+
+In fact, what I'd like to see is the .tcl pages not calling ns_return at
+all.  They should return a data structure (see <a
+href="templating-etc.html">templating-etc.html</a>) containing the
+string that they've produced and a tag saying "I'm a complete HTML page"
+or "I'm a fragment of HTML that needs to be wrapped in a site-wide
+template" or whatever.  For compatibility with old code, we can tell
+that a Tcl script is just calling <code>ns_return</code> or
+<code>ns_write</code> because it will return the empty string, 0, or 1.
+
+<h3>LDAP compliance</h3>
+
+Lars wrote a thing for Siemens to authenticate ACS users from an
+external system.  This is exactly the same problem as LDAP integration.
+I want Lars's code packaged up and documented and stuck into ACS,
+ideally with the next release.  It doesn't matter if it is
+comprehensive, just the hooks and a doc are enough to help adopters and
+to claim victory.
+
+
+<h3>Bookmarks module should deal with HTTPS</h3>
+
+Aure and Dave should extend bookmarks to distinguish between HTTPS and
+HTTP bookmarks (right now they both end up in the system without being
+distinguished).
+
+<h3>File storage module shouldn't recompute sort keys after an update</h3>
+
+Right now file storage recomputes all the sort keys after an update.
+This is obviously not going to scale to thousands of files very
+gracefully.
+
+<h3>A modest proposal:  one content table</h3>
+
+How about one single content table?  Instead of bboard, news,
+static_pages, etc. each storing user-uploaded content, just put
+everything that we might ever serve back to a user all in one big
+table.  This will make it easier to build an Intermedia index.  This
+will make approval, etc., potentially more consistent.
+
+<p>
+
+If Oracle were a true object database, we could have tables that
+inherited from the <code>all_content</code> table but supplemented it
+with extra columns (e.g., <code>refers_to</code> in the case of
+<code>bboard</code>).  But Oracle isn't so we will probably have to
+resort to kludges like the _info helper tables that we have for
+user groups.
+
+<p>
+
+Some ideas:  
+
+<ul>
+
+<li>think about related links; we have to keep the content (a short text
+string) plus a title, <em>plus</em> some annoation (brief description)
+
+<li>for attachments it probably makes more sense to have two content
+pieces, one for the thing and another that is "attached".  This means
+that a content item must be able to be a BLOB plus have all the extra
+data associated with an image, for example
+
+<li>in some cases we like to build a B-tree index on the content itself,
+which won't work with LOB datatypes, so we might have to denormalize out
+the first few hundred bytes or something if we need to do this
+
+<li>BLOB versus CLOB versus NCLOB?  If we're going to be international,
+we'd better figure out which is the right thing to use
+
+<li>speaking of international, we need a column to store which language
+the content is in
+
+<li>Let's try to figure out whether Oracle 8.1.6 fixes the
+"import/export doesn't work with LOBs" bug (feature); -- I read the docs 
+and, sure enough, this is covered as a feature:
+
+<blockquote>
+
+"If LOB data resides in a tablespace that does not exist at the time of
+import or the user does not have the necessary quota in that tablespace,
+the table will not be imported." -- 
+<a href="http://oradoc.photo.net/ora816/server.816/a76955/ch02.htm#36202">http://oradoc.photo.net/ora816/server.816/a76955/ch02.htm#36202</a>
+
+</blockquote>
+
+<li>Let's try to figure out if we can really stomach the pain of having
+nearly all of our data in an Oracle data type that does not support SQL
+(i.e., the LOB).  We won't be able to do LIKE or WHERE = or anything
+else with our content :-(
+
+
+</ul>
+
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/general-comments.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/general-comments.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/general-comments.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,201 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>General Comments</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>General Comments</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://teadams.com">Tracy Adams</a>
+
+<hr>
+
+<ul>
+<li>User-accessible directory:  <a href="/general-comments/">/general-comments/</a>
+<li>Site administrator directory:  <a href="/admin/general-comments/">/admin/general-comments/</a>
+<li>data model:  subsection within 
+<a href="/doc/sql/display-sql.tcl?url=/doc/sql/general-comments.sql">/doc/sql/general-comments.sql</a>
+<li>TCL: /tcl/general-comments.tcl
+</ul>
+
+<h3>The Big Idea</h3>
+
+We can solicit comments (or reports) on any piece
+of information in the database.
+
+<h3>Under the Hood</h3>
+
+General comments are stored in one table. Comments
+refer to items with an id <code>on_what_id</code>
+in the table <code>on_which_table</code>.
+
+<blockquote>
+<pre>
+create table general_comments (
+	comment_id		integer primary key,
+	on_what_id		integer not null,
+	on_which_table		varchar(50),
+	one_line_item_desc	varchar(200) not null,
+	user_id			not null references users,
+	comment_date		date not null,
+	ip_address		varchar(50) not null,
+	modified_date		date not null,
+	content			clob,
+	-- is the content in HTML or plain text (the default)
+	html_p			char(1) default 'f' check(html_p in ('t','f')),
+	approved_p		char(1) default 't' check(approved_p in ('t','f'))
+	-- columns useful for attachments, column names
+	-- lifted from file-storage.sql and bboard.sql
+	-- this is where the actual content is stored
+	attachment		blob,
+	-- file name including extension but not path
+	client_file_name	varchar(500),
+	file_type		varchar(100),	-- this is a MIME type (e.g., image/jpeg)
+	file_extension		varchar(50), 	-- e.g., "jpg"
+	-- fields that only make sense if this is an image
+	caption			varchar(4000),
+	original_width		integer,
+	original_height		integer
+);
+</pre>
+</blockquote>
+
+<p>
+The module contains one core procedure, <a href="proc-one.tcl?proc_name=ad_general_comments_list">ad_general_comments_list</a>, that
+will show comments on an item and make appropriate 
+links to files in <code>/general-comments</code> 
+for recording and editing user comments. 
+<p>
+The arguments  to <code>ad_general_comments_list</code> are:<br>
+<ul>
+<li> db handle
+<li> table_name containing item 
+<li> id of the item
+<li> A pretty noun describing the item for the user interface.
+<li> The module name
+<li> The submodule name
+<li> A return_url (optional, the default will be the current URL)
+</ul>
+<p>
+</ul>
+
+
+<h3>Administration</h3>
+
+To support central administration of comments, we rely on a helper table
+defined in community-core.sql:
+
+<blockquote>
+<pre><code>
+create table table_acs_properties (
+             table_name      varchar(30) primary key,
+             section_name    varchar(100) not null,
+             user_url_stub   varchar(200) not null,
+             admin_url_stub  varchar(200) not null
+);
+</code></pre>
+</blockquote>
+
+As with <a href="site-wide-search.html">site-wide search</a> and the <a
+href="user-profiling.html">user profiling system</a>, this helper table
+enables us to make a single query and yet link comments over to the
+appropriate admin or user pages.  Another part of this system is the
+one-line item description column in the <code>general_comments</code>
+table.
+
+
+<h3>The Steps</h3>
+
+<p>
+Consider applying this package to a legacy ACS module such as the classified ad system (/gc/) to allow comments on each classified ad. Here are the steps:
+<ol>
+<li> If necessary, decide on the site-wide comment approval policy:
+<p>
+The DefaultCommentApprovalPolicy parameter in your 
+<code>/parameters/service_name.ini</code> 
+file is the default approval policy for the site.
+<blockquote>
+<pre>
+[ns/server/yourservicename/acs]
+...
+; open means stuff goes live immediately
+; wait means stuff waits for administrator to approve
+; closed means only administrator can post
+DefaultCommentApprovalPolicy=wait
+...
+</pre>
+</blockquote>
+<li> Decide on module specific parameters:
+<p>
+If you would like the publisher to control the use of comments
+in your module, add <code>SolicitCommentsP</code> to your module
+parameters.
+<p>
+If you would like to use a comment approval policy other than the
+site's default, add <code>CommentApprovalPolicy</code> to 
+your module parameters.
+<blockquote>
+<pre>
+[ns/server/yourservicename/acs/gc]
+; If SolicitCommentsP is missing for the module, the default is 1
+SolicitCommentsP=1
+; If CommentApprovalPolicy is missing for the module, the
+; default is the DefaulCommentApprovalPolicy in [ns/server/yourservicename/acs]
+; open means stuff goes live immediately
+; wait means stuff waits for administrator to approve
+; closed means only administrator can post
+CommentApprovalPolicy=open
+</pre>
+</blockquote>
+
+<li> Identify the file and location to display and solicit comments and insert a call to <code>ad_general_comments_list</code>. 
+<blockquote>
+<pre>
+ad_general_comments_list $db $classified_ad_id classified_ads $one_line gc
+</pre>
+</blockquote>
+
+Note that <code>ad_general_comments_list</code> checks in the module's
+parameters to see if comments are being solicited or not.
+
+<p>
+
+<li>If necessary, insert a row into <code>table_acs_properties</code>
+so that the admin pages will be up to date
+
+<li> Remember to delete any attached comments from the
+<code>general_comments</code> table when you delete any rows from your
+subsystem's table or write database triggers to do the deletions automatically.
+
+</ol>
+
+
+<h3>Attachments</h3>
+
+Users can attach arbitrary files to a comment, if the publisher has
+configured the general comments system to accept attachments:
+
+<blockquote>
+<pre><code>
+[ns/server/photonet-dev/acs/general-comments]
+; Whether or not we accept file uploads for general comments.
+AcceptAttachmentsP=1
+; Maximum attachment size in bytes. Leave empty for no limitation.
+MaxAttachmentSize=5000000
+AdminEditingOptionsInlineP=0
+; Images with widths less than this parameter will be displayed inline.
+InlineImageMaxWidth=512
+</code></pre>
+</blockquote>
+
+Smaller photos are displayed in-line.  Larger photos are displayed as
+links.  Files that aren't identified as photos by the system are simply
+made available for one-click download (with a MIME type based on the
+extension of the file originally uploaded).
+
+<hr>
+<a href="http://teadams.com/"><address>teadams@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/general-links.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/general-links.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/general-links.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,193 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>General Links</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>General Links</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href=mailto:dh@arsdigita.com>dh@arsdigita.com</a> and <a href=mailto:tzumainn@arsdigita.com>tzumainn@arsdigita.com</a>
+
+<hr>
+
+<ul>
+<li>User-accessible directory:  <a href="/general-links/">/general-links/</a>
+<li>Site administrator directory:  <a href="/admin/general-links/">/admin/general-links/</a>
+<li>data model: <a href="/doc/sql/display-sql.tcl?url=/doc/sql/general-links.sql">/doc/sql/general-links.sql</a>
+<li>TCL: /tcl/general-links.tcl
+</ul>
+
+<h3>The Big Idea</h3>
+
+This module serves two related purposes: Display/Maintains categorized links on at a single location (hot list),  Solicit links to associate with any piece
+of information in the database.  <p>
+Users may rate links on the hot list (a scale of 0 to 10), and this rating may be used in display of the links. 
+
+<h3>The Medium Sized Idea</h3>
+
+A simple breakdown of the possible actions:
+
+<ul>
+<h4><u>Hot List</u></h4>
+<li>Users can view a categorized list of all the links
+<li>Users can give the links ratings
+<li>Users can suggest links to the Hot List
+<P>
+<li>Administrators can approve/reject links
+<li>Administrators can create categories
+<li>Administrators can edit/delete/recategorize links
+<h4><u>Associated Links</u></h4>
+<li>Users can view links associated with an item in the database
+<li>Users can suggest a new link and to be associated to an item in the database (the user will also be asked to classify this link as it will also be suggested to the Hot List automaticaly)
+<P>
+<li>Administrators can approve/reject new links associations
+<li>Administrators can edit/delete link associations
+</ul>
+
+<h3>Under the Hood</h3>
+
+General links are stored in one table <code>general_links</code>, with their properties (title, description, etc);  the associations between items in the database are stored in a mapping table <code>general_link_db_map</code>; and the user's rating are keep in the table <code>general_link_user_ratings</code>.
+<P>
+As in the <a href="/doc/general-comments.html">general-comments</a> module,
+references to items in the database via id <code>on_what_id</code>
+in the table <code>on_which_table</code>.
+
+<blockquote>
+<pre>
+create sequence general_link_id_sequence start with 1;
+
+create table general_links (
+	link_id                 integer primary key,
+	url                     varchar(300) not null,
+	link_title              varchar(100) not null,
+	link_description        varchar(4000),
+	-- meta tags defined by HTML at the URL
+	meta_description        varchar(4000),
+	meta_keywords           varchar(4000),
+	-- when was this submitted?
+	creation_time	    	    date default sysdate not null,
+	creation_user		    not null references users(user_id),
+	creation_ip_address	    varchar(20) not null,
+	last_modified		    date,
+	last_modifiying_user	    references users(user_id),
+	-- last time this got checked
+	last_checked_date       date,
+	last_live_date          date,
+	last_approved           date,
+	-- has the link been approved? ( note that this is different from
+	-- the approved_p in the table wite_wide_link_map ) 
+	approved_p              char(1) default 't' check(approved_p in ('t','f'))
+);
+
+create sequence general_link_map_id start with 1;
+
+-- This table associates urls with any item in the database
+
+create table site_wide_link_map (
+	map_id          integer primary key,
+	link_id                 not null references general_links,
+	-- the table is this url associated with 
+	on_which_table          varchar(30) not null,
+	-- the row in *on_which_table* the url is associated with
+	on_what_id              integer not null,
+	-- a description of what the url is associated with
+	one_line_item_desc      varchar(200) not null,
+	-- who made the association
+	creation_time	    	    date default sysdate not null,
+	creation_user		    not null references users(user_id),
+	creation_ip_address	    varchar(20) not null,
+	last_modified		    date,
+	last_modifiying_user	    references users(user_id),
+	-- has the link association  been approved ?
+	approved_p              char(1) check(approved_p in ('t','f')) not null
+);
+
+-- We want users to be able to rate links
+-- These ratings could be used in the display of the links
+-- eg, ordering within category by rating, or displaying 
+-- fav. links for people in a given group..
+
+create table general_link_user_ratings (
+	user_id         not null references users,
+ 	link_id         not null references general_links,
+	-- a user may give a url a rating between 0 and 10
+	rating          integer not null check(rating between 0 and 10 ),
+	-- require that the user/url rating is unique
+	primary key(link_id, user_id) 
+);
+</pre>
+</blockquote>
+
+<p>
+The module contains one core procedure, <a href="proc-one.tcl?proc_name=ad_general_links_list">ad_general_links_list</a> (based on ad_general_comments_list), that
+will show links associated with an item in the database and make appropriate 
+links to files in <code>/general-links</code> and  
+for recording and editing links.
+<p>
+The arguments  to <code>ad_general_links_list</code> are:<br>
+<ul>
+<li> db handle
+<li> table_name containing item 
+<li> id of the item
+<li> A pretty noun describing the item for the user interface.
+<li> The module name
+<li> The submodule name
+<li> A return_url (optional, the default will be the current URL)
+</ul>
+<p>
+</ul>
+
+Default approval policy is toggled by the DefaultLinkApprovalPolicy parameter.
+<p>
+If AllowGeneralLinksSuggestionsP is set to 1, then a user will be able to suggest links from /general-links/ index page.
+<p>
+In addition, by toggling GeneralLinksClickthroughP, one can toggle on/off the ability to keep track of link clickthroughs.  These statistics are stored in a table defined in community-core.sql:
+
+<blockquote>
+<pre><code>
+create table clickthrough_log (
+        local_url       varchar(400) not null,
+        foreign_url     varchar(300) not null,  -- full URL on the foreign server
+        entry_date      date,   -- we count referrals per day
+        click_count     integer default 0,
+        primary key (local_url, foreign_url, entry_date)
+);
+</pre></code>
+</blockquote>
+
+The links are marked by setting local_url to ad_link_<i>linkid</i>.
+
+
+<h3>Administration</h3>
+
+To support central administration of links, we rely on a helper table
+defined in community-core.sql:
+
+<blockquote>
+<pre><code>
+create table table_acs_properties (
+             table_name      varchar(30) primary key,
+             section_name    varchar(100) not null,
+             user_url_stub   varchar(200) not null,
+             admin_url_stub  varchar(200) not null
+);
+</code></pre>
+</blockquote>
+
+As with <a href="site-wide-search.html">site-wide search</a> and the <a
+href="user-profiling.html">user profiling system</a>, this helper table
+enables us to make a single query and yet connect links over to the
+appropriate admin or user pages.  Another part of this system is the
+one-line item description column in the <code>general_links</code>
+table.
+<p>
+For the purpose of the "hot list" page, links are put in different categories (one link could be placed in more than one category) by means of the tables <code>categories</code> and <code>category_heirarchy</code> found discussed in the <a href="/doc/user-profiling.html">/doc/user-profiling.html</a>. 
+
+
+
+<hr>
+<a href=mailto:dh@arsdigita.com>dh@arsdigita.com</a>
+</body>
+</html>
Index: web/openacs/www/doc/general-permissions.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/general-permissions.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/general-permissions.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,360 @@
+<html>
+<head>
+
+<title>General Permissions</title>
+
+<style>
+BODY {
+  background-color: #FFFFFF;
+  color: #000000
+}
+</style>
+
+</head>
+
+<body>
+
+<h2>General Permissions</h2>
+
+part of the <a href="/doc/">ArsDigita Community System</a>
+
+by <a href="mailto:richardl@arsdigita.com">Richard Li</a>,
+<a href="mailto:michael@arsdigita.com">Michael Yoon</a>,
+<a href="mailto:yon@arsdigita.com">Yon Feldman</a>, and
+<a href="mailto:markc@arsdigita.com">Mark Ciccarello</a>
+
+<hr>
+
+<ul>
+<li>User-accessible directory: /gp/ (no index page)
+<li>Site-wide administration directory: <a href="/admin/gp/">/admin/gp/</a>
+<li>Data model: <a href="/doc/sql/display-sql?url=/doc/sql/general-permissions.sql">/doc/sql/general-permissions.sql</a>
+<li>Tcl procedures: /tcl/ad-general-permissions.tcl
+<li>Acceptance tests: <a href="/admin/acceptance-tests/gp-acceptance-test">/admin/acceptance-tests/gp-acceptance-test</a>
+</ul>
+
+<h3>The Big Picture</h3>
+
+The General Permissions package lets you control who can do what with
+each row in your database, by providing:
+
+<ul>
+
+<li><strong>an API for defining and querying permission rules</strong>
+- Each rule grants a specific type of permission such as "read" or
+"write" (i.e., the "what") on one row in the database to a specific
+party (i.e., the "who")
+
+<li><strong>a simple means to enforce those rules throughout the
+site</strong> - One line of code at the top of each page identifies
+the required permission and ensures that each user who attempts to
+view the page has been granted that permission.
+
+</ul>
+
+There are five types of party to whom permissions can be granted:
+
+<ul>
+<li>An individual user
+<li>Any user who play a specific role in a specific user group
+<li>A specific user group, i.e., any user who is a member of the group
+<li>All registered users
+<li>All users, registered or not
+</ul>
+
+In essence, General Permissions treats rows in the database as
+operating systems like Unix and Microsoft Windows NT treat files in
+the filesystem.
+
+<h3>The Data Model</h3>
+
+The General Permissions data model is simple, consisting of one table:
+
+<blockquote>
+<pre><code>
+create table general_permissions (
+	permission_id		integer not null primary key,
+	-- on_what_id is a varchar to accomodate non-integer ID's
+	on_what_id		varchar(30) not null,
+	on_which_table		varchar(30) not null,
+        scope           	varchar(20),
+	user_id			references users,
+	group_id		references user_groups,
+	role			varchar(200),
+	permission_type		varchar(20) not null,
+	check ((scope = 'user' and user_id is not null
+                and group_id is null and role is null) or
+	       (scope = 'group_role' and user_id is null
+                and group_id is not null and role is not null) or
+	       (scope = 'group' and user_id is null
+                and group_id is not null and role is null) or
+	       (scope in ('registered_users', 'all_users')
+                and user_id is null
+                and group_id is null and role is null)),
+	unique (on_what_id, on_which_table,
+                scope, user_id, group_id, role, permission_type)
+);
+</code></pre>
+</blockquote>
+
+The <code>on_what_id</code> and <code>on_which_table</code> columns
+identify the database row in question. The <code>scope</code>,
+<code>user_id</code>, <code>group_id</code>, and <code>role</code>
+columns together identify the party to whom the permission is being
+granted. Finally, the <code>permission_type</code> column contains
+values like "read", "comment", "write", and "administer" that
+represent the actions you want to control. As with Unix, permission
+types are independent of one another. One permission does not imply
+another (e.g., "write" does not imply "read").
+
+<p>
+
+To define rules for who can insert new rows into a table, the
+convention is to require "write" access on a row in the table's parent
+table, e.g., in order to add contact information for a given user
+(insert a row into the <code>users_contact</code> table), you need to
+have "write" permission on the corresponding row in the
+<code>users</code> table.
+
+<h3>Enabling Users to Grant and Revoke Permissions</h3>
+
+The page <code>/gp/administer-permissions</code> (an <a
+href="abstract-url.html">abstract URL</a>) provides a reusable
+interface for granting and revoking permissions on an arbitrary row in
+the database. You simply link to this page from your own pages, making
+sure to pass along:
+
+<ul>
+
+<li><strong><code>on_what_id</code></strong> and
+<strong><code>on_which_table</code></strong> - the identity of the
+database row whose permissions will be edited
+
+<li><strong><code>object_name</code></strong> - the name of the
+database row whose permissions will be edited; used only for display
+purposes: in the page title, etc. (We name this variable "object_name"
+because a database row typically represents an object of some kind,
+and because "row_name" is not very intuitive.)
+
+<li><strong><code>return_url</code></strong> - usually the result of a
+call to <code>ns_conn url</code>, i.e., the page containing the link
+
+</ul>
+
+Consider the <a href="file-storage.html">File Storage</a> module,
+which enables users to upload and store files on the server through a
+web interface. To allow the user to edit the permissions of a row in
+the File Storage module's <code>fs_files</code> table, here is an
+example of how we could construct the link:
+
+<blockquote>
+<pre><code># assuming that $file_id contains the ID of a row in fs_files...
+#
+set on_what_id $file_id
+set on_which_table "fs_files"
+
+# use the value of the file_title column as the "object_name"
+#
+set object_name [database_to_tcl_string $db "select file_title
+from fs_files
+where file_id = $file_id"]
+
+set return_url [ns_conn url]
+
+set edit_permissions_link \
+     "/gp/administer-permissions?[export_url_vars on_what_id on_which_table object_name return_url]"
+</code></pre>
+</blockquote>
+
+Access to <code>/gp/administer-permissions</code> will be denied
+unless the user has "administer" permission on the specified database
+row.
+
+<h3>How to Enforce Permissions</h3>
+
+The page <code>/file-storage/one-file.tcl</code> (also part of the
+File Storage module) displays all versions of a given file. To make
+sure that we show the page only to users with "read" permission on the
+identified file, we include a call to <a
+href="proc-one?proc_name=ad_require_permission"><code>ad_require_permission</code></a>:
+
+<blockquote>
+<pre><code>ad_page_variables { file_id }
+
+set user_id [ad_validate_and_get_user_id]
+
+set db [ns_db gethandle]
+
+<strong>ad_require_permission $db $user_id "read" $file_id "fs_files"</strong>
+</code></pre>
+</blockquote>
+
+Let's walk through this example step by step: First, we specify that
+we expect to receive the identity of a row in the
+<code>fs_files</code> table as a form or query string variable. Next,
+we check the identity of the user and grab a database handle. Finally,
+the call to <code>ad_require_permission</code> is self-explanatory:
+"read" is the type of permission required and the combination of
+<code>$file_id</code> and <code>fs_files</code> identifies the
+database row that the user is attempting to access.
+
+<p>
+
+Internally, we first check to see if the user is logged-in. If so,
+then the following questions are asked to determine if the user has
+been granted the requested type of permission:
+
+<ul>
+
+<li>Is the user a member of the Site-wide Administration group?
+
+<li>Has the user been granted the permission directly (i.e., a
+<code>user</code>-scoped permission)?
+
+<li>Does the user play a role within a group where that role has been
+granted the permission (i.e., a <code>group_role</code>-scoped
+permission)?
+
+<li>Does the user belong to a group where all members of that group
+have been granted the permission (i.e., a <code>group</code>-scoped
+permission)?
+
+<li>Has the permission been granted to all registered users (i.e., a
+<code>registered_users</code>-scoped permission)?
+
+</ul>
+
+If the answer to all five of these questions is "no," then
+<code>ad_require_permission</code> prohibits further processing of the
+page by returning a 403 "Forbidden" error.
+
+<p>
+
+If the user is not logged-in, then we check to see if the requested
+permission has been granted to unregistered as well as registered
+users (i.e., an <code>all_users</code>-scoped permission). If not,
+then <code>ad_require_permission</code> redirects to the login page.
+
+<h3>The API</h3>
+
+In addition to <code>ad_require_permission</code>, the Tcl API of
+General Permissions provides the <a
+href="proc-one?proc_name=ad_user_has_row_permission_p"><code>ad_user_has_row_permission_p</code></a>
+predicate.
+
+<p>
+
+To access General Permissions data, you should use the <a
+href="view-pl-sql?name=ad_general_permissions&type=package"><code>ad_general_permissions</code></a>
+PL/SQL package, instead of SQL statements. (The Tcl API procs are just
+thin wrappers on top of the PL/SQL package.) Here is a summary of how
+to use the various procedures and functions in the package:
+
+<ul>
+<li>To check if the user has a specific permission, call
+<code>user_has_row_permission_p</code>
+
+<p>
+
+<li>To grant a permission, call one of:
+
+<p>
+
+<ul>
+<li><code>grant_permission_to_user</code>
+<li><code>grant_permission_to_role</code>
+<li><code>grant_permission_to_group</code>
+<li><code>grant_permission_to_reg_users</code>
+<li><code>grant_permission_to_all_users</code>
+</ul>
+
+<p>
+
+e.g., <code>ns_ora exec_plsql $db "begin :1 := ad_general_permissions.grant_permission_to_users($user_id, 'read', $version_id, 'FS_VERSIONS'); end;"</code>
+
+<p>
+
+<li>To get the ID of a specified permission, call one of:
+
+<p>
+
+<ul>
+<li><code>user_permission_id</code>
+<li><code>role_permission_id</code>
+<li><code>group_permission_id</code>
+<li><code>reg_users_permission_id</code>
+<li><code>all_users_permission_id</code>
+</ul>
+
+<p>
+
+All of these functions return zero if the specified permission has not
+been granted.
+
+<p>
+
+<li>To revoke a permission, first get the permission ID and then call
+<code>revoke_permission</code>
+
+</ul>
+
+<p>
+
+Note that the PL/SQL API (and therefore the Tcl API) is
+<em>case-insensitive</em>.
+
+<p>
+
+One instance in which you may need to query the
+<code>general_permissions</code> table directly is when you are trying
+to answer a question like "What are the titles of all files in the
+File Storage system on which I have administrative permission?" One
+way to write this query is:
+
+<blockquote>
+<pre><code>select f.file_title
+from fs_files f
+where ad_general_permissions.user_has_row_permission_p(<i>user_id</i>, 'administer', f.file_id, 'fs_files') = 't'
+</code></pre>
+</blockquote>
+
+While this query is simple and readable, it has the unfortunate
+side-effect of causing Oracle (8.1.5 and below) to execute a full
+table scan of <code>fs_files</code>. (If function-based indexes worked
+as advertised, then this would not be an issue.) So, if
+<code>fs_files</code> were to become large, we would want to rewrite
+this query with a join to <code>general_permissions</code> to keep
+performance acceptable; see the implementation of
+<code>user_has_row_permission_p</code> for what criteria that you
+would need to make this work.
+
+<h3>Future Enhancements</h3>
+
+A high-priority enhancement of this module is to design and implement
+a good scheme for default permissions, e.g., how do we know what
+permissions to grant when a user creates a new file in the File
+Storage system? The Unix <code>umask</code> concept is a simple model
+from which we can start.
+
+<p>
+
+A possible extension to the data model would be to support dependency
+rules between permission types, e.g., a way to say that granting
+"administer" permission implies granting "write" permission, which, in
+turn, implies granting "read" permission. It would be important to
+ensure that this extension would be optional, i.e., that it would not
+interfere with the current model, in which permission types are
+independent of one another.
+
+<hr>
+
+<address>
+<a href="mailto:richardl@arsdigita.com">richardl@arsdigita.com</a>
+</address>
+
+<address>
+<a href="mailto:michael@arsdigita.com">michael@arsdigita.com</a>
+</address>
+
+</body>
+</html>
Index: web/openacs/www/doc/glassroom.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/glassroom.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/glassroom.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,281 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Glass Room Subsystem</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Glass Room</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+<ul>
+<li>User-accessible directory:  <a href="/glassroom/">/glassroom/</a>
+<li>Site administrator directory:  <a
+href="/admin/glassroom/">/admin/glassroom/</a> (currently empty)
+<li>data model :  <a href="/doc/sql/display-sql.tcl?url=/doc/sql/glassroom.sql">/doc/sql/glassroom.sql</a>
+
+</ul>
+
+
+ArsDigita Glass Room is a module that lets the community system
+implement the final component of <a
+href="http://photo.net/wtr/arsdigita-server-architecture.html">the
+ArsDigita Server Architecture</a>:  coordinating a bunch of human beings
+to ensure the reliable operation of a Web service.
+
+<p>
+
+The first function that Glass Room must accomplish is the distribution
+of information.  The <code>glassroom_info</code> table contains:
+
+<ul>
+
+<li>the name of the service
+<li>a reference to the host that does Web service
+<li>a reference to the host that does RDBMS service
+<li>a reference to the host that does primary DNS service
+<li>a reference to the host that does secondary DNS service
+<li>a reference to the host that serves for disaster recovery
+</ul>
+
+
+For each of the physical computer systems involved, there is an entry in 
+<code>glassroom_hosts</code>:
+
+<ul>
+<li>main hostname
+<li>ip address
+<li>operating system version
+
+<li>description of physical configuration (e.g., "Sun Ultra 2 pizza box with two
+CPUs, 1.25 GB of RAM (4 SIMM slots free), two fast-wide SCSI disk drives
+(SCA connectors), one 68-pin mini-SCSI cable to disk enclosure
+containing 13 additional disks, one 68-pin mini-SCSI cable to DDS3 tape
+drive containing")
+
+<li>model #, serial #
+
+<li>street address
+
+<li>how one gets to the console port
+
+<li>service contract phone number 
+
+<li>service contract number and any other details
+
+<li>phone number and main contact for the facility where it is hosted
+(e.g., NOC at above.net or exodus.net)
+
+<li>human-readable description of the file system backup strategy and
+schedule for this host
+
+<li>human-readable description of the RDBMS backup strategy and schedule
+for this host (if applicable)
+
+</ul>
+
+An expired Verisign certificate can be nearly fatal to a service that
+requires SSL to operate.  Users get hammered with nasty warning messages
+that they don't understand.  So we need the
+<code>glassroom_certificates</code> table with the following columns:
+
+<ul>
+<li>hostname to which this cert applies
+<li>who issued the cert (usually Verisign)
+<li>email address encoded in the cert
+<li>expiry date
+</ul>
+
+Important news, such as the fact that regular backups have been halted
+and someone is restoring from tape, are recorded using the standard ACS
+/news subsystem.
+
+<p>
+
+<h3>Modeling the software</h3>
+
+Every site is going to depend on a set of software modules that can be
+versioned.  The ones that occasion the most discussion are presumably
+the custom-written software, e.g., the scripts that drive the Web site.
+However, we still need to keep track of packaged software.  People might
+need to know that we're currently running Oracle 8.0 but plan to upgrade
+to 8.1 in April 1999.
+
+<p>
+
+We also are going to tie bug tickets and feature requests to software
+modules so that only the relevant personnel need be alerted.  Here's
+what the <code>glassroom_modules</code> table keeps:
+
+<ul> 
+
+<li>name of module, e.g., "Solaris", "Oracle", "ArsDigita Reporte" for
+packaged software or "foobar.com" for the custom Web scripts
+
+<li>where we got it (URL, vendor phone number)
+
+<li>current operating version (a date of download if the software itself
+doesn't come with a version)
+
+<li>who installed it (references users table)
+
+
+</ul>
+
+
+
+
+<p>
+
+So that bug tickets and feature requests can be closed out with a
+structured "fixed in Release 4.1", Glass Room needs to know about
+software releases.  We have a table <code>glassroom_releases</code>
+containing:
+
+<ul>
+<li>module_id (references glassroom_modules)
+<li>release_date (null until done)
+<li>anticipated_release_date 
+<li>release name (just text; Glass Room doesn't care if 3.7 comes after 4.0)
+<li>manager (a person; references users(user_id))
+
+</ul>
+
+We also use this table even when we're talking about software releases
+that we're merely installing, not developing (e.g., for Oracle 8.1).
+
+<h3>Modeling and Logging Procedures</h3>
+
+A <i>procedure</i> is something that must be regularly done, e.g.,
+"verify backup tape".  We want to log everything of this nature that has
+been done, by whom, and when.  Glass Room needs to know which of these
+procedures need to be done and how frequently.  That way it can check
+the log and raise some alerts when procedures haven't been done
+sufficiently recently.
+
+<p>
+
+We keep a single <code>glassroom_logbook</code> table in which all kinds
+of events are intermingled.  Some of these might even be ad-hoc events
+for which we don't have a procedure on record as needing to be done.
+
+<p>
+
+So that the system can do automated checking of the logbook table, we
+keep <code>glassroom_procedures</code>:
+
+<ul>
+<li>procedure name (no spaces, e.g., "verify_backup_tape"; so we can use
+this as a database key)
+<li>responsible_user 
+<li>responsible_user_group
+<br>
+<i>(one of the preceding must be non-null)</i>
+
+<li>maximum time interval (in days or fractions of days)
+<li>importance (1 through 10; 10 is most important)
+
+</ul>
+
+Logbook entries can be made by human beings or robots.  As the Glass
+Room is generally running on a geographically separate machine from the
+production servers, the robots will have to make their log entries via
+HTTP GET or POST.
+
+<p>
+
+Here's the data model for <code>glassroom_logbook</code>:
+
+<ul>
+
+<li>entry_time
+
+<li>entry_author (user id; provision is made for robots by registering
+them as users)
+
+<li>procedure_name (generally references the procedures table but need
+not for one-time events)
+
+<li>notes
+
+</ul>
+
+People can comment on logbook entries, but we just do this with the
+general_comments table.
+
+<P>
+
+<h4>Suggested Procedures</h4>
+
+Check at least the following:
+
+<ul>
+<li>Oracle exports completing successfully
+<li>Oracle exports cover all production users
+<li>Oracle exports can be successfully imported into another system
+<li>tape backups occurring
+<li>verification of tape made yesterday in same drive
+<li>off-site transfers of tapes occurring
+<li>verification of off-site transferred tapes read into another machine
+
+</ul>
+
+<h3>Domains</h3>
+
+We don't want an unpaid InterNIC invoice rendering our service
+inaccessible to most users.  So we keep track of all the domains on
+which our service depends, when they expire, who has paid the bill, and
+when the last bill was paid.
+
+<blockquote>
+<pre><code>
+create table glassroom_domains (
+	domain_name	varchar(50),	-- e.g., 'photo.net'
+	last_paid	date,
+	by_whom_paid	varchar(100),
+	expires		date
+);
+</code></pre>
+</blockquote>
+
+<h3>Bug Tracking, Feature Requests, and Tickets</h3>
+
+In the tech world, people seem to like organizing things by trouble
+ticket:
+
+<ol>
+
+<li>Joe Customer opens a ticket when he is unhappy about a bug on a page
+
+<li>If it is a high priority bug, a variety of folks get notified via
+email and maybe pager; if it is a low priority bug, it sits in the queue
+until someone notices
+
+<li>A coordinator assigns the bug to Jane Programmer, causing the system
+to send Jane email
+
+<li>Jane Programmer fixes the bug and records that fact, causing the
+system to send email to Joe Customer
+
+</ol>
+
+The same kind of interaction works well for feature requests, except
+that Jane Programmer might need to record the version number of the
+software that will incorporate the new feature.
+
+<p>
+
+So that the group can see whether everyone is working together
+effectively, the system can produce reports such as "average time to
+implement a requested feature", "response time for bugs arranged by the
+person who reported them", etc.
+
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/glossary.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/glossary.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/glossary.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,49 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Glossary System</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Glossary</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="mailto:jsc@arsdigita.com">Jin Choi</a> 
+and <a href="mailto:rgvdh@arsdigita.com/">Robert van der Heide</a>
+
+<hr>
+
+<ul>
+<li> User-accessible directory: <a href="/glossary/">/glossary/</a>
+<li> Administration directory: <a href="/admin/glossary/">
+/admin/glossary/</a> (must use https://)
+<li> data model: <a href="/doc/sql/glossary.sql">/doc/sql/glossary.sql</a>
+</ul>
+
+<h3> The Big Idea </h3>
+
+Your site content may use technical, specialized or unfamiliar terminology.  
+You can create an on-site dictionary for users to refer to when they run into 
+a term they don't know.<p>
+
+<h3> Parameters</h3>
+By editing the glossary section of your site's .ini file, you can control 
+how terms are added to your glossary.
+<ul><li>
+If you want site staff to have total responsibility for adding and controlling
+all glossary content, set <code>ApprovalPolicy=closed</code>.
+<li>If you want to let users suggest terms, but keep control over what the 
+final result looks like, set  <code>ApprovalPolicy=wait</code>.  Only site 
+staff can edit the suggested definitions, 
+and only site staff can make them visible on the 
+site.
+<li>If you want to let users freely add and maintain entries, 
+set  <code>ApprovalPolicy=open</code>.  When a users adds a term it will 
+immediately show up on your site.  Users can edit definitions they entered
+themselves, and site staff can still edit the entire glossary.
+</ul>
+<hr>
+<a href="mailto:rgvdh@arsdigita.com"><address>rgvdh@arsdigita.com</address></a>
+</body>
+</html>
+ 
Index: web/openacs/www/doc/graphing.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/graphing.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/graphing.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,237 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Graphing Package</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Graphing Package</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://eve.arsdigita.com/">Eve Andersson</a>
+
+<hr>
+
+This "package" only consists of one main procedure (and a couple little
+supporting procs and gifs) that creates bar charts in plain html with 1x1
+pixel gifs stretched to the right width and height.  It will work on any
+browser that supports tables (i.e., pretty much all of them).
+
+<p>
+
+This package relies on a few gifs being
+present in /graphics/graphing-package/.  It also relies on the
+presense of ad_proc and its helper procs in utilities.tcl.  Make sure
+you always have the latest version of utilities.tcl every time you
+upgrade the ACS! The graphing Tcl procedures are in /tcl/ad-graphing.tcl.
+
+<p>
+
+If you want to do fancier charts like x-y-scatter graphs or pie charts,
+you should probably buy/find/write a cgi program that generates gifs
+on the fly (a popular free example is Gnuplot, distributed from
+<a href="http://www.cs.dartmouth.edu/gnuplot_info.html">http://www.cs.dartmouth.edu/gnuplot_info.html</a>).  In my experience, trying to do these the plain html way
+is very slow and limited.
+
+<p>
+
+The bar chart procedure, <code>gr_sideways_bar_chart</code> returns
+an HTML fragment.  It has just one mandatory
+argument, although there are a number of optional arguments to beautify
+or improve your graphs.  Because there are so many optional arguments,
+the optional arguments are specified using flags (keyword arguments), like
+Unix commands, instead of positionally like most tcl procedures.
+<p>
+
+To run this command: 
+
+<blockquote>
+<code>gr_sideways_bar_chart <i>subcategory_category_and_value_list</i></code>
+</blockquote>
+
+<p>
+
+To use optional arguments, for instance <code>legend</code> and 
+<code>left_heading</code>: 
+
+<blockquote>
+<code>gr_sideways_bar_chart -legend <i>legend</i> -left_heading <i>left_heading</i> <i>subcategory_category_and_value_list</i></code>
+</blockquote>
+
+The arguments:
+
+<ol>
+
+<b><li><code>subcategory_category_and_value_list</code></b><br>
+This is the only mandatory argument.
+
+<p>
+To create a graph like this:
+
+<p>
+<blockquote>
+<pre>
+<b>Dogs</b>
+Samoyed    xxxxxxxxxxx 45%
+Black Lab  xxxx 20%
+Terrier    xxxxxxxxxxxxxxxxxxxx 66%
+<b>Cats</b>
+Calico     xxxxxxxx 39%
+Persian    xx 10%
+</pre>
+</blockquote>
+
+supply <code>subcategory_category_and_value_list</code> as a Tcl list of lists:
+
+<p>
+
+<blockquote>
+<code>
+<pre>
+[list [list "Samoyed" "Dogs" "45"] \
+      [list "Black Lab" "Dogs" "20"] \
+      [list "Terrier" "Dogs" "66"] \
+      [list "Calico" "Cats" "39"] \
+      [list "Persian" "Cats" "10"]]
+</pre>
+</code>
+</blockquote>
+
+</p>
+
+
+Dogs and Cats are the categories, Samoyed, Black Lab, Terrier, Calico, and
+Persian are subcategories, and all the numbers are values.  You can have multiple
+values per subcategory, in which case you should supply the values as a list:
+
+<blockquote>
+<code>[list [list "Samoyed" "Dog" [list "45" "65" "34"]] ...]</code>
+</blockquote>
+
+<p>
+
+There can be an optional fourth argument, which specifies a URL to
+link around the value displayed (if values are being displayed). If
+provided, this overrides the setting of <code>default_drilldown_url</code> below.
+
+<p>
+
+<b><li><code>legend</code></b><br>
+<code>legend</code> is a list of what the values refer to if there's more than one value
+per subcategory.
+
+<p>
+
+So, if you have created a graph with three values per subcategory:
+
+<blockquote>
+<pre>
+<b>Dogs</b>
+Samoyed   xxxxxxxxxxx 45%
+          ----------------------- 90%
+          ++++++++++++++++++ 70%
+Black Lab xxxx 20%
+          ------ 30%
+          ++++++++++++ 60%
+</pre>
+</blockquote>
+
+
+then create a legend like
+
+<blockquote>
+<code>[list "March" "April" "May (projected)"]</code>
+</blockquote>
+
+<p>
+
+<b><li><code>bar_color_list</code></b><br>
+There is a default list of colors with which the values will be displayed
+if there is more than one value per subcategory, but if those
+colors don't meet your design needs, go ahead and supply your own color list.
+
+<p>
+
+<b><li><code>display_values_p</b></code><br>
+By default, the values (like 60%) aren't displayed after the bars, but if you
+want them to be, set this to "t".
+
+<p>
+
+<b><li><code>display_scale_p</code></b><br>
+By default, there's a scale displayed at the top of the chart that goes from
+0% to 100%, but if you don't want that scale there, set <code>display_scale_p</code> to "f".
+It doesn't make sense to have the scale if the values that are being charted
+are not percentages.
+
+<p>
+
+<b><li><code>default_drilldown_url</code></b><br>
+If supplied, should be a URL to which the numeric value (if being displayed) will be linked.
+This variable will undergo variable expansion, so <code>$category</code>, <code>$subcategory</code>, 
+and <code>$value</code> may be referenced.
+
+<p>
+
+<b><li><code>non_percent_values_p</code></b><br>
+Set this to "t" if the numbers you're charting are not percentages.  Then
+this procedure will, instead of creating bars that are a fixed number times the
+value, display the values relative to each other (it will, in essence, pretend
+that the highest value within a category is 100%, and then display the other 
+values in that category relative to each other).
+
+<p>
+
+<b><li><code>min_left_column_width</code></b><br>
+If you are going to stack charts, set the <code>min_left_column_width</code> to be
+the same for each of them so that they will line up.
+Otherwise, the left column, which contains the categories and subcategories, probably
+won't be the same for successive charts.
+
+<p>
+
+<b><li><code>bar_height</code></b><br>
+By default, the height of each bar is 15 pixels.
+
+<p>
+
+<b><li><code>subcategory_spacing</code></b><br>
+By default, the spacing between each subcategory is 7 pixels.
+
+<p>
+
+<b><li><code>compare_non_percents_across_categories</code></b><br>
+This is only relevant if you are graphing values that are not percentages.
+Usually (as explained above for non_percent_values_p), the bars are drawn so that
+they are relative only to other bars in the same category.  This makes sense
+if one category has values like 900, 854, 942, and another totally unrelated
+category has values like 2.5, 3, 3.27.  You wouldn't want the bars in the second
+category to be drawn relative to the ones in the first category because they
+would be very small and, besides, they're not even related.  But, if the numbers
+ARE related across categories, then set <code>compare_non_percents_across_categories</code>
+to "t".
+
+<p>
+
+<b><li><code>left_heading</code></b><br>
+Stuff (text/pictures/whatever) that goes above the items on the left of
+the chart (i.e. above the categories and subcategories).
+
+<p>
+
+<b><li><code>right_heading</code></b><br>
+Stuff that goes above the items on the right of the chart (i.e. above the values).
+
+<p>
+
+<b><li><code>replace_null_subcategory_with_none_p</code></b><br>
+Set this to "t" to have "[none]" be displayed as the subcategory if the
+subcategory is the empty string.
+
+</ol>
+
+
+<hr>
+<a href="mailto:eveander@arsdigita.com"><address>eveander@arsdigita.com</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/group-spam.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/group-spam.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/group-spam.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,165 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Group Spam System</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Group Spam System</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="mailto:ahmeds@mit.edu/">Sarah Ahmed</a>
+
+<hr>
+
+<ul>
+<li>User directory:  /groups/$short_name/spam-index.tcl
+<li>Admin directory:  /groups/admin/$short_name/spam-index.tcl
+<li>Data model:  subsection within 
+<a href="/doc/sql/display-sql.tcl?url=/doc/sql/user-groups.sql">/doc/sql/user-groups.sql</a> and <a href="/doc/sql/display-sql.tcl?url=/doc/sql/community-core.sql">/doc/sql/community-core.sql</a>
+<li>Procedures:  within /tcl/user-group-defs.tcl<br>
+     <ul>
+         <li><a href=proc-one.tcl?proc_name=send_one_group_spam_message>send_one_group_spam_message</a>
+         <li><a href=proc-one.tcl?proc_name=send_all_group_spam_messages>send_all_group_spam_messages</a>
+         <li><a href=proc-one.tcl?proc_name=group_spam_removal_blurb>group_spam_removal_blurb</a>
+         <li><a href=proc-one.tcl?proc_name=bozo_filter_blurb>bozo_filter_blurb</a>
+     </ul>
+<li>Related modules: <a href="spam.html">Spam System</a> and <a href="email-handler.html">automatic email processing</a>
+</ul>
+
+<h3>The Big Picture</h3>
+
+This system is designed to handle group level spamming. The site-wide administrator or the group-level administrator can set the group spam policy to be "open", "closed", or "wait". For open spam policy, any member of the group can spam other members/administrators of the group. For "wait" spam policy, spam generated by group members needs to be approved by the group administrator first. For "closed" spam policy, only the group administrators are allowed to spam the group. For any spam policy, spams sent from group admin pages are immediately approved.
+
+<h3>Under the Hood</h3>
+<P>
+
+<ul>
+
+<li>The system allows each group member to set his/her own email preferences; i.e. a group member will receive group spams only if he sets his personal profile to receive spams. Personal email profile can be set at the user pages. Also, a <a href=proc-one.tcl?proc_name=group_spam_removal_blurb>group spam removal blurb</a> is added at the bottom of each group spam.
+
+<p>
+
+<li>The system also employs a user-level bozo filter. At the bottom of every group spam ( or any spam for that matter), a <a href=proc-one.tcl?proc_name=bozo_filter_blurb>bozo filter blurb</a> is (can be)appended, which is used to set or unset a filter against the specific sender. This filter can be used to prevent a user from any site-wide email from the sender.   
+
+<p>
+<li>The system supports personalization of emails - in the message body, one can use variables like &#60first_names> , &#60last_name>, &#60email>,&#60group_name>,&#60admin_email>, which are respectively replaced by the receiver's first name, last name, email, the group's name and the group's administrative email.
+
+<p>
+ 
+<li>We keep a history of all the spam we've sent to users in the <code>group_spam_history</code> table, which also serves as a queue to send approved but unsent mails.
+
+<p>
+
+<li>Forms that allow a publisher to spam generate a new spam_id for the blank form; this way a double click does not result in a spam being sent twice.
+
+<p>
+
+<li>When the administrator resets the group spam policy to be "open", all currently "waiting" spams are immediately approved and sent out.
+
+<p>
+
+<li>The system distinguishes between three different states of a spam - "approved", "disapproved", "waiting" ( approved_p is "t", "f", null respectively). In the group admin main page, it only lists spams that are "waiting" for administrator's approval. However, the spam-history page logs all group spams from which the administrator can also approve a previously dispproved email.    
+
+</ul>
+
+<p>
+
+<h3>Data Model</h3>
+
+This system consists of three tables. 
+
+The group_spam_history table holds the spamming log for this group. This log is used both for displaying the group/personal email history and as a queue to send approved but unsent emails.
+
+<blockquote>
+<pre>
+
+create table group_spam_history (
+	spam_id			integer primary key,
+	group_id		references user_groups not null,
+	sender_id		references users(user_id) not null,
+	sender_ip_address	varchar(50) not null,
+	from_address		varchar(100),
+	subject			varchar(200),
+ 	body			clob,
+	send_to			varchar (50) default 'members' check (send_to in ('members','administrators')), 
+	creation_date		date not null,
+	-- approved_p matters only for spam policy='wait'
+	-- approved_p = 't' indicates administrator approved the mail 
+	-- approved_p = 'f' indicates administrator disapproved the mail, so it won't be listed for approval again
+	-- approved_p = null indicates the mail is not approved/disapproved by the administrator yet 
+	approved_p		char(1) default null check (approved_p is null or approved_p in ('t','f')),
+	send_date		date,
+	-- this holds the number of intended recipients
+	n_receivers_intended	integer default 0,
+	-- we'll increment this after every successful email
+	n_receivers_actual	integer default 0
+);
+</pre>
+</blockquote>
+
+<P>
+The group_member_email_preferences table retains email preferences of members that belong to a particular group.
+ 
+<blockquote>
+<pre>
+create table group_member_email_preferences (
+	group_id		references user_groups not null,
+	user_id			references users not null ,
+	dont_spam_me_p		char (1) default 'f' check(dont_spam_me_p in ('t','f')),
+	primary key (group_id, user_id)  
+);
+</pre>
+</blockquote> 
+
+The user_user_bozo_filter table contains information to implement a personalized "bozo filter". Any user ( origin_user_id) can restrain any emails from some other user ( target_user_id ). This table is not specific to a group.
+
+<pre>
+<blockquote> 
+create table user_user_bozo_filter (
+	origin_user_id	references users not null,
+	target_user_id	references users not null,
+	primary key (origin_user_id, target_user_id)
+);
+</pre>
+</blockquote> 
+
+
+<h3>Legal Transactions</h3>
+From the group administration pages, the administrator can 
+
+<ul>
+<li>Set the group spam policy
+<li>Send spam to group members
+<li>Send spam to group administrators
+<li>View spam history of the group
+<li>View individual spam 
+<li>Approve/dispprove a specific spam
+</ul>
+<P>
+
+From the user pages, a group member can 
+
+<ul>
+<li>Set his/her persoanl email preference
+<li>Send spam to group members
+<li>Send spam to group administrators
+<li>View his/her own spam history
+<li>View individual spam 
+</ul>
+<P>
+
+<p>
+
+<hr>
+
+<a href=mailto:ahmeds@mit.edu><address>ahmeds@mit.edu</address></a>
+</body>
+</html>
+
+
+
+
+
+
+
Index: web/openacs/www/doc/help.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/help.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/help.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,205 @@
+<html>
+<head>
+<title>Help System</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+
+<table>
+<tr>
+<td>
+<a href="http://photo.net/photo/pcd0834/helgumannen-60.tcl"><img HEIGHT=198 WIDTH=132 src="http://photo.net/photo/pcd0834/helgumannen-60.1.jpg" ALT="Old fishing hamlet of Helgumannen.  Faro, Gotland. Sweden"></a>
+
+
+<td>
+
+<h2>Help System</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+</tr>
+</table>
+
+<hr>
+
+<ul>
+<li>User directory: /help/
+<li>User directory (complete system guide): /help/guide/
+<li>Admin directory: /admin/help/
+<li>Admin directory (complete system guide): /admin/help/guide/
+<li>Data model: none (file system-based)
+<li>procedures (includes ADP tags): /tcl/help-defs.tcl
+</ul>
+
+<h3>The Big Idea</h3>
+
+We want a standard way of documenting a site for end-users.  We need
+
+<ul>
+
+<li>documentation for the whole site that gives a new user or
+administrator a high-level perspective of system capabilities
+
+<li>documentation of individual pages 
+
+<li>documentation of words or phrases 
+
+</ul>
+
+We want to achieve the following technical objectives:
+
+<ul>
+
+<li>we only have to change documentation style (e.g., background color,
+font design) in one place
+
+<li>a single documentation file can be authored in such a way that users
+with different levels of privilege or service will see only the relevant
+portion
+
+<li>documentation authors can continue to use familiar tools, e.g.,
+tools that are optimized for authoring HTML (perhaps with a few extra
+tags) 
+
+</ul>
+
+<h3>The Medium-sized Idea</h3>
+
+The high level documentation is in traditionally authored directories of
+HTML files, but we augment HTML with a set of additional tags to enforce
+site-wide style conventions (these will be a superset of the site-wide
+style tags used by online pages, as described in <a
+href="/doc/style.html">/doc/style.html</a>).  The augmentation also provides for tags
+that will switch on a section only if a user has selected a particular
+feature (for example, in a documentation production site, only users
+whose companies have elected "fancy workflow authorization" will see
+sections related to that).  Sometimes we augment HTML in order to
+provide greater convenience for the documentation authors, for example,
+we provide by default a <code>glossterm</code> tag that saves a doc author from
+having to hard-code in a link to the ACS glossary module: 
+<code>/glossary/one.tcl?term=film</code>.
+
+<p>
+
+The page-level documentation is stored in conventionally named files
+underneath the Web server root.  Support is provided for multi-lingual
+documentation.
+
+<p>
+
+The standard ACS /glossary module is used to provide word and phrase
+definitions.
+
+<h3>Under the hood</h3>
+
+We use ADP pages to create all documentation.  This allows us to register
+special tags using <code>ns_register_adptag</code>.  These special
+tags help enforce site-wide style conventions as well as providing a
+mechanism that will act as a switch for a particular section.  For
+instance, the code run by the special tag may check whether or not the
+user is a member of a particular user group.  If the user is in the
+group, then the procedure returns the string between the tags with the
+appropriate font and formating.  If the user is not in the group, then
+the procedure returns the empty string.
+
+<p>
+
+We place a call to <code>help_link</code> on every page that could
+potentially have a help file.  This procedure determines whether or
+not there actually is a help file associated with the given file.  If
+a help file exists, <code>help_link</code> returns a string containing
+a link to a page that will serve the requested help file.  If no help
+file exists then the empty string is returned.
+
+<p>
+
+We name all page-level help files with the same filename as the page
+that they document, with a .help extension.  For instance, if we have
+a URL named foo.tcl, the help file will be named foo.help.  If a
+multi-lingual help system is in place then the help file in english
+will be foo.en.help (the help file in french will be foo.fr.help,
+etc.).  Language encoding and the sorting out of user preferences are
+as described in <a href="/doc/style.html">/doc/style.html</a>.
+
+<p>
+
+These help files reside in a directory hierarchy mirroring that of the
+files that they document, rooted at a location specified by the
+HelpPageRoot parameter in the ns/server/servername/acs/help section of
+the server's auxiliary .ini file. This parameter specifies the root of
+the help file's directory hierarchy as a relative path from the server's
+page root, so HelpPageRoot=/help would specify that all help files lived
+under /web/servername/www/help. Leaving it blank specifies that the help
+page root is the same as the server's page root, so .help files reside
+in the same directories as their corresponding .tcl files.
+
+<p>
+
+.help files are registered to be interpreted as ADP files so that they
+can be viewed directly, in order to aid in their development.
+
+<h3>If you really love our ideas...</h3>
+
+If you really really love the photo.net/ACS style then you'll have kept
+the Yahoo-style context/navigation bars above the top HR in most of your
+scripts.  It seems to us that a natural companion to this is a help link
+just underneath the HR and to the far right of the page.  As long as
+we've got that, we might as well also include other options that are
+sort of outside the normal realm and flow of what a user might be doing
+with the page.  For example, an "administer" link could go there.
+
+<p>
+
+To faciliate this style of programming, we've defined
+<code>help_upper_right_menu</code> which takes an arbitrary number of
+optional args, each of which is a list of URL and anchor (similar to the
+<code>ad_context_bar</code> args).  These are extra options on the menu
+and they will be displayed in the order supplied, followed by a help
+link (if the .help file is found in the file system).
+
+
+
+<h3>The Steps</h3>
+
+<ul>
+
+<li>decide whether you want to go multi-lingual or not.
+
+<li>decide what types of things you would like to standardize.  Examples
+could be setting a specific, easily changable font or linking glossary terms
+to their definitions.
+
+<li>define a special tag for each type of item that should be standardized.
+
+<li>define a special tag for each type of content switch you would like
+to have (for instance, if you only want to show the workflow section to
+specific companies, you can wrap the workflow section in a
+<code>&lt;workflow&gt;</code> tag).
+
+<li>insert calls to <code>help_link</code> in your .tcl scripts and .adp
+templates
+
+</ul>
+
+<hr>
+
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+
+</body>
+</html>
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/doc/homepage.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/homepage.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/homepage.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,1444 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Homepage</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Homepage</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://web.mit.edu/mobin/web">mobin</a>
+<br>
+<hr>
+
+<ul>
+<li>worldViewableContent:  <a href="/users/">/users/</a>
+<li>siteAdministratorDirectory:  <a href="/admin/users/">/admin/users/</a>
+<li>userHomepageMaintenance:  <a href="/homepage/">/homepage/</a>
+<li>dataModel:  <a href="/doc/sql/display-sql.tcl?url=/doc/sql/homepage.sql">/doc/sql/homepage.sql</a>
+<li>TclProcs:  /tcl/homepage-defs.tcl 
+<li>userContent:  /web/servername/users/ (determined by [ad_parameter ContentRoot users])
+</ul>
+
+<i>since ACS 3.1</i>
+
+<h3>0&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Introduction</h3>
+
+The homepage module is about users maintaining their homepages and
+publishing web content.
+<p>
+
+<b>0.1&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Abilities</b>
+<p>
+
+The Homepage Module gives users of the site the ability to publish
+content on the world-wide-web. The users can create their own
+heirarchical directory structure to organize their content on the
+site. The not-so-advanced users and others who want to publish large
+amounts of content and wish to give their content a consistent look,
+can create special "managed content" directories in their file
+system. This would be useful for publishing content like books etc
+which require a considerable level of consistency between all the
+parts (chapters in the case of books) of the publication. This in no
+way hampers the endeavours of advanced html publishers who would like
+to maintain their own filesystem since they can choose not to use
+content managed directories and have full control over the look and
+feel of their web pages.
+<p>
+
+<b>0.2&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Inabilities</b>
+<p>
+
+The homepage module does not let users to author server side scripts,
+althought users are free to use client side scripts in html using the
+<code>&lt;script&gt;</code> tag. The module does not provide users with a database
+handle and therefore cannot be used to author database backed
+webpages.
+<p>
+
+<h3>1&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;User's Manual</h3>
+
+This section provides information regarding the use of the homepage
+module by the end users. Users have the facility to have their
+webpages on the system if the homepage module is enabled on their
+system. The users do not need to know html really, but they can learn
+sufficient html within five blinks of an eye by reading the lower
+parts of sections 1.1.4.2 and 1.1.4.5.1 of this document.
+<p>
+
+<b>1.1&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Homepage Maintenance</b>
+<p>
+
+If the homepage module is enabled in your system, three links should
+appear in your workspace: "Homepage Maintenance", "Neighborhoods", and
+"User Homepages". The "Homepage Maintenance" link is for maintining
+you own homepage and mainting the content you publish. The
+"Neighbourhoods" page is for browsing through neighbourhoods and
+viewing their members or joining one of them. You can leave your
+neighbourhood by clicking on "leave it!" link on the neighbourhoods
+page (this link appears only when you are the member of a
+neighbourhood).
+<p>
+
+1.1.1&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Neighbourhoods Page
+<p>
+The neighbourhoods page lets you browse through neighbourhoods. You
+can join a neighbourhood by clicking on the [join] button besides a
+neighbourhood's entry in the list. Similarly, the [members] button
+lets you view all the members of a neighbourhood. As a normal user,
+you cannot create, modify, delete, move, or rename neighbourhoods. An
+attempt at doing so will result only in a meaningless error message
+such as "Insufficient permission to perform requested database access
+in AddNeighborhood". The neighbourhoods page is located at
+/homepage/neighbourhoods.tcl. Alternatively, there is a link to it
+from your workspace.
+<p>
+
+1.1.2&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;User Homepages
+<p>
+A list of the users who have initialized their webspace (webspace
+initialization is discussed in 1.1.3) can be seen at
+/homepage/all.tcl. There is a link to it, marked as "User Homepages",
+at your workspace.
+<p>
+
+1.1.3&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Webspace Initialization
+<p>
+
+This section discusses using the "homepage maintenance" option for the
+first time.
+<p>
+
+1.1.3.1&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Root Directory Creation
+<p>
+You need to initialize your webspace before you can use the homepage
+module for the first time. When you attempt to go to the "Homepage
+Maintenance" page from your workspace or by visiting /homepage/, a
+message appears which reads "Your webspace has not been activated
+yet. Click here to set it up for the first time." Just click on "here"
+in the "... Click here to ..." and your webspace will be
+initialized. This process should take about a few hundred
+microseconds. In this process, the system creats a root directory for
+you and this is depicted by the consumption of some meagre amount of
+your quota space (typically 2,048 bytes). Once it is done, you can
+start maintaining your webpage if you already have a screen name set up.
+<p>
+
+1.1.3.2&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Setting up a screen name
+<p>
+If you have initialized your webspace but do not have a screen name
+yet, the "homepage maintenance" page /homepage/ displays a message
+with reads "You have not set up a screen name as yet. Click here to
+set one up.". You can set up your screen name by clicking on the
+"here" or alternatively, you can set up your screen name by clicking
+on the "update" link in your "Basic Information" section in your
+workspace /pvt/home.tcl.
+<p>
+
+1.1.4&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Homepage Maintenance Page
+<p>
+The homepage maintenance page is at /homepage/. You use it to maintain
+your web content once your webspace has been initialized and you have
+set up a screen name for yourself.
+<p>
+
+1.1.4.1&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Customizing your Maintenance and Public Pages
+<p>
+You can change the display settings of your maintenance page by
+clicking on the [display-settings] link in the lower right of the
+page. There are two types of settings: settings for public pages, and
+settings for maintenance pages. The settings will affect your public
+and maintenance pages respectively. Your public pages are the pages
+shown to the entire world and are available at
+http://yourdomain.com/users/your_screen_name. Your maintenance page is
+/homepage/, the page through which you maintain your webspace. You can
+also customize the way you view your files. The directory listing can
+be normal or hierarchical. This can be set using the [ normal view |
+tree view ] buttons at the upper right of the screen. By clicking on a
+directory, you browse its content (in the normal view), or you browse
+content rooted at it (in the tree view).
+<p>
+
+1.1.4.2&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Creating Files
+<p>
+You can create files by clicking on the "create file" link. You will
+be prompted for the name, and an empty file with that name will be
+created. Mind however that to be able to invoke the editor on a file,
+it should have a .text, .html, .htm, .txt or anyother extension that
+represents a mime type of text/*. If you're unsure of what this means,
+just end the filename in .html if it's an html file or .text if it's a
+text file. If you do not know html then, for your own good, I advise
+you to learn it. It is a very good advice. Take it. Html is very very
+easy to learn. Meanwhile, you can just name your files ending with
+.text or just use the "publish content" option. It requires no
+knowledge of html. The created file is placed in the directory you are
+currently browsing. Html files have the following format:<br>
+<code>
+<code>&lt;html&gt;</code><br>
+<code>&lt;head&gt;</code><br>
+<code>&lt;title&gt;</code><i>title-goes-here</i><code>&lt;/title&gt;</code><br>
+<code>&lt;/head&gt;</code><br>
+<code>&lt;body&gt;</code><br>
+<br>
+<i>body-text-goes-here</i><br>
+<br>
+<code>&lt;/body&gt;</code><br> <code>&lt;/html&gt;</code><br> </code><br> To learn about the
+things you can do in the body text, read the lower half of section
+1.1.4.5.1 of this document
+
+<p>
+
+1.1.4.2.1&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Index files and generated indices
+<p>
+If a web user requests a file from your webspace which is actually a
+directory, then the system generates a default index page for it. The
+format of the index page is such: your portrait (if you uploaded one
+following the links in your workspace) in the top right, your name as
+heading, and "webspace at your-system-name" as subheading. Then it
+displays a listing of files in the directory. If you do not wish to
+have a generated index, you can create an index file in that
+directory. By default filenames index.html, index.htm, and Default.htm
+will be treated by the system as index files and will be served when a
+directory is requested by the web browser. The presence of an index
+file makes it impossible for the web browser to lit the contents of
+that directory.
+<p>
+
+1.1.4.3&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Uploading Files
+<p>
+You can upload files from your local computer to your homepage
+webspace by clicking on the "upload file" link. You can either type
+the full filename on the local filesystem or press the browse button
+to browse your local filesystem to select the file you want to
+upload. Please mind your limited quota space before deciding on which
+files to upload.
+<p>
+
+1.1.4.4&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Creating Folders
+<p>
+Create folders using the "create folder" link. You are prompted for a
+folder name and a description. Choose a nice description for your
+folders as these descriptions are displayed alongside the folder name
+in the generated index pages which the world sees. You can remove,
+rename, or move folders by using the remove, rename, and move links
+respectively. A folder which is not empty cannot be deleted.
+<p>
+
+1.1.4.5&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Invoking the Content Manager
+<p>
+Click the "publish content" link to publish managed content on your
+site. You have to provide four parameters to the content manager: the
+content type, short name, full name, and subsections. Content type
+determines the type of your content. It can be anything from "book",
+"magazine", "newsletter", "encyclopedia", to anything you can come up
+with. The short name is a short name which describes the content. A
+specially marked folder with that name is created to store the
+content. The full name is the full name of your content. For example,
+if you're publishing your book then this ought to be the complete
+title of the book etcetra. In subsections, provide what one subsection
+of the content is called. For a book, this could be "chapter". If the
+content type is chapter, this could be "section". Please mind that you
+must provide a singular in this field.
+<p>
+
+1.1.4.5.1&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Managing Content
+<p>
+I will illustrate this with an example. Suppose I click on "publish
+content" and create content of type "magazine", short name "mobmag",
+full name "Mobin's Foolish Magazine", and subsections "article". This
+tells the content manager that I wish to publish a magazine which is
+composed of articles (multiple level hierarcies in content is possible
+but not discussed here). The content manager creates a folder "mobmag"
+(which is marked as a a magazine). When I click on "mobmag" to browse
+its contents, I see one file in it already, "Introductory Text". You
+can only edit or remove this file. The web viewer sees the contents of
+this file on the main magazine page (in this case
+http://mydomain.com/users/mobin/mobmag/) above the table of
+contents. To add an article, click on the "add article" link. This
+adds an empty article which you can then edit. While creating
+articles, choose meaningful descriptions for them. You can use html in
+these files if you want. This gives you the ability to show uploaded
+photos i your web content. The contents of these files are pasted
+within larger html files when these are served so you should not use
+the <code>&lt;html&gt;</code>, <code>&lt;title&gt;</code>,
+<code>&lt;body&gt;</code> etcetra tags. Also, since these files are
+really html, you will need to escape <code>&lt</code>,
+<code>&gt</code>, and <code>&</code> with <code>&amp;lt</code>,
+<code>&amp;gt</code> and <code>&amp;amp</code> respectively if any of these are
+used as text. So you can enclose text within the
+<code>&lt;h2&gt;</code> and <code>&lt;/h2&gt;</code> to make it a
+second level heading, <code>&lt;b&gt;</code> and
+<code>&lt;/b&gt;</code> to make it bold, <code>&lt;i&gt;</code> and
+<code>&lt;/i&gt;</code> to make it italicised and more importantly,
+you can use something like <code>&lt;a href=http://<i>whatever
+address</i>&gt;</code><i>whatever link name</i><code>&lt;/a&gt;</code>
+to provide a link to any addess on the web. Also, you can have
+something like <code>&lt;img src=<i>picture-filename</i>&gt;</code> to
+display the picture which has the name <i>picture-filename</i>. This
+way you can upload picture files and then show them in your documents.
+<p>
+
+1.1.4.5.2&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Deleting Managed Directories
+<p>
+Delete all files in a managed directory by using the remove links next
+to them and then go to the parent directory and then remove the
+managed directory.
+<p>
+
+<h4>1.2&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Sitewide Administration</h4>
+
+Administration features are available even if the module is not
+enabled. Administration is tied into users administration
+/admin/users/ and administrators can additionally change a user's
+screen name, change user's quota space, or become a user. This last
+one, reminiscent of the unix command "su" is a very powerful
+feature. Administration comes in three flavours really: user
+administration, neighbourhood administration, and user content
+administration.
+<p>
+
+1.2.1&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;User Administration
+<p>
+
+User administration is the same as has been before. Its directory is
+/admin/users/ However, the homepage module has introduced the concept
+of user quotas. Also, there had been a long felt need for screen names
+for users in ACS. With the homepage module, this need exceeded the
+threshold level and we incorporated them into the main ACS users
+table. The administration of screen names and user quotas is done via
+/admin/users/ Thus the homepage module doesn't really have a site wide
+administration directory of its own. Its administration is mainly done
+via /admin/users/
+<p>
+
+1.2.2&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Neighbourhood Administration
+<p>
+
+Administration of neighbourhoods is done at
+/homepage/neighbourhoods.tcl. This page will hereby be referred to as
+the "neighbourhoods page". If the homepage module is enabled in your
+system, a link should appear to the neighbourhoods page at your
+workspace. The neighbourhoods page is essentially for browsing through
+neighbourhoods, viewing their members or even joining a
+neighbourhood. Additionally, site wide administrators can create
+neighbourhoods by pressing the [create-neighborhood] button above the
+neighbourhoods listing; remove neighbourhoods by pressing the [remove]
+button besides a neighbourhoods name; change neighbourhood hierarchy
+by pressing the [move] button and moving neighbourhoods around; or
+change the name or description of a neighbourhood by pressing the
+[rename] button besides a neighbourhood name. Administrators should
+mind the five hundred letter maximum limit on neighbourhood names and
+a four thousand letter limit on neighbourhood descriptions.
+<p>
+
+1.2.3&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;User Content Administration
+<p>
+
+Situations may arise where an administrator will need to remove user
+content or take other such actions etcetra. In such a situation, the
+administrator can go to /admin/users/, search for the appropriate user
+and click on the "become this user!" link. This allows the
+administrator to become any user he or she might need to. (Just like
+the unix "su" command which lets the root swith into other
+users). This means that now administrators can do anything that a user
+can do. Administrators could become other users previously (by
+forcibly changing their password and logging in as them) but this is a
+much cleaner and acceptable way of doing that. Ofcourse,
+administrators must not misuse this feature and should use it only to
+administer when other means are unavailable.
+<p>
+
+
+<h3>2&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Technical Documentation</h3>
+
+This section describes the mechanics of the homepage module and
+concerns developers. Sections 2.1 to 2.4 discuss the different
+components of the module: User Quota Management, Filesystem and Access
+Management, Content Management, and Neighbourhood Management. Section
+2.5 talks about how we connect these four components together.
+<p>
+
+<h4>2.1&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;User Quota Management</h4>
+
+Users of the system have a limited max quota for storing their web
+content and uploaded files. The default values for the quotas are
+determined by some of the variables in the ad.ini file.
+<p>
+<code>
+;&nbsp;Maximum&nbsp;quota&nbsp;for&nbsp;a&nbsp;'normal&nbsp;user'&nbsp;(a&nbsp;lesser&nbsp;mortal&nbsp;who&nbsp;&nbsp;is&nbsp;not&nbsp;the&nbsp;<br>
+;&nbsp;site&nbsp;wide&nbsp;administrator)&nbsp;of&nbsp;the&nbsp;site&nbsp;in&nbsp;mega-bytes.&nbsp;For&nbsp;example,&nbsp;a&nbsp;<br>
+;&nbsp;'20'&nbsp;corresponds&nbsp;to&nbsp;20,971,520&nbsp;bytes.&nbsp;Values&nbsp;need&nbsp;not&nbsp;be&nbsp;&nbsp;integer.&nbsp;<br>
+;&nbsp;Value&nbsp;is&nbsp;overridden&nbsp;for&nbsp;a&nbsp;&nbsp;particular&nbsp;user&nbsp;&nbsp;throught&nbsp;existence&nbsp;&nbsp;of&nbsp;<br>
+;&nbsp;entry&nbsp;in&nbsp;the&nbsp;users_special_quotas&nbsp;table.<br>
+NormalUserMaxQuota=5<br>
+<br>
+;&nbsp;Maximum&nbsp;quota&nbsp;for&nbsp;site&nbsp;wide&nbsp;administrators.&nbsp;&nbsp;Special&nbsp;quotas&nbsp;can&nbsp;be&nbsp;<br>
+;&nbsp;set&nbsp;by&nbsp;adding&nbsp;rows&nbsp;to&nbsp;&nbsp;the&nbsp;users_special_quotas&nbsp;table.&nbsp;&nbsp;This&nbsp;param<br>
+;&nbsp;will&nbsp;be&nbsp;used&nbsp;for&nbsp;a&nbsp;site&nbsp;wide&nbsp;administrator&nbsp;only&nbsp;when&nbsp;he/she&nbsp;doesnt<br>
+;&nbsp;have&nbsp;an&nbsp;entry&nbsp;in&nbsp;the&nbsp;users_special_quotas&nbsp;table.<br>
+PrivelegedUserMaxQuota=20<br>
+<br>
+;&nbsp;Space&nbsp;taken&nbsp;by&nbsp;a&nbsp;directory&nbsp;(in&nbsp;bytes).&nbsp;We&nbsp;need&nbsp;this&nbsp;so&nbsp;that&nbsp;a&nbsp;user&nbsp;<br>
+;&nbsp;cannot&nbsp;crash&nbsp;the&nbsp;system&nbsp;by&nbsp;creating&nbsp;millions&nbsp;of&nbsp;directories.&nbsp;&nbsp;This&nbsp;<br>
+;&nbsp;will&nbsp;ensure&nbsp;that&nbsp;a&nbsp;directory&nbsp;detracts&nbsp;from&nbsp;his/her&nbsp;quota.<br>
+DirectorySpaceRequirement=2048<br>
+</code>
+<p>
+
+NormalUserMaxQuota and PrivelegedUserMaxQuota are specified in
+megabytes... which means that a 5 for example, corresponds to a quota
+space of 5,242,880 bytes. DirectorySpaceRequirement determines the
+amount of bytes to detract from the user's available quota for every
+directory he or she creates. This is useful because directories do
+take up space on the filesystem and we do not want to give a user the
+license to harm our system by creating a few hundred thousand
+directories.
+<p> 
+
+Users can have special quotas if they have an entry in the
+users_special_quotas table:
+<p>
+<pre><code>
+-- users have their quotas specified by [ad_parameter PrivelegedUserMaxQuota 
+-- users] or [ad_parameter  NormalUserMaxQuota users]  depending on  whether 
+-- they are site wide administrators or not. However, some users might  have 
+-- special quotas which can be granted  by site  wide administrators.  These 
+-- quotas are recorded in the users_special_quotas table. If a  user has  an 
+-- entry in this table then the above mentioned parameter values are ignored 
+-- and instead max_quota is used as his/her quota space.
+
+create table users_special_quotas (
+	user_id			integer primary key references users,
+	max_quota		number not null,
+	modification_date	date default sysdate not null
+);
+</code></pre>
+<p>
+
+An entry in this table overrides the default quotas specified by the
+parameters. Special quotas can be assigned/removed only by site wide
+administrators using the users admin pages /admin/users/
+<p>
+This dichotomy of user quota values (special quotas in Oracle and
+default quotas in parameters) results in long sql queries when
+querying the database from Tcl files for remaining quota space for a
+user. For example:
+<p>
+<pre>
+select ((decode((select count(*) from
+                users_special_quotas
+                where user_id=$user_id),
+                0, [ad_parameter [ad_decode $admin_p \
+                         0 NormalUserMaxQuota \
+                         1 PrivelegedUserMaxQuota \
+                         NormalUserMaxQuota] users],
+                (select max_quota from
+                 users_special_quotas
+                 where user_id=$user_id))) * power(2,20)) -
+      ((select count(*) * [ad_parameter DirectorySpaceRequirement users]
+        from users_files
+        where directory_p='t'
+        and owner_id=$user_id) +
+       (select nvl(sum(file_size),0)
+        from users_files
+        where directory_p='f'
+        and owner_id=$user_id)) as quota_left
+from dual
+
+</pre>
+
+<p>
+Following is the PL/SQL code used in user quota management:
+<p>
+This function returns the maximum quota space available to the user. It takes in the user_id, the default quota for normal users, the default quota for abnormal users, and whether this user is abnormal or not.
+<pre>
+create or replace function hp_user_quota_max (userid IN integer, lesser_mortal_quota IN integer, higher_mortal_quota IN integer, higher_mortal_p IN integer)
+return integer
+IS
+	quota_max		integer;
+	special_count		integer;
+	return_value		integer;
+BEGIN
+	select count(*) into special_count
+	from users_special_quotas
+        where user_id=userid;
+
+	IF special_count = 0
+	THEN
+		IF higher_mortal_p = 0
+		THEN
+			select (lesser_mortal_quota * power(2,20)) 
+			into return_value
+			from dual;
+			return return_value;
+		ELSE
+			select (higher_mortal_quota * power(2,20)) 
+			into return_value
+			from dual;
+			return return_value;
+		END IF;
+	ELSE
+		select max_quota into quota_max
+		from users_special_quotas
+                where user_id=userid;
+		select (quota_max * power(2,20)) 
+		into return_value
+		from dual;
+		return return_value;
+	END IF;
+END;
+/
+show errors
+</pre>
+Same as above, only that it does not need to know whether the person is a normal user or not.
+<pre>
+create or replace function hp_user_quota_max_check_admin (userid IN integer, lesser_mortal_quota IN integer, higher_mortal_quota IN integer)
+return integer
+IS
+	quota_max		integer;
+	special_count		integer;
+	return_value		integer;
+	higher_mortal_p		integer;
+BEGIN
+	select count(*) into special_count
+	from users_special_quotas
+        where user_id=userid;
+
+	select count(*) into higher_mortal_p
+	from user_group_map ugm
+	where ugm.user_id = userid
+	and ugm.group_id = system_administrator_group_id;
+
+	IF special_count = 0
+	THEN
+		IF higher_mortal_p = 0
+		THEN
+			select (lesser_mortal_quota * power(2,20)) 
+			into return_value
+			from dual;
+			return return_value;
+		ELSE
+			select (higher_mortal_quota * power(2,20)) 
+			into return_value
+			from dual;
+			return return_value;
+		END IF;
+	ELSE
+		select max_quota into quota_max
+		from users_special_quotas
+                where user_id=userid;
+		select (quota_max * power(2,20)) 
+		into return_value
+		from dual;
+		return return_value;
+	END IF;
+END;
+/
+show errors
+</pre>
+This function tells us the amount of quota space used by a user (in bytes). It takes in the directory space requirement and the user id.
+<pre>
+create or replace function hp_user_quota_used (userid IN integer, dir_requirement IN integer)
+return integer
+IS
+	return_value		integer;
+	file_space		integer;
+	dir_space		integer;
+BEGIN
+	select (count(*) * dir_requirement) into dir_space 
+        from users_files
+        where directory_p='t'
+        and owner_id=userid;
+
+	select nvl(sum(file_size),0) into file_space
+        from users_files
+        where directory_p='f'
+        and owner_id=userid;
+
+	return_value := dir_space + file_space;
+
+	return return_value;
+END;
+/
+show errors
+</pre>
+This function tells us the amount of quota space available to a user (in bytes). It takes in the directory space requirement, the user id, default quotas, and 'normality' of the user.
+<pre>
+create or replace function hp_user_quota_left (userid IN integer, lesser_mortal_quota IN integer, higher_mortal_quota IN integer, higher_mortal_p IN integer, dir_requirement IN integer)
+return integer
+IS
+	return_value		integer;
+BEGIN
+	select (hp_user_quota_max(userid, lesser_mortal_quota, higher_mortal_quota, higher_mortal_p) - hp_user_quota_used(userid, dir_requirement))
+	into return_value
+	from dual;
+
+	return return_value;
+END;
+/
+show errors
+</pre>
+Same as above but does not need to know whether user is normal (non-admin) or not. 
+<pre>
+create or replace function hp_user_quota_left_check_admin (userid IN integer, lesser_mortal_quota IN integer, higher_mortal_quota IN integer, dir_requirement IN integer)
+return integer
+IS
+	return_value		integer;
+BEGIN
+	select (hp_user_quota_max_check_admin(userid, lesser_mortal_quota, higher_mortal_quota) - hp_user_quota_used(userid, dir_requirement))
+	into return_value
+	from dual;
+
+	return return_value;
+END;
+/
+show errors
+
+
+</pre>
+<p>
+<h4>2.2&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Filesystem and Access Management</h4>
+
+User files are stored on the filesystem. They are not stored as BLOBs
+in Oracle. This is due to the fact that serving content from the
+database keeps the database handle engaged for the entire duration of
+the transmission (unless we come up with a way to first read the BLOB
+in a C structure and then serve the content after conveniently
+releasing the handle). Nevertheless, as I was saying, we store user
+content on the filesystem. The content is rooted at [ad_parameter
+ContentRoot users]:<br>
+<pre>
+; all user  web content will be rooted  under  this directory.  This
+; directory will be the root of  all the web content being published
+; by the users of the system.
+ContentRoot=/web/acsdev/users/
+</pre>
+Each user's personal content is rooted under [ad_parameter ContentRoot
+users]$user_id where $user_id is the user's unique id in the users
+table.
+<p>
+We do store meta data in the users_files table:<br>
+<pre>
+-- We use this sequence to assign values to file_id. The 
+-- reason for starting from 2 is that no file is special 
+-- enough to have file_id=1, or is there a file that is?
+
+create sequence users_file_id_seq start with 2;
+
+create table users_files (
+	file_id			integer primary key,
+	-- the maximum filesize in unix is 255 characters (starting from 1)
+	filename		varchar(255) not null,
+	directory_p		char(1) default 'f', 
+	constraint users_dir_ck check(directory_p in ('t','f')),
+	file_pretty_name	varchar(500) not null,
+	-- this is the number of bytes the files takes up on the file 
+	-- system. We will use these values to determine quota  usage 
+	-- except where directory_p is true. In that case, we'll  use 
+	-- [ad_parameter DirectorySpaceRequirement users] to see  the 
+	-- amount of quota space consumed by a directory. Thus, if we 
+	-- magically manage to change the file system,  we dont  have 
+	-- to update  file_size for  directories here  because it  is 
+	-- irrelevent.
+	managed_p		char(1) default 'f' check(managed_p in ('t','f')),
+	-- this column is used for files created by the content
+	-- publishing system which the user cannot rename or move
+	modifyable_p		char(1) default 't' check(modifyable_p in ('t','f')),
+	file_size		number not null,
+	content_type		references users_content_types,
+	-- points to the user_id of the user who owns this file.
+	owner_id		integer not null references users,
+	-- points to the file_id of the directory which contains 
+	-- this file. Useful for supporting hierarchical content 
+	-- structure.
+	parent_id		integer references users_files
+);
+
+create index users_files_idx1 on users_files(file_id, parent_id);
+
+create index users_files_idx2 on users_files(parent_id, file_id);
+
+create index users_files_idx3 on users_files(owner_id);
+
+</pre>
+Here is the PL/SQL code used for filesystem management (the
+filesystemManagement codeBlock is the largest PL/SQL codeblock in the
+homepage module:
+<br>
+This function returns the full filename (relative to the content root)
+of the file specified by the filesystem_node input. The
+filesystem_node is the file_id of the file in the users_files table.
+<pre>
+-- returned value is a filename that does not begin with a slash
+create or replace function hp_true_filename (filesystem_node IN integer)
+return varchar2
+IS
+	CURSOR name_cursor IS
+		select filename from users_files
+		where file_id=filesystem_node;
+	CURSOR parent_cursor IS
+		select parent_id from users_files
+		where file_id=filesystem_node;
+	fullname	varchar(500);
+	parentid	integer;
+BEGIN
+	OPEN parent_cursor;
+	OPEN name_cursor;
+	FETCH parent_cursor INTO parentid;
+	FETCH name_cursor INTO fullname;
+	CLOSE parent_cursor;
+	CLOSE name_cursor;
+	IF parentid is null
+	THEN 
+		return fullname;
+	ELSE
+		return CONCAT(hp_true_filename(parentid), CONCAT('/',fullname));
+	END IF;	
+END;
+/
+show errors
+</pre>
+This function takes in a filesystem node fsid and a user id u_id and
+returns 0 if the user has access permission to this file otherwise
+returns 1. Access management is abstracted out here so that we can
+change this function when changing our access management package.
+<pre>
+create or replace function hp_access_denied_p (fsid IN integer, u_id IN integer)
+return integer
+IS
+	CURSOR owner_cursor IS
+		select owner_id from users_files
+		where file_id=fsid;
+	owner_id	integer;
+BEGIN
+	OPEN owner_cursor;
+	FETCH owner_cursor INTO owner_id;
+	CLOSE owner_cursor;
+	IF owner_id = u_id
+	THEN
+		return 0;
+	ELSE
+		return 1;
+	END IF;
+END;
+/
+show errors
+</pre>
+Generates a unique sortkey for each file which gives us the ability to
+order files within branches of the tree view that CONNECT BY doesn't
+let us do.
+<pre>
+-- returned value is a varchar2 which is the sort key
+-- Uses the fact that the full filename of each file has
+-- to be unique.
+create or replace function hp_filesystem_node_sortkey_gen (filesystem_node IN integer)
+return varchar2
+IS
+	CURSOR plsql_is_stupid IS
+		select filename, 
+                       decode(directory_p,'t','0','1') as dp,
+                       parent_id 
+                from users_files
+		where file_id=filesystem_node;
+	fullname	varchar(500);
+	parentid	integer;
+	dir_p		varchar(1);
+	plsql_val	plsql_is_stupid%ROWTYPE;
+	discriminator	varchar(5);  -- useful for discriminating between files and directories
+BEGIN
+	OPEN plsql_is_stupid;
+	FETCH plsql_is_stupid into plsql_val;
+	dir_p := plsql_val.dp;
+	fullname := plsql_val.filename;
+	parentid := plsql_val.parent_id;
+
+	IF parentid is null
+	THEN 
+		return CONCAT(dir_p, fullname);
+	ELSE
+		return CONCAT(hp_filesystem_node_sortkey_gen(parentid), CONCAT('/', CONCAT(dir_p,fullname)));
+	END IF;	
+END;
+/
+show errors
+</pre>
+This function returns the full filename (relative to the user's root)
+of the file specified by the filesystem_node input. The
+filesystem_node is the file_id of the file in the users_files table.
+<pre>
+-- returns a filename beginning with a slash, unless the file is user's root
+create or replace function hp_user_relative_filename (filesystem_node IN integer)
+return varchar2
+IS
+	CURSOR name_cursor IS
+		select filename from users_files
+		where file_id=filesystem_node;
+	CURSOR parent_cursor IS
+		select parent_id from users_files
+		where file_id=filesystem_node;
+	fullname	varchar(500);
+	parentid	integer;
+BEGIN
+	OPEN parent_cursor;
+	OPEN name_cursor;
+	FETCH parent_cursor INTO parentid;
+	FETCH name_cursor INTO fullname;
+	CLOSE parent_cursor;
+	CLOSE name_cursor;
+	IF parentid is null
+	THEN 
+		return '';
+	ELSE
+		return CONCAT(hp_user_relative_filename(parentid) ,CONCAT('/',fullname));
+	END IF;	
+END;
+/
+show errors
+</pre>
+This function gives us the filesystem_node which corresponds to the
+root node of the user's webspace, the user being specified by the u_id
+input variable.
+<pre>
+create or replace function hp_get_filesystem_root_node (u_id IN integer)
+return integer
+IS
+	CURSOR root_cursor IS
+		select file_id from users_files
+	        where filename=u_id
+        	and parent_id is null
+	        and owner_id=u_id;
+	root_id		integer;
+BEGIN
+	OPEN root_cursor;
+	FETCH root_cursor INTO root_id;
+	CLOSE root_cursor;
+	return root_id;
+END;
+/
+show errors
+</pre>
+This function gives us the user_id of the user who owns the file
+represented by the filesystem node fsid input.
+<pre>
+create or replace function hp_get_filesystem_node_owner (fsid IN integer)
+return integer
+IS
+	CURSOR owner_cursor IS
+		select owner_id from users_files
+		where file_id=fsid;
+	owner_id	integer;
+BEGIN
+	OPEN owner_cursor;
+	FETCH owner_cursor INTO owner_id;
+	CLOSE owner_cursor;
+	return owner_id;
+END;
+/
+show errors
+</pre>
+This function returns us the number of children a filesystem node has.
+<pre>
+create or replace function hp_get_filesystem_child_count (fsid IN integer)
+return integer
+IS
+	CURSOR count_cursor IS
+		select count(*) from users_files
+		where parent_id=fsid;
+	counter		integer;
+BEGIN
+	OPEN count_cursor;
+	FETCH count_cursor INTO counter;
+	CLOSE count_cursor;
+	return counter;
+END;
+/
+show errors
+</pre>
+A very useful function which gives us the filesystem node represented
+by the filename which is relative to the file represented by the
+rootid input
+<pre>
+create or replace function hp_fs_node_from_rel_name (rootid IN integer, rel_name IN varchar2)
+return integer
+IS
+	slash_location		integer;
+	nodeid			integer;
+BEGIN
+	IF rel_name is null
+	THEN
+		return rootid;
+	ELSE
+		slash_location := INSTR(rel_name,'/');
+		IF slash_location = 0
+		THEN
+			select file_id into nodeid
+			from users_files
+			where parent_id=rootid
+			and filename=rel_name;
+			return nodeid;
+		ELSIF slash_location = 1
+		THEN
+			return hp_fs_node_from_rel_name(rootid, SUBSTR(rel_name,2));
+		ELSE
+			select file_id into nodeid
+			from users_files
+			where parent_id=rootid
+			and filename=SUBSTR(rel_name,1,slash_location-1);
+			return hp_fs_node_from_rel_name(nodeid,SUBSTR(rel_name,slash_location));
+		END IF;
+	END IF;
+END;
+/
+show errors
+
+</pre>
+<p>
+
+<h4>2.3&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Content Management</h4>
+
+The content manager which manages the look and feel of published
+content is described in sections 1.1.4.5 to 1.1.4.5.2 of this
+document. It creates a new specially marked directory for the content
+being published and each subsection is physically represented by a
+file on the filesystem underneath that directory. The file
+"Introductory Text" is automatically created when the content
+directory is created. These files can contain html-bodies and are
+edited using our standard text editor. People can publish sub-content
+from withing a specially managed directory to achieve hierarchical
+content publishing. The information on the content types for the
+directories is stored in the users_content_types table and the
+content_type column in users_files references
+users_content_types(type_id). Non-managed simple directories (folders)
+have a null pointer in their content_type column.
+
+<pre>
+create sequence users_type_id_seq start with 2;
+
+create table users_content_types (
+	type_id			integer primary key,
+	type_name		varchar(200) not null,
+	sub_type_name		varchar(200) not null,
+	owner_id		integer not null references users,
+	-- not used
+	sub_type		integer references users_content_types,
+	-- not used
+	super_type		integer references users_content_types
+);
+</pre>
+And here is the PL/SQL code used by the content management system:<br>
+This function takes in a filesystem_node and keeps on going up from
+that node and returns the content title of the top most managed
+content type.
+<pre>
+create or replace function hp_top_level_content_title (filesystem_node IN integer)
+return varchar2
+IS
+	CURSOR name_cursor IS
+		select file_pretty_name from users_files
+		where file_id=filesystem_node;
+	CURSOR parent_cursor IS
+		select parent_id from users_files
+		where file_id=filesystem_node;
+	CURSOR managed_p_cursor IS
+		select managed_p from users_files
+		where file_id=filesystem_node;
+	managedp		varchar(1);	
+	fullname		varchar(500);
+	parentid		integer;
+	parent_managedp 	varchar(1);
+BEGIN
+	OPEN parent_cursor;
+	OPEN name_cursor;
+	OPEN managed_p_cursor;
+	FETCH parent_cursor INTO parentid;
+	FETCH name_cursor INTO fullname;
+	FETCH managed_p_cursor INTO managedp;
+	CLOSE parent_cursor;
+	CLOSE name_cursor;
+	CLOSE managed_p_cursor;
+	IF parentid is null
+	THEN 
+		return fullname;
+	END IF;
+	IF managedp = 't'
+	THEN
+		select managed_p into parent_managedp
+		from users_files
+		where file_id=parentid;
+		
+		IF parent_managedp = 'f'
+		THEN
+			return fullname;
+		ELSE
+			return hp_top_level_content_title(parentid);
+		END IF;
+	ELSE
+		return fullname;
+	END IF;	
+END;
+/
+show errors
+</pre>
+This function takes in a filesystem_node and keeps on going up from
+that node and returns the filesystem node of the top most managed
+content type.
+<pre>
+create or replace function hp_top_level_content_node (filesystem_node IN integer)
+return varchar2
+IS
+	CURSOR parent_cursor IS
+		select parent_id from users_files
+		where file_id=filesystem_node;
+	CURSOR managed_p_cursor IS
+		select managed_p from users_files
+		where file_id=filesystem_node;
+	managedp		varchar(1);	
+	parentid		integer;
+	parent_managedp 	varchar(1);
+BEGIN
+	OPEN parent_cursor;
+	OPEN managed_p_cursor;
+	FETCH parent_cursor INTO parentid;
+	FETCH managed_p_cursor INTO managedp;
+	CLOSE parent_cursor;
+	CLOSE managed_p_cursor;
+	IF parentid is null
+	THEN 
+		return filesystem_node;
+	END IF;
+	IF managedp = 't'
+	THEN
+		select managed_p into parent_managedp
+		from users_files
+		where file_id=parentid;
+		
+		IF parent_managedp = 'f'
+		THEN
+			return filesystem_node;
+		ELSE
+			return hp_top_level_content_node(parentid);
+		END IF;
+	ELSE
+		return filesystem_node;
+	END IF;	
+END;
+/
+show errors
+</pre>
+This function takes in a filesystem_node and keeps on going up from
+that node and returns the title of the parent managed content type.
+<pre>
+create or replace function hp_onelevelup_content_title (filesystem_node IN integer)
+return varchar2
+IS
+	CURSOR name_cursor IS
+		select file_pretty_name from users_files
+		where file_id=filesystem_node;
+	CURSOR parent_cursor IS
+		select parent_id from users_files
+		where file_id=filesystem_node;
+	CURSOR managed_p_cursor IS
+		select managed_p from users_files
+		where file_id=filesystem_node;
+	CURSOR directory_p_cursor IS
+		select directory_p from users_files
+		where file_id=filesystem_node;
+	managedp		varchar(1);	
+	dirp			varchar(1);	
+	parentid		integer;
+	fullname		varchar(500);
+BEGIN
+	OPEN name_cursor;
+	OPEN parent_cursor;
+	OPEN managed_p_cursor;
+	OPEN directory_p_cursor;
+	FETCH parent_cursor INTO parentid;
+	FETCH managed_p_cursor INTO managedp;
+	FETCH directory_p_cursor INTO dirp;
+	FETCH name_cursor INTO fullname;
+	CLOSE parent_cursor;
+	CLOSE managed_p_cursor;
+	CLOSE directory_p_cursor;
+	CLOSE name_cursor;
+
+	IF parentid is null
+	THEN 
+		return fullname;
+	END IF;
+	IF managedp = 't'
+	THEN
+		IF dirp = 't'
+		THEN
+			return fullname;
+		ELSE
+			return hp_onelevelup_content_title(parentid);
+		END IF;
+	ELSE
+		return fullname;
+	END IF;	
+END;
+/
+show errors
+</pre>
+This function takes in a filesystem_node and keeps on going up from
+that node and returns the filesystem node of the parent managed
+content type.
+<pre>
+create or replace function hp_onelevelup_content_node (filesystem_node IN integer)
+return varchar2
+IS
+	CURSOR parent_cursor IS
+		select parent_id from users_files
+		where file_id=filesystem_node;
+	CURSOR managed_p_cursor IS
+		select managed_p from users_files
+		where file_id=filesystem_node;
+	CURSOR directory_p_cursor IS
+		select directory_p from users_files
+		where file_id=filesystem_node;
+	managedp		varchar(1);	
+	dirp			varchar(1);	
+	parentid		integer;
+BEGIN
+	OPEN parent_cursor;
+	OPEN managed_p_cursor;
+	OPEN directory_p_cursor;
+	FETCH parent_cursor INTO parentid;
+	FETCH managed_p_cursor INTO managedp;
+	FETCH directory_p_cursor INTO dirp;
+	CLOSE parent_cursor;
+	CLOSE managed_p_cursor;
+	CLOSE directory_p_cursor;
+	IF parentid is null
+	THEN 
+		return filesystem_node;
+	END IF;
+	IF managedp = 't'
+	THEN
+		IF dirp = 't'
+		THEN
+			return filesystem_node;
+		ELSE
+			return hp_onelevelup_content_node(parentid);
+		END IF;
+	ELSE
+		return filesystem_node;
+	END IF;	
+END;
+/
+show errors
+
+</pre>
+<h4>2.4&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Neighbourhood Management</h4>
+
+Neighbourhoods are created in a somewhat similar fashion to folders,
+only that they do not have anything to do with the physical
+filesystem. Neighbourhoods can have a hierarchical structure but
+cannot contain cycles in the hierarchy (just like the homepage
+filesystem). Neighbourhood information is stored in the
+users_neighborhoods table:<br>
+<pre>
+create sequence users_neighborhood_id_seq start with 2;
+
+create table users_neighborhoods (
+	neighborhood_id		integer primary key,
+	neighborhood_name	varchar(500) not null,
+	description		varchar(4000),
+	parent_id		integer references users_neighborhoods on delete cascade
+);
+</pre>
+
+A special "big kahuna" neighbourhood is always created to serve as the
+root node of the neighbourhood hierarchy. The name of this super
+parent neighbourhood is "Neighborhoods". It could be any name
+really. It could have any neighborhood_id really. But it must exist.
+<pre>
+-- the system is smart enough to adjust if the root neighborhood
+-- has a different neighborhood_id.
+insert into users_neighborhoods
+(neighborhood_id, 
+ neighborhood_name, 
+ description, 
+ parent_id)
+values (1, 
+ 'Neighborhoods', 
+ 'Neighborhood RootNode', 
+ null);
+</pre>
+
+The following PL/SQL functions are used by the neighbourhood
+management component:<br> This first function gives us the full name
+(with hierarchy) of the neighbourhood which has the neighborhood_id
+equal to the input value. An example of a return value could be
+something like "Neighborhoods : Music : Classic"
+
+<pre>
+create or replace function hp_true_neighborhood_name (neighborhood_node IN integer)
+return varchar2
+IS
+	CURSOR name_cursor IS
+		select neighborhood_name from users_neighborhoods
+		where neighborhood_id=neighborhood_node;
+	CURSOR parent_cursor IS
+		select parent_id from users_neighborhoods
+		where neighborhood_id=neighborhood_node;
+	fullname	varchar(500);
+	parentid	integer;
+BEGIN
+	OPEN parent_cursor;
+	OPEN name_cursor;
+	FETCH parent_cursor INTO parentid;
+	FETCH name_cursor INTO fullname;
+	CLOSE parent_cursor;
+	CLOSE name_cursor;
+	IF parentid is null
+	THEN 
+		return fullname;
+	ELSE
+		return CONCAT(hp_true_neighborhood_name(parentid), CONCAT(' : ',fullname));
+	END IF;	
+END;
+/
+show errors
+</pre>
+
+This function gives us the neighborhood_id of the big kahuna/top-level
+neighbourhood.
+
+<pre>
+create or replace function hp_get_neighborhood_root_node return integer
+IS
+	CURSOR root_cursor IS
+		select neighborhood_id 
+ 		from users_neighborhoods
+        	where parent_id is null;
+	root_id		integer;
+BEGIN
+	OPEN root_cursor;
+	FETCH root_cursor INTO root_id;
+	CLOSE root_cursor;
+	return root_id;
+END;
+/
+show errors
+</pre>
+
+Returns the name of the neighbourhood, except that it does not mention
+the root neighbourhood. An example of a return value could be "Music :
+Classic"
+
+<pre>
+create or replace function hp_relative_neighborhood_name (neighborhood_node IN integer)
+return varchar2
+IS
+	CURSOR name_cursor IS
+		select neighborhood_name from users_neighborhoods
+		where neighborhood_id=neighborhood_node;
+	CURSOR parent_cursor IS
+		select parent_id from users_neighborhoods
+		where neighborhood_id=neighborhood_node;
+	fullname	varchar(500);
+	parentid	integer;
+	root_node	integer;
+BEGIN
+	OPEN parent_cursor;
+	OPEN name_cursor;
+	FETCH parent_cursor INTO parentid;
+	FETCH name_cursor INTO fullname;
+	CLOSE parent_cursor;
+	CLOSE name_cursor;
+
+	select hp_get_neighborhood_root_node 
+	into root_node
+	from dual;
+
+	IF neighborhood_node = root_node
+	THEN
+		return '';
+	END IF;
+
+	IF parentid is null
+	THEN
+		return '';
+	END IF;
+
+	IF parentid = root_node
+	THEN 
+		return fullname;
+	ELSE
+		return CONCAT(hp_relative_neighborhood_name(parentid), CONCAT(' : ',fullname));
+	END IF;	
+END;
+/
+show errors
+</pre>
+Generates a sort key for the neighbourhoods which lets us
+alphabetically sort the neighbourhoods within brances of the
+hierarchical tree. This is something CONNECY BY doesn't let us do.
+<pre>
+-- generates a sort key for this neighbourhood. Can be used in 'connect by'
+-- with 'order by'.
+create or replace function hp_neighborhood_sortkey_gen (neighborhood_node IN integer)
+return varchar2
+IS
+	CURSOR name_cursor IS
+		select neighborhood_name from users_neighborhoods
+		where neighborhood_id=neighborhood_node;
+	CURSOR parent_cursor IS
+		select parent_id from users_neighborhoods
+		where neighborhood_id=neighborhood_node;
+	fullname	varchar(500);
+	parentid	integer;
+BEGIN
+	OPEN parent_cursor;
+	OPEN name_cursor;
+	FETCH parent_cursor INTO parentid;
+	FETCH name_cursor INTO fullname;
+	CLOSE parent_cursor;
+	CLOSE name_cursor;
+	IF parentid is null
+	THEN 
+		return '/';
+	ELSE
+		return CONCAT(hp_neighborhood_sortkey_gen(parentid), CONCAT('/',fullname));
+	END IF;	
+END;
+/
+show errors
+</pre>
+Gives us the branching factor underneath the neighbourhood represented
+by the input value.
+<pre>
+create or replace function hp_get_nh_child_count (neighborhoodid IN integer)
+return integer
+IS
+	CURSOR count_cursor IS
+		select count(*) from users_neighborhoods
+		where parent_id=neighborhoodid;
+	counter		integer;
+BEGIN
+	OPEN count_cursor;
+	FETCH count_cursor INTO counter;
+	CLOSE count_cursor;
+	return counter;
+END;
+/
+show errors
+</pre>
+A rather useful function which we use to prevent cycles in the
+neighbourhood structure. It takes in a source node and a target node
+and tells us whether we can reach target node starting from source
+node without backtracking above source node.
+<pre>
+create or replace function hp_neighborhood_in_subtree_p (source_node IN integer, target_node IN integer)
+return varchar2
+IS
+	CURSOR parent_cursor IS
+		select parent_id from users_neighborhoods
+		where neighborhood_id=target_node;
+	parentid	integer;
+BEGIN
+	OPEN parent_cursor;
+	FETCH parent_cursor INTO parentid;
+	CLOSE parent_cursor;
+	
+	IF source_node = target_node
+	THEN
+		return 't';
+	END IF;
+	
+	IF parentid is null
+	THEN 
+		return 'f';
+	ELSE
+		IF parentid = source_node
+		THEN
+			return 't';
+		ELSE
+			return hp_neighborhood_in_subtree_p(source_node, parentid);
+		END IF;
+	END IF;	
+END;
+/
+show errors
+</pre>
+
+<h4>2.5&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Putting it all together</h4>
+
+At the heart of the homepage module is the users_homepages table. This
+table contains information about each user's webspace and his/her
+homepage display settings. An entry in this table signifies that the
+user's webspace is initialized. Although, we use the existance of
+[ad_parameter ContentRoot]$user_id as a test for webspace
+initialization. This one should in theory serve equally well (The
+other test is better as it does not require a db handle) and because
+its truer, if there is such a word as truer.
+
+<pre>
+create table users_homepages (
+	user_id				primary key references users,
+	-- the background colour settings for user's public pages
+	bgcolor	 			varchar(40),
+	-- the text colour settings for user's public pages
+	textcolor			varchar(40),
+	-- the colour settings for unvisitied links in user's public pages
+	unvisited_link	  		varchar(40),
+	-- the colour settings for visitied links in user's public pages
+	visited_link	  		varchar(40),
+	-- the settings to determine whether the links are underlined or
+	-- not in user's public pages
+	link_text_decoration  		varchar(40),
+	-- the settings to determine whether the links are bold or
+	-- not in user's public pages. I have added this because I have
+	-- strong preference for bold links when they are not underlined.
+	link_font_weight		varchar(40),
+	-- font for user's public generated pages
+	font_type		  	varchar(40),
+	-- the background colour settings for user's maintenance pages
+	maint_bgcolor	 		varchar(40),
+	maint_textcolor			varchar(40),
+	maint_unvisited_link		varchar(40),
+	maint_visited_link	  	varchar(40),
+	maint_link_text_decoration  	varchar(40),
+	maint_link_font_weight		varchar(40),
+	maint_font_type			varchar(40),
+	neighborhood_id		        integer references users_neighborhoods on delete set null
+	-- feature_level		varchar(30),
+	-- constraint hp_feature_lvl_ck check(feature_level 'platinum', 'gold', 'silver'),
+	-- keywords			varchar(4000)
+
+);
+</pre>
+The neighborhod_id column is a reference to a neighbourhood to which
+this user has subscribed. A user can be subscribed to only 0 or 1
+neighbourhoods at one time.
+<p>
+
+<h4>2.6&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Features hiterto unsung</h4>
+
+Here we will mention those minuscule details which are not quite
+worthy of mention in the first place
+<p>
+2.6.1&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;File Access Log
+<p>
+We log accesses to users files in the users_files_access_logs table:
+<pre>
+create sequence users_access_id_sequence start with 2;
+
+create table users_files_access_log (
+	access_id		integer primary key,
+	file_id			references users_files on delete set null,
+	relative_filename	varchar(500) not null,
+	owner_id		references users on delete cascade,
+	access_date		date not null,
+	ip_address		varchar(50) not null
+);
+</pre>
+We log accesses after we serve files from homepage-defs.tcl's hp_serve
+procedure.
+
+<hr>
+<a href="http://web.mit.edu/mobin/web"><address>mobin@mit.edu</address></a>
+</body>
+</html>
\ No newline at end of file
Index: web/openacs/www/doc/index.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/index.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/index.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,464 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>ArsDigita Community System Documentation</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>ArsDigita Community System Documentation</h2>
+
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+<h3>Documentation</h3>
+
+<ul>
+
+<li>/doc/index.html -- this document
+
+<li><a href="arsdigita-faq.html">/doc/arsdigita-faq.html</a> -- ArsDigita Community System FAQ 
+
+<li><a href="installation.html">/doc/installation.html</a> 
+
+<li><a href="upgrading.html">/doc/upgrading.html</a> -- moving from one
+ACS version to the next
+
+<li><a href="developers.html">/doc/developers.html</a> -- including <a
+href="procs.tcl">procedure-by-procedure documentation</a> (for programmers)
+
+<li><a href="style.html">/doc/style.html</a> -- templates and
+multi-lingual support
+
+<li><a href="monitoring.html">/doc/monitoring.html</a>
+
+<li><a href="mainframe-integration.html">/doc/mainframe-integration.html</a>
+
+<li><a href="xml.html">working with XML</a>
+
+<li><a href="help.html">/doc/help.html</a> -- building documentation for
+the end-user
+
+<li><a href="security-sessions.html">/doc/security-sessions.html</a> --
+information on the security subsystem, and associating state with user
+sessions and browsers
+
+<li><a href="abstract-url.html">/doc/abstract-url.html</a> --
+information on the system allowing use of abstract (extensionless) URLs
+
+<li><a href="webmasters.html">/doc/webmasters.html</a> -- for the person
+who makes publishing decisions
+
+<li><a href="patches.html">/doc/patches.html</a> -- documentation of
+patches/fixes to the ArsDigita Community System (ACS) on this site;
+useful when you are upgrading and when we are building a new version
+of the system
+
+<li><a href="custom.html">/doc/custom.html</a> -- documentation of 
+custom features that you've added to this site that will/can never
+be rolled into the ACS.
+
+<li><a href="/acs-examples/">/acs-examples/</a> -- source code that
+shows how to use the rest of the software
+
+<p>
+
+<li><a href="standards">Development Standards</a>
+
+<li><a href="version-history.html">Version History</a>
+
+<p>
+
+<li><a href="http://www.aolserver.com/">AOLserver documentation</a>, a
+notably useful part of which is 
+<a href="http://www.aolserver.com/server/docs/2.3/html/tcldev.htm">the
+Tcl Developer's Guide</a>
+
+<h4>Individual Modules</h4>
+
+Each module is owned by at least one programmer.  The current list
+is in <a href="module-owners.html">module-owners.html</a>; each
+programmer
+is responsible for maintaining the module and 
+the relevant portion of <a
+href="acceptance-test.html">acceptance-test.html</a>
+
+<p>
+
+<li><a href="address-book.html">/doc/address-book.html</a>
+<li><a href="adserver.html">/doc/adserver.html</a>
+<li><a href="bannerideas.html">/doc/bannerideas.html</a>
+<li><a href="bboard.html">/doc/bboard.html</a> -- the discussion forum
+system
+
+<li><a href="bookmarks.html">/doc/bookmarks.html</a>
+
+
+<li><a href="calendar.html">/doc/calendar.html</a>
+
+<li><a href="chat.html">/doc/chat.html</a>
+<li><a href="classifieds.html">/doc/classifieds.html</a>
+
+<li><a href="clickthrough.html">/doc/clickthrough.html</a>
+
+<li><a href="contact-manager.html">/doc/contact-manager.html</a> -- good
+for sites with an extranet-y flavor 
+
+<li><a href="content-sections.html">/doc/content-sections.html</a> -- lets
+administrators add/manage different content sections of the site
+
+<li><a href="contest.html">/doc/contest.html</a> -- run give-away contests
+
+<li><a href="custom-sections.html">/doc/custom-sections.html</a> -- allows
+group administrators add/manage custom sections of the site
+
+<li><a href="curriculum.html">/doc/curriculum.html</a>
+
+<li><a href="directory.html">/doc/directory.html</a> -- letting users
+find each other
+
+<li><a href="display.html">/doc/display.html</a> -- lets administrators
+set display settings and upload logo of the site
+
+<li><a href="download.html">/doc/download.html</a> -- offering versions
+of software or other stuff to people
+
+<li><a href="dw.html">/doc/dw.html</a> -- a toolkit for data
+warehouse-style queries
+
+<li><a href="ecommerce.html">/doc/ecommerce.html</a> 
+
+<li><a href="education.html">/doc/education.html</a> 
+
+<li><a href="events.html">/doc/events.html</a> -- facilitates online 
+registration for events
+
+<li><a href="faq.html">/doc/faq.html</a> 
+
+<li><a href="file-storage.html">/doc/file-storage.html</a> -- users who
+don't know HTML can collaboratively maintain a set of files on the server
+
+<li><a href="glassroom.html">/doc/glassroom.html</a> -- the ArsDigita
+Glass Room system, for coordinating people involved in keeping a Web
+service up and running
+
+<li><a href="glossary.html">/doc/glossary.html</a> -- the ArsDigita
+Glossary, for creating an on-site dictionary of specialized terminology.
+
+<li><a href="intranet.html">/doc/intranet.html</a> -- run your
+organization from this toolkit
+
+<li><a href="neighbor.html">/doc/neighbor.html</a> -- Neighbor to
+Neighbor (hard to explain; see example at <a
+href="http://photo.net/neighbor/">http://photo.net/neighbor/</a>)
+
+<li><a href="news.html">/doc/news.html</a>
+
+<li><a href="partner.html">/doc/partner.html</a> -- site-wide cobranding 
+
+<li><a href="poll.html">/doc/poll.html</a> -- opinion polls
+
+<li><a href="portals.html">/doc/portals.html</a> -- using only a Web
+browser,
+build some portals
+for different groups within your organization (or the public)
+
+<li><a href="press.html">/doc/press.html</a> -- show press coverage
+about your site or company
+
+<li><a href="pull-down-menus.html">/doc/pull-down-menus.html</a> -- create Macintosh style menu bars
+
+
+<li><a href="spam.html">/doc/spam.html</a> -- send email to a group of users
+
+<li><a href="static.html">/doc/static.html</a> -- support for collecting
+comments, links, and download statistics for static .html files
+
+<li><a href="survey-simple.html">/doc/survey-simple.html</a> -- ask the
+users a series of questions
+
+<li><a href="ticket.html">/doc/ticket.html</a> -- a project 
+and bug tracking system
+
+
+<li><a href="wp.html">/doc/wp.html</a> -- WimpyPoint, a replacement for desktop
+bloatware like PowerPoint, allowing you to create and view presentations
+in your Web browsers
+
+<p>
+
+<li><a href="user-session-tracking.html">User session tracking</a> --
+getting a meaningful handle on usage
+
+<li><a href="user-registration.html">User registration and access control</a> 
+
+
+<li><a href="user-admin.html">User administration</a> -- how the
+publisher can select a class of users and what can then be done with
+that class
+
+<li><a href="crm.html">Customer relationship management</a> -- tracking a customer relationship through its various states. 
+
+<li><a href="user-groups.html">User groups</a> -- a general mechanism
+for lumping users together in groups, e.g., all students in a particular
+course 
+
+<li><a href="member-value.html">Member value</a> -- a way of
+accumulating charges for users and then billing them out at the end of
+each month (commercial sites) or excluding them from the community if
+the charges get too high (non-commercial)
+
+<li><a href="redirect.html">Redirects</a> -- ensuring that legacy URLs
+pointed to by bookmarks and search engines still work
+
+<li><a href="robot-detection.html">Robot detection</a> -- making sure
+that your entire site gets indexed
+
+<h4>Two Related Modules</h4>
+
+
+<li><a href="user-profiling.html">User profiling and content categorization</a> -- matching users
+to content 
+
+<li><a href="site-wide-search.html">Site-wide-search</a> -- a
+system for indexing all of a site's content from one big table
+
+
+
+
+<h4>Module Tools</h4>
+
+<li><a href="audit.html">Audit</a> -- adding a change history to a table
+
+<li><a href="calendar-widget.html">Calendar widget</a> -- displaying
+calendars
+
+<li><a href="content-tagging.html">Content tagging</a> -- useful for
+finding/screening naughty words but with wider potential as well
+
+<li><a href="email-handler.html">Email handler</a> -- queues incoming
+email into an Oracle table; let's you do things like unified customer
+support or email replies to tickets
+
+<li><a href="graphing.html">Graphing</a> -- generating bar charts
+
+<li><a href="new-stuff.html">New stuff</a> -- showing folks what is new site-wide
+
+<li><a href="permissions.html">Permissions</a> -- a standardized way of 
+answering: <i>"Is user x allowed to do y?"</i>
+
+<li><a href="general-permissions.html">General permissions</a> -- a
+way to answer the question "can a particular user, group, or role do
+this on a particular row?", where this can be an arbitrary action
+(e.g., read, comment, write, administer, etc.)
+
+<li><a href="general-comments.html">General comments</a> -- allows you to collect user comments on any item
+
+<li><a href="general-links.html">General links</a> -- allows you to collect user links on any item
+
+<li><a href="prototype.html">Prototype builder</a> -- quickly build standard ACS pages via a user interface
+
+<li><a href="tools.html">Tools</a> -- collections of scripts providing services to perform common tasks such as spell checking.
+
+<li><a href="server-cluster.html">Server Clusters</a> -- a facility for keeping
+state synchronized between a group of load-balance servers.
+
+</ul>
+
+
+<h4>The Glorious Future</h4>
+
+Here we link to plans that are in the works; it is a collaboration area
+for toolkit programmers to look at.
+
+<ul>
+
+<li><a href="bboard-revision.html">/bboard revision</a>
+
+<li><a href="templating-etc.html">templating, navigation, forms, and other enhancements</a>
+
+<li><a href="general-cleanup.html">general cleanup</a>
+
+
+
+</ul>
+
+
+<h3>Directories</h3>
+
+<ul>
+
+<h4>Not Under the Page Root</h4>
+
+<li>/web/yourdomain/parameters/ -- stores definitions such as the
+service name
+<li>/web/yourdomain/tcl/ -- Tcl procedures used system-wide
+
+<h4>Under the Page Root</h4>
+
+<li>/doc/ -- this directory
+
+<li>/doc/sql/ -- data model files
+
+<li>/install/ -- files needed for installation only
+
+<li>/global/ -- files served up by AOLserver when it gets unhappy (e.g.
+file not found or too many threads), also for privacy statements, etc.
+
+<li>/graphics/ -- for site-wide logos and other images that aren't
+specific to content sections
+
+<li>/ads/ -- banners ads to be served by /adserver scripts (below)
+
+<li>/pvt/ -- material private to a particular member
+
+<li>/shared/ -- material available to members but not private to a particular member
+
+<li>/incoming/ -- material that authorized users need to FTP up to
+you 
+
+<li>/acs-examples/ -- scripts that show programmers how to use
+various ACS features
+
+
+<h4>Subsystems</h4>
+
+Each module generally defines a top-level subdirectory with the same
+name as itself; there are some exceptions with weird names below.
+
+<p>
+
+<li>/adserver/ -- banner ad server
+
+<li>/comments/ -- comments on static pages
+
+<li>/gc/ -- generic classified ad system
+
+<li>/links/ -- Tcl scripts that show related links on the bottom of a page
+
+<li>/ug/ --  viewing and creating user groups
+
+</ul>
+
+<h3>Magic Files</h3>
+
+<ul>
+
+<li><a href="/global/copyright.adp">/global/copyright.adp</a> explains the site's copyright policy
+
+<li><a href="/global/server-busy.html">/global/server-busy.html</a> is served by AOLserver when the threads are
+stacked up (presumably because the RDBMS is overwhelmed)
+
+<li><a href="/global/file-not-found.html">/global/file-not-found.html</a> is served by AOLserver when the user
+hits a non-existent URL; presumably this will contain some search tips
+
+<li><a href="/global/unauthorized.html">/global/unauthorized.html</a> is served by AOLserver when the user hasn't
+typed in a valid HTTP username/password (this shouldn't really ever be
+part of the user experience since the ArsDigita Community System doesn't
+use HTTP usernames/passwords)
+
+<li><a href="/global/forbidden.html">/global/forbidden.html</a> is served by AOLserver when the nsperm system
+isn't happy and refuses to say why (not sure why this should ever happen)
+
+<li><a href="/global/error.html">/global/error.html</a> is served by AOLserver when it chokes on a Tcl
+API program or CGI script 
+
+<li><a href="/global/privacy.adp">/global/privacy.adp</a> is the site's privacy statement.
+
+<li><a href="/global/legal.adp">/global/legal.adp</a> is the site's legal statement.
+
+</ul>
+
+<h3>Filters and Other Tricks</h3>
+
+To be sure that you're getting them all on a particular server, do:
+
+<blockquote><pre>
+cd /web/yourservername/tcl/ 
+grep 'ad_register_filter' *.tcl
+</pre>
+</blockquote>
+
+<ul>
+
+<li>service of all /*.html files follows the following sequence:
+<ol>
+
+<li>the ad_verify_identity filter from /tcl/ad-security.tcl may run to
+abort service of the page, depending on which directories are specified
+for protection in /tcl/ad-security.tcl
+
+<li>ad_serve_html_page in /tcl/ad-html.tcl delivers the page, with
+included comments and related links 
+
+<li>ad_maintain_user_content_map from /tcl/ad-user-content-map.tcl runs
+after the page has been served, to insert rows into the
+<code>user_content_map</code> table
+
+<li>ad_pics_filter from /tcl/ad-pics.tcl will add a PICS header saying
+"I'm a naughty page" (or whatever else you've put in the ad.ini file) to
+the directories and files specified in ad.ini
+
+</ol>
+
+<p>
+
+<li>/tcl/ad-admin.tcl defines filters to restrict /admin pages to SSL
+(when available) and to registered users in the site-wide administration
+group
+
+<p>
+
+<li>/tcl/ad-last-visit.tcl defines a filter to maintain the last visit
+cookie and database rows 
+
+<p>
+
+<li>/tcl/ad-referer.tcl defines a filter to update referral counters in
+the database
+
+<p>
+
+<li>/tcl/ad-robot-defs.tcl may define a filter to look for robots
+visiting particular directories
+
+<p>
+
+<li>/tcl/ad-user-content-map.tcl defines a trace filter to enter rows
+into the <code>user_content_map</code>
+
+<P>
+
+<li>/tcl/curriculum.tcl defines a filter to maintain the curriculum
+cookie 
+
+</ul>
+
+
+<a name=pools>
+<h3>Database Pools</h3>
+
+The community system depends on the existence of three database
+pools:  main, subquery, and log.  They must be named as such.  The
+default pool will be "main".
+
+<h3>Substrate</h3>
+
+If you want to have a reliable service, you should read and apply 
+<a href="architecture-install.html">this installation guide</a> for the
+<a href="http://photo.net/wtr/arsdigita-server-architecture.html"</a>ArsDigita Server
+Architecture</a> (don't confuse this with the ACS intallation guide 
+in <a href="installation.html">/doc/installation.html</a>).
+
+
+
+<h3>Copyright and Legal Status of this Software</h3>
+
+<p> This software is mostly Copyright 1995-99 Philip Greenspun and
+licensed under <a href="license.text">the GNU General Public License,
+version 2 (June 1991)</a>.</p>
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/installation.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/installation.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/installation.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,287 @@
+<html>
+<!--AD_DND-->
+<!--installation.html,v 3.1.4.4 2000/03/17 05:26:04 gregh Exp-->
+<HEAD>
+<TITLE>ArsDigita Community System Installation Instructions</TITLE></HEAD>
+<BODY bgcolor=#ffffff text=#000000>
+<h2>ArsDigita Community System Installation</h2>
+by <A href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+<ul>
+<li>source: <a href="http://software.arsdigita.com">http://software.arsdigita.com</a>
+<li>bug reports: <a href="mailto:acs-bugs@arsdigita.com">acs-bugs@arsdigita.com</a>
+<li>philosophy:  <a
+href="http://photo.net/wtr/thebook/community.html">http://photo.net/wtr/thebook/community.html</a>
+(the community chapter of <cite>Philip and Alex's Guide to Web
+Publishing</cite>)
+<li>technical background: <a
+href="http://photo.net/wtr/thebook/">http://photo.net/wtr/thebook/</a>
+</ul>
+
+<h3>Prerequisites</h3>
+
+<ul>
+<li>Unix server
+<li><a href="http://www.oracle.com">Oracle 8 relational database
+management system</a>
+<li><a href="http://www.aolserver.com">AOLserver</a> (free)
+<li><a
+href="http://arsdigita.com/free-tools/oracle-driver.html">ArsDigita
+Oracle driver for AOLserver</a> (free)
+</ul>
+
+It is helpful if you have Oracle interMedia Text for full-text
+searches.  We're also trying to make our system work with the PLS
+System, available free from <a
+href="http://www.pls.com">http://www.pls.com</a>.
+
+<h3>Your Oracle installation</h3>
+
+The ACS requires that Oracle's NLS_DATE_FORMAT parameter be set to
+'YYYY-MM-DD', as God intended it to be.  See 
+<a
+href="http://photo.net/wtr/oracle-tips.html">http://photo.net/wtr/oracle-tips.html</a>
+for more details on how to bring Oracle into the ANSI age...
+
+<p>
+
+The "nuke a user" admin page and Intermedia won't run unless you set
+<code>open_cursors = 500</code> in the same Oracle init file.
+
+<h3>Creating a <code>chroot</code>'ed environment</h3>
+
+As of the arrival of AOLserver 3.0, we recommend running AOLserver and the
+ACS in a <code>chroot</code> "jail."  This enhances security, limiting the
+likelihood of a rogue intruder damaging your system.
+
+<p>
+
+This will require that all binaries you may need to access and all libraries
+those binaries may linked against be found under the jail's perimeter.  We
+recommend this be located in the directory /webroot.
+
+
+<h3>Your AOLserver installation</h3>
+
+All ArsDigita software packages, including the ACS, rely on a basket
+of utility procedures that are generally part of the AOLserver
+installation. This used to be distributed separately and put in the
+shared Tcl directory (/home/nsadmin/modules/tcl), but is now a part of
+the ACS and exists in [acsdir]/tcl/ad-utilities.tcl.preload. Note that many
+other files in the tcl directory depend on utility functions defined
+in this file, which is why it is named as it is, so that it will be
+loaded before any of the other files.
+
+<p>
+
+We place our entire AOLserver directory structure in /webroot/aol30.
+
+
+<h3>Getting Ready to Untar</h3>
+
+We recommend rooting webserver content in /webroot/web.  
+Since most servers these days are expected to run multiple 
+services from multiple IP addresses, each server gets a subdirectory from 
+/webroot/web.  For example, http://scorecard.org would be rooted at 
+/webroot/web/scorecard on one of our machines and if http://jobdirect.com were 
+on the same box then it would be at /webroot/web/jobdirect.
+
+<p>
+
+For the sake of argument, we're going to assume that your service is
+called "yourdomain", is going to be at http://yourdomain.com and is
+rooted at /webroot/web/yourdomain in the Unix file system.  Note that you'll
+find our definitions files starting out with "yourdomain.com".
+
+
+
+<ul>
+<li>download acs.tar into /tmp/acs.tar
+<li>cd /webroot/web/
+<li>tar xvf /tmp/acs.tar (creates a directory "acs")
+<li>mv acs yourdomain
+<li>chmod 777 yourdomain/users (if you plan on using the homepage module)
+</ul>
+
+You'll now find that /webroot/web/yourdomain/www contains the document root
+and /webroot/web/yourdomain/tcl contains Tcl scripts that are loaded when the
+AOLserver starts up.
+
+<h3>Feeding Oracle the Data Model</h3>
+
+The entire server will behave in an unhappy manner if it connects to
+Oracle and finds that, for example, the users table does not exist.
+Thus you need to connect to Oracle as whatever user the AOLserver will
+connect as, and feed Oracle the table definitions.
+
+<ul>
+
+<li>load the <code>states</code>, <code>country_codes</code> and <code>counties</code> tables
+using the <code>load-geo-tables</code> shell script in the 
+/webroot/web/yourdomain/www/install
+directory.  This relies on the Oracle SQL*Loader utility, documented 
+at <a
+href="http://photo.net/sql/ref/utilities">http://photo.net/sql/ref/utilities</a>
+
+<li>cd to /webroot/web/yourdomain/www/doc/sql/  and feed Oracle the .sql files that
+you find there. There is a meta-loader file, load-data-model.sql, that includes
+the other files in the proper order. To use it, run
+<blockquote>
+<code>
+sqlplus foo/foopassword < load-data-model.sql
+</code>
+</blockquote>
+
+<li>If you have interMedia installed, while still in /webroot/web/yourdomain/www/doc/sql/, run
+<blockquote>
+<code>
+./load-site-wide-search foo foopassword ctxsys-password
+</code>
+</blockquote>
+Note that there's no slash between foo and foopassword here. The third
+argument, ctxsys-password, is (obviously) the password for interMedia
+Text's special ctxsys user.
+
+</ul>
+
+<h3>Configuring AOLServer</h3>
+
+
+<b>Note: Because we're <code>chroot</code>'ing the webserver, it's view
+of the filesystem begins at /webroot.  So, it will actually see its 
+content at /web.</b>
+
+<ul>
+<li>the community system depends on the existence of three database
+pools:  main, subquery, and log.  They must be named as such.  The
+default pool will be "main".
+<li>you can only have one ArsDigita Community System running from a
+single nsd process (though you can have as many ACS servers as you like
+on a physical machine; each just needs its own process).  A big reason
+for this is that in the [ns/parameters] section of the AOLserver .ini
+file you need  to say 
+<blockquote>
+<tt>auxconfigdir=/web/yourdomain/parameters</tt>
+</blockquote>
+<li>Tell AOLserver that its pageroot is /web/yourdomain/www/
+<li>Tell AOLserver that the TclLibrary is /web/yourdomain/tcl
+(this will be the server's Private Tcl library)
+<li>in the [ns/parameters] section of your AOLServer .ini file, add
+the following:
+<blockquote>
+<tt>StackSize=500000</tt>
+</blockquote>
+
+This allows your to recurse a bit in Tcl and still use our Oracle
+driver (which allocates 40,000 bytes on the stack when called).
+
+<li>in the [ns/server/yourservername] section, if you want to use our
+fancy custom error responses and such, put in 
+
+<blockquote><pre>
+NotFoundResponse=/global/file-not-found.html
+ServerBusyResponse=/global/busy.html
+ServerInternalErrorResponse=/global/error.html
+ForbiddenResponse=/global/forbidden.html
+UnauthorizedResponse=/global/unauthorized.html
+</pre></blockquote>
+
+then go into the /www/global/ directory and edit these files to suit.
+
+</ul>
+
+
+<h3>Configuring ACS itself</h3>
+
+If you want a system that works, you have to copy
+/web/yourdomain/parameters/ad.ini to /web/yourdomain/parameters/yourdomain.ini
+(or any other name different from ad.ini).  You don't actually have to
+delete the ad.ini file.  Each section has a hardcoded "yourservername"
+in the name.  This means that the <code>ad_parameter</code>  will ignore
+everything in ad.ini unless your AOLserver name happens to be
+"yourservername".
+
+<p>
+
+Once you've got a private copy of the aux .ini file, make sure to change
+"yourservername" to whatever you're calling this particular AOLserver
+(look at the server name in the main .ini file for a reference).
+
+<p>
+
+Unless you want pages that advertise a community called "Yourdomain
+Network" owned by "webmaster@yourdomain.com", you'll probably want to
+edit the text of /web/yourdomain/parameters/yourdomain.ini file to
+change system-wide parameters.  If you want to change how some of these
+are used, a good place to look is /web/yourdomain/tcl/ad-defs.tcl.
+
+<h3>Configuring Permissions</h3>
+
+Now, you need to protect the proper administration directories of the
+ACS. You decide the policy. Here are the directories to consider
+protecting:
+
+<ul>
+<li> /doc (or at least /doc/sql/ since some AOLserver configurations
+will allow a user to execute SQL files)
+<li> /admin
+<li> any private admin dirs for a module you might have written that are
+not underneath the /admin directory
+</ul>
+
+<h3>Adding Yourself as a User and Making Yourself a Sysadmin</h3>
+
+The ArsDigita Community System will define two users:  system and
+anonymous.  It will also define a user group of system administrators.
+You'll want to add yourself as a user (at /register/ ) and then add
+yourself as as member of the site-wide administration group.  Start by
+logging out as yourself and logging in as the system user (email of
+"system").  Change the system user's password.  Visit the 
+the https://yourservername.com/admin/ug/ directory and add your personal
+user as a site-wide administrator.  Now you're bootstrapped!
+
+
+<h3>Closing Down Access</h3>
+
+The ACS ships with a user named "anonymous" (email "anonymous") to
+serve as a content owner.  If you're operating a restricted-access
+site, make sure to change the anonymous user's password.
+
+<h3>Where to Find What</h3>
+
+A few pointers: 
+
+<ul>
+<li> the /register directory contains the login and registration scripts. You
+can easily redirect someone to /register/index.tcl to have them login
+or register.
+
+<li> the /pvt directory is for user-specific pages. They can only be accessed by people who have logged in.
+
+</ul>
+
+<h3>Making sure that it works</h3>
+
+Run the acceptance tests in <a href="/doc/acceptance-test.html">/doc/acceptance-test.html</a>
+
+<h3>Reversing the whole process!</h3>
+
+If you want to take an operating ArsDigita Community System and use it
+as the basis of a new toolkit release, then what you want is the script
+at /admin/conversion/make-acs-dist (only works if you have zsh
+installed).  It plays some neat tricks such as 
+
+<ul>
+<li>leaving backup files behind
+<li>leaving random custom .ini files from the /parameters dir behind
+<li>rerooting the files at "acs" (rather than "yourservername")
+
+</ul>
+
+
+<hr>
+<a href="mailto:philg@mit.edu"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/intranet.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/intranet.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/intranet.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,250 @@
+<html>
+<head>
+<title>Intranet Module</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Intranet Module</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a><Br>
+by <a href="http://teadams.com">Tracy Adams</a>,
+<a href="http://photo.net/philg/">Philip Greenspun</a>,
+<A HREF=mailto:dvr@arsdigita.com>David Rodriguez</A>,
+and <A HREF=mailto:mbryzek@arsdigita.com>Michael Bryzek</a>
+
+<hr>
+<ul>
+<li>User directory:  <a href="/intranet">/intranet</a>
+<li>Admin directory: <a href="/intranet/employees/admin/">/intranet/employees/admin/</a>
+<li>data model:  
+<a href="/doc/sql/display-sql.tcl?url=/doc/sql/intranet.sql">/doc/sql/intranet.sql</a>
+<li>procedures:   /tcl/intranet-defs.tcl
+</ul>
+
+<h3>The Big Picture</h3>
+
+The faster the pace of change in an industry or business, the more time
+and effort workers have to spend on coordination.  Consider Adam Smith's
+pin factory.  The boss has to stand up in front of the workers once per
+year and say "Thank you for your fine work last year.  This year, I want
+you to make lots of pins.  They should be really straight, blunt on one
+end, and pointy on the other.  See you next year."  In a university
+literature department, you need to have a meeting once per semester.
+Perhaps some of the curriculum should be revised?  In a business facing
+innovative competitors, you need to have a meeting once every month to
+think about required responses.  In a complex organization that is
+try to change and adapt, meetings and other forms of coordination may
+consume 20-30 hours per week.
+
+<p>
+
+Why is this a problem?  People still have to work 40 hours per week to
+get anything done.  The result is that people will have to spend 60-70
+hours per week at the office in order to coordinate and work.
+
+<p>
+
+What's the solution to this social problem?  A computer program of
+course!  (You didn't expect anything better from three MIT graduates did
+you?)
+
+<p>
+
+A modern organization exhibits the classical problem at which Web-based
+applications excel: people separated in time and space.  We can thus use
+the same toolkit that we developed for helping people work together and
+teach each other over the Internet to work together within an
+organization.
+
+<h3>For What Kinds of Organizations Is This Best?</h3>
+
+What kinds of organizations can get the most out of this toolkit?  Ones
+just like ArsDigita, of course!  We built this for ourselves.  ArsDigita
+has three offices (Boston, San Francisco, Los Angeles), 30 busy
+highly-paid people (July 1999), and rapid growth (revenue doubling every
+six months).  Coincidentally, it also works great for groups within
+larger companies.  Consider Jane Manager at Hewlett-Packard who is
+forming a team to build a new product.  Within a couple of weeks, she
+might be managing 100 people spread out among four physical locations in
+Japan, California, the Pacific Northwest, and Spain.  That's much faster
+organizational growth and change than any startup company will ever
+experience.  It would be awfully nice if Jane could go up to a Web
+browser and ask "Who works for me today?  What are their names?  What do
+they look like?  How do I get in touch with them?"
+
+<h3>The Medium-Size Picture</h3>
+
+We assume that all the employees are users in a standard ArsDigita
+Community System.  We keep track of employees, customers, project,
+salaries, and deadlines.  This enables us to ask questions like 
+
+<ul>
+<li> How many people work in this organization and how much money are we
+spending each month on salaries?
+<li> Who works for whom?  (fun with Oracle tree extensions)
+<li> What are our upcoming deadlines?
+<li> What is John Smith working on?
+<li> Which people are on the CNN project?
+<li> How much time did that project take?
+<li> What current issues and problems we are facing?
+<li> What has this project involved so far?
+</ul>
+
+For companies that operate an Internet service based on our toolkit, a
+side benefit of using our intranet module is that employees who develop
+skills in maintaining the intranet can then apply those skills to the
+public Web services.  Novices have to start out somewhere and they might
+as well start in a place where an error isn't observed by customers.
+
+<p>
+One of the key components to any intranet is keeping members of the company up-to-date.
+The intranet makes it easy to spam the entire company, a specific office, or employees 
+working on a given project. 
+
+<h4>Daily Status Report</h4>
+The intranet supports a daily status report that is sent to every employee 
+in the company, on a nightly basis. Any module in the acs can add something
+to this status report by:
+<ol>
+  <li> Creating a procedure that generates the content to include in the 
+       status report. This procedure takes 4 arguments: database handle (db), 
+       number of days the report covers (coverage, defaults to 1), 
+       the date of the report (report_date, defaults to sysdate), and
+       the purpose of the report (purpose, generally defaults to email, 
+       but can be either web_display or email_display.
+  <p><b>Example:</b>
+<br>
+<pre>
+proc im_news_status {db {coverage ""} {report_date ""} {purpose ""} } {
+    if { [empty_string_p $coverage] } {
+	set coverage 1
+    } 
+    if { [empty_string_p $report_date] } {
+	set report_date sysdate
+    } else {
+	set report_date "'$report_date'"
+    }
+    set since_when [database_to_tcl_string $db "select to_date($report_date, 'YYYY-MM-DD') - $coverage from dual"]
+    return [news_new_stuff $db $since_when "f" $purpose]
+}
+</pre>
+
+  <p><li> Adding the name of the procedure to a shared global: <br><b>Example:</b><br>
+<pre>
+ns_share im_status_report_section_list
+
+if { ![info exists im_status_report_section_list] || [lsearch -glob "$im_status_report_section_list" "im_news_status" ] == -1 } {
+    lappend im_status_report_section_list [list "News" im_news_status]
+}
+</pre>
+</ol>
+
+
+
+
+<h3>Under the Hood</h3>
+The parameters/ad.ini file
+<blockquote>
+<pre><code>
+[ns/server/yourservername/acs/intranet]
+IntranetName=yourdomain Network
+IntranetEnabledP=0
+DisplayVacationsOnCalendar=1
+; the unit of measurement for entering salaries (month or year)
+SalaryPeriodInput=year
+; used to display salary
+SalaryPeriodDisplay=year
+; list of fee types
+FeeTypes="setup" "monthly development" "monthly hosting" "hourly" "stock"
+; Do we want to track hours?
+TrackHours=1
+; what's the url stub? i.e. http://yourdomain.com<stub>
+IntranetUrlStub=/intranet
+; Group Types
+IntranetGroupType=intranet
+ProjectGroupShortName=project
+OfficeGroupShortName=office
+CustomerGroupShortName=customer
+PartnerGroupShortName=partner
+ProcedureGroupShortName=procedure
+EmployeeGroupShortName=employee
+AuthorizedUsersGroupShortName=authorized_users
+; What color do we put in the header row of tables?
+TableColorHeader=#e6e6e6
+; What color do we put in the odd numbered rows of tables?
+TableColorOdd=#f4f4f4
+; What color do we put in the even numbered rows of tables?
+TableColorEven=#ffffff
+</code></pre>
+</blockquote>
+
+<h4>Groups</h4>
+The intranet is a group_type, and each category of users is its own user_group
+of type intranet. Within each group, you can have subgroups if there is a need.
+One example is offices. There is a user group named Offices, and each office is
+a subgroup of the Office group. In this way, we can keep the large number of 
+objects organized in a hierarchical way. 
+
+
+<h4>Employees</h4>
+
+Employees or key members of the company are users of the 
+ArsDigita Community System. Every employee is a member of the
+employees user_groups. Detailed contact information is 
+stored for users to provide a company directory. 
+The <TT>im_employee_info</TT> table holds information
+like the employee's salary and Social Security number.
+<p>
+Note that Authorized Users are similar to employees, but are granted fewer 
+permissions.
+
+
+<H4>Offices</H4>
+
+There is a user group named Offices, and each office is a subgroup. Employees
+of a particular belong to one of the subgroups. Additional office information 
+is stored in the im_offices table.
+
+<h4>Projects</h4>
+<p>
+Typical projects are 
+<ul>
+<li> A  client project (iMedix.com)
+<li> A module (Project Tracker Module)
+<li> An initiative (convert company structure from LLC to SCorp)
+</ul>
+
+The <code>im_projects</code> table stores the main project information.
+
+Each project is itself a user group, and people who are working on the project 
+belong to the project user group. Additionally, projects can have multiple states,
+e.g. open/closed, which are stored in the <code>im_project_status</code> table, as
+well as types, e.g. client/toolkit, which are stored in the <code>im_project_types</code> table.
+<p>
+The projects are integrated with the ticket tracker. The idea here is to use 
+projects in the intranet as a way of managing information about the projects - 
+employee allocations, payments, people involved, etc. - and use the ticket
+tracker to actually manage work on the project.
+<p>
+Users can record time spent on each project or deadline. All these hours
+are recorded in the im_hours table.
+
+
+<h4>Customers</h4>
+
+All customers are user groups, and the <code>im_customers</code> table store 
+additional information about each customer. Like projects, customers have 
+multiple states, stored in the <code>im_customer_status</code> table.
+
+<h4>Partners</h4>
+
+All partners are user groups, and the <code>im_partners</code> table store 
+additional information about each partner. Like projects, partners have 
+multiple states, stored in the <code>im_partner_status</code> table, and multiple
+types, stored in the im_partner_types table.
+
+
+<hr>
+<a href="mailto:mbryzek@arsdigita.com"><address>mbryzek@arsdigita.com</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/license.text
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/license.text,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/license.text	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,340 @@
+		    GNU GENERAL PUBLIC LICENSE
+		       Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+                       59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+			    Preamble
+
+  The licenses for most software are designed to take away your
+freedom to share and change it.  By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users.  This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it.  (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.)  You can apply it to
+your programs, too.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+  To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+  For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have.  You must make sure that they, too, receive or can get the
+source code.  And you must show them these terms so they know their
+rights.
+
+  We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+  Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software.  If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+  Finally, any free program is threatened constantly by software
+patents.  We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary.  To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+
+		    GNU GENERAL PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License.  The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language.  (Hereinafter, translation is included without limitation in
+the term "modification".)  Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope.  The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+  1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+  2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+    a) You must cause the modified files to carry prominent notices
+    stating that you changed the files and the date of any change.
+
+    b) You must cause any work that you distribute or publish, that in
+    whole or in part contains or is derived from the Program or any
+    part thereof, to be licensed as a whole at no charge to all third
+    parties under the terms of this License.
+
+    c) If the modified program normally reads commands interactively
+    when run, you must cause it, when started running for such
+    interactive use in the most ordinary way, to print or display an
+    announcement including an appropriate copyright notice and a
+    notice that there is no warranty (or else, saying that you provide
+    a warranty) and that users may redistribute the program under
+    these conditions, and telling the user how to view a copy of this
+    License.  (Exception: if the Program itself is interactive but
+    does not normally print such an announcement, your work based on
+    the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole.  If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works.  But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+  3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+    a) Accompany it with the complete corresponding machine-readable
+    source code, which must be distributed under the terms of Sections
+    1 and 2 above on a medium customarily used for software interchange; or,
+
+    b) Accompany it with a written offer, valid for at least three
+    years, to give any third party, for a charge no more than your
+    cost of physically performing source distribution, a complete
+    machine-readable copy of the corresponding source code, to be
+    distributed under the terms of Sections 1 and 2 above on a medium
+    customarily used for software interchange; or,
+
+    c) Accompany it with the information you received as to the offer
+    to distribute corresponding source code.  (This alternative is
+    allowed only for noncommercial distribution and only if you
+    received the program in object code or executable form with such
+    an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it.  For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable.  However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+  4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License.  Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+  5. You are not required to accept this License, since you have not
+signed it.  However, nothing else grants you permission to modify or
+distribute the Program or its derivative works.  These actions are
+prohibited by law if you do not accept this License.  Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+  6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions.  You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+  7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all.  For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices.  Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+  8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded.  In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+  9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time.  Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number.  If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation.  If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+  10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission.  For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this.  Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+			    NO WARRANTY
+
+  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+  12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+		     END OF TERMS AND CONDITIONS
+
+	    How to Apply These Terms to Your New Programs
+
+  If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+  To do so, attach the following notices to the program.  It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) 19yy  <name of author>
+
+    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.
+
+    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.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+    Gnomovision version 69, Copyright (C) 19yy name of author
+    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+    This is free software, and you are welcome to redistribute it
+    under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License.  Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary.  Here is a sample; alter the names:
+
+  Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+  `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+  <signature of Ty Coon>, 1 April 1989
+  Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs.  If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library.  If this is what you want to do, use the GNU Library General
+Public License instead of this License.
Index: web/openacs/www/doc/mainframe-integration.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/mainframe-integration.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/mainframe-integration.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,87 @@
+<html>
+<!--AD_DND-->
+<HEAD><TITLE>ArsDigita Community System Mainframe Integation</TITLE></HEAD>
+<BODY bgcolor=#ffffff text=#000000>
+<h2>Integrating the ArsDigita Community System with Mainframe Data</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+
+by <A href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+At most large companies, the most useful information is held by
+transaction systems running on an IBM mainframe of some sort, e.g., an
+S/390.  The ACS-backed Web service <i>per se</i> isn't as interesting to
+an end-user as the access to data or transaction opportunities.  For
+example, consider <a href="http://www.fedex.com">www.fedex.com</a>.
+What users value is the ability to find out the current location of
+their package, not interaction with other users or any pure Web service.
+
+<h3>Approach 1: have AOLserver talk to the mainframe</h3>
+
+AOLserver comes with drivers for a bunch of RDBMSes, including a driver
+for the Solid RDBMS, whose C library is basically the same as ODBC (and
+therefore libraries from companies like 
+<a href="http://www.openlinksw.com/">http://www.openlinksw.com/</a> 
+and
+<a href="http://www.merant.com/">http://www.merant.com/</a> (used to be
+InterSolv)
+will work).  AOL publishes a document entitled "Developing Database
+Drivers for AOLserver" at 
+<a
+href="http://www.aolserver.com/server/docs/3.0/html/dr-app.htm#3527">http://www.aolserver.com/server/docs/3.0/html/dr-app.htm#3527</a>.
+
+<p>
+
+It takes a good C programmer only a few days to write a database driver
+for AOLserver and the result is typically 500-1000 lines of code.
+Remarkably, there is nothing in the AOLserver database pooling system
+that says the database has to be <em>relational</em> or interpret SQL.
+The database management system to which you're talking ought to return a
+cursor and then you page through row-by-row and/or just grab one row at
+a time.  It ought to have some kind of ASCII query language.  It ought
+to be running on the same machine as AOLserver or have some facility to
+be queried over TCP/IP.
+
+<p>
+
+Making AOLserver talk directly to an RDBMS or other DBMS on the
+mainframe works great if all you want to do is display pages of
+information from the mainframe or send user data back to the mainframe.
+However, if you want to combine queries or transactions with a local
+Oracle RDBMS and some kind of DBMS on the mainframe, it might be better
+to take the next approach.
+
+<h3>Approach 2: have Oracle talk to the mainframe</h3>
+
+AOLserver knows how to talk to Oracle.  Oracle knows how to talk to
+virtually any database management system in the world, via the Oracle
+Procedural Gateways (see <a
+href="http://www.oracle.com/gateways/html/procedural.html">http://www.oracle.com/gateways/html/procedural.html</a>).
+If you need to query from your local Oracle and include or exclude rows
+depending on what's in the mainframe, an Oracle Procedural Gateway is a
+convenience.  If you want to do an atomic transaction where you
+are guaranteed that a local operation and a mainframe operation will
+either both commit or both rollback, the Procedural Gateway is
+essential. 
+
+
+<blockquote>
+<font size=-2 face="verdana, arial, helvetica">
+
+
+Note: AOLserver is free and open-source.  It runs on any computer with a C
+compiler.  Oracle runs on most mainframes.  So you could just move
+everything to the mainframe and serve all the Web pages from there.
+Not too many companies would choose to do this, however.
+
+
+</font>
+</blockquote>
+
+
+<hr>
+<a href="mailto:philg@mit.edu"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/maintenance.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/maintenance.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/maintenance.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,59 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Maintenance</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Maintenance</h2>
+
+of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+The most important thing to ensure in an ACS installation is that Oracle
+exports are being made.  In general, it is unwise to rely on full
+recovery of a damaged Oracle installation.  In theory, it is possible to
+recover Oracle if (1) the thing was set up correctly to begin with, and
+(2) you have an Oracle dba wizard around to bring the system back to
+life.  In practice, I don't feel comfortable unless I have a full export
+of my Oracle database made nightly (using the Oracle exp utility, as
+outlined in <a href="http://photo.net/wtr/thebook/">my book</a>).
+
+<p>
+
+So check on this!
+
+<p>
+
+Disaster recovery or just rebuilding your Oracle installation for any
+other reason (change of block size, moving everything to new disks)
+would then consist of the following steps:
+
+<ul>
+<li>put the ArsDigita Community System into read-only mode by editing
+/tcl/ad-read-only.tcl; all the pages in the system that accept user
+input are supposed to call ad_read_only_p before offering users a form.
+When ad_read_only_p is set to return 1, people will still be able to
+read whatever they want from an ACS installation but they won't be
+encouraged to contribute comments or bboard postings that would get lost
+when you "flip the switch" to the new Oracle installation
+
+<li>build a new Oracle installation
+
+<li>import the latest export file (.dmp) 
+
+<li>switch AOLserver to talk to the new Oracle installation
+
+<li>edit /tcl/ad-read-only.tcl to put the system back into normal mode
+
+
+
+</ul>
+
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/member-value.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/member-value.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/member-value.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,54 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Member Value</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Member Value</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+<ul>
+<li>User-accessible directory:  none
+<li>Site administrator directory:  <a href="/admin/member-value/">/admin/member-value/</a>
+<li>data model :  <a href="/doc/sql/display-sql.tcl?url=/doc/sql/member-value.sql">/doc/sql/member-value.sql</a>
+
+</ul>
+
+<h3>The Big Idea</h3>
+
+If we're commercial, we want to know how much to charge each user at the
+end of each month.  If we're non-commercial, we want to use
+pseudo-dollars to track those members who are imposing a burden on the
+community (e.g., by posting off-topic questions in a discussion forum).
+
+<h3>Rates, etc.</h3>
+
+Rates and policies are kept in the "acs/member-value" section of the
+/parameters/ad.ini file.  I'm not 100% happy about this because I think
+that some Oracle-based accounting software might need to check rates.
+It also keeps simple Oracle triggers from adding charges.  But on
+balance, I thought it was more important to be consistent with the
+ad.ini religion of the ArsDigita Community System.  None of the pages
+that use member value depend explicitly on rates being stored in a .ini
+file.  Instead of using <code>ad_parameter</code> to check a rate, they
+use <code>mv_parameter</code> (defined in /tcl/ad-member-value.tcl).
+
+<h3>A non-commercial site</h3>
+
+A site like photo.net that is non-commercial but wishes to keep track of
+who has cost the community how much needs the following tables:
+
+<ul>
+<li>users_orders (because users_charges references it)
+<li>users_charges
+</ul>
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/module-owners.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/module-owners.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/module-owners.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,281 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Module Owners</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Module Owners</h2>
+
+<hr>
+<blockquote>
+
+<table width=90%>
+
+<tr>
+<td>address-book</td>
+<td><a href="mailto:yon@arsdigita.com"><address>yon@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>bboard</td>
+<td><a href="mailto:bdolicki@arsdigita.com"><address>bdolicki@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>bookmarks</td>
+<td><a href="mailto:aure@arsdigita.com"><address>aure@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>calendar</td>
+<td><a href="mailto:caroline@arsdigita.com"><address>caroline@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>chat</td>
+<td><a href="mailto:aure@arsdigita.com"><address>aure@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>classifieds and auction</td>
+<td><a href="mailto:curtisg@arsdigita.com"><address>curtisg@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>content-sections</td>
+<td><a href="mailto:karlg@arsdigita.com"><address>karlg@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>contest</td>
+<td><a href="mailto:markd@arsdigita.com"><address>markd@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>curriculum</td>
+<td><a href="mailto:caroline@arsdigita.com"><address>caroline@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>custom-sections</td>
+<td><a href="mailto:karlg@arsdigita.com"><address>karlg@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>customer relationship management</td>
+<td><a href="mailto:jsc@arsdigita.com"><address>jsc@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>directory</td>
+<td><a href="mailto:flattop@mit.edu"><address>flattop@mit.edu</address></a></td>
+</tr>
+
+<tr>
+<td>display</td>
+<td><a href="mailto:tri@arsdigita.com"><address>tri@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>download</td>
+<td><a href="mailto:adickens@arsdigita.com"><address>adickens@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>ecommerce</td>
+<td><a href="mailto:eveander@arsdigita.com"><address>eveander@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>events</td>
+<td><a href="mailto:bryanche@arsdigita.com"><address>bryanche@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>faq</td>
+<td><a href="mailto:dh@arsdigita.com"><address>dh@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>file-storage</td>
+<td><a href="mailto:aure@arsdigita.com"><address>aure@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>general-comments</td>
+<td><a href="mailto:tarik@arsdigita.com"><address>tarik@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>general-links</td>
+<td><a href="mailto:tzumainn@arsdigita.com"><address>tzumainn@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>general-permissions</td>
+<td><a href="mailto:richardl@arsdigita.com"><address>richardl@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>glassroom</td>
+<td><a href="mailto:james@arsdigita.com"><address>james@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>glossary</td>
+<td><a href="mailto:walter@arsdigita.com"><address>walter@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>graphics</td>
+<td><a href="mailto:eveander@arsdigita.com"><address>eveander@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>help</td>
+<td><a href="mailto:scott@arsdigita.com"><address>scott@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>homepage</td>
+<td><a href="mailto:karlg@arsdigita.com"><address>karlg@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>installation</td>
+<td><a href="mailto:gregh@arsdigita.com"><address>gregh@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>intranet</td>
+<td><a href="mailto:mbryzek@arsdigita.com "><address>mbryzek@arsdigita.com </address></a></td>
+</tr>
+
+<tr>
+<td>jobs</td>
+<td><a href="mailto:oumi@arsdigita.com"><address>oumi@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>member-value</td>
+<td><a href="mailto:malte@arsdigita.com"><address>malte@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>monitoring</td>
+<td><a href="mailto:abe@arsdigita.com"><address>abe@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>neighbor to neighbor</td>
+<td><a href="mailto:bcameros@arsdigita.com"><address>bcameros@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>news</td>
+<td><a href="mailto:jkoontz@arsdigita.com"><address>jkoontz@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>oracle driver</td>
+<td><a href="mailto:markd@arsdigita.com"><address>markd@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>photodb</td>
+<td><a href="mailto:jkoontz@arsdigita.com"><address>jkoontz@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>poll</td>
+<td><a href="mailto:markd@arsdigita.com"><address>markd@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>portals</td>
+<td><a href="mailto:aure@arsdigita.com"><address>aure@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>press</td>
+<td><a href="mailto:ron@arsdigita.com"><address>ron@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>Pull-Down Menus</td>
+<td><a href="mailto:aure@arsdigita.com"><address>aure@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>referer</td>
+<td><a href="mailto:jsc@arsdigita.com"><address>jsc@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>robot detection</td>
+<td><a href="mailto:michael@arsdigita.com"><address>michael@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>spam</td>
+<td><a href="mailto:hqm@arsdigita.com"><address>hqm@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>Survery Simple</td>
+<td><a href="mailto:nuno@arsdigita.com"><address>nuno@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>templating system</td>
+<td><a href="mailto:christian@arsdigita.com"><address>christian@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>ticket</td>
+<td><a href="mailto:davis@arsdigita.com"><address>davis@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>toolkit general stuff</td>
+<td><a href="mailto:jsc@arsdigita.com"><address>jsc@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>user administration</td>
+<td><a href="mailto:scott@arsdigita.com            "><address>scott@arsdigita.com            </address></a></td>
+</tr>
+
+<tr>
+<td>user categorization</td>
+<td><a href="mailto:sebastian@arsdigita.com"><address>sebastian@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>user groups</td>
+<td><a href="mailto:michael@arsdigita.com"><address>michael@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>user registration</td>
+<td><a href="mailto:lars@arsdigita.com"><address>lars@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>Web Mail</td>
+<td><a href="mailto:jcs@arsdigita.com"><address>jcs@arsdigita.com</address></a></td>
+</tr>
+
+<tr>
+<td>wimpy point</td>
+<td><a href="mailto:jsalz@mit.edu"><address>jsalz@mit.edu</address></a></td>
+</tr>
+
+</table>
+
+</blockquote>
+<hr>
+<a href="mailto:philg@mit.edu"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/module-review.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/module-review.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/module-review.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,131 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Module Review Guidelines</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+
+<h2>How to Review a Module</h2>
+
+of the <a href="">Arsdigita Community System</a> 
+by <a href="http://aure.com/">Aurelius Prochazka</a>
+and <a href="http://michael.yoon.org/">Michael Yoon</a>
+<hr>
+
+The ArsDigita Community System has gone through considerable changes
+over the course of its existence.  Design and coding rules that were
+once thought to be set in stone have changed, and modules must be
+reviewed on a regular basis to keep quality high, rather than only
+when the module is first introduced.
+
+<p>
+
+Another reason why the ACS code base is not as consistent as we would
+like is that our programming standards have been propagated through a
+largely oral tradition. Collecting material from <a
+href="developers">the Developers Guide</a> (which is the closest thing
+we have to a standards document but also contains higher-level
+information about user interface design and information design) and
+other publications (e.g., Ron Henderson's <a
+href="http://ron.arsdigita.com/toolkit/acs-development.html">ACS
+Development</a> page), we have now started to publish our standards at
+<a href="/doc/standards">/doc/standards</a> (an <a
+href="abstract-url">abstract URL</a>) so that no one will have to
+waste any more time wondering, "So what's the official way to do X?"
+
+<p>
+
+Read the standards, and, whether or not, they coincide exactly with
+your personal style, please adhere to them. If you disagree with a
+standard for substantive reasons, then don't silently dissent; rather,
+raise the issue so that -- assuming your argument is persuasive -- the
+standard will be changed for the better.
+
+<h3>Coverage</h3>
+
+A full review will cover all of the following:
+
+<ul>
+<li> /doc/<em>module</em>.html - this file should warn the code reviewer
+if there is anything tricky about the system at all
+<li> /doc/sql/<em>module</em>.sql
+<li> /tcl/<em>module</em>-defs.tcl
+<li> user pages in /<em>module</em>/
+<li> site-wide administrator pages in /admin/<em>module</em>/
+<li> module administrator pages in /<em>module</em>/admin/
+</ul>
+
+<h3>Goals</h3>
+
+The overarching goal is to produce high-quality software. Consistency,
+correctness, and efficiency are recognized dimensions of software
+quality. We strive to achieve all of these goals by taking the
+following concrete steps:
+
+<ol>
+<li> Standardize:
+
+<ul>
+<li> <a href="standards#file_naming">file naming</a> if possible (be
+careful not to break links)
+
+<li> the <a href="standards#file_header">header</a> of each file
+
+<li> each <a href="standards#tcl_library_file">Tcl library file</a>
+
+<li> the <a href="standards#page_input">input specification and
+validation of each page</a>
+
+<li> the <a href="standards#page_construction">construction of each
+page</a>
+
+</ul>
+
+<p>
+
+<li> Identify bugs (the <a href="common-errors">common errors</a> list
+is a good resource for accomplishing this goal)
+
+<p>
+
+<li> Identify potential improvements (optimization, modularity, user
+interface, etc.)
+
+<p>
+
+<li> <b>TEST, TEST, TEST</b> - reading code and documentation alone is
+not enough to do an effective code review; you need to see the module
+in action, so perform the appropriate <a
+href="acceptance-test">Acceptance Test</a> and enhance it if it does
+not achieve full coverage of the module's feature set. In the short
+term, we will need to be exploring more sophisticated testing methods
+(automated testing, load testing).
+
+</ol>
+
+<h3>Output</h3>
+
+There should be a concrete artifact from every module review, i.e., a
+list of actionable items for the module owner to complete. Once this
+list has been provided to him/her, the module owner should publish a
+plan for completing the list by a set deadline (this plan need not be
+complicated; if the list is short and simple, an email saying "I'll
+get these done today" is probably sufficient).
+
+<p>
+
+As for what form the list of review items should take, there is no
+standard yet. In the past, email has been the <i>de facto</i>
+standard, but email is bad for a lot of reasons. The <a
+href="http://www.arsdigita.com/ticket/?project_id=128">ACS Ticket
+Tracker</a> is a natural candidate for fulfilling this function. For
+now, use your best judgment; just be sure (one way or another) to get
+it in writing.
+
+<hr>
+
+<a href="http://aure.com/"><address>aure@arsdigita.com</address></a>
+
+</body>
+</html>
Index: web/openacs/www/doc/modules.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/modules.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/modules.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,190 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>ACS Modules</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>ACS Modules</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="mailto:tarik@arsdigita.com">Tarik Alatovic </a> 
+
+<hr>
+
+<h3>The Big Picture</h3>
+
+An ACS module is a self-contained subsystem delivering a service
+visible to the end-user.  From programmers point of view, it is a
+collection of sql tables definitions supported by an html interface
+generated by a scripting language such as tcl.  In order for a module
+to become a part of Arsdigita toolkit, it must implement <i>common and
+reusable</i> functionality. Examples of modules in Arsdigita toolkit
+are News, Bulletin Board, Address Book and Ecommerce modules.
+
+
+<h3>Module Architecture</h3>
+
+<b>Directory Structure</b>
+
+Let's take faq module (Frequently Asked Questions) as an example. It's
+files are stored in 3 directories: /faq, /faq/admin and /admin/faq.
+We need these three separate directories in order to separate three
+levels of access to the module data: public, module administration and
+system administration.  Pages in /faq are public pages showing faq
+questions and answers to the users.  Pages in /faq/admin are pages
+where module admistrator can add, edit or remove faq questions and
+answers. Pages in /admin/faq are provided for system administrator who
+may need to add or delete whole faqs, collect faq module statistics
+(e.g, how many people used faq module in the previous month) and be
+able to do other operations refering to the whole faq module and not
+just to an instance of it.
+  
+<b>Data Model</b>
+
+Data model for the module should reside in /doc/sql directory
+(e.g. /doc/sql/faq.sql for faq module). 
+<a href=http://photo.net/sql/data-modeling.html>Data modeling</a> is the
+hardest and most important part of any module. If you get the data
+model wrong, your module might not do what users need, it might be
+unreliable, and it might fill up the database with garbage. In order
+to support module ownership (assigning instances of your module to
+groups for example) and module customization, take a look at Module
+Customization and Ownership sections bellow for the changes you need
+to make to your data model.
+
+<b>Utility Functions</b>
+
+All the tcl functions you write for your module should go to your
+private tcl directory (e.g. faq module has it's tcl functions stored
+in faq-defs.tcl) and should be prefixed with the module name or it's
+abbreviation (e.g. faq_maintaner_p).  If you think you wrote a really
+generic tcl function that everybody can benefit from, then you can send
+e-mail to <a href=mailto:philg@mit.edu>philg@mit.edu</a> and ask for
+your function to become a part of Arsdigita Toolkit utility functions.
+
+
+<h3>Module Documentation</h3>
+
+Every module should have it's documentation in html format in /doc
+directory (e.g. /doc/faq.html for faq module). This documentation is
+primarily intended for programmers and should be brief and technical
+as necesssary. It should list the features that this module provides,
+explain purpose of the module and it's possible uses, and discuss
+design decisions. For good example of documentation, take a look at <a
+href=/doc/chat.html>/doc/chat.html</a>.
+
+<h3>Module Customization</h3>
+
+A good, reusable module will be used in many Arsdigita installations
+and it may be required to perform a slightly different funcionality
+then the default one.  A way to customize a module, so that it can be
+configured to support several different modes of operation is through
+usage of parameters.
+
+There are two levels at which the module can be customized: module and instance level. 
+
+<b>Module Level Customization</b>
+
+Module customization includes parameters that are used by every
+instance of the module.  These parameters should be put in
+configuration file your_server_name.ini in the parameters directory.  
+For download module, parameters in configuration file look like this:
+<blockquote>
+[ns/server/photonet-dev/acs/download]
+; root directory of the downloadable files
+DownloadRoot=/web/photonet-dev/download/
+</blockquote>
+These parameters can be accessed from within the code using ad_parameter function.
+
+<b>Instance Level Customization</b>
+
+Note that not all modules support multiple instances. For example, you can have 
+at most one instance of eccomerce module per installation. For modules that 
+support multiple instances, parameters should be columns in table where module 
+instances are defined. For example, instances of chat module are chat rooms and 
+parameters such as moderated_p (determines whether chat room should be moderated) 
+are kept in chat_rooms table. This way parameter moderated_p is associated with
+an instance of the chat module and not chat module as a whole. 
+When using parameters, you should make decision whether parameter should be 
+associated with module and therefore put in parameters file or associated with 
+a particular instance of the module and kept in the database.
+
+
+<h3>Module Ownership</h3>
+
+Standards for module ownership have been introduced in Arsdigita
+toolkit release 3.0.  Before release 3.0, very few modules supported
+ownership, such as address book module, which provided an address-book
+instance for each user, effectively making user the owner of the
+address book. 
+
+Notice that it makes sense only the modules supporting multiple instances ca
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In order to be able to use 
+
+
+The acs_modules table in <a href="/doc/sql/display-sql.tcl?url=/doc/sql/modules.sql">/doc/sql/modules.sql</a> stores information about the acs modules (news, bboard, ...)
+
+<blockquote>
+<pre>
+create table acs_modules (
+	module_key		varchar(30) primary key,
+	pretty_name		varchar(200) not null,
+	-- this is the directory where module public files are stored. 
+	-- for the news module public_directory would be /news
+	public_directory	varchar(200),
+	-- this is the directory where module admin files are stored
+	-- for the news module admin_directory would be /admin/news
+	admin_directory		varchar(200),
+	-- this is the directory where system admin files are stored 
+	-- notice that this is not always same as the admin_directory
+	-- e.g. ticket module has admin directory /ticket/admin and
+	-- site admin directory /admin/ticket
+	site_wide_admin_directory	varchar(200),
+	-- if module_type=system, this module has all: public, admin and site_wide admin pages (e.g. faq, news)
+	-- notice that often admin and site_wide admin directory are merged together
+	-- if module_type=admin, this is admin module and has no public pages (e.g. display, content_sections)
+	-- notice that modules of this type have no public pages
+	-- if module_type=site_wide_admin, this is module for site wide administration of another module (e.g. news_admin, bboard_admin)
+	-- notice that having admin module for another module allows us to assign administration of modules to user groups
+	-- in this case public_directory will correspond to the directory where files for site wide administration of that
+	-- module are stored and admin_directory and site_wide_admin_directory are irrelevant 
+	module_type                    varchar(20) not null check(module_type in ('system', 'admin', 'site_wide_admin')),
+	-- does module support scoping
+	supports_scoping_p	char(1) default 'f' check(supports_scoping_p in ('t','f')),
+	-- this is short description describing what module is doing	
+	description		varchar(4000),
+	-- this is url of the html file containing module documentation
+	documentation_url	varchar(200),
+	-- this is url of the file containing date model of the module
+	data_model_url		varchar(200)
+);
+</blockquote>
+</pre>
+
+<hr>
+
+<a href=mailto:tarik@arsdigita.com><address>tarik@arsdigita.com</address></a>
+</body>
+</html>
+
+
+
+
+
+
+
Index: web/openacs/www/doc/monitoring.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/monitoring.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/monitoring.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,132 @@
+<html>
+<head>
+<title>Monitoring</title>
+</head>
+<body bgcolor=#ffffff>
+<h2>Monitoring</h2>
+
+your <a href="index.html">ArsDigita Community System</a> installation
+by <a href="http://teadams.com">Tracy Adams</a> and <a href="mailto:jsalz@mit.edu">Jon Salz</a>
+
+<hr>
+
+<ul>
+<li>User directory:  none
+<li>Admin directory:   <a href="/admin/monitoring/">/admin/monitoring/</a> 
+<li>Procedures:  /tcl/watchdog-defs.tcl, /tcl/cassandracle-defs.tcl
+<li>Binaries: /bin/aolserver-errors.pl
+</ul>
+
+
+<h3>The Big Picture</h3>
+
+The ArsDigita Community System has an integrated set of monitoring 
+tools. 
+
+<h3>Parameters</h3>
+
+Monitoring parameters as centralized in the monitoring
+section of the .ini file.  Add a new <code>PersontoNotify</code> for
+each person who should receive monitoring alerts.
+
+<blockquote>
+<pre>
+[ns/server/yourservername/acs/monitoring]
+; People to email for alerts
+PersontoNotify=nerd1@yourservicename.com
+;PersontoNotify=nerd2@yourservicename.com
+; location of the watchdog perl script
+WatchDogParser=/web/yourservicename/bin/aolserver-errors.pl
+; watchdog frequency in minutes
+WatchDogFrequency=15
+</pre>
+</blockquote>
+
+<h3>Current page requests - monitor.tcl</h3>
+
+The "current page request" section (linked from /admin/monitoring/)
+will produce a report like the following.
+<p>
+
+<center>
+
+<table width=90>
+<tr><td colspan=6>There are a total of 8 requests being served right now (to 8 distinct IP addresses). Note that this number seems to include only
+the larger requests. Smaller requests, e.g., for .html files and in-line images, seem to come and go too fast for this program to
+catch. </td></tr>
+<tr><th>conn #<th>client IP<th>state<th>method<th>url<th>n seconds<th>bytes</tr>
+<tr><td>17899<td>212.252.145.38<td>running<td>GET<td>/photo/pcd3255/chappy-store-31.4.jpg<td>59<td>158544
+<tr><td>18185<td>38.27.213.213<td>running<td>GET<td>/wtr/thebook/html.html<td>21<td>0
+<tr><td>18247<td>171.210.228.91<td>running<td>GET<td>/photo/nikon/nikon-reviews.html<td>15<td>0
+<tr><td>18367<td>209.86.54.190<td>running<td>GET<td>/bboard/image.tcl<td>8<td>34228
+<tr><td>18454<td>199.174.160.135<td>running<td>GET<td>/photo/pcd1669/treptower-big-view-51.4.jpg<td>1<td>34376
+<tr><td>18464<td>207.100.29.220<td>running<td>?<td>?<td>1<td>0
+<tr><td>18468<td>216.214.210.53<td>running<td>GET<td>/chat/js-refresh.tcl<td>0<td>0
+<tr><td>18481<td>216.34.106.252<td>running<td>GET<td>/monitor.tcl<td>0<td>0
+</table>
+</center>
+<p>
+This report will inform you which users are waiting on pages from your server.
+In the report above, users asking for large images or pages are waiting.  This
+is normal because some users have very slow connections.
+<p>
+If you see the same .tcl or .adp file often, especially with the longest wait times, it is likely that the script is extremely slow or is hogging database handles. You should
+<ul>
+<li>Examine and fix the page
+<li>User <a href=proc-one.tcl?proc_name=ad_return_if_another_copy_is_running>ad_return_if_another_copy_is_running</a> to limit the number of times the page can concurrently run (limit to a few less than your total db pool).  
+This will prevent multiple executions of that page from destroying your whole web service.
+</ul>
+<p>
+If you see a large number of requests from the same IP address, it is 
+likely that a poorly-designed spider is attacking your web service. To stop it,
+ban that IP address from your system.
+
+<h3>Cassandracle (Oracle)</h3>
+
+Cassandracle is a Web-based monitor for an Oracle installation. 
+The goal is that, at a glance, a novice Oracle DBA ought to be
+able to identify problems and find pointers to relevant reference materials. 
+<p>
+To use Cassandracle in your installation, you will need to 
+give the web service's database
+user read access to some core Oracle tables.  
+
+<ol>
+<li>Log into Oracle via sqlplus
+<li>Execute:
+<blockquote>
+SQL>  connect internal
+</blockquote>
+<li> Run the commands in /sql/cassandracle.sql
+<li> Execute
+<blockquote>
+SQL> grant ad_cassandracle to username;
+</blockquote>
+</ul>
+
+<h3>Configuration</h3>
+
+This is a simple section with information about the current machine
+and connection. The information provided is pretty sparse and should
+expand in the future.
+
+<h3>WatchDog (Error log)</h3>
+
+Every <code>WatchDogFrequency</code> seconds, the service's error logs will
+be scanned. If errors are found, they will be emailed to those configured
+as a <code>PersontoNotify</code>.  The administration pages have a tool
+to search the error log for errors.
+
+<h3>Registered Filters and Schedule Procedures</h3>
+
+The <tt>ad_register_filter</tt> and <tt>ad_schedule_proc</tt> procs are
+wrappers around the corresponding <tt>ns_</tt> calls, which allow us to
+more carefully track what's happening on the server and when.
+/admin/monitoring/filters.tcl shows which filters are called for which URLs and
+methods, and /admin/monitoring/scheduled-procs.tcl shows which procedures are
+scheduled to be called in the future.
+
+<hr>
+
+<a href="mailto:teadams@arsdigita.com"><address>teadams@arsdigita.com</address></a>,
+<a href="mailto:jsalz@mit.edu"><address>jsalz@mit.edu</address></a>
Index: web/openacs/www/doc/neighbor.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/neighbor.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/neighbor.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,124 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Neighbor to Neighbor system</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Neighbor to Neighbor system</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+<ul>
+<li> User-accessible directory: <a href="/neighbor/">/neighbor/</a>
+<li> Site adminstrator directory: <a href="/admin/neighbor/">/admin/neighbor/</a> (must use https://)
+<li> data model: <a href="/doc/sql/display-sql.tcl?url=/doc/sql/neighbor.sql">/doc/sql/neighbor.sql</a>
+<li> procedures: /tcl/neighbor-defs.tcl
+</ul>
+
+
+The original idea, going back to 1995, of the Neighbor to Neighbor
+system was a repository of user experience with various kinds of
+merchants.  I should be able to visit the service at
+http://photo.net/photo/ and say "I bought a camera via mail from Joe
+Smith and it arrived when promised and in the stated condition."  I
+should be able to come back a month later and edit the posting and say
+"Ooops..  actually the camera had a subtle hidden flaw."
+
+<p>
+
+At the time, it seemed like a very different application from threaded
+discussion.  In practice, the bboard system grew much more flexible and
+users of the Neighbor service really seemed to need some kind of
+grouping/threading of items.
+
+<p>
+
+So why do we still have separate systems?  I think that organizing by
+merchants and knowing that people are talking about transactions is
+going to be valuable in the long run.  These are specializations that
+would really uglify the bboard code and /bboard section of the ad.ini
+parameters file.  
+
+<p>
+
+The current code makes good use of the <code>about</code> column
+in the <code>neighbor_to_neighbor</code> table.  This would typically be
+filled with a merchant name, e.g., "B&H Photo".  In theory, the code can
+do much more than this. 
+
+<P>
+
+The original idea was to have several sites running on the same db
+server (so there was a <code>domain</code> column).  Then each site
+would have several neighbor services, e.g., my personal site could have
+a "photographic" category and a "Web servers" category.  Within each
+category there would be subcategories, e.g., "Camera Shops" for
+"photographic".
+
+<P>
+
+Like all comprehensive ambitious systems designed and operated by stupid
+people, neighbor to neighbor never really blossomed.  I ended up using
+it at http://photo.net/photo/ with a hardwired domain and a hardwired
+primary category.  I don't want to break links from all over the
+Internet so I can't really change this now.  Thus there will have to be
+a default primary_category in the ad.ini file.
+
+<P>
+
+Another thing that should be added is good support for regionalism.  It
+might be useful to have recommendations of roofing contractors but these
+have to be broken up by state.  There is a <code>region</code> column in
+the data model but I haven't really done anything with the code to
+support it.
+
+<p>
+
+Interesting anecdote: in mid-1999, four years after this software was
+built, a company called <a
+href="http://www.epinions.com">epinions.com</a> in California raised
+$millions in venture capital to do the same thing as <a
+href="http://photo.net/neighbor/">http://photo.net/neighbor/</a>!
+
+<h3>Configuration</h3>
+
+Here's the section from the ad.ini file:
+
+<blockquote>
+<pre><code>
+[ns/server/yourservername/acs/neighbor]
+; SystemName=Yourdomain Neighbor to Neighbor Service
+; SystemOwner= something different (if desired) from SystemOwner above
+; HostAdministrator=something different from system-wide
+; if you're only going to run one little category, and
+; for backward compatibility for photo.net
+; this is a category_id referencing the n_to_n_primary_categories
+; table
+DefaultPrimaryCategory=1
+; if someone can't think of more than one; affects links from opc.tcl
+OnlyOnePrimaryCategoryP=0
+; do we offer users a full-text search box
+ProvideLocalSearchP=1
+; do we use Oracle's Context option (only works if 
+; ProvideLocalSearchP=1)
+UseContext=0
+; do we use standalone PLS search system
+UsePLS=0
+; do we use AltaVista (only works if ProvideLocalSearchP=0
+; and if the site's content is exposed to AltaVista)
+LinktoAltaVista=0
+SolicitCommentsP=1
+CommentApprovalPolicy=wait
+</code></pre>
+</blockquote>
+
+
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/new-stuff.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/new-stuff.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/new-stuff.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,63 @@
+<html>
+<head>
+<!--AD_DND-->
+<title>New Stuff Package</title>
+</head>
+<body bgcolor=#ffffff text=#000000>
+
+<h2>New Stuff Package</h2>
+
+part of the <a href=index.html>ArsDigita Community System</a> 
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+<ul>
+
+<li>User directory:  none (just one page at <a href="/shared/new-stuff.tcl">/shared/new-stuff.tcl</a>)
+<li>Admin directory:  none (just one page at <a href="/admin/new-stuff.tcl">/admin/new-stuff.tcl</a>)
+
+<li>data model:  none
+
+<li>procedures:  base in /tcl/ad-new-stuff.tcl; generally one per
+ACS module within each module's defs.tcl file
+
+</ul>
+
+I'm too lazy to write more docs so I'll just quote from the .tcl file:
+
+<pre>
+# the big idea here is to have a central facility to look at content
+# posted by users across the entire site.  This is useful for the site
+# administrator (might want to delete stuff).  This is useful for the 
+# surfing user (might want to click through to stuff).  This is useful
+# for generating email summaries.
+
+# one weird extra feature is that we have an argument to limit to new 
+# content posted by new users.  This is an aid to moderators.  Basically
+# the idea is that new content posted by a person who has been a community
+# member for a year is unlikely to require deletion.  But new content
+# posted by a brand new community member is very likely to require scrutiny
+# since the new user may not have picked up on the rules and customs
+# of the community.
+
+# (publishers who require approval before content goes live will want
+# to see old users' contributions highlighted as well since these need
+# to be approved quickly)
+
+# this system scales as modules are added to the ACS either by
+# ArsDigita or publishers.  The basic mechanism by which modules buy
+# into this system is to lappend a data structure to the ns_share
+# variable ad_new_stuff_module_list (a Tcl list)
+</pre>
+
+<hr>
+
+<address>
+<a href="http://photo.net/philg/">philg@mit.edu</a>
+</address>
+</body>
+</html>
+
+
+
Index: web/openacs/www/doc/news.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/news.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/news.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,131 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>News</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>News</h2>
+
+part of the <a href="">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a> and <a href="mailto:jkoontz@arsdigita.com">Jesse Koontz</a>
+
+<hr>
+
+<ul>
+<li>User-accessible directory:  <a href="/news/">/news/</a>
+<li>Site administrator directory:  <a href="/admin/news/">/admin/news/</a>
+<li>data model :  <a href="/doc/sql/display-sql.tcl?url=/doc/sql/news.sql">/doc/sql/news.sql</a>
+<li>Tcl procs:  /tcl/news-defs.tcl 
+
+</ul>
+
+<h3>The Big Idea</h3>
+
+A news item is something that is interesting for awhile and then should
+disappear into the archives without further administrator intervention.
+We want a news article to serve as the focus of user comments.  You
+could use the /bboard system to accomplish the same function.  If you
+did, you'd get the advantages of file attachments, group-based
+administration, etc.  But we think that news truly is different from
+discussion.  We want to present it by date, not by topic.  The publisher
+probably wants to be very selective about what gets posted (as news if
+not as comments on news).  So it gets a separate module.
+<p>
+However, a <b>Newsgroup</b> approach allows a small about of administrative
+control over group scoped news postings.
+<blockquote>
+A message area in the Usenet News, each newsgroup can be either 'moderated' with only 
+postings approved by a moderator publically posted, or 'unmoderated' where all messages 
+are distributed to the newsgroup immediately. 
+</blockquote>
+<p>
+This module has three special newsgroups. The public newsgroup contains news
+items that are accessed at the site wide scope. The all_users newsgroup contains
+news items that show up on all newsgroups. The registered_users
+newsgroup contains news items that show up for all registered users.
+
+<h3>Under the Hood</h3>
+
+The data model has a two tables; one for describing newsgroup and another for holding the news items.
+
+<blockquote>
+<pre><code>
+create sequence newsgroup_id_sequence start with 1;
+
+create table newsgroups (
+	newsgroup_id	integer primary key,
+        -- if scope=all_users, this is the news for all newsgroups
+        -- is scope=registered_users, this is the news for all registered users
+	-- if scope=public, this is the news for the main newsgroup
+	-- if scope=group, this is news associated with a group
+        scope           varchar(20) not null,
+	group_id	references user_groups,
+	check ((scope='group' and group_id is not null) or
+	(scope='public') or
+	(scope='all_users') or
+	(scope='registered_users'))
+);
+
+
+create sequence news_item_id_sequence start with 100000;
+
+create table news_items (
+	news_item_id		integer primary key,
+	newsgroup_id		references newsgroups not null,
+	title			varchar(200) not null,
+	body			clob not null,
+	-- is the body in HTML or plain text (the default)
+	html_p			char(1) default 'f' check(html_p in ('t','f')),
+	approval_state		varchar(15) default 'unexamined' check(approval_state in ('unexamined','approved', 'disapproved')),
+	approval_date		date,
+	approval_user		references users(user_id),
+	approval_ip_address	varchar(50),
+	release_date		date not null,
+	expiration_date		date not null,
+	creation_date		date not null,
+	creation_user		not null references users(user_id),
+	creation_ip_address	varchar(50) not null
+);
+</code></pre>
+</blockquote>
+
+Comments are handled by the general comments facility and are attached to news items.
+<p>
+Permissions are handled by the general permissions system, and are attached
+to the newsgroup rows.
+<p>
+This module requires that a row exists in the newsgroups table before news
+items can be stored for a group (or scope). The all_users, registered_users, and
+public newsgroups are created by default. The group newsgroups are created when
+a group administrator or site-wide admin attempts to add an item or set the 
+newsgroup permissions. The default permissions for a non-existent group scope
+newsgroup is to allow members to view and admins to modify.
+
+<h3>Related Modules</h3>
+
+The <a href="calendar.html">/calendar module</a> is better if the news
+is about an upcoming event.  In this module, the non-expired items that
+are closest are displayed.  Also, there is some support for
+personalization by state or country.  See <a
+href="http://www.harpcolumn.com">www.harpcolumn.com</a> for a good
+running example that distinguishes /news from /calendar.
+
+
+<p>
+
+The <a href="bboard.html">/bboard system</a> is better if you want to
+support lively discussion and archive the exchanges.
+
+<h3>Future Enhancements</h3>
+
+This module will eventually be designed to produce an XML document of the 
+news items to be displayed. This can then be displayed in an adp templating
+system or incorporated as a part of a larger XML document.
+<p>
+The module may also eventually support the deletion of items (and associated
+permissions and comments).
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/partner.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/partner.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/partner.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,212 @@
+  <html>
+<head>
+  <title>Partner Co-Branding</title> 
+</head>
+<body bgcolor=white>
+<h2>Partner Co-Branding</h2>
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="mailto:mbryzek@arsdigita.com">Michael Bryzek</a>
+
+<hr>
+
+<blockquote>
+
+
+
+<ul>
+<li>User-accessible directory:  None (It's transparent to users)
+<li>Site administrator directory:  <a href="/admin/partner/">/admin/partner/</a>
+<li>data model :  <a href="/doc/sql/display-sql.tcl?url=/doc/sql/partner.sql">/doc/sql/partner.sql</a>
+<li>Tcl procs:  /tcl/partner.tcl
+</ul>
+
+<B>Public demonstrations: </b>
+  <ul>
+
+    <li> <a href=http://www.guidestar.org/gs/search>GuideStar Search</a>
+    <li> <a href=http://www.guidestar.org/aol/search>GuideStar Search</a>  (co-branded for AOL's <a href=http://www.helping.org>helping.org</a>)
+    <li> <a href=http://www.guidestar.org/schwab/search>GuideStar Search</a>  (co-branded for Schwab's <a href=http://www.schwabcharitable.org/>www.shwabcharitable.org</a>)
+
+  </ul>
+
+<h3>What is Co-Branding?</h3>
+Co-branding refers to the ability to make one page maintain full functionality while swapping in a
+new look-and-feel. Co-Branding must be easy to do - that is, we do not want to maintain duplicate
+files for every single co-brand partner... one file should be able to generate multiple look-and-feels
+with no modification to the single file.
+
+
+<h3>The Big Picture</h3>
+Many sites market their functionality to other websites - sometimes for money, but always to generate
+more traffic. A lot of the big sites on the web will only partner with your puny-in-comparison web
+service if you provide them with your site functionality but maintain the look-and-feel of their
+website. 
+<p>
+The brute force method to doing this is to use the <a href=style.html>ad-style</a> system and
+create a separate adp file for every single page you want to co-brand, and for every partner you
+want to support. This quickly gets out-of-hand if you support more than a couple partners and more
+than a couple pages.
+<p>
+This partner module lets you co-brand directories, as opposed to individual files, on a 
+partner-by-partner basis. And, once the files in a directory have been set-up to support co-branding,
+adding another partner takes almost no time at all (about 30 minutes to 4 hours depending on the 
+complexity of the new partner's html templates and the quality of their html). That's the point - in
+30 minutes, you can co-brand an entire directory for a new partner. If that directory contains 100 files,
+you've added templates to 100 files at a rate of 20 seconds per page - that's pretty efficient.
+<p>
+Co-branding works by separating a page into three components:
+<ol> 
+  <li> <b>The Header</b>: This refers to the top and left side of the page including, for example,
+       top graphics, left menu bars, etc.
+  <li> <b>Page Contents</b>: This refers to the actual contents of the page - the functionality, 
+       the features,
+       results of database queries etc. For co-branding to work with the partner module, the
+       Page Contents must be shared by all partners (If you need custom page contents for individual 
+       pages, the <a href=style.html>ad-style</a> system is for you.
+  <li> <b>The Footer</b>: This refers to the bottom and right side of the page including.
+</ol>
+
+<h3>The Medium-Sized Picture</h3>
+For each directory that you want to cobrand, you add a new "partner" through the 
+<a href=/admin/partner/>Partner Manager</a>. Each partner has some default properties associated 
+with it, such as what fonts to use, what colors to use, etc. The most important property is the 
+Partner Cookie - partner is cookie based. When you add a partner, you specify the name of the
+cookie you want to use to uniquely identify that partner. When the aolserver starts-up, it registers
+each of the partner-cookies to redirect requests for any url with starting with that cookie to a procedure
+that sets a user cookie (named ad_partner) and redirects to whatever page was specified after the cookie.
+
+<p>
+For example, with GuideStar.org, we have 3 partners:
+<ul>
+  <li> GuideStar (cookie=gs): <a href=http://www.guidestar.org/gs/search>http://www.guidestar.org/gs/search</a>
+  <li> AOL (cookie=aol): <a href=http://www.guidestar.org/aol/search>http://www.guidestar.org/aol/search</a>
+  <li> Schwab (cookie=schwab): <a href=http://www.guidestar.org/schwab/search>http://www.guidestar.org/schwab/search</a>
+</ul>
+Note that the final page no longer has the cookie in it! 
+
+<p>
+By using the cookie system, we avoid having to register procs or think about how we create links
+on our pages - it's all taken care of behind-the-scenes.
+
+<h3>Using partner</h3>
+If your version of acs includes partner, you'll need not configure anything to create your first
+co-branded page as partner comes with a default profile set up for ArsDigita look and feel.
+In fact, the entire <a href=/admin/partner>/admin/partner</a> directory uses the partner system
+to generate it's own look and feel even though it is not necessary. (partner frees you from ever 
+having to think about page headers and footers while you write your pages).
+<p> 
+To Create your first partner page, simply put the following .tcl file anywhere in your file tree:
+<pre>
+ReturnHeaders
+set page_title "My first co-branded page"
+set context_bar [ad_context_bar [list "/index.tcl" "Home"] "Test Page"]
+ns_write "
+[ad_partner_header]
+I just wanted to see what it's like to work with partner
+[ad_partner_footer]
+"
+</pre>
+And that's it! 
+
+<p><b>How this page is processed</b>
+<br>
+The call to ad_partner_header triggers the following sequence of events:
+<ol>
+  <li> We look at your current url and query the view ad_partner_header_procs to look
+       for tcl procedures that have been registered for that url. Note that we do not 
+       require a db handle to be passed as the db handle is only used if necessary.
+  <li> If we don't find any tcl procedures, we try the parent directory. Eventually we 
+       come to the root directory "/" for which partner already registered two procedures
+       (Check the installation script for partner)
+  <li> partner memoizes the list of procedures to run for your current url to avoid hitting 
+       the database next time you request the same url.
+  <li> partner runs the list of procedures, in the order specified (check out the Partner Manager
+       to see the order). These procedures simple call [ad_header $title] (note title is grabbed
+       from your calling environment) and append some additional html to the result.
+  <li> The html string is returned.
+</ol>
+We process the rest of the page as usual, and then reach the call to ad_partner_footer, which triggers
+the same sequence of events as for ad_partner_header, except we use the view ad_partner_footer_procs.
+
+<p>
+To co-brand an existing acs file with:
+<ol>
+  <li> Use the Partner Manager to register the tcl procedures to run for a given directory
+  <li> Replace ad_header with ad_partner_header
+  <li> Replace ad_footer with ad_partner_footer
+</ol>
+
+Note: There is another way to return co-branded pages, which I prefer:
+<pre>
+set page_title "My first co-branded page"
+set context_bar [ad_context_bar [list "/index.tcl" "Home"] "Test Page"]
+set page_body "I just wanted to see what it's like to work with partner"
+ns_return 200 text/html [ad_partner_return_template]
+</pre>
+ad_partner_return_template simply looks for $page_body and then generates
+the appropriate page. This way of using the partner system has the added benefit that you can
+release your database handle(s) before returning any html (just be sure the page loads quickly 
+or else your users will look at a blank screen!).
+
+<h3>Under the hood</h3>
+
+<b>Parameters File:</b>
+<pre>
+[ns/server/vs/acs/partner]
+; what is the name of the default partner cookie?
+CookieDefault=ad
+; All the variables we want to collect  (Any variables added here
+; must still be manually added to the data model.)
+; Each line of Variable= contains a pipe separated pair of 
+; name_of_column in ad_partner | what to display on the add/edit forms
+Variable=partner_name|Partner Name
+Variable=partner_cookie|Partner Cookie
+Variable=default_font_face|Default Font Face
+Variable=default_font_color|Default Font Color
+Variable=title_font_face|Title Font Face
+Variable=title_font_color|Title Font Color
+</pre>
+
+Note that except for group_id, all variables should be listed in the parameters file.
+We separate group_id to make a nice select box on the UI to easily tie a set of partner
+parameters to a user_group.
+
+<p><b>Accessing variables defined in the Partner Manager</b>
+All the variables you create using the Partner Manager can be accessed in tcl with this call:
+<pre>
+[ad_partner_var name_of_column]
+</pre>
+ad_partner_var memoizes the result to make retrieving partner variables fast.
+<p>
+Because we use fonts so often, there are two helper procedures to make getting font definitions
+easy:
+<pre>
+proc_doc ad_partner_default_font { {props ""} } {Returns an html font tag with the default font face and default font color filled in from the partner database. If props is nonempty, it is simply included in the font statement} {
+
+    set html "&lt;font face=\"[ad_partner_var default_font_face]\" color=\"[ad_partner_var default_font_color]\""
+    if { ![empty_string_p $props] } {
+	append html " $props"
+    }
+    return "$html&gt;"
+}
+
+proc_doc ad_partner_title_font { {props ""} } {Returns an html font tag with the default font face and default font color filled in from the partner database. If props is nonempty, it is simply included in the font statement} {
+    set html "&lt;font face=\"[ad_partner_var title_font_face]\" color=\"[ad_partner_var title_font_color]\""
+    if { ![empty_string_p $props] } {
+	append html " $props"
+    }
+    return "$html&gt;"
+}
+
+</pre>
+
+I don't think there is anything particularly interesting about the 
+<a href=/doc/sql/display-sql.tcl?url=/doc/sql/partner.sql>Data Model</a> so I've left it in it's own file.
+
+
+
+
+</blockquote>
+<hr size=1>
+<i>written by <a href=mailto:mbryzek@arsdigita.com>mbryzek@arsdigita.com</a> in January 2000</i>
+</body></html>
Index: web/openacs/www/doc/patches.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/patches.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/patches.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,31 @@
+<html>
+<head>
+<title>Patches for this installation</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Patches for this installation</h2>
+
+of the ArsDigita Community System
+
+<hr>
+
+Any changes, enhancements or fixes that you make to the core ArsDigita
+software should be logged on this page.  The information will then be
+useful (a) when upgrading this installation to a new version of the ACS
+(we'll know which files have to be customized), (b) when building new
+versions of the ACS core distribution, we can pull improvements and
+fixes from all of our installations merely by looking at
+/doc/patches.html on each one.
+
+<ul>
+<li>suggested format:  filename; change description; date; programmer
+<li>e.g.:  /bboard/q-and-a.tcl; made searching submit button appear even
+with non-MSIE browsers; 6/3/98; philg
+
+
+</ul>
+
+
+</body>
+</html>
Index: web/openacs/www/doc/permissions.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/permissions.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/permissions.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,211 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Permission Package</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Permission Package</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://teadams.com">Tracy Adams</a>
+
+<hr>
+
+<ul>
+<li>User directory:  none
+<li>Admin directory:  everything is done in the existing user group directory
+<a href="/admin/ug/">/admin/ug/</a> (this package builds on 
+<a href="user-groups.html">user groups</a>)
+
+<li>data model:  subsection within 
+<a href="/doc/sql/display-sql.tcl?url=/doc/sql/user-groups.sql">/doc/sql/user-groups.sql</a>
+
+<li>procedures:  mostly within /tcl/ad-user-groups.tcl
+
+</ul>
+
+<h3>The Big Picture</h3>
+
+We want a standardized way of asking "Is user x allowed to do y?"
+
+<h3>The Medium-sized Picture</h3>
+
+We define a table 
+
+<blockquote>
+<pre>
+create table administration_info (
+ 	group_id	integer not null references user_groups,
+	module		varchar(300) not null,
+	submodule	varchar(300),
+	unique(module, submodule, group_id)
+);
+</pre>
+</blockquote>
+
+This allows us to associate a user group with administration of a
+particular section of a site.  In general, these user groups will have a
+group type of "administration".  The extra columns for a user group of
+this type are "module" and "submodule".
+
+<p>
+
+The other key feature of this software package is a set of Tcl
+procedures that developers can call to find out of a user has
+appropriate permissions.  These procedures may elect to cache.
+For example, we expect pages to call <code>ad_permission_p</code> to
+find out whether a user is authorized to perform a particular action.
+
+<blockquote>
+<pre>
+create table user_group_action_role_map (
+	group_id     	integer not null references user_groups,
+	role		varchar(200) not null,
+	action		varchar(200) not null,
+	creation_date        date not null,	
+	creation_user        integer not null references users,
+	creation_ip_address  varchar(200) not null,
+	primary key (group_id, role, action) );
+</pre>
+</blockquote>
+
+<h3>Definitions</h3>
+
+<ul>
+
+<li><b>Site-wide administrator:</b> A person with access to the
+site-wide (/admin) pages. These pages are generally password-protected
+with AOLserver and users access these pages with https.  Some pages
+underneath /admin demand that the user be logged in, but we've been
+sloppy about requiring administration group membership for this user.
+
+<li><b>Group administrator:</b> A person with the role of
+"administrator" in a user group has the power to approve or reject
+applications by others for group membership.  Group administrators 
+implicitly have all the authority of users with any other role in the
+group.
+
+<li><b>Content administrators:</b>  A person with some role in a user
+group associated with a module (or module/submodule combination).
+
+
+</ul>
+
+<h3>The Steps</h3>
+
+Consider applying this package to a legacy ACS module such as the
+classified ad system (/gc/).  Here are the steps:
+
+<ul>
+
+<li>decide whether we are going to permission the entire system or elect
+content administrators on a per-domain basis (assume that we decide to
+go per-domain)
+
+<li>decide whether you need basic or multi-role permissions; in the
+"basic" case, everyone in the administration group with the roles of
+either "all" or "administrator" will have privileges according to 
+<code>ad_permission_p</code>.  In the multi-role case, 
+<code>ad_permission_p</code> will explore the 
+<code>user_group_action_role_map</code> table to find out whether 
+a user with a particular role can perform the specified action.  (assume
+that we decide to use the basic system)
+
+<li>create administration groups for each existing classified ad domain,
+using <code>ad_administration_group_add</code> or its PL/SQL
+counterpart.
+
+<li>insert a call to <code>ad_administration_group_add</code> in the
+code that creates a new classified ad domain
+
+<li>insert calls to <code>ad_permission_p</code> anywhere in the /gc/
+pages that you want to check authorizations
+
+<li>visit the /admin/ug/ pages to assign users to the created
+administration groups
+
+</ul>
+
+
+<h3>Apply the permissions package to modules that already have user
+groups</h3>
+
+If you already have a user group associated with your module, you do not
+have to create a group of type "administration"; you can use the
+lower-level generic helper procedures below.
+
+<h3>Multi-Role</h3>
+
+For some applications, roles of <i>"administrator"</i> and <i>"all"</i>
+are not sufficient.  For example, we've used this package in a system
+that keeps electronic medical records.  We needed to restrict access to
+various pages depending on the user's role in the hospital.  Some users
+were allowed access to full patient records, while others were only
+allowed to enter demographic information.
+
+<p>
+
+You specify multi-role permissions when you create a group with <a
+href="proc-one.tcl?proc_name=ad_administration_group_add">ad_administration_group_add</a>
+or by toggle the multi-role perms column in
+/admin/ug/group.tcl.  A group of any type, i.e., even one that isn't
+"administration" can be the basis of a multi-role permission scheme.
+
+<p>
+
+Once multi-role perms are enabled, the /admin/ug/group.tcl page will
+sprout some new user interface.  The basic idea is that you add roles
+and actions until you're looking at a matrix of which roles are
+authorized to perform which actions.  You could also fill this matrix
+programmatically by calling the procedures 
+ <a
+href="proc-one.tcl?proc_name=ad_administration_group_role_add">ad_administration_group_role_add</a>, 
+<a href="proc-one.tcl?proc_name=ad_administration_group_action_add">ad_administration_group_action_add</a>,
+<a
+href="proc-one.tcl?proc_name=ad_administration_group_action_role_map">ad_administration_group_action_role_map</a>.
+
+
+<h3>Administration group type procedures</h3>
+
+Groups of type administration can be identified 
+by their module and submodule.
+
+<ul>
+<li> To answer <i>"Is user x allowed to do y?"</i>   <a href="proc-one.tcl?proc_name=ad_permission_p">ad_permission_p</a>
+<li> To see if a user is in the group:  <a href="proc-one.tcl?proc_name=ad_administration_group_member">ad_administration_group_member</a>
+<li> Create a group of type administration: <a href="proc-one.tcl?proc_name=ad_administration_group_add">ad_administration_group_add</a> or the pls-sql procedure administration_group_add
+<li> To grant a user a role in an administration group:  <a href="proc-one.tcl?proc_name=ad_administration_group_user_add">ad_administration_group_user_add</a>
+<li> To add a role to an administration group:  <a href="proc-one.tcl?proc_name=ad_administration_group_role_add">ad_administration_group_role_add</a>
+<li> To add an action to an administration group: <a href="proc-one.tcl?proc_name=ad_administration_group_action_add">ad_administration_group_action_add</a>
+<li> To allow users with a role to execute an action: <a href="proc-one.tcl?proc_name=ad_administration_group_action_role_map">ad_administration_group_action_role_map</a>
+<li> To retrieve a group_id from an adminsitration group's module and submodule:   <a href="proc-one.tcl?proc_name=ad_administration_group_id">ad_administration_group_id</a>
+</ul>
+
+<h3>Generic procedures</h3>
+
+Group_id will identify any group, regardless of type. Both basic and
+multi-role permission schemes will work.
+
+<ul>
+<li> To answer  <i>"Is user x allowed to do y?"</i> <a href="proc-one.tcl?proc_name=ad_permission_p">ad_permission_p</a>
+<li> To see if a user is in the group:   <a href="proc-one.tcl?proc_name=ad_user_group_member">ad_user_group_member</a>
+<li> To answer <i>"Is the user an administrator of this group?"</i>  <a href="proc-one.tcl?proc_name=ad_user_group_authorized_admin">ad_user_group_authorized_admin</a>
+
+<li> To answer <i>"Is the user an administrator of this group? (or a
+site-wide administrator with uber-user privileges)"</i>  
+<a href="proc-one.tcl?proc_name=ad_user_group_authorized_admin_or_site_admin">ad_user_group_authorized_admin_or_site_admin</a>
+
+
+<li> To retrieve a group_id from an adminsitration group's module and submodule:   <a href="proc-one.tcl?proc_name=ad_administration_group_id">ad_administration_group_id</a>
+<li> To add an user group: <a href="proc-one.tcl?proc_name=ad_user_group_add">ad_user_group_add</a> 
+<li> To grant a user a role:  <a href="proc-one.tcl?proc_name=ad_user_group_user_add">ad_user_group_user_add</a>
+<li> To add a role:  <a href="proc-one.tcl?proc_name=ad_user_group_role_add">ad_user_group_role_add</a>
+<li> To add an action: <a href="proc-one.tcl?proc_name=ad_user_group_action_add">ad_user_group_action_add</a>
+<li> To allow users with a role to execute an action: <a href="proc-one.tcl?proc_name=ad_user_group_action_role_map">ad_user_group_action_role_map</a>
+</ul>
+
+<hr>
+<a href="http://teadams.com"><address>teadams@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/photonet-specific.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/photonet-specific.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/photonet-specific.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,29 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Photonet Specifics</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Photonet Specifics</h2>
+by <a href="http://photo.net/philg">Philip Greenspun</a>
+<hr>
+
+
+This document is specific to photonet. There is nothing to be learnt from it except that
+Oracle 8.03 is a pain because it cannot drop a column. 
+
+<h4>List of columns to be dropped when photonet is upgraded to Oracle 8.1.5.</h4>
+
+<ul>
+<li>table user_group_types (allow_module_administration_p, allow_module_enabling_p, allow_group_css_p, allow_group_logo_p, group_css)
+<li>table user_groups (css_bgcolor, css_textcolor, css_unvisited_link, css_visited_link, 
+                       css_enabled_p, css_type, css_link_text_decoration, css_font_type,
+		       logo_enabled_p, logo_file_type, logo_file_extension, logo)
+<li>table acs_modules(supports_module_admin_p, site_admin_directory)
+</ul>
+
+<hr>
+<a href="mailto:philg@mit.edu"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/poll.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/poll.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/poll.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,400 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Poll</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Poll</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://www.badgertronics.com">Mark Dalrymple</a>
+
+<hr>
+
+<ul>
+<li>User-accessible directory:  <a href="/poll/">/poll/</a>
+<li>Site administrator directory:  <a href="/admin/poll/">/admin/poll/</a>
+<li>data model :  <a href="/doc/sql/display-sql.tcl?url=/doc/sql/poll.sql">/doc/sql/poll.sql</a>
+<li>Tcl procs:  /tcl/poll-defs.tcl 
+
+</ul>
+
+<h3>The Big Idea</h3>
+
+People like to offer their opinions, and one of the easiest ways to do
+that is to vote in an opinion poll.  The Poll module lets you
+construct polls that are active for a range of dates, specify the
+choices the users can make, whether to require the voter to be a
+registered user, and display the current results.  Since site
+designers like to change things, all of the user-accessible portions
+of the polls use the ACS <a href="/doc/style.html">style</a>
+mechanism.
+
+<p>
+
+Limitation:  this system is only useful for asking one question at a
+time (i.e., if you have N questions to ask, each with M possible
+answers, you need to create N separate polls).
+
+<h3>Under the Hood</h3>
+
+Three tables are used.  One to hold the polls, one to hold the 
+choices the user can make for each pool, and the actual set of
+votes users have made.
+
+
+<pre>
+create table polls (
+	poll_id		integer not null primary key,
+	name		varchar(100),
+	description	varchar(4000),
+	start_date	date,
+	end_date	date,
+	require_registration_p	char(1) default 'f' check (require_registration_p in ('t','f'))
+);
+</pre>
+
+Any number of polls can be active at a time.  Whether a poll is active
+depends on the start_date and end_date.  To disable a poll, use the
+admin pages to set the end_date into the past or the start_date into
+the future.  Name is a short name used to label pages and links, while
+description is a longer description that is displayed with the votes
+and results.
+
+<p>
+
+require_registration_p indicates whether a user has to be a registered
+user (have an entry in the users table) before they can vote.  Making
+registration required implies that the user can only vote once for
+each poll.  
+
+<p>
+
+If registration is <b>not</b> required, we can't distinguish one vote
+from another, so users can vote any number of times for each poll.  In
+that case, it wouldn't be fair to let unregistered users vote any
+number of times and registered users vote only once, so we just let
+them all vote any number of times.  Why not restrict by IP address
+then in this case?  IP masquedaring hides many people behind one
+IP address (meaning we would prevent legal votes), and AOL users get 
+a random IP address (meaning obnoxious folks can vote multiple times)
+
+<pre>
+create table poll_choices (
+	choice_id	integer not null primary key,
+	poll_id		references polls,
+	label		varchar(500)
+);
+</pre>
+
+This holds the choices that users can vote on.
+
+<p>
+
+<pre>
+create table poll_user_choices (
+	poll_id		references polls,
+	choice_id	references poll_choices,
+	user_id		references users,
+	ip_address	varchar(50),
+	choice_date	date
+);
+</pre>
+
+Each user vote is recorded here.  If there is no user ID (meaning that
+the voter is not a registered user), the user_id in this table is
+NULL.  Even though we don't use the IP address to control user
+voting, we keep it around in case some obnoxious person stuffs
+the ballot box.  We can go into SQL*Plus and undo the damage.
+
+
+<h3>Templates and Customization</h3>
+
+The templates for the user-accessable pages are stored in 
+/template/poll.  The templates there are pretty much just
+examples to use and modify (the "fancy" templates are pretty horrific)
+The templates are named "template-name.plain.adp" and 
+"template-name.fancy.adp".  The ACS style mechanisms choose which
+template to use.
+
+<p>
+
+There are two categories of templates in use: those that display the polls,
+the choices, and the results; and those that say "you did something wrong".
+
+
+<ul>
+<li> <b>index</b>: what is used for the top-level page in /poll.
+<li> <b>one-poll</b>: display one poll for voting. 
+<li> <b>poll-results</b>: show the current resutls
+<li> <b>vote</b>: thanks for voting<p>
+<li> <b>already-voted</b>: the user has already voted in a "registration required" poll
+<li> <b>novote</b>: The user didn't chose a radio button on the one-poll page
+<li> <b>dberror</b>: something bad happened in storing the vote in the database.
+</ul>
+
+All templates are passed the page_title, header_image, and context_bar variables.
+These templates get extra variables:
+<ul>
+<li> <b>index</b>: polls (which should be passed to [poll_front_page])<p>
+
+<li> <b>one-poll</b>: poll_name, poll_description, choices (which should be passed to
+ [poll_display]), form_html (which should be output after the &lt;form&gt;)<p>
+
+<li> <b>poll-results</b>: poll_name, poll_description, values (which should be passed to [poll_results]), poll_id (which should be used in links), total_count (the total number of votes)<p>
+
+<li> <b>vote</b>: poll_id<p>
+
+<li> <b>already-voted</b>: poll_name, poll_description, poll_id<p>
+
+<li> <b>novote</b>: poll_id<p>
+
+<li> <b>dberror</b>: errmsg (the error string from the database)
+</ul>
+
+
+<h4>Customization Functions</h4>
+
+Customizing templates for the Poll system are twice as complicted as
+customizing the templates for the news system.  The designers need to
+know how to invoke functions as well as putting varibles into
+<code>&lt;%=&nbsp;$variable&nbsp;&gt;</code> units.  There are three
+functions provided that take the database-driven output (e.g. the currently
+active polls) and some customization information and then return a blob of
+html for inclusion.  Designers would do something like 
+<code>&lt;%=&nbsp;[poll_display&nbsp;-item_start&nbsp;"&lt;tr&gt;&lt;td&gt;"&nbsp;-item_end&nbsp;"&lt;/tr&gt;"&nbsp;-style_start&nbsp;"&lt;font&nbsp;color=white&gt;&lt;i&gt;"&nbsp;-style_end&nbsp;"&lt;/i&gt;&lt;/font&gt;"&nbsp;&nbsp;$choices]&nbsp;%&gt;</code>
+
+<p>
+
+So why not use <code>ad_register_styletag</code> and include tweakable parameters
+in the tagset?  ADPs have a severe limitation in that html &lt;tags&gt; embedded
+in the styletag cause ADPs to premature end the parsing of the tagset.  That is, this:<br>
+<code>&lt;my-tag foo="&lt;b&gt;" bar="&lt;li&gt;" baz="&lt;font face=happy&gt;"&gt;&lt;/my-tag&gt;</code><br>
+has a tagset that consists of <code>"foo=&lt;b"</code>, and a content-string of
+everything else. 
+
+<p>
+
+To allow customization of each line of database-driven output, say whether to
+arrange the available choices in an <code>&lt;ul&gt;</code> or in
+a table, not being able to include arbitrary html is major loss.
+
+<p>
+
+Instead, three functions are provided.  Each takes optional parameterized
+arguments and a required blob of data which is passed to the template ADP
+by the Tcl pages in /poll.
+
+<p>
+
+<b><code>poll_front_page ?optional arguments? polls</code></b>
+
+<blockquote>
+
+Use this function to control the display on the "index" page (the top-level page
+you get when going to /poll).  If invoked without optional arguments,
+the polls are arranged in an unordered list.  The "polls" variable is provided to
+the index template.
+
+<p>
+
+This code:<pre>
+&lt;ul&gt;
+<%= [poll_front_page $polls] %>
+&lt;/ul&gt;
+</pre>
+
+results in this:
+
+<blockquote>
+
+<li>  <a href="poll.html">What Would Rolf Do?</a>  
+<li>  <a href="poll.html">What's Your Favorite Color?</a>   (registration required) 
+
+</blockquote>
+
+While this:
+<pre>
+&lt;table border=1 bgcolor=white&gt;
+&lt;%= [poll_front_page -item_start "&lt;tr&gt;&lt;td&gt;" -style_start "&lt;font color=green&gt;" -style_end "&lt;/font&gt;" -require_registration_start "&lt;td&gt;" -require_registration_text "&lt;font color=green&gt;Registration Mandatory!!!&lt;/font&gt;"  $polls] %&gt;
+&lt;/table&gt;
+</pre>
+
+results in this:
+
+<blockquote>
+<table border=1 bgcolor=white>
+<tr><td> <font color=green> <a href="poll.html">What Would Rolf Do?</a> </font> 
+<tr><td> <font color=green> <a href="poll.html">What's Your Favorite Color?</a> </font> <td> <font color=green>Registration Mandatory!!!</font> 
+</table>
+</blockquote>
+
+<h4>The arguments:</h4>
+
+<ul>
+<li> <b>-item_start</b>: text to be emitted before each poll name.  Usual uses are &lt;li&gt;
+     or &lt;tr&gt;&lt;td&gt;  Defaults to &lt;li&gt;<p>
+
+<li> <b>-item_end</b>: text to be emitted after each poll name.<p>
+
+<li> <b>-style_start</b>: text to be emitted immediately before the poll name.
+     Here'd you put &lt;font&gt; directives or other text formatting commands<p>
+
+<li> <b>-style_end</b>: text to be emitted immediately after the poll name.  You'd
+     put &lt;/font&gt; tags and the like here.<p>
+
+<!-- the above two are pretty redundant.  maybe just merge them? -->
+
+<li> <b>-require_registration_text</b>: what to display if the poll requires registration.
+     Defaults to "There are no currently active polls"<p>
+
+<li> <b>-require_registraion_start</b>: text to be emitted immediately before the
+     require_registration_text.  You can put text formatting and/or html
+     structural tags (like making a new table row or column before the
+     require_registration_text)<p>
+
+<li> <b>-require_registration_end</b>: text to be emitted immediately after the
+     require_registration_text.<p>
+
+</ul>
+
+
+</blockquote>
+
+<b><code>poll_display ?optional arguments? choices</code></b>
+
+<blockquote>
+
+Use this function to control the display of an individual poll.  If
+invoked without optional arguments, the poll choices are arranged in an
+unordered list.  The "choices" variable is provided to the one-poll template.
+
+This code:<pre>
+&lt;ul&gt;
+<%= [poll_display $choices] %>
+&lt;/ul&gt;
+</pre>
+
+results in this:
+
+<blockquote>
+<form>
+<li> <input type=radio name=choice_id value=17>  Eat Cheese  
+<li> <input type=radio name=choice_id value=18>  Go Skateboarding  
+<li> <input type=radio name=choice_id value=19>  Wait for Cable Modem installer  
+</form>
+</blockquote>
+
+While this:
+<pre>
+&lt;table border=2 text=white bgcolor=black&gt;
+&lt;%= [poll_display -item_start "&lt;tr&gt;&lt;td&gt;" -item_end "&lt;/tr&gt;" -style_start "&lt;font color=white&gt;&lt;i&gt;" -style_end "&lt;/i&gt;&lt;/font&gt;"  $choices] %&gt;
+&lt;/table&gt;
+</pre>
+
+results in this:
+
+<blockquote>
+
+<form>
+<table border=2 text=white bgcolor=black>
+<tr><td> <input type=radio name=choice_id value=17> <font color=white><i> Eat Cheese </i></font> </tr>
+<tr><td> <input type=radio name=choice_id value=18> <font color=white><i> Go Skateboarding </i></font> </tr>
+<tr><td> <input type=radio name=choice_id value=19> <font color=white><i> Wait for Cable Modem installer </i></font> </tr>
+</table>
+</form>
+
+
+</blockquote>
+
+
+<h4>The arguments:</h4>
+
+<ul>
+<li> <b>-item_start</b>: text to be emitted before each choice name.  Usual uses are &lt;li&gt;
+     or &lt;tr&gt;&lt;td&gt;  Defaults to &lt;li&gt;<p>
+
+<li> <b>-item_end</b>: text to be emitted after each choice name.<p>
+
+<li> <b>-style_start</b>: text to be emitted immediately before the choice name.
+     Here'd you put &lt;font&gt; directives or other text formatting commands<p>
+
+<li> <b>-style_end</b>: text to be emitted immediately after the choice name.  You'd
+     put &lt;/font&gt; tags and the like here.<p>
+
+<!-- the above two are pretty redundant.  maybe just merge them? -->
+
+<li> <b>-no_choices</b>: text to be emitted if there are no choices in the poll.  This
+     is really an adimistration/configuration problem.  Defaults to "No Choices Specified"
+
+</ul>
+
+</blockquote>
+
+
+<b><code>poll_results ?optional arguments? results</b></code>
+
+<blockquote>
+
+Use this function to control the display on the "results" page.  This function
+is a wrapper around gr_sieways_bar_chart which simplifies the API.
+
+This code
+<pre>
+<%= [poll_results $values] %>
+</pre>
+
+results in this:
+<blockquote>
+
+<table border=0 cellspacing=0 cellpadding=0><tr><td><img width=1 height=10 src="/graphics/graphing-package/white-dot.gif"><br clear=all><font face=arial size=4 color=black></font></td><td align=right><img width=10 height=15 src="/graphics/graphing-package/scale-left.gif"><br clear=all><img width=1 height=3 src="/graphics/graphing-package/white-dot.gif"></td><td><img width=320 height=15 src="/graphics/graphing-package/scale-main.gif"><br clear=all><img width=1 height=3 src="/graphics/graphing-package/white-dot.gif"></td></tr><tr><td><font face=arial size=3 color=black>Eat Cheese</font></td><td width=10> </td><td><img width=120 height=15 src="/graphics/graphing-package/blue-dot.gif"> <font face=arial size=1 color=0000ff>40</font><br clear=all><img width=1 height=7 src="/graphics/graphing-package/white-dot.gif"></td></tr><tr><td><font face=arial size=3 color=black>Go Skateboarding</font></td><td width=10> </td><td><img width=80 height=15 src="/graphics/graphing-package/blue-dot.gif"> <font face=arial size=1 color=0000ff>26.7</font><br clear=all><img width=1 height=7 src="/graphics/graphing-package/white-dot.gif"></td></tr><tr><td><font face=arial size=3 color=black>Wait for Cable Modem installer</font></td><td width=10> </td><td><img width=100 height=15 src="/graphics/graphing-package/blue-dot.gif"> <font face=arial size=1 color=0000ff>33.3</font><br clear=all><img width=1 height=7 src="/graphics/graphing-package/white-dot.gif"></td></tr></table>
+
+</blockquote>
+
+While this:
+<pre>
+&lt;table bgcolor=pink border=3&gt;
+&lt;tr&gt;
+&lt;td width=300&gt;
+&lt;%= [poll_results -bar_color purple -display_values_p "f" -display_scale_p "f" -bar_height 30 $values] %&gt;
+&lt;/table&gt;
+</pre>
+
+results in this:
+
+<blockquote>
+<table bgcolor=pink border=3>
+<tr>
+<td width=300>
+<table border=0 cellspacing=0 cellpadding=0><tr><td><img width=1 height=10 src="/graphics/graphing-package/white-dot.gif"><br clear=all><font face=arial size=4 color=black></font></td><td><img width=10 height=15 src="/graphics/graphing-package/white-dot.gif"></td><td> </td></tr><tr><td><font face=arial size=3 color=black>Eat Cheese</font></td><td width=10> </td><td><img width=120 height=30 src="/graphics/graphing-package/purple-dot.gif"><br clear=all><img width=1 height=7 src="/graphics/graphing-package/white-dot.gif"></td></tr><tr><td><font face=arial size=3 color=black>Go Skateboarding</font></td><td width=10> </td><td><img width=80 height=30 src="/graphics/graphing-package/purple-dot.gif"><br clear=all><img width=1 height=7 src="/graphics/graphing-package/white-dot.gif"></td></tr><tr><td><font face=arial size=3 color=black>Wait for Cable Modem installer</font></td><td width=10> </td><td><img width=100 height=30 src="/graphics/graphing-package/purple-dot.gif"><br clear=all><img width=1 height=7 src="/graphics/graphing-package/white-dot.gif"></td></tr></table>
+</table>
+</blockquote>
+
+<h4>The arguments:</h4>
+
+<ul>
+<li> <b>-bar_color</b>: what color to display the bar.  Can be blue, dark-green, purple, red, black, orange, or medium-blue.  Defaults to blue.<p>
+
+<li> <b>-display_values_p</b>: a "t" or "f" value.  Should the percentages of the vote
+     be displayed.  Defaults to "t"<p>
+
+<li> <b>-display_scale_p</b>: a "t" or "f" value.  Should the "0 to 100" scale be
+     displayed at the top of the results.  Defaults to "t"<p>
+
+<li> <b>-bar_height</b>: how tall to make the bars.  Defaults to 15.
+
+</ul>
+
+Note that some specific customizations aren't possible now, such as putting the
+total number of votes after each bar on the chart, and using multiple pictures
+for each bar (like what the <a href="http://www.slashdot.org">Slashdot</a> poll
+does) due to limitations in the API of gr_sideways_bar_chart.  This is something
+that needs to be fixed eventually.
+
+</blockquote>
+
+<hr>
+<a href="mailto:markd@arsdigita.com"><address>markd@arsdigita.com</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/portals.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/portals.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/portals.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,180 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Portals</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Portals</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://aure.com/">Aurelius Prochazka</a> and <a href="mailto:dh@arsdigita.com">David Hill</a>
+
+<hr>
+
+<ul>
+<li>User-accessible directory:  <a href="/portals/">/portals/</a>
+<li>Site administrator directory:  <a href="/admin/portals/">/admin/portals/</a>
+<li>Portal manager directory:  <a href="/portals/admin/">/portals/admin/</a>
+<li>data model :  <a href="/doc/sql/display-sql.tcl?url=/doc/sql/portals.sql">/doc/sql/portals.sql</a>
+<li>Tcl procs:  /tcl/portals-defs.tcl
+
+<p>
+
+<li>Public demonstrations:  <a href="http://my.caltech.edu/">my.caltech.edu</a>
+and 
+<a href="http://photo.net/portals/">http://photo.net/portals/</a>
+
+</ul>
+
+<h3>What are portals?</h3>
+
+The term "portal" is used for any site that serves as an entry point, especially for those that serve as an entry point for many, many  people like <a href=http://www.yahoo.com/>Yahoo!</a>, <a href=http://www.excite.com/>Excite</a>,or <a href=http://www.lycos.com/>Lycos</a>.  
+
+<p>
+
+In order to retain users, these sites introduced personalized portals (eg my.yahoo.com) which allow the user, via simple interfaces,
+to select various types of pre-existing data-feeds and do basic page layout.  
+
+<h3>Why are portals useful?</h3>
+
+Even if you are not trying to index the world like Yahoo! you still might have a lot of information that you're trying to disseminate.  For instance, I designed Caltech's home page at first trying to create a nice hierarchical categorization system - you want research information, click here, you want news, click here.  This worked for a while, but as Caltech's web presence grew, interesting information became more and more buried and difficult to find.  The home page 
+couldn't be everything to all people.  
+<p>
+The solution to Caltech's dilemma was to offer information in two ways - organized as above, or organized by what kind of audience type the person browsing belongs to, i.e. Portals for Alumni, Undergraduates, Staff, etc.
+
+<h3> The big picture</h3>
+
+The sites above exemplify the types of portals which our system supports, user-level, group-level, and to some extent a mixture of the two. 
+
+<p>
+My{Yahoo|Excite|Lycos} are personal portals because they have a wide variety
+of choices from which each person may choose when personalizing his site.
+This type of portal is really popular right now, but I would be curious to see how
+many people actually take the time to personalize.
+
+<p>
+Our portals form a "group portal" system;  a set of administration level people
+(managers) guess at what a specific type of audience would like to see.  
+These managers construct or choose the data-feeds and do the page layout.  The parameter  AllowUserLevelPortals, when set to 1, can allow each user to act as his own manager - although the user-as-manager can not construct his own data-feeds.
+
+<p>
+Perhaps the best kind of portal is the kind that allows the user to start
+with a group type and then later may customize his own set up.  We don't currently have a way for a user to easily migrate from a group to a personal portal, but it should not be difficult to do so.
+
+<h3>The data model</h3>
+
+The data model is linked above.  The portal_tables table holds display information for each generic piece of the portal (usually kept in HTML tables, which is the table that is referred to in "portal_tables" - not necessarily a SQL table).
+Each table has a name and associated ADP display information.  The name is used as a header, and the ADP is displayed below the header.  One nice feature about the ADP is that the output may be regsubbed to fit into a site's look, for example, we change all &lt;td*&gt; to &lt;td*&gt;&lt;font face=arial,helvetica&gt; to make sure we have a consistent font.  
+<p>
+The default portal_table editor is a simple ADP editing field; the ADP itself can be complex depending on how much, if any, tcl is involved.  To shield managers from this, the admin_url column can be set to a URL of a better administration tool.  
+<p>
+Changes to portal_table fires a trigger which backs-up information in portal_tables_audit for versioning purposes.
+<p> 
+The portal_pages table holds page names, numbers, and owners, where the owner is either defined by a group_id or user_id, whichever is not null.
+<p>
+Finally, portal_page_map is a bit more than most _maps in ACS, it maps tables to pages and to locations (left side, right side, 3rd from top, etc.) so it is more of a layout definer than a map.
+
+<h3> Portals customization </h3>
+
+Here are the ad.ini parameters for the portals system
+
+<pre>
+; for the Portals System
+[ns/server/yourserver/acs/portals]
+Administrator=aure@caltech.edu
+AdministratorName=Aurelius Prochazka
+SystemName=Caltech Portals
+; set to 1 if individual may create their own portals
+AllowUserLevelPortals=1
+; set to 1 if super administrator can add or remove themselves and other super administrators
+SuperAdminCanChangeSuperAdminP=0
+BodyTag=&lt;body background="http://www.caltech.edu/pics/background.jpg" link=#006600 vlink=#003300 alink=#669966 bgcolor=#eeeedd>
+FontTag=&lt;font face=arial,helvetica size=-1>
+; These standardize a prettier table than the browser default
+BeginTable=&lt;table border=0 bgcolor=#006600 cellpadding=1 cellspacing=0 width=100%>&lt;tr>&lt;td>&lt;table border=0 bgcolor=white cellpadding=3 cellspacing=0 width=100%>
+EndTable=&lt;/table>&lt;/td>&lt;/tr>&lt;/table>
+HeaderTD=&lt;td bgcolor=#006600>&lt;font face=arial,helvetica size=-1 color=#eeeedd>&lt;b>
+HeaderBGColor=#006600
+SubHeaderTD=&lt;td bgcolor=#eeeedd>&lt;font face=arial,helvetica size=-1>&lt;b>
+SubHeaderBGColor=#eeeedd
+NormalTD=&lt;td>&lt;font face=arial,helvetica size=-1>
+; For portals with multiple pages, tabs link to the other pages, set this to 1 if you want each tab 
+; to be equal width instead of proportional to the name of the page
+EqualWidthTabsP=0
+MainPublicURL=/portals/
+; number of seconds to memoize a portal page
+CacheTimeout=100
+; browsers will decide the "optimal" column sizes unless you force column widths here:
+;LeftSideWidth=
+;RightSideWidth=
+SpacerImage=/portals/spacer.gif
+</pre>
+
+<h3> Setting up the portals </h3>
+
+The steps:
+
+<ol>
+<li>define a group type <code>portal_group</code>.  
+
+<li>create groups of this type.  Each of these groups will have its own
+portal.  
+
+<li>create a group called "Super Administrators" of type "portal_group"
+
+<li>Add yourself as a
+
+<code>Super Administrator</code> from the <code>/admin/portals</code>
+page.  
+
+<li>create tables from <code>/portals/admin/</code> 
+
+<li>finally, to lay out the portal pages, masquerade as an administrator
+of the various portal groups.
+
+</ol>
+
+
+<h3> User interface</h3>
+
+Portal display should be fairly simple to understand for the user. If the manager has spread that information over two pages, the user will see page tabs at the upper and lower right sections of the page.  Also in the footer, content managers are advertised to allow the user a place to complain if he didn't find what he wanted.
+<p>
+We use the "memoize" procs on the  portal pages for speed:  Popular pages need not incur x sql queries on each server request. We use a variant of Memoize_Force called Memoize_for_Awhile_Force found in /tcl/portals-defs.tcl
+
+<h3> Manager interface</h3>
+
+There are two types of managers: The Super Administrator and the regular ol' joe administrator we will refer to as a manager.  When configured with AllowUserLevelPortals, each user becomes a manager which we refer to as user-as-manager.
+<p>
+Super Administrators can assign portal managers and create, edit, delete or restore any portal table he wishes. When creating or editing a portal table he has the option of associating a url with that table. In restoring a table, the Super Administrator can view previous versions of a table (held in an audit table in Oracle) and select the one he wants.  
+<p>
+The Super Administrator may also masquerade as a manager of any portal group to directly change the layout of a given portal.
+<p>
+Regular managers see a list of manageable portals (one manager can have any number of portals to manage) or get redirected to the main portal management page if he is a manager of only one group.  On this page, he will see select boxes that correspond to page sides.  Each page has a
+re-nameable title. The last page is initially empty because it will only be created when items are moved into it.  Potential portal elements (not on any page) appear in the bottom
+centered selectbox, clicking one of the two arrow keys adds that element to
+the lowest page.
+<p>
+
+Here the manager may also click on "X" to remove the table from portal pages seen by the user or the manager may click "?" to edit the ADP content.  
+<ul>
+<li>The ADP content is not unique to a portal:  Change the
+content on one portal and it changes on all others.
+<li>If the Super Administrator has associated a url (admin_url) with a given portal, the manager will not be able to edit the ADP - he will be redirected to the url instead.
+<li>In the case of the user-as-manager, "?" edit is disabled.</ul>  
+<P>
+When done setting up the portals the way the manager likes, he clicks FINISH to
+implement the layout changes.
+
+<h3>Future Improvements</h3>
+
+There should be a simple way for a single user to migrate from a group-type portal
+to a custom single user (user-as-manager) portal.
+<p>
+
+
+<hr>
+<a href="mailto:aure@arsdigita.com"><address>aure@arsdigita.com</address></a>
+</body>
+</html>
+
Index: web/openacs/www/doc/press.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/press.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/press.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,237 @@
+<html>
+<!--AD_DND-->
+<!--press.html,v 3.1 2000/02/20 09:40:11 ron Exp-->
+<head>
+<title>Press</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Press</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="mailto:ron@arsdigita.com">Ron Henderson</a>
+
+<hr>
+
+<ul>
+<li>User-accessible directory:  <a href="/press/">/press/</a>
+<li>Site administrator directory:  <a href="/admin/press/">/admin/press/</a>
+<li>Group admin pages:  <a href="/press/admin/">/press/admin/</a>
+<li>data model:
+<a href="/doc/sql/display-sql.tcl?url=/doc/sql/press.sql">/doc/sql/press.sql</a>
+<li>Tcl procs:  /tcl/press-defs.tcl 
+</ul>
+
+<h3>The Big Picture</h3>
+
+<p>Most Web services and all corporate sites have a "foobar.com in the
+news" page.  This page lists, chronologically, articles in newspapers,
+magazines, etc. where the site or company is featured.  This is a
+little bit different from the <a href=news.html>news</a> module in
+that the publisher is mostly linking off to other publications and not
+trying to disseminate news him or herself.
+
+<p>
+
+Examples:
+
+<ul>
+<!--
+<li><a
+href="http://arsdigita.com/press.html">http://arsdigita.com/press.html</a>
+-->
+<li><a
+href="http://www.scorecard.org/about/about-press.tcl">http://www.scorecard.org/about/about-press.tcl</a>
+<li><a href="http://www.valinux.com/news/news.php3">http://www.valinux.com/news/news.php3</a>
+
+
+</ul>
+
+<p>The system supports site-wide press coverage (appropriate when one
+ACS installation is being used for a company) and subcommunity press
+coverage, e.g. for a service like arfdigita.org where many
+organizations are using the same ACS.  Anyone who has the
+administrator role in a user group can edit the press coverage for
+that group.
+
+<h3>Press Coverage Templates</h3>
+
+<p>The module provides a flexible template system to support the wide
+range of formats needed for different sites and types of press
+coverage.  A press item contains the followings bits of
+information:</p>
+
+<ul>
+<li>publication_name
+<li>publication_date
+<li>article_title
+<li>article_pages
+<li>abstract
+</ul>
+
+<p>A site administrator can define named templates to control how
+these pieces of information are displayed. The templates are written
+as ADP fragments using the variables listed above.  For example, the
+system default template might format a press item as follows:
+
+<p><blockquote>
+<pre>
+&lt;dl&gt;&lt;b&gt;<%=$publication_name%>&lt;/b&gt; - &lt;%=$article_name%&gt; (&lt;%=$article_pages&gt;)
+&lt;dd&gt;(&lt;%=$publication_date%&gt;) - "&lt;%=$abstract&gt;"&lt;/dd&gt;&lt;/dl&gt;
+</pre>
+</blockquote></p>
+
+<p>This template would be expanded into:</p>
+
+<blockquote>
+<dl> 
+<b>Dog's Life</b> - Planet of the Dogs (pp 50-52)
+<dd>January 1, 2100 - "They used to say that every dog has his
+day. Little did humans know that the collapse of their society at the
+beginning of this millenium would give rise to a new golden age of
+canine rule."</dd> 
+</dl>
+</blockquote>
+
+<p>Hyperlinks to external publications and articles are inserted
+automatically and optionally tracked using the <a
+href=/doc/clickthrough.html>clickthrough</a> module.</p> 
+
+<h3>Under the Hood</h3>
+
+<p>The data model for press coverage is quite simple:
+
+<blockquote>
+<pre><code>
+create sequence press_id_sequence start with 1;
+
+create table press (
+	press_id		integer primary key,
+	-- if scope=public, this is press coverage for the whole system
+        -- if scope=group, this is press coverage for a subcommunity
+        scope			varchar(20) not null,
+	-- will be NULL if scope=public 
+	group_id		references user_groups,
+	-- determine how the item is formatted
+	template_id		references press_templates,
+	-- if true, keep the item active after it would normally expire. 
+	important_p		char(1) default 'f' check (important_p in ('t','f')),
+	-- the name of the publication, e.g. New York Times
+	publication_name	varchar(100) not null,
+	-- the home page of the publication, e.g., http://www.nytimes.com
+	publication_link	varchar(200),
+	-- we use this for sorting
+	publication_date	date not null,
+	-- this will override publication_date where we need to say "Oct-Nov 1998 issue"
+	-- but will typically be NULL
+	publication_date_desc	varchar(100),
+	-- might be null if the entire publication is about the site or company
+	article_title		varchar(100),
+	-- if the article is Web-available
+	article_link		varchar(200),
+	-- optional page reference, e.g. page 100
+	article_pages		varchar(100),
+	-- quote from or summary of article
+	abstract		varchar(4000),
+	-- is the abstract in HTML or plain text (the default)
+	html_p			char(1) default 'f' check (html_p in ('t','f')),
+	creation_date		date not null,
+	creation_user		not null references users(user_id),
+	creation_ip_address	varchar(50) not null
+);
+</code></pre>
+</blockquote>
+
+<p>The data model for press coverage templates is equally straightforward:
+
+<blockquote>
+<pre><code>
+create sequence press_template_id_sequence start with 2;
+
+create table press_templates (
+	template_id		integer primary key,
+	-- we use this to select the template
+	template_name		varchar(100) not null,
+	-- the adp code fraqment
+	template_adp		varchar(4000) not null
+);
+
+</pre></code>
+</blockquote>
+
+<p>Note that <code>template_id=1</code> is reserved for the site-wide
+default template.</p>
+
+<h3>Legal Transactions</h3>
+
+<p>From the Site Administration pages at <a
+href=/admin/press/>/admin/press/</a> the site-wide administrator can do
+the following:</p>
+
+<ul>
+<li>Create a new press template: insert a new row into the
+table press_templates
+<li>Edit the properties of a press template: update a row in
+press_templates
+<li>Delete an unused press template: delete a row in
+press_templates
+</ul> 
+
+<p>From the Maintainers admin pages at <a
+href=/press/admin/>/press/admin/</a> the press coverage maintainers
+can:</p>
+
+<ul>
+<li>Add new press coverage: insert a new row in press
+<li>Edit existing press coverage: update a row in press
+<li>Delete press coverage: remove a row from press
+</ul>
+
+<p>You can change the site-wide behavior by setting the following parameters:
+
+<blockquote>
+<pre><code>
+[ns/server/service/acs/press]
+; maximum number of press items to display on the press coverage page
+DisplayMax=10
+; number of days a press item remains active
+ActiveDays=60
+; do we use clickthrough tracking from the press coverage page?
+ClickthroughP = 1
+</code></pre>
+</blockquote>
+
+<h3>Limitations</h3>
+
+<p>The expiration behavior of press coverage is strange.  Once an item
+surpasses the site-wide maximum number of active days and expires, the
+only way to turn it back on is to set the important_p flag and have it
+displayed permanently.  It would make more sense to define a
+per-press-item expiration date.
+
+<p>Any administrator can create public press coverage (the limitation
+is that this cannot be restricted).  
+
+<h3>Future Improvements</h3>
+
+<ul>
+<li>Expiration date for individual headlines
+<li>Separation of public and private (group only) headlines
+<li>Ability to display headlines based on publication name or a
+keyword search of title and abstract. 
+</ul>
+
+<hr>
+<a href="mailto:ron@arsdigita.com"><address>ron@arsdigita.com</address></a>
+</body>
+</html>
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/doc/proc-one.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/proc-one.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/proc-one.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,69 @@
+# proc-one.tcl,v 3.0 2000/02/06 03:36:59 ron Exp
+# print out documentation for one procedure
+# created by philg@mit.edu
+# March 27th, 1999. teadams@mit.edu modified to list default arguments
+# 19981223 added ad_proc arg usage messages. jcd
+
+set_form_variables
+
+# proc_name
+
+if [nsv_exists proc_doc $proc_name] {
+    set backlink_anchor "the documented procedures"
+    set what_it_does_section "
+ What it does:<br>
+ <blockquote>
+ [nsv_get proc_doc $proc_name]
+ </blockquote>
+
+ Defined in: <strong>[proc_source_file_full_path $proc_name]</strong>
+ </code>
+
+<p>
+"
+
+} else {
+    set what_it_does_section ""
+    set backlink_anchor "the defined (but not documented) Tcl procedures"
+}
+
+append Usage "<b>$proc_name</b> <i>"
+
+if {[nsv_exists ad_proc_args $proc_name]} { 
+    append Usage "[ns_quotehtml [nsv_get ad_proc_args $proc_name]] "
+} else { 
+    foreach arg [info args $proc_name] {
+        if [info default $proc_name $arg default] {
+            append Usage "&nbsp;&nbsp;{&nbsp;$arg&nbsp;\"[ns_quotehtml $default]\"&nbsp;} "
+        } else {
+            append Usage "&nbsp;&nbsp;$arg "
+        }
+    }
+}
+
+append Usage "</i>\n"
+
+ReturnHeaders
+
+ns_write "
+[ad_header "$proc_name"]
+
+<h2>$proc_name</h2>
+
+one of <a href=\"procs.tcl\">$backlink_anchor</a> in this
+installation of the ACS
+
+<hr>
+Usage:
+<blockquote>
+$Usage
+</blockquote>
+$what_it_does_section
+
+Source code:
+<pre>
+[ns_quotehtml [info body $proc_name]]
+</pre>
+
+[ad_admin_footer]
+"
Index: web/openacs/www/doc/proc-search-all-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/proc-search-all-procs.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/proc-search-all-procs.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,88 @@
+# proc-search-all-procs.tcl,v 3.0 2000/02/06 03:37:01 ron Exp
+proc procs_tcl_sort_by_second_element_desc {l1 l2} {
+    set first_comparison [string compare [lindex $l2 1] [lindex $l1 1]]
+    if { $first_comparison != 0 } {
+	return $first_comparison
+    } else {
+	return [string compare [lindex $l2 0] [lindex $l1 0]]
+    }
+}
+
+
+# this is for searching through all defined procedures, their args,
+# and their bodies
+
+set_form_variables 0
+
+# query_string, maybe exclude_body_p
+
+if { ![info exists query_string] || [empty_string_p $query_string] } {
+    ad_return_complaint 1 "<li>we need at least one word for which you're searching."
+    return
+}
+
+ReturnHeaders
+
+ns_write "
+[ad_header "Procedures matching \"$query_string\""]
+
+<h2>Matches for \"$query_string\"</h2>
+
+among all the procedures (not just the documented ones) in this
+installation of the ACS
+
+<hr>
+
+<ul>
+"
+
+# each elt is [list $proc_name $score $real_proc_p]
+set results [list]
+
+set real_procedures [info procs]
+
+foreach proc_name [info commands] {
+    set string_to_search ""
+    append string_to_search $proc_name 
+    if { [lsearch -exact $real_procedures $proc_name] != -1 } {
+	# this is a real procedure, not a command or C function
+	set real_proc_p 1
+	append string_to_search [info args $proc_name]
+	if { ![info exists exclude_body_p] || $exclude_body_p == 0 } {
+	    append string_to_search [info body $proc_name]
+	}
+    } else {
+	set real_proc_p 0
+    }
+    set score [philg_keywords_score $query_string $string_to_search]
+    if { $score > 0 } {
+	lappend results [list $proc_name $score $real_proc_p]
+    }
+}
+
+set sorted_results [lsort -command procs_tcl_sort_by_second_element_desc $results]
+
+if { [llength $sorted_results] > 0 } {
+    if { [llength $sorted_results] > 15 && (![info exists exclude_body_p] || $exclude_body_p == 0) } {
+	ns_write "<li><a href=\"proc-search-all-procs.tcl?exclude_body_p=1&[export_url_vars query_string]\">query again for \"$query_string\" but don't search through procedure bodies</a>\n<p>\n"
+    }
+    foreach sublist $sorted_results {
+	set proc_name [lindex $sublist 0]
+	set score [lindex $sublist 1]
+	set real_proc_p [lindex $sublist 2]
+	if $real_proc_p {
+	ns_write  "<li>$score: <b><a href=\"proc-one.tcl?proc_name=[ns_urlencode $proc_name]\">$proc_name</a></b>  <i>[info args $proc_name]</i>\n"
+	} else {
+	    ns_write "<li>$score: $proc_name (most likely documented at <a href=\"http://www.aolserver.com/server/docs/2.3/html/tcldev.htm\">www.aolserver.com</a>)\n"
+	}
+    }
+} else {
+    ns_write "no results found"
+}
+
+ns_write "
+
+</ul>
+
+[ad_admin_footer]
+"
Index: web/openacs/www/doc/proc-search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/proc-search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/proc-search.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,101 @@
+# proc-search.tcl,v 3.2 2000/03/10 21:12:17 lars Exp
+
+proc procs_tcl_sort_by_second_element {l1 l2} {
+    set first_comparison [string compare [lindex $l1 1] [lindex $l2 1]]
+    if { $first_comparison != 0 } {
+	return $first_comparison
+    } else {
+	return [string compare [lindex $l1 0] [lindex $l2 0]]
+    }
+}
+
+proc procs_tcl_sort_by_second_element_desc {l1 l2} {
+    set first_comparison [string compare [lindex $l2 1] [lindex $l1 1]]
+    if { $first_comparison != 0 } {
+	return $first_comparison
+    } else {
+	return [string compare [lindex $l2 0] [lindex $l1 0]]
+    }
+}
+
+set_form_variables 0
+
+# query_string, maybe exclude_body_p
+
+if { ![info exists query_string] || [empty_string_p $query_string] } {
+    ad_return_complaint 1 "<li>we need at least one word for which you're searching."
+    return
+}
+
+ReturnHeaders
+
+ns_write "
+[ad_header "Procedures matching \"$query_string\""]
+
+<h2>Matches for \"$query_string\"</h2>
+
+among <a href=\"procs.tcl\">the documented procedures</a> in this
+installation of the ACS
+
+
+<hr>
+
+<ul>
+"
+
+set list_of_lists [list]
+
+
+foreach proc_name [nsv_array names proc_doc] {
+    lappend list_of_lists [list $proc_name [proc_source_file_full_path $proc_name]]
+}
+
+# sort them by file name for stability of results
+# (i.e., stuff that is together in a file will tend to get printed out
+# together)
+
+set sorted_list [lsort -command procs_tcl_sort_by_second_element $list_of_lists]
+
+# each elt is [list $proc_name $score]
+set results [list]
+
+foreach sublist $sorted_list {
+    set proc_name [lindex $sublist 0]
+    set filename [lindex $sublist 1]
+    set string_to_search ""
+    append string_to_search $proc_name [info args $proc_name] [nsv_get proc_doc $proc_name]
+    if { ![info exists exclude_body_p] || $exclude_body_p == 0 } {
+	append string_to_search [info body $proc_name]
+    }
+    set score [philg_keywords_score $query_string $string_to_search]
+    if { $score > 0 } {
+	lappend results [list $proc_name $score]
+    }
+}
+
+set sorted_results [lsort -command procs_tcl_sort_by_second_element_desc $results]
+
+if { [llength $sorted_results] > 0 } {
+    if { [llength $sorted_results] > 15 && (![info exists exclude_body_p] || $exclude_body_p == 0) } {
+	ns_write "<li><a href=\"proc-search.tcl?exclude_body_p=1&[export_url_vars query_string]\">query again for \"$query_string\" but don't search through procedure bodies</a>\n<p>\n"
+    }
+    foreach sublist $sorted_results {
+	set proc_name [lindex $sublist 0]
+	set score [lindex $sublist 1]
+	ns_write  "<li>$score: <b><a href=\"proc-one.tcl?proc_name=[ns_urlencode $proc_name]\">$proc_name</a></b> <i>[info args $proc_name]</i>\n"
+    }
+} else {
+    ns_write "no results found"
+}
+
+ns_write "
+
+<P>
+
+<li><a href=\"proc-search-all-procs.tcl?[export_url_vars query_string]\">query again for \"$query_string\" but this time search through all defined procedures, even system and undocumented procedures</a>\n<p>\n
+
+
+</ul>
+
+[ad_admin_footer]
+"
Index: web/openacs/www/doc/procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/procs.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/procs.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,104 @@
+# procs.tcl,v 3.0 2000/02/06 03:37:03 ron Exp
+# page that shows all the documented Tcl procs 
+# in the system
+
+
+# we assume that we get a list of lists, each one containing
+# {proc_name filename} (i.e., a Tcl list in its own right)
+
+proc procs_tcl_sort_by_first_element {l1 l2} {
+    set first_comparison [string compare [lindex $l1 0] [lindex $l2 0]]
+    if { $first_comparison != 0 } {
+	return $first_comparison
+    } else {
+	return [string compare [lindex $l1 1] [lindex $l2 1]]
+    }
+}
+
+proc procs_tcl_sort_by_second_element {l1 l2} {
+    set first_comparison [string compare [lindex $l1 1] [lindex $l2 1]]
+    if { $first_comparison != 0 } {
+	return $first_comparison
+    } else {
+	return [string compare [lindex $l1 0] [lindex $l2 0]]
+    }
+}
+
+set_form_variables 0
+
+# maybe sort_by  (defaults to sorting by filename)
+
+ReturnHeaders
+
+ns_write "
+[ad_header "Documented Procedures"]
+
+<h2>Documented Procedures</h2>
+
+in this installation of the ArsDigita Community System
+
+<hr>
+
+This page lists those procedures that the programmers have defined
+using <code>proc_doc</code> (defined in
+<a href=\"http://photo.net/wtr/thebook/utilities.txt\">/home/nsadmin/modules/tcl/utilities.tcl</a>).  
+
+<p>
+
+Note that any procedure beginning with <code>ns_</code> is an
+AOLserver API call, documented at <a href=\"http://www.aolserver.com\">http://www.aolserver.com</a> (which also documents the basic Tcl language
+built-in procedures).
+
+"
+
+set list_of_lists [list]
+
+foreach proc_name [nsv_array names proc_doc] {
+    lappend list_of_lists [list $proc_name [proc_source_file_full_path $proc_name]]
+}
+
+if { [info exists sort_by] && $sort_by == "name" } {
+    set sorted_list [lsort -command procs_tcl_sort_by_first_element $list_of_lists]
+    set headline "Procs by Name"
+    set options "or sort by <a href=\"procs.tcl?sort_by=filename\">source file name</a>"
+} else {
+    # by filename
+    set sorted_list [lsort -command procs_tcl_sort_by_second_element $list_of_lists]
+    set headline "Procs by source filename"
+    set options "or sort by <a href=\"procs.tcl?sort_by=name\">name</a>"
+}
+
+ns_write "
+
+<form method=GET action=proc-search.tcl>
+Search: <input type=text name=query_string size=40> (space-separated keywords)
+</form>
+
+<h3>$headline</h3>
+
+$options
+
+<ul>
+"
+
+set last_filename ""
+foreach sublist $sorted_list {
+    set proc_name [lindex $sublist 0]
+    set filename [lindex $sublist 1]
+    if { [info exists sort_by] && $sort_by == "name"} {
+	ns_write "<li><a href=\"proc-one.tcl?proc_name=[ns_urlencode $proc_name]\">$proc_name</a> (defined in $filename)"
+    } else {
+	# we're doing this by filename
+	if { $filename != $last_filename } {
+	    ns_write "<h4>$filename</h4>\n"
+	    set last_filename $filename
+	}
+	ns_write "<li><a href=\"proc-one.tcl?proc_name=[ns_urlencode $proc_name]\">$proc_name</a>\n"
+    }
+}
+
+ns_write "
+</ul>
+
+[ad_admin_footer]
+"
Index: web/openacs/www/doc/project-tracker.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/project-tracker.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/project-tracker.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,179 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Project Tracker</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Project Tracker</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://teadams.com">Tracy Adams</a>
+
+<hr>
+<ul>
+<li>User directory:  <a href="/project-tracker">/project-tracker</a>
+<li>Admin directory: /admin/project-tracker
+<a href="/admin/project-tracker/">/admin/project-tracker</a> 
+<li>data model:  
+<a href="/doc/sql/display-sql.tcl?url=/doc/sql/project-tracker.sql">/doc/sql/project-tracker.sql</a>
+<li>procedures:   /tcl/project-tracker.tcl
+</ul>
+
+<h3>The Big Picture</h3>
+
+Corporations need a way of organizing their people, projects, and time.
+
+<h3>The Medium Size Picture</h3>
+
+Vital company knowledge lies in answers to the following questions.
+<ul>
+<li> Where is Betty Stripe today?
+<li> What are our upcoming deadlines?
+<li> What is John Smith working on?
+<li> Which people are on the CNN project?
+<li> How much time did that project take?
+<li> What current issues and problems we are facing?
+<li> What has this project involved so far?
+</ul>
+
+
+
+<h3>Core Components</h3>
+
+The Project Tracker runs as part of the dedicated
+ArsDigita Community System for your intranet.
+Components of the Project Tracker are employees, 
+customers, and projects.
+
+
+
+<h4>Employees</h4>
+
+Employees or key members of the company are users of the ArsDigita Community System. Detailed contact information is stored for users to provide a company directory. 
+
+<p>
+A "current information note" is used as a quick reference for employees' temporary contact information and other special items. Users are reminded to maintain their current information note in their workspace.
+<p>
+Email notifications remind users to keep their contact and current information note up to date.
+
+<h4>Projects</h4>
+<p>
+Typical projects are 
+<ul>
+<li> A  client (iMedix)
+<li> A module (Project Tracker Module)
+<li> An initiative (convert company structure from LLC to SCorp)
+</ul>
+
+The <code>project_tracker_projects</code> table stores the main project information.
+<blockquote>
+<pre>
+create sequence project_tracker_projects_id_seq;
+create table project_tracker_projects (
+        project_id       integer not null primary key,
+	creator_user_id  integer references users,
+	creation_date    date,
+	name            varchar(200),
+	--- the url of the staff server for this service, if applicable
+	glassroom_url   varchar(100),
+	start_date      date,
+	end_date        date,
+	-- if this project is for a customer, which one
+	customer_id     integer references project_tracker_customers,
+	--- purpose is sales, operations, customer
+        purpose         varchar(100),
+	--- major considerations for this project
+	notes           varchar(4000),
+);
+</pre>
+</blockquote>
+
+
+Employees of the company are assigned to projects.
+<blockquote>
+<pre>
+create table project_tracker_assignments (
+       user_id          integer references users,
+       project_id	integer references project_tracker_projects,
+       creator_user_id  integer references users,
+       creation_date    date,
+       -- what the user does for this project
+       role             varchar(4000),
+       unique(project_id, user_id)
+);
+</pre>
+</blockquote>
+
+
+Each project has  major deadlines. Example 
+deadlines are "initial launch", "site upgrade",
+or "progress checkpoint".
+
+<blockquote>
+<pre>
+create sequence project_tracker_deadline_id_seq;
+create table project_tracker_deadlines (
+    deadline_id      integer primary key,
+    creator_user_id  integer references users,
+    creation_date    date,
+    name             varchar(200),
+    start_date       date,
+    due_date         date,
+    description      varchar(4000),
+    status_note      varchar(4000)
+);
+</pre>
+</blockquote>
+
+User's record time spent on each project or deadline.
+
+<blockquote>
+<pre>
+create table project_tracker_hours (
+     user_id           integer not null references users,
+     project_id        integer not null references project_tracker_hours,
+     deadline_id       integer reference project_tracker_deadlines,
+     notes             varchar(4000),
+     -- start_time and finish_time include date and time
+     -- If total_hours is blank, we will assume that the
+     -- user precisely enter the times and will calculate total_hours
+     -- If total_hours is not blank, we will assume that start_time
+     -- and end_time represent "general timeframes" and not try
+     -- to recalculate total_hours
+     start_time	       date,             
+     finish_time       date,
+     total_hours       number(5,2),
+     -- billing rate is in dollars
+     billing_rate      number(5,2) 
+);
+</pre>
+</blockquote>
+
+<h4>Customers</h4>
+
+We store potential, current, and past customers.
+
+<blockquote>
+<pre>
+create sequence project_tracker_customer_id_seq;
+create table project_tracker_customers (
+     customer_id      integer primary key,  
+     creator_user_id  integer references users,
+     creation_date    date
+     name             varchar(200),
+     -- we are not going to bother storing a ton
+     -- of structure information
+     -- To store individual contact records, use the contact-manager
+     contact_info    varchar(4000),
+     -- potential, current, past
+     status         varchar(100),
+     notes          varchar(4000)
+);
+</pre>
+</blockquote>
+
+<hr>
+<a href="http://teadams.com"><address>teadams@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/prototype.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/prototype.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/prototype.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,632 @@
+<head>
+<title>Documentation for Prototype Builder</title>
+</head>
+<body bgcolor="white">
+
+<h2>The Prototype Builder: Documentation</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="mailto:rfrankel@athena.mit.edu">Rebecca Frankel</a>
+
+<hr>
+
+<h3>The Files that make up this Module and where They Go. </h3>
+
+<ul>
+<li>The tool: <a href=/admin/prototype>/admin/prototype</a>
+<li>Procedures: /tcl/ad-prototype.tcl 
+</ul>
+
+
+<h3>What is the Prototype Builder?</h3>
+
+ Often a web service will require a fair number of pages whose form
+and function are nearly identical. The first step of building a web
+service usually involves writing web pages to make
+it possible for the user to enter data into database table and pull it
+out again. These pages for adding and editing data in tables are very
+similar and writing them over and over can become tedious. Thus I have
+built a tool for automatically generating code for these kind of
+pages. The pages generated are meant to be "prototype" pages; it is
+expected that they will be modified before the service is
+complete. However, this tool makes it possible to quickly build the
+framework of a service so one can have a servicable prototype built as
+fast as possible.
+
+<h3>How to use the Prototype Builder: The Short Story</h3>
+
+The goal of the prototype builder is to make it possible to 
+quickly build an add or edit form for a table. To specify how
+one wants an add or edit form to behave requires four
+kinds of information: 
+<ul>
+<li>The text on the add and edit page: the titles, headers, and the
+prompt text for the forms. 
+ <li>Whether there are any columns for
+which data will need to be inserted into the database without user
+form input: such columns include an integer primary key, the creation
+date, and the creation user. The program can generate these kinds of
+data for itself if it is told into which columns they should go.  Also
+the program needs to know in which column to look for a name for the
+object, in order to generate a list page. 
+ <li>What kind of forms that
+are desired and information to configurate the forms. 
+ <li>Error
+handling information: what the program should do if the user fails to
+enter any input in the forms.
+</ul>
+
+In order to keep the interface as clean as possible, the prototype
+builder collects the information it needs on three successive
+pages. The first page asks for the table for which the pages should be
+built, and the base filename for the code that should be returned.
+(For example, if I choose <i>books</i> as my base filename, I will in
+the end be offered the code for the files <i>books-list.tcl</i>,
+<i>books-add.tcl</i>, <i>books-add-2.tcl</i>, <i>books-edit.tcl</i>,
+and <i>books-edit-2.tcl</i>.) The second page asks for general
+information in each of the three categories above, while the third
+page allows us to refine these choices. On the second page we are
+allowed to choose the text for page headers, to identify any special
+columns (like primary key, as discussed above), to choose what kind of
+form we will want for input into a column, and to choose what kind of
+action we wishes to be taken if the user fails to provide any input
+to a column. On the third page we are asked to refine this information
+based on the choices made on the previous page. Suppose we chose, for
+instance, that input to the <i>comments</i> column should be made via
+textarea, and that an error should be returned if the user fails to
+provide any input. Then the third page will ask you to specify a prompt 
+text for textarea, the size you wish for your textarea, and the
+text of an error message to return when the textarea is left blank.  
+<p>
+When we have hit the submit button on the third page, then we are
+offered a page showing how the list and add pages will look given the
+specifications one has entered. Also each listed item is a link to a
+demonstration edit page. Neither the add or the edit page are
+functional; they are just there to let us check that we like the
+choices we has made. If everything is satisfactory, then we may choose
+one of the links at the bottom of the add page to get the code to
+generate the pages. We are offered a choice to view the code (if we
+want to see whether it is what we want) or to save it in the specified
+directory. If we choose to save it, we are given a message at the top
+of the code page saying whether the save was successful, or what error
+was returned. If an error is returned then you may try to fix the
+error or change the directory, and try again. Notice that if the 
+error is "Permission Denied" then the problem is that the the user
+"nsadmin" does not have write permission to that directory. Also note
+that the system will not save over an existing file (its safer that way)
+so if you want to change a file you have already saved, you need to delete
+the old version. 
+
+<h3>How to use the Prototype Builder: The Long Story</h3>
+
+To make this explaination clearer, I wish to illustrate this process
+by working through an example. Suppose we have a large collection of
+penguins and wishes to keep a record of all our penguins in the
+database. (OK, I admit this is a silly example but makes a fine
+demonstration). First we create a data model:
+
+<pre>  
+create table penguins (
+        penguin_id      integer primary key,
+        penguin_name    varchar(50),
+        date_acquired   date,
+        made_of         char(20) default 'fuzzy cloth' check (made_of in <br>       ('fuzzy cloth','plain cloth','wood','glass','ceramic','plastic','other')),
+        -- is this a Linux penguin?
+        tux_p          char(1) default 'f' check(tux_p in ('t','f')),
+        description     varchar(700),
+        date_entered     date,
+        entered_by      references users
+);
+
+ create sequence penguin_seq
+</pre>  
+
+<a href ="prototype.html">
+<img src="prototype-gifs/penguinfront.gif" align=right width=302 height=574 hspace =10></a> 
+
+This is a reasonable collection of data to store about a penguin
+collection. Actually, I chose the columns to produce a range of types
+so I could demonstrate how they all worked. I have no idea if one
+would want to store anything like this about a penguin
+collection. However, there are some things to note about this data
+model. I have chosen an integer primary key and made an associated
+sequence, since the prototype builder can build better pages (with
+double-click protection and other nice features) when it has these
+things.
+
+<h4>The First Page</h4>
+
+Here we see an image of the first page of the prototype builder.  The
+first step of building the penguin application is to choose the table
+we have created above: 'penguins'. We also need to choose the base
+directoryname and filename. The directoryname tells the system where
+you wish code to be save (note that you will have an option to change it later
+too). The base file name tells the system how to prefix all the code it
+generates. Here we have chosen <code>penguin</code> as a basefile name:
+we will be returned files with names like penguin-list.tcl, penguin-add.tcl, 
+and so on.
+
+<p>
+After hitting the submit button, we will see...
+
+<h4>The Second Page</h4>
+
+This is an image of the first section on the second page.  It allows
+us to tell the program what kind of headers we wish to see on the
+generated pages. I refrained from making this section ask for too much
+detail because it is easy to edit the headers after getting the code
+back, if they aren't exactly the way you like them.
+<a href ="prototype.html">
+<img src="prototype-gifs/penguin2a.gif" align=left
+     width=311 height=407 vspace=10 hspace =10></a>
+The first textbox asks for the title for the main page.  This appears
+as a main header for the first page and as a title in the others. The
+next two boxes ask us to fill in phrases for the list page. when I
+built this, I was hoping I would get from the user the singular and
+plural form of the object that he or she is concerned about.  I use
+this data all over the system to fill in headings like "Edit the
+<i>singular form of object</i>" or "View all the <i>plural form of
+object</i>". The plural of my object is <code>penguins</code> and the
+singular is <code>penguin</code>, so that's what I typed these in
+these boxes.
+
+<p>
+The Arsdigita Community System has a sensible convention of always
+including a link to the homepage of a module directly below the
+main heading of any page. In order to comply with this convention, 
+the prototype builder asks for some phrases to allow it to 
+build this kind of backlink on every page. We needs to fill
+in the filename of the homepage (in this case <code>penguin-list.tcl</code>,
+though it usually is <code>index.tcl</code>) and the name of the module
+(in this case "Penguin Management System"). There is also a phrase which
+introduces the module-name link; it defaults to "part of the" and I didn't 
+chose to edit it.
+
+<a href ="prototype.html">
+<img src="prototype-gifs/penguin3a.gif" align=right width=280 height=345 vspace=10 hspace =10></a>
+
+<h4>Special Columns</h4>
+The next section on the second page asks the user
+to choose whether there are any special columns in the
+database table. There are two purposes to this section:
+First, the system must have a key and name for every
+object; if you don't enter those here, it will ask for them
+again on the next page. Second, there are columns for which 
+the program can generate values without having to ask
+the user for input. For instance, the creation date of an 
+object can be generated on the insert page at the time
+of the insert without having to ask the user to enter it. 
+In fact, it is better <em>not</em> to ask the user to 
+enter it because he or she might get it wrong! Similarly, the id of 
+the user creating the object, or an integer primary key,
+can be discovered automatically, and requesting this data
+would confuse the user and risk that he or she would enter 
+a wrong answer. Therefore, the prototype builder asks for
+these columns to be identified here, and one need do nothing
+more for them to be properly taken care of. In fact, with 
+the exception of the object's name, it is important to 
+remember to let these columns alone for the rest of the page.
+
+<h4>Choosing Form Types</h4>
+
+Next we are given the opportunity to choose which kind of form we
+wishe for entry into each column. Below we see the section of this
+page as it appears for our penguin collection data model. (I have
+increased the size of the font slightly because otherwise it is too
+hard to see which boxes are checked.) For every column there is a row
+of radiobuttons which we can use to choose a form type for entry into
+that column. It is important to note that one does not have to choose
+a form type; any column which is left with the choice "none" will just be
+ignored when building forms and will be 
+unavaliable for user input. Often, as I pointed out above, we might
+want this situation; there are columns you do not want the user to
+have access to. In this example, the <code>penguin_id</code>,
+<code>date_entered</code>, and <code>entered_by</code> columns are
+in this catagory; we want the user not to have access to them, so
+we leave them with the "none" option selected.
+
+
+<a href ="prototype.html">
+<img src="prototype-gifs/penguin4b.gif" width=677 height=384 vspace=10 hspace =10></a>
+<p>
+
+ For the rest of the
+columns I have chosen appropriate form types. The columns,
+<code>tux_p</code> and <code>date_acquired</code>, whose Oracle
+datatype were boolean and date, obviously should get those form types
+chosen for them.
+<a href ="prototype.html">
+<img src="prototype-gifs/penguin5b.gif" align=left width=435 height=364
+vspace=10 hspace =10></a>
+ For the shorter text column <code>penguin_name</code> I choose
+textbox, and for the longer one <code>description</code> I choose textarea.
+This leaves <code>made_of</code>, which, since it consists of a list
+of values amoung which the user should select, should be either a 
+radiobutton or selectbox. For demonstration purposes I choose radiobutton,
+though ordinarily I would probably choose selectbox. 
+
+
+<h4>Choosing Error Types</h4>
+
+The next section of the second page allows us to choose what kind of
+action to take if the user fails to enter input for a form. In this
+example, there is only one column for which we must badger the user to
+enter data: the <code>penguin_name</code>. We must demand this column
+because we chose it earlier in the 'special columns' section as the
+name of the object, and thus it will be used on the list page to
+identify the object to the user. The user would not wish to see an
+empty string in that listing.  There are some other columns for which
+I decided to set defaults, mostly for demonstration purposes. I could
+imagine, for instance, that a large part of the penguin collection was
+aquired at a certain date (a wedding shower?) and thus the user would
+wish that date as the default acquisition date.  One could also
+imagine that most of the penguins are made of a certain kind of
+material; perhaps most of them are plush fuzzy dolls, and thus we wish
+to set "fuzzy cloth" as the default material. One could also imagine
+that the Tux dolls are in the minority, and thus one would wish a default
+of 'false' for  <code>tux_p</code>
+<p>
+
+Again, it is important to note that we do not need to set an error
+action for every column. In fact, there are columns for which one
+<em>should not</em>. Columns for which one did not choose a form
+probably should not get an error action. Special columns like the
+primary key, creation date and creation user in particular should be
+left alone for the program to handle.  Also there are columns like the
+<code>description</code> column which are not important enough to
+harass the user about filling, and for which a null value in the
+database is perfectly acceptible.
+
+<a href ="prototype.html">
+<img src="prototype-gifs/penguin6a.gif" align=right width=348 height=287
+vspace=10 hspace =10></a>
+<p>
+
+We have reached the bottom of the second page. 
+After hitting the submit button, one will see...
+
+<h4>The Third Page</h4>
+
+At the right we see the top of the third page
+as it appears in our example. The third page
+asks for more information about every column 
+for which we requested action be taken. The
+first column listed is  <code>penguin_name</code>.
+Since we chose textbox as the form type, we are asked
+questions specific to textboxes. We are asked to enter
+some prompt text to introduce the textbox, and we are
+asked to choose how large we want it to be. Usually
+it is best to choose one of Small, Medium or Large, so
+that textboxes will be standard sizes throughout the
+application. However, in this case I wanted to make my textbox
+extra small to fit in the margins of this document, so 
+I chose to specify a custom size. Since we chose to 
+ask the program to complain if the user fails to enter
+input, the program asks us here for an error message to 
+show the user. This error message will be wrapped in 
+the standard text from <code>ad_return_complaint</code>, so if
+an error actually occurs the full text will be:<p>
+<code> We had a problem processing your entry:
+<ul>You must enter a penguin name.</ul>
+Please back up and resubmit your entry.</code>
+<p>
+It is useful to keep this context in mind when composing
+error messages. 
+
+<a href ="prototype.html">
+<img src="prototype-gifs/penguin7a.gif" align=left width=347 height=145
+vspace=10 hspace =10></a>
+<p>
+Next the third page asks us for more information about the form for
+entry into <code>date_acquired</code>.  We chose the form type to be
+date, with a default value specified, and thus this page asks us for a
+prompt text and a default date. I shall suppose that the magic date
+which was the start of the bulk of the penguin collection was May 1,
+1995, and thus I enter it here. Notice that one can also set the
+default date to be "Now," which means the default will be set to be
+whatever moment that the user chooses to look at the add
+page. However, I should mention that if you choose to set no default,
+the page will behave the same as if you had chosen this default. As it
+were, "Now" is the default by default, and thus there is little point
+to go out of one's way to specify it. 
+<a href ="prototype.html">
+<img src="prototype-gifs/penguin8a.gif" align=right width=351 height=194
+vspace=10 hspace =10></a>
+<p>
+Furthur down the third page, we see a request  for furthur information about 
+the form entry into <code>made_of</code>. We had chosen "radiobutton" for 
+this column, but this section would look the same if we had chosen
+radiobutton, select or checkbox. We are asked for a tcl list of values
+from which the program can generate radiobuttons. Notice that if
+we want more than one word to belong to one radiobutton label, we 
+have to enclose it in quotes, following the grouping convention of 
+tcl lists.  Then we can chose one of the entries of this list
+to be specified as the default value for our radiobutton variable.
+This entry will be checked by default on the add page. If this
+were a checkbox instead of a radiobutton we could choose more
+than one element of the list to be checked by default. 
+
+<a href ="prototype.html">
+<img src="prototype-gifs/penguin9a.gif" align=left width=343 height=167 vspace=10
+hspace =10></a> 
+<p>
+I have supposed that a large part of this penguin
+collection is made up of Tux dolls, and thus the owner might want to
+keep a record of whether this penguin represents the Linux mascot.
+Therefore we have requested an entry into the boolean
+<code>tux_p</code>.  For a boolean one is given a choice of whether
+one wishes it to be displayed Yes/No or True/False. Given the question
+I chose as my prompt text, Yes/No is the right choice here. However,
+when specifying the default, one should remember that booleans are
+represented in the database as 't' and 'f', and choose one of these
+letters as the default. (I should improve this interface; it is this
+way because booleans are handled as a special case of radiobuttons.)
+Since I am assuming that Tux dolls do not make up the majority of the
+collection, I choose 'f', for false, as the default.
+<a href ="prototype.html">
+<img src="prototype-gifs/penguin10a.gif" align=right width=344 height=166
+vspace=10 hspace =10></a>
+<p>
+Finally, we come to the last column for which we have requested 
+a form entry, <code>description</code>. We requested a textarea
+for this column. Textareas are handled very similarly to textboxes:
+the only difference is that we get to choose both the rows and 
+columns if we choose to specify the size. Again, since I want 
+my textarea to fit comfortably in the margin of this document, 
+I choose a small width and height. 
+<p>
+So we have come to the bottom of the third page, and 
+entered all the data we need to specify our prototype pages.
+We hit submit and see the fruit of our labors...
+
+<a href ="prototype.html">
+<img src="prototype-gifs/demopagetop.gif" align=left width=278 height=591
+vspace=10 hspace =10></a>
+
+<h4>The Preview Page</h4>
+
+The next page we see is intended to show us how the choices we have
+made will look. You can see at the left the results of the entries we
+have made. We have a title and backlink for our page, as we specified.
+We have a list of all the penguins in the database (I entered some
+earlier), listed by their names. We have a small textbox for entering
+the name of a new penguin. We have a date widget with our chosen
+default date filled in. We have a radio button list of material
+choices with "fuzzy cloth" set as the default.  We have a boolean
+selector for the Tux question with "No" set as the default. Finally we
+have a small textarea in which to enter a furthur description of the
+penguin. At this point we can review our choices and decide if we are
+happy with them. If not, it is easy to go back and change anything we
+do not like. 
+<p>
+However, even after adjustment there may still be some dissatisfying
+aspects of the formatting or functioning of the preview page which one
+might wish to change and cannot. For instance, one might not like the
+layout of the radiobuttons which list the materials (they are pretty
+ugly). Unfortunately, nothing on the previous pages will reconfigure this
+aspect of the page. This is why this is only the preview
+page, and the main goal of this module is not to produce a page like 
+this, but to produce the code that generates it. One cannot hope
+to produce enough configuration paramaters to generate pages that would
+please everyone in every circumstance. However, if one offers the 
+code for these pages, it is good enough to get reasonably close to 
+what people want, and allow them to edit the code to get the rest of the 
+way. So, for instance, if you want your radiobuttons grouped in 
+threes, or sorted by descending order by wordlength, or whatever you
+wish to make them pretty in your eyes, by far the easiest thing is 
+to pick up the code using the buttons at the bottom of the page, and
+start editing.
+<p>
+<a href ="prototype.html">
+<img src="prototype-gifs/penguincode.gif" align=right width=378 height=365
+vspace=10 hspace =10></a>
+ 
+
+Currently the buttons at the bottom of the preview page
+offer links to the code to five different pages: a list page, 
+that will look much like the top part of the preview page; an add
+page, that will look like the bottom part of the preview page;
+an edit page, that will look like the bottom part but with 
+value from the database filled in; and insert pages for the add
+and edit pages. 
+<p>
+If you click through any of these buttons, you will see a window with
+the code displayed. When I designed this system, I intended for the
+user to be able to use the Save As... button to save the code to
+wherever he or she wished. In addition, I added the option to save the
+code directly from the web server. If you choose the "Save code"
+button, the system will attempt to save the code for you in the
+directory specified, and will leave message at the top of the code
+page saying whether or not the attempt was successful. If the
+code-saving attempt fails, it will list the error message generated by
+the system.  <p> There are some standard reasons why code-saving would
+fail. First, if you include ".." anywhere in the name, it will fail
+for security reasons. Second, I decided it should refuse to save over
+existing code, out of a similar sense of caution. So if you hit the
+"Save" button twice, the save will fail the second time. You have to
+delete or move the generated code for the save to work again. Thirdly,
+unless your directory has write permission for the "nsadmin" user, you
+will get "Permission Denied."  The best fix for this problem is to add
+nsadmin to your group and make your directories group-writable. However if you don't have the option to change the
+groups in your system, then you have to make at least one directory
+world-writable. I made a world-writable code/ directory and always save 
+my code there, and then later move it to where I want it to be. 
+
+<p>
+
+
+<a href ="prototype.html">
+<img src="prototype-gifs/penguinlist.gif" align=left width=295 height=236
+vspace=10 hspace =10></a>
+
+However the code is saved, remember that it important to save it under
+the filename it claims it should be.  If you are desperately unhappy
+with this name, you can go back and change the base filename. If even
+this cannot make you happy, you can change the filename in the code,
+but remember that the list page links to the edit page, and the edit
+page will call the edit-2 page, and so on, so you have to be careful
+to change filenames every place they appear.
+<p>
+Now suppose we have managed to succesfully save our code under the
+appropriate names. We are ready to enjoy our working Penguin
+Management System. We visit penguin-list.tcl with our browser and
+see...
+
+<a href ="prototype.html">
+<img src="prototype-gifs/penguinadd.gif" align=right width=256 height=551
+vspace=10 hspace =10></a>
+
+<h4>The Working Penguin Management System</h4>
+
+
+At the right we see how the 
+list page of our Penguin Management
+System looks.
+
+ Since there are no other
+tables this becomes the front page as well
+(in a larger system in would probably be linked
+from the real front page). I have already added
+two penguins in the system, and each of them 
+is a link to an edit page which allows us to 
+edit their data. 
+
+<p>
+Recently some friends of mine offered to sell me some Linux stickers
+to stick on top of offending logos on my computer, of, well, shall we
+say, other vendors. Suppose these stickers feature the Linux penguin,
+so they count as a new addition to my penguin collection. Therefore I
+can use the link to "Add a penguin." to record this new addition to my
+collection.
+<p>
+
+At the left we see the add page that resulted when I followed the
+link. I edited the code a little to improve the formatting. The
+aforementioned offending radiobuttons look better now. I have filled
+in the values to record my Linux sticker in the database. I assume a
+sticker made of plastic counts as a plastic penguin, and I fill
+in the date of April Fools Day. I also include a short description
+because this is rather strange addition to a penguin collection.
+After
+submitting this data (where it is handled invisibly by
+penguin-add-2.tcl), I return to the list page, where I see I now have a
+new penguin in the database:
+
+<a href ="prototype.html">
+<img src="prototype-gifs/penguinlistwtux.gif" align=left width=256 height=250
+vspace=10 hspace =10></a>
+<p>
+Each of the names on the list page is a link to a page where
+the values in the database can be edited. Thus, 
+I can check the whether the values for "Mr. Tux" were successfully
+entered into the database by selecting his name. We are shown
+the edit page for the entry associated with "Mr.Tux" (seen below). The values seem to be the ones we entered. They are
+filled into forms so they could be further edited. If we want
+to change anything we can do so and press submit on this page 
+to feed the change into the database.
+ 
+<h3>Known Bugs and Missing Features</h3>
+
+<h4>Known Bugs</h4>
+ 
+This system has been thoroughly tested only in the situation 
+where the table has an integer primary key with an associated
+sequence. Any other case may not insert the primary key properly
+in the database and certainly will not produce double-click
+protection for the Add page. 
+<p>
+
+<a href ="prototype.html">
+<img src="prototype-gifs/penguinedit.gif" align=right width=253 height=560
+vspace=10 hspace =10></a>
+
+Variables are passed between pages using their column names.  This may
+cause problems if a programmer adds a call to
+set_variables_after_query and it overwrites the values passed from the
+forms. I am not sure what to do about this; calling the variable
+anything other than their column names makes them hard to keep track
+of.
+ <p>
+ Checkboxes are not appropriately filled in on the edit pages
+if more than one of them is checked. I used bt_mergepiece to fill them
+in, and I do not know why it isn't working right. In general,
+checkboxes are the least-well tested of the form-types, because they
+are rare and have strange properties.  So if you use checkboxes, check
+your code to make sure it is doing what you want.
+
+<h4>Missing Features</h4>
+
+The largest glaring assumption this system makes is that the
+table chosen is a simple primary-key table. Many tables
+are keyed by two identification numbers that reference other
+tables. The ability to handle such tables gracefullly is the
+biggest capability needed to make this tool able to automatically build
+systems more complex than our (very simplistic) Penguin Management
+System.
+<p>
+Another often used feature missing from this system is the
+ability to fill in a select, checkbox or radiobutton from 
+values pulled from another table in the system. For instance, 
+in my Penguin Management System, I might have had another table
+listing materials of which penguins might be made, and I would 
+want the page to find this list from the database, rather than 
+always using a pre-specified list.
+<p>
+
+Both these features would be hard to add without correcting a deeper
+weakness of this system. This system does not store data in the
+database as it builds pages, and its "data model" is entirely built
+out of variables passed between HTML pages. This kind of data
+structure has reached (or perhaps passed) the limit of the complexity
+it can handle.  I really need to build a meta-data data model and
+rewrite all the pages so they rely on the data they get from the
+database rather than on data passed through hidden forms from page to
+page. 
+
+ <p> There should be a feature to enable "sort by" links on the
+list page. This is simple to add; however I am not quite sure how to
+structure the configuration of such an option.
+<p>
+Another major feature that might be useful, but I do not even 
+begin to understand how to structure, would be some way to deal
+with objects that require permissions or approval for their 
+creation. I do not know well enough the standard patterns for
+permission and approval generation to know if or how it could
+be incorporated into a system like this. 
+
+<hr>
+
+<ADDRESS><a href="mailto:rfrankel@athena.mit.edu">rfrankel@athena.mit.edu</a> 
+</address>
+
+
+</body>
+<!--<a href ="prototype.html"> <img src=".gif" align=left border=2
+hspace =10></a>
+
+-->
+
+<!--
+Basically, using the prototype builder requires these steps:
+<p>
+On the first page:
+<ul>
+<li>Pick a database table and a filename.
+</ul>
+On the second page:
+<ul>
+<li>Enter information about what page heading you want.
+<li>Choose the columns for which you want the user
+to get entry-forms and which kind of forms you want.
+<li>Choose for which columns you want the program to 
+take an action in case the user enters no data and what kind of action 
+you wish it to take.
+</ul>
+On the third page:
+<ul>
+<li>
+</ul>
+-->
+
+
+
Index: web/openacs/www/doc/publishing.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/publishing.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/publishing.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,136 @@
+<html>
+<head>
+<title>
+Dynamic Publishing System
+</title>
+</head>
+<body>
+
+<h2>
+Dynamic Publishing System
+</h2>
+
+part the <a href="/doc">ArsDigita Community System</a> 
+by <a href="mailto:karlg@arsdigita.com">Karl Goldstein</a>
+
+<hr>
+
+<h3>The Problem</h3>
+
+<p>The traditional way to create dynamic pages for AOLserver 
+is to write "pages that are really programs," mixing Tcl code, 
+database queries and HTML in a single file.  This approach is
+convenient under the following conditions:</p>
+
+<ul>
+<li>when all people working on the site have equal responsibility and
+ability to write code, create content, and design page layouts.
+<li>When a single presentation of the content is sufficient.
+</ul>
+
+<p>Alas, the world of web publishing is not so monotonic these days.
+Most web publishing teams are faced with the following dilemma(s):</p>
+
+<ul> 
+
+<li><p>The process of creating a site is no longer in the lone hands
+of a team of programmers.  Page templates are usually designed by
+graphic artists, UI experts, and their associated journeymen.
+Programmers must wire their code into the complex templates handed to
+them by the HTML authors, and then take responsibility for any later
+changes to the HTML that involves their code.  Content may be managed
+and contributed by separate teams of editors and authors.</p>
+
+<li><p>As the Web truly becomes World Wide, the need to present the
+same content in different ways is becoming increasingly important.
+This includes both publishing in different languages as well as
+publishing for different devices, such as cell phones and home
+internet appliances.</p>
+
+</ul>
+
+<p>The complexities of contemporary web publishing demand more
+attention to improving productivity and collaboration among all
+members of the team.  Programmers need the means to focus more on
+functionality, optimization and security and less on design work.
+Conversely, HTML authors need the freedom to make most design changes
+without programmer intervention.  Editors and authors need a way to
+contribute and manage the content that the pages present.  Site
+managers need the means to oversee the work of the entire team.</p>
+
+<h3>The System</h3>
+
+<p>The Dynamic Publishing System addresses these problems with an integrated
+suite of tools:</p>
+
+<ul> 
+
+<li><em>Dynamic templates</em> that allow for strict separation of
+code (Tcl and SQL) and layout (HTML).  Programmers specify the sources
+and variable names of dynamic data in a <em>data specification</em>
+file associated with each template file.  HTML authors then use a
+small number of special markup tags to include the specified data in
+the template.
+
+<li>A <em>form manager</em> to handle user data transactions with
+similar separation of code and layout.  Programmers specify the
+functional characteristics of a form in a <em>form specification</em>
+file.  Most form manager uses this information to handle most common
+programming tasks related to forms, including validation, populating
+button groups and select lists, setting of default values for update
+forms, and database interaction.  HTML authors use special markup
+tags to include the specified form widgets in a form template.
+
+<li>A <em>site manager</em> that allows the publisher to establish a
+hierarchical structure for a site, for the purpose of generating
+navigation controls and site maps.  The manager may also be used to
+assign common properties, such as master layout templates, resource
+directories, and group access permissions to entire branches of the
+site.
+
+<li>A <em>content manager</em> that supports distributed contribution
+and editorial control of static text and images in multiple languages.
+A site may have any number of <em>content sections</em>, each with its
+own group of authors who have permission to contribute content and
+editors who have permission to make changes and approvals for public
+release.
+
+<li>A <em>locale manager</em> to define the languages in which the
+site is published and allow for user selection of locale.
+
+<li>An <em>index manager</em> for assignment of keywords to content,
+pages, and entire sections of the site.  This information may then be
+used to create metadata and site indices, as well as track user
+interests.
+
+<li>A <em>file management</em> tool for controlled editing and
+uploading of text and image files.
+
+</ul>
+
+<h3>Status</h3>
+
+<p>The Dynamic Publishing System is currently being developed,
+documented and reviewed internally by ArsDigita.  It is publicly
+available for trial and inspection from its <a
+href="http://karl.arsdigita.com/projects/template">development
+site</a>.  The documentation still needs improvement but should be
+enough for you to get started.  Questions and feedback are
+welcome.</p>
+
+<p>Due to bugs and limitations in the current beta release of
+AOLserver 3.0, the system currently works only with AOLserver 2.3.3.
+After internal review is complete and AOLserver 3.0 is finally
+released, the goal is to include it in the standard ACS
+distribution.</p>
+
+<hr>
+
+<a href="mailto:karlg@arsdigita.com">karlg@arsdigita.com</a>
+
+
+
+
+
+
+
Index: web/openacs/www/doc/pull-down-menus.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/pull-down-menus.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/pull-down-menus.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,126 @@
+<html>
+<!--AD_DND-->
+<!--pull-down-menus.html,v 3.1.2.2 2000/03/16 05:36:27 aure Exp-->
+
+<head>
+<title>Pull Down Menu System</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Pull Down Menu System</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://aure.com/">Aurelius Prochazka</a>
+
+<hr>
+
+<ul>
+<li> User-accessible directory: N/A
+<li> Adminstration directory: <a href="/admin/pull-down-menus/">/admin/pull-down-menus/</a> (must use https://)
+<li> Utility Directory: /pull-down-menus/
+<li> data model: <a href="/doc/sql/pull-down-menus.sql">/doc/sql/pull-down-menus.sql</a>
+<li> procedures: /tcl/pull-down-menu-defs.tcl
+</ul>
+
+<h3> The Big Picture </h3>
+
+Designing navigation methods is an integral part of creating the
+information architecture for a web site.  It is one of the things that
+we usually have to write from scratch for each site we create using
+the ArsDigita Community System (ACS).  As of February, 2000 the ACS
+provides only two navigation tools, <a
+href=content-sections.html>content sections</a> and context bars.  <p>
+With this module you can define two traditional site navigation
+methods - the top navbar (e.g. <a
+href=http://ibm.com/>http://ibm.com/</a> or <a
+href=http://cyranosciences.com/>http://cyranosciences.com/</a>) and
+the left navbar (e.g. <a href=http://vg-8.com/>http://vg-8.com/</a>).
+There are benefits to both methods, so often a site will use a
+combination (<a href=http://amazon.com/>http://amazon.com/</a>).  <p>
+One of the most impressive looking pull down menu systems appears on
+the main page of <a href=http://www.career.caltech.edu/>Caltech's
+Career Development Center</a>, but it is java and can cause Netscape
+(esp. on Linux) to die.  Our system does just about as much as this
+does for a lot less overhead.
+
+<h3>Setting Up the Menus</h3>
+
+
+<pre>
+[ns/server/<i>yourservername</i>/acs/pdm]
+; Flag to display the administration menu bar
+MenuOnAdminPagesP=1
+; Flag to display the default menu bar on non-/admin pages
+MenuOnUserPagesP=0
+</pre>
+
+
+<h3>Our Data Model</h3>
+
+<pre>create table pdm_menus (
+	menu_id			integer primary key,
+	-- programmer friendly title used to call the menu
+	menu_key			varchar(20) unique not null,
+	-- is this the menu to show if no pdm_key is passed to ad_pdm?
+	default_p		char(1) default 'f' check (default_p in ('t','f')),
+	-- orientation of the menu, either "horizontal" or "vertical"
+	orientation		varchar(20) not null check (orientation in ('horizontal','vertical')),
+	-- distance from the left side of the display area
+	x_offset		integer not null,
+	-- distance from top of the display area
+	y_offset		integer not null,
+	-- dimensions of a single menu element
+	element_height		integer not null,
+	element_width		integer not null,
+	-- css-type style guides for the fonts in the menu
+	main_menu_font_style	varchar(4000),
+	sub_menu_font_style	varchar(4000),
+	sub_sub_menu_font_style varchar(4000),
+	-- main menu background images and background colors 
+	main_menu_bg_img_url	varchar(200),
+	main_menu_bg_color	varchar(12),
+	-- hl stands for "highlight" - these are what are shown when
+	-- someone mouses over the menu
+	main_menu_hl_img_url    varchar(200),
+	main_menu_hl_color	varchar(12),
+	-- background and color definitions for first level sub menu
+	sub_menu_bg_img_url	varchar(200),
+	sub_menu_bg_color	varchar(12),
+	sub_menu_hl_img_url	varchar(200),
+	sub_menu_hl_color	varchar(12),
+	-- background and color definitions for second level sub menu
+	sub_sub_menu_bg_img_url	varchar(200),
+	sub_sub_menu_bg_color	varchar(12),
+	sub_sub_menu_hl_img_url	varchar(200),
+	sub_sub_menu_hl_color	varchar(12)
+);
+
+create table pdm_menu_items (
+	item_id			integer primary key,
+	menu_id			references pdm_menus,
+	-- within one level, sort_key defines the order of the items
+	sort_key		varchar(50) not null,
+	-- text of the item to be displayed if no images are shown and
+	-- as alt text to the images
+	label			varchar(200) not null,
+	-- url may be null if this item is only used to store other items
+	url			varchar(500),
+	-- don't show certain elements to people who haven't registered
+	requires_registration_p char(1) default 'f' check (requires_registration_p in ('t','f'))
+);</pre>
+
+<h3> Limitations and known bugs</h3>
+
+Not currently compatible with versions of Netscape 3.0 or Internet Explorer 3.0 (or earlier).
+<p>
+Netscape does not correctly place form elements on layers.  THe best way to deal with this problem is to try to place the pull-down in a place where it won't interact much with forms.   For instance, the menu bar could be at the top of a header image and only ever overlay the header.
+
+<h3> Future enhancements</h3>
+
+Need to improve the side bar version and user and programming documentation.
+
+<hr>
+<a href="mailto:aure@arsdigita.com"><address>aure@arsdigita.com</address></a>
+</body>
+</html>
+ 
Index: web/openacs/www/doc/queue-message.pl.txt
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/queue-message.pl.txt,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/queue-message.pl.txt	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,106 @@
+#!/usr/local/bin/perl
+#
+# Respond to incoming mail message on STDIN
+#
+# hqm@ai.mit.edu
+#
+# This script does the following:
+#
+sub usage () {
+    print '
+  usage: queue_message.pl db_datasrc db_user db_passwd destaddr
+
+  Inserts the data from stdin into a queue table.
+
+  Assumes the following table and sequence are defined in the db:
+
+    create table incoming_email_queue (
+	    id 		integer primary key,
+	    destaddr	varchar(256),
+	    content		clob,		-- the entire raw message content
+					    -- including all headers
+	    arrival_time	date
+    );
+
+    create sequence incoming_email_queue_sequence;
+
+';
+}
+
+use DBI;
+#use Mail::Address;
+
+################################################################
+# Global Definitions
+
+$db_datasrc        = shift;
+$db_user           = shift;
+$db_passwd         = shift;
+$destaddr          = shift;
+
+$DEBUG = 1;
+$debug_logfile = "/tmp/mailhandler-log.txt"; # 
+
+# Oracle access
+$ENV{'ORACLE_HOME'} = "/ora8/m01/app/oracle/product/8.1.5";
+$ENV{'ORACLE_BASE'} = "/ora8/m01/app/oracle";
+$ENV{'ORACLE_SID'} = "ora8";
+
+if (!defined $db_datasrc) {
+    $db_datasrc = 'dbi:Oracle:';
+}
+
+if (!defined $db_user) {
+    usage();
+    die("You must pass a db user in the command line");
+}
+
+if (!defined $db_passwd) {
+    usage();
+    die("You must pass a db passwd in the command line");
+}
+
+
+
+#################################################################
+## Snarf down incoming msg on STDIN
+#################################################################
+
+while (<>) {
+    $content .= $_; 
+}
+
+if ($DEBUG) {
+    open (LOG, ">>$debug_logfile");
+    debug("================================================================\n");
+    debug("Recevied content:\n$content\n");
+}
+
+# Open the database connection.
+$dbh = DBI->connect($db_datasrc, $db_user, $db_passwd)
+  || die "Couldn't connect to database";
+$dbh->{AutoCommit} = 1;
+# This is supposed to make it possible to write large CLOBs
+
+$dbh->{LongReadLen} = 2**20;   # 1 MB max message size 
+$dbh->{LongTruncOk} = 0;   
+
+
+debug("Status: inserting into email queue\n");
+$h = $dbh->prepare(qq[INSERT INTO incoming_email_queue (id, destaddr,  content, arrival_time) VALUES (incoming_email_queue_sequence.nextval, '$destaddr', ?, sysdate)]);
+
+
+if (!$h->execute($content)) {
+    die "Unable to open cursor:\n" . $dbh->errstr;
+}
+$h->finish;
+
+
+$dbh->disconnect;
+debug("[closing log]\n");
+if ($DEBUG) { close LOG; }
+
+sub debug () {
+    my ($msg) = @_;
+    print LOG $msg;
+}
Index: web/openacs/www/doc/redirect.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/redirect.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/redirect.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,77 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Redirects</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Redirects</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+<blockquote>
+Alternative title:  "papering over your historical stupidity."
+</blockquote>
+
+<p>
+
+Suppose that you're a stupid person like me and back in 1993 published
+URLs such as "/~philg/philg.html".  You now want users to get
+"/philg/index.html".  The redirect subsystem is for you!
+
+<p>
+
+Hey, doesn't AOLserver already have an aliases module?  Yes, but it
+assumes that you never move stuff off your server.  The ArsDigita
+Community System redirect module let's you do the following:
+
+<ul>
+<li>Redirect "foo" to "bar" (JustOne)
+<li>Redirect anything that starts with "foo" to "bar" (Inherit)
+<li>Redirect anything that starts with "foo" to whatever came after the
+"foo" but starting now with "bar" (Pattern)
+</ul>
+
+You specify redirects in /parameters/ad.ini.  All of the work happens in
+/tcl/ad-redirect.tcl
+
+<P>
+
+Here's an example:
+
+<blockquote>
+<pre>
+[ns/server/yourservername/acs/redirect]
+Pattern=/~philg|/philg
+JustOne=/~philg/new-zealand/nz-mtn-bike.text|/nz/nz-mtn-bike.html
+Inherit=/bp/czech-FAQ.html|http://www.fas.harvard.edu/~sever/Czech.homepage.html
+</pre>
+</blockquote>
+
+The first line ensures that old URLs with a ~philg will still work.  It
+is a "Pattern" redirect spec so that "/~philg/photo/hand-coloring.html"
+goes to "/philg/photo/hand-coloring.html" rather than simply to "/philg".
+
+<p>
+
+The second line redirects the user from a .text file in one directory to
+a .html file in another redirectory.
+
+<p>
+
+The third line redirects anything starting with "/bp/czech-FAQ.html" to
+a server at Harvard (the author of this FAQ is a Harvard staff member
+and it is easier for him to maintain the content there now that Harvard
+has moved into the Internet Age).  You might think that this would be a
+logical candidate for JustOne rather than Inherit but I wanted to make
+sure that something like "/bp/czech-FAQ.html#section1" would also get
+redirected.
+
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/reporte.ini
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/reporte.ini,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/reporte.ini	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,50 @@
+[ns/parameters]
+User=nsadmin
+ServerLog=/home/nsadmin/log/reporte-error.log
+Home=/home/nsadmin
+
+[ns/server/reporte]
+EnableTclPages=On
+PageRoot=/web/reporte
+DirectoryFile=index.html, index.htm, index.shtml
+
+[ns/server/reporte/module/nslog]
+enablehostnamelookup=Off
+file=/home/nsadmin/log/reporte.log
+logcombined=On
+logrefer=Off
+loguseragent=Off
+maxbackup=5
+rollday=*
+rollfmt=%y-%m-%d-%H:%M
+rollhour=0
+rollonsignal=On
+
+[ns/server/reporte/module/nsperm]
+Model=Small
+EnableHostnameLookup=Off
+
+[ns/server/reporte/module/nssock]
+timeout=120
+Port=1999
+Address=server_ip
+Hostname=server_domain
+
+[ns/server/reporte/modules]
+nslog=nslog.so
+nssock=nssock.so
+nsperm=nsperm.so
+nsssl=nsssle.so
+
+[ns/server/reporte/tcl]
+SharedGlobals=On
+Library=/web/reporte/tcl
+
+[ns/servers]
+reporte=reporte
+
+
+[ns/setup]
+ContinueOnError=On
+Enabled=Off
+Port=9879
\ No newline at end of file
Index: web/openacs/www/doc/reports.ini
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/reports.ini,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/reports.ini	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,50 @@
+[ns/parameters]
+User=nsadmin
+ServerLog=/home/nsadmin/log/reports-error.log
+Home=/home/nsadmin
+
+[ns/server/reports]
+EnableTclPages=On
+PageRoot=/web/reports
+DirectoryFile=index.html, index.htm, index.shtml
+
+[ns/server/reports/module/nslog]
+enablehostnamelookup=Off
+file=/home/nsadmin/log/reports.log
+logcombined=On
+logrefer=Off
+loguseragent=Off
+maxbackup=5
+rollday=*
+rollfmt=%y-%m-%d-%H:%M
+rollhour=0
+rollonsignal=On
+
+[ns/server/reports/module/nsperm]
+Model=Small
+EnableHostnameLookup=Off
+
+[ns/server/reports/module/nssock]
+timeout=120
+Port=1999
+Address=server_ip
+Hostname=server_domain
+
+[ns/server/reports/modules]
+nslog=nslog.so
+nssock=nssock.so
+nsperm=nsperm.so
+nsssl=nsssle.so
+
+[ns/server/reports/tcl]
+SharedGlobals=On
+Library=/web/reports/tcl
+
+[ns/servers]
+reports=reports
+
+
+[ns/setup]
+ContinueOnError=On
+Enabled=Off
+Port=9879
\ No newline at end of file
Index: web/openacs/www/doc/robot-detection.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/robot-detection.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/robot-detection.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,138 @@
+<html>
+<head>
+<title>Web Robot Detection</title>
+<style type="text/css">
+BODY {
+  background-color: #FFFFFF;
+}
+</style>
+</head>
+
+<body>
+
+<h2>Web Robot Detection</h2>
+
+part of the <a href="/doc/">ArsDigita Community System</a>
+by <a href="http://michael.yoon.org/">Michael Yoon</a>
+
+<hr>
+
+<ul>
+<li>User-accessible directory: none
+<li>Site administrator directory: <a href="/admin/robot-detection/">/admin/robot-detection/</a>
+<li>Data model: <a href="/doc/sql/robot-detection.sql">/doc/sql/robot-detection.sql</a>
+<li>Tcl procedures: /tcl/ad-robot-defs.tcl
+</ul>
+
+<h3>The Big Picture</h3>
+
+Many of the pages on an ACS-based website are hidden from robots
+(a.k.a. search engines) by virtue of the fact that login is required to
+access them. A generic way to expose login-required content to robots is
+to redirect all requests from robots to a special URL that is designed
+to give the robot what at least appear to be linked .html files.
+
+<p>
+
+You might want to use this software for situations where public (not
+password-protected) pages aren't getting indexed by a specific robot.
+Many robots won't visit pages that look like CGI scripts, e.g., with
+question marks and form vars (this is discussed in <a
+href="http://photo.net/wtr/thebook/publicizing.html">Chapter 7</a> of
+<cite>Philip and Alex's Guide to Web Publishing</cite>).
+
+<h3>The Medium-sized Picture</h3>
+
+In order for this to work, we need a way to distinguish robots from
+human beings.  Fortunately, the <a
+href="http://info.webcrawler.com/mak/projects/robots/active.html">Web
+Robots Database</a> maintains a list of active robots that they kindly
+publish as a <a
+href="http://info.webcrawler.com/mak/projects/robots/active/all.txt">text
+file</a>. By loading this list
+into the database, we can implement the following algorithm:
+
+<ol>
+<li>Check the <code>User-Agent</code> of each HTTP request against those of known robots (which are stored in the <code>robot_useragent</code> column of the <code>robots</code> table).
+<li>If there is a match, redirect to the special URL.
+<li>This special URL can either be a static page or a dynamic script that dumps lots of juicy text from the database, for the robot's indexing pleasure.
+</ol>
+
+<p>
+
+This algorithm is implemented by a postauth filter proc: <code>ad_robot_filter</code>.
+
+<p>
+
+(<em>Note:</em> For now, we are only storing the minimum number of
+fields needed to detect robots, so many of the columns in the
+<code>robots</code> table will be empty. Later, if the need presents
+itself, we can enhance the code to parse out and store all fields.)
+
+<h3>Configuration Parameters</h3>
+
+<pre>
+[ns/server/yourservername/acs/robot-detection]
+; the URL of the Web Robots DB text file
+WebRobotsDB=http://info.webcrawler.com/mak/projects/robots/active/all.txt
+; which URLs should ad_robot_filter check (uncomment to turn system on)
+; FilterPattern=/members-only-stuff/*.html
+; FilterPattern=/members-only-stuff/*.tcl
+; the URL where robots should be sent
+RedirectURL=/robot-heaven/
+; How frequently (in days) the robots table
+; should be refreshed from the Web Robots DB
+RefreshIntervalDays=30
+</pre>
+
+<h3>Notes for the Site Administrator</h3>
+
+<ul>
+
+<li>
+Though admin pages exist for this module, there should be no need to
+use them in normal operation. This is because the ACS automatically
+refreshes the contents of the <code>robots</code> table at startup, if
+it is empty or if its data is older than the number of days specified
+by the <code>RefreshIntervalDay</code> configuration parameter (see
+below).
+
+<li>
+If no <code>FilterPattern</code>s are specified in the configuration,
+then the robot detection filter will <em>not</em> be installed.
+
+</ul>
+
+<h3>Set Up</h3>
+
+<ul>
+
+<li>build a non-password protected site starting at /robot-heaven/
+(that's the default destination), using <code>ns_register_proc</code> if
+necessary to create a pseudo static HTML file appearance
+
+<li>specify directories and file types you want filtered and bounced
+into /robot-heaven/ (from the ad.ini file)
+
+<li>restart AOLserver
+
+<li>visit the /admin/robot-detection/ admin page to see whether your
+configs took effect
+
+<li>view your server error log to make sure that the filters are getting
+registered
+
+</ul>
+
+<h3>Testing</h3>
+
+See the <a href="acceptance-test#robot">ACS Acceptance Test</a>.
+
+<p>
+
+<hr>
+
+<a href="mailto:michael@arsdigita.com"><address>michael@arsdigita.com</address></a>
+
+</body>
+</html>
Index: web/openacs/www/doc/security-sessions.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/security-sessions.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/security-sessions.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,273 @@
+<html>
+
+<head>
+<title>Security and Session Tracking in ACS</title>
+</head>
+
+<body bgcolor=white text=black>
+
+<h2>Security and Session Tracking in ACS</h2>
+by <a href="mailto:jsalz@mit.edu">Jon Salz</a><br>
+
+<hr>
+
+<ul>
+<li>Data model: <a href="/doc/sql/display-sql.tcl?url=/doc/sql/security.sql">/doc/sql/security.sql</a>
+<li>Procedures: /tcl/security-defs.tcl
+</ul>
+
+<h3>The Problem</h3>
+
+<p>HTTP is a stateless protocol, but nearly all nontrivial Web services are stateful. We need to
+provide
+a way to maintain state within a session. Such state includes the user's preferences, login
+information if any (although the solution needs to be general enough to handle anonymous
+sessions),
+and an identifier for the session itself. This session identifier absolutely
+must remain constant from the moment a user enters to the site to the moment he or she is
+done (even if the user logs in or switches to HTTPS in the meantime!) so our clickstreaming
+software can ably analyze the users' behavior.
+
+<p>We need to provide different levels of security for different parts of this state:
+<ul>
+<li>No security at all, e.g., information used for clickstreaming analysis. We don't
+care if a wrong session ID gets logged here and there.
+<li>Basic security, e.g., login information. The user mustn't be able to edit his cookie
+file and change his login to masquerade as someone else, or merely fiddle with his session
+identifier to hijack someone else's session.
+<li>Virtually bulletproof, e.g., ordering information during an e-commerce session.
+We need to be absolutely sure that no information sent in the clear (over
+insecure HTTP) can be sniffed and used to gain access to sensitive information sent
+securely; thus we need separate protection mechanisms for insecure and secure connections.
+</ul>
+
+The new security and session-tracking subsystem needs to consolidate the myriad ways in place now
+for maintaining and securing session and persistent state (including login information). It must
+remember the last time the user visited the site, so we can determine which material on the site
+is new since the user's last visit.
+
+<h3>The Solution</h3>
+
+<h4>Tracking and Securing Sessions</h4>
+
+We now use <i>only</i> the following cookies to track sessions (ideally, no one will ever have to
+set another cookie again):
+
+<ul>
+
+<li><tt><b>ad_browser_id</b></tt> is an integer which is unique to a particular browser. It is
+persistent, set to expire way in the future, so it survives even when the users closes their
+browsers. We issue <tt>ad_browser_id</tt> whenever we receive an HTTP request from a client that
+doesn't already have it set.</p>
+
+<li><tt><b>ad_session_id</b></tt> takes the following form:
+
+<blockquote>
+<tt>ad_session_id := <i>session-id</i>,<i>user-id</i>,<i>token-string</i>,<i>last-issue</i></tt>
+</blockquote>
+
+<ul>
+<li><tt><i>session-id</i></tt> is a unique integer identifier for the session. This is pulled
+directly from a sequence - we don't care if a user can guess other users' session identifiers
+(by adding or subtracting a small integer from their own).
+<li><tt><i>user-id</i></tt> is the user's ACS ID.
+<li><tt><i>token-string</i></tt> is a <i>TokenLength</i>-character random string constructed from
+base64 characters (number, upper- and lowercase letters, period, and slash). It is used as a
+secret to protect the session - we shouldn't allow access to session-specific data unless we know
+the user has the token right. (We refer to this as the <b>insecure token string</b> since it may
+be sent unencrypted.)
+<li><tt><i>last-issue</i></tt> is the time (in seconds since the epoch) when the cookie was last
+issued. Whenever we see that this is more than <i>SessionCookieReissue</i> seconds in the past,
+we reissue the cookie.
+</ul>
+
+<p>Note that <i>TokenLength</i> and <i>SessionCookieReissue</i> are parameters configurable in the
+local <tt>.ini</tt> file.
+
+<p>We issue <tt>ad_session_id</tt>, like <tt>ad_browser_id</tt>, whenever we receive an HTTP request from a client that
+doesn't already have it set. We keep this cookie set to expire <i>SessionTimeout</i> seconds in the future
+(plus or minus <i>SessionCookieReissue</i> seconds).</p>
+
+<li><tt><b>ad_secure_token</b></tt> is another <i>TokenLength</i>-character random string which is
+only ever transmitted over SSL (it has <tt>Secure</tt> specified in the <tt>Set-Cookie</tt>
+header). Even if someone sniffs the session identifier and grabs the insecure token
+string, they will never be able to gain access to this <b>secure token string</b>.
+
+<p>This cookie is only ever sent to a client once, so there's positively no way we could make the
+mistake of sending it to two users (one masquerading as the other). Furthermore, when the
+secure token is issued (typically on a client's first access to the site via HTTPS) we reissue
+the insecure token as well. This way, if Gus sniffs Mary's insecure token and proceeds to make
+a secure access to the site (receiving her secure token), Mary's insecure session will stop
+working, limiting Gus's ability to mess with her.</p>
+
+<li><tt><b>ad_user_login</b></tt> is of the following form:
+
+<blockquote>
+<tt>ad_user_login := <i>user-id</i>,<i>permanent-login-token</i></tt>
+</blockquote>
+
+<p><tt><i>permanent-login-token</i></tt> is a <i>TokenLength</i>-character random string
+stored in the <tt>login_token</tt> field of a row in <tt>sec_login_tokens</tt>.
+This cookie is persistent, and allows the user to log into
+ACS without having to explicitly type a login name and password. If the user logged in securely
+(over SSL), this cookie is only ever transmitted over SSL; otherwise, we assume the user doesn't
+care about security anyway and let it be transmitted in the clear.
+
+</ul>
+
+When appropriate we log this information to, and check it against, the following table (caching to
+minimize hits to the database):
+
+<blockquote><pre>create table sec_sessions (
+    -- Unique ID (don't care if everyone knows this)
+    session_id            integer primary key,
+    user_id               references users,
+    -- A secret used for unencrypted connections
+    token                 varchar(50) not null,
+    -- A secret used for encrypted connections only. not generated until needed
+    secure_token          varchar(50),
+    browser_id            integer not null,
+    -- Make sure all hits in this session are from same host
+    last_ip               varchar(50) not null,
+    -- When was the last hit from this session? (seconds since the epoch)
+    last_hit              integer not null
+);</pre></blockquote>
+
+We populate <tt>secure_token</tt> only when we issue a secure token (the first time the client
+makes an access to the site over HTTPS).
+
+<h4>Maintaining Session- and Browser-Specific State</h4>
+
+<p>In order to let programmers write code to preserve state on a per-session or per-browser
+basis without sending lots of cookies, we maintain the following tables:
+
+<blockquote><pre>create table sec_session_properties (
+    session_id     references sec_sessions not null,
+    module         varchar2(50) not null,
+    property_name  varchar2(50) not null,
+    property_value varchar2(4000),
+    -- transmitted only across secure connections?
+    secure_p       char(1) check(secure_p in ('t','f')),
+    primary key(session_id, module, property_name),
+    foreign key(session_id) references sec_sessions on delete cascade
+);
+
+create table sec_browser_properties (
+    browser_id     integer not null,
+    module         varchar2(50) not null,
+    property_name  varchar2(50) not null,
+    property_value varchar2(4000),
+    -- transmitted only across secure connections?
+    secure_p       char(1) check(secure_p in ('t','f')),
+    primary key(browser_id, module, property_name)
+);</pre></blockquote>
+
+A client module needing to save or restore session- or browser-specific state uses the new
+<tt>ad_get_client_property</tt> and <tt>ad_set_client_property</tt> routines, which manage access to the
+table (caching as appropriate). This way they don't have to set their own cookies, and as a
+bonus they don't have to worry about users tampering with contents!
+
+<p>In general, use session-level properties when you want the properties to expire
+when the current session ceases (e.g., items in a shopping cart). Use browser-level
+properties which the properties should never expire (e.g., user preferences).
+
+<h4>Tracking the User's Last Visit</h4>
+
+The session-tracking subsystem maintains two special pieces of browser-specific state:
+the <tt>last_visit</tt> and <tt>second_to_last_visit</tt> properties (with module
+<tt>acs</tt>). <tt>last_visit</tt> is the time at which the current session started, and
+<tt>second_to_last_visit</tt> is the time at which the previous session started. This
+state (accessible via the <tt>ad_last_visit_ut</tt> and <tt>ad_second_to_last_visit_ut</tt>
+routines) allows client code to determine which material on the site is new since the
+user's last visit.
+
+<h4>Security</h4>
+
+<p>One really neat thing about properties is that if <tt>secure_p</tt> is true (i.e., the
+<tt>secure_p</tt> flag was passed to <tt>ad_set_client_property</tt> - see below) the
+<tt>ad_get_client_property</tt> routine will refuse to access the information except when the
+connection is secure (HTTPS) and the secure token is correct. So the user can switch back and
+forth between HTTP and HTTPS without giving anything away, and hijackers cannot tamper with
+any state marked secure (even if they're sniffing for tokens). Note that this only works for
+session-level state for the moment - browser-level state isn't protected by any kind of token.
+
+<h3>The API</h3>
+
+<h4>Summary</h4>
+
+<blockquote><pre><b><a href="/doc/proc-one.tcl?proc_name=ad_validate_security_info">ad_validate_security_info</a> [ -secure <i>f</i> ]</a></b>
+
+<b><a href="/doc/proc-one.tcl?proc_name=ad_get_user_id">ad_get_user_id</a></b>
+<b><a href="/doc/proc-one.tcl?proc_name=ad_verify_and_get_user_id">ad_verify_and_get_user_id</a></b> [ -secure <i>f</i> ]
+<b><a href="/doc/proc-one.tcl?proc_name=ad_get_session_id">ad_get_session_id</a></b>
+<b><a href="/doc/proc-one.tcl?proc_name=ad_verify_and_get_session_id">ad_verify_and_get_session_id</a></b> [ -secure <i>f</i> ]
+
+<b><a href="/doc/proc-one.tcl?proc_name=ad_last_visit_ut">ad_last_visit_ut</a></b>
+<b><a href="/doc/proc-one.tcl?proc_name=ad_second_to_last_visit_ut">ad_second_to_last_visit_ut</a></b>
+
+<b><a href="/doc/proc-one.tcl?proc_name=ad_set_client_property">ad_set_client_property</a></b> [ -browser <i>f</i> ] [ -secure <i>f</i> ] [ -deferred <i>f</i> ] [ -persistent <i>t</i> ] <i>module</i> <i>name</i> <i>value</i>
+<b><a href="/doc/proc-one.tcl?proc_name=ad_get_client_property">ad_get_client_property</a></b> [ -browser <i>f</i> ] [ -cache <i>t</i> ] [ -cache_only <i>t</i> ] <i>module</i> <i>name</i></pre></blockquote>
+
+<h4>Description</h4>
+
+<p>The heart of the new security system is <tt><b>ad_validate_security_info</b></tt>, which examines
+the session information (including the user ID), returning 1 if it is valid or 0 if not. This
+procedure takes an optional switch, <tt>-secure</tt>, taking a 
+argument. If <tt>-secure</tt> is true, the session won't be considered valid unless it's
+being conducted over HTTPS, and a valid secure token was provided (useful, e.g., for e-commerce
+applications). Typically client code will call <tt>ad_validate_security_info</tt> before
+doing anything else, redirecting or returning an error message if the session is deemed
+invalid.
+
+The semantics of <tt>ad_get_user_id</tt> and <tt>ad_verify_and_get_user_id</tt> remain the same:
+<tt><b>ad_get_user_id</b></tt> does absolutely no checking that the user ID isn't forged,
+while <tt><b>ad_verify_and_get_user_id</b></tt> makes sure the user is properly logged
+in. Correspondingly, the new routine <tt><b>ad_get_session_id</b></tt> returns a session ID (which may
+be forged), whereas the new routine <tt><b>ad_verify_and_get_session_id</b></tt> first verifies that the
+token is valid. Both <tt>verify</tt> routines take an optional
+<tt>-secure</tt> switch, taking a Boolean (<tt>t</tt>/<tt>f</tt>) argument defaulting to <tt>f</tt>;
+if true, only secure (HTTPS) connections will be considered valid.
+
+<p><tt><b>ad_set_client_property</b></tt> is used to set a session- or browser-level property. It takes
+three arguments: a module name, the name of the property, and the value of the property. In addition,
+the Boolean <tt>-browser</tt> switch, defaulting to <tt>f</tt>, determines whether the property should be
+persistent (i.e., browser-level); and the <tt>-secure</tt> switch, defaulting to <tt>f</tt>, determines
+whether the property should only be transmitted which a valid, secure session is in place. If it is
+supremely
+important that the property be set quickly, with no immediate database access, use <tt>-deferred t</tt>,
+causing the database hit to be deferred until after the HTTP connection is closed (so
+<tt>ad_set_client_property</tt> will return immediately). If the data should
+<i>never</i> be written to the database, use <tt>-persistent f</tt>.
+
+<p><tt><b>ad_get_client_property</b></tt> retrieves a property. It takes two arguments: module name and
+property name. Like <tt>ad_set_client_property</tt> it takes the optional <tt>-browser</tt> switch,
+defaulting to <tt>f</tt>. <tt>ad_get_client_property</tt> maintains a cache; to force the cache to be
+bypassed (in case accuracy is supremely important) specify <tt>-cache f</tt>. If <i>only</i>
+the cache should be queried (a database hit should never be incurred) use <tt>-cache_only t</tt>.
+If the property is
+not marked secure, <tt>ad_get_client_property</tt> does no checking to make sure the session is valid - it is
+the caller's responsibility to do this (usually using <tt>ad_validate_security_info</tt>).
+
+<h3>Future Enhancements</h3>
+
+We plan on modifying these cookies to support clusters of servers, i.e., sharing sessions amongst
+servers in a common domain (<tt>*.arsdigita.com</tt>).
+
+<h3>Credits</h3>
+
+This document (and the new security subsystem) ties together ideas introduced by lots of people,
+including:
+
+<ul>
+<li><a href="mailto:teadams@arsdigita.com">Tracy Adams</a>
+<li><a href="mailto:eveanders@arsdigita.com">Eve Andersson</a>
+<li><a href="mailto:jsc@arsdigita.com">Jin Choi</a>
+<li><a href="mailto:philg@mit.edu">Philip Greenspun</a>
+<li><a href="mailto:kai@arsdigita.com">Kai Wu</a>
+</ul>
+
+Thanks for their help and code!
+
+<hr>
+
+<address><a href="mailto:jsalz@mit.edu">jsalz@mit.edu</a>
\ No newline at end of file
Index: web/openacs/www/doc/security.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/security.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/security.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,228 @@
+<html>
+
+<head>
+<title>Security in ACS</title>
+</head>
+
+<body bgcolor=white text=black>
+
+<h2>Security in ACS</h2>
+
+by <a href="mailto:jsc@arsdigita.com">Jin Choi</a>
+
+<hr>
+
+In order to limit the amount of damage someone exploiting a security
+in ACS can do, it is possible to run AOLserver in a chroot environment
+(see <a
+href="http://www.aolserver.com/documentation/3.0/admin/sec-ch2.htm#8704">http://www.aolserver.com/documentation/3.0/admin/sec-ch2.htm#8704</a>). The
+tricky part to doing this is setting up a root directory that will let
+the Oracle driver find all the files it needs to work.
+
+<h3>Setting up the chroot directory</h2>
+
+In order to keep things simple, we'll use the server directory as the
+new root (let's call it <code>/home/aolserver</code>). We need to recreate
+a few system directories and populate them:
+
+<pre>
+cd /home/aolserver
+mkdir bin dev etc tmp usr var
+
+# Create some device files necessary for Oracle.
+# (The following is Solaris specific.)
+cd dev
+mknod kmem c 13 1
+mknod mem c 13 0
+mknod zero c 13 12
+chmod a+w zero
+
+# Copy necessary files to /etc.
+cd ../etc
+cp /etc/group /etc/hosts /etc/nsswitch.conf /etc/resolv.conf /etc/netconfig .
+grep nsadmin /etc/passwd > passwd
+
+# Create a symlink as /home/aolserver, so we don't have to edit all our
+# .ini files.
+cd ..
+mkdir home
+ln -s . home/aolserver
+
+# Make tmp directory world writable.
+chmod 1777 tmp 
+mkdir var/tmp
+chmod 1777 var/tmp
+
+# Copy rm to bin.
+cp /bin/rm bin
+
+# Copy unzip to usr/bin.
+mkdir usr/bin
+cp /usr/bin/unzip usr/bin
+
+# Copy shared libraries to usr.
+mkdir usr/lib
+cp /usr/lib/*.a /usr/lib/*.so.* usr/lib
+
+# If using the ecommerce module with ImageMagick to do image resizing,
+# copy ImageMagick files if available.
+mkdirhier usr/local/bin
+mkdirhier usr/local/lib
+cp /usr/local/bin/convert usr/local/bin
+cp /usr/local/lib/ImageMagick* usr/local/lib
+
+# Copy timezone files.
+mkdirhier usr/share/lib
+cp -r /usr/share/lib/zoneinfo usr/share/lib
+
+# The page root must also be within the chroot environment.
+mkdir web
+mv /web/servername /home/aolserver/web
+ln -s /home/aolserver/web/servername /web/servername
+
+# Copy necessary Oracle files to new root.
+mkdirhier /home/aolserver$ORACLE_HOME
+cd /home/aolserver$ORACLE_HOME
+(cd $ORACLE_HOME; tar cf - bin dbs lib network ocommon rdbms) | tar xvf -
+</pre>
+
+<h3>Setting up Oracle</h3>
+
+Unfortunately, when running Oracle in dedicated server mode, each
+client process starts up its own server process which requires direct
+access to the data files. This will obviously not work in a chroot
+environment unless all the Oracle data files are contained within the
+chroot directory. This is not desirable and generally not possible.
+
+<p>
+
+One workaround for this is to connect to Oracle through a TCP
+connection. This is by far the easiest to set up. The downside is that
+there is some performance loss going through TCP instead of using IPC.
+To do this, edit <code>$ORACLE_HOME/network/admin/listener.ora</code>
+to add a TCP listener and
+<code>$ORACLE_HOME/network/admin/tnsnames.ora</code> to add a network
+alias for that listener (see the <a
+href="http://oradoc.photo.net/ora81/DOC/network.815/a67440/toc.htm">Net8
+Administrator's Guide</a>, or just use netasst). Then have AOLserver
+use it by putting the network alias as the <code>Datasource</code>
+entry for the connection pool in your server's .ini file.
+
+<p>
+
+If you insist on using IPC, you must configure the database to run in
+multi-threaded server (MTS) mode. Configuring MTS mode can be somewhat
+tricky (see <a
+href="http://oradoc.photo.net/ora81/DOC/server.815/a67772/manproc.htm#1369">this
+doc</a>). In brief, you must:
+<ul>
+
+<li>add the following to your initSID.ora file:
+<pre>
+# Configure MTS for IPC connections and start up one server.
+mts_dispatchers = "(PROTOCOL = IPC)(DISP=1)(mul=OFF)(pool=OFF)(PRES=TTC)"
+mts_max_dispatchers = 5
+mts_servers = 1
+mts_max_servers = 20
+</pre>
+
+<li>Make sure there is an IPC listener configured in listener.ora:
+<pre>
+LISTENER =
+  (DESCRIPTION_LIST =
+    (DESCRIPTION =
+      (ADDRESS = (PROTOCOL = IPC)(KEY = EXTPROC))
+    )
+  )
+
+SID_LIST_LISTENER =
+  (SID_LIST =
+    (SID_DESC = 
+      (SID_NAME = PLSExtProc) 
+      (ORACLE_HOME = /ora8/m01/app/oracle/product/8.1.6) 
+      (PROGRAM = extproc) 
+    ) 
+    (SID_DESC = 
+      (GLOBAL_DBNAME = ora8) 
+      (ORACLE_HOME = /ora8/m01/app/oracle/product/8.1.6) 
+      (SID_NAME = ora8) 
+    ) 
+  )
+</pre>
+
+<li>add a network alias to tnsnames.ora:
+<pre>
+ORA8_IPC =
+  (DESCRIPTION =
+    (ADDRESS_LIST =
+      (ADDRESS = (PROTOCOL = IPC)(KEY = EXTPROC))
+    )
+    (CONNECT_DATA =
+      (SERVICE_NAME = ora8)
+      (SRVR = SHARED)
+    )
+  )
+</pre>
+
+<li>and use that network alias as the datasource in your server's .ini file.
+</ul>
+
+<p>
+
+To put Oracle into MTS mode, you must now restart the Oracle
+server. The listener should be started before the server so that the
+server can register itself properly with the listener. To verify that
+Oracle is in MTS mode, connect to Oracle using "sqlplus
+username/password@ora8_ipc" (substitute the network alias you put in
+tnsnames.ora for ora8_ipc), and run this SQL statement: <code>select
+username, program, server from v$session where
+audsid=userenv('sessionid');</code>. It should return "SHARED" in the
+SERVER column. If it says "DEDICATED" instead, your server is not in
+MTS mode.
+
+<p>
+
+One last problem with running ACS in a chrooted environment is that
+Oracle uses Unix domain socket files for IPC that are created in
+/var/tmp/.oracle. We must replace /var/tmp/.oracle with a symlink to a
+directory underneath the chroot directory. This must only be done with
+Oracle shut down!
+
+<pre>
+cd /home/aolserver
+mkdir var/tmp/.oracle
+chown oracle var/tmp/.oracle
+chmod 777 var/tmp/.oracle
+# Make sure Oracle is not running before you do this next step!
+rm -r /var/tmp/.oracle
+ln -s /home/aolserver/var/tmp/.oracle /var/tmp/.oracle
+</pre>
+
+<p>
+
+A caveat about specifying directories in .ini files: every path must
+be relative to the chroot directory (e.g., /home/nsadmin/foo/bar ->
+/foo/bar), <i>except</i> for AuxConfigdir, which must be an absolute
+path.
+
+<h3>Running AOLserver</h3>
+
+Run AOLserver using <code>/home/aolserver/bin/nsd-oracle -ikc
+/home/aolserver/servername.ini -r /home/aolserver</code> from inittab.
+
+
+<h3>Disk Issues</h3>
+
+Chrooting a server requires that everything related to the running of
+AOLserver reside under a single directory. This may cause problems
+with disk space, since what before was split up onto two directories
+(the server root and the page root) now must go under the same
+directory. One workaround is to mount a separate disk as
+/home/aolserver/web and symlink it to /web.
+
+<hr>
+<address><a href="mailto:jsc.arsdigita.com">jsc@arsdigita.com</a></address>
+
+</body>
+</html>
+
Index: web/openacs/www/doc/server-cluster.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/server-cluster.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/server-cluster.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,89 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Server Clustering</title>
+</head>
+
+<body bgcolor=white>
+<h2>Server Clustering</h2>
+
+part of the <a href="">ArsDigita Community System</a> by by <a href="jsalz@mit.edu">Jon Salz</a>
+
+<hr>
+
+<ul>
+<li>Tcl: /tcl/ad-server-cluster.tcl
+</ul>
+
+<h2>The Problem</h2>
+
+Many heavily-hit sites sit behind load balancers, which means that requests to a particular
+site can be handled by one of several machine conspiring to appear as a single server.
+For instance, requests to <tt>www.foobar.com</tt> might be routed to either <tt>www1.foobar.com</tt>,
+<tt>www2.foobar.com</tt>, or <tt>www3.foobar.com</tt>,
+three physically separate servers which share an Oracle tablespace (and
+hence all the data in ACS).
+
+<p>Many database queries are memoized in individual servers' local memory
+(using the <tt><a href="/doc/proc-one.tcl?proc_name=util_memoize">util_memoize</a></tt> procedures) to minimize fetches from the database.
+When a server updates an item in the database, the
+old item needs to be removed from the server's local cache (using <tt><a href="/doc/proc-one.tcl?proc_name=util_memoize_flush">util_memoize_flush</a></tt>)
+to force a database query the next time this item is accessed. But what happens when:
+
+<ul>
+  <li><tt>www1.foobar.com</tt> does <tt><a href="/doc/proc-one.tcl?proc_name=util_memoize">util_memoize</a> "get_greeble_info 43"</tt> (incurring an actual
+      database lookup, <tt>SELECT * FROM greeble WHERE greeble_id = 43</tt>, and caching the result)
+  <li><tt>www2.foobar.com</tt> does <tt><a href="/doc/proc-one.tcl?proc_name=util_memoize">util_memoize</a> "get_greeble_info 43"</tt> (incurring a
+      database lookup and caching the result)
+  <li><tt>www1.foobar.com</tt> <tt>UPDATE</tt>s the info for greeble #43 and does
+      <tt><a href="/doc/proc-one.tcl?proc_name=util_memoize_flush">util_memoize_flush</a> "get_greeble_info 43"</tt>
+  <li><tt>www2.foobar.com</tt> does <tt><a href="/doc/proc-one.tcl?proc_name=util_memoize">util_memoize</a> "get_greeble_info 43"</tt> (returned a cached
+      value). The old info for greeble #43 hasn't been flushed from its local cache, so the result
+      is outdated!
+</ul>
+
+In general, if any of several servers can
+update an item, the old version of the item can remain in other servers' local caches.
+<a href="http://www.mshonline.com/how/homer/doh.wav">Doh!</a>
+
+<h2>The Solution</h2>
+
+We introduce the concept of a <i>server cluster</i>, a group of look-alike servers sharing an Oracle tablespace.
+To set up a cluster, add the following to the ACS <tt>parameters/yourservername.ini</tt> file on each
+of the servers in the cluster:
+
+<blockquote><pre>; address information for a cluster of load-balanced servers (to enable
+; distributed util_memoize_flushing, for instance). One entry per
+; server; this machine's IP may be included as well
+[ns/server/click/acs/server-cluster]
+; 192.168.16.1 is www1.foobar.com
+ClusterMachine=192.168.16.1
+; 192.168.16.2 is www2.foobar.com
+ClusterMachine=192.168.16.2
+; 192.168.16.3 is www3.foobar.com
+ClusterMachine=192.168.16.3</pre></blockquote>
+
+Now when a server (say, <tt>www1.foobar.com</tt>) invokes
+<tt><a href="/doc/proc-one.tcl?proc_name=util_memoize_flush">util_memoize_flush</a></tt> or <tt><a href="/doc/proc-one.tcl?proc_name=util_memoize_seed">util_memoize_seed</a></tt>, those routines use
+<tt><a href="/doc/proc-one.tcl?proc_name=server_cluster_httpget_from_peers">server_cluster_httpget_from_peers</a></tt>
+to issue an HTTP GET request to all machines in the cluster (omitting the local server):
+
+<ul>
+<li><tt>GET http://www2.foobar.com/SYSTEM/flush-memoized-statement.tcl?statement=<i>tcl-statement</i></tt>
+<li><tt>GET http://www3.foobar.com/SYSTEM/flush-memoized-statement.tcl?statement=<i>tcl-statement</i></tt>
+</ul>
+
+causing the other machines (<tt>www2.foobar.com</tt> and <tt>www3.foobar.com</tt>) to flush the Tcl statement
+from their local caches. This is transparent and works with all existing code.
+
+<p>So don't think about it - just set up the <tt>server-cluster</tt> block in your <tt>yourservername.ini</tt> file,
+and <tt>util_memoize</tt> and friends will be <a href="http://www.mshonline.com/how/homer/woohoo.wav">happy</a>.
+
+<hr>
+
+<a href="mailto:jsalz@mit.edu"><address>jsalz@mit.edu</address></a>
+
+</body>
+</html>
+
+
Index: web/openacs/www/doc/site-wide-search.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/site-wide-search.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/site-wide-search.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,465 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Site-wide Search</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Site-wide Search</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+and Jin Choi
+
+<hr>
+
+<ul>
+<li>User-accessible directory:  <a href="/search/">/search/</a>
+<li>Site administrator directory:  none
+<li>data model :  <a href="/doc/sql/display-sql.tcl?url=/doc/sql/site-wide-search.sql">/doc/sql/site-wide-search.sql</a>
+
+</ul>
+
+<b>Note: this facility requires interMedia version 8.1.5.1, which you can upgrade to via a patch, or Oracle 8.1.6 (not yet available)</b>
+
+
+<h3>The Big Idea</h3>
+
+This is a system for using a full-text search engine bundled with the
+RDBMS, e.g., Oracle Intermedia, to permit site-wide searches with
+results ranked by descending relevance.  So, for example, bulletin board
+postings and classified ads are searched at the same time as static
+.html documents.
+
+<h3>Under the Hood</h3>
+
+We define a <code>site_wide_index</code> table which ties together
+rows from different tables to a single interMedia index column. We use
+the user datastore feature of interMedia which gives us flexibility in
+how we index various tables, and saves us from having to copy text we
+wish to index.
+
+<h3>Deeper Under the Hood</h3>
+
+The main action is 
+
+<blockquote>
+<pre><code>
+create table site_wide_index (
+	table_name	     	varchar(30) not null,
+	the_key		     	varchar(700) not null,
+	one_line_description 	varchar(4000) not null,
+	datastore		char(1) not null, -- place holder for datastore column
+	primary key (table_name, the_key)
+);
+</code></pre>
+</blockquote>
+
+We store the table name from which the content came originally.  We
+also keep a key from that table.  This will typically be an integer
+but it might be character data (e.g., the <code>msg_id</code> from
+<code>bboard</code>).  In some cases, it might be a delimited
+composite key (it is up to the application code to pull this out and
+use it intelligently).  Note that Oracle automatically coerces from
+integer to varchar and therefore we don't have to do anything fancy to
+make queries work in the typical case (where the primary key of the
+fundamental table is an integer).
+
+<p>
+
+We must have the primary key constraint on this index because Oracle
+Intermedia can't deal with any table that doesn't have a primary key.
+
+<p>
+
+We need <code>one_line_description</code> so that we can display a nice
+list of query results to users who do a site-wide search.  If we didn't
+keep this, we'd have to outer join with every possible table that
+contributes to the index or laboriously look up every row with a PL/SQL
+procedure.  And even then we'd need to keep some record of, for each
+table, what was the best way to get a one-line description.
+
+<p>
+
+For consistent site-wide user interface, we keep a table of what the
+table names in the index should be called as far as sections go.  For
+example, the table name for the /bboard module is "bboard" but a
+publisher might wish this presented in a search form as "Discussion
+Forums".  This is done by entering rows in the
+<code>table_acs_properties</code> table, described in 
+<a href="user-profiling.html">the user profiling documentation</a>.  We
+reproduce the table definition here:
+
+<blockquote>
+<pre><code>
+create table table_acs_properties (
+             table_name      varchar(30) primary key,
+             section_name    varchar(100) not null,
+             user_url_stub   varchar(200) not null,
+             admin_url_stub  varchar(200) not null
+);
+</code></pre>
+</blockquote>
+
+The <code>user_url_stub</code> column holds the url necessary to direct the
+user from the search results page to the page with the content.  For
+example, for the discussion forum module, this column would contain 
+"/bboard/redirect-for-sws.tcl?msg_id=".  The search
+results page will append the value of <code>the_key</code> column to
+this URL stub.  
+
+<h3>Triggers that fill the table</h3>
+
+Here's some example PL/SQL code to keep the site-wide index table
+updated for static pages. It is complicated by the need to observe the
+<code>index_p</code> flag, which is used to mark pages which should not
+be indexed.
+
+<p>
+
+Note that the <code>datastore</code> column is just a placeholder; its
+value is unimportant (we just happen to use the letter 'a'). Updating
+this column causes the index to be rebuilt for a row by calling the
+user datastore procedure (see next section).
+
+
+<pre>
+<code>
+create or replace trigger static_pages_sws_insert_tr
+  after insert on static_pages for each row
+BEGIN
+  IF :NEW.index_p = 't' THEN
+     -- we have to create a new row in the index table for this row.
+     insert into site_wide_index (table_name, the_key, one_line_description, datastore)
+       values ('static_pages', :new.page_id, :new.page_title, 'a');
+  END IF;
+END;
+/
+show errors
+  
+
+CREATE OR replace trigger static_pages_sws_update_tr
+  after UPDATE ON static_pages FOR each row
+BEGIN
+  IF :old.index_p = 'f' AND :NEW.index_p = 't' THEN
+     insert into site_wide_index (table_name, the_key, one_line_description, datastore)
+       values ('static_pages', :new.page_id, :new.page_title, 'a');
+  ELSIF :old.index_p = 't' AND :NEW.index_p = 'f' THEN
+     DELETE FROM site_wide_index
+       WHERE table_name = 'static_pages'
+       AND the_key = :old.page_id;
+  ELSIF :NEW.index_p = 't' THEN
+     update site_wide_index 
+       set the_key = :new.page_id, one_line_description = nvl(:new.page_title, '(no title)'), datastore = 'a'
+       where the_key = :old.page_id
+       and table_name = 'static_pages';
+  END IF;
+end;
+/
+show errors
+
+
+CREATE OR replace trigger static_pages_sws_delete_tr
+  after DELETE ON static_pages FOR each row
+BEGIN
+  IF :old.index_p = 't' THEN
+     DELETE FROM site_wide_index
+       WHERE the_key = :old.page_id
+       AND table_name = 'static_pages';
+  END IF;
+END;
+/
+show errors
+
+</code>
+</pre>
+
+<h3>User Datastore Procedure</h3>
+
+This is the heart of the site wide index. This procedure needs to know
+about every section of the ACS which intends to use the site-wide
+search. This example indexes <code>bboard</code> and
+<code>static_pages</code>.
+
+<p>
+
+This procedure is run to gather the text that is to be indexed for any
+row of the <code>site_wide_index</code> table. Its arguments are the
+rowid of the row that it is to retrieve the content for, and a
+temporary clob in which the results are to be stored.
+
+<p>
+
+Different sections can be indexed in different ways. Note that the
+bboard section indexes entire threads into a single entry in the site
+wide index, instead of indexing each message as its own entry.
+
+<p>
+
+The user datastore procedure must be loaded as the ctxsys user, and
+must be granted select access on the tables you want to index
+from. You must grant execute permissions on the user datastore
+procedure to the user who will be using it to create the index.
+
+<pre>
+<code>
+CREATE OR replace procedure sws_user_datastore_proc ( rid IN ROWID, tlob IN OUT nocopy clob )
+IS
+   v_table_name  VARCHAR(30);
+   v_primary_key VARCHAR(700);
+   v_one_line VARCHAR(700);
+   v_static_pages_row photonet.static_pages%ROWTYPE;
+   cursor bboard_cursor(v_msg_id CHAR) IS
+     SELECT one_line, message 
+       FROM photonet.bboard
+       WHERE sort_key LIKE v_msg_id || '%';
+BEGIN
+     -- get various info on table and columns to index
+   SELECT table_name, the_key, one_line_description
+     INTO v_table_name, v_primary_key, v_one_line
+     FROM photonet.site_wide_index
+     WHERE rid = site_wide_index.ROWID;
+   
+   -- clean out the clob we're going to stuff
+   dbms_lob.trim(tlob, 0);
+   
+   -- handle different sections
+   IF v_table_name = 'bboard' THEN
+
+      -- Get data from every message in the thread.
+      FOR bboard_record IN bboard_cursor(v_primary_key) LOOP
+	 IF bboard_record.one_line IS NOT NULL THEN
+	    dbms_lob.writeappend(tlob, length(bboard_record.one_line) + 1, bboard_record.one_line || ' ');
+	 END IF;
+	 dbms_lob.append(tlob, bboard_record.message);
+      END LOOP;
+   ELSIF v_table_name = 'static_pages' THEN
+      SELECT * INTO v_static_pages_row
+	FROM photonet.static_pages
+	WHERE page_id = v_primary_key;
+      
+      IF v_static_pages_row.page_title IS NOT NULL THEN
+         dbms_lob.writeappend(tlob, length(v_static_pages_row.page_title) + 1, v_static_pages_row.page_title || ' ');
+      END IF;
+      dbms_lob.append(tlob, v_static_pages_row.PAGE_BODY);
+   END IF;
+END;
+/
+show errors
+
+grant execute on sws_user_datastore_proc to photonet;
+
+</code>
+</pre>
+
+
+<h3>Querying</h3>
+
+If you just want to find the most relevant documents across the entire
+site:
+
+<blockquote>
+<pre><code>
+select 
+  score(10) as the_score,
+  the_key,
+  one_line_description,
+  map.user_url_stub 
+from site_wide_index swi, table_acs_properties map
+where swi.table_name = map.table_name
+and contains(indexed_stuff,'about($user_entered_query)',10) > 0 
+order by score(10) desc
+</code></pre>
+</blockquote>
+
+Within the discussion forums, you wouldn't bother to join with 
+<code>table_acs_properties</code> since you don't need the URL stub
+and you know what the section is called.  But you'd probably want to 
+join with the bboard table in order to restrict to a particular topic,
+e.g., 
+
+<blockquote>
+<pre><code>
+select 
+  score(10) as the_score,
+  msg_id,
+  one-line,
+  posting_time,
+  topic
+from site_wide_index swi, bboard
+where swi.the_key = bboard.msg_id 
+and swi.table_name = 'bboard'
+and contains(indexed_stuff,'about($user_entered_query)',10) > 0
+order by score(10) desc
+</code></pre>
+</blockquote>
+
+<p>
+
+The <code>about()</code> in the query specifies a theme query, which
+takes the words of the query to be "themes" to search for. Oracle
+has had geniuses locked up for the last several years dividing up the
+English language into a taxonomy of semantic topics. interMedia will
+decide which of these themes your documents are most relevant to, and
+match those up to the words in your query. Leaving out the
+<code>about()</code> gives you a simple word query, which is more like
+what you'd expect.
+
+<p>
+
+In practice, feeding a user entered query directly to interMedia turns
+out to be very bad, because it is expecting queries to be specified
+using their little query language. Any syntactical errors in defining
+a query causes interMedia to cough up an error. This is very easy to
+do, since various punctuation characters and words like "and" are
+special in this query language. We use the PL/SQL function
+<code>im_convert</code> to massage the user input into a form which is
+safe to pass to interMedia, and which performs a combination of text
+search and theme search to try to bring the most relevant documents.
+
+<p>
+
+<code>im_convert()</code> cannot be called directly from within
+<code>contains()</code>, so we must use a separate database query to
+convert the user search string. This may be replaced at a later date
+into a Tcl procedure, to make modifications easier.
+
+<h3>Tcl processing of the results</h3>
+
+Unlike Verity and PLS, ConText doesn't have a good way to refer to
+previous searches and say "give me results 100 through 200 from that
+last search".  Combined with the stateless nature of HTTP, this makes it
+hard to implement the kinds of search user interfaces prevalent at most
+sites (notably AltaVista).  Personally I'm not sorry.  I've always hated
+sites like those.  My personal theory is that the user should get about
+25 highly relevant documents back from a search.  Additional documents
+shouldn't be offered unless they are nearly as relevant as the most
+relevant.  Here's an example of the Tcl code necessary to implement
+this:
+
+<blockquote>
+<pre><code>
+set counter 0 
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+    if { ![info exists max_score] } {
+	# first iteration, this is the highest score
+	set max_score $the_score
+    }
+    if { ($counter &gt; 25) && ($the_score &lt; [expr 0.3 * $max_score] ) } {
+	# we've gotten more than 25 rows AND our relevance score
+	# is down to 30% of what the maximally relevant row was
+	ns_db flush $db
+	break
+    }
+    if { ($counter &gt; 50) && ($the_score &lt; [expr 0.5 * $max_score] ) } {
+	# take a tougher look
+	ns_db flush $db
+	break
+    }
+    if { ($counter &gt; 100) && ($the_score &lt; [expr 0.8 * $max_score] ) } {
+	# take a tougher look yet
+	ns_db flush $db
+	break
+    }
+...
+}
+</code></pre>
+</blockquote>
+
+<p>
+
+The heuristic cutoff in the above procedure has been packaged into the
+Tcl procedure <code>ad_search_results_cutoff</code>.
+
+<h3>For the user who has a PhD in computer science</h3>
+
+Suppose that the user doesn't like the rough results that come back from
+a phrase relevancy query in ConText.  We should give the user an
+opportunity to go into an "advanced search" mode where they can exploit
+the full power of the ConText query language.
+
+<h3>"More Like This"</h3>
+
+interMedia doesn't have a built-in facility for doing query by example
+("give me more documents like this one"), but we can use theme
+searches to build a reasonable facsimile. The Tcl procedure
+<code>ad_search_qbe_get_themes</code> takes a table name and key from
+the site wide index table and returns the top five themes associated
+with that document. Those themes can be used in an
+<code>about()</code> search to find documents about the same themes.
+
+<p>
+
+In practice, the themes returned by interMedia for a document are
+fairly general, and occasionally irrelevant (including things like
+HTML tags). So we throw in the <code>one_line_description</code> as
+part of the query, which seems to do a better job of bringing up
+relevant results. See <code>/search/query-by-example.tcl</code> for an
+example of query by example.
+
+<h3>Using a Separate Search Server</h3>
+
+You may decide you want a separate server to serve up the search
+queries, perhaps for performance reasons, or perhaps because Oracle
+hasn't made available the patch you need to run Oracle on a machine
+with more than 10 IP addresses on the architecture your main server is
+on. The two parameters, <code>BounceQueriesTo</code> and
+<code>BounceResultsTo</code> in the site-wide-search section of your
+parameters file allows you to do this.  <code>BounceQueriesTo</code>
+should be set on your main server, and <code>BounceResultsTo</code>
+set on the search server. This will bounce queries and results back
+and forth for all search pages.
+
+
+<h3>Keeping the index in sync</h3>
+
+If you update a table with a ConText index....  nothing happens.  The
+index doesn't get updated, unlike any other kind of index in the SQL
+world.  There are two ways to update the index:
+
+<ul>
+<li>saddle your Unix system administrator with the task of making sure
+that the ctxsrv process is kept running at all times (this is in
+addition to the six Unix process that constitute a normal Oracle
+installation)
+
+<li>periodically manually sync the index with 
+<code>alter index one_index rebuild parameters('sync');</code>
+</ul>
+
+This module supports both methods.  There is an ad.ini file parameter
+specifying the <code>ns_schedule</code> command to invoke to manually
+sync the index.  If this is left unspecified then it will never happen.
+
+<P>
+
+Another thing that you might have to do periodically is 
+
+<blockquote>
+<pre><code>
+alter index one_index rebuild online 
+parameters('optimize full maxtime 60');
+</code></pre>
+</blockquote>
+
+This gives Oracle one hour (60 minutes) to rebuild an optimized index.
+I'm not quite sure whether this simply means more efficient for query
+time or better (more relevant) results for users.
+
+<h3>If you care about performance</h3>
+
+If you don't want to slow down transactions by building up these clob
+copies of everything, keep the <code>site_wide_index</code> table on a
+separate physical disk drive.  Also try to put the Intermedia index onto
+yet another separate physical disk drive.  Since every disk drive on a
+24x7 server must be mirrored, that means you need four new disk drives
+to implement this glorious module.  If you happen to have two more disk
+drives, use them for the primary key index of the site_wide_index table.
+
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/social-shopping.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/social-shopping.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/social-shopping.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,203 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Social Shopping</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Social Shopping</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+and <a href="http://www.yoon.org">Michael Yoon</a>
+
+<hr>
+
+<ul>
+
+<li>User-accessible directory:  <a href="/social-shopping/">/social-shopping/</a>
+
+<li>Merchant-only pages:  <a href="/social-shopping/merchant/">/social-shopping/merchant/</a>
+<li>Moderator pages:  <a href="/social-shopping/admin/">/social-shopping/admin/</a>
+
+
+<li>Site administrator directory:  <a href="/admin/social-shopping/">/admin/social-shopping/</a>
+<li>data model :  <a href="/doc/sql/display-sql.tcl?url=/doc/sql/social-shopping.sql">/doc/sql/social-shopping.sql</a>
+
+</ul>
+
+<h3>The Big Idea</h3>
+
+People drove me (Philip) insane at photo.net asking shopping questions
+in what was supposed to be a photography technique Q&A forum.  If these
+pinheads had a shopping question, why didn't they call up a frigging
+camera store?
+
+<p>
+
+It hit me: they were terrified of buying the wrong thing.  Photography
+is a strange and technical field.  There are more than 1000 cameras on
+the market and more than 100,000 regularly-sold accessories.  Many times
+the differences between models are insignificant.  Camera manufacturing
+is a 150-year-old industry and most differentiation is simply marketing.
+So the plastic-electronic single-lens-reflex bodies from Canon, Minolta,
+and Nikon will all take the same pictures.  Yet to achieve a particular
+photographic goal, one often needs specialized equipment.  
+
+<p>
+
+<a href="http://photo.net/photo/pcd1765/bearfight-2.tcl"><img hspace=5 vspace=5 align=right HEIGHT=134 WIDTH=196 src="http://photo.net/photo/pcd1765/bearfight-2.1.jpg" ALT="Brooks Falls, Katmai National Park"></a>
+
+
+Consider the photo at right.  It was taken with 300/2.8 lens that costs
+$4500 and is rather too bulky to carry around most of the time.  The
+average camera store will not keep this lens in stock and the clerk will
+be unfamiliar with it.  You can ask his opinion of the alternatives:
+300/4, 400/2.8, 500/4.5, 600/4, 300/2.8 plus 1.4X and 2X
+teleconverters.  The clerk will never have physically handled any of
+these lenses and probably won't know that the 300/2.8 is great for bears
+but too short for birds.
+
+<p>
+
+There are little thousands of weird little accessories in the Nikon and
+Canon SLR lines.  Which cables and connectors do you need to use two
+flashes with a Canon EOS-5?  Even the best camera store might not give
+you the right answer.
+
+<p>
+
+What is needed is the virtual equivalent of the physical store where
+geeks hang out and schmooze.  If you go to real professional camera
+store, you'll often find a shopper conversing as much with fellow
+customers as with the salespeople.  The sales person is best qualified
+to give price and stock information but the other shoppers are often
+better qualified to say whether Item X fits Situation Y.
+
+<h3>The Shopper's Experience</h3>
+
+<ul>
+
+<li>shopper comes to an ACS-backed site and picks a social shopping
+forum (or more likely follows a link in)
+
+<li>shopper clicks on the "ready to buy" link
+
+<li>shopper types in text to explain his or her need and may upload a
+photo or document to elaborate
+
+<li>shopper clicks to agree to a condition of usage:  they promise to
+respond to two questions following their purchase ("How did you like the
+merchant from whom you bought?" and "How did you like the product?")
+
+<li>merchants and other users who've asked for email alerts get mail
+saying "new buyer is on the forum" (with the full text of the shopping
+situation) 
+
+<li>merchants may post offers to supply the goods desired.  If the
+shopper has left some ambiguity in the item desired (the usual
+situation), the merchant will explain exactly what he plans to supply
+and also a written explanation of why he thinks this is the best
+solution for the shopper's problem.  An offer by a merchant is
+immediately emailed to the shopper.  An offer by a merchant may be
+publicly available in the thread depend on how the publisher sets
+policies and what the merchant chooses (if the policy allows a choice). 
+
+<li>other users of the site post suggestions, which are immediately made
+public.  These suggestions are also emailed to the shopper.
+
+</ul>
+
+
+<h3>A Merchant's Private Pages</h3>
+
+In the /social-shopping/merchant/ directory, a merchant will find pages
+that show
+
+<ul>
+<li>summary statistics of offers made, offers accepted, dollar value of
+transactions 
+
+<li>currently open offers (made to shoppers who've not yet made up their
+mind); should be smart enough to exclude shoppers who randomly
+disappeared, e.g., each forum should have a specified number of days
+after which a consumer's shopping quest is considered stale
+
+</ul>
+
+
+<h3>Levels of Moderation/Administration</h3>
+
+The site administrator via the /admin/social-shopping/ directory does
+the following:
+
+<ul>
+<li>decides what social shopping forums will be available on a site,
+e.g., cameras, cars, and computers
+
+<li>decides on the publishing policies in each forum, e.g.,
+merchant_approval_policy
+
+<li>decides which users will get moderation responsibility for each
+forum 
+
+<li>views statistics on forum usage
+
+</ul>
+
+A designated moderator in a particular forum can do the following:
+
+<ul>
+
+<li>approve or disapprove a posting from either a user or a merchant 
+
+<li>edit postings
+
+<li>approve a merchant's application (if the publisher has set the
+policy to require this)
+
+<li>invite a merchant to participate 
+
+</ul>
+
+<h3>Software Engineering</h3>
+
+We build this system on the bones of <a href="bboard.html">the /bboard
+system</a> and <a href="permissions.html">the permissions package</a>.
+We may want to use the ecommerce system as well since it already has a
+way for a user to say "I want to sign up as a retailer" and for multiple
+users to have authority to maintain a retailer's prices and inventory.
+
+<p>
+
+There are two fundamental modes that we have to support:
+
+<ol>
+
+<li>shopper types textual description of what he wants to buy
+(appropriate for photographic equipment shopping where the range of
+products and packages is enormous)
+
+<li>shopper selects item he is considering purchasing from the products
+table in <a href="ecommerce.html">the ecommerce module</a> (appropriate
+for simpler markets, e.g., cars)
+
+</ol>
+
+So I guess we support this with a nullable column that references the
+products table.  The publisher decides for each forum whether it is Mode
+1 or Mode 2 (and if it is Mode 2, what range of stuff from the products
+table should be selectable; you don't want gardening shoppers having to
+wade through cameras or cars).
+
+<p>
+
+For Version 1 of this module, to be applied at photo.net, it is
+sufficient to implement only Mode 1 (textual descriptions).  But leave
+enough hooks in to do Mode 2.
+
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/spam.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/spam.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/spam.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,360 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>/admin/spam system</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>/admin/spam system</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+<ul>
+<li>User directory:  none
+<li>Admin directory:  <a href="/admin/spam/">/admin/spam/</a> 
+<li>Data model:  subsection within 
+<a href="/doc/sql/display-sql.tcl?url=/doc/sql/spam.sql">/doc/sql/spam.sql</a>
+
+<li>Procedures:  within /tcl/spam-daemon.tcl
+<li>Related modules: <a href="email-handler.html">automatic email processing</a>, bulkmail
+</ul>
+
+<h3>The Big Picture</h3>
+
+
+This is a module to be used only by the publisher.  Moreover, it has
+very little user interface of its own: URLs underneath /admin/spam are
+typically only invoked from within /admin/users.  The data model is in
+<a
+href="sql/display-sql.tcl?url=/doc/sql/spam.sql">/doc/sql/spam.sql</a>.
+
+<h3>Under the Hood</h3>
+<P>
+
+<ul>
+<li>we keep a history of all the spam we've sent to users in the
+<code>spam_history</code> table
+<p>
+<li>forms that allow a publisher to spam (e.g.,
+/admin/users/action-choose.tcl) generate a new spam_id for the blank
+form; this way a double click does not result in a spam being sent twice
+(spam is bad enough!)
+<p>
+<li> The spam sending system tries to send email using each users email_type preference
+(from the users_preferences table). You can enter copies of the spam mail message
+formatted as  plain-text, HTML, and AOL-HTML (some HTML subset). The spam sending routine
+will attempt to send the proper format to each user based on their preference. The default
+is plain text.
+<p>
+
+</ul>
+
+<h3>Sending spam from the browser</h3>
+
+ The /admin/spam page has a link
+to send a plain spam message to a class of users, or to send a
+combined plain and HTML message. In both cases you will be given a
+form which asks for a subject line, a target class of users, and a
+date to send the message. The from-address will probably be overridden
+with a machine-generated email address in order to make the automated bounce
+handling scripts work.
+
+<p>
+
+<h3>General Tcl Substitution in Message Body and Subject Line</h3>
+The spam entry forms all have a checkbox labeled <b>Template?</b>. 
+
+If checked, then Tcl evaluator will be run <i>at the time the message
+is actually sent</i> on message subject and body, substituting
+variables or procedure calls wherever \$ and \[\] chars are
+found. This is specially useful for creating automatically generated
+templates, such as a daily report which runs a tcl procedure to query
+the database or create some other summary message.
+<p>
+Note: if you have the <i>Template? </i> option selected, make sure you 
+use backslash to quote any $ or '[]' characters in your message, if you do
+not want them to undergo evaluation by the Tcl parser.
+<p>
+
+<h3>Guessing user's email preferences</h3>
+In the site .ini file, you can set up a list of patterns to be used to
+guess the email type preference of new users, based on their email address.
+<p>
+The param is an association-list, with SQL patterns on the left, and
+pseudo-mime types on the right. Supported types right now are <code>text/html,
+text/html, and text/aol-html</code>.
+
+<pre>
+EmailTypes={%@hotmail.com text/html} {%@aol.com text/aol-html}
+</pre>
+
+<h3>Manually Sending Spam From a File on the Server</h3>
+
+You can schedule a spam which gets its content from files in the file system,
+using the "Post spam from file" link on the admin spam page. It will look
+n the "Drop Zone" directory (described below) for files with the specified names, and 
+send the spam using them as the content to the target user class of your choice.
+
+<p>
+
+<h3>Spam Which Is Sent Automatically: Newsletter Groups</h3>
+
+The spam daemon can send out daily (or any period you want) email to
+groups of users in  designated user classes. There is a configurable list of "daily spam"
+files, accessible from the /admin/spam page via the 
+"View/modify automatic daily spam file settings " link.
+<p>
+Every time you create a new user group, a new user_class will be created to 
+go along with it. You may want to designate a specific group type to be the "Newsletter"
+group type, and then you can make a user self-service subscriptions page, which simply
+adds or removes the user from the groups of type Newsletter. You can then configure
+the Daily Spam Locations admin page to look for content files which correspond to
+the different Newsletter groups. Here is an example of what the admin page
+might look like for sending three types of newsletters; Daily, Weekly, and Special Updates.
+<p>
+<form action="none" method=post>
+<table border=1>
+<tr><td>
+<p>
+<h2>Daily Spam File Locations</h2>
+
+<a href="/pvt/home.tcl">Your Workspace</a> : <a href="/admin/">Admin Home</a> : <a href="index.tcl">Spam</a> : List Daily Spam Files
+
+<hr>
+<p>
+Spam files to look for in drop-zone directory "/web/greentravel-dev/spam/".
+<p>
+To delete an entry, just enter an empty string for the filename and subject, and press the Modify button.
+
+<form action=modify-daily-spam.tcl method=post>
+<table>
+<tr><th>User Class</th>
+<th>Subject</th>
+<th>Filename</th></tr>
+
+    
+<tr><td><select name=user_class_id_0>
+<option value=28>test
+<option value=30>Females
+<option value=31>Archaelogy users
+<option value=41>Gay Tours
+<option value=44>honeymoon
+<option value=45>Homestays
+<option value=46>Great contacts
+<option value=61>A last names
+<option value=62>Last name starts with A
+<option value=81>Old female climbers
+<option value=101>My first query
+<option value=102>Artist
+<option value=122>Cycling Women
+<option value=142>My favorites
+<option value=164>Last name starts with a
+<option value=182>Archeology users
+<option value=202>Testers
+<option value=222>HQM group
+<option value=283>Unusual specials
+<option value=282>Weekly newsletter
+<option value=263 selected>Daily newsletter
+
+</select></td>
+<td><input name=subject_0 type=text value="Greentravel Daily Newsletter for %%DATE%%" size=40></td>
+<td><input name=file_prefix_0 type=text size=24 value="daily"></td></tr>
+
+<tr><td><select name=user_class_id_1>
+<option value=28>test
+<option value=30>Females
+<option value=31>Archaelogy users
+<option value=41>Gay Tours
+<option value=44>honeymoon
+<option value=45>Homestays
+<option value=46>Great contacts
+<option value=61>A last names
+<option value=62>Last name starts with A
+<option value=81>Old female climbers
+<option value=101>My first query
+<option value=102>Artist
+<option value=122>Cycling Women
+<option value=142>My favorites
+<option value=164>Last name starts with a
+<option value=182>Archeology users
+<option value=202>Testers
+<option value=222>HQM group
+<option value=283>Unusual specials
+<option value=282 selected>Weekly newsletter
+<option value=263>Daily newsletter
+
+</select></td>
+<td><input name=subject_1 type=text value="Greentravel Weekly Newsletter for %%DATE%%" size=40></td>
+<td><input name=file_prefix_1 type=text size=24 value="weekly"></td></tr>
+
+<tr><td><select name=user_class_id_2>
+<option value=28>test
+<option value=30>Females
+<option value=31>Archaelogy users
+<option value=41>Gay Tours
+<option value=44>honeymoon
+<option value=45>Homestays
+<option value=46>Great contacts
+<option value=61>A last names
+<option value=62>Last name starts with A
+<option value=81>Old female climbers
+<option value=101>My first query
+<option value=102>Artist
+<option value=122>Cycling Women
+<option value=142>My favorites
+<option value=164>Last name starts with a
+<option value=182>Archeology users
+<option value=202>Testers
+<option value=222>HQM group
+<option value=283 selected>Unusual specials
+<option value=282>Weekly newsletter
+<option value=263>Daily newsletter
+
+</select></td>
+<td><input name=subject_2 type=text value="Greentravel Specials Newsletter for %%DATE%%" size=40></td>
+<td><input name=file_prefix_2 type=text size=24 value="specials"></td></tr>
+
+<tr><td colspan=3>Add new daily spam</tr>
+
+<tr><th>User Class</th>
+<th>Subject</th>
+<th>Filename</th></tr>
+
+<tr><td>
+<select name=user_class_id_3>
+<option value=28>test
+<option value=30>Females
+<option value=31>Archaelogy users
+<option value=41>Gay Tours
+<option value=44>honeymoon
+<option value=45>Homestays
+<option value=46>Great contacts
+<option value=61>A last names
+<option value=62>Last name starts with A
+<option value=81>Old female climbers
+<option value=101>My first query
+<option value=102>Artist
+<option value=122>Cycling Women
+<option value=142>My favorites
+<option value=164>Last name starts with a
+<option value=182>Archeology users
+<option value=202>Testers
+<option value=222>HQM group
+<option value=283>Unusual specials
+<option value=282>Weekly newsletter
+<option value=263>Daily newsletter
+
+</select>
+<td> <input name=subject_3 type=text size=40></td>
+<td><input name=file_prefix_3 type=text size=24></td>
+</tr>
+</table>
+
+<input type=submit value="Modify Spam Entries">
+</form>
+</td></tr></table>
+</form>
+
+<p>
+You can enter the following information for an automatic spam daily message:
+
+<dl>
+<dt>User Class
+<dd> (pulldown menu)
+<dt> Subject
+<dd>Note that you can include the current date in the subject line of
+the spam, by including the string "%%DATE%%" in the subject. 
+
+<dt>File Prefix
+<dd>The filename prefix where you will deposit the new content for periodic mailings.
+</dl>
+
+<p>
+
+<h3>Drop Zone Directory</h3>
+The files should be placed in the "Drop Zone" directory specified by the .ini
+parameter <code>DailySpamDirectory</code>:
+<p>
+
+Example:
+<pre>
+DailySpamDirectory=/home/johnny/spam
+</pre>
+
+For each spam defined in the Daily Spam list, the system will look for
+the following files:
+
+<pre>
+<i>file_prefix</i>-MM-DD-YYYY
+<i>file_prefix</i>
+</pre>
+<font color=red>Note: Be sure to always use two-digits for Month and Day fields, i.e.,
+03-06-1999. Don't forget the leading zeros.</font>
+<p>
+
+If a file whose name matches with the specified prefix and the current
+day's date is found, the contents are queued up to be sent as spam to
+the designated target user class.
+<p>
+The spam system will only send a dated spam once. It keeps a history of
+all spams sent, and will be robust across server restarts. If the server
+is restarted in the middle of sending a spam, the spam daemon will resume
+sending where it left off in the list of users.
+<p>
+<h4><font color=red>Be very careful with filenames that have no date suffix!</font></h4>
+
+If you use a filename with no date suffix, the spam will be sent once a day
+from the file. This behavior is designed to support a special case spam
+for new users, where the user class contains a magic query  like
+<pre>
+select user_id from users where trunc(registration_date)=trunc(sysdate-1) 
+</pre>
+which is carefully constructed to  always select a mutually exclusive set  of users each day, and never repeat the same user twice.
+
+<p>
+<h3>HTML and AOL content types</h3>
+Some users will have designated preferred MIME types for email via the
+users_preferences table. Currently we support HTML and AOL types in addition
+to plain text. If you create auxiliary files with the names
+<pre>
+<i>file_prefix</i>-html-MM-DD-YYYY
+<i>file_prefix</i>-aol-MM-DD-YYYY
+</pre>
+Then content from these files will be sent preferentially to users who have
+their email types preferences set in the database.
+<p>
+
+<h3>Setting the .ini Parameters</h3>
+
+Here is a summary of the .ini params you will need
+<pre> 
+[ns/server/yourserver/acs/spam]
+
+; Pairs of {email_addr_pattern pseudo-mime-type}
+EmailTypes={%@hotmail.com text/html} {%@aol.com text/aol-html}
+DailySpamDirectory=/web/yourserver/spam
+SpamRobotFromAddress=email-robot@yourdomain.com
+</pre>
+
+<h3>BulkMail</h3> By default the spam system uses the built-in
+AOLserver ns_sendmail routine. This is adequate for low volume
+mailings, but if you need to send mail to more than about 500 users,
+then it has serious limitations. A high-performance module called
+<i>bulkmail</i> which has a multi-threaded mail client which can talk
+to multiple mail servers concurrently, and can generate the QMAIL
+style VERP return addresseses to make automatic bounce handling
+possible. This will soon be available as part of the core ACS
+distribution, and the spam module will have an option to use this as
+the mail transport rather than sendmail.
+<p>
+For more info on the configuration of bulkmail and qmail, see <a href=bulkmail.html>bulkmail and qmail configuration</a>
+
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+<br><a href=mailto:hqm@arsdigita.com><address>hqm@arsdigita.com</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/standards.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/standards.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/standards.adp	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,350 @@
+<%
+#
+# /www/doc/standards.adp
+#
+# ACS standards
+#
+# michael@arsdigita.com, March 2000
+#
+# standards.adp,v 3.3.2.5 2000/03/17 08:29:54 michael Exp
+#
+
+proc proc_doc_link { proc_name } {
+    return "<a href=\"proc-one?[export_url_vars proc_name]\"><code>$proc_name</code></a>"
+}
+%>
+<html>
+<head>
+
+<title>Standards</title>
+<style type="text/css">
+BODY {
+  background-color: #FFFFFF;
+  color: #000000;
+}
+</style>
+
+</head>
+
+<body>
+
+<h2>Standards</h2>
+
+for the <a href=""">ArsDigita Community System</a>
+
+<hr>
+
+To ensure consistency (and its collateral benefit, maintainability),
+we define and adhere to standards in the following areas:
+
+<ul>
+<li><a href="#file_naming">File Naming</a>
+<li><a href="#file_header">File Headers</a>
+<li><a href="#page_input">Page Input</a>
+<li><a href="#page_construction">Page Construction</a>
+<li><a href="#tcl_library">Tcl Library</a>
+<li><a href="#data_modeling">Data Modeling</a>
+<li><a href="#tcl_library_file">Documentation</a>
+</ul>
+
+<a name="file_naming"><h3>File Naming</h3></a>
+
+Under the page root (and the template root if using the <a
+href="style">Style package</a>):
+
+<ul>
+
+<li>For naming files that enable a specific action on an object, use
+the convention:
+
+<blockquote>
+<code><em>object_type</em>-<em>verb</em>.<em>extension</em></code>
+</blockquote>
+
+For example, the page to erase a user's portrait from the database is
+<code>/admin/users/portrait-erase.tcl</code>.
+
+<p>
+
+<li>For naming files that display the properties of one object (rather
+than letting the user take a specific action), simply omit the verb,
+and use the convention:
+
+<blockquote>
+<code><em>object_type</em>.<em>extension</em></code>
+</blockquote>
+
+For example, the page to view the properties of an
+<href="ecommerce">ecommerce</a> product is
+<code>/ecommerce/product.tcl</code>.
+
+<p>
+
+<li>Typically, a module deals with one primary type of object, e.g.,
+the Bookmarks module deals mainly with bookmarks. Since the user pages
+for the Bookmarks module live in the <code>/bookmarks/</code>
+directory, it would be redundant to name the page for editing a
+bookmark <code>bookmark-edit.tcl</code> (which would result in the URL
+<code>bookmarks/bookmark-edit.tcl</code>. Instead, we omit the object
+type, and use the convention:
+
+<blockquote>
+<code><em>verb</em>.<em>extension</em></code>
+</blockquote>
+
+Thus, the page to edit a bookmark is <code>/bookmarks/edit.tcl</code>.
+
+<p>
+
+<li>Similarly, for naming files that display the properties of one
+primary-type object, use the convention:
+
+<blockquote>
+<code>one.<em>extension</em></code>
+</blockquote>
+
+For example, the page to view one bookmark is
+<code>/bookmarks/one.tcl</code>.
+
+<p>
+
+<li>For naming files in a page flow, use the convention:
+
+<p>
+
+<ul>
+<li><code><em>foobar</em>.<em>extension</em></code> (Step 1)
+<li><code><em>foobar</em>-2.<em>extension</em></code> (Step 2)
+<li>...
+<li><code><em>foobar</em>-<em>N</em>.<em>extension</em></code> (Step N)
+</ul>
+
+<p>
+
+where <code><em>foobar</em></code> is determined by the above
+rules.
+
+<p>
+
+Typically, we build three-step page flows:
+
+<p>
+
+<ol>
+
+<li>Present a form to the user
+
+<li>Present a confirmation page to the user
+
+<li>Perform the database transaction, then redirect
+
+</ol>
+
+<p>
+
+<li>Put data model files in <code>/www/doc/sql</code>, and name them
+using the convention:
+
+<blockquote>
+<code><em>module</em>.sql</code>
+</blockquote>
+
+</ul>
+
+In the Tcl library directory:
+
+<ul>
+
+<li>For files that contain module-specific procedures, use the
+convention:
+
+<blockquote>
+<code><em>module</em>-procs.tcl</code>
+</blockquote>
+
+<li>For files that contain procedures that are part of the core ACS,
+use the convention:
+
+<blockquote>
+<code>ad-<em>description</em>-procs.tcl</code>
+</blockquote>
+
+</ul>
+
+<h3>URLs</h3>
+
+File names also appear <em>within</em> pages, as linked URLs and
+form targets. When they do, always use <a href="abstract-url">abstract
+URLs</a> (e.g., <code>user-delete</code> instead of
+<code>user-delete.tcl</code>), because they enhance maintainability.
+
+<p>
+
+Similarly, when linking to the index page of a directory, do not
+explicitly name the index file (<code>index.tcl</code>,
+<code>index.adp</code>, <code>index.html</code>, etc.). Instead, use
+just the directory name, for both relative links
+(<code>subdir/</code>) and absolute links
+(<code>/top-level-dir/</code>). If linking to the directory in which
+the page is located, use the empty string (<code>""</code>), which
+browsers will resolve correctly.
+
+<a name="file_header"><h3>File Headers</h3></a>
+
+Include the standard header in all source files:
+
+<blockquote>
+<pre><code>
+# <em>path from server home</em>/<em>filename</em>
+#
+# <em>Brief description of the file's purpose</em>
+#
+# <em>author's email address</em>, <em>file creation date</em>
+#
+# <a href="http://www.loria.fr/~molli/cvs/doc/cvs_12.html#SEC93">&#36;Id&#36;</a>
+</code></pre>
+</blockquote>
+
+<p>
+
+Of course, replace "<code>#</code>" with the comment delimiter
+appropriate for the language in which you are programming, e.g.,
+"<code>--</code>" for SQL and PL/SQL.
+
+<p>
+
+Previously, the standard for headers in files under the page root was
+to specify a path relative to the page root, e.g.
+<code>/index.tcl</code>, unlike all other files in the ACS, where the
+path was relative to the server home directory,  e.g.
+<code>/tcl/bboard-defs.tcl</code>. The current standard eliminates
+this inconsistency, so that the path in every file header (under the
+page root or not) is relative to the server home directory:
+<code>/www/index.tcl</code> instead of <code>/index.tcl</code>.
+
+<a name="page_input"><h3>Page Input</h3></a>
+
+In addition to the standard file header, each page should start by:
+
+<ol>
+
+<li>specifying the input it expects (in essence, its parameter list)
+with a call to <%= [proc_doc_link ad_page_variables] %>
+(which supersedes <%= [proc_doc_link set_the_usual_form_variables] %>)
+
+<li>validating its input with a call to <%= [proc_doc_link page_validation] %>
+(which supersedes <%= [proc_doc_link ad_return_complaint] %>)
+
+</ol>
+
+<a name="page_construction"><h3>Page Construction</h3></a>
+
+Construct the page as one Tcl variable (name it
+<code>page_content</code>), and then send it back to the browser with
+one call to <code>ns_return</code>. Make sure to release any database
+handles (and any other acquired resources, e.g., filehandles) before
+the call.
+
+<p>
+
+For example:
+
+<blockquote>
+<pre>set db [ns_db gethandle]
+
+set page_content "[ad_header "<em>Page Title</em>"]
+
+&lt;h2&gt;<em>Page Title</em>&lt;/h2&gt;
+
+&lt;hr&gt;
+
+&lt;ul&gt;
+"
+
+set selection [ns_db select $db <em>sql</em>]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    append page_content "&lt;li&gt;<em>row information</em>\n"
+}
+
+append page_content "&lt;/ul&gt;
+
+[ad_footer]"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $page_content
+</pre>
+</blockquote>
+
+<p>
+
+Previously, the convention was to call <code>ReturnHeaders</code> and
+then <code>ns_write</code> for each distinct chunk of the page. This
+approach has the disadvantage of tying up a scarce and valuable
+resource (namely, a database handle) for an unpredictable amount of
+time while sending packets back to the browser, and so, it is to be
+avoided in most cases. (On the other hand, for a page that requires an
+expensive database query, it's better to call
+
+<%= [proc_doc_link ad_return_top_of_page] %>
+
+first, so that the user is not left to stare at an empty page while
+the query is running.)
+
+<p>
+
+Local procedures (i.e., procedures defined and used only within one
+page) should be prefixed with "<code><em>module</em>_</code>" and
+should be used rarely, only when they are exceedingly useful.
+
+<p>
+
+All files that prepare HTML to display should end with [ad_footer] or
+[<em>module</em>_footer].  If your module requires its own footer,
+this footer should call ad_footer within it.  Why?  Because when we
+adopt the ACS to a new site, it is often the case that the client will
+want a much fancier display than ACS standard.  We like to be able to
+edit ad_header (which quite possibly can start a &lt;table&gt;) and
+ad_footer (which may need to end the table started in ad_footer) to
+customize the look and feel of the entire site.
+
+<a name="tcl_library_file"><h3>Tcl Library Files</h3></a>
+
+After the file header, the first line of each Tcl library file should
+be a call to <%= [proc_doc_link util_report_library_entry] %>.
+
+<p>
+
+The last line of each Tcl library file should be a call to
+<%= [proc_doc_link util_report_successful_library_load] %>.
+
+<p>
+
+Under discussion; will include: proc naming conventions
+
+<a name="data_modeling"><h3>Data Modeling</h3></a>
+
+Under discussion; will include: standard columns, naming conventions
+for constraints.
+
+<a name="doc"><h3>Documentation</h3></a>
+
+Under discussion.
+
+</font>
+
+<hr>
+
+<a href="mailto:michael@arsdigita.com">
+<address>michael@arsdigita.com</address>
+</a>
+
+<a href="mailto:aure@arsdigita.com">
+<address>aure@arsdigita.com</address>
+</a>
+
+</body>
+</html>
Index: web/openacs/www/doc/static.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/static.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/static.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,47 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Static File Support</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Static File Support</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+<ul>
+
+<li>User-accessible directory:  <a href="/comments/">/comments/</a>, 
+<a href="/links/">/links/</a>
+
+<li>Site administrator directory:  <a href="/admin/static/">/admin/static/</a>
+
+<li>data model :  within <a href="/doc/sql/display-sql.tcl?url=/doc/sql/community-core.sql">/doc/sql/community-core.sql</a>
+<li>Tcl procs:  /tcl/ad-html.tcl; /tcl/ad-user-content-map.tcl; 
+
+</ul>
+
+<h3>The Big Idea</h3>
+
+Is explained fairly thoroughly in Chapter 3 of 
+<cite>Philip and Alex's Guide to Web Publishing</cite>.
+
+
+<h3>The Medium-size Idea</h3>
+
+Copy all the .html files on the server into an Oracle table.  Give each
+one a unique ID.  Collect comments and related links on each .html
+page.  Display these in-line via the procedures in /tcl/ad-html.tcl
+
+<p>
+
+The filter in /tcl/ad-user-content-map.tcl records which users have
+examined which .html files.
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/style-one.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/style-one.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/style-one.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,41 @@
+# style-one.tcl,v 3.0 2000/02/06 03:37:05 ron Exp
+# style-one.tcl
+#
+# documented at least by philg@mit.edu on July 2, 1999
+# written by jsc@arsdigita.com, Jan 25 2000
+
+# prints out information and source code on a defined site-wide style
+
+ns_share ad_styletag
+ns_share ad_styletag_source_file
+
+set_form_variables
+# style_name
+
+ns_return 200 text/html "[ad_admin_header "One Style"]
+<h2>One Style</h2>
+
+defined in $ad_styletag_source_file($style_name), part of the
+<a href=\"styles.tcl\">style module</a> of the ArsDigita Community System
+
+<hr>
+
+This page shows the available information on one style defined using <code>ad_register_styletag</code>.
+
+<h3>$style_name</h3>
+
+<blockquote>
+
+$ad_styletag($style_name)
+
+</blockquote>
+
+Source code:
+<pre>
+[philg_quote_double_quotes [info body ad_style_$style_name]]
+</pre>
+
+[ad_admin_footer]
+"
+
+
Index: web/openacs/www/doc/style.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/style.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/style.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,411 @@
+<html>
+<head>
+<!--AD_DND-->
+<title>Establishing Style and Supporting Multi-Lingualism</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+
+<h2>Establishing Style and Supporting Multi-Lingualism</h2>
+
+using <a href="index.html">the ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a> 
+
+<hr>
+
+<ul>
+<li>User-accessible directory:  none
+<li>Site administrator directory:  none (<a
+href="styles.tcl">/doc/styles.tcl</a> is as close as it gets)
+<li>data model :  none; entirely Tcl- and virtual memory-based
+<li>Tcl scripts:  /tcl/ad-style.tcl
+<li>style definitions:  by convention in /tcl/sitename-styles.tcl
+<li>Templates:  /web/yourservername/templates/
+
+</ul>
+
+This document explains how to establish site-wide style and presentation
+conventions.  A core element of the system is AOLserver's ADP template
+parsing system.
+
+<h3>The Big Problem</h3>
+
+Here are some of the challenges that we need to attack:
+
+<ul>
+
+<li>consistent look and style conventions across thousands of
+pages
+
+<li>publishers who change their mind about how the site should look
+
+<li>users who are browsing on a simple device (e.g., Nokia 9000 cell
+phone) and need a text-only site
+
+<li>users who can't read English (even though it was good enough for
+Jesus Christ)
+
+</ul>
+
+<h3>Some Trivial Solutions</h3>
+
+Suppose that you simply want consistent look and feel, changeable by
+editing only one file, across thousands of dynamic pages:
+
+<ul>
+
+<li>edit the ad.ini file to set site background and text colors (these
+parameters are read by <code>ad_header</code>)
+
+<li>bash the source code for <code>ad_header</code> in /tcl/ad-defs.tcl
+to do something more dramatic (e.g., display a company logo at the top
+right of each page).
+
+<li>bash the source code for <code>ad_footer</code> in /tcl/ad-defs.tcl
+to do something consistent at the bottom of all the pages on a site
+
+</ul>
+
+What about static HTML pages?  You can put <code>regsub</code> calls in
+<code>ad_serve_html_page</code> (in /tcl/ad-html.tcl) to consistently
+change the appearance of outgoing pages.
+
+<p>
+
+If you're building from scratch, you could build in ADP instead of HTML
+and use <code>ns_register_adptag</code> to augment the HTML a bit.
+
+<h3>Some Trivial Solutions in a Perfect World</h3>
+
+In a perfect world, you'd modify <code>ad_header</code> or your static
+HTML to reference a cascading style sheet (CSS).  See <a
+href="http://photo.net/wtr/thebook/html.html">the HTML chapter of
+<cite>Philip and Alex's Guide to Web Publishing</cite></a> for an
+explanation and also do a View Source on the document to see a style
+sheet reference from the HEAD of a document.
+
+<p>
+
+This doesn't work out too great because (1) only the 4.0 browsers
+interpret style sheets, and (2) Brand M and Brand N browsers do very
+different things given the same instructions (each implements a subset
+of the CSS standard).
+
+<h3>Why These Trivial Solutions Won't Work for You</h3>
+
+Publishers and the designers they hire want to control much more than
+background, text, alink, and vlink colors.  They want to move around the
+elements on each page.
+
+<p>
+
+So what's the big deal?  Let them write whatever HTML they want.
+
+<p>
+
+The problem is that they want control over pages that are generated by
+querying the database and executing procedures but they don't want to
+learn how to program.  Your naive solution is to let the designers build
+static HTML files and show them to you.  You'll work these elements into
+Tcl string literals and write programs that print them to the browser.
+In the end you'll have programs that query the database and produce
+output exactly like what the designer wanted... on Monday.  By Friday,
+the designer has changed his or her mind.  Would you rather spend your
+life attacking the hard problem of Web-based collaboration or moving
+strings around inside .tcl pages?
+
+
+<h3>Templates</h3>
+
+Suppose that you send your staff the following message:
+
+<blockquote>
+<pre>
+To: Web Developers
+
+I want you to put all the SQL queries into Tcl functions that get loaded
+at server start-up time.  The graphic designers are to build ADP pages
+that call a Tcl procedure which will set a bunch of local variables with
+values from the database.  They are then to stick <%=$variable_name=> in
+the ADP page wherever they want one of the variables to appear.
+
+Alternatively, write .tcl scripts that implement the "business logic"
+and, after stuffing a bunch of local vars, call ns_adp_parse to drag in
+the ADP created by the graphic designer.
+</pre>
+</blockquote>
+
+In future, a change to the look of a site won't require a programmer,
+only someone who knows HTML and who is careful enough not to disturb
+references to variables.
+
+<h3>Putting It All Together</h3>
+
+Putting it all together in an ArsDigita Community System-based site:
+
+<ul>
+
+<li>We define a set of styles using
+<code>ad_register_styletag</code>. This procedure will (a) record that
+we've got a style we want to use site-wide, (b) register an ADP tag, and
+(c) create a Tcl function to be used by straight .tcl pages (and that is
+also called by the ADP subsystem)
+
+<li>We create a convention that /www/foo/bar.tcl looks for ADP templates
+at /templates/foo/bar.*
+
+<li>We create a /style section in the ad.ini file to specify whether or
+not plain and fancy templates are available ("foobar.plain.adp" and
+"foobar.fancy.adp"), whether or not we're trying to be multilingual, and
+what language is our system default ("foobar.plain.en.adp" for English,
+"foobar.fancy.fr.adp" for a French graphics version).
+
+</ul>
+
+
+Why are the templates stored under a separate directory structure than
+the .tcl scripts?  Isn't this inconvenient?  Yes, if you're one person
+maintaining a site.  However, the whole point of this system is that a
+bunch of programmers and designers are collaborating.  The programmers
+will probably be happier if the designers never get FTP access to the
+directories containing .tcl scripts.  Also, from a security point of
+view, if someone is going to upload files to your server via FTP, you
+don't want them ending up directly underneath the Web server root.
+
+<p>
+
+Caveat nerdor:  remember that AOLserver sources private Tcl libraries
+alphabetically.  So your calls to <code>ad_register_styletag</code> must
+be in a Tcl file that sorts alphabetically after "ad-style.tcl" (we
+suggest that you stick to a convention of "sitename-styles.tcl", e.g.,
+"photonet-styles.tcl" would be the photo.net styles).
+
+<h3>How we represent languages</h3>
+
+Languages are represented by lowercase ISO 639 two-character
+abbreviations, e.g., "en" for English, "km" for Cambodian, "ja" for
+Japanese (<em>not</em> "jp" as you might expect; jp is the country code
+for Japan, not the language code for the Japanese language).  For a
+complete list, check your Netscape preferences (click on "languages" and
+then try to add one), visit <a
+href="http://www.w3.org/International/O-charset-lang.html">http://www.w3.org/International/O-charset-lang.html</a>,
+
+or refer to this list below (we're not going to make sure that it is
+kept up to date, so you might want to visit the source).
+
+<p>
+
+<TABLE ALIGN="CENTER">
+<TR><TH>Language Name</TH><TH>Code</TH><TH>Language Family</TH></TR>
+<TR><TD>Abkhazian</TD><TH>ab</TH><TD>Ibero-Caucasian</TD></TR>
+<TR><TD>Afan (Oromo)</TD><TH>om</TH><TD>Hamitic</TD></TR>
+<TR><TD>Afar</TD><TH>aa</TH><TD>Hamitic</TD></TR>
+<TR><TD>Afrikaans</TD><TH>af</TH><TD>Germanic</TD></TR>
+<TR><TD>Albanian</TD><TH>sq</TH><TD>Indo-european (other)</TD></TR>
+<TR><TD>Amharic</TD><TH>am</TH><TD>Semitic</TD></TR>
+<TR><TD>Arabic</TD><TH>ar</TH><TD>Semitic</TD></TR>
+<TR><TD>Armenian</TD><TH>hy</TH><TD>Indo-european (other)</TD></TR>
+<TR><TD>Assamese</TD><TH>as</TH><TD>Indian</TD></TR>
+<TR><TD>Aymara</TD><TH>ay</TH><TD>Amerindian</TD></TR>
+<TR><TD>Azerbaijani</TD><TH>az</TH><TD>Turkic/altaic</TD></TR>
+<TR><TD>Bashkir</TD><TH>ba</TH><TD>Turkic/altaic</TD></TR>
+<TR><TD>Basque</TD><TH>eu</TH><TD>Basque</TD></TR>
+<TR><TD>Bengali;bangla</TD><TH>bn</TH><TD>Indian</TD></TR>
+<TR><TD>Bhutani</TD><TH>dz</TH><TD>Asian</TD></TR>
+<TR><TD>Bihari</TD><TH>bh</TH><TD>Indian</TD></TR>
+<TR><TD>Bislama</TD><TH>bi</TH><TD>[notgiven]</TD></TR>
+<TR><TD>Breton</TD><TH>br</TH><TD>Celtic</TD></TR>
+<TR><TD>Bulgarian</TD><TH>bg</TH><TD>Slavic</TD></TR>
+<TR><TD>Burmese</TD><TH>my</TH><TD>Asian</TD></TR>
+<TR><TD>Byelorussian</TD><TH>be</TH><TD>Slavic</TD></TR>
+<TR><TD>Cambodian</TD><TH>km</TH><TD>Asian</TD></TR>
+<TR><TD>Catalan</TD><TH>ca</TH><TD>Romance</TD></TR>
+<TR><TD>Chinese</TD><TH>zh</TH><TD>Asian</TD></TR>
+<TR><TD>Corsican</TD><TH>co</TH><TD>Romance</TD></TR>
+<TR><TD>Croatian</TD><TH>hr</TH><TD>Slavic</TD></TR>
+<TR><TD>Czech</TD><TH>cs</TH><TD>Slavic</TD></TR>
+<TR><TD>Danish</TD><TH>da</TH><TD>Germanic</TD></TR>
+<TR><TD>Dutch</TD><TH>nl</TH><TD>Germanic</TD></TR>
+<TR><TD>English</TD><TH>en</TH><TD>Germanic</TD></TR>
+<TR><TD>Esperanto</TD><TH>eo</TH><TD>Internationalaux.</TD></TR>
+<TR><TD>Estonian</TD><TH>et</TH><TD>Finno-ugric</TD></TR>
+<TR><TD>Faroese</TD><TH>fo</TH><TD>Germanic</TD></TR>
+<TR><TD>Fiji</TD><TH>fj</TH><TD>Oceanic/indonesian</TD></TR>
+<TR><TD>Finnish</TD><TH>fi</TH><TD>Finno-ugric</TD></TR>
+<TR><TD>French</TD><TH>fr</TH><TD>Romance</TD></TR>
+<TR><TD>Frisian</TD><TH>fy</TH><TD>Germanic</TD></TR>
+<TR><TD>Galician</TD><TH>gl</TH><TD>Romance</TD></TR>
+<TR><TD>Georgian</TD><TH>ka</TH><TD>Ibero-caucasian</TD></TR>
+<TR><TD>German</TD><TH>de</TH><TD>Germanic</TD></TR>
+<TR><TD>Greek</TD><TH>el</TH><TD>Latin/greek</TD></TR>
+<TR><TD>Greenlandic</TD><TH>kl</TH><TD>Eskimo</TD></TR>
+<TR><TD>Guarani</TD><TH>gn</TH><TD>Amerindian</TD></TR>
+<TR><TD>Gujarati</TD><TH>gu</TH><TD>Indian</TD></TR>
+<TR><TD>Hausa</TD><TH>ha</TH><TD>Negro-african</TD></TR>
+<TR><TD>Hebrew</TD><TH>iw</TH><TD>Semitic</TD></TR>
+<TR><TD>Hindi</TD><TH>hi</TH><TD>Indian</TD></TR>
+<TR><TD>Hungarian</TD><TH>hu</TH><TD>Finno-ugric</TD></TR>
+<TR><TD>Icelandic</TD><TH>is</TH><TD>Germanic</TD></TR>
+<TR><TD>Indonesian</TD><TH>in</TH><TD>Oceanic/indonesian</TD></TR>
+<TR><TD>Interlingua</TD><TH>ia</TH><TD>Internationalaux.</TD></TR>
+<TR><TD>Interlingue</TD><TH>ie</TH><TD>Internationalaux.</TD></TR>
+<TR><TD>Inupiak</TD><TH>ik</TH><TD>Eskimo</TD></TR>
+<TR><TD>Irish</TD><TH>ga</TH><TD>Celtic</TD></TR>
+<TR><TD>Italian</TD><TH>it</TH><TD>Romance</TD></TR>
+<TR><TD>Japanese</TD><TH>ja</TH><TD>Asian</TD></TR>
+<TR><TD>Javanese</TD><TH>jv</TH><TD>Oceanic/indonesian</TD></TR>
+<TR><TD>Kannada</TD><TH>kn</TH><TD>Dravidian</TD></TR>
+<TR><TD>Kashmiri</TD><TH>ks</TH><TD>Indian</TD></TR>
+<TR><TD>Kazakh</TD><TH>kk</TH><TD>Turkic/altaic</TD></TR>
+<TR><TD>Kinyarwanda</TD><TH>rw</TH><TD>Negro-african</TD></TR>
+<TR><TD>Kirghiz</TD><TH>ky</TH><TD>Turkic/altaic</TD></TR>
+<TR><TD>Kurundi</TD><TH>rn</TH><TD>Negro-african</TD></TR>
+<TR><TD>Korean</TD><TH>ko</TH><TD>Asian</TD></TR>
+<TR><TD>Kurdish</TD><TH>ku</TH><TD>Iranian</TD></TR>
+<TR><TD>Laothian</TD><TH>lo</TH><TD>Asian</TD></TR>
+<TR><TD>Latin</TD><TH>la</TH><TD>Latin/greek</TD></TR>
+<TR><TD>Latvian;lettish</TD><TH>lv</TH><TD>Baltic</TD></TR>
+<TR><TD>Lingala</TD><TH>ln</TH><TD>Negro-african</TD></TR>
+<TR><TD>Lithuanian</TD><TH>lt</TH><TD>Baltic</TD></TR>
+<TR><TD>Macedonian</TD><TH>mk</TH><TD>Slavic</TD></TR>
+<TR><TD>Malagasy</TD><TH>mg</TH><TD>Oceanic/indonesian</TD></TR>
+<TR><TD>Malay</TD><TH>ms</TH><TD>Oceanic/indonesian</TD></TR>
+<TR><TD>Malayalam</TD><TH>ml</TH><TD>Dravidian</TD></TR>
+<TR><TD>Maltese</TD><TH>mt</TH><TD>Semitic</TD></TR>
+<TR><TD>Maori</TD><TH>mi</TH><TD>Oceanic/indonesian</TD></TR>
+<TR><TD>Marathi</TD><TH>mr</TH><TD>Indian</TD></TR>
+<TR><TD>Moldavian</TD><TH>mo</TH><TD>Romance</TD></TR>
+<TR><TD>Mongolian</TD><TH>mn</TH><TD>[notgiven]</TD></TR>
+<TR><TD>Nauru</TD><TH>na</TH><TD>[notgiven]</TD></TR>
+<TR><TD>Nepali</TD><TH>ne</TH><TD>Indian</TD></TR>
+<TR><TD>Norwegian</TD><TH>no</TH><TD>Germanic</TD></TR>
+<TR><TD>Occitan</TD><TH>oc</TH><TD>Romance</TD></TR>
+<TR><TD>Oriya</TD><TH>or</TH><TD>Indian</TD></TR>
+<TR><TD>Pashto;pushto</TD><TH>ps</TH><TD>Iranian</TD></TR>
+<TR><TD>Persian</TD><TH>(farsi)</TH><TD>Fairanian</TD></TR>
+<TR><TD>Polish</TD><TH>pl</TH><TD>Slavic</TD></TR>
+<TR><TD>Portuguese</TD><TH>pt</TH><TD>Romance</TD></TR>
+<TR><TD>Punjabi</TD><TH>pa</TH><TD>Indian</TD></TR>
+<TR><TD>Quechua</TD><TH>qu</TH><TD>Amerindian</TD></TR>
+<TR><TD>Rhaeto-romance</TD><TH>rm</TH><TD>Romance</TD></TR>
+<TR><TD>Romanian</TD><TH>ro</TH><TD>Romance</TD></TR>
+<TR><TD>Russian</TD><TH>ru</TH><TD>Slavic</TD></TR>
+<TR><TD>Samoan</TD><TH>sm</TH><TD>Oceanic/indonesian</TD></TR>
+<TR><TD>Sangho</TD><TH>sg</TH><TD>Negro-african</TD></TR>
+<TR><TD>Sanskrit</TD><TH>sa</TH><TD>Indian</TD></TR>
+<TR><TD>Scots</TD><TH>gaelic</TH><TD>Gdceltic</TD></TR>
+<TR><TD>Serbian</TD><TH>sr</TH><TD>Slavic</TD></TR>
+<TR><TD>Serbo-croatian</TD><TH>sh</TH><TD>Slavic</TD></TR>
+<TR><TD>Sesotho</TD><TH>st</TH><TD>Negro-african</TD></TR>
+<TR><TD>Setswana</TD><TH>tn</TH><TD>Negro-african</TD></TR>
+<TR><TD>Shona</TD><TH>sn</TH><TD>Negro-african</TD></TR>
+<TR><TD>Sindhi</TD><TH>sd</TH><TD>Indian</TD></TR>
+<TR><TD>Singhalese</TD><TH>si</TH><TD>Indian</TD></TR>
+<TR><TD>Siswati</TD><TH>ss</TH><TD>Negro-african</TD></TR>
+<TR><TD>Slovak</TD><TH>sk</TH><TD>Slavic</TD></TR>
+<TR><TD>Slovenian</TD><TH>sl</TH><TD>Slavic</TD></TR>
+<TR><TD>Somali</TD><TH>so</TH><TD>Hamitic</TD></TR>
+<TR><TD>Spanish</TD><TH>es</TH><TD>Romance</TD></TR>
+<TR><TD>Sundanese</TD><TH>su</TH><TD>Oceanic/indonesian</TD></TR>
+<TR><TD>Swahili</TD><TH>sw</TH><TD>Negro-african</TD></TR>
+<TR><TD>Swedish</TD><TH>sv</TH><TD>Germanic</TD></TR>
+<TR><TD>Tagalog</TD><TH>tl</TH><TD>Oceanic/indonesian</TD></TR>
+<TR><TD>Tajik</TD><TH>tg</TH><TD>Iranian</TD></TR>
+<TR><TD>Tamil</TD><TH>ta</TH><TD>Dravidian</TD></TR>
+<TR><TD>Tatar</TD><TH>tt</TH><TD>Turkic/altaic</TD></TR>
+<TR><TD>Telugu</TD><TH>te</TH><TD>Dravidian</TD></TR>
+<TR><TD>Thai</TD><TH>th</TH><TD>Asian</TD></TR>
+<TR><TD>Tibetan</TD><TH>bo</TH><TD>Asian</TD></TR>
+<TR><TD>Tigrinya</TD><TH>ti</TH><TD>Semitic</TD></TR>
+<TR><TD>Tonga</TD><TH>to</TH><TD>Oceanic/indonesian</TD></TR>
+<TR><TD>Tsonga</TD><TH>ts</TH><TD>Negro-african</TD></TR>
+<TR><TD>Turkish</TD><TH>tr</TH><TD>Turkic/altaic</TD></TR>
+<TR><TD>Turkmen</TD><TH>tk</TH><TD>Turkic/altaic</TD></TR>
+<TR><TD>Twi</TD><TH>tw</TH><TD>Negro-african</TD></TR>
+<TR><TD>Ukrainian</TD><TH>uk</TH><TD>Slavic</TD></TR>
+<TR><TD>Urdu</TD><TH>ur</TH><TD>Indian</TD></TR>
+<TR><TD>Uzbek</TD><TH>uz</TH><TD>Turkic/altaic</TD></TR>
+<TR><TD>Vietnamese</TD><TH>vi</TH><TD>Asian</TD></TR>
+<TR><TD>Volapuk</TD><TH>vo</TH><TD>Internationalaux.</TD></TR>
+<TR><TD>Welsh</TD><TH>cy</TH><TD>Celtic</TD></TR>
+<TR><TD>Wolof</TD><TH>wo</TH><TD>Negro-african</TD></TR>
+<TR><TD>Xhosa</TD><TH>xh</TH><TD>Negro-african</TD></TR>
+<TR><TD>Yiddish</TD><TH>ji</TH><TD>Germanic</TD></TR>
+<TR><TD>Yoruba</TD><TH>yo</TH><TD>Negro-african</TD></TR>
+<TR><TD>Zulu</TD><TH>zu</TH><TD>Negro-african</TD></TR>
+</TABLE>
+
+<p>
+
+What about language variants, e.g., British English versus correct
+English?  The standard way to handle variants is with suffixes, e.g.,
+"zh-CN" and "zh-TW" for Chinese from China and Taiwan respectively, 
+"en-GB" and "en-US" for UK and US English, "fr-CA" and "fr-FR" for
+Quebecois and French French.  We think this is cumbersome and can't
+imagine anyone wanting to have templates named
+"foobar.fancy.en-US.adp".  Our system doesn't require that the
+two-character coding be ISO-standard.  A publisher who wished to serve
+British and American readers could use "gb" and "us", for example.
+Non-standard?  Yes.  But in my defence, let me note that if you've flown
+over to England in an aeroplane, gone out in a mackintosh with a brolly,
+rotted your teeth on fairy cakes with coloured frosting, you probably
+have worse problems that non-standard file names.
+
+<h3>How we pick the right template</h3>
+
+At the end of /foo/bar.tcl, release your database handle (good practice;
+this way other threads can reuse it while AOLserver is streaming bytes
+out to your client) and then call <code>ad_return_template</code>.
+
+<p>
+
+If you need to set a cookie, bash <code>ns_conn outputheaders</code>.
+
+<p>
+
+How does <code>ad_return_template</code> work?  It goes up one Tcl
+level so that it can have access to all the local vars that bar.tcl
+might have set.  Then it looks at the user's language and graphics
+preferences (from the <code>users_preferences</code> defined in
+community-core.sql).  Then it looks in the templates subtree of the file
+system to see what the closest matching template is (language preference
+overrides graphics preference).
+
+<p>
+
+Note that <code>ad_return_template</code> returns headers and content
+bytes to the connection but does not terminate the thread.  So you can
+do logging or other database activity following the service of the
+parsed ADP template to the user.
+
+<h3>Standard Cookie Names</h3>
+
+If you're supporting registered users, you'll be pulling graphics and
+language preferences from <code>users_preferences</code>.  You might
+want to offer casual users a choice of languages or graphics
+complexity (see <a href="http://scorecard.org">scorecard.org</a> for an
+example).  In this case, you need to use cookies to record what the user
+said he or she wanted.
+
+<p>
+
+It is tough to know how and where the publisher will want to present
+users with language and graphics options.  But we can build standard Tcl
+API calls into /tcl/ad-style.tcl if we agree to standardize on cookie
+names.  So let's agree on the same names as the columns in
+<code>users_preferences</code>: "prefer_text_only_p" (value "t" or "f")
+and "language_preference" (two-char lowercase code).
+
+<p>
+
+Note that the code in ad-style.tcl will only look for cookies if 
+PlainFancyCookieP and LanguageCookieP parameters are turned on.
+
+
+<hr>
+
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+
+
+</body>
+</html>
Index: web/openacs/www/doc/styles.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/styles.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/styles.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,98 @@
+# styles.tcl,v 3.0 2000/02/06 03:37:06 ron Exp
+# page that shows all the defined styles
+# in the system
+
+ns_share ad_styletag
+ns_share ad_styletag_source_file
+
+# we assume that we get a list of lists, each one containing
+# {proc_name filename} (i.e., a Tcl list in its own right)
+
+proc procs_tcl_sort_by_first_element {l1 l2} {
+    set first_comparison [string compare [lindex $l1 0] [lindex $l2 0]]
+    if { $first_comparison != 0 } {
+	return $first_comparison
+    } else {
+	return [string compare [lindex $l1 1] [lindex $l2 1]]
+    }
+}
+
+proc procs_tcl_sort_by_second_element {l1 l2} {
+    set first_comparison [string compare [lindex $l1 1] [lindex $l2 1]]
+    if { $first_comparison != 0 } {
+	return $first_comparison
+    } else {
+	return [string compare [lindex $l1 0] [lindex $l2 0]]
+    }
+}
+
+set_form_variables 0
+
+# maybe sort_by  (defaults to sorting by filename)
+
+ReturnHeaders
+
+ns_write "
+[ad_header "Defined Styles"]
+
+<h2>Defined Styles</h2>
+
+in this installation of the ArsDigita Community System
+
+<hr>
+
+This page lists those styles that the programmers have defined
+using <code>ad_register_styletag</code> (defined in /tcl/ad-style.tcl).
+
+
+<p>
+
+"
+
+set list_of_lists [list]
+
+foreach style_name [array names ad_styletag] {
+    lappend list_of_lists [list $style_name $ad_styletag_source_file($style_name)]
+}
+
+if { [info exists sort_by] && $sort_by == "name" } {
+    set sorted_list [lsort -command procs_tcl_sort_by_first_element $list_of_lists]
+    set headline "Styles by Name"
+    set options "or sort by <a href=\"styles.tcl?sort_by=filename\">source file name</a>"
+} else {
+    # by filename
+    set sorted_list [lsort -command procs_tcl_sort_by_second_element $list_of_lists]
+    set headline "Styles by source filename"
+    set options "or sort by <a href=\"styles.tcl?sort_by=name\">name</a>"
+}
+
+ns_write "
+
+<h3>$headline</h3>
+
+$options
+
+<ul>
+"
+
+set last_filename ""
+foreach sublist $sorted_list {
+    set style_name [lindex $sublist 0]
+    set filename [lindex $sublist 1]
+    if { [info exists sort_by] && $sort_by == "name"} {
+	ns_write "<li><a href=\"style-one.tcl?style_name=[ns_urlencode $style_name]\">$style_name</a> (defined in $filename)"
+    } else {
+	# we're doing this by filename
+	if { $filename != $last_filename } {
+	    ns_write "<h4>$filename</h4>\n"
+	    set last_filename $filename
+	}
+	ns_write "<li><a href=\"style-one.tcl?style_name=[ns_urlencode $style_name]\">$style_name</a>\n"
+    }
+}
+
+ns_write "
+</ul>
+
+[ad_admin_footer]
+"
Index: web/openacs/www/doc/survey-simple.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/survey-simple.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/survey-simple.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,145 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Survey (Simple)</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Survey (Simple)</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+<ul>
+<li>User-accessible directory:  <a href="/survsimp/">/survsimp/</a>
+<li>Module administrator directory:  <a href="/survsimp/admin/">/survsimp/admin/</a>
+<li>Site administrator directory:  <a href="/admin/survsimp/">/admin/survsimp/</a>
+<li>data model :  <a href="/doc/sql/display-sql.tcl?url=/doc/sql/survey-simple.sql">/doc/sql/survey-simple.sql</a>
+<li>Tcl procs:  /tcl/survey-simple-defs.tcl
+<li>Configuration parameters: none
+</ul>
+
+<h3>The Big Idea</h3>
+
+We want to be able to survey users.  We want a non-technical person to
+be able to design surveys from HTML forms.  We want someone who is not
+a site-admin to be able to review answers (via the module
+administration directory).
+
+
+<h3>Division of Labor</h3>
+
+A site-wide administrator gets to decide which surveys are enabled or
+not enabled.  A module admin gets to build surveys (which started off
+disabled by default) and edit them.  The module admin also gets to
+review answers (as above). Module admins are designated by adding them
+to the "Simple Survey System Staff" administration group.
+
+
+<h3>Survey Question Possibilities</h3>
+
+Each survey question specifies an abstract data type for responses:
+
+<ul>
+
+<li>boolean
+<li>number
+<li>integer
+<li>shorttext (less than 4000 characters)
+<li>text
+<li>choice 
+
+</ul>
+
+Each survey also specifies a presentation type:
+
+<ul>
+<li>textbox
+<li>textarea (size can be specified in
+<code>presentation_options</code>)
+<li>select (from a fixed set of options in <code>survsimp_question_choices</code>)
+<li>radio (from a fixed set of options in <code>survsimp_question_choices</code>)
+<li>checkbox (from a fixed set of options in <code>survsimp_question_choices</code>)
+
+</ul>
+
+<h3>The data model</h3>
+
+We use the following tables:
+
+<ul>
+<li><code>survsimp_questions</code> -- questions for each survey
+<li><code>survsimp_surveys</code> -- specs for one survey form (except the questions)
+<li><code>survsimp_responses</code> -- user responses to surveys 
+<li><code>survsimp_question_responses</code> -- user responses to
+individual questions within a survey
+
+</ul>
+
+The philosophy about storing the users responses is to use one single
+Oracle table to store all responses, i.e., we do not create a new table
+when we create a new survey.  In order to make it possible to store all
+kinds of data in one table, we give the
+<code>survsimp_question_responses</code> table five columns.
+
+<blockquote>
+<pre><code>
+	-- if the user picked a canned response
+	choice_id		references survsimp_question_choices,
+	boolean_answer		char(1) check(boolean_answer in ('t','f')),
+	clob_answer		clob,
+	number_answer		number,
+	varchar_answer		varchar(4000),
+</code></pre>
+</blockquote>
+
+Only one of the columns will be not-null.
+
+<p>
+
+Why the CLOB in addition to the varchar?  The CLOB is necessary when
+people are using this system for proposal solicitation (people might
+type more than 4000 characters).  
+
+<h3>User Interface</h3>
+
+The user interface for creating a survey is as follows:
+<ol>
+<li>User creates a survey, giving it a name and a description.
+<li>User adds questions one by one, and is given the opportunity to reorder questions.
+
+<li>To add a question, user first types in the question and selects
+its presentation type (radio buttons, checkbox, text field, etc.).
+<li>Then the user is given the opportunity to specify further
+attributes for the question depending upon the presentation type that
+was chosen. For instance, any "choice" presentation (radio buttons,
+checkboxes, and select lists) require a list of choices. A text field
+requires the user to specify an abstract data type and the size of the
+input field.
+</ol>
+
+<h3>Parameters</h3>
+
+This module requires no section in /parameters/ad.ini !
+
+
+
+<h3>The Future</h3>
+
+This entire system should be superseded by a more glorious one that
+Buddy Dennis of UCLA (his PhD apparently isn't helping him get this ACS
+module finished) has developed.  That's why we call this the "simple"
+survey module.
+
+<P>
+
+If Buddy never gets his act together, we should add a feature to this
+system whereby a multiple-choice question can solicit a typed-in "Other"
+answer as well.
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/templating-etc.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/templating-etc.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/templating-etc.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,166 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>templating, forms, navigation, etc.</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+
+<h2>templating, forms, navigation, etc.</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+This document was written on February 28, 2000.  It reflects months of
+wrangling with trying to find the right abstractions for a whole range
+of stuff including
+
+<ul>
+
+<li>separation of programmers from graphic design changes
+
+<li>distributing authoring and editing out to non-technical people
+
+<li>changing site-wide look and feel by making a change in one place
+
+<li>standardizing the presentation for entry/editing and validation of
+elements in the database
+
+<li>taking the next step in multi-lingualism beyond <a
+href="style.html">the June 1999 system</a> (i.e., "getting English
+annotation out of programs" or "letting a designer pull multiple rows
+out of a datasource and annotate each row with some local language")
+
+<li>getting beyond HTML output; people using cell phones to visit an
+ACS-backed site will certainly not want the complex HTML pages produced
+by ArsDigita's customer's designers and they may not want HTML at all!
+(e.g., they might raw XML info; certainly co-brand partners will want
+just the XML)
+
+
+</ul>
+
+Here are some good high-level goals:
+
+<ul>
+
+<li>programmers should be able to work in a standard text editor, such
+as Emacs, rather than using a database + Web forms approach
+
+<li>if they so choose, programmers should be able to stick to a
+rat-simple everything-in-one-file approach a la Perl CGI, AOLserver
+.tcl, AOLserver ADP, Microsoft ASP, Java Server Pages (JSP); for simple
+stuff it is often much much easier to debug a system where you don't
+have to chase down four separate files to find the code
+
+<li>we should not have to do a major port of all modules of the ACS at
+once and yet we may want all the modules to be able to take advantage of
+at least some of the new services and abstractions
+
+<li>we should not rely on the template builder to personalize a page or
+screen out information for which the connected user does not have
+permission; no data should be available to the template unless the
+connected user is authorized to view those data 
+ 
+<li>we should not create our own language(s); Creating a new language
+requires also creating a tremendous amount of ancillary tools (e.g.,
+debuggers), educational materials, etc.  Consider that Microsoft has
+never created a new language!  IBM has not done so since the 1960s
+(PL/I; they did Fortran in the 1950s).  Sun has done one (Java).  In the
+Web world, the only company that has come close to establishing a new
+language is Allaire with Cold Fusion.  Cold Fusion has not been
+well-received by professional programmers or anyone attacking new
+challenges.
+
+<li><b>#1 most important goal:</b> if we have powerful abstractions for
+encapsulating decisions made about overall site look, navigation, etc.,
+these abstractions should be available to developers programming in any
+style (.tcl, .adp, Java inside Oracle, .tcl producing XML, fancy
+templating, etc.).  One should not have to buy into any one particular
+development style in order to take advantage of the abstractions.
+
+</ul>
+
+<h3>Development Styles that We Want to Support</h3>
+
+
+<ul>
+
+<li>a .tcl page producing a complete HTML document 
+
+<li>a .tcl page producing an HTML fragment, intended to be wrapped in a
+site-wide or section-wide master template 
+
+<li>a .tcl page producing a plain text document (to be served with MIME
+type of plain/text)
+
+<li>a .tcl page producing an XML document, which will later be rendered
+with a style sheet (XSL or our own thing) if the client does not want to
+accept XML
+
+<li>a .adp page that evaluates to a complete HTML document
+
+<li>a .adp page that includes lots of other .adp files and then
+evaluates to a complete HTML document (this is the AOL/DigitalCity
+method of development)
+
+<li>a Karl-style .spec file that produces a data structure to be
+rendered with a Karl-style augmented ADP template (breaks the "no
+creating new languages" rule above, but Cynthia and Karl like it)
+
+
+</ul>
+
+<h3>Form Generation and Processing</h3>
+
+We need metadata inside Oracle (so that it is available to all clients,
+whether AOLserver or other) that, for any column in the database says
+
+<ul>
+<li>what its pretty name is
+
+<li>how it is to be presented to the user for form input (e.g., text
+box, textarea, radio buttons)
+
+<li>if a radio button or checkbox presentation, what the legal choices
+are (the survey-simple.sql data model may be useful here)
+
+<li>what validity tests are to be performed on the user's input (it
+would be nice to use an interpreted language like Tcl here so that we
+are fully general but probably it is best to restrict ourselves to
+things that can be easily evaluated within Java within Oracle)
+
+</ul>
+
+We need a full Java API to these metadata, e.g., "give me the empty
+form" or "give me a form stuffed with the user's previous entries" or
+"validate these inputs for me".
+
+<p>
+
+For data that we're trying to collect from the users, we need a little
+language in which to express
+
+<ul>
+
+<li>the user needs to be asked to give us particular info (either
+table/column or something more abstract like "home_address") before
+performing some operation
+
+<li>the user needs to be forced to give us particular info (either
+table/column or something more abstract like "home_address") before
+performing some operation
+
+</ul>
+
+Note that the "user needs to be asked" implies that we have some kind of
+log so that we don't keep reasking a question that the user has refused
+to answer.  We want a full PL/SQL or Java API to this stuff.
+
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/ticket-project.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/ticket-project.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/ticket-project.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,235 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Remote project administration</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Remote project administration</h2>
+
+via a <a href="ticket.html">online ticket tracker</a>
+by <a href="http://teadams.com">Tracy Adams</a>
+
+<hr>
+
+<h3>The Big Picture</h3>
+
+We want a standard process for virtual project administration.
+
+
+<h3>The Medium Picture</h3>
+
+There are countless bug tracking systems. If fact, 
+most developers have either coded at least one themselves 
+or swear behind the feature set of one particular tool.
+Remember, however, it is the process behind the system 
+that is the key to success.
+<p>
+
+The need for structured communication heightens when clients 
+and developers do not work in the same location.
+Lack of a standard system is prone will result in a chaos caused by
+a pile of emails intertwined with various phone conversations no one 
+seems to recall in quite the same way...
+<p>
+<h3>The Cornerstone: Status</h3>
+
+The status of bug or issue determines who is in control.  
+Either the initiator or developer, but not both,
+is in responsible for issues in each state. 
+Typically, the initiator of most issues are the client.
+<p>
+<ul>
+<li><b>Status = "Need clarification" ---> Initiator's responsibility</b>
+<p>
+The developer is stuck and needs instruction from the client.
+The initiator should respond to issues and change the status to "open"
+so work can continue.
+<p>
+<li><b>Status = "Fixed waiting approval" ---> Initiator's responsibility</b>
+<p>
+The initiator has the final say in what is acceptable and therefore
+has the privilege of closing the issue.
+The ball is in the initiator's  court to either close the 
+issue or make a comment and reopen the issue.
+<p>
+
+<li><b>Status = "Open" ---> Developer's responsibility</b>
+<p>
+The developer is in charge of getting this issue done.  When the issue
+is fixed, the developer makes a note and sets the status to "fixed waiting approval".
+If the developer gets stuck, the developer makes a note and sets the status
+to "needs clarification".
+</ul>
+
+<h3>Case study</h3>
+
+<ol>
+<li> Client enters an issue: 
+<blockquote>
+<i>Message</i>: The edit comment page doesn't work right.<br>
+<i>Status</i>: <b>Open</b>
+</blockquote>
+<li> Developers assigned to the project receives an alert. The developer responds with a comment and changes the status:
+<blockquote>
+Comment: Please give a step-by-step outline describing what 
+you are experiencing.<br>
+<i>Status:</i> <b>Need Clarification</b>
+</blockquote>
+
+<li> Client receives an alert. Client adds a comment and changes the status.
+
+<blockquote>
+<i>Comment</i>: 
+I logged in as myself. I was on http://arsdigita.com/vision.html .
+I clicked on edit under my first comment. I changed the title from "I LUV
+this vision" to "I love this vision" and pressed Submit.  When I looked at the page with all the comments, the change was not there.<br>
+<i>Status</i>: <b>Open</b>
+</blockquote>
+
+<li> Developer receives an alert and fixes the issue. The developer adds a comment and a changes the status.
+<blockquote>
+<i>Comment</i>: I've edited /general-comments/edit-comment-2.tcl to update the comment
+title in the database.  You should now be able to run your example successfully.<br>
+<i>Status</i>: <b>Fixed waiting approval</b>
+</blockquote>
+
+<li> Client receives an alert and comes back to check. He decides that it is not quite right. Client adds a comment and changes the status.
+<blockquote>
+<i>Comment</i>:  Oh yeah, instead of saying "Submit", I'd like the button 
+on http://my-service.com/comments/edit-comment.tcl to say "Edit Comment".<br>
+<i>Status</i>: <b>Open</b>
+</blockquote>
+
+<li> Developer receives an alert and fixes the problem. Developer adds a comment and changes the status.
+
+<blockquote>
+<i>Comment</i>: I've edited /general-comments/edit-comment.tcl so that the button says "Edit Comment" instead of "Submit"<br>
+<i>Status</i>: <b>Fixed Waiting Approval</b>
+</blockquote>
+
+<li> Client receives an alert, checks, and  decides he is satisfied.  Client closes the issue.
+<blockquote>
+<i>Status</i>: <b>Closed</b>
+</blockquote>
+</ul>
+</ol>
+
+
+<h3>Useful habits</h3>
+
+<ul>
+<li> Use the ticket tracker for all assignments and discussions.
+Make projects to catalog different types of interactions such as "emergencies",
+"ongoing", "discussions", etc.  This will build up a central source of documentation as well tracking assignments.
+<p>
+<li> Be careful to assign appropriate users to each project so they will receive email alerts as people add issues and make comments.
+<p>
+<li> Use the ticket tracker as replacement to sending email to each other.  
+Entering or commenting on an issue will send alerts to the relevant people.
+<p>
+<li> Whenever you change a status, always enter a comment.  
+Note URLs that have changed and files you touched. 
+The project members will get alerted when there is something to view
+and will know what to look for.
+</ul>
+
+
+<h3>Enforcing the law</h3>
+
+This system only works if everyone uses it. 
+In the beginning of a project, make an  
+effort to teach clients and co-workers the process.
+<p>
+From time to time, the process will go astray.  You
+will get a solitary email with some tasks.  This is
+the time to reinforce proper use of the system.
+<p>
+You'll come to develop a style of your own to do this, but here are a few
+templates to get you started.
+
+<ul>
+<li> Philip Greenspun template:
+<blockquote>
+<pre>
+
+Is there any reason we are not using the 
+on-line collaboration system that we have been perfecting 
+since 1994?  "The Book" 
+(<a href="http://photo.net/wtr/thebook">Philip and Alex's Guide to Web Publishing</a>) 
+will give you an idea of  how ArsDigita operates in just 
+17 chapters.
+
+Philip
+up late cranking out my next book
+</pre>
+</blockquote>
+<li> Tracy Adams template:
+<blockquote>
+<pre>
+Please put this in the ticket tracker.
+
+Thank you,
+Tracy
+</pre>
+</blockquote>
+<li> Michael Yoon template:
+
+<blockquote>
+<pre>
+Thank you for writing. I am confirming that I have received 
+your email and I will investigate how  to fix this 
+issue. I am sorry I haven't executed what you need and 
+will try my best to rectify the situation.
+
+Perhaps I can suggest that we use the ticket tracking system
+that is set up your staff server.  I was thinking that this 
+would allow you to see and comment on any questions or 
+concerns you have about this issue at any time.
+
+I've added this issue to the system for you and made sure it
+appears as your entry. This will ensure you get  
+automatic email responses of any notes that are made.
+
+Just to be sure we are on the page, here is exactly what I did:
+<ul>
+<li> Going to http://your-servicename.com
+<li> Logged in
+<li> Clicked "ticket tracker administration" from the workspace
+<li> Clicking "add and issue"
+<li> Filled out the form with your instructions and hit submit
+</ul>
+
+Please take a look when you have a moment, and let me know if 
+you think the user interface is sufficiently clear. 
+Any suggestions on how to improve it are, of course, welcome.
+
+Hope this helps,
+Michael
+</pre>
+</blockquote>
+
+</ul>
+
+<h3>Testimonials</h3>
+
+<blockquote>
+<pre>
+"I live in the ticket tracker."
+  Atiasaya - GuideStar
+</pre>
+</blockquote>
+<blockquote>
+<pre>
+"I LOVE the ticket tracker."
+   Sheila - Infirmation <i>(personally posted 350
+   tickets in a 2 week period)</i>
+</pre>
+</blockquote>
+
+
+<hr>
+<a
+href="mailto:teadams@arsdigita.com"><address>teadams@arsdigita.com</a>
+</body>
+</html>
Index: web/openacs/www/doc/ticket.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/ticket.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/ticket.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,178 @@
+<html>
+  <!--AD_DND-->
+  <head>
+    <title>/ticket system</title>
+  </head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>/ticket system</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://teadams.com">Tracy Adams</a>, 
+<a href=mailto:hqm@arsdigita.com>Henry Minsky</a>, 
+<a href=mailto:davis@arsdigita.com>Jeff Davis</a>
+
+<hr>
+
+<ul>
+<li>User-accessible directory:  <a href="/ticket/">/ticket/</a>
+<li>Ticket system administration directory:  <a href="/ticket/admin/">/ticket/admin/</a>
+<li>Site administrator directory:  <a
+href="/admin/ticket/">/admin/ticket/</a> <em>(empty)</em>
+<li>data model :  <a href="/doc/sql/display-sql.tcl?url=/doc/sql/ticket.sql">/doc/sql/ticket.sql</a>
+<li><a href=ticket-project.html>Remote project administration</a> using this module
+</ul>
+
+<h3>The big picture</h3>
+Software occasionally has bugs.  The ticket system is designed to 
+to record and track tasks, bugs, and feature requests.  The intent 
+is to have clearly defined responsibilities for tickets in every state
+and to have auto-notification capabilities which ensure 
+that no ticket slips through the cracks. 
+
+<h3>The medium picture</h3>
+The new version is much more configurable and intended to support
+centralized tracking of multiple projects. Also, there are a number
+of new features to facilitate recording higher quality data on 
+web development projects in particular.  There is an interface
+into the ticket tracker which allows creating a link on each page
+for submitting a ticket which will record the user-agent, originating
+URL, and originating query.  
+<p>
+Additionally, there are two ticket entry modes: "feedback," which
+hides all the complexity of the ticket tracker, and "full," which
+allows all fields to be set.  Feedback mode is suitable for a feedback 
+link in the footer of user oriented pages (and will also record 
+user-agent and other data). 
+<p>
+To see the feedback entry mode and the enhanced information tracking visit 
+the "Feedback" link in the top right of the Administration screen.
+
+<h3>User Model</h3>
+Project and Feature areas are owned by groups.  Tickets can only be
+assigned to users who are members of the owning group of the Feature Area.
+Tickets can be private to projects or to Feature Areas (depending 
+on whether the "Public" flag is set) and will only be visible if the
+user is a member of either the owning group of the project or feature area.
+This restriction may also be applied on a per ticket basis.
+<p>
+Ticket Administration is carried out by members of the group <code>Ticket Admin Staff</code>,
+whose responsibilities include creating new projects and feature areas,
+project permissioning, and default ticket assignments per
+project/feature area. Adding a user to the <code>Ticket Admin Staff</code> group (group type 
+<code>Administration</code>) gives the user full access to all tickets 
+and ticket system administration capabilities.
+<p>
+
+<h3>Creating a Project</h3> 
+
+<ul>
+<li> Create the necessary feature areas for the project via "create new
+feature area" in the admin screen. <blockquote><em>note that feature areas can 
+be assigned to multiple projects so that it is not necessary to create 
+multiple "System Administration" feature areas unless the staffing 
+for System Administration was different between projects.</em></blockquote>
+<li> Create the project and assign an owning group.
+<ul>
+<li> Chose short and long titles.  Short titles are typically used in
+    tables while long titles are in reports and select boxes.  These 
+    can be changed later without impacting pre-existing tickets.
+<li> The current "version" string is stored with each ticket when it
+    is created.
+<li> Choose the "code set" that defines the all the ticket state codes 
+    (severity, cause, status, etc.)  In a base install there will 
+    only be one "code set" and currently there is no admin 
+    interface for defining new code sets and the "ad" code set 
+    defines the standard set used within ArsDigita.
+<li> Decide whether the tickets should be public (visible to any
+    registered user) or only to project members.
+<li> You may enter a long textual description of the project which 
+    will be displayed with the project on the new ticket creation
+    screen.
+<li> You then can assign feature areas explicitly or just use the same 
+    set as another project.
+<li> Finally you may enter a new ticket template to guide user's data
+    entry.  For example, for a development project this might be
+    something like:
+    <blockquote><pre>
+PROBLEM STATEMENT:
+
+STEPS TO REPRODUCE:
+
+FOUND IN VERSIONS:
+
+</pre>
+</blockquote>
+</ul>
+<li> Assign users to the owning group of the project and to the owning 
+groups of the assigned feature areas (note that for small teams these can actually be the same group).
+<li> Set default ticket assignments via "view feature areas" for the
+newly created project.
+</ul>
+<p>
+Note that you can also create a project as a "copy" of another
+project.  This is useful since you can create a "template project"
+with a set of feature areas such as System Administration, Admin,
+Automated testing reports, documentation, etc. preassigned.
+<p>
+You can also create a feature area and assign it to all the same
+projects as a pre-existing feature area.
+
+<h3>New features in 3.1</h3>
+User visible:
+<ul>
+<li> Per user persistent customizations ("Settings" at top right in <a href="/ticket/">/ticket</a>)
+<li> Customizable table display and sorting.
+<li> Much "flatter" organization.  Most functions now directly
+accessible from top level /ticket/ screen.
+<li> Meaningful sorting on all "coded" columns (severity, Status,
+Type, etc).  Sorts are now "stable."  
+<li> Scored "quick search"
+<li> Tickets comments now displayed on "/shared/community-member.tcl" page.
+<li> Tickets now "Alertable" with alert management via standard screens.
+<li> You can cancel/approve your own tickets.
+<li> Email notifications are much more informative.
+<li> index.tcl state is perserved in the context bar.
+<li> Per project named "milestones" supported for deadlines.
+</ul>
+Administrative: 
+<ul>
+<li> Tickets can be copied (not necessarily a good thing!)
+<li> Projects and feature areas can be copied.
+<li> Standard group management tools will work.
+<li> Comments and new tickets now show up in New Stuff with links for administration.
+</ul>
+Non user-visible: 
+<ul>
+<li> Much more "standard ACS" since it uses general-comments, normal 
+ auditing, and groups.
+<li> Cleaner data model with most things "data-driven."
+</ul>
+
+
+<h3>Missing features of the old version</h3>
+Some features of the original ticket tracker are currently 
+broken or missing:
+<ul>
+<li> Email support -- in progress (with enhanced ticket 
+    dispatching via an adressee -> project/feature area mapping table).
+<li> No Past-due notification emails.
+<li> Cross referencing now simple ID# entry rather than the "search"
+    driven interface from the old version.
+</ul>
+
+<h3>Things to come</h3>
+<ul> 
+<li> Integration with the intranet module.
+<li> Better tools to facilitate project management.
+<li> Tools for rolling tickets to new projects (Sharenet 5.6 -&gt;
+   Sharenet 5.7 for example).
+</ul>
+
+<hr>
+
+<a href="mailto:teadams@arsdigita.com"><address>teadams@arsdigita.com</a>, 
+<a href="mailto:hqm@arsdigita.com">hqm@arsdigita.com</a>
+<a href="mailto:davis@arsdigita.com">davis@arsdigita.com</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/todo.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/todo.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/todo.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,95 @@
+<HEAD><TITLE>Todo Manager ACS Module</TITLE></HEAD>
+<BODY bgcolor=white>
+<h2>Todo Manager</h2>
+by <a href=http://ben.adida.net>Ben Adida</a>
+<hr><p>
+<h3>Purpose</h3>
+The Todo Manager is meant to allow collaboration of task-list creation
+and completion. It is initially closely modeled on the PalmPilot ToDo
+app, with added collaboration.
+<p>
+The Todo Manager also includes plugability for other modules to
+display their information as todos. This allows as single
+organizational module to display tasks to the end-user.
+<p>
+
+<h3>The Todo Plugin Architecture</h3>
+A few important things about the plug-in architecture.
+<ul>
+<li>There is a runtime association between the
+todo module and other modules. Nothing in the database represents this
+association.
+<li>One plug-in can declare multiple categories for a given user, each 
+of which will correspond to one to-do list for that user.
+<li>It is the plug-in's role to register with the todo manager and to
+provide a call-back API to display todos.
+</ul>
+
+The registration proc will be as follows:
+<p>
+<pre>
+proc todo_plugin_register {plugin_name plugin_procs}
+</pre>
+<p>
+where plugin_procs is an ns_set containing the callback API. The
+todo plugin registration expects the following callbacks:
+<ul>
+<li> GET_PERSONAL_CATEGORIES: a procedure that takes a db connection
+and a user id and returns the categories that that user can see that
+are personal to him.
+<li> GET_OTHER_CATEGORIES: a procedure that takes a db connection and
+a user_id and returns the categories that that user can see that
+belong other to users.
+<li> ITEM_CHANGE_ALLOWED_P: 1 or 0 depending on whether the user
+can change the item from the todo interface or not.
+<li> ITEM_CHANGE: the name of a procedure that takes the following
+arguments:
+     <ul>
+     <li> a db conn.
+     <li> user_id: the user.
+     <li> todo_id: the id of the item. This id only has a meaning to
+     the plug-in, it is not the id of a real to-do item.
+     <li> new_date: the new date in standard SQL format.
+     <li> new_priority: the new priority
+     <li> new_item_details: the new item details
+     </ul>
+This procedure may be blank if the date is not allowed to change.
+<li> MARK_COMPLETED_ALLOWED_P: 1 or 0 depending on whether the user
+can mark an item as completed from the todo interface or not.
+<li> MARK_COMPLETED: the name of a procedure that takes the following
+arguments:
+     <ul>
+     <li> a db conn
+     <li> user_id: the user performing the operation
+     <li> todo_id: the id of the item.
+     <li> completion_date: when the item was completed. This argument
+     is not mandatory.
+     </ul>
+<li> ONE_ITEM_URL: the url for a single todo. This will be given the
+todo_id as argument.
+<li> ITEM_LIST_SQL: a procedure that takes the following arguments:
+     <ul>
+     <li> a db conn
+     <li> user_id: the user for whom we're querying.
+     <li> category: the category of the todos.
+     <li> date_prettifier: a PL/SQL proc that prettifies the due date
+     according to the to-do way of doing things.
+     <li> n_days_to_show_completed_items: the number of days that
+     complete items should show up for after they've been completed.
+     <li> completion_status: "open" "closed" or "both" depending on
+     what we want to show.
+     </ul>
+the SQL that produces the list of todos. This must
+return the following named columns:
+     <ul>
+     <li> todo_id: the id number. This means something only to the
+     plugin itself, not to the todo list. It is an identifier that
+     will be used to throw the user back into the plugged-in module.
+     <li> due_date: in the classic todo format of yesterday, today,
+     etc... the todo PL/SQL can be used for this.
+     <li> one_line: a one-liner description of the todo item.
+     <li> priority: the priority of the todo item.
+     <li> completed_p: whether or not this item has been completed
+     </ul>
+</ul>
+</BODY>
\ No newline at end of file
Index: web/openacs/www/doc/tools.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/tools.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/tools.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,130 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Tools</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Tools</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://eveander.com/">Eve Andersson</a>
+
+<hr>
+
+<ul>
+<li>all scripts: <a href="/tools/">/tools/</a>
+<li>data model: <a href="/doc/sql/tools.sql">/doc/sql/tools.sql</a>
+</ul>
+
+<h3>The Big Idea</h3>
+
+Tools are collections of scripts used by other scripts in the ACS
+to perform common tasks such as spell checking.
+
+<h3>The Tools</h3>
+
+<ol>
+
+<b><li>Spell Checker</b>
+
+<p>
+
+Files:
+
+<ul>
+<li>ispell-words
+<li>spell.tcl
+<li>spelling-dictionary-add-to.tcl
+<li>webspell
+</ul>
+
+<p>
+
+<p>
+webspell is a shell script wrapper to ispell, necessary because ispell
+requires the HOME environment variable to be set, and setting
+env(HOME) doesn't seem to work from AOLserver Tcl. It takes two
+arguments, a filename to be spell checked and a dictionary file of
+extra words, one word per line.
+<p>
+The file <code>ispell-words</code> is such a dictionary file. The table
+<code>ispell_words</code> contains the same information as <code>ispell-words</code>, and is
+kept to make the editing of <code>ispell-words</code> easy. Any additions or
+deletions are made to the table, then the entire file is regenerated
+from the table.
+
+<p>
+
+One table:
+
+<blockquote>
+<pre>
+create table ispell_words (
+    ispell_word    varchar(100) primary key
+);
+</pre>
+</blockquote>
+
+
+To use:
+
+<blockquote>
+Say you have a form as follows, and you want the <code>email_body</code> to be spellchecked when the user pushes Submit:
+
+<blockquote>
+<pre>
+&lt;form method=post action="email-send.tcl"&gt;
+
+&lt;input type=text name="email_to" size=30&gt;
+&lt;input type=text name="email_subject" size=40&gt;
+&lt;textarea name="email_body" rows=10 cols=50&gt;&lt;/textarea&gt;
+&lt;input type=submit value="Send"&gt;
+
+&lt;/form&gt;
+
+</pre>
+</blockquote>
+
+Change the action to <code>/tools/spell.tcl</code> and specify the 
+<code>var_to_spellcheck</code> and <code>target_url</code> as follows:
+
+<blockquote>
+<pre>
+&lt;form method=post action="/tools/spell.tcl"&gt;
+
+&lt;input type=hidden name="var_to_spellcheck" value="email_body"&gt;
+&lt;input type=hidden name="target_url" value="/fullpath/email-send.tcl"&gt;
+
+&lt;input type=text name="email_to" size=30&gt;
+&lt;input type=text name="email_subject" size=40&gt;
+&lt;textarea name="email_body" rows=10 cols=50&gt;&lt;/textarea&gt;
+&lt;input type=submit value="Send"&gt;
+
+&lt;/form&gt;
+
+</pre>
+</blockquote>
+
+The user will have the chance to correct any misspellings and then
+they'll be redirected, with all form variables intact, to the
+<code>target_url</code>.
+
+</blockquote>
+
+Make sure that all scripts are executable and that the UNIX utility
+<code>ispell</code> is in <code>/usr/local/bin/</code>.  Also, the file
+<code>ispell-words</code> should contain the same words as the table
+<code>ispell_words</code> (it's fine if they both start out empty).
+
+<p>
+
+The lovely spell checker was written by Jin Choi (<a href="mailto:jsc@arsdigita.com">jsc@arsdigita.com</a>) with some finishing touches by Eve Andersson 
+(<a href="eveander@arsdigita.com">eveander@arsdigita.com</a>).
+
+</ol>
+
+<hr>
+<a href="http://eveander.com/"><address>eveander@arsdigita.com</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/upgrading.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/upgrading.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/upgrading.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,134 @@
+<html>
+<!--AD_DND-->
+<HEAD><TITLE>ArsDigita Community System Upgrade Instructions</TITLE></HEAD>
+<BODY bgcolor=#ffffff text=#000000>
+<h2>Upgrading an ArsDigita Community System</h2>
+
+part of <a href="index.html">the ACS docs</a>
+
+by <A href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+This document contains some tips that may be useful when
+migrating data from a legacy database into ACS Oracle tables
+or upgrading an ArsDigita Community System.
+
+<h3>Migrating crud from legacy databases</h3>
+
+There isn't any best way to migrate data.  Here are some reasonable
+strategies that we've used.
+
+
+<h4>Strategy 1: if the legacy data can be loaded into Oracle</h4>
+
+Load your data in as a separate user, GRANT SELECT on these tables to
+your ACS Oracle user Once you've got all your data loaded in and owned
+by the "otherusername" user, construct statements of the following form:
+
+<blockquote>
+<pre><code>
+insert into clickthrough_log (local_url, foreign_url, entry_date, click_count)
+ select local_url, foreign_url, entry_date, click_count 
+ from otherusername.clickthrough_log;
+</code></pre>
+</blockquote>
+
+
+<h4>Strategy 2: if the legacy data aren't in Oracle and the data model
+isn't documented</h4>
+
+Suppose that you've got a huge database in an Informix database that you
+don't really understand.  Get hold of the Data Junction product (see
+<a href="http://www.datajunction.com/">http://www.datajunction.com/</a>)
+and have it connect to Informix, grab all the data, and stuff them into
+Oracle.
+
+
+<h4>Strategy 3: if you have lots of random losers giving you flat files
+in different formats</h4>
+
+Suppose that you have lots of little collectible shops giving you their
+inventory data.  You don't think they are sufficiently wizardly in
+<i>Excel</i> to massage their columns into your format.  So you're
+forced into taking data in all kinds of quirky formats.  Moreover, you
+don't want to have to hire a staff of really good programmers to write
+conversion scripts for each shop.  What my friend Olin did at
+exchange.com was use Data Junction again (<a
+href="http://www.datajunction.com/">http://www.datajunction.com/</a>).
+It has a little scripting language that was very convenient for this
+purpose.
+
+
+
+<h4>Strategy 4: if it was your crud to begin with but it is another
+brand of RDBMS</h4>
+
+Suppose that you've built up a big collection of data in Sybase and
+understand the data model but need to move it to Oracle.  If you are an
+expert AOLserver developer, the easiest thing to do is configure a pool
+of connections to Sybase and a pool to Oracle.  Then write .tcl scripts
+to select from Sybase and insert into Oracle.
+
+
+<h3>Upgrading ACS</h3>
+
+We're not going to pretend that upgrading an ACS-backed site is trivial,
+even if you've followed the religion of /doc/patches.html and
+/doc/custom.html.  Does this mean that ACS is badly engineered?  Maybe.
+But other major RDBMS-backed systems such as SAP suffer from the same
+problems.  People have had 20 years to attack this problem and nobody
+has come up with a silver bullet.  This is why IT departments tend to
+grow monotonically in size and budget.  Also, if we're going to be
+innovative we want it to be in collaboration features that users can
+use, not in sysadmin/dbadmin or other areas that only programmers will
+see. 
+
+<P>
+
+There are two basic strategies for upgrading an ACS.  If you're doing a
+minor upgrade, say from 2.3 to 2.4, you'll want to apply the ALTER TABLE
+statements to your online Oracle database, create any new tables, add a
+few parameters to your ad.ini file, and update your scripts.  If you're
+doing a major upgrade from 1.0 to 2.4, you might want to consider
+creating a new Oracle user and populating the fresh tables with data
+from the online system (see above section on migrating data).  Then
+reapply any personality or customizations to a freshly untarred ACS.
+Finally you can reconfigure your public Web server to run against the
+new ACS installation.
+
+<h4>Upgrading "stop and copy" style</h4>
+
+The /admin/conversion/ directory contains the following scripts that are
+useful if you are stopping and copying:
+
+<ul>
+<li><code>copy-acs-tables.sql</code> : a good model for copying data from an online
+system into a fresh development database for a new ACS version
+
+<li><code>sequence-update.tcl</code> : you'll want to make sure that all
+your sequences aren't still starting with 1 now that you have old data
+in your new tables
+
+<li><code>parameter-differences.pl</code> : this Perl script will help
+you identify differences between your ad.ini file and the new ACS's
+default; just call it from the shell with two file names as arguments
+and view the report on standard output
+
+
+</ul>
+
+
+<h4>Upgrading online style</h4>
+
+If you're doing an upgrade to an online database, you'll want to look
+at any relevant <code>/doc/sql/upgrade*.sql</code> scripts.  Also,
+you'll surely make use of
+<code>/admin/conversion/parameter-differences.pl</code> to see what
+parameters you must add. Lastly, <code>/install/obsolete.txt</code>
+lists files, by release, that you should remove.
+
+<hr>
+<a href="mailto:philg@mit.edu"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/user-admin.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/user-admin.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/user-admin.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,45 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>User Administration</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>User Administration</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+In <a href="/admin/users/">/admin/users/</a>, as elsewhere in the ACS,
+we try to follow the Macintosh user interface style:
+
+<ul>
+<li>pick the object, then
+<li>pick the verb
+</ul>
+
+So we want to help the publisher pick up a group of users (the object)
+and then pick something to do with those users (the verb).  Here's an
+example:
+
+<blockquote>
+
+"I am interested in users whose email address ends in "mit.edu" and who've
+either posted at least one entry in the last six months into a particular
+discussion forum or who have explicitly said that they're interested in
+learning more about large format photography.  Once I've seen how many
+there are, I would like to spam them."
+
+</blockquote>
+
+As different installations of the ACS will have different active modules
+and different publisher interest, we actually need a way for a publisher
+to formally specify "these are the kinds of ways I'd like to select out
+users".
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/user-groups.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/user-groups.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/user-groups.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,143 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>User Groups</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>User Groups</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+<ul>
+<li>User-accessible directory:  <a href="/ug/">/ug/</a>
+<li>Site administrator directory:  <a href="/admin/ug/">/admin/ug/</a>
+<li>data model :  <a href="/doc/sql/display-sql.tcl?url=/doc/sql/user-groups.sql">/doc/sql/user-groups.sql</a>
+
+</ul>
+
+<h3>The Big Idea</h3>
+
+There are many applications of the ArsDigita Community System in which
+we need to lump users together.  If we accomplish that lumping with a
+common mechanism, then we can build common user and admin tools that
+don't have to be separately debugged for each installation.
+
+<h3>Data Model Tour</h3>
+
+These are the tables that hold user group information:
+
+<ul>
+<li><code>user_group_types</code>; one row for each different
+<em>type</em> of user group, e.g., at a university you'd have a row for
+the "committee" group type and a row for the "course" group type
+
+<li><code>user_group_type_fields</code>; one row for each field that we must
+keep for a user group type, e.g., for a university "course" group type
+there would probably be rows in this table for
+<code>semester</code>, <code>meeting_times</code>,
+<code>room_number</code>, <code>final_exam_p</code>
+
+<li><code>user_groups</code>; one row for each user group in a
+community.  At a university with 1000 courses per semester, 1000 rows
+would be added to this table every semester.  Note that these rows don't
+store too much info about the groups, beyond their names (e.g., "CS 101,
+Introduction to computer languages not used in industry"), whether the
+group has been approved by the site administrator, and whether new
+members must be approved.  
+
+<li><code>*_info</code>; one table for each user group type in a
+community, each table named "${group_type}_info" (e.g., "course_info" or
+"committee_info").  Each table will contain one row for each user group
+of that type.  So the <code>course_info</code> table would pick up 1000
+new rows each semester.  This is where the real information about a
+group, the columns defined in <code>user_group_type_fields</code> are
+kept.
+
+<p>
+
+<li><code>user_group_map</code>
+
+<p>
+
+<strong>before ACS 3.2:</strong> one row for each user in a group.
+For example, in a university with 1000 courses, 30 students per
+course, 30,000 rows would be added to this table each semester.  The
+<code>user_group_map</code> table also records a user's role in the
+group.
+
+<p>
+
+<strong>ACS 3.2 and later:</strong> one row per each role played by a
+user in a group.  For example, in a small company where one person
+plays both the CEO role and the CTO role, you would represent the
+company as a user group of type "company", and there would be two rows
+in <code>user_group_map</code> for that person, one with a value of
+"CEO" in the <code>role</code> column and the other with a value of
+"CTO".
+
+<p>
+
+<li><code>user_group_map_queue</code>; one row for each user who has
+applied for membership in a group but whose membership has yet to be
+approved
+
+</ul>
+
+<h3>System-defined Groups</h3>
+
+There are a bunch of places within the ArsDigita Community System where
+users need to be lumped together.  Sadly, some of these subsystems
+predate the users group module and use their own mapping tables.  
+
+<p>
+
+An example of something done consistently, however, is the recording of
+whether or not a user is a system administrator of this site (tested
+with the Tcl procedure <code>ad_administrator_p</code>).  There is a
+user group type of "system".  One group of this type is pre-defined:
+"administrators".
+
+
+
+<h3>Example Applications</h3>
+
+Cisco sets up an ArsDigita Community System to support customers who've
+purchased routers.  Cisco would create a user group type of "company"
+and then a user group of that type for each customer, e.g., "Hewlett
+Packard" would be a user group and all the hp.com users would be members
+of that group.  The grouping mechanism would let Cisco ask for "all
+trouble tickets opened by HP employees".  The grouping mechanism would
+let Cisco offer online prices with the HP discount to anyone logged in
+who was recorded as a member of the HP group.
+
+<p>
+
+A university running one big ACS would have user group types of
+"committee" and "course".  All the administrators on a committee would
+be in a user group of type "committeee".  All the students and teachers
+in a particular course would be lumped together in a user group and
+could have a private discussion group.  The teachers would have a
+different role within the user group and hence would have more access privileges.
+<h3>Group login</h3>
+
+<p>
+<h3>More Information</h3>
+
+<ul>
+<li><a href="permissions.html">Permission Package</a> documentation on
+how to use multi-role permissions feature of user groups.
+<li><a href="writing-a-module.html">Module Administration</a> documentation on
+how to administer system and admin modules of user groups.
+</ul>
+
+<p>
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
+
Index: web/openacs/www/doc/user-profiling.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/user-profiling.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/user-profiling.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,403 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>User Profiling</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>User Profiling</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>, <a href="http://teadams.com/">Tracy Adams</a>, and <a href="http://michael.yoon.org/">Michael Yoon</a>
+
+<hr>
+
+<ul>
+<li>User directory:  <a href="/mailing-list/">/mailing-list/</a>
+<li>Admin directory:  <a href="/admin/categories/">/admin/categories/</a> 
+<li>data model:  subsection within 
+<a href="/doc/sql/display-sql.tcl?url=/doc/sql/community-core.sql">/doc/sql/community-core.sql</a>
+
+<li>procedures:  within /tcl/ad-user-profiling.tcl and /tcl/ad-categories.tcl
+<li>Related modules: <a href="site-wide-search.html">site-wide search</a>
+
+</ul>
+
+<h3>The Categories Themselves</h3>
+
+The profiling system provides an unlimited number of dimensions along
+which to place a user's interest.  Each dimension is represented
+in the following table:
+
+<blockquote>
+<pre><code>
+create table categories (
+	category_id	integer not null primary key,
+	category	varchar(50) not null,
+	category_description    varchar(4000),
+	-- e.g., for a travel site, 'country', or 'activity' 
+	-- could also be 'language'
+	category_type	varchar(50),
+	-- language probably would weight higher than activity 
+	profiling_weight	number default 1 check(profiling_weight >= 0),
+	enabled_p	char(1) default 't' check(enabled_p in ('t','f')),
+	mailing_list_info	varchar(4000)
+);
+</code></pre>
+</blockquote>
+
+Note that this is the same table that holds the dimensions for
+classifying content on a site.  If this were not so, it would be
+painful to match up users and content.
+
+<p>
+
+The <code>category_type</code> column bears mentioning.  It isn't used
+for score computation but only for user interface when querying the user
+or giving options for the site administrator.  The
+<code>profiling_weight</code> column may be used to disable scoring
+along a certain dimension or to make language preference much more
+important than other preferences.
+
+<p>
+
+The <code>mailing_list_info</code> column is used by the software
+underneath /mailing-list/.  It can contain information such as "We
+expect to send you email once every month if you sign up."  The
+<code>category_description</code> can be used in other places where a
+user simply wants clarification about a category.
+
+<h4>Optional Hierarchy</h4>
+
+Suppose that the flat <code>category_type</code> system doesn't work for
+you.  You are running a travel site and want to present the "Appalachian
+Trail" category to folks who have selected one of the states through
+which the AT runs (Georgia, Tennessee, North Carolina, Virginia, West
+Virginia, Maryland, Pennsylvania, New Jersey, New York, Connecticut,
+Massachusetts, Vermont, New Hampshire, Maine).
+
+<p>
+
+You represent this hierarchy with the following table:
+
+<blockquote>
+<pre><code>
+create table category_hierarchy (
+   parent_category_id     integer references categories,
+   child_category_id      integer regerences categories
+   unique (parent_category_id, child_category_id)
+);
+</code></pre>
+</blockquote>
+
+Notice that this isn't a strict hierarchy; a category can have more than
+one parent.  Also notice that we use UNIQUE rather than PRIMARY KEY.
+That is because we signify the top-level hierarchies with a NULL
+<code>parent_category_id</code> column.
+
+<h3>Mapping content to categories</h3>
+
+Similar to the approach taken in the site_wide_search and
+general_comments module, one table stores all the mappings of content to
+categories.  These content items will be in stored in disparate Oracle
+tables.  Note that this replaces some older tables such as
+<code>static_categories</code> (mapped static pages to categories). 
+
+<blockquote>
+<pre><code>
+create sequence site_wide_cat_map_id_seq;
+
+create table site_wide_category_map (
+             map_id                  integer primary key,
+	     category_id             not null references categories,
+	     -- We are mapping a category in the categories table
+	     -- to another row in the database.  Which table contains
+	     -- the row?
+             on_which_table          varchar(30) not null,
+	     -- What is the primary key of the item we are mapping to?
+	     -- With the bboard this is a varchar so we can't make this
+	     -- and integer
+             on_what_id              varchar(500) not null,
+	     mapping_date	     date not null,
+	     -- how strong is this relationship?
+	     -- (we can even map anti-relationships with negative numbers)
+	     mapping_weight          integer default 5 
+				     check(mapping_weight between -10 and 10),
+	     -- A short description of the item we are mapping
+	     -- this enables us to avoid joining with every table
+	     -- in the ACS when looking for the most relevant content 
+	     -- to a users' interests
+	     -- (maintain one_line_item_desc with triggers.)
+             one_line_item_desc      varchar(200) not null,
+	     mapping_comment         varchar(200),
+	     -- only map a category to an item once
+             unique(category_id, on_which_table, on_what_id)
+);
+</code></pre>
+</blockquote>
+
+To build user and admin interfaces when querying
+<code>site_wide_category_map</code>, we use the central
+<code>table_acs_properties</code>, which is shared by side-wide index
+and the general comments facility.
+
+<blockquote>
+<pre><code>
+create table table_acs_properties (
+             table_name      varchar(30) primary key,
+             section_name    varchar(100) not null,
+             user_url_stub   varchar(200) not null,
+             admin_url_stub  varchar(200) not null
+);
+</code></pre>
+</blockquote>
+
+Here is an example entry for the <code>bboard</code> table:
+
+<ul>
+<li><code>table_name</code> - bboard
+<li><code>section_name</code> - Discussion Forums
+<li><code>user_url_stub</code> - /bboard/q-and-a-fetch-msg.tcl?msg_id=
+<li><code>admin_url</code> - /bboard/admin-q-and-a-fetch-msg.tcl?msg_id=
+</ul>
+
+You're probably thinking that it would be nice to have
+<code>table_name</code> reference the Oracle data dictionary view
+<code>user_tables</code> but this doesn't seem to work.
+
+<p>
+
+To build admin pages for inserting, updating, and deleting data in the
+<code>site_wide_category_map</code> table, you can use the Tcl procs:
+
+<ul>
+<li><code>ad_categorization_widget</code>
+<li><code>ad_categorize_row</code>
+</ul>
+
+<h4><code>ad_categorization_widget</code></h4>
+
+Call <code>ad_categorization_widget</code> within an HTML form to
+create a user interface for categorizing a specific row in the
+database. It returns a selection widget that contains options for each
+category; already mapped categories are pre-selected, and, for each
+category, the <code>category_type</code> (if one exists) is included
+in parentheses. If a category hierarchy is defined, then indentation
+makes it visually apparent.
+
+<p>
+
+Suppose that you're running a restaurant-rating site like <a
+href="http://zagat.com/">ZAGAT.COM</a> and you want to categorize
+restaurants geographically. The <code>ad_categorization_widget</code>
+for a restaurant with multiple locations like Nobuyuki Matsuhisa's
+excellent <a
+href="http://newyork.citysearch.com/E/V/NYCNY/0003/34/66/">Nobu</a>
+would look something like this:
+
+<blockquote>
+
+<form>
+<select multiple>
+<option>Europe (Continent)
+<option>&nbsp;&nbsp;UK (Country)
+<option selected>&nbsp;&nbsp;&nbsp;&nbsp;London (City)
+<option>North America (Continent)
+<option>&nbsp;&nbsp;USA (Country)
+<option>&nbsp;&nbsp;&nbsp;&nbsp;California (State)
+<option selected>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Los Angeles (City)
+<option>&nbsp;&nbsp;&nbsp;&nbsp;New York (State)
+<option selected>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;New York (City)
+</select>
+</form>
+
+</blockquote>
+
+<code>ad_categorization_widget</code> takes the following parameters:
+
+<ul>
+<li><code>db</code>: a database handle
+
+<li><code>which_table</code> and <code>what_id</code>: together,
+these two parameters identify the specific row in the database
+
+<li><code>name</code>: value for the <code>name</code> attribute of
+the <code>&lt;select&gt;</code> tag; "category_id_list" by default
+
+<li><code>multiple_p</code>: if true (which is the default), then the
+widget will allow multiple selections
+
+<li><code>size</code>: the number of visible rows in the widget; if
+omitted, then the size of the widget will be the number of categories
+</ul>
+
+<code>ad_categorization_widget</code> is declared with
+<code>ad_proc</code> so you must call it with named arguments, e.g.:
+
+<blockquote>
+<code>
+ad_categorization_widget -db $db -which_table "restaurants" -what_id 123
+</code>
+</blockquote>
+
+<h4><code>ad_categorize_row</code></h4>
+
+Given a specific row in the database (identified by the
+<code>which_table</code> and <code>what_id</code> parameters) and the
+list of categories to which that row should be mapped (the
+<code>category_id_list</code> parameter),
+<code>ad_categorize_row</code> will update
+<code>site_wide_category_map</code> appropriately, inserting any new
+mappings and deleting any previously existing mappings to categories
+that are not in <code>category_id_list</code>. Thus, if
+<code>category_id_list</code> is empty, then all mappings to the row
+will be deleted.
+
+<p>
+
+In addition to <code>which_table</code>, <code>what_id</code>, and
+<code>category_id_list</code>, <code>ad_categorize_row</code> also
+takes the following parameters:
+
+<ul>
+<li><code>db</code>: a database handle
+
+<li><code>one_line_item_desc</code>: see the description of the
+corresponding column in <code>site_wide_category_map</code> above
+
+<li><code>mapping_weight</code>: see the description of the
+corresponding column in <code>site_wide_category_map</code> above;
+<em>optional</em>
+
+<li><code>mapping_comment</code>: see the description of the
+corresponding column in <code>site_wide_category_map</code> above;
+<em>optional</em>
+</ul>
+
+Like <code>ad_categorization_widget</code>, you must call
+<code>ad_categorize_row</code> with named arguments, e.g.:
+
+<blockquote>
+<pre>
+set category_id_list [<a href="/doc/proc-one.tcl?proc_name=util_GetCheckboxValues">util_GetCheckboxValues</a> [ns_conn form] "category_id_list"]
+if { $category_id_list != 0 } {
+     ad_categorize_row -db $db -which_table "restaurants" -what_id 123 \
+          -category_id_list $category_id_list -one_line_item_desc "Nobu"
+}
+</pre>
+</blockquote>
+
+Note that <code>ad_categorize_row</code> will use the same
+<code>mapping_weight</code> (as well as
+<code>one_line_item_desc</code> and <code>mapping_comment</code>) for
+all the categories in <code>category_id_list</code>, so you will need
+to call it multiple times if you have differently weighted mappings.
+
+<p>
+
+For instance, suppose you want to categorize a travel article about
+surfing near Santa Cruz with a <code>mapping_weight</code> of 10 for
+"Surfing" (because its great pictures and stories will be very
+interesting to all surfers, even if the reader is nowhere near
+California) but a <code>mapping_weight</code> of 2 for "Santa Cruz,
+CA" (because the average tourist will not find it interesting, not to
+mention the fact that it's only <strong>near</strong> Santa Cruz, not
+<strong>in</strong> Santa Cruz). You will have to call
+<code>ad_categorize_row</code> twice:
+
+<blockquote>
+<pre>
+ad_categorize_row -db $db -which_table "travel_articles" -what_id 456 \
+     -category_id_list <em>surfing_category_id</em> -mapping_weight 10 \
+     -one_line_item_desc "Surfin' Near Santa Cruz"
+
+ad_categorize_row -db $db -which_table "travel_articles" -what_id 456 \
+     -category_id_list <em>Santa_Cruz_CA_category_id</em> -mapping_weight 2 \
+     -one_line_item_desc "Surfin' Near Santa Cruz"
+</pre>
+</blockquote>
+
+<h3>Recording User Interests</h3>
+
+For a specific user, the level of interest (or lack thereof) is recorded
+in
+
+<blockquote>
+<pre><code>
+create table users_interests (
+	user_id		integer not null references users,
+	category_id	integer not null references categories,
+	-- 0 is same as NULL; -10 is "hate this kind of stuff"; 
+	-- 5 is "said I liked it", 10 is "love this kind of stuff"
+	interest_level	integer default 5 check(interest_level between -10 and 10),
+	interest_date	date,
+	unique(user_id, category_id)
+);
+</code></pre>
+</blockquote>
+
+As the comment above notes, the default behavior when a user signs up
+for a mailing list or whatever is to assign an interest level of 5.
+This means "moderately interested".  If we ever find out that a user
+doesn't like something, we can record that with a negative
+<code>interest_level</code>.
+
+<h3>Putting It All Together (Example Queries)</h3>
+
+A query to produce links to the most relevant content (to a particular
+user's interests) on the site in descending order:
+
+<blockquote>
+<pre><code>
+select one_line_item_description, user_url_stub, section_name
+from site_wide_category_map, categories, users_interests, table_acs_properties
+where users_interests.user_id = $user_id
+  and categories.category_id = users_interests.category_id
+  and site_wide_category_map.category_id = categories.category_id 
+  and site_wide_category_map.table_name = table_acs_properties.table_name
+group by one_line_item_description, user_url_stub, section_name
+order by (sum(categories.profiling_weight * users_interests.interest_level)) desc
+</code></pre>
+</blockquote>
+
+Combining keyword and categorical searches:
+
+<blockquote>
+<pre><code>
+select 
+    the_key, 
+    sum(search_score)+sum(category_score) as total_score, 
+    section_name, 
+    user_url_stub, 
+    one_line_description 
+from (select 
+        site_wide_index.one_line_description, 
+        site_wide_index.the_key,
+        site_wide_index.table_name, 
+        score(10) as search_score, 
+        0 as category_score
+      from site_wide_index
+      where (contains(indexed_stuff,'about($user_entered_query)',10) > 0) 
+      union
+      select 
+        site_wide_category_map.one_line_item_desc, 
+        on_what_id,
+        on_which_table, 
+        0 as search_score, 
+        sum(profiling_weight) as category_score
+      from site_wide_category_map, categories
+      where site_wide_category_map.category_id in ('[join $category_id_list "','"]')
+      and site_wide_category_map.category_id = categories.category_id
+      group by on_what_id, one_line_item_desc, on_which_table
+    ) site_wide, table_acs_properties
+where site_wide.table_name = table_acs_properties.table_name
+group by the_key, one_line_description, section_name, user_url_stub
+order by total_score desc
+</code></pre>
+</blockquote>
+
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/user-registration.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/user-registration.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/user-registration.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,196 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>User Registration and Access Control</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>User Registration and Access Control</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://teadams.com">Tracy Adams</a>
+
+<hr>
+
+<ul>
+<li>User directory:  /register
+<li>Admin directory:  <a href="/admin/ug/">/admin/users/</a> 
+<li>data model:  subsection within 
+<a href="/doc/sql/display-sql.tcl?url=/doc/sql/community-core.sql">/doc/sql/community-core.sql</a>
+
+<li>procedures:  within /tcl/ad-security.tcl and /tcl/ad-admin.tcl
+
+</ul>
+
+<h3>The Big Picture</h3>
+
+We want to let publishers decide how many hurdles and approvals a user
+must get through before being authorized to use the system.
+
+<h3>Medium Size Picture</h3>
+
+A typical public access web site might simply ask for your
+name and email to give you a unique identity and for user tracking.
+Sites concerned about personal misrepresentation will require an email verification
+step. Your active membership base will be in flux as leave and other you restrict. 
+For sensitive applications (ie - medical tracking systems), access 
+control becomes more serious. 
+Here, required options include approval systems, encrypting passwords in the
+database.  This module allows a site administrator to set up an
+access control system by choosing from a palette of options.
+<p>
+To simplify the user authentication, a finite state machine is used
+to control the user's state. Users with access to the system
+have a user_state of 'authorized'. 
+
+<h3>Registration Options</h3>
+
+<blockquote>
+<table border=1>
+<tr><th>Parameter</th><th>Definition</th></tr>
+
+<tr><td>NotifyAdminOfNewRegistrationsP</td><td>Administrator is notified of all new registrations</td></tr>
+
+<tr><td>NewRegistrationEmailAddress</td><td>Where to send administrator notifications of registration (defaults to SystemOwner)</td></tr>
+
+
+<tr><td>EmailRegistrationConfirmationToUserP</td><td>New user is sent an email confirmation</td></tr>
+
+<tr><td>RegistrationRequiresApprovalP</td><td>Administrator must approve before user is authorized</td></td>
+
+<tr><td>RegistrationRequiresEmailVerificationP</td><td>User must verify email before he/she is authorized</td></tr>
+
+
+<tr><td>RegistrationProvidesRandomPasswordP</td><td>System will generate a random password for the user</td></tr>
+
+<tr><td>EncryptPasswordsInDBP</td><td>Encrypt the passwords inside the database</td></tr>
+
+
+<tr><td>EmailForgottenPasswordP</td><td>Provide (and allow) an interface for the user to ask for forgotten password sent via email</td></tr>
+
+
+<tr><td>EmailRandomPasswordWhenForgottenP</td><td>If the user requests a password reminder, generate a random password</td></tr>
+
+
+<tr><td>EmailChangedPasswordP</td><td>If the admin changes the user's password, allow this to be sent to the user</td></tr>
+
+<tr><td>AllowPersistentLoginP</td><td>Give an option for persistent cookies to store login information</td></tr>
+
+<tr><td>PersistentLoginDefaultP</td><td>If persistent cookies are allowed, make it default on</td></tr>
+
+<tr><td>LastVisitCookiesEnabledP</td><td>Enable the cookie-backed tracking system</td></tr>
+
+<tr><td>LastVisitExpiration</td><td>Maximum visit length for session tracking</td></tr>
+
+<tr><td>NeedCookieChainP</td><td>Set a cookie on more than 1 hostname (i.e., is your site a typical "foobar.com" and "www.foobar.com" case)</td><td></tr>
+
+<tr><td>CookieChainFirstHostName=yourdomain.com</td><td>First domain name in the cookie chain</td></tr>
+<tr><td>CookieChainSecondHostName=www.yourdomain.com</td><td>Second domain name in the cookie chain</td></tr>
+</table>
+</blockquote>
+
+<h3>Registration Finite State Machine</h3>
+
+A user must be in the authorized state to have access to
+the system. Prior to approval, users must pass 
+"Need Email Verification" and "Need Admin Approval" tests.  
+Users may be "Rejected" at
+an stage prior to the "Authorized" state. 
+One a user is "Authorized", they may be "Deleted" or "Banned".
+"Deleted" users may self-activate.
+
+
+<blockquote>
+<pre>
+
+			Not a user
+		     	     |	
+		             V
+	           Need Email Verification          Rejected (via any
+	             Need Admin Approval             pre-authorization state)
+   			     |				
+   		   	     |  	                
+Need admin approval<--------- ------------->Need email verification 
+   |						        |
+   |                 		 			|
+   --------------------->Authorized<---------------------                       
+                             |
+        		     |		  
+ Banned------------><-------- ------><---------------Deleted
+</pre>
+</blockquote>
+
+Following ACS convention, states in the database are represented by
+lowercase tokens, sometimes with underscores:
+
+<blockquote>
+<pre><code>
+user_state		varchar(100) 
+  check(user_state in ('need_email_verification_and_admin_approv', 
+                       'need_admin_approv', 
+                       'need_email_verification', 
+                       'rejected', 
+                       'authorized', 
+		       'banned', 
+		       'deleted'))
+</code></pre>
+</blockquote>
+
+
+<h3>Restricting to authorized users</h3>
+
+
+The <code>users_active</code> view contains only authorized users:
+<blockquote>
+<pre>
+--- users who are not deleted or banned 
+--- (not that this does not have approval system)
+
+create or replace view users_active
+as select * from users 
+ where user_state = 'authorized';
+
+</pre>
+</blockquote>
+<p>
+
+The <code>users_spammable</code> view contains active users that 
+may be spammed:
+<blockquote>
+<pre>
+create or replace view users_spammable
+as select u.* from users u, users_preferences up
+ where u.user_id = up.user_id(+)
+ and (on_vacation_until is null or 
+      on_vacation_until < sysdate)
+ and user_state = 'authorized'
+ and (email_bouncing_p is null or email_bouncing_p = 'f')
+ and (dont_spam_me_p is null or dont_spam_me_p = 'f');
+</pre>
+</blockquote>
+
+The <code>users_alertable</code> view contains active users that 
+wish to receive alerts:
+<blockquote>
+<pre>
+create or replace view users_alertable
+as
+select * 
+ from users 
+ where (on_vacation_until is null or 
+        on_vacation_until < sysdate)
+ and user_state = 'authorized'
+ and (email_bouncing_p is null or email_bouncing_p = 'f');
+</pre>
+</blockquote>
+
+<h3>Future Improvements</h3>
+<ul>
+<li> Add options to force user to change password after x days.
+</ul>
+
+<hr>
+
+<a href="http://teadams.com"><address>teadams@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/user-session-tracking.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/user-session-tracking.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/user-session-tracking.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,150 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>User Session Tracking</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>User Session Tracking</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a> and <a href=http://teadams.com>Tracy Adams</a>
+
+<hr>
+
+<ul>
+<li>User-accessible directory:  none
+<li>really important file:  /tcl/ad-last-visit.tcl
+<li>Site administrator directory:  linked from 
+<a href="/admin/users/">/admin/users/</a>
+<li>data model :  inside <a href="/doc/sql/display-sql.tcl?url=/doc/sql/community-core.sql">/doc/sql/community-core.sql</a>
+
+</ul>
+
+<h3>What we said in the book</h3>
+
+<blockquote>
+<i>
+(where "the book" = <a href="http://photo.net/wtr/thebook/">Philip and
+Alex's Guide to Web Publishing</a>)
+</i>
+</blockquote>
+<p>
+
+In many areas of a community site, we will want to distinguish "new
+since your last visit" content from "the stuff that you've already seen"
+content.  The obvious implementation of storing a single
+<code>last_visit</code> column is inadequate.  Suppose that a user
+arrives at the site and the ACS sets the <cite>last_visit</cite> column
+to the current date and time.  <a href="http://photo.net/wtr/thebook/glossary.html#HTTP">HTTP</a> is
+a stateless protocol.  If the user clicks to visit a discussion forum,
+the ACS queries the <code>users</code> table and finds that the last
+visit was 3 seconds ago.  Consequently, none of the content will be
+highlighted as new.
+
+<p>
+
+The ACS stores <code>last_visit</code> and
+<code>second_to_last_visit</code> columns.  We take advantage of the
+AOLserver filter facility to specify a Tcl program that runs before
+every request is served.  The program does the following:
+
+<blockquote>
+
+IF a request comes with a user_id cookie, but the last_visit cookie is
+either not present or more than one day old, THEN the filter proc
+augments the AOLserver output headers with a persistent (expires in year
+2010) set-cookie of last_visit to the current time (HTTP format).  It
+also grabs an Oracle connection, and sets
+
+<blockquote>
+<pre>
+last_visit = sysdate, 
+second_to_last_visit = last_visit
+</pre>
+</blockquote>
+
+We set a persistent second_to_last_visit cookie with the
+<code>last_visit</code> time, either from the last_visit cookie or, if
+that wasn't present, with the value we just put into the
+<code>second_to_last_visit</code> column of the database.
+
+</blockquote>
+
+We do something similar for non-registered users, using pure browser
+cookies rather than the database.
+
+<h3>Stuff that we've added since</h3>
+
+A lot of <a href="http://arsdigita.com">arsdigita.com</a> customers
+wanted to know the total number of user sessions, the number of repeat
+sessions, and how this was evolving over time.  So we added:
+
+<ul>
+<li>an <code>n_sessions</code> column in the <code>users</code> table.
+<li>a table:
+<blockquote>
+<pre><code>
+create table session_statistics (
+	session_count	integer default 0 not null,
+	repeat_count	integer default 0 not null,
+	entry_date	date not null
+);
+</code></pre>
+</blockquote>
+<li>new code in ad-last-visits to stuff this table
+</ul>
+
+<h3>Rules</h3>
+
+<table border=1>
+<tr>
+<td>last_visit cookie present?</td>
+<td>log a  session</td> 
+<td>log repeat session </td> 
+<td>update last_visit cookie</td>
+<td>update second_to_last_visit_cookie</td>
+</tr>
+<tr>
+<td>Yes</td>
+<td>Yes if date - last_visit > LastVisitExpiration</td>
+<td>Yes if date - last_visit > LastVisitExpiration</td>
+<td>Yes if date - last_visit > LastVisitUpdateInterval</td>
+<td>Yes if date - last_visit > LastVisitExpiration</td>
+<td></td>
+</tr>
+<tr>
+<td>No</td>
+<td>Yes if the IP address has not been seen in the LastVisitCacheUpdateInterval seconds </td>
+<td>No</td>
+<td>Yes if the IP address has not been seen in the LastVisitCacheUpdateInterval seconds </td>
+<td>No</td>
+</tr>
+</table>
+<P>
+
+Upon login, a repeat session (but not an extra session) is logged
+if the <code>second_to_last_visit</code> is not present. 
+Logic: The user is a repeat user since they are logging in 
+instead of registering. 
+He either lost his cookies or is using a different
+browser.  On the first page load, the <code>last_visit</code> 
+cookie is set and a session is recorded.  When the user logs in, 
+we learn that he is a repeat visiter
+and log the repeat session.  (If the user was only missing a 
+<code>user_id</code> cookie, both the <code>last_visit</code> 
+and <code>second_to_last_visit</code> cookies would been updated on the
+initial hit.)
+
+
+<h3>Parameters</h3>
+
+<ul>
+<li><code>LastVisitUpdateInterval</code> - The <code>last_visit</code> cookie represents the date of the most recent visit, inclusive of the current visit. If the user remains on the site longer than the <code>LastVisitUpdateInterval</code>, the <code>last_visit</code> cookie is updated.  The database stores the <code>last_visit</code> date as well for using tracking and to display "who's online now".
+<li><code>LastVisitExpiration</code> - The minimum time interval separating 2 sessions.
+<li><code>LastVisitCacheUpdateInterval</code> - The period of time non-cookied hits from an individual IP is considered the same user for the  purpose of session tracking. (IP tracking and caching is necessary to not overcount browsers that do not take cookies.)
+</ul>
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/version-history.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/version-history.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/version-history.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,991 @@
+<html>
+<!--AD_DND-->
+<HEAD><TITLE>ArsDigita Community System Version History</TITLE></HEAD>
+<BODY bgcolor=#ffffff text=#000000>
+<h2>Version History</h2>
+
+for the <a href="index.html">ArsDigita Community System</a>
+
+by <A href="http://photo.net/philg/">Philip Greenspun</a> and <A href="http://teadams.com">Tracy Adams</a>.
+
+<hr>
+
+<ul>
+
+<li>Future Versions:
+
+<ul>
+<li>add scoping to the events module and make it conform more to ACS standards - Bryan Che
+<li>ad server enhancements - Tzu-Mainn
+<li>better support for private chat (Live Person)
+<li>class administration module - Randy and Aileen
+<li><a href="/doc/spam.html">spamming</a> bring closer to ACS admin UI standards - Henry Minsky
+<li><a href="/doc/member-value.html">member value</a> enhancement - Malte Sussdorf 
+<li>ecommerce - multi-store functionality Eve
+<li>process control module
+<li>enhanced survey builder
+<li>content management system (pset 3)
+<li>knowledge mangement system (pset 4)
+<li>room registration system (pset 2)
+<li>PIM (calendar)
+<li>appearance improvements and publisher-controlled layout
+<li>user-extensible table module tool (makes it easy to build systems
+where each user can have custom columns)
+<li>open source administration module
+<li>likely modules to expand - ecommerce
+<li>ticket tracker enhancement
+<li>bboard enhancement
+<li>improved template system (karl)
+<li>form management system (karl) 
+<li>expanded self-documentation and collaboration around develoment
+<li>auctions module - rwsu
+<li>Manual system (kevin) - need to get CVS running chroot.
+</ul>
+
+<p>
+
+<li>April 12, 2000: Version 3.2.2:
+<ul>
+  <li> rewrite of download module to fix version problems (ron)
+  <li> fixed several problems in abstract url (jsalz)
+</ul>
+
+<li>March 27, 2000: Version 3.2.1:
+<ul>
+  <li> minor fixes to general permissions (michael)
+  <li> fixed trailing slash bug in abstract urls (jsalz)
+  <li> fixed lots of problems in file-storage (tina)
+  <li> added bookmark open/close feature (carsten)
+</ul>
+
+<p>
+
+<li>March 17, 2000:  Version 3.2:
+
+<ul>
+
+<li>Spam system supports tcl templates, encoding and sending of multipart MIME
+messages containing text/HTML, and uses new user email_type preference
+to decide which content type to send. A preliminary version of gregh's
+bulkmail module is included, which allows the spam daemon to pump mail
+out multiple threads to multiple SMTP servers in parallel. That also
+supports email bounce processing, to automatically maintain clean
+mailing lists. (hqm@arsdigita.com)
+
+<li>Changed the primary key of user_group_map from (user_id, group_id)
+to (user_id, group_id, role), to enable users to be in more than one
+role per user_group. Note that this change turns code like "ns_db 1row
+$db <em>query of user_group_map with criteria for user_id and
+group_id</em>" into bugs waiting to be
+discovered. (michael@arsdigita.com, yon@arsdigita.com,
+markc@arsdigita.com)
+
+<li>Re-wrote events data model so that it would support user-group-based
+registrations and use a registrations/orders model.  Re-wrote tcl pages
+to use new data model (bryanche)
+
+<li>Fixed security hole in /bboard/admin-update-topics-table.tcl.  This
+script had no user validation whatsoever.  Anybody (even a
+nonregistered user) could update anything in the bboard_topics table
+just by visiting this script (branimir)
+
+<li>new <a href="general-permissions.html">general permissions</a>
+(michael, richardl)
+
+<li>cleaned-up classified ads system (standard comment headers,
+ad_page_variables) with ability to attach photos to ads
+
+<li>improvements to the contest system, at least to support
+arsdigita.org (markd)
+
+<li><a href="survey-simple.html">simple survey builder</a> (jsc, philg, surati, teadams)
+
+<li><a href="webmail.html">Web based email system</a> (jsc)
+
+<li>new <a href="security-sessions.html">security subsystem and
+session tracking system</a> (jsalz)
+
+<li><a href="abstract-url.html">abstract URL system</a> (jsalz)
+
+<li>new system for preloading and postloading .tcl files
+(/tcl/00-preload.tcl and /tcl/zz-postload.tcl - jsalz)
+
+<li>new <a
+href="/doc/proc-one.tcl?proc_name=ad_register_filter"><tt>ad_register_filter</tt></a>
+and <a
+href="/doc/proc-one.tcl?proc_name=ad_schedule_proc"><tt>ad_schedule_proc</tt></a>
+routines with <a href="/admin/monitoring/">monitoring tools</a>
+(jsalz)
+
+<li> <a href="download.html">Download</a> module has been upgraded - users are now able to see the available modules before registration, but they are required to register as users before actual download. Also download now supports version specific description, in addition to download specific description which is shown upon download request. (ahmeds) 
+
+<li> <a href="ticket.html">ticket</a> cleanup: bug fixes in adv search, confirms on comment entry,
+  better ticket submission help, added per feature area new ticket
+  templates, replyable notifications and comments, assignment at
+  creation for admins. date widget for ticket creation.
+
+<li> <a href=data-pipeline.html>Data Pipeline</a>: SQL abstraction layer based on form names
+(oumi, mbryzek)
+
+<li> <a href="news.html">News</a> module has been upgraded - news is now organized by newsgroup. There are two scopes of newsgroups: public which serves as the traditional (site-wide) news; and group which contains news for a user_group. There are two special newsgroups: all_users which contains news items that should be displayed to all users; and registered_users which contains items displayed to all registered users.
+
+<h4>minor fixes</h4>
+
+<li> modified <a href="general-links.html">general-links</a> to fit general cleanup guidelines for <code>approved_p</code>. (tzumainn)
+
+</ul>
+
+<p>
+
+<li>March 4, 2000: Version 3.1.5:
+<ul>
+  <li>added nsv_array wrapper to make proc_doc fully functional (contributed by tigre@ybos.net)
+</ul>
+
+<p>
+
+<li>February 28, 2000: Version 3.1.4:
+<ul>
+  <li>merged jsalz's changes to complete the fix for proc_doc (ron)
+  <li>fixed download module (ahmeds)
+</ul>
+
+<p>
+
+<li>February 20, 2000: Version 3.1.3:
+<ul>
+  <li>fixed problem in procs.tcl with AOLserver 2.x (ron)
+  <li>fixed sub-community administration for chat (dh)
+  <li>Changed version datatype from number to varchar to support version numbers like 3.1.2. Added support for download specific description which will be shown to the user upon download request (ahmeds)
+</ul>
+
+<p>
+
+<li>February 13, 2000: Version 3.1.2:
+<ul>
+  <li>added notes on security (jsc)
+  <li>minor bug fixes in download (ahmeds)
+  <li>minor bug fixes in homepage (mobin)
+  <li>minor usage change in FAQ (dh)
+</ul>
+
+<li>February 5, 2000:  Version 3.1.1:
+
+<ul>
+
+<li>fixed fatal errors in 00-ad-utilities.tcl due to a broken
+ad_page_variables (discovered and fixed by dh)
+
+<li>minor bug fixes in general-links (tzumainn)
+
+<li>minor bug fixes related to group-only bboards (branimir)
+
+</ul>
+
+<p>
+
+<li>Febrary 4, 2000:  Version 3.1:
+
+<ul>
+
+<li>installation verified using AOLserver 2.3.3 and 3.0, Oracle 8i,
+and Solaris 5.6 (aure, dh, ron)
+
+<li><a href=/doc/homepage.html>build your own homepage</a> or
+"GeoCities-in-a-box" (mobin)   
+
+<li>added <a href=/doc/events.html>events module</a> (bryanche)
+
+<li>integrated <a href=/doc/wp.html>WimpyPoint</a> (jsalz, jsc, philg)
+
+<li>revamped <a href=/doc/ticket.html>ticket tracking module</a> (davis)
+
+<li>documentation on <a href=/doc/writing-a-module.html>writing an
+ACS module</a>, now part of the developers guide (tarik)
+
+<li>changed 00-ad-utilities.tcl to use nsv_* instead of ns_share for
+performance benefits with AOLserver 3.0 using Tcl 8.2. The nsv
+mechanism is documented in <a href="README-NSV.txt">README.NSV</a>, in the
+top level of the AOLserver 3.0 source tree. Note that this is not backwards
+compatible with any previous version of AOLserver, but wrappers are
+provided for the nsv_* commands in 00-ad-utilities.tcl.
+
+<h4>minor fixes</h4>
+
+<li>philg updated comments and general comments to look for sabotage-prone
+HTML tags (such as DIV) in user-uploaded comments, implies a change to
+ad.ini (the antispam section)
+
+<li>teadams added editing a user's contact information in the admin pages
+
+</ul>
+<p>
+
+
+
+
+<p>
+
+<li>January 11, 2000:  Version 3.0:
+<ul>
+<li>support for AOLserver 3.0 is added (AOLserver 2.3 seems to work as
+well); AOLserver 3.0 should be configured to run Tcl 7.6 because we rely
+on <code>ns_share</code>
+
+<li>jsc integrated Henry and Branimir's bboard changes:
+<ul>
+<li>Every topic keyed by topic_id instead of topic.
+<li>Topic administration determined by standard ACS user group permission system.
+<li>Read/write permissions determined by new group-based system.
+</ul>
+
+<li>tarik, mobin and sarah - improved group capability (subdomained ACS); now acs modules that
+                             support scoping can be associated with the groups and group types
+<ul>
+<li>tarik added acs_modules table where all acs modules should eventually be registered
+<li>tarik improved content_sections table by adding scope (public, group) and having 
+           4 types of sections: static, custom (a content management system, allows storing
+           html files in db and serving them  to the users), system and admin (these are acs modules -
+           notice that this allows associating modules with groups)
+<li>mobin, sarah - new <a href="download.html">download module</a>
+<li>tarik, sarah - new <a href="display.html">display module</a> (allows configuration of css and logo for the pages)
+<li>tarik - added short name to the user_groups table (this is unique identifier of the group)
+            and is used in url. group public pages are now accessible in /groups directory
+            (e.g. novice-photographers group pages are located at /groups/novice-photographers),
+            group admin pages are accessible in /groups/admin directory (e.g. novice-photographers 
+            group admin pages are located at /groups/admin/novice-photographers)
+<li>tarik - improved group administration (acs_modules can be associated with the group type or with
+            the group). administrator can control how much control over the modules is given to the
+            group administrators
+<li>teadams, tarik added scoping (user, public, and group) to <a href="address-book.html">address book module</a> and ability to attach an address to any item in the database (similar to general comments)
+<li>sarah added scoping (user, public, and group) to <a href="news.html">news module</a> and ability to attach news to any item in the database (similar to general comments)
+<li>tarik, sarah added scoping (public, group) to <a href="faq.html">faq module</a>
+<li>tarik added scoping (public, group) to <a href="general-comments.html">general comments module</a>
+<li>tarik wrote a set of tcl functions needed for writing modules that support scoping (see /tcl/user-group-defs.tcl)
+</ul>
+<li>philg added commentability to the file storage module
+<li>philg added a trigger and fixed the SQL queries in Tcl defs for the
+robot detection module
+<li> philg added <a href="mainframe-integration.html">mainframe integration document</a>
+<li> karlg and philg  added <a href="xml.html">working with XML document</a>
+<li> philg added <a href=ecommerce-for-mbas.html>Ecommerce Subsystem (explained for MBAs)</a>
+<li> philg added some concurrency fixes to referer, clickthrough, and ad
+server logging
+<li> philg improved navigation and display on the /admin/adserver/
+pages; added an example of adserver usage in /acs-examples/ 
+<li> teadams added a monitoring section to the admin pages
+<ul>
+<li> teadams, dvr, and abe added Cassandacle as a built in 
+ACS module. This is in the new monitor section of the admin pages.  Of
+particular note:
+<ul>
+<li>the table detail page lists dependant tables
+<li>The sessions page lists all the information needed to find and kill
+runaway session (see "Be Wary of Sql Plus" in <a href=http://photo.net/wtr/oracle-tips.html#sessions>Oracle Tips</a>)
+
+</ul>
+<li>dvr (mostly) and teadams added Watchdog as a built in module.
+</ul>
+<li>dh added <a href="faq.html">an FAQ maintenance system</a>
+<li>ron added <a href="press.html">a press coverage bragging system</a>
+<li>we added <a href="download.html">a download management system</a>
+<li>davis added ad-table-display.tcl for dimensional
+    sliders, tables, sorts, and persistent user customizations.
+     Some <a href="/acs-examples/table-display/table-display-example.tcl">example
+code</a> is also available.
+
+<h4>minor fixes</h4>
+
+<li> teadams modified ad_restrict_to_administration in /tcl/ad-admin.tcl
+to get you back to the admin pages after you register
+<li> teadams adding the ability for administrator to approve email for
+users awaiting email verification
+<li>teadams modified /admin/users/user-class-add.tcl to be a little
+more intelligent in parsing the initial select clause.
+
+<li>philg modularized the comment/link stuff in /tcl/ad-html.tcl so that
+it was easier for .adp pages to take advantage of the tables and procs
+
+<li>philg made the portals system more robust (programming error in a
+subsection will not render an entire portal unviewable)
+
+<li>replaced the <code>Memoize</code> procedure with <code>util_memoize</code>
+
+<li>added <code>ad_user_group_authorized_admin_or_site_admin</code> API
+call to the <a href="permissions.html">permissions package</a>.
+
+
+</ul>
+<p>
+
+<li>November 8, 1999:  Version 2.4:
+<ul>
+
+<li> teadams added "self-documentation" in the admin area
+<li>philg added integrity checks to the poll system (for exploring and
+removing duplicate votes from the same IP address when you're not
+requiring registration)
+
+<li>philg wrote a "how to upgrade an ACS installation" document
+at <a href="upgrading.html">/doc/upgrading.html</a>
+
+<li>philg added procs to support creating CSV files to 00-utilities.tcl
+
+<li>philg fixed up the user admin pages (/admin/users/view-csv.tcl works now)
+
+<li>jsc and philg improved the <a href="graphing.html">graphing
+package</a> with a drill-down URL facility
+
+<li>philg enhanced ad_return_if_another_copy_is_running to be callable
+from ADP pages (good for stability under extreme loads)
+
+<li>philg fixed some cutting and pasting bugs in general-comments.sql
+triggers (left orphaned comments around)
+
+<li>tracy, philg, michael yoon, and sebastian made the huge overdue
+change to categorization and user profiling, described in
+<a href="user-profiling.html">user-profiling.html</a>
+
+<li>philg added the /tcl/ad-user-contributions-summary.tcl system, where
+each module defines a procedure to produce a summary of User X's
+contributions to a site.  This makes /shared/community-member.tcl and 
+/admin/users/one.tcl extensible and modular.
+
+<li>philg standardized navigation in the /address-book module 
+
+<li>philg added a /static section to ad.ini with exclusion patterns
+for the static page syncer
+
+<li>philg added the <code>static_page_index_exclusion</code> table
+to community-core.sql; this stores SQL LIKE patterns to exclude pages
+from the site-wide index
+
+<li>philg made major modifications to /admin/static/ to manage these
+exclusion patterns 
+
+<li>jsc and philg made major improvements/changes to site-wide search,
+with extensive help from the Context group at Oracle, notably Alpha and
+Paul Dixon. This has not been added to the upgrade script since it requires
+that the administrator be prepared to deal with interMedia, beginning
+with patching it to 8.1.5.1.
+
+<li>aure, dh, and philg improved the bookmarks system, notably the admin
+pages and a "most-popular-public.tcl" page
+
+</ul>
+
+<p>
+
+<li>October 10, 1999:  Version 2.3:
+<ul>
+<li><a href="/doc/crm.html">customer relationship management system</a> 
+<li><a href="/doc/curriculum.html">curriculum establishment system</a>
+<li><a href="/doc/user-profiling.html">user profiling enhancements</a>
+<li><a href="/doc/portals.html">portals system</a>
+<li><a href="/doc/poll.html">polls</a>
+<li>teadams added user classes (see user admin pages)
+<li>philg added ability for each user to upload a portrait of him or
+herself to be displayed to other users.  To be done:  automatic
+production of thumbnail versions when ImageMagick is installed
+(lots of columns added to the users table, including two BLOBs)
+
+<li>philg and MarkD made major improvements to the poll module
+<li>teadams added group login /ug/group-login.tcl, and ad_get_group_id and ad_get_group_info in tcl/ad-user-groups.tcl
+
+<li>General comments: added triggers in general-comments.sql to delete comments on rows that get deleted.
+
+
+<h4>minor fixes</h4>
+<li> rolf: fixed a minor bug in /admin/ug/group-type.tcl, added group-type-member-field-delete.tcl and group-type-member-field-delete-2.tcl.
+<li> teadams: fixed a few little bugs in the bookmarks 
+module that cropped up with a new user
+<li> teadams: modified /regiser/user-new-2.tcl to update last_visit in the users table
+<li> philg: fixed bug whereby the /chat system would produce an error if
+user's contribution was merely spaces
+<li> philg added a simple index-by-date to the referer_log table; speeds
+up queries on photo.net (1.3 million entries) from 34 seconds to 4.
+
+<li> walter documented the <a href="directory.html">/directory system</a>
+
+</ul>
+
+<p>
+
+<li>September 23, 1999: Version 2.2.1:
+<ul>
+<li>eveander: fixed an important ecommerce module bug that appeared due to an undocumented, unannounced CyberCash API change (thank you, CyberCash).  The "query" part of the procedure ec_talk_to_cybercash was modified.
+
+<li>jsc &amp; eveander: significant user group improvements including fixing all user group bugs at photo.net/ticket/, improving UI for group administrators, and allowing administrators to specify fields that are collected for all members of groups of a given type and for all members of a given group.
+
+<li>teadams: added StaffServerP to the ini file.  If StaffServerP=1, 
+then intranet, filestorage, ticket tracker and discussion groups
+will appear in the workspace
+</ul>
+
+<p>
+
+<li>September 22, 1999:  Version 2.2:
+
+<ul>
+
+<li>improved intranet module (procedures plus who is checked off to
+perform them, project and customer reports) (dvr)
+<li>poll module (markd)
+<P>
+<li>eveander: ecommerce module bugs 1822, 1821, 2261 at photo.net/ticket/ were fixed
+<li>eveander: ecommerce module small improvements: <br>
+  <ol>
+  <li>columns shipment_id and refund_id were added to
+  ec_financial_transactions and the admin pages were modified
+  to fill in those columns when making charges/refunds (this is
+  just an extra auditing precaution; those values are never used)
+  <li>the user tracking present in most of the user pages was
+  encapsulated into a procedure to make the code cleaner
+  </ol>
+<li>philg:  added commentability to classified ads; fixed some bugs and
+taste problems in the general comments facility
+<li>teadams: modified content sections so you can add info_blurb, help_blurb, add and edit content sections
+<li>teadams: modified the last visit system so that it a) doesn't record sessions from AOLserver monitors, and b) records a repeat-visit if the last-visit cookie is not present on the inital page load and the user subsequently logs in
+<li> teadams: few annotation edits in /directory
+<li> teadams: modified /share/community-member.tcl to have a menu bar
+<li> teadams: modified /ticket/project-top.tcl to redirect a user
+to the admin pages if they are in the ticket administration group.
+<li> teadams: modified /admin/spam/spam.tcl to clear the ^M's from the email that gets sent
+<li> teadams: modified /tcl/ad-last-visit.html to not overcount cookied browsers. (IP caching), modified /register/user-login-2.tcl to log a repeat visit (not session!) if the second_to_last_visit cookie is not present.  See: doc/user-session-tracking.html for details.
+<li> dvr: file storage permission fixes and ability to add urls
+<li> teadams: modified user admin page to allow admins to select users with different criteria (ie - males who logged in within the last 10 days). This will expand into dynamic user classes.
+<li> jsc: general_comments - added ability to upload files and images
+<li> teadams: general_comments - added option to use titles and list comments by title.
+<li> jsc: finally added utilities.tcl officially to the ACS, as tcl/00-ad-utilities.tcl
+</ul>
+<p>
+
+
+<li>August 9, 1999:  Version 2.1:
+
+<ul>
+<li>collaborative bookmark maintenance system
+</ul>
+
+<h4>minor fixes</h4>
+<ul>
+
+<li>(philg) - added ability to clear a forum of all messages 
+(useful for forums that support university classes when the new semester
+comes around)
+
+<li>(philg) - added <code>one_if_within_n_days</code> to
+/doc/sql/pl-sql.sql (necessary for ecommerce module)
+
+<li>(eveander and jsc) - added templates that were left out in the
+ecommerce module release
+
+<li>(eveander and jkoontz) - new release of the audit trail package
+(necessary for ecommerce module)
+
+<li>(eveander) - slight change in ecommerce data model to protect
+against inserting 2 rows into ec_admin_settings.  See
+http://photo.net/ticket/issue-view.tcl?msg_id=1601
+
+<li>(eveander) - modified various tcl scripts in the ecommerce module
+to fix bugs.  See: http://photo.net/ticket/issue-view.tcl?msg_id=1621,
+http://photo.net/ticket/issue-view.tcl?msg_id=1641, 
+http://photo.net/ticket/issue-view.tcl?msg_id=1701,
+http://photo.net/ticket/issue-view.tcl?msg_id=1721,
+http://photo.net/ticket/issue-view.tcl?msg_id=1741,
+http://photo.net/ticket/issue-view.tcl?msg_id=1761, and
+http://photo.net/ticket/issue-view.tcl?msg_id=1762
+
+
+<li>(teadams) prototype fixes submitted by John Lowry.
+http://photo.net/ticket/admin/issue-view.tcl?msg_id=1461 (tcl/ad-prototype.tcl)
+and http://photo.net/ticket/admin/issue-view.tcl?msg_id=1441 (/admin/prototype/tableinfo-3.tcl)
+
+<li> (teadams) fixed typo in /tcl/file-storage-defs.tcl (public_f instead of public_p)
+
+<li> (teadams) renamed /tcl/ad-prototype.tcl to /tcl/prototype-defs.tcl to reflect the fact that the prototype tool is an standalone module and not a part of ACS core.
+
+<li>(philg) augmented <code>ad_header</code> with an optional arg for
+extra stuff to put in the document HEAD (e.g., JavaScript)
+
+<li>(philg) improved /tcl/ad-html.tcl to never hold onto a db handle
+while writing to the connection (also improve cleanliness of display)
+
+<li> (teadams) edited /general-comments/comment-edit-2.tcl and /general-comments/comment-edit-3.tcl - fixed bug where you couldn't edit your comment.
+</ul>
+
+<p>
+
+
+<li>August 4, 1999:  Version 2.0:
+<ul>
+<li><a href="ecommerce.html">ecommerce module</a> (so huge that we decided to rev the major version number)
+</ul>
+<h4>minor fixes</h4>
+<ul>
+
+<li>(philg) - wrote docs for /news and /calendar modules 
+<li>(philg) - changed release script so that /templates/ with news
+subsystem example would go out in .tar file
+
+</ul>
+
+
+<p>
+
+<li>July 27, 1999:  Version 1.7:
+<ul>
+<li>standard package for adding comments to a table/module 
+<li>ticket tracker upgrade
+<li>Registration paramaterization and finite state machine (update every 
+file in /register and many in /admin, plus load script /doc/sql/upgrade-1.6-2.0-1.sql)
+
+<li>file storage system (requires our Oracle driver 1.03 or newer; you
+need the <code>ns_ora blob_dml_file</code> command); see 
+<a href="file-storage.html">file-storage.html</a>
+
+</ul>
+
+<h4>minor fixes</h4>
+<ul>
+
+<li>(teadams) - modified /tcl/news-defs.tcl (news_new_stuff).  The query to display new stuff to users had "release_date < sysdate".  This was modified to
+and "release_date > sysdate" in order to show news items that have been released in the past.
+
+<li>(jsc) added configurable file system root for the help system (and
+associated parameter in ad.ini); see /doc/help.html for details.
+
+<li>(philg) added Tracy's util_httppost code to utilities.tcl (not
+officially part of ACS)
+
+<li>(philg) added util_link_responding_p and util_get_http_status to
+utilites.tcl; useful for figuring out of a link is returning "404 Not
+Found" or whatever
+
+<li>(philg) enhanced the admin pages for links and comments to provide
+searchability, better sweeping (using
+<code>util_link_responding_p</code>), and one-click restoration of links
+thought to be dead by the sweeper
+
+<li>(philg) changed the most heavily hit /bboard pages to compute the
+page in a string, release the db handle, then ns_return the bytes
+(slightly worse user experience on unloaded system; much better
+performance under heavy load from many users with slow connections
+(fewer db handles tied up))
+
+<li>(teadams) changed /gc/place-ad-4.tcl to produce a user friendly
+error message when the mailer is down
+
+<li>(philg) added the new intranet-required fields to
+<code>users_contact</code> in community-core.sql (thank you, Sean Y)
+
+<li>(teadams) modified /ug/group-new-3.tcl to not produce an error message
+when the user doesn't fill in a non-new column
+
+<li> (teadams) added export_ns_set_vars to utilities.tcl (not officially 
+part of ACS)
+
+<li> (teadams) Added /admin/users/user-add.tcl, user-add-2.tcl and user-add-3.tcl to
+allow admin additions to ACS. Modified /admin/users/index.tcl to add a link.
+
+<li> (teadams) modified /tcl/ad-admin.tcl to allow /www/admin/users/action-choose.tcl to group by intranet users (employees) and groups.  This allows you to spam employees or groups.  Adding a link to "employees" on /www/admin/www/users/index.tcl, controled by the new paramter IntranetEnabled_p.  Adding link for "download or spam group" in /www/admin/ug/group.tcl. Modified /www/admin/www/action-choose.tcl to fix a spam bug (spamming was sending email all authorized users!) 
+
+<li> (teadams) fixed http://photo.net/issue-view.tcl?msg_id=1161  (formatting problem in prototype results)
+
+</ul>
+<p>
+
+<li>July 8, 1999:  Version 1.6:
+<ul>
+<li><a href="robot-detection.html">robot detection</a>
+
+<li><a href="intranet.html">intranet module</a> -- run your whole company from the ACS (that's what
+we do at ArsDigita and we've grown to $6 million in sales without any
+financing or major bloodshed).  Requires 
+<blockquote>
+<pre><code>
+alter table users_contact add (
+        cell_phone            varchar(100),
+        priv_cell_phone       integer,
+        note                  varchar(4000),
+        current_information   varchar(4000)
+);
+</code></pre>
+</blockquote>
+
+<li><a href="calendar-widget.html">calendar display module</a>
+
+
+<li>(philg) added standard way to do site-wide style and multi-languages
+via templating:
+<ul>
+<li>new column in users_preferences:
+<blockquote>
+<pre><code>
+	-- an ISO 639 language code (in lowercase)
+	language_preference	char(2) default 'en',
+</code></pre>
+</blockquote>
+<li>new document at <a href="http://photo.net/doc/style.html">/doc/style.html</a>
+<li>new procs in /tcl/ad-style.tcl 
+</ul>
+
+<li>(philg) added a standard way to do site-wide end-user help pages;
+see 
+<a href="http://photo.net/doc/help.html">/doc/help.html</a>
+
+<li>(hqm) added <a href="/doc/email-handler.html">a standard incoming
+email handler</a> (stuffs email into an Oracle table)
+
+<li>(hqm and philg) added <a href="/doc/ticket.html">a new ticket
+tracker module</a> with automatic integration of Web and email
+contributions (i.e., a programmer can be a full participant in
+discussions even if he or she only uses email).  The system includes a
+revised and simplified user interface and comes out from its hiding
+place under /admin/.
+
+<li>(philg) added a comprehensive system for presentation of new content
+site-wide to site admins, random Web surfers, and folks following via
+email.  Check out /tcl/ad-new-stuff.tcl, <a
+href="http://photo.net/shared/new-stuff.tcl">/shared/new-stuff.tcl</a>, and
+/admin/new-stuff.tcl.
+
+<li>(jsc and eveander) added a spell-checker and inaugurated a /tools/
+directory, documentated at <a href="/doc/tools.html">/doc/tools.html</a>
+
+<li>(teadams) added prototype builder that will allow developers to build standard add/edit/list pages via web forms <a href="/doc/prototype.html">/doc/prototype.html</a>
+
+<h4>minor fixes</h4>
+
+<li>added <code>util_report_library_entry</code> and
+<code>util_report_successful_library_load</code> to 
+utilities.tcl and call them from a bunch of /tcl files so as to make
+debugging easier in the event of a source code error
+(<b>**** you'll have to upgrade your utilities.tcl from 
+http://photo.net/wtr/thebook/utilities.txt to make your ACS work ****</b>)
+
+<li>fixed /chat/post-message.tcl to catch error where browser doesn't
+supply msg
+<li>(teadams) fixed /bboard/add-alert.tcl to use ad_maybe_redirect_for_registration.  Old method did not ns_urlencode spaces.
+
+<li>(teadams) added glossary section to ad.ini file (controls ApprovalPolicy)
+
+<li>(philg) fixed ad_user_class_query (in /tcl/ad-admin.tcl) for small
+sites where you're trying to query out every user
+
+<li>(philg) added active_p column to user_groups 
+
+<li>(philg) fixed "who's online now" to suppress email address if
+connected user isn't logged in
+
+<li>(philg) added query_strings_by_date index on query_strings table in community-core.sql
+
+<li>(philg) fixed /adserver/adimg.tcl to not interpose bogus /adserver/
+in path to ads (thank you, Raissa)
+
+<li>(philg) fixed bug in ad_administration_group_id
+
+<li>(philg) fixed var <code>url</code> being clobbered in /pvt/home.tcl
+by admin group url (thanks again, Raissa)
+
+<li>(philg) changed ad_maintain_last_visits_for_whosonline_internal so
+that if someone's second_to_last_visit was more than four times as long
+as the session expiration seconds (typically one day), we update the
+session (formerly we never updated the second_to_last_visit if someone
+was using JavaScript chat or otherwise coming to the server at least
+once per day)
+
+<li>(philg) moved /tcl/ad-chat.tcl to /tcl/chat-defs.tcl (more standard
+since chat is its own module)
+
+<li>(philg) took the symlinks from /tcl and make them ordinary files
+(and removed the defs.tcl files from the module dirs).  Did this for 
+adserver-defs.tcl, bboard-defs.tcl, calendar-defs.tcl, contest-defs.tcl,
+gc-defs.tcl.
+
+</ul>
+
+<p>
+
+<li>May 31, 1999:  Version 1.5:
+<ul>
+
+<li>fixed philg_quote_double_quotes (used by export_entire_form) in
+utilities.tcl to also quote &gt;, &lt, &amp; chars; this fixes some
+weird behavior when people try to discuss HTML in the /bboard system;
+<b>**** you'll have to upgrade your utilities.tcl from what you see at 
+http://photo.net/wtr/thebook/utilities.txt to get this fix ****</b>
+
+<li>fixed file upload-related bug in /bboard/insert-msg.tcl  (error when
+file uploads enabled but none specified)
+
+<li>because ns_striphtml is so stupid (removes &gt; and &lt; chars but
+doesn't remove teh tags within), change /bboard/insert-msg.tcl to 
+
+<li>fixed typo in bboard_uploaded_files definition (/doc/sql/bboard.sql)
+-- good catch, seany@altavista.net!
+
+<li>squashed a lot of bugs in the bboard photo uploading stuff and
+improved the user interface
+
+<li>added banner ideas system and applied it to the classifieds
+
+<li>added graphic package to generate bar charts
+
+<li>modified /doc/proc-one.tcl to distinguish optional variables
+
+<li>modified /admin/ug/group-info-edit-2.tcl to actually update 
+the user group helper table.
+
+<li>added /admin/categories/ to maintain canonical content categories
+("interests" as far as users are concerned) and also add info for when
+users see this as a mailing list thing
+
+<li>actually implemented the spamming/mailing list system
+(/mailing-list/ for the users /admin/spam/ for the admin).  One of these
+files used to end with "set db [ns_db gethandle]"!  What's the point of
+open-sourcing software if people don't tell us these things!
+
+<li>fixed a bug in the content section stuff whereby "require
+registration_p" did not automatically register a filter
+
+<li>added RegistrationRequiresApprovalP and
+RegistrationRequiresEmailVerification to ad.ini and made lots of changes
+to registration, login, and user admin pages to support private sites
+where people can't just register and waltz in; this necessitates adding
+an <code>approved_p</code> column to the <code>users</code> table, which
+in turns breaks lots and lots of pages site-wide (because
+<code>approved_p</code> becomes ambiguously defined in a JOIN)
+
+<li>added Yahoo-style nav bar in /calendar system
+
+<li>added content tagging system, esp. useful for flagging and replacing
+naughty words
+
+<li>added /chat system, which uses the content tagging system as a
+package
+
+<li>added /shared/whos-online.tcl, which is intertwined with chat and an
+index to support it: <code>users_by_last_visit</code> (in
+/doc/sql/community-core.sql)
+
+<li>added /tcl/ad-sidegraphics.tcl and corresponding section in ad.ini
+file; standard way to decorate lots of ACS pages (or custom pages that
+you might define); see <a
+href="http://photo.net/bboard/">http://photo.net/bboard/</a> for the system in use
+
+<li>added a "sort by usage" option to the /bboard system index page (and
+some graphics options)
+
+<li>added Yahoo-style navigation to the user group admin pages
+
+<li>Usability upgrade to the ticket tracker. Users can now do things like edit the issue's project.
+
+<li>standard package for adding auditing to Oracle tables:  <a href="audit.html">/doc/audit.html</a>
+
+
+
+<h4>pathetically small fixes/changes</h4>
+
+<li>fixed bug in /tcl/ad-monitor.tcl 
+
+<li>changed ad_administration_group_id to return "" if it can't find a
+group (instead of 0)
+
+</ul>
+
+<p>
+
+<li>April 18, 1999:  Version 1.4:
+<ul>
+<li>added the /glossary module 
+
+<li>augmented /bboard to handle arbitrary file uploads (and made image
+file uploads really work)
+
+<li>modified ad_generic_optionlist in /tcl/ad-widgets.tcl to use string compare instead of ==.  This solves some problems the TCL has with using integers with ==.
+
+<li>added bozo filters in the /bboard system (to prevent photo.net users
+from writing "aperature", for example)
+
+<li>added session tracking and reporting.  Keeps counts for each day of
+total sessions and repeat sessions, including both non-registered and
+registered users.  For registered users, we've added an
+<code>n_sessions</code> column to the <code>users</code> table.
+
+<li>added auditing to the classified ads (/gc) module; required new
+table definition for <code>classified_ads_audit</code>, two indices,
+audit insert statements all over the place.  Also removed some dead code
+and clarified the individual ad pages.
+
+<li>April 6, 1999 (teadams): Fixed clobs query in  
+/neighbor/post-new-5.tcl.
+
+<li>added statistics.tcl link to the q-and-a.tcl page for the bboard
+system
+
+<li>added Yahoo-style navigation (from ad-navigation.tcl) to the /bboard
+subsystem 
+
+<li>added Yahoo-style navigation (from ad-navigation.tcl) to the /gc
+subsystem 
+
+<li>added ability for /gc/ system to bounce ads that mention eBay
+
+<li>added <a href="/doc/permissions.html">/doc/permissions.html</a> package
+
+<li>added /gc/admin/ pages that use permissions system
+
+<li>dropped the ad_authorized_maintainers table from the classifieds.sql
+data model (replaced with generic permissions scheme)
+
+<li>created view users_active in /doc/sql/community-core.sql.  Modified view users_alertable to exclude banned users.
+
+<li>ad_handle_spammers in ad-antispam.tcl will block out IP addresses
+identified in the new [ns/server/photonet/acs/antispam] section of the
+ad.ini file; there is a "feign failure" mode where the spammer is
+treated to a bunch of ns_sleep commands
+
+<li>fixed bug in password system (make sure to upgrade to this version
+so that users won't get locked out if they choose the wrong passwords
+and also for better security)
+
+</ul>
+
+<P>
+
+<li>March 1, 1999:  Version 1.3:
+<ul>
+<li> Fixed the "From" field in daily and monday/thursday bboard email alerts.
+<li> Fixed /bboard/admin-community-view.tcl and subordinate pages to use the current data model.
+<li> Users are asked to log in before deleting a classified ad. (Users would visit an ad from an emails alert, click delete and then be told they were not authorized.)
+<li> Modified insert statement in /doc/sql/bboard.sql and classifieds.sql to prevent multiple inserts of seed rows. They are now PL/SQL blocks that first verify the row is not present. 
+<li>Added /tcl/ad-last-visit.tcl to maintain the last_visit and
+second_to_last_visit cookies and users table columns
+<li>Fixed notification message in /gc/place-bid-2.tcl. Changed mailto link to a link to the /shared/community-member.tcl in gc/place-bid.tcl
+<li>Moved call to bbaord_get_top_info in /bboard/q-and-a.tcl before the message output so users can't see private messages for bboard groups they are not in. 
+<li>Modified /shared/community-member.tcl to not return messages from private bboards.
+<li>Added user-error trapping code in /gc/place-ad-4.tcl to limit classified ad to 3600 characters
+<li> Fixed typo in the pl-sql procedure that added the system user in /doc/sql/community-core.sql.  Fixed typo in the pl-sql procedure that add the administrator user-group in /doc/sql/user-groups.sql.
+<li> Set QQtopic to <code>[DoubleApos $topic]</code> in /bboard/q-and-a-fetch-msg.tcl, /bboard/q-and-a-post-repl-form.tcl, /bboard/usgeospacial-fetch-msg.tcl, bboard/usgeospacial-post-reply-form.tcl
+<li> Modified /bboard/q-and-a-post-reply-form.tcl to use html_p.
+<li> Modified /admin/ug/member-add-2.tcl to fix a HTML table problem that occurred when a role was specified in the post. 
+<li> Modified query for user_group_map record in  /admin/ug/role-edit.tcl to contrain by group_id. 
+<li> Only queries supplement group information table if the table exists in /ug/group.tcl.
+<li> Upgraded the ticket tracking system to include status (open, closed, fixed waiting approval, etc).  To upgrade, you must add the column status to the ticket_issues table.
+
+<li>Added member value user charges to bboard deletion.
+<li>Added a "show me expensive users" feature to the admin index (when
+mv_enabled_p ).
+
+<li>Fixed /admin/users/one.tcl to display dates more cleanly and, more
+importantly, not to drag all the actual content of static pages out of
+Oracle when only the title and url stub were needed.
+
+<p>
+
+<li>Added a spam hunter to the links section
+<li>Added pages to manipulate the blacklist GLOB table to the
+/admin/links/ section
+
+<li>Installed the automatic dead link sweeper to the /admin/links/
+pages.  This required adding <code>checked_date	date</code> to the
+<code>links</code> table.
+
+<li>Moved the link-check.tcl procedure (spider to find dead links in
+static .html files) into /admin/static/ (from /admin/).  Linked it from
+the top-level static content admin page.
+
+<li>completely revamped the referral reporting system
+
+<li>Added a procedure <code>ad_context_bar</code> to
+/tcl/ad-navigation.tcl to support Yahoo-style navigation.
+
+<li>Added a Yahoo-style navigation system to the entire /admin tree
+
+</ul>
+
+<p>
+
+<li>February 8, 1999:  Version 1.2:
+<ul>
+
+<li>Added a content section to /parameters/ad.ini; useful for telling
+the ACS where the site map is and also whether the index.tcl page should
+be generated or served from a static file (the average publisher is
+going to want to take special care with the root page of the site).
+
+<li>Began experimenting with a nice tree view of all a site's static
+content (for the administrator) but gave up.  It is too slow on a big
+site such as Photo.Net to keep dragging all the information out of
+Oracle.  The correct solution is to wait a few weeks until Oracle 8.1
+comes out and we can run Java inside the server.  Then do most of the
+work inside Oracle.
+
+<li>Fixed a lot of bugs in the classified ad subsystem.
+<li> Fixed various bugs throughout the system. 
+<li> Added user choice of HTML verses Plain text to comment system.
+<li> Changed /bboard/insert-msg.tcl to isolate the mailer from the database handle by accumulating emails in a ns_set, releasing the handle, and them emailing the messages.
+<li>Added ticket(/admin/ticket) and address book modules
+
+<li>Added a <code>users_alertable</code> view to the database that
+excludes users who've been deleted, who are on vacation, or whose email
+address is generating bounces.  Added pages to let a user announce a
+vacation and then mark his or her return.  Changed all the procedures
+that generate alerts to query from <code>users_alertable</code> rather
+than <code>users</code>.
+
+<li>Removed the <code>administrator_p</code> column from the users
+table, added a predefined user_group of type "system", group name
+"administrators" that accomplishes the same function (lumping a set of
+users together as admins).
+
+<li>Much beefing up of the user groups stuff.
+
+<li>Added <code>ad_acs_version</code> and
+<code>ad_acs_release_date</code> to /tcl/ad-defs.tcl; these will let you
+write programs that adjust to the ACS version
+
+<li>Added ability for users to change passwords
+
+<li>Added /directory module so that users can look each other up
+(entails new section in ad.ini file)
+
+</ul>
+
+<p>
+
+
+
+<li>January 17, 1999:  Version 1.1.  
+<ul>
+<li>Added neighbor-to-neighbor module (under /neighbor)
+
+<li>Substantial improvements to admin pages
+
+<li>User's password (kept in cookie) is now crypted with ns_crypt (means
+users with persistent cookies will be asked to log in again).
+
+<li>Added a skeleton data warehousing module (/dw)
+
+<li>Added a data model for a IT collaboration server: GlassRoom; sadly,
+no .tcl scripts yet
+
+</ul>
+
+<p>
+
+<li>December 12, 1998:  Version 1.0.
+
+<p>
+
+<li>1995-1998:  private releases of different portions of the ACS
+
+</ul>
+
+
+
+<hr>
+<A href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/view-pl-sql.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/view-pl-sql.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/view-pl-sql.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,45 @@
+#
+# /doc/view-pl-sql.tcl
+#
+# 
+#
+# Author: michael@arsdigita.com, 2000-03-05
+#
+# view-pl-sql.tcl,v 3.1 2000/03/06 05:37:21 michael Exp
+#
+
+ad_page_variables {
+    name
+    type
+}
+
+set db [ns_db gethandle]
+
+set selection [ns_db select $db "select text
+from user_source
+where name = upper('$name')
+and type = upper('$type')
+order by line"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    append source_text $text
+}
+
+ad_return_top_of_page "[ad_header $name]
+
+<h2>$name</h2>
+
+a PL/SQL $type in this installation of <a href=\"\">the ACS</a>
+
+<hr>
+
+<blockquote>
+<pre>
+$source_text
+</pre>
+</blockquote>
+
+[ad_footer]
+"
Index: web/openacs/www/doc/webmail.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/webmail.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/webmail.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,271 @@
+<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
+<html>
+  <head>
+    <title>Web-based Email</title>
+  </head>
+
+<body bgcolor=#ffffff text=#000000>
+    <h2>Web-based Email</h2>
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="mailto:jsc@arsdigita.com">Jin Choi</a>
+
+<hr>
+
+<ul>
+<li> User-accessible directory: <a href="/webmail/">/webmail/</a>
+<li> Site adminstrator directory: <a href="/admin/webmail/">/admin/webmail/</a>
+<li> data model: <a href="/doc/sql/display-sql.tcl?url=/doc/sql/webmail.sql">/doc/sql/webmail.sql</a>
+<li> procedures: /tcl/webmail-defs.tcl
+</ul>
+
+<h3>The big picture</h3>
+
+In the beginning, email would get sent to your big Unix box and
+delivered to a central mail queue, where you would pick it up from
+time to time with your mail reader and store it permanently in your
+home directory somewhere. You telnetted to the machine, used your
+favorite mail reader, all your mail was available from one place, it
+got backed up every night along with everything else on the machine,
+and life was good.
+
+<p>
+
+Then along came POP. Mail was sent to your big Unix box where it got
+delivered to a central mail queue, from where you would pick it up
+from time to time with your mail reader. Only now, it would get stored
+on whatever machine you happened to be at the time that you decided to
+read it. You could tell it to keep all the mail on the server, but
+then every time you read your email, you would see things you'd
+already seen before, even mail you had deleted elsewhere. If you
+didn't tell it to keep your mail on the server it would get deleted as
+soon as you picked it up, and the only copy would be on your desktop
+machine or your laptop, with no backups whatsoever.
+
+<p>
+
+IMAP was invented to address this problem, giving both the benefits of
+POP along with the centralized mail reading convenience of the
+old-school style of doing things. True, probably your favorite mail
+reader didn't support IMAP just yet, but you could get by with what
+was available, and more readers were adding support all the
+time. Still, you might be stuck somewhere without a readily available
+IMAP client, and in today's hostile net environment, telnetting to the
+server in the clear is a no-no. This is where web-based email
+shines. Constant access to your email store wherever you may be, as
+long as a web browser is available. Combined with an IMAP interface to
+the same store, you can have the benefits of both worlds, and be
+almost as happy as when you were telnetting to your mail server.
+
+<p>
+
+This architecture is available today. You can sign up for an account
+at criticalpath.net, and they will set you up with an IMAP and
+web-based email account. You can install Oracle email server from a CD
+and get the same thing. Why yet another system? Ease of modification
+and flexibility. If you find yourself missing a feature from Critical
+Path's system that you would dearly love, you can request it of them
+and they might deign to provide it in the indeterminate future. You
+may or may not be able to modify the Oracle email system to your
+particular needs, but I wouldn't know as I haven't been able to figure
+out how it works. This module is flexible, easy to extend, and easy to
+understand. Or if not, at least all the source is there for you to
+look at.
+
+<h3>Architecture</h3>
+
+As far as possible, I've tried to avoid getting into implementing
+systems that have been done well before. That means no reinventing of
+mail software; no implementing of IMAP or SMTP protocols; no worrying
+about file locking and mail delivery. <a
+href="http://www.qmail.org/">qmail</a> and the UW IMAP server were
+written years ago by people who dedicated lots of effort to make sure
+they were done correctly. This module doesn't even look at email until
+it has been delivered by qmail as it would be to any user.
+
+<p>
+
+Once the mail has been delivered, it is parsed and inserted into
+Oracle by some Java code running inside Oracle. Using a relational
+database as the message store has many benefits. It provides a
+standard data model for multiple interfaces to hook up to. It makes it
+easy to do the web interface. It is fast and scalable. It makes
+implementing powerful email search facilities easy. Using Java lets us
+leverage the JavaMail API to do the hard work of parsing the
+messages. It also has the benefit of tight integration to Oracle
+through the JServer JSQL interface. For example, messages are read
+into a CLOB column by being streamed from the file system in bite
+sized chunks. If we were using, say, a perl DBI program to do the
+insertion, we would have to read the entire message into memory before
+writing it to the CLOB. With multi-megabyte emails becoming more
+common in today's media-rich environment, this has obvious benefits.
+
+<p>
+
+On the front end, we provide a more or less traditional ACS web module
+for the web-based front end, and an Oracle "driver" (mail store
+hookup) for the UW IMAP server to provide the IMAP interface (not yet
+written).
+
+
+<h4>Receiving Mail</h4>
+
+The webmail module interfaces with qmail to receive mail. All of the
+heavy lifting involved in getting email delivered reliably and in a
+standards-conformant manner is done by qmail.
+
+<p>
+
+The webmail system defines <i>domains</i> and <i>email accounts</i>. A
+domain is defined by a host name and a short string to be able to
+refer to it easily. The full domain name must correspond to a virtual
+domain that qmail is set up to receive email for. In the following,
+let us assume that "webmail.arsdigita.com" is the full domain name and
+"wm" is the short name.
+
+<ul>
+<li>Set up DNS so that the full domain name resolves to the host on
+which you are setting up this system (or set up an appropriate MX
+record).
+
+<li>Add a line consisting of the full domain name to
+/var/qmail/control/rcpthosts so that qmail knows to receive email for
+this domain.
+
+<li>Select a name for an email account that will be used to handle all
+the email for this system. This can be arbitrary, so we will just use
+"webmail" (if you want to use something else, you must edit the Java code).
+
+<li>Create a virtual user by adding the following line to /var/qmail/users/assign:
+<pre>
++webmail-:oracle:101:102:/home/nsadmin/qmail/alias:-::
+</pre>
+This says any email intended for "webmail-*@webmail.arsdigita.com"
+will be handled by the Unix user "oracle" (uid 101, gid 102) according
+to the alias files in the directory /home/nsadmin/qmail/alias. Make
+sure that directory exists, and can be written to by the nsadmin user:
+<pre>
+(as root):
+mkdirhier /home/nsadmin/qmail/alias
+chown nsadmin /home/nsadmin/qmail/alias
+</pre>
+The location of this alias directory can be changed by setting the
+AliasDirectory parameter in the webmail section of the ACS .ini file
+for this server.
+
+<li>Run /var/qmail/bin/qmail-newu to have the previous change take effect.
+
+<li>Add the following to /var/qmail/control/virtualdomains:
+<pre>
+webmail.arsdigita.com:webmail-wm
+</pre>
+
+This tells qmail that any mail sent to "*@webmail.arsdigita.com" will
+be handled by the webmail virtual user, and have "-wm" appended to the
+username portion of the email address. So, mail sent to
+"foo@webmail.arsdigita.com" will be delivered to the webmail user as
+"webmail-wm@webmail.arsdigita.com".
+
+<li>Register this domain with the webmail system by using the
+administration pages, with (again, just for this example) "wm" as the
+short name and "webmail.arsdigita.com" as the domain name. (You will
+need to load the data model file to do this, which requires that the
+Java libraries be loaded, see below).
+
+<li>Create a queue directory for deliveries to the webmail user. Make
+sure it is writable and readable by the oracle Unix account (or
+whatever user Oracle runs at):
+<pre>
+(as root:)
+/var/qmail/bin/maildirmake /home/nsadmin/qmail/queue
+chown -R oracle /home/nsadmin/qmail/queue
+</pre>
+The location of the queue directory can be changed by setting the
+QueueDirectory parameter in webmail section of the ACS .ini file for
+this server.
+</ul>
+
+<p>
+
+Once the domain has been set up, you can start adding email
+accounts. An email account is tied to an ACS user; an ACS user can
+receive email at any number of different accounts, on any domains that
+this host receives email for. Once received, they are treated
+identically, and are indistinguishable other than from the email
+headers. Email accounts can be assigned to users by using the
+administration pages.
+
+<p>
+
+When an email account is added, a file is created automatically in the
+alias directory of the form ".qmail-[short domain name]-username"
+(e.g., ".qmail-wm-jsc") that contains one line with the full path to
+the queue directory (/home/nsadmin/qmail/queue/). This file specifies
+that mail sent to "webmail-wm-jsc@webmail.arsdigita.com" be delivered
+to the maildir directory that we have set up. All email to be handled
+by the webmail system ends up in the same place
+(/home/nsadmin/qmail/queue/new). The system uses the RFC822
+Delivered-To header to distinguish who it should be displayed to. The
+indirection through the .qmail alias files is done so that only email
+sent to valid accounts will be received. Email sent to an address that
+does not have a .qmail file set up for it will bounce normally.
+
+<p>
+
+Once every minute, Oracle polls the new directory of the maildir queue
+and picks up any mail that has been delivered. Using the JavaMail
+library running inside Oracle, it stores and parses the message, and
+saves off various pieces of information (parsed headers, attachments,
+etc.; see the <a
+href="/doc/sql/display-sql.tcl?url=/doc/sql/webmail.sql">data
+model</a>).
+
+<p>
+
+To install the Java portion of this module, download the JavaMail
+library from <a
+href="http://java.sun.com/products/javamail/">http://java.sun.com/products/javamail/</a>
+and the JavaBeans Activation Framework from <a
+href="http://java.sun.com/beans/glasgow/jaf.html">http://java.sun.com/beans/glasgow/jaf.html</a>.
+Unpack the distributions and load activation.jar and mail.jar into Oracle:
+<pre>
+loadjava -user dbuser/dbpasswd -resolve -verbose activation.jar
+loadjava -user dbuser/dbpasswd -resolve -verbose mail.jar
+</pre>
+(You may get a verification warning attempting to resolve
+javax/activation/ActivationDataFlavor which you can ignore.) The
+database user must have been granted the JAVASYSPRIV role.
+
+<p>
+
+Then load the various Java files in the /webmail/java directory:
+
+<pre>
+loadjava -user dbuser/dbpasswd -resolve -verbose BlobDataSource.java ClobDataSource.java MessageParser.sqlj MessageComposer.sqlj
+</pre>
+Make sure you create the PL/SQL bindings in the data model file and
+create the job which will poll the mail queue.
+
+<p>
+
+To test that you are receiving mail properly, send a message to
+user@full_domain_name. A new file should immediately be created in
+/home/nsadmin/qmail/queue/new. If one does not appear, check out the
+qmail error logs (usually /var/log/qmail/current) to see what the
+problem might be. If you have started the polling job, the file should
+disappear in less than a minute, and the message should be waiting in
+the user's INBOX.
+
+<h4>Reading Email</h4>
+
+The web interface should be self-explanatory and documented with Help
+links. The IMAP interface isn't yet written, so there is no
+documentation for it.
+
+    <hr>
+    <address><a href="mailto:jsc@arsdigita.com"></a></address>
+<!-- Created: Mon Feb 28 08:45:15 EST 2000 -->
+<!-- hhmts start -->
+Last modified: Wed Mar  1 05:16:54 EST 2000
+<!-- hhmts end -->
+  </body>
+</html>
Index: web/openacs/www/doc/webmasters.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/webmasters.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/webmasters.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,109 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Webmasters Guide</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Webmasters Guide</h2>
+
+to the <a href="index.html">ArsDigita Community System</a>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>
+
+<hr>
+
+This document contains instructions and pointers for the person who
+makes publishing decisions on a site backed by the ArsDigita Community
+System.
+
+<h3>Setting up your site</h3>
+
+First, decide which major modules of the ArsDigita Community System
+you're going to actually use.  For example, you might say 
+
+<ul>
+<li>yes, we'll use the /bboard discussion system
+<li>no, we're not going to have classified ads from /gc
+
+<li>yes, we're going to track all clickthroughs from our site to others
+
+<li>since we don't have banner ads, we're not going to use the banner ad
+server 
+
+<li>yes, we're going to use the member value system to bill people a
+subscription fee every month
+
+</ul>
+
+You can realize these decisions to some extent by using the forms in
+/admin/content-sections/ but also by editing any static .html files that
+you might have.
+
+<p>
+
+Second, decide how much moderation you want to do.  Generally, the
+ArsDigita Community System allows anything to be commentable.  For
+example, there are facilities to let users comment on a static .html
+file.  User A can post a news item and User B can comment on that news
+item.  Any time that users are able to contribute content, you can
+choose between three moderation policies:
+
+<ul>
+
+<li>open -- contribution goes live immediately; moderator may be
+notified via email; moderator can revoke approval or delete the
+contribution if he or she wishes.  
+
+<li>wait -- the software solicits contributions from readers but doesn't
+show those contributions to other readers until a moderator has approved
+them
+
+<li>closed -- the software does not solicit contributions from readers
+
+</ul>
+
+Note that these are configurable.  For example, in February 1999,
+http://photo.net/photo/ had an open policy for /bboard, a wait policy
+for top-level /news items, and an open policy for comments on approved
+news items.  For policy configuration, have your programmer edit your
+/parameters/ad.ini file and restart the Web server.
+
+<h3>Editing standard files</h3>
+
+
+Visit /www/global/ and edit the standard files that AOLserver (if
+properly configured) will send for server error messages, file not
+found, etc.  You might also want to take advantage of our predrafted
+copyright and privacy.adp pages (you will have to work these into your
+site).
+
+
+<h3>Maintenance</h3>
+
+Users hate dead links.  They will complain to you via email even if it
+isn't your fault so you want to make sure that you at least get rid of
+dead links in 
+
+<ol>
+<li>your static .html content
+<li>user-submitted related links
+</ol>
+
+The ArsDigita Community System contains automated tools to help you
+check both potential sources of dead links.  Every few weeks, run
+/admin/static/link-check.tcl to make sure that your static .html files
+don't contain embedded references to sites that no longer exist.  
+
+<p>
+
+For the user-submitted links, visit /admin/links/ and you'll find an
+automated sweeper that checks every user-submitted link.  If a link is
+unreachable on three successive tries (separated by at least 24 hours),
+the ArsDigita Community System will ignore it in the future (though you
+can still recover it from the database).
+
+
+<hr>
+<a href="http://photo.net/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/doc/wimpy2.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/wimpy2.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/wimpy2.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,182 @@
+<html>
+<head><title>6.916: WimpyPoint II</title></head>
+<body bgcolor=white>
+
+<h2>WimpyPoint II</h2>
+
+by <a href="mailto:jsalz@mit.edu">Jon Salz</a><br>
+Revision 2 (13 Nov 1999)
+
+<hr>
+
+<h3>Overview</h3>
+This document outlines the design and implementation strategy planned
+for improving WimpyPoint, including (in order of priority):
+
+<ul>
+  <li>Integration with ACS (e.g., fixing naming conventions and using ACS users).
+  <li>Allowing authors to freeze presentations, and later view older versions
+      of the presentation or revert to a previous, frozen version.      
+  <li>Unlimited length for slide content.
+  <li>Allowing files and images to be attached to slides.
+  <li>User/group-based access control (ACL lists).
+  <li>Implementing data mirroring (copying everything to a backup server
+      nightly).
+  <li>Allowing users to upload and maintain their own style sheets.
+  <li>Allowing viewers to override authors' style information.
+  <li>User-interface improvements in authoring mode.
+</ul>
+
+<h3>Data Model</h3>
+The tentative new data model is available
+<a href="sql/wimpysql.txt">here</a>.
+It differs
+from the old data model in the following ways:
+
+<h4>Naming Conventions</h4>
+All tables will begin with the prefix <tt>wp_</tt>. This provides
+consistency with ACS and will ease migration (see <a href="#migration">Migration</a>).
+
+<h4>ACS Integration</h4>
+There will be no table specifically tracking WimpyPoint users - instead, we will use
+WimpyPoint users and groups.
+
+<h4>Access Control</h4>
+The new <tt>wp_user_access</tt> and <tt>wp_group_access</tt> tables describe the set of privileges
+available to particular users/groups with respect to a presentation. A user or group may
+have
+
+<ul>
+  <li><tt>read</tt> access, allowing the user to view the presentation even
+    if it is not public.
+  <li><tt>write</tt> access, allowing the user (a "collaborator") to edit the presentation.
+  <li><tt>admin</tt> access, allowing the user (an "owner") to change the ACL, invite
+    collaborators, freeze the presentation, delete the presentation, etc.
+</ul>
+
+<p>An administrator can invite another user to collaborate (or co-own the
+presentation) by adding him to the ACL list. (WimpyPoint will notify the
+invitee via E-mail if requested.) If the user is not already an ACS user
+(and thus cannot be added to the ACL), WimpyPoint will issue a "ticket"
+(a row in the <tt>wp_user_access_ticket</tt>) which can be redeemed for
+an ACL entry once the account is created. The ticket is protected by a
+secret text string which is encoded into the URL sent to the invitee
+as part of the invitation request.
+
+<h4>Versioning</h4>
+WimpyPoint will allow authors to freeze presentations,
+causing the server to maintain a copy of the current state of the presentation.
+To freeze a presentation we set a "checkpoint," causing WimpyPoint to make any future
+modifications to any slide in a separate copy. The current checkpoint
+ID for a presentation is stored in <tt>wp_presentations.checkpoint</tt>. Operations
+on slides are handled as follows:
+
+<ul>
+<li>To obtain the most recent version of a slide <i>ss</i>, use a query like
+<blockquote><pre>
+SELECT *
+FROM   wp_slides sl
+WHERE  slide_id = <i>ss</i>
+AND    checkpoint = (SELECT MAX(checkpoint) FROM wp_slides WHERE slide_id = sl.slide_id)
+AND    deleted_in_checkpoint IS NULL
+</pre></blockquote>
+In other words, we select the row with the maximum checkpoint.
+
+<li>To obtain the slide as it was when we set checkpoint <i>nn</i>:
+<blockquote><pre>
+SELECT *
+FROM   wp_slides
+WHERE  slide_id = <i>ss</i>
+AND    checkpoint = (SELECT MAX(checkpoint) FROM wp_slides
+                     WHERE  slide_id = sl.slide_id
+                     AND    checkpoint <= <i>nn</i>)
+AND    (deleted_in_checkpoint IS NULL OR deleted_in_checkpoint > <i>nn</i>)
+</pre></blockquote>
+Again, we select the row with the maximum checkpoint, this time subject to the constraint
+that the checkpoint is <i>nn</i> or earlier (i.e., get the latest change before <i>nn</i>).
+
+<p>Note that these previous two queries are not specific to querying for single
+slides; for instance, to view the most resent version of an entire presentation <i>pp</i>,
+simply change <tt>slide_id = <i>ss</i></tt> to <tt>presentation_id = <i>pp</i></tt> and
+add <tt>ORDER BY sort_key</tt>.
+<li>To modify a slide, we check and see if the current version of the slide has <tt>checkpoint</tt>
+set to the most recent checkpoint for the presentation (stored in <tt>wp_presentations.checkpoint</tt>).
+If so, we modify the slide in-place using an <tt>UPDATE</tt>; if not, a checkpoint has been set since
+the last modification so we must create a new row in the <tt>wp_slides</tt> table referring to the
+most recent checkpoint.
+<li>To add a slide, we simply add a row to <tt>wp_slides</tt> with <tt>checkpoint</tt> set to the
+most recent checkpoint for the presentation.
+<li>To delete a slide (assuming that the current checkpoint for the presentation is <i>cc</i>):
+<blockquote><pre>
+DELETE FROM wp_slides
+WHERE  slide_id = <i>ss</i> AND checkpoint = <i>cc</i>
+
+UPDATE wp_slides
+SET    deleted_after_checkpoint = <i>cc</i>
+WHERE  presentation_id = <i>pp</i>
+</pre></blockquote>
+</ul>
+
+<h4>Images and Attachments</h4>
+Users will be able to upload images and attachments to display in
+slides, either inline or with an explicit link.
+
+<p>Users can upload attachments and images to be displayed inline (embedded
+in the page) or separately. These are stored in a separate table
+(<tt>wp_attachments</tt>) so that multiple versions of a presentation can
+share them.
+
+<h4>Styles</h4>
+Style information is not limited to a CSS file name - styles will be
+stored as rows in the <tt>wp_styles</tt> table. A style contains
+a name, a description, CSS source (included inline when presentations
+are displayed), and optionally an owner who can maintain the style.
+Users will be able to upload images associated with their style sheets
+(stored in <tt>wp_style_images</tt>).
+
+<p>Individual readers can override authors' style preferences, e.g.,
+if the reader prefers black text on white text because he/she needs to
+deal with a finicky projector.
+
+<h3>Implementation</h3>
+
+Implementation steps:
+
+<ul>
+  <li>Migrate the existing code to the new data model (this includes
+      ACS integration).
+  <li>Clean up the authoring interface.
+  <li>Add support for versioning.
+  <li>Implement unlimited slide length and image/attachment upload.
+  <li>Add access control.
+  <li>Set up data mirroring (the backup server will run WimpyPoint,
+      but with editing features disabled).
+  <li>Implement the new style management system.
+</ul>
+
+It would also be very cool and useful to allow the user to download a tarball/zipfile
+of an entire presentation
+(<a href="http://intranet.arsdigita.com/proposals/admin/details.tcl?proposal_id=764&title=Improve%20WimpyPoint%20and%20integrate%20with%20ACS">thanks, Richard Tibbets</a>),
+but this is really low priority.
+
+<h3><a name=migration>Migration</a></h3>
+
+All existing presentations will be migrated to the new data model.
+We will write a script which:
+
+<ul>
+  <li>Creates an ACS user entry for each WimpyPoint user.
+  <li>For each presentation in the old WimpyPoint, reads the
+    presentation and slides and inserts the appropriate rows
+    into tables in the new data model, mapping WimpyPoint users
+    to ACS users, ownership privileges to ACL entries, etc.
+</ul>
+
+This will be fairly easy because the new data model is a functional
+superset of the old data model.
+
+<hr>
+<address><a href="mailto:jsalz@mit.edu">jsalz@mit.edu</a></address>
+
+</body>
+</html>
Index: web/openacs/www/doc/wp.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/wp.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/wp.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,159 @@
+<html>
+<head>
+<title>WimpyPoint</title>
+</head>
+
+<body bgcolor=white text=black>
+<h2>WimpyPoint</h2>
+
+part of the <a href="">ArsDigita Community System</a><br>
+by <a href="http://photo.net/philg/">Philip Greenspun</a>,
+   <a href="http://www.coordination.com/krish/">Krish Menon</a>, and
+   <a href="mailto:jsalz@mit.edu">Jon Salz</a>
+
+<hr>
+
+<ul>
+<li>User-accessible directory: <a href="/wp/">/wp/</a>
+<li>Data model: <a href="/doc/sql/display-sql.tcl?url=/doc/sql/wp.sql">/doc/sql/wp.sql</a>
+<li>Procedures: /tcl/wp-defs.tcl
+</ul>
+
+<h3>History</h3>
+
+WimpyPoint was born as a standalone application, started by Philip Greenspun
+in late December, 1997 and later enhanced by Krish Menon. WimpyPoint was 
+rewritten by Jon Salz and reborn as an ACS module in late 1999, as
+a term project for MIT's <a href="http://6916.lcs.mit.edu">6.916: Software Engineering of Innovative Web Services</a> class.
+
+<p>For more general information, see
+the <a href="/help/for-one-page.tcl?url=%2fwp%2findex%2etcl">the user-level help pages</a>.
+
+<h3>Data Model</h3>
+
+<h4>Styles</h4>
+
+The standalone WimpyPoint provided only limited style support: it allowed users to select
+from a limited set of CSS style sheets to associate with each presentation. Users can now
+maintain their own repositories of styles. Each style is a row in the <tt>wp_styles</tt>
+table. Users can provide colors (stored in table columns in the form <tt>192,192,255</tt>)
+and optionally background image.
+
+<p>A style can be marked public, meaning that every user can view it. (For instance,
+the "Default (Plain)" style is public.) The UI does not provide any mechanism for
+styles to be marked public (administrators should just use SQL*Plus to change <tt>public_p</tt>).
+
+<p>Note that the <tt>wp_styles</tt> and <tt>wp_style_images</tt> tables are interdependent,
+so if you wanted to drop either table you'd need to use the <tt>CASCADE CONSTRAINTS</tt>
+option to <tt>DROP TABLE</tt>.
+
+<p>The style mechanism has much more general applicability than just to WimpyPoint - it
+might be useful in the future to abstract this out somehow to provide cross-module style-editing
+support.
+
+<h4>Versioning</h4>
+
+The data model is complicated significantly by versioning support,
+which allows the owner of a presentation to freeze the slide set (and
+later view previous versions, or revert to them). Each presentation
+is associated with a nonempty set of "checkpoints," each a row in the
+<tt>wp_checkpoints</tt> table.
+Each slide is associated with the range of checkpoints
+<tt>[min_checkpoint, max_checkpoint)</tt> in <tt>wp_slides</tt> (a <tt>max_checkpoint</tt>
+of <tt>NULL</tt> corresponds to infinity, i.e., the latest version).
+
+<p>In general, when a slide is edited and hasn't been changed
+since the latest checkpoint, we make a new copy of the slide and fiddle
+with the <tt>(min|max)_checkpoint</tt> of the old and new slide; when a slide is deleted,
+we just set <tt>max_checkpoint</tt> to the current checkpoint (so it becomes
+invisible in the most recent "view"). See <tt>slide-edit-2.tcl</tt> and
+<tt>slide-delete-2.tcl</tt> for examples.
+
+<p>When a slide set is frozen, we preserve the sorted order of the slides
+in <tt>wp_historical_sort</tt>. Without this facility, in order to maintain
+the versioning abstraction, whenever a user reordered slides
+in a versioned presentation we'd have to recopy all the slides (defeating
+the incremental nature of our versioning implementation).
+
+<p>The <tt>wp_(previous|next)_slide</tt> functions determine
+the slide before/after a particular slide when viewing the slide set at
+a particular checkpoint (a <tt>v_checkpoint</tt> of <tt>NULL</tt>) corresponds
+to the latest version).
+
+<p><tt>wp_set_checkpoint</tt> and <tt>wp_revert_to_checkpoint</tt> do pretty
+much what you'd think.
+
+<h4>Access Control</h4>
+
+Access control is handled using ACS groups. The <tt>wp_access</tt> function
+determines, given a user's ID (or <tt>NULL</tt> for an anonymous user and
+some fields from <tt>wp_presentations</tt>, what privileges the user has
+with respect to the presentation.
+
+<h3>Tcl Definitions</h3>
+
+This was a term project, so I (<a href="mailto:jsalz@mit.edu">Jon</a>) was
+eager to do something interesting from an engineering standpoint,
+and went maybe a little overboard with
+the abstractions involved. I don't think these are bad abstractions per se -
+they consolidate code which, while taking 6.916, I found myself writing over and over -
+but in retrospect maybe using abstraction so heavily is not The ACS Way(tm).
+
+<ul>
+<li><tt><b>wp_select</b></tt>, a control structure, takes the
+place of the usual <tt>ns_db select</tt>/<tt>ns_db getrow</tt>/<tt>set_variables_after_query</tt>
+loop. You can do:
+
+<blockquote><pre>wp_select $db "select foo, bar from whatever" {
+    ns_write "&lt;li&gt;$foo, $bar\n"
+} else {
+    ns_write "&lt;li&gt;nothing selected\n"
+}</pre></blockquote>
+
+<li><tt><b>wp_prepare_dml</b></tt>, given a table name, and names and values of columns, prepares
+an <tt>UPDATE</tt> or <tt>INSERT</tt> statement. In general, this facilitates the consolidation
+of pages which add records and edit existing records (e.g., <tt>slide-edit-2.tcl</tt> and
+<tt>slide-add-2.tcl</tt> are wrapped into <tt>slide-add.tcl</tt>). This is useful since
+<tt>-add</tt> and <tt>-edit</tt> pages often have to do the same kind of input validation
+anyway.
+
+<li><tt><b>wp_clob_dml</b></tt> applies an <tt>INSERT</tt> or <tt>UPDATE</tt> DML statement (such as that prepared by
+<tt>wp_prepare_dml</tt>), optionally with up to three CLOBs provided in a list.
+
+<li><tt><b>wp_try_dml</b></tt> and <tt><b>wp_try_dml_or_break</b></tt> try to execute a <tt>DML</tt> statement
+but generate an appropriate error message if it fails. (<tt>wp_try_dml_or_break</tt> additionally does a
+<tt>return -code return</tt> in this case.)
+
+<li><tt><b>wp_only_if</b></tt> returns certain text if a condition is true, else other text.
+This is useful for embedding in long strings, e.g.:
+
+<blockquote><pre>ns_write "
+... stuff ...
+
+&lt;option [wp_only_if { $id == 1 } "selected"]&gt;Nummer Eins
+&lt;option [wp_only_if { $id == 2 } "selected"]&gt;Nummer Zwei
+
+... more stuff ...
+"</pre></blockquote>
+
+<li><tt><b>wp_header</b></tt>, given an <tt>ad_context_bar</tt>-style argument list, generates
+the entire header for a page. The title is simply the last element of the argument list.
+<i>Your Workspace</i> is included in the header only if the user is currently logged in.
+
+<li><tt><b>wp_header_form</b></tt> is just like <tt>wp_header</tt>, except that the first
+argument contains attributes to insert into a <tt>&lt;form&gt;</tt> tag placed at the top
+of the page. (We always insert <tt>&lt;form&gt;</tt> at the very top of a page because
+placing it anywhere else results in unsightly extra white space.)
+
+<li><tt><b>wp_slider</b></tt> generates a slider given a list of options. It's typically
+used like this:
+
+<blockquote><pre>ns_write [wp_slider "age" $age \
+    [list [list 7 "Week Old"] [list 30 "Month Old"] [list all "All"]]]</pre></blockquote>
+
+</ul>
+
+</body>
+</html>
+
+
Index: web/openacs/www/doc/writing-a-module.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/writing-a-module.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/writing-a-module.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,261 @@
+<html>
+<!--AD_DND-->
+<head>
+<title>Writing an ACS Module</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Writing an ACS Module</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+by <a href="mailto:tarik@arsdigita.com">Tarik Alatovic </a> 
+
+<hr>
+
+<h3>The Big Picture</h3>
+
+An ACS module is a self-contained subsystem delivering a service
+visible to the end-user.  From a programmer's point of view, it is a
+collection of sql table definitions supported by HTML interface
+generated by a scripting language such as Tcl.  In order for a module
+to become a part of <a href=http://photo.net/wtr/using-the-acs.html>
+ArsDigita toolkit</a>, it must implement <i>common and reusable</i> 
+functions. Examples of modules in the <a href=http://photo.net/wtr/using-the-acs.html>
+ArsDigita toolkit</a> are <a href=news.html>News</a>, <a href=bboard.html>
+Bulletin Board</a>, <a href=address-book.html>Address Book</a> and 
+<a href=ecommerce.html>Ecommerce</a>.
+
+<h3>Module Implementation Checklist</h3>
+<ul>
+<li>put the SQL data model in /doc/sql/module-name.sql
+<li>put an HTML file explaining how to configure and use the module in /doc/module-name.html
+<li>put the user scripts in /module-name/
+<li>put the module administrator scripts in /module-name/admin/
+<li>put the site-wide administrator scripts in /admin/module-name/
+<li>put commonly called procedures in the private tcl directory (/web/yourdomain/tcl) as module-name-defs.tcl
+<li>if your module results in content being posted to the site, write a procedure to interface to the <a href="new-stuff.html">new
+stuff</a> system and put it in your defs.tcl file, along with some in-line code to add it to the ns_share'd variable <code>ad_new_stuff_module_list</code>
+<li>write a procedure to interface to the /tcl/ad-user-contributions-summary.tcl system (similar to the new stuff system but for stuff you want to show up on the
+/shared/community-member.tcl and /admin/users/one.tcl pages)
+</ul>
+
+
+<h3>Module Architecture</h3>
+
+<ul>
+<li><b>Directory Structure</b>
+<p>
+Let's take <a href=faq.html>faq module</a> (Frequently Asked
+Questions) as an example. Its files are stored in three directories:
+/faq, /faq/admin and /admin/faq.  We need these three separate
+directories in order to support three levels of access to the module
+data: public, module administrator and site-wide administrator.  Pages
+in /faq are public pages showing questions and answers.  Pages in
+/faq/admin are used by module admistrator to add, edit or remove
+faq questions and answers. Pages in /admin/faq are provided for
+site-wide administrator who may need to add or delete whole faqs,
+collect faq module statistics (e.g, how many people used the faq module in
+the previous month) and be able to do other operations refering to the
+whole faq module and not just to an instance of it.
+<p>
+<li><b>Data Model</b>
+<p>
+Data model for the module should reside in /doc/sql directory
+(e.g. /doc/sql/faq.sql for faq module).  
+<a href=http://photo.net/sql/data-modeling.html>Data modeling</a> is the
+hardest and most important part of any module. If you get the data
+model wrong, your module might not do what users need, it might be
+unreliable, and it might fill up the database with garbage. In order
+to support module customization and module scoping, your data model
+needs to conform with ACS standards (see Module Customization and
+Scoping sections bellow for the changes you need to make to your
+data model). All tables, sequences, functions, triggers, views, etc. 
+should be prefixed with the module name or its abbreviation in order
+to avoid naming conflicts (e.g. faq_q_and_a for faq questions and answers).
+<p> 
+<li><b>Utility Functions</b>
+<p>
+All the Tcl functions you write for your module should go to your
+private tcl directory (e.g. faq module has its Tcl functions stored
+in faq-defs.tcl). Procedures should be prefixed with the module name
+or its abbreviation (e.g. faq_maintainer_p), in order to avoid naming
+conflicts. If you think you wrote a generic Tcl function that
+everybody can use, then you can send e-mail to <a href=mailto:jsc@mit.edu>
+jsc@mit.edu</a> and suggest that your function becomes a part of ArsDigita Toolkit
+ utility functions.
+</ul>
+
+<h3>Module Documentation</h3>
+
+Every module should have its documentation in HTML format in the /doc
+directory (e.g. /doc/faq.html for faq module). This documentation is
+primarily intended for programmers and should be brief and technical
+as necesssary. It should list the features that this module provides,
+explain purpose of the module, possible uses and discuss design decisions. 
+For good example of documentation, take a look at <a href=/doc/chat.html>
+Chat Module Documentation</a>.
+
+<h3>Module Customization</h3>
+
+A good, reusable module will be used in many ArsDigita installations
+and it may be required to perform a slightly different funcionality
+then the default one.  A way to customize a module, so that it can be
+configured to support several different modes of operation is through
+usage of parameters.
+
+There are two levels at which the module can be customized: module and instance level. 
+<ul>
+
+<p>
+<li><b>Module Level Customization</b>
+<p>
+Module customization includes parameters that are used by the whole module.
+These parameters should be put in configuration file your_server_name.ini 
+in the parameters directory. 
+For download module, parameters in configuration file look like this:
+
+
+<code>
+<pre>
+[ns/server/yourservername/acs/download]
+; root directory of the downloadable files
+DownloadRoot=/web/photonet-dev/download/
+</pre>
+</code>
+
+These parameters can be accessed from within the code using the
+<code>ad_parameter</code> function.
+<p>
+<li><b>Instance Level Customization</b>
+<p>
+ 
+An ACS module is a collection of sql table definitions supported by
+HTML interface.  An <i>instance</i> of a module uses this table definitions
+and HTML interface to present a module functionality to the user. For
+example, an <i>instance</i> of chat module is a chat room, an <i>instance</i>
+of a bulletin board is a bulletin board for a certain topic and an
+<i>instance</i> of faq module is a faq collection, such as, AOL Server FAQ or
+Novice Photographers FAQ.
+
+Note that not all modules support multiple <i>instances</i> (e.g.
+eccomerce module has only one <i>instance</i>).  Modules supporting
+multiple <i>instances</i> should have parameters kept in columns of
+the table where module <i>instances</i> are defined.  For chat module,
+instances are chat rooms and parameters are columns in the chat_rooms
+table.  For example, parameter that determines whether chat room should be
+moderated is kept in the moderated_p column of the chat_rooms table. 
+Parameter moderated_p configures an <i>instance</i> of the chat module
+and not the whole chat module.  When using parameters, you should
+make decision whether parameter should be associated with module and
+be put in parameters file or associated with a particular
+<i>instance</i> of the module and be stored in the database.
+</ul>
+
+<h3>Module Scoping</h3>
+
+Standards for module scoping have been introduced in ArsDigita toolkit
+release 3.0.  Before this release, very few modules supported
+scoping. For example, the address book module provided an address book
+<i>instance</i> for each user
+<p>
+ArsDigita standard defines three scopes: public, group and user.
+<ul>
+<li>Public <i>instance</i> of module is associated with the whole installation and 
+it serves all users (e.g. photo.net/news is public <i>instance</i> of news module
+and it provides news items of interest to all users).
+<li>Group <i>instance</i> of module is associated with particular group. For example,
+news section of Novice Photogaphers provides news of interest for novice photographers
+only. News items are administered by the Novice Photographers group administrator.
+<li>User <i>instance</i> of module is associated with particular user. For example,
+Philip owns his address book and he is the only person who has the right to
+view, add and edit records in that address book.
+</ul>
+
+Notice that scoping makes sense only for the modules supporting 
+multiple <i>instances</i>, since scoping concept applies only to the 
+<i>instances</i> of the module and not the module itself. 
+In order to support scoping, your data model should include columns:
+ scope, user_id and group_id in the table where module <i>instances</i> 
+are defined. If user scope is not supported, then you don't need to 
+have user_id column, and if group scope is not supported then you don't
+need to have group_id column. Here is the example of the faq data model, 
+which supports scoping:
+ 
+<code>
+<pre>
+create table faqs (
+	faq_id		integer primary key,
+	-- name of the FAQ.
+	faq_name	varchar(250) not null,
+	-- group the viewing may be restricted to 
+	group_id	integer references user_groups,
+	-- permissions can be expanded to be more complex later
+        scope		varchar(20),
+        -- insure consistant state 
+       	constraint faq_scope_check check ((scope='group' and group_id is not null) 
+                                          or (scope='public' and group_id null))
+);
+</pre>
+</code>
+
+Notice that faqs don't support user scope, so user_id is ommited and faq_scope_check
+restricts scope to public and group only.
+
+<h3>Module Integration</h3>  
+
+If module supports multiple <i>instances</i> and scoping, you can decide to
+implement ACS interface for associating module with groups and users
+(i will refer to modules implementing this interface <i>embeddable</i>
+modules). Examples of <i>embeddable</i> modules are faq, news and address
+book module. <i>Embeddable</i> modules can be easily associated with groups
+through admin user group pages in /admin/ug. 
+
+There are two steps in making an <i>embeddable</i> module:
+<ul>
+<li>Register the module in <a href="/doc/sql/display-sql.tcl?url=/doc/sql/modules.sql">acs_modules table</a>.
+    For example, news module registration is the following insert statement:
+    <code>
+    <pre>
+    insert into acs_modules
+    (module_key, pretty_name, public_directory, admin_directory, site_wide_admin_directory, module_type, supports_scoping_p, documentation_url, data_model_url)
+    values
+    ('news', 'News', '/news', '/news/admin', '/admin/news', 'system', 't', '/doc/news.html', '/doc/sql/news.sql');
+    </pre>
+    </code>
+
+<li>Handle all scopes that this module supports in the Tcl files. You
+    will need to use calls to database (select, insert, delete)
+    appropriate for each scope. Display elements, such as headers,
+    footers and context bars should also be customized based on the
+    scope.  This will be an easy process if you use utility functions
+    defined in ad-scope.tcl.  For example, you will use
+    <code>ad_scope_header</code>, <code>ad_scope_footer</code> and
+    <code>ad_scope_context_bar</code> instead of
+    <code>ad_header</code>, <code>ad_footer</code> and
+    <code>ad_context_bar</code>. ad-scope.tcl also defines a powerful
+    security procedure <code>ad_scope_authorize</code>, which
+    authorizes a user for specified action and specified scope. If you
+    don't understand this scope stuff, take a look at files in /faq
+    and /faq/admin directories for examples of files implementing
+    embedding interface.
+</ul>
+
+Finally, to see your <i>embeddable</i> module work, you should create a test
+group and associate module with that group through files in /admin/ug.
+For Novice Photographers group, faq module public pages will be
+located at /groups/novice-photographers/faq and faq module
+administration pages at /groups/admin/novice-photographers/faq.
+For more information on associating <i>embeddable</i> modules with user groups,
+take a look at <a href=user-groups.html>User Groups Documentation</a>.
+
+<hr>
+<a href=mailto:tarik@arsdigita.com><address>tarik@arsdigita.com</address></a>
+</body>
+</html>
+
+
+
+
+
+
+
Index: web/openacs/www/doc/xml.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/xml.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/xml.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,302 @@
+<html>
+<!--AD_DND-->
+<!--xml.html,v 3.0 2000/02/06 03:27:31 ron Exp-->
+<head>
+<title>Working with XML Data in ArsDigita Community System</title>
+</head>
+
+<body bgcolor=white>
+<h2>Working with XML</h2>
+
+in the <a href="index.html">ArsDigita Community System</a>
+by <a href="mailto:karlg@arsdigita.com">Karl Goldstein</a>
+
+<hr>
+
+Perspective: the ArsDigita philosophy is not to put stuff into our
+toolkit that is part of the core Oracle RDBMS.  Oracle Corporation has
+thousands of programmers, their most reliable product is the core RDBMS
+server, they have documentation, training, support, etc.  Oracle has
+wonderful support for XML built into their core RDBMS from version 8.1.5
+forward.  This support is available to any Oracle client, including
+an AOLserver running the ArsDigita Community System.  The XML support is
+made possible by the fact that the core Oracle server is capable of
+running programs in procedural languages such as Java and PL/SQL.
+
+<p>
+
+Basically what we do for a site that needs to make heavy use of XML is
+to download the appropriate Java libraries for Oracle's built-in Java
+VM.  After that it is just a question of how to use those libraries:
+
+<ul> 
+
+<li><b>I want to grab some data from an Oracle table and publish it
+in XML:</b> run the <code>xmlgen.getXML</code> procedure inside Oracle,
+which will automatically figure out how to go from the Oracle data
+dictionary into XML; AOLserver gets a big string of XML back from Oracle
+
+<li><b>I want to grab some data from a server elsewhere on the Internet
+and stuff it into an Oracle table:</b>  Take the entire XML document and
+feed it to Oracle, then run <code>xmlgen.insertXML</code>. 
+
+<li><b>I want to render some data stored in Oracle as XML and publish it
+on the Web in HTML:</b> Here you have an Oracle CLOB column containing
+an XML document.  You want a reader to be able to view it in a standard
+browser.  You want to use XSL to render the XML document into HTML.  Do
+this by calling our <code>apply_xsl</code> procedure (invokes some Java
+code within the database).
+
+</ul>
+
+
+Generally AOLserver wants to parse XML that comes from a database
+table.  In this case, it makes sense to do the parsing 
+
+
+that is already in the database
+
+<h3>Overview</h3>
+
+<p>This document describes how to use XML to publish and retrieve data 
+from Oracle tables.  The procedure relies on Oracle's XML parser and
+SQL to XML utility, which makes it easy to transform a query result into
+a simple XML document with the following general structure:</p>
+
+<pre><tt>
+&lt;rowset&gt;
+  &lt;row&gt;
+    &lt;column1&gt;value&lt;/column1&gt;
+    &lt;column2&gt;value&lt;/column2&gt;
+    ...
+    &lt;columnN&gt;value&lt;/columnN&gt;
+  &lt;/row&gt;
+  ...
+&lt;/rowset&gt;
+</tt></pre>
+
+<p>The parser is written in Java, but Oracle provides a PL/SQL wrapper
+package so that the methods can be called directly from SQL.  The
+package includes methods to format a query result as an XML document,
+and to insert an XML document into a database table.  However, <em>you
+cannot specify a URL as the document source</em>; the document must
+already be stored locally in a CLOB or varchar variable.  It would be
+easy to write a stored procedure in Java that performed the retrieval
+(the Oracle Java classes support this form), but Oracle requires you
+to have special permissions to open a socket from a Java stored procedure.
+We will rely on AOLserver to do the retrieval for us.</p>
+
+<h3>Preparation: Load the Utility</h3>
+
+<p>The first step in any XML project is to load the Java classes and
+PL/SQL package into your tablespace.  The whole package is available
+from the Oracle web site at <a
+href="http://technet.oracle.com/tech/xml/oracle_xsu/">
+http://technet.oracle.com/tech/xml/oracle_xsu/ </a>.  You may have to
+register with Oracle TechNet to get it.</p>
+
+<p>Once you have managed to get the tar file onto your server,
+explode it and change to the <tt>lib</tt> directory.  Edit
+the database user and password in the file <tt>oraclexmlsqlload.csh</tt> 
+and run the script from the shell command line.  This
+will load everything and perform some tests to ensure that
+it is working properly.</p>
+
+<h3>Example data model</h3>
+
+<p>For the examples below, suppose that you have this database table you
+want to publish as XML:</p>
+
+<pre><tt>
+create table xmltest (
+    pk        integer primary key,
+    color     varchar2(40),
+    shape     varchar2(40)
+);
+
+insert into xmltest values (1, 'red', 'circle'); 
+insert into xmltest values (2, 'blue', 'triangle'); 
+insert into xmltest values (3, 'green', 'square'); 
+
+commit;
+</tt></pre>
+
+<h3>Creating XML from Oracle table data</h3>
+
+<p>The Oracle package <tt>xmlgen</tt> allows you to publish any query
+result as an XML document.  As an example, we will publish the simplest
+possible query:</p>
+
+<pre><tt>
+select * from xmltest;
+</tt></pre>
+
+<p>The Oracle package <tt>xmlgen</tt> has a <tt>getXML</tt> function
+that turns a query into a simple XML document.  You might hope that
+something like this would work:</p>
+
+<pre><tt>
+select xmlgen.getXML('select * from xmltest') from dual;
+</tt></pre>
+
+<p>This works fine in SQL*plus, but only works <em>once</em> per
+session if called from AOLserver.  This probably has to do
+with the fact that the function returns a temporary CLOB which
+has to be freed before the function can be called again, although
+this doesn't really explain why it works in SQL*plus.</p>
+
+<p>The workaround is to use a <em>temporary table</em>, which is a new
+feature in Oracle 8i that stores session- or transaction- specific
+information and deletes it at the end of the session or transaction.
+This table will hold the XML document CLOB long enough to get it into
+a Tcl string.  We will use the <tt>on commit delete rows</tt> option
+(this is the default) so that any rows inserted during a transaction
+are deleted at the end of the transaction.</p>
+
+<p>First you have a create a table to store the generated XML
+documents.  Here is a skeleton table, although you may want to
+extend it to suit your needs:</p>
+
+<pre><tt>
+create sequence xmldoc_seq start with 1;
+
+create global temporary table xmldocs (
+    doc_id        integer primary key,
+    doc           CLOB
+) on commit delete rows;
+</tt></pre>
+
+<p>Next, you need a PL/SQL wrapper function that generates the
+XML document into the temporary CLOB, stores it, and returns
+the id of the stored document:</p>
+
+<pre><tt>
+create or replace function get_xml (
+  query varchar2) 
+  return integer is
+  doc_id integer;
+begin
+  select xmldoc_seq.nextval into doc_id from dual;
+  insert into xmldocs values (doc_id, xmlgen.getXML(query));
+  return doc_id;
+end;
+/
+show errors;
+</tt></pre>
+
+<h3>Publish an XML document from Oracle data</h3>
+
+<p>To actually publish the query as an XML document, create an AOLserver 
+tcl page called <tt>xmltest-publish.tcl</tt>:
+
+<pre><tt>
+set db [ns_db gethandle]
+
+ns_db dml $db "begin transaction"
+
+set doc_id [ns_ora exec_plsql $db "
+  begin 
+    :1 := get_xml('select * from xmltest');
+  end;
+"]
+
+set result [ns_db 1row $db "select doc from xmldocs where doc_id = $doc_id"]
+
+set xmldoc [ns_set value $result 0]
+
+ns_db dml $db "end transaction"
+
+ns_return 200 text/plain $xmldoc
+</tt></pre>
+
+<p>This code obtains the document ID from the <tt>get_xml</tt> function 
+created above, and then retrieves the actual document.  Note
+that the <tt>ns_ora exec_plsql</tt> procedure must be used because
+the function has the side effect of inserting a row into a table.
+The entire block is wrapped in a transaction so that the generated
+XML document is automatically deleted once the page is written.
+</p>
+
+<h3>Retrieving an XML document and store its data in an Oracle table</h3>
+
+<p>To retrieve an XML document and store its field values into a database table,
+create another copy of the above table named <tt>xmltest2</tt>.
+Then create an AOLserver tcl page called <tt>xmltest-retrieve.tcl</tt>:
+
+<pre><tt>
+set xmldoc [ns_httpget http://yourdomain/xmltest-publish.tcl]
+
+regsub -all "\[\r\n\]" $xmldoc {} xmldoc
+
+set db [ns_db gethandle]
+
+set statement "
+declare
+  rowsp integer;
+begin
+  rowsp := xmlgen.insertXML('xmltest2', [ns_dbquotevalue $xmldoc]);
+end;
+"
+
+ns_db dml $db $statement
+
+ns_return 200 text/html "XML inserted."
+</tt></pre>
+
+<p>Once the XML document is retrieved using the <tt>ns_httpget</tt>
+method, all line breaks in the document must be removed to
+avoid breaking the SQL statement.  The <tt>insertXML</tt>
+function itself must be executed within a PL/SQL block; it
+returns the number of rows successfully inserted.</p>
+
+<h3>Transforming an XML document with an XSL stylesheet</h3>
+
+<p>Version 2 of the Oracle XML parser supports XSL stylesheets, which
+provide a convenient way to transform XML documents into HTML or any
+other format.  The <tt>xmlgen</tt> PL/SQL package does not provide this
+capability, but I have created my own Java code to support such
+transformations.  The code is invoked by the <tt>apply_xsl</tt>
+procedure in SQL/plus.  It can be found in <tt>doc/sql/XMLPublisher</tt>
+in the ACS distribution.</p>
+
+<p>To use the function, you need a table to store XSL stylesheets in
+the database:</p>
+
+<pre>
+create sequence xsldoc_seq start with 1;
+
+create table xsldocs (
+    doc_id        integer primary key,
+    doc_name      varchar2(100),
+    doc           CLOB
+);
+</pre>
+
+<p>Once you have inserted a stylesheet into the table, you can apply
+it to any generated xml document.  Simply generate the XML document
+into the <tt>xmldocs</tt> table as above, and then call
+<tt>apply_xsl</tt> to apply a transformation:</p>
+
+<pre>
+...
+
+set doc_id [ns_ora exec_plsql $db "
+  begin
+    :1 := get_xml('select * from xmltest');
+    apply_xsl(:1, 'mystyle.xsl');
+  end;
+"]
+
+...
+</pre>
+
+<p>The <tt>apply_xsl</tt> procedure is bound to a Java stored
+procedure that retrieves the document from the <tt>xmldocs</tt>
+temporary table the named stylesheet from the <tt>xsldocs</tt>
+table.  It applies the transformation to the document and updates
+the xmldocs table with the transformed version of the XML document,
+which can then be retrieved as before.</p>
+
+<hr>
+
+<a href="mailto:karlg@arsdigita.com">karlg@arsdigita.com</a>
Index: web/openacs/www/doc/lessons/intermedia.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/lessons/intermedia.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/lessons/intermedia.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,382 @@
+<HTML>
+<HEAD>
+<TITLE>Working With Intermedia</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF" TEXT="#000000">
+
+<table>
+<tr>
+<td>
+
+<td>
+
+<H2>Working With Intermedia</H2>
+
+part of 
+<a
+href="/doc/">ACS lessons</a>
+by <a href="mailto:mbryzek@arsdigita.com">Michael Bryzek</a>
+
+</tr>
+</table>
+
+<hr>
+
+<BLOCKQUOTE>
+
+If you're like me, you love the idea of Intermedia - full text indexing,
+decent performance, tight integration with sql. But, if you're like me,
+Intermedia is the part of Oracle that doesn't let you sleep at night.
+<p>
+While working on <a href=http://www.guidestar.org>GuideStar</a> with a 
+lot of other really good programmers, we decided to use Intermedia to 
+add a keyword search box to our site. Following Phil's recommendation, 
+we built a <a href=http://photo.net/doc/site-wide-search.html>Site-wide Search</a>, 
+that we called search. 
+We were going to use Intermedia to index a columm, keywords, in that table.
+Sounds simple, and it would have been, except that our data set contained
+approximately 700,000 rows, 3,000-5,000 of which were updated daily. (Note: 
+Alpha, one of the guys who wrote Intermedia, says 700,000 rows is nothing for 
+Intermedia. I, however, disagree.)
+
+
+<h3>Creating Intermedia Indexes</h3>
+Once we had populated the table search with a pl/sql procedure, we ran 
+<pre>
+SQL&gt; create index search_im_keyword_idx on search(keywords) indextype is ctxsys.context;
+</pre>
+to create an intermedia index on search(keywords). Note that the "im" in the name of 
+the index is just there to help me identify Intermedia indexes more easily. 
+About 2 1/2 hours later (on a Sun E450 with 4 processors and 4gb of RAM) we saw:
+<pre>
+Index created.
+</pre>
+And we were in business. This one line sql command was enough to give us the 
+performance we wanted:
+<pre>
+SQL&gt; set timing on
+SQL&gt; select count(1) 
+   from search 
+   where contains(keywords, 'guidestar', 1) > 1
+   order by score(1);
+
+  COUNT(1)
+----------
+	 3
+
+Elapsed: 00:00:00.27
+</pre>
+
+<h3>Updating Intermedia Indexes</h3>
+Unlike normal oracle indexes, intermedia indexes are not updated after the 
+execution of dml statements. This means that we manually have to update the
+Intermedia indexes we are using. There are at least two ways to update these
+indexes:
+<ol>
+  <li> Run the context server to automatically update your indexes. To start 
+       context server, get yourself a unix shell and run:
+<pre> &gt; ctxsrv -user ctxsys/ctxsyspwd -personality M -log $ORACLE_HOME/ctx/ctxsys.log &</pre>
+where ctxsyspwd is the password for the oracle user ctxsys. As it good as it sounds,
+running the context server is not the recommend method to keep the indexes up-to-date and
+the context server is already deprecated. 
+
+  <p><li> Manually update the index on a regular basis. To update an intermedia index, 
+       open a sqlplus session as the user who created the index. Then:
+<pre>SQL&gt; alter index search_im_keyword_idx rebuild online parameters('sync memory 45M');
+Index altered.
+</pre>
+       The parameters of this call:
+       <ul>
+         <li> rebuild online: Rebuild the index incrementally so that it is still accessible.
+              If you forget to specify "online," users searching the website would not
+              be able to access the index.
+         <li> sync: Just update the index (rather than rebuild it entirely)
+         <li> memory 45M: Specify the amount of memory, in megabytes, that Intermedia can 
+              use while rebuilding the index. Using more memory decreases the amount of
+              disk I/O and thus increases the speed with which the index can be rebuilt.
+              The default is 12 megabytes and the acceptable range of inputs for memory
+	      is 1 KB to about 50 MB. To increase the maximum allowable index memory:
+	      <pre> SQL&gt; exec ctx_adm.set_parameter('max_index_memory', '1G');</pre>
+         <li> More information available in the <a href=http://oradoc.photo.net/ora81/DOC/inter.815/a67843/csql.htm#14189>Oracle Documentation</a>
+       </ul>
+</ol>
+
+Since the context server is deprecated, we use the second method. From start to finish, the
+update of our Intermedia index looks like:
+
+<ol>
+  <li> We have triggers on all the tables that feed into the site wide index. Whenever a row in one of these
+       tables is updated, the "dirty bit" in the site wide search table is set
+  <li> Every hour we run a tcl procedure that updates the dirty rows in the search table
+       by calling a pl/sql procedure. The aolserver call looks like:
+       <pre>    ns_ora exec_plsql $db "begin :1 := 1; keyword_datastore_gasket('$ein'); end;" </pre>
+       where the :1 := 1 is just a hack to work around exec_plsql behavior
+  <li> Every hour we also run a tcl procedure that executes an "alter index" statement to update the intermedia indexes:
+       <pre>    ns_db dml $db "alter index search_im_keyword_idx rebuild online parameters('sync memory 45M')"</pre>
+</ol>
+
+
+When manually altering intermedia indexes, you have to make sure that no more than 1 of these alter index statements is running at any given time. More than 1 statement could result in a deadlock inside intermedia that can only be solved by dropping and recreating the index.
+
+<p>
+<h3>Useful Intermedia Trivia</h3>
+If you ever wanted to know how many rows are waiting to be synced with each of your Intermedia
+indexes, you can do:
+<pre>
+    SQL&gt; select PND_INDEX_NAME, count(1) from ctx_user_pending group by PND_INDEX_NAME;
+</pre>
+
+You can also look at Intermedia errors to find out what went wrong by opening 
+a sqlplus session as the ctxsys user and running:
+<pre>
+    SQL&gt; select err_timestamp, err_index_name, err_text from ctx_index_errors order by err_timestamp;</pre>
+to get a list of all the errors on intermedia indexes, sorted by date.
+</pre>
+
+<p>
+
+<h3>Where the Problems Start</h3>
+A few times the update of the intermedia index failed. One night as I was headed to bed, 
+I decided to update the index overnight. 
+<pre> 
+   SQL&gt; alter index search_im_keyword_idx rebuild online parameters('sync memory 45M');
+</pre>
+
+About two hours into my dreams, the phone rang to wake me up - all searches were 
+failing on the website. Users were simply getting back a page with zero results, 
+regardless of their query. About fifteen minutes later, I'm back at the computer
+where I ran the update index statement. I saw that my index was in a FAILED/LOADING state. 
+Had I been smart, I would have logged what was going on in context by executing:
+<pre>
+   SQL&gt; exec ctx_output.start_log('better_days');           
+</pre>
+before running my query to log its progress. This starts 
+context logging to $ORACLE_HOME/ctx/log/better_days.
+
+<p>
+Whenever an index update fails, try a resume statement that 
+should finish up the work from before:
+<pre> 
+   SQL&gt; alter index search_im_keyword_idx rebuild online parameters('resume memory 45M');
+</pre>
+The resume statement has never worked for me but maybe you'll have better luck. Probably, 
+you'll just see the same error message you had before.
+Somehow the index has become corrupted: 
+<pre> 
+  SQL&gt; drop index search_im_keyword_idx force;
+  SQL&gt; create index search_im_keyword_idx on search(keywords) indextype is ctxsys.context;
+</pre>
+And 2 1/2 hours later, the index was re-created and back on-line. Meanwhile, our website
+was not serving search results for over three hours.
+
+<h3>What Went Wrong?</h3>
+
+<p>
+The hourly procedure running inside
+AOLServer to update the Intermedia index started up in parallel to the one I 
+manually executed in sqlplus. These two threads competed for
+some resource, and ended up in a deadlock. 
+<p>
+I have also seen the same error while running
+context server and executing the an alter index statement in sqlplus. Alpha
+tells me that the deadlock shouldn't happen, and I agree with him. However, the 
+reality of the deadlock gives us the following Intermedia law: <B>Use exactly one
+method to update Intermedia indexes.</B> It is also worth mentioning that an 
+uncommitted sql session can keep the alter index statement from completing.
+<p>
+Note that the two threads were able to become deadlocked simply because we had a lot
+of data. On a small data set, it is much less likely that two threads would be running
+at once since each thread would complete much more quickly.
+
+<h3>Using Intermedia on the web</h3>
+The queries humans write will most certainly not be Intermedia friendly. The 
+following procedure provided by some folks at Intermedia takes text written 
+by a human and returns a string suitable for feeding into Intermedia:
+<pre>
+- -- We will assume that the users are not going to use any intermedia text syntax
+- -- So all intermedia text keywords will be braced to escape them
+
+create or replace function im_convert(
+        query in varchar2 default null
+        ) return varchar2
+is
+  i   number :=0;
+  len number :=0;
+  char varchar2(1);
+  minusString varchar2(256);
+  plusString varchar2(256); 
+  mainString varchar2(256);
+  mainAboutString varchar2(256);
+  finalString varchar2(256);
+  hasMain number :=0;
+  hasPlus number :=0;
+  hasMinus number :=0;
+  token varchar2(256);
+  tokenStart number :=1;
+  tokenFinish number :=0;
+  inPhrase number :=0;
+  inPlus number :=0;
+  inWord number :=0;
+  inMinus number :=0;
+  completePhrase number :=0;
+  completeWord number :=0;
+  code number :=0;  
+begin
+  
+  len := length(query);
+
+- -- we iterate over the string to find special web operators
+  for i in 1..len loop
+    char := substr(query,i,1);
+    if(char = '"') then
+      if(inPhrase = 0) then
+        inPhrase := 1;
+        tokenStart := i;
+      else
+        inPhrase := 0;
+        completePhrase := 1;
+        tokenFinish := i-1;
+      end if;
+    elsif(char = ' ') then
+      if(inPhrase = 0) then
+        completeWord := 1;
+        tokenFinish := i-1;
+      end if;
+    elsif(char = '+') then
+      inPlus := 1;
+      tokenStart := i+1;
+    elsif((char = '-') and (i = tokenStart)) then
+      inMinus :=1;
+      tokenStart := i+1;
+    end if;
+
+    if(completeWord=1) then
+      token := '{ '||substr(query,tokenStart,tokenFinish-tokenStart+1)||' }';      
+      if(inPlus=1) then
+        plusString := plusString||','||token||'*10';
+        hasPlus :=1;    
+      elsif(inMinus=1) then
+        minusString := minusString||'OR '||token||' ';
+        hasMinus :=1;
+      else
+        mainString := mainString||' NEAR '||token;
+        mainAboutString := mainAboutString||' '||token; 
+        hasMain :=1;
+      end if;
+      tokenStart  :=i+1;
+      tokenFinish :=0;
+      inPlus := 0;
+      inMinus :=0;
+    end if;
+    completePhrase := 0;
+    completeWord :=0;
+  end loop;
+
+  -- find the last token
+  token := '{ '||substr(query,tokenStart,len-tokenStart+1)||' }';
+  if(inPlus=1) then
+    plusString := plusString||','||token||'*10';
+    hasPlus :=1;        
+  elsif(inMinus=1) then
+    minusString := minusString||'OR '||token||' ';
+    hasMinus :=1;
+  else
+    mainString := mainString||' NEAR '||token;
+    mainAboutString := mainAboutString||' '||token; 
+    hasMain :=1;
+  end if;
+
+  
+  mainString := substr(mainString,6,length(mainString)-5);
+  mainAboutString := replace(mainAboutString,'{',' ');
+  mainAboutString := replace(mainAboutString,'}',' ');
+  plusString := substr(plusString,2,length(plusString)-1);
+  minusString := substr(minusString,4,length(minusString)-4);
+
+  -- we find the components present and then process them based on the specific combinations
+  code := hasMain*4+hasPlus*2+hasMinus;
+  if(code = 7) then
+    finalString := '('||plusString||','||mainString||'*0.1,about('||mainAboutString||')*0.5) NOT ('||minusString||')';
+  elsif (code = 6) then  
+    finalString := plusString||','||mainString||'*0.1'||',about('||mainAboutString||')*0.5';
+  elsif (code = 5) then  
+    finalString := '('||mainString||',about('||mainAboutString||')) NOT ('||minusString||')';
+  elsif (code = 4) then  
+    finalString := mainString;
+    finalString := replace(finalString,'*1,',NULL); 
+    finalString := '('||finalString||')*0.1,about('||mainAboutString||')';
+  elsif (code = 3) then  
+    finalString := '('||plusString||') NOT ('||minusString||')';
+  elsif (code = 2) then  
+    finalString := plusString;
+  elsif (code = 1) then  
+    -- not is a binary operator for intermedia text
+    finalString := 'totallyImpossibleString'||' NOT ('||minusString||')';
+  elsif (code = 0) then  
+    finalString := '';
+  end if;
+
+  return finalString;
+end;
+/ 
+</pre>
+
+<b>Words of Caution:</b> Oracle 8.1.5.0 has a bug in the parser for the about clause. 
+The bug seems to incorrectly map multi word queries to their corresponding tokens in
+the Intermedia tables. For example, about('massachusetts bay'), which is tokenized
+as 'Massachusetts Bay', is parsed as 'Massachusetts bay', not matching any row in the
+Intermedia tokens table and thereby throwing an error. If you find yourself in this
+situation, simply get rid of the about clauses in the above pl/sql function.
+
+
+<h3>Optimizing Intermedia</h3>
+As you continue to update your intermedia index, the tables Intermedia maintains
+will become more and more fragmented. Once in awhile, you might want to optimize
+your index by executing the following from sqlplus:
+<pre> 
+  SQL&gt; ALTER INDEX newsindex rebuild parameters('optimize fast');
+</pre>
+Optimization is an extremely slow process and it's not clear that the performance
+gain of an optimized index will be noticeable. If you are going to optimize, 
+you should limit the amount of time that the optimization will take (180 = 180 minutes):
+<pre> 
+  SQL&gt; ALTER INDEX newsindex rebuild parameters('optimize full maxtime 180');
+</pre>
+
+The <a href=http://oradoc.photo.net/ora81/DOC/inter.815/a67843/csql.htm#20206>Intermedia documentation</a> 
+has more information about optimizing indexes.
+
+
+<h3>Optimizing Web Searches with Intermedia</h3>
+Unlike "normal" SQL queries, Intermedia actually handles the FIRST_ROWS hint 
+very well. This means that you can sort large data sets incrementally 
+(as opposed to sorting the entire data set to return the first 25 rows in
+sorted order):
+<pre>
+SQL&gt; set timing on
+SQL&gt; select /*+ FIRST_ROWS */ org_name
+          from search 
+          where contains(keywords, 'philanthropic', 1) > 0
+          order by score(1);
+
+250 rows selected.
+
+Elapsed: 00:00:00.42
+</pre>
+The search is optimized to return the first rows from the cursor. We 
+could now display multi-page search results for organization names 
+that matched the query for "philanthropic"... in .42 seconds, 
+including the time my sqlplus
+session took to print out the org names. It is important 
+to know that Intermedia does a better job with FIRST_ROWS than Oracle which 
+leads us to second Intermedia law: <B>When sorting through a large dataset, 
+order by score(n) rather than a column not indexed by Intermedia.</b>
+
+
+</BLOCKQUOTE>
+<HR>
+
+<a href="mailto:mbryzek@arsdigita.com"><address>mbryzek@arsdigita.com</address></a>
+
+</body></HTML>
+
Index: web/openacs/www/doc/lessons/sql-tuning-advanced.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/lessons/sql-tuning-advanced.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/lessons/sql-tuning-advanced.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,478 @@
+<HTML>
+<HEAD>
+<TITLE>Tuning SQL Queries</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF" TEXT="#000000">
+
+<table>
+<tr>
+<td>
+
+<td>
+
+<H2>Tuning SQL Queries</H2>
+
+part of 
+<a
+href="/doc">ACS lessons</a>
+by <a href="mailto:mbryzek@arsdigita.com">Michael Bryzek</a>
+
+</tr>
+</table>
+
+<hr>
+
+<blockquote>
+
+By now you've invested in a great RDBMS and even tried to 
+<a href=http://photo.net/sql/tuning.html>optimize</a>
+some of your queries by creating indexes (and possibly moving 
+tablespaces onto physically separate drives). You find that your 
+application is still not fast enough. You have two choices: 
+<OL>
+  <li> Close shop and go on vacation
+  <li> Hire a real DBA
+  <li> Expand your knowledge of SQL
+</OL>
+Though the first option is nice, it's hard to go on vacation if you
+don't have a job. And the second option could be quite expensive (not 
+to mention hard to find). It's time to look at a couple ways to tune the
+SQL you're using on your tables with hundreds of thousands or 
+millions of rows. The hope is that a few examples will add a few new
+tools to your SQL toolbox to help you tune your own problematic queries.
+ 
+<P>
+
+From here on, we assume you've created your plan table, that you
+have located the problematic query, and have tried indexing the appropriate 
+columns. (If not, read  
+<a href=http://photo.net/sql/tuning.html>Phil's Indexing and Tuning Page</a>
+first.) And just in case it's not clear enough, make sure you:
+<pre>     SQL&gt; analyze table <your table> compute statistics for all columns</pre>
+to help oracle's cost-based optimizer do the "right thing."
+<p>
+
+Here are the steps to further optimize your sql:
+<ol>
+  <li> copy the problematic query into emacs.
+  <li> open a sqlplus session
+  <li> become creative 
+</ol>
+
+How can you become creative? I'm not sure, but thanks to the help
+of Alpha (one of the guys who actually wrote Intermedia), we were
+able to replace a query that took about 10 seconds with one that took 
+about a tenth of a second. That's pretty creative.
+
+<h3>Setting up your sqlplus session</h3>
+One of the major problems in tuning expensive queries is that it takes
+to long to repeadetly run variations of the query. Instead of running
+the queries, we focus on reading and understanding the 
+execution plan. Once we have found an execution plan that we think 
+looks good, we'll run the query with <pre> SQL&gt; set autotrace on </pre>
+to make sure that we're not hitting the disk too often. 
+
+<p>
+In general, there are at least two ways to just look at the execution plan of a query:
+
+<p><b>Method 1 (not recommended):</b><br>
+<blockquote>
+<pre>
+SQL&gt; explain plan for &lt;your query&gt;
+SQL&gt; select  rtrim(lpad(' ',2*level)||
+             rtrim(operation)||' '||
+             rtrim(options)||' '||
+             object_name) query_plan
+     from plan_table
+     connect by prior id=parent_id
+     start with id=0;
+SQL&gt; truncate table plan_table;
+(Note that we only truncate the plan_table so that the next time we 
+use explain plan, we only read back the query we ran. I put the select
+statement above into a file format_plan.sql that I run every time I 
+need to)
+</pre>
+</blockquote>
+
+
+<p><b>Method 2 (recommend because of its simplicity):</b>
+<blockquote>
+<pre>
+SQL&gt; set autotrace traceonly explain
+SQL&gt; &lt;your query&gt;
+       </pre>
+</blockquote>
+
+Another useful tool for tuning in general is the use of trace files and tkprof 
+to look at what is going on while your query executes. Example 3 illustrates
+the importance of these tools.
+
+<a name="example1">
+<h3>SQL Tuning Example 1:</h3>
+<b>Context</b><br>
+<a href=http://www.guidestar.org>GuideStar</a> is a website focused 
+on delivering financial information about nonprofits to potential 
+investors. The financial information is taken from the tax forms that
+all non-profits file every year (Form 990 or 990-EZ). We receive
+digitized versions of these forms and run a series of math and spelling
+checks to ensure that the appropriate numbers add up as they should. 
+When a form has no more errors, it is approved for public use.
+
+<p><b>The Tables</b><br>
+I wanted to get back 50 form_id's for forms that had at least one 
+error in the state "found." Forms are stored in a table called 
+f990_header with a primary key of form_id and a boolean approved_p that 
+indicates whether the form is approved.  Errors and their 
+related states are stored in a table called gs_990_errors which has
+a primary key pair (form_id, check_id) where check_id refers to the
+type of error flagged. Each form_id in f990_header has about 30-40 
+corresponding rows in gs_990_errors. At the time I was working on this
+query, f990_header had about 140,000 rows and gs_990_errors had 
+about 4.5 million rows. 
+
+<p><b>Tuning</b><br>
+The original query looked like this: 
+<pre>
+SQL&gt; set autotrace traceonly explain
+SQL&gt; select h.form_id 
+             from f990_header h, gs_990_errors e
+             where approved_p='N'
+             and rownum <= 50
+             and e.form_id = h.form_id
+             and e.error_state = 'found';
+
+
+Execution Plan
+----------------------------------------------------------
+   0	  SELECT STATEMENT Optimizer=CHOOSE (Cost=41454 Card=67621 Byt
+	  es=4665849)
+
+   1	0   COUNT (STOPKEY)
+   2	1     MERGE JOIN (Cost=41454 Card=67621 Bytes=4665849)
+   3	2	SORT (JOIN) (Cost=1818 Card=67621 Bytes=1961009)
+   4	3	  TABLE ACCESS (FULL) OF 'F990_HEADER' (Cost=716 Card=
+	  67621 Bytes=1961009)
+
+   5	2	SORT (JOIN) (Cost=39636 Card=1040847 Bytes=41633880)
+   6	5	  TABLE ACCESS (FULL) OF 'GS_990_ERRORS' (Cost=4079 Ca
+	  rd=1040847 Bytes=41633880)
+
+</pre>
+
+The query plan is about as bad as it gets. I'm doing a full table scan
+of f990_header and gs_990_errors. (Note: If you were to actually run the
+query with autotrace on, you would see that I'm hitting the disk 
+over 10,000 times.)
+<p>
+Let's time how long it actually takes to run the query:
+<pre>
+SQL&gt; set timing on;
+SQL&gt; set autotrace off;
+SQL&gt; select h.form_id 
+             from f990_header h, gs_990_errors e
+             where approved_p='N'
+             and rownum <= 50
+             and e.form_id = h.form_id
+             and e.error_state = 'found';
+
+50 rows selected.
+
+Elapsed: 00:00:09.52
+
+</pre>
+
+The first step to improving this query is to look at what it is I am 
+interested in obtaining: the f990_header form_id. I don't care at all about any data in 
+gs_990_errors. I rewrote the query as:
+
+<pre>
+SQL&gt; set autotrace traceonly explain 
+SQL&gt; set timing off
+SQL&gt; select h.form_id 
+     from f990_header h
+     where h.approved_p='N'
+     and h.form_id = (select e.form_id
+                      from gs_990_errors e
+                      where rownum < 2
+                      and e.form_id = h.form_id
+                      and e.error_state = 'found')
+     and rownum <= 50;
+
+
+Execution Plan
+----------------------------------------------------------
+   0	  SELECT STATEMENT Optimizer=CHOOSE (Cost=716 Card=1 Bytes=42)
+   1	0   COUNT (STOPKEY)
+   2	1     FILTER
+   3	2	TABLE ACCESS (FULL) OF 'F990_HEADER' (Cost=716 Card=1
+	  Bytes=42)
+
+   4	2	COUNT (STOPKEY)
+   5	4	  TABLE ACCESS (BY INDEX ROWID) OF 'GS_990_ERRORS' (Co
+	  st=4 Card=1 Bytes=45)
+
+   6	5	    INDEX (RANGE SCAN) OF 'GS_990_ERRORS_FORM_CHECK_ID
+	  X' (NON-UNIQUE) (Cost=3 Card=1)
+
+</pre> 
+
+That's quite a bit better. We got rid of the full table scan on 
+gs_990_errors and are now simply hitting the index on 
+gs_990_errors(form_id, check_id). Could we do better? Maybe. 
+I created an index on approved_p naively hoping that the query would 
+use it (I even gave it a hint to do so!). However, over 40% of the 
+rows in f990_header have approved_p='N', 
+which means the full table scan will be more efficient than the index
+scan. The optimizer is doing the right thing here.
+
+<p>
+
+My friend <a href=mailto:oumi@arsdigita.com>Oumi</a> pointed out that 
+we could simplify the query a bit since we don't even need to return
+e.form_id from the inner select:
+
+<pre>
+SQL&gt; select h.form_id 
+     from f990_header h
+     where h.approved_p='N'
+     and exists (select 1
+                 from gs_990_errors e
+                 where rownum < 2
+                 and e.form_id = h.form_id
+                 and e.error_state = 'found')
+     and rownum <= 50;
+
+50 rows selected.
+
+Elapsed: 00:00:00.01
+</pre> 
+
+From almost 10 seconds to .01 - that's about 1,000 times faster!
+<p>
+Here's the intuition behind this example: <b>Only join two tables when 
+you really need data from both tables. Otherwise, a faster query 
+using a subquery probably exists.</b> I found that this general rule works
+best when all tables being accessed are fairly large (greater than 50,000 rows)
+and one of the tables is at least five times larger than the rest.
+
+<p>
+It's worth noting that our example is somewhat unique in that we are only accessing
+fifty rows of gs_990_errors meaning that we really win big over a full table scan
+of gs_990_errors. I tested a query that counted the total number of forms with an 
+error in the state "found," forcing a full table scan in both cases. Using a standard
+join, the query took 17.65 seconds while the sub-query method took 6.58 seconds. Not an 
+improvement of 100 times, but still much better!
+
+<a name="example2">
+<h3>SQL Tuning Example 2:</h3>
+<b>Context</b><br>
+Another friend of mine, also named Michael, was tuning a query for 
+a bonds site. The idea was to identify a particular bond and the  
+number of positions a user (or users) had executed in that bond. 
+<p>
+In this example, we are actually tuning views. Michael
+later told me that the query could also have been rewritten using the base
+tables to solve the problem we had. In any case, it's a good example of
+sql tuning.
+
+<p><b>The Views</b><br>
+
+The bonds are stored in a view called bonds with primary key bond_id.
+Positions are stored in orders_executable. Some users may not have any 
+corresponding rows in the orders_executable view.
+
+<p><b>Tuning</b><br>
+The original query looked like this 
+
+<pre>
+SQL&gt; set autotrace traceonly explain
+SQL&gt; select b.bond_id, sum(decode(o.order_id, null, 0, 1)) as n_orders
+     from bonds b, orders_executable o
+     where b.moody_long_term_rtg_sort >= (select ordinal_num 
+                                          from moody_ratings 
+                                          where code='AAA')
+     and b.moody_long_term_rtg_sort <= (select ordinal_num 
+                                        from moody_ratings 
+                                        where code='A')
+     and b.bond_id = o.bond_id(+)
+     group by b.bond_id;
+
+Execution Plan
+----------------------------------------------------------
+   0      SELECT STATEMENT Optimizer=CHOOSE
+   1    0   SORT (GROUP BY)
+   2    1     FILTER
+   3    2       MERGE JOIN (OUTER)
+   4    3         SORT (JOIN)
+   5    4           VIEW OF 'BONDS'
+   6    5             NESTED LOOPS (OUTER)
+   7    6               TABLE ACCESS (FULL) OF 'BOND_DESCRIPTIONS'
+   8    6               INDEX (UNIQUE SCAN) OF 'SYS_C0057002' (UNIQUE)
+   9    3         SORT (JOIN)
+  10    9           VIEW OF 'ORDERS_EXECUTABLE'
+  11   10             TABLE ACCESS (BY INDEX ROWID) OF 'ORDERS'
+  12   11               INDEX (RANGE SCAN) OF 'ORDER_STATUS_IDX' (NON-UNIQUE)
+  13    2       TABLE ACCESS (BY INDEX ROWID) OF 'MOODY_RATINGS'
+  14   13         INDEX (UNIQUE SCAN) OF 'SYS_C0057182' (UNIQUE)
+  15    2       TABLE ACCESS (BY INDEX ROWID) OF 'MOODY_RATINGS'
+  16   15         INDEX (UNIQUE SCAN) OF 'SYS_C0057182' (UNIQUE)
+</pre>
+
+In line 7 you see that we are doing a full table access of the
+bond_descriptions table. To tune this query, we:
+<ol>
+  <li> Identify what information we need: bond_id and the number of orders
+
+  <p><li> Identify the minimum set of tables we need to get that information: The 
+       number of orders definitely must come from 
+       orders_executable table. However, bond_id can come from either orders_executable
+       or bonds. Our first instinct would be to eliminate using the bonds table at all. 
+       This doesn't work here since we need the outer join on orders_executable to get
+       the bond_id's which do not have any corresponding rows in orders_executable.
+
+  <p><li> Try to replace a full table scan with a smaller view of the data that we really need:
+       In our case, we are only using a subset of the bonds table (namely those bonds whose 
+       moody_ratings fall in some range).
+</ol>
+
+We rewrote the query by replacing bonds with a "view created on the fly":
+<pre> 
+select b.bond_id, sum(decode(o.order_id, null, 0, 1)) as n_orders
+     from (select bond_id from bonds
+           where moody_long_term_rtg_sort >= (select ordinal_num from
+                                              moody_ratings where code='AAA')
+           and moody_long_term_rtg_sort <= (select ordinal_num from
+                                            moody_ratings where code='A')) b, orders_executable o
+     where b.bond_id = o.bond_id(+)
+     group by b.bond_id;
+
+Execution Plan
+----------------------------------------------------------
+   0      SELECT STATEMENT Optimizer=CHOOSE
+   1    0   SORT (GROUP BY)
+   2    1     MERGE JOIN (OUTER)
+   3    2       SORT (JOIN)
+   4    3         VIEW
+   5    4           NESTED LOOPS (OUTER)
+   6    5             TABLE ACCESS (BY INDEX ROWID) OF 'BOND_DESCRIPTIONS'
+   7    6               INDEX (RANGE SCAN) OF 'BOND_MOODY_LT_RTG_SORT_IDX' (NON-UNIQUE)
+   8    7                 TABLE ACCESS (BY INDEX ROWID) OF 'MOODY_RATINGS'
+   9    8                   INDEX (UNIQUE SCAN) OF 'SYS_C0057182' (UNIQUE)
+  10    5             INDEX (UNIQUE SCAN) OF 'SYS_C0057002' (UNIQUE)
+  11    2       SORT (JOIN)
+  12   11         VIEW OF 'ORDERS_EXECUTABLE'
+  13   12           TABLE ACCESS (BY INDEX ROWID) OF 'ORDERS'
+  14   13             INDEX (RANGE SCAN) OF 'ORDER_STATUS_IDX' (NON-UNIQUE)
+
+</pre> 
+
+The full table scan we previously saw in line 7 is now replaced with index lookups to 
+create the view that we then join with orders_executable.
+<p>
+Did we really win? In this case, yes! The full table scan was our bottleneck. However,
+keep in mind that this method of optimizing a sql query might not be too useful if the 
+view you create on they fly contains a good portion of the rows in your table. 
+
+<a name="example3">
+<h3>Example 3: Tuning With Trace Files and <a href=http://oradoc.photo.net/ora81/DOC/server.815/a67775/ch14_str.htm>tkprof</a></h3>
+Sometimes it hard to understand why a particular query, procedure, or function
+is taking so long to execute. The best solution here is to create a trace file
+to log what's going on during execution and to feed that trace file to tkprof 
+which formats and sorts the trace file.
+<p>
+I use a <a href=http://photo.net/doc/site-wide-search.html>Site-wide Search</a> 
+Table</a>, named search,  to allow users to search all the content
+on <a href=http://www.guidestar.org>GuideStar</a> and I created a pl/sql procedure
+that updates one row of the search table. This procedure is not very efficient - 
+It takes over eight seconds per row on the average - multiply that by 700,000 rows 
+and it would take
+about two months to update every row. Let's find out why this procedure takes 
+so long to execute. Note that autotrace doesn't give us any information
+about the execution of pl/sql procedures (at least I don't know how to get it!).
+The first step is to make sure timing is on inside Oracle (this ensures that the trace
+file will contain information regarding execution time):
+<ol>
+  <li> Open up the Oracle init file ($ORACLE_BASE/admin/ora8/pfile/initora8.ini)
+       in your favorite editor
+  <li> Make sure it says somewhere "timing = true". If timing is set to false, 
+       set timing to true, shutdown the database, and start it back up.
+</ol>
+
+<PRE>
+SQL&gt; alter session set sql_trace=true;
+
+Session altered.
+
+SQL&gt; BEGIN gs_update_search_for_ein('25-0965554'); END;
+  2  /
+
+PL/SQL procedure successfully completed.
+
+SQL&gt; alter session set sql_trace=false;
+
+Session altered.
+</PRE>
+
+Now we look at the trace file:
+<ol>
+  <li> From a unix shell as the oracle user, go to the trace files 
+       directory ($ORACLE_BASE/admin/ora8/udump)
+  <p><li> Figure out which trace file was generated (use ls -lrt *.trc to sort all trace
+       files in ascending order of time last modified. The last file is probably the one you want)
+  <p><li> Run tkprof (my trace file was called ora8_ora_24611.trc): 
+       <pre> &gt; tkprof ora8_ora_24611.trc output=ora8_ora_24611.prf sort=prsdsk,exedsk,fchdsk </pre>
+       <b> About the arguments to tkprof:</b>
+       <ul>
+         <li> prsdsk - parse-time disk access (time to parse your sql)
+         <li> exedsk - execution disk access (time to open the cursor)
+         <li> fchdsk - fetch disk access (time to walk down the cursor)
+       </ul>
+  <p><li> Look at the file ora8_ora_24611.prf:
+<pre>
+
+UPDATE SEARCH SET GIF_P=:b1,FIN_P=:b2,BMF_P=:b3,F990_P=:b4,PDF_P=:b5,FORM_ID=
+  :b6,ADDRESS=:b7,DESCRIPTION=:b8,URL=:b9,ORG_NAME=:b10,UPPER_ORG_NAME=
+  UPPER(:b10),ZIP=:b12,CITY=:b13,UPPER_CITY=UPPER(:b13),STATE=:b15,LONGITUDE=
+  :b16,LATITUDE=:b17,NTEE_CD_BMF=:b18,NTEE_CD_1=:b19,NTEE_CD_2=:b20,NTEE_CD_3=
+  :b21,NTEE_CD_BMF_ALL=:b22,NTEE_CD_1_ALL=:b23,NTEE_CD_2_ALL=:b24,
+  NTEE_CD_3_ALL=:b25,NTEE_CD_BMF_RANGE=:b26,NTEE_CD_1_RANGE=:b27,
+  NTEE_CD_2_RANGE=:b28,NTEE_CD_3_RANGE=:b29,KEYWORDS=EMPTY_CLOB(),
+  REVENUE_CODE=:b30,FOUNDN_IRS=:b31,DATA_QUALITY=:b32,PROCESSED_P='t' 
+WHERE
+ EIN = :b33
+
+
+call     count       cpu    elapsed       disk      query    current        rows
+------- ------  -------- ---------- ---------- ---------- ----------  ----------
+Parse        1      0.01       0.01          0          0          0           0
+Execute      1      0.63       6.68       3126       3866        364           1
+Fetch        0      0.00       0.00          0          0          0           0
+------- ------  -------- ---------- ---------- ---------- ----------  ----------
+total        2      0.64       6.69       3126       3866        364           1
+
+</pre>
+
+In this case, the most expensive query was the update on the table search -
+It took over 3,000 disk accesses! It turns out, every column that is
+being updated is itself indexed, and several pairs of columns are indexed as well. 
+There are over 25 indexes on this table that all must be updated on all dml queries. 
+<p>
+Knowing that the problem was disk I/O, I:
+<ol>
+  <li> Separated my tablespaces over 4 disks
+  <li> Ran several instances of the above procedure in parallel
+</ol>
+
+<p>
+The point here is that usually the hardest part of tuning is
+finding the bottleneck - sql trace files and tkprof can help.
+
+
+</ol>
+
+</BLOCKQUOTE>
+<HR>
+
+<a href="mailto:mbryzek@arsdigita.com"><address>mbryzek@arsdigita.com</address></a>
+
+</body></HTML>
Index: web/openacs/www/doc/openacs/index.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/index.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/index.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,21 @@
+<HEAD><TITLE>OpenACS Documentation</TITLE></HEAD>
+<BODY bgcolor=white>
+<h2>OpenACS Documentation</h2>
+by <a href=mailto:rmello@fslc.usu.edu>Roberto Mello</a>.
+
+<hr><p>
+This is the documentation for OpenACS. Feedback and suggestions are appreciated, through our <a href=http://www.openacs.org/sdm>Software Development Manager</a>.
+<p>
+<ul>
+<li> <a href=pdf/>Documentation in PDF format</a>
+<li> <a href=install/>OpenACS Installation Guide</a>
+<li> <a href=getting-started/>OpenACS Getting Started Guide</a>
+<li> <a href=aolserver/>Simple AOLserver Installation Guide</a>
+<li> <a href=nsd.txt>Sample nsd.tcl Config File</a>
+<li> <a href=postgres/>Simple PostgreSQL Installation Guide</a>
+<li> <a href=html/oracle-to-pg-porting.html>Guide to porting Oracle SQL to PostgreSQL</a>
+</ul>
+<p>
+<hr>
+<address>rmello@cc.usu.edu ben@adida.net mcmullan@alum.mit.edu</address>
+</body>
Index: web/openacs/www/doc/openacs/nsd.txt
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/nsd.txt,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/nsd.txt	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,333 @@
+#
+# AOLserver/OpenNSD Sample Configuration File
+#
+# Improved with lots of comments and things you'll need for
+# running OpenACS.
+#
+# by Roberto Mello (rmello@fslc.usu.edu)
+# $Id: nsd.txt,v 1.1 2001/04/17 14:05:11 donb Exp $
+
+ns_log notice "nsd.tcl: starting to read config file..."
+
+# 
+# If httpport is set to 80, you'll have to start AOLserver as root and pass the user 
+# AOLserver will run as in the command line. (e.g. ./nsd -u nsadmin -g nsadmin -t ../nsd.tcl)
+# (assuming you're starting AOLserver from the {aolserverdir}/bin directory.
+
+set httpport               80 
+set httpsport             443 
+
+#
+# Make sure your /etc/hostname is setup right, with your full domain. If you want AOLserver 
+# to listen to www.foobar.com instead of foobar.com then hard code the appropriate domain  
+# in the line below (e.g. set hostname www.foobar.com).
+#
+set hostname              [ns_info hostname]  
+set address               [ns_info address] 
+
+# 
+# You can name your server whatever you want, but you'll need a directory with that
+# name under {aolserverdir}/servers/ writable by you AOLserver user.
+#
+# For example: if your AOLserver is in /usr/local/aolserver and your server is "server1"
+# you will need a /usr/local/aolserver/servers/server1 directory.
+#
+set server		   "server1" 
+set servername             "openacs" 
+
+# 
+# AOLserver's home and binary directories. Autoconfigurable. 
+#
+set homedir                 [file dirname [ns_info config]] 
+set bindir                  [file dirname [ns_info nsd]] 
+
+#
+# Where are your pages going to live ?
+#
+set pageroot                /web/${server}/www 
+set directoryfile           index.adp,index.tcl,index.html,index.htm
+
+# 
+# nsssl: Only loads if keyfile.pem and certfile.pem exist.
+# If you are using SSL, make sure you have these dirs and files (refer
+# to the AOLserver docs)
+
+set sslkeyfile ${homedir}/servers/${server}/modules/nsssl/keyfile.pem
+
+set sslcertfile ${homedir}/servers/${server}/modules/nsssl/certfile.pem 
+
+# 
+# Global server parameters 
+#
+
+ns_section "ns/parameters" 
+        ns_param   home         $homedir 
+        ns_param   debug        false 
+        ns_param   MailHost     localhost 
+        ns_param   ServerLog    ${homedir}/log/server.log 
+        ns_param   LogRoll      on
+
+# 
+# Thread library (nsthread) parameters 
+# 
+ns_section "ns/threads" 
+        ns_param   mutexmeter      true      ;# measure lock contention 
+        #ns_param   stacksize [expr 128*1024] ;# Per-thread stack size for hungry C modules
+
+# 
+# MIME types. 
+# 
+#  Note: AOLserver already has an exhaustive list of MIME types, but in
+#  case something is missing you can add it here. 
+#
+
+ns_section "ns/mimetypes" 
+        ns_param   default         "*/*"     ;# MIME type for unknown extension 
+        ns_param   noextension     "*/*"     ;# MIME type for missing extension 
+        #ns_param   ".xls"         "application/vnd.ms-excel''
+
+# 
+# Tcl Configuration 
+# 
+ns_section "ns/server/${server}/tcl" 
+        ns_param autoclose 	"on" 
+        ns_param debug 		"false" 
+ 
+
+# This is where this server's private Tcl library is. All .tcl files in this directory 
+# are parsed when AOLserver starts. The crucial procedures used in OpenACS are
+# defined through this library
+#
+        ns_param library "/web/${server}/tcl" 
+
+############################################################ 
+# 
+# Server-level configuration 
+# 
+#  There is only one server in AOLserver, but this is helpful when multiple
+#  servers share the same configuration file.  This file assumes that only
+#  one server is in use so it is set at the top in the "server" Tcl variable
+#  Other host-specific values are set up above as Tcl variables, too.
+# 
+ns_section "ns/servers" 
+        ns_param   $server     $servername 
+
+# 
+# Server parameters 
+# 
+ns_section "ns/server/${server}" 
+        ns_param   directoryfile        $directoryfile 
+        ns_param   pageroot             $pageroot 
+        ns_param   globalstats          false     ;# Enable built-in statistics 
+        ns_param   urlstats             false     ;# Enable URL statistics 
+        ns_param   maxurlstats          1000      ;# Max number of URL's to do stats on
+        ns_param   enabletclpages       true      ;# Parse tcl files in pageroot (dangerous)
+
+#
+# If you want to customize AOLserver's response to things like ``Internal Server Error''
+# and other HTTP responses. OpenACS comes with some in the directory www/global.
+
+        ns_param   NotFoundResponse   		"/global/file-not-found.html"
+        ns_param   ServerBusyResponse	  	"/global/busy.html"
+        ns_param   ServerInternalErrorResponse 	"/global/error.html"
+        ns_param   ForbiddenResponse   		"/global/forbidden.html"
+        ns_param   UnauthorizedResponse  	"/global/unauthorized.html"
+
+# Directory listings -- use an ADP or a Tcl proc to generate them.
+#
+        #ns_param   directoryadp    $pageroot/dirlist.adp ;# Choose one or the other
+        ns_param   directoryproc    _ns_dirlist           ;#  ...but not both! 
+        ns_param   directorylisting  fancy                ;# Can be simple or fancy 
+# 
+# ADP (AOLserver Dynamic Page) configuration 
+# 
+ns_section "ns/server/${server}/adp" 
+        ns_param   map           "/*.adp"  ;# Extensions to parse as ADP's 
+        #ns_param   map          "/*.html" ;# Any extension can be mapped 
+        ns_param   enableexpire  false     ;# Set "Expires: now" on all ADP's 
+        ns_param   enabledebug   false     ;# Allow Tclpro debugging with "?debug"
+
+ 
+
+# ADP special pages 
+        #ns_param   errorpage      ${pageroot}/errorpage.adp ;# Pretty-print ADP scripting errors
+
+# 
+# ADP custom parsers -- see adp.c 
+# 
+ns_section "ns/server/${server}/adp/parsers" 
+        ns_param   fancy            ".adp"
+
+# 
+# Socket driver module (HTTP)  -- nssock 
+# 
+ns_section "ns/server/${server}/module/nssock" 
+        ns_param   port         $httpport 
+        ns_param   hostname     $hostname 
+        ns_param   address      $address
+
+# 
+# Socket driver module (HTTPS) -- nsssl 
+# 
+#  nsssl does not load unless sslkeyfile/sslcertfile exist (above).
+# 
+ns_section "ns/server/${server}/module/nsssl" 
+        ns_param   port        $httpsport 
+        ns_param   hostname    $hostname 
+        ns_param   address     $address 
+        ns_param   keyfile     $sslkeyfile 
+        ns_param   certfile    $sslcertfile
+
+# 
+# Database drivers 
+# The database driver is specified here. PostgreSQL driver being loaded.
+# Make sure you have the driver compiled and put it in {aolserverdir}/bin
+#
+ns_section "ns/db/drivers" 
+    ns_param   postgres     ${bindir}/postgres.so  ;# Load PostgreSQL driver
+
+# 
+# Database Pools: This is how AOLserver  ``talks'' to the RDBMS. You need three for
+# OpenACS: main, log, subquery. Make sure to replace ``yourdb'' and ``yourpassword''
+# with the actual values for your db name and the password for it.
+# AOLserver can have different pools connecting to different databases and even different
+# different database servers.
+# 
+ns_section "ns/db/pools" 
+    ns_param   main       "OpenACS Main Pool" 
+    ns_param   log        "OpenACS Log Pool" 
+    ns_param   subquery   "OpenACS Subquery Pool"
+
+ns_section "ns/db/pool/main" 
+    ns_param Driver postgres 
+    ns_param Connections 5                  ;# 5 is a good number. Increase according to your needs
+    ns_param DataSource localhost::yourdb   ;# Replace 'yourdb' with the name of your database in PG
+    ns_param User nsadmin                   ;# User and password AOLserver will use to connect
+    ns_param Password "yourpassword" 
+    ns_param Verbose Off                    ;# Set it to On to see all queries. Good for debugging SQL.
+    ns_param LogSQLErrors On 
+    ns_param ExtendedTableInfo On 
+   # ns_param MaxOpen 1000000000            ;# Max time to keep idle db connection open
+   # ns_param MaxIdle 1000000000            ;# Max time to keep active db connection open 
+
+ns_section "ns/db/pool/log" 
+    ns_param Driver postgres 
+    ns_param Connections 5 
+    ns_param DataSource localhost::yourdb 
+    ns_param User nsadmin 
+    ns_param Password "yourpassword" 
+    ns_param Verbose On 
+    ns_param LogSQLErrors On 
+    ns_param ExtendedTableInfo On 
+   # ns_param MaxOpen 1000000000 
+   # ns_param MaxIdle 1000000000 
+
+ns_section "ns/db/pool/subquery" 
+    ns_param Driver postgres 
+    ns_param Connections 2 
+    ns_param DataSource localhost::yourdb 
+    ns_param User nsadmin 
+    ns_param Password "yourpassword" 
+    ns_param Verbose On 
+    ns_param LogSQLErrors On 
+    ns_param ExtendedTableInfo On
+   # ns_param MaxOpen 1000000000 
+   # ns_param MaxIdle 1000000000 
+
+ns_section "ns/server/${server}/db" 
+        ns_param Pools          "*" 
+        ns_param DefaultPool    "main"
+
+#
+# nscp: AOLserver Control Port - very useful for testing and evaluating.
+# Uncomment the sample password below and do a "telnet localhost 9999"
+# log in with "nsadmin", password "x", type "ns_crypt newpassword salt"
+# and paste the new encrypted string below.
+#
+# Sample User="nsadmin", password="x" 
+ set nscp_user              "nsadmin:t2GqvvaiIUbF2:"
+
+# 
+# Control port -- nscp 
+#  nscp does not load unless nscp_user is a valid user. 
+# 
+ns_section "ns/server/${server}/module/nscp" 
+        ns_param   port            9999 
+        ns_param   address         "127.0.0.1" ;# LOCALHOST IS RECOMMENDED      
+
+ns_section "ns/server/${server}/module/nscp/users" 
+        ns_param   user            $nscp_user
+
+# 
+# Access log -- nslog 
+# 
+ns_section "ns/server/${server}/module/nslog" 
+        ns_param   rolllog         true      ;# Should we roll log? 
+        ns_param   rollonsignal    true      ;# Roll log on SIGHUP 
+        ns_param   rollhour        0         ;# Time to roll log 
+        ns_param   maxbackup       5         ;# Max number to keep around when rolling 
+
+#
+# nsjava - aolserver module that embeds a java virtual machine.  Needed to 
+#          support webmail.  See http://nsjava.sourceforge.net for further 
+#          details.
+#
+
+ns_section "ns/server/acs-pg/module/nsjava"
+        ns_param   EnableJava          "off"  ;# Set to on to enable nsjava.
+        ns_param   VerboseJvm          "off"  ;# Same as command line -debug.
+        ns_param   LogLevel            "Notice"
+        ns_param   DestroyJvm          "off"  ;# Destroy jvm on shutdown.
+        ns_param   DisableJITCompiler  "off"  
+        ns_param   ClassPath "/usr/local/jdk/jdk118_v1/lib/classes.zip:/usr/local/aolserver/bin/nsjava.jar:/home/nsadmin/mirror/acs3-pg/www/webmail/java/activation.jar:/home/nsadmin/mirror/acs3-pg/www/webmail/java/mail.jar:/home/nsadmin/mirror/acs3-pg/www/webmail/java" 
+
+# 
+# CGI interface -- nscgi, if you have legacy stuff. Tcl or ADP files inside 
+# AOLserver are vastly superior to CGIs. You don't actually need the Interps 
+# if your script calls the appropriate interpreter itself.
+# 
+#ns_section "ns/server/${server}/module/nscgi" 
+#       ns_param   map "GET  /cgi-bin /web/$server/cgi-bin"
+#       ns_param   map "POST /cgi-bin /web/$server/cgi-bin" 
+#       ns_param   Interps CGIinterps
+
+#ns_section "ns/interps/CGIinterps" 
+#       ns_param .pl "/usr/bin/perl"
+
+# 
+# Modules to load 
+# 
+ns_section "ns/server/${server}/modules" 
+        ns_param   nssock          ${bindir}/nssock.so 
+        ns_param   nslog            ${bindir}/nslog.so 
+#        ns_param   nsperm          ${bindir}/nsperm.so 
+#        ns_param   nscgi           ${bindir}/nscgi.so 
+        ns_param   nsjava          ${bindir}/libnsjava.so
+
+#
+## nsssl: loads only if requisite files already exist (see top of this
+# file). 
+#
+if { [file exists $sslcertfile] && [file exists $sslkeyfile] } { 
+    ns_param nsssl ${bindir}/nsssle.so 
+} else { 
+    ns_log warning "nsd.tcl: nsssl not loaded because key/cert files do not exist."
+}
+
+# nscp: loads only if nscp_user is set (see top of this file).
+if { $nscp_user != "" } {
+    ns_param nscp ${bindir}/nscp.so
+} else {
+    ns_log warning "nsd.tcl: nscp not loaded because user/password is not set."
+}
+
+# 
+# To Source OpenACS Config File. You need a "yourservername.tcl" file in the
+# OpenACS parameters dir. e.g.: say your server is "server1" then you'd need a
+# file named /web/server1/parameters/server1.tcl
+# (Hint: Rename ad.tcl to yourservername.tcl and edit it.)
+#
+
+source /web/${server}/parameters/${server}.tcl
+
+ns_log notice "nsd.tcl: finished reading config file."
Index: web/openacs/www/doc/openacs/restart-aolserver.txt
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/restart-aolserver.txt,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/restart-aolserver.txt	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,61 @@
+#!/usr/local/bin/perl
+# restart-aolserver,v 3.2.4.1 2000/03/16 10:59:24 james Exp
+
+## Restarts an AOLserver. Takes as its only argument the name of the
+## server to kill.
+
+## This is a perl script because it needs to run setuid root, 
+## and perl has fewer security gotchas than most shells.
+
+use strict;
+
+## added to resolve a taint issue in rh linux due to ENV varables being passed - doug@arsdigita.com - 2000-06-08
+
+undef %ENV;
+
+$ENV{'PATH'} = '/sbin:/bin';
+my @superusers=('roberto','nsadmin','brucek','dbryant');
+
+my $name;
+($name) = (getpwuid($<))[0];
+
+my $superuser = 0;
+if (grep ($name eq $_,@superusers) ) {
+   $superuser = 1;
+}
+
+if (scalar(@ARGV) == 0 && !$superuser) {
+    die "Don't run this without any arguments!\n";
+}
+
+my $server = shift;
+# untaint this variable to make suidperl happy
+$server =~ /^([\w-]*)$/;
+my $servername = $1;
+
+if ($server && !$servername) {
+   die "An AOL servername should only have letters, numbers, underscores, or a dash.\nYou told us to restart $server, and we can't do that.
+
+You just want to say something like \"restart-aolserver student000\".
+"
+} elsif (!$servername && !$superuser) {
+   die "We need something besides the empty string to restart.\n"
+}
+
+$< = $>; # set realuid to effective uid (root)
+
+## get the PIDs of all jobdirect servers
+## changed '/usr/bin/ps -ef' to '/bin/ps -efw' - doug@arsdigita.com - 2000-06-08
+
+open(PID, "/bin/ps -efw |") || die $!;
+my @pids;
+while (<PID>) {
+  next unless /^\s*\S+\s+(\d+).*nsd.*\/$servername\.tcl/;
+  my $pid = $1;
+  push(@pids, $pid);
+}
+close PID;
+
+print "Killing ", join(" ", @pids), "\n";
+kill 'KILL', @pids;
+
Index: web/openacs/www/doc/openacs/aolserver/index.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/aolserver/index.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/aolserver/index.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,155 @@
+<HTML
+><HEAD
+><TITLE
+>  Simple AOLserver Install Guide
+ </TITLE
+><META
+NAME="GENERATOR"
+CONTENT="Modular DocBook HTML Stylesheet Version 1.61
+"><LINK
+REL="NEXT"
+TITLE="  Getting the best web/application server up and running
+ "
+HREF="x10.html"></HEAD
+><BODY
+CLASS="ARTICLE"
+BGCOLOR="#FFFFFF"
+TEXT="#000000"
+LINK="#0000FF"
+VLINK="#840084"
+ALINK="#0000FF"
+><DIV
+CLASS="ARTICLE"
+><DIV
+CLASS="TITLEPAGE"
+><H1
+CLASS="TITLE"
+><A
+NAME="AEN2"
+>Simple AOLserver Install Guide</A
+></H1
+><H3
+CLASS="AUTHOR"
+><A
+NAME="AEN4"
+>Roberto Mello (rmello@fslc.usu.edu)</A
+></H3
+><DIV
+><DIV
+CLASS="ABSTRACT"
+><A
+NAME="AEN7"
+></A
+><P
+></P
+><P
+>  A simple AOLserver installation guide. My development box is a marvelous Debian GNU/Linux system, so if this doesn't work on a platform other than GNU/Linux, it's probably due to some specific thing.
+ </P
+><P
+>  This is the February 2001 revision of the documentation.
+ </P
+><P
+></P
+></DIV
+></DIV
+><HR></DIV
+><DIV
+CLASS="TOC"
+><DL
+><DT
+><B
+>Table of Contents</B
+></DT
+><DT
+>1. <A
+HREF="x10.html"
+>Getting the best web/application server up and running</A
+></DT
+><DD
+><DL
+><DT
+>1.1. <A
+HREF="x10.html#AEN12"
+>What you need</A
+></DT
+><DT
+>1.2. <A
+HREF="x10.html#AEN23"
+>Downloading and UN-tarring</A
+></DT
+><DT
+>1.3. <A
+HREF="x10.html#AEN31"
+>Building and Installing</A
+></DT
+><DT
+>1.4. <A
+HREF="x10.html#AEN39"
+>Testing and Configuring</A
+></DT
+><DT
+>1.5. <A
+HREF="x10.html#AEN47"
+>Setting it to be restarted</A
+></DT
+><DT
+>1.6. <A
+HREF="x10.html#AEN54"
+>Securing Your Installation</A
+></DT
+></DL
+></DD
+></DL
+></DIV
+></DIV
+><DIV
+CLASS="NAVFOOTER"
+><HR
+ALIGN="LEFT"
+WIDTH="100%"><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+><A
+HREF="x10.html"
+>Next</A
+></TD
+></TR
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>Getting the best web/application server up and running</TD
+></TR
+></TABLE
+></DIV
+></BODY
+></HTML
+>
\ No newline at end of file
Index: web/openacs/www/doc/openacs/aolserver/x10.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/aolserver/x10.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/aolserver/x10.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,361 @@
+<HTML
+><HEAD
+><TITLE
+>  Getting the best web/application server up and running
+ </TITLE
+><META
+NAME="GENERATOR"
+CONTENT="Modular DocBook HTML Stylesheet Version 1.61
+"><LINK
+REL="HOME"
+TITLE="  Simple AOLserver Install Guide
+ "
+HREF="index.html"><LINK
+REL="PREVIOUS"
+TITLE="  Simple AOLserver Install Guide
+ "
+HREF="index.html"></HEAD
+><BODY
+CLASS="SECT1"
+BGCOLOR="#FFFFFF"
+TEXT="#000000"
+LINK="#0000FF"
+VLINK="#840084"
+ALINK="#0000FF"
+><DIV
+CLASS="NAVHEADER"
+><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TH
+COLSPAN="3"
+ALIGN="center"
+>Simple AOLserver Install Guide</TH
+></TR
+><TR
+><TD
+WIDTH="10%"
+ALIGN="left"
+VALIGN="bottom"
+><A
+HREF="index.html"
+>Prev</A
+></TD
+><TD
+WIDTH="80%"
+ALIGN="center"
+VALIGN="bottom"
+></TD
+><TD
+WIDTH="10%"
+ALIGN="right"
+VALIGN="bottom"
+>&nbsp;</TD
+></TR
+></TABLE
+><HR
+ALIGN="LEFT"
+WIDTH="100%"></DIV
+><DIV
+CLASS="SECT1"
+><H1
+CLASS="SECT1"
+><A
+NAME="AEN10"
+>1. Getting the best web/application server up and running</A
+></H1
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN12"
+>1.1. What you need</A
+></H2
+><P
+></P
+><UL
+><LI
+><P
+>   GCC (GNU Compiler Collection)
+   </P
+></LI
+><LI
+><P
+>   GMake (GNU Make - Default in GNU/Linux)
+   </P
+></LI
+><LI
+><P
+>   Development libraries including glibc and libpthread
+   </P
+></LI
+><LI
+><P
+>   GNU tar and Gzip
+   </P
+></LI
+></UL
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN23"
+>1.2. Downloading and UN-tarring</A
+></H2
+><P
+>   Create a user and group for AOLserver, such as nsadmin. In GNU/Linux you would do:
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>addgroup nsadmin
+adduser -g nsadmin nsadmin
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   Get the AOLserver source (not the binaries, unless you know what you're doing) distribution from <A
+HREF="http://www.aolserver.com/download"
+TARGET="_top"
+>http://www.aolserver.com/download</A
+>.
+  </P
+><P
+>   Untar it at some temporary directory such as /usr/local/src with the following command:
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>tar xzvf aolserver3_0.tar.gz
+  </PRE
+></TD
+></TR
+></TABLE
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN31"
+>1.3. Building and Installing</A
+></H2
+><P
+>   cd into the newly created directory (aolserver3_0 for AOLserver 3.0) and do a:
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>make (or gmake if you are not using GNU/Linux)
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   Once the compilation process is over, it's time to install AOLserver. Choose a directory to install AOLserver at, such as /home/aolserver. Then do a:
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>make install INST=/home/aolserver
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   Now change the ownership of the directory where you installed AOLserver with:
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>chown -R nsadmin:nsadmin /home/aolserver
+  </PRE
+></TD
+></TR
+></TABLE
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN39"
+>1.4. Testing and Configuring</A
+></H2
+><P
+>   AOLserver comes with two nsd (the main AOLserver daemon) files: nsd76 and nsd8x. nsd76 uses Tcl 7.6, which is an AOLserver-hacked Tcl version highly optimized for multithreading and performance. nsd8x uses Tcl 8.3 which offers some nice extra regular expressions features, byte code compiler and other things. In my personal experience nsd76 is a bit faster, so choose it according to your needs. Simply make a symbolic link to the file of your choice (nsd -&#62; nsd76 or nsd -&#62; nsd8x).
+  </P
+><P
+>   To do a quick-test on your AOLserver installation, CD into the AOLserver directory and (as the AOLserver user - e.g. nsadmin) do a:
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>./bin/nsd -kt nsd.tcl
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   Then with your browser, go to yourdomain.com:8000 and you should see AOLserver's default page.
+  </P
+><P
+>   Find AOLserver's PID (ps aux | grep nsd) and kill it (kill -9 pid). You can then use <A
+HREF="/doc/openacs/nsd.txt"
+TARGET="_top"
+>our nsd.tcl</A
+> to configure your AOLserver. More information on the nsd.tcl config file can be found in doc/config.txt in the AOLserver source tree.
+  </P
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN47"
+>1.5. Setting it to be restarted</A
+></H2
+><P
+>   AOLserver must be started as root so it can use the priviledged ports 80 and 443. You need to pass the user and group to which it will switch right after starting. 
+  </P
+><P
+>   The most common way to have AOLserver restarted even if the computer needs to be rebooted is by including it in your <I
+CLASS="EMPHASIS"
+>/etc/inittab</I
+> file. Include a line like this in your /etc/inittab:
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>as:2345:respawn:/home/aolserver/bin/nsd -it /home/aolserver/nsd.tcl -u nsadmin -g nsadmin
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   As of OpenACS 3.2.2, if you need to you can restart AOLserver right from the OpenACS admin pages. To restart it from the command line use the &#8220;-k&#8221; flag to nsd (e.g. /home/aolserver/bin/nsd -kt /home/aolserver/nsd.tcl -u nsadmin -g nsadmin).
+  </P
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN54"
+>1.6. Securing Your Installation</A
+></H2
+><P
+>   It is safer to run AOLserver in a chrooted environment. I am not including instructions here for simplicity's sake. Follow these links to learn how to do it.
+  </P
+><P
+>   <A
+HREF="http://aolserver.com/docs/admin/sec-ch2.htm#8685"
+TARGET="_top"
+>http://aolserver.com/docs/admin/sec-ch2.htm#8685</A
+>
+  </P
+><P
+>   <A
+HREF="http://www.arsdigita.com/doc/security"
+TARGET="_top"
+>http://www.arsdigita.com/doc/security</A
+>
+  </P
+></DIV
+></DIV
+><DIV
+CLASS="NAVFOOTER"
+><HR
+ALIGN="LEFT"
+WIDTH="100%"><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+><A
+HREF="index.html"
+>Prev</A
+></TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+><A
+HREF="index.html"
+>Home</A
+></TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>&nbsp;</TD
+></TR
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>Simple AOLserver Install Guide</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>&nbsp;</TD
+></TR
+></TABLE
+></DIV
+></BODY
+></HTML
+>
\ No newline at end of file
Index: web/openacs/www/doc/openacs/getting-started/index.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/getting-started/index.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/getting-started/index.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,211 @@
+<HTML
+><HEAD
+><TITLE
+>  OpenACS Getting Started Guide
+ </TITLE
+><META
+NAME="GENERATOR"
+CONTENT="Modular DocBook HTML Stylesheet Version 1.61
+"><LINK
+REL="NEXT"
+TITLE="  Thinking about your web service
+ "
+HREF="x10.html"></HEAD
+><BODY
+CLASS="ARTICLE"
+BGCOLOR="#FFFFFF"
+TEXT="#000000"
+LINK="#0000FF"
+VLINK="#840084"
+ALINK="#0000FF"
+><DIV
+CLASS="ARTICLE"
+><DIV
+CLASS="TITLEPAGE"
+><H1
+CLASS="TITLE"
+><A
+NAME="AEN2"
+>OpenACS Getting Started Guide</A
+></H1
+><H3
+CLASS="AUTHOR"
+><A
+NAME="AEN4"
+>Roberto Mello (rmello@fslc.usu.edu)</A
+></H3
+><DIV
+><DIV
+CLASS="ABSTRACT"
+><A
+NAME="AEN7"
+></A
+><P
+></P
+><P
+>  This is a guide to help you get started with OpenACS. This is not a complete guide to OpenACS and its modules... it would be too long. For detailed documentation on a module, refer to the www/doc directory in the OpenACS distribution. This guide assumes you have a working installation of OpenACS.
+ </P
+><P
+>  This is the February 2001 revision of the documentation.
+ </P
+><P
+></P
+></DIV
+></DIV
+><HR></DIV
+><DIV
+CLASS="TOC"
+><DL
+><DT
+><B
+>Table of Contents</B
+></DT
+><DT
+>1. <A
+HREF="x10.html"
+>Thinking about your web service</A
+></DT
+><DT
+>2. <A
+HREF="x18.html"
+>OpenACS Basics</A
+></DT
+><DD
+><DL
+><DT
+>2.1. <A
+HREF="x18.html#AEN20"
+>Admin pages are your friends</A
+></DT
+><DT
+>2.2. <A
+HREF="x18.html#AEN28"
+>Content Sections</A
+></DT
+><DT
+>2.3. <A
+HREF="x18.html#AEN32"
+>User Groups</A
+></DT
+></DL
+></DD
+><DT
+>3. <A
+HREF="x43.html"
+>Look and feel</A
+></DT
+><DD
+><DL
+><DT
+>3.1. <A
+HREF="x43.html#AEN59"
+>Editing ad_header and ad_footer</A
+></DT
+><DT
+>3.2. <A
+HREF="x43.html#AEN71"
+>Customized ADP tags</A
+></DT
+><DT
+>3.3. <A
+HREF="x43.html#AEN81"
+>Templates</A
+></DT
+><DT
+>3.4. <A
+HREF="x43.html#AEN93"
+>ArsDigita Templating System (ATS)</A
+></DT
+></DL
+></DD
+><DT
+>4. <A
+HREF="x99.html"
+>Backups tips from Don Baccus</A
+></DT
+><DD
+><DL
+><DT
+>4.1. <A
+HREF="x99.html#AEN101"
+>The Strategy</A
+></DT
+><DT
+>4.2. <A
+HREF="x99.html#AEN119"
+>The &#8220;<I
+CLASS="EMPHASIS"
+>vacuum analyze</I
+>&#8221; command</A
+></DT
+><DT
+>4.3. <A
+HREF="x99.html#AEN124"
+>Sample Tcl script</A
+></DT
+></DL
+></DD
+><DT
+>5. <A
+HREF="x128.html"
+>Intranet Getting Started Guide</A
+></DT
+><DT
+>6. <A
+HREF="x178.html"
+>Acknowledgements</A
+></DT
+></DL
+></DIV
+></DIV
+><DIV
+CLASS="NAVFOOTER"
+><HR
+ALIGN="LEFT"
+WIDTH="100%"><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+><A
+HREF="x10.html"
+>Next</A
+></TD
+></TR
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>Thinking about your web service</TD
+></TR
+></TABLE
+></DIV
+></BODY
+></HTML
+>
\ No newline at end of file
Index: web/openacs/www/doc/openacs/getting-started/x10.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/getting-started/x10.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/getting-started/x10.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,154 @@
+<HTML
+><HEAD
+><TITLE
+>  Thinking about your web service
+ </TITLE
+><META
+NAME="GENERATOR"
+CONTENT="Modular DocBook HTML Stylesheet Version 1.61
+"><LINK
+REL="HOME"
+TITLE="  OpenACS Getting Started Guide
+ "
+HREF="index.html"><LINK
+REL="PREVIOUS"
+TITLE="  OpenACS Getting Started Guide
+ "
+HREF="index.html"><LINK
+REL="NEXT"
+TITLE="  OpenACS Basics
+ "
+HREF="x18.html"></HEAD
+><BODY
+CLASS="SECT1"
+BGCOLOR="#FFFFFF"
+TEXT="#000000"
+LINK="#0000FF"
+VLINK="#840084"
+ALINK="#0000FF"
+><DIV
+CLASS="NAVHEADER"
+><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TH
+COLSPAN="3"
+ALIGN="center"
+>OpenACS Getting Started Guide</TH
+></TR
+><TR
+><TD
+WIDTH="10%"
+ALIGN="left"
+VALIGN="bottom"
+><A
+HREF="index.html"
+>Prev</A
+></TD
+><TD
+WIDTH="80%"
+ALIGN="center"
+VALIGN="bottom"
+></TD
+><TD
+WIDTH="10%"
+ALIGN="right"
+VALIGN="bottom"
+><A
+HREF="x18.html"
+>Next</A
+></TD
+></TR
+></TABLE
+><HR
+ALIGN="LEFT"
+WIDTH="100%"></DIV
+><DIV
+CLASS="SECT1"
+><H1
+CLASS="SECT1"
+><A
+NAME="AEN10"
+>1. Thinking about your web service</A
+></H1
+><P
+>  OpenACS is a toolkit for online communities. This is a pretty powerful concept. If you think that most of the successful websites are community-oriented, you'll begin to see the power that OpenACS brings to you.
+ </P
+><P
+>  Most people get too focused on how their website is going to look, rather than thinking what it's going to provide for the users. Looks are important, but if you don't have content and services well organized, you can have as much looks as you want. Yahoo.com is pretty much all text-based, but it's fast and provides lots of content to users, or &#8220;magnet content&#8221; as Philip Greenspun calls. 
+ </P
+><P
+>  OpenACS has over 40 modules to facilitate collaboration among users. You need to think which of these modules you can use in your web service and what's the best way to do it. A complete list of OpenACS modules is at <A
+HREF="http://www.arsdigita.com/pages/toolkit"
+TARGET="_top"
+>http://www.arsdigita.com/pages/toolkit</A
+>. After you have that planned and defined, you can start worrying about look and feel. You should also read the Webmasters Guide, which is at /doc/webmasters.html.
+ </P
+><P
+>  Refer to <A
+HREF="http:/photo.net/wtr/thebook/"
+TARGET="_top"
+>Philip and Alex's Guide to Web Publishing</A
+> for more info on how to build great web services.
+ </P
+></DIV
+><DIV
+CLASS="NAVFOOTER"
+><HR
+ALIGN="LEFT"
+WIDTH="100%"><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+><A
+HREF="index.html"
+>Prev</A
+></TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+><A
+HREF="index.html"
+>Home</A
+></TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+><A
+HREF="x18.html"
+>Next</A
+></TD
+></TR
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>OpenACS Getting Started Guide</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>OpenACS Basics</TD
+></TR
+></TABLE
+></DIV
+></BODY
+></HTML
+>
\ No newline at end of file
Index: web/openacs/www/doc/openacs/getting-started/x128.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/getting-started/x128.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/getting-started/x128.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,317 @@
+<HTML
+><HEAD
+><TITLE
+>  Intranet Getting Started Guide
+ </TITLE
+><META
+NAME="GENERATOR"
+CONTENT="Modular DocBook HTML Stylesheet Version 1.61
+"><LINK
+REL="HOME"
+TITLE="  OpenACS Getting Started Guide
+ "
+HREF="index.html"><LINK
+REL="PREVIOUS"
+TITLE="  Backups tips from Don Baccus
+ "
+HREF="x99.html"><LINK
+REL="NEXT"
+TITLE="  Acknowledgements
+ "
+HREF="x178.html"></HEAD
+><BODY
+CLASS="SECT1"
+BGCOLOR="#FFFFFF"
+TEXT="#000000"
+LINK="#0000FF"
+VLINK="#840084"
+ALINK="#0000FF"
+><DIV
+CLASS="NAVHEADER"
+><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TH
+COLSPAN="3"
+ALIGN="center"
+>OpenACS Getting Started Guide</TH
+></TR
+><TR
+><TD
+WIDTH="10%"
+ALIGN="left"
+VALIGN="bottom"
+><A
+HREF="x99.html"
+>Prev</A
+></TD
+><TD
+WIDTH="80%"
+ALIGN="center"
+VALIGN="bottom"
+></TD
+><TD
+WIDTH="10%"
+ALIGN="right"
+VALIGN="bottom"
+><A
+HREF="x178.html"
+>Next</A
+></TD
+></TR
+></TABLE
+><HR
+ALIGN="LEFT"
+WIDTH="100%"></DIV
+><DIV
+CLASS="SECT1"
+><H1
+CLASS="SECT1"
+><A
+NAME="AEN128"
+>5. Intranet Getting Started Guide</A
+></H1
+><P
+>  This section was written by Jade Rubick with slight modifications by Roberto Mello. The ACS Intranet module is being used by large corporations such as Siemens to manage their intranets.
+ </P
+><P
+>  Congratulations, you've just installed ACS. You've managed to get through the install guide (or the OpenACS install guide), you've gotten Oracle or Postgres working, you're now a pretty cool person because you got it working.
+ </P
+><P
+>  Well, if you're using the Intranet module, you're going to need some more setup, and currently, I don't know of any good documentation on the module except for what is at <A
+HREF="http://www.arsdigita.com/doc/intranet"
+TARGET="_top"
+>ArsDigita</A
+>. Read that first.
+ </P
+><P
+>  The Intranet is a pretty complicated module because it relies conceptually on so many other modules. Unless you already understand the ACS, it may take a while to get a handle on it.
+ </P
+><P
+>  First of all, if you're using Postgres 7.02, I recommend applying <A
+HREF="http://openacs.org/bboard/q-and-a-fetch-msg.tcl?msg_id=0000RV"
+TARGET="_top"
+>a patch</A
+> that fixes the <A
+HREF="PortalHeapMemoryError"
+TARGET="_top"
+>http://www.postgresql.org/bugs/bugs.php?4~2</A
+>. Preferably, you would install this before installing OpenACS, because otherwise you have to export and import your data to get this working. But the directions are pretty good, so just follow them carefully. I'm not sure if this works completely though -- I started from a fresh copy. (<I
+CLASS="EMPHASIS"
+>NOTE: This is most likely fixed in PostgreSQL 7.0.3 and later versions.</I
+>)
+ </P
+><P
+>  Steps to getting your intranet running:
+ </P
+><P
+></P
+><UL
+><LI
+><P
+>  Set up your admin account and so on like the directions say.
+  </P
+></LI
+><LI
+><P
+>  Go through your <I
+CLASS="EMPHASIS"
+>/web/servicename/parameters/servicename.tcl</I
+> or .ini file and set the preferences for Intranet and New-ticket modules. Make sure you enable the Intranet module.
+  </P
+></LI
+><LI
+><P
+>  In your web browser, go to <I
+CLASS="EMPHASIS"
+>/admin/users</I
+> and add in the users you want. I assume these are Employees -- they won't be able to use the Intranet unless you then go to /admin/ug and click on Intranet. Add them to both the Authorized Users and Employees category.
+  </P
+></LI
+><LI
+><P
+>  While you're in the Intranet/Employees section of <I
+CLASS="EMPHASIS"
+>/admin/ug</I
+>, click on "<I
+CLASS="EMPHASIS"
+>add module</I
+>" under "<I
+CLASS="EMPHASIS"
+>Modules associated with groups in Employees</I
+>". Set up the news module. They will then be able to make company-wide postings for the main page, and be able to see other postings. Otherwise, they will get an error when they click on the post an item link on the main intranet page.
+  </P
+></LI
+><LI
+><P
+>  Go to the /intranet page. Click on "<I
+CLASS="EMPHASIS"
+>Offices</I
+>", and set up an office.
+  </P
+></LI
+><LI
+><P
+>  Set up your partner types. This is a pain, unless I'm overlooking an easier way to do it. You have to open up a shell, start up postgres, and change the categories in the database. Then, you have to restart AOLserver, because I believe the variables are cached in memory.
+  </P
+></LI
+></UL
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>[postgres@intranet pgsql]$ psql intranet (or your servicename)
+Welcome to psql, the PostgreSQL interactive terminal.
+
+Type: copyright for distribution terms 
+      h for help with SQL commands 
+      ? for help on internal slash commands 
+      g or terminate with semicolon to execute query 
+      q to quit
+
+intranet=# select * from im_partner_types ;
+
+partner_type_id |    partner_type    | display_order
+----------------+--------------------+--------------- 
+              1 | Usability          | 1
+              2 | Graphics           | 2 
+              3 | Strategy           | 3 
+              4 | Supplier           | 4 
+              5 | Sys-admin          | 5 
+              6 | Hosting            | 6 
+              7 | Systems Integrator | 7 
+(7 rows)
+
+intranet=# update im_partner_types set partner_type = 'Service Provider' intranet
+-# where partner_type = 'Usability'; 
+UPDATE 1
+
+intranet=# select * from im_partner_types ;
+partner_type_id |     partner_type       | display_order
+----------------+------------------------+--------------- 
+              2 | Graphics               | 2 
+              3 | Strategy               | 3 
+              4 | Supplier               | 4 
+              5 | Sys-admin              | 5 
+              6 | Hosting                | 6 
+              7 | Systems Integrator     | 7 
+              1 | Service Provider       | 1 
+(7 rows)
+ </PRE
+></TD
+></TR
+></TABLE
+><P
+></P
+><UL
+><LI
+><P
+>  Don't forget to restart Aolserver
+  </P
+></LI
+><LI
+><P
+>  If you don't have site-wide-search, you might want to disable the site-wide-search box on the main /intranet page.
+  </P
+></LI
+><LI
+><P
+>  Set up the calendar categories in /calendar/admin. Look at the <A
+HREF="http://www.openacs.org/doc/calendar"
+TARGET="_top"
+>documentation</A
+> that won't be relevant to this at all :) Think of categories like: Social, Project Meeting, etc...
+  </P
+></LI
+><LI
+><P
+>  Get pictures for everyone in your office and put them in. Or let everyone do it themselves.
+  </P
+></LI
+><LI
+><P
+>  Add in any Discussion Groups you might want.
+  </P
+></LI
+><LI
+><P
+>  Add in teams for the <I
+CLASS="EMPHASIS"
+>new-ticket</I
+> module. Go to <I
+CLASS="EMPHASIS"
+>/team</I
+> to add in teams. Make sure everyone who will be using the ticket system is part of a team. If you don't do this, tickets won't work.
+  </P
+></LI
+><LI
+><P
+>  Change the project types if the project types don't fit what you need. I haven't done this yet, so no help here. Sorry!
+  </P
+></LI
+></UL
+></DIV
+><DIV
+CLASS="NAVFOOTER"
+><HR
+ALIGN="LEFT"
+WIDTH="100%"><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+><A
+HREF="x99.html"
+>Prev</A
+></TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+><A
+HREF="index.html"
+>Home</A
+></TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+><A
+HREF="x178.html"
+>Next</A
+></TD
+></TR
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>Backups tips from Don Baccus</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>Acknowledgements</TD
+></TR
+></TABLE
+></DIV
+></BODY
+></HTML
+>
\ No newline at end of file
Index: web/openacs/www/doc/openacs/getting-started/x178.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/getting-started/x178.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/getting-started/x178.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,133 @@
+<HTML
+><HEAD
+><TITLE
+>  Acknowledgements
+ </TITLE
+><META
+NAME="GENERATOR"
+CONTENT="Modular DocBook HTML Stylesheet Version 1.61
+"><LINK
+REL="HOME"
+TITLE="  OpenACS Getting Started Guide
+ "
+HREF="index.html"><LINK
+REL="PREVIOUS"
+TITLE="  Intranet Getting Started Guide
+ "
+HREF="x128.html"></HEAD
+><BODY
+CLASS="SECT1"
+BGCOLOR="#FFFFFF"
+TEXT="#000000"
+LINK="#0000FF"
+VLINK="#840084"
+ALINK="#0000FF"
+><DIV
+CLASS="NAVHEADER"
+><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TH
+COLSPAN="3"
+ALIGN="center"
+>OpenACS Getting Started Guide</TH
+></TR
+><TR
+><TD
+WIDTH="10%"
+ALIGN="left"
+VALIGN="bottom"
+><A
+HREF="x128.html"
+>Prev</A
+></TD
+><TD
+WIDTH="80%"
+ALIGN="center"
+VALIGN="bottom"
+></TD
+><TD
+WIDTH="10%"
+ALIGN="right"
+VALIGN="bottom"
+>&nbsp;</TD
+></TR
+></TABLE
+><HR
+ALIGN="LEFT"
+WIDTH="100%"></DIV
+><DIV
+CLASS="SECT1"
+><H1
+CLASS="SECT1"
+><A
+NAME="AEN178"
+>6. Acknowledgements</A
+></H1
+><P
+>  Several people have contributed to this document in either content or error reporting and I would like to thank them. Please let me know if I forgot to include your name.
+ </P
+><P
+>  Contributors (in no specific order):
+ </P
+><P
+>  Don Baccus, Michael Cleverly, Gregory McMullan, Ben Adida, Jade Rubick.
+ </P
+></DIV
+><DIV
+CLASS="NAVFOOTER"
+><HR
+ALIGN="LEFT"
+WIDTH="100%"><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+><A
+HREF="x128.html"
+>Prev</A
+></TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+><A
+HREF="index.html"
+>Home</A
+></TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>&nbsp;</TD
+></TR
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>Intranet Getting Started Guide</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>&nbsp;</TD
+></TR
+></TABLE
+></DIV
+></BODY
+></HTML
+>
\ No newline at end of file
Index: web/openacs/www/doc/openacs/getting-started/x18.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/getting-started/x18.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/getting-started/x18.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,212 @@
+<HTML
+><HEAD
+><TITLE
+>  OpenACS Basics
+ </TITLE
+><META
+NAME="GENERATOR"
+CONTENT="Modular DocBook HTML Stylesheet Version 1.61
+"><LINK
+REL="HOME"
+TITLE="  OpenACS Getting Started Guide
+ "
+HREF="index.html"><LINK
+REL="PREVIOUS"
+TITLE="  Thinking about your web service
+ "
+HREF="x10.html"><LINK
+REL="NEXT"
+TITLE="  Look and feel
+ "
+HREF="x43.html"></HEAD
+><BODY
+CLASS="SECT1"
+BGCOLOR="#FFFFFF"
+TEXT="#000000"
+LINK="#0000FF"
+VLINK="#840084"
+ALINK="#0000FF"
+><DIV
+CLASS="NAVHEADER"
+><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TH
+COLSPAN="3"
+ALIGN="center"
+>OpenACS Getting Started Guide</TH
+></TR
+><TR
+><TD
+WIDTH="10%"
+ALIGN="left"
+VALIGN="bottom"
+><A
+HREF="x10.html"
+>Prev</A
+></TD
+><TD
+WIDTH="80%"
+ALIGN="center"
+VALIGN="bottom"
+></TD
+><TD
+WIDTH="10%"
+ALIGN="right"
+VALIGN="bottom"
+><A
+HREF="x43.html"
+>Next</A
+></TD
+></TR
+></TABLE
+><HR
+ALIGN="LEFT"
+WIDTH="100%"></DIV
+><DIV
+CLASS="SECT1"
+><H1
+CLASS="SECT1"
+><A
+NAME="AEN18"
+>2. OpenACS Basics</A
+></H1
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN20"
+>2.1. Admin pages are your friends</A
+></H2
+><P
+>   For most of the OpenACS modules, you can configure them through the admin pages, accessible through <I
+CLASS="EMPHASIS"
+>/admin</I
+> from any browser. You must be registered as a site-wide administrator to access those pages (refer to the installation guide to know how to do that).
+  </P
+><P
+>   By visiting the /admin pages, you'll have most of the modules in front of you, and you'll have the opportunity to set them up. This is a great way to explore the possibilities that OpenACS opens to you. 
+  </P
+><P
+>   If you see a module that you don't understand how to setup, just visit the /doc directory to learn how that module works and what it's intended to do.
+  </P
+><P
+>   For the ecommerce module, type in <I
+CLASS="EMPHASIS"
+>/admin/ecommerce </I
+>to be taken to its admin pages.
+  </P
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN28"
+>2.2. Content Sections</A
+></H2
+><P
+>   URL: /admin/content-sections
+  </P
+><P
+>   The content sections module allows you to add a &#8220;section&#8221; of the website, static or dynamic, to the users' &#8220;Workspace&#8221; and tell if that's publicly available or only to registered users, plus provide an introduction and help to the users.
+  </P
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN32"
+>2.3. User Groups</A
+></H2
+><P
+>   URL: /admin/ug
+  </P
+><P
+>   User groups are a great feature of OpenACS and gives you lots of flexibility. Unfortunately, as of this release, not all modules are user groups-ready, but that should change with OpenACS 4 (coming this summer).
+  </P
+><P
+>   There are <I
+CLASS="EMPHASIS"
+>User Group Types</I
+> and <I
+CLASS="EMPHASIS"
+>User Groups</I
+>. One user group type can have several user groups, which in turn can have several <I
+CLASS="EMPHASIS"
+>subgroups</I
+>. Each user group can have modules associated with it, that members of that group will be able to use and that will be specific to that group.
+  </P
+><P
+>   For example, in the USU Free Software and GNU/Linux Club we had several projects that were being carried by club members and we wanted to provide a way for them to collaborate. Something besides mailing lists. So we created a group type called projects and several groups inside it, one for each project. Each group had an administrator assigned to it, who had control over that group an<I
+CLASS="EMPHASIS"
+>d that could create subgroups if he/she thought necessary. OpenACS provides group pages, all ready, in </I
+>/groups. 
+  </P
+><P
+>   There's much power in user groups and I highly recommed you to read the documentation about it on /doc/ug.
+  </P
+></DIV
+></DIV
+><DIV
+CLASS="NAVFOOTER"
+><HR
+ALIGN="LEFT"
+WIDTH="100%"><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+><A
+HREF="x10.html"
+>Prev</A
+></TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+><A
+HREF="index.html"
+>Home</A
+></TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+><A
+HREF="x43.html"
+>Next</A
+></TD
+></TR
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>Thinking about your web service</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>Look and feel</TD
+></TR
+></TABLE
+></DIV
+></BODY
+></HTML
+>
\ No newline at end of file
Index: web/openacs/www/doc/openacs/getting-started/x43.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/getting-started/x43.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/getting-started/x43.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,364 @@
+<HTML
+><HEAD
+><TITLE
+>  Look and feel
+ </TITLE
+><META
+NAME="GENERATOR"
+CONTENT="Modular DocBook HTML Stylesheet Version 1.61
+"><LINK
+REL="HOME"
+TITLE="  OpenACS Getting Started Guide
+ "
+HREF="index.html"><LINK
+REL="PREVIOUS"
+TITLE="  OpenACS Basics
+ "
+HREF="x18.html"><LINK
+REL="NEXT"
+TITLE="  Backups tips from Don Baccus
+ "
+HREF="x99.html"></HEAD
+><BODY
+CLASS="SECT1"
+BGCOLOR="#FFFFFF"
+TEXT="#000000"
+LINK="#0000FF"
+VLINK="#840084"
+ALINK="#0000FF"
+><DIV
+CLASS="NAVHEADER"
+><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TH
+COLSPAN="3"
+ALIGN="center"
+>OpenACS Getting Started Guide</TH
+></TR
+><TR
+><TD
+WIDTH="10%"
+ALIGN="left"
+VALIGN="bottom"
+><A
+HREF="x18.html"
+>Prev</A
+></TD
+><TD
+WIDTH="80%"
+ALIGN="center"
+VALIGN="bottom"
+></TD
+><TD
+WIDTH="10%"
+ALIGN="right"
+VALIGN="bottom"
+><A
+HREF="x99.html"
+>Next</A
+></TD
+></TR
+></TABLE
+><HR
+ALIGN="LEFT"
+WIDTH="100%"></DIV
+><DIV
+CLASS="SECT1"
+><H1
+CLASS="SECT1"
+><A
+NAME="AEN43"
+>3. Look and feel</A
+></H1
+><P
+>  There's quite a bit of information about this on <I
+CLASS="EMPHASIS"
+>Establishing Style and Supporting Multi-Lingualism</I
+> at /doc/style.html.
+ </P
+><P
+>  Basically you have four ways of modifying the look and feel of your OpenACS website:
+ </P
+><P
+></P
+><OL
+TYPE="1"
+><LI
+><P
+>  Editing ad_header and ad_footer
+  </P
+></LI
+><LI
+><P
+>  Customized ADP tags
+  </P
+></LI
+><LI
+><P
+>  Templates
+  </P
+></LI
+><LI
+><P
+>  ArsDigita Templating System
+  <A
+NAME="AEN57"
+HREF="#FTN.AEN57"
+>[1]</A
+>
+  
+  </P
+></LI
+></OL
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN59"
+>3.1. Editing ad_header and ad_footer</A
+></H2
+><P
+>   Almost all of the tcl pages shipped with OpenACS make calls o ad_header and ad_footer, two procedures defined in <I
+CLASS="EMPHASIS"
+>tcl/ad-defs.tcl.preload</I
+>
+  </P
+><P
+>   ad_header returns the initial HTML tags and title to the page, and optionally returns extra stuff for the &#60;head&#62;. This is its usage:
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>ad_header page_title { extra_stuff_for_document_head "" } 
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   ad_footer stuff an &#60;hr&#62; and a e-mail signature (defaults to system owner) and then it closes the body and html tags. Its usage is:
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>ad_footer { signatory "" } { suppress_curriculum_bar_p "0" }
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   For example, you'd call them from an adp page like this:
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>&#60;%= [ad_header &#8220;My First OpenACS Page&#8221;] %&#62;
+&#60;%= [ad_footer &#8220;me@mydomain.com&#8221;] %&#62;
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   The &#8220;&#60;%=&#8221; means &#8220;evaluate this and then return as a ns_puts&#8221;. The above would return a page with the title &#8220;My First OpenACS page&#8221; and an e-mail signature in the bottom saying &#8220;me@mydomain.com&#8221;.
+  </P
+><P
+>   Ths disadvantages of this approach is that it's very limited and requires restarting AOLserver for changes in the ad-defs file to take effect.
+  </P
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN71"
+>3.2. Customized ADP tags</A
+></H2
+><P
+>   OpenACS has some utility procedures to help you. One of them is <I
+CLASS="EMPHASIS"
+>ad_register_styletag</I
+> (defined in tcl/ad-style.tcl). 
+  </P
+><P
+>   With ad_register_styletag you can register a tag can will be available for use under ADP and TCL pages. It will also register documentation for that tag through the proc_doc OpenACS procedure. 
+  </P
+><P
+>   Usually what I do is rename the file <I
+CLASS="EMPHASIS"
+>tcl/photonet-styles.tcl</I
+> to <I
+CLASS="EMPHASIS"
+>tcl/myservice-styles.tcl</I
+> and then edit it. In that file I define some tags like &#8220;pagetop&#8221;, &#8220;pagebottom&#8221;, &#8220;pageside&#8221;. Then I call these tags from ADP pages just like regular HTML tags (e.g. &#60;pagetop&#62;&#60;/pagetop&#62;). From .tcl pages, you'd call these tags through &#8220;ad_style_pagetop&#8221; (or [ad_style_pagetop] if you are calling it from inside a ns_write).
+  </P
+><P
+>   ad_register_styletag used the AOLserver API call to ns_register_adptag, which will give you more flexibility on defining your tags (e.g. you can define tags that take arguments). Read the documentation for ns_register_adptag for more info.
+  </P
+><P
+>   Although this approach is more flexible, it also requires you to restart AOLserver to make changes.
+  </P
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN81"
+>3.3. Templates</A
+></H2
+><P
+>   Templates are very flexible and do not require an AOLserver restart. You can find full documentation on this at /doc/style.html.
+  </P
+><P
+>   Basically, if you have a .tcl page that has the Tcl and SQL code in /test/mypage.tcl, you have this page call <I
+CLASS="EMPHASIS"
+>ad_return_template</I
+> at its bottom. ad_return_template will search for an .adp template at <I
+CLASS="EMPHASIS"
+>/templates/test/mypage.*.adp</I
+> and return it. 
+  </P
+><P
+>   You can also use <I
+CLASS="EMPHASIS"
+>ad_return_template template_file</I
+>, where <I
+CLASS="EMPHASIS"
+>template_file</I
+> is a .adp file in your template subdirectory that should be returned to the user.
+  </P
+><P
+>   You can have several templates with different interfaces or even languages, such as mypage.plain.adp (for users than want text-only) or mypage.fancy.adp (for users that want graphical site) or mypage.plain.pt.adp (for users that speak Portuguese). ad_return_template will server the page according to the user's preferences.
+  </P
+><P
+>   This means that programmers will edit the .tcl pages and define some variables that HTML designers will then use in the the .adp templates they will handle. If I am not mistaken, there are mods for Dreamweaver to handle adp pages.
+  </P
+><P
+>   Unfortunately, because the templating module is fairly new, only a few modules are template-enabled, ecommerce being one of them.
+  </P
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN93"
+>3.4. ArsDigita Templating System (ATS)</A
+></H2
+><P
+>   ArsDigita has written a very powerful publishing system that was included in ACS/Oracle 3.2.3. Older incarnations of this system could be used with OpenACS with very few modifications. Newer versions -designed for ACS 4.x- however, are not so easy. We are looking into a port of the templating system done by Vlad Seryakov, and the templating system will probably be included in the next release of OpenACS. Stay tuned!
+  </P
+><P
+>   The ATS uses XML and defines some special tags that completely separates programming from presentation. People that have been using it told me that it's really nice.
+  </P
+><P
+>   You can find more information about the ATS at <A
+HREF="http://developer.arsdigita.com/doc/acs-templating"
+TARGET="_top"
+>http://developer.arsdigita.com/doc/acs-templating</A
+>.
+  </P
+></DIV
+></DIV
+><H3
+CLASS="FOOTNOTES"
+>Notes</H3
+><TABLE
+BORDER="0"
+CLASS="FOOTNOTES"
+WIDTH="100%"
+><TR
+><TD
+ALIGN="LEFT"
+VALIGN="TOP"
+WIDTH="5%"
+><A
+NAME="FTN.AEN57"
+HREF="x43.html#AEN57"
+>[1]</A
+></TD
+><TD
+ALIGN="LEFT"
+VALIGN="TOP"
+WIDTH="95%"
+><P
+>&#13;   </P
+></TD
+></TR
+></TABLE
+><DIV
+CLASS="NAVFOOTER"
+><HR
+ALIGN="LEFT"
+WIDTH="100%"><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+><A
+HREF="x18.html"
+>Prev</A
+></TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+><A
+HREF="index.html"
+>Home</A
+></TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+><A
+HREF="x99.html"
+>Next</A
+></TD
+></TR
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>OpenACS Basics</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>Backups tips from Don Baccus</TD
+></TR
+></TABLE
+></DIV
+></BODY
+></HTML
+>
\ No newline at end of file
Index: web/openacs/www/doc/openacs/getting-started/x99.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/getting-started/x99.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/getting-started/x99.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,288 @@
+<HTML
+><HEAD
+><TITLE
+>  Backups tips from Don Baccus
+ </TITLE
+><META
+NAME="GENERATOR"
+CONTENT="Modular DocBook HTML Stylesheet Version 1.61
+"><LINK
+REL="HOME"
+TITLE="  OpenACS Getting Started Guide
+ "
+HREF="index.html"><LINK
+REL="PREVIOUS"
+TITLE="  Look and feel
+ "
+HREF="x43.html"><LINK
+REL="NEXT"
+TITLE="  Intranet Getting Started Guide
+ "
+HREF="x128.html"></HEAD
+><BODY
+CLASS="SECT1"
+BGCOLOR="#FFFFFF"
+TEXT="#000000"
+LINK="#0000FF"
+VLINK="#840084"
+ALINK="#0000FF"
+><DIV
+CLASS="NAVHEADER"
+><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TH
+COLSPAN="3"
+ALIGN="center"
+>OpenACS Getting Started Guide</TH
+></TR
+><TR
+><TD
+WIDTH="10%"
+ALIGN="left"
+VALIGN="bottom"
+><A
+HREF="x43.html"
+>Prev</A
+></TD
+><TD
+WIDTH="80%"
+ALIGN="center"
+VALIGN="bottom"
+></TD
+><TD
+WIDTH="10%"
+ALIGN="right"
+VALIGN="bottom"
+><A
+HREF="x128.html"
+>Next</A
+></TD
+></TR
+></TABLE
+><HR
+ALIGN="LEFT"
+WIDTH="100%"></DIV
+><DIV
+CLASS="SECT1"
+><H1
+CLASS="SECT1"
+><A
+NAME="AEN99"
+>4. Backups tips from Don Baccus</A
+></H1
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN101"
+>4.1. The Strategy</A
+></H2
+><P
+>   The need for making backups should be self-explanatory. There are several strategies you can use. My own strategy for minimizing the odds that I'll lose all my data is quite simple:
+  </P
+><P
+></P
+><UL
+><LI
+><P
+>   The database is stored on a mirrored (RAID 1) disk.
+   </P
+></LI
+><LI
+><P
+>   The machine has battery backup.
+   </P
+></LI
+><LI
+><P
+>   Backups are made nightly onto a third disk on another controller
+   </P
+></LI
+><LI
+><P
+>   ftp is used to copy the resulting backup to two separate remote servers in two locations
+   </P
+></LI
+></UL
+><P
+>   Rather than making remote copies, you might choose to dump to tape or writeable CD media. Whatever strategy you use, it is important to routinely check dumps to make sure they can be reloaded. The strategy outlined above means that in the case of catastrophic failure, I'll lose at most one day's data.
+  </P
+><P
+>   By mirroring disks and using a battery backup, preferably one that can trigger an automatic and controlled shutdown of the system when the battery runs low, you greatly lower the odds of ever having to use your nightly backup. Despite this, it is important to take backups seriously if the data stored at your site is valuable to you or your users.
+  </P
+><P
+>   It is also important that you use the Postgres dump utility, <I
+CLASS="EMPHASIS"
+>pg_dump</I
+>, rather than simply copy the files in the database directory unless you stop the Postmaster while making your copy. If you copy the files while the Postmaster is running and updates to the database are being made, you'll end up with inconsistent tables and a potentially unusable database. <I
+CLASS="EMPHASIS"
+>pg_dump</I
+> makes a consistent dump even when the database is in use.
+  </P
+><P
+>   I find it convenient to use AOLserver's schedule proc routine to run a Tcl script which generates my nightly backups, rather than use cron. The major benefit is that you can very easily make a web page that calls this script, and link to it from an admin page. If there are problems making your backups (connectivity problems seem to crop up a few times a year, in my experience), you can just click on the link to force a backup with no need to remember where you placed the script, what you called it, any arguments that might be needed, etc.
+  </P
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN119"
+>4.2. The &#8220;<I
+CLASS="EMPHASIS"
+>vacuum analyze</I
+>&#8221; command</A
+></H2
+><P
+>   Currently, Postgres doesn't automatically reclaim space in a database table when an existing row is deleted or updated. 
+  </P
+><P
+>   The "vacuum" command must be run periodically to reclaim space. The "vacuum analyze" form additionally collects statistics on the disbursion of columns in the database, which the optimizer uses when it calculates just how to execute queries. The availability of this data can make a tremendous difference in the execution speed of queries. I run this command as part of my nightly backup procedure - if "vacuum" is going to screw up my database, I'd prefer it to happen immediately after (not before!) I've made a backup! The "vacuum" command is very reliable, and has never caused me a problem, but conservatism is the key to good system management.
+  </P
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN124"
+>4.3. Sample Tcl script</A
+></H2
+><P
+>   Here's a sample script based on the one used to back up the database backing my most important personal site, "birdnotes.net". If you're wondering why this procedure doesn't backup the scripts for the site as well, it is because they're developed on a local machine, which is backed up separately.
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+># Back up the database, scheduled to be run nightly. As written, it 	# keeps a month's worth of daily backups, cycling over the same files 	# which are suffixed with the day of the month on which the backup is 	# created.	# This version: ftp only.	# NOTE: The indenting gets screwed up during conversion to HTML	
+proc backup {} {	
+  # Set these to the appropriate values for your installation.
+  set b "/usr/local/pgsql/bin" 
+  set bak "/home/birdnotes_backup/" 	  
+  set db [ns_db gethandle] 
+  set sql "select date_part('day','today'::date) as day" 
+  set selection [ns_db 1row $db $sql] 
+  set_variables_after_query 
+  set data "birdnotes_$day.dmp"	
+  ns_log Notice "Backup of [ad_system_name] starting."
+  ns_log Notice "pg_dump beginning..." 	
+  if [catch {append msg [exec "$b/pg_dump" "birdnotes" "&#62;$bak/$data"]} errmsg] { 
+    ns_log Error "pg_dump failed: $errmsg" 
+   ns_sendmail [ad_system_owner] [ad_system_owner] "[ad_system_name] : pg_dump failed..." "$errmsg" 
+     ns_db releasehandle $db 
+     return 
+}	
+  append msg "\n"
+  ns_log Notice "gzip of data beginning..." 	
+  if [catch {append msg [exec "gzip" "-f" "$bak/$data"]} errmsg] { 
+     ns_log Error "gzip of data failed: $errmsg" 
+  ns_sendmail [ad_system_owner] [ad_system_owner] "[ad_system_name] : gzip of data failed..." "$errmsg" 
+     ns_db releasehandle $db 
+     return 
+  }	
+  append msg "\n"	
+  ns_log Notice "ftp data beginning..." 
+  set fd [open "$bak/ftp_data.tmp" w]	
+  # Replace "your_username", "your_password", and "your_remotedir" with the values 
+  # appropriate for the remote system on which you're keeping backup copies.	
+ puts $fd "user your_username your_password\nbinary\nput $bak/$data.gz your_remotedir/$data.gz\nquit\n" 
+    close $fd	
+# "your_remoteserver" should be set to the IP of the remote system which stores your # backups.	
+  if [catch {append msg [exec "ftp" "-n" "your_remoteserver" "&#60;$bak/ftp_data.tmp"]} errmsg] { \
+     ns_log Error "ftp data failed: $errmsg" 
+    ns_sendmail [ad_system_owner] [ad_system_owner] "[ad_system_name] : ftp data failed..." "$errmsg" 
+    ns_db releasehandle $db 
+    return 
+  }
+  append msg "\n"	
+  # Replicate the above code to make remote copies to other systems	
+  ns_log Notice "vacuum beginning..." 	
+  if [catch {append msg [exec "$b/psql" "-q" "-c" "vacuum analyze"]} errmsg] { 
+     ns_log Error "vacuum failed: $errmsg" 
+    ns_sendmail [ad_system_owner] [ad_system_owner] "[ad_system_name] : vacuum failed..." "$errmsg" 
+    ns_db releasehandle $db return 
+  }	
+  ns_db releasehandle $db 
+  ns_log Notice "Backup succeeded." 
+  append msg "Backups succeeded"
+  ns_sendmail [ad_system_owner] [ad_system_owner] "[ad_system_name] : backup succeeded" "$msg 
+}	 
+ns_share -init {set schedule_backup 0} schedule_backup
+if {!$schedule_backup} { 
+  ns_schedule_daily 0 backup 
+  ns_log Notice "Backup has been scheduled." 
+}
+  </PRE
+></TD
+></TR
+></TABLE
+></DIV
+></DIV
+><DIV
+CLASS="NAVFOOTER"
+><HR
+ALIGN="LEFT"
+WIDTH="100%"><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+><A
+HREF="x43.html"
+>Prev</A
+></TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+><A
+HREF="index.html"
+>Home</A
+></TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+><A
+HREF="x128.html"
+>Next</A
+></TD
+></TR
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>Look and feel</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>Intranet Getting Started Guide</TD
+></TR
+></TABLE
+></DIV
+></BODY
+></HTML
+>
\ No newline at end of file
Index: web/openacs/www/doc/openacs/html/oracle-to-pg-porting.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/html/oracle-to-pg-porting.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/html/oracle-to-pg-porting.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,255 @@
+<HEAD><TITLE>Oracle to Postgres Conversion</TITLE></HEAD>
+<BODY bgcolor=white>
+<h2>Oracle to Postgres Conversion</h2>
+by <a href=mailto:james@motifstudios.com>James Shannon</a>, <a href=mailto:ben@adida.net>Ben Adida</a>, and
+<a href=mailto:dhogaza@pacifier.com>Don Baccus</a>
+<hr><p>
+
+<h3>What you should know before you begin</h3>
+
+You should know SQL relatively well. Knowing the details of Oracle SQL
+and Postgres SQL are obviously tremendous advantages, but the hints in
+this document should quickly bring you up to speed on what the
+differences are.
+<p>
+If you're porting Oracle SQL to Postgres SQL for the <a
+href=http://acspg.benadida.com>ACS/pg</a>, you should also be quite
+familiar with AOLserver Tcl, especially the AOLserver database APIs.
+<p>
+In this document, we're talking about:
+<ul>
+<li> Oracle 8 and 8i
+<li> Postgres 7.0, and sometimes this also works for Postgres 6.5.3
+</ul>
+<p>
+
+<h3>Grammar Differences</h3>
+There are a handful of grammar differences in Postgres for
+functionality that is actually the same. ACS/pg attempts to perform
+these changes automatically, leaving only the major functionality
+differences to be ported by hand. This is done by <tt>db_sql_prep</tt>
+which performs a number of regular expression substitutions on a piece
+of SQL.
+<p>
+<h4>Sysdate</h4>
+Oracle uses the keyword <tt>sysdate</tt> to denote the current date
+and time. Postgres uses <tt>'now'::datetime</tt>, which ACS/pg has
+conveniently wrapped in a function named <tt>sysdate()</tt>.
+<p>
+ACS/pg also includes a Tcl procedure named <tt>db_sysdate</tt> which
+should be used every time the <tt>sysdate</tt> term appears. Thus:
+<pre>
+set now [database_to_tcl_string $db "select sysdate from dual"]
+</pre>
+should become
+<pre>
+set now [database_to_tcl_string $db "select [db_sysdate] from dual"]
+</pre>
+<p>
+
+<h4>The Dual Table</h4>
+
+Oracle uses the "fake" dual table for many selects. This table was
+created in postgres as a view to ease porting problems. This allows
+code to remain somewhat compatible with Oracle SQL without annoying
+the Postgres parser.
+
+<h4>Sequences</h4>
+
+Oracle's sequence grammar is <tt>sequence_name.nextval</tt>.<br>
+Postgres's sequence grammar is <tt>nextval('sequence_name')</tt>.
+<p>
+In Tcl, getting the next sequence value can be abstracted by calling
+<tt>[db_sequence_nextval $db sequence_name]</tt>. In case you need to
+include a sequence's value in a more complex SQL statement, you can
+use <tt>[db_sequence_nextval_sql sequence_name]</tt> which will return
+the appropriate grammar.
+
+<h4>Decode</h4>
+Oracle's handy <tt>decode</tt> function works as follows:
+
+<pre>
+decode(expr, search, expr[, search, expr...] [, default])
+</pre>
+
+To evaluate this expression, Oracle compares expr to each search value
+one by one. If expr is equal to a search, Oracle returns the
+corresponding result. If no match is found, Oracle returns default,
+or, if default is omitted, returns null.
+<p>
+Postgres doesn't have the same construct. It can be replicated with:
+
+<pre>
+CASE WHEN expr THEN expr [...] ELSE expr END
+</pre>
+
+which returns the expression corresponding to the first true predicate. For example:
+<pre>
+CASE WHEN c1 = 1 THEN 'match' ELSE 'no match' END
+</pre>
+
+<h4>NVL</h4>
+
+Oracle has another handy function: <tt>NVL</tt>. <tt>NVL</tt> returns
+its first argument if it is not null, otherwise it returns its second
+argument.
+<pre>
+start_date := NVL(hire_date, SYSDATE);
+</pre>
+The above statement will return <tt>SYSDATE</tt> if <tt>hire_date</tt>
+is null.
+
+Postgres has a function that performs the same thing in a more
+generalized way: <tt>coalesce(expr1, expr2, expr3,....)</tt> returns
+the first non-null expression that is passed to it.
+
+<p>
+
+<h3>Functional Differences</h3> 
+
+Postgres doesn't have all the functionality of Oracle. ACS/pg is
+forced to deal with these limitations with specific
+work-arounds. Almost everything can be done under Postgres, but some
+features are awaiting new versions of the open-source database.
+
+<h4>Outer Joins</h4>
+Outer Joins work as follows:
+<pre>
+select a.field1, b.field2
+from a, b
+where a.item_id = b.item_id(+)
+</pre>
+where the <tt>(+)</tt> indicates that, if there is no row in table
+<tt>b</tt> that matches the correct <tt>item_id</tt>, the match should
+still happen, with an empty row from table <tt>b</tt>. In this case,
+for example, for all rows in table <tt>a</tt> where there is no
+matching row in <tt>b</tt>, a row will still be returned where
+<tt>a.field1</tt> is correct, but <tt>b.field2</tt> is null.
+<p>
+Depending on the exact operation performed by the outer join, there
+are different approaches. For outer joins where specific, raw data is
+extracted from the outer-joined table (e.g. as above), it's best to
+use a <tt>UNION</tt> operation as follows:
+<pre>
+select a.field1, b.field2
+from a, b
+where a.item_id = b.item_id
+UNION
+select a.field1, NULL as field2
+from a
+where 0= (select count(*) from b where b.item_id=a.item_id)
+</pre>
+<p>
+
+For queries with quadruple outer-joins, the queries can be quite long!
+They work quite well, though.
+<p>
+In certain other cases where only aggregate values are pulled out of
+the outer-joined table, it's possible to not use a join at all. If the
+original query is:
+
+<pre>
+select a.field1, sum(b.field2)
+from a, b
+where a.item_id = b.item_id (+)
+group by a.field1
+</pre>
+
+then the Postgres query can look like:
+
+<pre>
+select a.field1, b_sum_field2_by_item_id(a.item_id)
+from a
+</pre>
+
+where you've defined the function:
+
+<pre>
+create function b_sum_field2_by_item_id(integer)
+returns integer
+as '
+DECLARE
+     v_item_id alias for $1;
+BEGIN
+     return sum(field2) from b where item_id= v_item_id;
+END;
+' language 'plpgsql';
+</pre>
+
+<p>
+
+<h4>Connect By</h4>
+Postgres doesn't have connect by statements. Uggh. No easy way to do
+this.
+
+<h4>CLOBs</h4>
+Postgres doesn't have decent CLOB support. However, with the lztext
+extension coming with Postgres 7.0, there is no need for CLOBs in the
+ACS/pg. We'll be able to do everything using varchars. For now, we're
+using only varchar(4000).
+
+<h4>BLOBs</h4>
+Binary large object support in Postgres is very poor and unsuitable 
+for use in a 24/7 environment, because you can't dump them with pg_dump.
+Backing up a database that makes use of Postgres large objects requires
+one to knock down the RDBMS and dump the files in the database directory.
+<p>
+Don Baccus put together a hack that extends AOLserver's postgres driver
+with BLOB-like support, by uuencoding/decoding binary files before stuffing
+them into or extracting them from the database.  The resulting objects
+can be consistently dumped by "pg_dump" while the RDBMS is up and running.
+There is no need to interrupt service while making your backup.
+<p> To get around the one-block
+limit on the size of a tuple imposed by Postgres, the driver segments
+the encoded data into 8K chunks.
+<p>
+Postgres large objects are scheduled for a major overhaul in
+ summer 2000.  Because of this, only the BLOB functionality used by
+the ACS was implemented.
+<p>
+To use the BLOB driver extension, you must first create a column
+of type "integer" with the name "lob" in the table that will
+store the BLOB, and a trigger on it that calls "on_lob_ref".  You
+<b>must</b> use the name "lob".  Here's an example:
+<pre>
+create table my_table (
+    my_key			integer primary key,
+	lob				integer references lobs,
+    my_other_data	some_type -- etc
+);
+
+create trigger my_table_lob_trig before insert or delete or update
+on my_table for each row execute procedure on_lob_ref();
+</pre>
+To put a binary file into "my_table":
+<pre>
+set lob [database_to_tcl_string $db "select empty_lob()"]
+
+ns_db dml $db "begin"
+ns_db dml $db "update my_table set lob = $lob where my_key = $my_key"
+ns_pg blob_dml_file $db $lob $tmp_filename
+ns_db dml $db "end"
+</pre>
+Note that the call to ns_pg to stuff the file into the database
+MUST be wrapped in a transaction, even if you're not updating any
+other tables at the same time.  The driver will return an error
+if you don't.  
+<p>
+To return a large object stored in "my_table" to the user:
+<pre>
+set lob [database_to_tcl_string $db "select lob from my_table
+                                     where my_key = $my_key"]
+ns_pg blob_write $db $lob
+</pre>
+Note that you don't need to wrap the call to blob_write in a 
+transaction, as the database isn't being modified.
+<p>
+The large objects are automatically deleted when no longer
+used.  To replace the large object stored in an existing
+record, just allocate a new one by
+calling "empty_lob()" and assign the returned key to the
+"lob" column in your table.
+<p>
+<hr>
+<address>james@motifstudios.com / ben@adida.net</address>
+</body>
Index: web/openacs/www/doc/openacs/install/index.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/install/index.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/install/index.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,294 @@
+<HTML
+><HEAD
+><TITLE
+>  OpenACS Installation Guide
+ </TITLE
+><META
+NAME="GENERATOR"
+CONTENT="Modular DocBook HTML Stylesheet Version 1.61
+"><LINK
+REL="NEXT"
+TITLE="  What is OpenACS
+ "
+HREF="x11.html"></HEAD
+><BODY
+CLASS="ARTICLE"
+BGCOLOR="#FFFFFF"
+TEXT="#000000"
+LINK="#0000FF"
+VLINK="#840084"
+ALINK="#0000FF"
+><DIV
+CLASS="ARTICLE"
+><DIV
+CLASS="TITLEPAGE"
+><H1
+CLASS="TITLE"
+><A
+NAME="AEN2"
+>OpenACS Installation Guide</A
+></H1
+><H3
+CLASS="AUTHOR"
+><A
+NAME="AEN4"
+>Roberto Mello (rmello@fslc.usu.edu)  and the OpenACS Team</A
+></H3
+><DIV
+><DIV
+CLASS="ABSTRACT"
+><A
+NAME="AEN8"
+></A
+><P
+></P
+><P
+>  This is the Installation Guide for the ArsDigita Community System port for the PostgreSQL Relational Database Management System. This documentation is based on Philip Greenspun's ACS installation docs with parts of it (marked with [1]s) being quoted here. 
+ </P
+><P
+>  This is the February 2001 revision of the documentation.
+ </P
+><P
+></P
+></DIV
+></DIV
+><HR></DIV
+><DIV
+CLASS="TOC"
+><DL
+><DT
+><B
+>Table of Contents</B
+></DT
+><DT
+>1. <A
+HREF="x11.html"
+>What is OpenACS</A
+></DT
+><DT
+>2. <A
+HREF="x24.html"
+>What you need to run OpenACS</A
+></DT
+><DT
+>3. <A
+HREF="x47.html"
+>Getting ready to Untar [1]</A
+></DT
+><DT
+>4. <A
+HREF="x60.html"
+>AOLserver/OpenNSD</A
+></DT
+><DD
+><DL
+><DT
+>4.1. <A
+HREF="x60.html#AEN62"
+>Installing AOLserver</A
+></DT
+><DT
+>4.2. <A
+HREF="x60.html#AEN69"
+>Configuring AOLserver</A
+></DT
+><DT
+>4.3. <A
+HREF="x60.html#AEN79"
+>Sample nsd.tcl file</A
+></DT
+></DL
+></DD
+><DT
+>5. <A
+HREF="x83.html"
+>PostgreSQL</A
+></DT
+><DD
+><DL
+><DT
+>5.1. <A
+HREF="x83.html#AEN85"
+>Installing PostgreSQL</A
+></DT
+><DT
+>5.2. <A
+HREF="x83.html#AEN91"
+>PG 6.5.3 or 7 ?</A
+></DT
+><DT
+>5.3. <A
+HREF="x83.html#AEN96"
+>Compiling the PostgreSQL driver for AOLserver</A
+></DT
+><DT
+>5.4. <A
+HREF="x83.html#AEN110"
+>Some PostgreSQL tips from Don Baccus</A
+></DT
+><DT
+>5.5. <A
+HREF="x83.html#AEN132"
+>Loading the data model</A
+></DT
+><DT
+>5.6. <A
+HREF="x83.html#AEN153"
+>Notes on PostgreSQL 7.1</A
+></DT
+></DL
+></DD
+><DT
+>6. <A
+HREF="x161.html"
+>Configuring OpenACS itself</A
+></DT
+><DD
+><DL
+><DT
+>6.1. <A
+HREF="x161.html#AEN163"
+>What is where (OpenACS directories and what is inside each of them)</A
+></DT
+><DT
+>6.2. <A
+HREF="x161.html#AEN182"
+>Configuring OpenACS</A
+></DT
+><DT
+>6.3. <A
+HREF="x161.html#AEN199"
+>Configuring Permissions [1]</A
+></DT
+><DT
+>6.4. <A
+HREF="x161.html#AEN209"
+>Adding Yourself as a User and Making Yourself a Sysadmin [1]</A
+></DT
+><DT
+>6.5. <A
+HREF="x161.html#AEN221"
+>CAVEAT for those that want encrypted passwords in the DB <A
+NAME="CAVEAT"
+></A
+></A
+></DT
+><DT
+>6.6. <A
+HREF="x161.html#AEN235"
+>Closing Down Access [1]</A
+></DT
+><DT
+>6.7. <A
+HREF="x161.html#AEN238"
+>Making sure that it works (and stays working)</A
+></DT
+><DT
+>6.8. <A
+HREF="x161.html#AEN246"
+>Ensure that your service automatically starts on boot (or any other time the service dies).</A
+></DT
+></DL
+></DD
+><DT
+>7. <A
+HREF="x283.html"
+>Everything works, now what ?</A
+></DT
+><DD
+><DL
+><DT
+>7.1. <A
+HREF="x283.html#AEN295"
+>Backing up your PostgreSQL databases</A
+></DT
+><DT
+>7.2. <A
+HREF="x283.html#AEN300"
+>If you are using the e-commerce module</A
+></DT
+></DL
+></DD
+><DT
+>8. <A
+HREF="x309.html"
+>Where do go I for help and how can I help ?</A
+></DT
+><DD
+><DL
+><DT
+>8.1. <A
+HREF="x309.html#AEN322"
+>Why Not MySQL ?</A
+></DT
+><DT
+>8.2. <A
+HREF="x309.html#AEN328"
+>Some Useful Links</A
+></DT
+></DL
+></DD
+><DT
+>9. <A
+HREF="x344.html"
+>Contributed Items</A
+></DT
+><DT
+>10. <A
+HREF="x354.html"
+>Acknowledgements</A
+></DT
+></DL
+></DIV
+></DIV
+><DIV
+CLASS="NAVFOOTER"
+><HR
+ALIGN="LEFT"
+WIDTH="100%"><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+><A
+HREF="x11.html"
+>Next</A
+></TD
+></TR
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>What is OpenACS</TD
+></TR
+></TABLE
+></DIV
+></BODY
+></HTML
+>
\ No newline at end of file
Index: web/openacs/www/doc/openacs/install/x11.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/install/x11.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/install/x11.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,172 @@
+<HTML
+><HEAD
+><TITLE
+>  What is OpenACS
+ </TITLE
+><META
+NAME="GENERATOR"
+CONTENT="Modular DocBook HTML Stylesheet Version 1.61
+"><LINK
+REL="HOME"
+TITLE="  OpenACS Installation Guide
+ "
+HREF="index.html"><LINK
+REL="PREVIOUS"
+TITLE="  OpenACS Installation Guide
+ "
+HREF="index.html"><LINK
+REL="NEXT"
+TITLE="  What you need to run OpenACS
+ "
+HREF="x24.html"></HEAD
+><BODY
+CLASS="SECT1"
+BGCOLOR="#FFFFFF"
+TEXT="#000000"
+LINK="#0000FF"
+VLINK="#840084"
+ALINK="#0000FF"
+><DIV
+CLASS="NAVHEADER"
+><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TH
+COLSPAN="3"
+ALIGN="center"
+>OpenACS Installation Guide</TH
+></TR
+><TR
+><TD
+WIDTH="10%"
+ALIGN="left"
+VALIGN="bottom"
+><A
+HREF="index.html"
+>Prev</A
+></TD
+><TD
+WIDTH="80%"
+ALIGN="center"
+VALIGN="bottom"
+></TD
+><TD
+WIDTH="10%"
+ALIGN="right"
+VALIGN="bottom"
+><A
+HREF="x24.html"
+>Next</A
+></TD
+></TR
+></TABLE
+><HR
+ALIGN="LEFT"
+WIDTH="100%"></DIV
+><DIV
+CLASS="SECT1"
+><H1
+CLASS="SECT1"
+><A
+NAME="AEN11"
+>1. What is OpenACS</A
+></H1
+><P
+>  According to Philip Greenspun, the main creator of the ACS: 
+ </P
+><P
+>  &#8220;The ArsDigita Community System it is a toolkit of software that will help you build Web services with a collaborative dimension, ranging from knowledge management within companies to B2C ecommerce to product support and community among the customers. The software is free and open-source and has been tested in heavy use since 1995. &#8220; 
+ </P
+><P
+>  &#8220;The software and underlying philosophy are documented in a full-length textbook for Web developers (also free and available online at <A
+HREF="http://photo.net/wtr/thebook"
+TARGET="_top"
+>http://photo.net/wtr/thebook</A
+>)&#8221; (<A
+HREF="http://photo.net/wtr/using-the-acs.html"
+TARGET="_top"
+>Using The ACS</A
+>). We highly recommend you to read this book. It will save you lots of trial-and-error, time, grief and will help you understand how to build a great web service. <A
+HREF="http://photo.net/wtr/thebook/community.html"
+TARGET="_top"
+>Chapter 3</A
+> is of special interest, because that's where the data model and ideas of the ACS are explained, but the whole book is great.
+ </P
+><P
+>  If you are serious about building a web service, you should also read <A
+HREF="http://photo.net/wtr/arsdigita-server-architecture.html"
+TARGET="_top"
+>ArsDigita Server Architecture</A
+>, a way of building and delivering reliable web services.
+ </P
+><P
+>  The port for the PostgreSQL RDBMS was started and coordinated by Ben Adida (who also helped to write the original ACS) and Don Baccus, and is maintained as a community project. 
+ </P
+><P
+>  The combination of GNU/Linux, AOLserver, PostgreSQL and OpenACS enables you to build very sophisticated web sites with completely free software. The development and demo web site for OpenACS is <A
+HREF="http://openacs.org"
+TARGET="_top"
+>http://openacs.org</A
+>.
+ </P
+></DIV
+><DIV
+CLASS="NAVFOOTER"
+><HR
+ALIGN="LEFT"
+WIDTH="100%"><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+><A
+HREF="index.html"
+>Prev</A
+></TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+><A
+HREF="index.html"
+>Home</A
+></TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+><A
+HREF="x24.html"
+>Next</A
+></TD
+></TR
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>OpenACS Installation Guide</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>What you need to run OpenACS</TD
+></TR
+></TABLE
+></DIV
+></BODY
+></HTML
+>
\ No newline at end of file
Index: web/openacs/www/doc/openacs/install/x161.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/install/x161.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/install/x161.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,589 @@
+<HTML
+><HEAD
+><TITLE
+>  Configuring OpenACS itself
+ </TITLE
+><META
+NAME="GENERATOR"
+CONTENT="Modular DocBook HTML Stylesheet Version 1.61
+"><LINK
+REL="HOME"
+TITLE="  OpenACS Installation Guide
+ "
+HREF="index.html"><LINK
+REL="PREVIOUS"
+TITLE="  PostgreSQL
+ "
+HREF="x83.html"><LINK
+REL="NEXT"
+TITLE="  Everything works, now what ?
+ "
+HREF="x283.html"></HEAD
+><BODY
+CLASS="SECT1"
+BGCOLOR="#FFFFFF"
+TEXT="#000000"
+LINK="#0000FF"
+VLINK="#840084"
+ALINK="#0000FF"
+><DIV
+CLASS="NAVHEADER"
+><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TH
+COLSPAN="3"
+ALIGN="center"
+>OpenACS Installation Guide</TH
+></TR
+><TR
+><TD
+WIDTH="10%"
+ALIGN="left"
+VALIGN="bottom"
+><A
+HREF="x83.html"
+>Prev</A
+></TD
+><TD
+WIDTH="80%"
+ALIGN="center"
+VALIGN="bottom"
+></TD
+><TD
+WIDTH="10%"
+ALIGN="right"
+VALIGN="bottom"
+><A
+HREF="x283.html"
+>Next</A
+></TD
+></TR
+></TABLE
+><HR
+ALIGN="LEFT"
+WIDTH="100%"></DIV
+><DIV
+CLASS="SECT1"
+><H1
+CLASS="SECT1"
+><A
+NAME="AEN161"
+>6. Configuring OpenACS itself</A
+></H1
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN163"
+>6.1. What is where (OpenACS directories and what is inside each of them)</A
+></H2
+><P
+></P
+><UL
+><LI
+><P
+>   /bin - executables used by the toolkit (e.g. WatchDog)
+   </P
+></LI
+><LI
+><P
+>   /parameters - OpenACS configuration file(s)
+   </P
+></LI
+><LI
+><P
+>   /tcl - OpenACS Tcl scripts library. Your AOLserver config needs to point to here as its Tcl library. The definitions for the modules are here.
+   </P
+></LI
+><LI
+><P
+>   /templates - where templates are stored. Templates modify how a page is displayed according the user's preference (e.g. text x graphics) and language (e.g. with language extensions .fr, .pt, etc.) Not all modules are template-enabled yet, but expect that to change in ACS 4.
+   </P
+></LI
+><LI
+><P
+>   /users - user specific files. Used by the home page module for example.
+   </P
+></LI
+><LI
+><P
+>   /www - Where all the pages live. Each module has a subdirectory here (e.g. www/bboard)
+   </P
+></LI
+><LI
+><P
+>   The www/register directory contains the login and registration scripts. You can easily redirect someone to /register/index.tcl to have them login or register. [1]
+   </P
+></LI
+><LI
+><P
+>   The www/pvt directory is for user-specific pages. They can only be accessed by people who have logged in. [1]
+   </P
+></LI
+></UL
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN182"
+>6.2. Configuring OpenACS</A
+></H2
+><P
+></P
+><UL
+><LI
+><P
+>   In the parameters directory of the OpenACS tree, rename the ad.tcl file to the name of the virtual server you are running in AOLserver (<I
+CLASS="EMPHASIS"
+>server1.tcl</I
+> for example)
+   </P
+></LI
+><LI
+><P
+>   Each module of the ACS is configured in the sections of this file, with a heading such as <I
+CLASS="EMPHASIS"
+>ns/${server}/acs</I
+> (if you are using the included ad.tcl file). If you are using .ini file, than the headers will look like <I
+CLASS="EMPHASIS"
+>[ns/server/yourservername/acs]</I
+>. In this case, replace all ocurrences of yourservername with the actual name of the virtual server configured in AOLserver (such as photonet, or server1).
+   </P
+></LI
+><LI
+><P
+>   Edit the parameters to fit your needs, otherwise your website will show &#8220;Yourdomain Network&#8221; and &#8220;webmaster@yourdomain.com&#8221; all over. &#8220;If you want to change how some of these are used, a good place to look is <I
+CLASS="EMPHASIS"
+>/web/yourdomain/tcl/ad-defs.tcl</I
+>.&#8221; [1] There are lots of comments in the file to help you out and the documentation of each individual module can be found at <A
+HREF="http://openacs.org/doc"
+TARGET="_top"
+>http://openacs.org/doc</A
+>. 
+   </P
+></LI
+><LI
+><P
+>   <A
+HREF="x161.html#CAVEAT"
+>READ THE CAVEAT</A
+> in section 6.5 if you choose to save encrypted password in the db (EncryptPasswordsInDBP=0 or ns_param EncryptPasswordsInDBP "0" in nsd.ini or nsd.tcl respectively).
+   </P
+></LI
+></UL
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN199"
+>6.3. Configuring Permissions [1]</A
+></H2
+><P
+>   You need to protect the proper administration directories of the ACS. You decide the policy. Here are the directories to consider protecting: 
+  </P
+><P
+></P
+><UL
+><LI
+><P
+>   /doc (or at least /doc/sql/ since some AOLserver configurations will allow a user to execute SQL files) 
+   </P
+></LI
+><LI
+><P
+>   /admin (this directory is already protected in latter OpenACS releases).
+   </P
+></LI
+><LI
+><P
+>   any private admin dirs for a module you might have written that are not underneath the /admin directory 
+   </P
+></LI
+></UL
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN209"
+>6.4. Adding Yourself as a User and Making Yourself a Sysadmin [1]</A
+></H2
+><P
+>   The ArsDigita Community System will define two users: system and anonymous. It will also define a user group of system administrators. 
+  </P
+><P
+>   After starting AOLserver, you'll want to: 
+  </P
+><P
+></P
+><UL
+><LI
+><P
+>   add yourself as a user to the system, at http://yourservername.com/register/ 
+   </P
+></LI
+><LI
+><P
+>   add yourself as as member of the site-wide administration group. 
+   </P
+></LI
+></UL
+><P
+>   To do this, log out as yourself (there's a link at &#8220;Your Workspace&#8221; http://yourservername.com/pvt/home.tcl ) and then log in as the system user (email of "system"). Change the system user's password (the default is &#8220;changeme&#8221;). Visit the the User Groups Admin pages at <I
+CLASS="EMPHASIS"
+>http://yourservername.com/admin/ug/</I
+> and add your personal user as a site-wide administrator. 
+  </P
+><P
+>   Now you're bootstrapped! 
+  </P
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN221"
+>6.5. CAVEAT for those that want encrypted passwords in the DB <A
+NAME="CAVEAT"
+></A
+></A
+></H2
+><P
+>   If you want to save encrypted passwords in the database, you'll have to do some things manually to get ACS working because the default users &#8220;system&#8221; and &#8220;anonymous&#8221; come with plain text passwords. 
+  </P
+><P
+>   This is what you need to do: 
+  </P
+><P
+></P
+><OL
+TYPE="1"
+><LI
+><P
+>   create a login for you (as described above). Your password will be saved encrypted in the database. Go into psql and do a &#8220;<I
+CLASS="EMPHASIS"
+>select user_id,first_names,password from users;</I
+>&#8221; to see all the users in your database. 
+   </P
+></LI
+><LI
+><P
+>   Next, change the system user password for the password of the user you just created. Let's say the encrypted password for your user was something like &#8220;0xabcdef&#8221; (or whatever), then do a &#8220;<I
+CLASS="EMPHASIS"
+>update users set password='0xabcdef' where user_id=1;</I
+>&#8221; 
+   </P
+></LI
+><LI
+><P
+>   Now go back to your browser, and logout as your user (from http://yourservername.com/pvt/home.tcl), login as system with the same password you used for your user, add your user to the administration group as described above, and then change the system and anonymous passwords (from http://yoursername.com/admin/users).
+   </P
+></LI
+></OL
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN235"
+>6.6. Closing Down Access [1]</A
+></H2
+><P
+>   The ACS ships with a user named "anonymous" (email "anonymous") to serve as a content owner. If you're operating a restricted-access site, make sure to change the anonymous user's password (the default is &#8220;changeme&#8221;). 
+  </P
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN238"
+>6.7. Making sure that it works (and stays working)</A
+></H2
+><P
+>   Run the acceptance tests in <A
+HREF="http://photo.net/doc/acceptance-test.html"
+TARGET="_top"
+>http://photo.net/doc/acceptance-test.html</A
+>.
+  </P
+><P
+>   Note: The first part of the above page is aimed at the original version of ACS for Oracle. You can replace that first part by going to psql (PostgreSQL interactive SQL tool) and doing some tests:
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>$ su - youraolserveruser 
+$ psql yourdb 
+yourdb# \d 
+yourdb# select * from users;
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   The first psql command is going to list all your tables (under PG 6.5) or all your relationships (under PG 7) and the second will show all the records in the users table.
+  </P
+><P
+>   The other sections of the acceptance-test can be used either under the Oracle or the PostgreSQL versions of the ACS.
+  </P
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN246"
+>6.8. Ensure that your service automatically starts on boot (or any other time the service dies).</A
+></H2
+><P
+>   This section was taken from &#8220;The Hitchhiker's Guide to the ACS&#8221;, written by the ArsDigita folks. 
+  </P
+><P
+>   This step should be completed as root. This can break every service on your machine, so proceed with caution.
+  </P
+><P
+></P
+><UL
+><LI
+><P
+>   Copy this <A
+HREF="../restart-aolserver.txt"
+TARGET="_top"
+>restart-aolserver</A
+> into /tmp/restart-aolserver.txt
+   </P
+></LI
+><LI
+><P
+>   This script needs to be SUID-root, which means that the script will run as root. This is necessary to ensure that the aolserver processes are killed regardless of who owns them. However the script should be in the <I
+CLASS="EMPHASIS"
+>web</I
+> group to ensure that the users updating the web page can use the script, but that general system users cannot run the script. You also need to have Perl installed and also a symbolic link to it in /usr/local/bin. 
+   </P
+></LI
+></UL
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>$ su - ; Enter root password. 
+# cp /tmp/restart-aolserver.txt /usr/local/bin/restart-aolserver # chown root.web /usr/local/bin/restart-aolserver 
+# chmod 4750 /usr/local/bin/restart-aolserver 
+# ln -s /usr/bin/perl /usr/local/bin/perl 
+# su - nsadmin
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+></P
+><UL
+><LI
+><P
+>   Test the <I
+CLASS="EMPHASIS"
+>restart-aolserver</I
+> script by making sure all servers are dead, starting a new server, and then killing it. You should see the following lines. nsadmin and typing 
+   </P
+></LI
+></UL
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>$ killall -9 nsd 
+nsd: no process killed 
+$ /home/aolserver/bin/nsd -u nsadmin -g web -t /home/aolserver/service_name.tcl 
+$ restart-aolserver service_name 
+Killing 23727 23728 23729 23730 
+$ killall -9 nsd nsd: no process killed
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   The numbers indicate the process ids (PIDs) of the processes being killed. It is important that no processes are killed by the second call to killall. If there are processes being killed, it means that the script is not working. 
+  </P
+><P
+></P
+><UL
+><LI
+><P
+>   Assuming that the restart-aolserver script worked, login as root and open /etc/inittab for editing. 
+   </P
+></LI
+></UL
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>$ su - ; Enter root password 
+# emacs -nw /etc/inittab
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+></P
+><UL
+><LI
+><P
+>   Copy this line into the bottom of the file as a template, making sure that the first field nss is unique. 
+   </P
+></LI
+></UL
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>nss:2345:respawn:/home/aolserver/bin/nsd -u nsadmin -g web -i -t /home/aolserver/service_name.tcl
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+></P
+><UL
+><LI
+><P
+>   Important: Make sure there is a newline at the end of the file. If there is not a newline at the end of the file, the system may suffer catastrophic failures. 
+   </P
+></LI
+><LI
+><P
+>   Still as root, enter the following command to re-initialize /etc/inittab. 
+   </P
+></LI
+></UL
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+># killall -9 nsd 
+# /sbin/init q
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+></P
+><UL
+><LI
+><P
+>   Important: See if it worked by running the restart-aolserver script again. 
+   </P
+></LI
+></UL
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+># restart-aolserver service_name Killing 23750 23753 23754 23756	
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   If the processes were killed, congratulations, your server is now automated for startup and shutdown. 
+  </P
+></DIV
+></DIV
+><DIV
+CLASS="NAVFOOTER"
+><HR
+ALIGN="LEFT"
+WIDTH="100%"><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+><A
+HREF="x83.html"
+>Prev</A
+></TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+><A
+HREF="index.html"
+>Home</A
+></TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+><A
+HREF="x283.html"
+>Next</A
+></TD
+></TR
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>PostgreSQL</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>Everything works, now what ?</TD
+></TR
+></TABLE
+></DIV
+></BODY
+></HTML
+>
\ No newline at end of file
Index: web/openacs/www/doc/openacs/install/x24.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/install/x24.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/install/x24.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,208 @@
+<HTML
+><HEAD
+><TITLE
+>  What you need to run OpenACS
+ </TITLE
+><META
+NAME="GENERATOR"
+CONTENT="Modular DocBook HTML Stylesheet Version 1.61
+"><LINK
+REL="HOME"
+TITLE="  OpenACS Installation Guide
+ "
+HREF="index.html"><LINK
+REL="PREVIOUS"
+TITLE="  What is OpenACS
+ "
+HREF="x11.html"><LINK
+REL="NEXT"
+TITLE="  Getting ready to Untar [1]
+ "
+HREF="x47.html"></HEAD
+><BODY
+CLASS="SECT1"
+BGCOLOR="#FFFFFF"
+TEXT="#000000"
+LINK="#0000FF"
+VLINK="#840084"
+ALINK="#0000FF"
+><DIV
+CLASS="NAVHEADER"
+><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TH
+COLSPAN="3"
+ALIGN="center"
+>OpenACS Installation Guide</TH
+></TR
+><TR
+><TD
+WIDTH="10%"
+ALIGN="left"
+VALIGN="bottom"
+><A
+HREF="x11.html"
+>Prev</A
+></TD
+><TD
+WIDTH="80%"
+ALIGN="center"
+VALIGN="bottom"
+></TD
+><TD
+WIDTH="10%"
+ALIGN="right"
+VALIGN="bottom"
+><A
+HREF="x47.html"
+>Next</A
+></TD
+></TR
+></TABLE
+><HR
+ALIGN="LEFT"
+WIDTH="100%"></DIV
+><DIV
+CLASS="SECT1"
+><H1
+CLASS="SECT1"
+><A
+NAME="AEN24"
+>2. What you need to run OpenACS</A
+></H1
+><P
+>  - <A
+HREF="http://www.aolserver.com"
+TARGET="_top"
+>AOLserver</A
+> - A free, Tcl-enabled, multi threaded, powerful web server that is behind huge sites such as aol.com and digitalcity.com. AOLserver is also a complete web development platform being designed from start to have efficient access to databases. We support AOLserver 3. NOTE: In february a fork of the AOLserver project was started to better address user contributions and requests. The project is called OpenNSD and its home page is at <A
+HREF="http://www.opennsd.org"
+TARGET="_top"
+>http://www.opennsd.org</A
+>)
+ </P
+><P
+>  (Note: ArsDigita and Robert Thau came up with a mod_aolserver for the Apache web server, which intends to replicate the AOLserver API on Apache. It has performance issues when compared to AOLserver, but Apache fans can use it. <A
+HREF="http://apache.arsdigita-dev.com"
+TARGET="_top"
+>http://apache.arsdigita-dev.com</A
+>)
+ </P
+><P
+>  - <A
+HREF="http://www.postgresql.org"
+TARGET="_top"
+>PostgreSQL</A
+> - A free, powerful SQL92-based Relational Database Management System with advanced features including Multi-variant Concurrency Control (unlike in the more common table-locking model, readers don't wait for writers and writers don't wait for readers, very crucial in a high-volume web server environment). Version 7 is the supported version. 
+ </P
+><P
+>  - <I
+CLASS="EMPHASIS"
+>Some flavor of UNIX or Windows</I
+>. Our development is almost entirely done on <A
+HREF="http://www.linux.com"
+TARGET="_top"
+>GNU/Linux</A
+> (and when not done in GNU/Linux, it is tested on it) and for now, this is the only operating system we can help you with. Some very big web sites run on GNU/Linux and it has proven itself as a great platform for web servers, plus it is free software. <A
+HREF="http://www.redhat.com"
+TARGET="_top"
+>Red Hat Linux</A
+> and <A
+HREF="http://www.debian.org"
+TARGET="_top"
+>Debian GNU/Linux</A
+> are the reference distributions for AOLserver and OpenACS, but if you know what you are doing, you can use any GNU/Linux distribution (and many people do). 
+ </P
+><P
+>  In fact, <A
+HREF="http://www.debian.org"
+TARGET="_top"
+>Debian GNU/Linux</A
+> has OpenACS .deb packages all ready to install. Thanks to Brent Fulgham for providing the Debian packages. ArsDigita is providing RPM packages for OpenACS with mod_aolserver on Apache. They are available at the <A
+HREF="http://openacs.org/software.adp"
+TARGET="_top"
+>OpenACS software page.</A
+>
+ </P
+><P
+>  To get OpenACS working on Windows you will have to get PostgreSQL working on it first, which is beyond the scope of this document. Please refer to the PostgreSQL documentation for that information. The OpenACS-specific instructions should need very little adaptation. Please contribute the documentation for Windows if you are going to do it.
+ </P
+><P
+>  - <I
+CLASS="EMPHASIS"
+>The PostgreSQL driver</I
+> for AOLserver, available at <A
+HREF="http://openacs.org/software.adp"
+TARGET="_top"
+>OpenACS software page.</A
+>.
+ </P
+><P
+>  - The OpenACS distribution, available at <A
+HREF="http://openacs.org/software.adp"
+TARGET="_top"
+>OpenACS software page.</A
+>.
+ </P
+></DIV
+><DIV
+CLASS="NAVFOOTER"
+><HR
+ALIGN="LEFT"
+WIDTH="100%"><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+><A
+HREF="x11.html"
+>Prev</A
+></TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+><A
+HREF="index.html"
+>Home</A
+></TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+><A
+HREF="x47.html"
+>Next</A
+></TD
+></TR
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>What is OpenACS</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>Getting ready to Untar [1]</TD
+></TR
+></TABLE
+></DIV
+></BODY
+></HTML
+>
\ No newline at end of file
Index: web/openacs/www/doc/openacs/install/x283.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/install/x283.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/install/x283.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,225 @@
+<HTML
+><HEAD
+><TITLE
+>  Everything works, now what ?
+ </TITLE
+><META
+NAME="GENERATOR"
+CONTENT="Modular DocBook HTML Stylesheet Version 1.61
+"><LINK
+REL="HOME"
+TITLE="  OpenACS Installation Guide
+ "
+HREF="index.html"><LINK
+REL="PREVIOUS"
+TITLE="  Configuring OpenACS itself
+ "
+HREF="x161.html"><LINK
+REL="NEXT"
+TITLE="  Where do go I for help and how can I help ?
+ "
+HREF="x309.html"></HEAD
+><BODY
+CLASS="SECT1"
+BGCOLOR="#FFFFFF"
+TEXT="#000000"
+LINK="#0000FF"
+VLINK="#840084"
+ALINK="#0000FF"
+><DIV
+CLASS="NAVHEADER"
+><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TH
+COLSPAN="3"
+ALIGN="center"
+>OpenACS Installation Guide</TH
+></TR
+><TR
+><TD
+WIDTH="10%"
+ALIGN="left"
+VALIGN="bottom"
+><A
+HREF="x161.html"
+>Prev</A
+></TD
+><TD
+WIDTH="80%"
+ALIGN="center"
+VALIGN="bottom"
+></TD
+><TD
+WIDTH="10%"
+ALIGN="right"
+VALIGN="bottom"
+><A
+HREF="x309.html"
+>Next</A
+></TD
+></TR
+></TABLE
+><HR
+ALIGN="LEFT"
+WIDTH="100%"></DIV
+><DIV
+CLASS="SECT1"
+><H1
+CLASS="SECT1"
+><A
+NAME="AEN283"
+>7. Everything works, now what ?</A
+></H1
+><P
+></P
+><UL
+><LI
+><P
+>  Add your site to the OpenACS Sites list: <A
+HREF="http://www.openacs.org/sites.html"
+TARGET="_top"
+>http://www.openacs.org/sites.html</A
+>
+  </P
+></LI
+><LI
+><P
+>  Read the <A
+HREF="getting-started.html"
+TARGET="_top"
+>OpenACS Getting Started Guide</A
+>.
+  </P
+></LI
+><LI
+><P
+>  Read the <A
+HREF="http://dev.arsdigita.com/ad-training/acs-install/monitors.html"
+TARGET="_top"
+>Installing Monitors</A
+> section of The Hitchhiker's Guide to the ACS. It will teach you how to install programs that will monitor your web server and take actions in case something goes wrong. It is written for ACS/Oracle, but it can be easily adapted to OpenACS (except for Cassandracle). We intend to &#8220;port&#8221; those documents to OpenACS in the near future.
+  </P
+></LI
+></UL
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN295"
+>7.1. Backing up your PostgreSQL databases</A
+></H2
+><P
+>   See <I
+CLASS="EMPHASIS"
+>Backup Tips from Don Baccus</I
+> , in the <I
+CLASS="EMPHASIS"
+>OpenACS Getting Started Guide</I
+>.
+  </P
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN300"
+>7.2. If you are using the e-commerce module</A
+></H2
+><P
+>   You should be aware that the e-commerce module makes use of the <I
+CLASS="EMPHASIS"
+>ImageMagick</I
+> suite of graphics manipulation programs to generate picture thumbnails, especifically the <I
+CLASS="EMPHASIS"
+>convert</I
+> program. Unfortunately the path to this program is hard-coded into the OpenACS code and this path may not match where your copy of <I
+CLASS="EMPHASIS"
+>convert</I
+> is installed.
+  </P
+><P
+>   To find out where your <I
+CLASS="EMPHASIS"
+>convert</I
+> is and make a symlink from it to where OpenACS thinks it is installed, do the following:
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+># which convert
+/usr/X11R6/bin/convert
+ln -s /usr/X11R6/bin/convert /usr/local/bin/convert
+  </PRE
+></TD
+></TR
+></TABLE
+></DIV
+></DIV
+><DIV
+CLASS="NAVFOOTER"
+><HR
+ALIGN="LEFT"
+WIDTH="100%"><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+><A
+HREF="x161.html"
+>Prev</A
+></TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+><A
+HREF="index.html"
+>Home</A
+></TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+><A
+HREF="x309.html"
+>Next</A
+></TD
+></TR
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>Configuring OpenACS itself</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>Where do go I for help and how can I help ?</TD
+></TR
+></TABLE
+></DIV
+></BODY
+></HTML
+>
\ No newline at end of file
Index: web/openacs/www/doc/openacs/install/x309.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/install/x309.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/install/x309.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,242 @@
+<HTML
+><HEAD
+><TITLE
+>  Where do go I for help and how can I help ?
+ </TITLE
+><META
+NAME="GENERATOR"
+CONTENT="Modular DocBook HTML Stylesheet Version 1.61
+"><LINK
+REL="HOME"
+TITLE="  OpenACS Installation Guide
+ "
+HREF="index.html"><LINK
+REL="PREVIOUS"
+TITLE="  Everything works, now what ?
+ "
+HREF="x283.html"><LINK
+REL="NEXT"
+TITLE="  Contributed Items
+ "
+HREF="x344.html"></HEAD
+><BODY
+CLASS="SECT1"
+BGCOLOR="#FFFFFF"
+TEXT="#000000"
+LINK="#0000FF"
+VLINK="#840084"
+ALINK="#0000FF"
+><DIV
+CLASS="NAVHEADER"
+><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TH
+COLSPAN="3"
+ALIGN="center"
+>OpenACS Installation Guide</TH
+></TR
+><TR
+><TD
+WIDTH="10%"
+ALIGN="left"
+VALIGN="bottom"
+><A
+HREF="x283.html"
+>Prev</A
+></TD
+><TD
+WIDTH="80%"
+ALIGN="center"
+VALIGN="bottom"
+></TD
+><TD
+WIDTH="10%"
+ALIGN="right"
+VALIGN="bottom"
+><A
+HREF="x344.html"
+>Next</A
+></TD
+></TR
+></TABLE
+><HR
+ALIGN="LEFT"
+WIDTH="100%"></DIV
+><DIV
+CLASS="SECT1"
+><H1
+CLASS="SECT1"
+><A
+NAME="AEN309"
+>8. Where do go I for help and how can I help ?</A
+></H1
+><P
+></P
+><UL
+><LI
+><P
+>  <A
+HREF="http://openacs.org/bboard"
+TARGET="_top"
+>http://openacs.org/bboard</A
+> - the OpenACS installation and configuration bulletin board.
+  </P
+></LI
+><LI
+><P
+>  <A
+HREF="http://openacs.org/sdm"
+TARGET="_top"
+>http://openacs.org/sdm</A
+> - all bug reports and feature requests should go here (including corrections/suggestions to this documentation).
+  </P
+></LI
+><LI
+><P
+>  If you want to help with the OpenACS project, email ben@mit.edu
+  </P
+></LI
+><LI
+><P
+>  http://yourservername.com/doc. Once you have your OpenACS system setup, the /doc directory contains documentation about all modules and many other aspects of the toolkit.
+  </P
+></LI
+></UL
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN322"
+>8.1. Why Not MySQL ?</A
+></H2
+><P
+>   We get this question many times. Ben Adida wrote a short article explaining why OpenACS doesn't use MySQL (which made into Slashdot, giving openacs.org 37,000+ hits on that day). Read it at <A
+HREF="http://www.openacs.org/why-not-mysql.html"
+TARGET="_top"
+>http://www.openacs.org/why-not-mysql.html</A
+>.
+  </P
+><P
+>   You can read more about this on the article that explains why Sourceforge.net has moved away from MySQL, at <A
+HREF="http://www.phpbuilder.com/columns/tim20001112.php3"
+TARGET="_top"
+>http://www.phpbuilder.com/columns/tim20001112.php3</A
+>.
+  </P
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN328"
+>8.2. Some Useful Links</A
+></H2
+><P
+></P
+><UL
+><LI
+><P
+>   <A
+HREF="http://www.aolserver.com"
+TARGET="_top"
+>aolserver.com</A
+> and especially <A
+HREF="http://www.aolserver.com/doc"
+TARGET="_top"
+>aolserver.com/doc</A
+> for AOLserver info and documentation (also included in the source distribution).
+   </P
+></LI
+><LI
+><P
+>   <A
+HREF="http://wimpy.arsdigita.com/public/presentation-top.adp?presentaion_id=12383"
+TARGET="_top"
+>ArsDigita's AOLserver Presentation</A
+>
+   </P
+></LI
+><LI
+><P
+>   <A
+HREF="http://www.arsdigita.com/asj"
+TARGET="_top"
+>ArsDigita Systems Journal</A
+> for lots of good quality information on AOLserver, the ACS and building great web services.
+   </P
+></LI
+><LI
+><P
+>   <A
+HREF="http://www.openforce.net"
+TARGET="_top"
+>OpenForce Inc</A
+>, provides commercial support, customization and other services using OpenACS.
+   </P
+></LI
+></UL
+></DIV
+></DIV
+><DIV
+CLASS="NAVFOOTER"
+><HR
+ALIGN="LEFT"
+WIDTH="100%"><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+><A
+HREF="x283.html"
+>Prev</A
+></TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+><A
+HREF="index.html"
+>Home</A
+></TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+><A
+HREF="x344.html"
+>Next</A
+></TD
+></TR
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>Everything works, now what ?</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>Contributed Items</TD
+></TR
+></TABLE
+></DIV
+></BODY
+></HTML
+>
\ No newline at end of file
Index: web/openacs/www/doc/openacs/install/x344.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/install/x344.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/install/x344.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,159 @@
+<HTML
+><HEAD
+><TITLE
+>  Contributed Items
+ </TITLE
+><META
+NAME="GENERATOR"
+CONTENT="Modular DocBook HTML Stylesheet Version 1.61
+"><LINK
+REL="HOME"
+TITLE="  OpenACS Installation Guide
+ "
+HREF="index.html"><LINK
+REL="PREVIOUS"
+TITLE="  Where do go I for help and how can I help ?
+ "
+HREF="x309.html"><LINK
+REL="NEXT"
+TITLE="  Acknowledgements
+ "
+HREF="x354.html"></HEAD
+><BODY
+CLASS="SECT1"
+BGCOLOR="#FFFFFF"
+TEXT="#000000"
+LINK="#0000FF"
+VLINK="#840084"
+ALINK="#0000FF"
+><DIV
+CLASS="NAVHEADER"
+><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TH
+COLSPAN="3"
+ALIGN="center"
+>OpenACS Installation Guide</TH
+></TR
+><TR
+><TD
+WIDTH="10%"
+ALIGN="left"
+VALIGN="bottom"
+><A
+HREF="x309.html"
+>Prev</A
+></TD
+><TD
+WIDTH="80%"
+ALIGN="center"
+VALIGN="bottom"
+></TD
+><TD
+WIDTH="10%"
+ALIGN="right"
+VALIGN="bottom"
+><A
+HREF="x354.html"
+>Next</A
+></TD
+></TR
+></TABLE
+><HR
+ALIGN="LEFT"
+WIDTH="100%"></DIV
+><DIV
+CLASS="SECT1"
+><H1
+CLASS="SECT1"
+><A
+NAME="AEN344"
+>9. Contributed Items</A
+></H1
+><P
+>  Several user have contributed to the OpenACS project. These are the items that our community has found useful and requested to be included in the documentation:
+ </P
+><P
+></P
+><UL
+><LI
+><P
+>  <A
+HREF="http://www.openacs.org/doc/openacs/getting-started/"
+TARGET="_top"
+>Backup Tips from Don Baccus</A
+>- Tips for optimizing and backing up your PostgreSQL databases, including a script that can be used from within OpenACS.
+  </P
+></LI
+><LI
+><P
+>  <A
+HREF="http://michael.cleverly.com/aolserver"
+TARGET="_top"
+>Red Hat Updater</A
+>- Michael Cleverly has written this Tcl script to keep your Red Hat box up-to-date.
+  </P
+></LI
+></UL
+></DIV
+><DIV
+CLASS="NAVFOOTER"
+><HR
+ALIGN="LEFT"
+WIDTH="100%"><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+><A
+HREF="x309.html"
+>Prev</A
+></TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+><A
+HREF="index.html"
+>Home</A
+></TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+><A
+HREF="x354.html"
+>Next</A
+></TD
+></TR
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>Where do go I for help and how can I help ?</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>Acknowledgements</TD
+></TR
+></TABLE
+></DIV
+></BODY
+></HTML
+>
\ No newline at end of file
Index: web/openacs/www/doc/openacs/install/x354.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/install/x354.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/install/x354.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,133 @@
+<HTML
+><HEAD
+><TITLE
+>  Acknowledgements
+ </TITLE
+><META
+NAME="GENERATOR"
+CONTENT="Modular DocBook HTML Stylesheet Version 1.61
+"><LINK
+REL="HOME"
+TITLE="  OpenACS Installation Guide
+ "
+HREF="index.html"><LINK
+REL="PREVIOUS"
+TITLE="  Contributed Items
+ "
+HREF="x344.html"></HEAD
+><BODY
+CLASS="SECT1"
+BGCOLOR="#FFFFFF"
+TEXT="#000000"
+LINK="#0000FF"
+VLINK="#840084"
+ALINK="#0000FF"
+><DIV
+CLASS="NAVHEADER"
+><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TH
+COLSPAN="3"
+ALIGN="center"
+>OpenACS Installation Guide</TH
+></TR
+><TR
+><TD
+WIDTH="10%"
+ALIGN="left"
+VALIGN="bottom"
+><A
+HREF="x344.html"
+>Prev</A
+></TD
+><TD
+WIDTH="80%"
+ALIGN="center"
+VALIGN="bottom"
+></TD
+><TD
+WIDTH="10%"
+ALIGN="right"
+VALIGN="bottom"
+>&nbsp;</TD
+></TR
+></TABLE
+><HR
+ALIGN="LEFT"
+WIDTH="100%"></DIV
+><DIV
+CLASS="SECT1"
+><H1
+CLASS="SECT1"
+><A
+NAME="AEN354"
+>10. Acknowledgements</A
+></H1
+><P
+>  Several people have contributed to this document in either content or error reporting and I would like to thank them. Please let me know if I forgot to include your name.
+ </P
+><P
+>  Contributors (in no specific order):
+ </P
+><P
+>  Philip Greenspun, Ben Adida, Don Baccus, Michael Cleverly, Janne Blonqvist, Jonathan Ellis, Janine Sisk, Jade Rubick, Chris Hardy.
+ </P
+></DIV
+><DIV
+CLASS="NAVFOOTER"
+><HR
+ALIGN="LEFT"
+WIDTH="100%"><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+><A
+HREF="x344.html"
+>Prev</A
+></TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+><A
+HREF="index.html"
+>Home</A
+></TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>&nbsp;</TD
+></TR
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>Contributed Items</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>&nbsp;</TD
+></TR
+></TABLE
+></DIV
+></BODY
+></HTML
+>
\ No newline at end of file
Index: web/openacs/www/doc/openacs/install/x47.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/install/x47.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/install/x47.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,164 @@
+<HTML
+><HEAD
+><TITLE
+>  Getting ready to Untar [1]
+ </TITLE
+><META
+NAME="GENERATOR"
+CONTENT="Modular DocBook HTML Stylesheet Version 1.61
+"><LINK
+REL="HOME"
+TITLE="  OpenACS Installation Guide
+ "
+HREF="index.html"><LINK
+REL="PREVIOUS"
+TITLE="  What you need to run OpenACS
+ "
+HREF="x24.html"><LINK
+REL="NEXT"
+TITLE="  AOLserver/OpenNSD
+ "
+HREF="x60.html"></HEAD
+><BODY
+CLASS="SECT1"
+BGCOLOR="#FFFFFF"
+TEXT="#000000"
+LINK="#0000FF"
+VLINK="#840084"
+ALINK="#0000FF"
+><DIV
+CLASS="NAVHEADER"
+><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TH
+COLSPAN="3"
+ALIGN="center"
+>OpenACS Installation Guide</TH
+></TR
+><TR
+><TD
+WIDTH="10%"
+ALIGN="left"
+VALIGN="bottom"
+><A
+HREF="x24.html"
+>Prev</A
+></TD
+><TD
+WIDTH="80%"
+ALIGN="center"
+VALIGN="bottom"
+></TD
+><TD
+WIDTH="10%"
+ALIGN="right"
+VALIGN="bottom"
+><A
+HREF="x60.html"
+>Next</A
+></TD
+></TR
+></TABLE
+><HR
+ALIGN="LEFT"
+WIDTH="100%"></DIV
+><DIV
+CLASS="SECT1"
+><H1
+CLASS="SECT1"
+><A
+NAME="AEN47"
+>3. Getting ready to Untar [1]</A
+></H1
+><P
+>  We recommend rooting Web server content in /web (typically a symlink to a large mirrored disk drive). Since most servers these days are expected to run multiple services from multiple IP addresses, each server gets a subdirectory from /web. For example, http://scorecard.org would be rooted at /web/scorecard on one of our machines and if http://jobdirect.com were on the same box then it would be at /web/jobdirect. 
+ </P
+><P
+>  For the sake of argument, we're going to assume that your service is called "yourdomain", is going to be at http://yourdomain.com and is rooted at /web/yourdomain in the Unix file system. Note that you'll find our definitions files starting out with "yourdomain.com". 
+ </P
+><P
+></P
+><UL
+><LI
+><P
+>  download openacs-3.2.?.tar.gz into /tmp/openacs-3.2.?.tar.gz (where ? is the version number)
+  </P
+></LI
+><LI
+><P
+>  cd /web
+  </P
+></LI
+><LI
+><P
+>  tar xzvf /tmp/openacs-3.2.?.tar.gz (creates a directory "openacs-3.2.?")
+  </P
+></LI
+><LI
+><P
+>  mv openacs-3.2.? /web/yourdomain 
+  </P
+></LI
+></UL
+></DIV
+><DIV
+CLASS="NAVFOOTER"
+><HR
+ALIGN="LEFT"
+WIDTH="100%"><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+><A
+HREF="x24.html"
+>Prev</A
+></TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+><A
+HREF="index.html"
+>Home</A
+></TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+><A
+HREF="x60.html"
+>Next</A
+></TD
+></TR
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>What you need to run OpenACS</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>AOLserver/OpenNSD</TD
+></TR
+></TABLE
+></DIV
+></BODY
+></HTML
+>
\ No newline at end of file
Index: web/openacs/www/doc/openacs/install/x60.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/install/x60.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/install/x60.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,236 @@
+<HTML
+><HEAD
+><TITLE
+>  AOLserver/OpenNSD
+ </TITLE
+><META
+NAME="GENERATOR"
+CONTENT="Modular DocBook HTML Stylesheet Version 1.61
+"><LINK
+REL="HOME"
+TITLE="  OpenACS Installation Guide
+ "
+HREF="index.html"><LINK
+REL="PREVIOUS"
+TITLE="  Getting ready to Untar [1]
+ "
+HREF="x47.html"><LINK
+REL="NEXT"
+TITLE="  PostgreSQL
+ "
+HREF="x83.html"></HEAD
+><BODY
+CLASS="SECT1"
+BGCOLOR="#FFFFFF"
+TEXT="#000000"
+LINK="#0000FF"
+VLINK="#840084"
+ALINK="#0000FF"
+><DIV
+CLASS="NAVHEADER"
+><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TH
+COLSPAN="3"
+ALIGN="center"
+>OpenACS Installation Guide</TH
+></TR
+><TR
+><TD
+WIDTH="10%"
+ALIGN="left"
+VALIGN="bottom"
+><A
+HREF="x47.html"
+>Prev</A
+></TD
+><TD
+WIDTH="80%"
+ALIGN="center"
+VALIGN="bottom"
+></TD
+><TD
+WIDTH="10%"
+ALIGN="right"
+VALIGN="bottom"
+><A
+HREF="x83.html"
+>Next</A
+></TD
+></TR
+></TABLE
+><HR
+ALIGN="LEFT"
+WIDTH="100%"></DIV
+><DIV
+CLASS="SECT1"
+><H1
+CLASS="SECT1"
+><A
+NAME="AEN60"
+>4. AOLserver/OpenNSD</A
+></H1
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN62"
+>4.1. Installing AOLserver</A
+></H2
+><P
+>   We wrote a <A
+HREF="/doc/openacs"
+TARGET="_top"
+>Simple AOLserver Install Guide</A
+>. For other instrtuctions, see the <A
+HREF="http://www.aolserver.com/docs/3.0/"
+TARGET="_top"
+>AOLserver docs</A
+>.
+  </P
+><P
+>   It was verified that, as of June 2000, AOLserver has problems compiling with pgcc (used by GNU/Linux distributions such as Mandrake and Stampede). I could only get AOLserver 3 to compile once I got rid of pgcc in my Mandrake 6.1 box and loaded egcs (standard in Red Hat.)
+  </P
+><P
+>   You must create a user that AOLserver is going to run as, since it will not run as root. I usually use nsadmin or ns (for NaviServer, AOLserver's original name).
+  </P
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN69"
+>4.2. Configuring AOLserver</A
+></H2
+><P
+>   Note: AOLserver 3 can use both .ini and .tcl files for initialization. We are dropping support for old .ini files because .tcl files are much more flexible. Those who are used to .ini files and want to use them will know what to do :-) 
+  </P
+><P
+>   We are including a sample working nsd.tcl file as reference that you can use, but you must configure it for your own needs. Just moving it to your AOLserver directory and running AOLserver will not work. The file is well commented so you should be able to understand it. Look at the AOLserver docs for other parameters you could have.
+  </P
+><P
+>   Pay special attention to the following sections in the nsd.tcl file:
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>ns_section "ns/db/drivers" 
+ns_section "ns/db/pools" 
+ns_section "ns/server/${server}/tcl" 
+ns_section "ns/server/${server}"	
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   You can only have one ArsDigita Community System running from a single nsd process (though you can have as many ACS servers as you like on a physical machine; each just needs its own process).The reason reason for this is that each ACS installation needs to source its own parameter file (see second to last line in the nsd.tcl file).
+  </P
+><P
+>   In the ns/server/${server} section, if you want to use our fancy custom error responses and such, uncomment the lines 
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>ns_param NotFoundResponse            "/global/file-not-found.html" 
+ns_param ServerBusyResponse          "/global/busy.html" 
+ns_param ServerInternalErrorResponse "/global/error.html " 
+ns_param ForbiddenResponse           "/global/forbidden.html" 
+ns_param UnauthorizedResponse        "/global/unauthorized.html"	
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   then go into the www/global/ directory and edit these files to suit. &#8220; [1]
+  </P
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN79"
+>4.3. Sample nsd.tcl file</A
+></H2
+><P
+>   You can find well-commented, almost ready nsd.tcl file <A
+HREF="/doc/openacs/nsd.txt"
+TARGET="_top"
+>right here</A
+>. Rename it to nsd.tcl, chown it to your AOLserver user and edit to your needs. There are only a few things that need changes. Read the comments.
+  </P
+></DIV
+></DIV
+><DIV
+CLASS="NAVFOOTER"
+><HR
+ALIGN="LEFT"
+WIDTH="100%"><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+><A
+HREF="x47.html"
+>Prev</A
+></TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+><A
+HREF="index.html"
+>Home</A
+></TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+><A
+HREF="x83.html"
+>Next</A
+></TD
+></TR
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>Getting ready to Untar [1]</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>PostgreSQL</TD
+></TR
+></TABLE
+></DIV
+></BODY
+></HTML
+>
\ No newline at end of file
Index: web/openacs/www/doc/openacs/install/x83.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/install/x83.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/install/x83.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,473 @@
+<HTML
+><HEAD
+><TITLE
+>  PostgreSQL
+ </TITLE
+><META
+NAME="GENERATOR"
+CONTENT="Modular DocBook HTML Stylesheet Version 1.61
+"><LINK
+REL="HOME"
+TITLE="  OpenACS Installation Guide
+ "
+HREF="index.html"><LINK
+REL="PREVIOUS"
+TITLE="  AOLserver/OpenNSD
+ "
+HREF="x60.html"><LINK
+REL="NEXT"
+TITLE="  Configuring OpenACS itself
+ "
+HREF="x161.html"></HEAD
+><BODY
+CLASS="SECT1"
+BGCOLOR="#FFFFFF"
+TEXT="#000000"
+LINK="#0000FF"
+VLINK="#840084"
+ALINK="#0000FF"
+><DIV
+CLASS="NAVHEADER"
+><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TH
+COLSPAN="3"
+ALIGN="center"
+>OpenACS Installation Guide</TH
+></TR
+><TR
+><TD
+WIDTH="10%"
+ALIGN="left"
+VALIGN="bottom"
+><A
+HREF="x60.html"
+>Prev</A
+></TD
+><TD
+WIDTH="80%"
+ALIGN="center"
+VALIGN="bottom"
+></TD
+><TD
+WIDTH="10%"
+ALIGN="right"
+VALIGN="bottom"
+><A
+HREF="x161.html"
+>Next</A
+></TD
+></TR
+></TABLE
+><HR
+ALIGN="LEFT"
+WIDTH="100%"></DIV
+><DIV
+CLASS="SECT1"
+><H1
+CLASS="SECT1"
+><A
+NAME="AEN83"
+>5. PostgreSQL</A
+></H1
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN85"
+>5.1. Installing PostgreSQL</A
+></H2
+><P
+>   I wrote a bare-bones installation guide for PostgreSQL, see Simple PostgreSQL Install Guide (<A
+HREF="/doc/openacs"
+TARGET="_top"
+>simple-pg-install.html</A
+>). 
+  </P
+><P
+>   For more generic downloading and compiling instructions see <A
+HREF="http://www.postgresql.org/docs/admin/install855.htm"
+TARGET="_top"
+>http://www.postgresql.org/docs/admin/install855.htm</A
+>.
+  </P
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN91"
+>5.2. PG 6.5.3 or 7 ?</A
+></H2
+><P
+>   PostgreSQL 7 is out at the time of this writing. It comes with some exciting new features such as referential integrity, to_char, optimizer overhaul and an enhanced psql. 
+  </P
+><P
+>   The more advanced features of PG 7 are critical to OpenACS (such as lztext which will allow bigger comments, static pages, and referential integrity) so that's the version we support. Upgrading from PG 6.5 to PG 7 is not too hard although you'll need to pg_dump and restore your database plus an initdb. 
+  </P
+><P
+>   If you want to use RPMs, please use the official PostgreSQL RPMs. They are available at Postgres' website. Lamar Owen maintains those RPMs and is also a member of the OpenACS team, so we know exactly how those packages are done and our tests and documentation are based on that.
+  </P
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN96"
+>5.3. Compiling the PostgreSQL driver for AOLserver</A
+></H2
+><P
+>   Note: You can use the nspostgres.so driver included in the AOLserver distribution, but if you want to compile the latest driver, you'll need the AOLserver source distribution.
+  </P
+><P
+>   Also, to do any compiling in C, you'll need a compiler and the right libraries installed in your system. AOLserver, PostgreSQL and the PG driver were tested with gcc (the GNU Compiler Collection) and gmake (GNU Make). You will need gcc (egcs in Red Hat, pgcc in Mandrake/Stampede) and the glibc (GNU C library) installed (for GNU/Linux distributions this usually means packages like glibc and glibc-devel).
+  </P
+><P
+>   The PostgreSQL driver now comes with the AOLserver distribution (nspostgres.so), but if you are having problems, you can always get the latest PostgreSQL driver from <A
+HREF="http://openacs.org/software.adp"
+TARGET="_top"
+>OpenACS software page</A
+> and compile it. If you are using the driver that comes with AOLserver, skip the next step.
+  </P
+><P
+>   Edit the Makefile to include the correct path to your PostgreSQL and AOLserver directories. If you are using the RPM version of PostgreSQL, make sure you have the devel package installed as well. You need to pay attention to these lines: 
+
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>PGLIB=/usr/local/pgsql/lib # Where your PG libraries are installed 
+PGINC=/usr/local/pgsql/include # Where your PG includes are installed 
+NSHOME=/home/aolserver # Where your AOLserver is installed 
+NSINC=/usr/local/src/aolserver3_0/include # Where you untarred AOLserver
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   Do a <I
+CLASS="EMPHASIS"
+>make</I
+> and then <I
+CLASS="EMPHASIS"
+>make install</I
+>. The file <I
+CLASS="EMPHASIS"
+>postgres.so</I
+> will be copied to the AOLserver's bin directory.
+  </P
+><P
+>   If you are running PG 7, make a symbolic link from libpq.so.2.0 pointing to libpq.so.2.1 because AOLserver looks for libpq.so.2.0 when loading the driver:
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>cd /usr/local/pgsql/lib 
+ln -s libpq.so.2.1 libpq.so.2.0 (as user postgres)
+  </PRE
+></TD
+></TR
+></TABLE
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN110"
+>5.4. Some PostgreSQL tips from Don Baccus</A
+></H2
+><P
+>   Note: These are not absolutely necessary for running OpenACS, but I included here because it tells you how to get more out of PostgreSQL. It is good reading especially if you want to do something serious with your copy of OpenACS.
+  </P
+><P
+>   You'll need to make sure the Postgres postmaster is running, first. This is the process that forks a Postgres backend when AOLserver (or any other application, including PSQL) initiates a backend connection. I've got my .ini file configured so idle connections never get released by AOLserver, so this forking happens only once per connection per lifetime of the server (the MaxOpen and MaxIdle in the pools section of the nsd.ini, as in the example above).
+  </P
+><P
+>   Here's the command I use to run Postmaster from my <I
+CLASS="EMPHASIS"
+>/etc/rc.d/init.d/postgresql</I
+> script:
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>su -l postgres -c '/usr/local/pgsql/bin/postmaster -B 1000 -o "-S 2000" -S -D /usr/local/pgsql/data'
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   For the RPM version should be something like this:
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>su -l postgres -c '/usr/bin/postmaster -B 1000 -o "-S 2000" -S -D /var/lib/pgsql/data'
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   Some explanations - "<I
+CLASS="EMPHASIS"
+>-B 1000</I
+>" tells it to allocate 1000 blocks of shared memory (rather than the default 64, which is way puny). I've compiled my copy of postgres with a 16K blocksize, so this is 16MB of shared memory space, i.e. the most postgres will use without a kernel recompile. If you've compiled with the default 8K blocksize (RPM version), "-B 2000" will work. You needn't do this for testing, but for an active system helps a lot.
+  </P
+><P
+>   The <I
+CLASS="EMPHASIS"
+>'-o "-S 2000" '</I
+> tells each backend to use up to 2 MB (2000 x 1KB) of RAM for sorting, etc before spilling to disk.
+  </P
+><P
+>   The other "<I
+CLASS="EMPHASIS"
+>-S</I
+>" (to the postmaster itself, don't confuse with the above where -o is used to pass flags to forked backends) tells it to run "silently", in the background.
+  </P
+><P
+>   -D is used to pass the path to the database which you've hopefully already run initdb on, etc.
+  </P
+><DIV
+CLASS="SECT3"
+><H3
+CLASS="SECT3"
+><A
+NAME="AEN126"
+>5.4.1. How to increase the blocksize in PostgreSQL</A
+></H3
+><P
+>    Again, this is not required to run OpenACS.
+   </P
+><P
+>    By default PostgreSQL is compiled with a blocksize of 8 Kb. You can compile PostgreSQL to have 16 Kb blocksize instead, which will allow for bigger text and lztext data types. (NOTE: This will be completely unnecessary in PostgreSQL 7.1 as it will be rid of this limitation)
+   </P
+><P
+>    Refer to the <A
+HREF="/doc/openacs"
+TARGET="_top"
+>Simple PostgreSQL Installation Guide</A
+> for instructions on how to do this.
+   </P
+></DIV
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN132"
+>5.5. Loading the data model</A
+></H2
+><P
+>   Make sure PostgreSQL is running fine with all the environment variables set (the RPM version does that all for you).
+  </P
+><P
+>   - Login as &#8220;postgres&#8221; (the PostgreSQL super user) and create a user for AOLserver in PostgreSQL. If your AOLserver runs as &#8220;nsadmin&#8221; , that should be the user to create with the command createuser nsadmin. In PG 6.5, you will be asked if the user is a super user and allowed to create dabatases, respond YES (y) to both. In PG 7 it will ask you if this user is allowed to create databases and if this user is allowed to create new users, respond YES (y) to both as well. 
+  </P
+><P
+>   From now on, become the user AOLserver will connect to PostgreSQL as (e.g. nsadmin). 
+  </P
+><P
+>   - Come up with a name for your Database (Usually it will be the name of the web service you're setting up. I'll use yourdb as example). Then create the database with the command: createdb yourdb.
+  </P
+><P
+>   - cd to the www/install directory of the OpenACS distribution and load the country/state/zip codes with the command :
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>./load-geo-tables yourdb
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   - cd to the <I
+CLASS="EMPHASIS"
+>www/doc/sql</I
+> directory. If you are running the RPM version of PostgreSQL, edit the file postgres.sql and uncomment the following lines, commenting the two similar lines right below them: 
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>--create function plpgsql_call_handler() RETURNS opaque 
+--as '/usr/lib/pgsql/plpgsql.so' language 'c';
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   - Edit the file load-data-model.sql. Uncomment the line \i postgres65.sql only if you are running PG 6.5.x. 
+  </P
+><P
+>   (Optional - Deprecated) If you are running PG 6.5.3 and have the Tcl package loaded (or compiled --with-tcl) you may comment the \i postgres65.sql line and uncomment the \i postgres-pgtcl.sql line.
+  </P
+><P
+>   - Load the data model into yourdb with the command: 
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>psql -f load-data-model.sql yourdb
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   Alternatively and for debugging purposes you can do (I always do): 
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>psql -f load-data-model.sql yourdb 2&#62; datamodel.txt 
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   to save PG's output to a file called datamodel.txt, which you can review and look for errors. If you have a bunch of &#8220; ERROR&#8221; messages in this file, then you forgot to configure one of the OpenACS files.
+  </P
+><P
+>   If anything goes wrong, it is easier to simply destroy the db ( command dropdb yourdb) and recreate it after you've reviewed your steps.
+  </P
+><P
+>   - Do a <I
+CLASS="EMPHASIS"
+>psql yourdb</I
+>. You should end up with a prompt after a couple of messages indicating that it has successfully connected with the database. Do a &#8220;\d&#8221; to see all the tables in your db. Once you're certain you can connect from the account via psql, you should have no problem connecting via AOLserver. [DRB]
+  </P
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN153"
+>5.6. Notes on PostgreSQL 7.1</A
+></H2
+><P
+>   The long-awaited 7.1 version of PostgreSQL, as usual, brings some exciting features and improvements like OUTER JOINs, optimizer improvements, fixes in PL/PgSQL, etc. The purpose of this section is to let you know what OpenACS 3.2.x items will behave differently under PG 7.1. This is what we know so far, if you find something else, please let us know.
+  </P
+><P
+></P
+><UL
+><LI
+><P
+>   In <I
+CLASS="EMPHASIS"
+>bookmarks.sql</I
+> you can comment the lines where the <I
+CLASS="EMPHASIS"
+>chr(int4)</I
+> function is declared, for PG 7.1 comes with an identical one (contributed by Krzysztof Kowalczyk).
+   </P
+></LI
+></UL
+></DIV
+></DIV
+><DIV
+CLASS="NAVFOOTER"
+><HR
+ALIGN="LEFT"
+WIDTH="100%"><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+><A
+HREF="x60.html"
+>Prev</A
+></TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+><A
+HREF="index.html"
+>Home</A
+></TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+><A
+HREF="x161.html"
+>Next</A
+></TD
+></TR
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>AOLserver/OpenNSD</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>Configuring OpenACS itself</TD
+></TR
+></TABLE
+></DIV
+></BODY
+></HTML
+>
\ No newline at end of file
Index: web/openacs/www/doc/openacs/pdf/getting-started.pdf
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/pdf/getting-started.pdf,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/pdf/getting-started.pdf	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,875 @@
+%PDF-1.2
+%����
+1 0 obj<</Producer(htmldoc 1.8.4 Copyright 1997-1999 Easy Software Products, All Rights Reserved.)/CreationDate(D:20010215062447Z)/Title( OpenACS Getting Started Guide )/Creator(Modular DocBook HTML Stylesheet Version 1.61\12)>>endobj
+2 0 obj<</Type/Encoding/Differences[ 32/space/exclam/quotedbl/numbersign/dollar/percent/ampersand/quotesingle/parenleft/parenright/asterisk/plus/comma/minus/period/slash/zero/one/two/three/four/five/six/seven/eight/nine/colon/semicolon/less/equal/greater/question/at/A/B/C/D/E/F/G/H/I/J/K/L/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/bracketleft/backslash/bracketright/asciicircum/underscore/grave/a/b/c/d/e/f/g/h/i/j/k/l/m/n/o/p/q/r/s/t/u/v/w/x/y/z/braceleft/bar/braceright/asciitilde 130/quotesinglbase/florin/quotedblbase/ellipsis/dagger/daggerdbl/circumflex/perthousand/Scaron/guilsinglleft/OE 145/quoteleft/quoteright/quotedblleft/quotedblright/bullet/endash/emdash/tilde/trademark/scaron/guilsinglright/oe 159/Ydieresis/space/exclamdown/cent/sterling/currency/yen/brokenbar/section/dieresis/copyright/ordfeminine/guillemotleft/logicalnot/hyphen/registered/macron/degree/plusminus/twosuperior/threesuperior/acute/mu/paragraph/periodcentered/cedilla/onesuperior/ordmasculine/guillemotright/onequarter/onehalf/threequarters/questiondown/Agrave/Aacute/Acircumflex/Atilde/Adieresis/Aring/AE/Ccedilla/Egrave/Eacute/Ecircumflex/Edieresis/Igrave/Iacute/Icircumflex/Idieresis/Eth/Ntilde/Ograve/Oacute/Ocircumflex/Otilde/Odieresis/multiply/Oslash/Ugrave/Uacute/Ucircumflex/Udieresis/Yacute/Thorn/germandbls/agrave/aacute/acircumflex/atilde/adieresis/aring/ae/ccedilla/egrave/eacute/ecircumflex/edieresis/igrave/iacute/icircumflex/idieresis/eth/ntilde/ograve/oacute/ocircumflex/otilde/odieresis/divide/oslash/ugrave/uacute/ucircumflex/udieresis/yacute/thorn/ydieresis]>>endobj
+3 0 obj<</Type/Font/Subtype/Type1/BaseFont/Courier/Encoding 2 0 R>>endobj
+4 0 obj<</Type/Font/Subtype/Type1/BaseFont/Times-Roman/Encoding 2 0 R>>endobj
+5 0 obj<</Type/Font/Subtype/Type1/BaseFont/Times-Bold/Encoding 2 0 R>>endobj
+6 0 obj<</Type/Font/Subtype/Type1/BaseFont/Times-Italic/Encoding 2 0 R>>endobj
+7 0 obj<</Type/Font/Subtype/Type1/BaseFont/Times-BoldItalic/Encoding 2 0 R>>endobj
+8 0 obj<</Type/Font/Subtype/Type1/BaseFont/Helvetica/Encoding 2 0 R>>endobj
+9 0 obj<</Type/Font/Subtype/Type1/BaseFont/Helvetica-Bold/Encoding 2 0 R>>endobj
+10 0 obj<</Type/Font/Subtype/Type1/BaseFont/Helvetica-BoldOblique/Encoding 2 0 R>>endobj
+11 0 obj<</Type/Font/Subtype/Type1/BaseFont/Symbol>>endobj
+12 0 obj<</S/URI/URI(x10.html)>>endobj
+13 0 obj<</Subtype/Link/Rect[119.0 488.1 160.9 501.1]/Border[0 0 0]/A 12 0 R>>endobj
+14 0 obj<</S/URI/URI(x10.html)>>endobj
+15 0 obj<</Subtype/Link/Rect[160.9 488.1 188.7 501.1]/Border[0 0 0]/A 14 0 R>>endobj
+16 0 obj<</S/URI/URI(x10.html)>>endobj
+17 0 obj<</Subtype/Link/Rect[188.7 488.1 211.6 501.1]/Border[0 0 0]/A 16 0 R>>endobj
+18 0 obj<</S/URI/URI(x10.html)>>endobj
+19 0 obj<</Subtype/Link/Rect[211.6 488.1 232.1 501.1]/Border[0 0 0]/A 18 0 R>>endobj
+20 0 obj<</S/URI/URI(x10.html)>>endobj
+21 0 obj<</Subtype/Link/Rect[232.1 488.1 263.2 501.1]/Border[0 0 0]/A 20 0 R>>endobj
+22 0 obj<</S/URI/URI(x18.html)>>endobj
+23 0 obj<</Subtype/Link/Rect[119.0 461.7 165.1 474.7]/Border[0 0 0]/A 22 0 R>>endobj
+24 0 obj<</S/URI/URI(x18.html)>>endobj
+25 0 obj<</Subtype/Link/Rect[165.1 461.7 193.9 474.7]/Border[0 0 0]/A 24 0 R>>endobj
+26 0 obj<</Subtype/Link/Rect[127.2 422.1 158.7 435.1]/Border[0 0 0]/Dest[229 0 R/XYZ null 770 0]>>endobj
+27 0 obj<</Subtype/Link/Rect[158.7 422.1 187.1 435.1]/Border[0 0 0]/Dest[229 0 R/XYZ null 770 0]>>endobj
+28 0 obj<</Subtype/Link/Rect[187.1 422.1 204.5 435.1]/Border[0 0 0]/Dest[229 0 R/XYZ null 770 0]>>endobj
+29 0 obj<</Subtype/Link/Rect[204.5 422.1 227.5 435.1]/Border[0 0 0]/Dest[229 0 R/XYZ null 770 0]>>endobj
+30 0 obj<</Subtype/Link/Rect[227.5 422.1 258.0 435.1]/Border[0 0 0]/Dest[229 0 R/XYZ null 770 0]>>endobj
+31 0 obj<</Subtype/Link/Rect[127.2 395.7 164.8 408.7]/Border[0 0 0]/Dest[229 0 R/XYZ null 592 0]>>endobj
+32 0 obj<</Subtype/Link/Rect[164.8 395.7 201.5 408.7]/Border[0 0 0]/Dest[229 0 R/XYZ null 592 0]>>endobj
+33 0 obj<</Subtype/Link/Rect[127.2 369.3 151.4 382.3]/Border[0 0 0]/Dest[229 0 R/XYZ null 494 0]>>endobj
+34 0 obj<</Subtype/Link/Rect[151.4 369.3 184.4 382.3]/Border[0 0 0]/Dest[229 0 R/XYZ null 494 0]>>endobj
+35 0 obj<</S/URI/URI(x43.html)>>endobj
+36 0 obj<</Subtype/Link/Rect[83.0 329.7 107.8 342.7]/Border[0 0 0]/A 35 0 R>>endobj
+37 0 obj<</S/URI/URI(x43.html)>>endobj
+38 0 obj<</Subtype/Link/Rect[107.8 329.7 127.0 342.7]/Border[0 0 0]/A 37 0 R>>endobj
+39 0 obj<</S/URI/URI(x43.html)>>endobj
+40 0 obj<</Subtype/Link/Rect[127.0 329.7 142.9 342.7]/Border[0 0 0]/A 39 0 R>>endobj
+41 0 obj<</Subtype/Link/Rect[91.2 290.1 126.4 303.1]/Border[0 0 0]/Dest[232 0 R/XYZ null 559 0]>>endobj
+42 0 obj<</Subtype/Link/Rect[126.4 290.1 176.2 303.1]/Border[0 0 0]/Dest[232 0 R/XYZ null 559 0]>>endobj
+43 0 obj<</Subtype/Link/Rect[176.2 290.1 195.4 303.1]/Border[0 0 0]/Dest[232 0 R/XYZ null 559 0]>>endobj
+44 0 obj<</Subtype/Link/Rect[195.4 290.1 238.2 303.1]/Border[0 0 0]/Dest[232 0 R/XYZ null 559 0]>>endobj
+45 0 obj<</Subtype/Link/Rect[91.2 263.7 145.3 276.7]/Border[0 0 0]/Dest[235 0 R/XYZ null 793 0]>>endobj
+46 0 obj<</Subtype/Link/Rect[145.3 263.7 169.5 276.7]/Border[0 0 0]/Dest[235 0 R/XYZ null 793 0]>>endobj
+47 0 obj<</Subtype/Link/Rect[169.5 263.7 187.8 276.7]/Border[0 0 0]/Dest[235 0 R/XYZ null 793 0]>>endobj
+48 0 obj<</Subtype/Link/Rect[91.2 237.3 136.5 250.3]/Border[0 0 0]/Dest[235 0 R/XYZ null 549 0]>>endobj
+49 0 obj<</Subtype/Link/Rect[91.2 210.9 137.4 223.9]/Border[0 0 0]/Dest[235 0 R/XYZ null 253 0]>>endobj
+50 0 obj<</Subtype/Link/Rect[137.4 210.9 190.3 223.9]/Border[0 0 0]/Dest[235 0 R/XYZ null 253 0]>>endobj
+51 0 obj<</Subtype/Link/Rect[190.3 210.9 223.6 223.9]/Border[0 0 0]/Dest[235 0 R/XYZ null 253 0]>>endobj
+52 0 obj<</Subtype/Link/Rect[223.6 210.9 249.2 223.9]/Border[0 0 0]/Dest[235 0 R/XYZ null 253 0]>>endobj
+53 0 obj<</S/URI/URI(x99.html)>>endobj
+54 0 obj<</Subtype/Link/Rect[83.0 184.5 123.0 197.5]/Border[0 0 0]/A 53 0 R>>endobj
+55 0 obj<</S/URI/URI(x99.html)>>endobj
+56 0 obj<</Subtype/Link/Rect[123.0 184.5 141.7 197.5]/Border[0 0 0]/A 55 0 R>>endobj
+57 0 obj<</S/URI/URI(x99.html)>>endobj
+58 0 obj<</Subtype/Link/Rect[141.7 184.5 165.2 197.5]/Border[0 0 0]/A 57 0 R>>endobj
+59 0 obj<</S/URI/URI(x99.html)>>endobj
+60 0 obj<</Subtype/Link/Rect[165.2 184.5 186.9 197.5]/Border[0 0 0]/A 59 0 R>>endobj
+61 0 obj<</S/URI/URI(x99.html)>>endobj
+62 0 obj<</Subtype/Link/Rect[186.9 184.5 218.7 197.5]/Border[0 0 0]/A 61 0 R>>endobj
+63 0 obj<</Subtype/Link/Rect[91.2 144.9 110.5 157.9]/Border[0 0 0]/Dest[241 0 R/XYZ null 770 0]>>endobj
+64 0 obj<</Subtype/Link/Rect[110.5 144.9 147.2 157.9]/Border[0 0 0]/Dest[241 0 R/XYZ null 770 0]>>endobj
+65 0 obj<</Subtype/Link/Rect[91.2 118.5 110.5 131.5]/Border[0 0 0]/Dest[241 0 R/XYZ null 302 0]>>endobj
+66 0 obj<</Subtype/Link/Rect[110.5 118.5 117.1 131.5]/Border[0 0 0]/Dest[241 0 R/XYZ null 302 0]>>endobj
+67 0 obj<</Subtype/Link/Rect[117.1 118.5 154.1 131.5]/Border[0 0 0]/Dest[241 0 R/XYZ null 302 0]>>endobj
+68 0 obj<</Subtype/Link/Rect[154.1 118.5 187.7 131.5]/Border[0 0 0]/Dest[241 0 R/XYZ null 302 0]>>endobj
+69 0 obj<</Subtype/Link/Rect[187.7 118.5 197.0 131.5]/Border[0 0 0]/Dest[241 0 R/XYZ null 302 0]>>endobj
+70 0 obj<</Subtype/Link/Rect[197.0 118.5 239.8 131.5]/Border[0 0 0]/Dest[241 0 R/XYZ null 302 0]>>endobj
+71 0 obj<</Subtype/Link/Rect[91.2 92.1 126.4 105.1]/Border[0 0 0]/Dest[244 0 R/XYZ null 793 0]>>endobj
+72 0 obj<</Subtype/Link/Rect[126.4 92.1 143.2 105.1]/Border[0 0 0]/Dest[244 0 R/XYZ null 793 0]>>endobj
+73 0 obj<</Subtype/Link/Rect[143.2 92.1 168.3 105.1]/Border[0 0 0]/Dest[244 0 R/XYZ null 793 0]>>endobj
+74 0 obj<</S/URI/URI(x128.html)>>endobj
+75 0 obj<</Subtype/Link/Rect[83.0 65.7 121.2 78.7]/Border[0 0 0]/A 74 0 R>>endobj
+76 0 obj<</S/URI/URI(x128.html)>>endobj
+77 0 obj<</Subtype/Link/Rect[121.2 65.7 156.9 78.7]/Border[0 0 0]/A 76 0 R>>endobj
+78 0 obj<</S/URI/URI(x128.html)>>endobj
+79 0 obj<</Subtype/Link/Rect[156.9 65.7 191.5 78.7]/Border[0 0 0]/A 78 0 R>>endobj
+80 0 obj<</S/URI/URI(x128.html)>>endobj
+81 0 obj<</Subtype/Link/Rect[191.5 65.7 218.4 78.7]/Border[0 0 0]/A 80 0 R>>endobj
+82 0 obj[13 0 R
+15 0 R
+17 0 R
+19 0 R
+21 0 R
+23 0 R
+25 0 R
+26 0 R
+27 0 R
+28 0 R
+29 0 R
+30 0 R
+31 0 R
+32 0 R
+33 0 R
+34 0 R
+36 0 R
+38 0 R
+40 0 R
+41 0 R
+42 0 R
+43 0 R
+44 0 R
+45 0 R
+46 0 R
+47 0 R
+48 0 R
+49 0 R
+50 0 R
+51 0 R
+52 0 R
+54 0 R
+56 0 R
+58 0 R
+60 0 R
+62 0 R
+63 0 R
+64 0 R
+65 0 R
+66 0 R
+67 0 R
+68 0 R
+69 0 R
+70 0 R
+71 0 R
+72 0 R
+73 0 R
+75 0 R
+77 0 R
+79 0 R
+81 0 R
+]endobj
+83 0 obj<</S/URI/URI(x178.html)>>endobj
+84 0 obj<</Subtype/Link/Rect[83.0 718.8 167.3 731.8]/Border[0 0 0]/A 83 0 R>>endobj
+85 0 obj<</S/URI/URI(x10.html)>>endobj
+86 0 obj<</Subtype/Link/Rect[537.6 690.4 559.0 703.4]/Border[0 0 0]/A 85 0 R>>endobj
+87 0 obj<</S/URI/URI(index.html)>>endobj
+88 0 obj<</Subtype/Link/Rect[72.0 650.8 92.2 663.8]/Border[0 0 0]/A 87 0 R>>endobj
+89 0 obj<</S/URI/URI(x18.html)>>endobj
+90 0 obj<</Subtype/Link/Rect[537.6 650.8 559.0 663.8]/Border[0 0 0]/A 89 0 R>>endobj
+91 0 obj[84 0 R
+86 0 R
+88 0 R
+90 0 R
+]endobj
+92 0 obj<</S/URI/URI(http://www.arsdigita.com/pages/toolkit)>>endobj
+93 0 obj<</Subtype/Link/Rect[132.8 550.8 305.1 563.8]/Border[0 0 0]/A 92 0 R>>endobj
+94 0 obj<</S/URI/URI(http:/photo.net/wtr/thebook/)>>endobj
+95 0 obj<</Subtype/Link/Rect[110.5 498.0 139.5 511.0]/Border[0 0 0]/A 94 0 R>>endobj
+96 0 obj<</S/URI/URI(http:/photo.net/wtr/thebook/)>>endobj
+97 0 obj<</Subtype/Link/Rect[139.5 498.0 158.2 511.0]/Border[0 0 0]/A 96 0 R>>endobj
+98 0 obj<</S/URI/URI(http:/photo.net/wtr/thebook/)>>endobj
+99 0 obj<</Subtype/Link/Rect[158.2 498.0 188.6 511.0]/Border[0 0 0]/A 98 0 R>>endobj
+100 0 obj<</S/URI/URI(http:/photo.net/wtr/thebook/)>>endobj
+101 0 obj<</Subtype/Link/Rect[188.6 498.0 218.2 511.0]/Border[0 0 0]/A 100 0 R>>endobj
+102 0 obj<</S/URI/URI(http:/photo.net/wtr/thebook/)>>endobj
+103 0 obj<</Subtype/Link/Rect[218.2 498.0 229.5 511.0]/Border[0 0 0]/A 102 0 R>>endobj
+104 0 obj<</S/URI/URI(http:/photo.net/wtr/thebook/)>>endobj
+105 0 obj<</Subtype/Link/Rect[229.5 498.0 253.0 511.0]/Border[0 0 0]/A 104 0 R>>endobj
+106 0 obj<</S/URI/URI(http:/photo.net/wtr/thebook/)>>endobj
+107 0 obj<</Subtype/Link/Rect[253.0 498.0 300.1 511.0]/Border[0 0 0]/A 106 0 R>>endobj
+108 0 obj<</S/URI/URI(index.html)>>endobj
+109 0 obj<</Subtype/Link/Rect[72.0 469.6 92.2 482.6]/Border[0 0 0]/A 108 0 R>>endobj
+110 0 obj<</S/URI/URI(index.html)>>endobj
+111 0 obj<</Subtype/Link/Rect[302.1 469.6 328.9 482.6]/Border[0 0 0]/A 110 0 R>>endobj
+112 0 obj<</S/URI/URI(x18.html)>>endobj
+113 0 obj<</Subtype/Link/Rect[537.6 469.6 559.0 482.6]/Border[0 0 0]/A 112 0 R>>endobj
+114 0 obj<</S/URI/URI(x10.html)>>endobj
+115 0 obj<</Subtype/Link/Rect[72.0 430.0 92.2 443.0]/Border[0 0 0]/A 114 0 R>>endobj
+116 0 obj<</S/URI/URI(x43.html)>>endobj
+117 0 obj<</Subtype/Link/Rect[537.6 430.0 559.0 443.0]/Border[0 0 0]/A 116 0 R>>endobj
+118 0 obj[93 0 R
+95 0 R
+97 0 R
+99 0 R
+101 0 R
+103 0 R
+105 0 R
+107 0 R
+109 0 R
+111 0 R
+113 0 R
+115 0 R
+117 0 R
+]endobj
+119 0 obj<</S/URI/URI(x10.html)>>endobj
+120 0 obj<</Subtype/Link/Rect[72.0 148.6 92.2 161.6]/Border[0 0 0]/A 119 0 R>>endobj
+121 0 obj<</S/URI/URI(index.html)>>endobj
+122 0 obj<</Subtype/Link/Rect[302.1 148.6 328.9 161.6]/Border[0 0 0]/A 121 0 R>>endobj
+123 0 obj<</S/URI/URI(x43.html)>>endobj
+124 0 obj<</Subtype/Link/Rect[537.6 148.6 559.0 161.6]/Border[0 0 0]/A 123 0 R>>endobj
+125 0 obj<</S/URI/URI(x18.html)>>endobj
+126 0 obj<</Subtype/Link/Rect[72.0 109.0 92.2 122.0]/Border[0 0 0]/A 125 0 R>>endobj
+127 0 obj<</S/URI/URI(x99.html)>>endobj
+128 0 obj<</Subtype/Link/Rect[537.6 109.0 559.0 122.0]/Border[0 0 0]/A 127 0 R>>endobj
+129 0 obj[120 0 R
+122 0 R
+124 0 R
+126 0 R
+128 0 R
+]endobj
+130 0 obj<</Subtype/Link/Rect[242.8 511.2 242.8 513.2]/Border[0 0 0]/Dest[238 0 R/XYZ null 679 0]>>endobj
+131 0 obj<</Subtype/Link/Rect[242.8 511.2 255.6 524.2]/Border[0 0 0]/Dest[238 0 R/XYZ null 679 0]>>endobj
+132 0 obj[130 0 R
+131 0 R
+]endobj
+133 0 obj<</S/URI/URI(http://developer.arsdigita.com/doc/acs-templating)>>endobj
+134 0 obj<</Subtype/Link/Rect[289.8 692.4 511.1 705.4]/Border[0 0 0]/A 133 0 R>>endobj
+135 0 obj<</Subtype/Link/Rect[74.0 634.3 74.0 636.3]/Border[0 0 0]/Dest[232 0 R/XYZ null 556 0]>>endobj
+136 0 obj<</Subtype/Link/Rect[74.0 634.3 86.8 647.3]/Border[0 0 0]/Dest[232 0 R/XYZ null 556 0]>>endobj
+137 0 obj<</S/URI/URI(x18.html)>>endobj
+138 0 obj<</Subtype/Link/Rect[72.0 588.7 92.2 601.7]/Border[0 0 0]/A 137 0 R>>endobj
+139 0 obj<</S/URI/URI(index.html)>>endobj
+140 0 obj<</Subtype/Link/Rect[302.1 588.7 328.9 601.7]/Border[0 0 0]/A 139 0 R>>endobj
+141 0 obj<</S/URI/URI(x99.html)>>endobj
+142 0 obj<</Subtype/Link/Rect[537.6 588.7 559.0 601.7]/Border[0 0 0]/A 141 0 R>>endobj
+143 0 obj<</S/URI/URI(x43.html)>>endobj
+144 0 obj<</Subtype/Link/Rect[72.0 549.1 92.2 562.1]/Border[0 0 0]/A 143 0 R>>endobj
+145 0 obj<</S/URI/URI(x128.html)>>endobj
+146 0 obj<</Subtype/Link/Rect[537.6 549.1 559.0 562.1]/Border[0 0 0]/A 145 0 R>>endobj
+147 0 obj[134 0 R
+135 0 R
+136 0 R
+138 0 R
+140 0 R
+142 0 R
+144 0 R
+146 0 R
+]endobj
+148 0 obj<</S/URI/URI(x43.html)>>endobj
+149 0 obj<</Subtype/Link/Rect[72.0 631.6 92.2 644.6]/Border[0 0 0]/A 148 0 R>>endobj
+150 0 obj<</S/URI/URI(index.html)>>endobj
+151 0 obj<</Subtype/Link/Rect[302.1 631.6 328.9 644.6]/Border[0 0 0]/A 150 0 R>>endobj
+152 0 obj<</S/URI/URI(x128.html)>>endobj
+153 0 obj<</Subtype/Link/Rect[537.6 631.6 559.0 644.6]/Border[0 0 0]/A 152 0 R>>endobj
+154 0 obj<</S/URI/URI(x99.html)>>endobj
+155 0 obj<</Subtype/Link/Rect[72.0 592.0 92.2 605.0]/Border[0 0 0]/A 154 0 R>>endobj
+156 0 obj<</S/URI/URI(x178.html)>>endobj
+157 0 obj<</Subtype/Link/Rect[537.6 592.0 559.0 605.0]/Border[0 0 0]/A 156 0 R>>endobj
+158 0 obj[149 0 R
+151 0 R
+153 0 R
+155 0 R
+157 0 R
+]endobj
+159 0 obj<</S/URI/URI(http://www.arsdigita.com/doc/intranet)>>endobj
+160 0 obj<</Subtype/Link/Rect[353.1 577.2 396.5 590.2]/Border[0 0 0]/A 159 0 R>>endobj
+161 0 obj<</S/URI/URI(http://openacs.org/bboard/q-and-a-fetch-msg.tcl?msg_id=0000RV)>>endobj
+162 0 obj<</Subtype/Link/Rect[356.3 511.2 363.9 524.2]/Border[0 0 0]/A 161 0 R>>endobj
+163 0 obj<</S/URI/URI(http://openacs.org/bboard/q-and-a-fetch-msg.tcl?msg_id=0000RV)>>endobj
+164 0 obj<</Subtype/Link/Rect[363.9 511.2 387.8 524.2]/Border[0 0 0]/A 163 0 R>>endobj
+165 0 obj<</S/URI/URI(PortalHeapMemoryError)>>endobj
+166 0 obj<</Subtype/Link/Rect[72.0 498.0 276.3 511.0]/Border[0 0 0]/A 165 0 R>>endobj
+167 0 obj[160 0 R
+162 0 R
+164 0 R
+166 0 R
+]endobj
+168 0 obj<</S/URI/URI(http://www.openacs.org/doc/calendar)>>endobj
+169 0 obj<</Subtype/Link/Rect[382.6 244.2 448.0 257.2]/Border[0 0 0]/A 168 0 R>>endobj
+170 0 obj<</S/URI/URI(x99.html)>>endobj
+171 0 obj<</Subtype/Link/Rect[72.0 57.4 92.2 70.4]/Border[0 0 0]/A 170 0 R>>endobj
+172 0 obj<</S/URI/URI(index.html)>>endobj
+173 0 obj<</Subtype/Link/Rect[302.1 57.4 328.9 70.4]/Border[0 0 0]/A 172 0 R>>endobj
+174 0 obj<</S/URI/URI(x178.html)>>endobj
+175 0 obj<</Subtype/Link/Rect[537.6 57.4 559.0 70.4]/Border[0 0 0]/A 174 0 R>>endobj
+176 0 obj[169 0 R
+171 0 R
+173 0 R
+175 0 R
+]endobj
+177 0 obj<</S/URI/URI(x128.html)>>endobj
+178 0 obj<</Subtype/Link/Rect[72.0 692.4 92.2 705.4]/Border[0 0 0]/A 177 0 R>>endobj
+179 0 obj[178 0 R
+]endobj
+180 0 obj<</S/URI/URI(x128.html)>>endobj
+181 0 obj<</Subtype/Link/Rect[72.0 588.4 92.2 601.4]/Border[0 0 0]/A 180 0 R>>endobj
+182 0 obj<</S/URI/URI(index.html)>>endobj
+183 0 obj<</Subtype/Link/Rect[302.1 588.4 328.9 601.4]/Border[0 0 0]/A 182 0 R>>endobj
+184 0 obj[181 0 R
+183 0 R
+]endobj
+185 0 obj<</Dests 186 0 R>>endobj
+186 0 obj<</Kids[187 0 R]>>endobj
+187 0 obj<</Limits[(aen10)(x99.html)]/Names[(aen10)188 0 R(aen101)189 0 R(aen119)190 0 R(aen124)191 0 R(aen128)192 0 R(aen178)193 0 R(aen18)194 0 R(aen2)195 0 R(aen20)196 0 R(aen28)197 0 R(aen32)198 0 R(aen4)199 0 R(aen43)200 0 R(aen57)201 0 R(aen59)202 0 R(aen7)203 0 R(aen71)204 0 R(aen81)205 0 R(aen93)206 0 R(aen99)207 0 R(ftn.aen57)208 0 R(index.html)209 0 R(x10.html)210 0 R(x128.html)211 0 R(x178.html)212 0 R(x18.html)213 0 R(x43.html)214 0 R(x99.html)215 0 R]>>endobj
+188 0 obj<</D[223 0 R/XYZ null 812 null]>>endobj
+189 0 obj<</D[238 0 R/XYZ null 770 null]>>endobj
+190 0 obj<</D[238 0 R/XYZ null 302 null]>>endobj
+191 0 obj<</D[241 0 R/XYZ null 793 null]>>endobj
+192 0 obj<</D[247 0 R/XYZ null 812 null]>>endobj
+193 0 obj<</D[256 0 R/XYZ null 812 null]>>endobj
+194 0 obj<</D[226 0 R/XYZ null 812 null]>>endobj
+195 0 obj<</D[217 0 R/XYZ null 812 null]>>endobj
+196 0 obj<</D[226 0 R/XYZ null 770 null]>>endobj
+197 0 obj<</D[226 0 R/XYZ null 592 null]>>endobj
+198 0 obj<</D[226 0 R/XYZ null 494 null]>>endobj
+199 0 obj<</D[217 0 R/XYZ null 722 null]>>endobj
+200 0 obj<</D[229 0 R/XYZ null 812 null]>>endobj
+201 0 obj<</D[229 0 R/XYZ null 556 null]>>endobj
+202 0 obj<</D[229 0 R/XYZ null 559 null]>>endobj
+203 0 obj<</D[217 0 R/XYZ null 627 null]>>endobj
+204 0 obj<</D[232 0 R/XYZ null 793 null]>>endobj
+205 0 obj<</D[232 0 R/XYZ null 549 null]>>endobj
+206 0 obj<</D[232 0 R/XYZ null 253 null]>>endobj
+207 0 obj<</D[238 0 R/XYZ null 812 null]>>endobj
+208 0 obj<</D[235 0 R/XYZ null 679 null]>>endobj
+209 0 obj<</D[217 0 R/XYZ null 698 null]>>endobj
+210 0 obj<</D[220 0 R/XYZ null 643 null]>>endobj
+211 0 obj<</D[244 0 R/XYZ null 584 null]>>endobj
+212 0 obj<</D[253 0 R/XYZ null 684 null]>>endobj
+213 0 obj<</D[223 0 R/XYZ null 422 null]>>endobj
+214 0 obj<</D[226 0 R/XYZ null 101 null]>>endobj
+215 0 obj<</D[235 0 R/XYZ null 541 null]>>endobj
+216 0 obj<</Type/Pages/MediaBox[0 0 595 792]/Count 15/Kids[217 0 R
+220 0 R
+223 0 R
+226 0 R
+229 0 R
+232 0 R
+235 0 R
+238 0 R
+241 0 R
+244 0 R
+247 0 R
+250 0 R
+253 0 R
+256 0 R
+259 0 R
+]>>endobj
+217 0 obj<</Type/Page/Parent 216 0 R/Contents 218 0 R/Resources<</ProcSet[/PDF/Text/ImageB/ImageC/ImageI]/Font<</F8 8 0 R/F9 9 0 R>>>>>>endobj
+218 0 obj<</Length 219 0 R/Filter/FlateDecode>>stream
+x�][sܸr�R��P�I�C��G�`-�d�*���e�}K%�*�<�򘇓J���ȑ�� ��@�|�q'�v����}������������_��z�����o�Q7���������� Η��~�h|��������ǻ�/��������p�����ϟ~���O��=����ߛ�׷׷7����������pw8������������������o���ߧ�~�����p�������n���������7�{�y�9�����r�v�?�����k�{w���~<�.�A������������������r���?]}�v����n��x8߿\/� ���/<S_ k,��e1SU���!��ęj��♉@?���s�|�T���/ ���@��o����n�k��Cb��z��ڕyjZ���bn��ޞ��~��䕸N�uv�v�y�����?�<�������ܖߑ��f=�k�ܪjwp�+W?��2,�$� w}Ձ���J�=��Kȟ��gom��k�8�B��DL�81�3|�� �T�|�,u�(|�@[��
+*���ڀr���V*�n�xjV���jFA�۷�N^'�`�<9#����T`:��W����$ԣ�t�槭$��m���28��c
+6Ȓ�ݮ)�^G!�Z�q�&ڑ�AB+L�R�����g���#	�^�3II�kck�FC؊�^���z
+��*f���tZSd�����H4OÚ7MoU ڀ���֘)�'aXB��('4/(��63xT^� /�^�2���&��8�a��5�������մ�GLk�- ./�ԋ� R��q]��h�w�
+#Ӥd�M����d��Z�ICC��4QD�m�+��;5��V$\;�a�d�91���w���Du���b��b�}'����Ƥ�	�"Agp�IZF��܌�-���rAw}�'ӊ�U>R�}H��4��3�j��LL7M���V?_l��0����J¹�Fg[t��[�g�-��֯� �BQtrr1��i�{m0K{I�HX��E��R�$�鳚=
+�	�-�[	��b��L�2�[�`B�
++)2GXȑ�W
+Odcb*��hB�`a/�����B��N!�s�u]�4�C��A7r@�]��6��BZ!²1i	Ȉ����]LL��M/'Hh.�s��k�4��u7���Yh���&���	�C߯���A1���Xճ�qP��4�YT|��dcR�M�a��I��Aٜ�8n��8dV�M��Ϲ��sоSi��\L'a��b����0�j��0�N�<L�Q�Ak�.�I: ������IBOf�u1m��)w�G��W����V���`+�M>$����S�0��ј=IlA�h��<��ق�1�x銐Pd�~J`^�.E����W�R��$ݬs�n��tq1���$�I2���}1	�]X���xП�>�AWE���B 	�])Ҙ%c�Pb��dn%$L}���ryԱn���F���������[+��j01�јރf(�HO�H�r$m�r����:��5�>����tP���	��])�ҍ�_���)��M:m�����$tU����"��ۊ,��i$xkuOD�������x.�:k
+�@���{e��h�ʖ�M�MOž��/2��e"�{K
+N����2���*���E
+LyL�s*;i��!a�S��������>;��*c&�Pmy�,	h���s��weQ�a�c�L�kpi�&�w���J�Ж�̓`�Ϧ%�9͐�L�v�
+o��7�@U�PdB�3ԡH��/��<&$��HS��q��#��{��܎�l2,�Ʀ1;�dI�9)^<����ʡ-�		�I���	�(g!��uۡ`��&X�$���� �0��Y�z�@9��1�H0&�֦	{��b{�����,v;H�7��qUY��★݉��X��W9��1Ap�&@��$eI�M$j���r&	R(��J�䅵U��䥁4�*�诞�6���򘐑2B��%a��ȑ�uj���u��˄�g����;�W�A'�E�D�Ж�,'!0IY�0Rȓ�W`ɤ��3I2{j`����8����ʡ-�9��\�ȓ��֥=���
+"�5F�iQ�uӰ�
+5GSc�1�`�
+���m0�`�z�3����,	b�u���2E�&���	H=0fmZ�
+�J�������F�<RmyL�`a��ET�	�@���ф\����C�,�T"�5�u]N;߯B��xS��ЖDŽ<�!c���$���L��G��	���v�*B�
+��W�L���;p;��y���I���k���*)H/��+��v��!�%NԔ���+gU����$��/����1���|�ЖDŽt�i�)��Q	2�
+��
+
+S���{�7T2�}W��.��W�?s[9��M��rh�cB�sI�'��h���p!	W0V�{$��!��)L�3���
+f��ph�̜��ɑ����rh�c."M�ׄ��*��L]�;U���ېp^Η�1�EX�lE����j�],�K�I�*���b���|M0&)E�~j�Y(�
+	
+�gv@z���+�V�\��t���`LR\���Ԁ�(lz���ߨ�hฆd�iTW��m�e�C�@����w�-�xTu��$�������*\Ʃ�����{��k�#�-B9$Ώ��[���b�~�D+�39ەh��H�s?���b��țCS�?���n8�גi\�7)�\B���m$o4��p�tG��I�={�8t�Z�2�j���yll���h֭:��徭uD{G�}vX�3\Nv��
+bf�u�[��1j5v��h
+��@L�á��1��>�f�� ����r&Oܥ|��Mz�"�=�B�̸/FC��*.��6�����3<B��t�G��a����p㨅d��H��������N�g���b:�����ɲ<q% 9^��LF�F�����
+�@7�7"X��s�� YA�,X�cќT� ϹV��<�i�4��N3��u�R�n����{1�1^�G���"�uywD�4�I�:6��DS�N6\�|�m�5�$A#�;u�D���ȹA�Q��+B]�ia`&���6��S
+�8GP��)r��L!!h$D³�$(%��)�9Ổ����E!�Z�
+H��PZ{�����)���~���
+L��5`�1E���:�7Uq�{�vO�2ms�(ញ��P8\�E9��
+�Ϗ� A	�3��E��>֐��!%�P'�#�T�89��K�[��D����!���_aQP��N�荩�P^q���J,nH	���P�_�O&I��~/5�&�b���܄�1J'fy�<+CP�x���+����*���D��t�/��4��*&��O�0��1�!!�.gA
+[�Ua�-n�JLܒ�K��$j(}<��E=w$P��¥�)��b+�'��yG��LR9�oS@Wy}������#�bH�X�S^��r۠��!f:0�lR�ԋ
+�_��J���:�7�p�Y��Ww;���7J!aY7��R�a0�U�5��	����'�T�T�x_0m�nm�����(B�!���6a�0�|�~hIB�lDHPj�G��U��@��~��Ő_���
+}�H<C(�ܰQf]�ՄE-��&��Yi�	B�����%a	{t~
+T��rj�gə/^��c��k�"d�.J&?\�#>C¼�YI�l0�_�p_�	���xqzzz�f�HD�����)�傴��!g>@�,E�ٹ�����wZ#�ڍ몦g����=vH���WD��s�+Oߜ�D�|zA�A�Ii�ĥι���5�C�RJi�{'�vo�~����M+Xx����o�AW�1i�A��G`&�s���N/l4{�ː�7	�n��]d���:`BQ���l�0`��8�6���O4
+�X�yO7$��6o��*3�7��6t���ΐ��zr�b�/|z����
+jD���1�{e���4a�zOԓ`��6�E����&Ā�I,���d�T�֯�(���U���J���x���90���`��� m��%�1K#����ev|��&�.Ja�F���Bt	a�`K������_�%���S���z
+v��a�	|P!r	U�taG?�'Ҋ�P����*�~t�\���k��B�@�Bs`סi�uۖ9�"L��%�[m�ޟ�_\�9=���
+�.`�U!{͙��"��n!>�7j�򊰎+�.�w!�	�u�=ΠSD�=�q�Fd!����9�
+(�����Yp�_Br�XN�H�a7��Xɳ�R ���`FW�P@F�E7�*��Ě�#�WXe�(���������p7h#�0���~�
+мįt��6'}3R��9Q��WQ���JЀy�h�d@������2��zNI� ̒�|��5�B��o�<����3FU�$��)>֖V��9�����q��t��mD�tQb"LRN�>��&@��K0�VD�b���~j�i�Rg6���@��Ÿ��2z��{'i�$n�@�&�SD<�����	0�T@��O�/�0��fFE�Q���R	�L��V_)N�i0HG���pC�Ud������~��b���Q\�x���n6]�2kΠ9n��Wv9MRPФ�H��c�e�<��
+Fi�#�Du�'�6�d��i���mޱ�gNc�;��uѫڜ��}�4\�N�Œ̦�!%yj��`{㷵�W�`����p��%G���������y��7	�f��>���Z���/"M���H�8�/%i':��U�]��es�Lݙ�1��q{���p���\�:�T��y����6m�ȥ68������,��O���p�|��f>m���d5�B�S!�����T�I}��� ��b�
+Ta��d�Q�]b��Q0�l�D�X�^�d��UhH�����V=��|�}&+�s�I����`
+H*W]G��<D�Z#(_:y�Y\�0	�<�пA�w�~k���[b
+X�
+�e�d)���|0TQU��n'�yF]�dJ[h����y�U�I�$����RqQ�(����H7�$c��i ��n*RQ0=���-T��G��gTA�3�=u��_�ӊ����M3��`��-L��|SY���[�4p@6���k��r�ª�.#YV�W�e:�.hL%���g$aƾJ��h��+���؛`h��(ipVTj�ш*D��a���c9�2��`I fS��[�5�j#(�%�G���F��l�vH�l�dά1�YhT��1����,�id&�E*�0�	e~�����c$�d��W�_�*N�ZrG׺�r1�`������yI���t����ٺyXU�Hc5���.2�SG��O+�}(0�Lœs�~��Wf��Kuv�00�^϶Y
+�.xC���&���v���
+g'Qq6���<�W��@�X1���Kj�H@RB��흶�D�t¢7���)B����;B�̎��F����sD�����˨�p�����5��'���fA2���aD�a�6�I�)'�!�2��Kl����-��o��Z�'
+�v�O�2M�1r�\|= �A��2����."<�DCK�����\*����^��.S�\YN)��h�6yL���XVf�bڬ��չ���p�6
+�C�3�[�a���͎CW`����J�4͚5�W ���,:p��Su|O2�������J�'��x,	}CY�8�ťHP���"A8Y���hH��Y��	��fgbcS�$:��`;ܺ����y�i�i�7��i����DI���dM)2�4�Gt�?��f2��>��c"����c�దR�]Nm�7�}FMߑ$���	�`U�f���Iz��,٦!i���=�Q��hӭ�A��is$P�QV2��E�<\<౻J8O��	u��IN�C��n�b�655H�[�p�P�<v�T>�Z`c�(�(�h��� �_�#o��Α�gQ	cETa���q�Š�6	�I�E�VH�Z/	S%�)X��A���=v,�Nq/�9�Cb�FXp�f�'�L�^�a�z�E��.aA6�,(Bj	��#�`r�|�u[���qV2A�ޣ-��v�l�
+3l��@Z@�TG��!CO���s�Q�Y��	X@4�:���I��)I2
+�Qc-_�"��s��ڱH����(�I�1I���������fI�oNK����M�c�b����%IpX��������7���s���S��R�v�_�	ȫ���Mr�"��c(N7�7<�`�O��i\\����bm�*��K�"��AJ������by���8�$�0�ǚgKd��2l��]�PT.z��F�6i���FEp�[ܤ;�E8�
+�	+V)g
+�����c"7f�Eڙ~@�X(���#]$�B��{k����/��a�m�C�x�L,-�.�!K~�lłu����o�O��ߤ��~� #I��|'8�<>|�������>�d�lW�7��Խb�<~�{d�	�I�q��S4����J�`�v+Y��i����-W�t�%�AE�|[F1ۭ��D}/]�#�Lj��g����N2Ndt��î�6X/X@����d�T�~D���(��&��I�1kk+�X��(���%AB��G� v������
+@���刻Ǔv�∸��h�)?���:�	��J8`�=€4_�#b(䞤Y8��M�a�1��A�
+�me&Q�	+i���il痊6nN�g��z��d��҄MBbHh�H9��NOq���
+}͵i�	k9X�$}��"�e�Y��A�U�	X8�챤�N��M	54@��^2�B��N�̂��(4�W��ClO�L�#9��cI(�Q^Ѥw�I�=|=V�TN�Y0$|���"1�@o�	%al�$�N��cv�͂��p��jH����>Yj�����tL		�����	*"ts���s
+��sO���0�,�ւ���)����z�F7m��`2*ĥ�*Byo�����#�HǑ`�/��{�Yc$�*�L_��٩��|�M3�&��N�Q$�g�X|27U�#a����.�V/*��#�
+�G�nn���nKp0�z�!�y8�o=�� �"���ٚ�G�e
+5��G|_ꈆ��8���8	�:RL1/?���9Y�rۖ��2c:a?��lb�����S��a�$�����B���4����m��ΑHzFϋ���B,�ϒP ��æF$/����5؊� �_����e^�ً�/â�O�U�'�c�6�%Ҹ�92����H6�7@��i%E����e�Ցt,�������b�\�L�>{��6�[�I�BE�4$�u5�Iѓi�+]��|VZ�ѭ|=�E��֝~#A<9
+;25	>._�*r�K��!�4�g�7�]�F,W�V��3�܂��¬��<���(XM�����"p�KŸ��Kj���ۏ^@{4	��b���Ll4/���Y��(
+/��,%4�~��L�
+�µ}1F����^xA�Y�������r��
+������s
+��w�T0�TIS�4V025�3VI�P�/H�stVpO-)��KW.I,*IMQp/�LIU���r
+�
+���0��endstream
+endobj
+219 0 obj
+7634
+endobj
+220 0 obj<</Type/Page/Parent 216 0 R/Contents 221 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F4 4 0 R/F6 6 0 R/F7 7 0 R/F8 8 0 R/F9 9 0 R>>>>/Annots 82 0 R>>endobj
+221 0 obj<</Length 222 0 R/Filter/FlateDecode>>stream
+x�X�n�6}�W�c�*�_ޚ�&(Т��}P���%��ٯ�3e1��`�����p��/<r�ϣħ �m}q�������h�Ó8�����/���]у��l���y'EACY�/���]�y��0q"���݈N�􇨪�/��?��뫭3�#���˸?$�ӻ�̉y����	_9��ѓ�^�h/$�ڊC)�H��д�i%vn���R��/ySP){>{���n����8xH�v�
+���-Um�w��2/+�_�ۡ��e�6���F�_�;ѱ��I��p����[�voT6f�dZQ��+7�j���}��z���U�C�=sJ��*m�n�r�1~�fL��{��������ײWn���|S4����R�XE�	>���	ڍ�It!�0uG	��M%���m�H�J|d����o��q)�ǣ��������H�Q4�9�.5��Nb0��ߝo"�W*�a��؅EV���>�P.3���n����=����|��%��Al��k�UU��1����f�P-tX�C�'����^�^���'l�YeX�31OZ���r{^w��ZS�`'ƅ����W���<f6��E�3s�a��i"�|�ۊ7�ÑO��4F5��������^u��K�G��Q�J!��M�Y|�L��I�~^X�{�:����������ܓ>F&v�0h������A�Px���ja�!��W
+,7�����~�������vx9o����g�J6�zq�|FGcl�T5!��!�{*o� �(�Ѥ+&Gq]���m��/ԝ��~�e�eq-���zqr�ԉ`q����eI�A�4���e_MK3xg�ilL�q���4����oE�榼��I�4���j׶Rt�D�O�4������1�j�h,3�p+�63���p(�.rTG��ն��l��F�뻿H�{K9(�����8d����ˡA1����p�\�&�\�ON�0�f�gA��r���@��CK�
+2�_
+kg��b2�G�a+�@��$��?�ϣ��]W�K������z)jL����8�/��}y!�wT5��qa�Z��C[�*d��4����)P&��h�.��"�6���>��a�/��C޴�7�����v][�^�����L�1H]O-la��mC��-b4���y�:�l�20�o+١��o�ƕ�{B�!?�g��)�2�ֵf��1n�#�i���x��$h���Y|�Z�
+��>_�6��:Np������7�������vj\y��C<��ָC�	�ƱYݎ�%��"1EY�3SA:�s�=M���������X���N�mE��+_�yG�������˂u|V���͙���p$=us~��QS�d�)����F�YuB/G/%���T]��{��+�|���[��>�Q�w�2�������O���endstream
+endobj
+222 0 obj
+1433
+endobj
+223 0 obj<</Type/Page/Parent 216 0 R/Contents 224 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F4 4 0 R/F5 5 0 R/F6 6 0 R/F8 8 0 R>>>>/Annots 91 0 R>>endobj
+224 0 obj<</Length 225 0 R/Filter/FlateDecode>>stream
+x}R�v�0����bd������P��*�b���;	A�=B�3s��;��	����һM�����ss��A�0	Y%L$]����ϐR ]&e��ܤoC�f�i����N�U�J�MZ��rS&}cdDIL���F���.�Yd8-cq����)�P2��
+K�FN���+q\�S�vm�m�/B��ZW���]��E�-�
+,W�A�W}h�V�WͱȔ!ϤS�X2	g��wUM�0WZ��^6Z�0?�-�S�uVH;��؅6��}<���v�O�:����`��ίG����:;{�v��vyreg�@������ŮI(&l�+��g�j���endstream
+endobj
+225 0 obj
+344
+endobj
+226 0 obj<</Type/Page/Parent 216 0 R/Contents 227 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F4 4 0 R/F5 5 0 R/F8 8 0 R/F9 9 0 R>>>>/Annots 118 0 R>>endobj
+227 0 obj<</Length 228 0 R/Filter/FlateDecode>>stream
+x�V�n�6}�W̛S���V����[�7^ ��DI�%Q%)oܯ�J�^�N`X��Ù9��ߋ�B�Et��8������X~���6%~ɮ�`E��]ЦVݣ�*[=8zփ��ܒ��I���?��P�W�,H��_��n~ eI�ӺyT�JmHw��$�m�N9%�/b���H瞩�;iʡAX����[ɵ�q;x
+G���t���"�E�m�!ϥ�|�Z�$�0���m��,�8�e��VV�C��%9���Xh��5��r.�5g�p7��}#���!n>XY�2�z�i�'�;b��fb�����@���d�}�P���GO�g���O���[n
+(�)GԪ�q�sW���j$��ݥ�Z<1-��s$�b�Ղ8��M%:����;)��K��JZ/��"j�h�p'm}�@v'���V���3FY
+�ȝL�,�:�O*�M�=��
+���8iEՁ���q�
+�תQ=�);��4�=�pֹ�
+�%�&+��A�R�����u�` ����Րq��L�I���Yw�9�Q�U���m��YF��h�<#l0�"o%Xډg�Rh�#�[t��}h�Q�dL���_6ab�����ea��4J�li�A4�z����G���'��#��q:Sѻڹ��r���al�*���/{QI�����e�_�ҁtf���y߈���B����z��Ɲ�b��y��+�,�������zh�����P
+�~������݀q��Q6���IJ���e�Ԯm��Β����,`&l֗��I��'Y��kO��L�[Zg�ucZ��Z܃��9��F >�Q��ħ��^�s��5<��~"`�����es���Ĵgs�x��m#�al���/���a�!����p�_���KCu�~��+T�<��ܿ�e2�FI��%����q�d)O���%qa�0d9�a6�+|�"�xo�w~�'�8d���i����d��֯��ɒ���d#��>�)ٟX��9]��/o�y������ӌQ�Bq�U¤���Et͸�y��AX�[^~L����*I�x�50ǾY�,n'�I��o�s���X�������Q�9���Y=j�O�V�of{e9�Y��hI�!|�ً'��}�?��|endstream
+endobj
+228 0 obj
+1107
+endobj
+229 0 obj<</Type/Page/Parent 216 0 R/Contents 230 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F4 4 0 R/F5 5 0 R/F6 6 0 R/F8 8 0 R/F9 9 0 R>>>>/Annots 129 0 R>>endobj
+230 0 obj<</Length 231 0 R/Filter/FlateDecode>>stream
+x�W�n�8}�W�[R���N�om�d{�,�%��Ԓ����!%�Q7��6�mqng�������ft;�Ś�����jr��f�i�Ó��*��6��'�k#��O�(��ܻ��xr��ųc6⓳�>��ԈB:V�Ѵ�vVI�w�K��:��:Y�影T���ȗ��6y[I7b/�	M��;U���c5^�i�2؈s��,�Ω���L�z}�=[��&�0>�S�AƦ&���Zsp�&�'R�[�J��P�K+s(���r|P���Ϭ�ɛ.da��`y��r'�)G�ҸO�KW�yQU�+��h�'�<ks�x�x��]ҙ�(~<�^!���H�,
+^W�b/_a�a��\�=���P��Ɉ�3Mc�o���a����Ih[*G�/��Rx:�#'/_����Qc�E�B� �tj�����e~�:8	�Q	3$�,��מZ�KQArk�}��"B��(WVf�Vȯ���h�|5v��>�08?p��_�R��p�!4h�2�ᓙ�ki3���="l��đ&�==ob�&�������z�,5GT����1�(Q���,��
+��ޖ�㷯?Q�
+��Fcwa���ۢ��x�������4�*r�������b��� SV҈�:�2j�Q�Ze��Y/�����/p����dw�/Av��Dp�6�TVI셪x7���C�5U#k�AԚ�kѲP�dPʪy�⿵`��#ʠ�����]���˜�e���x<b��S��(�c�T\��]%_���HGP;B��g[	E89ԫ�'���0ȇ����5�!��Җ'4�J�V9e�Ѕ����)�%=�@qh!�kY"?N70A8�r��3������6�i2<��N_��WO�N��e�#L��`��#���r��k�Y��$��>8=cz��l��Z�9Ā*�0ص�S�$��!����	J�(ʆ�]#3����� ���p�/�nx�a��L7�to1�7f��4f��/���J�/��jS:H��c\DL����Mp�n��i�	��a(��H{����x�Sa����3��`0�p��w�L�a-Au�I���՘���=��j�;zc8J�w����%U��NupF}q�ɀ�C�V������Φ�zl�0
+\z�_��б\n��4R���Td�l�Dt)G/����YTg(
+�(�㳔W�AXf�uyҒ�,a1A�aӁ�:\����u#�tם�>���@�.���n>0�΂�7�*UQb���5�,q��ZLE\�m��+nTh;f�–��X�&88i������4�v�Xb?]����`�`s��|{�X+ɚj�O�U�mx����ݳ%Nc����=����dv��Z'X�C��u�s�3�����z��}���W����_�K\N�B��8�<m����3�%b�K�B")�o�*͗˔+�{v�Jn���<�ᰓ���'�+��?���{�|
+�s�A���n��,�ޒ�,��s��Kל����L�{^�j��-�Pt�#������O�V��r�k�14 [�Qv�ᱼ����+�����o5�endstream
+endobj
+231 0 obj
+1560
+endobj
+232 0 obj<</Type/Page/Parent 216 0 R/Contents 233 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F0 3 0 R/F4 4 0 R/F6 6 0 R/F8 8 0 R/F9 9 0 R>>>>/Annots 132 0 R>>endobj
+233 0 obj<</Length 234 0 R/Filter/FlateDecode>>stream
+x��mo�H���S�*U	;��|-�
+4w'����E��^�{�^��n�!�;�Y;I(�@�흝����s�O=���$�����zѹXtz�tJ����&�pJ����)~���=�FQ�'>ޟ�����Vp
+��?0ѝϨ?�E
+�Ɠ.��AH�Z"Q&�J�?_���·��7�A4�,�Ȥ��,}���$h��T�jS�tIb�kG.S���h��N.��\�L�k�v�J`�*m��s��K<���}WNH8�ң�?h|�&:�ZVf����x��kaU,�|K[]S&n�M]ڈ-L�ЉJ�l�e��Y�c\2������k�ȕEܿ��hD�`�9+��ljl�H�G$�L�D'�R��4�!�+=V�N�?��������>���񷻚��r��c�a#���a�g6���DN�Hjq�-�k��A����طj���֘���:Yxw~��t��5�ZL�S`u�Tk�C�#{��O;�G�Tͥ`����Fu~�?��</�u|���9Ub--��Bm6�e{B
+�I���ڿ ��Tˤ6M����T�Ыʇ��]��!����\��s�C���t�)��@� S������C��tʡ��"��YW�Ӿ}v:�gYW�):��_��gL���<���T[��ӝ�hƵI)� �E:xʦ��3_ɛZzS��D�ׅ,�o)::�o>E�<��ڌ�W��^3���׺.J:�̫�-I�P9Y�.R%��i�EH�&۰�7�47ϛ�e�Dd�ڂfc��-�=HO%����ei�Y2�!A_[���6��&%��˸6F�u^˕0ˊ�z������c���/��Ɛ{�xl9��R��+;�
+X�H��q���%}8rE�ӫ-͕A�&�{�'�ӏt<�N�{Pц�U��b�h��c]<u�g�_�67����˛��
+)�	x��"�1(}`��6���Xo�]V����4cW�4��F�y���=!F���gwW��`�Q&�����~ ڟխ�� +�����`�Zk����,%ʊ�V�X���.4��;Z�7�˄���x��fcW82�w@���f-�����@��|�����A��r;�(U�D�(�T�λڝO�?��^8�`6m�舕aw����,��endstream
+endobj
+234 0 obj
+1122
+endobj
+235 0 obj<</Type/Page/Parent 216 0 R/Contents 236 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F4 4 0 R/F6 6 0 R/F8 8 0 R/F9 9 0 R>>>>>>endobj
+236 0 obj<</Length 237 0 R/Filter/FlateDecode>>stream
+x}W]o�F|���>�.$*�%�NҴ�:���EU'�(^L�1����wv��)�	�"��������r0������c:YPZ�Z�ޞ��Y�9�-���2;<I�z���*�����{
+j㏖�q�������x����Z���WT(O�U��`JvT7.�Y�hO�Q�˚v�M��jr9�BWd<EË��ʮ�1>��ڇ]��|��!�3����wOi:G�MH˙ʦr2�?��������	=慣�TY�������֔%�5�[eJ�.5审�#[��FPR6�����F��ޅQhbC���;�\�V���b2*��P4��� y�o����qr}��rG[6�2�7�*ԅ-��G8�g���gu��yF.~���k���j�uskR����[ҙ	d��x���IpZj��̣��hZ��2��ի�g��ߵ ���7���	-��;T��w�J�卫�\R�Q�>���8Ж��_��]ă�C�lz�E���Y���l�a��0��d�wU�En �p��>I��g��_2�PU5Z���$������_o�C�?J}0YjD�\P���<��zQ\���P̤	�7�VKH�CLy�����Q���#>������K�:5���وR<���V1��9|��L�46wc�����Tݨ:SH���z�xwJ���p=��A5a�#V
+	����8���;�w����U]����n��$�P�]8��B��DãA,]t	��u:4ь�
+�G�
+�� �-e��f���*���Rް�v@(��P���W��^f��%��A_}��ԁ���هY�c!��DJ8;��Kx����0N!�m�u������2db���=�8
+�D^{���[=pL�|�-R�^����G]�r��
+<���`�1�[$ҏ��LB56�)�Y�w������kV�4#+�;��G�8s�Ψ��� ��u9����"^=��Θ%��W��3�JX��5حм{4Q����9��(�Œ���C��"ky�Nȷ(v��I���������k
+4J[�A
+Sg���mw6re�ݽ
+IAN�xjӨ]1{i����}z@�x��|��
+�wMh7-�<�������5k�C*M]�q����i���Ơ/YU�V�KM�T#">dl����[�`Pߪ��^�ِ��io6�73B��,P���C��%�M�7/�%+5��]U��*�h�v�߁��+�y��F�j��4�U7r�Һ�պ���>b2�{�>̝l�S��(#_�j�s�]�L����턘3PL�����9<�*���($�:<���Ʊ��;����4��ƿ1T?;����s��|y�:b_����gyy�}!�(*N��m��M�.�/خ�vE�[16-�L�p�`v٨�����j<J'Td��B�|���ٴo@;�b�^Q~vY�Cgb%��5"�=[9�v,Ĝ����r�|�R��pb"�၉�\+�K�S�R��
+��&��I
+Ft�9�$C�F~�;��Ěr�	�n�-<�Տ8�%.����Ǝ{�W>bю�@KD(��`I�*���1�����=��0.��<���VV�owkC�I
+w[޸���d��4@^תᵄ�"�8y�8�X|�������sZ�Xċ�����F�M@�iyc�xO�g�M�?�܂��<�p�?����endstream
+endobj
+237 0 obj
+1674
+endobj
+238 0 obj<</Type/Page/Parent 216 0 R/Contents 239 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F4 4 0 R/F5 5 0 R/F8 8 0 R/F9 9 0 R>>>>/Annots 147 0 R>>endobj
+239 0 obj<</Length 240 0 R/Filter/FlateDecode>>stream
+x}T���0����.w�j����l<�"�6
+!���;���������ܹ��$�
+>�($�1䕳�o��p'^Gd
+Y�z�)��p�g�B��w�>�ԠUY@e��~�A+xY��Z悼�~8�3�'>V35��4A��%$�
+�0%�F%�
+d�ָ���r^�A�XJ�d}PmŵT5�g�#����lH�Լ*�auҺy�y�8�R5�%��
+y���\U^�r�睫EՔ�\/qD�3h�)А�WnHIb�>*-����,MI������{E��3�W@M'ƃ�9�~"��uľ�5��W�����8���7�����0��	20,���
+�HQ7��щ1�K�dG�KO�8/�#�qfd��:�	샪�]�(f$��FM<��(~�ێ�c����F�o���̇��q�7�#H����?��-q9���w8��5ޖ�{�R�vti�Tf'�I�k�jQ����}�Copj�ܛ!�ۛex�K��9�b��o��5��"S����x�+5�����nx�����j��E[�Cj�w��N�'�/��/�endstream
+endobj
+240 0 obj
+551
+endobj
+241 0 obj<</Type/Page/Parent 216 0 R/Contents 242 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F4 4 0 R/F6 6 0 R/F8 8 0 R/F9 9 0 R/Fb 10 0 R/Fc 11 0 R>>>>>>endobj
+242 0 obj<</Length 243 0 R/Filter/FlateDecode>>stream
+x�W]o�6|�������-
+`�E��P�(��X�����;CJg[�C� H�D�.gwfv��d%o�k%Wgr~)�9y�>y��FV7�.������L���b)� ��һF>������j�%�{���'�s���+#G�����Z
+�]./�&_j�)�t^ug۝l���r}]��H0u�0]�Z�?��ވ��`�W���ʚ ׋V���,����}�����<^>䴶������qE���r{Z�R��D��9H���ko#2ۦ��/���]#���fyIx���+y�
+�:ރ�t���С����z����}~w�QV�WR�p�|�p�,��$l��lk�R�����P�
+=2�MiT���]k���xbe}�$|�C��h<�����Xe�X>4�$Ӯ;�^z�:>���ށ4�"3śƱ�ƃEAl��N�h]���F#_?�tkУ�:�@Npo�����ʑ;HY�M�R��������F>|��V-�0�Tf��T���b#��{�G�F���H�Z��軔v�"�������5��M�Р"kt��$1BֈY�ں{tԨv���jr֕�;*�p]e����H7��(�M'��!1>Q
+8�¾?�g�H� �-���V�Υ�췉^D�]�v����k�F�yVLp����P+B4��+�a�
+�=��n�;��F���d�d��BZ��N[FJL�:j#{�R>���S p�;-��������o�1
+�J0!�	���{U���7�AJ���m�ӇiSn�T�S���<JhD�'��z���9�X�x��w9��������O�$��2�$E%GMG���F�̷����YXo4���-���R@p�������M��g)�eB3I��F�I^��� E�J�v����2���í�[t�D������
+A�`qM����W�����ӈh��,dL����'O@x:�25�mi?FM^�G�p�Q��RZ`�W	gm�|f��?~˖
+�xRѣ��wz���Z=��Zcvko���Jv���YIL�A'�::xN�Q{�fWk�P{�XeVS�Җ6�Ĩ`Q��J�f+�����iw6���~��:O��#$H�M�h@W�I�"���hkPy�I�����-hl�!*�;A|	��2�P��챘5d���p�% {����f�*�A��º�X0����/�k��89�ݺ��!=�i�IPǒb1Ӝ��[9G/��`+��Ț����LfI���I\M1��5Q;	���o�g�כ��{�i{|iv�t�7H��÷$��1f��m�`�䣣#=Iz�q�^�hq΄�4>��E8P�l#�C��(�$�+��<@�����VajQ7�M��#�Q����4l,�:�ƻ²�X�ح'W��Ώ�y�%�*
+˝�']���4Z"�)��� L�m�ΥU��}�1��X���&?\��o��r]h!��}M�Or'�V(���{��=�2u��Cm���3�e�N��$m[`fb�(�9P�5sX@��?L0ҏ�nS��
+��c��*��|bW���x�>�d�I}l��ܰ @0f?�q_�0�2U���T���m�����O�r��jp-5/��p{�ݍ������l��$� ��6�"�)Z��w�`h�~��W`)D������(��&
+���w�<q�sŰ]M�B�0L�� ��ai��~�������v�s��O�:����endstream
+endobj
+243 0 obj
+1729
+endobj
+244 0 obj<</Type/Page/Parent 216 0 R/Contents 245 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F0 3 0 R/F4 4 0 R/F8 8 0 R/F9 9 0 R>>>>>>endobj
+245 0 obj<</Length 246 0 R/Filter/FlateDecode>>stream
+x�W[S�F~�W��=��16}J:�ʹI[��g-��-�V�pL&���YI`	'Ц-���>{n�w.��P�:��t��t��t�����b��ҧ�/���8<�Q�$����+�z�_ �{;���pL��N'4�N���E�'��QB62*w/���ޞ�`P
+
+G�	���F�[d�+�8ͅ�1��J�MR�ߝ��5�?��,�U��tC���T�k�D�(���L$l�OG�c�V9yH�\�8�N�0�.�Â6��G�k��Ұ��jc�Rnt$�?�Z�l�y��+�ۖ�x���	Kk�$��|�[��n.#��Xz�cy+��QJt$JE�R\]�T�"���!�V��'�MXf�O�nAC:�0;�zG���
+�$UF%�"�L-W���6�9������2g�R���Z#�+���J6U&�!E�(��[Y%B���J��z�8��b�>Å��&�9�������#Q#�Od$B�C���O!شJgg�p9.s0�_�>~��9��$`3�>.��LO�.
+l�8�Y����~��/T����7_�җ�FS�}:���a���J丛��V$r�|�ܲN$�p���l��H�k�
+kz��|io��\eA۬�א^�TB�b���_/��m�T���t��ސ����D^�R�X���3'gࡻ<�~���N����r��k��w�Y�@��ف�k��~&v���
+do2���I3�)����[�V}Ϻp"����#8�K����$\/`hx!��X'�Y_�1̛0h宥"_��"�Q�K�e|!���%�p(�/���bJ�.�gQНa�%�
+�Gß�sq�C8NW_I�{W`aK?Q��c����j�z��u˛����,�I!���Τ��q<J�5����o��tF�����4xd\a�f�_w3z+���e�h�;�Q��i!�-O��TG�<�Z
+w����@l���6��Vj۰��Ur��w �Rͭq��lVA��3�:n
+��Pw��'�{��F��~`}����0�Zfuhd��"VJ��Vu��Sڞ
+��Pާ��<��j9�a̓����V�TSy^`�ur�^�9s���v�a"�p�x.�J�����s���qq�Ó(�|l��U��"��a�]�"��3�������}���r)�NLP?=;��=�n�~�T�_bY��}
+F���6X�h���͌3;{Oͧ��_����2�T
+���u�]�܊�y�[������/�9�E�]�_�Rq����Θټ>i,R����[���z=�oETi{�-r�����/�Z�'�͝|b���P��x�0�OY�
+п����շ�m�Q$e�u�Q#�fT)����1������`��7���ß�ގ�����	�Ƨ�@�'��W?��;����9�x�xW(0��&ᄎN�}�0�#<����y{�endstream
+endobj
+246 0 obj
+1438
+endobj
+247 0 obj<</Type/Page/Parent 216 0 R/Contents 248 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F0 3 0 R/F4 4 0 R/F5 5 0 R/F8 8 0 R>>>>/Annots 158 0 R>>endobj
+248 0 obj<</Length 249 0 R/Filter/FlateDecode>>stream
+x��Oo�@��|�ר����v���v+U�s��Yl)ક���e��������̛�����`�㘇�$�;�&�ާ���h70�P��U���2��Q�zKuN�g�$�!�@�_��]��(�/�ǡ�=��V��J��g��#���ћ����snJ��^_$q�D��r���o��sx���
+n��\k\�ml��Zקf��j�q��cBK�8�y#Vs"t�t��
+�oK�T$2��!d�j*��H��"�a(t��)��|i�ϳ���F,�,y$S�Q��}hv��b�d96<�n��(p�n���2:��E@���#� ����y@V�(��LJ̼��9)�!�X�mV��,uߗ��>k{�c�/s��l!&����������V/��H]C3�qL6��1	��!9l��q��b�R#�I�#X�j�<_>�Dg�pi����_�X��S�]gn?�zO��	�endstream
+endobj
+249 0 obj
+464
+endobj
+250 0 obj<</Type/Page/Parent 216 0 R/Contents 251 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F0 3 0 R/F4 4 0 R/F6 6 0 R/F8 8 0 R/F9 9 0 R/Fc 11 0 R>>>>/Annots 167 0 R>>endobj
+251 0 obj<</Length 252 0 R/Filter/FlateDecode>>stream
+x�XMo�F��W�Q���dٲsi�4R$u�(����"�&���2�z�o��d�F�cJ�3og�̛�Ǔ�����K:���8�~s�zsr]^���R���r���r��z��i��|+���7W�����/��ђ6��<��ep�ԁ��L��]P.���&�/6��oV�X�;g�x��Mf<ycKj��ƙtI�=��Mꭉ�1!#��4T���L�x���V�`��s�&�t��n���Oi�8k�b{�k�߭f��JXɕK5��U�u�}gPwF��P�²�i��t��Q�?�+[�0R筡)�m�����j�����
+���~�N�G�0���:��Q��R%�O���o+]���x��v����uj%��N�8=L�l}H�Fȭ{@ ڕ�|iRT9$r�x؜*�<�ձB��0sd��wgi�ߐ�)��Dj�q�
+�i�2@H���Tj���B#���u��)�2��vN�!�O�-%�|���м'����
+-/т�WK�����*:��r��㵣����g�	L�5�$��(0�C�s��@;D���	O	�P3��3�v����/���G�A+�
+��a��q���!GE�sA V�>U&��s�,Ƕd�5���cx�2~�y\��G�k�k�Gy儫�ޞ�2��#"�(J���4P5��:+ʰ�Wb�����3Z�/$=˫Etս
+�Y��m�pt���_�x�n�dr8�)LHUU�gf=͒#�`��<���"���yYQ!ΞHr������$nʫ�3<Z��y��
+^.5�z9�7MU]��#����N�<�*��]��|cD?;��Nm��8����dhC�{�V��Ck�v�h*V�g��1]���!(�?��)hSȏ��(QA�w}g��k���
+����V#�\�S&��ݝ�:4���{v5*���@��k>���t�Ku��F��L��l>���l;g�}�ڦ�p��V0}?a@�N�&?�n^��>��H�����g�)��|��;Q\h���'�K��AM'�/�s��st%b!-���bE�.K$�e.��-/Q\����u�~y��*9�Y���D��ÑJ
+�Wql�M%B�r磍s�վ����=��~�XXl�Q|�<o�v��db]�B�+����?�B��;��dŠ�� hVth���P��s��b�O���t3W����h��)
+����j��񸕷K�*,o�68>m�m�)�Kh!��2���;�S�Dh��eM[����BZ��Q�(!�=;�^�^�^#P(�ڣ�X��X-Ƕl���kq�e�z��LTu{����}D�@��x�N#.�kT�3��~�㊩D��Ժ���o�u��si���6?��'\h��H��>N�?4=m����y֊����;u$��F���S��Jy�=�QW��5F��{�2s#�&�9<)	/��sD�f
+��,R�FR[�BB�!���Ly�1�ݰ)�[~gY�����ȥ*I;'s���!�x��F�(7%��fh��
+���0M��F�U��/�w��eG���YnR��@ne�W�;n�h��D�þ��b�f�tc�)��c����.����qh�
+�5<ZL�<��s�H�(1�9�L�	���I?�t�>�������L�X�U��!�q��'�3������;�	n����?aRf�0�I9�=]��8k��и��=㔮x"�A7W��݆��wHq�?�~C���,79`uКA�5�r2��	�LV6ˏ�ä�I�qk%V����M,�'��
+���M�wr��Kb|pf[��mxiR��_�\s�������s5t�]?���F���&
+�H��������endstream
+endobj
+252 0 obj
+1875
+endobj
+253 0 obj<</Type/Page/Parent 216 0 R/Contents 254 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F0 3 0 R/F4 4 0 R/F6 6 0 R/F8 8 0 R/Fc 11 0 R>>>>/Annots 176 0 R>>endobj
+254 0 obj<</Length 255 0 R/Filter/FlateDecode>>stream
+x�WQo�6~����q�X�eGvZC�4i�u�f�-@�Hg��$*$eǀ��(ٲ�&]�ɀ �w�������>��ׇ���´�Ǵ�~��y�1�/=�A������f�B�dg�"��e�<�3�!��4j�{~���c���@fu&0�01�*ME8�~m����׊s =�Ne&,�J��2T	�
+�ÂV����Y�g��Bچ�ƀ��"C���N0��+̴JA����6C}k�9x��k�oe>��$�7I�'b}�t��a�s��v0v���7�O�}1�N&Ү�)~o��ط^�/�֯��c���
+-<�5 �	��|o'�<�5d�"������)�S�Z�����N��
+H�2Vf�Z��<�5*����H���	�5�n�#�jen�Aj�PV���x�Mȼ��	���ZJ�����k�z��b��l@��w8z���������6��l^컰K��c��88'~&%A7{�<����Ay������A{��ė�����a�9k�J����#�℺�!p	�"P1�^��������J`䍩\��D��Y�3s�"�|��yùJ�Pɶ��NC�G�?�`�
+���X"i�����:�O�@*籅�ȜD��.A���p���Z*dƙ���W���>J�9z��C�]�V�>���`��Q��W���jx9J`…��'�>I�pN(�E��E�Y$4�L�JK��D���|�Q�*��A'�#9"�5��ڑ
+�3+�T��u�X����ʅ��\R@��TŇn����~"I���1Lc�-@���L�_�D�R$'L�_��B�JphC��o����@�s�mAxs]��*#z���1�S�y�C�E��g
+	)��#�\�.d��En�G; �5\H�P����"7H�?��(�Dr�����ePei;�U��p���8�!UQ��Wt�����Z�����&<aC�(�����XPrQ��@�bE�b���~J�
+�
+��X:fm�����GP�)R)Ow�h;��Lϕҋ��],�yIy�ͲӔ3�es����d�)Œ�!F�+0'1�����ў�Q����qm8�
+���_x�� ���n����u�n)�f���!��t�+69���H�(�Z�ެ���5�z^g�4��v�����⣖��)3^�`��e��j���>�Բ#�-u/��;���Ap��>瘝���%��('\i0���
+���x��������~��߭7(��endstream
+endobj
+255 0 obj
+1247
+endobj
+256 0 obj<</Type/Page/Parent 216 0 R/Contents 257 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F4 4 0 R/F5 5 0 R/F8 8 0 R>>>>/Annots 179 0 R>>endobj
+257 0 obj<</Length 258 0 R/Filter/FlateDecode>>stream
+x}P�n�0��+�� ��q�I�p�~ �H�Ĵ��5���Cey�g<;��8Z��Ԩz�/���9ʆ^�Q�AY���y���:*�4�x�m5���*�
+��t����0~^l���n�o�	)c��K���j��C��:�
+-
+w�����]m��O%K�������:�H�����;���Z�����d?��|9\�����.������2�ړE4�;�}�!��-�J
+� Z	\�v_���h�endstream
+endobj
+258 0 obj
+254
+endobj
+259 0 obj<</Type/Page/Parent 216 0 R/Contents 260 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F4 4 0 R/F8 8 0 R/F9 9 0 R>>>>/Annots 184 0 R>>endobj
+260 0 obj<</Length 261 0 R/Filter/FlateDecode>>stream
+x]R]o�0|�W�c+A��$���~p=	�Wx�k/�ñ9ǡ���:�V�������g�2��d��W��`��=ϐͰ��I5)�kuS%��{�>
+�-�dCs����Y�cGy���#yap w0��8����6�Bp;�@9�F&h�aG���?΃�����|�va^��Z�`��za�QG�Q6�2O��Րh�jB�����[b��Ҵ�pr��5%g����7x�a�֡9��-Y�"�~����Y̅�m3�R˝ �/Ĝ�Xx�:�R.[c�bN�J+1�/�j��-����� MR���+������M<`�b�bx[�e9fj�)W��*zz��[��,�ޯWO�8F���7�I��\V����L�����ɗ®7w��4s_�DĨ��,�˸�aٰ���U>�ˢժ�̋8�7�u~�<=o�L*��"�w"+�����ϑendstream
+endobj
+261 0 obj
+448
+endobj
+262 0 obj<</Type/Catalog/Pages 216 0 R/Names 185 0 R/PageLayout/SinglePage/OpenAction[220 0 R/XYZ null null null]/PageMode/FullScreen/PageLabels<</Nums[0<</P(title)>>1<</S/D>>]>>>>endobj
+xref
+0 263 
+0000000000 65535 f 
+0000000015 00000 n 
+0000000250 00000 n 
+0000001807 00000 n 
+0000001881 00000 n 
+0000001959 00000 n 
+0000002036 00000 n 
+0000002115 00000 n 
+0000002198 00000 n 
+0000002274 00000 n 
+0000002355 00000 n 
+0000002444 00000 n 
+0000002503 00000 n 
+0000002542 00000 n 
+0000002627 00000 n 
+0000002666 00000 n 
+0000002751 00000 n 
+0000002790 00000 n 
+0000002875 00000 n 
+0000002914 00000 n 
+0000002999 00000 n 
+0000003038 00000 n 
+0000003123 00000 n 
+0000003162 00000 n 
+0000003247 00000 n 
+0000003286 00000 n 
+0000003371 00000 n 
+0000003476 00000 n 
+0000003581 00000 n 
+0000003686 00000 n 
+0000003791 00000 n 
+0000003896 00000 n 
+0000004001 00000 n 
+0000004106 00000 n 
+0000004211 00000 n 
+0000004316 00000 n 
+0000004355 00000 n 
+0000004439 00000 n 
+0000004478 00000 n 
+0000004563 00000 n 
+0000004602 00000 n 
+0000004687 00000 n 
+0000004791 00000 n 
+0000004896 00000 n 
+0000005001 00000 n 
+0000005106 00000 n 
+0000005210 00000 n 
+0000005315 00000 n 
+0000005420 00000 n 
+0000005524 00000 n 
+0000005628 00000 n 
+0000005733 00000 n 
+0000005838 00000 n 
+0000005943 00000 n 
+0000005982 00000 n 
+0000006066 00000 n 
+0000006105 00000 n 
+0000006190 00000 n 
+0000006229 00000 n 
+0000006314 00000 n 
+0000006353 00000 n 
+0000006438 00000 n 
+0000006477 00000 n 
+0000006562 00000 n 
+0000006666 00000 n 
+0000006771 00000 n 
+0000006875 00000 n 
+0000006980 00000 n 
+0000007085 00000 n 
+0000007190 00000 n 
+0000007295 00000 n 
+0000007400 00000 n 
+0000007503 00000 n 
+0000007607 00000 n 
+0000007711 00000 n 
+0000007751 00000 n 
+0000007833 00000 n 
+0000007873 00000 n 
+0000007956 00000 n 
+0000007996 00000 n 
+0000008079 00000 n 
+0000008119 00000 n 
+0000008202 00000 n 
+0000008576 00000 n 
+0000008616 00000 n 
+0000008700 00000 n 
+0000008739 00000 n 
+0000008824 00000 n 
+0000008865 00000 n 
+0000008948 00000 n 
+0000008987 00000 n 
+0000009072 00000 n 
+0000009117 00000 n 
+0000009186 00000 n 
+0000009271 00000 n 
+0000009330 00000 n 
+0000009415 00000 n 
+0000009474 00000 n 
+0000009559 00000 n 
+0000009618 00000 n 
+0000009703 00000 n 
+0000009763 00000 n 
+0000009850 00000 n 
+0000009910 00000 n 
+0000009997 00000 n 
+0000010057 00000 n 
+0000010144 00000 n 
+0000010204 00000 n 
+0000010291 00000 n 
+0000010333 00000 n 
+0000010418 00000 n 
+0000010460 00000 n 
+0000010547 00000 n 
+0000010587 00000 n 
+0000010674 00000 n 
+0000010714 00000 n 
+0000010799 00000 n 
+0000010839 00000 n 
+0000010926 00000 n 
+0000011044 00000 n 
+0000011084 00000 n 
+0000011169 00000 n 
+0000011211 00000 n 
+0000011298 00000 n 
+0000011338 00000 n 
+0000011425 00000 n 
+0000011465 00000 n 
+0000011550 00000 n 
+0000011590 00000 n 
+0000011677 00000 n 
+0000011735 00000 n 
+0000011841 00000 n 
+0000011947 00000 n 
+0000011981 00000 n 
+0000012062 00000 n 
+0000012149 00000 n 
+0000012253 00000 n 
+0000012357 00000 n 
+0000012397 00000 n 
+0000012482 00000 n 
+0000012524 00000 n 
+0000012611 00000 n 
+0000012651 00000 n 
+0000012738 00000 n 
+0000012778 00000 n 
+0000012863 00000 n 
+0000012904 00000 n 
+0000012991 00000 n 
+0000013073 00000 n 
+0000013113 00000 n 
+0000013198 00000 n 
+0000013240 00000 n 
+0000013327 00000 n 
+0000013368 00000 n 
+0000013455 00000 n 
+0000013495 00000 n 
+0000013580 00000 n 
+0000013621 00000 n 
+0000013708 00000 n 
+0000013766 00000 n 
+0000013835 00000 n 
+0000013922 00000 n 
+0000014015 00000 n 
+0000014102 00000 n 
+0000014195 00000 n 
+0000014282 00000 n 
+0000014335 00000 n 
+0000014421 00000 n 
+0000014471 00000 n 
+0000014538 00000 n 
+0000014625 00000 n 
+0000014665 00000 n 
+0000014748 00000 n 
+0000014790 00000 n 
+0000014875 00000 n 
+0000014916 00000 n 
+0000015001 00000 n 
+0000015051 00000 n 
+0000015092 00000 n 
+0000015177 00000 n 
+0000015203 00000 n 
+0000015244 00000 n 
+0000015329 00000 n 
+0000015371 00000 n 
+0000015458 00000 n 
+0000015492 00000 n 
+0000015526 00000 n 
+0000015560 00000 n 
+0000016037 00000 n 
+0000016086 00000 n 
+0000016135 00000 n 
+0000016184 00000 n 
+0000016233 00000 n 
+0000016282 00000 n 
+0000016331 00000 n 
+0000016380 00000 n 
+0000016429 00000 n 
+0000016478 00000 n 
+0000016527 00000 n 
+0000016576 00000 n 
+0000016625 00000 n 
+0000016674 00000 n 
+0000016723 00000 n 
+0000016772 00000 n 
+0000016821 00000 n 
+0000016870 00000 n 
+0000016919 00000 n 
+0000016968 00000 n 
+0000017017 00000 n 
+0000017066 00000 n 
+0000017115 00000 n 
+0000017164 00000 n 
+0000017213 00000 n 
+0000017262 00000 n 
+0000017311 00000 n 
+0000017360 00000 n 
+0000017409 00000 n 
+0000017598 00000 n 
+0000017741 00000 n 
+0000025446 00000 n 
+0000025468 00000 n 
+0000025631 00000 n 
+0000027135 00000 n 
+0000027157 00000 n 
+0000027311 00000 n 
+0000027726 00000 n 
+0000027747 00000 n 
+0000027902 00000 n 
+0000029080 00000 n 
+0000029102 00000 n 
+0000029266 00000 n 
+0000030897 00000 n 
+0000030919 00000 n 
+0000031083 00000 n 
+0000032276 00000 n 
+0000032298 00000 n 
+0000032438 00000 n 
+0000034183 00000 n 
+0000034205 00000 n 
+0000034360 00000 n 
+0000034982 00000 n 
+0000035003 00000 n 
+0000035163 00000 n 
+0000036963 00000 n 
+0000036985 00000 n 
+0000037125 00000 n 
+0000038634 00000 n 
+0000038656 00000 n 
+0000038811 00000 n 
+0000039346 00000 n 
+0000039367 00000 n 
+0000039541 00000 n 
+0000041487 00000 n 
+0000041509 00000 n 
+0000041674 00000 n 
+0000042992 00000 n 
+0000043014 00000 n 
+0000043160 00000 n 
+0000043485 00000 n 
+0000043506 00000 n 
+0000043652 00000 n 
+0000044171 00000 n 
+0000044192 00000 n 
+trailer
+<</Size 263/Root 262 0 R/Info 1 0 R>>
+startxref
+44379
+%%EOF
Index: web/openacs/www/doc/openacs/pdf/openacs-install.pdf
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/pdf/openacs-install.pdf,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/pdf/openacs-install.pdf	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,1835 @@
+%PDF-1.2
+%����
+1 0 obj<</Producer(htmldoc 1.8.4 Copyright 1997-1999 Easy Software Products, All Rights Reserved.)/CreationDate(D:20010215050724Z)/Title( OpenACS Installation Guide )/Creator(Modular DocBook HTML Stylesheet Version 1.61\12)>>endobj
+2 0 obj<</Type/Encoding/Differences[ 32/space/exclam/quotedbl/numbersign/dollar/percent/ampersand/quotesingle/parenleft/parenright/asterisk/plus/comma/minus/period/slash/zero/one/two/three/four/five/six/seven/eight/nine/colon/semicolon/less/equal/greater/question/at/A/B/C/D/E/F/G/H/I/J/K/L/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/bracketleft/backslash/bracketright/asciicircum/underscore/grave/a/b/c/d/e/f/g/h/i/j/k/l/m/n/o/p/q/r/s/t/u/v/w/x/y/z/braceleft/bar/braceright/asciitilde 130/quotesinglbase/florin/quotedblbase/ellipsis/dagger/daggerdbl/circumflex/perthousand/Scaron/guilsinglleft/OE 145/quoteleft/quoteright/quotedblleft/quotedblright/bullet/endash/emdash/tilde/trademark/scaron/guilsinglright/oe 159/Ydieresis/space/exclamdown/cent/sterling/currency/yen/brokenbar/section/dieresis/copyright/ordfeminine/guillemotleft/logicalnot/hyphen/registered/macron/degree/plusminus/twosuperior/threesuperior/acute/mu/paragraph/periodcentered/cedilla/onesuperior/ordmasculine/guillemotright/onequarter/onehalf/threequarters/questiondown/Agrave/Aacute/Acircumflex/Atilde/Adieresis/Aring/AE/Ccedilla/Egrave/Eacute/Ecircumflex/Edieresis/Igrave/Iacute/Icircumflex/Idieresis/Eth/Ntilde/Ograve/Oacute/Ocircumflex/Otilde/Odieresis/multiply/Oslash/Ugrave/Uacute/Ucircumflex/Udieresis/Yacute/Thorn/germandbls/agrave/aacute/acircumflex/atilde/adieresis/aring/ae/ccedilla/egrave/eacute/ecircumflex/edieresis/igrave/iacute/icircumflex/idieresis/eth/ntilde/ograve/oacute/ocircumflex/otilde/odieresis/divide/oslash/ugrave/uacute/ucircumflex/udieresis/yacute/thorn/ydieresis]>>endobj
+3 0 obj<</Type/Font/Subtype/Type1/BaseFont/Courier/Encoding 2 0 R>>endobj
+4 0 obj<</Type/Font/Subtype/Type1/BaseFont/Times-Roman/Encoding 2 0 R>>endobj
+5 0 obj<</Type/Font/Subtype/Type1/BaseFont/Times-Bold/Encoding 2 0 R>>endobj
+6 0 obj<</Type/Font/Subtype/Type1/BaseFont/Times-Italic/Encoding 2 0 R>>endobj
+7 0 obj<</Type/Font/Subtype/Type1/BaseFont/Times-BoldItalic/Encoding 2 0 R>>endobj
+8 0 obj<</Type/Font/Subtype/Type1/BaseFont/Helvetica/Encoding 2 0 R>>endobj
+9 0 obj<</Type/Font/Subtype/Type1/BaseFont/Helvetica-Bold/Encoding 2 0 R>>endobj
+10 0 obj<</Type/Font/Subtype/Type1/BaseFont/Symbol>>endobj
+11 0 obj<</S/URI/URI(x11.html)>>endobj
+12 0 obj<</Subtype/Link/Rect[119.0 510.1 145.0 523.1]/Border[0 0 0]/A 11 0 R>>endobj
+13 0 obj<</S/URI/URI(x11.html)>>endobj
+14 0 obj<</Subtype/Link/Rect[145.0 510.1 155.1 523.1]/Border[0 0 0]/A 13 0 R>>endobj
+15 0 obj<</S/URI/URI(x11.html)>>endobj
+16 0 obj<</Subtype/Link/Rect[155.1 510.1 198.4 523.1]/Border[0 0 0]/A 15 0 R>>endobj
+17 0 obj<</S/URI/URI(x24.html)>>endobj
+18 0 obj<</Subtype/Link/Rect[119.0 483.7 145.0 496.7]/Border[0 0 0]/A 17 0 R>>endobj
+19 0 obj<</S/URI/URI(x24.html)>>endobj
+20 0 obj<</Subtype/Link/Rect[145.0 483.7 163.6 496.7]/Border[0 0 0]/A 19 0 R>>endobj
+21 0 obj<</S/URI/URI(x24.html)>>endobj
+22 0 obj<</Subtype/Link/Rect[163.6 483.7 187.1 496.7]/Border[0 0 0]/A 21 0 R>>endobj
+23 0 obj<</S/URI/URI(x24.html)>>endobj
+24 0 obj<</Subtype/Link/Rect[187.1 483.7 198.4 496.7]/Border[0 0 0]/A 23 0 R>>endobj
+25 0 obj<</S/URI/URI(x24.html)>>endobj
+26 0 obj<</Subtype/Link/Rect[198.4 483.7 216.5 496.7]/Border[0 0 0]/A 25 0 R>>endobj
+27 0 obj<</S/URI/URI(x24.html)>>endobj
+28 0 obj<</Subtype/Link/Rect[216.5 483.7 259.8 496.7]/Border[0 0 0]/A 27 0 R>>endobj
+29 0 obj<</S/URI/URI(x47.html)>>endobj
+30 0 obj<</Subtype/Link/Rect[119.0 457.3 154.8 470.3]/Border[0 0 0]/A 29 0 R>>endobj
+31 0 obj<</S/URI/URI(x47.html)>>endobj
+32 0 obj<</Subtype/Link/Rect[154.8 457.3 182.5 470.3]/Border[0 0 0]/A 31 0 R>>endobj
+33 0 obj<</S/URI/URI(x47.html)>>endobj
+34 0 obj<</Subtype/Link/Rect[182.5 457.3 193.9 470.3]/Border[0 0 0]/A 33 0 R>>endobj
+35 0 obj<</S/URI/URI(x47.html)>>endobj
+36 0 obj<</Subtype/Link/Rect[193.9 457.3 222.9 470.3]/Border[0 0 0]/A 35 0 R>>endobj
+37 0 obj<</S/URI/URI(x47.html)>>endobj
+38 0 obj<</Subtype/Link/Rect[222.9 457.3 236.9 470.3]/Border[0 0 0]/A 37 0 R>>endobj
+39 0 obj<</S/URI/URI(x60.html)>>endobj
+40 0 obj<</Subtype/Link/Rect[119.0 430.9 214.9 443.9]/Border[0 0 0]/A 39 0 R>>endobj
+41 0 obj<</Subtype/Link/Rect[127.2 391.3 172.2 404.3]/Border[0 0 0]/Dest[555 0 R/XYZ null 792 0]>>endobj
+42 0 obj<</Subtype/Link/Rect[172.2 391.3 220.4 404.3]/Border[0 0 0]/Dest[555 0 R/XYZ null 792 0]>>endobj
+43 0 obj<</Subtype/Link/Rect[127.2 364.9 183.8 377.9]/Border[0 0 0]/Dest[555 0 R/XYZ null 654 0]>>endobj
+44 0 obj<</Subtype/Link/Rect[183.8 364.9 232.1 377.9]/Border[0 0 0]/Dest[555 0 R/XYZ null 654 0]>>endobj
+45 0 obj<</Subtype/Link/Rect[127.2 338.5 162.4 351.5]/Border[0 0 0]/Dest[555 0 R/XYZ null 220 0]>>endobj
+46 0 obj<</Subtype/Link/Rect[162.4 338.5 194.2 351.5]/Border[0 0 0]/Dest[555 0 R/XYZ null 220 0]>>endobj
+47 0 obj<</Subtype/Link/Rect[194.2 338.5 208.2 351.5]/Border[0 0 0]/Dest[555 0 R/XYZ null 220 0]>>endobj
+48 0 obj<</S/URI/URI(x83.html)>>endobj
+49 0 obj<</Subtype/Link/Rect[83.0 298.9 136.8 311.9]/Border[0 0 0]/A 48 0 R>>endobj
+50 0 obj<</Subtype/Link/Rect[91.2 259.3 136.2 272.3]/Border[0 0 0]/Dest[561 0 R/XYZ null 792 0]>>endobj
+51 0 obj<</Subtype/Link/Rect[136.2 259.3 190.0 272.3]/Border[0 0 0]/Dest[561 0 R/XYZ null 792 0]>>endobj
+52 0 obj<</Subtype/Link/Rect[91.2 232.9 108.7 245.9]/Border[0 0 0]/Dest[561 0 R/XYZ null 694 0]>>endobj
+53 0 obj<</Subtype/Link/Rect[108.7 232.9 133.4 245.9]/Border[0 0 0]/Dest[561 0 R/XYZ null 694 0]>>endobj
+54 0 obj<</Subtype/Link/Rect[133.4 232.9 145.9 245.9]/Border[0 0 0]/Dest[561 0 R/XYZ null 694 0]>>endobj
+55 0 obj<</Subtype/Link/Rect[145.9 232.9 154.2 245.9]/Border[0 0 0]/Dest[561 0 R/XYZ null 694 0]>>endobj
+56 0 obj<</Subtype/Link/Rect[154.2 232.9 159.7 245.9]/Border[0 0 0]/Dest[561 0 R/XYZ null 694 0]>>endobj
+57 0 obj<</Subtype/Link/Rect[91.2 206.5 140.5 219.5]/Border[0 0 0]/Dest[561 0 R/XYZ null 529 0]>>endobj
+58 0 obj<</Subtype/Link/Rect[140.5 206.5 156.6 219.5]/Border[0 0 0]/Dest[561 0 R/XYZ null 529 0]>>endobj
+59 0 obj<</Subtype/Link/Rect[156.6 206.5 213.2 219.5]/Border[0 0 0]/Dest[561 0 R/XYZ null 529 0]>>endobj
+60 0 obj<</Subtype/Link/Rect[213.2 206.5 242.8 219.5]/Border[0 0 0]/Dest[561 0 R/XYZ null 529 0]>>endobj
+61 0 obj<</Subtype/Link/Rect[242.8 206.5 258.4 219.5]/Border[0 0 0]/Dest[561 0 R/XYZ null 529 0]>>endobj
+62 0 obj<</Subtype/Link/Rect[258.4 206.5 306.7 219.5]/Border[0 0 0]/Dest[561 0 R/XYZ null 529 0]>>endobj
+63 0 obj<</Subtype/Link/Rect[91.2 180.1 117.8 193.1]/Border[0 0 0]/Dest[564 0 R/XYZ null 815 0]>>endobj
+64 0 obj<</Subtype/Link/Rect[117.8 180.1 174.4 193.1]/Border[0 0 0]/Dest[564 0 R/XYZ null 815 0]>>endobj
+65 0 obj<</Subtype/Link/Rect[174.4 180.1 193.0 193.1]/Border[0 0 0]/Dest[564 0 R/XYZ null 815 0]>>endobj
+66 0 obj<</Subtype/Link/Rect[193.0 180.1 216.5 193.1]/Border[0 0 0]/Dest[564 0 R/XYZ null 815 0]>>endobj
+67 0 obj<</Subtype/Link/Rect[216.5 180.1 238.2 193.1]/Border[0 0 0]/Dest[564 0 R/XYZ null 815 0]>>endobj
+68 0 obj<</Subtype/Link/Rect[238.2 180.1 270.0 193.1]/Border[0 0 0]/Dest[564 0 R/XYZ null 815 0]>>endobj
+69 0 obj<</Subtype/Link/Rect[91.2 153.7 130.7 166.7]/Border[0 0 0]/Dest[564 0 R/XYZ null 230 0]>>endobj
+70 0 obj<</Subtype/Link/Rect[130.7 153.7 146.9 166.7]/Border[0 0 0]/Dest[564 0 R/XYZ null 230 0]>>endobj
+71 0 obj<</Subtype/Link/Rect[146.9 153.7 169.2 166.7]/Border[0 0 0]/Dest[564 0 R/XYZ null 230 0]>>endobj
+72 0 obj<</Subtype/Link/Rect[169.2 153.7 196.1 166.7]/Border[0 0 0]/Dest[564 0 R/XYZ null 230 0]>>endobj
+73 0 obj<</Subtype/Link/Rect[91.2 127.3 119.1 140.3]/Border[0 0 0]/Dest[567 0 R/XYZ null 246 0]>>endobj
+74 0 obj<</Subtype/Link/Rect[119.1 127.3 132.8 140.3]/Border[0 0 0]/Dest[567 0 R/XYZ null 246 0]>>endobj
+75 0 obj<</Subtype/Link/Rect[132.8 127.3 189.3 140.3]/Border[0 0 0]/Dest[567 0 R/XYZ null 246 0]>>endobj
+76 0 obj<</Subtype/Link/Rect[189.3 127.3 203.1 140.3]/Border[0 0 0]/Dest[567 0 R/XYZ null 246 0]>>endobj
+77 0 obj<</S/URI/URI(x161.html)>>endobj
+78 0 obj<</Subtype/Link/Rect[83.0 100.9 139.5 113.9]/Border[0 0 0]/A 77 0 R>>endobj
+79 0 obj<</S/URI/URI(x161.html)>>endobj
+80 0 obj<</Subtype/Link/Rect[139.5 100.9 185.7 113.9]/Border[0 0 0]/A 79 0 R>>endobj
+81 0 obj<</S/URI/URI(x161.html)>>endobj
+82 0 obj<</Subtype/Link/Rect[185.7 100.9 207.1 113.9]/Border[0 0 0]/A 81 0 R>>endobj
+83 0 obj<</Subtype/Link/Rect[91.2 61.3 117.2 74.3]/Border[0 0 0]/Dest[573 0 R/XYZ null 792 0]>>endobj
+84 0 obj<</Subtype/Link/Rect[117.2 61.3 127.3 74.3]/Border[0 0 0]/Dest[573 0 R/XYZ null 792 0]>>endobj
+85 0 obj<</Subtype/Link/Rect[127.3 61.3 156.9 74.3]/Border[0 0 0]/Dest[573 0 R/XYZ null 792 0]>>endobj
+86 0 obj<</Subtype/Link/Rect[156.9 61.3 206.7 74.3]/Border[0 0 0]/Dest[573 0 R/XYZ null 792 0]>>endobj
+87 0 obj<</Subtype/Link/Rect[206.7 61.3 257.2 74.3]/Border[0 0 0]/Dest[573 0 R/XYZ null 792 0]>>endobj
+88 0 obj<</Subtype/Link/Rect[257.2 61.3 276.4 74.3]/Border[0 0 0]/Dest[573 0 R/XYZ null 792 0]>>endobj
+89 0 obj<</Subtype/Link/Rect[276.4 61.3 300.5 74.3]/Border[0 0 0]/Dest[573 0 R/XYZ null 792 0]>>endobj
+90 0 obj<</Subtype/Link/Rect[300.5 61.3 310.6 74.3]/Border[0 0 0]/Dest[573 0 R/XYZ null 792 0]>>endobj
+91 0 obj<</Subtype/Link/Rect[310.6 61.3 339.7 74.3]/Border[0 0 0]/Dest[573 0 R/XYZ null 792 0]>>endobj
+92 0 obj<</Subtype/Link/Rect[339.7 61.3 363.2 74.3]/Border[0 0 0]/Dest[573 0 R/XYZ null 792 0]>>endobj
+93 0 obj<</Subtype/Link/Rect[363.2 61.3 374.5 74.3]/Border[0 0 0]/Dest[573 0 R/XYZ null 792 0]>>endobj
+94 0 obj<</Subtype/Link/Rect[374.5 61.3 399.5 74.3]/Border[0 0 0]/Dest[573 0 R/XYZ null 792 0]>>endobj
+95 0 obj<</Subtype/Link/Rect[91.2 34.9 147.8 47.9]/Border[0 0 0]/Dest[573 0 R/XYZ null 437 0]>>endobj
+96 0 obj<</Subtype/Link/Rect[147.8 34.9 191.2 47.9]/Border[0 0 0]/Dest[573 0 R/XYZ null 437 0]>>endobj
+97 0 obj[12 0 R
+14 0 R
+16 0 R
+18 0 R
+20 0 R
+22 0 R
+24 0 R
+26 0 R
+28 0 R
+30 0 R
+32 0 R
+34 0 R
+36 0 R
+38 0 R
+40 0 R
+41 0 R
+42 0 R
+43 0 R
+44 0 R
+45 0 R
+46 0 R
+47 0 R
+49 0 R
+50 0 R
+51 0 R
+52 0 R
+53 0 R
+54 0 R
+55 0 R
+56 0 R
+57 0 R
+58 0 R
+59 0 R
+60 0 R
+61 0 R
+62 0 R
+63 0 R
+64 0 R
+65 0 R
+66 0 R
+67 0 R
+68 0 R
+69 0 R
+70 0 R
+71 0 R
+72 0 R
+73 0 R
+74 0 R
+75 0 R
+76 0 R
+78 0 R
+80 0 R
+82 0 R
+83 0 R
+84 0 R
+85 0 R
+86 0 R
+87 0 R
+88 0 R
+89 0 R
+90 0 R
+91 0 R
+92 0 R
+93 0 R
+94 0 R
+95 0 R
+96 0 R
+]endobj
+98 0 obj<</Subtype/Link/Rect[91.2 740.8 147.8 753.8]/Border[0 0 0]/Dest[576 0 R/XYZ null 815 0]>>endobj
+99 0 obj<</Subtype/Link/Rect[147.8 740.8 204.3 753.8]/Border[0 0 0]/Dest[576 0 R/XYZ null 815 0]>>endobj
+100 0 obj<</Subtype/Link/Rect[204.3 740.8 218.4 753.8]/Border[0 0 0]/Dest[576 0 R/XYZ null 815 0]>>endobj
+101 0 obj<</Subtype/Link/Rect[91.2 714.4 125.8 727.4]/Border[0 0 0]/Dest[576 0 R/XYZ null 637 0]>>endobj
+102 0 obj<</Subtype/Link/Rect[125.8 714.4 165.2 727.4]/Border[0 0 0]/Dest[576 0 R/XYZ null 637 0]>>endobj
+103 0 obj<</Subtype/Link/Rect[165.2 714.4 177.7 727.4]/Border[0 0 0]/Dest[576 0 R/XYZ null 637 0]>>endobj
+104 0 obj<</Subtype/Link/Rect[177.7 714.4 186.0 727.4]/Border[0 0 0]/Dest[576 0 R/XYZ null 637 0]>>endobj
+105 0 obj<</Subtype/Link/Rect[186.0 714.4 210.1 727.4]/Border[0 0 0]/Dest[576 0 R/XYZ null 637 0]>>endobj
+106 0 obj<</Subtype/Link/Rect[210.1 714.4 229.4 727.4]/Border[0 0 0]/Dest[576 0 R/XYZ null 637 0]>>endobj
+107 0 obj<</Subtype/Link/Rect[229.4 714.4 265.7 727.4]/Border[0 0 0]/Dest[576 0 R/XYZ null 637 0]>>endobj
+108 0 obj<</Subtype/Link/Rect[265.7 714.4 305.1 727.4]/Border[0 0 0]/Dest[576 0 R/XYZ null 637 0]>>endobj
+109 0 obj<</Subtype/Link/Rect[305.1 714.4 313.4 727.4]/Border[0 0 0]/Dest[576 0 R/XYZ null 637 0]>>endobj
+110 0 obj<</Subtype/Link/Rect[313.4 714.4 358.3 727.4]/Border[0 0 0]/Dest[576 0 R/XYZ null 637 0]>>endobj
+111 0 obj<</Subtype/Link/Rect[358.3 714.4 372.4 727.4]/Border[0 0 0]/Dest[576 0 R/XYZ null 637 0]>>endobj
+112 0 obj<</Subtype/Link/Rect[91.2 688.0 134.3 701.0]/Border[0 0 0]/Dest[576 0 R/XYZ null 381 0]>>endobj
+113 0 obj<</Subtype/Link/Rect[134.3 688.0 149.9 701.0]/Border[0 0 0]/Dest[576 0 R/XYZ null 381 0]>>endobj
+114 0 obj<</Subtype/Link/Rect[149.9 688.0 175.9 701.0]/Border[0 0 0]/Dest[576 0 R/XYZ null 381 0]>>endobj
+115 0 obj<</Subtype/Link/Rect[175.9 688.0 195.8 701.0]/Border[0 0 0]/Dest[576 0 R/XYZ null 381 0]>>endobj
+116 0 obj<</Subtype/Link/Rect[195.8 688.0 219.9 701.0]/Border[0 0 0]/Dest[576 0 R/XYZ null 381 0]>>endobj
+117 0 obj<</Subtype/Link/Rect[219.9 688.0 266.0 701.0]/Border[0 0 0]/Dest[576 0 R/XYZ null 381 0]>>endobj
+118 0 obj<</Subtype/Link/Rect[266.0 688.0 315.2 701.0]/Border[0 0 0]/Dest[576 0 R/XYZ null 381 0]>>endobj
+119 0 obj<</Subtype/Link/Rect[315.2 688.0 326.5 701.0]/Border[0 0 0]/Dest[576 0 R/XYZ null 381 0]>>endobj
+120 0 obj<</Subtype/Link/Rect[326.5 688.0 342.7 701.0]/Border[0 0 0]/Dest[576 0 R/XYZ null 381 0]>>endobj
+121 0 obj<</Subtype/Link/Rect[342.7 688.0 360.1 701.0]/Border[0 0 0]/Dest[576 0 R/XYZ null 381 0]>>endobj
+122 0 obj<</Subtype/Link/Rect[360.1 688.0 360.1 690.0]/Border[0 0 0]/Dest[576 0 R/XYZ null 381 0]>>endobj
+123 0 obj<</Subtype/Link/Rect[91.2 661.6 128.2 674.6]/Border[0 0 0]/Dest[579 0 R/XYZ null 815 0]>>endobj
+124 0 obj<</Subtype/Link/Rect[128.2 661.6 157.3 674.6]/Border[0 0 0]/Dest[579 0 R/XYZ null 815 0]>>endobj
+125 0 obj<</Subtype/Link/Rect[157.3 661.6 189.9 674.6]/Border[0 0 0]/Dest[579 0 R/XYZ null 815 0]>>endobj
+126 0 obj<</Subtype/Link/Rect[189.9 661.6 204.0 674.6]/Border[0 0 0]/Dest[579 0 R/XYZ null 815 0]>>endobj
+127 0 obj<</Subtype/Link/Rect[91.2 635.2 127.6 648.2]/Border[0 0 0]/Dest[579 0 R/XYZ null 743 0]>>endobj
+128 0 obj<</Subtype/Link/Rect[127.6 635.2 149.3 648.2]/Border[0 0 0]/Dest[579 0 R/XYZ null 743 0]>>endobj
+129 0 obj<</Subtype/Link/Rect[149.3 635.2 169.2 648.2]/Border[0 0 0]/Dest[579 0 R/XYZ null 743 0]>>endobj
+130 0 obj<</Subtype/Link/Rect[169.2 635.2 178.0 648.2]/Border[0 0 0]/Dest[579 0 R/XYZ null 743 0]>>endobj
+131 0 obj<</Subtype/Link/Rect[178.0 635.2 207.1 648.2]/Border[0 0 0]/Dest[579 0 R/XYZ null 743 0]>>endobj
+132 0 obj<</Subtype/Link/Rect[207.1 635.2 230.0 648.2]/Border[0 0 0]/Dest[579 0 R/XYZ null 743 0]>>endobj
+133 0 obj<</Subtype/Link/Rect[230.0 635.2 254.7 648.2]/Border[0 0 0]/Dest[579 0 R/XYZ null 743 0]>>endobj
+134 0 obj<</Subtype/Link/Rect[254.7 635.2 294.4 648.2]/Border[0 0 0]/Dest[579 0 R/XYZ null 743 0]>>endobj
+135 0 obj<</Subtype/Link/Rect[91.2 608.8 125.2 621.8]/Border[0 0 0]/Dest[579 0 R/XYZ null 509 0]>>endobj
+136 0 obj<</Subtype/Link/Rect[125.2 608.8 145.0 621.8]/Border[0 0 0]/Dest[579 0 R/XYZ null 509 0]>>endobj
+137 0 obj<</Subtype/Link/Rect[145.0 608.8 167.9 621.8]/Border[0 0 0]/Dest[579 0 R/XYZ null 509 0]>>endobj
+138 0 obj<</Subtype/Link/Rect[167.9 608.8 201.8 621.8]/Border[0 0 0]/Dest[579 0 R/XYZ null 509 0]>>endobj
+139 0 obj<</Subtype/Link/Rect[201.8 608.8 265.1 621.8]/Border[0 0 0]/Dest[579 0 R/XYZ null 509 0]>>endobj
+140 0 obj<</Subtype/Link/Rect[265.1 608.8 292.3 621.8]/Border[0 0 0]/Dest[579 0 R/XYZ null 509 0]>>endobj
+141 0 obj<</Subtype/Link/Rect[292.3 608.8 306.0 621.8]/Border[0 0 0]/Dest[579 0 R/XYZ null 509 0]>>endobj
+142 0 obj<</Subtype/Link/Rect[306.0 608.8 328.4 621.8]/Border[0 0 0]/Dest[579 0 R/XYZ null 509 0]>>endobj
+143 0 obj<</Subtype/Link/Rect[328.4 608.8 344.5 621.8]/Border[0 0 0]/Dest[579 0 R/XYZ null 509 0]>>endobj
+144 0 obj<</Subtype/Link/Rect[344.5 608.8 363.2 621.8]/Border[0 0 0]/Dest[579 0 R/XYZ null 509 0]>>endobj
+145 0 obj<</Subtype/Link/Rect[363.2 608.8 389.2 621.8]/Border[0 0 0]/Dest[579 0 R/XYZ null 509 0]>>endobj
+146 0 obj<</Subtype/Link/Rect[389.2 608.8 410.8 621.8]/Border[0 0 0]/Dest[579 0 R/XYZ null 509 0]>>endobj
+147 0 obj<</Subtype/Link/Rect[410.8 608.8 427.0 621.8]/Border[0 0 0]/Dest[579 0 R/XYZ null 509 0]>>endobj
+148 0 obj<</Subtype/Link/Rect[427.0 608.8 460.9 621.8]/Border[0 0 0]/Dest[579 0 R/XYZ null 509 0]>>endobj
+149 0 obj<</Subtype/Link/Rect[460.9 608.8 485.1 621.8]/Border[0 0 0]/Dest[579 0 R/XYZ null 509 0]>>endobj
+150 0 obj<</S/URI/URI(x283.html)>>endobj
+151 0 obj<</Subtype/Link/Rect[83.0 582.4 134.0 595.4]/Border[0 0 0]/A 150 0 R>>endobj
+152 0 obj<</S/URI/URI(x283.html)>>endobj
+153 0 obj<</Subtype/Link/Rect[134.0 582.4 165.8 595.4]/Border[0 0 0]/A 152 0 R>>endobj
+154 0 obj<</S/URI/URI(x283.html)>>endobj
+155 0 obj<</Subtype/Link/Rect[165.8 582.4 186.9 595.4]/Border[0 0 0]/A 154 0 R>>endobj
+156 0 obj<</S/URI/URI(x283.html)>>endobj
+157 0 obj<</Subtype/Link/Rect[186.9 582.4 211.0 595.4]/Border[0 0 0]/A 156 0 R>>endobj
+158 0 obj<</S/URI/URI(x283.html)>>endobj
+159 0 obj<</Subtype/Link/Rect[211.0 582.4 216.5 595.4]/Border[0 0 0]/A 158 0 R>>endobj
+160 0 obj<</Subtype/Link/Rect[91.2 542.8 130.0 555.8]/Border[0 0 0]/Dest[585 0 R/XYZ null 633 0]>>endobj
+161 0 obj<</Subtype/Link/Rect[130.0 542.8 143.8 555.8]/Border[0 0 0]/Dest[585 0 R/XYZ null 633 0]>>endobj
+162 0 obj<</Subtype/Link/Rect[143.8 542.8 166.7 555.8]/Border[0 0 0]/Dest[585 0 R/XYZ null 633 0]>>endobj
+163 0 obj<</Subtype/Link/Rect[166.7 542.8 223.2 555.8]/Border[0 0 0]/Dest[585 0 R/XYZ null 633 0]>>endobj
+164 0 obj<</Subtype/Link/Rect[223.2 542.8 267.2 555.8]/Border[0 0 0]/Dest[585 0 R/XYZ null 633 0]>>endobj
+165 0 obj<</Subtype/Link/Rect[91.2 516.4 100.7 529.4]/Border[0 0 0]/Dest[585 0 R/XYZ null 588 0]>>endobj
+166 0 obj<</Subtype/Link/Rect[100.7 516.4 119.4 529.4]/Border[0 0 0]/Dest[585 0 R/XYZ null 588 0]>>endobj
+167 0 obj<</Subtype/Link/Rect[119.4 516.4 136.8 529.4]/Border[0 0 0]/Dest[585 0 R/XYZ null 588 0]>>endobj
+168 0 obj<</Subtype/Link/Rect[136.8 516.4 163.4 529.4]/Border[0 0 0]/Dest[585 0 R/XYZ null 588 0]>>endobj
+169 0 obj<</Subtype/Link/Rect[163.4 516.4 179.5 529.4]/Border[0 0 0]/Dest[585 0 R/XYZ null 588 0]>>endobj
+170 0 obj<</Subtype/Link/Rect[179.5 516.4 239.8 529.4]/Border[0 0 0]/Dest[585 0 R/XYZ null 588 0]>>endobj
+171 0 obj<</Subtype/Link/Rect[239.8 516.4 272.2 529.4]/Border[0 0 0]/Dest[585 0 R/XYZ null 588 0]>>endobj
+172 0 obj<</S/URI/URI(x309.html)>>endobj
+173 0 obj<</Subtype/Link/Rect[83.0 490.0 114.5 503.0]/Border[0 0 0]/A 172 0 R>>endobj
+174 0 obj<</S/URI/URI(x309.html)>>endobj
+175 0 obj<</Subtype/Link/Rect[114.5 490.0 128.2 503.0]/Border[0 0 0]/A 174 0 R>>endobj
+176 0 obj<</S/URI/URI(x309.html)>>endobj
+177 0 obj<</Subtype/Link/Rect[128.2 490.0 142.0 503.0]/Border[0 0 0]/A 176 0 R>>endobj
+178 0 obj<</S/URI/URI(x309.html)>>endobj
+179 0 obj<</Subtype/Link/Rect[142.0 490.0 148.4 503.0]/Border[0 0 0]/A 178 0 R>>endobj
+180 0 obj<</S/URI/URI(x309.html)>>endobj
+181 0 obj<</Subtype/Link/Rect[148.4 490.0 164.0 503.0]/Border[0 0 0]/A 180 0 R>>endobj
+182 0 obj<</S/URI/URI(x309.html)>>endobj
+183 0 obj<</Subtype/Link/Rect[164.0 490.0 185.7 503.0]/Border[0 0 0]/A 182 0 R>>endobj
+184 0 obj<</S/URI/URI(x309.html)>>endobj
+185 0 obj<</Subtype/Link/Rect[185.7 490.0 204.9 503.0]/Border[0 0 0]/A 184 0 R>>endobj
+186 0 obj<</S/URI/URI(x309.html)>>endobj
+187 0 obj<</Subtype/Link/Rect[204.9 490.0 226.0 503.0]/Border[0 0 0]/A 186 0 R>>endobj
+188 0 obj<</S/URI/URI(x309.html)>>endobj
+189 0 obj<</Subtype/Link/Rect[226.0 490.0 244.6 503.0]/Border[0 0 0]/A 188 0 R>>endobj
+190 0 obj<</S/URI/URI(x309.html)>>endobj
+191 0 obj<</Subtype/Link/Rect[244.6 490.0 251.0 503.0]/Border[0 0 0]/A 190 0 R>>endobj
+192 0 obj<</S/URI/URI(x309.html)>>endobj
+193 0 obj<</Subtype/Link/Rect[251.0 490.0 272.7 503.0]/Border[0 0 0]/A 192 0 R>>endobj
+194 0 obj<</S/URI/URI(x309.html)>>endobj
+195 0 obj<</Subtype/Link/Rect[272.7 490.0 278.2 503.0]/Border[0 0 0]/A 194 0 R>>endobj
+196 0 obj<</Subtype/Link/Rect[91.2 450.4 113.5 463.4]/Border[0 0 0]/Dest[588 0 R/XYZ null 620 0]>>endobj
+197 0 obj<</Subtype/Link/Rect[113.5 450.4 132.2 463.4]/Border[0 0 0]/Dest[588 0 R/XYZ null 620 0]>>endobj
+198 0 obj<</Subtype/Link/Rect[132.2 450.4 168.5 463.4]/Border[0 0 0]/Dest[588 0 R/XYZ null 620 0]>>endobj
+199 0 obj<</Subtype/Link/Rect[168.5 450.4 174.0 463.4]/Border[0 0 0]/Dest[588 0 R/XYZ null 620 0]>>endobj
+200 0 obj<</Subtype/Link/Rect[91.2 424.0 117.8 437.0]/Border[0 0 0]/Dest[588 0 R/XYZ null 509 0]>>endobj
+201 0 obj<</Subtype/Link/Rect[117.8 424.0 149.3 437.0]/Border[0 0 0]/Dest[588 0 R/XYZ null 509 0]>>endobj
+202 0 obj<</Subtype/Link/Rect[149.3 424.0 173.1 437.0]/Border[0 0 0]/Dest[588 0 R/XYZ null 509 0]>>endobj
+203 0 obj<</S/URI/URI(x344.html)>>endobj
+204 0 obj<</Subtype/Link/Rect[83.0 397.6 138.9 410.6]/Border[0 0 0]/A 203 0 R>>endobj
+205 0 obj<</S/URI/URI(x344.html)>>endobj
+206 0 obj<</Subtype/Link/Rect[138.9 397.6 162.8 410.6]/Border[0 0 0]/A 205 0 R>>endobj
+207 0 obj<</S/URI/URI(x354.html)>>endobj
+208 0 obj<</Subtype/Link/Rect[88.5 371.2 172.8 384.2]/Border[0 0 0]/A 207 0 R>>endobj
+209 0 obj<</S/URI/URI(x11.html)>>endobj
+210 0 obj<</Subtype/Link/Rect[554.6 342.8 576.0 355.8]/Border[0 0 0]/A 209 0 R>>endobj
+211 0 obj<</S/URI/URI(index.html)>>endobj
+212 0 obj<</Subtype/Link/Rect[72.0 303.2 92.2 316.2]/Border[0 0 0]/A 211 0 R>>endobj
+213 0 obj<</S/URI/URI(x24.html)>>endobj
+214 0 obj<</Subtype/Link/Rect[554.6 303.2 576.0 316.2]/Border[0 0 0]/A 213 0 R>>endobj
+215 0 obj[98 0 R
+99 0 R
+100 0 R
+101 0 R
+102 0 R
+103 0 R
+104 0 R
+105 0 R
+106 0 R
+107 0 R
+108 0 R
+109 0 R
+110 0 R
+111 0 R
+112 0 R
+113 0 R
+114 0 R
+115 0 R
+116 0 R
+117 0 R
+118 0 R
+119 0 R
+120 0 R
+121 0 R
+122 0 R
+123 0 R
+124 0 R
+125 0 R
+126 0 R
+127 0 R
+128 0 R
+129 0 R
+130 0 R
+131 0 R
+132 0 R
+133 0 R
+134 0 R
+135 0 R
+136 0 R
+137 0 R
+138 0 R
+139 0 R
+140 0 R
+141 0 R
+142 0 R
+143 0 R
+144 0 R
+145 0 R
+146 0 R
+147 0 R
+148 0 R
+149 0 R
+151 0 R
+153 0 R
+155 0 R
+157 0 R
+159 0 R
+160 0 R
+161 0 R
+162 0 R
+163 0 R
+164 0 R
+165 0 R
+166 0 R
+167 0 R
+168 0 R
+169 0 R
+170 0 R
+171 0 R
+173 0 R
+175 0 R
+177 0 R
+179 0 R
+181 0 R
+183 0 R
+185 0 R
+187 0 R
+189 0 R
+191 0 R
+193 0 R
+195 0 R
+196 0 R
+197 0 R
+198 0 R
+199 0 R
+200 0 R
+201 0 R
+202 0 R
+204 0 R
+206 0 R
+208 0 R
+210 0 R
+212 0 R
+214 0 R
+]endobj
+216 0 obj<</S/URI/URI(http://photo.net/wtr/thebook)>>endobj
+217 0 obj<</Subtype/Link/Rect[193.9 599.2 317.6 612.2]/Border[0 0 0]/A 216 0 R>>endobj
+218 0 obj<</S/URI/URI(http://photo.net/wtr/using-the-acs.html)>>endobj
+219 0 obj<</Subtype/Link/Rect[334.3 599.2 363.3 612.2]/Border[0 0 0]/A 218 0 R>>endobj
+220 0 obj<</S/URI/URI(http://photo.net/wtr/using-the-acs.html)>>endobj
+221 0 obj<</Subtype/Link/Rect[363.3 599.2 383.2 612.2]/Border[0 0 0]/A 220 0 R>>endobj
+222 0 obj<</S/URI/URI(http://photo.net/wtr/using-the-acs.html)>>endobj
+223 0 obj<</Subtype/Link/Rect[383.2 599.2 404.6 612.2]/Border[0 0 0]/A 222 0 R>>endobj
+224 0 obj<</S/URI/URI(http://photo.net/wtr/thebook/community.html)>>endobj
+225 0 obj<</Subtype/Link/Rect[129.7 572.8 167.3 585.8]/Border[0 0 0]/A 224 0 R>>endobj
+226 0 obj<</S/URI/URI(http://photo.net/wtr/thebook/community.html)>>endobj
+227 0 obj<</Subtype/Link/Rect[167.3 572.8 172.8 585.8]/Border[0 0 0]/A 226 0 R>>endobj
+228 0 obj<</S/URI/URI(http://photo.net/wtr/arsdigita-server-architecture.html)>>endobj
+229 0 obj<</Subtype/Link/Rect[376.9 533.2 423.0 546.2]/Border[0 0 0]/A 228 0 R>>endobj
+230 0 obj<</S/URI/URI(http://photo.net/wtr/arsdigita-server-architecture.html)>>endobj
+231 0 obj<</Subtype/Link/Rect[423.0 533.2 454.5 546.2]/Border[0 0 0]/A 230 0 R>>endobj
+232 0 obj<</S/URI/URI(http://photo.net/wtr/arsdigita-server-architecture.html)>>endobj
+233 0 obj<</Subtype/Link/Rect[454.5 533.2 509.5 546.2]/Border[0 0 0]/A 232 0 R>>endobj
+234 0 obj<</S/URI/URI(http://openacs.org)>>endobj
+235 0 obj<</Subtype/Link/Rect[490.5 440.8 569.7 453.8]/Border[0 0 0]/A 234 0 R>>endobj
+236 0 obj<</S/URI/URI(index.html)>>endobj
+237 0 obj<</Subtype/Link/Rect[72.0 412.4 92.2 425.4]/Border[0 0 0]/A 236 0 R>>endobj
+238 0 obj<</S/URI/URI(index.html)>>endobj
+239 0 obj<</Subtype/Link/Rect[310.6 412.4 337.4 425.4]/Border[0 0 0]/A 238 0 R>>endobj
+240 0 obj<</S/URI/URI(x24.html)>>endobj
+241 0 obj<</Subtype/Link/Rect[554.6 412.4 576.0 425.4]/Border[0 0 0]/A 240 0 R>>endobj
+242 0 obj<</S/URI/URI(x11.html)>>endobj
+243 0 obj<</Subtype/Link/Rect[72.0 372.8 92.2 385.8]/Border[0 0 0]/A 242 0 R>>endobj
+244 0 obj<</S/URI/URI(x47.html)>>endobj
+245 0 obj<</Subtype/Link/Rect[554.6 372.8 576.0 385.8]/Border[0 0 0]/A 244 0 R>>endobj
+246 0 obj[217 0 R
+219 0 R
+221 0 R
+223 0 R
+225 0 R
+227 0 R
+229 0 R
+231 0 R
+233 0 R
+235 0 R
+237 0 R
+239 0 R
+241 0 R
+243 0 R
+245 0 R
+]endobj
+247 0 obj<</S/URI/URI(http://www.aolserver.com)>>endobj
+248 0 obj<</Subtype/Link/Rect[81.0 704.8 130.4 717.8]/Border[0 0 0]/A 247 0 R>>endobj
+249 0 obj<</S/URI/URI(http://www.opennsd.org)>>endobj
+250 0 obj<</Subtype/Link/Rect[116.3 652.0 223.2 665.0]/Border[0 0 0]/A 249 0 R>>endobj
+251 0 obj<</S/URI/URI(http://apache.arsdigita-dev.com)>>endobj
+252 0 obj<</Subtype/Link/Rect[140.1 599.2 281.4 612.2]/Border[0 0 0]/A 251 0 R>>endobj
+253 0 obj<</S/URI/URI(http://www.postgresql.org)>>endobj
+254 0 obj<</Subtype/Link/Rect[81.0 572.8 134.7 585.8]/Border[0 0 0]/A 253 0 R>>endobj
+255 0 obj<</S/URI/URI(http://www.linux.com)>>endobj
+256 0 obj<</Subtype/Link/Rect[430.5 506.8 483.7 519.8]/Border[0 0 0]/A 255 0 R>>endobj
+257 0 obj<</S/URI/URI(http://www.redhat.com)>>endobj
+258 0 obj<</Subtype/Link/Rect[115.4 467.2 135.8 480.2]/Border[0 0 0]/A 257 0 R>>endobj
+259 0 obj<</S/URI/URI(http://www.redhat.com)>>endobj
+260 0 obj<</Subtype/Link/Rect[135.8 467.2 154.5 480.2]/Border[0 0 0]/A 259 0 R>>endobj
+261 0 obj<</S/URI/URI(http://www.redhat.com)>>endobj
+262 0 obj<</Subtype/Link/Rect[154.5 467.2 180.8 480.2]/Border[0 0 0]/A 261 0 R>>endobj
+263 0 obj<</S/URI/URI(http://www.debian.org)>>endobj
+264 0 obj<</Subtype/Link/Rect[202.1 467.2 236.7 480.2]/Border[0 0 0]/A 263 0 R>>endobj
+265 0 obj<</S/URI/URI(http://www.debian.org)>>endobj
+266 0 obj<</Subtype/Link/Rect[236.7 467.2 289.8 480.2]/Border[0 0 0]/A 265 0 R>>endobj
+267 0 obj<</S/URI/URI(http://www.debian.org)>>endobj
+268 0 obj<</Subtype/Link/Rect[105.9 427.6 140.4 440.6]/Border[0 0 0]/A 267 0 R>>endobj
+269 0 obj<</S/URI/URI(http://www.debian.org)>>endobj
+270 0 obj<</Subtype/Link/Rect[140.4 427.6 193.6 440.6]/Border[0 0 0]/A 269 0 R>>endobj
+271 0 obj<</S/URI/URI(http://openacs.org/software.adp)>>endobj
+272 0 obj<</Subtype/Link/Rect[222.0 401.2 269.9 414.2]/Border[0 0 0]/A 271 0 R>>endobj
+273 0 obj<</S/URI/URI(http://openacs.org/software.adp)>>endobj
+274 0 obj<</Subtype/Link/Rect[269.9 401.2 310.6 414.2]/Border[0 0 0]/A 273 0 R>>endobj
+275 0 obj<</S/URI/URI(http://openacs.org/software.adp)>>endobj
+276 0 obj<</Subtype/Link/Rect[310.6 401.2 334.1 414.2]/Border[0 0 0]/A 275 0 R>>endobj
+277 0 obj<</S/URI/URI(http://openacs.org/software.adp)>>endobj
+278 0 obj<</Subtype/Link/Rect[310.1 308.8 358.0 321.8]/Border[0 0 0]/A 277 0 R>>endobj
+279 0 obj<</S/URI/URI(http://openacs.org/software.adp)>>endobj
+280 0 obj<</Subtype/Link/Rect[358.0 308.8 398.7 321.8]/Border[0 0 0]/A 279 0 R>>endobj
+281 0 obj<</S/URI/URI(http://openacs.org/software.adp)>>endobj
+282 0 obj<</Subtype/Link/Rect[398.7 308.8 422.2 321.8]/Border[0 0 0]/A 281 0 R>>endobj
+283 0 obj<</S/URI/URI(http://openacs.org/software.adp)>>endobj
+284 0 obj<</Subtype/Link/Rect[258.2 282.4 306.1 295.4]/Border[0 0 0]/A 283 0 R>>endobj
+285 0 obj<</S/URI/URI(http://openacs.org/software.adp)>>endobj
+286 0 obj<</Subtype/Link/Rect[306.1 282.4 346.8 295.4]/Border[0 0 0]/A 285 0 R>>endobj
+287 0 obj<</S/URI/URI(http://openacs.org/software.adp)>>endobj
+288 0 obj<</Subtype/Link/Rect[346.8 282.4 370.3 295.4]/Border[0 0 0]/A 287 0 R>>endobj
+289 0 obj<</S/URI/URI(x11.html)>>endobj
+290 0 obj<</Subtype/Link/Rect[72.0 254.0 92.2 267.0]/Border[0 0 0]/A 289 0 R>>endobj
+291 0 obj<</S/URI/URI(index.html)>>endobj
+292 0 obj<</Subtype/Link/Rect[310.6 254.0 337.4 267.0]/Border[0 0 0]/A 291 0 R>>endobj
+293 0 obj<</S/URI/URI(x47.html)>>endobj
+294 0 obj<</Subtype/Link/Rect[554.6 254.0 576.0 267.0]/Border[0 0 0]/A 293 0 R>>endobj
+295 0 obj<</S/URI/URI(x24.html)>>endobj
+296 0 obj<</Subtype/Link/Rect[72.0 214.4 92.2 227.4]/Border[0 0 0]/A 295 0 R>>endobj
+297 0 obj<</S/URI/URI(x60.html)>>endobj
+298 0 obj<</Subtype/Link/Rect[554.6 214.4 576.0 227.4]/Border[0 0 0]/A 297 0 R>>endobj
+299 0 obj[248 0 R
+250 0 R
+252 0 R
+254 0 R
+256 0 R
+258 0 R
+260 0 R
+262 0 R
+264 0 R
+266 0 R
+268 0 R
+270 0 R
+272 0 R
+274 0 R
+276 0 R
+278 0 R
+280 0 R
+282 0 R
+284 0 R
+286 0 R
+288 0 R
+290 0 R
+292 0 R
+294 0 R
+296 0 R
+298 0 R
+]endobj
+300 0 obj<</S/URI/URI(x24.html)>>endobj
+301 0 obj<</Subtype/Link/Rect[72.0 438.8 92.2 451.8]/Border[0 0 0]/A 300 0 R>>endobj
+302 0 obj<</S/URI/URI(index.html)>>endobj
+303 0 obj<</Subtype/Link/Rect[310.6 438.8 337.4 451.8]/Border[0 0 0]/A 302 0 R>>endobj
+304 0 obj<</S/URI/URI(x60.html)>>endobj
+305 0 obj<</Subtype/Link/Rect[554.6 438.8 576.0 451.8]/Border[0 0 0]/A 304 0 R>>endobj
+306 0 obj<</S/URI/URI(x47.html)>>endobj
+307 0 obj<</Subtype/Link/Rect[72.0 399.2 92.2 412.2]/Border[0 0 0]/A 306 0 R>>endobj
+308 0 obj<</S/URI/URI(x83.html)>>endobj
+309 0 obj<</Subtype/Link/Rect[554.6 399.2 576.0 412.2]/Border[0 0 0]/A 308 0 R>>endobj
+310 0 obj[301 0 R
+303 0 R
+305 0 R
+307 0 R
+309 0 R
+]endobj
+311 0 obj<</S/URI/URI(openacs)>>endobj
+312 0 obj<</Subtype/Link/Rect[125.4 685.8 159.4 698.8]/Border[0 0 0]/A 311 0 R>>endobj
+313 0 obj<</S/URI/URI(openacs)>>endobj
+314 0 obj<</Subtype/Link/Rect[159.4 685.8 211.6 698.8]/Border[0 0 0]/A 313 0 R>>endobj
+315 0 obj<</S/URI/URI(openacs)>>endobj
+316 0 obj<</Subtype/Link/Rect[211.6 685.8 241.9 698.8]/Border[0 0 0]/A 315 0 R>>endobj
+317 0 obj<</S/URI/URI(openacs)>>endobj
+318 0 obj<</Subtype/Link/Rect[241.9 685.8 268.7 698.8]/Border[0 0 0]/A 317 0 R>>endobj
+319 0 obj<</S/URI/URI(http://www.aolserver.com/docs/3.0/)>>endobj
+320 0 obj<</Subtype/Link/Rect[410.5 685.8 462.7 698.8]/Border[0 0 0]/A 319 0 R>>endobj
+321 0 obj<</S/URI/URI(http://www.aolserver.com/docs/3.0/)>>endobj
+322 0 obj<</Subtype/Link/Rect[462.7 685.8 482.9 698.8]/Border[0 0 0]/A 321 0 R>>endobj
+323 0 obj<</S/URI/URI(nsd.txt)>>endobj
+324 0 obj<</Subtype/Link/Rect[322.6 114.0 346.1 127.0]/Border[0 0 0]/A 323 0 R>>endobj
+325 0 obj<</S/URI/URI(nsd.txt)>>endobj
+326 0 obj<</Subtype/Link/Rect[346.1 114.0 365.1 127.0]/Border[0 0 0]/A 325 0 R>>endobj
+327 0 obj<</S/URI/URI(x47.html)>>endobj
+328 0 obj<</Subtype/Link/Rect[72.0 72.4 92.2 85.4]/Border[0 0 0]/A 327 0 R>>endobj
+329 0 obj<</S/URI/URI(index.html)>>endobj
+330 0 obj<</Subtype/Link/Rect[310.6 72.4 337.4 85.4]/Border[0 0 0]/A 329 0 R>>endobj
+331 0 obj<</S/URI/URI(x83.html)>>endobj
+332 0 obj<</Subtype/Link/Rect[554.6 72.4 576.0 85.4]/Border[0 0 0]/A 331 0 R>>endobj
+333 0 obj[312 0 R
+314 0 R
+316 0 R
+318 0 R
+320 0 R
+322 0 R
+324 0 R
+326 0 R
+328 0 R
+330 0 R
+332 0 R
+]endobj
+334 0 obj<</S/URI/URI(x60.html)>>endobj
+335 0 obj<</Subtype/Link/Rect[72.0 740.8 92.2 753.8]/Border[0 0 0]/A 334 0 R>>endobj
+336 0 obj<</S/URI/URI(x161.html)>>endobj
+337 0 obj<</Subtype/Link/Rect[554.6 740.8 576.0 753.8]/Border[0 0 0]/A 336 0 R>>endobj
+338 0 obj[335 0 R
+337 0 R
+]endobj
+339 0 obj<</S/URI/URI(openacs)>>endobj
+340 0 obj<</Subtype/Link/Rect[75.7 672.6 178.2 685.6]/Border[0 0 0]/A 339 0 R>>endobj
+341 0 obj<</S/URI/URI(http://www.postgresql.org/docs/admin/install855.htm)>>endobj
+342 0 obj<</Subtype/Link/Rect[72.0 633.0 307.6 646.0]/Border[0 0 0]/A 341 0 R>>endobj
+343 0 obj<</S/URI/URI(http://openacs.org/software.adp)>>endobj
+344 0 obj<</Subtype/Link/Rect[357.0 304.6 405.0 317.6]/Border[0 0 0]/A 343 0 R>>endobj
+345 0 obj<</S/URI/URI(http://openacs.org/software.adp)>>endobj
+346 0 obj<</Subtype/Link/Rect[405.0 304.6 445.6 317.6]/Border[0 0 0]/A 345 0 R>>endobj
+347 0 obj<</S/URI/URI(http://openacs.org/software.adp)>>endobj
+348 0 obj<</Subtype/Link/Rect[445.6 304.6 466.4 317.6]/Border[0 0 0]/A 347 0 R>>endobj
+349 0 obj[340 0 R
+342 0 R
+344 0 R
+346 0 R
+348 0 R
+]endobj
+350 0 obj<</S/URI/URI(openacs)>>endobj
+351 0 obj<</Subtype/Link/Rect[126.7 170.0 160.6 183.0]/Border[0 0 0]/A 350 0 R>>endobj
+352 0 obj<</S/URI/URI(openacs)>>endobj
+353 0 obj<</Subtype/Link/Rect[160.6 170.0 217.1 183.0]/Border[0 0 0]/A 352 0 R>>endobj
+354 0 obj<</S/URI/URI(openacs)>>endobj
+355 0 obj<</Subtype/Link/Rect[217.1 170.0 269.4 183.0]/Border[0 0 0]/A 354 0 R>>endobj
+356 0 obj<</S/URI/URI(openacs)>>endobj
+357 0 obj<</Subtype/Link/Rect[269.4 170.0 296.3 183.0]/Border[0 0 0]/A 356 0 R>>endobj
+358 0 obj[351 0 R
+353 0 R
+355 0 R
+357 0 R
+]endobj
+359 0 obj<</S/URI/URI(x60.html)>>endobj
+360 0 obj<</Subtype/Link/Rect[72.0 725.6 92.2 738.6]/Border[0 0 0]/A 359 0 R>>endobj
+361 0 obj<</S/URI/URI(index.html)>>endobj
+362 0 obj<</Subtype/Link/Rect[310.6 725.6 337.4 738.6]/Border[0 0 0]/A 361 0 R>>endobj
+363 0 obj<</S/URI/URI(x161.html)>>endobj
+364 0 obj<</Subtype/Link/Rect[554.6 725.6 576.0 738.6]/Border[0 0 0]/A 363 0 R>>endobj
+365 0 obj<</S/URI/URI(x83.html)>>endobj
+366 0 obj<</Subtype/Link/Rect[72.0 686.0 92.2 699.0]/Border[0 0 0]/A 365 0 R>>endobj
+367 0 obj<</S/URI/URI(x283.html)>>endobj
+368 0 obj<</Subtype/Link/Rect[554.6 686.0 576.0 699.0]/Border[0 0 0]/A 367 0 R>>endobj
+369 0 obj[360 0 R
+362 0 R
+364 0 R
+366 0 R
+368 0 R
+]endobj
+370 0 obj<</S/URI/URI(http://openacs.org/doc)>>endobj
+371 0 obj<</Subtype/Link/Rect[416.0 159.4 514.0 172.4]/Border[0 0 0]/A 370 0 R>>endobj
+372 0 obj<</Subtype/Link/Rect[108.0 133.0 140.7 146.0]/Border[0 0 0]/Dest[576 0 R/XYZ null 381 0]>>endobj
+373 0 obj<</Subtype/Link/Rect[140.7 133.0 164.8 146.0]/Border[0 0 0]/Dest[576 0 R/XYZ null 381 0]>>endobj
+374 0 obj<</Subtype/Link/Rect[164.8 133.0 209.4 146.0]/Border[0 0 0]/Dest[576 0 R/XYZ null 381 0]>>endobj
+375 0 obj[371 0 R
+372 0 R
+373 0 R
+374 0 R
+]endobj
+376 0 obj<</S/URI/URI(http://photo.net/doc/acceptance-test.html)>>endobj
+377 0 obj<</Subtype/Link/Rect[193.9 636.8 376.1 649.8]/Border[0 0 0]/A 376 0 R>>endobj
+378 0 obj<</S/URI/URI(restart-aolserver.txt)>>endobj
+379 0 obj<</Subtype/Link/Rect[153.2 304.4 227.2 317.4]/Border[0 0 0]/A 378 0 R>>endobj
+380 0 obj[377 0 R
+379 0 R
+]endobj
+381 0 obj<</S/URI/URI(x83.html)>>endobj
+382 0 obj<</Subtype/Link/Rect[72.0 103.0 92.2 116.0]/Border[0 0 0]/A 381 0 R>>endobj
+383 0 obj<</S/URI/URI(index.html)>>endobj
+384 0 obj<</Subtype/Link/Rect[310.6 103.0 337.4 116.0]/Border[0 0 0]/A 383 0 R>>endobj
+385 0 obj<</S/URI/URI(x283.html)>>endobj
+386 0 obj<</Subtype/Link/Rect[554.6 103.0 576.0 116.0]/Border[0 0 0]/A 385 0 R>>endobj
+387 0 obj<</S/URI/URI(x161.html)>>endobj
+388 0 obj<</Subtype/Link/Rect[72.0 63.4 92.2 76.4]/Border[0 0 0]/A 387 0 R>>endobj
+389 0 obj<</S/URI/URI(x309.html)>>endobj
+390 0 obj<</Subtype/Link/Rect[554.6 63.4 576.0 76.4]/Border[0 0 0]/A 389 0 R>>endobj
+391 0 obj[382 0 R
+384 0 R
+386 0 R
+388 0 R
+390 0 R
+]endobj
+392 0 obj<</S/URI/URI(http://www.openacs.org/sites.html)>>endobj
+393 0 obj<</Subtype/Link/Rect[289.5 678.4 440.8 691.4]/Border[0 0 0]/A 392 0 R>>endobj
+394 0 obj<</S/URI/URI(getting-started.html)>>endobj
+395 0 obj<</Subtype/Link/Rect[149.5 652.0 197.5 665.0]/Border[0 0 0]/A 394 0 R>>endobj
+396 0 obj<</S/URI/URI(getting-started.html)>>endobj
+397 0 obj<</Subtype/Link/Rect[197.5 652.0 233.3 665.0]/Border[0 0 0]/A 396 0 R>>endobj
+398 0 obj<</S/URI/URI(getting-started.html)>>endobj
+399 0 obj<</Subtype/Link/Rect[233.3 652.0 267.2 665.0]/Border[0 0 0]/A 398 0 R>>endobj
+400 0 obj<</S/URI/URI(getting-started.html)>>endobj
+401 0 obj<</Subtype/Link/Rect[267.2 652.0 294.1 665.0]/Border[0 0 0]/A 400 0 R>>endobj
+402 0 obj<</S/URI/URI(http://dev.arsdigita.com/ad-training/acs-install/monitors.html)>>endobj
+403 0 obj<</Subtype/Link/Rect[149.5 625.6 193.9 638.6]/Border[0 0 0]/A 402 0 R>>endobj
+404 0 obj<</S/URI/URI(http://dev.arsdigita.com/ad-training/acs-install/monitors.html)>>endobj
+405 0 obj<</Subtype/Link/Rect[193.9 625.6 234.2 638.6]/Border[0 0 0]/A 404 0 R>>endobj
+406 0 obj<</S/URI/URI(x161.html)>>endobj
+407 0 obj<</Subtype/Link/Rect[72.0 315.4 92.2 328.4]/Border[0 0 0]/A 406 0 R>>endobj
+408 0 obj<</S/URI/URI(index.html)>>endobj
+409 0 obj<</Subtype/Link/Rect[310.6 315.4 337.4 328.4]/Border[0 0 0]/A 408 0 R>>endobj
+410 0 obj<</S/URI/URI(x309.html)>>endobj
+411 0 obj<</Subtype/Link/Rect[554.6 315.4 576.0 328.4]/Border[0 0 0]/A 410 0 R>>endobj
+412 0 obj<</S/URI/URI(x283.html)>>endobj
+413 0 obj<</Subtype/Link/Rect[72.0 262.6 92.2 275.6]/Border[0 0 0]/A 412 0 R>>endobj
+414 0 obj<</S/URI/URI(x344.html)>>endobj
+415 0 obj<</Subtype/Link/Rect[554.6 262.6 576.0 275.6]/Border[0 0 0]/A 414 0 R>>endobj
+416 0 obj[393 0 R
+395 0 R
+397 0 R
+399 0 R
+401 0 R
+403 0 R
+405 0 R
+407 0 R
+409 0 R
+411 0 R
+413 0 R
+415 0 R
+]endobj
+417 0 obj<</S/URI/URI(http://openacs.org/bboard)>>endobj
+418 0 obj<</Subtype/Link/Rect[108.0 678.4 220.7 691.4]/Border[0 0 0]/A 417 0 R>>endobj
+419 0 obj<</S/URI/URI(http://openacs.org/sdm)>>endobj
+420 0 obj<</Subtype/Link/Rect[108.0 652.0 208.5 665.0]/Border[0 0 0]/A 419 0 R>>endobj
+421 0 obj<</S/URI/URI(http://www.openacs.org/why-not-mysql.html)>>endobj
+422 0 obj<</Subtype/Link/Rect[72.0 487.8 276.0 500.8]/Border[0 0 0]/A 421 0 R>>endobj
+423 0 obj<</S/URI/URI(http://www.phpbuilder.com/columns/tim20001112.php3)>>endobj
+424 0 obj<</Subtype/Link/Rect[72.0 448.2 321.0 461.2]/Border[0 0 0]/A 423 0 R>>endobj
+425 0 obj<</S/URI/URI(http://www.aolserver.com)>>endobj
+426 0 obj<</Subtype/Link/Rect[108.0 376.4 170.0 389.4]/Border[0 0 0]/A 425 0 R>>endobj
+427 0 obj<</S/URI/URI(http://www.aolserver.com/doc)>>endobj
+428 0 obj<</Subtype/Link/Rect[238.1 376.4 319.1 389.4]/Border[0 0 0]/A 427 0 R>>endobj
+429 0 obj<</S/URI/URI(http://wimpy.arsdigita.com/public/presentation-top.adp?presentaion_id=12383)>>endobj
+430 0 obj<</Subtype/Link/Rect[108.0 336.8 160.4 349.8]/Border[0 0 0]/A 429 0 R>>endobj
+431 0 obj<</S/URI/URI(http://wimpy.arsdigita.com/public/presentation-top.adp?presentaion_id=12383)>>endobj
+432 0 obj<</Subtype/Link/Rect[160.4 336.8 212.6 349.8]/Border[0 0 0]/A 431 0 R>>endobj
+433 0 obj<</S/URI/URI(http://wimpy.arsdigita.com/public/presentation-top.adp?presentaion_id=12383)>>endobj
+434 0 obj<</Subtype/Link/Rect[212.6 336.8 267.0 349.8]/Border[0 0 0]/A 433 0 R>>endobj
+435 0 obj<</S/URI/URI(http://www.arsdigita.com/asj)>>endobj
+436 0 obj<</Subtype/Link/Rect[108.0 310.4 154.1 323.4]/Border[0 0 0]/A 435 0 R>>endobj
+437 0 obj<</S/URI/URI(http://www.arsdigita.com/asj)>>endobj
+438 0 obj<</Subtype/Link/Rect[154.1 310.4 193.6 323.4]/Border[0 0 0]/A 437 0 R>>endobj
+439 0 obj<</S/URI/URI(http://www.arsdigita.com/asj)>>endobj
+440 0 obj<</Subtype/Link/Rect[193.6 310.4 225.9 323.4]/Border[0 0 0]/A 439 0 R>>endobj
+441 0 obj<</S/URI/URI(http://www.openforce.net)>>endobj
+442 0 obj<</Subtype/Link/Rect[108.0 270.8 159.6 283.8]/Border[0 0 0]/A 441 0 R>>endobj
+443 0 obj<</S/URI/URI(http://www.openforce.net)>>endobj
+444 0 obj<</Subtype/Link/Rect[159.6 270.8 173.7 283.8]/Border[0 0 0]/A 443 0 R>>endobj
+445 0 obj<</S/URI/URI(x283.html)>>endobj
+446 0 obj<</Subtype/Link/Rect[72.0 229.2 92.2 242.2]/Border[0 0 0]/A 445 0 R>>endobj
+447 0 obj<</S/URI/URI(index.html)>>endobj
+448 0 obj<</Subtype/Link/Rect[310.6 229.2 337.4 242.2]/Border[0 0 0]/A 447 0 R>>endobj
+449 0 obj<</S/URI/URI(x344.html)>>endobj
+450 0 obj<</Subtype/Link/Rect[554.6 229.2 576.0 242.2]/Border[0 0 0]/A 449 0 R>>endobj
+451 0 obj<</S/URI/URI(x309.html)>>endobj
+452 0 obj<</Subtype/Link/Rect[72.0 189.6 92.2 202.6]/Border[0 0 0]/A 451 0 R>>endobj
+453 0 obj<</S/URI/URI(x354.html)>>endobj
+454 0 obj<</Subtype/Link/Rect[554.6 189.6 576.0 202.6]/Border[0 0 0]/A 453 0 R>>endobj
+455 0 obj[418 0 R
+420 0 R
+422 0 R
+424 0 R
+426 0 R
+428 0 R
+430 0 R
+432 0 R
+434 0 R
+436 0 R
+438 0 R
+440 0 R
+442 0 R
+444 0 R
+446 0 R
+448 0 R
+450 0 R
+452 0 R
+454 0 R
+]endobj
+456 0 obj<</S/URI/URI(http://www.openacs.org/doc/openacs/getting-started/)>>endobj
+457 0 obj<</Subtype/Link/Rect[108.0 638.8 144.4 651.8]/Border[0 0 0]/A 456 0 R>>endobj
+458 0 obj<</S/URI/URI(http://www.openacs.org/doc/openacs/getting-started/)>>endobj
+459 0 obj<</Subtype/Link/Rect[144.4 638.8 166.7 651.8]/Border[0 0 0]/A 458 0 R>>endobj
+460 0 obj<</S/URI/URI(http://www.openacs.org/doc/openacs/getting-started/)>>endobj
+461 0 obj<</Subtype/Link/Rect[166.7 638.8 190.8 651.8]/Border[0 0 0]/A 460 0 R>>endobj
+462 0 obj<</S/URI/URI(http://www.openacs.org/doc/openacs/getting-started/)>>endobj
+463 0 obj<</Subtype/Link/Rect[190.8 638.8 212.5 651.8]/Border[0 0 0]/A 462 0 R>>endobj
+464 0 obj<</S/URI/URI(http://www.openacs.org/doc/openacs/getting-started/)>>endobj
+465 0 obj<</Subtype/Link/Rect[212.5 638.8 244.3 651.8]/Border[0 0 0]/A 464 0 R>>endobj
+466 0 obj<</S/URI/URI(http://michael.cleverly.com/aolserver)>>endobj
+467 0 obj<</Subtype/Link/Rect[108.0 599.2 128.5 612.2]/Border[0 0 0]/A 466 0 R>>endobj
+468 0 obj<</S/URI/URI(http://michael.cleverly.com/aolserver)>>endobj
+469 0 obj<</Subtype/Link/Rect[128.5 599.2 147.1 612.2]/Border[0 0 0]/A 468 0 R>>endobj
+470 0 obj<</S/URI/URI(http://michael.cleverly.com/aolserver)>>endobj
+471 0 obj<</Subtype/Link/Rect[147.1 599.2 182.5 612.2]/Border[0 0 0]/A 470 0 R>>endobj
+472 0 obj<</S/URI/URI(x309.html)>>endobj
+473 0 obj<</Subtype/Link/Rect[72.0 557.6 92.2 570.6]/Border[0 0 0]/A 472 0 R>>endobj
+474 0 obj<</S/URI/URI(index.html)>>endobj
+475 0 obj<</Subtype/Link/Rect[310.6 557.6 337.4 570.6]/Border[0 0 0]/A 474 0 R>>endobj
+476 0 obj<</S/URI/URI(x354.html)>>endobj
+477 0 obj<</Subtype/Link/Rect[554.6 557.6 576.0 570.6]/Border[0 0 0]/A 476 0 R>>endobj
+478 0 obj<</S/URI/URI(x344.html)>>endobj
+479 0 obj<</Subtype/Link/Rect[72.0 504.8 92.2 517.8]/Border[0 0 0]/A 478 0 R>>endobj
+480 0 obj[457 0 R
+459 0 R
+461 0 R
+463 0 R
+465 0 R
+467 0 R
+469 0 R
+471 0 R
+473 0 R
+475 0 R
+477 0 R
+479 0 R
+]endobj
+481 0 obj<</S/URI/URI(x344.html)>>endobj
+482 0 obj<</Subtype/Link/Rect[72.0 597.2 92.2 610.2]/Border[0 0 0]/A 481 0 R>>endobj
+483 0 obj<</S/URI/URI(index.html)>>endobj
+484 0 obj<</Subtype/Link/Rect[310.6 597.2 337.4 610.2]/Border[0 0 0]/A 483 0 R>>endobj
+485 0 obj[482 0 R
+484 0 R
+]endobj
+486 0 obj<</Dests 487 0 R>>endobj
+487 0 obj<</Kids[488 0 R]>>endobj
+488 0 obj<</Limits[(aen11)(x83.html)]/Names[(aen11)489 0 R(aen110)490 0 R(aen126)491 0 R(aen132)492 0 R(aen153)493 0 R(aen161)494 0 R(aen163)495 0 R(aen182)496 0 R(aen199)497 0 R(aen2)498 0 R(aen209)499 0 R(aen221)500 0 R(aen235)501 0 R(aen238)502 0 R(aen24)503 0 R(aen246)504 0 R(aen283)505 0 R(aen295)506 0 R(aen300)507 0 R(aen309)508 0 R(aen322)509 0 R(aen328)510 0 R(aen344)511 0 R(aen354)512 0 R(aen4)513 0 R(aen47)514 0 R(aen60)515 0 R(aen62)516 0 R(aen69)517 0 R(aen79)518 0 R(aen8)519 0 R(aen83)520 0 R(aen85)521 0 R(aen91)522 0 R(aen96)523 0 R(caveat)524 0 R(index.html)525 0 R(x11.html)526 0 R(x161.html)527 0 R(x24.html)528 0 R(x283.html)529 0 R(x309.html)530 0 R(x344.html)531 0 R(x354.html)532 0 R(x47.html)533 0 R(x60.html)534 0 R(x83.html)535 0 R]>>endobj
+489 0 obj<</D[543 0 R/XYZ null 834 null]>>endobj
+490 0 obj<</D[561 0 R/XYZ null 815 null]>>endobj
+491 0 obj<</D[561 0 R/XYZ null 336 null]>>endobj
+492 0 obj<</D[561 0 R/XYZ null 230 null]>>endobj
+493 0 obj<</D[564 0 R/XYZ null 246 null]>>endobj
+494 0 obj<</D[570 0 R/XYZ null 834 null]>>endobj
+495 0 obj<</D[570 0 R/XYZ null 792 null]>>endobj
+496 0 obj<</D[570 0 R/XYZ null 437 null]>>endobj
+497 0 obj<</D[573 0 R/XYZ null 815 null]>>endobj
+498 0 obj<</D[537 0 R/XYZ null 834 null]>>endobj
+499 0 obj<</D[573 0 R/XYZ null 637 null]>>endobj
+500 0 obj<</D[573 0 R/XYZ null 381 null]>>endobj
+501 0 obj<</D[576 0 R/XYZ null 815 null]>>endobj
+502 0 obj<</D[576 0 R/XYZ null 743 null]>>endobj
+503 0 obj<</D[546 0 R/XYZ null 834 null]>>endobj
+504 0 obj<</D[576 0 R/XYZ null 509 null]>>endobj
+505 0 obj<</D[582 0 R/XYZ null 834 null]>>endobj
+506 0 obj<</D[582 0 R/XYZ null 633 null]>>endobj
+507 0 obj<</D[582 0 R/XYZ null 588 null]>>endobj
+508 0 obj<</D[585 0 R/XYZ null 834 null]>>endobj
+509 0 obj<</D[585 0 R/XYZ null 620 null]>>endobj
+510 0 obj<</D[585 0 R/XYZ null 509 null]>>endobj
+511 0 obj<</D[588 0 R/XYZ null 834 null]>>endobj
+512 0 obj<</D[591 0 R/XYZ null 834 null]>>endobj
+513 0 obj<</D[537 0 R/XYZ null 744 null]>>endobj
+514 0 obj<</D[549 0 R/XYZ null 834 null]>>endobj
+515 0 obj<</D[552 0 R/XYZ null 834 null]>>endobj
+516 0 obj<</D[552 0 R/XYZ null 792 null]>>endobj
+517 0 obj<</D[552 0 R/XYZ null 654 null]>>endobj
+518 0 obj<</D[552 0 R/XYZ null 220 null]>>endobj
+519 0 obj<</D[537 0 R/XYZ null 649 null]>>endobj
+520 0 obj<</D[558 0 R/XYZ null 834 null]>>endobj
+521 0 obj<</D[558 0 R/XYZ null 792 null]>>endobj
+522 0 obj<</D[558 0 R/XYZ null 694 null]>>endobj
+523 0 obj<</D[558 0 R/XYZ null 529 null]>>endobj
+524 0 obj<</D[573 0 R/XYZ null 381 null]>>endobj
+525 0 obj<</D[537 0 R/XYZ null 720 null]>>endobj
+526 0 obj<</D[540 0 R/XYZ null 295 null]>>endobj
+527 0 obj<</D[567 0 R/XYZ null 678 null]>>endobj
+528 0 obj<</D[543 0 R/XYZ null 365 null]>>endobj
+529 0 obj<</D[579 0 R/XYZ null 55 null]>>endobj
+530 0 obj<</D[582 0 R/XYZ null 254 null]>>endobj
+531 0 obj<</D[585 0 R/XYZ null 181 null]>>endobj
+532 0 obj<</D[588 0 R/XYZ null 497 null]>>endobj
+533 0 obj<</D[546 0 R/XYZ null 206 null]>>endobj
+534 0 obj<</D[549 0 R/XYZ null 391 null]>>endobj
+535 0 obj<</D[552 0 R/XYZ null 25 null]>>endobj
+536 0 obj<</Type/Pages/MediaBox[0 0 612 792]/Count 20/Kids[537 0 R
+540 0 R
+543 0 R
+546 0 R
+549 0 R
+552 0 R
+555 0 R
+558 0 R
+561 0 R
+564 0 R
+567 0 R
+570 0 R
+573 0 R
+576 0 R
+579 0 R
+582 0 R
+585 0 R
+588 0 R
+591 0 R
+594 0 R
+]>>endobj
+537 0 obj<</Type/Page/Parent 536 0 R/Contents 538 0 R/Resources<</ProcSet[/PDF/Text/ImageB/ImageC/ImageI]/Font<</F8 8 0 R/F9 9 0 R>>>>>>endobj
+538 0 obj<</Length 539 0 R/Filter/FlateDecode>>stream
+x�][sܸr�R��P�I�C��ƣ_��oZ��T�V�I�-���<���cN*���qi�qk�i�������w�o矮��ߧ��>_}�����9�����_��v�����/���_?]}�������o�~����x�o�����OwW_>�������p���oן?}����z8|����7��o�oo�����o׿=���������ׯ�non����?��~sw
+�>�}������/���5��t�x��p�p�x8��������������x�����÷���w�w8�=^���������w!RW�?���?������?��՗�����ӷ�w�ru{������zA��^xA����YcA��(�����=q&'�T;��L��}���������(}q���E�*ug}�}]�vc]�"5��n׮�SӪG�s+�x�������'��u������C�ކW��X��Y|TEF_&���,p6�^��VU��k]��1Օaa�'�����V��_2@���>{ks�^���	�&b����I����ɦ�cg��E�c
+��Z�VP��5�t��������R1v+�S����V3
+޾��t�:������lL��Q$�z5�' ���6?m%�(�l�����i���k�Y@�t�vM�:
+a@����h6юZa�腐¯�O�<�/LIx�z�IZHB][�7�V�B-��kX�V1���Ӛ"c��
+>D�yּiz�Z��D�����LY<	���$@9�yA��5�����2����y�G�B��0U]�0Y��a?�N�IT��(uE��}g<"`ZS�hY��qy��^����7���J�F3о�<h��&%��m�lLg? Sl���HR���"*0�h�^9�ߩ魵"���C'#8͉)�t�ӕ�$�4��u@�;yWWf6&ML�	:�3L�2T�f�n�t���K>�V����C~�����V� fb�i�����b����	���FW�E7:ۢ���j58+m�t�~�6�9h������dO���k�Y�KZDº�>/"@<��&iM���i@N(m9h�JXN���g�������0�hXI�9�B���R8x"S�F��{I�$Lv�vv
+1���ڦ�R���Z���aD��*a��I3@H@F�ֈF7�b`��nz9�@�Cs��\���t��)���B�$�0I�$L0�~�OϮ��֎���-����2/��̒��C�&���h��TL����T��qkW
+��!�Jl
+-~��=����J��b:	{$�����W
+���t
+_��`��jZ�t��N�	�W��~Lz23��i{�N�K=�n��=��� [��n�!	e�����7E���Ib�D������i�KW��"��C���Rt)B��ܽ��z�&�f��v��Ԧ��$%M����I��"���vƃ�\����*���Ih�J��,3�+}p';p+!a�[g
+`�ˣ�uc���7Z�?ՠ�^'�%�'�Z1,U�8���w���4C�&@z�Fr��#ah�3�ֹO���UF����H8u�J��nD����LL�0�n�i/u~F�'��j�&6�'��Vd��O#�[�{"p���$�5�'�s���YSx�5f�+��@�U���ho�x�d�~	��g.�4�[Rp:7���y��Wqe�.j`�c�S�I��	ko͘´ܽ�f��7�ى�T3ᎀrh�cfI@��3$��C(�ڬ�d�\�K;7���U*��<f�3|6-��i��g���nx�4�������"b��E�.~9��1!1�G���	���\�vTe�aa76���$K��I��W|w�WmyLH0OB�$�H�@9����6��%IF(�	���0�z��hʡ-�YF�1I�6�H؋����&g�gq�ہ@
+����l������,�NUG�ʽ�ʡ-�	�4b�&)Kh�� Qs
+d�3I�BI�W� %/��*ص'/
+��$P�E�D��}�ЖDŽ�����,	� lG���S�
+5�#D\&�<35�]ޑ���:Y.%*��<f9	�Iʒ���B��;H&=��I���S�&�pׄ�ǹ4�gUmy�$����F�ط.�g'Va�1�O������lx�9�� (��cV8��=m�	3�˞��$eI��s$l�)0�-�L@�1k�Jn�6PJ��ϘM�5�rh�cB��(�B�H�:$T�&�:���x��`A��ɬ�r��~�������/��<&�a	[�'6=�f
+'<�D�H���CT�`�l`֨��g��M߁ہ�ͫ�ЖǜM�U_�E?GUIAz�^Y��@-q��<�%�_9�j$G��&��~�������+��<&�;OLQԌJ�IU���@UP��P�H�+���1���
+7�t�~�r����ʁ'n�d�C[��K>�6G#�F�I0�����J�#q���	�Na�!tn��0c�Ckg�̠�M��ŏT�C[s	h����&4�8U�
+g
+�ީ�'�ކ��p���,��e+:�_ W���`��X�O�HU9�D��t��k�1I)�S#�BiUH�P�>���Z�K\]�B����Ԥ���c�����p�LDa+��L�F�D�5� �N����oK-2��ֈ�Sgm�&���×$�����T�2N�5���\]S7�l�!!p~\��B����&Z���ٮD��$D�_���$v��}D��R����w����L㚼I�Z��l� y�`����8�,pMr ��ơk�����V�u��cc;tTF�nձ'.�mը#��;��B؟��r�3�U3�;ݚ��Q��S/0�SGS��b��������4c�	�`�3y
+�.�+�n�����*�`�}�0үWq�$�����O���>�#>���$V�G-\ �lD�'|�D�@F�v��=����x�6πN��a�+��:8`225�E�&�V@��Y��:l�����
+�f�J��ByεJ��HN��a%vZ��5����t�̕�ދa�a��<�ug��˻#*��H�ֱ1M�� ��u��j�DhӬ���$	��ީ&"�F�
+��_^�zN3	�%�q��R��9��TM��Gf�A#!��%A)�$O��	ߥ�|���-
+I�*U@"�8���$����E��HI��K�|U`�d�ۍ)����I���{��˶{��i�KE	�L���ᒰ-�UX}~|	�H0��.�����}�)Q�:8������]��"-$��V���o��
+��B�\t��@oL���/�PbqCJ��N�����}2I���{��6PS,��&D�Q:1˛�Y����|\�W�V� �&o����(�y�W1	F�x�h�	Վ�
+	t9j�B�
+�nq�Wb�T^�4%�PC�㑷/�#��m.�H��[?i��;��d8f��ȩ~������~qC��2��2����e�
+1Ӂq���`��^Tp�T_�T�$8&�9�I�;�bE�����e�Q	˺�^�Z�
+�I�"��oO��v��>����:����h�0�wkc\�77uG�
+��瀴	���s_�@Kbf#B�R��=:=������e(���x��T�e@�B�再2뺭&,j�6a��J3O�XX�~/	Kأ�S ���S�<K�|y�
+t���O\s!3wQ2��"��e�J"e�9�����M��HƋ��Ӌ7#�G"z.��NOI-�$9�g)B��]�h\,f�ː����n\W5=��/'�C
+�"R��\x���|%Z��(�O�H�P$.uέ��ȥ��4�RJK�܃81��{[�[���`lZ�›D'�?s�b��H��?b�39�ۭOwza��S\��IXw��"��h���-g�`�k��)X|���}�Q���{��� y,�yk4W�i�Y5���w�'��c[�Ӄ�x��WP#b�����+�_M��	{�{Z����9�.
+M��7!$Oba�h�&;,�*�~�G��<�rMUB/_��~� ΁Q��X����_�	h��,�8�Y�Ou�-���C�ո�71wQ��6��w�H{[bU]��/��/a�E����=X��S����#M8��
+�K���;2��<�V���>%WWq�����^˅�gb��MC�۶�1a��/��j���������i��GV8u��"�k�$�a$u�ѿQ�W�u\�u���fH����q�"�5" 9@���	U@��w�7̂����r�Dz�٧�J�E��u3���0
+-
+�ᰰ��P�U'���Š(kD1�l�/��4E��A@Q�i�����n��%~��/�9雑*m͉������O?W��+Gk$R��^_����%�(�sJ�a��ۍ��J��x�������0��&)]N񱶴�D��������3$l#b0(��a�Bp*��4��^ꀀQ�
+ j�p�x�S�O��:��^�G�t]�ѓ
+F�;I&q+���4��"��X�P�p\EH��|~�#��53*��r����BH�eʞ��Jq�Ms�A:��0�/���" �M��m|H���]+T����+�$X�p����Ys�q+�����i���&�Fr�f.��Ml0J��&���>��� �/4H��\� m��<sc�a���^���7��Ӧ��w�-�d6�)�S#w�������Rk� (%���7��.9�0�,�~(��
+��P�S�IH6�4�7�^�ڧi2�e߄G����px)1H;�A���*�Z.�;f�δ��>����-��� �J��
+���ȜD�߷i��@.�����m���f�g�T=d�3�#�5�i�p%�A��*����"L�C��9��W�
+h$�*�+��"X��f�%�ƒ`��&-�
+@Cz?�d]�|������3Yy��LZxg����S@R���:
+��!���A���Ӕ�₇I��90��
+�#7X�[���k��W�-s'KiU�惡���$p;���0��$S�B�7�8�����OB� ���N���BE`�u�G�i&��uL����uS����A�F?�n�r\>�?�
+ž��c.(�ʝV�W�n����ma�\�C�ʂ�߂����YՇ_�e�#V�vɲj�-(ӱwAc*��>#	3�U��D��_�;�,Xĕ��C�GI����P��FT!z�Ǵx�i��mK1[����b]��U#!@Y��(A<��u�6�<d�C�`�%sf�A�B��b00U�g�f!O#39p-Rф9L(�+���G#�g 潲��TqRג;�֝��Q����tP_�K���/�����͓����D��g�4�t�y��8b}xZ�P�C�yxf�C�됅޸2�.�^���F����z��j�v��MU5PװS� �m8;����^�y����NJ��/_R�E���l��'B��1F�N"eH7���Bgv�d0P| ���#b`� ކ�^F`��s�$`-t���>��m42�Q���0
+#�
+k��,H:O�;�-�!L\b[�ElD~hѥ~Cu�Z>i�(�z�ij���%���yXGB����m�w�'�X%؅�����P�������Pv����rJ�eFs��cb@�<�Ƣ�2��f�\���0d`��Q���ز
+��`mv����E��WZ�i֬1��|~fс�윪�{��
+U
+��V�=�h�cI�ʂ�A@/.E���$	�ɚE�DC�4ͪ�M�_6;�8��:$�I���ֽfH�
+��M{M˼�4N㬐W,HEІ J�- �hJ���Y?�������h6����IM��$l��5��rj;���3j��$Y�d�M@����0�7O�K5e�6
+I{dD�َ��G�nE��N�#�
+�����p/������U���8x*��XH����Lr*�w�${���Ar�������[���Ԋ��D��FaFۼ��86�b�y��w�$>�JX+�
+��팛-}�I�N�/��Bb�zI�*qN�
+,��z?�`��cY�w�{�
+ȱc7‚c�6<�hf��~���;-r5v	�dARKX���í೬�*�p5�0�+��	�m��;d�l`�as���:��zzE����R̢M�Z�q���OZ�LI�i��zk�:�	d�s�֎E�]�pG�O�I���P�Ք4K��xsZʜ/P�or�[���/�Ԙ(I��B�������}�،�J<�������N@^��$l�{Yg{@q�q��1�~2_�H���ڤ��+hCU�4\��U
+�P�<�U���������ap$�=�<["{7�a/�r�s|v�0�-�I���5*���r�&�)/�)V�LX�*H9kX�UW（Ѹ90�/������B���|�"	���[����_~��a�m�C�x�L,-�.�!K~�lłu����o�O��ߤ��~� #I��|'8�<>|�������>�d�lW�7��Խb�<~�{d�	�I�q��S4����J�`�v+Y��i����-W�t�%�AE�|[F1ۭ��D}/]�#�Lj��g����N2Ndt��î�6X/X@����d�T�~D���(��&��I�1kk+�X��(���%AB��G� v������
+@���刻Ǔv�∸��h�)?���:�	��J8`�=€4_�#b(䞤Y8��M�a�1��A�
+�me&Q�	+i���il痊6nN�g��z��d��҄MBbHh�H9��NOq���
+}͵i�	k9X�$}��"�e�Y��A�U�	X8�챤�N��M	54@��^2�B��N�̂��(4�W��ClO�L�#9��cI(�Q^Ѥw�I�=|=V�TN�Y0$|���"1�@o�	%al�$�N��cv�͂��p��jH����>Yj�����tL		�����	*"ts���s
+��sO���0�,�ւ���)����z�F7m��`2*ĥ�*Byo�����#�HǑ`�/��{�Yc$�,�L_��٩��|�M3�&��N�Q$�g�X|27U�#a����.�V/*��#�
+�G�nn���nKp0�z�!�y8�o=�� �"���ٚ�G�e
+5��G|_ꈆ��8���8	�:RL1/?���9Y�rۖ��2c:a?��lb�����S��a�$�����B���4����m��ΑHzFϋ���B,�ϒP ��æF$/����5؊� �_����e^�ً�/â�O�U�'�c�6�%Ҹ�92����H6�7@��i%E����e�Ցt,�������b�\�L�>{��6�[�I�BE�4$�u5�Iѓi�+]��|VZ�ѭ|=�E��֝~#A<9
+;25	>._�*r�K��!�4�g�7�]�F,W�V��3�܂��¬��<���(XM�����"p�KŸ��Kj���ۏ^@{4	��b���Ll4/���Y��(
+/��,%4�~��L�
+?õ}1F����^xA�Y�;������r��
+������s
+��w�T0�TIS042P025�3WI�P�/H�stV��+.I��I,���Sp/�LIU���r
+�
+����+endstream
+endobj
+539 0 obj
+7633
+endobj
+540 0 obj<</Type/Page/Parent 536 0 R/Contents 541 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F4 4 0 R/F6 6 0 R/F7 7 0 R/F8 8 0 R/F9 9 0 R>>>>/Annots 97 0 R>>endobj
+541 0 obj<</Length 542 0 R/Filter/FlateDecode>>stream
+x�X�r�F��+��`��ĶbU��x!S9D9@�PD��@���y=�C�9eYć7ݯ����+A.�	�=�#�UWo�W�ޥ$R���M�ƎG����Q֯�n跺볲������T����������� vB~�Ks/۾��,��n+��eߕ;�ԝ���^PV��$�KleV
+�	�)�ԉ�r{(:�?����M��z�v7�C�g����S]�y�zYѱi�	�����Vn>��/r�*+�&���S���<˯?du� +Y���!eN��N��A����>��8�m+e�O�O���)"���{�蘵}G͞���7V�����_p*�_����ˢ~������JG?�EN�T�w�=e�#y�+��ߊ�#��X�3ͯ�+�q)�C�2t\{��J�9�� mB����Kɜo��� 40!��ƿ��2�ů�TQ�O7%m�h��0�^8�JhpT��x``gB�����"����(�'O�`Ï���C�s�]�ip2H�xrR�h'�E���A�g�g��ĩ@e��:jm��`�mp1�c���ikD ���I�$~U�Q%�cs�Z"��\�S����<�G$�WT7�Hx>���o����ں��ļ��`m������}o ���3�������﹧�2�Y�?��ZB��縟�X>�;��~i�A�'B��_|����l_q����Y� ���a�b+\w��Z�Cp��UL:v/Ac�Z��j���M��(u��O�t�R�����
+��9)����!:�]`��ܓ�-}_<�����*J]�M�X=�.�Ɔ�����GPl����$��Ә����$B�ښMV���]�����E�悋�D�>�*���D߬��h.R�/\��yHYM��-σr���ma��T�J� �|"a�:�1o�-�ݨ��C`��v�Xa�P7���
+�H�&���0Ƞ�@F��ˬ1�j>ቘ�b;�h#@m/��=c���x&���[��nL?�SB�B�`��c��I�A��M� �Ə�y)�@��WV]��D��("+�@����k���<?`�'{.���b��#�ztt��眦�-�_����~��pR�آ��3t��y�d��9�����1�c�@I��x5�Y�����o �Gq��X�3��i����ű�}�Tt�ϛl�;��K���������X����JHl�0Ϩ�'%K�d�(��g�eT��O>����C��ƀ��}�RF��7Y>&t��/UM.K{gI�agA�ڒ����C'�(4S�As�O�K}����a�6�@�b��3uF����r��wpz]��h�#~��-� ���`�f&b}$�ĺ�����c&��l�@a�y����d�_wX����Ɓу�-{z8F;���D�J��n�]z<�6�Ԇ�~��gq��[�
+���d{�4��`k��ظ
+����K�o[	v]z���zi����#�K/
+�f4���b���7����*�t���Z���-�AS2/Z�뛶@i������ެ�$�lw�ﶪ���}�G!�dރյ%s�Q{�%qg&�U��2�Y����O[���?i���endstream
+endobj
+542 0 obj
+1579
+endobj
+543 0 obj<</Type/Page/Parent 536 0 R/Contents 544 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F4 4 0 R/F5 5 0 R/F6 6 0 R/F8 8 0 R>>>>/Annots 215 0 R>>endobj
+544 0 obj<</Length 545 0 R/Filter/FlateDecode>>stream
+x��[o�V���)����n�SB@��B�U�f�Mܬ���&���o�x=��g����g����!�\�BZg�oϮn�l��������#ge�فSA���t��y�6$ǡ�
+�Ev�_ߦ/B˳����%
+!9�kyB��-_�Pᇯ�w�ν6�U���vu^�ѧ�.�ɫ����u4V��
+�*(�`Vw譞i��G��6hc��X/�����I�$v��`;���$�;�����\�$8��� �,V�<�9�� 
+r=�>���;'������/��<�#<ٻ�{c.\�)��_ծn�톒����jJʔ>$����}��E^�Dr"�l$g������A�����BJ=�VB�<w����	\�]SS��s���RG�j&�5����1�����V��G�#�S_�/NMS�/�9��f�	�^]�Ҧ�����?�������\���6K�1i��NBF���y��ֻ��V�-3��fZV�h�2C%/�����}�<O �7
+.	�6h�#��q��r[5\�o��.����тVⲟ8 4�O���)��4	3�?���~B��Q��Rh�K��K��p#�xA��S�>v��4��@��.7�W�<x�o�ͮ�K%G�T�CC__p+o�dߘO�__�Eq�3��K�A�~��Zk��6H�l!�H�'��м'=���mw}4\�1��G�Ffj�%��^����~�� �G.z�*_�W\�*/��Q:/	�X�t�K<���I��d��A��a|��i��r*�=v#�F���3JvmU$m�N��=U�6T����ZT�UR��,�����l�r�g�ח�r�a����/�Xv��V{~�W�B�Y���{����-x��\�%ou��\�$����L���9�y�������io�PY=�3/�.;��045���As��Il�hMm�����c��V��������S��pIpSF�gf���p
+K_'k��������i�����{J�6��4Y��؏���ô�0{��s!�1���ua�e.�I�<������@@Xy���P*.	�!��&^���28�G?^o8p�`ؙ���Ov���"�Ѽ�*�m��r��M3��y�t-��Y���/�k�$u>�J:��1(�PO��㩩�����U���a� ��o��"	�X�W:/���H<z���ܖU��%�n/��@0���I��du@�|���QZ�]E��w�m�+�{t�uR�c�щ��;��#����lu8E��qwU�����I�<c��
+���@Tl����>�������=}Ī�a�m��w�����[��x�[ٝo�f,D�W�I��Zs��ppUq��8�������wQ�ݖ���2|�syXs�j�(��Yz��~�d�����E��Q}8�kݶο��E�u����5��%�Ia�cN�����y��#��3��zq�~�r��һ���v��(�݇9b�F�i��t/����7�
+�-���,‹e(��օ�S�7���e�w��q�������{�3k2pP��#�ќ�+�j���wZ~�-1o�Ǭ���a����u��(�G�Ď��b�ǒ�n����Z��&��!��a��Wo'Ǻ!r8�S�=-����}����@/l�������Ե�1�|�?�_�endstream
+endobj
+545 0 obj
+1684
+endobj
+546 0 obj<</Type/Page/Parent 536 0 R/Contents 547 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F4 4 0 R/F5 5 0 R/F8 8 0 R/F9 9 0 R>>>>/Annots 246 0 R>>endobj
+547 0 obj<</Length 548 0 R/Filter/FlateDecode>>stream
+x�V�r�8��+�6v�E����lg�IU&������D$$�@���y
+�eYSS.�����ׯ��EH��4�(�QZ^�>^�?,)\���̖� ���2�g.)K_jY��=\=��iBaؚ��Y���M�j��jCN��\��{#ee릺&�K*��(5R8mH��gp��}Nh��)Na}c�{�QNН.˦RnG;�dI�g$I�q�/��n+��S�UEA�,j��V�*2�)Wd�yV��0p9�.p�զ�(�J�Գ�L�H^i$oD����F�����Bf��	+�r.N�������$>)�I�����Iݫ���km�*��]���%pH�4|؀�}�����{�Y�p ��K+`ON���Z.���U��Ÿ�p)\.���{��Λ*���1 5�����1��N���(h�Ũ��`;��VZ��5�Ͻ��,����t)
+�9����`v��|��0
+�%Mg	�TR�L�Yw*聹;�q��p�x
+�,$�Ppq�;vo6t�;W���\;Tҍ�Ό=�{6�h�!�e�?�I��b�ϼK���)����!NK��%�(p�S�������)yh9���.�`��Ӭ�C���˧+���\m�bG�e8h���c�3��������|��@4��݀Z�1�k�v��Q��c#i�6P
+��5m��k����D��^o9x;�7 2gq�΃9M�y����{������w��A3Ϟ7�9pQR8����ػ�(w���4s�o ���W��`�a���ƈ��g�5��Z�Ͻfd�Y�L6�I�AqyX}�|�ɗ��D���ms�	�s�$<��Y\�I�9M�?��$�N{d�岝ӏk�yV
+��ҍ%H/��2
+�6�
+������|K��1
+�(�R9`�K�Т�tڳĜ����+谮�d�������5-��?�k.R��ߍ��$0]h%��a`���6�����(�
+�VXny�|�֡�>����? �%�a��J��߂ϫ�b{�d*P(���W*�Ƥm
+jcǞ��1�;�K! OW��{]ѭH��P/�H�p�j�,�`�aG�fo��市k���\���c�IU��5�|�ě]B1er���B�b�l/R�N���K�:�r�g���f�d�5#��hޝԞ��t�W�	
+�$��/�~���ۂ��	g��,;�/7�/�y�O���/~���l�
+�|�.�~L��	E�� �_��w)������`v�C_�I2l�h_�_�|>h��<c}'Ǯ{���_x�u�`��ښ���
+:g��y�Qk�����F�CO������dLxS�ބaԞ���7[%�q1M�7�/�?L��(�ϐ������-�Yۢ�mvҢ��=�7�6������;�t���(ݞ�m�L�W��v�/&�~�endstream
+endobj
+548 0 obj
+1398
+endobj
+549 0 obj<</Type/Page/Parent 536 0 R/Contents 550 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F4 4 0 R/F5 5 0 R/F6 6 0 R/F8 8 0 R/F9 9 0 R>>>>/Annots 299 0 R>>endobj
+550 0 obj<</Length 551 0 R/Filter/FlateDecode>>stream
+x�Xao�8��_1�.lŲe;��v�
+Ц�Ľ=�z8�ms#�^�����ސ�,�����AQ3�7o���UL��i:�ф���������͗x2�M�!ͳ�aD��������2#���%}�����w�?�~�_
+���<�Y#�YtK�o�$,rz����j:�.��[;1eVt}��S%�V���n'?�>���H٣y��e)��zTԹUd�F�����fY紓���S-�Z��땤JYYQU�k��I�x��:�R]���L��y���Q([y�Ilri�s�ɭ������M.�R��U��LVjUु��
+cO\���J�˥J�i*��S�	+��҅ԛ�6��(��/�_��CIK�0�0{����@A6�����L-�0�<	�ZiHd��j����֨Em�.� 2��ZVa��1tR�#G�F�/�^e+Z�B����J�hD�x
+j�cdį����1i#�EN��D�����77��.�`rYe�6+w��-����' 2����Q[���L��q������ע��
+I��vʂDT��`N�P��oD
+Tl��n��:UZYf�ؓ\��U*�����������,�R�l�D�2��t�Ƨ��l���`�b&�QL�I�f�ï��'c_(K
+��df����>ta*_U}�
+�ߦ�,KXyƣ�S��0���!���z�+�2��O�w���
+�\�=K�6j@��!&}%X�*�e_YYnd[�Ov���Fa�
+i^g,�Y��[a�@���˴6F���F���.s�
+�KǏB��.@
+�C.��N_��(���hN%.��?�ܕe}���_���'[��A����:U8:��V�u���p :�r��.�o���M����Aπ,�捦 }븹���r��e.�8�����ÿ����;w���U�)�Ǝ=I�>~�]��S�B2z2E��6񃾻P�J8�UF�{l����V�er�����*뿎��:����.�k}F۞��ߚ���Pa��
+�;���z�Ĉ5@�K�	I4 0�R��G(��7n`Y��A>I�#�B�|�]�inۈ��{�2zA���|�f � �mstl�u�&��֝�[>�?��dqJFC'U����$���+��;街���:�t;d�8�l�d`���ـ>5`�9lǠu�R�
+=#Q���gc�G&`8aQWۨ��4jb	~\&.ص�G�}�MH����V2���ޕ��KɊ&1YU�A�9��)t�>{l�g ��6������7�P���n2
+V�ܲ�M��B<��
+
+t�^�1��� WgSF�h4F�G��$,Z΍f#<��c�Hm�I�Y[��A�a�����X;�4��?
+>
+N�2T�+:j1�]���J�~y�s�(_���re��WkQp�p�pQ���ķU�}������
+�s�����g�	ЍS�Ô./3x��~3q�J��U�!��ӌNS1�)b+T�M��H����a
+���usR쐇��njw�n��x���6`4��V�wĖMţ?�ߴɹ���41���C�Cc�Ļ��������x�L���/Q{��,8nnMU�7�||�@�3�b(1>�X��g�1�o�F7L�a�_�Jp�pt��g�~����U�q3���Tk]癿˺n�+k9˙��`3��^g�<}͉�� >L�ˍ�����S�wt|��E�1�bN���G��ݯ�o�[v�If��	�B}������~�_�CA#�j���=ϻ;��8��?���H!�����ݳR#p�N�d.Єas�V�	����Ihw���Աo��a�����-.���gajbn��A��(��x�0s��]�N',Č���*���
+x��4j�����d��2��P�vqoL��`��d0���~��z��y�1&~���Q��?����j�����|A��|&�ȸ�x'����E�˝oC�g~-����7�܏��?���$��7X/uk�]m9�/�!~q1�{��[��84><�GN†�X�Q�5��p�Ju´߮�iť�endstream
+endobj
+551 0 obj
+2092
+endobj
+552 0 obj<</Type/Page/Parent 536 0 R/Contents 553 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F4 4 0 R/F5 5 0 R/F8 8 0 R/F9 9 0 R/Fc 10 0 R>>>>/Annots 310 0 R>>endobj
+553 0 obj<</Length 554 0 R/Filter/FlateDecode>>stream
+x�U�r�8��+�t�]eA"EmsI%��'U)g�R>��������4��%_�.��,sH�RD��{����:
+��h�pL�꼞w��3�f4_ag<�����Րѝ�^�5Y��#yC�������������:Ջ�,	��S���Yc��bIN؝����$5��x���ǭLy���;�\꧐�S��Z���+2ʤ{��ʝX\3z�:�ŀzѰb���uG~#���q+H�"���-4�"�r��2^�����>~��x�Y�p7$x�i���EjW,3	���c��1�5��B��x����w)���f��5�M�g��m0��/�i��h�	2+2��ȫ@Lj��[��_LM���0�(��W�����o�7�۳u���AK�T�Ay
+��� �dX��+�t�a��<�s�1IG��P�
+�3���ݛ��tNp��6�=S�*%�K�ڠ�c��g-����G�bt�O�^�9va���f�K���p���eK��I�y�$�����֣Oћ�ግ�t,�񄪀fv&l�vpf�:7\�B������%CR��
+=0��ն�����~*�2��c���.�R���9��Y��c�fe[�D�:_w�_JHq���Ϙ�f��gr��'D��ͭ��횠�yg���	�6$�?�ޮ�.����OwaA�`�:*�(w���!ܭ��� ����]��7N���<�=�nj���*oĊ�X2���U������^�)<�-��~��<ݺ�����������C�'S6�h�-[?�٬Z�z��z-�C��ßU{�����q�F�tԠ�Vc����Bf?�j3'(J]�j���<�
+�x�&�e�*7���gI���1��J��%]��]�}�|M`0�endstream
+endobj
+554 0 obj
+861
+endobj
+555 0 obj<</Type/Page/Parent 536 0 R/Contents 556 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F0 3 0 R/F4 4 0 R/F5 5 0 R/F8 8 0 R/F9 9 0 R>>>>/Annots 333 0 R>>endobj
+556 0 obj<</Length 557 0 R/Filter/FlateDecode>>stream
+x�W�n7}�W�u�ku�d)}��i��M#EQ�˕��*ɵ�����r/���	`I�ù�9���lL#��Մ�sJ˳g�g/o�F�bA������ɂf�K|_���J�!;��d�L�+~�@��@����K/�6����
+�n��˄����I{/���7��o?�����c�qB���(��t'�Dp��	G��ͦ�%�g�JZ\�?
+Zq���K��K!FX�E��/I�I�=U%���d���.�ƍ����d�u�����'�Yv�	d7F�uB+U�
+�%����T&O�5�.�Y���rt�nv�ᄮ�%�ҒB���R��v�$<?�Ծ��.ǣϲ�Ũ���J���q�]-��~>�O&s`	{�i/�*W2���_���~����h4��%t�w;kօ,��ܩ�ɽ�[�mҔ��+E���y?|�t�)8D���~����B~�U�
+�(tf�G�Og����L�=�a�*22�8�F��3S�&:!�>��OVA<��Q��|y�l͓1�ͧ`�0"��r�:�fә��I���{ᓻ�QU��_MEe�<�V��9�݆$��TNq��Y[iP(�V!��(H���
+Yc<�\�
+�~��$�DV� L���yw���W�@&�Z}�*Z�QZ��(9���	��$���\m*��c�|�B�\��R���k�%J���ħ媐��U<�J�/��O�#@��5�v�ng��ez��:�e*8;=���d<�����������@p�5�T�'j�i~��\"։~-��|�f���_9�z2x���[T$��`�����vY�3#��\Z�x��@3yA��FY�O�����)�פ��\��2Ks�6�4���e���{���E;2i�ɞs�Sԑ��,�#� �Rj�^q��m��5
+�*���L��Yp(�7�|$�,wV����㹥����ǹ:3����V������|+�v2�`��1��}`c�)
+��`�4�m�o��y�f��#Z2o�4��0���#��G�
+��0�
+���<\��r;c����w�o����3D�|]��G�5i
+�P���™��)�<Ɛ���7�ĺ�/@eY�o�:8��h��[S2��JT��ِJ��Q�Ͷ.t�☾J����
+�ૐ�~�(&
+&h�=8����H�J��H�}`p�J :�>��ݢ�`d��oձy 9�\P�n���n����	t
+5����#�0�\�.\�TD�<U$�R_7B��B6� ����)�[9:=P�T��Zi��� [��<\/�ұ7�
+(�0f?CVN�=���M��wQ{�0�|4�f-�!s���l��h����[�[�j?����V�����������oյZBZ�z�F�7�ƮU�Iݞ��k��A��W]z�E�[��|��VU��ڢ��8�ٱ(�ƭ�����:��.3&���X��0�b���^�o��k�Ò�p�&���W���׎	6�9]-��4���R���ڱ1C6ē+��gʠ�"���A'����g�|�*ݳ	��#�[q�>���ழ���S�H��u7h��"�iL��[��n�r~������7�/lhκ0q*Ǚ
+��ͅ�1���r�ĥ7��X��H��w�
+ז/�<|]�umh�hW�I��e��"�Д7D$l��{,ؑ4ońU)lo��?
+H�[�����N��Q���<��].&��z�k�����ɳO����Ԃm9^I�y���BG��^ئ&�l��k���a����X���
+^��"��/���y�ĵ�(�-����ܪendstream
+endobj
+557 0 obj
+1792
+endobj
+558 0 obj<</Type/Page/Parent 536 0 R/Contents 559 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F4 4 0 R/F8 8 0 R>>>>/Annots 338 0 R>>endobj
+559 0 obj<</Length 560 0 R/Filter/FlateDecode>>stream
+xm��
+1��y�9ꥦ����z���=X��M��A%00!�on��2�`�p쩍��Ċe_Dٯ���F�0�L5W���}>c�����x�N��i���>����r#�a;+�sP�6�1������u� =�AF|N�hGO�2�endstream
+endobj
+560 0 obj
+145
+endobj
+561 0 obj<</Type/Page/Parent 536 0 R/Contents 562 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F0 3 0 R/F4 4 0 R/F6 6 0 R/F8 8 0 R/F9 9 0 R>>>>/Annots 349 0 R>>endobj
+562 0 obj<</Length 563 0 R/Filter/FlateDecode>>stream
+x}Wko�6��_q�}���+v���em �+�
+Z�e.���TT���\J�e'�:�xy�����)M�oJ�3�/)�O~8y�p2�..h�aR���l-i19�׳|I�����;9����������%=l`vyy��!,"���K���r{��ZD�܈/��4���:�e�H�]9�鴽0[Fg|�j��$Aka�h�iI5*�S���R	�Ц�nHVJ�Wy����`�����
+N9̯�4��i9? 9M'KD�����E��»Հ�������zӣ2��F[�g����N#B��D�k� ��4*�D�E�E¨�"�X���~S���_�
+�hq�Y�i6_p���U�����m�+ߎ�u]Ge�d�=��Ilj��X$�*�m����J�>�W�1��i-�9!�s����?�@�=� �,�ʑp䶒��%�
+��ym�b��c���Z�-Y|%�#��TȚ6R����V��7���)�$�F�y�tU8�B�nHN���I�0�~JC�I���2�$Q�,���eB%Cv����,��F����s�)�(b��}*e���V��i����ꭂ��`:�tMk��pa��[�!� �R)Ri���^�(�6��)��½�_�g��j	��R�_ejjn���,��>��H��G.��κ���-�t��`�j�~K��l=���"���ZXIeVY�W��1�7�Zl�*\�����#�m~�|ћ����~�`������_<	��5:	8�RϾk�����"�>ղ�\�G�g�t����
+�e�f�0ae�]'E����ɔ?D�m���:���#g����Gz3���1L	ZH\1����bB29��W�󈮺�Î�
+01
+����ݧ[+
+~�w/�G���#s!�
+m%B̭BU�Y��?��I�S���Ժ�7$�%u��9���	ƣ51<�܁
+�by`*$:��w� ���|w-�����@q*8�ҭ�L��0j?Ӛ�=���:���_�~�VT\�_������q�����?����\�,�~|��YM��G?E&����;`V���N㋵�+Ә�2}��?�C��s<��N���{'�R&��a�"|v�;�b�[�%��,P����VՏ��p���*[���PXu��E�1L�9#%�Ifχ� zNp.��y����Ы��r�m������1�X`Jϖ�~���ݯ0�i�%�o ���L9�;�*��bg�94����|�~Շ�՜��s�k<b�6ޙz��<����?X$�~�0�q��f��ՌO&O�n/��%ϟP�
+�i�,=b�ݬf=�坉��7�~&{eU�E���2T_(���j`�Z�(�4��U���6���h��Wr|f_gfa�
+ D�[x�G`&�	�+B�r1l�p�%�k��x�x�wo�v�ZfYS����x��ޣ�#ӈ b�a��-��?L蒷�
+Ͱ����׷7��:��gK˸L���Qo�����@r��}���k�0^���뛏W��ȏu�ϛA��ʏ�~�{��x�5p,t�̬C��)BOyUϑk��{}�o��~��US�	��Xp/Q�l�zG@v>iޅ����9^�oJ�Ь��v�k�l�����;�	}d�l7~��;Ͷ�Ƃ�K����ٍ�q�8�;��vE�䛪(�Lyal�,���ΰ��q���hT~�'�-��X�|qk�R8��ZƂw�.��xo�eZ?Z����M�Bcg/Y���*��^�y����4���]
+P�p� ��l���+h�9���?�\�endstream
+endobj
+563 0 obj
+1779
+endobj
+564 0 obj<</Type/Page/Parent 536 0 R/Contents 565 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F0 3 0 R/F4 4 0 R/F6 6 0 R/F8 8 0 R/F9 9 0 R>>>>/Annots 358 0 R>>endobj
+565 0 obj<</Length 566 0 R/Filter/FlateDecode>>stream
+x�WMS�H��+��`�l���lB�"���*_��؞E�Q4#�����H��Hv+����Q���ݯ[?NB�_Hc��)JOn�'�'����_F4���1�FS\O.�K����f��f�٫_`?������W΂KZn��b�2�͂i@�J�j���r��9�Y��&��FӍ��ž/�9�N)�c��`<�l�q�-w�J���#��&)�LJ�2�֊����)/�VzK_2���Z�i]8�#����eL;	k�֔#�H,����ٓ3���	��t�<b`�lZ1t�HY��-�Wi3)����x�{���PlȂ��cV�������TN��J��x����
+!�Mq�$��t*�$� �����t��:�3̚�>mTn]�:q���,7L!��c�,�&R��!k=I�~'5]��P��a��B#�U�%*Nݯ�縿"��s�PN	'�Mc/2��@�ٳ�`���QD�H�7j��c�J*�n�&,�aT��\&RX[�G�}~�@"\��d�-����w�1򏔨�t
+���`T����'1_�1@�+��A��*��amc�Oi��:��H3k�,W�ݚ�u}V�32i�n�k���t����.-�o�u����E�<
+�!���Я�GR�lZ�G6�U��U�GtŽ��1Z�7�-h�����i�ٰ��01�H���k��������d`�t��1�O	�����X8qְ�5��X�@��*��EarB�>j¢���L��"��CO&
+]�%��a�A(�,�u����5T�d�о�@,�vrX����i�r,w��Nȃ��k|A�����S*�w%:��!
+U��r#���|�oȯEr�Sю�d/J�
+]�<�&F)f�VX-�;օW?A���*�<6&̅�7�:�m&"<��4�(ڶ�$w�b	�$s-�B�
+H�R���zh\5M���`�UZ��>
+��.ག�=& h�l}�x4ڃ�X���0�-��@cK�w���`X���ĸ�,��O�z��U?��9��^]R {��@��"�R��q7���7oT��������v(�	��NP.���>�
+r51�T�
+�i��)��
+'�=ٜ�ɦJ�X
+M��I/�<��T��������$b�4~
+ȸ����"�jK�����Ԣ��K�So�����q7HhXױ��ž}�A�֘R�ʭ����qg2�)x�	o�WrV�x��'�����7�_���Z�€���
+pF0������k�[;��V(8�e�`x��B�b ��7��Myh��&�u�a�J
+����u�4�>��Nw�s��&�`Ii����5��Y���~�j��w�€�����,���L��5����o�@���`8������a}�+]����`$W1�MT����9��kz�]��b?~��4��p�{xJ��Xʫ/	-x�Ǫ�5+��pPUa��Z�@J�t|Gsǭ�q�>��W��y�u"��xLZ�_�=xx{���1,��uZs�L"s�$�X�Xz��2��|f9�y��I^��ݾ�c��/+�{^U/,��>�j�o�/���A��x8��-Ȩ�z��ʪ����7���*7:���%�	V%��2�m���O~9�!����\�]�a�"�>��L�z�[Mf��P[�:e�!u�,X���	=n����]D��`���c�Vĩ�����=�Cf�\����F��}���Oզ����C�<���w/��Wa� Sx!;xAj^���}�^*9���dŴ}������a���0�5Fׯ!\�e�6��c�����g��Bo��op����{kGtu�;�O��iendstream
+endobj
+566 0 obj
+1827
+endobj
+567 0 obj<</Type/Page/Parent 536 0 R/Contents 568 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F0 3 0 R/F4 4 0 R/F6 6 0 R/F8 8 0 R/F9 9 0 R/Fc 10 0 R>>>>>>endobj
+568 0 obj<</Length 569 0 R/Filter/FlateDecode>>stream
+x�W�R�H}�+�ͦʒ�ؐ<��l�@�yH��Rci$�2�(3�|�����U�-(c����>�}��hH�i6����������h���Ӌ��a@��qxJ'�	ޏgx��R�ŧ�,��d2������t���t����A�{���ń�CZ��u6�"�E��~~CQwSihi�	G��:<^�s4�`4
+'|�š5�&��h)c��T�$UNZzwu�?�xW+�)6y.�M^WfV�|�d�QW�YH��Z��񡓀>�ݪ��r�����1����K�$�ܺJh�!U6.�M4��I}d�\G�b��;��ɲTy!}�h��8C�\��d����.�D��Xɜb+EٸI���0�y�=q�|�a�0.|����]�D(Q���6��B��>���+�ZV�29�i#`�����n�0P���*D"Q=��k#�7���ŀ�8�F���>�� �&�����v@��K�\�R)���H@O�5��-ẜjb���1�b�)s�$e�$P)[�9W��_�I��c���z$�ϤJK*���u�nK��U9c �������C�\��/!n���!��Jۜ ��U	���\�� h��¥/\��A��Q�+��������v���L!~V҃�Q{���,��+g�Z-��B��:�!-���N�y�e:���:3:X�?����V�E��!<=�c�܂/�v����I�p���{U0BS@e΃�	px�����g�J�7���5"��9r�``@��8�Ppe���-&m3��b���'�+Y�l_f�dPdp�1�Ӈyt��R�<��r4~�S�&����/�T0�A�s
+�W�w��.��E��%��	�dM��2f}QYtP����l?�е�8|���G�4���g�Ь|(����F�s̀�OG�*��o��=w*��v�ꕊW~�p.V�+Y����ԥ�ƺ����DӮ����'t>�_ͣ�	��s`�CM�"�|=&T�=����S�Ui=t0�yj�C�D��U�$3<Эɳ�:8��)�YDa=mP?,��d�ډ�[JQbM�[D�1�8:�Yc�&R�� Qг���)ӕ\)�a��
+64��_���k����vQtC���s+S�$��ݖ/�-�6��M���X���(��f6�Q�J���]ǨKZ�0h5R��C��a9
+E	W���<��v���>{,q�ʟDD,m)���%Al�O�z�7���vν���<AZ<�rC@�w������;]�_���n =��	�7r�����I8
+�)�,ɧ
+I�p��{�n��4��Z(�a>��E�MT�����Αc�&b勒B���s���^�uX�w�J��vq>�?�>��5Xk�J�_롡�����_gЏX�e��vP5݄�p�N,��Բ��A��^�;[e��>�Ir͚	�_J_�D���,���a�
+��fjI�@P*,ڳY��ʓ�U��R;�#��E,�Y9oď��E�ʥ�)�Y0>��Gm��tv��f(�N�|��pi��Zػ���[���Z�+ ���=g��:^A�`{M���om�p�K"c�%��x�+
+h<��a����LV	�-Lo?�.z�Ѻ��rC_���=��_L-t���k�2��շ��8�endstream
+endobj
+569 0 obj
+1610
+endobj
+570 0 obj<</Type/Page/Parent 536 0 R/Contents 571 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F4 4 0 R/F5 5 0 R/F8 8 0 R>>>>/Annots 369 0 R>>endobj
+571 0 obj<</Length 572 0 R/Filter/FlateDecode>>stream
+x�R�N�0��+��8~�u,�$��Tԉ���'��|։JQ�by��ώ?<?1�k����]�QB!f�H��=�_+(�6����em
+�RJ"h�S�mQCf���`%�1�ԍR�}���I��u�f���H5kD!^k���X���Q�d�O�&w?���m��`Ⱦ��;4�OH�	4���^����]���ִq����9���$S��ڢ*�jK0�e�Ы�0�`�1�,D���m?��z7T]�C��lz�(��������?�3�
+v��0R��N�̆�:^U��/���\���endstream
+endobj
+572 0 obj
+305
+endobj
+573 0 obj<</Type/Page/Parent 536 0 R/Contents 574 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F4 4 0 R/F6 6 0 R/F8 8 0 R/F9 9 0 R/Fc 10 0 R>>>>/Annots 375 0 R>>endobj
+574 0 obj<</Length 575 0 R/Filter/FlateDecode>>stream
+x�WkG�ߟb�*`�Y?,[�B��i%I�!D���V��O���=ˢ�����$+m0Y���̼y�f��ɀ��7��!�&T�O��N�SLi�ē��"Ҭ�M2zn�R�Z���4R_=O�;Y/�����γ�x���AF*�I9�T�J���������*�H�ϣ��N���(*����efI�����讠���
+/a4�&�q>�\P4'���b�Biꓼ�E�Ţ���ɒ[���1���Rf+�.|Q�0�c��{w���FX��^Z�]�E�Sxe4-U-�=�HG��<���V5�Q�V�mFMk����N�[i)FAZ��!{j�Ҟ߄b	�&�hw���]Y��\*�8
+GKc�kS��@����~Ѿ@/�M-<��'�a4�eF�����*�!A�XIf`��٢ܢ(�-��\u0�~뎲j�\"p]0g���tG++�J�U�m-��e�j�|E�/qD��M����5���/2�~m<������3���X�f_j&kI[��փ�
+��iP��BHR���qp35�'?j��@Q�ѯ�R�����B��@�Y��f��>D#.���|+3��:$�M�v�)
+��&�
+W勅�|\w���wY�R�:E�ry�
+a�f�2��EK;<ub�@*���9Uoa�!0�>n.�v�1W��ww9w��A��=���2�4��1������4�B��L����*h�J�e4�ZHn1�Wi��n��dyLx���JӤ���
+�94|p�O��f�+��S�}e��ى��R�f
+=�D����5A9(<K�n������ |kڠ��՚���w'��^Li��X/^1`w�I7�z�]�8�vU� Ly��D�r�����]�L
+`pJA�Pyu-�Tm�_v�`�]���1�rQ$�}j�ZRT�:�V��ے�|���iF���3L��2Fα��mT�<�ژH̍LKDr�"�q��Ʒ\j�:��.l®�J!\ �	��)ZƊ# w����=b�(��̬���(U���x��Z8�	�E.u�������s�`�A,�-��
+����('��p�C
+�?9�����#�K����k�7���G�,�GH��ׂ�ve�Y�0����Ld؈�Ѥ�Yj}��x�B��SL��1��R��@Q#f;j�(�"ƒ�CsQ����5�8!Ϭ�p��k�%� ���x�Z�S�J�
+c�~�g'g��v~�˻i4g�4gcZ�x<�}��=������O�"l<��p%��.�B�u�}�nU�•�:;4}iZ���r?��^�}�]��:@WdƮrx�og��G��� ��%^�4��.�{��sl���4�@8��������3�Gw#��e���x~򼻾zA������o�W�/��NJ�윒��1 $��x�c����C���b'��"\�_��h�6Y�W�ų�ߟq�k�G�PzІ��=�x�+�Z�AV�|X�C�c���I9P�_N�fSE�endstream
+endobj
+575 0 obj
+1490
+endobj
+576 0 obj<</Type/Page/Parent 536 0 R/Contents 577 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F4 4 0 R/F6 6 0 R/F8 8 0 R/F9 9 0 R/Fc 10 0 R>>>>>>endobj
+577 0 obj<</Length 578 0 R/Filter/FlateDecode>>stream
+x�V]o�F|�����2 Q�ۉ�<(M�I��)��N䉺��c�V��;{GR���c����ٙ���v2�s�L�jJ�KJ˓狓�oOir�<���]�Oh�
+.�YB/�^���J�����rN��ɿg��x�1M�4�6�^&���Ϧ&-eF�Pe���'���w%-��TZ9o��Q�)��UґY��/>&ħd2U��/�B���~�V��/Nd�;�%S�{xJ����m�-\G�i�y�/�fO�K~}9���㦮@Iw�83)-x*�p�����V��)�Jr��4��I{��@��:ڪ� QfK�j<���2������Z�-ώA��@�/��.`��r�;�Da��v-�Gi*���������H�Bh.�n�����5sG���B���*�xڈ[I[��DCV���j���OK�7�����]�����ͦ�
+0cB�,c��K��bM4�_L���!n����;k����<��ʕ������;~��2ʜɵ�0����5��-���]ij������=�Ԙ#������c@�s�Sd�j��|ͪ:/��;K��S�p+4��<h D��q̶��i�8�<,���8>˓�E)�Ԕc+s$�������Q)�h��)/G[N� �>{Ł�`�6����q�
+�09��t�^y�C�l�B��q9{�.����q�H�rvqO�խo��OZ��{R���1�(��4F�r K�
+n�Q����^l��cb6FaM���m��B4H����\�Ei8����O
+����!�k���t!�qr��Q��&\?W=�0��F�v��P������pF�"v����۟�w�[v=2ee���SU2�%�ݧ��Ӹ�.@��ӫ�"D��ǔ��06R�vWyhK�c�����{�`&߬F;y�8��9*^����Ȇ��ƀ5Þ�?u�]c��x���b�Gd9�����Vv�c�F��i9��AR�f���U!�W����3��݃[��{noY���~�N��.ݢM��xq��Q���@�L�Ԫ�+s+ٟ�y�Z%b��?�7;��e5�צG��`��6�e�4D�t������Ee�5֚��q���5eL�_�۝��Jq�!��1Q��C����˟�)��e�$R��p�����a2�l��H�X�Z�^�z+=��	���u�w[�l�-�b��"(o$z�]�R؏��)v��RX�
+�
+n�?����GCX�(߷=;m+�€|[l�z6��w�ŝ�?;$�$7��
+��B�ʚ-(�zô��+"6��<7�Z�u�������൮נ�ˎ��f%F,�͚/�^��
+y��&,vt�뭣�L�
+y��U8���4ˀs��u�Z�|8��
+�endstream
+endobj
+578 0 obj
+1361
+endobj
+579 0 obj<</Type/Page/Parent 536 0 R/Contents 580 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F0 3 0 R/F4 4 0 R/F6 6 0 R/F8 8 0 R/F9 9 0 R/Fc 10 0 R>>>>/Annots 380 0 R>>endobj
+580 0 obj<</Length 581 0 R/Filter/FlateDecode>>stream
+x�V]��6|�_�H�8K�:��<�I.	��I�}�>�m��H�����w��叻�(�'��������ŀ��7��Fʪ���o�����?v�,������irKV�
++�4��g2�&7t;��݇�l��-S^� �ǵ?8?������WHh��<��$��^��)��7f��U�I����W�.һ1
+����d̛慤W����v�U� A�����dNO�6zW��=�ť��*��-�������h/�'��6�+ڙ湕����D�5���s�e:oU�e�1a����Jl$�( DV��_H��(���Q-���#A��˕hJOʝ]���J.F7��$�reo0�PN�El8��A!p�'��8�:'����
+�-���@�}���>}yG�� �Ѥ?@�*�����{��qc&�!�5����X- ����P���PWG���,��_�i]o-}��,eH���O
+_����x���/_3d����٢����Ҡ�@O���+���7V��%}��)�ySle,�fEVʄ���2����\�
+Y(rs����^���V����k+�? dʼBB��)�KnQv9S����D�4\�B||�6S��j�)�mP�>���g1:�ʗ��7|���b�?���Rf�~��5U`�{yr8�}.��ܨPi�������|�K��!Q���bYJ&j�sh��;�$`<zsXce		��t��g�J�[�$���&�f�l�ɏ��I��j��ˇ���N���g�$aL����H\?��%�kO=+<���oz���sS��h���X�w,~1��Kc<�fd�n.�H,�C!If�+�:�yԒ����U=�PG�������YQ�����w���� (�vM[�<�� �uo�J/��r�6�CzYsW�2'��ե�+��[��
+��e��RlHk і(^��
+���b�&�8!̕�n-�Y;����bo4K&�z��dt�b^i8�A��M���H1����aĽ65���Cw�& t��)�t]��4�R_��-��;Xz�/��S�x]a��|к̪ړd��.����M��GK�TI���7��i12N{����;�@��ٳ�U�<�:�����D`�n w4�ʵ�9l%hk[򜊬zo�L��:*�����h�6���4���e|�W�%��ij��<�h/M��+���q1=��(�kZ6[K�JD��޸��z2�[CЌ%��K��47�s*��'iK��	�'�E�ܮZ�ReT*����<(����Ai�lZXJ�T{etө7C�r(��P/aPwA���'���Ϣ���?�)�F}�e�0wLgV=#��;�-���W&���������z.�$)�����Y�0��yQf�C2����%.�����o�M������@���mu	��5��F�|�����\�F���kصm\�(Hs�V#/V0䯸F�2s2r�^�-/�*�jA���j|�\ᯟ/��S��endstream
+endobj
+581 0 obj
+1504
+endobj
+582 0 obj<</Type/Page/Parent 536 0 R/Contents 583 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F0 3 0 R/F4 4 0 R/F5 5 0 R/F8 8 0 R/Fc 10 0 R>>>>/Annots 391 0 R>>endobj
+583 0 obj<</Length 584 0 R/Filter/FlateDecode>>stream
+x�V[o�6~��8@��%K�,gC�%]�]�ŏZ�.�T����R�e�I;�	@���}߹<����1$)�����j5�&Y�Co����$�y4���͡D��8��̲�M�E�̓l2?z3��q�ߤN��A��z����݁n��,'1�J�a-`U\�ã�*VU,A�ެ�EL�t�?\�T��*��8Y~$sცy�Te���u�2$UA�YQ	�Z���~%LoD������W��cڌe�;�0|q(�Crq����ܹ�3�����t����"��姄 � !�0W����\�9�,��'O�/no~5�o@��;n`��s��� PM�U�2iQ��(�4�]K��¿����lx�d9AkU�2jv�����w������3i�]
+��Zl�SRYh�~Dw'�Ax�wو3t$H���ܹ���Q���`ڹ�֘����8��J�x1�Jm�K̀V���ԖK��C!��l
+���a���H$3to�u���~�+i�����uD�3�5�
+�=0է�UJό].R��,��\�S[B
+!G�r�"FY_+kUݓ�†Ѓ���B~��fƂh:�гRhc��U��<2�H�����A��8��/�-k����k�=��v�W�%����>~�Y�`H޺Lb�PB8Q�W%qP(M�~�E�uG[z?vJͳA�g4_�H",yf�V��C�D�^��"	��[Erg�!�c�U��*����k*�����`�����*�g}w89� 4��I3<����`x���ڎ/ujb��ҷ~j���6L�ow��f���s��'3���d��o����+}s#Zr��m�z��fϪ�n�!���-����p�̍�f�ڝyhl�Z�[="Ȳ�6��?������ޭ$)-5��&���;�a��i��tI=�V�O�7խ�����+B����Pkw����‹zfY������������g�����^l7]n����>�N�1�L�
+Cr#i�9H��+�X���b%��Zhi��LO��y?��|2���p��}w7!������(^������E�{�Z�-�UD|:>�C�u�����}:����v+�XG_��\endstream
+endobj
+584 0 obj
+1121
+endobj
+585 0 obj<</Type/Page/Parent 536 0 R/Contents 586 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F0 3 0 R/F4 4 0 R/F5 5 0 R/F6 6 0 R/F8 8 0 R/F9 9 0 R/Fc 10 0 R>>>>/Annots 416 0 R>>endobj
+586 0 obj<</Length 587 0 R/Filter/FlateDecode>>stream
+x�V�n�F}�WЇ*�E��D�~)�4N4Mb�H�eM�ĭH.������%iʪ�0@��̙ۙ�?!M��2�YLiy�f}�n}1
+V+f��)ͦI���t�ߋ#i��'`�\'&���=N�AD�l���7i.WՖ����%UzO�\8������uJa�z�
+J�YĬz�Kb�\o-d���)
+�����,�S�@Vp�}+��\�;XD����,��nY�$9M.������wt�o�
+eݕ7<��"�Q�\}5����@CK�6�f;a4�,��A����c/��8����q�K"�"�0Zp���l����"�A=��c ��a0;�|�3},�d�7��I�EQ�?�N��.P@_���9�̝�Ɍ�7*��;
+�����<A��O����$�A��۹$/��%�K�<@q�#��	�I����G7�u�(8u��6������)]���|��\��j'�϶�[�t�<�G{U�Hs��ѐN3�x�e��S�T�5��`��k��Om7���0�t�'v���ɒ�(V�եl��V���FW[�j���rNV�ц���i!/�q��*z�$�UŁD&j�z����H~Oe�<�[a-|����*��Y��s�{?��ڸ��qj���)e����xxhTR�4�1����͍A6��ϸ�~���+��m�>k�F�}��2���0L�)���ZwR�y4����6b<`�UmictI�����6'0#��
+��m�<B��z��_�"�w<�y�G(���H`94��dsr�겔&�T�)|��G��
+�\7E�u{��D;C%�eaH2��vS���(�*ݵ!��`D��5���UjV��)��	�k��J�Z�\r�mʇJ��L�Z�j�R���G����ԛ�@@T��k*��j�r&�;:-R�ra2d9���ˌ?���x�8`�:Č��
+,�_������<��<ꦄ�|#v�i��i�{d�f��\md%F�%;���m{�h�a�`D���Sf��a��Ii7�(�L�j}�R�͊]��'�+d�(�y�)�h�X3�3o�Ƀ�&�D��Ɩ���
+�<�O���#,��Ᏸ���N�N"|�	5�Q4�F���y���za;k>��sr�蚭��m��<1u���g�����λ�y�t`��ﾃ�@�/2n%��[]mԶ1<�zz(ge�ag��*X�FE!}��Ͽ~��l5���ˢ�,�
+����|?%�Ҹ!/ԝ��n@��U|,ջ�-u?n���l�}9�%r�+ʗӿ���8����rv	�lt86�t`}����u��'D�r�/h�WGendstream
+endobj
+587 0 obj
+1327
+endobj
+588 0 obj<</Type/Page/Parent 536 0 R/Contents 589 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F4 4 0 R/F5 5 0 R/F8 8 0 R/F9 9 0 R/Fc 10 0 R>>>>/Annots 455 0 R>>endobj
+589 0 obj<</Length 590 0 R/Filter/FlateDecode>>stream
+x�WM��F���Ke-[���K� �"�T�e,��IcfF6ί��dٰZ6EQe4�v���ׯ[�/B�_H���SJ��g�×
+t��_��Y�mz9�C&��T�F�
+���L�[eJ��S"J|�����G�I(�M4���xL��]4����#�珐?޿�-D��AL��<�5���|��~a64|7q��4��KDɜ��<�,Ebm6��J�r�Ή��K��$�����%��:���)]�]�զ2�7�*ϥS%y��y��Y0�A8��{L��I#]$?��?=2�pޓ�M��L���
+���Y��Z
+W��F~��ŗ6�U�r�}��.U��U�ʍw�e�hcd�H١�6����i@�,�T�,��������z��͚���(��l�+��ok�G\�d!2�寅r�L�G�'t�(�7V��4�(d��b�z[&��-;�`�d��dAV�j{�o�?�T1l��r���
+F�gȑX��׮�i�˺n�(��]C�n�В^� N���FOO�K���}2Gm_���z��yX�{MM��]��DӺ�>H�H��U�,���p��6�g���T���F;I�Ydpi�T�K�_�9�h��m��Z�����_1��r��$C�T�5Q�e.l�j�x�v���i<��F?Q����Rq���))��q�{%�@�$XE��x�mI63�G�����ɍ�HvPj7(�sd��}�G�;ʐ/�	����,���]h�g�_��i��i6[��\M$�z#��˄���LI�Ł�F5�W��������?=�G��j����f�U��T�4�Ϋ��D�V����O����&R<����������*�ת��[�&�8�Z̑n}�M��4�8��^:�e����Z8�a�ѝO߄k9��wA�rKn{]8��������<���������o_�G����p�Cw�"��q�.���
+������Qj=��r���x&<V��mK��G����(�ꫜ�G��1������.���MZT��>b�����Mm�O,uH�e�m'���w\���C4�x��#��>�`� �(&��Z��8���.͚�qĄ�~Z��(E�z溞d�S�+w��4E��A����S�7�F��4{��8�@E��
+���T������ǬF�g��?�@��Jkvb�(A~O/��/5D�nʾ.�",@;�bA��Ұ8�����]QRY��o����C�	�0�f6{��~�Ĉ&~$Fx�4Z��zhFt�����>�6[O�q�>�qI��h<�G�Sf���֠q�;fB����9�s:s�4���/~c��?A]��Q�^`5<`>��'{E%ގ�����*�/5#��!�w�W-��c�Z	U����L�I�~3��ca��M�@����W*ߛ���$F��6��[�N�P�	_�|�J
+nM��� �A����-����߰����:��endstream
+endobj
+590 0 obj
+1452
+endobj
+591 0 obj<</Type/Page/Parent 536 0 R/Contents 592 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F4 4 0 R/F5 5 0 R/F8 8 0 R/F9 9 0 R/Fc 10 0 R>>>>/Annots 480 0 R>>endobj
+592 0 obj<</Length 593 0 R/Filter/FlateDecode>>stream
+x�UMo�@��W�c+�7��*I��R?����^0��M�%�'���e�M"ۭ� 0�����?L\r��R�Q^M����/	�	�K�����(-�$6]�ZI��+h�XվM���u
+��";��9{d2+�k��u��(}W	RkF?V�]̩���ʦt�ZF�d�k�O�]�HtU��\=������B�/�RW�����/${�X���YF��ˮ�#�{�B�]�j�).���|hÛ���;ҝ����4�s:ql��W_n/12#r|{JF���CI����$����BiS�q�|��>p��4~����#<\�[���԰J��:������7�E��>���a������w�yc
+`!I4�W��W�u[�K߃�Y�~-Z��l~�Le��e�Wzm{js�eL�g��)L]������Ru+F7;���a�'�m�>�#��D��Zu���ߪ�Qh��]_au~6���v�)��댕tQ�-�vm$W��U�-�y����{�m�',������I�XͮP�؈Fq��?{��VX"TC��a�*��o�46�Ѿ��k��.��O��1c2(�?g���+Q��d�T�%3=� ����I�e�;��Z3��4C�!0Y�����{��9g�Q�S��6���r��N��Xͳ����+��n��p:��=�k��<�խ�ʲ�F��xq|*Z� J���3G��'�;&@�"���_�~|��(�q��]��W7��%��4endstream
+endobj
+593 0 obj
+744
+endobj
+594 0 obj<</Type/Page/Parent 536 0 R/Contents 595 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F4 4 0 R/F8 8 0 R/F9 9 0 R>>>>/Annots 485 0 R>>endobj
+595 0 obj<</Length 596 0 R/Filter/FlateDecode>>stream
+x]R�r�0���̀kc��@�$��	sQ��Ȓ#�d���0$-��zVz�����2��d�����`�|�9G6�f�7�|��ب�,Mp'��}R;�Ɇ�v������2)"xM� !�B%�l����B�[('��mA:T�O�x�<�{��烶;����������:R��q/�y�+C�%
+�	Q8�����\���J�)��uVԔ��.c,/��o�z�"�Cې�[-Y�"�z���hUi�<x"�6�bAwJ+1�g�Rv����,Mܖ9�KXKXg��
+|����7Fs	4#ֺ��D���/ݛ�|��<o�Qxu<�t��I��lcZp����m�`Đ���Lʜ�Y#O��'��+�߱K&�y�+O���oxś�gI��\N�,�Q_�g�GW�~*<���d�̸/[
+�ݨ`�_��q쵧@�ɩy1K��]��y�<��jendstream
+endobj
+596 0 obj
+458
+endobj
+597 0 obj<</Type/Catalog/Pages 536 0 R/Names 486 0 R/PageLayout/SinglePage/OpenAction[540 0 R/XYZ null null null]/PageMode/FullScreen/PageLabels<</Nums[0<</P(title)>>1<</S/D>>]>>>>endobj
+xref
+0 598 
+0000000000 65535 f 
+0000000015 00000 n 
+0000000247 00000 n 
+0000001804 00000 n 
+0000001878 00000 n 
+0000001956 00000 n 
+0000002033 00000 n 
+0000002112 00000 n 
+0000002195 00000 n 
+0000002271 00000 n 
+0000002352 00000 n 
+0000002411 00000 n 
+0000002450 00000 n 
+0000002535 00000 n 
+0000002574 00000 n 
+0000002659 00000 n 
+0000002698 00000 n 
+0000002783 00000 n 
+0000002822 00000 n 
+0000002907 00000 n 
+0000002946 00000 n 
+0000003031 00000 n 
+0000003070 00000 n 
+0000003155 00000 n 
+0000003194 00000 n 
+0000003279 00000 n 
+0000003318 00000 n 
+0000003403 00000 n 
+0000003442 00000 n 
+0000003527 00000 n 
+0000003566 00000 n 
+0000003651 00000 n 
+0000003690 00000 n 
+0000003775 00000 n 
+0000003814 00000 n 
+0000003899 00000 n 
+0000003938 00000 n 
+0000004023 00000 n 
+0000004062 00000 n 
+0000004147 00000 n 
+0000004186 00000 n 
+0000004271 00000 n 
+0000004376 00000 n 
+0000004481 00000 n 
+0000004586 00000 n 
+0000004691 00000 n 
+0000004796 00000 n 
+0000004901 00000 n 
+0000005006 00000 n 
+0000005045 00000 n 
+0000005129 00000 n 
+0000005233 00000 n 
+0000005338 00000 n 
+0000005442 00000 n 
+0000005547 00000 n 
+0000005652 00000 n 
+0000005757 00000 n 
+0000005862 00000 n 
+0000005966 00000 n 
+0000006071 00000 n 
+0000006176 00000 n 
+0000006281 00000 n 
+0000006386 00000 n 
+0000006491 00000 n 
+0000006595 00000 n 
+0000006700 00000 n 
+0000006805 00000 n 
+0000006910 00000 n 
+0000007015 00000 n 
+0000007120 00000 n 
+0000007224 00000 n 
+0000007329 00000 n 
+0000007434 00000 n 
+0000007539 00000 n 
+0000007643 00000 n 
+0000007748 00000 n 
+0000007853 00000 n 
+0000007958 00000 n 
+0000007998 00000 n 
+0000008082 00000 n 
+0000008122 00000 n 
+0000008207 00000 n 
+0000008247 00000 n 
+0000008332 00000 n 
+0000008434 00000 n 
+0000008537 00000 n 
+0000008640 00000 n 
+0000008743 00000 n 
+0000008846 00000 n 
+0000008949 00000 n 
+0000009052 00000 n 
+0000009155 00000 n 
+0000009258 00000 n 
+0000009361 00000 n 
+0000009464 00000 n 
+0000009567 00000 n 
+0000009669 00000 n 
+0000009772 00000 n 
+0000010258 00000 n 
+0000010362 00000 n 
+0000010467 00000 n 
+0000010573 00000 n 
+0000010678 00000 n 
+0000010784 00000 n 
+0000010890 00000 n 
+0000010996 00000 n 
+0000011102 00000 n 
+0000011208 00000 n 
+0000011314 00000 n 
+0000011420 00000 n 
+0000011526 00000 n 
+0000011632 00000 n 
+0000011738 00000 n 
+0000011843 00000 n 
+0000011949 00000 n 
+0000012055 00000 n 
+0000012161 00000 n 
+0000012267 00000 n 
+0000012373 00000 n 
+0000012479 00000 n 
+0000012585 00000 n 
+0000012691 00000 n 
+0000012797 00000 n 
+0000012903 00000 n 
+0000013008 00000 n 
+0000013114 00000 n 
+0000013220 00000 n 
+0000013326 00000 n 
+0000013431 00000 n 
+0000013537 00000 n 
+0000013643 00000 n 
+0000013749 00000 n 
+0000013855 00000 n 
+0000013961 00000 n 
+0000014067 00000 n 
+0000014173 00000 n 
+0000014278 00000 n 
+0000014384 00000 n 
+0000014490 00000 n 
+0000014596 00000 n 
+0000014702 00000 n 
+0000014808 00000 n 
+0000014914 00000 n 
+0000015020 00000 n 
+0000015126 00000 n 
+0000015232 00000 n 
+0000015338 00000 n 
+0000015444 00000 n 
+0000015550 00000 n 
+0000015656 00000 n 
+0000015762 00000 n 
+0000015803 00000 n 
+0000015889 00000 n 
+0000015930 00000 n 
+0000016017 00000 n 
+0000016058 00000 n 
+0000016145 00000 n 
+0000016186 00000 n 
+0000016273 00000 n 
+0000016314 00000 n 
+0000016401 00000 n 
+0000016506 00000 n 
+0000016612 00000 n 
+0000016718 00000 n 
+0000016824 00000 n 
+0000016930 00000 n 
+0000017035 00000 n 
+0000017141 00000 n 
+0000017247 00000 n 
+0000017353 00000 n 
+0000017459 00000 n 
+0000017565 00000 n 
+0000017671 00000 n 
+0000017712 00000 n 
+0000017798 00000 n 
+0000017839 00000 n 
+0000017926 00000 n 
+0000017967 00000 n 
+0000018054 00000 n 
+0000018095 00000 n 
+0000018182 00000 n 
+0000018223 00000 n 
+0000018310 00000 n 
+0000018351 00000 n 
+0000018438 00000 n 
+0000018479 00000 n 
+0000018566 00000 n 
+0000018607 00000 n 
+0000018694 00000 n 
+0000018735 00000 n 
+0000018822 00000 n 
+0000018863 00000 n 
+0000018950 00000 n 
+0000018991 00000 n 
+0000019078 00000 n 
+0000019119 00000 n 
+0000019206 00000 n 
+0000019311 00000 n 
+0000019417 00000 n 
+0000019523 00000 n 
+0000019629 00000 n 
+0000019734 00000 n 
+0000019840 00000 n 
+0000019946 00000 n 
+0000019987 00000 n 
+0000020073 00000 n 
+0000020114 00000 n 
+0000020201 00000 n 
+0000020242 00000 n 
+0000020328 00000 n 
+0000020368 00000 n 
+0000020455 00000 n 
+0000020497 00000 n 
+0000020582 00000 n 
+0000020622 00000 n 
+0000020709 00000 n 
+0000021477 00000 n 
+0000021537 00000 n 
+0000021624 00000 n 
+0000021695 00000 n 
+0000021782 00000 n 
+0000021853 00000 n 
+0000021940 00000 n 
+0000022011 00000 n 
+0000022098 00000 n 
+0000022173 00000 n 
+0000022260 00000 n 
+0000022335 00000 n 
+0000022422 00000 n 
+0000022509 00000 n 
+0000022596 00000 n 
+0000022683 00000 n 
+0000022770 00000 n 
+0000022857 00000 n 
+0000022944 00000 n 
+0000022994 00000 n 
+0000023081 00000 n 
+0000023123 00000 n 
+0000023208 00000 n 
+0000023250 00000 n 
+0000023337 00000 n 
+0000023377 00000 n 
+0000023464 00000 n 
+0000023504 00000 n 
+0000023589 00000 n 
+0000023629 00000 n 
+0000023716 00000 n 
+0000023854 00000 n 
+0000023910 00000 n 
+0000023996 00000 n 
+0000024050 00000 n 
+0000024137 00000 n 
+0000024200 00000 n 
+0000024287 00000 n 
+0000024344 00000 n 
+0000024430 00000 n 
+0000024482 00000 n 
+0000024569 00000 n 
+0000024622 00000 n 
+0000024709 00000 n 
+0000024762 00000 n 
+0000024849 00000 n 
+0000024902 00000 n 
+0000024989 00000 n 
+0000025042 00000 n 
+0000025129 00000 n 
+0000025182 00000 n 
+0000025269 00000 n 
+0000025322 00000 n 
+0000025409 00000 n 
+0000025462 00000 n 
+0000025549 00000 n 
+0000025612 00000 n 
+0000025699 00000 n 
+0000025762 00000 n 
+0000025849 00000 n 
+0000025912 00000 n 
+0000025999 00000 n 
+0000026062 00000 n 
+0000026149 00000 n 
+0000026212 00000 n 
+0000026299 00000 n 
+0000026362 00000 n 
+0000026449 00000 n 
+0000026512 00000 n 
+0000026599 00000 n 
+0000026662 00000 n 
+0000026749 00000 n 
+0000026812 00000 n 
+0000026899 00000 n 
+0000026939 00000 n 
+0000027024 00000 n 
+0000027066 00000 n 
+0000027153 00000 n 
+0000027193 00000 n 
+0000027280 00000 n 
+0000027320 00000 n 
+0000027405 00000 n 
+0000027445 00000 n 
+0000027532 00000 n 
+0000027758 00000 n 
+0000027798 00000 n 
+0000027883 00000 n 
+0000027925 00000 n 
+0000028012 00000 n 
+0000028052 00000 n 
+0000028139 00000 n 
+0000028179 00000 n 
+0000028264 00000 n 
+0000028304 00000 n 
+0000028391 00000 n 
+0000028449 00000 n 
+0000028488 00000 n 
+0000028575 00000 n 
+0000028614 00000 n 
+0000028701 00000 n 
+0000028740 00000 n 
+0000028827 00000 n 
+0000028866 00000 n 
+0000028953 00000 n 
+0000029019 00000 n 
+0000029106 00000 n 
+0000029172 00000 n 
+0000029259 00000 n 
+0000029298 00000 n 
+0000029385 00000 n 
+0000029424 00000 n 
+0000029511 00000 n 
+0000029551 00000 n 
+0000029634 00000 n 
+0000029676 00000 n 
+0000029761 00000 n 
+0000029801 00000 n 
+0000029886 00000 n 
+0000029992 00000 n 
+0000030032 00000 n 
+0000030117 00000 n 
+0000030158 00000 n 
+0000030245 00000 n 
+0000030279 00000 n 
+0000030318 00000 n 
+0000030404 00000 n 
+0000030487 00000 n 
+0000030573 00000 n 
+0000030636 00000 n 
+0000030723 00000 n 
+0000030786 00000 n 
+0000030873 00000 n 
+0000030936 00000 n 
+0000031023 00000 n 
+0000031081 00000 n 
+0000031120 00000 n 
+0000031207 00000 n 
+0000031246 00000 n 
+0000031333 00000 n 
+0000031372 00000 n 
+0000031459 00000 n 
+0000031498 00000 n 
+0000031585 00000 n 
+0000031635 00000 n 
+0000031675 00000 n 
+0000031760 00000 n 
+0000031802 00000 n 
+0000031889 00000 n 
+0000031930 00000 n 
+0000032017 00000 n 
+0000032057 00000 n 
+0000032142 00000 n 
+0000032183 00000 n 
+0000032270 00000 n 
+0000032328 00000 n 
+0000032382 00000 n 
+0000032469 00000 n 
+0000032575 00000 n 
+0000032681 00000 n 
+0000032787 00000 n 
+0000032837 00000 n 
+0000032910 00000 n 
+0000032997 00000 n 
+0000033050 00000 n 
+0000033137 00000 n 
+0000033171 00000 n 
+0000033211 00000 n 
+0000033296 00000 n 
+0000033338 00000 n 
+0000033425 00000 n 
+0000033466 00000 n 
+0000033553 00000 n 
+0000033594 00000 n 
+0000033677 00000 n 
+0000033718 00000 n 
+0000033803 00000 n 
+0000033861 00000 n 
+0000033926 00000 n 
+0000034013 00000 n 
+0000034065 00000 n 
+0000034152 00000 n 
+0000034204 00000 n 
+0000034291 00000 n 
+0000034343 00000 n 
+0000034430 00000 n 
+0000034482 00000 n 
+0000034569 00000 n 
+0000034663 00000 n 
+0000034750 00000 n 
+0000034844 00000 n 
+0000034931 00000 n 
+0000034972 00000 n 
+0000035057 00000 n 
+0000035099 00000 n 
+0000035186 00000 n 
+0000035227 00000 n 
+0000035314 00000 n 
+0000035355 00000 n 
+0000035440 00000 n 
+0000035481 00000 n 
+0000035568 00000 n 
+0000035682 00000 n 
+0000035739 00000 n 
+0000035826 00000 n 
+0000035880 00000 n 
+0000035967 00000 n 
+0000036040 00000 n 
+0000036126 00000 n 
+0000036208 00000 n 
+0000036294 00000 n 
+0000036350 00000 n 
+0000036437 00000 n 
+0000036497 00000 n 
+0000036584 00000 n 
+0000036691 00000 n 
+0000036778 00000 n 
+0000036885 00000 n 
+0000036972 00000 n 
+0000037079 00000 n 
+0000037166 00000 n 
+0000037226 00000 n 
+0000037313 00000 n 
+0000037373 00000 n 
+0000037460 00000 n 
+0000037520 00000 n 
+0000037607 00000 n 
+0000037663 00000 n 
+0000037750 00000 n 
+0000037806 00000 n 
+0000037893 00000 n 
+0000037934 00000 n 
+0000038019 00000 n 
+0000038061 00000 n 
+0000038148 00000 n 
+0000038189 00000 n 
+0000038276 00000 n 
+0000038317 00000 n 
+0000038402 00000 n 
+0000038443 00000 n 
+0000038530 00000 n 
+0000038700 00000 n 
+0000038783 00000 n 
+0000038870 00000 n 
+0000038953 00000 n 
+0000039040 00000 n 
+0000039123 00000 n 
+0000039210 00000 n 
+0000039293 00000 n 
+0000039380 00000 n 
+0000039463 00000 n 
+0000039550 00000 n 
+0000039619 00000 n 
+0000039706 00000 n 
+0000039775 00000 n 
+0000039862 00000 n 
+0000039931 00000 n 
+0000040018 00000 n 
+0000040059 00000 n 
+0000040144 00000 n 
+0000040186 00000 n 
+0000040273 00000 n 
+0000040314 00000 n 
+0000040401 00000 n 
+0000040442 00000 n 
+0000040527 00000 n 
+0000040641 00000 n 
+0000040682 00000 n 
+0000040767 00000 n 
+0000040809 00000 n 
+0000040896 00000 n 
+0000040930 00000 n 
+0000040964 00000 n 
+0000040998 00000 n 
+0000041769 00000 n 
+0000041818 00000 n 
+0000041867 00000 n 
+0000041916 00000 n 
+0000041965 00000 n 
+0000042014 00000 n 
+0000042063 00000 n 
+0000042112 00000 n 
+0000042161 00000 n 
+0000042210 00000 n 
+0000042259 00000 n 
+0000042308 00000 n 
+0000042357 00000 n 
+0000042406 00000 n 
+0000042455 00000 n 
+0000042504 00000 n 
+0000042553 00000 n 
+0000042602 00000 n 
+0000042651 00000 n 
+0000042700 00000 n 
+0000042749 00000 n 
+0000042798 00000 n 
+0000042847 00000 n 
+0000042896 00000 n 
+0000042945 00000 n 
+0000042994 00000 n 
+0000043043 00000 n 
+0000043092 00000 n 
+0000043141 00000 n 
+0000043190 00000 n 
+0000043239 00000 n 
+0000043288 00000 n 
+0000043337 00000 n 
+0000043386 00000 n 
+0000043435 00000 n 
+0000043484 00000 n 
+0000043533 00000 n 
+0000043582 00000 n 
+0000043631 00000 n 
+0000043680 00000 n 
+0000043729 00000 n 
+0000043777 00000 n 
+0000043826 00000 n 
+0000043875 00000 n 
+0000043924 00000 n 
+0000043973 00000 n 
+0000044022 00000 n 
+0000044070 00000 n 
+0000044299 00000 n 
+0000044442 00000 n 
+0000052146 00000 n 
+0000052168 00000 n 
+0000052331 00000 n 
+0000053981 00000 n 
+0000054003 00000 n 
+0000054158 00000 n 
+0000055913 00000 n 
+0000055935 00000 n 
+0000056090 00000 n 
+0000057559 00000 n 
+0000057581 00000 n 
+0000057745 00000 n 
+0000059908 00000 n 
+0000059930 00000 n 
+0000060095 00000 n 
+0000061027 00000 n 
+0000061048 00000 n 
+0000061212 00000 n 
+0000063075 00000 n 
+0000063097 00000 n 
+0000063234 00000 n 
+0000063450 00000 n 
+0000063471 00000 n 
+0000063635 00000 n 
+0000065485 00000 n 
+0000065507 00000 n 
+0000065671 00000 n 
+0000067569 00000 n 
+0000067591 00000 n 
+0000067750 00000 n 
+0000069431 00000 n 
+0000069453 00000 n 
+0000069599 00000 n 
+0000069975 00000 n 
+0000069996 00000 n 
+0000070161 00000 n 
+0000071722 00000 n 
+0000071744 00000 n 
+0000071894 00000 n 
+0000073326 00000 n 
+0000073348 00000 n 
+0000073522 00000 n 
+0000075097 00000 n 
+0000075119 00000 n 
+0000075284 00000 n 
+0000076476 00000 n 
+0000076498 00000 n 
+0000076681 00000 n 
+0000078079 00000 n 
+0000078101 00000 n 
+0000078266 00000 n 
+0000079789 00000 n 
+0000079811 00000 n 
+0000079976 00000 n 
+0000080791 00000 n 
+0000080812 00000 n 
+0000080958 00000 n 
+0000081487 00000 n 
+0000081508 00000 n 
+trailer
+<</Size 598/Root 597 0 R/Info 1 0 R>>
+startxref
+81695
+%%EOF
Index: web/openacs/www/doc/openacs/pdf/simple-aolserver-install.pdf
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/pdf/simple-aolserver-install.pdf,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/pdf/simple-aolserver-install.pdf	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,362 @@
+%PDF-1.2
+%����
+1 0 obj<</Producer(htmldoc 1.8.4 Copyright 1997-1999 Easy Software Products, All Rights Reserved.)/CreationDate(D:20010215050425Z)/Title( Simple AOLserver Install Guide )/Creator(Modular DocBook HTML Stylesheet Version 1.61\12)>>endobj
+2 0 obj<</Type/Encoding/Differences[ 32/space/exclam/quotedbl/numbersign/dollar/percent/ampersand/quotesingle/parenleft/parenright/asterisk/plus/comma/minus/period/slash/zero/one/two/three/four/five/six/seven/eight/nine/colon/semicolon/less/equal/greater/question/at/A/B/C/D/E/F/G/H/I/J/K/L/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/bracketleft/backslash/bracketright/asciicircum/underscore/grave/a/b/c/d/e/f/g/h/i/j/k/l/m/n/o/p/q/r/s/t/u/v/w/x/y/z/braceleft/bar/braceright/asciitilde 130/quotesinglbase/florin/quotedblbase/ellipsis/dagger/daggerdbl/circumflex/perthousand/Scaron/guilsinglleft/OE 145/quoteleft/quoteright/quotedblleft/quotedblright/bullet/endash/emdash/tilde/trademark/scaron/guilsinglright/oe 159/Ydieresis/space/exclamdown/cent/sterling/currency/yen/brokenbar/section/dieresis/copyright/ordfeminine/guillemotleft/logicalnot/hyphen/registered/macron/degree/plusminus/twosuperior/threesuperior/acute/mu/paragraph/periodcentered/cedilla/onesuperior/ordmasculine/guillemotright/onequarter/onehalf/threequarters/questiondown/Agrave/Aacute/Acircumflex/Atilde/Adieresis/Aring/AE/Ccedilla/Egrave/Eacute/Ecircumflex/Edieresis/Igrave/Iacute/Icircumflex/Idieresis/Eth/Ntilde/Ograve/Oacute/Ocircumflex/Otilde/Odieresis/multiply/Oslash/Ugrave/Uacute/Ucircumflex/Udieresis/Yacute/Thorn/germandbls/agrave/aacute/acircumflex/atilde/adieresis/aring/ae/ccedilla/egrave/eacute/ecircumflex/edieresis/igrave/iacute/icircumflex/idieresis/eth/ntilde/ograve/oacute/ocircumflex/otilde/odieresis/divide/oslash/ugrave/uacute/ucircumflex/udieresis/yacute/thorn/ydieresis]>>endobj
+3 0 obj<</Type/Font/Subtype/Type1/BaseFont/Courier/Encoding 2 0 R>>endobj
+4 0 obj<</Type/Font/Subtype/Type1/BaseFont/Times-Roman/Encoding 2 0 R>>endobj
+5 0 obj<</Type/Font/Subtype/Type1/BaseFont/Times-Bold/Encoding 2 0 R>>endobj
+6 0 obj<</Type/Font/Subtype/Type1/BaseFont/Times-Italic/Encoding 2 0 R>>endobj
+7 0 obj<</Type/Font/Subtype/Type1/BaseFont/Times-BoldItalic/Encoding 2 0 R>>endobj
+8 0 obj<</Type/Font/Subtype/Type1/BaseFont/Helvetica/Encoding 2 0 R>>endobj
+9 0 obj<</Type/Font/Subtype/Type1/BaseFont/Helvetica-Bold/Encoding 2 0 R>>endobj
+10 0 obj<</Type/Font/Subtype/Type1/BaseFont/Symbol>>endobj
+11 0 obj<</S/URI/URI(x10.html)>>endobj
+12 0 obj<</Subtype/Link/Rect[119.0 523.3 154.8 536.3]/Border[0 0 0]/A 11 0 R>>endobj
+13 0 obj<</S/URI/URI(x10.html)>>endobj
+14 0 obj<</Subtype/Link/Rect[154.8 523.3 170.9 536.3]/Border[0 0 0]/A 13 0 R>>endobj
+15 0 obj<</S/URI/URI(x10.html)>>endobj
+16 0 obj<</Subtype/Link/Rect[170.9 523.3 191.4 536.3]/Border[0 0 0]/A 15 0 R>>endobj
+17 0 obj<</S/URI/URI(x10.html)>>endobj
+18 0 obj<</Subtype/Link/Rect[191.4 523.3 265.1 536.3]/Border[0 0 0]/A 17 0 R>>endobj
+19 0 obj<</S/URI/URI(x10.html)>>endobj
+20 0 obj<</Subtype/Link/Rect[265.1 523.3 295.3 536.3]/Border[0 0 0]/A 19 0 R>>endobj
+21 0 obj<</S/URI/URI(x10.html)>>endobj
+22 0 obj<</Subtype/Link/Rect[295.3 523.3 309.0 536.3]/Border[0 0 0]/A 21 0 R>>endobj
+23 0 obj<</S/URI/URI(x10.html)>>endobj
+24 0 obj<</Subtype/Link/Rect[309.0 523.3 328.3 536.3]/Border[0 0 0]/A 23 0 R>>endobj
+25 0 obj<</S/URI/URI(x10.html)>>endobj
+26 0 obj<</Subtype/Link/Rect[328.3 523.3 363.1 536.3]/Border[0 0 0]/A 25 0 R>>endobj
+27 0 obj<</Subtype/Link/Rect[127.2 483.7 153.2 496.7]/Border[0 0 0]/Dest[90 0 R/XYZ null 769 0]>>endobj
+28 0 obj<</Subtype/Link/Rect[153.2 483.7 171.9 496.7]/Border[0 0 0]/Dest[90 0 R/XYZ null 769 0]>>endobj
+29 0 obj<</Subtype/Link/Rect[171.9 483.7 192.6 496.7]/Border[0 0 0]/Dest[90 0 R/XYZ null 769 0]>>endobj
+30 0 obj<</Subtype/Link/Rect[127.2 457.3 189.9 470.3]/Border[0 0 0]/Dest[90 0 R/XYZ null 605 0]>>endobj
+31 0 obj<</Subtype/Link/Rect[189.9 457.3 209.1 470.3]/Border[0 0 0]/Dest[90 0 R/XYZ null 605 0]>>endobj
+32 0 obj<</Subtype/Link/Rect[209.1 457.3 263.0 470.3]/Border[0 0 0]/Dest[90 0 R/XYZ null 605 0]>>endobj
+33 0 obj<</Subtype/Link/Rect[127.2 430.9 167.9 443.9]/Border[0 0 0]/Dest[90 0 R/XYZ null 408 0]>>endobj
+34 0 obj<</Subtype/Link/Rect[167.9 430.9 187.1 443.9]/Border[0 0 0]/Dest[90 0 R/XYZ null 408 0]>>endobj
+35 0 obj<</Subtype/Link/Rect[187.1 430.9 229.3 443.9]/Border[0 0 0]/Dest[90 0 R/XYZ null 408 0]>>endobj
+36 0 obj<</Subtype/Link/Rect[127.2 404.5 162.4 417.5]/Border[0 0 0]/Dest[93 0 R/XYZ null 815 0]>>endobj
+37 0 obj<</Subtype/Link/Rect[162.4 404.5 181.6 417.5]/Border[0 0 0]/Dest[93 0 R/XYZ null 815 0]>>endobj
+38 0 obj<</Subtype/Link/Rect[181.6 404.5 235.4 417.5]/Border[0 0 0]/Dest[93 0 R/XYZ null 815 0]>>endobj
+39 0 obj<</Subtype/Link/Rect[127.2 378.1 160.6 391.1]/Border[0 0 0]/Dest[93 0 R/XYZ null 561 0]>>endobj
+40 0 obj<</Subtype/Link/Rect[160.6 378.1 169.4 391.1]/Border[0 0 0]/Dest[93 0 R/XYZ null 561 0]>>endobj
+41 0 obj<</Subtype/Link/Rect[169.4 378.1 180.7 391.1]/Border[0 0 0]/Dest[93 0 R/XYZ null 561 0]>>endobj
+42 0 obj<</Subtype/Link/Rect[180.7 378.1 193.9 391.1]/Border[0 0 0]/Dest[93 0 R/XYZ null 561 0]>>endobj
+43 0 obj<</Subtype/Link/Rect[193.9 378.1 233.6 391.1]/Border[0 0 0]/Dest[93 0 R/XYZ null 561 0]>>endobj
+44 0 obj<</Subtype/Link/Rect[127.2 351.7 169.1 364.7]/Border[0 0 0]/Dest[93 0 R/XYZ null 373 0]>>endobj
+45 0 obj<</Subtype/Link/Rect[169.1 351.7 193.2 364.7]/Border[0 0 0]/Dest[93 0 R/XYZ null 373 0]>>endobj
+46 0 obj<</Subtype/Link/Rect[193.2 351.7 244.0 364.7]/Border[0 0 0]/Dest[93 0 R/XYZ null 373 0]>>endobj
+47 0 obj<</S/URI/URI(x10.html)>>endobj
+48 0 obj<</Subtype/Link/Rect[554.6 310.1 576.0 323.1]/Border[0 0 0]/A 47 0 R>>endobj
+49 0 obj<</S/URI/URI(index.html)>>endobj
+50 0 obj<</Subtype/Link/Rect[72.0 257.3 92.2 270.3]/Border[0 0 0]/A 49 0 R>>endobj
+51 0 obj[12 0 R
+14 0 R
+16 0 R
+18 0 R
+20 0 R
+22 0 R
+24 0 R
+26 0 R
+27 0 R
+28 0 R
+29 0 R
+30 0 R
+31 0 R
+32 0 R
+33 0 R
+34 0 R
+35 0 R
+36 0 R
+37 0 R
+38 0 R
+39 0 R
+40 0 R
+41 0 R
+42 0 R
+43 0 R
+44 0 R
+45 0 R
+46 0 R
+48 0 R
+50 0 R
+]endobj
+52 0 obj<</S/URI/URI(http://www.aolserver.com/download)>>endobj
+53 0 obj<</Subtype/Link/Rect[72.0 411.2 233.3 424.2]/Border[0 0 0]/A 52 0 R>>endobj
+54 0 obj[53 0 R
+]endobj
+55 0 obj<</S/URI/URI(nsd.txt)>>endobj
+56 0 obj<</Subtype/Link/Rect[440.1 526.4 457.6 539.4]/Border[0 0 0]/A 55 0 R>>endobj
+57 0 obj<</S/URI/URI(nsd.txt)>>endobj
+58 0 obj<</Subtype/Link/Rect[457.6 526.4 486.6 539.4]/Border[0 0 0]/A 57 0 R>>endobj
+59 0 obj<</S/URI/URI(http://aolserver.com/docs/admin/sec-ch2.htm#8685)>>endobj
+60 0 obj<</Subtype/Link/Rect[72.0 227.0 300.6 240.0]/Border[0 0 0]/A 59 0 R>>endobj
+61 0 obj<</S/URI/URI(http://www.arsdigita.com/doc/security)>>endobj
+62 0 obj<</Subtype/Link/Rect[72.0 200.6 241.3 213.6]/Border[0 0 0]/A 61 0 R>>endobj
+63 0 obj<</S/URI/URI(index.html)>>endobj
+64 0 obj<</Subtype/Link/Rect[72.0 172.2 92.2 185.2]/Border[0 0 0]/A 63 0 R>>endobj
+65 0 obj<</S/URI/URI(index.html)>>endobj
+66 0 obj<</Subtype/Link/Rect[310.6 172.2 337.4 185.2]/Border[0 0 0]/A 65 0 R>>endobj
+67 0 obj[56 0 R
+58 0 R
+60 0 R
+62 0 R
+64 0 R
+66 0 R
+]endobj
+68 0 obj<</Dests 69 0 R>>endobj
+69 0 obj<</Kids[70 0 R]>>endobj
+70 0 obj<</Limits[(aen10)(x10.html)]/Names[(aen10)71 0 R(aen12)72 0 R(aen2)73 0 R(aen23)74 0 R(aen31)75 0 R(aen39)76 0 R(aen4)77 0 R(aen47)78 0 R(aen54)79 0 R(aen7)80 0 R(index.html)81 0 R(x10.html)82 0 R]>>endobj
+71 0 obj<</D[87 0 R/XYZ null 834 null]>>endobj
+72 0 obj<</D[87 0 R/XYZ null 769 null]>>endobj
+73 0 obj<</D[84 0 R/XYZ null 834 null]>>endobj
+74 0 obj<</D[87 0 R/XYZ null 605 null]>>endobj
+75 0 obj<</D[87 0 R/XYZ null 408 null]>>endobj
+76 0 obj<</D[90 0 R/XYZ null 815 null]>>endobj
+77 0 obj<</D[84 0 R/XYZ null 744 null]>>endobj
+78 0 obj<</D[90 0 R/XYZ null 561 null]>>endobj
+79 0 obj<</D[90 0 R/XYZ null 373 null]>>endobj
+80 0 obj<</D[84 0 R/XYZ null 649 null]>>endobj
+81 0 obj<</D[84 0 R/XYZ null 720 null]>>endobj
+82 0 obj<</D[84 0 R/XYZ null 249 null]>>endobj
+83 0 obj<</Type/Pages/MediaBox[0 0 612 792]/Count 4/Kids[84 0 R
+87 0 R
+90 0 R
+93 0 R
+81 0 R
+81 0 R
+81 0 R
+81 0 R
+81 0 R
+]>>endobj
+84 0 obj<</Type/Page/Parent 83 0 R/Contents 85 0 R/Resources<</ProcSet[/PDF/Text/ImageB/ImageC/ImageI]/Font<</F8 8 0 R/F9 9 0 R>>>>>>endobj
+85 0 obj<</Length 86 0 R/Filter/FlateDecode>>stream
+x�][sܸr�R��P�I�C��ƣ_��oZ��T�V�I�-���<���cN*���qi�qk�i�������w�o矮��ߧ��>_}�����9�����_��v�����/���_?]}�������o�~����x�o�����OwW_>�������p���oן?}����z8|����7��o�oo�����o׿=���������ׯ�non����?��~sw
+�>�}������/���5��t�x��p�p�x8��������������x�����÷���w�w8�=^���������w!RW�?���?������?��՗�����ӷ�w�ru{������zA��^xA����YcA��(�����=q&'�T;��L��}���������(}q���E�*ug}�}]�vc]�"5��n׮�SӪG�s+�x�������'��u������C�ކW��X��Y|TEF_&���,p6�^��VU��k]��1Օaa�'�����V��_2@���>{ks�^���	�&b����I����ɦ�cg��E�c
+��Z�VP��5�t��������R1v+�S����V3
+޾��t�:������lL��Q$�z5�' ���6?m%�(�l�����i���k�Y@�t�vM�:
+a@����h6юZa�腐¯�O�<�/LIx�z�IZHB][�7�V�B-��kX�V1���Ӛ"c��
+>D�yּiz�Z��D�����LY<	���$@9�yA��5�����2����y�G�B��0U]�0Y��a?�N�IT��(uE��}g<"`ZS�hY��qy��^����7���J�F3о�<h��&%��m�lLg? Sl���HR���"*0�h�^9�ߩ魵"���C'#8͉)�t�ӕ�$�4��u@�;yWWf6&ML�	:�3L�2T�f�n�t���K>�V����C~�����V� fb�i�����b����	���FW�E7:ۢ���j58+m�t�~�6�9h������dO���k�Y�KZDº�>/"@<��&iM���i@N(m9h�JXN���g�������0�hXI�9�B���R8x"S�F��{I�$Lv�vv
+1���ڦ�R���Z���aD��*a��I3@H@F�ֈF7�b`��nz9�@�Cs��\���t��)���B�$�0I�$L0�~�OϮ��֎���-����2/��̒��C�&���h��TL����T��qkW
+��!�Jl
+-~��=����J��b:	{$�����W
+���t
+_��`��jZ�t��N�	�W��~Lz23��i{�N�K=�n��=��� [��n�!	e�����7E���Ib�D������i�KW��"��C���Rt)B��ܽ��z�&�f��v��Ԧ��$%M����I��"���vƃ�\����*���Ih�J��,3�+}p';p+!a�[g
+`�ˣ�uc���7Z�?ՠ�^'�%�'�Z1,U�8���w���4C�&@z�Fr��#ah�3�ֹO���UF����H8u�J��nD����LL�0�n�i/u~F�'��j�&6�'��Vd��O#�[�{"p���$�5�'�s���YSx�5f�+��@�U���ho�x�d�~	��g.�4�[Rp:7���y��Wqe�.j`�c�S�I��	ko͘´ܽ�f��7�ى�T3ᎀrh�cfI@��3$��C(�ڬ�d�\�K;7���U*��<f�3|6-��i��g���nx�4�������"b��E�.~9��1!1�G���	���\�vTe�aa76���$K��I��W|w�WmyLH0OB�$�H�@9����6��%IF(�	���0�z��hʡ-�YF�1I�6�H؋����&g�gq�ہ@
+����l������,�NUG�ʽ�ʡ-�	�4b�&)Kh�� Qs
+d�3I�BI�W� %/��*ص'/
+��$P�E�D��}�ЖDŽ�����,	� lG���S�
+5�#D\&�<35�]ޑ���:Y.%*��<f9	�Iʒ���B��;H&=��I���S�&�pׄ�ǹ4�gUmy�$����F�ط.�g'Va�1�O������lx�9�� (��cV8��=m�	3�˞��$eI��s$l�)0�-�L@�1k�Jn�6PJ��ϘM�5�rh�cB��(�B�H�:$T�&�:���x��`A��ɬ�r��~�������/��<&�a	[�'6=�f
+'<�D�H���CT�`�l`֨��g��M߁ہ�ͫ�ЖǜM�U_�E?GUIAz�^Y��@-q��<�%�_9�j$G��&��~�������+��<&�;OLQԌJ�IU���@UP��P�H�+���1���
+7�t�~�r����ʁ'n�d�C[��K>�6G#�F�I0�����J�#q���	�Na�!tn��0c�Ckg�̠�M��ŏT�C[s	h����&4�8U�
+g
+�ީ�'�ކ��p���,��e+:�_ W���`��X�O�HU9�D��t��k�1I)�S#�BiUH�P�>���Z�K\]�B����Ԥ���c�����p�LDa+��L�F�D�5� �N����oK-2��ֈ�Sgm�&���×$�����T�2N�5���\]S7�l�!!p~\��B����&Z���ٮD��$D�_���$v��}D��R����w����L㚼I�Z��l� y�`����8�,pMr ��ơk�����V�u��cc;tTF�nձ'.�mը#��;��B؟��r�3�U3�;ݚ��Q��S/0�SGS��b��������4c�	�`�3y
+�.�+�n�����*�`�}�0үWq�$�����O���>�#>���$V�G-\ �lD�'|�D�@F�v��=����x�6πN��a�+��:8`225�E�&�V@��Y��:l�����
+�f�J��ByεJ��HN��a%vZ��5����t�̕�ދa�a��<�ug��˻#*��H�ֱ1M�� ��u��j�DhӬ���$	��ީ&"�F�
+��_^�zN3	�%�q��R��9��TM��Gf�A#!��%A)�$O��	ߥ�|���-
+I�*U@"�8���$����E��HI��K�|U`�d�ۍ)����I���{��˶{��i�KE	�L���ᒰ-�UX}~|	�H0��.�����}�)Q�:8������]��"-$��V���o��
+��B�\t��@oL���/�PbqCJ��N�����}2I���{��6PS,��&D�Q:1˛�Y����|\�W�V� �&o����(�y�W1	F�x�h�	Վ�
+	t9j�B�
+�nq�Wb�T^�4%�PC�㑷/�#��m.�H��[?i��;��d8f��ȩ~������~qC��2��2����e�
+1Ӂq���`��^Tp�T_�T�$8&�9�I�;�bE�����e�Q	˺�^�Z�
+�I�"��oO��v��>����:����h�0�wkc\�77uG�
+��瀴	���s_�@Kbf#B�R��=:=������e(���x��T�e@�B�再2뺭&,j�6a��J3O�XX�~/	Kأ�S ���S�<K�|y�
+t���O\s!3wQ2��"��e�J"e�9�����M��HƋ��Ӌ7#�G"z.��NOI-�$9�g)B��]�h\,f�ː����n\W5=��/'�C
+�"R��\x���|%Z��(�O�H�P$.uέ��ȥ��4�RJK�܃81��{[�[���`lZ�›D'�?s�b��H��?b�39�ۭOwza��S\��IXw��"��h���-g�`�k��)X|���}�Q���{��� y,�yk4W�i�Y5���w�'��c[�Ӄ�x��WP#b�����+�_M��	{�{Z����9�.
+M��7!$Oba�h�&;,�*�~�G��<�rMUB/_��~� ΁Q��X����_�	h��,�8�Y�Ou�-���C�ո�71wQ��6��w�H{[bU]��/��/a�E����=X��S����#M8��
+�K���;2��<�V���>%WWq�����^˅�gb��MC�۶�1a��/��j���������i��GV8u��"�k�$�a$u�ѿQ�W�u\�u���fH����q�"�5" 9@���	U@��w�7̂����r�Dz�٧�J�E��u3���0
+-
+�ᰰ��P�U'���Š(kD1�l�/��4E��A@Q�i�����n��%~��/�9雑*m͉������O?W��+Gk$R��^_����%�(�sJ�a��ۍ��J��x�������0��&)]N񱶴�D��������3$l#b0(��a�Bp*��4��^ꀀQ�
+ j�p�x�S�O��:��^�G�t]�ѓ
+F�;I&q+���4��"��X�P�p\EH��|~�#��53*��r����BH�eʞ��Jq�Ms�A:��0�/���" �M��m|H���]+T����+�$X�p����Ys�q+�����i���&�Fr�f.��Ml0J��&���>��� �/4H��\� m��<sc�a���^���7��Ӧ��w�-�d6�)�S#w�������Rk� (%���7��.9�0�,�~(��
+��P�S�IH6�4�7�^�ڧi2�e߄G����px)1H;�A���*�Z.�;f�δ��>����-��� �J��
+���ȜD�߷i��@.�����m���f�g�T=d�3�#�5�i�p%�A��*����"L�C��9��W�
+h$�*�+��"X��f�%�ƒ`��&-�
+@Cz?�d]�|������3Yy��LZxg����S@R���:
+��!���A���Ӕ�₇I��90��
+�#7X�[���k��W�-s'KiU�惡���$p;���0��$S�B�7�8�����OB� ���N���BE`�u�G�i&��uL����uS����A�F?�n�r\>�?�
+ž��c.(�ʝV�W�n����ma�\�C�ʂ�߂����YՇ_�e�#V�vɲj�-(ӱwAc*��>#	3�U��D��_�;�,Xĕ��C�GI����P��FT!z�Ǵx�i��mK1[����b]��U#!@Y��(A<��u�6�<d�C�`�%sf�A�B��b00U�g�f!O#39p-Rф9L(�+���G#�g 潲��TqRג;�֝��Q����tP_�K���/�����͓����D��g�4�t�y��8b}xZ�P�C�yxf�C�됅޸2�.�^���F����z��j�v��MU5PװS� �m8;����^�y����NJ��/_R�E���l��'B��1F�N"eH7���Bgv�d0P| ���#b`� ކ�^F`��s�$`-t���>��m42�Q���0
+#�
+k��,H:O�;�-�!L\b[�ElD~hѥ~Cu�Z>i�(�z�ij���%���yXGB����m�w�'�X%؅�����P�������Pv����rJ�eFs��cb@�<�Ƣ�2��f�\���0d`��Q���ز
+��`mv����E��WZ�i֬1��|~fс�윪�{��
+U
+��V�=�h�cI�ʂ�A@/.E���$	�ɚE�DC�4ͪ�M�_6;�8��:$�I���ֽfH�
+��M{M˼�4N㬐W,HEІ J�- �hJ���Y?�������h6����IM��$l��5��rj;���3j��$Y�d�M@����0�7O�K5e�6
+I{dD�َ��G�nE��N�#�
+�����p/������U���8x*��XH����Lr*�w�${���Ar�������[���Ԋ��D��FaFۼ��86�b�y��w�$>�JX+�
+��팛-}�I�N�/��Bb�zI�*qN�
+,��z?�`��cY�w�{�
+ȱc7‚c�6<�hf��~���;-r5v	�dARKX���í೬�*�p5�0�+��	�m��;d�l`�as���:��zzE����R̢M�Z�q���OZ�LI�i��zk�:�	d�s�֎E�]�pG�O�I���P�Ք4K��xsZʜ/P�or�[���/�Ԙ(I��B�������}�،�J<�������N@^��$l�{Yg{@q�q��1�~2_�H���ڤ��+hCU�4\��U
+�P�<�U���������ap$�=�<["{7�a/�r�s|v�0�-�I���5*���r�&�)/�)V�LX�*H9kX�UW（Ѹ90�/������B���|�"	���[����_~��a�m�C�x�L,-�.�!K~�lłu����o�O��ߤ��~� #I��|'8�<>|�������>�d�lW�7��Խb�<~�{d�	�I�q��S4����J�`�v+Y��i����-W�t�%�AE�|[F1ۭ��D}/]�#�Lj��g����N2Ndt��î�6X/X@����d�T�~D���(��&��I�1kk+�X��(���%AB��G� v������
+@���刻Ǔv�∸��h�)?���:�	��J8`�=€4_�#b(䞤Y8��M�a�1��A�
+�me&Q�	+i���il痊6nN�g��z��d��҄MBbHh�H9��NOq���
+}͵i�	k9X�$}��"�e�Y��A�U�	X8�챤�N��M	54@��^2�B��N�̂��(4�W��ClO�L�#9��cI(�Q^Ѥw�I�=|=V�TN�Y0$|���"1�@o�	%al�$�N��cv�͂��p��jH����>Yj�����tL		�����	*"ts���s
+��sO���0�,�ւ���)����z�F7m��`2*ĥ�*Byo�����#�HǑ`�/��{�Yc$�,�L_��٩��|�M3�&��N�Q$�g�X|27U�#a����.�V/*��#�
+�G�nn���nKp0�z�!�y8�o=�� �"���ٚ�G�e
+5��G|_ꈆ��8���8	�:RL1/?���9Y�rۖ��2c:a?��lb�����S��a�$�����B���4����m��ΑHzFϋ���B,�ϒP ��æF$/����5؊� �_����e^�ً�/â�O�U�'�c�6�%Ҹ�92����H6�7@��i%E����e�Ցt,�������b�\�L�>{��6�[�I�BE�4$�u5�Iѓi�+]��|VZ�ѭ|=�E��֝~#A<9
+;25	>._�*r�K��!�4�g�7�]�F,W�V��3�܂��¬��<���(XM�����"p�KŸ��Kj���ۏ^@{4	��b���Ll4/���Y��(
+/��,%4�~��L�
+?õ}1F����^xA�Y�;������r��
+������s
+��w�T0�TIS040�3S025�3WI�P��-�IUp��)N-*K-R��+.I��Qp/�LIU���r
+�
+�����
+endstream
+endobj
+86 0 obj
+7639
+endobj
+87 0 obj<</Type/Page/Parent 83 0 R/Contents 88 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F4 4 0 R/F5 5 0 R/F6 6 0 R/F7 7 0 R/F8 8 0 R/F9 9 0 R>>>>/Annots 51 0 R>>endobj
+88 0 obj<</Length 89 0 R/Filter/FlateDecode>>stream
+x�VMs�6��W�-�LL��xk�Ԟ�$n+��L.��lIB%A���}�"lIT�q,����.v��A>�%���6�Ň���:%��j���i�IZ�wE�+���S��G���uk��������������|�*L��/~�k�M�UYj�q�T��m[n���<�w?���Cb��^̷�S��q�;�L�k�g�}~�\=�R�*UZ�'*Zʨ����]Kպ�j�����T���ϭQ�;j5[�����/�n�Z��C?u��UF�23[�T��"`\��0oZ�5z��K��Av�+E�Nm�m������o2�Bָbo��t��M�5�$}_P���e��k�7�ڭ��V��S.��"?�g��FѶOe2�ٍD;A�6յ���	��P
+���������S�\zU���r8�tכ�'��2�G'
+:6*J�^���_�w���WO���]�i��y���H�������)8������}|*^���|%��G��x���2�e+e�ZT�Z/�ݮ,6�c^n���Ω��𓩊"���r/��!��	\Pba��%�sU0YC�\���0:�dU���hT��o��g�Q�T~F���ԅH��=��5ck^��u�A
+��7>Er|v.��w�3�G:�Ϻ�Y�����z{e��9�� ��9��aN~���Y���|�Ԡ	����(AJNp�C�ل��|�r/}�S��)���2�=�JO�~�	/��>Y����d��t|���R��f�w?&�}[�w�#�!wJ<�%ӳ�Y�a��z4#ݱ��&�do�P��@�8�����z�1�"8��җ���
+͵0<��
+#�Oc�u�@Đb�����آ��
+�3�E�Fk�z�o{ۇ�e�#��W�	��#�;��uD�u�_��P9��;�$~b�q9��L��L⾚�� ��N/!���d����Ah�d�W_���0�)T#��_���	X��.{	c���œSxq
+�ԕ�t���}tw�	���Ă���d��NR�A�'V��
+�}�)�"D�J�_��]�endstream
+endobj
+89 0 obj
+1046
+endobj
+90 0 obj<</Type/Page/Parent 83 0 R/Contents 91 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F0 3 0 R/F4 4 0 R/F8 8 0 R/F9 9 0 R/Fc 10 0 R>>>>/Annots 54 0 R>>endobj
+91 0 obj<</Length 92 0 R/Filter/FlateDecode>>stream
+x�U�n�8}�W�[ �,��%�>l���M��A_,h���R����&_���&��],ȴHΜ9s���IS�İH �CVM�n'ﶓi�\��a�c
+�8���t��t�á��x�r._�I�Sw�8=qg�ǝ�rȃ�0��*z��x����a��,aÝ������A���k)2�V`������Ϸ�&S���}�(��魏I�)C@�(>f�Z2�Ź�� ��`�DA�
+�tz���Ś�0��=��z
+�����uU���ZJ���yws<�������\�5ҁP�)�B5?�_�k~ϥ�+�H�7�n1~&��Zp���L��+
+g����E!S�q�(��m
+P�A�RHB�֭��y4���6��fl�����M[#JǁA�B�F�X
+m�Ϗ:�\�m��eY^	��/�zu���9�����"`��ebyޅ�c�9R*�oz��aH1|?9�����]%��5Xݘ�d�t���7�%���w�[h{��A��	۝C.�3b�xFWŏ���19��Ə�t1ǂ+��q��Ԡ_�И9�_��z���WQԶmȴ��3]Ey�LO�8
+|,�p����S����ju����(�,Ġ�4��6F�5����5�•����[3"�PB'�I�~<�0�N����6<<��2_�x��%)u�
+�m#��e��5�f9z�i�W�V>@�5���ܝ�
+멘!
+��]�G������F
+������ra��Sc��g�e��kB��P�4��c�ݘ���H�‚�y}��|c�	j�Ƃ=-GG��.��d�c�/D9\����(�e�D��-���`nn�l���RyS�F�-�.+�:tT�ֹ���A��cUmɑr����ȃ���f%ƅ��0K����G�>�4�	o�Y endstream
+endobj
+92 0 obj
+908
+endobj
+93 0 obj<</Type/Page/Parent 83 0 R/Contents 94 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F0 3 0 R/F4 4 0 R/F6 6 0 R/F8 8 0 R/F9 9 0 R>>>>/Annots 67 0 R>>endobj
+94 0 obj<</Length 95 0 R/Filter/FlateDecode>>stream
+x�WM��6����:�Z��e
+�I7
+�"iח��e��D����?�o(��z7((�Eμ�y���nBc���jJ�%%���ۻ_�w�(���c���-�s~_�a$e�;��|M_}�-|����Fk�,`g���j<�m:�D��:UHT)}�U��������Ü&��G��e4�C��f�y��]JK'�rr'M�Mi7p��R���}����v�(S��޸Zzx�������6)h-�锫$gp=�!L�V�z��\$G��3�c��(W��8���*�?��iCeS8�4R�!�Z|)E�H�?~���8��8�`Hg��E�T�D�|vF�����H�(,eR��{ڟ�D�R~�5`|�y2�r�}��<0Y]���9�J�$�v��4�^9ʄu��%��V~I����i:��P%e
+'�����R%��s�ׅJ�PՑ���B�7��8��w.��
+�ۯ��ݻ�;زՔj��֨�8t��J�bOUY'�B8��>|$Uu��=�22qڜ}�va=�~�gn�IF.�HK�d(�4zӚI�����F{U�|8G�aE.����Q{6t�gќ�-����^���>�=�ٶ�澈@�M<Fr�a/�\7EJVʞ�?ZJe&�[��A��z�}=�����#�&4_����Y���ݪ�G��1��⃂�K�����(h
+:5��/��9n$��UQ0�v�6\S��-���:A#�1w������4��_��h�B�0{�^��߫�8�I�[�3��4l�\��vD�k��|�3㘐L��❱�8�=�B7HD-�ɨu�gǿ�ɋqtbcyCCgd[��"<��[^�7��"�t#x�v8a�L_2�M.t�t'�a�v,��!p�hm�Z<=@km�����|>k��Z�ja��b:��t0��yc+��sb�XL�$'�eP�d�2�O��
+��@'qf{�x�N�%$��6��8XJ6�풲=�|�����$E�uP��(�o�6��n�
+F�%#U)���e��
+��l���)�B�-�[�6�]�v3���V�S��(#��v��2���~$6A�hx�!����*O_jY���H�����s�r��̝�W$o��]�b3^d�\a�lu8@���Nr�Yi|2Gw���-(+āK���A^�o�q-ط��L� ���U޺����\r{&�R��g��~\���U{~�:� pe� Lsuqa��l�R�UVO�誔��H�T�{���IX�,���z���q���Pr��,ܖtQ����S
+��������hV��Å�L�1F�tC��U-1���g,j�s�f�s����iG�%#+�a�O�ܕ?��x�i|s�xK�j%M��h�'�,�X�.O�S$�M�A9ܲ?Н_�	c��Y�|��m:ܳ��t�~+.�S���M�" z+)����~5���`w�]�p��0qϸ66t�~�j�1B��L�"�!�Y�y8_�`�2�M�Ze;FӧF���tG�+�k�ꏻ��&�ʝendstream
+endobj
+95 0 obj
+1502
+endobj
+96 0 obj<</Type/Catalog/Pages 83 0 R/Names 68 0 R/PageLayout/SinglePage/OpenAction[87 0 R/XYZ null null null]/PageMode/FullScreen/PageLabels<</Nums[0<</P(title)>>1<</S/D>>]>>>>endobj
+xref
+0 97 
+0000000000 65535 f 
+0000000015 00000 n 
+0000000251 00000 n 
+0000001808 00000 n 
+0000001882 00000 n 
+0000001960 00000 n 
+0000002037 00000 n 
+0000002116 00000 n 
+0000002199 00000 n 
+0000002275 00000 n 
+0000002356 00000 n 
+0000002415 00000 n 
+0000002454 00000 n 
+0000002539 00000 n 
+0000002578 00000 n 
+0000002663 00000 n 
+0000002702 00000 n 
+0000002787 00000 n 
+0000002826 00000 n 
+0000002911 00000 n 
+0000002950 00000 n 
+0000003035 00000 n 
+0000003074 00000 n 
+0000003159 00000 n 
+0000003198 00000 n 
+0000003283 00000 n 
+0000003322 00000 n 
+0000003407 00000 n 
+0000003511 00000 n 
+0000003615 00000 n 
+0000003719 00000 n 
+0000003823 00000 n 
+0000003927 00000 n 
+0000004031 00000 n 
+0000004135 00000 n 
+0000004239 00000 n 
+0000004343 00000 n 
+0000004447 00000 n 
+0000004551 00000 n 
+0000004655 00000 n 
+0000004759 00000 n 
+0000004863 00000 n 
+0000004967 00000 n 
+0000005071 00000 n 
+0000005175 00000 n 
+0000005279 00000 n 
+0000005383 00000 n 
+0000005487 00000 n 
+0000005526 00000 n 
+0000005611 00000 n 
+0000005652 00000 n 
+0000005735 00000 n 
+0000005962 00000 n 
+0000006026 00000 n 
+0000006110 00000 n 
+0000006134 00000 n 
+0000006172 00000 n 
+0000006257 00000 n 
+0000006295 00000 n 
+0000006380 00000 n 
+0000006459 00000 n 
+0000006543 00000 n 
+0000006611 00000 n 
+0000006695 00000 n 
+0000006736 00000 n 
+0000006819 00000 n 
+0000006860 00000 n 
+0000006945 00000 n 
+0000007004 00000 n 
+0000007036 00000 n 
+0000007068 00000 n 
+0000007282 00000 n 
+0000007329 00000 n 
+0000007376 00000 n 
+0000007423 00000 n 
+0000007470 00000 n 
+0000007517 00000 n 
+0000007564 00000 n 
+0000007611 00000 n 
+0000007658 00000 n 
+0000007705 00000 n 
+0000007752 00000 n 
+0000007799 00000 n 
+0000007846 00000 n 
+0000007976 00000 n 
+0000008116 00000 n 
+0000015824 00000 n 
+0000015845 00000 n 
+0000016014 00000 n 
+0000017129 00000 n 
+0000017150 00000 n 
+0000017311 00000 n 
+0000018288 00000 n 
+0000018308 00000 n 
+0000018468 00000 n 
+0000020039 00000 n 
+0000020060 00000 n 
+trailer
+<</Size 97/Root 96 0 R/Info 1 0 R>>
+startxref
+20243
+%%EOF
Index: web/openacs/www/doc/openacs/pdf/simple-postgres-install.pdf
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/pdf/simple-postgres-install.pdf,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/pdf/simple-postgres-install.pdf	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,718 @@
+%PDF-1.2
+%����
+1 0 obj<</Producer(htmldoc 1.8.4 Copyright 1997-1999 Easy Software Products, All Rights Reserved.)/CreationDate(D:20010215051115Z)/Title( Simple PostgreSQL Installation Guide )/Creator(Modular DocBook HTML Stylesheet Version 1.61\12)>>endobj
+2 0 obj<</Type/Encoding/Differences[ 32/space/exclam/quotedbl/numbersign/dollar/percent/ampersand/quotesingle/parenleft/parenright/asterisk/plus/comma/minus/period/slash/zero/one/two/three/four/five/six/seven/eight/nine/colon/semicolon/less/equal/greater/question/at/A/B/C/D/E/F/G/H/I/J/K/L/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/bracketleft/backslash/bracketright/asciicircum/underscore/grave/a/b/c/d/e/f/g/h/i/j/k/l/m/n/o/p/q/r/s/t/u/v/w/x/y/z/braceleft/bar/braceright/asciitilde 130/quotesinglbase/florin/quotedblbase/ellipsis/dagger/daggerdbl/circumflex/perthousand/Scaron/guilsinglleft/OE 145/quoteleft/quoteright/quotedblleft/quotedblright/bullet/endash/emdash/tilde/trademark/scaron/guilsinglright/oe 159/Ydieresis/space/exclamdown/cent/sterling/currency/yen/brokenbar/section/dieresis/copyright/ordfeminine/guillemotleft/logicalnot/hyphen/registered/macron/degree/plusminus/twosuperior/threesuperior/acute/mu/paragraph/periodcentered/cedilla/onesuperior/ordmasculine/guillemotright/onequarter/onehalf/threequarters/questiondown/Agrave/Aacute/Acircumflex/Atilde/Adieresis/Aring/AE/Ccedilla/Egrave/Eacute/Ecircumflex/Edieresis/Igrave/Iacute/Icircumflex/Idieresis/Eth/Ntilde/Ograve/Oacute/Ocircumflex/Otilde/Odieresis/multiply/Oslash/Ugrave/Uacute/Ucircumflex/Udieresis/Yacute/Thorn/germandbls/agrave/aacute/acircumflex/atilde/adieresis/aring/ae/ccedilla/egrave/eacute/ecircumflex/edieresis/igrave/iacute/icircumflex/idieresis/eth/ntilde/ograve/oacute/ocircumflex/otilde/odieresis/divide/oslash/ugrave/uacute/ucircumflex/udieresis/yacute/thorn/ydieresis]>>endobj
+3 0 obj<</Type/Font/Subtype/Type1/BaseFont/Courier/Encoding 2 0 R>>endobj
+4 0 obj<</Type/Font/Subtype/Type1/BaseFont/Times-Roman/Encoding 2 0 R>>endobj
+5 0 obj<</Type/Font/Subtype/Type1/BaseFont/Times-Bold/Encoding 2 0 R>>endobj
+6 0 obj<</Type/Font/Subtype/Type1/BaseFont/Times-Italic/Encoding 2 0 R>>endobj
+7 0 obj<</Type/Font/Subtype/Type1/BaseFont/Times-BoldItalic/Encoding 2 0 R>>endobj
+8 0 obj<</Type/Font/Subtype/Type1/BaseFont/Helvetica/Encoding 2 0 R>>endobj
+9 0 obj<</Type/Font/Subtype/Type1/BaseFont/Helvetica-Bold/Encoding 2 0 R>>endobj
+10 0 obj<</Type/Font/Subtype/Type1/BaseFont/Symbol>>endobj
+11 0 obj<</S/URI/URI(http://www.postgresql.org/docs/admin/install855.htm)>>endobj
+12 0 obj<</Subtype/Link/Rect[209.5 591.3 247.1 604.3]/Border[0 0 0]/A 11 0 R>>endobj
+13 0 obj<</S/URI/URI(http://www.postgresql.org/docs/admin/install855.htm)>>endobj
+14 0 obj<</Subtype/Link/Rect[247.1 591.3 255.3 604.3]/Border[0 0 0]/A 13 0 R>>endobj
+15 0 obj<</S/URI/URI(http://www.postgresql.org/docs/admin/install855.htm)>>endobj
+16 0 obj<</Subtype/Link/Rect[255.3 591.3 267.2 604.3]/Border[0 0 0]/A 15 0 R>>endobj
+17 0 obj<</S/URI/URI(http://www.postgresql.org/docs/admin/install855.htm)>>endobj
+18 0 obj<</Subtype/Link/Rect[267.2 591.3 283.4 604.3]/Border[0 0 0]/A 17 0 R>>endobj
+19 0 obj<</S/URI/URI(http://www.postgresql.org/docs/admin/install855.htm)>>endobj
+20 0 obj<</Subtype/Link/Rect[283.4 591.3 352.2 604.3]/Border[0 0 0]/A 19 0 R>>endobj
+21 0 obj<</S/URI/URI(http://www.postgresql.org/docs/admin/install855.htm)>>endobj
+22 0 obj<</Subtype/Link/Rect[352.2 591.3 379.0 604.3]/Border[0 0 0]/A 21 0 R>>endobj
+23 0 obj<</S/URI/URI(x12.html)>>endobj
+24 0 obj<</Subtype/Link/Rect[119.0 510.1 151.1 523.1]/Border[0 0 0]/A 23 0 R>>endobj
+25 0 obj<</S/URI/URI(x12.html)>>endobj
+26 0 obj<</Subtype/Link/Rect[151.1 510.1 169.7 523.1]/Border[0 0 0]/A 25 0 R>>endobj
+27 0 obj<</S/URI/URI(x12.html)>>endobj
+28 0 obj<</Subtype/Link/Rect[169.7 510.1 189.9 523.1]/Border[0 0 0]/A 27 0 R>>endobj
+29 0 obj<</Subtype/Link/Rect[127.2 470.5 160.6 483.5]/Border[0 0 0]/Dest[187 0 R/XYZ null 528 0]>>endobj
+30 0 obj<</Subtype/Link/Rect[160.6 470.5 167.0 483.5]/Border[0 0 0]/Dest[187 0 R/XYZ null 528 0]>>endobj
+31 0 obj<</Subtype/Link/Rect[167.0 470.5 204.5 483.5]/Border[0 0 0]/Dest[187 0 R/XYZ null 528 0]>>endobj
+32 0 obj<</Subtype/Link/Rect[204.5 470.5 217.1 483.5]/Border[0 0 0]/Dest[187 0 R/XYZ null 528 0]>>endobj
+33 0 obj<</Subtype/Link/Rect[217.1 470.5 234.5 483.5]/Border[0 0 0]/Dest[187 0 R/XYZ null 528 0]>>endobj
+34 0 obj<</Subtype/Link/Rect[234.5 470.5 242.7 483.5]/Border[0 0 0]/Dest[187 0 R/XYZ null 528 0]>>endobj
+35 0 obj<</Subtype/Link/Rect[242.7 470.5 274.2 483.5]/Border[0 0 0]/Dest[187 0 R/XYZ null 528 0]>>endobj
+36 0 obj<</Subtype/Link/Rect[274.2 470.5 306.0 483.5]/Border[0 0 0]/Dest[187 0 R/XYZ null 528 0]>>endobj
+37 0 obj<</Subtype/Link/Rect[306.0 470.5 333.8 483.5]/Border[0 0 0]/Dest[187 0 R/XYZ null 528 0]>>endobj
+38 0 obj<</Subtype/Link/Rect[333.8 470.5 339.3 483.5]/Border[0 0 0]/Dest[187 0 R/XYZ null 528 0]>>endobj
+39 0 obj<</S/URI/URI(x32.html)>>endobj
+40 0 obj<</Subtype/Link/Rect[83.0 430.9 132.2 443.9]/Border[0 0 0]/A 39 0 R>>endobj
+41 0 obj<</S/URI/URI(x32.html)>>endobj
+42 0 obj<</Subtype/Link/Rect[132.2 430.9 151.5 443.9]/Border[0 0 0]/A 41 0 R>>endobj
+43 0 obj<</S/URI/URI(x32.html)>>endobj
+44 0 obj<</Subtype/Link/Rect[151.5 430.9 196.4 443.9]/Border[0 0 0]/A 43 0 R>>endobj
+45 0 obj<</S/URI/URI(x32.html)>>endobj
+46 0 obj<</Subtype/Link/Rect[196.4 430.9 212.6 443.9]/Border[0 0 0]/A 45 0 R>>endobj
+47 0 obj<</S/URI/URI(x32.html)>>endobj
+48 0 obj<</Subtype/Link/Rect[212.6 430.9 233.0 443.9]/Border[0 0 0]/A 47 0 R>>endobj
+49 0 obj<</S/URI/URI(x32.html)>>endobj
+50 0 obj<</Subtype/Link/Rect[233.0 430.9 252.9 443.9]/Border[0 0 0]/A 49 0 R>>endobj
+51 0 obj<</S/URI/URI(x32.html)>>endobj
+52 0 obj<</Subtype/Link/Rect[252.9 430.9 288.9 443.9]/Border[0 0 0]/A 51 0 R>>endobj
+53 0 obj<</Subtype/Link/Rect[91.2 391.3 151.8 404.3]/Border[0 0 0]/Dest[190 0 R/XYZ null 792 0]>>endobj
+54 0 obj<</Subtype/Link/Rect[91.2 364.9 133.1 377.9]/Border[0 0 0]/Dest[190 0 R/XYZ null 532 0]>>endobj
+55 0 obj<</Subtype/Link/Rect[133.1 364.9 143.3 377.9]/Border[0 0 0]/Dest[190 0 R/XYZ null 532 0]>>endobj
+56 0 obj<</Subtype/Link/Rect[143.3 364.9 166.8 377.9]/Border[0 0 0]/Dest[190 0 R/XYZ null 532 0]>>endobj
+57 0 obj<</Subtype/Link/Rect[166.8 364.9 178.1 377.9]/Border[0 0 0]/Dest[190 0 R/XYZ null 532 0]>>endobj
+58 0 obj<</Subtype/Link/Rect[178.1 364.9 218.1 377.9]/Border[0 0 0]/Dest[190 0 R/XYZ null 532 0]>>endobj
+59 0 obj<</Subtype/Link/Rect[218.1 364.9 234.3 377.9]/Border[0 0 0]/Dest[190 0 R/XYZ null 532 0]>>endobj
+60 0 obj<</Subtype/Link/Rect[234.3 364.9 277.4 377.9]/Border[0 0 0]/Dest[190 0 R/XYZ null 532 0]>>endobj
+61 0 obj<</Subtype/Link/Rect[277.4 364.9 288.7 377.9]/Border[0 0 0]/Dest[190 0 R/XYZ null 532 0]>>endobj
+62 0 obj<</Subtype/Link/Rect[288.7 364.9 345.3 377.9]/Border[0 0 0]/Dest[190 0 R/XYZ null 532 0]>>endobj
+63 0 obj<</Subtype/Link/Rect[345.3 364.9 345.3 366.9]/Border[0 0 0]/Dest[196 0 R/XYZ null 144 0]>>endobj
+64 0 obj<</Subtype/Link/Rect[345.3 364.9 359.3 377.9]/Border[0 0 0]/Dest[196 0 R/XYZ null 144 0]>>endobj
+65 0 obj<</Subtype/Link/Rect[91.2 338.5 140.5 351.5]/Border[0 0 0]/Dest[190 0 R/XYZ null 249 0]>>endobj
+66 0 obj<</Subtype/Link/Rect[140.5 338.5 159.7 351.5]/Border[0 0 0]/Dest[190 0 R/XYZ null 249 0]>>endobj
+67 0 obj<</Subtype/Link/Rect[159.7 338.5 201.3 351.5]/Border[0 0 0]/Dest[190 0 R/XYZ null 249 0]>>endobj
+68 0 obj<</Subtype/Link/Rect[91.2 312.1 127.0 325.1]/Border[0 0 0]/Dest[196 0 R/XYZ null 449 0]>>endobj
+69 0 obj<</Subtype/Link/Rect[127.0 312.1 135.9 325.1]/Border[0 0 0]/Dest[196 0 R/XYZ null 449 0]>>endobj
+70 0 obj<</Subtype/Link/Rect[135.9 312.1 147.2 325.1]/Border[0 0 0]/Dest[196 0 R/XYZ null 449 0]>>endobj
+71 0 obj<</Subtype/Link/Rect[147.2 312.1 170.1 325.1]/Border[0 0 0]/Dest[196 0 R/XYZ null 449 0]>>endobj
+72 0 obj<</Subtype/Link/Rect[170.1 312.1 191.8 325.1]/Border[0 0 0]/Dest[196 0 R/XYZ null 449 0]>>endobj
+73 0 obj<</Subtype/Link/Rect[191.8 312.1 218.4 325.1]/Border[0 0 0]/Dest[196 0 R/XYZ null 449 0]>>endobj
+74 0 obj<</Subtype/Link/Rect[218.4 312.1 237.9 325.1]/Border[0 0 0]/Dest[196 0 R/XYZ null 449 0]>>endobj
+75 0 obj<</Subtype/Link/Rect[91.2 285.7 123.6 298.7]/Border[0 0 0]/Dest[196 0 R/XYZ null 337 0]>>endobj
+76 0 obj<</S/URI/URI(x111.html)>>endobj
+77 0 obj<</Subtype/Link/Rect[83.0 259.3 127.9 272.3]/Border[0 0 0]/A 76 0 R>>endobj
+78 0 obj<</S/URI/URI(x111.html)>>endobj
+79 0 obj<</Subtype/Link/Rect[127.9 259.3 160.6 272.3]/Border[0 0 0]/A 78 0 R>>endobj
+80 0 obj<</S/URI/URI(x111.html)>>endobj
+81 0 obj<</Subtype/Link/Rect[160.6 259.3 202.8 272.3]/Border[0 0 0]/A 80 0 R>>endobj
+82 0 obj<</Subtype/Link/Rect[91.2 219.7 118.1 232.7]/Border[0 0 0]/Dest[202 0 R/XYZ null 792 0]>>endobj
+83 0 obj<</Subtype/Link/Rect[91.2 193.3 116.9 206.3]/Border[0 0 0]/Dest[202 0 R/XYZ null 297 0]>>endobj
+84 0 obj<</S/URI/URI(x155.html)>>endobj
+85 0 obj<</Subtype/Link/Rect[83.0 166.9 167.3 179.9]/Border[0 0 0]/A 84 0 R>>endobj
+86 0 obj<</S/URI/URI(x12.html)>>endobj
+87 0 obj<</Subtype/Link/Rect[554.6 138.5 576.0 151.5]/Border[0 0 0]/A 86 0 R>>endobj
+88 0 obj<</S/URI/URI(index.html)>>endobj
+89 0 obj<</Subtype/Link/Rect[72.0 98.9 92.2 111.9]/Border[0 0 0]/A 88 0 R>>endobj
+90 0 obj<</S/URI/URI(x32.html)>>endobj
+91 0 obj<</Subtype/Link/Rect[554.6 98.9 576.0 111.9]/Border[0 0 0]/A 90 0 R>>endobj
+92 0 obj[12 0 R
+14 0 R
+16 0 R
+18 0 R
+20 0 R
+22 0 R
+24 0 R
+26 0 R
+28 0 R
+29 0 R
+30 0 R
+31 0 R
+32 0 R
+33 0 R
+34 0 R
+35 0 R
+36 0 R
+37 0 R
+38 0 R
+40 0 R
+42 0 R
+44 0 R
+46 0 R
+48 0 R
+50 0 R
+52 0 R
+53 0 R
+54 0 R
+55 0 R
+56 0 R
+57 0 R
+58 0 R
+59 0 R
+60 0 R
+61 0 R
+62 0 R
+63 0 R
+64 0 R
+65 0 R
+66 0 R
+67 0 R
+68 0 R
+69 0 R
+70 0 R
+71 0 R
+72 0 R
+73 0 R
+74 0 R
+75 0 R
+77 0 R
+79 0 R
+81 0 R
+82 0 R
+83 0 R
+85 0 R
+87 0 R
+89 0 R
+91 0 R
+]endobj
+93 0 obj<</S/URI/URI(ftp://ftp.gnu.org)>>endobj
+94 0 obj<</Subtype/Link/Rect[186.5 652.0 256.8 665.0]/Border[0 0 0]/A 93 0 R>>endobj
+95 0 obj<</S/URI/URI(index.html)>>endobj
+96 0 obj<</Subtype/Link/Rect[72.0 314.2 92.2 327.2]/Border[0 0 0]/A 95 0 R>>endobj
+97 0 obj<</S/URI/URI(index.html)>>endobj
+98 0 obj<</Subtype/Link/Rect[310.6 314.2 337.4 327.2]/Border[0 0 0]/A 97 0 R>>endobj
+99 0 obj<</S/URI/URI(x32.html)>>endobj
+100 0 obj<</Subtype/Link/Rect[554.6 314.2 576.0 327.2]/Border[0 0 0]/A 99 0 R>>endobj
+101 0 obj<</S/URI/URI(x12.html)>>endobj
+102 0 obj<</Subtype/Link/Rect[72.0 261.4 92.2 274.4]/Border[0 0 0]/A 101 0 R>>endobj
+103 0 obj<</S/URI/URI(x111.html)>>endobj
+104 0 obj<</Subtype/Link/Rect[554.6 261.4 576.0 274.4]/Border[0 0 0]/A 103 0 R>>endobj
+105 0 obj[94 0 R
+96 0 R
+98 0 R
+100 0 R
+102 0 R
+104 0 R
+]endobj
+106 0 obj<</S/URI/URI(http://www.postgresql.org/sites.html)>>endobj
+107 0 obj<</Subtype/Link/Rect[72.0 574.0 233.0 587.0]/Border[0 0 0]/A 106 0 R>>endobj
+108 0 obj<</Subtype/Link/Rect[529.3 452.0 529.3 454.0]/Border[0 0 0]/Dest[196 0 R/XYZ null 144 0]>>endobj
+109 0 obj<</Subtype/Link/Rect[529.3 452.0 548.7 469.8]/Border[0 0 0]/Dest[196 0 R/XYZ null 144 0]>>endobj
+110 0 obj[107 0 R
+108 0 R
+109 0 R
+]endobj
+111 0 obj<</S/URI/URI(http://www.postgresql.org/docs/admin/install855.htm)>>endobj
+112 0 obj<</Subtype/Link/Rect[370.8 574.4 408.4 587.4]/Border[0 0 0]/A 111 0 R>>endobj
+113 0 obj<</S/URI/URI(http://www.postgresql.org/docs/admin/install855.htm)>>endobj
+114 0 obj<</Subtype/Link/Rect[408.4 574.4 416.6 587.4]/Border[0 0 0]/A 113 0 R>>endobj
+115 0 obj<</S/URI/URI(http://www.postgresql.org/docs/admin/install855.htm)>>endobj
+116 0 obj<</Subtype/Link/Rect[416.6 574.4 428.5 587.4]/Border[0 0 0]/A 115 0 R>>endobj
+117 0 obj<</S/URI/URI(http://www.postgresql.org/docs/admin/install855.htm)>>endobj
+118 0 obj<</Subtype/Link/Rect[428.5 574.4 444.7 587.4]/Border[0 0 0]/A 117 0 R>>endobj
+119 0 obj<</S/URI/URI(http://www.postgresql.org/docs/admin/install855.htm)>>endobj
+120 0 obj<</Subtype/Link/Rect[444.7 574.4 513.5 587.4]/Border[0 0 0]/A 119 0 R>>endobj
+121 0 obj<</S/URI/URI(http://www.postgresql.org/docs/admin/install855.htm)>>endobj
+122 0 obj<</Subtype/Link/Rect[513.5 574.4 540.4 587.4]/Border[0 0 0]/A 121 0 R>>endobj
+123 0 obj[112 0 R
+114 0 R
+116 0 R
+118 0 R
+120 0 R
+122 0 R
+]endobj
+124 0 obj<</Subtype/Link/Rect[74.0 98.9 74.0 100.9]/Border[0 0 0]/Dest[190 0 R/XYZ null 532 0]>>endobj
+125 0 obj<</Subtype/Link/Rect[74.0 98.9 86.8 111.9]/Border[0 0 0]/Dest[190 0 R/XYZ null 532 0]>>endobj
+126 0 obj<</S/URI/URI(x12.html)>>endobj
+127 0 obj<</Subtype/Link/Rect[72.0 53.3 92.2 66.3]/Border[0 0 0]/A 126 0 R>>endobj
+128 0 obj<</S/URI/URI(index.html)>>endobj
+129 0 obj<</Subtype/Link/Rect[310.6 53.3 337.4 66.3]/Border[0 0 0]/A 128 0 R>>endobj
+130 0 obj<</S/URI/URI(x111.html)>>endobj
+131 0 obj<</Subtype/Link/Rect[554.6 53.3 576.0 66.3]/Border[0 0 0]/A 130 0 R>>endobj
+132 0 obj[124 0 R
+125 0 R
+127 0 R
+129 0 R
+131 0 R
+]endobj
+133 0 obj<</S/URI/URI(x32.html)>>endobj
+134 0 obj<</Subtype/Link/Rect[72.0 727.6 92.2 740.6]/Border[0 0 0]/A 133 0 R>>endobj
+135 0 obj<</S/URI/URI(x155.html)>>endobj
+136 0 obj<</Subtype/Link/Rect[554.6 727.6 576.0 740.6]/Border[0 0 0]/A 135 0 R>>endobj
+137 0 obj[134 0 R
+136 0 R
+]endobj
+138 0 obj<</S/URI/URI(http://www.postgresql.org/sites.html)>>endobj
+139 0 obj<</Subtype/Link/Rect[396.8 685.8 557.8 698.8]/Border[0 0 0]/A 138 0 R>>endobj
+140 0 obj[139 0 R
+]endobj
+141 0 obj<</S/URI/URI(x32.html)>>endobj
+142 0 obj<</Subtype/Link/Rect[72.0 378.8 92.2 391.8]/Border[0 0 0]/A 141 0 R>>endobj
+143 0 obj<</S/URI/URI(index.html)>>endobj
+144 0 obj<</Subtype/Link/Rect[310.6 378.8 337.4 391.8]/Border[0 0 0]/A 143 0 R>>endobj
+145 0 obj<</S/URI/URI(x155.html)>>endobj
+146 0 obj<</Subtype/Link/Rect[554.6 378.8 576.0 391.8]/Border[0 0 0]/A 145 0 R>>endobj
+147 0 obj<</S/URI/URI(x111.html)>>endobj
+148 0 obj<</Subtype/Link/Rect[72.0 326.0 92.2 339.0]/Border[0 0 0]/A 147 0 R>>endobj
+149 0 obj[142 0 R
+144 0 R
+146 0 R
+148 0 R
+]endobj
+150 0 obj<</S/URI/URI(x111.html)>>endobj
+151 0 obj<</Subtype/Link/Rect[72.0 610.4 92.2 623.4]/Border[0 0 0]/A 150 0 R>>endobj
+152 0 obj<</S/URI/URI(index.html)>>endobj
+153 0 obj<</Subtype/Link/Rect[310.6 610.4 337.4 623.4]/Border[0 0 0]/A 152 0 R>>endobj
+154 0 obj[151 0 R
+153 0 R
+]endobj
+155 0 obj<</Dests 156 0 R>>endobj
+156 0 obj<</Kids[157 0 R]>>endobj
+157 0 obj<</Limits[(aen101)(x32.html)]/Names[(aen101)158 0 R(aen106)159 0 R(aen111)160 0 R(aen113)161 0 R(aen12)162 0 R(aen132)163 0 R(aen155)164 0 R(aen2)165 0 R(aen28)166 0 R(aen32)167 0 R(aen34)168 0 R(aen4)169 0 R(aen44)170 0 R(aen46)171 0 R(aen62)172 0 R(aen8)173 0 R(ftn.aen46)174 0 R(index.html)175 0 R(x111.html)176 0 R(x12.html)177 0 R(x155.html)178 0 R(x32.html)179 0 R]>>endobj
+158 0 obj<</D[193 0 R/XYZ null 449 null]>>endobj
+159 0 obj<</D[193 0 R/XYZ null 337 null]>>endobj
+160 0 obj<</D[199 0 R/XYZ null 834 null]>>endobj
+161 0 obj<</D[199 0 R/XYZ null 792 null]>>endobj
+162 0 obj<</D[184 0 R/XYZ null 834 null]>>endobj
+163 0 obj<</D[199 0 R/XYZ null 297 null]>>endobj
+164 0 obj<</D[205 0 R/XYZ null 834 null]>>endobj
+165 0 obj<</D[181 0 R/XYZ null 834 null]>>endobj
+166 0 obj<</D[184 0 R/XYZ null 528 null]>>endobj
+167 0 obj<</D[187 0 R/XYZ null 834 null]>>endobj
+168 0 obj<</D[187 0 R/XYZ null 792 null]>>endobj
+169 0 obj<</D[181 0 R/XYZ null 744 null]>>endobj
+170 0 obj<</D[187 0 R/XYZ null 532 null]>>endobj
+171 0 obj<</D[187 0 R/XYZ null 532 null]>>endobj
+172 0 obj<</D[187 0 R/XYZ null 249 null]>>endobj
+173 0 obj<</D[181 0 R/XYZ null 649 null]>>endobj
+174 0 obj<</D[193 0 R/XYZ null 144 null]>>endobj
+175 0 obj<</D[181 0 R/XYZ null 720 null]>>endobj
+176 0 obj<</D[193 0 R/XYZ null 6 null]>>endobj
+177 0 obj<</D[181 0 R/XYZ null 91 null]>>endobj
+178 0 obj<</D[202 0 R/XYZ null 318 null]>>endobj
+179 0 obj<</D[184 0 R/XYZ null 253 null]>>endobj
+180 0 obj<</Type/Pages/MediaBox[0 0 612 792]/Count 10/Kids[181 0 R
+184 0 R
+187 0 R
+190 0 R
+193 0 R
+196 0 R
+199 0 R
+202 0 R
+205 0 R
+208 0 R
+178 0 R
+178 0 R
+178 0 R
+178 0 R
+178 0 R
+178 0 R
+]>>endobj
+181 0 obj<</Type/Page/Parent 180 0 R/Contents 182 0 R/Resources<</ProcSet[/PDF/Text/ImageB/ImageC/ImageI]/Font<</F8 8 0 R/F9 9 0 R>>>>>>endobj
+182 0 obj<</Length 183 0 R/Filter/FlateDecode>>stream
+x�][sܸr�R��P�I�C��ƣ_��oZ��T�V�I�-���<���cN*���qi�qk�i�������w�o矮��ߧ��>_}�����9�����_��v�����/���_?]}�������o�~����x�o�����OwW_>�������p���oן?}����z8|����7��o�oo�����o׿=���������ׯ�non����?��~sw
+�>�}������/���5��t�x��p�p�x8��������������x�����÷���w�w8�=^���������w!RW�?���?������?��՗�����ӷ�w�ru{������zA��^xA����YcA��(�����=q&'�T;��L��}���������(}q���E�*ug}�}]�vc]�"5��n׮�SӪG�s+�x�������'��u������C�ކW��X��Y|TEF_&���,p6�^��VU��k]��1Օaa�'�����V��_2@���>{ks�^���	�&b����I����ɦ�cg��E�c
+��Z�VP��5�t��������R1v+�S����V3
+޾��t�:������lL��Q$�z5�' ���6?m%�(�l�����i���k�Y@�t�vM�:
+a@����h6юZa�腐¯�O�<�/LIx�z�IZHB][�7�V�B-��kX�V1���Ӛ"c��
+>D�yּiz�Z��D�����LY<	���$@9�yA��5�����2����y�G�B��0U]�0Y��a?�N�IT��(uE��}g<"`ZS�hY��qy��^����7���J�F3о�<h��&%��m�lLg? Sl���HR���"*0�h�^9�ߩ魵"���C'#8͉)�t�ӕ�$�4��u@�;yWWf6&ML�	:�3L�2T�f�n�t���K>�V����C~�����V� fb�i�����b����	���FW�E7:ۢ���j58+m�t�~�6�9h������dO���k�Y�KZDº�>/"@<��&iM���i@N(m9h�JXN���g�������0�hXI�9�B���R8x"S�F��{I�$Lv�vv
+1���ڦ�R���Z���aD��*a��I3@H@F�ֈF7�b`��nz9�@�Cs��\���t��)���B�$�0I�$L0�~�OϮ��֎���-����2/��̒��C�&���h��TL����T��qkW
+��!�Jl
+-~��=����J��b:	{$�����W
+���t
+_��`��jZ�t��N�	�W��~Lz23��i{�N�K=�n��=��� [��n�!	e�����7E���Ib�D������i�KW��"��C���Rt)B��ܽ��z�&�f��v��Ԧ��$%M����I��"���vƃ�\����*���Ih�J��,3�+}p';p+!a�[g
+`�ˣ�uc���7Z�?ՠ�^'�%�'�Z1,U�8���w���4C�&@z�Fr��#ah�3�ֹO���UF����H8u�J��nD����LL�0�n�i/u~F�'��j�&6�'��Vd��O#�[�{"p���$�5�'�s���YSx�5f�+��@�U���ho�x�d�~	��g.�4�[Rp:7���y��Wqe�.j`�c�S�I��	ko͘´ܽ�f��7�ى�T3ᎀrh�cfI@��3$��C(�ڬ�d�\�K;7���U*��<f�3|6-��i��g���nx�4�������"b��E�.~9��1!1�G���	���\�vTe�aa76���$K��I��W|w�WmyLH0OB�$�H�@9����6��%IF(�	���0�z��hʡ-�YF�1I�6�H؋����&g�gq�ہ@
+����l������,�NUG�ʽ�ʡ-�	�4b�&)Kh�� Qs
+d�3I�BI�W� %/��*ص'/
+��$P�E�D��}�ЖDŽ�����,	� lG���S�
+5�#D\&�<35�]ޑ���:Y.%*��<f9	�Iʒ���B��;H&=��I���S�&�pׄ�ǹ4�gUmy�$����F�ط.�g'Va�1�O������lx�9�� (��cV8��=m�	3�˞��$eI��s$l�)0�-�L@�1k�Jn�6PJ��ϘM�5�rh�cB��(�B�H�:$T�&�:���x��`A��ɬ�r��~�������/��<&�a	[�'6=�f
+'<�D�H���CT�`�l`֨��g��M߁ہ�ͫ�ЖǜM�U_�E?GUIAz�^Y��@-q��<�%�_9�j$G��&��~�������+��<&�;OLQԌJ�IU���@UP��P�H�+���1���
+7�t�~�r����ʁ'n�d�C[��K>�6G#�F�I0�����J�#q���	�Na�!tn��0c�Ckg�̠�M��ŏT�C[s	h����&4�8U�
+g
+�ީ�'�ކ��p���,��e+:�_ W���`��X�O�HU9�D��t��k�1I)�S#�BiUH�P�>���Z�K\]�B����Ԥ���c�����p�LDa+��L�F�D�5� �N����oK-2��ֈ�Sgm�&���×$�����T�2N�5���\]S7�l�!!p~\��B����&Z���ٮD��$D�_���$v��}D��R����w����L㚼I�Z��l� y�`����8�,pMr ��ơk�����V�u��cc;tTF�nձ'.�mը#��;��B؟��r�3�U3�;ݚ��Q��S/0�SGS��b��������4c�	�`�3y
+�.�+�n�����*�`�}�0үWq�$�����O���>�#>���$V�G-\ �lD�'|�D�@F�v��=����x�6πN��a�+��:8`225�E�&�V@��Y��:l�����
+�f�J��ByεJ��HN��a%vZ��5����t�̕�ދa�a��<�ug��˻#*��H�ֱ1M�� ��u��j�DhӬ���$	��ީ&"�F�
+��_^�zN3	�%�q��R��9��TM��Gf�A#!��%A)�$O��	ߥ�|���-
+I�*U@"�8���$����E��HI��K�|U`�d�ۍ)����I���{��˶{��i�KE	�L���ᒰ-�UX}~|	�H0��.�����}�)Q�:8������]��"-$��V���o��
+��B�\t��@oL���/�PbqCJ��N�����}2I���{��6PS,��&D�Q:1˛�Y����|\�W�V� �&o����(�y�W1	F�x�h�	Վ�
+	t9j�B�
+�nq�Wb�T^�4%�PC�㑷/�#��m.�H��[?i��;��d8f��ȩ~������~qC��2��2����e�
+1Ӂq���`��^Tp�T_�T�$8&�9�I�;�bE�����e�Q	˺�^�Z�
+�I�"��oO��v��>����:����h�0�wkc\�77uG�
+��瀴	���s_�@Kbf#B�R��=:=������e(���x��T�e@�B�再2뺭&,j�6a��J3O�XX�~/	Kأ�S ���S�<K�|y�
+t���O\s!3wQ2��"��e�J"e�9�����M��HƋ��Ӌ7#�G"z.��NOI-�$9�g)B��]�h\,f�ː����n\W5=��/'�C
+�"R��\x���|%Z��(�O�H�P$.uέ��ȥ��4�RJK�܃81��{[�[���`lZ�›D'�?s�b��H��?b�39�ۭOwza��S\��IXw��"��h���-g�`�k��)X|���}�Q���{��� y,�yk4W�i�Y5���w�'��c[�Ӄ�x��WP#b�����+�_M��	{�{Z����9�.
+M��7!$Oba�h�&;,�*�~�G��<�rMUB/_��~� ΁Q��X����_�	h��,�8�Y�Ou�-���C�ո�71wQ��6��w�H{[bU]��/��/a�E����=X��S����#M8��
+�K���;2��<�V���>%WWq�����^˅�gb��MC�۶�1a��/��j���������i��GV8u��"�k�$�a$u�ѿQ�W�u\�u���fH����q�"�5" 9@���	U@��w�7̂����r�Dz�٧�J�E��u3���0
+-
+�ᰰ��P�U'���Š(kD1�l�/��4E��A@Q�i�����n��%~��/�9雑*m͉������O?W��+Gk$R��^_����%�(�sJ�a��ۍ��J��x�������0��&)]N񱶴�D��������3$l#b0(��a�Bp*��4��^ꀀQ�
+ j�p�x�S�O��:��^�G�t]�ѓ
+F�;I&q+���4��"��X�P�p\EH��|~�#��53*��r����BH�eʞ��Jq�Ms�A:��0�/���" �M��m|H���]+T����+�$X�p����Ys�q+�����i���&�Fr�f.��Ml0J��&���>��� �/4H��\� m��<sc�a���^���7��Ӧ��w�-�d6�)�S#w�������Rk� (%���7��.9�0�,�~(��
+��P�S�IH6�4�7�^�ڧi2�e߄G����px)1H;�A���*�Z.�;f�δ��>����-��� �J��
+���ȜD�߷i��@.�����m���f�g�T=d�3�#�5�i�p%�A��*����"L�C��9��W�
+h$�*�+��"X��f�%�ƒ`��&-�
+@Cz?�d]�|������3Yy��LZxg����S@R���:
+��!���A���Ӕ�₇I��90��
+�#7X�[���k��W�-s'KiU�惡���$p;���0��$S�B�7�8�����OB� ���N���BE`�u�G�i&��uL����uS����A�F?�n�r\>�?�
+ž��c.(�ʝV�W�n����ma�\�C�ʂ�߂����YՇ_�e�#V�vɲj�-(ӱwAc*��>#	3�U��D��_�;�,Xĕ��C�GI����P��FT!z�Ǵx�i��mK1[����b]��U#!@Y��(A<��u�6�<d�C�`�%sf�A�B��b00U�g�f!O#39p-Rф9L(�+���G#�g 潲��TqRג;�֝��Q����tP_�K���/�����͓����D��g�4�t�y��8b}xZ�P�C�yxf�C�됅޸2�.�^���F����z��j�v��MU5PװS� �m8;����^�y����NJ��/_R�E���l��'B��1F�N"eH7���Bgv�d0P| ���#b`� ކ�^F`��s�$`-t���>��m42�Q���0
+#�
+k��,H:O�;�-�!L\b[�ElD~hѥ~Cu�Z>i�(�z�ij���%���yXGB����m�w�'�X%؅�����P�������Pv����rJ�eFs��cb@�<�Ƣ�2��f�\���0d`��Q���ز
+��`mv����E��WZ�i֬1��|~fс�윪�{��
+U
+��V�=�h�cI�ʂ�A@/.E���$	�ɚE�DC�4ͪ�M�_6;�8��:$�I���ֽfH�
+��M{M˼�4N㬐W,HEІ J�- �hJ���Y?�������h6����IM��$l��5��rj;���3j��$Y�d�M@����0�7O�K5e�6
+I{dD�َ��G�nE��N�#�
+�����p/������U���8x*��XH����Lr*�w�${���Ar�������[���Ԋ��D��FaFۼ��86�b�y��w�$>�JX+�
+��팛-}�I�N�/��Bb�zI�*qN�
+,��z?�`��cY�w�{�
+ȱc7‚c�6<�hf��~���;-r5v	�dARKX���í೬�*�p5�0�+��	�m��;d�l`�as���:��zzE����R̢M�Z�q���OZ�LI�i��zk�:�	d�s�֎E�]�pG�O�I���P�Ք4K��xsZʜ/P�or�[���/�Ԙ(I��B�������}�،�J<�������N@^��$l�{Yg{@q�q��1�~2_�H���ڤ��+hCU�4\��U
+�P�<�U���������ap$�=�<["{7�a/�r�s|v�0�-�I���5*���r�&�)/�)V�LX�*H9kX�UW（Ѹ90�/������B���|�"	���[����_~��a�m�C�x�L,-�.�!K~�lłu����o�O��ߤ��~� #I��|'8�<>|�������>�d�lW�7��Խb�<~�{d�	�I�q��S4����J�`�v+Y��i����-W�t�%�AE�|[F1ۭ��D}/]�#�Lj��g����N2Ndt��î�6X/X@����d�T�~D���(��&��I�1kk+�X��(���%AB��G� v������
+@���刻Ǔv�∸��h�)?���:�	��J8`�=€4_�#b(䞤Y8��M�a�1��A�
+�me&Q�	+i���il痊6nN�g��z��d��҄MBbHh�H9��NOq���
+}͵i�	k9X�$}��"�e�Y��A�U�	X8�챤�N��M	54@��^2�B��N�̂��(4�W��ClO�L�#9��cI(�Q^Ѥw�I�=|=V�TN�Y0$|���"1�@o�	%al�$�N��cv�͂��p��jH����>Yj�����tL		�����	*"ts���s
+��sO���0�,�ւ���)����z�F7m��`2*ĥ�*Byo�����#�HǑ`�/��{�Yc$�,�L_��٩��|�M3�&��N�Q$�g�X|27U�#a����.�V/*��#�
+�G�nn���nKp0�z�!�y8�o=�� �"���ٚ�G�e
+5��G|_ꈆ��8���8	�:RL1/?���9Y�rۖ��2c:a?��lb�����S��a�$�����B���4����m��ΑHzFϋ���B,�ϒP ��æF$/����5؊� �_����e^�ً�/â�O�U�'�c�6�%Ҹ�92����H6�7@��i%E����e�Ցt,�������b�\�L�>{��6�[�I�BE�4$�u5�Iѓi�+]��|VZ�ѭ|=�E��֝~#A<9
+;25	>._�*r�K��!�4�g�7�]�F,W�V��3�܂��¬��<���(XM�����"p�KŸ��Kj���ۏ^@{4	��b���Ll4/���Y��(
+/��,%4�~��L�
+?õ}1F����^xA�Y�;������r��
+������s
+��w�T0�TIS07�3S025�3WI�P��-�IU�/.I/J
+�Q��+.I��I,���Sp/�LIU���r
+�
+���-�]endstream
+endobj
+183 0 obj
+7644
+endobj
+184 0 obj<</Type/Page/Parent 180 0 R/Contents 185 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F4 4 0 R/F5 5 0 R/F6 6 0 R/F7 7 0 R/F8 8 0 R/F9 9 0 R>>>>/Annots 92 0 R>>endobj
+185 0 obj<</Length 186 0 R/Filter/FlateDecode>>stream
+x�X�r�6}�W�=�/"���N�f&�V�u(�X�T���{ EH��NbG�g�.��L��?�"��	-������ݔĔfK<�L#ǣYz���\�Cմ�Z>}�D˦M�<i����m�ʋ���e����/��	���j.붢�2�+z>�����ζ�:2�>_���{۟:~�����'5G>d�+���I���u#���'�6�n��<idJp�]�q�Y�5m��UݰpZ(��s�C_�����e
+0?���r���z-i��T^fE���d��z��Z�h���7��I)[�f묡�?u��8�8�>!MȤ#�����W��r�c��s�W?�QS�o�M�d���O����4	\V5U��&��bU4�':���
+��7�lr?�鏬L�׆d�=����e�k�x9�6�[~�]ᝋ
+4��M��a:��e���U�x�0;s��_�=ޓ�YNa8q|*HD�#�UNO,]����ӤD��C��8��-��"�aMo�[��d �����o 
+�p+�D��o�7�n�0'LXO�>��j�jG����BB��*��52��@��K����,�~��r����_�u�F�	]O���*�y[q���Gs���R�UP4�����ꮯ��	�C�Q�4jаQ:^d��Uh��q9S�"<b8`��7� �g�%�Ϻ�:{�R
+��1:�^�g���'�L���5�!ސ�T��K�� ^��e���.R+�@�?yӾ��>r9]�M*r�i�D��zm�M���v��`<��`T?���>��m��GZT�&�1�֊c����������w������rR`�=.����tE/N
+���QM���S�<C��Am����z���臃�p��rQV��`u
+1�g�D��~;��7Ȧ`~F���f��J!��|Nu#/yN�˦�e-%=����t:�S�]w*�ϸ[���^�(��n�P�<�|�ԙ<ݍ��ݛj����}�U��*���$P'��wYH�M-`v~�
+���rs��M��M��`�yo8o" #7�2��o"��";���G<�X��c������~�� ��~�^yl��E-1�ki�������os�;�q�e8s��C���O��I[Z���ƃ�s�Q�b1Ĩ�ik}�1��<H��5h��d!�;�F�ǽ/��c���{Q��
+������@�R
+,��@���,n�P�<��������������
+7��;��#�����9];�e�r��Z.
+5�k֮I��Uuz$T��B�x�?��O/l�,��u����~��>��
+���f�v!�Y-l�z!�Ѝ�\S݈;�=p
+^M����̎��+H���8[o����,^��['��E�j�za	[ġ�۷�����8NE+���\�mӐ[��;N��c�l�	��n�B�wۦ��3�k#[^/^��5��J�/
+���ށs�W�~�j�\�/�D���U�bp�r৯vA�LD��y�:��WM�J����"��{�/5r�}ѨW,�@{9v������	&�}��߸��h�Q�eqV�d�>����n�x’���%LQ�RԁwhR��ǝ���=G{�Q5�d����6�endstream
+endobj
+186 0 obj
+1609
+endobj
+187 0 obj<</Type/Page/Parent 180 0 R/Contents 188 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F4 4 0 R/F5 5 0 R/F8 8 0 R/F9 9 0 R/Fc 10 0 R>>>>/Annots 105 0 R>>endobj
+188 0 obj<</Length 189 0 R/Filter/FlateDecode>>stream
+x�V]S�H|�W��A˖�I^�U�#@�*�����A�uv%�����$�8$UW\Q���t���z�	iQDqqp�p�=?���R��N�AD�aЩL���6�R����;bc
+C��&��O��Ϣј�A0&�	�u��d�򜴔	]\�+�$�44�T�Эqef���/�vU9*���*/Ii^�~Q�z!�v�,�1��m{ۭޱ�:��
+����X�9��
+l�ߒ�s�X�kʌ�Wce�����f����À��XhJ�J�F$���^�������C��G�����r�g���(�0l Rk
+��^:��aZ.?v��2]�f��Ͷ�
+�j�[�:��o	�Rl��ʥ!�)�|���;���������B�tI�������iw��4�,s�,�.)Ws+��.��7%Q.PQ�*��B
+�(�K1	�Y���/t|�w}n,��R+�cɺ��@�L�I�4$�(˽jg)�'�I�����嗢]�K������͒99X�L���Tlơr���GN^��#=H[(�q̳�7m�>��kK�{t�a7UT���C���?�rO䀜d�iK�]��'�U�8�?�ҙ�"��M
+�*�����y[�*��	1�/�G�s�$�������Қ�����n�:���';��N?j]�z�0,ﲝ0�thAs��.f�w�W�t����Y'l]ҍF��ͣFn+S���KMs���*W%_,89/�{5S�c�h�\��B�|)� �5�zd���Gb D�~
+~+�Kx4�0�NrՒ�Ԫg%rZZ����	+����I@����)B��RI�/-d�D�ܔ��:|ٕN�Ŵi�1��n��xWG��(_��+�?����,w��岔�-W������́�T=)�+W�J���I�X�Z����fR�P����@�����*tU�>x������$4_������3\����mN�������f�6� ���6�z&�
+2��m��j���=;4�
+����qrP4>���z�S?4���g�'u�Z��e�y�F�	��̣!&�U�&�M���e��$�I���n�l�d��OGp����z��v!wg�><�{�\����h0	��ޜ�� �q���S�Bk��6�Η6���(�R�����=���Z'��m��˥M�oR����R�~Iu�|kiQ4�-�744{4<�n�4�Z�^��5�ے/7����D���_��2�endstream
+endobj
+189 0 obj
+1226
+endobj
+190 0 obj<</Type/Page/Parent 180 0 R/Contents 191 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F0 3 0 R/F4 4 0 R/F6 6 0 R/F8 8 0 R/F9 9 0 R>>>>/Annots 110 0 R>>endobj
+191 0 obj<</Length 192 0 R/Filter/FlateDecode>>stream
+x�V�r�6}�W�L�tDJ�]y��2I��ՙ�u �P�
+����Y���q�8����s���YB}�%4�pBi~v�8�X���ٌ�/v�/}��G�4���JZ��O��0���x:ߝ��3��c�{A�ޛ9%sZ���d>���:��^��TZkEF��_�F�R:O++%}{}����⟳�g�jO�d?IL_��*W��J��tDI�&�L_:��M�gk�?6�t)�RxI�*'mHmmMU�UG���T���x�)3�$g���Xy���F_��k+/�~�i�Q���#��T��gB�)J�u)�Gh��&[$9U����,�op�1���V�2�/밮I�J�����E}�>�9֊
+B�ÝD��V.ن�A��ߚ����v���z��=mR�{����s!b��?zFM�ۦDHcد���lmDvP9����Z��EM�q�o�\XIZ����$Թ�l�y������m
+�!�4�d�_i�i�db��0+h<�s=6ޗ/z��v���ѱ��S^�x��;�gpщ��%��\�T1p�jM+�%pu5�hF���n��
+@8X,��ݶ�
+l\U���.��]B*��9�P!B"�[^R��L����t������g-7~/��@�߄��&�A�'���w��]�ott��b<����;H����d	����	�$�
+%j�'�Km%Y6�Wy��*���aPX���2E���0O�!�����5p8V�Q�a��f}.ٵ��;�e@��W�p	v\;������j��T��x�$�$2�|CR%�N>_�͎l���mu�JAQ�M|d|�r,�>��=er%P�#��(Ą$h_tF�{&<�±YR�KX��|�Ia>H�ui�Q�EPJ�M`������w>H�~3�A��<��>/.^�����nY���'�Y��S�|7̀B�E�l&���`4��X�u���5��y���D�
+���<�{fP�\\㬖P
+oN�F��nC��֟v杴�
+��
+N�����<�`J�
+�ߍ���_ԟsw6�̺����h����`F9SY�GT���s��ƺ�p���Tj�P����LJ?s��$ȫ�����/�&���W.��Y2�-���P�t#�u�����d2�5��룤G���dT��Y��a!��ГZVp�WG�C�^��/�AmI�k-�-ym��a����W���@erB�؆{��&?����$�nV���n?@L�I^}@�`����<�4�J����j��Y�bZ�HXr�_uoE��:�k�/��V(-��&L��۾��"��	c�LS��Xr0}�~{�g������uSI�Vo���2� Y�K�K3~Ons�]���.�[ǍB0��6r
+ߡ4�R�2�X$�Zڰ�"����F����>.�!�k�	�_=�1����ȩ(endstream
+endobj
+192 0 obj
+1421
+endobj
+193 0 obj<</Type/Page/Parent 180 0 R/Contents 194 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F0 3 0 R/F4 4 0 R/F6 6 0 R/F8 8 0 R>>>>/Annots 123 0 R>>endobj
+194 0 obj<</Length 195 0 R/Filter/FlateDecode>>stream
+x�V]��8}�W\i+�V%ᛙJ}`��Ҭf��R�Re^;c;K�_�����#��$���{�u�j�סQ�zCJ��ʹ�e�hGWW���n�ԋ�h���_�
+�i�H,dz��Mot�f�O���M��S_�
+���l���L��T�����"�p������k�:���Ȩ�N��[r���Y.7�jb�n�O#�:܆7�8�j.���}�Vw����=���E�,rb�Em�F�ؾK�.��͌�B�6�<��I۝��-�����%�Dg���	�(7:���ZHI�(�,��i�Z��9zȹ�>S)Y�	��K<���h�eN�rZ˕p����x�&��+�4��εV"Y	�����ڥ.d���؂�aa�R1F	zN�ں��O?�IX�E����X��&���$��cRF�A�U���6M�{ٻ��z�m�p'��ۢ.�AG��y(��^.KQ�bjX?�\K�ׁC����t{�'�1�Q?�l�h/ݪ�z��hP��D|-�n4�_�Ȩ�２��x���#H��	��K�{�|���i&���ic�ii���CNdj�Ʒʄ5��\)��K�Gp�]��{���b��J�kb�&�|a��Β�^��Xm����}}���s����|����f�`?p0T�@���?<)�I?$*�ƗbfX�a�!S(
+�/������\D�㧊�<-
+*�`R���*�8�9���4�n��,]���p~T�u��r���$�܊7T�7����ҙPG��t�Z�_$�_$y�#�)f��X��Mbfht
+M��W|Mv�YS�YDS����K�	 �]"F(rkMk�)��̮��%���Rs��81�*�(XF��V
+���}�������x����x��ӱ3b�+L��1����8:Zxs���	��eY���T	g%�:�Kh������:�.d�El!�X��BuU]xO?��>�#7h�r��+$B�P˷���PRd\�p���|������P�֠�~L��y�-|���H�������	�Y�-�W�p��>|
+l��a8�~4����endstream
+endobj
+195 0 obj
+1066
+endobj
+196 0 obj<</Type/Page/Parent 180 0 R/Contents 197 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F0 3 0 R/F4 4 0 R/F6 6 0 R/F8 8 0 R/F9 9 0 R>>>>/Annots 132 0 R>>endobj
+197 0 obj<</Length 198 0 R/Filter/FlateDecode>>stream
+x�VMS�F��+:U��$X�l�k����R�P,x���H���a�_��#����.!{fz���~�OGu�ѰK���������Q'�h�(f��m�8��߉���($M��C�~t�?�}�
+wW�wWg�W���k�qs�?n��3\w7�^�E4�"�ag�h��&sei�R�:��S���J�ɂ���¤b.g�if&%������������
+ӿнt咬�%I��
+�s�=�B��oq�r�(imʂj�}�*Y|xe�SR*4e�;��If�)=�wI�ti�,����>*�.ʬ�c%�ki���Cc��(��/Y��|�巟���MԉҵC�_ֺ>����/oO��;"_��pT�["�s�N>�:
+��@	!�t��bP��Z�f����
+��SJ)���2�D"}M�p�hzh�͕)�S��pЕ�P' �Ws��us��P�����=�0k�
+6׸S���*m�|Z������ �c��K=�j.�,�GS��rYB��߿v�����w�q`��3hX)7���Atv0�w=d�ra�o/�Ջڭ���Tڻ85����?M������:�$��I]��Q&�HW��D����S.PΊ��x$��پ'���:����ibe��#+}*���(�֊W>.�=E�fe*m@�H���R�в2�l�Va}�������f)���РsFa&�C]B"�3|j���[�Qotր䓴ɱ1E}V�)���M7��D�\�����4��H�5%�86������A�+5�u4
+ylIV�5�׮�%��goͮ�w92�5]�|�*]�P��+���ᄑ�pF���!�Ѐ��3��o�hh��}�N�t��(X֫�,]Qn`i_&��BD�"-��_�A���T����u�gM����n
+>���g�8-�x݌� �[A�Q��h�;Dk(_�an!�B�΀3��o+����=�,R(�n�Y�/щ���d��ܱX�����+Z�m��ۄBBD�*��(gi9����ə�)�8~�=h�+�;%��}'���u���N^��s��lNKL	���K��|�%
+��L���_��iZ�ng��z���B��	$|l�er�Q�]�hbV:��>=+�+��-�>�x4j��`�p�W�V?�5�T�#��%u1k
+z������w�wvF14���{S�߽7�ui�><�3�ˣ����\��]�b�Q]��tK憅"�n/iD$,��BeMF'�������iƷT�Ro�3�,ʡ6�k=S6��@���Ё/��`l�;�^Dt[���e��v{��%Z��1
+�ڭ�kK_�-ţ��R̮�z��t#_��n���v�q�G�m��?�0���)��Ap^e"L�q������X>*ͬܢ�r��v�/	�$endstream
+endobj
+198 0 obj
+1375
+endobj
+199 0 obj<</Type/Page/Parent 180 0 R/Contents 200 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F4 4 0 R/F5 5 0 R/F8 8 0 R>>>>/Annots 137 0 R>>endobj
+200 0 obj<</Length 201 0 R/Filter/FlateDecode>>stream
+xu�A
+�0E�9�_�&&i�֭�E�6MK%��x|�](20���{�B8�+�T �طd��d��s�
+\r�"e�fP�Qٴg��9]���Xa�]��1��9u�o�A�Ց�a�9�oܷm�ȩ�-�",�w~���ER�������
+q��oG��1H��֏�6q�!n�8�$�d5*R�'utFYendstream
+endobj
+201 0 obj
+188
+endobj
+202 0 obj<</Type/Page/Parent 180 0 R/Contents 203 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F0 3 0 R/F4 4 0 R/F6 6 0 R/F8 8 0 R/F9 9 0 R>>>>/Annots 140 0 R>>endobj
+203 0 obj<</Length 204 0 R/Filter/FlateDecode>>stream
+x�VMo�8��W������W.ŦiZl���-ђ6������#)َ�9H��7�����#Z�i2���ܮ;_֝a�\���3�i<�9N�s��洅-N��hZ�L�'Ӊ;>�d�g�>=�bp��ъ�[ ��ј�iw�Wi,�����#=��e�\���x�Y�~}�y�"����[�z�d#���?4O�3��H*i�t›�Gׅ���F��l���k�S)K���g��ҥ{P�f�?��Fe��Ҕe��dՎ�(��,9���=&4��[[���!�B0�,"���),7QnK���q��?��x&�u��KT��T��TH 1�b�YNU�E2^�$,|�IIq�C���<�^��8ߴҞq����KTL��HW���R����ֆ�=�6G�l�<�3O�� ̘BIr�&��Z8�n��=80i��X���Gdg�Uy�0���hh�ȋ~ا�7�]7Zw�J�� 
+�q�pb��=:6�`�d2�AA̐Vʆ���!���liA�9�/�9]���'H��N�i���y���A����%H��'�O)��L��xT�T�/c�U��w��n����V ��g$�u�k&F��	�++��RT+��
+� �#�"�r��<�ʧ�D�eZ��s
+.��V��{�t�6���O��p�*�9kf��\D#M�Ri�C�0D}V����r�D��'��J������b�����-����_�,�0�����V
+�{
+p�t��B��J᛺>����>�ܱ����P��&W;����U��
+aB��y�V�M��ٶ�^C�S������'~�B6m�
+�w�{%��O��*/("�PyL7�N\��_���
+U�5n$Ɠpٌ�����QS��=����?��k����;��弫�9>�<5\�����9pK�C<�����{>�d���"��ipj:z	Cw�t���������1���a�m�L�b��0��U�w��|�z2����K׿�+?�[%�:8�6�~m�Ҝ��+���ď��9��6endstream
+endobj
+204 0 obj
+1022
+endobj
+205 0 obj<</Type/Page/Parent 180 0 R/Contents 206 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F0 3 0 R/F4 4 0 R/F5 5 0 R/F6 6 0 R/F8 8 0 R>>>>/Annots 149 0 R>>endobj
+206 0 obj<</Length 207 0 R/Filter/FlateDecode>>stream
+x�T�r�0}�+�-N�oؐ�N�&ifzI��K�4Fr,94ߕ%A M��`�vu�����(��?!d�)����jt��|�GW�K�q�̂�����@����Z��Y�`�@��ua��fA��V�k�Te��S3ɛ�qu��5
+`�~rb���F��oTL�⮽���ÎpmI�I9�;�gy�
+ʎ�U���
+�F
+��T����AK�GR⯽�>?a����V���+�X��g�%S z�@%kX��p
+��G3zk��uj��nMTs�D����3	���V��D�P�b�A�x�^G�<:5�!Y��:(D���+�(T}aU�(5�M���-ɣv��C����x�i�K�)���S�ධaU�^��#I&�r>�5��n-��V��="�B٧�,4�"잁Ҕ�|ZsT�N}f�{�G�K;A�80
+8�e����tv;�Q(j�3���4���QS��/�cp�C�1��>P�Ȇ�v�>��\wj�9��}Y9�Ns���6{��^ũ��G=�n`�B7r������3,\i�v�#7�9��?ܘ���8�[�,L<�4�ԋ���d9�Ib��]gFބ���E��91�#�a���8�Ul�N��`�<zf��s�`?�o�Q�nH	�ω���b�֍�]U;�vL`sXLο���/�ߗ�l����mh�0���P,����]�hɶؖҴ�̮�I4K�s�J����}��,�j�᦯��az-P{WO��_���8�j��4KoHiHѶZ4���c�j��?���endstream
+endobj
+207 0 obj
+787
+endobj
+208 0 obj<</Type/Page/Parent 180 0 R/Contents 209 0 R/Resources<</ProcSet[/PDF/Text]/Font<</F4 4 0 R/F8 8 0 R/F9 9 0 R>>>>/Annots 154 0 R>>endobj
+209 0 obj<</Length 210 0 R/Filter/FlateDecode>>stream
+x]RMs�0��+��d&&���{���C�N�1E<���\!�ɿ������F��]���H�IQeX��C����ok�k�-��*�P7Wy�O�7�ES��@Ə��o��H�#v��q��t '4�d������;�<yj�-�N�h���)�#7���@�qu���+�A�wx��n�UOGa��#�"]�2�c�I�M!�jy����>�*#��^��`�@��|��g�֍x�b��bܓT���!�t��b�5�)��?���`w���_��X7�|��$NP�Kv]$9�3~�
+�J(i(�C��*��Ȓ017�!���8��:��ut����r�o�ePxG}��~؁��s8k�bV���r��E�7'K�Ό^h��(#�+�B����e�*�������}����endstream
+endobj
+210 0 obj
+405
+endobj
+211 0 obj<</Type/Catalog/Pages 180 0 R/Names 155 0 R/PageLayout/SinglePage/OpenAction[184 0 R/XYZ null null null]/PageMode/FullScreen/PageLabels<</Nums[0<</P(title)>>1<</S/D>>]>>>>endobj
+xref
+0 212 
+0000000000 65535 f 
+0000000015 00000 n 
+0000000257 00000 n 
+0000001814 00000 n 
+0000001888 00000 n 
+0000001966 00000 n 
+0000002043 00000 n 
+0000002122 00000 n 
+0000002205 00000 n 
+0000002281 00000 n 
+0000002362 00000 n 
+0000002421 00000 n 
+0000002503 00000 n 
+0000002588 00000 n 
+0000002670 00000 n 
+0000002755 00000 n 
+0000002837 00000 n 
+0000002922 00000 n 
+0000003004 00000 n 
+0000003089 00000 n 
+0000003171 00000 n 
+0000003256 00000 n 
+0000003338 00000 n 
+0000003423 00000 n 
+0000003462 00000 n 
+0000003547 00000 n 
+0000003586 00000 n 
+0000003671 00000 n 
+0000003710 00000 n 
+0000003795 00000 n 
+0000003900 00000 n 
+0000004005 00000 n 
+0000004110 00000 n 
+0000004215 00000 n 
+0000004320 00000 n 
+0000004425 00000 n 
+0000004530 00000 n 
+0000004635 00000 n 
+0000004740 00000 n 
+0000004845 00000 n 
+0000004884 00000 n 
+0000004968 00000 n 
+0000005007 00000 n 
+0000005092 00000 n 
+0000005131 00000 n 
+0000005216 00000 n 
+0000005255 00000 n 
+0000005340 00000 n 
+0000005379 00000 n 
+0000005464 00000 n 
+0000005503 00000 n 
+0000005588 00000 n 
+0000005627 00000 n 
+0000005712 00000 n 
+0000005816 00000 n 
+0000005920 00000 n 
+0000006025 00000 n 
+0000006130 00000 n 
+0000006235 00000 n 
+0000006340 00000 n 
+0000006445 00000 n 
+0000006550 00000 n 
+0000006655 00000 n 
+0000006760 00000 n 
+0000006865 00000 n 
+0000006970 00000 n 
+0000007074 00000 n 
+0000007179 00000 n 
+0000007284 00000 n 
+0000007388 00000 n 
+0000007493 00000 n 
+0000007598 00000 n 
+0000007703 00000 n 
+0000007808 00000 n 
+0000007913 00000 n 
+0000008018 00000 n 
+0000008122 00000 n 
+0000008162 00000 n 
+0000008246 00000 n 
+0000008286 00000 n 
+0000008371 00000 n 
+0000008411 00000 n 
+0000008496 00000 n 
+0000008600 00000 n 
+0000008704 00000 n 
+0000008744 00000 n 
+0000008828 00000 n 
+0000008867 00000 n 
+0000008952 00000 n 
+0000008993 00000 n 
+0000009075 00000 n 
+0000009114 00000 n 
+0000009198 00000 n 
+0000009621 00000 n 
+0000009669 00000 n 
+0000009754 00000 n 
+0000009795 00000 n 
+0000009878 00000 n 
+0000009919 00000 n 
+0000010004 00000 n 
+0000010043 00000 n 
+0000010129 00000 n 
+0000010169 00000 n 
+0000010254 00000 n 
+0000010295 00000 n 
+0000010382 00000 n 
+0000010445 00000 n 
+0000010513 00000 n 
+0000010599 00000 n 
+0000010705 00000 n 
+0000010811 00000 n 
+0000010853 00000 n 
+0000010936 00000 n 
+0000011023 00000 n 
+0000011106 00000 n 
+0000011193 00000 n 
+0000011276 00000 n 
+0000011363 00000 n 
+0000011446 00000 n 
+0000011533 00000 n 
+0000011616 00000 n 
+0000011703 00000 n 
+0000011786 00000 n 
+0000011873 00000 n 
+0000011939 00000 n 
+0000012042 00000 n 
+0000012145 00000 n 
+0000012185 00000 n 
+0000012268 00000 n 
+0000012310 00000 n 
+0000012395 00000 n 
+0000012436 00000 n 
+0000012521 00000 n 
+0000012579 00000 n 
+0000012619 00000 n 
+0000012704 00000 n 
+0000012745 00000 n 
+0000012832 00000 n 
+0000012866 00000 n 
+0000012934 00000 n 
+0000013021 00000 n 
+0000013047 00000 n 
+0000013087 00000 n 
+0000013172 00000 n 
+0000013214 00000 n 
+0000013301 00000 n 
+0000013342 00000 n 
+0000013429 00000 n 
+0000013470 00000 n 
+0000013555 00000 n 
+0000013605 00000 n 
+0000013646 00000 n 
+0000013731 00000 n 
+0000013773 00000 n 
+0000013860 00000 n 
+0000013894 00000 n 
+0000013928 00000 n 
+0000013962 00000 n 
+0000014351 00000 n 
+0000014400 00000 n 
+0000014449 00000 n 
+0000014498 00000 n 
+0000014547 00000 n 
+0000014596 00000 n 
+0000014645 00000 n 
+0000014694 00000 n 
+0000014743 00000 n 
+0000014792 00000 n 
+0000014841 00000 n 
+0000014890 00000 n 
+0000014939 00000 n 
+0000014988 00000 n 
+0000015037 00000 n 
+0000015086 00000 n 
+0000015135 00000 n 
+0000015184 00000 n 
+0000015233 00000 n 
+0000015280 00000 n 
+0000015328 00000 n 
+0000015377 00000 n 
+0000015426 00000 n 
+0000015623 00000 n 
+0000015766 00000 n 
+0000023481 00000 n 
+0000023503 00000 n 
+0000023675 00000 n 
+0000025355 00000 n 
+0000025377 00000 n 
+0000025542 00000 n 
+0000026839 00000 n 
+0000026861 00000 n 
+0000027025 00000 n 
+0000028517 00000 n 
+0000028539 00000 n 
+0000028694 00000 n 
+0000029831 00000 n 
+0000029853 00000 n 
+0000030017 00000 n 
+0000031463 00000 n 
+0000031485 00000 n 
+0000031631 00000 n 
+0000031890 00000 n 
+0000031911 00000 n 
+0000032075 00000 n 
+0000033168 00000 n 
+0000033190 00000 n 
+0000033354 00000 n 
+0000034212 00000 n 
+0000034233 00000 n 
+0000034379 00000 n 
+0000034855 00000 n 
+0000034876 00000 n 
+trailer
+<</Size 212/Root 211 0 R/Info 1 0 R>>
+startxref
+35063
+%%EOF
Index: web/openacs/www/doc/openacs/postgres/index.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/postgres/index.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/postgres/index.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,197 @@
+<HTML
+><HEAD
+><TITLE
+>  Simple PostgreSQL Installation Guide
+ </TITLE
+><META
+NAME="GENERATOR"
+CONTENT="Modular DocBook HTML Stylesheet Version 1.61
+"><LINK
+REL="NEXT"
+TITLE="  Before you start
+ "
+HREF="x12.html"></HEAD
+><BODY
+CLASS="ARTICLE"
+BGCOLOR="#FFFFFF"
+TEXT="#000000"
+LINK="#0000FF"
+VLINK="#840084"
+ALINK="#0000FF"
+><DIV
+CLASS="ARTICLE"
+><DIV
+CLASS="TITLEPAGE"
+><H1
+CLASS="TITLE"
+><A
+NAME="AEN2"
+>Simple PostgreSQL Installation Guide</A
+></H1
+><H3
+CLASS="AUTHOR"
+><A
+NAME="AEN4"
+>Roberto Mello (rmello@fslc.usu.edu)</A
+></H3
+><DIV
+><DIV
+CLASS="ABSTRACT"
+><A
+NAME="AEN8"
+></A
+><P
+></P
+><P
+>  A very simple PostgreSQL installation guide to aid OpenACS users, based on the PostgreSQL Administrators Guide. Not intended to be a full-blown guide to every imaginable architecture on the planet. This was written in a <I
+CLASS="EMPHASIS"
+>GNU/Linux</I
+> box, so some adaptation may be necessary for other platforms. This guide does not apply for Windows environments. Check the PostgreSQL documentation for more details on installing PostgreSQL on Windows and other platforms (<A
+HREF="http://www.postgresql.org/docs/admin/install855.htm"
+TARGET="_top"
+>Chapter 5 of the Administrators Guide</A
+>).
+ </P
+><P
+></P
+></DIV
+></DIV
+><HR></DIV
+><DIV
+CLASS="TOC"
+><DL
+><DT
+><B
+>Table of Contents</B
+></DT
+><DT
+>1. <A
+HREF="x12.html"
+>Before you start</A
+></DT
+><DD
+><DL
+><DT
+>1.1. <A
+HREF="x12.html#AEN28"
+>Should I compile or use a binary (RPM, DEB) ?</A
+></DT
+></DL
+></DD
+><DT
+>2. <A
+HREF="x32.html"
+>Compiling and Installing the best free RDBMS</A
+></DT
+><DD
+><DL
+><DT
+>2.1. <A
+HREF="x32.html#AEN34"
+>Preliminaries</A
+></DT
+><DT
+>2.2. <A
+HREF="x32.html#AEN44"
+>Optional - How to increase the blocksize in PostgreSQL
+   <A
+NAME="AEN46"
+HREF="#FTN.AEN46"
+>[1]</A
+></A
+></DT
+><DT
+>2.3. <A
+HREF="x32.html#AEN62"
+>Compiling and installing</A
+></DT
+><DT
+>2.4. <A
+HREF="x32.html#AEN101"
+>Getting it to start with every boot</A
+></DT
+><DT
+>2.5. <A
+HREF="x32.html#AEN106"
+>Testing</A
+></DT
+></DL
+></DD
+><DT
+>3. <A
+HREF="x111.html"
+>Installing Binary Packages</A
+></DT
+><DD
+><DL
+><DT
+>3.1. <A
+HREF="x111.html#AEN113"
+>RPMs</A
+></DT
+><DT
+>3.2. <A
+HREF="x111.html#AEN132"
+>DEBs</A
+></DT
+></DL
+></DD
+><DT
+>4. <A
+HREF="x155.html"
+>Acknowledgements</A
+></DT
+></DL
+></DIV
+></DIV
+><DIV
+CLASS="NAVFOOTER"
+><HR
+ALIGN="LEFT"
+WIDTH="100%"><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+><A
+HREF="x12.html"
+>Next</A
+></TD
+></TR
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>Before you start</TD
+></TR
+></TABLE
+></DIV
+></BODY
+></HTML
+>
\ No newline at end of file
Index: web/openacs/www/doc/openacs/postgres/x111.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/postgres/x111.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/postgres/x111.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,321 @@
+<HTML
+><HEAD
+><TITLE
+>  Installing Binary Packages
+ </TITLE
+><META
+NAME="GENERATOR"
+CONTENT="Modular DocBook HTML Stylesheet Version 1.61
+"><LINK
+REL="HOME"
+TITLE="  Simple PostgreSQL Installation Guide
+ "
+HREF="index.html"><LINK
+REL="PREVIOUS"
+TITLE="  Compiling and Installing the best free RDBMS
+ "
+HREF="x32.html"><LINK
+REL="NEXT"
+TITLE="  Acknowledgements
+ "
+HREF="x155.html"></HEAD
+><BODY
+CLASS="SECT1"
+BGCOLOR="#FFFFFF"
+TEXT="#000000"
+LINK="#0000FF"
+VLINK="#840084"
+ALINK="#0000FF"
+><DIV
+CLASS="NAVHEADER"
+><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TH
+COLSPAN="3"
+ALIGN="center"
+>Simple PostgreSQL Installation Guide</TH
+></TR
+><TR
+><TD
+WIDTH="10%"
+ALIGN="left"
+VALIGN="bottom"
+><A
+HREF="x32.html"
+>Prev</A
+></TD
+><TD
+WIDTH="80%"
+ALIGN="center"
+VALIGN="bottom"
+></TD
+><TD
+WIDTH="10%"
+ALIGN="right"
+VALIGN="bottom"
+><A
+HREF="x155.html"
+>Next</A
+></TD
+></TR
+></TABLE
+><HR
+ALIGN="LEFT"
+WIDTH="100%"></DIV
+><DIV
+CLASS="SECT1"
+><H1
+CLASS="SECT1"
+><A
+NAME="AEN111"
+>3. Installing Binary Packages</A
+></H1
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN113"
+>3.1. RPMs</A
+></H2
+><P
+>   * Download the RPMs form the PostgreSQL mirror closest to you (list at <A
+HREF="http://www.postgresql.org/sites.html"
+TARGET="_top"
+>http://www.postgresql.org/sites.html</A
+>)
+  </P
+><P
+>   The RPMs come split into separate packages so you can install only what you need. Download the packages:
+  </P
+><P
+>   postgresql-7.xxx.i386.rpm
+  </P
+><P
+>   postgresql-devel-7.xxx.i386.rpm 
+  </P
+><P
+>   postgresql-server-7.xxx.i386.rpm 
+  </P
+><P
+>   postgresql-test-7.xxx.i386.rpm (for the regression tests).
+  </P
+><P
+>   (if you want pgaccess, PostgreSQL graphical tool, also install postgresql-tk-7.xxx.i386.rpm)
+  </P
+><P
+>   * Install them in the sequence above, with the command: (as root)
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>rpm -ivh postgresql-xxx.i386.rpm 
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   If it asks for dependency packages, install them from the CD or after downloading them (from rpm.net for example). 
+  </P
+><P
+>   The RPM packages will very nicely create the postgres user and group, set the environment variables, install the documentation and other goodies for you. Cozy huh ? Thank Lamar Owens for that.
+  </P
+><P
+>   * Then start the database server with the command:
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>/etc/rc.d/init.d/postgresql start
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   If everything went fine, you should be able to, as user <I
+CLASS="EMPHASIS"
+>postgres</I
+>, create a database and connect to it through psql:
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>su - postgres
+createdb mydb
+psql mydb
+  </PRE
+></TD
+></TR
+></TABLE
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN132"
+>3.2. DEBs</A
+></H2
+><P
+>   * The DEB packages come split into separate packages so you can install only what you need. 
+  </P
+><P
+>   As root, fire up <I
+CLASS="EMPHASIS"
+>dselect</I
+> and go into &#8220;<I
+CLASS="EMPHASIS"
+>Select</I
+>&#8221;.
+  </P
+><P
+>   Do a &#8220; / postgresql &#8221; to search for postgresql packages. Search again by pressing &#8220;\&#8221;
+  </P
+><P
+>   Mark for installation (by pressing +) the following packages:
+  </P
+><P
+>   postgresql
+  </P
+><P
+>   postgresql-pl
+  </P
+><P
+>   postgresql-client
+  </P
+><P
+>   postgresql-dev
+  </P
+><P
+>   postgresql-doc
+  </P
+><P
+>   postgresql-test
+  </P
+><P
+>   (if you want pgaccess, PostgreSQL graphical tool also install the package pgaccess)
+  </P
+><P
+>   Then hit &#8220;Enter&#8221; to get out of dselect and go into &#8220;<I
+CLASS="EMPHASIS"
+>Install</I
+>&#8221;.
+  </P
+><P
+>   That's it. It should download, install and start the server for you. Hard huh ? Thanks to Oliver Elphick for providing these packages.
+  </P
+><P
+>   * If the setup process doesn't start the server, you can start it with: (as root)
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>/etc/init.d/postgresql start
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   * If everything went fine, you should be able to, as user <I
+CLASS="EMPHASIS"
+>postgres</I
+>, create a database and connect to it through psql:
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>su - postgres
+createdb mydb
+psql mydb
+  </PRE
+></TD
+></TR
+></TABLE
+></DIV
+></DIV
+><DIV
+CLASS="NAVFOOTER"
+><HR
+ALIGN="LEFT"
+WIDTH="100%"><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+><A
+HREF="x32.html"
+>Prev</A
+></TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+><A
+HREF="index.html"
+>Home</A
+></TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+><A
+HREF="x155.html"
+>Next</A
+></TD
+></TR
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>Compiling and Installing the best free RDBMS</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>Acknowledgements</TD
+></TR
+></TABLE
+></DIV
+></BODY
+></HTML
+>
\ No newline at end of file
Index: web/openacs/www/doc/openacs/postgres/x12.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/postgres/x12.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/postgres/x12.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,187 @@
+<HTML
+><HEAD
+><TITLE
+>  Before you start
+ </TITLE
+><META
+NAME="GENERATOR"
+CONTENT="Modular DocBook HTML Stylesheet Version 1.61
+"><LINK
+REL="HOME"
+TITLE="  Simple PostgreSQL Installation Guide
+ "
+HREF="index.html"><LINK
+REL="PREVIOUS"
+TITLE="  Simple PostgreSQL Installation Guide
+ "
+HREF="index.html"><LINK
+REL="NEXT"
+TITLE="  Compiling and Installing the best free RDBMS
+ "
+HREF="x32.html"></HEAD
+><BODY
+CLASS="SECT1"
+BGCOLOR="#FFFFFF"
+TEXT="#000000"
+LINK="#0000FF"
+VLINK="#840084"
+ALINK="#0000FF"
+><DIV
+CLASS="NAVHEADER"
+><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TH
+COLSPAN="3"
+ALIGN="center"
+>Simple PostgreSQL Installation Guide</TH
+></TR
+><TR
+><TD
+WIDTH="10%"
+ALIGN="left"
+VALIGN="bottom"
+><A
+HREF="index.html"
+>Prev</A
+></TD
+><TD
+WIDTH="80%"
+ALIGN="center"
+VALIGN="bottom"
+></TD
+><TD
+WIDTH="10%"
+ALIGN="right"
+VALIGN="bottom"
+><A
+HREF="x32.html"
+>Next</A
+></TD
+></TR
+></TABLE
+><HR
+ALIGN="LEFT"
+WIDTH="100%"></DIV
+><DIV
+CLASS="SECT1"
+><H1
+CLASS="SECT1"
+><A
+NAME="AEN12"
+>1. Before you start</A
+></H1
+><P
+></P
+><UL
+><LI
+><P
+>  You will need GNU Make to build PostgreSQL. GNU Make is the default in GNU/Linux systems, in other systems it may be called gmake. We are simply going to refer to it as &#8220;make&#8221;. You can download GNU Make from <A
+HREF="ftp://ftp.gnu.org"
+TARGET="_top"
+>ftp://ftp.gnu.org</A
+>.
+  </P
+></LI
+><LI
+><P
+>  You will need a C compiler. GCC (GNU Compiler Collection) is what I am using.
+  </P
+></LI
+><LI
+><P
+>  You will need C/C++ development libraries. On GNU/Linux systems, this usually means glibc and glibc-devel.
+  </P
+></LI
+><LI
+><P
+>  For convenience, install GNU Readline and its development packages (usually readline and readline-devel).
+  </P
+></LI
+><LI
+><P
+>  (Optional) If you are going to use psql from an X Terminal, then install the X development libraries.
+  </P
+></LI
+><LI
+><P
+>  A minimum of 35 Mb of disk space is necessary to build PostgreSQL (including the sources). Of course, you will need more to create databases, so be generous :-)
+  </P
+></LI
+></UL
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN28"
+>1.1. Should I compile or use a binary (RPM, DEB) ?</A
+></H2
+><P
+>   Compiling gives you more flexibility because you can compile PostgreSQL with some extra options (and we will mention some here). It is not a super trivial process, but it is not too hard. Following this guide will help a lot, but some understanding of what's going on is expected of you.
+  </P
+><P
+>   If you are completely new to UNIX systems or if you just want to get it up and running fast, then go with a binary installation, such as the ones provided by RPMs (Red Hat packages, provided in most GNU/Linux distributions) and DEBs (Debian GNU/Linux packages).
+  </P
+></DIV
+></DIV
+><DIV
+CLASS="NAVFOOTER"
+><HR
+ALIGN="LEFT"
+WIDTH="100%"><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+><A
+HREF="index.html"
+>Prev</A
+></TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+><A
+HREF="index.html"
+>Home</A
+></TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+><A
+HREF="x32.html"
+>Next</A
+></TD
+></TR
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>Simple PostgreSQL Installation Guide</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>Compiling and Installing the best free RDBMS</TD
+></TR
+></TABLE
+></DIV
+></BODY
+></HTML
+>
\ No newline at end of file
Index: web/openacs/www/doc/openacs/postgres/x155.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/postgres/x155.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/postgres/x155.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,133 @@
+<HTML
+><HEAD
+><TITLE
+>  Acknowledgements
+ </TITLE
+><META
+NAME="GENERATOR"
+CONTENT="Modular DocBook HTML Stylesheet Version 1.61
+"><LINK
+REL="HOME"
+TITLE="  Simple PostgreSQL Installation Guide
+ "
+HREF="index.html"><LINK
+REL="PREVIOUS"
+TITLE="  Installing Binary Packages
+ "
+HREF="x111.html"></HEAD
+><BODY
+CLASS="SECT1"
+BGCOLOR="#FFFFFF"
+TEXT="#000000"
+LINK="#0000FF"
+VLINK="#840084"
+ALINK="#0000FF"
+><DIV
+CLASS="NAVHEADER"
+><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TH
+COLSPAN="3"
+ALIGN="center"
+>Simple PostgreSQL Installation Guide</TH
+></TR
+><TR
+><TD
+WIDTH="10%"
+ALIGN="left"
+VALIGN="bottom"
+><A
+HREF="x111.html"
+>Prev</A
+></TD
+><TD
+WIDTH="80%"
+ALIGN="center"
+VALIGN="bottom"
+></TD
+><TD
+WIDTH="10%"
+ALIGN="right"
+VALIGN="bottom"
+>&nbsp;</TD
+></TR
+></TABLE
+><HR
+ALIGN="LEFT"
+WIDTH="100%"></DIV
+><DIV
+CLASS="SECT1"
+><H1
+CLASS="SECT1"
+><A
+NAME="AEN155"
+>4. Acknowledgements</A
+></H1
+><P
+>  Several people have contributed to this document in either content or error reporting and I would like to thank them. Please let me know if I forgot to include your name.
+ </P
+><P
+>  Contributors (in no specific order):
+ </P
+><P
+>  Don Baccus, Mark Rohn, Bob O'Connor.
+ </P
+></DIV
+><DIV
+CLASS="NAVFOOTER"
+><HR
+ALIGN="LEFT"
+WIDTH="100%"><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+><A
+HREF="x111.html"
+>Prev</A
+></TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+><A
+HREF="index.html"
+>Home</A
+></TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>&nbsp;</TD
+></TR
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>Installing Binary Packages</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>&nbsp;</TD
+></TR
+></TABLE
+></DIV
+></BODY
+></HTML
+>
\ No newline at end of file
Index: web/openacs/www/doc/openacs/postgres/x32.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/openacs/postgres/x32.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/openacs/postgres/x32.html	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,579 @@
+<HTML
+><HEAD
+><TITLE
+>  Compiling and Installing the best free RDBMS
+ </TITLE
+><META
+NAME="GENERATOR"
+CONTENT="Modular DocBook HTML Stylesheet Version 1.61
+"><LINK
+REL="HOME"
+TITLE="  Simple PostgreSQL Installation Guide
+ "
+HREF="index.html"><LINK
+REL="PREVIOUS"
+TITLE="  Before you start
+ "
+HREF="x12.html"><LINK
+REL="NEXT"
+TITLE="  Installing Binary Packages
+ "
+HREF="x111.html"></HEAD
+><BODY
+CLASS="SECT1"
+BGCOLOR="#FFFFFF"
+TEXT="#000000"
+LINK="#0000FF"
+VLINK="#840084"
+ALINK="#0000FF"
+><DIV
+CLASS="NAVHEADER"
+><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TH
+COLSPAN="3"
+ALIGN="center"
+>Simple PostgreSQL Installation Guide</TH
+></TR
+><TR
+><TD
+WIDTH="10%"
+ALIGN="left"
+VALIGN="bottom"
+><A
+HREF="x12.html"
+>Prev</A
+></TD
+><TD
+WIDTH="80%"
+ALIGN="center"
+VALIGN="bottom"
+></TD
+><TD
+WIDTH="10%"
+ALIGN="right"
+VALIGN="bottom"
+><A
+HREF="x111.html"
+>Next</A
+></TD
+></TR
+></TABLE
+><HR
+ALIGN="LEFT"
+WIDTH="100%"></DIV
+><DIV
+CLASS="SECT1"
+><H1
+CLASS="SECT1"
+><A
+NAME="AEN32"
+>2. Compiling and Installing the best free RDBMS</A
+></H1
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN34"
+>2.1. Preliminaries</A
+></H2
+><P
+>   As <I
+CLASS="EMPHASIS"
+>root</I
+>, create a user and group (if you haven't done so before) for PostgreSQL. This is the account that PostgreSQL will run as since it will not run as root. Also give the postgres user a password:
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>groupadd web
+useradd -g web postgres -d /usr/local/pgsql
+passwd postgres
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   Download PostgreSQL from the mirror closest to you. The list of mirrors is at <A
+HREF="http://www.postgresql.org/sites.html"
+TARGET="_top"
+>http://www.postgresql.org/sites.html</A
+>. You can download it in one big file (&#732; 8 Mb) or in smaller files (base, support, doc, test). Put it in a temp directory such as /tmp.
+  </P
+><P
+>   Untar with the command:
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>tar xzvf postgresql-xxxxx.tar.gz 
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   Repeat the tar command for each file if you are downloading the multiple-file distribution.
+  </P
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN44"
+>2.2. Optional - How to increase the blocksize in PostgreSQL
+   <A
+NAME="AEN46"
+HREF="#FTN.AEN46"
+>[1]</A
+></A
+></H2
+><P
+>   This is not required to compile PostgreSQL.
+  </P
+><P
+>   By default PostgreSQL is compiled with a blocksize of 8 Kb. You can compile PostgreSQL to have 16 Kb blocksize instead, which will allow for bigger text and lztext data types. NOTE: If you've built PostgreSQL in that directory before, you need to a) delete the config.cache file (created by autoconf) and b) do a make clean to give it a fresh start.
+  </P
+><P
+>   Here's how you do it:
+  </P
+><P
+></P
+><OL
+TYPE="1"
+><LI
+><P
+>   Go into the src/include directory of the PostgreSQL source distribution.
+   </P
+></LI
+><LI
+><P
+>   Edit the file config.h.in
+   </P
+></LI
+><LI
+><P
+>   Look for the line&#8220;<I
+CLASS="EMPHASIS"
+>#define BLCKSZ 8192</I
+>&#8220; and change it to&#8220;<I
+CLASS="EMPHASIS"
+>#define BLCKSZ 16384</I
+>&#8220;
+   </P
+></LI
+><LI
+><P
+>   Save it.
+   </P
+></LI
+></OL
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN62"
+>2.3. Compiling and installing</A
+></H2
+><P
+>   * You will need to run the command ./configure from within the src/ directory of the PostgreSQL distribution. This will create the files with the options that will be used to compile PostgreSQL specifically to your machine (./configure --help will show you all the available options).
+  </P
+><P
+>   * If you are going to access psql (the PostgreSQL's interactive query tool) from within an X terminal (such as xterm, kterm, Eterm,...) and you have the X development libraries installed then do: 
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>./configure --with-x
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   Otherwise simply do a <I
+CLASS="EMPHASIS"
+>./configure</I
+>
+  </P
+><P
+>   * After it's done fire up a: 
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>make
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   * The compilation process will take place. Go look at OpenACS and see on what you can help make the toolkit even more butt-kicking. After it's done, you should see a message like this: 
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>All of PostgreSQL is successfully made. Ready to install.
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   * If you are upgrading your PostgreSQL, follow the instructions on <A
+HREF="http://www.postgresql.org/docs/admin/install855.htm"
+TARGET="_top"
+>Chapter 5 of the Administrators Guide</A
+>.
+  </P
+><P
+>   * Create the directories to house PostgreSQL:
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>mkdir /usr/local/pgsql
+chown postgres.web /usr/local/pgsql
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   * Become the postgres user: su - postgres
+  </P
+><P
+>   * Then install the PG executable files and libraries by running: 
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>make install
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   * Then you need to initialize the database templates and other things by doing this:
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+># su - postgres
+$ cd /usr/local/pgsql
+$ mkdir data
+$ cd bin
+$ ./initdb -D /usr/local/pgsql/data
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   * Tell your system how to find the new shared libraries. This can be accomplished in two ways: 
+  </P
+><P
+>   Editing the file /etc/profile and adding the lines:
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>LD_LIBRARY_PATH=/usr/local/pgsql/lib 
+export LD_LIBRARY_PATH 
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   OR editing the file /etc/ld.so.conf and adding the line: 
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>/usr/local/pgsql/lib 
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   and then running the command /sbin/ldconfig.
+  </P
+><P
+>   * You probably want to install the man and HTML documentation. Type 
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>cd /usr/local/src/pgsql/postgresql-7.0/doc (or wherever you untarred it)
+make install 
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   This will install files under /usr/local/pgsql/doc and /usr/local/pgsql/man. 
+  </P
+><P
+>   * Setup some environment variables to make your life easier:
+  </P
+><P
+>   You can do this by editing the /etc/profile file and including these lines:
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>PATH=$PATH:/usr/local/pgsql/bin
+MANPATH=$MANPATH:/usr/local/pgsql/man 
+export MANPATH
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   * As the user <I
+CLASS="EMPHASIS"
+>postgres</I
+>, create the database installation (the working data files). It can be anywhere that is writable by the postgres user (usually /usr/local/pgsql/data):
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>mkdir /usr/local/pgsql/data
+/usr/local/pgsql/bin/initdb -D /usr/local/pgsql/data
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   * Start the database server with the command: 
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>/usr/local/pgsql/bin/postmaster -D /usr/local/pgsql/data
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   This will start the server in the foreground (CTRL+C to stop it). To make it detach to the background, you can use the -S option, but then you won't see any log messages the server produces. A better way to put the server in the background is :
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>nohup /usr/local/pgsql/bin/postmaster -D /usr/local/pgsql/data &#60; /dev/null &#62;&#62; server.log 2&#62;&#62;1 &#38;
+  </PRE
+></TD
+></TR
+></TABLE
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN101"
+>2.4. Getting it to start with every boot</A
+></H2
+><P
+>   Unfortunately there's no easy answer here. Every system (even GNU/Linux distributions) is a bit different than the other. In Red Hat / Mandrake systems I modify the postgresql startup script that comes with the RPM distribution to fit a compiled version. 
+  </P
+><P
+>   In the <I
+CLASS="EMPHASIS"
+>contrib/linux</I
+> directory of the PostgreSQL source distribution there's a sample startup script that you can use to include in your /etc/init.d directory.
+  </P
+></DIV
+><DIV
+CLASS="SECT2"
+><H2
+CLASS="SECT2"
+><A
+NAME="AEN106"
+>2.5. Testing</A
+></H2
+><P
+>   After you've started the database server, try creating a database and connecting to it through psql:
+  </P
+><TABLE
+BORDER="0"
+BGCOLOR="#E0E0E0"
+WIDTH="100%"
+><TR
+><TD
+><PRE
+CLASS="PROGRAMLISTING"
+>createdb mydb
+psql mydb
+  </PRE
+></TD
+></TR
+></TABLE
+><P
+>   If you see a prompt after a few messages, you're set ! Congratulations.
+  </P
+></DIV
+></DIV
+><H3
+CLASS="FOOTNOTES"
+>Notes</H3
+><TABLE
+BORDER="0"
+CLASS="FOOTNOTES"
+WIDTH="100%"
+><TR
+><TD
+ALIGN="LEFT"
+VALIGN="TOP"
+WIDTH="5%"
+><A
+NAME="FTN.AEN46"
+HREF="x32.html#AEN46"
+>[1]</A
+></TD
+><TD
+ALIGN="LEFT"
+VALIGN="TOP"
+WIDTH="95%"
+><P
+>This is unnecessary in PG 7.1 as it is rid of the blocksize limit.
+    </P
+></TD
+></TR
+></TABLE
+><DIV
+CLASS="NAVFOOTER"
+><HR
+ALIGN="LEFT"
+WIDTH="100%"><TABLE
+WIDTH="100%"
+BORDER="0"
+CELLPADDING="0"
+CELLSPACING="0"
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+><A
+HREF="x12.html"
+>Prev</A
+></TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+><A
+HREF="index.html"
+>Home</A
+></TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+><A
+HREF="x111.html"
+>Next</A
+></TD
+></TR
+><TR
+><TD
+WIDTH="33%"
+ALIGN="left"
+VALIGN="top"
+>Before you start</TD
+><TD
+WIDTH="34%"
+ALIGN="center"
+VALIGN="top"
+>&nbsp;</TD
+><TD
+WIDTH="33%"
+ALIGN="right"
+VALIGN="top"
+>Installing Binary Packages</TD
+></TR
+></TABLE
+></DIV
+></BODY
+></HTML
+>
\ No newline at end of file
Index: web/openacs/www/doc/prototype-gifs/demopagetop.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/prototype-gifs/demopagetop.gif,v
diff -u
Binary files differ
Index: web/openacs/www/doc/prototype-gifs/penguin10a.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/prototype-gifs/penguin10a.gif,v
diff -u
Binary files differ
Index: web/openacs/www/doc/prototype-gifs/penguin2a.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/prototype-gifs/penguin2a.gif,v
diff -u
Binary files differ
Index: web/openacs/www/doc/prototype-gifs/penguin3a.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/prototype-gifs/penguin3a.gif,v
diff -u
Binary files differ
Index: web/openacs/www/doc/prototype-gifs/penguin4b.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/prototype-gifs/penguin4b.gif,v
diff -u
Binary files differ
Index: web/openacs/www/doc/prototype-gifs/penguin5b.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/prototype-gifs/penguin5b.gif,v
diff -u
Binary files differ
Index: web/openacs/www/doc/prototype-gifs/penguin6a.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/prototype-gifs/penguin6a.gif,v
diff -u
Binary files differ
Index: web/openacs/www/doc/prototype-gifs/penguin7a.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/prototype-gifs/penguin7a.gif,v
diff -u
Binary files differ
Index: web/openacs/www/doc/prototype-gifs/penguin8a.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/prototype-gifs/penguin8a.gif,v
diff -u
Binary files differ
Index: web/openacs/www/doc/prototype-gifs/penguin9a.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/prototype-gifs/penguin9a.gif,v
diff -u
Binary files differ
Index: web/openacs/www/doc/prototype-gifs/penguinadd.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/prototype-gifs/penguinadd.gif,v
diff -u
Binary files differ
Index: web/openacs/www/doc/prototype-gifs/penguincode.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/prototype-gifs/penguincode.gif,v
diff -u
Binary files differ
Index: web/openacs/www/doc/prototype-gifs/penguinedit.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/prototype-gifs/penguinedit.gif,v
diff -u
Binary files differ
Index: web/openacs/www/doc/prototype-gifs/penguinfront.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/prototype-gifs/penguinfront.gif,v
diff -u
Binary files differ
Index: web/openacs/www/doc/prototype-gifs/penguinlist.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/prototype-gifs/penguinlist.gif,v
diff -u
Binary files differ
Index: web/openacs/www/doc/prototype-gifs/penguinlistwtux.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/prototype-gifs/penguinlistwtux.gif,v
diff -u
Binary files differ
Index: web/openacs/www/doc/schema-browser/column-comments-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/schema-browser/column-comments-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/schema-browser/column-comments-2.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,11 @@
+set_the_usual_form_variables
+
+#
+# expected: table_name, column_name, comments
+#
+
+set db [ns_db gethandle]
+
+ns_db dml $db "comment on column $table_name.$column_name is '$QQcomments'"
+
+ns_returnredirect "index.tcl?[export_url_vars table_name]"
\ No newline at end of file
Index: web/openacs/www/doc/schema-browser/column-comments.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/schema-browser/column-comments.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/schema-browser/column-comments.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,45 @@
+set_the_usual_form_variables
+
+#
+# expected: table_name, column_name
+#
+
+set error_count 0
+set error_message ""
+
+if { ![info exists table_name] || $table_name == "" } {
+    incr error_count
+    append error_message "<li>variable table_name not found"
+}
+
+if { ![info exists column_name] || $column_name == "" } {
+    incr error_count
+    append error_message "<li>variable column_name not found"
+}
+
+if { $error_count > 0 } {
+    ad_return_complaint $error_count $error_message
+}
+
+
+set db [ns_db gethandle]
+
+
+set comments [database_to_tcl_string_or_null $db "
+    select comments from user_col_comments where table_name = '[string toupper $table_name]' and column_name = '[string toupper $column_name]'"
+]
+
+ns_write "
+<h2>ArsDigita Schema Browser</h2>
+<hr>
+<a href=\"index.tcl?[export_url_vars table_name]\">Tables</a> : Column Comment
+<p>
+<b>Enter or revise the comment on $table_name.$column_name:</b>
+<form method=post action=\"column-comments-2.tcl\">
+[export_form_vars table_name column_name]
+<textarea name=\"comments\" rows=\"4\" cols=\"40\" wrap=soft>$comments</textarea>
+<p>
+<input type=submit value=\"Save comment\">
+</form>
+<hr>
+"
Index: web/openacs/www/doc/schema-browser/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/schema-browser/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/schema-browser/index.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,477 @@
+#
+# schema-browser/index.tcl
+#
+# mark@ciccarello.com
+#
+
+
+# constraint descriptor: { constraint_name constraint_type { constraint_columns } search_condition {foreign_columns} foreign_table foreign_constraint }
+
+set CD_CONSTRAINT_NAME 0
+set CD_CONSTRAINT_TYPE 1
+set CD_CONSTRAINT_COLUMN_LIST 2
+set CD_SEARCH_CONDITION 3
+set CD_PARENT_COLUMN_LIST 4
+set CD_PARENT_TABLE_NAME 5
+set CD_PARENT_CONSTRAINT 6
+
+
+proc sb_get_triggers { db table_name } {
+
+    set selection [ns_db select $db "
+        select
+            trigger_name,
+            trigger_type,
+            triggering_event,
+            status
+        from
+            user_triggers
+        where
+            table_name = '[string toupper $table_name]'"
+    ]
+
+    set return_string "\n-- triggers:"
+    set count 0
+    while { [ns_db getrow $db $selection] } {
+        set_variables_after_query
+        append return_string "\n--\t<a href=\"trigger.tcl?[export_url_vars trigger_name]\">$trigger_name</a> $triggering_event $trigger_type $status"
+    incr count
+    }
+    if { $count == 0 } {
+        append return_string "\n--\tnone"
+    }
+    return $return_string        
+}
+
+
+
+proc xx_get_child_tables { db table_name {html_anchor_p "f"} } {
+
+
+  #
+  # child tables -- put in comments about each child table that references this one
+  #
+
+  set return_string ""
+
+  # this takes about 8 minutes to run -- for one table!
+  #   set selection [ns_db select $db "
+  #        select
+  #            childcon.constraint_name,
+  #            parentcol.column_name as parent_column,
+  #            childcol.column_name as child_column,
+  #            childcol.table_name as child_table,
+  #            parentcol.table_name as parent_table
+  #        from
+  #            user_constraints childcon,
+  #            user_cons_columns parentcol,
+  #            user_cons_columns childcol
+  #        where
+  #            childcon.r_constraint_name = parentcol.constraint_name and
+  #            childcon.constraint_name = childcol.constraint_name and
+  #            childcon.constraint_type = 'R' and
+  #            parentcol.table_name = '$table_name'
+  #    "]
+
+  # since the above is so slow, forget about joining in user_cons_columns for the child table, so we won't know the
+  # column names of the child table involved.
+
+     set selection [ns_db select $db "
+         select distinct
+             childcon.constraint_name,
+             childcon.r_constraint_name,
+             childcon.table_name as child_table
+         from
+             user_constraints childcon,
+             user_cons_columns parentcol
+         where
+             childcon.r_constraint_name = parentcol.constraint_name and
+             childcon.constraint_type = 'R' and
+             parentcol.table_name = '[string toupper $table_name]'
+       "]
+
+              
+    append return_string "\n-- child tables:"
+
+    set child_count 0
+    while { [ns_db getrow $db $selection] } {
+        if { [expr (($child_count % 3) == 0)] } {
+            append return_string "\n--"
+	}
+        set_variables_after_query
+        if { $html_anchor_p == "t" } {
+            append return_string " <a href=\"index.tcl?table_name=$child_table\">[string tolower $child_table]</a>"
+        } else {
+            append return_string " [string tolower $child_table]"
+	} 
+        append return_string "($r_constraint_name)"
+        incr child_count
+    }
+    if {$child_count == 0} {
+        append return_string "\n--\t none"
+    }
+
+    return $return_string
+
+}
+
+
+proc add_column_constraint { column_list column_constraint } {
+
+#
+# adds a column constraint to the column list
+#
+# column_list := list of column_descriptor
+# column_constraint := constraint descriptor
+# 
+#
+
+    set i 0
+    set found_p "f"
+
+    while { $i < [llength $column_list] && [lindex $column_constraint 2] != [lindex [lindex $column_list $i] 0] } {
+        incr i
+    }
+
+    if { $i < [llength $column_list] } {
+         set column_descriptor [lindex $column_list $i]
+         set column_constraints [lindex $column_descriptor 4]
+         lappend column_constraints $column_constraint
+         set column_descriptor [lreplace $column_descriptor 4 4 $column_constraints]
+         set column_list [lreplace $column_list $i $i $column_descriptor]
+    }
+
+    return $column_list
+
+
+}
+
+proc xx_get_constraints { db table_name column_list {html_anchors_p "f"} } {
+
+
+}
+
+
+
+proc xx_get_indexes { db table_name { html_anchors_p "f" } } {
+
+    set return_string ""
+
+
+    #
+    # create statements for non-unique indices
+    # 
+
+    set selection [ns_db select $db "
+        select
+            i.index_name, 
+            i.index_type, 
+            i.uniqueness,
+            c.column_name      
+        from
+            user_indexes i, user_ind_columns c
+        where
+            i.index_name = c.index_name and
+            i.table_name = '[string toupper $table_name]'
+        order by
+            i.index_name,
+            c.column_position
+        "
+    ]
+
+    set prev_index ""
+
+    while { [ns_db getrow $db $selection] } {
+        set_variables_after_query
+        if { $uniqueness == "NONUNIQUE" } {
+            set uniqueness ""
+	}
+        if { $index_name != $prev_index } {
+            if { $prev_index != "" } {
+                append return_string ");"
+	    }
+            append return_string "\nCREATE $uniqueness INDEX [string tolower $index_name] ON [string tolower $table_name]\("
+        } else {
+            append return_string ","
+	}
+        append return_string "[string tolower $column_name]" 
+        set prev_index $index_name
+    }
+
+    if { $prev_index != "" } {
+        append return_string ");"
+    }
+
+
+}
+
+set_the_usual_form_variables 0
+
+#
+# expected: table_name (optional)
+#           n_columns (optional, default 4)
+#
+
+if { ![info exists n_columns] } {
+    set n_columns 4
+}
+
+
+ReturnHeaders
+
+ns_write "
+<h2>ArsDigita Schema Browser</h2>
+<hr>
+"
+
+set db [ns_db gethandle]
+
+set selected_table_name ""
+
+
+if { [info exists table_name] && $table_name != "" } {
+    set selected_table_name $table_name
+    set selection [ns_db select $db "
+        select
+            user_tab_columns.column_name,
+            data_type,
+            data_length,
+            user_col_comments.comments as column_comments,
+            user_tab_columns.data_default,
+            decode(nullable,'N','NOT NULL','') as nullable
+        from
+            user_tab_columns,
+            user_tables,
+            user_col_comments
+        where
+            user_tables.table_name = '[string toupper $selected_table_name]' and
+            user_tab_columns.table_name = '[string toupper $selected_table_name]' and
+            user_col_comments.table_name(+) = '[string toupper $selected_table_name]' and
+            user_col_comments.column_name(+) = user_tab_columns.column_name
+        order by
+            column_id
+    "]
+    ns_write "<pre>"
+    ns_write "\nCREATE TABLE [string tolower $selected_table_name] ("
+ 
+    set column_list ""
+    while { [ns_db getrow $db $selection] } {
+        set_variables_after_query
+        set column [list $column_name $data_type $data_length $column_comments "" $data_default $nullable]
+        lappend column_list $column
+    }
+
+    #
+    # find the column and table constraints
+    #
+
+
+    set selection [ns_db select $db "
+        select
+            columns.constraint_name,
+            columns.column_name,
+            columns.constraint_type,
+            columns.search_condition,
+            columns.r_constraint_name,
+            decode(columns.constraint_type,'P',0,'U',1,'R',2,'C',3,4) as constraint_type_ordering,
+            parent_columns.table_name as parent_table_name,
+            parent_columns.column_name as parent_column_name
+        from
+            (   
+               select 
+                   col.table_name,
+                   con.constraint_name, 
+                   column_name, 
+                   constraint_type, 
+                   search_condition, 
+                   r_constraint_name,
+                   position 
+               from
+                   user_constraints con,
+                   user_cons_columns col
+               where
+                   con.constraint_name = col.constraint_name
+            ) columns, 
+            user_cons_columns parent_columns
+        where
+            columns.table_name = '[string toupper $table_name]' and
+            constraint_type in ('P','U','C','R') and
+            columns.r_constraint_name = parent_columns.constraint_name(+) and
+            columns.position = parent_columns.position(+)
+        order by
+            constraint_type_ordering,
+            constraint_name,
+            columns.position
+        "
+    ]
+
+
+    # table_constraint_list -- a list of constraint descriptors for all constraints involving more than one column
+    set table_constraint_list ""     
+    
+
+    # current_contraint -- a constraint descriptor for the constraint being processed in the loop below
+    set current_constraint ""        
+
+    while { [ns_db getrow $db $selection] } {
+        set_variables_after_query
+        if { $constraint_name != [lindex $current_constraint $CD_CONSTRAINT_NAME] } {
+            if { $current_constraint != "" } {
+                # we've reached a new constraint, so finish processing the old one
+		if { [llength [lindex $current_constraint $CD_CONSTRAINT_COLUMN_LIST]] > 1 } {
+                    # this is a table constraint -- involves more than one column, so add it to the table constraint list
+                    lappend table_constraint_list $current_constraint
+		} else {
+                    set column_list [add_column_constraint $column_list $current_constraint]
+	        }
+	    }
+	    set current_constraint [list $constraint_name $constraint_type $column_name $search_condition $parent_column_name $parent_table_name $r_constraint_name]
+	} else {
+           # same constraint -- add the column to the descriptor
+           set constraint_column_list [lindex $current_constraint $CD_CONSTRAINT_COLUMN_LIST]
+           lappend constraint_column_list $column_name
+           set current_constraint [lreplace $current_constraint $CD_CONSTRAINT_COLUMN_LIST $CD_CONSTRAINT_COLUMN_LIST $constraint_column_list]
+	   if { $parent_column_name != "" } {
+               set parent_column_list [lindex $current_constraint $CD_PARENT_COLUMN_LIST] 
+               lappend parent_column_list $parent_column_name
+               set current_constraint [lreplace $current_constraint $CD_PARENT_COLUMN_LIST $CD_PARENT_COLUMN_LIST $parent_column_list]
+	   }
+	}
+    }
+
+    if { $current_constraint != "" } {
+        if { [llength [lindex $current_constraint $CD_CONSTRAINT_COLUMN_LIST]] > 1 } {
+  	    lappend table_constraint_list $current_constraint
+	} else {
+            set column_list [add_column_constraint $column_list $current_constraint]
+        }
+    }
+
+    #
+    # write out the columns with associated constraints
+    #
+
+
+    set n_column 0
+    foreach column $column_list {
+        if { $n_column > 0 } {
+            ns_write ","
+	}
+        set column_name [lindex $column 0]
+        set data_type [lindex $column 1]
+        set data_length [lindex $column 2]
+        set comments [lindex $column 3]
+        set constraint_list [lindex $column 4]
+        set data_default [lindex $column 5]
+        set nullable [lindex $column 6]
+ 
+        ns_write "\n\t[string tolower $column_name]\t $data_type\($data_length)"
+        if { $nullable != "" } {
+	    ns_write " $nullable"
+	}
+        if { $data_default != "" } {
+            ns_write " DEFAULT [util_convert_plaintext_to_html $data_default]"
+	}
+        foreach constraint $constraint_list {
+            if { [lindex $constraint $CD_CONSTRAINT_TYPE] == "P" } {
+                ns_write " PRIMARY KEY"
+	    } elseif { [lindex $constraint $CD_CONSTRAINT_TYPE] == "U" } {
+                ns_write " UNIQUE"
+	    } elseif { [lindex $constraint $CD_CONSTRAINT_TYPE] == "R" } {
+                ns_write " FOREIGN KEY REFERENCES [string tolower [lindex $constraint $CD_PARENT_TABLE_NAME]]([string tolower [lindex $constraint $CD_PARENT_COLUMN_LIST]])"
+	    } elseif { [lindex $constraint $CD_CONSTRAINT_TYPE] == "C" } {
+                # check constraint  ignore not-null checks
+                # because we already handled them
+                if { [string first "NOT NULL" [lindex $constraint $CD_SEARCH_CONDITION]] == -1 } { 
+                    ns_write "\n\t\tCHECK ([lindex $constraint $CD_SEARCH_CONDITION])"
+                }
+            } 
+	}
+
+        if {$comments != ""} {
+            if { [string length $comments] > 40 } {
+                ns_write "\t-- [string range $comments 0 36]..."
+	    } else {
+                ns_write "\t-- $comments"
+	    }
+	}
+        incr n_column
+    }
+
+
+    #
+    # write out the table-level constraints in the table_constraint_list
+    #
+
+    foreach constraint $table_constraint_list {
+        if { [lindex $constraint $CD_CONSTRAINT_TYPE] == "P" } {
+            ns_write ",\n\tPRIMARY KEY [lindex $constraint $CD_CONSTRAINT_NAME]("
+            ns_write "[string tolower [join [lindex $constraint $CD_CONSTRAINT_COLUMN_LIST] ","]])"
+	} elseif { [lindex $constraint $CD_CONSTRAINT_TYPE] == "U"} {
+            ns_write ",\n\tUNIQUE [lindex $constraint $CD_CONSTRAINT_NAME]("
+            ns_write "[string tolower [join [lindex $constraint $CD_CONSTRAINT_COLUMN_LIST] ","]])"
+        } elseif { [lindex $constraint $CD_CONSTRAINT_TYPE] == "R"} {
+            ns_write ",\n\tFOREIGN KEY [lindex $constraint $CD_CONSTRAINT_NAME]("
+            ns_write "[string tolower [join [lindex $constraint $CD_CONSTRAINT_COLUMN_LIST] ","]])"
+            ns_write " REFERENCES [string tolower [lindex $constraint $CD_PARENT_TABLE_NAME]]("
+            ns_write "[string tolower [join [lindex $constraint $CD_PARENT_COLUMN_LIST] ","]])"
+	}
+    }
+    
+    ns_write "\n);"
+    ns_write [xx_get_indexes $db $selected_table_name]
+    ns_write [sb_get_triggers $db $selected_table_name]
+    ns_write [xx_get_child_tables $db $selected_table_name "t"]
+    ns_write "</pre>"
+
+}
+
+
+ns_write "<h3>Tables:</h3>"
+set tables ""
+set selection [ns_db select $db "select table_name from user_tables order by table_name"]
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    lappend tables $table_name
+}
+
+set n_rows [expr ([llength $tables] - 1) / $n_columns + 1]
+
+ns_write "<table>"
+for { set row 0 } { $row < $n_rows } { incr row } {
+     ns_write "<tr>"
+     for {set column 0} {$column < $n_columns} {incr column} {
+         set i_element [expr $n_rows * $column + $row]
+         if { $i_element < [llength $tables] } {
+             set table_name [lindex $tables $i_element]
+             if { $table_name == $selected_table_name } {
+                 ns_write "<td><b>[string tolower $table_name]</b></td>"
+	     } else {
+                 ns_write "<td><a href=\"index.tcl?[export_url_vars table_name]\">[string tolower $table_name]</a></td>"
+             }
+	 }
+          
+     }   
+     ns_write "</tr>"
+}
+ns_write "</table>"
+
+  
+
+    
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/doc/schema-browser/test.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/schema-browser/test.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/schema-browser/test.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,18 @@
+
+
+ReturnHeaders
+
+set one "a one and a"
+set two [list "two"]
+set three ""
+
+set thelist [list $one $two $three]
+
+set n 1
+foreach item $thelist {
+    ns_write "<br>$n: $item"
+    incr n
+} 
+
+
+ns_write "<br>$thelist"
\ No newline at end of file
Index: web/openacs/www/doc/schema-browser/trigger.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/schema-browser/trigger.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/schema-browser/trigger.tcl	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,50 @@
+set_the_usual_form_variables
+
+#
+# expected: trigger_name
+#
+
+
+ReturnHeaders
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "
+    select
+        table_name,
+        trigger_type,
+        triggering_event,
+        status,
+        trigger_body
+    from
+        user_triggers
+    where
+        trigger_name = '[string toupper $trigger_name]'"
+]
+
+set_variables_after_query
+
+regsub -all ";" $trigger_body ";<br> " trigger_body
+regsub "begin" $trigger_body "begin<br>" trigger_body
+
+ns_write "
+<hr>
+create or replace trigger [string tolower $trigger_name]
+$triggering_event $trigger_type
+<br>
+[util_convert_plaintext_to_html $trigger_body]
+"
+
+ad_footer
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/doc/sql/LEFT-TO-DO.txt
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/LEFT-TO-DO.txt,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/LEFT-TO-DO.txt	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,6 @@
+
+- finish all ecommerce stuff
+
+- check general-comments! might be screwed from the real 3.0 version
+
+- site-wide-search.sql left to do
Index: web/openacs/www/doc/sql/ad-partner.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/ad-partner.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/ad-partner.sql	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,123 @@
+-- we need a table that will let us dynamically create cobranded pages.
+-- we do this by stuffing some appearance variables in a table and 
+-- create some header and footer functions in the tcl directory for 
+-- every partner. The partner_id fields in the gs_partner table 
+-- will all be automatically registered to set a cookie and redirect
+-- to the appropriate page
+
+-- To kill ad-partner
+-- drop view ad_partner_header_procs;
+-- drop view ad_partner_footer_procs;
+-- drop table ad_partner_procs;
+-- drop table ad_partner_url;
+-- drop table ad_partner;
+
+create sequence ad_partner_partner_id_seq start with 1000;
+create table ad_partner (
+        partner_id		integer primary key,
+	-- a human understandable name of the partner
+	partner_name		varchar(250) not null,
+	-- the cookie that will get set in the  ad_partner cookie (e.g. aol)
+	partner_cookie		varchar(50) not null,
+        -- now we start defining stuff that we use in the templates 
+        -- font face and color for standard text
+	default_font_face	varchar(100),
+	default_font_color	varchar(20),
+        -- font face and color for titles
+	title_font_face		varchar(100),
+	title_font_color	varchar(20),
+	group_id		references user_groups
+);
+create index ad_partner_partner_cookie on ad_partner(partner_cookie);
+create index ad_partner_partner_name_idx on ad_partner(partner_name);
+
+create sequence ad_partner_url_url_id_seq start with 1000;
+create table ad_partner_url (
+	url_id			integer primary key,
+	partner_id  		not null references ad_partner(partner_id),
+	-- the url stub of the section(directory) we are cobranding (e.g. /search)
+        -- use a leading slash but don't include the partner_cookie
+	url_stub		varchar(50) not null,
+	unique(partner_id,url_stub)
+);
+create index ad_partner_url_url_stub on ad_partner_url(url_stub);
+
+create sequence ad_partner_procs_proc_id_seq start with 1000;
+-- each partner can have multiple procs registered for displaying section
+-- headers. These will be called in order based on call_number
+create table ad_partner_procs (
+	proc_id			integer primary key,
+	url_id 			not null references ad_partner_url(url_id),
+	proc_name		varchar(100) not null,
+	call_number		integer not null,
+	proc_type		char(15) not null check(proc_type in ('header','footer')),
+	unique(call_number,url_id,proc_type)
+);
+
+create or replace view ad_partner_header_procs as
+select u.partner_id, u.url_id, p.proc_name, p.call_number, p.proc_id
+from ad_partner_procs p, ad_partner_url u
+where proc_type='header'
+and p.url_id=u.url_id
+order by call_number;
+
+create or replace view ad_partner_footer_procs as
+select u.partner_id, u.url_id, p.proc_name, p.call_number, p.proc_id
+from ad_partner_procs p, ad_partner_url u
+where proc_type='footer'
+and p.url_id=u.url_id
+order by call_number;
+
+
+create table ad_partner_group_map (
+	partner_id  	integer references ad_partner not null,
+	group_id	integer references user_groups not null,
+	primary key (group_id, partner_id)
+);
+
+
+create or replace function ad_partner_get_cookie (v_group_id integer)
+return varchar
+IS
+  v_partner_cookie  ad_partner.partner_cookie%TYPE;
+BEGIN
+  select partner_cookie into v_partner_cookie
+    from ad_partner_group_map, ad_partner
+   where ad_partner_group_map.partner_id = ad_partner.partner_id
+     and ad_partner_group_map.group_id = v_group_id;
+
+  return v_partner_cookie;
+
+END;
+/
+show errors;
+
+-- Initial Population for ArsDigita (cookie = ad)
+
+insert into ad_partner 
+(partner_id,partner_cookie, partner_name, default_font_face, default_font_color, title_font_face, title_font_color)
+values
+('1',
+ 'ad',
+ 'ArsDigita',
+ '',
+ '',
+ '',
+ ''
+);
+
+insert into ad_partner_url 
+(url_id, partner_id, url_stub)
+values 
+(1,1,'/');
+
+insert into ad_partner_procs 
+(proc_id, url_id, proc_name, call_number, proc_type)
+values 
+(1,1,'ad_partner_generic_header',1,'header');
+
+insert into ad_partner_procs 
+(proc_id, url_id, proc_name, call_number, proc_type)
+values 
+(4,1,'ad_partner_generic_footer',1,'footer');
+
Index: web/openacs/www/doc/sql/address-book.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/address-book.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/address-book.sql	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,66 @@
+--
+-- address-book.sql 
+--
+-- by eveander@arsdigita.com
+--
+-- supports a personal address book system
+--
+-- modified 12/17/99 by Tarik Alatovic (tarik@arsdigita.com):
+-- added support for scoping (user, group, public, table) to the address book table
+--
+-- ported by the ACS-pg team, munged from 2.4 by Ben Adida (ben@adida.net)
+
+create sequence address_book_id_sequence;
+create table address_book (
+	address_book_id	integer primary key,
+	-- if scope=public, this is the address book the whole system
+        -- if scope=group, this is the address book for a particular group
+        -- is scope=user, this is the address book for for particular user
+	-- if scope=table, this address book is associated with a table
+	user_id		integer references users,
+	group_id	integer references user_groups,
+	on_which_table  varchar(50),
+	on_what_id      integer,
+	first_names	varchar(30),
+	last_name	varchar(30),
+	email		varchar(100),
+	email2		varchar(100),
+	line1		varchar(100),
+	line2		varchar(100),
+	city		varchar(100),
+	-- state
+	usps_abbrev	char(2),
+	-- big enough to hold zip+4 with dash
+	zip_code	varchar(10),
+	phone_home	varchar(30),
+	phone_work	varchar(30),
+	phone_cell	varchar(30),
+	phone_other	varchar(30),
+	country		varchar(30),
+	birthmonth	char(2),
+	birthday	char(2),
+	birthyear	char(4),
+	days_in_advance_to_remind	integer,
+	date_last_reminded	datetime,
+	days_in_advance_to_remind_2	integer,
+	date_last_reminded_2	datetime,
+	notes		varchar(4000),
+	scope		varchar(20) not null 
+);
+
+--DRB: needs to go into the table itself for PG 7.0
+--alter table address_book add (
+--	check ((scope='group' and group_id is not null) or
+--      (scope='user' and user_id is not null) or
+--      (scope='table' and on_which_table is not null and
+--      on_what_id is not null) or (scope='public'))
+--);      
+
+
+create index address_book_idx on address_book ( user_id );
+create index address_book_group_idx on address_book ( group_id );
+
+
+
+
+
Index: web/openacs/www/doc/sql/adserver.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/adserver.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/adserver.sql	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,91 @@
+-- This data model is for the ArsDigita AdServer,
+-- a module of the ArsDigita Community System
+--
+-- created by philg@mit.edu, 12/2/98
+-- updated by brucek@arsdigita.com 12/23/98
+--
+
+create table advs (
+	adv_key         varchar(200) primary key,
+	-- this is useful for integrating with third-party ad products and services
+	local_image_p	char(1) default 't' constraint advs_local_img_p check (local_image_p in ('t','f')),
+	-- 't' indicates that target_url contains lots of html and this ad should not get wrapped
+	-- in the clickthrough counter.  This is useful for doubleclick, etc. where they've
+	-- got javascript and other nonsense wrapping the ad
+	track_clickthru_p char(1) default 't' constraint advs_trk_clk_p check (track_clickthru_p in ('t','f')),
+	-- a stub, relative to [ns_info pageroot] if local_image_p, or a url if !local_image_p
+	adv_filename    varchar(200),
+	target_url      varchar(4000)
+);
+
+-- **** move the unique index into a separate tablespace
+-- constraint adv_log_u unique (adv_key,entry_date) 
+-- using index tablespace photonet_index
+
+create table adv_log (
+	adv_key         varchar(200) not null references advs,  
+	entry_date      datetime not null,
+	display_count   integer default 0,
+	click_count     integer default 0,
+	unique(adv_key,entry_date)
+);
+
+-- for publishers who want to get fancy
+
+create table adv_user_map (
+	user_id         integer not null references users,
+	adv_key         varchar(200) not null references advs,
+	event_time      datetime not null,
+	-- will generally be 'd' (displayed) 'c' (clicked through)
+	event_type      char(1)
+);
+
+-- **** tablespace photonet_index
+create index adv_user_map_idx on adv_user_map(user_id);
+
+-- for publishers who want to get really fancy 
+
+create table adv_categories (
+	adv_key         varchar(200) not null references advs,
+	category_id     integer not null references categories,
+	unique(adv_key, category_id)
+);
+
+-- for publishers who want to get extremely fancy
+
+create table adv_keyword_map (
+	adv_key		varchar(200),
+	keyword		varchar(50),
+	unique(adv_key, keyword)
+);
+
+-- stuff built on top of the raw ad server layer 
+
+-- this is for publishers who want to rotate ads within a group
+
+create table adv_groups (
+	group_key	varchar(30) not null primary key,
+	pretty_name	varchar(50),
+	-- need to define some rotation methods
+	-- sequential: show the ads in the order specified in adv_group_map
+	-- least-exposure-first: show the ad the has been shown the least
+	-- unseen-then-sequential: show an unseen ad if available, otherwise show the next ad as specified in adv_group_map
+	-- unseen-then-least-first: show an unseen ad if available, otherwise show theleast exposed ad
+	-- random: show a random ad
+	-- keyword: show an ad that best matches the keywords
+	rotation_method char(35) default 'sequential' constraint ad_grp_rotation_method check (rotation_method in ('sequential','least-exposure-first', 'unseen-then-sequential', 'unseen-then-least-first', 'random', 'keyword'))
+);
+
+create table adv_group_map (
+	group_key	varchar(30) not null references adv_groups,
+	adv_key		varchar(200) not null references advs,
+	primary key (group_key,adv_key)
+);
+
+
+-- This view is used to select ads for display based on the current days 
+-- impression count
+create view advs_todays_log AS
+SELECT * FROM adv_log a WHERE a.entry_date = DATE_TRUNC('day',current_timestamp);
+
+
Index: web/openacs/www/doc/sql/bannerideas.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/bannerideas.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/bannerideas.sql	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,20 @@
+--
+-- bannerideas.sql
+--
+
+create sequence idea_id_sequence;
+
+-- the keyword facility gives us a way to match a banner idea
+-- to page content
+-- picture HTML includes a thumbnail and a full URL
+
+create table bannerideas (
+	idea_id		integer primary key,
+	intro		varchar(4000),
+	more_url	varchar(200),
+	picture_html	varchar(4000),
+	-- space-separated keywords
+	keywords	varchar(4000),
+	clickthroughs	integer default 0
+);
+
Index: web/openacs/www/doc/sql/bboard.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/bboard.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/bboard.sql	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,451 @@
+--
+-- data-model.sql for generic bboard system
+-- bashed for Oracle8 12/3/97
+-- bashed to run with community data model (users table rather
+-- than unauthenticated email/name) by Tracy Adams in the summer of 1998
+-- bashed 9/13/98 by philg to run with the Scorecard data model
+-- edited on 11/15/98 by philg so that the usgeospatial style
+-- of forum, from www.scorecard.org, would be part of the
+-- generic community system
+-- added active_p to bboard_topics teadams@mit.edu 1/7/98
+-- edited by Tracy Adams (teadams@mit.edu) on 2/7/98 to prevent
+--   multiple row inserted into msg_id_generator if this file
+--   is loaded more than once
+--
+-- updated by hqm to use numeric sequence vals as primary keys,
+-- and to integrate better with ACS user/group model 
+-- see /doc/bboard-new.html 
+-- hqm@ai.mit.edu 8/99
+
+-- Copyright 1996, 1997 Philip Greenspun (philg@mit.edu)
+--
+
+create sequence bboard_topic_id_sequence;
+
+create table bboard_topics (
+	topic_id	integer not null primary key,
+	-- topic name
+	topic		varchar(200) unique not null,
+	-- read access rights
+	-- can be one of any (anonymous), public (any registered user), group
+	read_access	varchar(16) default 'any' check (read_access in ('any','public','group')),
+	-- write (post new message) access
+	-- can be one of (public, group)
+	write_access 	varchar(16) default 'public' check (write_access in ('public','group')),
+ 	users_can_initiate_threads_p	boolean default 't',
+	backlink	varchar(4000),	-- a URL pointing back to the relevant page
+	backlink_title	varchar(4000),	-- what to say for the link back
+	blather		varchar(4000),	-- arbitrary HTML text that goes at the top of the page
+	-- posting is always restricted to members
+	-- is viewing restricted to members or only posting?
+	restricted_p	boolean default 'f',
+	primary_maintainer_id	integer not null references users(user_id),
+	subject_line_suffix	varchar(40),	-- whether to put something after the subject line, e.g., 'name', 'date'
+	notify_of_new_postings_p	char(1) default 't' check (notify_of_new_postings_p in ('t','f')),	-- send email when a message is added?
+	pre_post_caveat		varchar(4000),	-- special HTML to encourage user to search elsewhere before posting a new message
+	-- 'unmoderated', 'new_threads_by_maintainer', 'new_threads_by_helpers'
+	-- 'all_threads_by_maintainer', 'all_threads_by_helpers','answers_only_from_helpers', 'moderated_topics'
+	moderation_policy	varchar(40),
+	-- used for keeping messages for 50 US states, for example
+	-- where each state is a top level posting but not really a 
+	-- question
+	-- if this isn't NULL then we put in an "about" link
+	policy_statement	varchar(4000),
+	-- presentation_type  q-and-a (Question and answer format), threads (standard listserve), or ed_com (Question and response pages separated, editiorial language)
+	presentation_type	varchar(20) default 'q_and_a' constraint check_presentation_type check(presentation_type in ('q_and_a','threads', 'ed_com', 'usgeospatial')),
+	-- stuff just for Q&A  use
+	q_and_a_sort_order	varchar(4) default 'asc' not null check (q_and_a_sort_order in ('asc','desc')),
+	q_and_a_categorized_p	boolean default 'f',
+	q_and_a_new_days	integer default 7,
+	q_and_a_solicit_category_p	boolean default 't',
+	q_and_a_cats_user_extensible_p	boolean default 'f',
+	-- use the interest level system
+	q_and_a_use_interest_level_p 	boolean default 't',
+	-- for popular boards, only show categories for non-new msgs
+	q_and_a_show_cats_only_p	boolean default 'f',
+	-- for things like NE43 memory project and 6.001 pset site 
+	-- top level threads can have custom sort keys, e.g., date
+	-- of story (rather than date of posting)
+	custom_sort_key_p 		boolean default 'f',
+	custom_sort_key_name		varchar(50),	-- for display
+	-- SQL data type, lowercase, e.g., "date" (ANSI format so that it sorts)
+	-- we really only use this for user input validation
+	custom_sort_key_type		varchar(20),
+	custom_sort_order		varchar(4) default 'asc' not null check (custom_sort_order in ('asc','desc')),
+	-- display to user if there aren't message yet
+	custom_sort_not_found_text	varchar(4000),
+	-- ask user to supply a sort key with new postings
+	custom_sort_solicit_p		boolean default 'f',
+	-- ask user to supply a pretty sort key for display
+	-- e.g., "Fall 1997" instead of 9-29-97
+	custom_sort_solicit_pretty_p   boolean default 'f',
+	custom_sort_pretty_name		varchar(50),	-- for display
+	custom_sort_pretty_explanation	varchar(100),	-- why we ask for it
+	-- fragment of Tcl code that evaluates to 0 if a sort key is
+	-- bad, 1 if OK, assumed to include "$custom_sort_key"
+	custom_sort_validation_code	varchar(4000),
+	-- for the 2nd round of 6.001 discussion thinking
+	category_centric_p		boolean default 'f',
+	-- image and file uploading
+	uploads_anticipated		varchar(30) check (uploads_anticipated is null or uploads_anticipated in ('images','files','images_or_files')),
+	-- should this forum come up on the user interface?
+	active_p			boolean default 't',
+	group_id                        integer references user_groups
+);
+
+
+-- useful for maintaining FAQs
+
+create table bboard_q_and_a_categories (
+	topic_id	integer not null references bboard_topics,	
+	category	varchar(200) not null
+);
+
+-- useful for keeping idiots out of forums, e.g., looking for
+-- "aperature" in the photo.net Q&A forum
+
+create table bboard_bozo_patterns (
+	topic_id	integer not null references bboard_topics,
+	the_regexp	varchar(200) not null,
+	scope		varchar(20) default 'both' 
+           check(scope in ('one_line','message','both')),
+        message_to_user	varchar(4000),
+	creation_date	datetime not null,
+	creation_user 		integer not null references users(user_id),
+	creation_comment	varchar(4000),
+	primary key (topic_id, the_regexp)
+);
+
+-- **** primary key using index tablespace photonet_index
+
+create table bboard (
+	msg_id		char(6) primary key,
+	refers_to	char(6),
+        root_msg_id	char(6),
+	topic_id	integer not null references bboard_topics,
+	category	varchar(200),	-- only used for categorized Q&A forums
+	originating_ip	varchar(16),	-- stored as string, separated by periods
+	user_id		integer not null references users,
+	one_line	varchar(700),
+	-- message can now be full-lengthed text field in PostreSQL v7.0
+	message		lztext,
+	-- html_p - is the message in html or not
+	html_p		boolean default 'f',
+	posting_time	datetime,
+	expiration_days	integer,	-- optional N days after posting_time to expire
+	-- really only used for postings that initiate threads
+	interest_level	integer check ( interest_level is null or interest_level >= 0 and interest_level <= 10 ),
+	sort_key	varchar(700),
+	-- only used for weirdo things like NE43 memory project and 
+	-- 6.001
+	-- if this is a DATE, it has to be an ANSI so that it will
+	-- sort lexicographically
+	-- I guess we should constraint this to be UNIQUE
+	custom_sort_key		varchar(100),
+	custom_sort_key_pretty	varchar(100),
+	-- stuff for US geospatial forums
+	epa_region	integer check(epa_region is null or epa_region >= 1 and epa_region <= 10),
+	usps_abbrev	char(2) references states,
+	fips_county_code	char(5) references counties,
+	zip_code	varchar(5),
+        urgent_p        boolean not null default 'f'
+);
+
+-- for all of the following indices: **** tablespace photonet_index
+
+create index bboard_by_user on bboard (user_id);
+
+-- this SORT_KEY index will make fetching single Q&A thread fast
+-- but it will only work if sort_key is bashed down to 758 chars
+-- (note:  Illustra could trivially have indexed this)
+
+-- DRB
+-- "like" on an indexed field doesn't work in 6.5, strange, and was
+-- fixed in 6.5.1 by forcing a sequential scan.  I've added a root_msg_id
+-- field and am indexing it to get around the problem.
+
+-- create index bboard_by_sort_key on bboard ( sort_key );
+create index bboard_by_root_msg_id on bboard ( root_msg_id );
+
+-- we need this to avoid an O(N^2) search for "unanswered questions"
+-- (made worse by stupid Illustra's inability to cache after a sequential
+-- scan)
+
+-- don't think we need this anymore because we never ask for
+-- refers_to without a topic spec (hence the new_questions 
+-- concat index will work fine)
+-- OOOps *** we do in fact need this for the unanswered questions
+
+create index bboard_index_by_refers_to on bboard ( refers_to );
+
+-- this is designed to make checking for already posted messages faster
+-- on a system where not all of the messages are in one TOPIC then
+-- this should be a concatenated index on topic, one_line
+
+create index bboard_index_by_one_line on bboard ( one_line );
+-- don't need this anymore because "new_questions one works"
+-- create index bboard_by_topic on bboard ( topic );
+
+-- let's try to make the very top-level query load faster
+
+create index bboard_for_new_questions on bboard ( topic_id, refers_to, posting_time );
+
+-- let's try to make the "postings in one category" faster
+
+create index bboard_for_one_category on bboard ( topic_id, category, refers_to );
+
+-- you might want this depending on how you think custom sort keys are handled
+-- can't have just custom_sort_key unique because then you can't have the 
+-- same one for two topics
+
+-- create unique index bboard_index_custom on bboard ( topic_id, custom_sort_key );
+
+
+-- let's try to make the "first N days" query fast
+-- create index bboard_for_top_N on bboard using btree ( topic, refers_to, posting_time );
+-- fails: W01P0G:warning: index hint for range variable bboard is unusable
+
+-- takes a sort_key and returns just the six digit root
+-- doesn't work as well as you'd think because you can't 
+-- GROUP BY a functional result
+
+--create function bboard_root_msg(text) returns char(6)
+--as 
+--return substring ( $1 from 1 for 6 );
+
+create view bboard_new_answers_helper 
+as
+select b.root_msg_id, b.topic_id, b.posting_time from bboard b
+where b.refers_to is not null;
+
+create function bboard_uninteresting_p (integer)
+returns char
+AS
+'
+BEGIN
+  IF ($1 < 4) THEN
+    return ''t'';  
+  ELSE
+    return ''f'';
+  END IF;
+END;
+' language 'plpgsql';
+
+--create index bboard_pls_index on bboard using pls
+--( one_line, message, email, name );
+
+create table msg_id_generator (
+	last_msg_id	char(6)
+);
+
+-- Apparently Ben and I (DRB) ran into similar problems trying
+-- to port over the generator, and both punted and just did an
+-- insert...but this insert's a little fancier than his, because
+-- it only inserts if the table's empty.
+
+insert into msg_id_generator 
+select '000000'
+where 0 = (select count(*) from msg_id_generator);
+
+--
+-- an "email me if changed" system
+--
+
+create table bboard_email_alerts (
+	user_id		integer not null references users,
+	topic_id	integer not null references bboard_topics,
+	valid_p		boolean default 't',	-- we set this to 'f' if we get bounces
+	frequency	varchar(30),		-- 'instant', 'daily', 'Monday/Thursday', 'weekly', etc.	
+	keywords	varchar(2000)	-- stuff the user is interested in
+);
+
+create index bboard_email_alerts_idx on bboard_email_alerts(user_id);
+
+-- Alert by thread system; obsoletes notify field in bboard table.
+create table bboard_thread_email_alerts (
+	thread_id	char(6) references bboard, -- references msg_id of thread root
+	user_id		integer references users,
+	primary key (thread_id, user_id)
+);
+
+
+
+--
+-- this holds the last time we sent out notices and the total
+-- number of messages sent (just for fun)
+--
+
+-- had to change name of table from 
+-- bboard_email_alerts_last_updates
+
+create table bboard_email_alerts_updates (
+	weekly	datetime,
+	weekly_total	integer,
+	daily	datetime,
+	daily_total	integer,
+	monthu	datetime,
+	monthu_total	integer
+);
+
+-- need something to initialize this table 
+
+insert into bboard_email_alerts_updates 
+(weekly, weekly_total, daily, daily_total, monthu, monthu_total)
+values
+(current_timestamp,0,current_timestamp,0,current_timestamp,0);
+
+create function bboard_contains (varchar, varchar, varchar, varchar, varchar)
+returns integer as '
+declare
+  email alias for $1;
+  user_name alias for $2;
+  one_line alias for $3;
+  message alias for $4;
+  space_sep_list_untrimmed alias for $5;
+  space_sep_list        varchar(32000);
+  upper_indexed_stuff   varchar(32000);
+  -- if you call this var START you get hosed royally
+  first_space           integer;
+  score                 integer;
+BEGIN 
+  space_sep_list := upper(ltrim(rtrim(space_sep_list_untrimmed)));
+  upper_indexed_stuff := upper(email || user_name || one_line || substr(message,30000));
+  score := 0;
+  IF space_sep_list is null or upper_indexed_stuff is null THEN
+    RETURN score;  
+  END IF;
+  LOOP
+   first_space := position(space_sep_list in '' '');
+   IF first_space = 0 THEN
+     -- one token or maybe end of list
+     IF position(upper_indexed_stuff in space_sep_list) <> 0 THEN
+        RETURN score+10;
+     END IF;
+     RETURN score;
+   ELSE
+   -- first_space <> 0
+     IF position(upper_indexed_stuff in substr(space_sep_list,1,first_space-1)) <> 0 THEN
+        score := score + 10;
+     END IF;
+   END IF;
+    space_sep_list := substr(space_sep_list,first_space+1);
+  END LOOP;  
+END;
+' language 'plpgsql';
+
+-- for geospatialized forum
+
+-- There must be one row for every state, though we guess that you
+-- don't have to use the same 10 EPA regions that we used for
+-- Scorecard
+
+-- if you want to use this, feed your database the epa-regions.dmp 
+-- file that is in the /install directory
+
+-- create table bboard_epa_regions (
+-- 	state_name		varchar(30),
+--  	fips_numeric_code	char(2),
+-- 	epa_region		integer,
+-- 	usps_abbrev		char(2),
+--         -- "Great Lakes Region", "Central Region", etc. 
+--         -- Not very normalized, but easy.... -jsc
+--         description             varchar(50)
+-- );
+
+-- for uploading files with bboard postings
+
+-- these are stored in a configurable directory
+
+-- we add photos, Word and Excel documents, etc.
+-- file_type is "photo", "spreadsheet", "plaintext"
+-- "pdf", "html", "word", "miscbinary", "audio"
+
+-- we only allow one upload per message
+
+create sequence bboard_upload_id_sequence;
+
+create table bboard_uploaded_files (
+	bboard_upload_id	integer primary key,
+	msg_id			char(6) not null unique references bboard,
+	file_type		varchar(100),	-- e.g., "photo"
+	file_extension		varchar(50), 	-- e.g., "jpg"
+	-- can be useful when deciding whether to present all of something
+	n_bytes			integer,
+	-- what this file was called on the client machine
+	client_filename		varchar(4000) not null,
+	-- generally the filename will be "*msg_id*-*upload_id*.extension"
+	-- where the extension was the originally provided (so 
+	-- that ns_guesstype will work)
+	filename_stub		varchar(200) not null,
+	-- fields that only make sense if this is an image
+	caption			varchar(4000),
+	-- will be null if the photo was small to begin with
+	thumbnail_stub		varchar(200),
+	original_width		integer,
+	original_height		integer
+);
+
+-- Part of a series of security fixes
+-- (BMA, spec'ed by aD)
+create function bboard_user_can_view_topic_p (integer,integer)	
+returns char AS '
+DECLARE
+	v_user_id alias for $1;
+	v_topic_id alias for $2;
+	v_read_access varchar(16);	     
+	v_group_id    integer;
+	v_count       integer;
+BEGIN
+	select read_access, group_id into v_read_access, v_group_id
+	from bboard_topics
+	where topic_id = v_topic_id;
+
+	IF v_read_access = ''any'' or v_read_access = ''public'' THEN
+	RETURN ''t'';
+	END IF;
+
+	select count(*) into v_count
+	from user_group_map
+	where user_id = v_user_id
+	and group_id = v_group_id;      
+
+	IF v_count > 0 THEN
+	RETURN ''t'';
+	END IF;
+
+	RETURN ''f'';
+END;
+' language 'plpgsql';
+
+
+
+-- Extra added stuff for Postgres
+-- by Ben
+create function bboard_mod_pol_number(varchar) returns integer
+as '
+declare
+	mod_pol alias for $1;
+begin
+	if mod_pol=''''
+	then return 1;
+	end if;
+	
+	if mod_pol= ''featured''
+	then return 2;
+	end if;
+
+	if mod_pol= ''moderated''
+	then return 3;
+	end if;
+
+	if mod_pol= ''unmoderated''
+	then return 4;
+	end if;
+
+	if mod_pol= ''private''
+	then return 5;
+	end if;
+
+	return 6;
+end;
+' language 'plpgsql';
Index: web/openacs/www/doc/sql/bookmarks.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/bookmarks.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/bookmarks.sql	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,264 @@
+-- bookmarks.sql
+--
+-- created June 1999 and modified July 1999
+-- by aure@arsdigita.com and dh@arsdigita.com 
+
+-- ported to openacs by sokolof@rpi.edu
+
+
+create sequence bm_url_id_seq;
+-- since many people will be bookmarking the same sites, we keep urls in a separate table
+
+create table bm_urls (
+	url_id integer primary key,
+	-- url title may be null in the case of bookmarks that are merely icons ie. AIM
+	url_title varchar(500),
+	-- host url is separated from complete_url for counting purposes
+	host_url varchar(100) not null,
+	complete_url varchar(500) not null,
+	-- meta tags that could be looked up regularly	
+	meta_keywords varchar(4000),
+	meta_description varchar(4000),
+	last_checked_date timestamp,
+	-- the last time the site returned a "live" status
+	last_live_date timestamp
+);
+
+create sequence bm_bookmark_id_seq;
+-- this table contains both bookmarks and folders
+
+
+create table bm_list (
+	bookmark_id integer primary key,
+	-- sort keys contains 3 characters per level of depth, from
+	-- 0-9, then A-Z, a-z. You can get the depth as length(parent_sort_key) / 3.
+	-- the full sort key for any bookmark is parent_sort_key || local_sort_key
+  	parent_sort_key varchar(99), -- parent's sort key
+	local_sort_key char(3) not null,
+	owner_id integer not null references users(user_id),
+	creation_date timestamp not null,
+	modification_date timestamp,
+	-- url_id may be null if the bookmark is a folder
+	url_id integer references bm_urls,
+	-- a person may rename any of his bookmarks so we keep a local title
+	local_title varchar(500),
+	private_p char(1) default 'f' check (private_p in ('t','f')),
+	-- needed in addition to private_p for the case where a public bookmark
+	-- is under a hidden folder
+	hidden_p char(1) default 'f' check (hidden_p in ('t','f')),
+	-- this is 't' if the bookmark is a folder
+	folder_p char(1) default 'f' check (folder_p in ('t','f')),
+	-- null parent_id indicates this is a top level folder/bookmark
+	parent_id integer references bm_list(bookmark_id),
+	-- refers to whether a folder is open or closed
+	closed_p char(1) default 't' check (closed_p in ('t','f')),
+	-- whether the bookmark is within a closed folder and therefore not shown
+	in_closed_p char(1) default 'f' check (in_closed_p in ('t','f')) 
+);
+
+-- a hack to supply Oracle chr()functionality in pg7.0.2
+-- will need to be changed because postgres programmers
+-- intend to have chr in future releases
+
+create function chr(int4)
+returns char
+as '
+begin
+   return ichar($1);
+end;'
+language 'plpgsql';
+
+
+-- Increments char from 0-9 A-Z.
+-- acs_classic incremented from a-z after A-Z
+-- but this doesn't seem to sort properly in
+-- postgres
+
+CREATE function inc_char_for_sort_key (char)
+RETURNS CHAR
+AS 'DECLARE
+   old_code INTEGER;
+   new_code INTEGER;
+BEGIN
+   old_code := ascii($1);
+   IF old_code = 57 THEN
+      -- skip from 9 to A
+      new_code := 65;
+   ELSE
+     IF old_code = 90 THEN
+       -- wrap around
+       new_code := 48;
+     ELSE
+       new_code := old_code + 1;
+     END IF;
+  END IF;
+  RETURN chr(new_code);
+END;'
+LANGUAGE 'plpgsql';
+
+
+-- Sets carry_p to true if incrementing
+-- from Z to 0.
+
+CREATE function get_carry_for_sort_key (char)
+RETURNS CHAR
+AS 'DECLARE
+   old_code INTEGER;
+--   carry_p INTEGER;
+BEGIN
+  old_code := ascii($1);
+  IF old_code = 90 THEN
+   -- wrap around
+      RETURN ''t'';
+  END IF;
+    RETURN ''f'';
+END;'
+LANGUAGE 'plpgsql';
+
+
+-- Takes a local sort key and increments it by one.
+
+CREATE FUNCTION new_sort_key (varchar) 
+RETURNS VARCHAR
+AS 'DECLARE
+   v_chr_1 char;
+   v_chr_2 char;
+   v_chr_3 char;
+   v_carry char;
+   foo char;
+BEGIN
+
+   IF $1 IS null THEN
+      RETURN ''000'';
+   END IF;
+   
+   v_chr_1 := substr($1, 1, 1);
+   v_chr_2 := substr($1, 2, 1);
+   v_chr_3 := substr($1, 3, 1);
+
+   SELECT get_carry_for_sort_key(v_chr_3) INTO v_carry;
+   SELECT inc_char_for_sort_key(v_chr_3) INTO v_chr_3;
+   IF v_carry = ''t'' THEN
+      SELECT get_carry_for_sort_key(v_chr_2) INTO v_carry;
+      SELECT inc_char_for_sort_key(v_chr_2) INTO v_chr_2;
+      IF v_carry = ''t'' THEN
+        SELECT inc_char_for_sort_key(v_chr_1) INTO v_chr_1;
+      END IF;
+   END IF;
+   RETURN v_chr_1 || v_chr_2 || v_chr_3;
+END;'
+LANGUAGE 'plpgsql';
+
+-- calculates a new sort key for inserts
+
+CREATE function bm_list_sort_key_i() returns opaque as '
+DECLARE
+  v_last_sort_key bm_list.local_sort_key%TYPE;
+  v_parent_sort_key bm_list.parent_sort_key%TYPE;
+  parent_rec record;
+BEGIN
+   IF NEW.parent_id IS NULL THEN
+      SELECT max(local_sort_key) INTO v_last_sort_key
+	FROM bm_list
+	WHERE parent_id IS NULL;
+      v_parent_sort_key := null;
+   ELSE
+      SELECT max(local_sort_key) INTO v_last_sort_key
+        FROM bm_list
+        WHERE parent_id = NEW.parent_id;
+
+      -- postgres cannot concatenate a null value to a non null value
+      SELECT INTO parent_rec * FROM bm_list WHERE bookmark_id = NEW.parent_id;
+      IF parent_rec.parent_sort_key IS NULL THEN
+         v_parent_sort_key := parent_rec.local_sort_key;
+      ELSE
+        v_parent_sort_key := parent_rec.parent_sort_key || cast(parent_rec.local_sort_key as varchar(3));
+      END IF;
+   END IF;
+
+   NEW.local_sort_key := new_sort_key(v_last_sort_key);
+   NEW.parent_sort_key := v_parent_sort_key;
+   RETURN new;
+END;
+' language 'plpgsql'; 
+
+CREATE trigger bm_list_insert_tr
+before INSERT ON bm_list
+for each row
+execute procedure bm_list_sort_key_i(); 
+
+
+-- Fixes up parent_sort_key and local_sort_key for a bookmark.
+-- If the bookmark was a folder, recursively updates its children.
+
+CREATE FUNCTION bm_fixup_sort_key(INTEGER) 
+RETURNS INTEGER AS 'DECLARE
+   v_last_sort_key bm_list.local_sort_key%TYPE;
+   v_parent_sort_key bm_list.parent_sort_key%TYPE;
+   v_new_sort_key bm_list.local_sort_key%TYPE;
+   bm_list_rec record;
+   bm_list_parent_rec record;
+   child_rec record;
+   placeholder integer;
+BEGIN
+   SELECT INTO bm_list_rec * FROM bm_list WHERE bookmark_id = $1;
+   IF bm_list_rec.parent_id IS NULL THEN
+      -- Handle top-level changes
+      SELECT max(local_sort_key) INTO v_last_sort_key
+	FROM bm_list
+	WHERE parent_id IS NULL;
+      UPDATE bm_list SET parent_sort_key = NULL, local_sort_key = new_sort_key(v_last_sort_key) WHERE bookmark_id = $1;	 
+   ELSE
+      -- we are in a subfolder
+
+      SELECT max(local_sort_key) INTO v_last_sort_key
+	FROM bm_list
+	WHERE parent_id = bm_list_rec.parent_id;
+      SELECT into bm_list_parent_rec * FROM bm_list WHERE bookmark_id = bm_list_rec.parent_id;
+      -- postgres does not concatenate nulls to strings
+      -- so we have to test first
+         IF bm_list_parent_rec.parent_sort_key is null THEN
+   	    v_parent_sort_key := bm_list_parent_rec.local_sort_key;
+	 ELSE
+   	    v_parent_sort_key := bm_list_parent_rec.parent_sort_key || cast(bm_list_parent_rec.local_sort_key as varchar(3));
+	 END IF;
+      UPDATE bm_list SET parent_sort_key = v_parent_sort_key, local_sort_key = new_sort_key(v_last_sort_key) WHERE bookmark_id = $1;
+   END IF;
+   
+   -- Recursively run on children if this is a folder.
+    IF bm_list_rec.folder_p = ''t'' THEN
+      FOR child_rec in SELECT * FROM bm_list WHERE parent_id = $1 LOOP
+	 placeholder := bm_fixup_sort_key(child_rec.bookmark_id);
+      END LOOP;
+   END IF;
+   RETURN 1;
+END;'
+language 'plpgsql';
+
+
+-- finds out if bookmark is in a folder; used for connect statements
+-- tcl/bookmarks.defs
+
+create function bm_node_is_child(integer,integer) returns char as '
+declare
+        start   alias for $1;
+        id      alias for $2;
+        pid     integer;
+begin
+        if id = start then return ''t'';
+        end if;
+
+        select into pid parent_id from bm_list where bookmark_id = id;
+
+        if pid is null then
+           return ''f'';
+        else if id = start then 
+           return ''t'';
+        else 
+           return bm_node_is_child(start,pid);
+        end if;
+        end if;
+end;
+' language 'plpgsql';
+
+
Index: web/openacs/www/doc/sql/bulkmail.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/bulkmail.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/bulkmail.sql	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,25 @@
+create sequence bulkmail_id_sequence start with 1;
+
+create table bulkmail_instances (
+	bulkmail_id	integer primary key,
+	description	varchar(400),
+	creation_date	date not null,
+	creation_user	references users(user_id),
+	end_date	date,
+	n_sent		integer
+);
+
+create table bulkmail_log (
+	bulkmail_id	references bulkmail_instances,
+	user_id		references users,
+	sent_date	date not null
+);
+
+create table bulkmail_bounces (
+	bulkmail_id	references bulkmail_instances,
+	user_id		references users,
+	creation_date	date default sysdate,
+	active_p	char(1) default 't' check(active_p in ('t', 'f'))
+);	
+	
+create index bulkmail_user_bounce_idx on bulkmail_bounces(user_id, active_p);
Index: web/openacs/www/doc/sql/calendar.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/calendar.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/calendar.sql	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,79 @@
+--
+-- data model for on-line calendar (ArsDigita Calendar)
+-- 
+-- created by brucek@arsdigita.com on September 8, 1998
+-- 
+-- adapted to ArsDigita Community System on November 20, 1998
+-- by philg@mit.edu
+--
+
+-- what kinds of events are we interested in
+
+create sequence calendar_id_sequence;
+create sequence calendar_category_id_sequence;
+
+create table calendar_categories (
+	category_id	integer primary key,
+	-- if scope=public, this is a calendar category the whole system
+        -- if scope=group, this is a calendar category for a particular group
+	-- if scope=user, this is a calendar category for a user
+ 	scope           varchar(20) not null,
+	group_id	integer references user_groups,
+	user_id         integer references users,
+	category	varchar(100) not null,
+	enabled_p	char(1) default 't' check(enabled_p in ('t','f')),
+	constraint calendar_category_scope_check check ((scope='group' and group_id is not null) or
+	                                                (scope='user' and user_id is not null) or
+       							(scope='public')),
+	constraint calendar_category_unique_check unique(scope, category, group_id, user_id)	
+  );
+  
+create index calendar_categories_group_idx on calendar_categories ( group_id );
+
+create table calendar (
+	calendar_id	integer primary key,
+	category_id	integer not null references calendar_categories,
+	title		varchar(100) not null,
+	body		lztext not null,
+	-- is the body in HTML or plain text (the default)
+	html_p			char(1) default 'f' check(html_p in ('t','f')),
+	start_date	datetime not null,  -- first day of the event
+	end_date	datetime not null,  -- last day of the event (same as start_date for single-day events)
+	expiration_date	datetime not null,  -- day to stop including the event in calendars, typically end_date
+	event_url	varchar(200),  -- URL to the event
+	event_email	varchar(100),  -- email address for the event
+	-- for events that have a geographical location
+	country_code	char(2) references country_codes(iso),
+	-- within the US
+	usps_abbrev	char(2) references states,
+	-- we only want five digits
+	zip_code	varchar(10),
+	approved_p	char(1) default 'f' check(approved_p in ('t','f')),
+	creation_date	datetime not null,
+	creation_user		integer not null references users(user_id),
+	creation_ip_address	varchar(50) not null
+);
+
+
+
+create function trig_calendar_dates() returns opaque
+as '
+declare
+begin
+ if NEW.creation_date is null then
+   NEW.creation_date := current_timestamp;
+ end if;
+ if NEW.end_date is null then
+   NEW.end_date := NEW.start_date;
+ end if;
+ if NEW.expiration_date is null then
+   NEW.expiration_date := NEW.end_date;
+ end if;
+ RETURN NEW;
+end;
+' language 'plpgsql';
+
+create trigger calendar_dates
+before insert on calendar
+for each row
+execute procedure trig_calendar_dates();
Index: web/openacs/www/doc/sql/cassandracle.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/cassandracle.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/cassandracle.sql	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,59 @@
+-- create.role.ad_cassandracle.sql
+-- 1999-12-09
+-- David Ambercrobie: abe@arsdigita.com
+--
+-- Cassandracle normally connects as a user with DBA privleges,
+-- but we can also grant select privledges to a role, then 
+-- grant this role to normal database users. This allows a 
+-- normal ACS Oracle user to be able to use Cassandracle
+-- using the normal driver without worrying about DBA role
+-- users running amok.
+--
+-- More privliges will be added to this role as Cassandracle evolves.
+--
+-- You might need to restart the server after granting this
+-- role to an ACS Oracle user: granting a new role to a 
+-- user seems to have no effect on currently logged in users.
+
+-- To use:
+-- 1) Log into Oracle via sqlplus
+-- 2) connect internal 
+-- 3) load the sql commands below
+-- 4) grant role on username
+
+
+create role ad_cassandracle;
+
+-- http://oradoc.photo.net/ora81/DOC/server.815/a67790/ch3.htm
+grant select on v_$license to ad_cassandracle;
+grant select on v_$parameter to ad_cassandracle;
+grant select on v_$process to ad_cassandracle;
+grant select on v_$sess_io to ad_cassandracle;
+grant select on v_$session to ad_cassandracle; 
+grant select on v_$sql to ad_cassandracle;
+grant select on v_$sysstat to ad_cassandracle;
+grant select on v_$waitstat to ad_cassandracle;
+grant select on v_$sqltext to ad_cassandracle;
+grant select on v_$session_wait to ad_cassandracle;  
+
+-- http://oradoc.photo.net/ora81/DOC/server.815/a67790/ch2.htm#745
+grant select on dba_col_comments to ad_cassandracle;
+grant select on dba_cons_columns to ad_cassandracle;
+grant select on dba_constraints to ad_cassandracle;
+grant select on dba_data_files to ad_cassandracle;
+grant select on dba_free_space to ad_cassandracle;
+grant select on dba_ind_columns to ad_cassandracle;
+grant select on dba_indexes to ad_cassandracle;
+grant select on dba_objects to ad_cassandracle;
+grant select on dba_tab_columns to ad_cassandracle;
+grant select on dba_tab_comments to ad_cassandracle;
+grant select on dba_source to ad_cassandracle;
+
+-- http://oradoc.photo.net/ora81/DOC/server.815/a67790/ch2.htm#88786
+-- Oracle suggests using dba_data_files instead
+grant select on sys.filext$ to ad_cassandracle;
+
+-- http://oradoc.photo.net/ora81/DOC/server.815/a67779/ch4e.htm#8578
+grant comment any table to ad_cassandracle;
+
+-- end of create.role.ad_cassandracle.sql
Index: web/openacs/www/doc/sql/chat.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/chat.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/chat.sql	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,81 @@
+--
+-- chat.sql 
+--
+-- by philg@mit.edu on April 25, 1999
+--
+
+create sequence chat_room_id_sequence;
+
+create table chat_rooms (
+	chat_room_id		integer primary key,
+	pretty_name		varchar(100),
+	-- if set, this is a private chat room, associated with
+	-- a particular user group; otherwise public
+	private_group_id	integer references user_groups,
+	moderated_p		char(1) default 'f' 
+              check (moderated_p in ('t','f')),
+	-- if NULL, this room gets archived permanently; can be fractional
+	expiration_days		integer,
+	creation_date		datetime default current_timestamp not null,
+	active_p		char(1) default 't' check (active_p in ('t','f')),
+	-- permissions can be expanded to be more complex later
+    scope			varchar(20) not null,
+	group_id		integer references user_groups
+	 -- insure consistant state 
+--DRB: commented out as this breaks PG 6.5 (but not PG 7.0)
+--        	constraint chat_scope_not_null_check check ((scope='group' and group_id is not null) 
+--                                                 or (scope='public' and group_id is null))
+);
+
+create index chat_rooms_group_idx on chat_rooms ( group_id );
+
+create sequence chat_msg_id_sequence;
+
+-- if the ACS the content tagging system, e.g., for naughty words, is
+-- enabled, we store a content_tag (bit mask) for the original MSG
+-- and also store a bowdlerized version of the MSG (if necessary) 
+-- for quick serving to people who've enabled filtering.
+
+-- so the query for a filtered user would be 
+--     coalesce(msg_bowdlerized, msg) as filtered_msg 
+
+create table chat_msgs (
+	chat_msg_id	integer primary key,
+	msg		varchar(4000) not null,
+	msg_bowdlerized	varchar(4000),
+	content_tag	integer,
+	html_p		char(1) default 'f' check (html_p in ('t','f')),
+	approved_p	char(1) default 't' check(approved_p in ('t','f')),
+	-- things like "joe has entered the room" 
+	system_note_p	char(1) default 'f' check(system_note_p in ('t','f')),
+	creation_date	datetime not null,
+	creation_user		integer not null references users(user_id),
+	creation_ip_address	varchar(50) not null,
+	-- if set, this is a 1:1 message
+	recipient_user		integer references users(user_id),
+	-- if set, this is a broadcast message of some sort
+	chat_room_id		integer references chat_rooms
+);
+
+-- to support a garden variety chat room display
+
+create index chat_msgs_by_room_date on chat_msgs ( chat_room_id, creation_date );
+
+-- to support an admin looking into a user's history or a customer service 
+-- rep's history
+
+create index chat_msgs_by_user on chat_msgs ( creation_user );
+
+-- to support a query by a user for "any new messages for me?"
+
+create index chat_msgs_by_recipient on chat_msgs ( recipient_user, creation_date );
+
+-- Helper to count messages in a room (workaround for no outer joins and no
+-- subselects in target list)
+
+create function chat_room_msgs(integer) returns integer as '
+begin
+  return count(*) from chat_msgs where chat_room_id = $1;
+end;
+' language 'plpgsql';
+
Index: web/openacs/www/doc/sql/classifieds.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/classifieds.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/classifieds.sql	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,288 @@
+--
+-- Classified Ads data-model.sql
+--
+-- Created July 12, 1996 by Philip Greenspun (philg@mit.edu)
+-- 
+-- added auction stuff on December 21, 1996
+--
+-- converted from Illustra to Oracle January 5, 1998
+--
+-- edited to run from generic community system users table 
+-- (instead of email address/name stored in row) teadams@mit.eud April 2, 1998
+
+-- edited by philg on 11/18/98 to incorporate employment ad fields
+-- and also domain_type 
+
+-- edited by teadams@mit.edu on 1/7/98 to add active_p to ad_domains
+-- edited by teadams@mit.edu on 2/10/98 to prevent multiple seed inserts into 
+--   classified_alerts_last_updates
+-- edited by curtisg@arsdigita.com on 3/9/00 to convert primary keys
+--   to integers
+
+create table ad_domains (
+        domain_id               integer primary key,
+	-- short key, e.g., "Jobs"
+	domain			varchar(30) unique,
+	-- a description for this domain, e.g., "Jobs classifieds" 
+	-- or "Job Listings", this is designed to serve as a
+	-- hypertext anchor back to the top-level page
+	full_noun		varchar(100),
+	primary_maintainer_id	integer not null references users(user_id),
+	domain_type		varchar(30),	-- e.g., 'employment', 'automotive'
+	blurb			varchar(4000),
+	blurb_bottom		varchar(4000),
+	insert_form_fragments	varchar(4000),
+	ad_deletion_blurb	varchar(4000),
+	default_expiration_days	integer default 100,
+	levels_of_categorization integer default 1,
+	user_extensible_cats_p	char(1) default 'f' check(user_extensible_cats_p in ('t','f')),
+	wtb_common_p		char(1) default 'f' check(wtb_common_p in ('t','f')),
+	auction_p		char(1) default 'f' check(auction_p in ('t','f')),
+	geocentric_p 		char(1) default 'f' check(geocentric_p in ('t','f')),
+	--should this show up on the user interface?
+	active_p			char(1) default 't' check (active_p in ('t','f'))
+);
+create sequence ad_domain_id_seq start 1;
+
+-- we test these on inserts or updates to the table
+-- with user interface complaints
+--- check_code is something that goes into a Tcl If statement
+
+create table ad_integrity_checks (
+        integrity_check_id integer primary key,
+        domain_id       integer references ad_domains(domain_id),
+	check_code	varchar(4000),
+	error_message	varchar(4000)
+);
+create sequence ad_integrity_check_id_seq start 1;
+
+
+--
+-- We have a lot of redundant info in this
+-- (e.g., each primary_category may be represented 50 times)
+-- but we query into this with DISTINCT and we memo-ize
+-- so we don't care
+--
+-- the entire user interface is built from this
+--
+
+create table ad_categories (
+        category_id             integer primary key,
+        domain_id               integer references ad_domains(domain_id),
+	primary_category	varchar(100),
+	subcategory_1		varchar(100),
+	subcategory_2		varchar(100),
+	ad_placement_blurb	varchar(4000)
+);
+create sequence ad_category_id_seq start 1;
+
+-- if we're going to have a system where we only use primary 
+-- category then presumably these should be constrained unique
+-- we can do that with an index:
+
+create unique index ad_categories_unique on ad_categories ( domain_id, primary_category );
+
+-- old system had about 10,000 ads so far, this way we'll know whether
+-- or not an ad was inserted under the Oracle regime
+
+create sequence classified_ad_id_sequence;
+
+create table classified_ads (
+	classified_ad_id	integer primary key,
+	user_id			integer not null references users,
+        domain_id               integer not null references ad_domains(domain_id),
+	originating_ip		varchar(16),	-- stored as string, separated by periods
+	posted			datetime not null,
+	expires			datetime,
+	wanted_p		char(1) default 'f' check(wanted_p in ('t','f')),
+	private_p		char(1) default 't' check(private_p in ('t','f')),
+	-- if 'f', the reply_to link will not be displayed with the ad
+	reply_to_poster_p	char(1) default 't' check(reply_to_poster_p in ('t','f')),
+	primary_category	varchar(100),
+	subcategory_1		varchar(100),
+	subcategory_2		varchar(100),
+	manufacturer		varchar(50),	
+	model			varchar(50),
+	date_produced		datetime,
+	item_size		varchar(100),
+	color			varchar(50),
+	location		varchar(200),
+	us_citizen_p		char(1) default 'f' check(us_citizen_p in ('t','f')),
+	one_line		varchar(150),
+	full_ad			varchar(3600),
+	-- is the ad in HTML or plain text (the default)
+	html_p			char(1) default 'f' check(html_p in ('t','f')),
+	graphic_url		varchar(200),
+	price			numeric(9,2),
+	currency		varchar(50) default 'US dollars',
+	auction_p		char(1) default 't' check(auction_p in ('t','f')),
+	country			varchar(2),
+	state			varchar(30),
+	-- when system is used for employment ads (Cognet wanted these)
+	employer		varchar(100),
+	salary_range		varchar(200),
+	last_modified		datetime
+);
+
+create function trig_classified_update_last_mod() returns opaque
+as '
+declare
+begin
+ NEW.last_modified := current_timestamp;
+ IF TG_OP=''INSERT'' and NEW.posted is null THEN
+   NEW.posted := current_timestamp;
+ END IF;
+ RETURN NEW;
+end;
+' language 'plpgsql';
+
+create trigger classified_update_last_mod
+before insert or update on classified_ads 
+for each row
+execute procedure trig_classified_update_last_mod();
+
+create index classified_ads_by_primary_cat on classified_ads (primary_category);
+
+create index classified_ads_by_subcat_1 on classified_ads (subcategory_1);
+
+-- for the "remember to update your ads spam"
+
+create index classified_ads_by_email on classified_ads (user_id);
+
+-- the auction system 
+
+create table classified_auction_bids (
+	bid_id                  integer primary key,
+	classified_ad_id	integer not null references classified_ads,
+	user_id			integer not null references users,
+	bid			numeric(9,2),
+	currency		varchar(100) default 'US dollars',
+	bid_time		datetime,
+	location		varchar(100)
+);
+create sequence classified_auction_bid_id_seq start 1;
+
+create index classified_auction_bids_index 
+on classified_auction_bids (classified_ad_id);
+
+
+-- audit table (we hold deletions, big changes, here)
+-- warning:  this gives SQL*Plus heartburn if typed at the shell
+
+create table classified_ads_audit (
+	classified_ad_id	integer,
+	user_id			integer,
+        domain_id               integer,
+	originating_ip		varchar(16),
+	posted			datetime,
+	expires			datetime,
+	wanted_p		char(1),
+	private_p		char(1),
+	reply_to_poster_p	char(1),
+	primary_category	varchar(100),
+	subcategory_1		varchar(100),
+	subcategory_2		varchar(100),
+	manufacturer		varchar(50),	
+	model			varchar(50),
+	date_produced		datetime,
+	item_size		varchar(100),
+	color			varchar(50),
+	location		varchar(200),
+	us_citizen_p		char(1),
+	one_line		varchar(150),
+	full_ad			varchar(3600),
+	html_p			char(1),
+	graphic_url		varchar(200),
+	price			numeric(9,2),
+	currency		varchar(50),
+	auction_p		char(1),
+	country			varchar(2),
+	state			varchar(30),
+	employer		varchar(100),
+	salary_range		varchar(200),
+	last_modified		datetime,
+	-- from where user edited ad
+	audit_ip		varchar(16),
+	-- deleted by moderator?
+	deleted_by_admin_p	char(1) default 'f' check(deleted_by_admin_p in  ('t','f'))
+);
+
+create index classified_ads_audit_idx on classified_ads_audit(classified_ad_id);
+create index classified_ads_audit_user_idx on classified_ads_audit(user_id);
+
+
+-- ConText index stuff 
+
+-- this is also good for sequential scanning with pseudo_contains
+
+create view classified_context_view as
+  select ca.classified_ad_id, ca.domain_id, ca.one_line, ca.expires, ca.one_line || ' ' || ca.full_ad || ' ' || u.email || ' ' || u.first_names || ' ' || u.last_name || ' ' || ca.manufacturer || ' ' || ca.model || ' '  as indexed_stuff
+from classified_ads ca, users u
+where ca.user_id = u.user_id;
+
+
+-- email alert system
+
+--
+-- this holds the last time we sent out notices
+--
+
+create table classified_alerts_last_updates (
+	update_id       integer primary key,
+	weekly	datetime,
+	weekly_total	integer,
+	daily	datetime,
+	daily_total	integer,
+	monthu	datetime,
+	monthu_total	integer
+);
+
+create function init_classifieds() returns boolean as '
+declare
+ n_last_update_seed_rows integer;
+begin
+ select count(*) into n_last_update_seed_rows from classified_alerts_last_updates;
+ if n_last_update_seed_rows = 0 then 
+	insert into classified_alerts_last_updates (update_id, weekly, weekly_total, daily, daily_total, monthu, monthu_total) values (1, current_timestamp,0,current_timestamp,0,current_timestamp,0);
+ end if;
+ return ''t'';
+end;
+' language 'plpgsql';
+
+select init_classifieds();
+
+create table classified_email_alerts (
+	alert_id	integer primary key,
+	domain_id	varchar(30) not null references ad_domains(domain_id),
+	user_id		integer not null references users,
+	valid_p		char(1) default 't' check(valid_p in ('t','f')),
+	expires		datetime,
+	howmuch		varchar(100),	-- 'everything', 'one_line'
+	frequency	varchar(100),	-- 'instant', 'daily', 'Monday/Thursday', 'weekly', etc.
+	alert_type	varchar(20),	-- 'all', 'category', 'keywords'
+	category	varchar(100),
+	keywords	varchar(100),
+	established	datetime
+);
+create sequence classified_email_alert_id_seq start 1;
+
+create function trig_classified_ed_established() returns opaque
+as '
+declare
+begin
+ IF NEW.established IS NULL
+ THEN NEW.established := current_timestamp;
+ END IF;
+ RETURN NEW;
+end;
+' language 'plpgsql';
+
+create trigger classified_ea_established
+before insert on classified_email_alerts
+for each row
+execute procedure trig_classified_ed_established();
+
+
+
+--- random stuff for the AOLserver /NS/Admin pages
+
Index: web/openacs/www/doc/sql/community-core.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/community-core.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/community-core.sql	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,1095 @@
+-- ArsDigita Community System data model
+-- by philg@mit.edu
+
+-- as distributed, this will load into a user's default tablespace in
+-- Oracle; you'll get substantially higher transaction performance if
+-- you put certain tables or their indices into tablespaces that are
+-- on separate physical disk drives.  Search for "****" for things 
+-- that I (philg) think are good candidates.  Generally there will 
+-- be a commented-out directive to park something in a photonet tablespace
+-- you can comment these back in and change the tablespace name to something
+-- that is meaningful on your system
+
+-- first we define tables that store information about other tables
+-- (our own private data dictionary).  We could use the NS2_TABLES
+-- table to store this info if we wanted to tie ourselves even
+-- more to AOLserver, but we don't so we have our own table (also
+-- might make it easier to JOIN)
+
+-- TABLE_ACS_PROPERTIES is used for user profiling, site-wide search,
+-- and general comments
+
+create table table_acs_properties (
+             table_name      		varchar(30) primary key,
+             section_name    		varchar(100) not null,
+             user_url_stub   		varchar(200) not null,
+             admin_url_stub  		varchar(200) not null,
+	     module_key      		varchar(30) references acs_modules,
+	     -- we need to keep group_public_file and group_admin_file to support url's
+	     -- of items belonging to the groups. there are better ways of doing this but this way
+	     -- was chosen because of compatibility issues with previous acs releases. 
+	     group_public_file          varchar(200),
+	     group_admin_file           varchar(200)
+);
+
+-- only the US states (and random territories such as Guam)
+
+-- no need to define these; the /install/*.dmp files
+-- create them when you import (you must do that first)
+
+-- create table states (
+--  	usps_abbrev	char(2) not null primary key,
+--  	fips_state_code char(2),
+--  	state_name	varchar(25)
+-- );
+
+-- create table country_codes (
+-- 	iso		char(2) not null primary key,
+-- 	country_name	varchar(150)
+-- );
+
+-- create table counties (
+-- 	fips_county_code	 varchar(5) not null primary key,
+-- 	fips_county_name	 varchar(35) not null,
+-- 	fips_state_code		 varchar(2) not null,
+-- 	usps_abbrev		 varchar(2) not null,
+-- 	state_name		 varchar(50) not null
+-- );
+
+create sequence user_id_sequence;
+
+-- in general, users can't be deleted because of integrity constraints
+-- on content they've contributed; we can pseudo-delete them by setting 
+-- deleted_p to 't'; at this point there is the question of what to do 
+-- if/when they reappear on the site.  If they deleted themselves 
+-- then presumably we let them re-enable their registration.  If they
+-- were banned by the administration then we have to play dead or inform 
+-- them of that fact.
+
+create table users (
+	user_id			integer not null primary key,
+	first_names		varchar(100) not null,
+	last_name		varchar(100) not null,
+	screen_name		varchar(100),
+	constraint users_screen_name_unique unique(screen_name),
+	priv_name		integer default 0,
+	email			varchar(100) not null unique,
+	priv_email		integer default 5,
+	email_bouncing_p	char(1) default 'f' check(email_bouncing_p in ('t','f')),
+	-- converted_p means password is bogus; we imported this guy
+	-- from a system where we only had email address
+	converted_p		char(1) default 'f' check(converted_p in ('t','f')),
+	password		varchar(30) not null,
+	-- we put homepage_url here so that we can
+	-- always make names hyperlinks without having to 
+	-- JOIN to users_contact
+	url			varchar(200),
+	-- to suppress email alerts
+	on_vacation_until	datetime,
+	-- set when user reappears at site
+	last_visit		datetime,
+	-- this is what most pages query against (since the above column
+	-- will only be a few minutes old for most pages in a session)
+	second_to_last_visit	datetime,
+	-- how many times this person has visited
+	n_sessions		integer default 1,
+	registration_date	datetime,
+	registration_ip		varchar(50),
+	-- state the user is in in the registration process
+	user_state		varchar(100) check(user_state is null or user_state in ('need_email_verification_and_admin_approv', 'need_admin_approv', 'need_email_verification', 'rejected', 'authorized', 'banned', 'deleted')),
+	-- admin approval system
+        approved_date           datetime,
+        approving_user          integer references users(user_id),
+	approving_note       	varchar(4000),
+	-- email verification system
+	email_verified_date      datetime,
+	-- used if the user rejected before they reach 
+	-- the authorized state
+	rejected_date		datetime,
+	rejecting_user		integer references users(user_id),
+	rejecting_note          varchar(4000),
+	-- user was active but is now deleted from the system 
+	-- may be revived
+	deleted_date		datetime,	
+	deleting_user   	integer references users(user_id),
+	deleting_note          varchar(4000),
+	-- user was active and now not allowed into the system
+	banned_date		datetime,
+	-- who and why this person was banned
+	banning_user		integer references users(user_id),
+	banning_note		varchar(4000),
+	-- customer relationship manager fields
+	crm_state		varchar(50), -- forward reference: references crm_user_states,
+	crm_state_entered_date	datetime, -- when the current state was entered
+	-- portrait (esp. useful for corporate intranets)
+	-- portrait		blob,
+	lob			integer references lobs,
+	portrait_upload_date	datetime,
+	-- not a caption but background info
+	portrait_comment	varchar(4000),
+	-- file name including extension but not path
+	portrait_client_file_name	varchar(500),
+	portrait_file_type			varchar(100),	-- this is a MIME type (e.g., image/jpeg)
+	portrait_file_extension		varchar(50), 	-- e.g., "jpg"
+	portrait_original_width		integer,
+	portrait_original_height	integer,
+	-- if our server is smart enough (e.g., has ImageMagick loaded)
+	-- we'll try to stuff the thumbnail column with something smaller
+	-- portrait_thumbnail		blob,
+	portrait_thumbnail_width	integer,
+	portrait_thumbnail_height	integer,
+	-- so user's can tell us their life story
+	bio			varchar(4000)
+);
+
+create trigger user_lob_trig before insert or delete or update
+on users for each row execute procedure on_lob_ref();
+
+-- we need this to support /shared/whos-online.tcl and /chat 
+create index users_by_last_visit on users (last_visit);
+
+-- we need this index to list number of users in given user_state
+-- for the admin pages
+create index users_user_state on users (user_state);
+
+-- for queries by crm_state
+create index users_by_crm_state on users (crm_state);
+
+-- when Oracle 8.1 comes out, build a case-insensitive 
+-- functional index
+-- create unique index users_email_idx on users(upper(email));
+
+-- records multiple vacations
+create sequence user_vacations_vacation_id_seq start 1;
+create table user_vacations (
+	vacation_id	integer primary key,
+	user_id		integer references users,
+	start_date	datetime constraint user_vacations_start_const not null,
+	end_date 	datetime constraint user_vacations_end_const not null,
+	description	varchar(4000),
+	contact_info	varchar(4000),
+	-- should this user receive email during the vacation?
+	receive_email_p char(1) default 't' 
+  		constraint user_vacations_email_const check (receive_email_p in ('t','f')),
+	last_modified	datetime,
+	vacation_type   varchar(20)
+);
+
+create index user_vacations_user_id_idx on user_vacations(user_id);
+create index user_vacations_dates_idx on user_vacations(start_date, end_date);
+create index user_vacations_type_idx on user_vacations(vacation_type);
+
+-- on_vacation_p refers to the vacation_until column of the users table
+-- it does not care about user_vacations!
+
+create function on_vacation_p (datetime) returns CHAR
+AS '
+BEGIN
+	IF ($1 is not null) AND ($1 >= current_timestamp) THEN
+		RETURN ''t'';
+	ELSE
+		RETURN ''f'';
+	END IF;
+END;
+' language 'plpgsql';
+
+-- DRB: This function gets around a weird problem involving views.
+-- Though tuple size limitations have been removed throughout most
+-- of Postgres for V7.0, apparently this is not true for rules,
+-- though.  I attempted this kludge with "not exists" and that
+-- crashed the backend, so count(*) is the way we'll do it.
+
+-- I'll try to track this down and fix it in Postgres at some
+-- point.
+
+create function user_vacations_kludge(integer) returns integer as '
+begin
+ return count(*) 
+   from user_vacations v, users u
+   where u.user_id = $1 and v.user_id = u.user_id
+   and current_timestamp between v.start_date and v.end_date;
+end;' language 'plpgsql';
+
+create view users_alertable
+as
+select u.user_id, u.email, u.first_names, u.last_name, u.password
+ from users u
+ where (u.on_vacation_until is null or 
+        u.on_vacation_until < current_timestamp)
+ and u.user_state = 'authorized'
+ and (u.email_bouncing_p is null or u.email_bouncing_p = 'f')
+ and user_vacations_kludge(u.user_id) = 0;
+
+--- users who are not deleted or banned
+
+create view users_active
+as
+select user_id, email, first_names, last_name, password, portrait_client_file_name
+ from users u
+ where u.user_state = 'authorized';
+  
+-- users who've signed up in the last 30 days
+-- useful for moderators since new users tend to 
+-- be the ones who cause trouble
+
+create view users_new
+as
+select user_id, first_names, last_name, email, password
+ from users u
+ where u.registration_date > (current_timestamp - 30)::datetime;
+
+-- create a system user (to do things like own administrators group)
+-- and also create an anonymous user (to own legacy content)
+-- we keep their status in special email addresses because these are indexed
+-- (constrained unique) and therefore fast to look up 
+
+create function init_community_core() returns bool 
+as '
+declare
+ n_system_users		integer;
+ n_anonymous_users	integer;
+begin
+ select count(*) into n_system_users from users where email = ''system'';
+ if n_system_users = 0 then 
+   insert into users
+    (user_id, first_names, last_name, email, password, user_state)
+   values 
+    (nextval(''user_id_sequence''), ''system'', ''system'', ''system'', ''changeme'', ''authorized'');
+ end if;
+ -- if moving content from an old system, you might have lots that needs
+ -- to be owned by anonymous
+ select count(*) into n_anonymous_users from users where email = ''anonymous'';
+ if n_anonymous_users = 0 then 
+   insert into users
+    (user_id, first_names, last_name, email, password, user_state)
+   values 
+    (nextval(''user_id_sequence''), ''anonymous'', ''anonymous'', ''anonymous'', ''changeme'', ''authorized'');
+ end if;
+ return true;
+end;' language 'plpgsql';
+
+select init_community_core();
+
+create function system_user_id()
+returns integer
+as '
+declare
+  v_user_id	integer;
+begin
+  select user_id into v_user_id from users where email = ''system'';
+  return v_user_id;
+end;
+' language 'plpgsql';
+
+
+create function anonymous_user_id()
+returns integer
+as '
+declare
+  v_user_id	integer;
+begin
+  select user_id into v_user_id from users where email = ''anonymous'';
+  return v_user_id;
+end;' language 'plpgsql';
+
+
+create table users_preferences (
+	user_id			integer primary key references users,
+	prefer_text_only_p	char(1) default 'f' check (prefer_text_only_p in ('t','f')),
+	-- an ISO 639 language code (in lowercase)
+	language_preference	char(2) default 'en',
+	dont_spam_me_p		char(1) default 'f' check (dont_spam_me_p in ('t','f')),
+	email_type		varchar(64)
+);
+
+
+---- same as users_alertable but for publisher-initiated correspondence
+
+-- DRB: This function gets around a weird problem involving views.
+-- Though tuple size limitations have been removed throughout most
+-- of Postgres for V7.0, apparently this is not true for rules,
+-- though.  I attempted this kludge with "not exists" and that
+-- crashed the backend, so count(*) is the way we'll do it.
+
+-- SCC: Following needs to be checked for correctness:
+
+-- MAC: View previously only: select u.user_id, u.email, u.first_names, 
+-- u.last_name, u.password, up.email_type
+--
+-- Because of the queries automatically generated by the Tcl proc
+-- ad_user_class_query in tcl/ad-admin.tcl are going to be looking
+-- for essentially all non-blob columns of users (which get regsubbed
+-- to users_spammable by the spam module).
+
+create view users_spammable
+as
+select u.*, up.email_type
+ from users u, users_preferences up
+ where u.user_id = up.user_id
+ and user_state = 'authorized'
+ and (email_bouncing_p is null or email_bouncing_p = 'f')
+ and (dont_spam_me_p is null or dont_spam_me_p = 'f')
+ and user_vacations_kludge(u.user_id) = 0;
+
+-- there is a bit of redundancy here with users_contact
+-- but people may want to do a survey without ever asking
+-- users for full addresses
+
+create table users_demographics (
+	user_id		   	integer primary key references users,
+	birthdate		datetime,
+	priv_birthdate		integer,
+	sex			char(1) check (sex in ('m','f')),
+	priv_sex		integer,
+	postal_code		varchar(80),
+	priv_postal_code	integer,
+	ha_country_code		char(2) references country_codes(iso),
+	priv_country_code	integer,
+	affiliation		varchar(40),
+	-- these last two have to do with how the person
+	-- became a member of the community
+	how_acquired		varchar(40),
+	-- will be non-NULL if they were referred by another user
+	referred_by		integer references users(user_id)
+);
+
+create function user_demographics_summary (integer)
+returns text
+as '
+declare
+  demo_row		users_demographics%ROWTYPE;
+  age			integer;
+  pretty_sex		varchar(20);
+begin
+  select * into demo_row from users_demographics where user_id = $1;
+  age := round(date_part(''months'',current_timestamp- demo_row.birthdate)/12.0);
+  IF demo_row.sex = ''m'' THEN
+    pretty_sex := ''man'';
+  ELSE
+    IF demo_row.sex = ''f'' THEN
+      pretty_sex := ''woman'';
+    END IF;
+  END IF;
+  IF pretty_sex is null and age is null THEN
+    return null;
+  ELSE
+    IF pretty_sex is not null and age is null THEN
+      return ''a '' || pretty_sex;
+    ELSE
+      IF pretty_sex is null and age is not null THEN
+        return ''a '' || age || ''-year-old person of unknown sex'';
+      ELSE
+        return ''a '' || age || ''-year-old '' || pretty_sex;
+      END IF;
+    END IF;
+  END IF;
+end;' language 'plpgsql';
+
+-- contact info for users
+
+create table users_contact (
+	user_id		integer primary key references users,
+	home_phone	varchar(100),
+	priv_home_phone	integer,
+	work_phone	varchar(100),
+	priv_work_phone	integer,
+	cell_phone	varchar(100),
+	priv_cell_phone	integer,
+	pager		varchar(100),
+	priv_pager	integer,
+	fax		varchar(100),
+	priv_fax	integer,
+	-- to facilitate users talking to each other and Web server
+	-- sending instant messages, we keep the AOL Instant Messenger 
+	-- screen name
+	aim_screen_name		varchar(50),
+	priv_aim_screen_name	integer,
+	-- also the ICQ# (they have multi-user chat)
+	-- currently this is probably only a 32-bit integer but
+	-- let's give them 50 chars anyway
+	icq_number		varchar(50),
+	priv_icq_number		integer,
+	-- Which address should we mail to?
+	m_address		char(1) check (m_address is null or m_address in ('w','h')),
+	-- home address
+	ha_line1		varchar(80),
+	ha_line2		varchar(80),
+	ha_city			varchar(80),
+	ha_state		varchar(80),
+	ha_postal_code		varchar(80),
+	ha_country_code		char(2) references country_codes(iso),
+	priv_ha			integer,
+	-- work address
+	wa_line1		varchar(80),
+	wa_line2		varchar(80),
+	wa_city			varchar(80),
+	wa_state		varchar(80),
+	wa_postal_code		varchar(80),
+	wa_country_code		char(2) references country_codes(iso),
+	priv_wa			integer,
+	-- used by the intranet module
+        note			varchar(4000),
+        current_information	varchar(4000)
+);
+
+-- drop view users_contact_null;
+
+create view users_contact_null as 
+select 
+ ''::integer as user_id       
+,''::varchar as home_phone   
+,''::integer as priv_home_phone        
+,''::varchar as work_phone   
+,''::integer as priv_work_phone        
+,''::varchar as cell_phone   
+,''::integer as priv_cell_phone        
+,''::varchar as pager   
+,''::integer as priv_pager        
+,''::varchar as fax   
+,''::integer as priv_fax        
+,''::varchar as aim_screen_name    
+,''::integer as priv_aim_screen_name        
+,''::varchar as icq_number    
+,''::integer as priv_icq_number        
+,''::char as m_address        
+,''::varchar as ha_line1
+,''::varchar as ha_line2     
+,''::varchar as ha_city    
+,''::varchar as ha_state    
+,''::varchar as ha_postal_code    
+,''::char as ha_country_code        
+,''::integer as priv_ha        
+,''::varchar as wa_line1 
+,''::varchar as wa_line2  
+,''::varchar as wa_city    
+,''::varchar as wa_state    
+,''::varchar as wa_postal_code    
+,''::char as wa_country_code        
+,''::integer as priv_wa        
+,''::varchar as note  
+,''::varchar as current_information;  
+
+
+create function user_contact_summary (integer)
+returns varchar
+as '
+declare
+  contact_row		users_contact%ROWTYPE;
+  v_return		varchar(4000);
+begin
+  select * into contact_row from users_contact where user_id = $1;
+
+  IF NOT FOUND then return '''';
+  END IF;
+
+  IF contact_row.m_address = ''w'' THEN
+    v_return:=
+      case when contact_row.wa_line1 is null
+      then '''' else contact_row.wa_line1 end ||
+      '' '' ||
+      case when contact_row.wa_line2 is null
+      then '''' else contact_row.wa_line2 end ||
+      '' '' ||
+      case when contact_row.wa_city is null
+      then '''' else contact_row.wa_city end ||
+      '', '' ||
+      case when contact_row.wa_state is null 
+      then '''' else contact_row.wa_state end ||
+      case when contact_row.wa_postal_code is null
+      then '''' else contact_row.wa_postal_code end  ||
+      '' '' ||
+      cast(case when contact_row.wa_country_code is null
+           then ''''
+           else contact_row.wa_country_code end as varchar(2));
+  ELSE
+    v_return:=
+      case when contact_row.ha_line1 is null
+      then '''' else contact_row.ha_line1 end ||
+      '' '' ||
+      case when contact_row.ha_line2 is null
+      then '''' else contact_row.ha_line2 end ||
+      '' '' ||
+      case when contact_row.ha_city is null
+      then '''' else contact_row.ha_city end ||
+      '', '' ||
+      case when contact_row.ha_state is null
+      then '''' else contact_row.ha_state end ||
+      case when contact_row.ha_postal_code is null
+      then '''' else contact_row.ha_postal_code end ||
+      '' '' ||
+      cast (case when contact_row.ha_country_code is null
+            then ''''
+            else contact_row.ha_country_code end as varchar(2));
+  END IF; 
+
+  return v_return;
+end;
+' language 'plpgsql';
+
+-- a table for keeping track of a "commitment" requirement for
+-- users. This means that we can require that a user give a real
+-- address, a birthdate, etc... because we think that this user
+-- needs to commit more to the community.
+
+create table user_requirements (
+	user_id			integer primary key references users,
+	demographics		char(1) default 'f' check (demographics in ('t','f')),
+	contacts		char(1) default 'f' check (contacts in ('t','f'))
+);	
+
+-- a PL/SQL function to make life easier, and to abstract out a 
+-- bit the requirements of this data model
+create function user_fulfills_requirements_p(integer) returns char
+AS '
+DECLARE
+	requirements	user_requirements%ROWTYPE;
+	count_result	integer;
+begin
+	select count(*) INTO count_result from user_requirements where user_id= $1;
+	IF count_result=0
+	THEN RETURN ''t'';
+	END IF;
+
+	select * INTO requirements from user_requirements where user_id= $1;
+	
+	select count(*) INTO count_result from users_demographics where user_id= $1;
+
+	IF requirements.demographics=''t'' AND count_result=0 THEN
+		RETURN ''f'';
+	END IF;
+
+	select count(*) INTO count_result from users_contact where user_id= $1;
+
+	IF requirements.contacts=''t'' AND count_result=0 THEN
+		RETURN ''f'';
+	END IF;
+
+	RETURN ''t'';	
+end;
+' language 'plpgsql';
+
+-- we use these for categorizing content, registering user interest
+-- in particular areas, organizing archived Q&A threads
+-- we also may use this as a mailing list to keep users up
+-- to date with what goes on at the site
+
+create sequence category_id_sequence;
+
+create table categories (
+	category_id	integer not null primary key,
+	category	varchar(50) not null,
+	category_description    varchar(4000),
+	-- e.g., for a travel site, 'country', or 'activity' 
+	-- could also be 'language'
+	category_type	varchar(50),
+	-- language probably would weight higher than activity 
+	profiling_weight	float4 default 1 check(profiling_weight >= 0),
+	enabled_p	char(1) default 't' check(enabled_p in ('t','f')),
+	mailing_list_info	varchar(4000)
+);
+
+-- optional system to put categories in a hierarchy 
+-- (see /doc/user-profiling.html)
+
+-- we use a UNIQUE constraint instead of PRIMARY key 
+-- because we use rows with NULL parent_category_id to 
+-- signify the top-level categories
+
+create table category_hierarchy (
+   parent_category_id     integer references categories,
+   child_category_id      integer references categories,
+   unique (parent_category_id, child_category_id)
+);
+
+create sequence site_wide_cat_map_id_seq;
+
+-- this table can represent "item X is related to category Y" for any
+-- item in the ACS; see /doc/user-profiling.html for examples
+
+create table site_wide_category_map (
+             map_id                  integer primary key,
+	     category_id             integer not null references categories,
+	     -- We are mapping a category in the categories table
+	     -- to another row in the database.  Which table contains
+	     -- the row?
+             on_which_table          varchar(30) not null,
+	     -- What is the primary key of the item we are mapping to?
+	     -- With the bboard this is a varchar so we can't make this
+	     -- and integer
+             on_what_id              varchar(500) not null,
+	     mapping_date	     datetime not null,
+	     -- how strong is this relationship?
+	     -- (we can even map anti-relationships with negative numbers)
+	     mapping_weight          integer default 5 
+				     check(mapping_weight between 0 and 10),
+				     -- hack, changed -10 to 0.
+	     -- A short description of the item we are mapping
+	     -- this enables us to avoid joining with every table
+	     -- in the ACS when looking for the most relevant content 
+	     -- to a users' interests
+	     -- (maintain one_line_item_desc with triggers.)
+             one_line_item_desc      varchar(200) not null,
+	     mapping_comment         varchar(200),
+	     -- only map a category to an item once
+             unique(category_id, on_which_table, on_what_id)
+);
+
+create index swcm_which_table_what_id_idx on site_wide_category_map (on_which_table, on_what_id);
+
+-- a place to record which users care about what
+
+create table users_interests (
+	user_id		integer not null references users,
+	category_id	integer not null references categories,
+	-- 0 is same as NULL, -10 is "hate this kind of stuff" 
+	-- 5 is "said I liked it", 10 is "love this kind of stuff"
+	-- changed -10 to 0 again
+	interest_level	integer default 5 check(interest_level between 0 and 10),
+	interest_date	datetime,
+	unique(user_id, category_id)
+);
+
+-- PostgreSQL:  Outer Join Fix - Jamie Ross 1/1/2000
+-- this is a dummy table used to support null extensions for outerjoin workarounds with users_interests
+-- it provides null fields that can with union joins in 
+create table ui_null (
+	n_users integer,
+	category_id integer
+);
+-- create one record with null fields
+insert into ui_null
+	(n_users, category_id)
+	values
+	(0,'');
+-- End fix
+
+-- a place to record which items of content are related to which
+-- categories (this can be used in conjunction with any table
+-- system-wide)
+
+create sequence page_id_sequence;
+create table static_pages (
+	page_id		integer not null primary key,
+	url_stub	varchar(400) not null unique,
+	original_author	integer references users(user_id),
+	-- generally PAGE_TITLE will be whatever was inside HTML TITLE tag
+	page_title	varchar(4000),
+	-- the dreaded CLOB data type (bleah)
+	page_body	lztext,
+	draft_p		char(1) default 'f' check (draft_p in ('t','f')),
+	-- for a page that is no longer in the file system, but we 
+	-- don't actually delete it from the database because of 
+	-- integrity constraints
+	obsolete_p	char(1) default 'f' check (obsolete_p in ('t','f')),
+	-- force people to register before viewing?
+	members_only_p	char(1) default 'f' check (members_only_p in ('t','f')),
+	-- if we want to charge (or pay) readers for viewing this
+	price		float8,
+	-- for deviations from site-default copyright policy
+	copyright_info	varchar(4000),
+	-- whether or not this page accepts reader contributions
+	accept_comments_p	char(1) default 't' check (accept_comments_p in ('t','f')),
+	accept_links_p		char(1) default 't' check (accept_links_p in ('t','f')),
+	-- do we display comments on the same page?
+	inline_comments_p	char(1) default 't' check (inline_comments_p in ('t','f')),
+	inline_links_p	char(1) default 't' check (inline_links_p in ('t','f')),
+	-- include in site-wide index?
+	index_p		char(1) default 't' check (index_p in ('t','f')),
+	index_decision_made_by	varchar(30) default 'robot' check(index_decision_made_by in ('human', 'robot')),
+	-- for sites with fancy navigation, do we want this page to have a menu?
+	menu_p			char(1) default 't'  check (menu_p in ('t','f')),
+	-- if the menu has an "uplevel" link and it should
+	-- not go to the directory defaults, what the link should be
+	uplink			varchar(200),
+	-- filesize in bytes
+	file_size		integer,
+	-- determined by the unix file system
+	last_updated		datetime,
+	-- used to prevent minor changes from looking like new content
+	publish_date		datetime
+);
+
+-- if a page has been authored by one or more users, then 
+-- there are rows here (this serves for both credit and update
+-- permission)
+-- 
+-- also keep track of whether author wants to get email 
+-- notifications of new comments, links, etc.
+-- (this information will also be available in a summary Web page
+--  when author logs in)
+
+create table static_page_authors (
+	page_id		integer not null references static_pages,
+	user_id		integer not null references users,
+	notify_p	char(1) default 't' check (notify_p in ('t','f')),
+	unique(page_id,user_id)
+);
+
+
+-- patterns for exclusion from index of static pages
+-- these match either the URLs, page titles, or page_body
+-- (the last one is tricky because it is a CLOB and LIKE doesn't 
+--  work; let's not implement this for now :-( )
+
+-- all matching is done lowercased (e.g., the patterns should be
+-- in lower case)
+
+create sequence static_page_index_excl_seq;
+
+create table static_page_index_exclusion (
+	exclusion_pattern_id	integer primary key,
+	match_field		varchar(30) default 'url_stub' not null check(match_field in ('url_stub', 'page_title', 'page_body')),
+	like_or_regexp		varchar(30) default 'like' not null check(like_or_regexp in ('like', 'regexp')),
+	pattern			varchar(4000) not null,
+	pattern_comment		varchar(4000),
+	creation_user		integer not null references users,
+	creation_date		datetime default current_timestamp not null 
+);
+
+-- comment_type is generally one of the following:
+--   alternative_perspective
+--   private_message_to_page_authors 
+--   rating
+--   unanswered_question
+-- if an administrator had to delete a comment, deleted_p will be 't'
+
+
+create sequence comment_id_sequence;
+
+create table comments (
+	comment_id	integer  primary key,
+	page_id		integer not null references static_pages,
+	user_id		integer not null references users,
+	comment_type	varchar(30),
+	message		lztext,
+	html_p		char(1) check (html_p is null or html_p in ('t','f')),
+	-- null unless comment_type is 'rating'
+	rating		integer check (rating >= 0 and rating <= 10),
+	originating_ip	varchar(50),
+	posting_time	datetime,
+	deleted_p	char(1) default 'f' check (deleted_p in ('t','f')),
+	-- columns useful for attachments, column names
+	-- lifted from general_comments
+	-- this is where the actual content is stored
+	-- attachment		blob,
+	-- file name including extension but not path
+	client_file_name	varchar(500),
+	file_type		varchar(100),	-- this is a MIME type (e.g., image/jpeg)
+	file_extension		varchar(50), 	-- e.g., "jpg"
+	-- fields that only make sense if this is an image
+	caption			varchar(4000),
+	original_width		integer,
+	original_height		integer
+);
+
+create index comments_by_page_idx on comments(page_id);
+create index comments_by_user_idx on comments(user_id);
+
+create view comments_not_deleted 
+as 
+select * 
+from comments c
+where c.deleted_p is null
+or c.deleted_p = 'f';
+
+-- user-contributed links (a micro-Yahoo)
+
+
+create table links (
+	page_id		integer not null references static_pages,
+	user_id		integer not null references users,
+	url		varchar(300) not null,
+	link_title	varchar(100) not null,
+	link_description	varchar(4000),
+	-- contact if link is dead?
+	contact_p	char(1) default 't' check (contact_p in ('t','f')),
+	status		varchar(10) default 'live' check (status in ('live','coma','dead','removed')),
+	originating_ip	varchar(50),
+	posting_time	datetime,
+	-- last time this got checked 
+	checked_date	datetime,
+	unique(page_id,url)
+);
+
+--
+-- we store glob patterns (like REGEXP but simpler)
+-- of URLs that we don't want to see added
+--
+-- page_id = NULL means "applies to all pages on the site"
+--
+
+create table link_kill_patterns (
+	page_id		integer references static_pages,
+	-- who added the kill pattern
+	user_id		integer not null references users,
+	date_added	datetime,
+	glob_pattern	varchar(500) not null
+);
+
+--- which pages has a user read
+--- we'll do this index-only to save space and time
+--- **** good table to put in another tablespace
+---  (add "tablespace photonet_index" AFTER the organization directive;
+---   Oracle doesn't believe in commutivity)
+
+create table user_content_map (
+	user_id		integer not null references users,
+	page_id		integer not null references static_pages,
+	view_time	datetime not null,
+	primary key(user_id, page_id));
+
+
+-- referers (people who came in from external references)
+
+create table referer_log (
+	-- relative to the PageRoot, includes the leading /
+	local_url	varchar(250) not null,
+	-- full URL on the foreign server, including http://
+	foreign_url	varchar(250) not null,
+	entry_date	datetime not null,	-- we count referrals per day
+	click_count	integer default 0,
+	primary key ( local_url, foreign_url, entry_date)
+);
+
+-- the primary key constraint above will make it really fast to get to
+-- the one relevant row
+
+-- let's also try to make it fast for quick daily reports
+
+create index referer_log_date_idx on referer_log (entry_date);  -- **** tablespace photonet_index
+
+
+-- Tcl GLOB patterns that lump referrer headers together,
+-- particularly useful for search engines (i.e., we don't want
+-- every referral from AltaVista logged separately).
+
+create table referer_log_glob_patterns (
+	glob_pattern		varchar(250) primary key,
+	canonical_foreign_url	varchar(250) not null,
+	-- not NULL if this is here for a search engine and 
+	-- we're also interested in harvesting query strings
+	search_engine_name	varchar(30),
+	search_engine_regexp	varchar(200)
+);
+
+-- strings entered by users, either on our site-local search engine
+-- or at Internet-wide servers
+
+create table query_strings (
+	query_date		datetime not null,
+	query_string		varchar(300) not null,
+	-- if they came in from a public search engine and we 
+	-- picked it from the referer header
+	search_engine_name	varchar(30),
+	-- subsection of the site from which they were searching
+	subsection		varchar(100),
+	-- if we know who they are
+	user_id		integer references users,
+	-- not null if this was a local query
+	n_results	integer	
+);
+
+-- **** tablespace photonet_index
+create index query_strings_by_user on query_strings (user_id);
+
+create index query_strings_by_date on query_strings (query_date);
+
+create index query_strings_by_engine on query_strings (search_engine_name, query_date);
+
+-- stuff to manage email and make sure that we don't keep sending
+-- to guys with invalid addresses
+
+-- a bounce is event_type = 'bounce' and content NULL
+-- a bboard alert is event_type = 'alert' 
+
+-- this is actually a great candidate for an index-organized table
+
+create table email_log (
+	user_id		integer not null references users,
+	email_date	datetime not null,
+	event_type	varchar(100) not null,
+	content		varchar(4000)
+);
+
+-- **** tablespace photonet_index
+create index email_log_idx on email_log ( user_id, event_type );
+
+-- can't have local and foreign_urls too long or they won't be
+-- indexable in Oracle
+-- note that the local URL does NOT include the starting / 
+
+create table clickthrough_log (
+	local_url	varchar(400) not null,
+	foreign_url	varchar(300) not null,	-- full URL on the foreign server
+	entry_date	datetime,	-- we count referrals per day
+	click_count	integer default 0,
+	primary key (local_url, foreign_url, entry_date)
+);
+
+--- keep track of user sessions
+--- we keep the total in "session_count" and the number of repeaters
+--  (folks who had a last_visit cookie already set) in repeat_count
+--  entry-date is midnight on the day of interest, as with our
+--  referer and clickthrough stuff
+
+create table session_statistics (
+	session_count	integer default 0 not null,
+	repeat_count	integer default 0 not null,
+	entry_date	datetime not null
+);
+
+
+
+--- dynamic user groupings
+create sequence user_class_id_seq;
+
+create table user_classes (
+	user_class_id    integer primary key,
+	name		 varchar(200) unique,
+	description      varchar(4000),
+	-- this query was written by our tcl procs, we'll
+	-- have an autogenerated description describing what it means.
+	sql_description   varchar(1000),
+	-- The sql that will follow the select clause.
+	-- for example, sql_post_select_list for 'select count(user_id) from
+	-- users' would be 'from users'.
+	-- We record this fragment instead of the complete sql
+	-- query so we can select a count of desired columns as desired.
+	sql_post_select    varchar(4000)	
+);
+
+
+-- user_user_bozo_filter table contains information to implement a personalized "bozo filter"
+-- any user ( origin_user_id) can restrain any emails from some other user ( target_user_id )
+-- this is not group specific
+
+
+create table user_user_bozo_filter (
+	origin_user_id	integer references users not null,
+	target_user_id	integer references users not null,
+	primary key (origin_user_id, target_user_id)
+);
+
+
+-- Postgres stuff
+
+create function user_first_names(integer)
+returns varchar
+as '
+DECLARE
+	v_user_id alias for $1;
+BEGIN
+	return first_names from users where user_id = v_user_id;
+END;
+' language 'plpgsql';
+
+create function user_last_name(integer)
+returns varchar
+as '
+DECLARE
+	v_user_id alias for $1;
+BEGIN
+	return last_name from users where user_id = v_user_id;
+END;
+' language 'plpgsql';
+
+create function user_full_name(integer)
+returns varchar
+as '
+DECLARE
+	v_user_id alias for $1;
+BEGIN
+	return first_names || '' '' || last_name from users where user_id = v_user_id;
+END;
+' language 'plpgsql';
+
+create function user_email(integer) 
+returns varchar as '
+DECLARE
+	v_user_id alias for $1; 
+BEGIN 
+      return email from users where user_id = v_user_id; 
+END;
+' language 'plpgsql';
+
+
+create function category_hierarchy_level(integer, integer, integer)
+returns integer as '
+DECLARE
+	v_category_id alias for $1;
+	v_start_id alias for $2;
+	v_level alias for $3;
+	v_parent_id integer;
+BEGIN
+	IF v_category_id = v_start_id
+	then return v_level;
+	end if;
+
+	select parent_category_id into v_parent_id from category_hierarchy where child_category_id= v_category_id;
+
+	if v_parent_id is null
+	then 
+	     if v_start_id= 0
+	     then return v_level+1;
+	     else return null;
+	     end if;
+	end if;
+
+	return category_hierarchy_level(v_parent_id, v_start_id, 1+v_level);
+END;
+' language 'plpgsql';
+
+create function category_hierarchy_sortkey(integer, integer, char)
+returns char as '
+DECLARE
+	v_category_id alias for $1;
+	v_start_id alias for $2;
+	v_sortkey alias for $3;
+	v_parent_id integer;
+BEGIN
+	IF v_category_id = v_start_id
+	then return (v_category_id::char || v_sortkey);
+	end if;
+
+	select parent_category_id into v_parent_id from category_hierarchy where child_category_id= v_category_id;
+	
+	if v_parent_id is null
+	then return null;
+	end if;
+
+	return category_hierarchy_sortkey(v_parent_id, v_start_id, ''/'' || v_category_id::char || v_sortkey);
+END;
+' language 'plpgsql';
+
+
+create function category_hierarchy_reverse_sortkey(integer, integer, char)
+returns char as '
+DECLARE
+	v_category_id alias for $1;
+	v_start_id alias for $2;
+	v_sortkey alias for $3;
+	v_child_id integer;
+BEGIN
+	IF v_category_id = v_start_id
+	then return (v_category_id::char || v_sortkey);
+	end if;
+
+	select child_category_id into v_child_id from category_hierarchy where parent_category_id= v_category_id;
+	
+	if v_child_id is null
+	then return null;
+	end if;
+
+	return category_hierarchy_reverse_sortkey(v_child_id, v_start_id, ''/'' || v_category_id::char || v_sortkey);
+END;
+' language 'plpgsql';
+
+create function count_users_interested_in_category(integer)
+returns integer as '
+DECLARE
+  v_category_id alias for $1;
+BEGIN
+  RETURN count(*) FROM users_interests WHERE category_id = v_category_id;
+END;
+' language 'plpgsql';
+
Index: web/openacs/www/doc/sql/contact-manager.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/contact-manager.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/contact-manager.sql	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,69 @@
+--
+-- contact-manager.sql
+--
+-- defined by philg@mit.edu on March 31, 1999
+--
+-- a generic, albeit somewhat wimpy, contact manager 
+--
+
+-- we use "contact_" as a table prefix so as not to get confused
+-- with any content management systems whose tables would be prefixed
+-- "cm_"
+
+-- create the user_group for the contact manager 
+
+create sequence contact_event_id_sequence;
+
+-- this table points into some other table in the system but we 
+-- can't say which one in advance
+
+create table contact_events (
+	contact_event_id	integer primary key,
+	other_table_key		varchar(700) not null,
+	event_date		datetime not null,
+	user_id			integer not null references users,
+	contactee_name		varchar(200),
+	contactee_email		varchar(100),
+	note			varchar(4000)
+);
+
+-- we need a table for more structured info (acquired if the user 
+-- presses particular buttons in the /contact-manager/ directory)
+
+-- event_type could be 'not_worth_contacting' or 'success'
+
+create table contact_structured_events (
+	contact_event_id	integer primary key,
+	other_table_key		varchar(700) not null,
+	user_id			integer not null references users,
+	event_date		datetime not null,
+	event_type		varchar(100) not null
+);
+
+-- build an Intermedia index on this table using a USER_DATASTORE (PL/SQL proc
+-- that will combine the contactee_name and _email with the note); this works
+-- in Oracle 8.1.5 or newer -- **** it does not work in regular Oracle 8.0 ****
+
+-- note that we don't put this into the site-wide index because it is so separate; 
+-- if you were a sales person searching for a contact name, you wouldn't want to
+-- wade through public content.  Nor would people searching public content ever
+-- be sent here; this contact information simply isn't part of the site content!
+
+-- **** this procedure must be owned by CTXSYS! *****
+
+-- conn ctxsys/ctxsyspassword
+-- create or replace procedure contact_events_index_proc 
+-- ( nextrow IN ROWID, nextclob IN OUT CLOB )
+-- IS
+--  event_record    contact_events%ROWTYPE;
+-- BEGIN
+--  select * into event_record from contact_events where rowid = nextrow;
+--  dbms_lob.writeappend(v_nextclob, length(event_record.contactee_name), event_record.contactee_name);
+-- END contact_events_index_proc;
+-- /
+-- show errors 
+
+-- **** then you have to make it excecutable by the regular Web server user! *****
+
+-- conn realuser/realuserpassword
+-- grant execute on contact_events_index_proc to realuser;
Index: web/openacs/www/doc/sql/content-sections.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/content-sections.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/content-sections.sql	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,246 @@
+-- File:     /doc/sql/content-sections.sql
+-- Date:     01/08/2000	
+-- Contact:  tarik@arsdigita.com
+-- Purpose:  content sections and content files tables
+
+-- changes for new content sections table
+-- note that we have changed the primary key in the content_sections table
+-- so we will have to move data to new temporary table
+-- let's first create content_sections table, then insert data into it 
+-- from the old content_sections table, then drop the old content sections 
+-- table and finally rename content_sections table back to content_sections
+
+create sequence content_section_id_sequence;
+create table content_sections (
+        section_id              integer primary key,
+        -- if scope=public, this is the content sections for the whole system
+        -- if scope=group this is the content sections for particular group
+        -- is scope=user this is the content sections for particular user
+        scope                   varchar(20) not null,
+	-- if section_type=system, this section corresponds to one of the system sections
+	-- such as news, bboard, ...
+	-- if section_type=custom, this section is custom section
+	-- custom sections serve like url directories. so if group administrator of group travel 
+	-- at photo.net defines custom section sweeden (e.g. photo.net/travel/sweeden), he will be 
+	-- able to then to upload files for this section (see content_files table) in order to display
+	-- the file photo.net/groups/travel/sweeden/stockholm.html
+	-- if section_type=static, this section is static section
+	-- static sections serve as html pages and address of html page is specified in section_url_stub
+	-- if you have file arsdigita.html in your carrers directory then section_url_stub should be
+	-- /carrers/arsdigita.html  
+	-- if section_type=admin, this section is system section but does not have associated public pages
+	-- it only has administration pages.
+	section_type                    varchar(20) not null,
+	-- does user have to be registered in order to access this page
+	requires_registration_p	char(1) default 'f' check(requires_registration_p in ('t','f')),
+	-- if visibility=public this content section is viewable by everybody
+	-- if visibility=private this content section is viewable be a user only if scope=user
+	-- or by group members only if scope=group
+	visibility		varchar(20) not null check(visibility in ('private', 'public')),
+        user_id                 integer references users,
+        group_id                integer references user_groups,
+        section_key             varchar(30) not null,
+	-- this is used only for system sections
+	-- each system sections is associated with an acs module
+	module_key		varchar(30) references acs_modules,
+        section_url_stub        varchar(200),
+        section_pretty_name     varchar(200) not null,
+        -- if we print lists of sections, where does this go?
+        -- two sections with same sort_key will sort 
+        -- by upper(section_pretty_name)
+        sort_key                integer,
+        enabled_p               char(1) default 't' check(enabled_p in ('t','f')),
+        intro_blurb		varchar(4000),
+        help_blurb      	varchar(4000),
+        index_page_enabled_p    char(1) default 'f' check (index_page_enabled_p in ('t','f')),
+        -- html content for customizing index page (this is used only for content sections of section_type custom)
+        body                    lztext,
+        html_p                  char(1) default 'f' check(html_p in ('t','f')),
+
+	-- add check to make sure section_url_stub is always provided
+	-- for the static sections also, system and admin sections must
+	-- have associated acs module with them
+	-- Postgres 6.5 not yet ready for this !! (BMA)
+
+	-- add checks for appropriate uniqueness
+	unique(scope, section_key, user_id, group_id)
+);
+
+-- alter table content_sections add (
+--       check ((scope='group' and group_id is not null and user_id is null) or
+--       (scope='user' and user_id is not null and group_id is null) or
+--       (scope='public' and user_id is null and group_id is null))
+-- );
+
+--alter table content_sections add (
+--      section_type                    varchar(20) not null      
+--      check ((section_type='static' and section_url_stub is not null) or
+--      ((section_type='system' or section_type='admin') and
+--      module_key is not null) or 
+--      (section_type='custom'))
+--);
+
+-- returns t if section exists and is enabled
+create function enabled_section_p (integer)
+returns varchar as '
+DECLARE
+	v_section_id alias for $1;
+	v_enabled_p char(1);
+BEGIN
+       select enabled_p into v_enabled_p 
+         from content_sections
+         where section_id = v_section_id;
+
+      if v_enabled_p is null then
+         return ''f'';
+       else 
+         return v_enabled_p;
+       end if;
+END;' language 'plpgsql';
+
+create function content_section_id_to_key(integer)
+returns varchar as '
+DECLARE
+	v_section_id alias for $1;
+	v_section_key content_sections.section_key%TYPE;
+BEGIN
+	select section_key into v_section_key
+	from content_sections
+	where section_id=v_section_id;
+
+	return v_section_key;
+END;
+' language 'plpgsql';
+
+
+-- versioning, indexing, categorization of static content
+
+-- URL_STUB is relative to document root, includes leading /
+-- and trailing ".html"
+
+-- for collaboration, the software assumes the possible existence
+-- of a file ending in ".new.html" (presented only to authors)
+-- this is not handled in the RDBMS
+
+-- draft pages end in ".draft.html" in the Unix file system; they are
+-- only made available to users who show up in the static_page_authors
+-- table; the URL_STUB during development does not include the ".draft"
+-- but is instead the final location where the file will ultimately reside
+
+-- we could key by url_stub but (1) that makes reorganizing
+-- the static pages on the server even harder, (2) that bloats
+-- out the referring tables
+
+-- we keep an ORIGINAL_AUTHOR (redundant with static_page_authors)
+-- when the page was originally created by one particular user
+-- will be NULL if we don't have the author in our system
+
+create sequence content_file_id_sequence;
+
+create table content_files (
+	content_file_id 	integer primary key,
+	section_id 		integer references content_sections,
+	-- this will be part of url; should be a-zA-Z and underscore
+	file_name		varchar(30) not null,
+        -- this is a MIME type (e.g., text/html, image/jpeg)	
+        file_type               varchar(100) not null,
+        file_extension          varchar(50),    -- e.g., "jpg"
+	-- if file is text or html we need page_pretty_name, body and html_p
+	page_pretty_name        varchar(200),
+	body			lztext,
+	html_p			char(1) default 'f' check(html_p in ('t','f')),
+	-- if the file is attachment we need use binary_data blob( e.g. photo, image)
+	-- binary_data             blob
+    unique(section_id, file_name)
+);
+
+
+create sequence section_link_id_sequence;
+create table content_section_links(
+	section_link_id integer primary key,
+	from_section_id integer references content_sections,
+	to_section_id integer references content_sections,
+	constraint content_section_links_unique unique(from_section_id, to_section_id)
+);
+
+-- this is the helper function for function uniq_group_module_section_key below
+
+-- DRB sez: don't use cursors in functions, just select stuff directly!
+-- PL/pgSQL doesn't know about cursors, and you don't need them.
+
+create function uniq_group_module_section_key2 (varchar, integer, integer) 
+returns varchar as '
+DECLARE
+	v_module_key alias for $1;
+	v_group_id alias for $2;
+	v_identifier alias for $3;
+    v_new_section_key content_sections.section_key%TYPE;
+    v_dummy content_sections.section_key%TYPE;
+BEGIN
+
+	if v_identifier = 0
+	then v_new_section_key := v_module_key;
+	else v_new_section_key := v_module_key || v_identifier;
+	end if;
+
+	select section_key into v_dummy from content_sections
+    	where scope=''group'' and group_id= v_group_id and
+			section_key = v_new_section_key;
+
+	if not found then
+        return v_new_section_key;
+    else	
+	    return uniq_group_module_section_key2(v_module_key, v_group_id, v_identifier+1);
+	end if;
+END;
+' language 'plpgsql';
+
+-- this function generates unique section_key
+-- v_module_key is the proposed section_key, this function will keep adding numbers to it
+-- until it makes it unique (e.g. if sections news and news1 already exist for this groups, 
+-- and module_key is news this function will return news2)
+create function uniq_group_module_section_key (varchar, integer)
+returns varchar as '
+DECLARE
+	v_module_key alias for $1;
+	v_group_id alias for $2;
+BEGIN
+	return uniq_group_module_section_key2(v_module_key, v_group_id, 0);
+END;
+' language 'plpgsql';
+
+-- this function returns t if a section module identified by module_key
+-- is associated with the group identified by the group_id
+create function group_section_module_exists_p(varchar, integer)
+returns char as '
+DECLARE
+	v_module_key alias for $1;
+	v_group_id alias for $2;
+	v_dummy integer;
+
+	cursor c1 is select 1
+	from content_sections
+	where scope=''group'' 
+	and group_id=v_group_id
+	and module_key=v_module_key;
+BEGIN
+	OPEN c1;
+	FETCH c1 into v_dummy;
+
+	if c1%NOTFOUND then
+	    return ''f'';
+        else	
+	    return ''t'';
+	end if;
+END;
+' language 'plpgsql';
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/doc/sql/content-tagging.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/content-tagging.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/content-tagging.sql	17 Apr 2001 14:05:11 -0000	1.1
@@ -0,0 +1,31 @@
+--
+-- content-tagging.sql 
+--
+-- by philg@mit.edu on April 26, 1999
+--
+
+-- if upgrading from an older version of the ACS
+-- alter table users_preferences add content_mask integer;
+
+create table content_tags (
+    word               varchar(100) primary key,
+    tag		       integer not null,
+    creation_user      integer not null references users,
+    creation_date      datetime
+);
+
+-- for cases when users are posting naughty stuff 
+
+create table naughty_events (
+    table_name            varchar(30),
+    the_key               varchar(700),
+    offensive_text        text,
+    creation_user         integer not null references users,
+    creation_date         datetime,
+    reviewed_p            char(1) default 'f' check (reviewed_p in ('t','f'))
+);
+
+create table naughty_table_to_url_map (
+    table_name      varchar(30) primary key,
+    url_stub        varchar(200) not null
+);      
Index: web/openacs/www/doc/sql/contest.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/contest.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/contest.sql	17 Apr 2001 14:05:12 -0000	1.1
@@ -0,0 +1,59 @@
+--
+-- contest system data model
+--
+-- created  6/29/97 by Philip Greenspun (philg@mit.edu)
+-- modified 1/18/98 by Cotton Seed (cottons@arsdigita.com)
+-- modified 11/26/98 by Philip Greenspun to integrate
+-- with community data model
+-- modified 3/10/00 by Mark Dalrymple (markd@arsdigita.com) to
+-- use integer primary keys instead of characters
+
+create sequence contest_domain_id_sequence;
+
+create table contest_domains (
+	domain_id		integer not null primary key,
+	domain			varchar(21) not null unique,
+	-- the unique constraint creates an index for us
+	entrants_table_name	varchar(30),
+	pretty_name		varchar(100) not null,
+	-- where the contest starts
+	home_url	varchar(200),
+	-- arbitrary HTML text that goes at the top of 
+	-- the auto-generated entry form
+	blather		varchar(4000),
+	-- where to send users after they enter
+	-- (if blank, we use a generated form)
+	post_entry_url	varchar(200),
+	maintainer	integer not null references users(user_id),
+	notify_of_additions_p	char(1) default 'f' check (notify_of_additions_p in ('t', 'f')),  -- send email when a person enters
+	us_only_p		char(1) default 'f' check (us_only_p in ('t', 'f')),
+	start_date		datetime,	-- these are optional
+	end_date		datetime
+);
+
+
+
+create table contest_extra_columns (
+	domain_id		integer not null references contest_domains,
+	column_pretty_name	varchar(30),
+	column_actual_name	varchar(200) not null,
+	column_type		varchar(200) not null,	-- things like 'boolean' or 'text'
+	column_extra_sql	varchar(200)	-- things like 'not null' or 'default 5'
+);
+
+
+--
+-- every contest will be created with a table named
+-- contest_entrants_$domain ; this may have lots of extra columns 
+-- 
+-- here's what a default table might look like
+-- 
+-- create table contest_entrants_fpx_of_month (
+-- 	-- we don't care how many times they enter;
+-- 	-- we query for "distinct" eventually
+-- 	entry_date	datetime,
+-- 	user_id		not null references users,
+--      answer		varchar(4000)
+-- );
+--
+
Index: web/openacs/www/doc/sql/crm.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/crm.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/crm.sql	17 Apr 2001 14:05:12 -0000	1.1
@@ -0,0 +1,49 @@
+-- Customer Relationship Manager
+-- jsc@arsdigita.com, Sept 24, 1999
+
+-- PORTED to postgres by james shannon (jshannon@webgalaxy.com)
+
+
+-- Reference table for available states.
+create table crm_states (
+	state_name	varchar(50) not null primary key,
+	description	varchar(1000) not null, -- for UI
+	initial_state_p	char(1) default 'f' not null check (initial_state_p in ('t','f'))
+);
+
+-- Defines allowable transitions and a bit of SQL which can trigger it.
+create table crm_state_transitions (
+	state_name	varchar(50) not null references crm_states,
+	next_state	varchar(50) not null references crm_states,
+	triggering_order	integer not null,
+	-- a SQL fragment which will get called as:
+	-- update users set crm_state = <next_state>, crm_state_entered_date = sysdate where crm_state = <state_name> and (<transition_condition>)
+	transition_condition	varchar(500) not null,
+	primary key (state_name, next_state)
+);
+
+-- Some helper functions
+create function activity_since (INTEGER, DATETIME)
+returns INTEGER
+as '
+declare
+  v_user_id alias for $1;
+  since alias for $2;
+  n_posts	INTEGER;
+  n_comments	INTEGER;
+begin
+  select count(*) into n_posts from bboard where user_id = v_user_id and posting_time::date > since::date;
+  select count(*) into n_comments from comments where user_id = v_user_id and posting_time::date > since::date;
+  return n_posts + n_comments;
+end;
+' language 'plpgsql';
+
+create function crm_state_count_users(varchar)
+returns integer
+as '
+DECLARE
+	v_state_name alias for $1;
+BEGIN
+	return count(*) from users where crm_state= v_state_name;
+END;
+' language 'plpgsql';
Index: web/openacs/www/doc/sql/curriculum.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/curriculum.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/curriculum.sql	17 Apr 2001 14:05:12 -0000	1.1
@@ -0,0 +1,46 @@
+--
+-- curriculum.sql
+--
+-- created by philg@mit.edu on September 25, 1999
+--
+-- supports the /doc/curriculum.html system that enables publisher
+-- to say "I want novice users to see the following N things over
+-- their months or years of casual surfing"
+--
+-- ported to Postgres by BMA (ben@adida.net) and DRB
+
+create sequence curriculum_element_id_sequence;
+
+create table curriculum (
+	curriculum_element_id	integer primary key,
+	-- 0 is the first element of the course, 8 would be the 9th
+	element_index		integer,
+	url			varchar(200) not null,
+	very_very_short_name	varchar(30) not null,
+	one_line_description	varchar(200) not null,
+	full_description	varchar(4000)
+);
+
+-- what has a particular user seen
+
+create table user_curriculum_map (
+	user_id			integer not null references users,
+	curriculum_element_id	integer not null references curriculum,
+	completion_date		datetime default current_timestamp not null,
+	primary key (user_id, curriculum_element_id)
+);
+
+
+-- Postgres stuff
+
+create function curriculum_users_n_elements_completed(integer)
+returns integer
+as '
+DECLARE
+	v_user_id alias for $1;
+BEGIN
+	return count(*) from curriculum, user_curriculum_map
+	where curriculum.curriculum_element_id= user_curriculum_map.curriculum_element_id
+	and user_id= v_user_id;
+END;
+' language 'plpgsql';
\ No newline at end of file
Index: web/openacs/www/doc/sql/custom.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/custom.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/custom.sql	17 Apr 2001 14:05:12 -0000	1.1
@@ -0,0 +1,2 @@
+alter table bboard_topics add group_id references user_groups;
+alter table im_projects add ticket_project_id 	    references ticket_projects;
Index: web/openacs/www/doc/sql/cybercash-stub.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/cybercash-stub.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/cybercash-stub.sql	17 Apr 2001 14:05:12 -0000	1.1
@@ -0,0 +1,18 @@
+
+--
+-- A Cybercash stub
+--
+-- written by Ben Adida (ben@adida.net)
+
+create table cybercash_stub_transactions (
+       order_id				 varchar(100) not null primary key,
+       card_number			 varchar(20) not null,
+       card_exp				 varchar(10) not null,
+       currency				 varchar(5),
+       amount_auth			 numeric,
+       amount_mark			 numeric,
+       amount_refund			 numeric,  
+       postauth_p			 char(1) default 'f' not null check (postauth_p in ('t','f')),
+       return_p				 char(1) default 'f' not null check (return_p in ('t','f')),
+       void_p				 char(1) default 'f' not null check (void_p in ('t','f'))
+);
\ No newline at end of file
Index: web/openacs/www/doc/sql/db-logging.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/db-logging.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/db-logging.sql	17 Apr 2001 14:05:12 -0000	1.1
@@ -0,0 +1,35 @@
+--
+-- /www/doc/sql/db-logging.sql
+--
+-- Contains a PL/SQL procedure (ad_db_log) that provides a simple
+-- way to write out logging info from within PL/SQL, without
+-- having to use the DBMS_OUTPUT package (which is only useful
+-- in SQL*Plus anyway). It is based on AOLserver's ns_log API
+--
+-- Author: michael@arsdigita.com, 2000-02-17
+--
+-- db-logging.sql,v 3.1 2000/03/11 09:26:37 michael Exp
+--
+
+create table ad_db_log_messages (
+	severity	varchar(7) not null check (severity in 
+			 ('notice', 'warning', 'error', 'fatal',
+			  'bug', 'debug')),
+	message		varchar(4000) not null,
+	creation_date	date default sysdate not null
+);
+
+create or replace procedure ad_db_log (
+ v_severity in ad_db_log_messages.severity%TYPE,
+ v_message in ad_db_log_messages.message%TYPE
+)
+as
+pragma autonomous_transaction;
+begin
+ insert into ad_db_log_messages(severity, message)
+ values(v_severity, v_message);
+
+ commit;
+end ad_db_log;
+/
+show errors
Index: web/openacs/www/doc/sql/display-sql.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/display-sql.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/display-sql.tcl	17 Apr 2001 14:05:12 -0000	1.1
@@ -0,0 +1,29 @@
+# display-sql.tcl,v 3.0 2000/02/06 03:36:57 ron Exp
+# display-sql.tcl
+#
+# by philg on 12/19/98
+# 
+# enables user to see a .sql file without encountering the 
+# AOLserver's db module magic (offering to load the SQL into a database) 
+#
+# patched by philg at Jeff Banks's request on 12/5/99
+# to close the security hole whereby a client adds extra form
+# vars
+# 
+
+set_form_variables
+
+# url (full relative path)
+
+# this is normally a password-protected page, but to be safe let's
+# check the incoming URL for ".." to make sure that someone isn't 
+# doing 
+# https://photo.net/doc/sql/display-sql.tcl?url=/../../../../etc/passwd
+# for example
+
+if { [string match "*..*" $url] } {
+    ad_return_error "Can't back up beyond the pageroot" "You can't use display-sql.tcl to look at files underneath the pageroot."
+    return
+} 
+
+ns_returnfile 200 text/plain "[ns_info pageroot]$url"
Index: web/openacs/www/doc/sql/display.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/display.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/display.sql	17 Apr 2001 14:05:12 -0000	1.1
@@ -0,0 +1,105 @@
+-- File:     /doc/sql/display.sql
+-- Date:     12/26/1999
+-- Contact:  tarik@arsdigita.com
+-- Purpose:  data model for the display module
+--           this module supports cascaded style sheets and logos
+
+-- notice that these two separate data models will be merged into 
+-- one in the next release of the acs (per jeff davis data model
+
+-- Ported to Postgres by Ben Adida (ben@mit.edu)
+
+-- using this table makes writing user friendly css forms possible
+-- it limits how much you can do with css though, but it should
+-- suffice for most practical purposes
+create sequence css_simple_id_sequence;
+create table css_simple (
+        css_id  		  integer primary key,
+        -- if scope=public, this is the css for the whole system
+        -- if scope=group, this is the css for a particular group
+        -- is scope=user this is the css for particular user
+        scope   	          varchar(20) not null,
+        user_id			  integer references users,
+        group_id		  integer references user_groups,
+	css_bgcolor		  varchar(40),
+	css_textcolor		  varchar(40),
+	css_unvisited_link	  varchar(40),
+	css_visited_link	  varchar(40),
+	css_link_text_decoration  varchar(40),
+	css_font_type		  varchar(40),
+--	unique(scope, user_id, group_id)
+-- DRB: put these back in for PG V7.0 and remove previous line.
+	unique(scope, user_id, group_id),
+	check ((scope='group' and group_id is not null and user_id is null) or
+      (scope='user' and user_id is not null and group_id is null) or
+        (scope='public'))
+);
+
+--Ben I (DRB) took this out since you said it was failing in 6.5.
+--Since 7.0 won't have alter table add check, either, and since
+--uncommenting out the check within the table def works, we can
+--probably just delete this:
+
+--alter table css_simple add (
+--	check ((scope='group' and group_id is not null and user_id is null) or
+--     (scope='user' and user_id is not null and group_id is null) or
+--        (scope='public'))
+--);
+
+-- if you need full control of how your css look like you should use 
+-- css_complete_version table which is capable of storing any css
+create sequence css_complete_id_sequence;
+create table css_complete (
+        css_id integer primary key,
+        -- if scope=public, this is the css for the whole system
+        -- if scope=group, this is the css for a particular group
+        -- is scope=user this is the css for particular user
+        scope           varchar(20) not null,
+        user_id		integer references users,
+        group_id	integer references user_groups,
+	-- e.g. A, H1, P, P.intro
+	selector varchar(60) not null,
+	-- e.g. color, bgcolor, font-family
+        property varchar(40) not null,
+	-- e.g. "Times Roman", "Verdana". notice that value can be rather
+	-- big (for example when specifying font-families)
+        value varchar(400) not null,
+	-- selector and property must be unique for the appropriate scope
+--	unique (scope, group_id, user_id, selector, property)
+	check ((scope='group' and group_id is not null and user_id is null) or
+        (scope='user' and user_id is not null and group_id is null) or
+        (scope='public'))
+);
+
+--DRB: see above for why this needs to go into the table.
+--alter table css_complete add (
+--	check ((scope='group' and group_id is not null and user_id is null) or
+--        (scope='user' and user_id is not null and group_id is null) or
+--        (scope='public'))
+--);
+
+-- this table stores the log that can be displayed on every page
+create sequence page_logos_id_sequence;
+create table page_logos (
+	logo_id 		integer primary key,
+       	-- if scope=public, this is the system-wide logo
+        -- if scope=group, this is the logo for a particular group
+        -- is scope=user this is the logo for a particular user
+        scope           	varchar(20) not null,
+        user_id			integer references users,
+        group_id		integer references user_groups,
+	logo_enabled_p		char(1) default 'f' check(logo_enabled_p in ('t', 'f')),
+	logo_file_type          varchar(100) not null,
+        logo_file_extension     varchar(50) not null,    -- e.g., "jpg"
+	-- logo			blob not null	
+	-- PG hack. Don rocks. (BMA)
+	lob			integer references lobs,
+	check ((scope='group' and group_id is not null and user_id is null) or
+        (scope='user' and user_id is not null and group_id is null) or
+        (scope='public')),
+	unique(scope, user_id, group_id)
+);
+
+create trigger display_versions_trigger before delete or update or insert
+on page_logos for each row execute procedure on_lob_ref();
+
Index: web/openacs/www/doc/sql/download.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/download.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/download.sql	17 Apr 2001 14:05:12 -0000	1.1
@@ -0,0 +1,206 @@
+--
+-- download.sql
+-- 
+-- created by philg@mit.edu on 12/28/99
+-- augmented by ahmeds@mit.edu
+
+-- supports a system for keeping track of what .tar files or whatever
+-- are available to which users and who has downloaded what
+--
+-- e.g., we use this at ArsDigita to keep track of who has downloaded
+-- our open-source toolkit (so that we can later spam them with 
+-- upgrade notifications)
+-- 
+-- ported to Postgres by Ben Adida (ben@mit.edu).
+
+create sequence download_id_sequence;
+
+create table downloads (
+	download_id		integer primary key,
+	-- if scope=public, this is a download for the whole system
+        -- if scope=group, this is a download for/from a subcommunity
+        scope           varchar(20) not null,
+	-- will be NULL if scope=public 
+ 	group_id	integer references user_groups on delete cascade,
+	-- e.g., "Bloatware 2000"
+	download_name	varchar(100) not null,
+	directory_name	varchar(100) not null,
+	description		varchar(4000),
+	-- is the description in HTML or plain text (the default)
+	html_p			char(1) default 'f' check(html_p in ('t','f')),
+	creation_date		datetime default current_timestamp not null,
+	creation_user		integer not null references users(user_id),
+	creation_ip_address	varchar(50) not null,
+        -- state should be consistent
+	constraint download_scope_check check ((scope='group' and group_id is not null) 
+                                               or (scope='public'))
+);
+
+create index download_group_idx on downloads ( group_id );
+
+create sequence download_version_id_sequence;
+
+create table download_versions (
+	version_id	        integer primary key,
+	download_id	        integer not null references downloads on delete cascade,
+	-- when this can go live before the public
+	release_date	        datetime not null,
+	pseudo_filename	        varchar(100) not null,
+	-- might be the same for a series of .tar files, we'll serve
+	-- the one with the largest version_id
+	version                 varchar(4000),
+	version_description     varchar(4000),
+	-- is the description in HTML or plain text (the default)
+	version_html_p          char(1) default 'f' check(version_html_p in ('t','f')),
+	status		        varchar(30) check (status in ('promote', 'offer_if_asked', 'removed')),
+	creation_date		datetime default current_timestamp not null ,
+	creation_user		integer references users on delete set null,
+  	creation_ip_address	varchar(50) not null
+  );
+  
+  create sequence download_rule_id_sequence start 1;
+  
+  create table download_rules (
+  	rule_id		integer primary key,
+  	-- one of the following will be not null
+	version_id	integer references download_versions on delete cascade,
+	download_id	integer references downloads on delete cascade,
+	visibility	varchar(30) check (visibility in ('all', 'registered_users', 'purchasers', 'group_members', 'previous_purchasers')),
+  	-- price to purchase or upgrade, typically NULL
+  	price		numeric,
+  	-- currency code to feed to CyberCash or other credit card system
+	currency	char(3) default 'USD' references currency_codes ,
+	constraint download_version_null_check check ( download_id is not null or version_id is not null)
+  );
+  
+  -- PL/pgSQL proc
+  -- returns 't' if a user can download, 'f' if not 
+  -- if supplied user_id is NULL, this is an unregistered user and we 
+  -- look for rules accordingly
+
+  -- DRB: this probably needs work as I'm hackin', not testin'
+  
+create function download_authorized_p (integer, integer) returns varchar as '
+declare
+	v_version_id alias for $1;
+	v_user_id alias for $2;
+	v_visibility download_rules.visibility%TYPE;
+	v_group_id downloads.group_id%TYPE;
+	v_return_value varchar(30);
+begin
+	select visibility into v_visibility
+	from download_rules
+	where version_id = v_version_id;
+	
+	if v_visibility = ''all'' 
+	then	
+		return ''authorized'';
+	else if v_visibility = ''group_members'' then	
+
+		select group_id into v_group_id
+		from downloads d, download_versions dv
+		where dv.version_id = v_version_id
+		and dv.download_id = d.download_id;
+
+		select case when count(*) = 0 then ''not_authorized'' else ''authorized'' end into v_return_value
+		from user_group_map where user_id = v_user_id 
+		and group_id = v_group_id;
+
+		return v_return_value;		
+	else
+		select case when count(*) = 0 then ''reg_required'' else ''authorized'' end into v_return_value
+		from users where user_id = v_user_id;
+		
+		return v_return_value;
+	end if; 
+	end if;
+  
+END;' language 'plpgsql';
+  
+  -- history 
+  
+  create sequence download_log_id_sequence start 1;
+  
+create table download_log (
+	log_id		integer primary key,
+	version_id	integer not null references download_versions on delete cascade,
+	-- user_id should reference users, but that interferes with
+	-- downloadlog_user_delete_tr below.
+	user_id		integer references users on delete set null,
+	entry_date	datetime not null,
+	ip_address	varchar(50) not null,
+	-- keeps track of why people downloaded this
+	download_reasons varchar(4000)
+);
+  
+create index download_log_version_idx on download_log ( version_id );
+
+-- DRB: only needed for PG 6.5.  If you put these back and get rid
+-- of the "on delete cascades" above, please leave the cascade defs
+-- commented out but left in the source so we can do this right for
+-- PG V7.0.
+
+-- create function trig_download_versions_delete_info() returns opaque as '
+-- DECLARE
+-- BEGIN
+-- delete from download_versions
+-- where download_id=OLD.download_id;
+-- END;
+-- ' language 'plpgsql';
+-- 
+-- create trigger download_versions_delete_info
+-- before delete on downloads
+-- for each row
+-- execute procedure trig_download_versions_delete_info();
+-- 
+-- create function trig_downloads_rules_dload_del_tr() returns opaque as '
+-- DECLARE
+-- BEGIN
+--    delete from download_rules
+--    where download_id=OLD.download_id;
+-- END;
+-- ' language 'plpgsql';
+-- 
+-- create trigger downloads_rules_dload_del_tr
+-- before delete on downloads
+-- for each row
+-- execute procedure trig_downloads_rules_dload_del_tr();
+-- 
+-- create function trig_downloads_rules_versions_del_tr() returns opaque as '
+-- DECLARE
+-- BEGIN
+--    delete from download_rules
+--    where version_id=OLD.version_id;
+-- END;
+-- ' language 'plpgsql';
+-- 
+-- create trigger downloads_rules_version_del_tr
+-- before delete on download_versions
+-- for each row
+-- execute procedure trig_downloads_rules_versions_del_tr();
+-- 
+-- create function trig_download_log_user_delete_tr() returns opaque as '
+-- DECLARE
+-- BEGIN
+--    delete from download_log
+--    where user_id=OLD.user_id;
+-- END;
+-- ' language 'plpgsql';
+-- 
+-- create trigger download_log_user_delete_tr
+-- before delete on users
+-- for each row
+-- execute procedure trig_download_log_user_delete_tr();
+-- 
+-- create function trig_download_log_version_delete_tr() returns opaque as '
+-- DECLARE
+-- BEGIN
+--    delete from download_log
+--    where version_id=OLD.version_id;
+-- END;
+-- ' language 'plpgsql';
+-- 
+-- create trigger download_log_version_delete_tr
+-- before delete on download_versions
+-- for each row
+-- execute procedure trig_download_log_version_delete_tr();
Index: web/openacs/www/doc/sql/drop-classifieds.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/drop-classifieds.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/drop-classifieds.sql	17 Apr 2001 14:05:12 -0000	1.1
@@ -0,0 +1,7 @@
+drop table classified_ads_audit;
+drop table classified_auction_bids;
+drop table classified_ads;
+drop table ad_categories;
+drop table ad_integrity_checks;
+drop table ad_authorized_maintainers;
+drop table ad_domains;
Index: web/openacs/www/doc/sql/dw.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/dw.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/dw.sql	17 Apr 2001 14:05:12 -0000	1.1
@@ -0,0 +1,68 @@
+--
+-- queries.sql 
+--
+-- defined by philg@mit.edu on December 25, 1998
+--
+-- tables for storing user queries
+--
+
+create sequence query_sequence;
+
+create table queries (
+	query_id	integer primary key,
+	query_name	varchar(100) not null,
+	query_owner	integer not null references users,
+	definition_time	datetime not null,
+	-- if this is non-null, we just forget about all the query_columns
+	-- stuff; the user has hand-edited the SQL
+	query_sql	varchar(4000)
+);
+
+-- we store old hand-edited SQL in here 
+
+create table queries_audit (
+	query_id	integer not null,
+	audit_time	datetime not null,
+	query_sql	varchar(4000)
+);
+
+create function trig_queries_audit_sql() returns opaque
+as '
+declare
+begin
+  IF OLD.query_sql is not null AND
+	(new.query_sql is null OR
+	OLD.query_sql <> NEW.query_sql)
+  THEN
+  	insert into queries_audit (query_id, audit_time, query_sql)
+  	values
+  	(OLD.query_id, current_timestamp, OLD.query_sql);
+  END IF;
+end trig_queries_audit_sql;
+' language 'plpgsql';
+
+create trigger queries_audit_sql
+before update on queries
+for each row
+execute procedure trig_queries_audit_sql();
+
+
+-- this specifies the columns we we will be using in a query and
+-- what to do with each one, e.g., "select_and_group_by" or
+-- "select_and_aggregate"
+
+-- "restrict_by" is tricky; value1 contains the restriction value, e.g., '40'
+-- or 'MA' and value2 contains the SQL comparion operator, e.g., "=" or ">"
+
+create table query_columns (
+	query_id	integer not null references queries,
+	column_name	varchar(30),
+	pretty_name	varchar(50),
+	what_to_do	varchar(30),
+	-- meaning depends on value of what_to_do
+	value1		varchar(4000),
+	value2		varchar(4000)
+);
+
+create index query_columns_idx on query_columns(query_id);
+
Index: web/openacs/www/doc/sql/ecommerce-plsql.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/ecommerce-plsql.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/ecommerce-plsql.sql	17 Apr 2001 14:05:12 -0000	1.1
@@ -0,0 +1,719 @@
+--
+-- ecommerce-plsql.sql
+--
+-- by eveander@arsdigita.com, April 1999
+--
+
+-- Helper stuff (ben@adida.net)
+create function least(numeric,numeric)
+returns numeric
+as '
+DECLARE
+	first alias for $1;
+	second alias for $2;
+BEGIN
+	if first < second
+	then return first;
+	else return second;
+	end if;
+END;
+' language 'plpgsql';
+
+--------------- price calculations -------------------
+-------------------------------------------------------
+
+-- just the price of an order, not shipping, tax, or gift certificates
+-- this is actually price_charged minus price_refunded
+create function ec_total_price (integer) 
+returns numeric
+AS '
+declare
+	v_order_id alias for $1;
+BEGIN
+	RETURN case when sum(price_charged) is null then 0::numeric else sum(price_charged) end - 
+	case when sum(price_refunded) is null then 0::numeric else sum(price_refunded) end
+		FROM ec_items
+		WHERE order_id= v_order_id
+		and item_state <> ''void'';
+END;
+' language 'plpgsql';
+
+-- just the shipping of an order, not price, tax, or gift certificates
+-- this is actually total shipping minus total shipping refunded
+create function ec_total_shipping(integer)
+returns numeric as '
+DECLARE
+	v_order_id alias for $1;
+	order_shipping		numeric;
+	item_shipping		numeric;
+BEGIN
+	select case when shipping_charged is null then 0::numeric else shipping_charged end - 
+	case when shipping_refunded is null then 0::numeric else shipping_refunded end
+	into order_shipping
+	from ec_orders where order_id= v_order_id;
+
+	select case when sum(shipping_charged) is null then 0::numeric else sum(shipping_charged) end - 
+	case when sum(shipping_refunded) is null then 0:: numeric else sum(shipping_refunded) end
+	into item_shipping
+	from ec_items
+	where order_id= v_order_id
+	and item_state <> ''void'';
+
+	RETURN order_shipping + item_shipping;
+END;
+' language 'plpgsql';
+
+-- OK
+-- just the tax of an order, not price, shipping, or gift certificates
+-- this is tax minus tax refunded
+create function ec_total_tax(integer)
+returns numeric as '
+DECLARE
+	v_order_id alias for $1;
+	order_tax		numeric;
+	item_price_tax		numeric;
+	item_shipping_tax	numeric;
+BEGIN
+	select case when shipping_tax_charged is null then 0::numeric else shipping_tax_charged end - 
+	case when shipping_tax_refunded is null then 0::numeric else shipping_tax_refunded end
+	into order_tax
+	from ec_orders
+	where order_id= v_order_id;
+
+	select case when sum(price_tax_charged) is null then 0::numeric else sum(price_tax_charged) end -
+	case when sum(price_tax_refunded) is null then 0::numeric else sum(price_tax_refunded) end
+	into item_price_tax
+	from ec_items
+	where order_id= v_order_id
+	and item_state <> ''void'';
+
+	select case when sum(shipping_tax_charged) is null then 0::numeric else sum(shipping_tax_charged) end - 
+	case when sum(shipping_tax_refunded) is null then 0::numeric else sum(shipping_tax_refunded) end
+	into item_shipping_tax
+	from ec_items
+	where order_id= v_order_id;
+
+	RETURN order_tax + item_price_tax + item_shipping_tax;
+END;
+' language 'plpgsql';
+
+-- OK
+-- just the price of a shipment, not shipping, tax, or gift certificates
+-- this is the price charged minus the price refunded of the shipment
+create function ec_shipment_price(integer)
+returns numeric
+as '
+DECLARE
+	v_shipment_id alias for $1;
+	shipment_price	    numeric;
+BEGIN
+	SELECT case when sum(price_charged) is null then 0::numeric else sum(price_charged) end - 
+	case when sum(price_refunded) is null then 0::numeric else sum(price_refunded) end 
+	into shipment_price
+	FROM ec_items
+	WHERE shipment_id= v_shipment_id
+	and item_state <> ''void'';
+
+	RETURN shipment_price;
+END;
+' language 'plpgsql';
+
+-- OK
+-- just the shipping charges of a shipment, not price, tax, or gift certificates
+-- note: the base shipping charge is always applied to the first shipment in an order.
+-- this is the shipping charged minus the shipping refunded
+create function ec_shipment_shipping(integer)
+returns numeric
+as '
+DECLARE
+	v_shipment_id alias for $1;
+	item_shipping		numeric;
+	base_shipping		numeric;
+	v_order_id		ec_orders.order_id%TYPE;
+	min_shipment_id		ec_shipments.shipment_id%TYPE;
+BEGIN
+	SELECT order_id into v_order_id FROM ec_shipments where shipment_id= v_shipment_id;
+	SELECT min(shipment_id) into min_shipment_id FROM ec_shipments where order_id= v_order_id;
+	IF v_shipment_id= min_shipment_id THEN
+		SELECT case when shipping_charged is null then 0::numeric else shipping_charged end - 
+		case when shipping_refunded is null then 0::numeric else shipping_refunded end 
+		into base_shipping FROM ec_orders where order_id= v_order_id;
+	ELSE
+		base_shipping := 0;
+	END IF;
+	SELECT  case when sum(shipping_charged) is null then 0::numeric else sum(shipping_charged) end - 
+	case when sum(shipping_refunded) is null then 0::numeric else sum(shipping_refunded) end 
+	into item_shipping FROM ec_items where shipment_id= v_shipment_id and item_state <> ''void'';
+	RETURN item_shipping + base_shipping;
+END;
+' language 'plpgsql';
+
+-- OK
+-- just the tax of a shipment, not price, shipping, or gift certificates
+-- note: the base shipping tax charge is always applied to the first shipment in an order.
+-- this is the tax charged minus the tax refunded
+create function ec_shipment_tax(integer)
+returns numeric
+as '
+DECLARE
+	v_shipment_id alias for $1;
+	item_price_tax		numeric;
+	item_shipping_tax	numeric;
+	base_shipping_tax	numeric;
+	v_order_id		ec_orders.order_id%TYPE;
+	min_shipment_id		ec_shipments.shipment_id%TYPE;
+BEGIN
+	SELECT order_id into v_order_id FROM ec_shipments where shipment_id= v_shipment_id;
+	SELECT min(shipment_id) into min_shipment_id FROM ec_shipments where order_id= v_order_id;
+	IF v_shipment_id= min_shipment_id THEN
+		SELECT coalesce(shipping_tax_charged,0::numeric) - coalesce(shipping_tax_refunded,0::numeric) into base_shipping_tax FROM ec_orders where order_id= v_order_id;
+	ELSE
+		base_shipping_tax := 0;
+	END IF;
+	SELECT coalesce(sum(price_tax_charged),0::numeric) - coalesce(sum(price_tax_refunded),0::numeric) into item_price_tax FROM ec_items where shipment_id= v_shipment_id and item_state <> ''void'';
+	SELECT coalesce(sum(shipping_tax_charged),0::numeric) - coalesce(sum(shipping_tax_refunded),0::numeric) into item_shipping_tax FROM ec_items where shipment_id= v_shipment_id and item_state <> ''void'';
+	RETURN item_price_tax + item_shipping_tax + base_shipping_tax;
+END;
+' language 'plpgsql';
+
+-- OK
+-- the gift certificate amount used on one order
+create function ec_order_gift_cert_amount(integer)
+returns numeric
+as '
+DECLARE
+	v_order_id alias for $1;
+	gift_cert_amount	numeric;
+BEGIN
+	select case when sum(amount_used) is null then 0::numeric else sum(amount_used) end - 
+	case when sum(amount_reinstated) is null then 0::numeric else sum(amount_reinstated) end
+	into gift_cert_amount
+	from ec_gift_certificate_usage
+	where order_id= v_order_id;
+
+	return gift_cert_amount;
+END;
+' language 'plpgsql';
+
+
+-- OK
+-- tells how much of the gift certificate amount used on the order is to be applied
+-- to a shipment (it's applied chronologically)
+create function ec_shipment_gift_certificate (integer)
+returns numeric
+as '
+DECLARE
+	v_shipment_id alias for $1;
+	v_order_id		ec_orders.order_id%TYPE;
+	gift_cert_amount	numeric;
+	past_ship_amount	numeric;
+BEGIN
+	SELECT order_id into v_order_id FROM ec_shipments WHERE shipment_id= v_shipment_id;
+	gift_cert_amount := ec_order_gift_cert_amount(v_order_id);
+
+	SELECT coalesce(sum(ec_shipment_price(shipment_id)) + sum(ec_shipment_shipping(shipment_id))+sum(ec_shipment_tax(shipment_id)),0::numeric) into past_ship_amount FROM ec_shipments WHERE order_id = v_order_id and shipment_id <> v_shipment_id;
+
+	IF past_ship_amount > gift_cert_amount THEN
+		return 0;
+	ELSE
+		return least(gift_cert_amount - past_ship_amount, coalesce(ec_shipment_price(v_shipment_id) + ec_shipment_shipping(v_shipment_id) + ec_shipment_tax(v_shipment_id),0::numeric));
+	END IF;
+END;
+' language 'plpgsql';
+
+-- OK
+-- this can be used for either an item or order
+-- given price and shipping, computes tax that needs to be charged (or refunded)
+-- order_id is an argument so that we can get the usps_abbrev (and thus the tax rate),
+--
+-- OUTER JOIN HACK by BMA: I just took out the outer join for now, it doesn't look very necessary, we'll see.
+
+create function ec_tax (numeric, numeric, integer)
+returns numeric
+as '
+DECLARE
+	v_price alias for $1;
+	v_shipping alias for $2;
+	v_order_id alias for $3;
+	taxes			ec_sales_tax_by_state%ROWTYPE;
+BEGIN
+	SELECT t.* into taxes
+	FROM ec_orders o, ec_addresses a, ec_sales_tax_by_state t
+	WHERE o.shipping_address=a.address_id
+	AND a.usps_abbrev=t.usps_abbrev
+	AND o.order_id= v_order_id;
+	
+	IF coalesce(taxes.shipping_p,''f'') = ''f'' THEN
+		return coalesce(taxes.tax_rate,0)::numeric * v_price;
+	ELSE
+		return coalesce(taxes.tax_rate,0)::numeric * (v_price + v_shipping);
+	END IF;
+END;
+' language 'plpgsql';
+
+-- OK
+-- total order cost (price + shipping + tax - gift certificate)
+-- this should be equal to the amount that the order was authorized for
+-- (if no refunds have been made)
+create function ec_order_cost(integer) 
+returns numeric
+as '
+DECLARE
+	v_order_id alias for $1;
+	v_price		numeric;
+	v_shipping	numeric;
+	v_tax		numeric;
+	v_certificate	numeric;
+BEGIN
+	v_price := ec_total_price(v_order_id);
+	v_shipping := ec_total_shipping(v_order_id);
+	v_tax := ec_total_tax(v_order_id);
+	v_certificate := ec_order_gift_cert_amount(v_order_id);
+
+	return v_price + v_shipping + v_tax - v_certificate;
+END;
+' language 'plpgsql';
+
+-- OK
+-- total shipment cost (price + shipping + tax - gift certificate)
+create function ec_shipment_cost(integer)
+returns numeric
+as '
+DECLARE
+	v_shipment_id alias for $1;
+	v_price		numeric;
+	v_shipping	numeric;
+	v_certificate	numeric;
+	v_tax		numeric;
+BEGIN
+	v_price := ec_shipment_price(v_shipment_id);
+	v_shipping := ec_shipment_shipping(v_shipment_id);
+	v_tax := ec_shipment_tax(v_shipment_id);
+	v_certificate := ec_shipment_gift_certificate(v_shipment_id);
+
+	return v_price + v_shipping - v_certificate + v_tax;
+END;
+' language 'plpgsql';
+
+-- OK
+-- total amount refunded on an order so far
+create function ec_total_refund(integer)
+returns numeric
+as '
+DECLARE
+	v_order_id alias for $1;
+	v_order_refund	numeric;
+	v_items_refund	numeric;
+BEGIN
+	select coalesce(shipping_refunded,0) + coalesce(shipping_tax_refunded,0) into v_order_refund from ec_orders where order_id= v_order_id;
+	select sum(coalesce(price_refunded,0)) + sum(coalesce(shipping_refunded,0)) + sum(coalesce(price_tax_refunded,0)) + sum(coalesce(shipping_tax_refunded,0)) into v_items_refund from ec_items where order_id= v_order_id;
+	return v_order_refund + v_items_refund;
+END;
+' language 'plpgsql';
+
+-------------- end price calculations -----------------
+-------------------------------------------------------
+
+
+----------- gift certificate procedures ---------------
+-------------------------------------------------------
+  
+--
+-- BMA (PGsql port)
+-- Postgres is way cooler than Oracle with MVCC, which allows it
+-- to have triggers updating the same table. Thus, we get rid of this
+-- trio crap and we have a simple trigger for everything.
+
+create function trig_ec_cert_amount_remains() 
+returns opaque
+as '
+DECLARE
+	bal_amount_used		numeric;
+	original_amount		numeric;
+BEGIN
+	select amount into original_amount
+	from ec_gift_certificates where gift_certificate_id= NEW.certificate_id for update;
+
+	select coalesce(sum(amount_used), 0) - coalesce(sum(amount_reinstated), 0)
+	into bal_amount_used
+	from ec_gift_certificate_usage
+	where gift_certificate_id= NEW.gift_certificate_id;
+
+	UPDATE ec_gift_certificates 
+	SET amount_remaining_p = case when amount > bal_amount_used then ''t'' else ''f'' end
+	WHERE gift_certificate_id = gift_certificate_rec.gift_certificate_id;
+END;
+' language 'plpgsql';
+
+create trigger ec_cert_amount_remains
+before update on ec_gift_certificate_usage
+for each row
+execute procedure trig_ec_cert_amount_remains();		
+
+
+-- OK
+-- calculates how much a user has in their gift certificate account
+create function ec_gift_certificate_balance(integer)
+returns numeric
+as '
+DECLARE
+	v_user_id alias for $1;
+	original_amount			numeric;
+	total_amount_used		numeric;
+BEGIN
+	SELECT case when sum(amount) is null then 0::numeric else sum(amount) end
+	into original_amount
+	FROM ec_gift_certificates_approved
+	WHERE user_id= v_user_id
+	AND amount_remaining_p=''t''
+	AND expires > sysdate();
+	
+	SELECT case when sum(u.amount_used) is null then 0::numeric else sum(u.amount_used) end - 
+	case when sum(u.amount_reinstated) is null then 0::numeric else sum(u.amount_reinstated) end
+	into total_amount_used
+	FROM ec_gift_certificates_approved c, ec_gift_certificate_usage u
+	WHERE c.gift_certificate_id=u.gift_certificate_id
+	AND c.user_id= v_user_id
+	AND c.amount_remaining_p=''t''
+	AND c.expires> sysdate();
+
+	RETURN original_amount - total_amount_used;
+END;
+' language 'plpgsql';
+
+-- OK
+-- Returns price + shipping + tax - gift certificate amount applied
+-- for one order.
+-- Requirement: ec_orders.shipping_charged, ec_orders.shipping_tax_charged,
+-- ec_items.price_charged, ec_items.shipping_charged, ec_items.price_tax_chaged,
+-- and ec_items.shipping_tax_charged should already be filled in.
+
+create function ec_order_amount_owed(integer)
+returns numeric
+as '
+DECLARE
+	v_order_id alias for $1;
+	pre_gc_amount_owed		numeric;
+	gc_amount			numeric;
+BEGIN
+	pre_gc_amount_owed := ec_total_price(v_order_id) + ec_total_shipping(v_order_id) + ec_total_tax(v_order_id);
+	gc_amount := ec_order_gift_cert_amount(v_order_id);
+
+	RETURN pre_gc_amount_owed - gc_amount;
+END;
+' language 'plpgsql';
+
+-- OK
+-- the amount remaining in an individual gift certificate
+create function gift_certificate_amount_left (integer)
+returns numeric
+as '
+DECLARE
+	v_gift_certificate_id alias for $1;
+	original_amount		numeric;
+	amount_used		numeric;
+BEGIN
+	SELECT coalesce(sum(amount_used),0) - coalesce(sum(amount_reinstated),0)
+	into amount_used
+	FROM ec_gift_certificate_usage
+	WHERE gift_certificate_id = v_gift_certificate_id;
+	
+	SELECT amount
+	into original_amount
+	FROM ec_gift_certificates
+	WHERE gift_certificate_id = v_gift_certificate_id;
+
+	RETURN original_amount - amount_used;
+END;
+' language 'plpgsql';
+
+-- I DON'T USE THIS PROCEDURE ANYMORE BECAUSE THERE'S A MORE
+-- FAULT-TOLERANT TCL VERSION
+-- This applies gift certificate balance to an entire order
+-- by iteratively applying unused/unexpired gift certificates
+-- to the order until the order is completely paid for or
+-- the gift certificates run out.
+-- Requirement: ec_orders.shipping_charged, ec_orders.shipping_tax_charged,
+-- ec_items.price_charged, ec_items.shipping_charged, ec_items.price_tax_charged,
+-- ec_items.shipping_tax_charged should already be filled in.
+-- Call this within a transaction.
+-- create or replace procedure ec_apply_gift_cert_balance (v_order_id IN integer, v_user_id IN integer)
+-- IS
+-- 	CURSOR gift_certificate_to_use_cursor IS
+-- 		SELECT *
+-- 		FROM ec_gift_certificates_approved
+-- 		WHERE user_id = v_user_id
+-- 		AND (expires is null or sysdate - expires < 0)
+-- 		AND amount_remaining_p = 't'
+--                 ORDER BY expires;
+-- 	amount_owed			number;
+-- 	gift_certificate_balance	number;
+-- 	certificate			ec_gift_certificates_approved%ROWTYPE;
+-- BEGIN
+-- 	gift_certificate_balance := ec_gift_certificate_balance(v_user_id);
+-- 	amount_owed := ec_order_amount_owed(v_order_id);
+
+--         OPEN gift_certificate_to_use_cursor;
+-- 	WHILE amount_owed > 0 and gift_certificate_balance > 0
+-- 		LOOP
+-- 			FETCH gift_certificate_to_use_cursor INTO certificate;
+
+-- 	        	INSERT into ec_gift_certificate_usage
+-- 			(gift_certificate_id, order_id, amount_used, used_date)
+-- 			VALUES
+-- 			(certificate.gift_certificate_id, v_order_id, least(gift_certificate_amount_left(certificate.gift_certificate_id), amount_owed), sysdate);
+
+-- 			gift_certificate_balance := ec_gift_certificate_balance(v_user_id);
+-- 			amount_owed := ec_order_amount_owed(v_order_id);	
+-- 		END LOOP;
+--         CLOSE gift_certificate_to_use_cursor;
+-- END ec_apply_gift_cert_balance;
+-- /
+-- show errors
+
+
+-- OK
+-- reinstates all gift certificates used on an order (as opposed to
+-- individual items), e.g. if the order was voided or an auth failed
+
+create function ec_reinst_gift_cert_on_order(integer)
+returns integer
+as '
+DECLARE
+	v_order_id alias for $1;
+BEGIN
+	insert into ec_gift_certificate_usage
+	(gift_certificate_id, order_id, amount_reinstated, reinstated_date)
+	select gift_certificate_id, v_order_id, coalesce(sum(amount_used),0)-coalesce(sum(amount_reinstated),0), sysdate()
+	from ec_gift_certificate_usage
+	where order_id= v_order_id
+	group by gift_certificate_id;
+
+	return 0;
+END;
+' language 'plpgsql';
+	
+-- Given an amount to refund to an order, this tells
+-- you how much of that is to be refunded in cash (as opposed to 
+-- reinstated in gift certificates).  Then you know you have to
+-- go and reinstate v_amount minus (what this function returns)
+-- in gift certificates.
+-- (when I say cash I'm really talking about credit card
+-- payment -- as opposed to gift certificates)
+
+-- Call this before inserting the amounts that are being refunded
+-- into the database.
+create function ec_cash_amount_to_refund (numeric, integer)
+returns numeric
+as '
+DECLARE
+	v_amount alias for $1;
+	v_order_id alias for $2;
+	amount_paid			numeric;
+	items_amount_paid		numeric;
+	order_amount_paid		numeric;
+	amount_refunded			numeric;
+	curr_gc_amount			numeric;
+	max_cash_refundable		numeric;
+	cash_to_refund			numeric;
+BEGIN
+	-- the maximum amount of cash refundable is equal to
+	-- the amount paid (in cash + certificates) for shipped items only (since
+	--  money is not paid until an item actually ships)
+	-- minus the amount refunded (in cash + certificates) (only occurs for shipped items)
+	-- minus the current gift certificate amount applied to this order
+	-- or 0 if the result is negative
+
+	select sum(coalesce(price_charged,0)) + sum(coalesce(shipping_charged,0)) + sum(coalesce(price_tax_charged,0)) + sum(coalesce(shipping_tax_charged,0)) into items_amount_paid from ec_items where order_id= v_order_id and shipment_id is not null and item_state <> ''void'';
+
+	select coalesce(shipping_charged,0) + coalesce(shipping_tax_charged,0) into order_amount_paid from ec_orders where order_id= v_order_id;
+
+	amount_paid := items_amount_paid + order_amount_paid;
+	amount_refunded := ec_total_refund(v_order_id);
+	curr_gc_amount := ec_order_gift_cert_amount(v_order_id);
+	
+	max_cash_refundable := amount_paid - amount_refunded - curr_gc_amount;
+	cash_to_refund := least(max_cash_refundable, v_amount);
+
+	RETURN cash_to_refund;
+END;
+' language 'plpgsql';
+
+-- The amount of a given gift certificate used on a given order.
+-- This is a helper function for ec_gift_cert_unshipped_amount.
+create function ec_one_gift_cert_on_one_order (integer,integer)
+returns numeric
+as '
+DECLARE
+	v_gift_certificate_id alias for $1;
+	v_order_id alias for $2;
+	bal_amount_used		numeric;
+BEGIN
+	select coalesce(sum(amount_used),0)-coalesce(sum(amount_reinstated),0) into bal_amount_used
+	from ec_gift_certificate_usage
+	where order_id= v_order_id
+	and gift_certificate_id= v_gift_certificate_id;
+
+	RETURN bal_amount_used;
+
+END;
+' language 'plpgsql';
+
+-- The amount of all gift certificates used on a given order that
+-- expire before* a given gift certificate (*in the event that two
+-- expire at precisely the same time, the one with a higher
+-- gift_certificate_id is defined to expire last).
+-- This is a helper function for ec_gift_cert_unshipped_amount.
+create function ec_earlier_certs_on_one_order (integer, integer)
+returns numeric 
+as '
+DECLARE
+	v_gift_certificate_id alias for $1;
+	v_order_id alias for $2;
+	bal_amount_used		numeric;
+BEGIN
+	select coalesce(sum(u.amount_used),0)-coalesce(sum(u.amount_reinstated),0) into bal_amount_used
+	from ec_gift_certificate_usage u, ec_gift_certificates g, ec_gift_certificates g2
+	where u.gift_certificate_id=g.gift_certificate_id
+	and g2.gift_certificate_id= v_gift_certificate_id
+	and u.order_id= v_order_id
+	and (g.expires < g2.expires or (g.expires = g2.expires and g.gift_certificate_id < g2.gift_certificate_id));
+
+	return bal_amount_used;
+END;
+' language 'plpgsql';
+
+-- The amount of a gift certificate that is applied to the upshipped portion of an order.
+-- This is a helper function for ec_gift_cert_unshipped_amount.
+create function ec_cert_unshipped_one_order (integer, integer)
+returns numeric 
+as ' 
+DECLARE
+	v_gift_certificate_id alias for $1;
+	v_order_id alias for $2;
+	total_shipment_cost	numeric;
+	earlier_certs		numeric;
+	total_tied_amount	numeric;
+BEGIN
+	select coalesce(sum(coalesce(ec_shipment_price(shipment_id),0) + coalesce(ec_shipment_shipping(shipment_id),0) + coalesce(ec_shipment_tax(shipment_id),0)),0) into total_shipment_cost
+	from ec_shipments
+	where order_id= v_order_id;
+
+	earlier_certs := ec_earlier_certs_on_one_order(v_gift_certificate_id, v_order_id);
+
+	IF total_shipment_cost <= earlier_certs THEN
+		total_tied_amount := ec_one_gift_cert_on_one_order(v_gift_certificate_id, v_order_id);
+	ELSIF total_shipment_cost > earlier_certs + ec_one_gift_cert_on_one_order(v_gift_certificate_id, v_order_id) THEN
+		total_tied_amount := 0;
+	ELSE
+		total_tied_amount := ec_one_gift_cert_on_one_order(v_gift_certificate_id, v_order_id) - (total_shipment_cost - earlier_certs);
+	END IF;
+
+	RETURN total_tied_amount;		
+END;
+' language 'plpgsql';
+
+-- Returns the amount of a gift certificate that is applied to the unshipped portions of orders
+-- (this amount is still considered "outstanding" since revenue, and thus gift certificate usage,
+-- isn't recognized until the items ship).
+create function ec_gift_cert_unshipped_amount (integer)
+returns numeric
+as '
+DECLARE
+	v_gift_certificate_id alias for $1;
+	tied_but_unshipped_amount	numeric;
+BEGIN
+	select coalesce(sum(ec_cert_unshipped_one_order(v_gift_certificate_id,order_id)),0) into tied_but_unshipped_amount
+	from ec_orders
+	where order_id in (select unique order_id from ec_gift_certificate_usage where gift_certificate_id= v_gift_certificate_id);
+
+	return tied_but_unshipped_amount;
+END;
+' language 'plpgsql';
+
+---------- end gift certificate procedures ------------
+-------------------------------------------------------
+
+-- Thing to help out with outer joins
+
+create function ec_items_reportable_count(integer)
+returns integer
+as '
+DECLARE
+	v_product_id alias for $1;
+BEGIN
+	return count(*) from ec_items_reportable where product_id= v_product_id;
+END;
+' language 'plpgsql';
+
+
+create function ec_comments_count(integer)
+returns integer
+as '
+DECLARE
+	v_product_id alias for $1;
+BEGIN
+	return count(*) from ec_product_comments where product_id= v_product_id;
+END;
+' language 'plpgsql';
+
+
+create function ec_shipment_status(integer, integer)
+returns varchar
+as '
+DECLARE
+	v_order_id alias for $1;
+	v_shipment_id alias for $2;
+	n_items_ordered integer;
+	n_items_shipped integer;
+BEGIN
+	select coalesce(count(*),0) into n_items_ordered from ec_items where order_id= v_order_id;
+	select coalesce(count(*),0) into n_items_shipped from ec_items where shipment_id= v_shipment_id;
+
+	if n_items_ordered = n_items_shipped
+	then return ''Full'';
+	else return ''Partial'';
+	end if;
+END;
+' language 'plpgsql';
+
+
+create function ec_shipment_n_items(integer)
+returns varchar
+as '
+DECLARE
+	v_shipment_id alias for $1;
+BEGIN
+	return coalesce(count(*),0) from ec_items where shipment_id= v_shipment_id;
+END;
+' language 'plpgsql';
+
+
+create function ec_category_product_count(integer)
+returns integer
+as '
+DECLARE
+	v_category_id alias for $1;
+BEGIN
+	return count(*) from ec_category_product_map where category_id= v_category_id;
+END;
+' language 'plpgsql';
+
+create function cybercash_to_date(varchar)
+returns datetime
+as '
+DECLARE
+	v_str alias for $1;
+	new_str varchar(20);
+BEGIN
+	if v_str=''''
+	then return null;
+	end if;
+
+	new_str:= substr(v_str,1,4) || ''-'' || substr(v_str,5,2) || ''-'' || substr(v_str,7,2) ||
+		  '' '' || substr(v_str,9,2) || '':'' || substr(v_str,11,2) || '':'' ||
+		  substr(v_str,12,2);
+	
+	return new_str::datetime;
+END;
+' language 'plpgsql';
Index: web/openacs/www/doc/sql/ecommerce.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/ecommerce.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/ecommerce.sql	17 Apr 2001 14:05:12 -0000	1.1
@@ -0,0 +1,2744 @@
+--
+-- ecommerce.sql
+--
+-- by eveander@arsdigita.com, April 1999
+--
+
+-- Besides the tables defined here, you also need to import
+-- zip_codes, which contains the following columns:
+--  ZIP_CODE				   NOT NULL VARCHAR2(10)
+--  STATE_CODE					    CHAR(2)
+--  CITY_NAME					    VARCHAR2(32)
+--  COUNTY_NAME					    VARCHAR2(32)
+--  LONGITUDE					    NUMBER(9,6)
+--  LATITUDE					    NUMBER(9,6)
+
+
+-- Each table in ecommerce has a column for user_id, ip_address, 
+-- creation_date and last_modified to assist in auditing user
+-- inserts, updates, and deletes.
+-- Audit tables store information about entries in the main ec_ tables.
+-- They have an column for each column of the main table, plus
+-- a column for marking when a logged entry was for a deleted row.
+
+-- product display templates
+create sequence ec_template_id_sequence;
+
+-- I should have named this product_templates because now we
+-- have other kinds of templates.
+create table ec_templates (
+	template_id		integer not null primary key,
+	template_name		varchar(200),
+	template		varchar(4000),
+	last_modified		datetime not null,
+	last_modifying_user	integer not null references users,
+	modified_ip_address	varchar(20) not null
+);
+
+create table ec_templates_audit (
+	template_id		integer,
+	template_name		varchar(200),
+	template		varchar(4000),
+	last_modified		datetime,
+	last_modifying_user	integer,
+	modified_ip_address	varchar(20),
+	delete_p		char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+-- A trigger is used to move information from the main table to 
+-- the audit table
+create function trig_ec_templates_audit_tr() returns opaque
+as '
+declare
+begin
+	insert into ec_templates_audit (
+	template_id, template_name,
+	template,
+	last_modified,
+	last_modifying_user, modified_ip_address
+	) values (
+	OLD.template_id,
+	OLD.template_name, OLD.template,
+	OLD.last_modified,
+	OLD.last_modifying_user, OLD.modified_ip_address	
+	);
+  return new;
+end;
+' language 'plpgsql';
+
+create trigger ec_templates_audit_tr
+after update or delete on ec_templates
+for each row
+execute procedure trig_ec_templates_audit_tr();
+
+-- This inserts the default template into the ec_templates table
+insert into ec_templates (
+	template_id, template_name, template,
+	last_modified, last_modifying_user, modified_ip_address
+	) values (
+	1,'Default', '<head>' || '\n' || '<title><%= $product_name %></title>' || '\n' || '</head>' || '\n' || '<body bgcolor=white text=black>' || '\n' || '\n' || '<h2><%= $product_name %></h2>' || '\n'  || '\n' || '<table width=100%>' || '\n' || '<tr>' || '\n' || '<td>' || '\n' || ' <table>' || '\n' || ' <tr>' || '\n' || ' <td><%= [ec_linked_thumbnail_if_it_exists $dirname] %></td>' || '\n' || ' <td>' || '\n' || ' <b><%= $one_line_description %></b>' || '\n' || ' <br>' || '\n' || ' <%= [ec_price_line $db $product_id $user_id $offer_code] %>' || '\n' || ' </td>' || '\n' || ' </tr>' || '\n' || ' </table>' || '\n' || '</td>' || '\n' || '<td align=center>' || '\n' || '<%= [ec_add_to_cart_link $db $product_id] %>' || '\n' || '</td>' || '\n' || '</tr>' || '\n' || '</table>' || '\n' || '\n' || '<p>' || '\n' || '<%= $detailed_description %>' || '\n' || '\n' || '<%= [ec_display_product_purchase_combinations $db $product_id] %>' || '\n' || '\n' || '<%= [ec_product_links_if_they_exist $db $product_id] %>' || '\n' || '\n' || '<%= [ec_professional_reviews_if_they_exist $db $product_id] %>' || '\n' || '\n' || '<%= [ec_customer_comments $db $product_id $comments_sort_by] %>' || '\n' || '\n' || '<p>' || '\n' || '\n' || '<%= [ec_mailing_list_link_for_a_product $db $product_id] %>' || '\n' || '\n' || '<%= [ec_footer $db] %>' || '\n' || '</body>' || '\n' || '</html>',
+	current_timestamp,
+	1, 'none');
+
+
+
+-- product categories and subcategories and subsubcategories
+create sequence ec_category_id_sequence;
+
+create table ec_categories (
+	category_id		integer not null primary key,
+	-- pretty, human-readable
+	category_name		varchar(100),
+	sort_key		float4,
+	last_modified		datetime not null,
+	last_modifying_user	integer not null references users,
+	modified_ip_address	varchar(20) not null
+);
+
+create index ec_categories_sort_idx on ec_categories (sort_key);
+
+create table ec_categories_audit (
+	category_id		integer,
+	category_name		varchar(100),
+	sort_key		float4,
+	last_modified		datetime,
+	last_modifying_user	integer,
+	modified_ip_address	varchar(20),
+	delete_p		char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+create function trig_ec_categories_audit_tr() returns opaque
+as '
+declare
+begin
+	insert into ec_categories_audit (
+	category_id, category_name, sort_key,
+	last_modified,
+	last_modifying_user, modified_ip_address
+	) values (
+	OLD.category_id, OLD.category_name, OLD.sort_key,
+	OLD.last_modified,
+	OLD.last_modifying_user, OLD.modified_ip_address	
+	);
+  return new;
+end;
+' language 'plpgsql';
+
+
+create trigger ec_categories_audit_tr
+after update or delete on ec_categories
+for each row
+execute procedure trig_ec_categories_audit_tr();
+
+create sequence ec_subcategory_id_sequence;
+
+create table ec_subcategories (
+	subcategory_id		integer not null primary key,
+	category_id		integer not null references ec_categories,
+	-- pretty, human-readable
+	subcategory_name	varchar(100),
+	sort_key		float4,
+	last_modified		datetime not null,
+	last_modifying_user	integer not null references users,
+	modified_ip_address	varchar(20) not null
+);
+
+create index ec_subcategories_idx on ec_subcategories (category_id);
+create index ec_subcategories_idx2 on ec_subcategories (sort_key);
+
+create table ec_subcategories_audit (
+	subcategory_id		integer,
+	category_id		integer,
+	subcategory_name	varchar(100),
+	sort_key		float4,
+	last_modified		datetime,
+	last_modifying_user	integer,
+	modified_ip_address	varchar(20),
+	delete_p		char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+create function trig_ec_subcategories_audit_tr() returns opaque 
+as '
+declare
+begin
+	insert into ec_subcategories_audit (
+	subcategory_id, category_id,
+	subcategory_name, sort_key,
+	last_modified,
+	last_modifying_user, modified_ip_address
+	) values (
+	OLD.subcategory_id, OLD.category_id,
+	OLD.subcategory_name, OLD.sort_key,
+	OLD.last_modified,
+	OLD.last_modifying_user, OLD.modified_ip_address		
+	);
+  return new;
+end;
+' language 'plpgsql';
+
+create trigger ec_subcategories_audit_tr
+after update or delete on ec_subcategories
+for each row
+execute procedure trig_ec_subcategories_audit_tr();
+
+-- a view with category_name also
+
+create view ec_subcategories_augmented 
+as
+select subs.*, cats.category_name
+from ec_subcategories subs, ec_categories cats
+where subs.category_id = cats.category_id;
+
+create sequence ec_subsubcategory_id_sequence;
+
+create table ec_subsubcategories (
+	subsubcategory_id	integer not null primary key,
+	subcategory_id		integer not null references ec_subcategories,
+	-- pretty, human-readable
+	subsubcategory_name	varchar(100),
+	sort_key		float4,
+	last_modified		datetime not null,
+	last_modifying_user	integer not null references users,
+	modified_ip_address	varchar(20) not null
+);
+
+create index ec_subsubcategories_idx on ec_subsubcategories (subcategory_id);
+create index ec_subsubcategories_idx2 on ec_subsubcategories (sort_key);
+
+create table ec_subsubcategories_audit (
+	subsubcategory_id	integer,
+	subcategory_id		integer,
+	subsubcategory_name	varchar(100),
+	sort_key		float4,
+	last_modified		datetime,
+	last_modifying_user	integer,
+	modified_ip_address	varchar(20),
+	delete_p		char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+create function trig_ec_subsubcategories_audit_tr() returns opaque
+as '
+declare
+begin
+	insert into ec_subsubcategories_audit (
+	subsubcategory_id, subcategory_id,
+	subsubcategory_name, sort_key,
+	last_modified,
+	last_modifying_user, modified_ip_address
+	) values (
+	OLD.subsubcategory_id, OLD.subcategory_id,
+	OLD.subsubcategory_name, OLD.sort_key,
+	OLD.last_modified,
+	OLD.last_modifying_user, OLD.modified_ip_address		
+	);
+   return new;
+end;
+' language 'plpgsql';
+
+
+create trigger ec_subsubcategories_audit_tr
+after update or delete on ec_subsubcategories
+for each row
+execute procedure trig_ec_subsubcategories_audit_tr();
+
+-- a view with full subcategory and category info as well 
+create view ec_subsubcategories_augmented
+as
+select subsubs.*, subs.subcategory_name, cats.category_id, cats.category_name
+from ec_subsubcategories subsubs, ec_subcategories subs, ec_categories cats
+where subsubs.subcategory_id = subs.subcategory_id
+and subs.category_id = cats.category_id;
+
+
+create sequence ec_product_id_sequence;
+
+-- This table contains the products and also the product series.
+-- A product series has the same fields as a product (it actually
+-- *is* a product, since it's for sale, has its own price, etc.).
+-- The only difference is that it has other products associated
+-- with it (that are part of it).  So information about the
+-- whole series is kept in this table and the product_series_map
+-- table below keeps track of which products are inside each
+-- series. 
+
+create table ec_products (
+	product_id		integer not null primary key,
+	sku			varchar(100),
+	product_name		varchar(200),
+	creation_date		datetime default current_timestamp not null,
+	one_line_description	varchar(400),
+	detailed_description	varchar(4000),
+	search_keywords		varchar(4000),
+	-- this is the regular price for the product.  If user
+	-- classes are charged a different price, it should be
+	-- specified in ec_product_user_class_prices
+	price			numeric,
+	-- leave this blank if shipping is calculated using
+	-- one of the more complicated methods available
+	shipping		numeric,
+	-- fill this in if shipping is calculated by: above price
+	-- for first item (with this product_id), and the below
+	-- price for additional items (with this product_id)
+	shipping_additional	numeric,
+	-- fill this in if shipping is calculated using weight
+	-- use whatever units you want (lbs/kg), just be consistent
+	-- and make your shipping algorithm take the units into
+	-- account
+	weight			float4,
+	-- holds pictures, sample chapters, etc.
+	dirname			varchar(200),
+	-- whether this item should show up in searches (e.g., if it's
+	-- a volume of a series, you might not want it to)
+	present_p		char(1) check (present_p in ('f','t')) default 't',
+	-- whether the item should show up at all in the user pages
+	active_p		char(1) check (active_p in ('f','t')) default 't',
+	-- the date the product becomes available for sale (it can be listed
+	-- before then, it's just not buyable)
+	available_date		datetime default current_timestamp not null,
+	announcements		varchar(4000),
+	announcements_expire	datetime,
+	-- if there's a web site with more info about the product
+	url			varchar(300),
+	template_id		integer references ec_templates,
+	-- o = out of stock, q = ships quickly, m = ships
+	-- moderately quickly, s = ships slowly, i = in stock
+	-- with no message about the speed of the shipment (shipping
+	-- messages are in parameters .ini file)
+	stock_status		char(1) check (stock_status in ('o','q','m','s','i')),
+	-- comma-separated lists of available colors, sizes, and styles for the user
+	-- to choose upon ordering
+	color_list		varchar(4000),
+	size_list		varchar(4000),
+	style_list		varchar(4000),
+	-- the user ID and IP address of the creator of the product
+	last_modified		datetime not null,
+	last_modifying_user	integer not null references users,
+	modified_ip_address	varchar(20) not null	
+);
+
+create view ec_products_displayable
+as
+select * from ec_products
+where active_p='t';
+
+create view ec_products_searchable
+as
+select * from ec_products
+where active_p='t' and present_p='t';
+
+create table ec_products_audit (
+	product_id		integer,
+	product_name		varchar(200),
+	creation_date		datetime,
+	one_line_description	varchar(400),
+	detailed_description	varchar(4000),
+	search_keywords		varchar(4000),
+	price			numeric,
+	shipping		numeric,
+	shipping_additional	numeric,
+	weight			float4,
+	dirname			varchar(200),
+	present_p		char(1) check (present_p in ('f','t')) default 't',
+	active_p		char(1) check (present_p in ('f','t')) default 't',
+	available_date		datetime,
+	announcements		varchar(4000),
+	announcements_expire	datetime,
+	url			varchar(300),
+	template_id		integer,
+	stock_status		char(1) check (stock_status in ('o','q','m','s','i')),
+	last_modified		datetime,
+	last_modifying_user	integer,
+	modified_ip_address	varchar(20),
+	delete_p		char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+create function trig_ec_product_audit_tr() returns opaque
+as '
+declare
+begin
+	insert into ec_products_audit (
+	product_id, product_name, creation_date,
+	one_line_description, detailed_description,
+	search_keywords, shipping,
+	shipping_additional, weight,
+	dirname, present_p,
+	active_p, available_date,
+	announcements, announcements_expire, 
+	url, template_id,
+	stock_status,
+	last_modified,
+	last_modifying_user, modified_ip_address
+	) values (
+	OLD.product_id, OLD.product_name, OLD.creation_date,
+	OLD.one_line_description, OLD.detailed_description,
+	OLD.search_keywords, OLD.shipping,
+	OLD.shipping_additional, OLD.weight,
+	OLD.dirname, OLD.present_p,
+	OLD.active_p, OLD.available_date,
+	OLD.announcements, OLD.announcements_expire, 
+	OLD.url, OLD.template_id,
+	OLD.stock_status,
+	OLD.last_modified,
+	OLD.last_modifying_user, OLD.modified_ip_address
+	);
+  return new;
+end;
+' language 'plpgsql';
+
+create  trigger ec_products_audit_tr
+after update or delete on ec_products
+for each row
+execute procedure trig_ec_product_audit_tr();
+
+-- people who bought product_id also bought products 0 through
+-- 4, where product_0 is the most frequently purchased, 1 is next,
+-- etc.
+create table ec_product_purchase_comb (
+	product_id	integer not null primary key references ec_products,
+	product_0	integer references ec_products,
+	product_1	integer references ec_products,
+	product_2	integer references ec_products,
+	product_3	integer references ec_products,
+	product_4	integer references ec_products
+);
+
+create index ec_product_purchase_comb_idx0 on ec_product_purchase_comb(product_0);
+create index ec_product_purchase_comb_idx1 on ec_product_purchase_comb(product_1);
+create index ec_product_purchase_comb_idx2 on ec_product_purchase_comb(product_2);
+create index ec_product_purchase_comb_idx3 on ec_product_purchase_comb(product_3);
+create index ec_product_purchase_comb_idx4 on ec_product_purchase_comb(product_4);
+
+create sequence ec_sale_price_id_sequence;
+
+create table ec_sale_prices (
+	sale_price_id		integer not null primary key,
+	product_id		integer not null references ec_products,
+	sale_price		numeric,
+	sale_begins		datetime not null,
+	sale_ends		datetime not null,
+	-- like Introductory Price or Sale Price or Special Offer
+	sale_name		varchar(30),
+	-- if non-null, the user has to know this code to get the sale price
+	offer_code		varchar(20),
+	last_modified		datetime not null,
+	last_modifying_user	integer not null references users,
+	modified_ip_address	varchar(20) not null
+);
+
+create index ec_sale_prices_by_product_idx on ec_sale_prices(product_id);
+
+-- TODO: fix the date comparisons here.
+create view ec_sale_prices_current
+as
+select * from ec_sale_prices
+where current_timestamp>=sale_begins
+and current_timestamp<=sale_ends;
+
+
+create table ec_sale_prices_audit (
+	sale_price_id		integer,
+	product_id		integer,
+	sale_price		numeric,
+	sale_begins		datetime,
+	sale_ends		datetime,
+	sale_name		varchar(30),
+	offer_code		varchar(20),
+	last_modified		datetime,
+	last_modifying_user	integer,
+	modified_ip_address	varchar(20),
+	delete_p		char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+create function trig_ec_sale_prices_audit_tr() returns opaque
+as '
+declare
+begin
+	insert into ec_sale_prices_audit (
+	sale_price_id, product_id, sale_price,
+	sale_begins, sale_ends, sale_name, offer_code,
+	last_modified,
+	last_modifying_user, modified_ip_address
+	) values (
+	OLD.sale_price_id, OLD.product_id, OLD.sale_price,
+	OLD.sale_begins, OLD.sale_ends, OLD.sale_name, OLD.offer_code,
+	OLD.last_modified,
+	OLD.last_modifying_user, OLD.modified_ip_address
+	);
+  return new;
+end;
+' language 'plpgsql';
+
+create trigger ec_sale_prices_audit_tr
+after update or delete on ec_sale_prices
+for each row
+execute procedure trig_ec_sale_prices_audit_tr();
+
+create table ec_product_series_map (
+	-- this is the product_id of a product that happens to be
+	-- a series
+	series_id		integer not null references ec_products,
+	-- this is the product_id of a product that is one of the
+	-- components of the above series
+	component_id		integer not null references ec_products,
+	primary key (series_id, component_id),
+	last_modified		datetime not null,
+	last_modifying_user	integer not null references users,
+	modified_ip_address	varchar(20) not null
+);
+
+create index ec_product_series_map_idx2 on ec_product_series_map(component_id);
+
+create table ec_product_series_map_audit (
+	series_id		integer,
+	component_id		integer,
+	last_modified		datetime,
+	last_modifying_user	integer,
+	modified_ip_address	varchar(20),
+	delete_p		char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+create function trig_ec_product_series_map_audit_tr() returns opaque
+as '
+declare
+begin
+	insert into ec_product_series_map_audit (
+	series_id, component_id,
+	last_modified,
+	last_modifying_user, modified_ip_address
+	) values (
+	OLD.series_id, OLD.component_id,
+	OLD.last_modified,
+	OLD.last_modifying_user, OLD.modified_ip_address	
+	);
+  return new;
+end;
+' language 'plpgsql';
+
+create  trigger ec_product_series_map_audit_tr
+after update or delete on ec_product_series_map
+for each row
+execute procedure trig_ec_product_series_map_audit_tr();
+
+create sequence ec_address_id_sequence; 
+
+create table ec_addresses (
+	address_id	integer not null primary key,
+	user_id		integer not null references users,
+	address_type	varchar(20) not null,	-- e.g., billing
+	attn		varchar(100),
+	line1		varchar(100),
+	line2		varchar(100),
+	city		varchar(100),
+	-- state
+	usps_abbrev	char(2) references states,
+	-- big enough to hold zip+4 with dash
+	zip_code	varchar(10),
+	phone		varchar(30),
+	-- for international addresses
+	country_code	char(2) references country_codes(iso),
+	-- this can be the province or region for an international address
+	full_state_name	varchar(30),
+	-- D for day, E for evening
+	phone_time	varchar(10)
+);
+
+create index ec_addresses_by_user_idx on ec_addresses (user_id);
+
+create sequence ec_creditcard_id_sequence;
+
+create table ec_creditcards (
+	creditcard_id		integer not null primary key,
+	user_id			integer not null references users,
+	-- Cybercash does not ask for this but we'll store it anyway
+	creditcard_type		char(1),
+	-- no spaces; always 16 digits (oops; except for AMEX, which is 15)
+	-- depending on admin settings, after we get success from Cybercash, 
+	-- we may bash this to NULL
+	-- we make this a VARCHAR so it doesn't get padded by Oracle
+	creditcard_number	varchar(16),
+	-- just the last four digits for subsequent UI
+	creditcard_last_four	char(4),
+	-- ##/## 
+	creditcard_expire	char(5),
+	billing_zip_code	varchar(80),
+	-- if it ever failed (conclusively), set this to 't' so we
+	-- won't give them the option of using it again
+	failed_p		char(1) check (failed_p in ('f','t')) default 'f'
+);
+
+create index ec_creditcards_by_user_idx on ec_creditcards (user_id);
+
+create sequence ec_user_class_id_sequence;
+
+create table ec_user_classes (
+	user_class_id		integer not null primary key,
+	-- human-readable
+	user_class_name		varchar(200), -- e.g., student
+	last_modified		datetime not null,
+	last_modifying_user	integer not null references users,
+	modified_ip_address	varchar(20) not null
+);
+
+create table ec_user_classes_audit (
+	user_class_id		integer,
+	user_class_name		varchar(200), -- e.g., student
+	last_modified		datetime,
+	last_modifying_user	integer,
+	modified_ip_address	varchar(20),
+	delete_p		char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+create function trig_ec_user_classes_audit_tr() returns opaque
+as '
+declare
+begin
+	insert into ec_user_classes_audit (
+	user_class_id, user_class_name,
+	last_modified,
+	last_modifying_user, modified_ip_address
+	) values (
+	OLD.user_class_id, OLD.user_class_name,
+	OLD.last_modified,
+	OLD.last_modifying_user, OLD.modified_ip_address	
+	);
+  return new;
+end;
+' language 'plpgsql';
+
+create  trigger ec_user_classes_audit_tr
+after update or delete on ec_user_classes
+for each row
+execute procedure trig_ec_user_classes_audit_tr();
+
+create table ec_product_user_class_prices (
+	product_id		integer not null references ec_products,
+	user_class_id		integer not null references ec_user_classes,
+	price			numeric,
+	primary key (product_id, user_class_id),
+	last_modified		datetime not null,
+	last_modifying_user	integer not null references users,
+	modified_ip_address	varchar(20) not null
+);
+
+create index ec_product_user_class_idx on ec_product_user_class_prices(user_class_id);
+
+-- ec_product_user_class_prices_audit abbreviated as
+-- ec_product_u_c_prices_audit
+create table ec_product_u_c_prices_audit (
+	product_id		integer,
+	user_class_id		integer,
+	price			numeric,
+	last_modified		datetime,
+	last_modifying_user	integer,
+	modified_ip_address	varchar(20),
+	delete_p		char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+create function trig_ec_product_u_c_prices_audit_tr() returns opaque
+as '
+declare
+begin
+	insert into ec_product_u_c_prices_audit (
+	product_id, user_class_id,
+	price,
+	last_modified,
+	last_modifying_user, modified_ip_address
+	) values (
+	OLD.product_id, OLD.user_class_id,
+	OLD.price,
+	OLD.last_modified,
+	OLD.last_modifying_user, OLD.modified_ip_address	
+	);
+  return new;
+end;
+' language 'plpgsql';
+
+create  trigger ec_product_u_c_prices_audit_tr
+after update or delete on ec_product_user_class_prices
+for each row
+execute procedure trig_ec_product_u_c_prices_audit_tr();
+
+
+create sequence ec_recommendation_id_sequence;
+
+create table ec_product_recommendations (
+	recommendation_id	integer not null primary key,
+	product_id		integer not null references ec_products,
+	-- might be null if the product is recommended for everyone
+	user_class_id		integer references ec_user_classes,
+	-- html format
+	recommendation_text	varchar(4000),
+	active_p		char(1) check (active_p in ('f','t')) default 't',
+	-- where it's displayed (top level if all three are blank):
+	category_id		integer references ec_categories,
+	subcategory_id		integer references ec_subcategories,
+	subsubcategory_id	integer references ec_subsubcategories,
+	last_modified		datetime not null,
+	last_modifying_user	integer not null references users,
+	modified_ip_address	varchar(20) not null
+);
+
+create index ec_product_recommendation_idx on ec_product_recommendations(category_id);
+create index ec_product_recommendation_idx2 on ec_product_recommendations(subcategory_id);
+create index ec_product_recommendation_idx3 on ec_product_recommendations(subsubcategory_id);
+create index ec_product_recommendation_idx4 on ec_product_recommendations(user_class_id);
+create index ec_product_recommendation_idx5 on ec_product_recommendations(active_p);
+
+create table ec_product_recommend_audit (
+	recommendation_id	integer,
+	product_id		integer,
+	user_class_id		integer,
+	recommendation_text	varchar(4000),
+	active_p		char(1) check (active_p in ('f','t')) default 't',
+	category_id		integer,
+	subcategory_id		integer,
+	subsubcategory_id	integer,
+	last_modified		datetime,
+	last_modifying_user	integer,
+	modified_ip_address	varchar(20),
+	delete_p		char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+create function trig_ec_product_recommend_audit_tr() returns opaque
+as '
+declare
+begin
+	insert into ec_product_recommend_audit (
+	recommendation_id, product_id,
+	user_class_id, recommendation_text,
+	active_p, category_id,
+	subcategory_id, subsubcategory_id,
+	last_modified,
+	last_modifying_user, modified_ip_address
+	) values (
+	OLD.recommendation_id, OLD.product_id,
+	OLD.user_class_id, OLD.recommendation_text,
+	OLD.active_p, OLD.category_id,
+	OLD.subcategory_id, OLD.subsubcategory_id,
+	OLD.last_modified,
+	OLD.last_modifying_user, OLD.modified_ip_address	
+	);
+  return new;
+end;
+' language 'plpgsql';
+
+create  trigger ec_product_recommend_audit_tr
+after update or delete on ec_product_recommendations
+for each row
+execute procedure trig_ec_product_recommend_audit_tr();
+
+-- This is going to be a BIG problem for Postgres
+-- For now I'm commenting this out
+-- ben@mit.edu
+--
+--create view ec_recommendations_cats_view as
+--select 
+--  recs.*,
+--  COALESCE(cats.category_id,COALESCE(subs.category_id,subsubs.category_id)) as the_category_id, 
+--  COALESCE(cats.category_name,COALESCE(subs.category_name,subsubs.category_name)) as the_category_name, 
+--  COALESCE(subs.subcategory_id,subsubs.subcategory_id) as the_subcategory_id,
+--  COALESCE(subs.subcategory_name,subsubs.subcategory_name) as the_subcategory_name,
+--  subsubs.subsubcategory_id as the_subsubcategory_id,
+--  subsubs.subsubcategory_name as the_subsubcategory_name
+--from 
+--  ec_product_recommendations recs, 
+--  ec_categories cats, 
+--  ec_subcategories_augmented subs, 
+--  ec_subsubcategories_augmented subsubs
+--where 
+--  recs.category_id = cats.category_id(+)
+--and
+--  recs.subcategory_id = subs.subcategory_id(+)
+--and 
+--  recs.subsubcategory_id = subsubs.subcategory_id(+);
+
+-- one row per customer-user; all the extra info that the ecommerce
+-- system needs
+
+-- untested other than loading into psql dcwickstrom@earthlink.net
+-- 21 Feb, 2001.
+
+create view ec_recommendations_cats_view as
+select 
+  recs.*,
+  (select (case when subs.subcategory_id is null then 
+                     subsubs.subcategory_id 
+                else subs.subcategory_id end) 
+     from ec_subcategories_augmented subs, 
+          ec_subsubcategories_augmented subsubs
+    where recs.subcategory_id = subs.subcategory_id
+      and recs.subsubcategory_id = subsubs.subcategory_id) as the_subcategory_id,
+  (select (case when subs.subcategory_name is null then 
+                     subsubs.subcategory_name 
+                else subs.subcategory_name end) 
+     from ec_subcategories_augmented subs, 
+          ec_subsubcategories_augmented subsubs
+    where recs.subcategory_id = subs.subcategory_id
+      and recs.subsubcategory_id = subsubs.subcategory_id) as the_subcategory_name,
+  (select (case when cats.category_id is null then 
+               (case when subs.category_id is null then 
+                     subsubs.category_id 
+                else subs.category_id end) 
+           else cats.category_id end) 
+     from ec_categories cats, 
+          ec_subcategories_augmented subs, 
+          ec_subsubcategories_augmented subsubs
+    where recs.category_id = cats.category_id
+      and recs.subcategory_id = subs.subcategory_id
+      and recs.subsubcategory_id = subsubs.subcategory_id) as the_category_id,
+  (select (case when cats.category_name is null then 
+               (case when subs.category_name is null then 
+                     subsubs.category_name 
+                else subs.category_name end) 
+           else cats.category_name end) 
+     from ec_categories cats, 
+          ec_subcategories_augmented subs, 
+          ec_subsubcategories_augmented subsubs
+    where recs.category_id = cats.category_id
+      and recs.subcategory_id = subs.subcategory_id
+      and recs.subsubcategory_id = subsubs.subcategory_id) as the_category_name,
+  (select subsubcategory_id 
+     from ec_subsubcategories_augmented 
+    where subcategory_id = recs.subsubcategory_id) as the_subsubcategory_id,
+  (select subsubcategory_name 
+     from ec_subsubcategories_augmented 
+    where subcategory_id = recs.subsubcategory_id) as the_subsubcategory_name
+from 
+  ec_product_recommendations recs;
+
+
+create table ec_user_class_user_map (
+	user_id 		integer not null references users,
+	user_class_id 		integer not null references ec_user_classes,
+	primary key (user_id, user_class_id),
+	user_class_approved_p 	char(1) check (user_class_approved_p in ('f','t')),
+	last_modified		datetime not null,
+	last_modifying_user	integer not null references users,
+	modified_ip_address	varchar(20) not null
+);
+
+create index ec_user_class_user_map_idx on ec_user_class_user_map (user_class_id);
+create index ec_user_class_user_map_idx2 on ec_user_class_user_map (user_class_approved_p);
+
+create table ec_user_class_user_map_audit (
+	user_id 		integer,
+	user_class_id 		integer,
+	user_class_approved_p 	char(1) check (user_class_approved_p in ('f','t')),
+	last_modified		datetime,
+	last_modifying_user	integer,
+	modified_ip_address	varchar(20),
+	delete_p		char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+create function trig_ec_user_class_user_audit_tr() returns opaque
+as '
+declare
+begin
+	insert into ec_user_class_user_map_audit (
+	user_id, user_class_id, user_class_approved_p,
+	last_modified,
+	last_modifying_user, modified_ip_address
+	) values (
+	OLD.user_id, OLD.user_class_id, OLD.user_class_approved_p,
+	OLD.last_modified,
+	OLD.last_modifying_user, OLD.modified_ip_address	
+	);
+  return new;
+end;
+' language 'plpgsql';
+
+create  trigger ec_user_class_user_audit_tr
+after update or delete on ec_user_class_user_map
+for each row
+execute procedure trig_ec_user_class_user_audit_tr();
+
+
+-- this specifies that product_a links to product_b on the display page for product_a
+create table ec_product_links (
+	product_a		integer not null references ec_products,
+	product_b		integer not null references ec_products,
+	last_modified		datetime not null,
+	last_modifying_user	integer not null references users,
+	modified_ip_address	varchar(20) not null,
+	primary key (product_a, product_b)
+);
+
+create index ec_product_links_idx on ec_product_links (product_b);
+
+create table ec_product_links_audit (
+	product_a		integer,
+	product_b		integer,
+	last_modified		datetime,
+	last_modifying_user	integer,
+	modified_ip_address	varchar(20),
+	delete_p		char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+create function trig_ec_product_links_audit() returns opaque
+as '
+declare
+begin
+	insert into ec_product_links_audit (
+	product_a, product_b,
+	last_modified,
+	last_modifying_user, modified_ip_address
+	) values (
+	OLD.product_a, OLD.product_b,
+	OLD.last_modified,
+	OLD.last_modifying_user, OLD.modified_ip_address	
+	);
+  return new;
+end;
+' language 'plpgsql';
+
+create  trigger ec_product_links_audit_tr
+after update or delete on ec_product_links
+for each row
+execute procedure trig_ec_product_links_audit();
+
+create sequence ec_product_comment_id_sequence;
+
+-- comments made by users on the products
+create table ec_product_comments (
+	comment_id		integer not null primary key,
+	product_id		integer not null references ec_products,
+	user_id			integer not null references users,
+	user_comment		varchar(4000),
+	one_line_summary	varchar(300),
+	rating			float4,
+	-- in some systems, the administrator will have to approve comments first
+	approved_p		char(1) check (approved_p is null or approved_p in ('f','t')),
+	comment_date		datetime,
+	last_modified		datetime not null,
+	last_modifying_user	integer not null references users,
+	modified_ip_address	varchar(20) not null
+);
+
+create index ec_product_comments_idx on ec_product_comments(product_id);
+create index ec_product_comments_idx2 on ec_product_comments(user_id);
+create index ec_product_comments_idx3 on ec_product_comments(approved_p);
+
+create table ec_product_comments_audit (
+	comment_id		integer,
+	product_id		integer,
+	user_id			integer,
+	user_comment		varchar(4000),
+	one_line_summary	varchar(300),
+	rating			float4,
+	approved_p		char(1) check (approved_p is null or approved_p in ('f','t')),
+	last_modified		datetime,
+	last_modifying_user	integer,
+	modified_ip_address	varchar(20),
+	delete_p		char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+create function trig_ec_product_comments_audit_tr() returns opaque
+as '
+declare
+begin
+	insert into ec_product_comments_audit (
+	comment_id, product_id, user_id,
+	user_comment, one_line_summary, rating, approved_p,
+	last_modified,
+	last_modifying_user, modified_ip_address
+	) values (
+	OLD.comment_id, OLD.product_id, OLD.user_id,
+	OLD.user_comment, OLD.one_line_summary, OLD.rating, OLD.approved_p,
+	OLD.last_modified,
+	OLD.last_modifying_user, OLD.modified_ip_address	
+	);
+  return new;
+end;
+' language 'plpgsql';
+
+create  trigger ec_product_comments_audit_tr
+after update or delete on ec_product_comments
+for each row
+execute procedure trig_ec_product_comments_audit_tr();
+
+create sequence ec_product_review_id_sequence;
+
+-- reviews made by professionals of the products
+create table ec_product_reviews (
+	review_id		integer not null primary key,
+	product_id		integer not null references ec_products,
+	author_name		varchar(100),
+	publication		varchar(100),
+        review_date             datetime,
+	-- in HTML format
+	review			text,
+	display_p		char(1) check (display_p in ('f','t')),
+	last_modified		datetime not null,
+	last_modifying_user	integer not null references users,
+	modified_ip_address	varchar(20) not null
+);
+
+create index ec_product_reviews_idx on ec_product_reviews (product_id);
+create index ec_product_reviews_idx2 on ec_product_reviews (display_p);
+
+create table ec_product_reviews_audit (
+	review_id		integer,
+	product_id		integer,
+	author_name		varchar(100),
+	publication		varchar(100),
+        review_date             datetime,
+	-- in HTML format
+	review			text,
+	display_p		char(1) check (display_p in ('f','t')),
+	last_modified		datetime,
+	last_modifying_user	integer,
+	modified_ip_address	varchar(20),
+	delete_p		char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+create function trig_ec_product_reviews_audit_tr() returns opaque
+as '
+declare
+begin
+	insert into ec_product_reviews_audit (
+	review_id, product_id,
+	author_name, publication, review_date,
+	review,
+	display_p,
+	last_modified,
+	last_modifying_user, modified_ip_address
+	) values (
+	OLD.review_id, OLD.product_id,
+	OLD.author_name, OLD.publication, OLD.review_date,
+	OLD.review, 
+	OLD.display_p,
+	OLD.last_modified,
+	OLD.last_modifying_user, OLD.modified_ip_address	
+	);
+  return new;
+end;
+' language 'plpgsql';
+
+create  trigger ec_product_reviews_audit_tr
+after update or delete on ec_product_reviews
+for each row
+execute procedure trig_ec_product_reviews_audit_tr();
+
+
+
+-- a product can be in more than one category
+create table ec_category_product_map (
+	product_id		integer not null references ec_products,
+	category_id		integer not null references ec_categories,
+	publisher_favorite_p	char(1) check (publisher_favorite_p is null or publisher_favorite_p in ('f','t')),
+	last_modified		datetime not null,
+	last_modifying_user	integer not null references users,
+	modified_ip_address	varchar(20) not null,
+	primary key (product_id, category_id)
+);
+
+create index ec_category_product_map_idx on ec_category_product_map (category_id);
+create index ec_category_product_map_idx2 on ec_category_product_map (publisher_favorite_p);
+
+create table ec_category_product_map_audit (
+	product_id		integer,
+	category_id		integer,
+	publisher_favorite_p	char(1) check (publisher_favorite_p in ('f','t')),
+	last_modified		datetime,
+	last_modifying_user	integer,
+	modified_ip_address	varchar(20),
+	delete_p		char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+-- ec_category_product_map_audit_tr abbreviated as
+-- ec_cat_prod_map_audit_tr
+create function trig_ec_cat_prod_map_audit_tr() returns opaque
+as '
+declare
+begin
+	insert into ec_category_product_map_audit (
+	product_id, category_id,
+	publisher_favorite_p,
+	last_modified,
+	last_modifying_user, modified_ip_address
+	) values (
+	OLD.product_id, OLD.category_id,
+	OLD.publisher_favorite_p,
+	OLD.last_modified,
+	OLD.last_modifying_user, OLD.modified_ip_address		
+	);
+  return new;
+end;
+' language 'plpgsql';
+
+create  trigger ec_cat_prod_map_audit_tr
+after update or delete on ec_category_product_map
+for each row
+execute procedure trig_ec_cat_prod_map_audit_tr();
+
+create table ec_subcategory_product_map (
+	product_id		integer not null references ec_products,
+	subcategory_id		integer not null references ec_subcategories,
+	publisher_favorite_p	char(1) check (publisher_favorite_p in ('f','t')),
+	last_modified		datetime not null,
+	last_modifying_user	integer not null references users,
+	modified_ip_address	varchar(20) not null,
+	primary key (product_id, subcategory_id)
+);
+
+create index ec_subcat_product_map_idx on ec_subcategory_product_map (subcategory_id);
+create index ec_subcat_product_map_idx2 on ec_subcategory_product_map (publisher_favorite_p);
+
+-- ec_subcategory_product_map_audit abbreviated as
+create table ec_subcat_prod_map_audit (
+	product_id		integer,
+	subcategory_id		integer,
+	publisher_favorite_p	char(1) check (publisher_favorite_p in ('f','t')),
+	last_modified		datetime,
+	last_modifying_user	integer,
+	modified_ip_address	varchar(20),
+	delete_p		char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+create function trig_ec_subcat_prod_map_audit_tr() returns opaque
+as '
+declare
+begin
+	insert into ec_subcat_prod_map_audit (
+	product_id, subcategory_id,
+	publisher_favorite_p,
+	last_modified,
+	last_modifying_user, modified_ip_address
+	) values (
+	OLD.product_id, OLD.subcategory_id,
+	OLD.publisher_favorite_p,
+	OLD.last_modified,
+	OLD.last_modifying_user, OLD.modified_ip_address		
+	);
+  return new;
+end;
+' language 'plpgsql';
+
+-- ec_subcat_prod_map_audit_tr
+create  trigger ec_subcat_prod_map_audit_tr
+after update or delete on ec_subcategory_product_map
+for each row
+execute procedure trig_ec_subcat_prod_map_audit_tr();
+
+create table ec_subsubcategory_product_map (
+	product_id		integer not null references ec_products,
+	subsubcategory_id	integer not null references ec_subsubcategories,
+	publisher_favorite_p	char(1) check (publisher_favorite_p in ('f','t')),
+	last_modified		datetime not null,
+	last_modifying_user	integer not null references users,
+	modified_ip_address	varchar(20) not null,
+	primary key (product_id, subsubcategory_id)
+);
+
+create index ec_subsubcat_prod_map_idx on ec_subsubcategory_product_map (subsubcategory_id);
+create index ec_subsubcat_prod_map_idx2 on ec_subsubcategory_product_map (publisher_favorite_p);
+
+create table ec_subsubcat_prod_map_audit (
+	product_id		integer,
+	subsubcategory_id	integer,
+	publisher_favorite_p	char(1) check (publisher_favorite_p in ('f','t')),
+	last_modified		datetime,
+	last_modifying_user	integer,
+	modified_ip_address	varchar(20),
+	delete_p		char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+create function trig_ec_subsubcat_prod_map_audit_tr() returns opaque
+as '
+declare
+begin
+	insert into ec_subsubcat_prod_map_audit (
+	product_id, subsubcategory_id,
+	publisher_favorite_p,
+	last_modified,
+	last_modifying_user, modified_ip_address
+	) values (
+	OLD.product_id, OLD.subsubcategory_id,
+	OLD.publisher_favorite_p,
+	OLD.last_modified,
+	OLD.last_modifying_user, OLD.modified_ip_address		
+	);
+  return new;
+end;
+' language 'plpgsql';
+
+create  trigger ec_subsubcat_prod_map_audit_tr
+after update or delete on ec_subsubcategory_product_map
+for each row
+execute procedure trig_ec_subsubcat_prod_map_audit_tr();
+
+-- A template can have more than 1 category associated
+-- with it, but a category can have at most one template.
+-- When a product is added in a given category, its template
+-- will default to the one associated with its category (if
+-- the product is in more than 1 category, it'll get the
+-- template associated with one of its categories), although
+-- the admin can always associate a product with any category
+-- they want.
+create table ec_category_template_map (
+	category_id		integer not null primary key references ec_categories,
+	template_id		integer not null references ec_templates
+);
+
+create index ec_category_template_map_idx on ec_category_template_map (template_id);
+
+
+-- I could in theory make some hairy system that lets them specify
+-- what kind of form element each field will have, does 
+-- error checking, etc., but I don't think it's necessary since it's 
+-- just the site administrator using it.  So here's a very simple
+-- table to store the custom product fields:
+create table ec_custom_product_fields (
+	field_identifier	varchar(100) not null primary key,
+	field_name		varchar(100),
+	default_value		varchar(100),
+	-- column type for oracle (i.e. text, varchar(50), integer, ...)
+	column_type		varchar(100),
+	creation_date		datetime,
+	active_p		char(1) check (active_p in ('f','t')) default 't',
+	last_modified		datetime not null,
+	last_modifying_user	integer not null references users,
+	modified_ip_address	varchar(20) not null
+);
+
+create table ec_custom_product_fields_audit (
+	field_identifier	varchar(100),
+	field_name		varchar(100),
+	default_value		varchar(100),
+	column_type		varchar(100),
+	creation_date		datetime,
+	active_p		char(1) check (active_p in ('f','t')) default 't',
+	last_modified		datetime,
+	last_modifying_user	integer,
+	modified_ip_address	varchar(20),
+	delete_p		char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+create function trig_ec_custom_prod_fields_audit_tr() returns opaque 
+as '
+declare
+begin
+	insert into ec_custom_product_fields_audit (
+	field_identifier, field_name,
+	default_value, column_type,
+	creation_date, active_p,
+	last_modified,
+	last_modifying_user, modified_ip_address
+	) values (
+	OLD.field_identifier, OLD.field_name,
+	OLD.default_value, OLD.column_type,
+	OLD.creation_date, OLD.active_p,
+	OLD.last_modified,
+	OLD.last_modifying_user, OLD.modified_ip_address		
+	);
+  return new;
+end;
+' language 'plpgsql';
+
+create  trigger ec_custom_prod_fields_audit_tr
+after update or delete on ec_custom_product_fields
+for each row
+execute procedure trig_ec_custom_prod_fields_audit_tr();
+
+-- more columns are added to this table (by Tcl scripts) when the 
+-- administrator adds custom product fields
+-- the columns in this table have the name of the field_identifiers
+-- in ec_custom_product_fields
+-- this table stores the values
+create table ec_custom_product_field_values (
+	product_id		integer not null primary key references ec_products,
+	last_modified		datetime not null,
+	last_modifying_user	integer not null references users,
+	modified_ip_address	varchar(20) not null
+);
+
+create table ec_custom_p_field_values_audit (
+	product_id		integer,
+	last_modified		datetime,
+	last_modifying_user	integer,
+	modified_ip_address	varchar(20),
+	delete_p		char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+create function trig_ec_custom_p_f_values_audit_tr() returns opaque
+as '
+declare
+begin
+	insert into ec_custom_p_field_values_audit (
+	product_id,
+	last_modified,
+	last_modifying_user, modified_ip_address
+	) values (
+	OLD.product_id,
+	OLD.last_modified,
+	OLD.last_modifying_user, OLD.modified_ip_address	
+	);
+  return new;
+end;
+' language 'plpgsql';
+
+create  trigger ec_custom_p_f_values_audit_tr
+after update or delete on ec_custom_product_field_values
+for each row
+execute procedure trig_ec_custom_p_f_values_audit_tr();
+
+
+create sequence ec_user_session_sequence;
+
+create table ec_user_sessions (
+	user_session_id		integer not null primary key,
+	-- often will not be known
+	user_id			integer references users,
+	ip_address		varchar(20) not null,
+	start_time		datetime,
+	http_user_agent		varchar(4000)
+);
+
+create index ec_user_sessions_idx on ec_user_sessions(user_id);
+
+create table ec_user_session_info (
+	user_session_id		integer not null references ec_user_sessions,
+	product_id		integer references ec_products,
+	category_id		integer references ec_categories,
+	search_text		varchar(200)
+);
+
+create index ec_user_session_info_idx  on ec_user_session_info (user_session_id);
+create index ec_user_session_info_idx2 on ec_user_session_info (product_id);
+create index ec_user_session_info_idx3 on ec_user_session_info (category_id);
+
+-- If a user comes to product.tcl with an offer_code in the url,
+-- I'm going to shove it into this table and then check this
+-- table each time I try to determine the price for the users'
+-- products.  The alternative is to store the offer_codes in a
+-- cookie and look at that each time I try to determine the price
+-- for a product.  But I think this will be a little faster.
+
+create table ec_user_session_offer_codes (
+	user_session_id		integer not null references ec_user_sessions,
+	product_id		integer not null references ec_products,
+	offer_code		varchar(20) not null,
+	primary key (user_session_id, product_id)
+);
+
+-- create some indices
+create index ec_u_s_offer_codes_by_u_s_id on ec_user_session_offer_codes(user_session_id);
+create index ec_u_s_offer_codes_by_p_id on ec_user_session_offer_codes(product_id);
+
+create sequence ec_order_id_sequence;
+
+create table ec_orders (
+	order_id	integer not null primary key,
+	-- can be null, until they've checked out or saved their basket
+	user_id			integer references users,
+	user_session_id		integer references ec_user_sessions,
+	order_state	varchar(50) default 'in_basket' not null,
+	shipping_method	varchar(20),	-- express or standard
+	shipping_address	integer references ec_addresses(address_id),
+	-- store credit card info in a different table
+	creditcard_id	integer references ec_creditcards(creditcard_id),
+	-- information recorded upon FSM state changes
+	-- we need this to figure out if order is stale
+	-- and should be offered up for removal
+	in_basket_date		datetime,
+	confirmed_date		datetime,
+	authorized_date		datetime,
+	voided_date		datetime,
+	expired_date		datetime,
+	-- base shipping, which is added to the amount charged for each item
+	shipping_charged	numeric,
+	shipping_refunded	numeric,
+	shipping_tax_charged	numeric,
+	shipping_tax_refunded	numeric,
+	-- entered by customer service
+	cs_comments		varchar(4000),
+	reason_for_void		varchar(4000),
+	voided_by		integer references users,
+	-- if the user chooses to save their shopping cart
+	saved_p			char(1) check (saved_p is null or saved_p in ('f','t')),
+	 check (user_id is not null or user_session_id is not null)
+);
+
+create index ec_orders_by_user_idx on ec_orders (user_id);
+create index ec_orders_by_user_sess_idx on ec_orders (user_session_id);
+create index ec_orders_by_credit_idx on ec_orders (creditcard_id);
+create index ec_orders_by_addr_idx on ec_orders (shipping_address);
+create index ec_orders_by_conf_idx on ec_orders (confirmed_date);
+create index ec_orders_by_state_idx on ec_orders (order_state);
+
+-- note that an order could essentially become uninteresting for financial
+-- accounting if all the items underneath it are individually voided or returned
+
+create view ec_orders_reportable
+as 
+select * 
+from ec_orders 
+where order_state <> 'in_basket'
+and order_state <> 'void';
+
+-- orders that have items which still need to be shipped
+create view ec_orders_shippable
+as
+select *
+from ec_orders
+where order_state in ('authorized_plus_avs','authorized_minus_avs','partially_fulfilled');
+
+
+-- this is needed because orders might be only partially shipped
+create sequence ec_shipment_id_sequence;
+
+create table ec_shipments (
+	shipment_id		integer not null primary key,
+	order_id		integer not null references ec_orders,
+	-- usually, but not necessarily, the same as the shipping_address
+	-- in ec_orders because a customer may change their address between
+	-- shipments.
+	-- a trigger fills address_id in automatically if it's null
+	address_id		integer not null references ec_addresses,
+	shipment_date		datetime not null,
+	expected_arrival_date	datetime,
+	carrier			varchar(50),	-- e.g., 'fedex'
+	tracking_number		varchar(24),
+	-- only if we get confirmation from carrier that the goods
+	-- arrived on a specific date
+	actual_arrival_date	datetime,
+	-- arbitrary info from carrier, e.g., 'Joe Smith signed for it'
+	actual_arrival_detail	varchar(4000),
+	last_modified		datetime,
+	last_modifying_user	integer,
+	modified_ip_address	varchar(20)
+);
+
+create index ec_shipments_by_order_id on ec_shipments(order_id);
+create index ec_shipments_by_shipment_date on ec_shipments(shipment_date);
+
+-- fills address_id into ec_shipments if it's missing
+-- (using the shipping_address associated with the order)
+create function trig_ec_shipment_address_update_tr() returns opaque
+as '
+declare
+	v_address_id		ec_addresses.address_id%TYPE;
+begin
+	select shipping_address into v_address_id from ec_orders where order_id= NEW.order_id;
+	IF NEW.address_id is null THEN
+		NEW.address_id := v_address_id;
+		return NEW;
+	END IF;
+  return new;
+end;
+' language 'plpgsql';
+
+create  trigger ec_shipment_address_update_tr
+before insert on ec_shipments
+for each row
+execute procedure trig_ec_shipment_address_update_tr();
+
+
+create table ec_shipments_audit (
+	shipment_id		integer,
+	order_id		integer,
+	address_id		integer,
+	shipment_date		datetime,
+	expected_arrival_date	datetime,
+	carrier			varchar(50),
+	tracking_number		varchar(24),
+	actual_arrival_date	datetime,
+	actual_arrival_detail	varchar(4000),
+	last_modified		datetime,
+	last_modifying_user	integer,
+	modified_ip_address	varchar(20),
+	delete_p		char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+create function trig_ec_shipments_audit_tr() returns opaque
+as '
+declare
+begin
+	insert into ec_shipments_audit (
+	shipment_id, order_id, address_id,
+	shipment_date, 
+	expected_arrival_date,
+	carrier, tracking_number,
+	actual_arrival_date, actual_arrival_detail,
+	last_modified,
+	last_modifying_user, modified_ip_address
+	) values (
+	OLD.shipment_id, OLD.order_id, OLD.address_id,
+	OLD.shipment_date,
+	OLD.expected_arrival_date,
+	OLD.carrier, OLD.tracking_number,
+	OLD.actual_arrival_date, OLD.actual_arrival_detail,
+	OLD.last_modified,
+	OLD.last_modifying_user, OLD.modified_ip_address	
+	);
+  return new;
+end;
+' language 'plpgsql';
+
+create  trigger ec_shipments_audit_tr
+after update or delete on ec_shipments
+for each row
+execute procedure trig_ec_shipments_audit_tr();
+
+
+create sequence refund_id_sequence;
+
+create table ec_refunds (
+	refund_id	integer not null primary key,
+	order_id	integer not null references ec_orders,
+	-- not really necessary because it's in ec_financial_transactions
+	refund_amount	numeric not null,
+	refund_date	datetime not null,
+	refunded_by	integer not null references users,
+	refund_reasons	varchar(4000)
+);
+
+create index ec_refunds_by_order_idx on ec_refunds (order_id);
+
+-- these are the items that make up each order
+create sequence ec_item_id_sequence;
+
+create table ec_items (
+	item_id		integer not null primary key,
+	product_id	integer not null references ec_products,
+	color_choice    varchar(4000),
+	size_choice     varchar(4000),
+	style_choice    varchar(4000),
+	order_id	integer not null references ec_orders,
+	shipment_id	integer references ec_shipments,
+	-- this is the date that user put this item into their shopping basket
+	in_cart_date	datetime,
+	voided_date	datetime,
+	voided_by	integer references users,
+	expired_date	datetime,
+	item_state	varchar(50) default 'in_basket',
+	-- NULL if not received back
+	received_back_date	datetime,
+	-- columns for reporting (e.g., what was done, what was made)
+	price_charged		numeric,
+	price_refunded		numeric,
+	shipping_charged	numeric,
+	shipping_refunded	numeric,
+	price_tax_charged	numeric,
+	price_tax_refunded	numeric,
+	shipping_tax_charged	numeric,
+	shipping_tax_refunded	numeric,
+	-- like Our Price or Sale Price or Introductory Price
+	price_name		varchar(30),
+	-- did we go through a merchant-initiated refund?
+	refund_id		integer references ec_refunds,
+	-- comments entered by customer service (CS)
+	cs_comments		varchar(4000)
+);
+
+create index ec_items_by_product on ec_items(product_id);
+create index ec_items_by_order on ec_items(order_id);
+create index ec_items_by_shipment on ec_items(shipment_id);
+
+create view ec_items_reportable 
+as 
+select * 
+from ec_items
+where item_state in ('to_be_shipped', 'shipped', 'arrived');
+
+create view ec_items_refundable
+as
+select *
+from ec_items
+where item_state in ('shipped','arrived')
+and refund_id is null;
+
+create view ec_items_shippable
+as
+select *
+from ec_items
+where item_state in ('to_be_shipped');
+
+-- This view displays:
+-- order_id
+-- shipment_date
+-- bal_price_charged sum(price_charged - price_refunded) for all items in the shipment
+-- bal_shipping_charged
+-- bal_tax_charged
+-- The purpose: payment is recognized when an item ships so this sums the various
+-- parts of payment (price, shipping, tax) for all the items in each shipment
+
+-- DRB: this view is never used and blows out Postgres, which thinks
+-- it's too large even with a block size of (gulp) 16384!
+
+-- create view ec_items_numeric_view
+-- as
+-- select i.shipment_id, i.order_id, s.shipment_date, COALESCE(sum(i.price_charged),0) - COALESCE(sum(i.price_refunded),0) as bal_price_charged,
+-- COALESCE(sum(i.shipping_charged),0) - COALESCE(sum(i.shipping_refunded),0) as bal_shipping_charged,
+-- COALESCE(sum(i.price_tax_charged),0) - COALESCE(sum(i.price_tax_refunded),0) + COALESCE(sum(i.shipping_tax_charged),0)
+--   - COALESCE(sum(i.shipping_tax_refunded),0) as bal_tax_charged
+-- from ec_items i, ec_shipments s
+-- where i.shipment_id=s.shipment_id
+-- and i.item_state <> 'void'
+-- group by i.order_id, i.shipment_id, s.shipment_date;
+
+-- a set of triggers to update order_state based on what happens
+-- to the items in the order
+-- partially_fulfilled: some but not all non-void items have shipped
+-- fulfilled: all non-void items have shipped
+-- returned: all non-void items received_back
+-- void: all items void
+-- We're not interested in partial returns.
+
+-- this is hellish because you can't select a count of the items
+-- in a given item_state from ec_items when you're updating ec_items,
+-- so we have to do a horrid "trio" (temporary table, row level trigger,
+-- system level trigger) as discussed in
+-- http://photo.net/doc/site-wide-search.html (we use a temporary
+-- table instead of a package because they're better)
+
+-- BMA for ACS/pg: heh heh heh, except in Postgres, things are much 
+-- better, and we don't need this trio stuff. Which is quite convenient
+-- given that statement level triggers don't exist yet.
+
+create function trig_ec_order_state_after_tr() returns opaque
+as '
+declare
+	v_order_id		integer;
+	n_items			integer;
+	n_shipped_items		integer;
+	n_received_back_items	integer;
+	n_void_items		integer;
+	n_nonvoid_items		integer;
+
+begin
+	select count(*) into n_items from ec_items where order_id= NEW.order_id;
+	select count(*) into n_shipped_items from ec_items where order_id= NEW.order_id and item_state=''shipped'' or item_state=''arrived'';
+	select count(*) into n_received_back_items from ec_items where order_id= NEW.order_id and item_state=''received_back'';
+	select count(*) into n_void_items from ec_items where order_id= NEW.order_id and item_state=''void'';
+
+	IF n_items = n_void_items THEN
+		update ec_orders set order_state=''void'', voided_date=current_timestamp where order_id= NEW.order_id;
+	ELSE
+		n_nonvoid_items := n_items - n_void_items;
+		IF n_nonvoid_items = n_received_back_items THEN
+			update ec_orders set order_state=''returned'' where order_id= NEW.order_id;
+		ELSE
+			IF n_nonvoid_items = n_received_back_items + n_shipped_items THEN
+			   update ec_orders set order_state=''fulfilled'' where order_id= NEW.order_id;
+			ELSE 
+			     IF n_shipped_items >= 1 or n_received_back_items >=1 THEN
+				update ec_orders set order_state=''partially_fulfilled'' where order_id= NEW.order_id;
+			     END IF;
+			END IF;
+		END IF;
+	END IF;
+        RETURN NEW;
+end;
+' language 'plpgsql';
+
+create  trigger ec_order_state_after_tr
+after update on ec_items
+for each row
+execute procedure trig_ec_order_state_after_tr();
+
+-- this is a 1-row table
+-- it contains all settings that the admin can change from the admin pages
+-- most of the configuration is done using the parameters .ini file
+create table ec_admin_settings (
+	-- this is here just so that the insert statement (a page or
+	-- so down) can't be executed twice
+	admin_setting_id		integer not null primary key,	
+	-- the following columns are related to shipping costs
+	base_shipping_cost		numeric,
+	default_shipping_per_item	numeric,
+	weight_shipping_cost		numeric,
+	add_exp_base_shipping_cost	numeric,
+	add_exp_amount_per_item		numeric,
+	add_exp_amount_by_weight	numeric,
+	-- default template to use if the product isn't assigned to one
+	-- (until the admin changes it, it will be 1, which will be
+	-- the preloaded template)
+	default_template	integer default 1 not null references ec_templates,
+	last_modified		datetime not null,
+	last_modifying_user	integer not null references users,
+	modified_ip_address	varchar(20) not null
+);
+
+create table ec_admin_settings_audit (
+	admin_setting_id		integer,
+	base_shipping_cost		numeric,
+	default_shipping_per_item	numeric,
+	weight_shipping_cost		numeric,
+	add_exp_base_shipping_cost	numeric,
+	add_exp_amount_per_item		numeric,
+	add_exp_amount_by_weight	numeric,
+	default_template	integer,
+	last_modified		datetime,
+	last_modifying_user	integer,
+	modified_ip_address	varchar(20),
+	delete_p		char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+create function trig_ec_admin_settings_audit_tr() returns opaque
+as '
+declare
+begin
+	insert into ec_admin_settings_audit (
+	admin_setting_id, base_shipping_cost, default_shipping_per_item,
+	weight_shipping_cost, add_exp_base_shipping_cost,
+	add_exp_amount_per_item, add_exp_amount_by_weight,
+	default_template,
+	last_modified,
+	last_modifying_user, modified_ip_address
+	) values (
+	OLD.admin_setting_id, OLD.base_shipping_cost, OLD.default_shipping_per_item,
+	OLD.weight_shipping_cost, OLD.add_exp_base_shipping_cost,
+	OLD.add_exp_amount_per_item, OLD.add_exp_amount_by_weight,
+	OLD.default_template,
+	OLD.last_modified,
+	OLD.last_modifying_user, OLD.modified_ip_address	
+	);
+  return new;
+end;
+' language 'plpgsql';
+
+create  trigger ec_admin_settings_audit_tr
+after update or delete on ec_admin_settings
+for each row
+execute procedure trig_ec_admin_settings_audit_tr();
+
+-- put one row into ec_admin_settings so that I don't have to use 0or1row
+insert into ec_admin_settings (
+	admin_setting_id,
+	default_template,
+	last_modified,
+	last_modifying_user, modified_ip_address
+	) values (
+	1,
+	1,
+	current_timestamp,
+	1, 'none');
+
+-- this is populated by the rules the administrator sets in /admin/ecommerce/sales-tax.tcl
+create table ec_sales_tax_by_state (
+	usps_abbrev		char(2) not null primary key references states,
+	-- this a decimal number equal to the percentage tax divided by 100
+	tax_rate		float4 not null,
+	-- charge tax on shipping?
+	shipping_p		char(1) check (shipping_p in ('f','t')) not null,
+	last_modified		datetime not null,
+	last_modifying_user	integer not null references users,
+	modified_ip_address	varchar(20) not null
+);
+
+create table ec_sales_tax_by_state_audit (
+	usps_abbrev		char(2),
+	tax_rate		float4,
+	shipping_p		char(1) check (shipping_p in ('f','t')),
+	last_modified		datetime,
+	last_modifying_user	integer,
+	modified_ip_address	varchar(20),
+	delete_p		char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+create function trig_ec_sales_tax_by_state_audit_tr() returns opaque
+as '
+declare
+begin
+	insert into ec_sales_tax_by_state_audit (
+	usps_abbrev, tax_rate,
+	shipping_p,
+	last_modified,
+	last_modifying_user, modified_ip_address
+	) values (
+	OLD.usps_abbrev, OLD.tax_rate,
+	OLD.shipping_p,
+	OLD.last_modified,
+	OLD.last_modifying_user, OLD.modified_ip_address		
+	);
+  return new;
+end;
+' language 'plpgsql';
+
+create  trigger ec_sales_tax_by_state_audit_tr
+after update on ec_sales_tax_by_state
+for each row
+execute procedure trig_ec_sales_tax_by_state_audit_tr();
+
+-- these tables are used if MultipleRetailersPerProductP is 1 in the
+-- parameters .ini file
+
+create sequence ec_retailer_sequence;
+
+create table ec_retailers (
+	retailer_id		integer not null primary key,
+	retailer_name		varchar(300),
+	primary_contact_name	varchar(100),
+	secondary_contact_name	varchar(100),
+	primary_contact_info	varchar(4000),
+	secondary_contact_info	varchar(4000),
+	line1			varchar(100),
+	line2			varchar(100),
+	city			varchar(100),
+	-- state
+	usps_abbrev	char(2) references states,
+	-- big enough to hold zip+4 with dash
+	zip_code		varchar(10),
+	phone			varchar(30),
+	fax			varchar(30),
+	-- for international addresses
+	country_code		char(2) references country_codes(iso),
+	--national, local, international
+	reach			varchar(15) check (reach in ('national','local','international','regional','web')),
+	url			varchar(200),
+	-- space-separated list of states in which tax must be collected
+	nexus_states		varchar(200),
+	financing_policy	varchar(4000),
+	return_policy		varchar(4000),
+	price_guarantee_policy	varchar(4000),
+	delivery_policy		varchar(4000),
+	installation_policy	varchar(4000),
+	last_modified		datetime not null,
+	last_modifying_user	integer not null references users,
+	modified_ip_address	varchar(20) not null
+);
+
+create table ec_retailers_audit (
+	retailer_id		integer,
+	retailer_name		varchar(300),
+	primary_contact_name	varchar(100),
+	secondary_contact_name	varchar(100),
+	primary_contact_info	varchar(4000),
+	secondary_contact_info	varchar(4000),
+	line1		varchar(100),
+	line2		varchar(100),
+	city		varchar(100),
+	usps_abbrev	char(2),
+	zip_code	varchar(10),
+	phone		varchar(30),
+	fax		varchar(30),
+	country_code	char(2),
+	reach		varchar(15) check (reach in ('national','local','international','regional','web')),
+	url		varchar(200),
+	nexus_states	varchar(200),
+	financing_policy	varchar(4000),
+	return_policy		varchar(4000),
+	price_guarantee_policy	varchar(4000),
+	delivery_policy		varchar(4000),
+	installation_policy	varchar(4000),
+	last_modified		datetime,
+	last_modifying_user	integer,
+	modified_ip_address	varchar(20),
+	delete_p		char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+create function trig_ec_retailers_audit_tr() returns opaque
+as '
+declare
+begin
+	insert into ec_retailers_audit (
+	retailer_id, retailer_name,
+	primary_contact_name, secondary_contact_name,
+	primary_contact_info, secondary_contact_info,
+	line1, line2,
+	city, usps_abbrev,
+	zip_code, phone,
+	fax, country_code,
+	reach, url,
+	nexus_states, financing_policy,
+	return_policy, price_guarantee_policy,
+	delivery_policy, installation_policy,
+	last_modified,
+	last_modifying_user, modified_ip_address
+	) values (
+	OLD.retailer_id, OLD.retailer_name,
+	OLD.primary_contact_name, OLD.secondary_contact_name,
+	OLD.primary_contact_info, OLD.secondary_contact_info,
+	OLD.line1, OLD.line2,
+	OLD.city, OLD.usps_abbrev,
+	OLD.zip_code, OLD.phone,
+	OLD.fax, OLD.country_code,
+	OLD.reach, OLD.url,
+	OLD.nexus_states, OLD.financing_policy,
+	OLD.return_policy, OLD.price_guarantee_policy,
+	OLD.delivery_policy, OLD.installation_policy,
+	OLD.last_modified,
+	OLD.last_modifying_user, OLD.modified_ip_address	
+	);
+  return new;
+end;
+' language 'plpgsql';
+
+create  trigger ec_retailers_audit_tr
+after update or delete on ec_retailers
+for each row
+execute procedure trig_ec_retailers_audit_tr();
+
+
+create sequence ec_retailer_location_sequence;
+
+create table ec_retailer_locations (
+        retailer_location_id    integer not null primary key,
+        retailer_id             integer not null references ec_retailers,
+        location_name           varchar(300),
+        primary_contact_name    varchar(100),
+        secondary_contact_name  varchar(100),
+        primary_contact_info    varchar(4000),
+        secondary_contact_info  varchar(4000),
+        line1                   varchar(100),
+        line2                   varchar(100),
+        city                    varchar(100),
+        -- state
+        usps_abbrev     char(2) references states,
+        -- big enough to hold zip+4 with dash
+        zip_code                varchar(10),
+        phone                   varchar(30),
+        fax                     varchar(30),
+        -- for international addresses
+        country_code            char(2) references country_codes(iso),
+        url                     varchar(200),
+        financing_policy        varchar(4000),
+        return_policy           varchar(4000),
+        price_guarantee_policy  varchar(4000),
+        delivery_policy         varchar(4000),
+        installation_policy     varchar(4000),
+        last_modified           datetime not null,
+        last_modifying_user     integer not null references users,
+        modified_ip_address     varchar(20) not null
+);
+
+create table ec_retailer_locations_audit (
+        retailer_location_id    integer,
+        retailer_id             integer,
+        location_name           varchar(300),
+        primary_contact_name    varchar(100),
+        secondary_contact_name  varchar(100),
+        primary_contact_info    varchar(4000),
+        secondary_contact_info  varchar(4000),
+        line1           varchar(100),
+        line2           varchar(100),
+        city            varchar(100),
+        usps_abbrev     char(2),
+        zip_code        varchar(10),
+        phone           varchar(30),
+        fax             varchar(30),
+        country_code    char(2),
+        url             varchar(200),
+        financing_policy        varchar(4000),
+        return_policy           varchar(4000),
+        price_guarantee_policy  varchar(4000),
+        delivery_policy         varchar(4000),
+        installation_policy     varchar(4000),
+        last_modified           datetime,
+        last_modifying_user     integer,
+        modified_ip_address     varchar(20),
+        delete_p                char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+create function trig_ec_retailer_locations_audit_tr() returns opaque
+as '
+declare
+begin
+        insert into ec_retailer_locations_audit (
+        retailer_location_id, retailer_id, location_name,
+        primary_contact_name, secondary_contact_name,
+        primary_contact_info, secondary_contact_info,
+        line1, line2,
+        city, usps_abbrev,
+        zip_code, phone,
+        fax, country_code,
+        url, financing_policy,
+        return_policy, price_guarantee_policy,
+        delivery_policy, installation_policy,
+        last_modified,
+        last_modifying_user, modified_ip_address
+        ) values (
+        OLD.retailer_location_id,
+        OLD.retailer_id, OLD.location_name,
+        OLD.primary_contact_name, OLD.secondary_contact_name,
+        OLD.primary_contact_info, OLD.secondary_contact_info,
+        OLD.line1, OLD.line2,
+        OLD.city, OLD.usps_abbrev,
+        OLD.zip_code, OLD.phone,
+        OLD.fax, OLD.country_code,
+        OLD.url, OLD.financing_policy,
+        OLD.return_policy, OLD.price_guarantee_policy,
+        OLD.delivery_policy, OLD.installation_policy,
+        OLD.last_modified,
+        OLD.last_modifying_user, OLD.modified_ip_address
+        );
+  return new;
+end;
+' language 'plpgsql';
+
+
+create  trigger ec_retailer_locations_audit_tr
+after update or delete on ec_retailer_locations
+for each row
+execute procedure trig_ec_retailer_locations_audit_tr();
+
+
+create sequence ec_offer_sequence;
+
+create table ec_offers (
+        offer_id                integer not null primary key,
+        product_id              integer not null references ec_products,
+        retailer_location_id    integer not null references ec_retailer_locations,
+        store_sku               integer,
+        retailer_premiums       varchar(500),
+        price                   numeric not null,
+        shipping                numeric,
+        shipping_unavailable_p  char(1) check (shipping_unavailable_p in ('f','t')),
+        -- o = out of stock, q = ships quickly, m = ships
+        -- moderately quickly, s = ships slowly, i = in stock
+        -- with no message about the speed of the shipment (shipping
+        -- messages are in parameters .ini file)
+        stock_status            char(1) check (stock_status in ('o','q','m','s','i')),
+        special_offer_p         char(1) check (special_offer_p in ('f','t')),
+        special_offer_html      varchar(500),
+        offer_begins            datetime not null,
+        offer_ends              datetime not null,
+        deleted_p               char(1) check (deleted_p in ('f','t')) default 'f',
+        last_modified           datetime not null,
+        last_modifying_user     integer not null references users,
+        modified_ip_address     varchar(20) not null
+);
+
+create view ec_offers_current
+as
+select * from ec_offers
+where deleted_p='f'
+and current_timestamp>= offer_begins
+and current_timestamp<= offer_ends;
+
+
+create table ec_offers_audit (
+        offer_id                integer,
+        product_id              integer,
+        retailer_location_id    integer,
+        store_sku               integer,
+        retailer_premiums       varchar(500),
+        price                   numeric,
+        shipping                numeric,
+        shipping_unavailable_p  char(1) check (shipping_unavailable_p in ('f','t')),
+        stock_status            char(1) check (stock_status in ('o','q','m','s','i')),
+        special_offer_p         char(1) check (special_offer_p in ('f','t')),
+        special_offer_html      varchar(500),
+        offer_begins            datetime,
+        offer_ends              datetime,
+        deleted_p               char(1) check (delete_p in ('f','t')) default 'f',
+        last_modified           datetime,
+        last_modifying_user     integer,
+        modified_ip_address     varchar(20),
+        -- This differs from the deleted_p column!
+        -- deleted_p refers to the user request to stop offering
+        -- delete_p indicates the row has been deleted from the main offers table
+        delete_p                char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+create function trig_ec_offers_audit_tr() returns opaque
+as '
+declare
+begin
+        insert into ec_offers_audit (
+        offer_id,
+        product_id, retailer_location_id,
+        store_sku, retailer_premiums,
+        price, shipping,
+        shipping_unavailable_p, stock_status,
+        special_offer_p, special_offer_html,
+        offer_begins, offer_ends,
+        deleted_p,
+        last_modified,
+        last_modifying_user, modified_ip_address
+        ) values (
+        OLD.offer_id,
+        OLD.product_id, OLD.retailer_location_id,
+        OLD.store_sku, OLD.retailer_premiums,
+        OLD.price, OLD.shipping,
+        OLD.shipping_unavailable_p, OLD.stock_status,
+        OLD.special_offer_p, OLD.special_offer_html,
+        OLD.offer_begins, OLD.offer_ends,
+        OLD.deleted_p,
+        OLD.last_modified,
+        OLD.last_modifying_user, OLD.modified_ip_address
+        );
+  return new;
+end;
+' language 'plpgsql';
+
+create  trigger ec_offers_audit_tr
+after update or delete on ec_offers
+for each row
+execute procedure trig_ec_offers_audit_tr();
+
+-- Gift certificate stuff ----
+------------------------------
+
+create sequence ec_gift_cert_id_sequence;
+
+create table ec_gift_certificates (
+	gift_certificate_id	integer primary key,
+	gift_certificate_state	varchar(50) not null,
+	amount			numeric not null,
+	-- a trigger will update this to f if the
+	-- entire amount is used up (to speed up
+	-- queries)
+	amount_remaining_p	char(1) check (amount_remaining_p in ('f','t')) default 't',
+	issue_date		datetime,
+	authorized_date		datetime,
+	claimed_date		datetime,
+	-- customer service rep who issued it
+	issued_by		integer references users,
+	-- customer who purchased it
+	purchased_by		integer references users,
+	expires			datetime,
+	user_id			integer references users,
+	-- if it's unclaimed, claim_check will be filled in,
+	-- and user_id won't be filled in
+	-- claim check should be unique (one way to do this
+	-- is to always begin it with "$gift_certificate_id-")
+	claim_check		varchar(50),
+	certificate_message	varchar(200),
+	certificate_to		varchar(100),
+	certificate_from	varchar(100),
+	recipient_email		varchar(100),
+	voided_date		datetime,
+	voided_by		integer references users,
+	reason_for_void		varchar(4000),
+	last_modified		datetime not null,
+	last_modifying_user	integer not null references users,
+	modified_ip_address	varchar(20) not null,
+	 check (user_id is not null or claim_check is not null)
+);
+
+create index ec_gc_by_state on ec_gift_certificates(gift_certificate_state);
+create index ec_gc_by_amount_remaining on ec_gift_certificates(amount_remaining_p);
+create index ec_gc_by_user on ec_gift_certificates(user_id);
+create index ec_gc_by_claim_check on ec_gift_certificates(claim_check);
+
+-- note: there's a trigger in ecommerce-plsql.sql which updates amount_remaining_p
+-- when a gift certificate is used
+
+-- note2: there's a 1-1 correspondence between user-purchased gift certificates
+-- and financial transactions.  ec_financial_transactions stores the corresponding
+-- gift_certificate_id.
+
+create view ec_gift_certificates_approved
+as 
+select * 
+from ec_gift_certificates
+where gift_certificate_state in ('authorized','authorized_plus_avs','authorized_minus_avs');
+
+create view ec_gift_certificates_purchased
+as
+select *
+from ec_gift_certificates
+where gift_certificate_state in ('authorized_plus_avs','authorized_minus_avs');
+
+create view ec_gift_certificates_issued
+as
+select *
+from ec_gift_certificates
+where gift_certificate_state in ('authorized')
+  and issued_by is not null;
+
+
+create table ec_gift_certificates_audit (
+	gift_certificate_id	integer,
+	gift_certificate_state	varchar(50),
+	amount			numeric,
+	issue_date		datetime,
+	authorized_date		datetime,
+	issued_by		integer,
+	purchased_by		integer,
+	expires			datetime,
+	user_id			integer,
+	claim_check		varchar(50),
+	certificate_message	varchar(200),
+	certificate_to		varchar(100),
+	certificate_from	varchar(100),
+	recipient_email		varchar(100),
+	voided_date		datetime,
+	voided_by		integer,
+	reason_for_void		varchar(4000),
+	last_modified		datetime,
+	last_modifying_user	integer,
+	modified_ip_address	varchar(20),
+	delete_p		char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+create function trig_ec_gift_certificates_audit_tr() returns opaque
+as '
+declare
+begin
+	insert into ec_gift_certificates_audit (
+	gift_certificate_id, amount,
+	issue_date, authorized_date, issued_by, purchased_by, expires,
+	user_id, claim_check, certificate_message,
+	certificate_to, certificate_from,
+	recipient_email, voided_date, voided_by, reason_for_void,
+	last_modified,
+	last_modifying_user, modified_ip_address
+	) values (
+	OLD.gift_certificate_id, OLD.amount,
+	OLD.issue_date, OLD.authorized_date, OLD.issued_by, OLD.purchased_by, OLD.expires,
+	OLD.user_id, OLD.claim_check, OLD.certificate_message,
+	OLD.certificate_to, OLD.certificate_from,
+	OLD.recipient_email, OLD.voided_date, OLD.voided_by, OLD.reason_for_void,
+	OLD.last_modified,
+	OLD.last_modifying_user, OLD.modified_ip_address	
+	);
+  return new;
+end;
+' language 'plpgsql';
+
+create  trigger ec_gift_certificates_audit_tr
+after update or delete on ec_gift_certificates
+for each row
+execute procedure trig_ec_gift_certificates_audit_tr();
+
+
+create table ec_gift_certificate_usage (
+	gift_certificate_id	integer not null references ec_gift_certificates,
+	order_id		integer references ec_orders,
+	amount_used		numeric,
+	used_date		datetime,
+	amount_reinstated	numeric,
+	reinstated_date		datetime
+);
+
+create index ec_gift_cert_by_id on ec_gift_certificate_usage (gift_certificate_id);
+
+
+--------- customer service --------------------
+
+create sequence ec_issue_id_sequence;
+create sequence ec_action_id_sequence;
+create sequence ec_interaction_id_sequence;
+create sequence ec_user_ident_id_sequence;
+
+-- this contains the bits of info a cs rep uses to identify
+-- a user
+-- often user_id is not known and the customer service rep
+-- will have to get other info in order to identify the user
+create table ec_user_identification (
+	user_identification_id	integer not null primary key,
+	date_added	datetime,
+	user_id		integer references users,
+	email		varchar(100),
+	first_names	varchar(100),
+	last_name	varchar(100),
+	-- this is varchar(80) in community-core.sql, so I'll be consistent
+	postal_code	varchar(80),
+	other_id_info	varchar(2000)
+);
+
+-- should index everything because this all columns may potentially
+-- be searched through every time a new interaction is recorded
+create index ec_user_ident_by_user_id on ec_user_identification(user_id);
+create index ec_user_ident_by_email on ec_user_identification(email);
+create index ec_user_ident_by_first_names on ec_user_identification(first_names);
+create index ec_user_ident_by_last_name on ec_user_identification(last_name);
+create index ec_user_ident_by_postal_code on ec_user_identification(postal_code);
+
+
+-- puts date_added into ec_user_identification if it's missing
+create function trig_ec_user_identificate_date_tr() returns opaque
+as '
+declare
+begin
+	IF NEW.date_added is null THEN
+		NEW.date_added := current_timestamp;
+		RETURN NEW;
+	END IF;
+  return new;
+end;
+' language 'plpgsql';
+
+create  trigger ec_user_identificate_date_tr
+before insert on ec_user_identification
+for each row
+execute procedure trig_ec_user_identificate_date_tr();
+
+create table ec_customer_serv_interactions (
+	interaction_id		integer not null primary key,
+	customer_service_rep	integer references users,
+	user_identification_id	integer not null references ec_user_identification,
+	interaction_date	datetime,
+	interaction_originator	varchar(20) not null, -- e.g. customer, customer-service-rep, automatic
+	interaction_type		varchar(30) not null, -- e.g. email, phone_call
+	-- will be filled in if the customer-originated interaction is
+	-- an email
+	interaction_headers		varchar(4000)
+);
+
+create index ec_csin_by_user_ident_id on ec_customer_serv_interactions(user_identification_id);
+
+create function trig_ec_cs_interaction_inserts() returns opaque
+as '
+declare
+begin
+ IF NEW.interaction_date is null THEN 
+    NEW.interaction_date := current_timestamp;
+    return NEW;
+ END IF;
+  return new;
+end;
+' language 'plpgsql';
+
+create  trigger ec_cs_interaction_inserts
+before insert on ec_customer_serv_interactions
+for each row
+execute procedure trig_ec_cs_interaction_inserts();
+
+create view ec_customer_service_reps
+as
+select user_id, first_names, last_name, email, password, url, last_visit, second_to_last_visit, user_state from users 
+where user_id in (select customer_service_rep from ec_customer_serv_interactions)
+   or user_id in (select issued_by from ec_gift_certificates_issued);
+
+create table ec_customer_service_issues (
+	issue_id	integer not null primary key,
+	user_identification_id	integer not null references ec_user_identification,
+	-- may be null if this issue isn't associated with an order
+	order_id	integer references ec_orders,
+	gift_certificate_id	integer references ec_gift_certificates,
+	open_date	datetime not null,
+	close_date	datetime,
+	-- customer service reps who closed the issue
+	closed_by	integer references users,
+	-- we never really delete issues
+	deleted_p	char(1) check (deleted_p in ('f','t')) default 'f'
+);
+
+create index ec_csi_by_user_ident_id on ec_customer_service_issues(user_identification_id);
+create index ec_csi_by_open_date on ec_customer_service_issues(open_date);
+
+-- because an issue can have more than one issue_type
+create table ec_cs_issue_type_map (
+	issue_id	integer not null references ec_customer_service_issues,
+	issue_type	varchar(40) not null -- e.g. billing, web site
+);
+
+create index ec_csitm_by_issue_id on ec_cs_issue_type_map(issue_id);
+create index ec_csitm_by_issue_type on ec_cs_issue_type_map(issue_type);
+
+create function trig_ec_cs_issues_inserts() returns opaque
+as '
+declare
+begin
+ IF NEW.open_date is null THEN 
+    NEW.open_date := current_timestamp;
+    return NEW;
+ END IF;
+ return new;
+end;
+' language 'plpgsql';
+
+create  trigger ec_cs_issue_inserts
+before insert on ec_customer_service_issues
+for each row
+execute procedure trig_ec_cs_issues_inserts();
+
+create table ec_customer_service_actions (
+	action_id		integer not null primary key,
+	issue_id		integer not null references ec_customer_service_issues,
+	interaction_id		integer not null references ec_customer_serv_interactions,
+	action_details		varchar(4000),
+	follow_up_required	varchar(4000)
+);
+	
+create index ec_csa_by_issue on ec_customer_service_actions(issue_id);
+
+create table ec_cs_action_info_used_map (
+	action_id		integer not null references ec_customer_service_actions,
+	info_used		varchar(100) not null
+);
+
+create index ec_csaium_by_action_id on ec_cs_action_info_used_map(action_id);
+create index ec_csaium_by_info_used on ec_cs_action_info_used_map(info_used);
+
+-- this table contains picklist choices for the customer service data
+-- entry people
+
+create sequence ec_picklist_item_id_sequence;
+
+create table ec_picklist_items (
+	picklist_item_id	integer not null primary key,
+	-- pretty, human-readable
+	picklist_item		varchar(100),
+	-- which picklist this item is in
+	picklist_name		varchar(100),
+	sort_key		float4,
+	last_modified		datetime not null,
+	last_modifying_user	integer not null references users,
+	modified_ip_address	varchar(20) not null
+);
+
+create table ec_picklist_items_audit (
+	picklist_item_id	integer,
+	picklist_item		varchar(100),
+	picklist_name		varchar(100),
+	sort_key		float4,
+	last_modified		datetime,
+	last_modifying_user	integer,
+	modified_ip_address	varchar(20),
+	delete_p              char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+create function trig_ec_picklist_items_audit_tr() returns opaque
+as '
+declare
+begin
+        insert into ec_picklist_items_audit (
+	picklist_item_id, picklist_item,
+	picklist_name, sort_key,
+	last_modified,
+        last_modifying_user, modified_ip_address
+        ) values (
+	OLD.picklist_item_id, OLD.picklist_item,
+	OLD.picklist_name, OLD.sort_key,
+        OLD.last_modified,
+        OLD.last_modifying_user, OLD.modified_ip_address
+        );
+  return new;
+end;
+' language 'plpgsql';
+
+
+create  trigger ec_picklist_items_audit_tr
+after update or delete on ec_picklist_items
+for each row
+execute procedure trig_ec_picklist_items_audit_tr();
+
+-- Canned responses for customer support
+create sequence ec_canned_response_id_sequence;
+
+create table ec_canned_responses (
+	response_id	integer not null primary key,
+	one_line	varchar(100) not null,
+	response_text	varchar(4000) not null
+);
+
+-----------------------------------------------
+
+-- templates 1-6 are pre-defined (see the insert statements below the
+-- table definitions)
+-- the wording of each can be changed at /admin/ecommerce/email-templates/
+create sequence ec_email_template_id_sequence;
+
+create table ec_email_templates (
+	email_template_id	integer not null primary key,
+	title			varchar(100),
+	subject			varchar(200),
+	message			varchar(4000),
+	-- this lists the variable names that customer service can
+	-- use in this particular email -- for their info only
+	variables		varchar(1000),
+	-- for informational purposes only, when the email is
+	-- sent
+	when_sent		varchar(1000),
+	-- for customer service issues, this is a tcl list of all
+	-- the issue_types that should be inserted into 
+	-- ec_cs_issue_type_map for the issue that will be created
+	-- when the message is sent
+	issue_type_list		varchar(100),
+        last_modified           datetime not null,
+        last_modifying_user     integer not null references users,
+        modified_ip_address     varchar(20) not null
+);
+
+create table ec_email_templates_audit (
+	email_template_id	integer,
+	title			varchar(100),
+	subject			varchar(200),
+	message			varchar(4000),
+	variables		varchar(1000),
+	when_sent		varchar(1000),
+	issue_type_list		varchar(100),
+        last_modified           datetime,
+        last_modifying_user     integer,
+        modified_ip_address     varchar(20),
+        delete_p              char(1) check (delete_p in ('f','t')) default 'f'
+);
+
+create function trig_ec_email_templates_audit_tr() returns opaque
+as '
+declare
+begin
+        insert into ec_email_templates_audit (
+	email_template_id, title,
+	subject, message,
+	variables, when_sent,
+	issue_type_list,
+	last_modified,
+        last_modifying_user, modified_ip_address
+        ) values (
+	OLD.email_template_id, OLD.title,
+	OLD.subject, OLD.message,
+	OLD.variables, OLD.when_sent,
+	OLD.issue_type_list,
+        OLD.last_modified,
+        OLD.last_modifying_user, OLD.modified_ip_address
+        );
+  return new;
+end;
+' language 'plpgsql';
+
+create  trigger ec_email_templates_audit_tr
+after update or delete on ec_email_templates
+for each row
+execute procedure trig_ec_email_templates_audit_tr();
+
+-- The following templates are predefined.  The templates are
+-- used in procedures which send out the email, so the template_ids
+-- shouldn't be changed, although the text can be edited at
+-- /admin/ecommerce/email-templates/
+--
+-- email_template_id	used for
+-- ----------------- 	---------
+-- 	1		new order
+-- 	2		order shipped
+-- 	3		delayed credit denied
+-- 	4		new gift certificate order
+--	5		gift certificate recipient
+--	6		gift certificate order failure
+
+-- set scan off
+
+insert into ec_email_templates
+(email_template_id, title, subject, message, variables, when_sent, issue_type_list, last_modified, last_modifying_user, modified_ip_address)
+values
+(1, 'New Order', 'Your Order', 'Thank you for your order.  We received your order' || '\n' || 'on confirmed_date_here.' || '\n' || '\n' || 'The following is your order information:' || '\n' || '\n' || 'item_summary_here' || '\n' || '\n' || 'Shipping Address:' || '\n' || 'address_here' || '\n' || '\n' || 'price_summary_here' || '\n' || '\n' || 'Thank you.' || '\n' || '\n' || 'Sincerely,' || '\n' || 'customer_service_signature_here', 'confirmed_date_here, address_here, item_summary_here, price_here, shipping_here, tax_here, total_here, customer_service_signature_here', 'This email will automatically be sent out after an order has been authorized.', '{new order}', current_timestamp, 1, 'none');
+
+insert into ec_email_templates
+(email_template_id, title, subject, message, variables, when_sent, issue_type_list, last_modified, last_modifying_user, modified_ip_address)
+values
+(2, 'Order Shipped', 'Your Order Has Shipped', 'We shipped the following items on shipped_date_here:' || '\n' || '\n' || 'item_summary_here' || '\n' || '\n' || 'Your items were shipped to:' || '\n' || '\n' || 'address_here' || '\n' || '\n' || 'sentence_about_whether_this_completes_the_order_here' || '\n' || '\n' || 'You can track your package by accessing' || '\n' || '"Your Account" at system_url_here' || '\n' || '\n' || 'Sincerely,' || '\n' || 'customer_service_signature_here', 'shipped_date_here, item_summary_here, address_here, sentence_about_whether_this_completes_the_order_here, system_url_here, customer_service_signature_here', 'This email will automatically be sent out after an order or partial order has shipped.', '{order shipped}', current_timestamp, 1, 'none');
+
+
+insert into ec_email_templates
+(email_template_id, title, subject, message, variables, when_sent, issue_type_list, last_modified, last_modifying_user, modified_ip_address)
+values
+(3, 'Delayed Credit Denied', 'Your Order', 'At this time we are not able to receive' || '\n' || 'authorization to charge your account.  We' || '\n' || 'have saved your order so that you can come' || '\n' || 'back to system_url_here' || '\n' || 'and resubmit it.' || '\n' || '\n' || 'Please go to your shopping cart and' || '\n' || 'click on "Retrieve Saved Cart".' || '\n' || '\n' || 'Thank you.' || '\n' || '\n' || 'Sincerely,' || '\n' || 'customer_service_signature_here', 'system_url_here, customer_service_signature_here', 'This email will automatically be sent out after a credit card authorization fails if it didn''t fail at the time the user initially submitted their order.', 'billing', current_timestamp, 1, 'none');
+
+
+insert into ec_email_templates
+(email_template_id, title, subject, message, variables, when_sent, issue_type_list, last_modified, last_modifying_user, modified_ip_address)
+values
+(4, 'New Gift Certificate Order', 'Your Order', 'Thank you for your gift certificate order at system_name_here!' || '\n' || '\n' || 'The gift certificate will be sent to:' || '\n' || '\n' || 'recipient_email_here' || '\n' || '\n' || 'Your order details:' || '\n' || '\n' || 'Gift Certificate   certificate_amount_here' || '\n' || 'Shipping           0.00' || '\n' || 'Tax                0.00' || '\n' || '------------       ------------' || '\n' || 'TOTAL              certificate_amount_here' || '\n' || '\n' || 'Sincerely,' || '\n' || 'customer_service_signature_here', 'system_name_here, recipient_email_here, certificate_amount_here, customer_service_signature_here', 'This email will be sent after a customer orders a gift certificate.', '{gift certificate}', current_timestamp, 1, 'none');
+
+
+insert into ec_email_templates
+(email_template_id, title, subject, message, variables, when_sent, issue_type_list, last_modified, last_modifying_user, modified_ip_address)
+values
+(5, 'Gift Certificate Recipient', 'Gift Certificate', 'It''s our pleasure to inform you that someone' || '\n' || 'has purchased a gift certificate for you at' || '\n' || 'system_name_here!' || '\n' || '\n' || 'Use the claim check below to retrieve your gift' || '\n' || 'certificate at system_url_here' || '\n' || '\n' || 'amount_and_message_summary_here' || '\n' || '\n' || 'Claim Check: claim_check_here' || '\n' || '\n' || 'To redeem it, just go to' || '\n' || 'system_url_here' || '\n' || 'choose the items you wish to purchase,' || '\n' || 'and proceed to Checkout.  You''ll then have' || '\n' || 'the opportunity to type in your claim code' || '\n' || 'and redeem your certificate!  Any remaining' || '\n' || 'balance must be paid for by credit card.' || '\n' || '\n' || 'Sincerely,' || '\n' || 'customer_service_signature_here', 'system_name_here, system_url_here, amount_and_message_summary_here, claim_check_here, customer_service_signature_here', 'This is sent to recipients of gift certificates.', '{gift certificate}', current_timestamp, 1, 'none');
+
+insert into ec_email_templates
+(email_template_id, title, subject, message, variables, when_sent, issue_type_list, last_modified, last_modifying_user, modified_ip_address)
+values
+(6, 'Gift Certificate Order Failure', 'Your Gift Certificate Order', 'We are sorry to report that the authorization' || '\n' || 'for the gift certificate order you placed' || '\n' || 'at system_name_here could not be made.' || '\n' || 'Your order has been canceled.  Please' || '\n' || 'come back and try your order again at:' || '\n' || '\n' || 'system_url_here' || '\n' || 'For your records, here is the order' || '\n' || 'that you attempted to place:' || '\n' || '\n' || 'Would have been sent to: recipient_email_here' || '\n' || 'amount_and_message_summary_here' || '\n' || 'We apologize for the inconvenience.' || '\n' || 'Sincerely,' || '\n' || 'customer_service_signature_here', 'system_name_here, system_url_here, recipient_email_here, amount_and_message_summary_here, customer_service_signature_here', 'This is sent to customers who tried to purchase a gift certificate but got no immediate response from CyberCash and we found out later the auth failed.', '{gift certificate}', current_timestamp, 1, 'none');
+
+-- set scan on
+
+-- users can sign up for mailing lists based on category, subcategory,
+-- or subsubcategory (the appropriate level of categorization on which
+-- to base mailing lists depends on how the site administrator has
+-- set up their system)
+-- when the user is signed up for a subsubcategory list, the subcategory_id
+-- and category_id are also filled in (which makes it easier to refer
+-- to the mailing list later).
+-- "cat" stands for "categorization"
+create table ec_cat_mailing_lists (
+	user_id			integer not null references users,
+	category_id		integer references ec_categories,
+	subcategory_id		integer references ec_subcategories,
+	subsubcategory_id	integer references ec_subsubcategories
+);
+
+create index ec_cat_mailing_list_idx on ec_cat_mailing_lists(user_id);
+create index ec_cat_mailing_list_idx2 on ec_cat_mailing_lists(category_id);
+create index ec_cat_mailing_list_idx3 on ec_cat_mailing_lists(subcategory_id);
+create index ec_cat_mailing_list_idx4 on ec_cat_mailing_lists(subsubcategory_id);
+
+create sequence ec_spam_id_sequence;
+
+create table ec_spam_log (
+	spam_id			integer not null primary key,
+	spam_date		datetime,
+	spam_text		varchar(4000),
+	-- the following are all criteria used in choosing the users to be spammed
+	mailing_list_category_id	integer references ec_categories,
+	mailing_list_subcategory_id	integer references ec_subcategories,
+	mailing_list_subsubcategory_id	integer references ec_subsubcategories,
+	user_class_id			integer references ec_user_classes,
+	product_id			integer references ec_products,
+	last_visit_start_date		datetime,
+	last_visit_end_date		datetime
+);
+
+create index ec_spam_log_by_cat_mail_idx on ec_spam_log (mailing_list_category_id);
+create index ec_spam_log_by_cat_mail_idx2 on ec_spam_log (mailing_list_subcategory_id);
+create index ec_spam_log_by_cat_mail_idx3 on ec_spam_log (mailing_list_subsubcategory_id);
+create index ec_spam_log_by_user_cls_idx on ec_spam_log (user_class_id);
+create index ec_spam_log_by_product_idx on ec_spam_log (product_id);
+
+
+
+-- CREDIT CARD STUFF ------------------------
+---------------------------------------------
+
+create sequence ec_transaction_id_sequence;
+
+create table ec_financial_transactions (
+	transaction_id		integer not null primary key,
+	-- order_id or gift_certificate_id must be filled in
+	order_id		integer references ec_orders,
+	-- The following two rows were added 1999-08-11.  They're
+	-- not actually needed by the system right now, but
+	-- they might be useful in the future (I can envision them
+	-- being useful as factory functions are automated).
+	shipment_id		integer references ec_shipments,
+	refund_id		integer references ec_refunds,
+	-- this refers to the purchase of a gift certificate, not the use of one
+	gift_certificate_id	integer references ec_gift_certificates,
+	-- creditcard_id is in here even though order_id has a creditcard_id associated with
+	-- it in case a different credit card is used for a refund or a partial shipment.
+	-- a trigger fills the creditcard_id in if it's not specified
+	creditcard_id		integer not null references ec_creditcards,
+	transaction_amount	numeric not null,
+	-- charge doesn't imply that a charge will actually occur; it's just
+	-- an authorization to charge
+	-- in the case of a refund, there's no such thing as an authorization
+	-- to refund, so the refund really will occur
+	transaction_type	varchar(6) not null check (transaction_type in ('charge','refund')),
+	-- it starts out null, becomes 't' when we want to capture it, or becomes
+	-- 'f' it is known that we don't want to capture the transaction (although
+	-- the 'f' is mainly just for reassurance; we only capture ones with 't')
+	-- There's no need to set this for refunds.  Refunds are always to be captured.
+	to_be_captured_p	char(1) check (to_be_captured_p is null or to_be_captured_p in ('f','t')),
+	inserted_date		datetime not null,
+	authorized_date		datetime,
+	-- set when to_be_captured_p becomes 't'; used in cron jobs
+	to_be_captured_date	datetime,
+	marked_date		datetime,
+	settled_date		datetime,
+	refunded_date		datetime,
+	refund_settled_date	datetime,
+	-- generated by us talking to Cybercash
+	disputed_p		char(1) check (disputed_p is null or disputed_p in ('f','t')),
+	-- date on which we discovered the dispute
+	dispute_discovery_date	datetime,
+	-- if the consumer's bank got his numeric back from us forcibly
+	charged_back_p		char(1) check (charged_back_p is null or charged_back_p in ('f','t')),
+	-- if the transaction failed, this will keep the cron jobs from continuing
+	-- to retry it
+	failed_p		char(1) check (failed_p in ('f','t')) default 'f',
+	check ((order_id notnull) or (gift_certificate_id notnull))
+);
+
+create index ec_finan_trans_by_order_idx on ec_financial_transactions (order_id);
+create index ec_finan_trans_by_cc_idx on ec_financial_transactions (creditcard_id);
+create index ec_finan_trans_by_gc_idx on ec_financial_transactions (gift_certificate_id);
+
+-- reportable transactions: those which have not failed which are to
+-- be captured (note: refunds are always to be captured)
+create view ec_fin_transactions_reportable
+as
+select * from ec_financial_transactions
+where (transaction_type='charge' and to_be_captured_p='t' and failed_p='f')
+or (transaction_type='refund' and failed_p='f');
+
+
+-- fills creditcard_id into ec_financial_transactions if it's missing
+-- (using the credit card associated with the order)
+create function trig_fin_trans_ccard_update_tr() returns opaque
+as '
+declare
+	v_creditcard_id		ec_creditcards.creditcard_id%TYPE;
+begin
+	IF NEW.order_id is not null THEN
+		select creditcard_id into v_creditcard_id from ec_orders where order_id= NEW.order_id;
+		IF NEW.creditcard_id is null THEN
+			NEW.creditcard_id := v_creditcard_id;
+			return NEW;
+		END IF;
+	END IF;
+  return NEW;
+end;
+' language 'plpgsql';
+
+create  trigger fin_trans_ccard_update_tr
+before insert on ec_financial_transactions
+for each row
+execute procedure trig_fin_trans_ccard_update_tr();
+
+create table ec_cybercash_log (
+	transaction_id	integer not null references ec_financial_transactions,
+	-- The types of transactions that will be logged here are
+	-- mauthonly, postauth, return, void, retry, query
+	txn_attempted_type	varchar(25),
+	txn_attempted_time	datetime,
+	-- Everything below this line is returned by CyberCash.  Note
+	-- that not all columns will have values (for instance, cc_time 
+	-- is only returned when doing a query, aux_msg is not returned
+	-- when doing a query, ref-code never seems to be returned,
+	-- batch-id is only returned when querying for settled or setlret).
+	-- Note: when doing a non-query, there is no txn_type returned
+	-- by CyberCash, so this value will be inserted by talk_to_cybercash
+	-- procedure.  The reason for doing this is consistency; for
+	-- example the attempted transaction type may be mauthonly, but later
+	-- when querying for this authorization, the txn_type is auth.  So,
+	-- auth will be inserted into txn_type when doing an mauthonly.
+	txn_type	varchar(25),
+	-- we take the time returned by CyberCash and chop off the
+	-- sub-second precision
+	cc_time		datetime,
+	merch_txn	varchar(25),
+	cust_txn	varchar(25),
+	origin		char(1),
+	txn_status	varchar(25),
+	errloc		varchar(25),
+	errmsg		varchar(200),
+	aux_msg		varchar(200),
+	auth_code	varchar(25),
+	action_code	varchar(25),
+	avs_code	varchar(3),
+	ref_code	varchar(25),
+	batch_id	varchar(25),
+	amount		numeric
+);
+
+-- END CREDIT CARD STUFF ----------------------------
+-----------------------------------------------------
+
+
+-- this is to record any problems that may have occurred so that the site administrator
+-- can be alerted on the admin pages
+create sequence ec_problem_id_sequence;
+
+create table ec_problems_log (
+	problem_id	integer not null primary key,
+	problem_date	datetime,
+	problem_details	varchar(4000),
+	-- if it's related to an order
+	order_id	integer references ec_orders,
+	-- if it's related to a gift certificate
+	gift_certificate_id	integer references ec_gift_certificates,
+	resolved_date	datetime,
+	resolved_by	integer references users
+);
+
+
+-- keeps track of automatic emails (based on templates) that are sent out
+create table ec_automatic_email_log (
+	user_identification_id	integer not null references ec_user_identification,
+	email_template_id	integer not null references ec_email_templates,
+	order_id		integer references ec_orders,
+	shipment_id		integer references ec_shipments,
+	gift_certificate_id	integer references ec_gift_certificates,
+	date_sent		datetime
+);
+
+create index ec_auto_email_by_usr_id_idx on ec_automatic_email_log (user_identification_id);
+create index ec_auto_email_by_temp_idx on ec_automatic_email_log (email_template_id);
+create index ec_auto_email_by_order_idx on ec_automatic_email_log (order_id);
+create index ec_auto_email_by_shipment_idx on ec_automatic_email_log (shipment_id);
+create index ec_auto_email_by_gc_idx on ec_automatic_email_log (gift_certificate_id);
Index: web/openacs/www/doc/sql/education.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/education.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/education.sql	17 Apr 2001 14:05:12 -0000	1.1
@@ -0,0 +1,1603 @@
+--
+-- /www/doc/sql/education.sql
+--
+-- by randyg@mit.edu and aileen@mit.edu on September 29, 1999
+-- with much help from philg@arsdigita.com on October 28, 1999
+
+-- the system is centered around the classes
+-- as it is too difficult to have 2 types of queries to support 
+-- individual users
+
+-- instead of having a classes table, we just define a user group
+-- type of "edu_class" 
+
+-- for the class name we'll use "group_name" (a default field from
+-- the user_groups table); everything else will have to be in
+-- edu_class_info; this is a bit tricky since we need to
+-- keep the definitions for the helper edu_classes_info table in
+-- sync with what we insert into user_group_type_fields (used
+-- to generate UI)
+
+-- we don't store much contact info in the classes table; if we need
+-- to send out a report on system usage, we send it to all the people
+-- with the admin role in this user group
+
+
+-- this table holds the terms for the classes (e.g. Fall 1999)
+ 
+create sequence edu_term_id_sequence start 1;
+
+create table edu_terms (
+     term_id         integer not null primary key,
+     term_name       varchar(100) not null,
+     start_date      datetime not null,
+     end_date        datetime not null
+);
+
+-- we want the above table to automatically start with a term that extends over all time
+-- (or at least 100 years) for classes that people take at their own pace
+
+insert into edu_terms (term_id, term_name, start_date, end_date) 
+select nextval('edu_term_id_sequence'), 'No Term', sysdate(), sysdate()+'1200 months'::reltime
+from dual
+where 0 = (select count(*) from edu_terms);
+
+-- for a multi-department university, we need to this to sort courses
+-- by department; we're going to want private discussion groups, etc. 
+-- for people who work in departments, so we make this a user group
+
+-- to find the department head and other big staffers, we look at people with
+-- particular roles in the user_group_map
+
+create table edu_department_info (
+	group_id 		integer primary key references user_groups,
+	-- for schools like MIT where each department has a number
+	department_number	varchar(100),
+	-- we'll generate a home page for them but if they have one already
+	-- we can provide a link
+	external_homepage_url	varchar(200),
+	mailing_address		varchar(200),
+	phone_number		varchar(20),
+	fax_number		varchar(20),
+	inquiry_email		varchar(50),
+	description		varchar(4000),
+	mission_statement	varchar(4000),
+	last_modified          	datetime default current_timestamp not null,
+        last_modifying_user    	integer references users,
+        modified_ip_address    	varchar(20)
+);
+
+
+-- we want to audit the department information
+
+create table edu_department_info_audit (
+	group_id 		integer,
+	department_number	varchar(100),
+	external_homepage_url	varchar(200),
+	mailing_address		varchar(200),
+	phone_number		varchar(20),
+	fax_number		varchar(20),
+	inquiry_email		varchar(50),
+	description		varchar(4000),
+	mission_statement	varchar(4000),
+	last_modified          	datetime,
+        last_modifying_user    	integer,
+        modified_ip_address    	varchar(20)
+);
+
+
+-- we create a trigger to keep the audit table current
+
+create function trig_edu_department_audit_tr()
+returns opaque as '
+DECLARE
+BEGIN
+   insert into edu_department_info_audit (
+	group_id,
+	department_number,
+	external_homepage_url,
+	mailing_address,
+	phone_number,
+	fax_number,
+	inquiry_email,
+	description,
+	mission_statement,
+	last_modified,
+        last_modifying_user,
+        modified_ip_address)
+     values (
+	OLD.group_id,
+	OLD.department_number,
+	OLD.external_homepage_url,
+	OLD.mailing_address,
+	OLD.phone_number,
+	OLD.fax_number,
+	OLD.inquiry_email,
+	OLD.description,
+	OLD.mission_statement,
+	OLD.last_modified,
+        OLD.last_modifying_user,
+        OLD.modified_ip_address);
+
+    return NEW;
+end;
+' language 'plpgsql';
+
+create trigger edu_department_info_audit
+before update or delete on edu_department_info
+for each row
+execute procedure trig_edu_department_audit_tr();
+
+-- now, lets create a group of type department and insert all of
+-- the necessary rows to generate the user interface on the /admin pages
+
+create function init_education() returns integer as '
+declare	
+ n_departments_group_types integer;
+begin
+ select count(*) into n_departments_group_types from user_group_types where group_type = ''edu_department'';
+  if n_departments_group_types = 0 then
+    insert into user_group_types
+    (group_type, pretty_name, pretty_plural, approval_policy, default_new_member_policy, group_module_administration)
+    values
+   (''edu_department'',''Department'',''Departments'',''wait'',''open'',''full'');
+
+   insert into user_group_type_fields (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) 
+   values
+   (''edu_department'', ''department_number'', ''Department Number'', ''text'', ''varchar(100)'', NULL, 1);
+
+   insert into user_group_type_fields (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) 
+   values
+   (''edu_department'', ''external_homepage_url'', ''External Homepage URL'', ''text'', ''varchar(200)'', NULL, 2);
+
+   insert into user_group_type_fields (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) 
+   values
+   (''edu_department'', ''mailing_address'', ''Mailing Address'', ''text'', ''varchar(200)'', NULL, 3);
+
+   insert into user_group_type_fields (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) 
+   values
+   (''edu_department'', ''phone_number'', ''Phone Number'', ''text'', ''varchar(20)'', NULL, 4);
+
+   insert into user_group_type_fields (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) 
+   values
+   (''edu_department'', ''fax_number'', ''Fax Number'', ''text'', ''varchar(20)'', NULL, 5);
+
+   insert into user_group_type_fields (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) 
+   values
+   (''edu_department'', ''inquiry_email'', ''Inquiry Email'', ''text'', ''varchar(50)'', NULL, 6);
+
+   insert into user_group_type_fields (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) 
+   values
+   (''edu_department'', ''description'', ''Description'', ''text'', ''varchar(4000)'', NULL, 7);
+
+   insert into user_group_type_fields (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) 
+   values
+   (''edu_department'', ''mission_statement'', ''Mission Statement'', ''text'', ''varchar(4000)'', NULL, 8);
+
+  end if;
+  return 1;
+end;
+' language 'plpgsql';
+
+select init_education();
+
+
+-- now we want to create a view to easily select departments
+
+create view edu_departments
+as
+select
+	user_groups.group_id as department_id,
+	group_name as department_name,
+	department_number,
+	external_homepage_url,
+	mailing_address,
+	phone_number,
+	fax_number,
+	inquiry_email,
+	description,
+	mission_statement
+from user_groups, edu_department_info
+where user_groups.group_id = edu_department_info.group_id
+and group_type = 'edu_department'
+and active_p = 't'
+and approved_p = 't';
+
+
+
+-- we model the subjects offered by departments
+
+create sequence edu_subject_id_sequence;
+
+-- we don't store the subject number in edu_subjects because a joint subject
+-- may have more than one number 
+
+create table edu_subjects (
+	subject_id		integer primary key,
+	subject_name		varchar(100) not null,
+	description		varchar(4000),
+	-- at MIT this will be a string like "3-0-9"
+	credit_hours		varchar(50),	
+	prerequisites		varchar(4000),
+	professors_in_charge	varchar(200),
+	last_modified          	datetime default current_timestamp not null,
+        last_modifying_user    	integer not null references users,
+        modified_ip_address    	varchar(20) not null
+);
+
+
+-- we want to audit edu_subjects
+
+create table edu_subjects_audit (
+	subject_id		integer,
+	subject_name		varchar(100),
+	description		varchar(4000),
+	credit_hours		varchar(50),	
+	prerequisites		varchar(4000),
+	professors_in_charge	varchar(200),
+	last_modified          	datetime,
+        last_modifying_user    	integer,
+        modified_ip_address    	varchar(20)
+);
+
+
+-- we create a trigger to keep the audit table current
+
+create function trig_edu_subjects_audit_trigger()
+returns opaque as '
+DECLARE
+begin
+   insert into edu_subjects_audit (
+	subject_id,
+	subject_name,
+	description,
+	credit_hours,
+	prerequisites,
+	professors_in_charge,
+	last_modified,
+        last_modifying_user,
+        modified_ip_address)
+   values (
+	OLD.subject_id,
+	OLD.subject_name,
+	OLD.description,
+	OLD.credit_hours,
+	OLD.prerequisites,
+	OLD.professors_in_charge,
+	OLD.last_modified,
+        OLD.last_modifying_user,
+        OLD.modified_ip_address);
+   return NEW;
+end;
+' language 'plpgsql';
+
+create trigger edu_subjects_audit_trigger
+before update or delete on edu_subjects
+for each row
+execute procedure trig_edu_subjects_audit_trigger();
+
+
+create table edu_subject_department_map (
+	department_id		integer references user_groups,
+	subject_id		integer references edu_subjects,
+	-- this would be the full '6.014' or 'CS 101'
+	subject_number		varchar(20),
+        grad_p                  char(1) default 'f' check(grad_p in ('t','f')),
+	primary key ( department_id, subject_id )
+);
+
+
+-- now we create classes.  A class is a particular subject being taught in a particular
+-- term.  However, we can also have special cases where a class is not associated with 
+-- a term and we can even have classes that stand by themselves and aren't associated with
+-- subjects, e.g., an IAP knitting course  (IAP = MIT's Independent Activities Period)
+
+-- the PL/SQL statement cannot create the table so we do it here.
+-- create a table to hold the extra info for each group of type
+-- 'edu_classes'
+
+create table edu_class_info (
+	group_id		integer not null primary key references user_groups,
+	term_id			integer references edu_terms,
+	subject_id		integer references edu_subjects,
+	-- if the class doesn't start or end on the usual term boundary, fill these in
+	start_date		datetime,
+	end_date		datetime,
+	description 		varchar(4000),
+	-- at MIT, something like 'Room 4-231, TR 1-2:30'
+	where_and_when		varchar(4000),
+	-- I still don't agree with this column.  I think we should use
+	-- the file system to hold this and just keep a pointer to the 
+	-- syllabus.  That way we would have versioning which we do not 
+	-- have now (randyg@arsdigita.com, November, 1999)
+	syllabus_id		integer references fs_files,
+	-- we keep references to the class folders so that we can link to them directly
+	-- from various different parts of the system.
+	assignments_folder_id		integer references fs_files,
+	projects_folder_id		integer references fs_files,
+	lecture_notes_folder_id		integer references fs_files,
+	handouts_folder_id		integer references fs_files,
+	exams_folder_id			integer references fs_files,
+	-- will the class web page and the documents on it be open to the public?
+	public_p			char(1) default 'f' check(public_p in ('t','f')),
+	-- do students receive grades?
+	grades_p  		        char(1) default 'f' check(grades_p in ('t','f')),
+	-- will the class be divided into teams?
+	teams_p			 	char(1) default 'f' check(teams_p in ('t','f')),
+	exams_p                  	char(1) default 'f' check (exams_p in ('t', 'f')),
+	-- does the class have a final exam?
+	final_exam_p                	char(1) default 'f' check (final_exam_p in ('t','f')),
+	last_modified           	datetime default current_timestamp not null,
+        last_modifying_user     	integer references users,
+        modified_ip_address     	varchar(20)
+);
+
+-- this table audits edu_class_info
+create table edu_class_info_audit (
+	group_id		integer,
+	term_id			integer,
+	subject_id		integer,
+	start_date		datetime,
+	end_date		datetime,
+	description 		varchar(4000),
+	where_and_when		varchar(4000),
+	syllabus_id		integer,
+	assignments_folder_id	integer,
+	projects_folder_id	integer,
+	lecture_notes_folder_id integer,
+	handouts_folder_id	integer,
+	exams_folder_id		integer,
+	public_p		char(1),
+	grades_p  		char(1),
+	teams_p			char(1),
+	exams_p                 char(1),
+	final_exam_p            char(1),
+	last_modified          	datetime,
+        last_modifying_user     integer,
+        modified_ip_address     varchar(20)
+);
+
+
+
+-- we create a trigger to keep the audit table current
+-- drop function trig_edu_class_info_audit_trigger();
+create function trig_edu_class_info_audit_trigger()
+returns opaque as '
+DECLARE
+BEGIN
+   insert into edu_class_info_audit (
+	group_id,		
+	term_id,			
+	subject_id,		
+	start_date,		
+	end_date,		
+	description, 		
+	where_and_when,		
+	syllabus_id,		
+	assignments_folder_id,	
+	projects_folder_id,	
+	lecture_notes_folder_id, 
+	handouts_folder_id,	
+	exams_folder_id,		
+	public_p,		
+	grades_p,  		
+	teams_p,			
+	exams_p,                 
+	final_exam_p,            
+	last_modified,          	
+        last_modifying_user,     
+        modified_ip_address)
+    values (
+	OLD.group_id,		
+	OLD.term_id,			
+	OLD.subject_id,		
+	OLD.start_date,		
+	OLD.end_date,		
+	OLD.description, 		
+	OLD.where_and_when,		
+	OLD.syllabus_id,		
+	OLD.assignments_folder_id,	
+	OLD.projects_folder_id,	
+	OLD.lecture_notes_folder_id, 
+	OLD.handouts_folder_id,	
+	OLD.exams_folder_id,		
+	OLD.public_p,		
+	OLD.grades_p,  		
+	OLD.teams_p,			
+	OLD.exams_p,                 
+	OLD.final_exam_p,            
+	OLD.last_modified,          	
+        OLD.last_modifying_user,     
+        OLD.modified_ip_address);
+    return NEW;
+END;
+' language 'plpgsql';
+
+-- drop trigger edu_class_info_audit_trigger on edu_class_info;
+create trigger edu_class_info_audit_trigger
+before update or delete on edu_class_info
+for each row
+execute procedure trig_edu_class_info_audit_trigger();
+
+
+create function init_education_2() returns integer as '
+declare
+ n_classes_group_types integer;
+begin
+ select count(*) into n_classes_group_types from user_group_types where group_type = ''edu_class'';
+  if n_classes_group_types = 0 then
+	insert into user_group_types
+  (group_type, pretty_name, pretty_plural, approval_policy, default_new_member_policy, group_module_administration)
+  values
+  (''edu_class'',''Class'',''Classes'',''wait'',''open'',''full'');
+
+
+   insert into user_group_type_fields (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) 
+   values
+   (''edu_class'', ''term_id'', ''Term Class is Taught'', ''text'', ''integer'', ''not null references edu_terms'', 1);
+
+
+   insert into user_group_type_fields (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) 
+   values
+   (''edu_class'', ''subject_id'', ''Subject'', ''text'', ''integer'', ''not null references edu_subjects'', 2);
+
+
+   insert into user_group_type_fields 
+   (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) 
+   values
+  (''edu_class'', ''start_date'', ''Date to Start Displaying Class Web Page'', ''datetime'', ''datetime'', NULL, 3);
+
+
+   insert into user_group_type_fields (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) 
+   values
+   (''edu_class'', ''end_date'', ''Date to Stop Displaying Class Web Page'', ''datetime'', ''datetime'', NULL, 4);
+
+
+   insert into user_group_type_fields (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) 
+   values
+   (''edu_class'', ''description'', ''Class Description'', ''text'', ''varchar(4000)'', NULL, 5);
+
+
+   insert into user_group_type_fields (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) 
+   values
+   (''edu_class'', ''where_and_when'', ''Where and When'', ''text'', ''varchar(4000)'', NULL, 6);
+
+
+   insert into user_group_type_fields (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) 
+   values
+   (''edu_class'', ''syllabus_id'', ''Syllabus ID'', ''integer'', ''integer'', ''references fs_files'', 7);
+
+
+   insert into user_group_type_fields (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) 
+   values
+   (''edu_class'', ''assignments_folder_id'', ''Assignments Folder'', ''integer'', ''integer'', ''references fs_files'', 8);
+
+
+   insert into user_group_type_fields (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) 
+   values
+   (''edu_class'', ''projects_folder_id'', ''Projects Folder'', ''integer'', ''integer'', ''references fs_files'', 8.5);
+
+
+   insert into user_group_type_fields (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) 
+   values
+   (''edu_class'', ''lecture_notes_folder_id'', ''Lecture Notes Folder'', ''integer'', ''integer'', ''references fs_files'', 9);
+
+
+   insert into user_group_type_fields (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) 
+   values
+   (''edu_class'', ''handouts_folder_id'', ''Handouts Folder'', ''integer'', ''integer'', ''references fs_files'', 10);
+
+
+   insert into user_group_type_fields (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) 
+   values
+   (''edu_class'', ''public_p'', ''Will the web page be open to the public?'', ''boolean'', ''char(1)'', ''default ''''t'''' check(public_p in (''''t'''',''''f''''))'', 11);
+
+
+   insert into user_group_type_fields (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) 
+   values
+   (''edu_class'', ''grades_p'', ''Do students recieve grades?'', ''boolean'', ''char(1)'',''default ''''f'''' check(grades_p in (''''t'''',''''f''''))'', 12);
+
+
+   insert into user_group_type_fields (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) 
+   values
+   (''edu_class'', ''teams_p'', ''Will the class be divided into teams?'', ''boolean'', ''char(1)'',''default ''''f'''' check(teams_p in (''''t'''',''''f''''))'', 13);
+
+
+   insert into user_group_type_fields (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) 
+   values
+   (''edu_class'', ''exams_p'', ''Will the class have exams?'', ''boolean'', ''char(1)'',''default ''''f'''' check(exams_p in (''''t'''',''''f''''))'', 14);
+
+
+   insert into user_group_type_fields (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) 
+   values
+   (''edu_class'', ''final_exam_p'', ''Will the class have a final exam?'', ''boolean'', ''char(1)'',''default ''''f'''' check(final_exam_p in (''''t'''',''''f''''))'', 15);
+
+   insert into user_group_type_fields (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) 
+   values
+   (''edu_class'', ''exams_folder_id'', ''Exams Folder'', ''integer'', ''integer'', ''references fs_files'', 16);
+
+  end if;
+  return 0;
+end;
+' language 'plpgsql';
+
+select init_education_2();
+
+-- create a view for current classes whose webpages we should display 
+-- to students
+
+create view edu_current_classes
+as
+select
+	user_groups.group_id as class_id,
+	group_name as class_name,
+	edu_class_info.term_id,
+	subject_id,
+	edu_class_info.start_date,
+	edu_class_info.end_date,
+	description,
+	where_and_when,
+	syllabus_id,
+	lecture_notes_folder_id,
+	handouts_folder_id,
+	assignments_folder_id,
+	projects_folder_id,
+	exams_folder_id,
+	public_p,
+	grades_p,
+	teams_p,
+	exams_p,
+	final_exam_p
+from user_groups, edu_class_info
+where user_groups.group_id = edu_class_info.group_id
+and group_type = 'edu_class'
+and active_p = 't'
+and existence_public_p='t'
+and approved_p = 't'
+and sysdate() < edu_class_info.end_date
+and sysdate() >= edu_class_info.start_date;
+
+-- create a view for all active classes in the system - these are so
+-- professors can access the admin pages even though students don't see
+-- these classes
+
+create view edu_classes
+as
+select
+	user_groups.group_id as class_id,
+	group_name as class_name,
+	edu_class_info.term_id,
+	subject_id,
+	edu_class_info.start_date,
+	edu_class_info.end_date,
+	description,
+	where_and_when,
+	syllabus_id,
+	lecture_notes_folder_id,
+	handouts_folder_id,
+	assignments_folder_id,
+	projects_folder_id,
+	exams_folder_id,
+	public_p,
+	grades_p,
+	teams_p,
+	exams_p,
+	final_exam_p
+from user_groups, edu_class_info
+where user_groups.group_id = edu_class_info.group_id
+and group_type = 'edu_class'
+and active_p = 't'
+and existence_public_p='t'
+and approved_p = 't';
+
+
+
+-- now, we want to be able to store information about each individual in
+-- a class so we create an entry in user_group_type_member_fields
+
+insert into user_group_type_member_fields 
+(group_type, role, field_name, field_type, sort_key) 
+values 
+('edu_class', 'student', 'Institution ID', 'short_text', 1);
+
+insert into user_group_type_member_fields 
+(group_type, role, field_name, field_type, sort_key) 
+values 
+('edu_class', 'dropped', 'Institution ID', 'short_text', 2);
+
+insert into user_group_type_member_fields 
+(group_type, role, field_name, field_type, sort_key) 
+values 
+('edu_class', 'student', 'Student Account', 'short_text', 3);
+
+insert into user_group_type_member_fields 
+(group_type, role, field_name, field_type, sort_key) 
+values 
+('edu_class', 'dropped', 'Student Account', 'short_text', 4);
+
+insert into user_group_type_member_fields 
+(group_type, role, field_name, field_type, sort_key) 
+values
+('edu_class', 'ta', 'Office', 'short_text', 5);
+
+insert into user_group_type_member_fields 
+(group_type, role, field_name, field_type, sort_key) 
+values
+('edu_class', 'professor', 'Office', 'short_text', 6);
+
+insert into user_group_type_member_fields 
+(group_type, role, field_name, field_type, sort_key) 
+values
+('edu_class', 'professor', 'Phone Number', 'short_text', 7);
+
+insert into user_group_type_member_fields 
+(group_type, role, field_name, field_type, sort_key) 
+values
+('edu_class', 'ta', 'Phone Number', 'short_text', 8);
+
+insert into user_group_type_member_fields 
+(group_type, role, field_name, field_type, sort_key) 
+values
+('edu_class', 'ta', 'Office Hours', 'short_text', 9);
+
+insert into user_group_type_member_fields 
+(group_type, role, field_name, field_type, sort_key) 
+values
+('edu_class', 'professor', 'Office Hours', 'short_text', 10);
+
+
+
+
+-- we want to be able to divide classes further into sections.
+-- this is nice for tutorials and recitations.  
+
+-- you can get the class for the section from the parent_group_id from user_groups
+
+create table edu_section_info (
+	group_id		integer not null references user_groups,
+	section_time		varchar(100),
+	section_place		varchar(100)
+);
+
+
+
+create function init_education_3() returns integer as '
+declare	
+ n_section_group_types integer;
+begin
+ select count(*) into n_section_group_types from user_group_types where group_type = ''edu_section'';
+  if n_section_group_types = 0 then
+    insert into user_group_types
+    (group_type, pretty_name, pretty_plural, approval_policy, default_new_member_policy,group_module_administration)
+    values
+   (''edu_section'',''Section'',''Sections'',''wait'',''open'',''full'');
+
+
+   insert into user_group_type_fields (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) 
+   values
+   (''edu_section'', ''section_time'', ''Section Time'', ''text'', ''varchar(100)'', NULL, 2);
+
+
+   insert into user_group_type_fields (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key) 
+   values
+   (''edu_section'', ''section_place'', ''Section Place'', ''text'', ''varchar(100)'', NULL, 3);
+
+  end if;
+  return 0;
+end;
+' language 'plpgsql';
+
+select init_education_3();
+
+
+create view edu_sections
+as
+select
+	user_groups.group_id as section_id,
+	group_name as section_name,
+	parent_group_id as class_id,
+	section_time,
+ 	section_place
+from user_groups, edu_section_info
+where user_groups.group_id = edu_section_info.group_id
+and group_type = 'edu_section'
+and active_p = 't'
+and approved_p = 't';
+
+
+
+create function init_education_4()
+returns integer as '
+declare	
+ n_classes_group_types integer;
+begin
+ select count(*) into n_classes_group_types from user_group_types where group_type = ''edu_department'';
+  if n_classes_group_types = 0 then
+    insert into user_group_types
+    (group_type, pretty_name, pretty_plural, approval_policy, default_new_member_policy, group_module_administration)
+    values
+   (''edu_department'',''Department'',''Departments'',''wait'',''open'',''none'');
+  end if;
+  return 0;
+end;
+' language 'plpgsql';
+
+select init_education_4();
+
+-- we are implementing teams as subgroups so lets create a view to see them
+
+
+create view edu_teams
+as
+select
+	group_id as team_id,
+	group_name as team_name,
+	parent_group_id as class_id,
+	admin_email,
+	registration_date,
+	creation_user,
+	creation_ip_address,
+	existence_public_p,
+	new_member_policy,
+	email_alert_p,
+	multi_role_p,
+	group_admin_permissions_p,
+	index_page_enabled_p,
+	body,
+	html_p,
+	modification_date,
+	modifying_user
+from user_groups
+where group_type = 'edu_team'
+and active_p = 't'
+and approved_p = 't';
+
+-- Create edu_team group type
+create function init_education_5() returns integer as '
+declare	
+ n_teams_group_types integer;
+begin
+ select count(*) into n_teams_group_types from user_group_types where group_type = ''edu_team'';
+  if n_teams_group_types = 0 then
+    insert into user_group_types
+    (group_type, pretty_name, pretty_plural, approval_policy, default_new_member_policy,group_module_administration)
+    values
+   (''edu_team'',''Team'',''Teams'',''wait'',''open'',''none'');
+  end if;
+  return 0;
+end;
+' language 'plpgsql';
+
+select init_education_5();
+
+create sequence edu_textbooks_sequence start 1;
+
+create table edu_textbooks (
+	textbook_id	integer not null primary key,
+	title		varchar(200),
+	author		varchar(400),
+	publisher	varchar(200),
+        -- isbn has to be a varchar and not a number because some ISBNs have the letter
+        -- x at the end; ISBN will be just the digits and letters mushed together
+	-- (no dashes in between), amazon.com style
+        isbn               varchar(50)
+);
+
+
+-- map the textbooks to classes
+
+create table edu_classes_to_textbooks_map (
+	textbook_id	integer references edu_textbooks,
+	class_id	integer references user_groups,
+	required_p	char(1) default 't' check (required_p in ('t','f')),
+	comments		varchar(4000),
+	primary key (class_id, textbook_id)
+);
+
+
+
+
+create sequence edu_grade_sequence;
+
+-- records the grade types and their relative weights. this table will not 
+-- capture the qualitative factors, but should take care of the
+-- quantitative portion of the final grade
+create table edu_grades (
+       grade_id		       integer not null primary key,
+       grade_name	       varchar(100),
+       class_id		       integer not null references user_groups,
+       comments		       varchar(4000),
+       -- weight is a percentage
+       weight		       numeric check (weight between 0 and 100),
+       last_modified           datetime default current_timestamp not null,
+       last_modifying_user     integer not null references users,
+       modified_ip_address     varchar(20) not null
+);
+
+-- we want to audit edu_grades
+
+create table edu_grades_audit (
+       grade_id		       integer,
+       grade_name	       varchar(100),
+       class_id		       integer,
+       comments		       varchar(4000),
+       -- weight is a percentage
+       weight		       numeric,
+       last_modified           datetime,
+       last_modifying_user     integer,
+       modified_ip_address     varchar(20),
+       delete_p                char(1) default('f') check (delete_p in ('t','f'))
+);
+
+
+-- we create a trigger to keep the audit table current
+create function trig_edu_grades_audit_trigger()
+returns opaque as '
+DECLARE
+begin
+   insert into edu_grades_audit (
+        grade_id,
+        grade_name,
+	class_id,
+	comments,
+	weight,
+	last_modified,
+	last_modifying_user,
+	modified_ip_address)
+    values (
+        OLD.grade_id,
+        OLD.grade_name,
+	OLD.class_id,
+	OLD.comments,
+	OLD.weight,
+	OLD.last_modified,
+	OLD.last_modifying_user,
+	OLD.modified_ip_address);
+    return NEW;
+end;
+' language 'plpgsql';
+
+create trigger edu_grades_audit_trigger
+before update or delete on edu_grades
+for each row
+execute procedure trig_edu_grades_audit_trigger();
+
+
+-- we want to be able to easily keep track of lecture notes/handouts
+-- note that we do not keep track of author or date uploaded or even
+-- a comment about it.  We do not because is all kept in the
+-- fs_files table, which edu_handouts references.  We keep the handout_name
+-- in both places because we will be displaying that a lot and we do not
+-- want to always have to join with fs_files
+
+create sequence edu_handout_id_sequence start 1;
+
+create table edu_handouts (
+	handout_id		integer not null primary key,
+	class_id		integer references user_groups,
+	handout_name		varchar(500) not null,
+	file_id			integer references fs_files not null,
+	-- what kind of handout is this?  Possibilities include
+	-- lecture_notes and announcement
+	handout_type		varchar(200),
+	-- what date was this handout given out
+	distribution_date 	datetime default current_timestamp
+);
+
+
+
+
+-- we want to be able to keep track of assignemnts within the class.
+
+create sequence edu_task_sequence;
+
+-- includes assignments, projects, exams, any tasks a student might be
+-- graded on
+
+create table edu_student_tasks (
+	task_id		integer primary key,
+	class_id 	integer not null references user_groups,
+	grade_id	integer references edu_grades,
+        -- we have to have a task type so we can categorize tasks in the
+        -- user pages
+	task_type	varchar(100) check (task_type in ('assignment', 'exam', 'project')),
+	task_name	varchar(100),
+	description	varchar(4000),
+	-- the date we assigned/created the task
+	date_assigned	datetime,
+	-- we want to know the last time the task was modified
+	-- (the permissions were changed or a new version was uploaded, etc)
+        last_modified   datetime,
+	-- could be date assignment is due, or date of an exam
+	due_date	datetime,
+	-- this references the fs_files that holds either the 
+	-- actual assignment available for download or the url of the
+	-- assignment
+	file_id		integer references fs_files,
+	-- who assigned this?
+	assigned_by	integer not null references users,
+        -- This column is for projects where students can
+        -- assign themselves to teams.
+        self_assignable_p char(1) default 'f' check (self_assignable_p in ('t','f')),
+        self_assign_deadline    datetime,
+	-- how much is this assignment worth compared to the others with
+        -- the same grade_id (e.g. under the same grade group)?
+	-- weight is a percentage	
+	weight			numeric check (weight between 0 and 100),
+	requires_grade_p char(1) check (requires_grade_p in ('t','f')),
+	-- whether the task is submitted/administered online
+	online_p char(1) check (online_p in ('t','f')),
+	-- if an assignment has been deleted we mark it as inactive
+	active_p char(1) default 't' check (active_p in ('t','f'))
+);
+
+
+-- views for assignments, exams, and projects
+create view edu_projects
+as 
+  select
+  task_id as project_id,
+  class_id,
+  task_type,
+  assigned_by as teacher_id,
+  grade_id,
+  task_name as project_name,
+  description,
+  date_assigned,
+  last_modified,
+  due_date,
+  file_id,
+  weight,
+  requires_grade_p,
+  online_p as electronic_submission_p
+from edu_student_tasks 
+where task_type='project'
+and active_p='t';
+
+create view edu_exams
+as
+  select
+  task_id as exam_id,
+  task_type,
+  class_id,
+  assigned_by as teacher_id,
+  grade_id,
+  task_name as exam_name,
+  description as comments,
+  date_assigned as creation_date,
+  last_modified,
+  due_date as date_administered,
+  file_id,
+  weight,
+  requires_grade_p,
+  online_p
+from edu_student_tasks 
+where task_type='exam'
+and active_p='t';
+
+create view edu_assignments 
+as 
+  select 
+  task_id as assignment_id,
+  task_type,
+  class_id,
+  assigned_by as teacher_id,
+  grade_id,
+  task_name as assignment_name,
+  description,
+  date_assigned,
+  last_modified,
+  due_date,
+  file_id,
+  weight,
+  requires_grade_p,
+  online_p as electronic_submission_p
+from edu_student_tasks
+where task_type = 'assignment'
+and active_p='t';
+
+
+-- we want to be able to post the solutions and associate the solutions
+-- to a given file
+
+create table edu_task_solutions (
+	task_id			integer references edu_student_tasks,
+	file_id			integer references fs_files,
+	primary key(task_id, file_id)
+);
+
+
+
+-- we want a table to map student solutions to assignments
+-- this is what allows students to upload their finished papers, etc.
+
+create table edu_student_answers (
+	student_id		integer references users,
+	task_id			integer references edu_student_tasks,
+	file_id			integer references fs_files,
+	-- this is the date of the last time the solutions were changed
+	last_modified           datetime default current_timestamp not null,
+        last_modifying_user     integer not null references users,
+	-- modified_ip_address is stored as a string separated by periods.
+        modified_ip_address     varchar(20) not null
+);
+
+
+create table edu_student_answers_audit (
+	student_id		integer,
+	task_id			integer,
+	file_id			integer,
+	-- this is the date of the last time the solutions were changed
+	last_modified           datetime,
+        last_modifying_user     integer,
+	-- modified_ip_address is stored as a string separated by periods.
+        modified_ip_address     varchar(20)
+);
+
+
+-- we create a trigger to keep the audit table current
+
+create function trig_edu_student_answers_audit()
+returns opaque as '
+DECLARE
+begin
+	insert into edu_student_answers_audit (
+	    	student_id,
+		task_id,
+		file_id,
+		last_modified,
+		last_modifying_user,
+		modified_ip_address)
+           values (
+	    	OLD.student_id,
+		OLD.task_id,
+		OLD.file_id,
+		OLD.last_modified,
+		OLD.last_modifying_user,
+		OLD.modified_ip_address);  
+         return NEW;                   
+end;
+' language 'plpgsql';
+
+create trigger edu_student_answers_audit
+before update or delete on edu_student_answers
+for each row
+execute procedure trig_edu_student_answers_audit();
+
+
+
+-- this is where we keep the student grades and the evaluations
+-- that students receive from teachers
+
+create sequence edu_evaluation_id_sequence;
+
+create table edu_student_evaluations (
+	evaluation_id		integer primary key,
+	class_id		integer not null references user_groups,
+        -- must have student_id or team_id 
+	student_id		integer references users,
+	team_id			integer references user_groups,
+	task_id		        integer references edu_student_tasks,
+	-- there may be several times during the term that the prof 
+        -- wants to evaluate a student.  So, the evaluation_type 
+        -- is something like 'end_of_term' or 'midterm'
+	evaluation_type		varchar(100),
+	grader_id		integer not null references users,
+	grade			varchar(5),
+	comments		varchar(4000),
+	show_student_p		char(1) default 't' check (show_student_p in ('t','f')),
+	evaluation_date		datetime default current_timestamp,
+	last_modified           datetime default current_timestamp not null,
+        last_modifying_user     integer not null references users,
+	-- modified_ip_address is stored as a string separated by periods.
+        modified_ip_address     varchar(20) not null
+);
+
+
+-- we want to audit the evaluations table
+
+create table edu_student_evaluations_audit (
+	evaluation_id		integer,
+	class_id		integer,
+        -- must have student_id or team_id 
+	student_id		integer,
+	team_id			integer,
+	task_id		        integer,
+	evaluation_type		varchar(100),
+	grader_id		integer,
+	grade			varchar(5),
+	comments		varchar(4000),
+	show_student_p		char(1),
+	evaluation_date		datetime,
+	last_modified           datetime,
+        last_modifying_user	integer,
+        modified_ip_address     varchar(20)
+);
+
+
+-- now, we want to hold information about each project.  It is possible
+-- to have one term project but many instances of that project.  For
+-- instance, "Final Project for 6.916" is a term project that would
+-- be kept in the edu_tasks table but ArfDigita.org is a project
+-- instance that would be kept in this table.  There is a many to 
+-- one mapping
+
+-- we make task_id not null because every project has to be part of
+-- some sort of task (either an assignment or a project)
+-- we make it a task because all evaluations are done on tasks
+
+create sequence edu_project_instance_id_seq start 1;
+
+create table edu_project_instances  (
+	project_instance_id 	integer not null primary key,
+	project_instance_name	varchar(200),
+	project_instance_url	varchar(500),
+	-- which project is this an instance of?
+	project_id		integer not null references edu_student_tasks,
+	description		varchar(4000),
+	approved_p		char(1) default 'f' check(approved_p in ('t','f')),
+        approved_date           datetime,
+        approving_user          integer references users(user_id),
+	-- we want to be able to generate a consistent user interface so
+	-- we record the type of project.  
+	project_type		varchar(10) default 'team' check(project_type in ('user','team')),
+	min_body_count		integer,
+	max_body_count		integer,
+	-- we want to be able to "delete" project instances so we have active_p
+	active_p		char(1) default 't' check(active_p in ('t','f'))
+);
+
+
+
+
+-- we want to be able to assign students and teams to projects
+
+create table edu_project_user_map (
+	project_instance_id	integer not null references edu_project_instances,
+	team_id			integer references user_groups,
+	student_id		integer references users,
+	constraint edu_project_user_map_check check ((team_id is null and student_id is not null) or (team_id is not null and student_id is null))
+);
+
+create index edu_project_map_idx on edu_project_user_map(project_instance_id, team_id, student_id);
+
+
+-- we want to allow classes to rename their roles.  That is,
+-- some people want to be called Professor where others want
+-- to be called Instructor and still others want to be called
+-- Lecturer.  We don't want to just use the 'role' column
+-- in user_group_roles because then we would not have a way
+-- to "spam all professors and TAs" because we would not know
+-- which role was a prof and which was a TA.  Also, we want to
+-- have a sort_key so that we know which order to display these
+-- items when they are shown to the user.  So, we have the following
+-- table
+
+-- so, for the case where a class wants to call the prof a Lecturer, 
+-- we would have role = Professor and pretty_role = Lecturer
+
+create table edu_role_pretty_role_map (
+	group_id		integer not null references user_groups,
+	-- role should reference user_group_roles(role)
+	role			varchar(200),
+	-- what the class wants to call the role
+	pretty_role		varchar(200),
+	pretty_role_plural 	varchar(300),
+	-- sort key for display of columns.
+	sort_key		integer not null,
+	-- this is to capture info about the hierarchy of role permissions
+	priority		integer,
+	primary key (group_id, role)
+);
+
+
+
+
+
+
+
+-------------------------------------------------
+-------------------------------------------------
+--
+--        	BEGIN PL/SQL 
+--
+--
+-------------------------------------------------
+-------------------------------------------------
+
+
+
+
+-- now, we need a trigger to update the table we just created
+-- this is included in case people want to add new roles to
+-- the class all they have to do insert into user_group_roles
+-- and this will take care of the rest
+
+-- PG rocks. No need for this trio stuff (BMA).
+create function trig_edu_class_role_update_tr()
+returns opaque as '
+DECLARE
+BEGIN
+	v_group_id	user_group_roles.group_id%TYPE;
+	v_new_role	user_group_roles.role%TYPE;
+	v_class_p	integer;
+BEGIN
+	select count(user_group_roles.group_id) into v_class_p,
+        user_group_roles.group_id into v_group_id, 
+        role into v_new_role
+	from user_groups, user_group_roles
+	where group_type = ''edu_class''
+        and user_group_roles.oid = NEW.oid
+        and user_group_roles.group_id = user_groups.group_id
+        group by user_group_roles.group_id, role;
+
+ 	-- if this is a group of type edu_class
+	IF v_class_p > 0 THEN
+	   -- we want to update the existing row
+	   update edu_role_pretty_role_map
+           set role = v_new_role
+           where group_id = v_group_id
+           and role = OLD.role;
+	END IF;
+	
+	return new;
+END;
+' language 'plpgsql';
+
+CREATE TRIGGER edu_class_role_update_tr
+BEFORE UPDATE ON user_group_roles
+FOR EACH ROW
+execute procedure trig_edu_class_role_update_tr();
+
+-- for every row that is inserted into the user_group_roles, if
+-- the group is of type edu_class then we want to insert a corresponding
+-- role into edu_role_pretty_role_map
+
+create function trig_edu_class_role_insert_tr()
+returns opaque as '
+DECLARE
+	v_class_p	integer;
+BEGIN
+	select count(group_id) into v_class_p
+	from user_groups
+	where group_type = ''edu_class''
+        and group_id = NEW.group_id;
+
+	IF v_class_p > 0 THEN
+
+		insert into edu_role_pretty_role_map (
+        	       group_id, 
+	               role, 
+        	       pretty_role,
+                       pretty_role_plural, 
+	               sort_key,
+                       priority) 
+        	    select
+	               NEW.group_id, 
+  		       NEW.role, 
+		       NEW.role, 
+                       NEW.role || ''s'',
+    		       coalesce(max(sort_key),0) + 1,
+    		       coalesce(max(priority),0) + 1
+	             from edu_role_pretty_role_map
+        	    where group_id = NEW.group_id;
+	END IF;
+	return NEW;
+END;
+' language 'plpgsql';
+
+CREATE TRIGGER edu_class_role_insert_tr
+AFTER INSERT ON user_group_roles
+FOR EACH ROW
+execute procedure trig_edu_class_role_insert_tr();
+
+-- if a role is delete from user_group_roles and the group
+-- is of type edu_class then we also want to delete it from
+-- edu_role_pretty_role_map
+
+create function trig_edu_class_role_delete_tr()
+returns opaque as '
+DECLARE
+	v_class_p	integer;
+BEGIN
+	select count(group_id) into v_class_p
+	from user_groups
+	where group_type = ''edu_class''
+        and group_id = OLD.group_id
+	and group_type = ''edu_class'';
+
+	IF v_class_p > 0 THEN
+
+		delete from edu_role_pretty_role_map 
+		where group_id = OLD.group_id
+                and role = OLD.role;
+
+	END IF;
+        return OLD;
+END;
+' language 'plpgsql';
+
+CREATE TRIGGER edu_class_role_delete_tr
+BEFORE DELETE ON user_group_roles
+FOR EACH ROW
+execute procedure trig_edu_class_role_delete_tr();
+
+
+
+
+---------------------------------------------------
+--
+--
+--
+--    begin the portal tables
+--
+--
+--
+---------------------------------------------------
+
+
+
+-- the portal mini-tables
+
+create sequence weather_id_sequence;
+
+
+create table portal_weather (
+       weather_id    integer not null primary key,
+       user_id		    integer not null references users,
+       city		    varchar(100),
+       usps_abbrev	    char(2) references states,
+       zip_code		    varchar(10),
+       -- the type can be: next day forecast, 5 day forecast, current conditions
+       five_day_p		    char(1) default 'f' check (five_day_p in ('t','f')),
+       next_day_p		    char(1) default 'f' check (next_day_p in ('t','f')),
+       current_p	    char(1) default 'f' check (current_p in ('t','f'))
+);
+
+create table portal_stocks (
+       user_id		   integer not null references users,
+       symbol		   varchar(10) not null,
+       default_p	   char(1) default 'f' check(default_p in ('t','f'))
+);
+
+--- we're currently using the calendar module and not edu_calendar
+--- because the features have not been fully implemented 
+-- this is taken from the intranet calendar
+create table edu_calendar_categories (
+	category	varchar(100) primary key,
+	enabled_p	char(1) default 't' check(enabled_p in ('t','f'))
+);
+
+create sequence edu_calendar_id_sequence;
+
+-- updates from intranet/doc/sql/calendar.sql:
+-- the addition of a viewable column that specifies whether the calendar
+-- entry is viewable by the public and if so, whether we should show the
+-- title or something in place of the title (e.g. Busy, Free, Tentative --
+-- MS Outlook options). also, addition of owner column that identifies who
+-- the entry is for: so we can display calendars with respect to individual
+-- users or groups of users (like in a team)
+
+create table edu_calendar (
+	calendar_id	integer primary key,
+	category	integer not null references calendar_categories,
+	-- the way we connect calendar entries to users
+	owner		integer not null references users,
+	title		varchar(100) not null,
+	body		varchar(4000) not null,
+	-- is the body in HTML or plain text (the default)
+	html_p			char(1) default 'f' check(html_p in ('t','f')),
+	start_date	datetime not null,  -- first day of the event
+	end_date	datetime not null,  -- last day of the event (same as start_date for single-day events)
+	expiration_date	datetime not null,  -- day to stop including the event in calendars, typically end_date
+	-- viewable as public means the title will be displayed. private
+	-- means the entry will be invisible unless viewed by the
+	-- owner. busy, free, or tentative will be displayed instead of title
+	-- to viewers other than owner
+	viewable	varchar(100) default 'public' check(viewable in
+	('public', 'busy', 'free', 'tentative', 'private')),
+	event_url	varchar(200),  -- URL to the event
+	event_email	varchar(100),  -- email address for the event
+	-- for events that have a geographical location
+	country_code	char(2) references country_codes(iso),
+	-- within the US
+	usps_abbrev	char(2) references states,
+	-- we only want five digits
+	zip_code	varchar(10),
+	approved_p	char(1) default 'f' check(approved_p in ('t','f')),
+	creation_date	datetime not null,
+	creation_user		integer not null references users(user_id),
+	creation_ip_address	varchar(50) not null
+);
+
+-- create default tables for each portal
+-- start a personal category so the user can enter personal events of
+-- "user" scope
+create function trig_portal_page_upon_new_user()
+returns opaque as '
+DECLARE
+  begin
+    insert into portal_pages 
+    (page_id, user_id, page_number)
+    values
+    (nextval(''portal_page_id_sequence''), NEW.user_id, 1);
+    insert into calendar_categories (category_id, scope, user_id, category,
+enabled_p) 
+    values 
+    (nextval(''calendar_category_id_sequence''), ''user'', NEW.user_id,
+''Personal'', ''t'');    
+    return NEW;
+  end;
+' language 'plpgsql';
+
+create trigger portal_page_upon_new_user
+after insert on users
+for each row
+execute procedure trig_portal_page_upon_new_user();
+
+-- the opposite of the above trigger -- for deleting users
+create function trig_portal_remove_upon_user_delete()
+returns opaque as '
+DECLARE
+BEGIN
+	delete from portal_pages
+	where user_id= OLD.user_id;
+	return OLD;  
+END;
+' language 'plpgsql';
+
+create trigger portal_remove_upon_user_delete
+before delete on users
+for each row
+execute procedure trig_portal_remove_upon_user_delete();
+
+create function trig_portal_setup_upon_page_insert()
+returns opaque as '
+DECLARE
+	stock_table_id		portal_tables.table_id%TYPE;
+	weather_table_id	portal_tables.table_id%TYPE;
+	classes_table_id	portal_tables.table_id%TYPE;
+	announcements_table_id	portal_tables.table_id%TYPE;
+	calendar_table_id	portal_tables.table_id%TYPE;
+BEGIN
+	select table_id into stock_table_id from portal_tables where
+table_name=''Stock Quotes'';
+	select table_id into weather_table_id from portal_tables where
+table_name=''Current Weather'';
+	select table_id into classes_table_id from portal_tables where
+table_name=''Classes'';
+	select table_id into announcements_table_id from portal_tables where
+table_name=''Announcements'';
+	select table_id into calendar_table_id from portal_tables where
+table_name=''Calendar'';
+     insert into portal_table_page_map
+     (page_id, table_id, sort_key, page_side)
+     values
+     (NEW.page_id, stock_table_id, 1, ''l'');
+     insert into portal_table_page_map
+     (page_id, table_id, sort_key, page_side)
+     values
+     (NEW.page_id, weather_table_id, 2, ''l'');
+     insert into portal_table_page_map
+     (page_id, table_id, sort_key, page_side)
+     values
+     (NEW.page_id, classes_table_id, 1, ''r'');
+     insert into portal_table_page_map
+     (page_id, table_id, sort_key, page_side)
+     values
+     (NEW.page_id, announcements_table_id, 3, ''l'');
+     insert into portal_table_page_map
+     (page_id, table_id, sort_key, page_side)
+     values
+     (NEW.page_id, calendar_table_id, 2, ''r'');
+     return NEW;
+END;
+' language 'plpgsql';
+
+create trigger portal_setup_upon_page_insert
+after insert on portal_pages
+for each row
+execute procedure trig_portal_setup_upon_page_insert();
+
+-- the opposite of the trigger above -- upon deleting a page for portal
+-- table we also want to delete the entries from portal_table_page_map
+create function trig_portal_update_upon_page_delete()
+returns opaque as '
+DECLARE
+BEGIN
+	delete from portal_table_page_map where page_id= OLD.page_id;
+    return old;
+END;
+' language 'plpgsql';
+
+
+-- drop function edu_count_classes(integer);
+create function edu_count_classes(integer) returns integer as '
+declare
+        id      alias for $1;
+        cnt     integer;
+begin
+        select into cnt count(class_id) 
+          from edu_classes, edu_terms
+         where edu_classes.term_id = edu_classes.term_id;
+        return (case when cnt is null then 0 else cnt end);
+end;
+' language 'plpgsql';
+
+create trigger portal_update_upon_page_delete
+before delete on portal_pages
+for each row
+execute procedure trig_portal_update_upon_page_delete();
+
+
+create view solution_files as 
+select sol.file_id, version_id, file_extension, url, task_id
+  from edu_task_solutions sol, fs_versions_latest ver
+ where sol.file_id = ver.file_id;
+
+
+create view task_files as 
+select ver.file_id, version_id, file_extension, url, task_id
+  from edu_task_solutions sol, fs_versions_latest ver
+ where sol.file_id = ver.file_id;
+
+
+create view student_files as 
+select url, author_id as student_id, file_extension, version_id, task_id, task.file_id 
+  from fs_versions_latest ver, edu_student_answers task  
+ where task.file_id = ver.file_id;
+
+-- drop view student_answer_files;
+create view student_answer_files as 
+select file_extension, file_title, url, version_id, task_id, student_id
+                    from fs_versions_latest ver,
+                         edu_student_answers ans,
+                         fs_files
+                   where ver.file_id = ans.file_id 
+                     and fs_files.file_id = ver.file_id;
+
+
+create view member_field_mapping as 
+select fm.field_name,  fm.field_value, tmf.sort_key,  fm.user_id, group_type
+  from user_group_type_member_fields tmf, user_group_member_field_map fm
+ where tmf.field_name = fm.field_name;
+
+-- check about distinct in this query DanW
+create view user_group_member_field_mapping as
+select fm.field_name, 
+                   fm.field_value,
+                   tmf.sort_key,
+                   fm.user_id,
+                   fm.group_id
+              from user_group_type_member_fields tmf,
+                   user_group_member_field_map fm,
+                   user_group_map map
+             where group_type = 'edu_class'
+               and map.group_id = fm.group_id
+               and (tmf.role is null or lower(tmf.role) = lower(map.role))
+               and lower(tmf.field_name) = lower(fm.field_name);
+
+
+
+-- drop view student_answers;
+create view student_answers as 
+select users.first_names,
+               users.last_name,
+               eval.grade,
+               eval.comments,
+               eval.evaluation_id,
+               eval.show_student_p,
+               eval.task_id,
+               eval.grader_id,
+               eval.student_id
+          from edu_student_evaluations eval,
+               users
+         where users.user_id = eval.grader_id;
+
+
+create view role_mapping as 
+select pretty_role, map.group_id, map.user_id
+               from user_group_map map,
+                    edu_role_pretty_role_map role_map
+              where lower(role_map.role) = lower(map.role)
+                and role_map.group_id = map.group_id;
Index: web/openacs/www/doc/sql/email-handler.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/email-handler.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/email-handler.sql	17 Apr 2001 14:05:12 -0000	1.1
@@ -0,0 +1,21 @@
+--
+-- email-handler.sql
+--
+-- by hqm@arsdigita.com June 1999
+--
+-- for queueing up email that arrives to robots 
+-- 
+
+create sequence incoming_email_queue_sequence;
+
+-- CONTENT contains the entire raw message content
+-- including all headers
+
+create table incoming_email_queue (
+	id 		integer primary key,
+	destaddr	varchar(256),
+	content		text,
+	arrival_time	datetime
+    );
+
+
Index: web/openacs/www/doc/sql/events.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/events.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/events.sql	17 Apr 2001 14:05:12 -0000	1.1
@@ -0,0 +1,377 @@
+--
+-- data model for events module
+-- 
+-- re-written by bryanche@arsdigita.com on Feb 02, 2000
+-- to support group-based registrations
+-- created by bryanche@arsdigita.com on Jan 13, 2000
+-- adapted from register.photo.net's chautauqua code
+
+-- we store the ISO code in lower case, e.g,. 'us'
+
+-- if detail_url does not start with "HTTP://" then we assume
+-- it is a stub for information on our server and we grab it
+-- from the file system, starting at [ns_info pageroot]
+
+-- Ported to Postgres by Ben Adida (ben@adida.net)
+
+--- create the administration group for the Events module
+select administration_group_add ('Events Administration', 'events', 'events', '', 'f', '/admin/events/'); 
+
+--- create a sub-group in Events for managing activities
+select administration_subgroup_add ('Activities Administration', 'activities', 'events', 'activities', 'f', '/admin/events/', 'events');
+
+-- create a group type of "events"
+insert into user_group_types 
+(group_type, pretty_name, pretty_plural, approval_policy, group_module_administration)
+values
+('event', 'Event', 'Events', 'closed', 'full');
+
+create table event_info (
+       group_id integer primary key references user_groups
+);
+
+-- can't ever delete an event/activity because it might have been
+-- ordered and therefore the row in events_registrations would be hosed
+-- so we flag it
+
+create sequence events_activity_id_sequence;
+
+-- the activities
+create table events_activities (
+	activity_id	integer primary key,
+	-- activities are owned by user groups
+	group_id	integer references user_groups,
+	user_id		integer references users,
+        creator_id      integer not null references users,
+	short_name	varchar(100) not null,
+	default_price   numeric default 0 not null,
+	currency	char(3) default 'USD',
+	description	varchar(4000),
+        -- Is this activity occurring? If not, we can't assign
+        -- any new events to it.
+        available_p	char(1) default 't' check (available_p in ('t', 'f')),
+        deleted_p	char(1) default 'f' check (deleted_p in ('t', 'f')),
+        detail_url 	varchar(256) -- URL for more details
+);
+
+create sequence events_venues_id_sequence;
+
+-- where the events occur
+create table events_venues (
+       venue_id		  integer primary key,
+       venue_name	  varchar(200) not null,
+       address1		  varchar(100),
+       address2		  varchar(100),
+       city		  varchar(100) not null,
+       usps_abbrev	  char(2),
+       postal_code	  varchar(20),
+       iso		  char(2) default 'us' references country_codes,
+       time_zone	  varchar(50),
+       needs_reserve_p	  char(1) default 'f' check (needs_reserve_p in ('t', 'f')),
+       max_people	  integer,	
+       description	  varchar(4000)
+);
+
+create sequence events_event_id_sequence;
+
+-- the events (instances of activities)
+create table events_events (
+        event_id              integer not null primary key,
+        activity_id	      integer not null references events_activities,
+	venue_id	      integer not null references events_venues,
+	-- the user group that is created for this event's registrants
+	group_id	      integer not null references user_groups,
+	creator_id	      integer not null references users,
+        -- HTML to be displayed after a successful order.
+        display_after         varchar(4000),
+        -- Date and time.
+        start_time            datetime not null,
+        end_time              datetime not null,
+	reg_deadline	      datetime not null,
+        -- An event may have been cancelled.
+        available_p	      char(1) default 't' check (available_p in ('t', 'f')),	
+        deleted_p	      char(1) default 'f' check (deleted_p in ('t', 'f')),
+        max_people	      numeric,
+	-- can someone cancel his registration?		
+	reg_cancellable_p     char(1) default 't' check (reg_cancellable_p in ('t', 'f')),
+	-- does a registration need approval to become finalized?
+	reg_needs_approval_p  char(1) default 'f' check (reg_needs_approval_p in ('t', 'f')),
+	-- notes for doing av setup
+	av_note		      varchar(4000),
+	-- notes for catering
+	refreshments_note     varchar(4000),
+	-- extra info about this event
+	additional_note	      varchar(4000),
+	-- besides the web, is there another way to register?
+	alternative_reg	      varchar(4000),
+        check (start_time < end_time),
+	check (reg_deadline <= start_time)
+);
+
+-- Each activity can have default custom fields registrants should enter.  
+create table events_activity_fields (
+	activity_id	integer not null references events_activities,
+	column_name	varchar(30) not null,
+	pretty_name	varchar(50) not null,
+	-- something generic and suitable for handing to AOLserver, 
+	-- e.g., boolean or text
+	column_type	varchar(50) not null,
+	-- something nitty gritty and Oracle-specific, e.g.,
+	-- char(1) instead of boolean
+	-- things like "not null"
+	column_actual_type	varchar(100) not null,
+	column_extra	varchar(100),
+	-- Sort key for display of columns.
+	sort_key	integer not null
+);
+
+  
+-- Each event can have custom fields registrants should enter.  The
+-- event's custom fields are actually stored in the table,
+-- event_{$event_id}_info.  For example, the event with event_id == 5
+-- would have a corresponding table of event_5_info.  Furthermore, this
+-- table will contain a "user_id not null references users" column
+
+-- This table describes the columns that go into event_{$event_id}_info
+create table events_event_fields (
+	event_id	integer not null references events_events,
+	column_name	varchar(30) not null,
+	pretty_name	varchar(50) not null,
+	-- something generic and suitable for handing to AOLserver, 
+	-- e.g., boolean or text
+	column_type	varchar(50) not null,
+	-- something nitty gritty and Oracle-specific, e.g.,
+	-- char(1) instead of boolean
+	-- things like "not null"
+	column_actual_type	varchar(100) not null,
+	column_extra	varchar(100),
+	-- Sort key for display of columns.
+	sort_key	integer not null
+);
+
+
+-- the organizers for events
+create table events_organizers_map (
+       event_id		      integer not null references events_events,  
+       user_id		      integer not null references users,
+       role		      varchar(200) default 'organizer' not null,
+       responsibilities	      varchar(4000)
+);
+
+create sequence events_price_id_sequence;
+
+create table events_prices (
+    price_id            integer primary key,
+    event_id            integer not null references events_events,
+    -- e.g., "Developer", "Student"
+    description         varchar(100) not null,
+    -- we also store the price here too in case someone doesnt want
+    -- to use the ecommerce module but still wants to have prices
+    price		numeric not null,
+    -- This is for hooking up to ecommerce.	
+    -- Each product is a different price for this event.  For example,
+    -- student price and normal price products for an event.
+--  product_id          integer references ec_products,
+    -- prices may be different for early, normal, late, on-site
+    -- admission,
+    -- depending on the date
+    expire_date	      datetime not null,
+    available_date    datetime not null
+);
+
+create sequence events_orders_id_sequence;
+
+create table events_orders (
+       order_id		integer not null primary key,
+--       ec_order_id	integer references ec_orders,
+       -- the person who made the order
+       user_id		integer not null references users,
+       paid_p		char(1) default null check (paid_p in ('t', 'f', null)),
+	payment_method	varchar(50),
+	confirmed_date	datetime,
+	price_charged	numeric,
+	-- the date this registration was refunded, if it was refunded
+	refunded_date	datetime,
+	price_refunded	numeric,	
+       	ip_address	varchar(50) not null
+);
+
+create sequence events_reg_id_sequence;
+
+create table events_registrations(
+          -- Goes into table at confirmation time:
+	reg_id		integer not null primary key,
+	order_id	integer not null references events_orders,
+	price_id	integer not null references events_prices,
+	-- the person registered for this reg_id (may not be the person
+	-- who made the order)
+  	user_id		integer not null references users,
+	-- reg_states: pending, shipped, canceled, refunded
+	--pending: waiting for approval
+	--shipped: registration all set 
+	--canceled: registration canceled
+	--waiting: registration is wait-listed
+	reg_state	varchar(50) not null check (reg_state in ('pending', 'shipped', 'canceled',  'waiting')),
+	-- when the registration was made
+	reg_date	datetime,
+	-- when the registration was shipped
+	shipped_date	datetime,
+  	org		varchar(4000),
+  	title_at_org	varchar(4000),
+	attending_reason  varchar(4000),
+	where_heard	varchar(4000),
+	-- does this person need a hotel?
+        need_hotel_p	char(1) default 'f' check (need_hotel_p in ('t', 'f')),
+	-- does this person need a rental car?
+        need_car_p	char(1) default 'f' check (need_car_p in ('t', 'f')),
+	-- does this person need airfare?
+	need_plane_p	char(1) default 'f' check (need_plane_p in ('t', 'f')),
+	comments	varchar(4000)
+);
+
+-- trigger for recording when a registration ships
+create function trig_event_ship_date_trigger()
+returns opaque
+as '
+DECLARE
+BEGIN
+	IF TG_OP=''INSERT''
+	then if NEW.reg_state = ''shipped''
+	     then NEW.shipped_date:=sysdate();
+	     end if;
+	else
+		IF OLD.reg_state != ''shipped'' and NEW.reg_state=''shipped''
+		THEN
+			NEW.shipped_date:= sysdate();
+		END IF;
+	end if;
+	return NEW;
+END;
+' language 'plpgsql';
+
+create trigger event_ship_date_trigger
+before insert or update on events_registrations
+for each row
+execute procedure trig_event_ship_date_trigger();
+
+create view events_pending_orders
+as select * from events_registrations where reg_state='pending';
+
+create view events_waiting_orders
+as select * from events_registrations where reg_state='waiting';
+
+-- create a view that shows order states based upon each order's 
+-- registrations.  The order states are:
+-- void: All registrations canceled
+-- incomplete: This order is not completely fulfilled--some registrations
+-- are either canceled, waiting, or pending
+-- fulfilled: This order is completely fulfilled
+
+create view events_orders_states_helper
+as
+select order_id, 
+case when (floor (avg (case when reg_state = 'canceled' then 0
+				when reg_state = 'waiting' then 1
+				when reg_state = 'pending' then 2
+				when reg_state = 'shipped' then 3
+				else 0 end)))=0 then 'canceled'
+     when (floor (avg (case when reg_state = 'canceled' then 0
+				when reg_state = 'waiting' then 1
+				when reg_state = 'pending' then 2
+				when reg_state = 'shipped' then 3
+				else 0 end)))=1 then 'incomplete'
+     when (floor (avg (case when reg_state = 'canceled' then 0
+				when reg_state = 'waiting' then 1
+				when reg_state = 'pending' then 2
+				when reg_state = 'shipped' then 3
+				else 0 end)))=2 then 'incomplete'
+     when (floor (avg (case when reg_state = 'canceled' then 0
+				when reg_state = 'waiting' then 1
+				when reg_state = 'pending' then 2
+				when reg_state = 'shipped' then 3
+				else 0 end)))=3 then 'fulfilled'
+     else 'void' end as order_state
+from events_registrations group by order_id;
+
+create view events_orders_states 
+as
+select  o.*,
+o_states.order_state
+from events_orders o, events_orders_states_helper o_states
+where o_states.order_id = o.order_id;
+
+create view events_reg_not_canceled
+as 
+select * 
+from events_registrations
+where reg_state <> 'canceled';
+
+create view events_reg_canceled
+as 
+select * 
+from events_registrations
+where reg_state = 'canceled';
+
+create view events_reg_shipped
+as
+select *
+from events_registrations
+where reg_state = 'shipped';
+
+create sequence events_fs_file_id_seq start 1;
+
+create table events_file_storage (
+	file_id			integer primary key,
+	file_title		varchar(300),
+	-- file_content		blob not null,
+	client_file_name		varchar(500),
+	file_type		varchar(100),
+	file_extension		varchar(50),
+	on_which_table		varchar(100) not null,
+	on_what_id		integer not null,
+	-- the size (kB) of the fileument
+	file_size		integer, 
+	created_by		integer references users,
+	creation_ip_address	varchar(100),
+	creation_date		datetime default current_timestamp 
+);
+	
+create index events_file_storage_id_idx on events_file_storage(on_which_table, on_what_id);
+
+
+--
+-- Outer join stuff
+-- 
+-- BMA
+
+create function events_count_reg_shipped_by_price_id(integer)
+returns integer
+as '
+DECLARE
+	v_price_id alias for $1;
+BEGIN
+	return count(*) from events_reg_shipped where price_id= v_price_id;
+END;
+' language 'plpgsql';
+
+
+create function events_count_pending_orders_by_price_id(integer)
+returns integer
+as '
+DECLARE
+	v_price_id alias for $1;
+BEGIN
+	return count(*) from events_pending_orders where price_id= v_price_id;
+END;
+' language 'plpgsql';
+
+
+create function events_count_waiting_orders_by_price_id(integer)
+returns integer
+as '
+DECLARE
+	v_price_id alias for $1;
+BEGIN
+	return count(*) from events_waiting_orders where price_id= v_price_id;
+END;
+' language 'plpgsql';
Index: web/openacs/www/doc/sql/faq.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/faq.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/faq.sql	17 Apr 2001 14:05:12 -0000	1.1
@@ -0,0 +1,51 @@
+-- faq.sql  
+
+-- a simple data model for holding a set of FAQs
+-- by dh@arsdigita.com
+
+-- Created Dec. 19 1999
+
+-- ported to Postgres by Ben Adida (ben@mit.edu)
+
+
+create sequence faq_id_sequence;
+
+create table faqs (
+	faq_id		integer primary key,
+	-- name of the FAQ.
+	faq_name	varchar(250) not null,
+	-- group the viewing may be restricted to 
+	group_id	integer references user_groups,
+	-- permissions can be expanded to be more complex later
+        scope		varchar(20) not null,
+        -- insure consistant state 
+       	constraint faq_scope_check check ((scope='group' and group_id is not null) 
+                                          or (scope='public' and group_id is null))
+);
+
+create index faqs_group_idx on faqs ( group_id );
+
+create sequence faq_entry_id_sequence;
+
+create table faq_q_and_a (
+	entry_id	integer primary key,
+	 -- which FAQ
+	faq_id		integer references faqs not null,
+	question	varchar(4000) not null,
+	answer		varchar(4000) not null,
+	 -- determines the order of questions in a FAQ
+	sort_key	integer not null
+);
+
+
+-- weird needed things (BMA)
+
+create function faq_count_entries(integer)
+returns integer
+as '
+DECLARE
+	v_faq_id alias for $1;
+BEGIN
+	return count(*) from faq_q_and_a where faq_id= v_faq_id;
+END;
+' language 'plpgsql';
Index: web/openacs/www/doc/sql/file-storage.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/file-storage.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/file-storage.sql	17 Apr 2001 14:05:12 -0000	1.1
@@ -0,0 +1,231 @@
+--
+-- file-storage.sql
+--
+-- created June 1999 by aure@arsdigita.com and dh@arsdigita.com
+-- 
+
+-- modified January 2000 by randyg@arsdigita.com
+-- All permissions are now taken care of by the general-permissions module
+-- (general-permissions.sql).  Permissions are per version.
+
+create sequence fs_file_id_seq;
+
+create table fs_files (
+	file_id			integer primary key,
+	file_title		varchar(500) not null,
+	-- sort_key and depth help us with displaying contents quickly
+        sort_key		integer not null,
+        depth                   integer not null,
+	folder_p		char(1) default 'f' check (folder_p in ('t','f')),
+	-- the group_id and public_p are used solely for display purposes
+        -- if there is a group_id then we display this file under the group folder
+	group_id                integer references user_groups(group_id),
+	-- if public_p is 't' we show the file in the public folder
+	public_p                char(1) default 'f' check (public_p in ('t','f')),
+	-- if group_id is null and public_p <> 't'
+	-- the folder or document is in the users' tree
+	owner_id		integer not null references users(user_id),
+	deleted_p		char(1) default 'f' check (deleted_p in ('t','f')),
+	-- parent_id is null for top level items
+	parent_id		integer references fs_files(file_id)
+);
+
+create function fs_files_tr() returns opaque as '
+begin
+         if new.parent_id = '''' then
+            new.parent_id := null;
+         end if;
+         if new.group_id = '''' then
+            new.group_id = null;
+         end if;
+  return new;
+end;
+' language 'plpgsql';
+
+create trigger fs_files_tr
+before insert or update on fs_files
+for each row execute procedure fs_files_tr();
+
+-- need two indices to support CONNECT BY 
+
+create index fs_files_idx1 on fs_files(file_id, parent_id);
+create index fs_files_idx2 on fs_files(parent_id, file_id);
+
+
+-- folders are also stored in fs_versions so that general_permissions can be
+-- wrapped around the folders as well.  This way, is someone ever wants to 
+-- put permissions on folders the functionality will already be in place.
+
+create sequence fs_version_id_seq;
+
+create table fs_versions (
+	version_id		integer primary key,
+	-- this is a version of the file key defined by file_key
+	file_id			integer not null references fs_files,
+	-- this is where the actual content is stored
+	-- POSTGRES: not sure what to do here!
+	-- version_content		blob,
+        lob                     integer references lobs,
+	-- description can be keywords, version notes, etc.
+	version_description 	varchar(500),
+	creation_date		datetime not null,
+	author_id		integer not null references users(user_id),
+	-- file name including extension but not path
+	client_file_name	varchar(500),
+	file_type		varchar(100),	-- this is a MIME type (e.g., image/jpeg)
+	file_extension		varchar(50), 	-- e.g., "jpg"
+	-- this value is null for the most recent version or equal to the id 
+        -- of the version that supersedes this one
+	superseded_by_id	integer references fs_versions(version_id),
+	-- can be useful when deciding whether to present all of something
+	n_bytes			integer,
+	-- added so we can store URLs
+	url			varchar(200)
+);
+
+create trigger fs_versions_trigger before delete or update or insert
+on fs_versions for each row execute procedure on_lob_ref();
+
+
+-- we'll often be asking "show me all the versions of file #4"
+create index fs_versions_by_file on fs_versions(file_id);
+
+create view fs_versions_latest
+as
+select * from fs_versions fs where fs.superseded_by_id is null;
+
+
+create function fs_node_is_child(integer,integer) returns char as '
+declare
+        start   alias for $1;
+        id      alias for $2;
+        pid     integer;
+begin
+        if id = start then return ''t'';
+        end if;
+
+        select into pid parent_id from fs_files where file_id = id;
+
+        if pid is null then
+           return ''f'';
+        else if id = start then 
+           return ''t'';
+        else 
+           return fs_node_is_child(start,pid);
+        end if;
+        end if;
+end;
+' language 'plpgsql';
+
+-- drop function fs_gen_key(integer);
+create function fs_gen_key(integer) returns varchar as '
+declare
+        id      alias for $1;
+        str     varchar;
+        len     integer;
+begin
+        str := ''0000000000'' || text(id);
+        len := char_length(str);
+        return substr(str,len - 9);
+end;
+' language 'plpgsql';
+
+-- drop function fs_connect_by(integer);
+create function fs_connect_by(integer) returns text as '
+declare
+	id              alias for $1;
+        pid             integer;
+BEGIN
+        select into pid parent_id from fs_files where id = file_id;
+	IF pid is null
+	THEN 
+		return fs_gen_key(id);
+	ELSE
+		return fs_connect_by(pid) || ''/'' || fs_gen_key(id);
+	END IF;	
+END;
+' language 'plpgsql';
+
+-- drop function fs_level_gen(integer,integer);
+create function fs_level_gen(integer,integer) returns integer as '
+declare
+	id              alias for $1;
+        cnt             alias for $2;
+	pid             integer;
+BEGIN
+        select into pid parent_id from fs_files where file_id = id;
+
+	IF pid is null
+	THEN 
+		return cnt;
+	ELSE
+		return fs_level_gen(pid,cnt+1);
+	END IF;	
+END;
+' language 'plpgsql';
+
+-- lets create an easy way to walk the tree so that we can join the connect by
+-- with the permissions tables
+--DRB: PG doesn't have connect by
+-- create view fs_files_tree
+-- as
+-- select
+--       file_id,	
+--       file_title,
+--       sort_key,
+--       depth,   
+--       folder_p,
+--       owner_id,
+--       deleted_p,
+--       group_id,
+--       public_p,
+--       parent_id,
+--       fs_level_gen(file_id,1) as the_level
+--  from fs_files
+-- order by fs_connect_by(file_id);
+
+-- connect by prior fs_files.file_id = parent_id
+-- start with parent_id is null;
+
+
+-- if you have Intermedia installed (Oracle 8i only + additional
+-- sysadmin/dbadmin nightmares)
+
+-- create index fs_versions_content_idx 
+-- on fs_versions (version_content)
+-- indextype is ctxsys.context;
+
+-- Seed the general_permission_types table with data for
+-- administering permissions on this module (markc@arsdigita.com)
+--
+insert into general_permission_types (
+    table_name,
+    permission_type
+) values (
+    'FS_VERSIONS',
+    'read'
+);
+
+insert into general_permission_types (
+    table_name,
+    permission_type
+) values (
+    'FS_VERSIONS',
+    'write'
+);
+
+insert into general_permission_types (
+    table_name,
+    permission_type
+) values (
+    'FS_VERSIONS',
+    'comment'
+);
+
+insert into general_permission_types (
+    table_name,
+    permission_type
+) values (
+    'FS_VERSIONS',
+    'owner'
+);
Index: web/openacs/www/doc/sql/general-comments.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/general-comments.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/general-comments.sql	17 Apr 2001 14:05:12 -0000	1.1
@@ -0,0 +1,195 @@
+-- 
+-- A general comment facility 
+--
+-- created by philg@mit.edu on 11/20/98
+-- (and substantially upgraded by philg 9/5/99)
+-- (and upgrade to use table_acs_properties by philg on 10/31/99)
+
+-- this is used for when people want to comment on a news article
+-- or calendar posting or other tables that are yet to be 
+-- built; we don't mix in the page comments or the discussion
+-- forums here, though perhaps we should...
+
+create sequence general_comment_id_sequence;
+
+create table general_comments (
+	comment_id		integer primary key,
+	on_what_id		integer not null,
+	on_which_table		varchar(50),
+	-- a description of what we're commenting on 
+	one_line_item_desc	varchar(200) not null,
+	user_id			integer not null references users,
+        scope			varchar(20) default 'public' not null,
+	constraint general_comments_scope_check check (scope in ('public', 'group')),
+	-- group_id of the group for which this general comment was submitted
+	group_id		integer references user_groups,
+	comment_date		datetime not null,
+	ip_address		varchar(50) not null,
+	modified_date		datetime,
+	one_line		varchar(200),
+	content			text,
+	-- is the content in HTML or plain text (the default)
+	html_p			char(1) default 'f' check(html_p in ('t','f')),
+	approved_p		char(1) default 't' check(approved_p in ('t','f')),
+        lob			integer references lobs,
+	-- file name including extension but not path
+	client_file_name	varchar(500),
+	file_type		varchar(100),	-- this is a MIME type (e.g., image/jpeg)
+	file_extension		varchar(50), 	-- e.g., "jpg"
+	-- fields that only make sense if this is an image
+	caption			varchar(4000),
+	original_width		integer,
+	original_height		integer
+);
+
+create trigger gc_lob_trig before delete or update or insert
+on general_comments for each row execute procedure on_lob_ref();
+
+create function trig_general_comments_modified() returns opaque
+as '
+declare
+begin
+ NEW.modified_date := current_timestamp;
+ return NEW;
+end;
+' language 'plpgsql';
+
+create trigger general_comments_modified
+before insert or update on general_comments
+for each row execute procedure trig_general_comments_modified();
+
+-- an index useful when printing out content to the public 
+
+create index general_comments_cidx on general_comments(on_which_table, on_what_id);
+
+-- an index useful when printing out a user history
+
+create index general_comments_uidx on general_comments(user_id);
+
+
+-- store pre-modification content
+-- these are all pre-modification values
+
+-- no integrity constraints because we don't want to interfere with a
+-- comment being deleted
+
+create table general_comments_audit (
+	comment_id		integer,
+	-- who did the modification and from where
+	user_id			integer not null,
+	ip_address		varchar(50) not null,
+	audit_entry_time	datetime,
+	-- the old modified date that goes with this content
+	modified_date		datetime,
+	content			text,
+	one_line		varchar(200)
+);
+
+create function init_general_comments() returns boolean
+as '
+declare
+ n_news_rows		integer;
+ n_calendar_rows	integer;
+ n_classified_rows	integer;
+ n_neighbor_rows	integer;
+begin
+ select count(*) into n_news_rows from table_acs_properties where table_name = ''news'';
+ if n_news_rows = 0 then 
+   insert into table_acs_properties
+    (table_name, module_key, section_name, user_url_stub, admin_url_stub)
+    values
+    (''news_items'',''news'',''News'',''/news/item.tcl?news_item_id='',''/admin/news/item.tcl?news_item_id='');
+ end if;
+ select count(*) into n_calendar_rows from table_acs_properties where table_name = ''calendar'';
+ if n_calendar_rows = 0 then 
+   insert into table_acs_properties
+    (table_name, module_key, section_name, user_url_stub, admin_url_stub)
+    values
+    (''calendar'',''calendar'',''Calendar'',''/calendar/item.tcl?calendar_id='',''/admin/calendar/item.tcl?calendar_id='');
+ end if;
+ select count(*) into n_classified_rows from table_acs_properties where table_name = ''classified_ads'';
+ if n_classified_rows = 0 then 
+   insert into table_acs_properties
+    (table_name, section_name, user_url_stub, admin_url_stub)
+    values
+    (''classified_ads'',''Classifieds'',''/gc/view-one.tcl?classified_ad_id='',''/admin/gc/edit-ad.tcl?classified_ad_id='');
+ end if;
+ select count(*) into n_neighbor_rows from table_acs_properties where table_name = ''neighbor_to_neighbor'';
+ if n_neighbor_rows = 0 then 
+   insert into table_acs_properties
+    (table_name, section_name, user_url_stub, admin_url_stub)
+    values
+    (''neighbor_to_neighbor'',''Neighbor to Neighbor'',''/neighbor/view-one.tcl?neighbor_to_neighbor_id='',''/admin/neighbor/view-one.tcl?neighbor_to_neighbor_id='');
+ end if;
+ return ''t'';
+end;
+' language 'plpgsql';
+
+select init_general_comments();
+
+create function trig_news_gc_delete() returns opaque
+as '
+declare 
+BEGIN
+  DELETE FROM general_comments
+    WHERE on_which_table = ''news_items''
+    AND on_what_id = OLD.news_item_id;
+
+    return OLD;
+END;
+' language 'plpgsql';
+
+CREATE trigger news_gc_delete
+  after DELETE
+  ON news_items
+  FOR each row execute procedure trig_news_gc_delete();
+
+CREATE function trig_calendar_gc_delete() returns opaque
+as '
+DECLARE
+BEGIN
+  DELETE FROM general_comments
+    WHERE on_which_table = ''calendar''
+    AND on_what_id = OLD.calendar_id;
+END;
+' language 'plpgsql';
+
+CREATE trigger calendar_gc_delete
+  after DELETE
+  ON calendar
+  FOR each row execute procedure trig_calendar_gc_delete();
+
+CREATE function trig_classified_ads_gc_delete() returns opaque
+as '
+DECLARE
+BEGIN
+  DELETE FROM general_comments
+    WHERE on_which_table = ''classified_ads''
+    AND on_what_id = old.classified_ad_id;
+  RETURN old;
+END;
+' language 'plpgsql';
+
+CREATE trigger classified_ads_gc_delete
+  after DELETE
+  ON classified_ads
+  FOR each row execute procedure trig_classified_ads_gc_delete();
+
+create function trig_n_to_n_gc_delete() returns opaque
+as '
+DECLARE
+BEGIN
+  DELETE FROM general_comments
+    WHERE on_which_table = ''neighbor_to_neighbor''
+    AND on_what_id = OLD.neighbor_to_neighbor_id;
+END;
+' language 'plpgsql';
+
+CREATE trigger n_to_n_gc_delete
+  after DELETE
+  ON neighbor_to_neighbor
+  FOR each row execute procedure trig_n_to_n_gc_delete();
+
+
+
+
Index: web/openacs/www/doc/sql/general-links.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/general-links.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/general-links.sql	17 Apr 2001 14:05:12 -0000	1.1
@@ -0,0 +1,117 @@
+--
+-- /doc/sql/general-links.sql
+--
+-- by dh@arsdigita.com, <original creation date>
+--
+-- This is used in a similar way to general-comments to add links to a page.
+-- In addition, users can view a "Hot Link" page of categorized links.
+
+create sequence general_link_id_sequence start 1;
+
+create table general_links (
+	link_id                 integer primary key,
+	url                     varchar(300) not null,
+	link_title              varchar(100) not null,
+	link_description        varchar(4000),
+	-- meta tags defined by HTML at the URL
+	meta_description        varchar(4000),
+	meta_keywords           varchar(4000),
+	n_ratings               integer,
+        avg_rating              numeric,
+	-- when was this submitted?
+	creation_time	    	    datetime default current_timestamp not null,
+	creation_user		    integer not null references users(user_id),
+	creation_ip_address	    varchar(20) not null,
+	last_modified		    datetime,
+	last_modifying_user	    integer references users(user_id),
+	-- last time this got checked
+	last_checked_date       datetime,
+	last_live_date          datetime,
+        last_approval_change               datetime,
+	-- has the link been approved? ( note that this is different from
+	-- the approved_p in the table wite_wide_link_map ) 
+	approved_p              char(1) check(approved_p in ('t','f')),
+	approval_change_by     integer references users
+);
+
+-- Index on searchable fields
+
+create index general_links_title_idx on general_links (link_title);
+
+create sequence general_link_map_id start 1;
+
+-- This table associates urls with any item in the database
+
+create table site_wide_link_map (
+	map_id          integer primary key,
+	link_id                 integer not null references general_links,
+	-- the table is this url associated with 
+	on_which_table          varchar(30) not null,
+	-- the row in *on_which_table* the url is associated with
+	on_what_id              integer not null,
+	-- a description of what the url is associated with
+	one_line_item_desc      varchar(200) not null,
+	-- who made the association
+	creation_time	    	    datetime default current_timestamp not null,
+	creation_user		    integer not null references users(user_id),
+	creation_ip_address	    varchar(20) not null,
+	last_modified		    datetime,
+	last_modifying_user	    integer references users(user_id),
+	-- has the link association  been approved ?
+	approved_p              char(1) check(approved_p in ('t','f')),
+	approval_change_by     integer references users
+);
+
+create index swlm_which_table_what_id_idx on site_wide_link_map (on_which_table, on_what_id);
+
+-- We want users to be able to rate links
+-- These ratings could be used in the display of the links
+-- eg, ordering within category by rating, or displaying 
+-- fav. links for people in a given group..
+
+create table general_link_user_ratings (
+	user_id         integer not null references users,
+ 	link_id         integer not null references general_links,
+	-- a user may give a url a rating between 0 and 10
+	rating          integer not null check(rating between 0 and 10 ),
+	-- require that the user/url rating is unique
+	primary key(link_id, user_id) 
+);
+
+
+insert into table_acs_properties (table_name, section_name, user_url_stub, admin_url_stub)
+values ('general_links', 'General Links', '/general-links/view-one.tcl?link_id=', '/admin/general-links/edit-link.tcl?link_id=');
+
+-- trigger for user ratings
+-- PGsql doesn't have statement level triggers, so we move this to a row-level trigger.
+-- That's fine because the reason this was a statement-level trigger to begin
+-- with is once again Oracle's limitation of triggers reading from the table that triggered them.
+-- (BMA)
+
+create function trig_general_links_rating_update() returns opaque
+as '
+DECLARE
+	v_n_ratings	integer;
+	v_avg_rating	numeric;
+BEGIN
+	select count(*), avg(rating) into v_n_ratings, v_avg_rating from general_link_user_ratings
+	where link_id= NEW.link_id;
+
+	update general_links
+	set n_ratings= v_n_ratings,
+	avg_rating= v_avg_rating
+	where link_id= NEW.link_id;
+
+	return NEW;
+END;
+' language 'plpgsql';
+
+create trigger general_links_rating_update
+after insert or update on general_link_user_ratings
+for each row
+execute procedure trig_general_links_rating_update();
+
+--
+-- Postgres stuff (BMA)
+--
+
Index: web/openacs/www/doc/sql/general-permissions.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/general-permissions.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/general-permissions.sql	17 Apr 2001 14:05:12 -0000	1.1
@@ -0,0 +1,576 @@
+-- 
+-- A general permissions facility 
+--
+-- created by richardl@arsdigita.com on 7/14/99
+-- rewritten by michael@arsdigita.com, yon@arsdigita.com & markc@arsdigita.com, 2000-02-25
+
+create sequence gp_id_sequence start 1;
+
+create table general_permissions (
+	permission_id		integer not null primary key,
+	on_what_id		integer not null,
+	on_which_table		varchar(30) not null,
+        scope           	varchar(20),
+	user_id			integer references users,
+	group_id		integer references user_groups,
+	role			varchar(200),
+	permission_type		varchar(20) not null,
+-- This check statment makes the tuple too big for PG 7 ( >8K )
+--	check ((scope = 'user' and user_id is not null
+--                and group_id is null and role is null) or
+--	       (scope = 'group_role' and user_id is null
+--                and group_id is not null and role is not null) or
+--	       (scope = 'group' and user_id is null
+--                and group_id is not null and role is null) or
+--	       (scope in ('registered_users', 'all_users')
+--                and user_id is null
+--                and group_id is null and role is null)),
+	unique (on_what_id, on_which_table,
+                scope, user_id, group_id, role, permission_type)
+);
+
+-- This trigger normalizes values in the on_which_table column to
+-- be all lowercase. This makes it easier to implement a case-
+-- insensitive API (since function-based indexes do not seem to
+-- work as advertised in Oracle 8.1.5). Just make sure to call
+-- LOWER whenever constructing a criterion involving
+-- on_which_table.
+--
+
+create function trig_gp_on_which_table_tr() returns opaque
+as '
+DECLARE
+BEGIN
+	NEW.on_which_table:= lower(NEW.on_which_table);
+	NEW.permission_type:= lower(NEW.permission_type);
+	return NEW;
+END;
+' language 'plpgsql';
+
+create trigger gp_on_which_table_tr
+before insert or update on general_permissions
+for each row
+execute procedure trig_gp_on_which_table_tr();
+
+-- This trigger normalizes values in the permission_type column to
+-- be all lowercase. This makes it easier to implement a case-
+-- insensitive API (since function-based indexes do not seem to
+-- work as advertised in Oracle 8.1.5). Just make sure to call
+-- LOWER whenever constructing a criterion involving
+-- permission_type.
+
+-- packaged this in last trigger
+
+-- This view makes it simple to fetch a standard set of
+-- permission flags (true or false) for arbitrary rows
+-- in the database.
+--
+create view general_permissions_grid
+as
+select
+ p.on_what_id, p.on_which_table,
+ p.scope, p.user_id, p.group_id, p.role,
+ case when sum(case when p.permission_type = 'read' then 1 else 0 end)= 0 then 'f'::char else 't'::char end
+  as read_permission_p,
+ case when sum(case when p.permission_type='comment' then 1 else 0 end)= 0 then 'f'::char else 't'::char end
+  as comment_permission_p,
+ case when sum(case when p.permission_type= 'write' then 1 else 0 end)= 0 then 'f'::char else 't'::char end
+  as write_permission_p,
+ case when sum(case when p.permission_type= 'administer' then 1 else 0 end)= 0 then 'f'::char else 't'::char end
+ as administer_permission_p
+from general_permissions p
+group by
+ p.on_what_id, p.on_which_table,
+ p.scope, p.user_id, p.group_id, p.role;
+
+-- no packages in PG (BMA)
+--create or replace package ad_general_permissions
+--as
+ -- Returns 't' if the specified user has the specified permission on
+ -- the specified database row.
+ --
+-- drop function gp_has_group_role(integer,varchar,integer);
+create function gp_has_group_role(integer,varchar,integer) 
+returns char as '
+declare
+        gid     alias for $1;
+        role    alias for $2;
+        uid     alias for $3;
+        exist   char;
+begin
+        select into exist (case when count(1) is null then ''f'' else
+                           case when count(1) = 0 then ''f'' else 
+                           ''t'' end end)
+          from user_group_map ugm
+         where ugm.user_id = uid
+           and ugm.group_id = gid
+           and ugm.role = role;
+           return exist;
+end;
+' language 'plpgsql';
+
+-- drop function gp_group_member(integer,integer);
+create function gp_group_member(integer,integer) returns char as '
+declare
+        gid     alias for $1;
+        uid     alias for $2;
+        exist   char;
+begin
+        select into exist (case when count(1) is null then ''f'' else
+                           case when count(1) = 0 then ''f'' else
+                           ''t'' end end)
+          from user_group_map ugm
+         where ugm.user_id = uid
+           and ugm.group_id = gid;
+
+        return exist;
+end;
+' language 'plpgsql';
+
+
+-- drop function user_has_row_permission_p (integer, varchar, integer, varchar);
+create function user_has_row_permission_p (integer, varchar, integer, varchar)
+returns char as '
+DECLARE
+ v_user_id                     alias for $1;
+ v_permission_type             alias for $2;
+ v_on_what_id                  alias for $3;
+ v_on_which_table              alias for $4;
+ v_user_has_row_permission_p   integer;
+BEGIN
+ -- Return true if the permission has been granted to at least one of:
+ --
+ -- * all users
+ -- * registered users if the user is logged in
+ -- * the user directly
+ -- * a role in a user group that the user plays
+ -- * an entire user group of which the user is a member
+ --
+ select into v_user_has_row_permission_p count(*)
+  from general_permissions gp
+ where gp.on_what_id = v_on_what_id
+   and gp.on_which_table = lower(v_on_which_table)
+   and gp.permission_type = lower(v_permission_type)
+   and ((gp.scope = ''all_users'')
+        or (gp.scope = ''user'' and gp.user_id = v_user_id)
+        or (gp.scope = ''registered_users'' and v_user_id > 0)
+        or ad_group_member_p(v_user_id,system_administrator_group_id()) = ''t''
+        or (gp.scope = ''group''
+            and gp_group_member(gp.group_id,v_user_id) = ''t'')
+        or (gp.scope = ''group_role''
+            and gp_has_group_role(gp.group_id,gp.role,v_user_id) = ''t''));
+
+ return (case when v_user_has_row_permission_p is null then ''f'' else 
+         case when v_user_has_row_permission_p = 0 then ''f'' else ''t'' 
+         end end);
+END;
+' language 'plpgsql';
+
+
+ create function grant_permission_to_user ( integer, varchar, integer, varchar )
+ returns integer as '
+ DECLARE
+  v_user_id		alias for $1;
+  v_permission_type	alias for $2;
+  v_on_what_id		alias for $3;
+  v_on_which_table	alias for $4;
+  v_permission_id	general_permissions.permission_id%TYPE;
+ BEGIN
+  select nextval(''gp_id_sequence'') into v_permission_id;
+
+  insert into general_permissions
+   (permission_id, on_what_id, on_which_table,
+    scope, user_id, permission_type)
+  values
+   (v_permission_id, v_on_what_id, v_on_which_table,
+    ''user'', v_user_id, v_permission_type);
+
+  return v_permission_id;
+ END;
+ ' language 'plpgsql';
+
+-- drop function grant_permission_to_role ( integer, varchar, varchar, integer, varchar );
+ create function grant_permission_to_role ( integer, varchar, varchar, integer, varchar )
+ returns integer as '
+ DECLARE
+  v_group_id		alias for $1;
+  v_role		alias for $2;
+  v_permission_type	alias for $3;
+  v_on_what_id		alias for $4;
+  v_on_which_table	alias for $5;
+  v_permission_id	integer;
+ BEGIN
+  select  into v_permission_id nextval(''gp_id_sequence'');
+
+  insert into general_permissions
+   (permission_id, on_what_id, on_which_table,
+    scope, group_id, role, permission_type)
+  values
+   (v_permission_id, v_on_what_id, v_on_which_table,
+    ''group_role'', v_group_id, v_role, v_permission_type);
+
+  return v_permission_id;
+ END;
+ ' language 'plpgsql';
+
+ create function grant_permission_to_group ( integer, varchar, integer, varchar )
+ returns integer as '
+ DECLARE
+  v_group_id		alias for $1;
+  v_permission_type	alias for $2;
+  v_on_what_id		alias for $3;
+  v_on_which_table	alias for $4;
+  v_permission_id	general_permissions.permission_id%TYPE;
+ BEGIN
+  select nextval(''gp_id_sequence'') into v_permission_id;
+
+  insert into general_permissions
+   (permission_id, on_what_id, on_which_table,
+    scope, group_id, permission_type)
+  values
+   (v_permission_id, v_on_what_id, v_on_which_table,
+    ''group'', v_group_id, v_permission_type);
+
+  return v_permission_id;
+ END;
+ ' language 'plpgsql';
+
+ create function grant_permission_to_reg_users ( varchar, integer, varchar )
+ returns integer as '
+ DECLARE
+  v_permission_type	alias for $1;
+  v_on_what_id		alias for $2;
+  v_on_which_table	alias for $3;
+  v_permission_id	general_permissions.permission_id%TYPE;
+ BEGIN
+  select nextval(''gp_id_sequence'') into v_permission_id;
+
+  insert into general_permissions
+   (permission_id, on_what_id, on_which_table,
+    scope, permission_type)
+  values
+   (v_permission_id, v_on_what_id, v_on_which_table,
+    ''registered_users'', v_permission_type);
+
+  return v_permission_id;
+ END;
+ ' language 'plpgsql';
+
+-- drop function grant_permission_to_all_users ( varchar, integer, varchar );
+ create function grant_permission_to_all_users ( varchar, integer, varchar )
+ returns integer as '
+ DECLARE
+  v_permission_type	alias for $1;
+  v_on_what_id		alias for $2;
+  v_on_which_table	alias for $3;
+  v_permission_id	general_permissions.permission_id%TYPE;
+ BEGIN
+  select nextval(''gp_id_sequence'') into v_permission_id;
+
+  insert into general_permissions
+   (permission_id, on_what_id, on_which_table,
+    scope, permission_type)
+  values
+   (v_permission_id, v_on_what_id, v_on_which_table,
+    ''all_users'', v_permission_type);
+
+  return v_permission_id;
+ END;
+ ' language 'plpgsql';
+
+-- drop function revoke_permission ( integer );
+ create function revoke_permission ( integer )
+ returns integer as '
+ DECLARE
+  v_permission_id	alias for $1;
+ BEGIN
+  delete from general_permissions
+  where permission_id = v_permission_id;
+  return 0::integer;
+ END;
+ ' language 'plpgsql';
+
+ create function user_permission_id ( integer, varchar, integer, varchar )
+ returns integer as '
+ DECLARE
+  v_user_id		alias for $1;
+  v_permission_type	alias for $2;
+  v_on_what_id		alias for $3;
+  v_on_which_table	alias for $4;
+  v_permission_id	general_permissions.permission_id%TYPE;
+ BEGIN
+  select permission_id
+  into v_permission_id
+  from general_permissions
+  where on_what_id = v_on_what_id
+  and on_which_table = lower(v_on_which_table)
+  and scope = ''user''
+  and user_id = v_user_id
+  and permission_type = lower(v_permission_type);
+
+  if not found then
+   return 0;
+  else
+   return v_permission_id;
+  end if;
+ END;
+ ' language 'plpgsql';
+
+ create function group_role_permission_id ( integer, varchar, varchar, integer, varchar )
+ returns integer as '
+ DECLARE
+  v_group_id		alias for $1;
+  v_role		alias for $2;
+  v_permission_type	alias for $3;
+  v_on_what_id		alias for $4;
+  v_on_which_table	alias for $5;
+  v_permission_id	general_permissions.permission_id%TYPE;
+ BEGIN
+  select permission_id
+  into v_permission_id
+  from general_permissions
+  where on_what_id = v_on_what_id
+  and on_which_table = lower(v_on_which_table)
+  and scope = ''group_role''
+  and group_id = v_group_id
+  and role = v_role
+  and permission_type = lower(v_permission_type);
+
+  if not found then
+   return 0;
+  else
+   return v_permission_id;
+  end if;
+ END;
+ ' language 'plpgsql';
+
+ create function group_permission_id ( integer, varchar, integer, varchar )
+ returns integer as '
+ DECLARE
+  v_group_id		alias for $1;
+  v_permission_type	alias for $2;
+  v_on_what_id		alias for $3;
+  v_on_which_table	alias for $4;
+  v_permission_id	general_permissions.permission_id%TYPE;
+ BEGIN
+  select permission_id
+  into v_permission_id
+  from general_permissions
+  where on_what_id = v_on_what_id
+  and on_which_table = lower(v_on_which_table)
+  and scope = ''group''
+  and group_id = v_group_id
+  and permission_type = lower(v_permission_type);
+
+  if not found then
+   return 0;
+  else
+   return v_permission_id;
+  end if;
+ END;
+ ' language 'plpgsql';
+
+ create function reg_users_permission_id ( varchar, integer, varchar )
+ returns integer as '
+ DECLARE
+  v_permission_type	alias for $1;
+  v_on_what_id		alias for $2;
+  v_on_which_table	alias for $3;
+  v_permission_id	general_permissions.permission_id%TYPE;
+ BEGIN
+  select permission_id
+  into v_permission_id
+  from general_permissions
+  where on_what_id = v_on_what_id
+  and on_which_table = lower(v_on_which_table)
+  and scope = ''registered_users''
+  and permission_type = lower(v_permission_type);
+
+  if not found then
+   return 0;
+  else
+   return v_permission_id;
+  end if;
+ END;
+ ' language 'plpgsql';
+
+ create function all_users_permission_id ( varchar, integer, varchar )
+ returns integer as '
+ DECLARE
+  v_permission_type	alias for $1;
+  v_on_what_id		alias for $2;
+  v_on_which_table	alias for $3;
+  v_permission_id	general_permissions.permission_id%TYPE;
+ BEGIN
+  select permission_id
+  into v_permission_id
+  from general_permissions
+  where on_what_id = v_on_what_id
+  and on_which_table = lower(v_on_which_table)
+  and scope = ''all_users''
+  and permission_type = lower(v_permission_type);
+
+  if not found then
+   return 0;
+  else
+   return v_permission_id;
+  end if;
+ END;
+ ' language 'plpgsql';
+
+-- This table defines the valid types of permission for each
+-- table. Right now, it's only used by the admin pages. We
+-- need to figure out if we should use it more broadly.
+--
+create table general_permission_types (
+	table_name	varchar(30) not null,
+	permission_type	varchar(20) not null,
+	primary key (table_name, permission_type)
+);
+
+
+create view users_view as 
+select 
+user_id       
+,first_names  
+,last_name  
+,screen_name  
+,priv_name       
+,email  
+,priv_email       
+,email_bouncing_p       
+,converted_p       
+,password   
+,url  
+,to_char(on_vacation_until,'YYYY-MM-DD') as on_vacation_until     
+,to_char(last_visit,'YYYY-MM-DD') as last_visit     
+,to_char(second_to_last_visit,'YYYY-MM-DD') as second_to_last_visit     
+,n_sessions       
+,to_char(registration_date,'YYYY-MM-DD') as registration_date      
+,registration_ip    
+,user_state   
+,to_char(approved_date,'YYYY-MM-DD') as approved_date      
+,approving_user        
+,approving_note  
+,to_char(email_verified_date,'YYYY-MM-DD') as email_verified_date      
+,to_char(rejected_date,'YYYY-MM-DD') as rejected_date      
+,rejecting_user        
+,rejecting_note  
+,to_char(deleted_date,'YYYY-MM-DD') as deleted_date      
+,deleting_user        
+,deleting_note  
+,to_char(banned_date,'YYYY-MM-DD') as banned_date      
+,banning_user        
+,banning_note  
+,crm_state    
+,to_char(crm_state_entered_date,'YYYY-MM-DD') as crm_state_entered_date      
+,lob        
+,to_char(portrait_upload_date,'YYYY-MM-DD') as portrait_upload_date      
+,portrait_comment  
+,portrait_client_file_name   
+,portrait_file_type   
+,portrait_file_extension    
+,portrait_original_width        
+,portrait_original_height        
+,portrait_thumbnail_width        
+,portrait_thumbnail_height        
+,bio from users;  
+
+
+create view users_null as 
+select 
+''::integer as user_id       
+,''::varchar as first_names  
+,''::varchar as last_name  
+,''::varchar as screen_name  
+,''::integer as priv_name       
+,''::varchar as email  
+,''::integer as priv_email       
+,''::char as email_bouncing_p       
+,''::char as converted_p       
+,''::varchar as password   
+,''::varchar as url  
+,''::varchar as on_vacation_until     
+,''::varchar as last_visit     
+,''::varchar as second_to_last_visit     
+,''::integer as n_sessions       
+,''::varchar as registration_date      
+,''::varchar as registration_ip    
+,''::varchar as user_state   
+,''::varchar as approved_date      
+,''::integer as approving_user        
+,''::varchar as approving_note  
+,''::varchar as email_verified_date      
+,''::varchar as rejected_date      
+,''::integer as rejecting_user        
+,''::varchar as rejecting_note  
+,''::varchar as deleted_date      
+,''::integer as deleting_user        
+,''::varchar as deleting_note  
+,''::varchar as banned_date      
+,''::integer as banning_user        
+,''::varchar as banning_note  
+,''::varchar as crm_state    
+,''::varchar as crm_state_entered_date      
+,''::integer as lob        
+,''::varchar as portrait_upload_date      
+,''::varchar as portrait_comment  
+,''::varchar as portrait_client_file_name   
+,''::varchar as portrait_file_type   
+,''::varchar as portrait_file_extension    
+,''::integer as portrait_original_width        
+,''::integer as portrait_original_height        
+,''::integer as portrait_thumbnail_width        
+,''::integer as portrait_thumbnail_height        
+,''::varchar as bio;  
+
+create view user_groups_view as 
+select 
+group_id      
+,group_type  
+,group_name 
+,short_name 
+,admin_email 
+,to_char(registration_date,'YYYY-MM-DD') as registration_date    
+,creation_user      
+,creation_ip_address  
+,approved_p      
+,active_p      
+,existence_public_p      
+,new_member_policy  
+,spam_policy  
+,email_alert_p      
+,multi_role_p      
+,group_admin_permissions_p      
+,index_page_enabled_p      
+,body         
+,html_p      
+,to_char(modification_date,'YYYY-MM-DD') as modification_date     
+,modifying_user       
+,parent_group_id from user_groups;       
+
+
+create view user_groups_null as 
+select 
+''::integer as group_id      
+,''::varchar as group_type  
+,''::varchar as group_name 
+,''::varchar as short_name 
+,''::varchar as admin_email 
+,''::varchar as registration_date    
+,''::integer as creation_user      
+,''::varchar as creation_ip_address  
+,''::char as approved_p      
+,''::char as active_p      
+,''::char as existence_public_p      
+,''::varchar as new_member_policy  
+,''::varchar as spam_policy  
+,''::char as email_alert_p      
+,''::char as multi_role_p      
+,''::char as group_admin_permissions_p      
+,''::char as index_page_enabled_p      
+,''::text as body         
+,''::char as html_p      
+,''::varchar as modification_date     
+,''::integer as modifying_user       
+,''::integer as parent_group_id;       
Index: web/openacs/www/doc/sql/glassroom-nuke.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/glassroom-nuke.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/glassroom-nuke.sql	17 Apr 2001 14:05:12 -0000	1.1
@@ -0,0 +1,20 @@
+--
+-- glassroom-nuke.sql -- remove all of the db objects for glassroom
+
+drop sequence glassroom_host_id_sequence;
+drop sequence glassroom_cert_id_sequence;
+drop sequence glassroom_module_id_sequence;
+drop sequence glassroom_logbook_entry_id_seq;
+drop sequence glassroom_release_id_sequence;
+drop table glassroom_info;
+drop table glassroom_hosts;
+drop table glassroom_certificates;
+drop table glassroom_releases;
+drop table glassroom_modules;
+drop table glassroom_logbook;
+drop table glassroom_procedures;
+drop table glassroom_domains;
+drop table glassroom_info;
+drop table glassroom_services;
+delete from general_comments where on_which_table='glassroom_logbook';
+commit;
Index: web/openacs/www/doc/sql/glassroom.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/glassroom.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/glassroom.sql	17 Apr 2001 14:05:12 -0000	1.1
@@ -0,0 +1,114 @@
+--
+-- glassroom.sql 
+--
+-- Created January 4, 1999 by Philip Greenspun (philg@mit.edu)
+--
+-- Supports the ArsDigita Glass Room collaboration system for 
+-- people involved in keeping a Web service up and running
+-- (probably also useful for other IT-type activities)
+--
+
+create sequence glassroom_host_id_sequence;
+
+create table glassroom_hosts (
+	host_id		integer primary key,
+	-- fully qualified hostname; the main name of the host
+	hostname	varchar(100),
+	-- e.g., 18.23.0.16 (or some reasonable human-readable IPv6 format)
+	ip_address	varchar(50),	
+	-- e.g., 'HP-UX 11.0'
+	os_version	varchar(50),
+	description	varchar(4000),
+	model_and_serial	varchar(4000),
+	street_address		varchar(4000),
+	-- how to get to the console port
+	remote_console_instructions	varchar(4000),
+	service_phone_number	varchar(100),
+	service_contract	varchar(4000),
+	-- e.g., the above.net NOC
+	facility_phone		varchar(100),
+	facility_contact	varchar(4000),
+	backup_strategy		varchar(4000),
+	rdbms_backup_strategy	varchar(4000),
+	further_docs_url	varchar(200)
+);
+
+create sequence glassroom_cert_id_sequence;
+
+create table glassroom_certificates (
+	cert_id		integer primary key,
+	hostname	varchar(100),
+	-- typically this will be "Versign"
+	issuer		varchar(100),
+	-- a cert usually contains an encoded email request
+	encoded_email	varchar(2000),
+	-- when does this expire (this is important!)
+	expires		datetime
+);
+
+create sequence glassroom_module_id_sequence;
+create sequence glassroom_release_id_sequence;
+
+-- we keep track of the significant software modules that make up
+-- this service, including some of the people who own it.  However,
+-- we also expect that there will be a user_group of people associated
+-- with many modules
+
+create table glassroom_modules (
+	module_id	integer primary key,
+	module_name	varchar(100),
+	-- URL, vendor phone number, whatever is necessary to get a new copy
+	source		varchar(4000),	
+	-- what we're running in production
+	current_version		varchar(50),
+	who_installed_it	integer references users(user_id),
+	who_owns_it		integer references users(user_id)
+);
+
+create table glassroom_releases (
+	release_id	integer primary key,
+	module_id	integer not null references glassroom_modules,
+	release_date			datetime,
+	anticipated_release_date	datetime,
+	release_name	varchar(50),	-- e.g., '3.2'
+	manager		integer references users(user_id)
+);
+
+create table glassroom_procedures (
+	procedure_name		varchar(50) primary key,
+	procedure_description	varchar(4000),
+	responsible_user	integer references users(user_id),
+	responsible_user_group	integer references user_groups(group_id),
+	max_time_interval	float4,
+	importance		integer check(importance >= 1 and importance <= 10)
+);
+
+create sequence glassroom_logbook_entry_id_seq;
+
+create table glassroom_logbook (
+	entry_id	integer primary key,
+	entry_time	datetime not null,
+	entry_author	integer not null references users(user_id),
+	procedure_name	varchar(100) not null, 
+	notes		varchar(4000)
+);
+
+create table glassroom_domains (
+	domain_name	varchar(50),	-- e.g., 'photo.net'
+	last_paid	datetime,
+	by_whom_paid	varchar(100),
+	expires		datetime
+);
+
+-- this is kind of lame in that this table will probably
+-- only have one row
+
+create table glassroom_services (
+	service_name		varchar(50) primary key,
+	web_service_host	integer references glassroom_hosts,
+	rdbms_host		integer references glassroom_hosts,
+	dns_primary_host	integer references glassroom_hosts,
+	dns_secondary_host	integer references glassroom_hosts,
+	disaster_host		integer references glassroom_hosts
+);
+
Index: web/openacs/www/doc/sql/glossary.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/glossary.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/glossary.sql	17 Apr 2001 14:05:12 -0000	1.1
@@ -0,0 +1,59 @@
+--
+-- glossary.sql
+--
+-- defined by philg@mit.edu on March 6, 1999
+--
+-- a system that lets a group of people collaboratively maintain
+-- a glossary
+--
+
+-- we limit the definition to 4000 chars because we don't want to deal with CLOBs
+
+create table glossary (
+	term		varchar(200) primary key,
+	definition	varchar(4000) not null,
+	author			integer not null references users,
+	approved_p		char(1) default 'f' check(approved_p in ('t','f')),
+	creation_date		datetime not null,
+	modification_date	datetime not null
+);
+
+create function trig_glossary_modified() returns opaque
+AS '
+declare
+begin
+  NEW.modification_date := current_timestamp;
+  return NEW;
+end;
+' language 'plpgsql';
+
+
+create trigger glossary_modified
+before insert or update on glossary
+for each row
+execute procedure trig_glossary_modified();
+
+-- the same thing as GLOSSARY but without a primary key constraint on TERM
+
+create table glossary_audit (
+	term		varchar(200),
+	definition	varchar(4000),
+	author			integer,
+	modification_date	datetime
+);
+
+create function trig_glossary_audit_sql() returns opaque as '
+declare
+begin
+  insert into glossary_audit (term, definition, author, modification_date)
+  values
+  (OLD.term, OLD.definition, OLD.author, OLD.modification_date);
+  return NEW;
+end;
+' language 'plpgsql';
+
+create trigger glossary_audit_sql
+before update on glossary
+for each row
+execute procedure trig_glossary_audit_sql();
+
Index: web/openacs/www/doc/sql/homepage.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/homepage.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/homepage.sql	17 Apr 2001 14:05:12 -0000	1.1
@@ -0,0 +1,1180 @@
+--
+-- homepage.sql
+-- 
+-- created by mobin@mit.edu at Mon Jan 10 21:52:32 EST 2000 42��21'N 71��04'W
+-- Usman Y. Mobin
+--
+-- supports the Homepage system for giving users the ability to publish 
+-- personal web content within a larger community.
+-- the public content actually appears in /users/ 
+-- should some of the maintenance pages appear at /homepage/ ?
+-- the site-wide admin pages are at /admin/homepage/
+-- no group admin pages
+
+-- be explicit about 
+--   1) does more than one user ever get to maintain a  particular set  of 
+--	content? e.g., can they collaborate with another user? Not really. 
+--	One user takes responsibility for all of this and maintains it him 
+--	or herself. However, a user can authorize one or more other  users 
+--	to be helpers. These  people can  be "HTML  programmers" that  are 
+--	friends of the user but their email address will  never appear  as 
+--	signatory. This is different from group-maintained content where a 
+--	group of users is authorized to maintain but the  group signs  and 
+--	takes collective responsiblity.
+--
+--   2) what if a site gets really large and the primary purpose is giving 
+--	members personal homepages (e.g., if an adopter of ACS decides  to 
+--	become "The GeoCities of Brazil")? How do we support this?  First, 
+--	users could decide to  join user  groups. Then  the /users/  index 
+--	page  would  show  a  summary of  user groups  whose members  have 
+--	personal  pages.  This requires  no new  data in  Oracle. This  is 
+--	enabled with SubdivisionByGroupP=1 in  the .ini  file. Users  with 
+--	homepages and no group affiliation show up in "unaffiliated"  (fun 
+--	with  OUTER  JOIN). When  SubdivisionByNeighborhoodP=1, we  either 
+--	keep a denormalized  neighborhood_sortkey in  the homepages  table 
+--	and flag the "homepages" that are actually neighborhood folders or 
+--	have some separate tables holding categorization.
+--    
+
+create sequence users_neighborhood_id_seq_t start 2;
+create view users_neighborhood_id_seq as
+select nextval('users_neighborhood_id_seq_t') as nextval;
+
+
+create table users_neighborhoods (
+	neighborhood_id		integer primary key,
+	neighborhood_name	varchar(500) not null,
+	description		varchar(4000),
+	parent_id		integer references users_neighborhoods  on delete cascade
+);
+
+
+-- the system is smart enough to adjust if the root neighborhood
+-- has a different neighborhood_id.
+insert into users_neighborhoods
+(neighborhood_id, 
+ neighborhood_name, 
+ description, 
+ parent_id)
+values
+(1, 
+ 'Neighborhoods', 
+ 'Neighborhood RootNode', 
+ null);
+
+
+create table users_homepages (
+	user_id				integer,
+	-- the background colour settings for user's public pages
+	bgcolor	 			varchar(40),
+	-- the text colour settings for user's public pages
+	textcolor			varchar(40),
+	-- the colour settings for unvisitied links in user's public pages
+	unvisited_link	  		varchar(40),
+	-- the colour settings for visitied links in user's public pages
+	visited_link	  		varchar(40),
+	-- the settings to determine whether the links are underlined or
+	-- not in user's public pages
+	link_text_decoration  		varchar(40),
+	-- the settings to determine whether the links are bold or
+	-- not in user's public pages. I have added this because I have
+	-- strong preference for bold links when they are not underlined.
+	link_font_weight		varchar(40),
+	-- font for user's public generated pages
+	font_type		  	varchar(40),
+	-- the background colour settings for user's maintenance pages
+	maint_bgcolor	 		varchar(40),
+	maint_textcolor			varchar(40),
+	maint_unvisited_link		varchar(40),
+	maint_visited_link	  	varchar(40),
+	maint_link_text_decoration  	varchar(40),
+	maint_link_font_weight		varchar(40),
+	maint_font_type			varchar(40),
+	neighborhood_id		        integer
+	-- feature_level		varchar(30),
+	-- constraint hp_feature_lvl_ck check(feature_level 'platinum', 'gold', 'silver')
+	-- keywords			varchar(4000)
+);
+
+
+-- users have their quotas specified by [ad_parameter PrivelegedUserMaxQuota 
+-- users] or [ad_parameter  NormalUserMaxQuota users]  depending on  whether 
+-- they are site wide administrators or not. However, some users might  have 
+-- special quotas which can be granted  by site  wide administrators.  These 
+-- quotas are recorded in the users_special_quotas table. If a  user has  an 
+-- entry in this table then the above mentioned parameter values are ignored 
+-- and instead max_quota is used as his/her quota space.
+
+create table users_special_quotas (
+	user_id			integer primary key references users,
+	max_quota		float8 not null,
+	modification_date	datetime default sysdate() not null
+);
+
+
+create sequence users_type_id_seq_t start 2;
+create view users_type_id_seq as
+select nextval('users_type_id_seq_t') as nextval;
+
+
+create table users_content_types (
+	type_id			integer primary key,
+	type_name		varchar(200) not null,
+	sub_type_name		varchar(200) not null,
+	owner_id		integer references users,
+	sub_type		integer references users_content_types,
+	super_type		integer references users_content_types
+);
+
+
+-- We use this sequence to assign values to file_id. The 
+-- reason for starting from 2 is that no file is special 
+-- enough to have file_id=1, or is there a file that is?
+
+create sequence users_file_id_seq_t start 2;
+create view users_file_id_seq as
+select nextval('users_file_id_seq_t') as nextval;
+
+
+create table users_files (
+	file_id			integer primary key,
+	-- the maximum filesize in unix is 255 characters (starting from 1)
+	filename		varchar(255) not null,
+	directory_p		char(1) default 'f', 
+	constraint users_dir_ck check(directory_p in ('t','f')),
+	file_pretty_name	varchar(500) not null,
+	-- this is the number of bytes the files takes up on the file 
+	-- system. We will use these values to determine quota  usage 
+	-- except where directory_p is true. In that case, we'll  use 
+	-- [ad_parameter DirectorySpaceRequirement users] to see  the 
+	-- amount of quota space consumed by a directory. Thus, if we 
+	-- magically manage to change the file system,  we dont  have 
+	-- to update  file_size for  directories here  because it  is 
+	-- irrelevent.
+	managed_p		char(1) default 'f' check(managed_p in ('t','f')),
+	-- this column is used for files created by the content
+	-- publishing system which the user cannot rename or move
+	modifyable_p		char(1) default 't' check(modifyable_p in ('t','f')),
+	file_size		float8 not null,
+	content_type		integer references users_content_types,
+	-- points to the user_id of the user who owns this file.
+	owner_id		integer not null references users,
+	-- points to the file_id of the directory which contains 
+	-- this file. Useful for supporting hierarchical content 
+	-- structure.
+	parent_id		integer references users_files
+);
+
+create index users_files_idx1 on users_files(file_id, parent_id);
+
+create index users_files_idx2 on users_files(parent_id, file_id);
+
+create index users_files_idx3 on users_files(owner_id);
+
+create sequence users_access_id_sequence_t start 2;
+create view users_access_id_sequence as
+select nextval('users_access_id_sequence_t') as nextval;
+
+
+create table users_files_access_log (
+	access_id		integer primary key,
+	file_id			integer references users_files on delete set null,
+	relative_filename	varchar(500) not null,
+	owner_id		integer references users on delete set null,
+	access_date		datetime not null,
+	ip_address		varchar(50) not null
+);
+
+
+
+
+------------------------------------------------
+-- BEGINNINGOF fileSystemManagement codeBlock --
+------------------------------------------------
+
+
+-- returned value is a filename that does not begin with a slash
+create function hp_true_filename(integer) returns varchar as '
+declare
+	filesystem_node alias for $1;
+	fullname	varchar;
+	parentid	integer;
+BEGIN
+        select into parentid parent_id from users_files
+		where file_id = filesystem_node;
+        select into fullname filename from users_files
+		where file_id = filesystem_node;
+	IF parentid is null or parentid = ''''
+	THEN 
+		return fullname;
+	ELSE
+		return hp_true_filename(parentid) || ''/'' || fullname;
+	END IF;	
+END;
+' language 'plpgsql';
+
+-- drop function hp_true_dirname(integer);
+
+create function hp_true_dirname(integer) returns varchar as '
+declare
+	filesystem_node alias for $1;
+	fullname	varchar;
+	parentid	integer;
+        dirp            char(1);
+BEGIN
+        select into parentid parent_id from users_files
+		where file_id = filesystem_node;
+        select into fullname filename from users_files
+		where file_id = filesystem_node;
+        select into dirp directory_p from users_files
+		where file_id = filesystem_node;
+
+        IF dirp = ''f'' then 
+          fullname := '''';
+        END IF;
+	IF parentid is null or parentid = ''''
+	THEN 
+		return fullname;
+	ELSE
+		return hp_true_dirname(parentid) || ''/'' || fullname;
+	END IF;	
+END;
+' language 'plpgsql';
+
+
+
+-- returned value is a varchar2 which is the sort key
+-- Uses the fact that the full filename of each file has
+-- to be unique.
+-- drop function hp_filesystem_node_sortkey_gen(integer,integer);
+create function hp_filesystem_node_sortkey_gen(integer,integer) 
+returns varchar as '
+declare
+	filesystem_node alias for $1;
+        start           alias for $2;
+	fullname	varchar;
+	parentid	integer;
+	dir_p		varchar(1);
+	plsql_val	record;
+	discriminator	varchar(5);  -- useful for discriminating between files and directories
+BEGIN
+        select into plsql_val 
+               filename, 
+               (case when directory_p = ''t'' then ''0'' else ''1'' end) as dp,
+               parent_id 
+        from users_files
+	where file_id = filesystem_node;
+	dir_p    := plsql_val.dp;
+	fullname := plsql_val.filename;
+	parentid := plsql_val.parent_id;
+
+	IF parentid = start or parentid is null or parentid = ''''
+	THEN 
+		return dir_p || fullname;
+	ELSE
+		return hp_filesystem_node_sortkey_gen(parentid,start) || ''/'' || dir_p || fullname;
+	END IF;	
+END;
+' language 'plpgsql';
+
+
+-- select *,hp_filesystem_node_sortkey_gen(file_id) as generated_sort_key,filename
+-- from users_files order by generated_sort_key asc;
+
+
+-- drop function hp_filesystem_node_level_gen(integer,integer,integer);
+create function hp_filesystem_node_level_gen(integer,integer,integer) 
+returns integer as '
+declare
+	filesystem_node alias for $1;
+        count           alias for $2;
+        start           alias for $3;
+	parentid	integer;
+BEGIN
+        select into parentid parent_id
+                from users_files
+		where file_id = filesystem_node;
+
+	IF parentid = start or parentid is null or parentid = ''''
+	THEN 
+		return count;
+	ELSE
+		return hp_filesystem_node_level_gen(parentid,count+1,start);
+	END IF;	
+END;
+' language 'plpgsql';
+
+
+-- drop function hp_id_is_subnode(integer,integer);
+create function hp_id_is_subnode(integer,integer) 
+returns varchar as '
+declare
+        node            alias for $1;
+	filesystem_node alias for $2;
+	parentid	integer;
+BEGIN
+        select into parentid parent_id
+                from users_files
+		where file_id = node;
+
+	IF parentid is null THEN 
+		return ''f'';
+	ELSE IF parentid = filesystem_node THEN
+                return ''t'';
+        ELSE
+		return hp_id_is_subnode(parentid,filesystem_node);
+	END IF;	
+        END IF;
+END;
+' language 'plpgsql';
+
+
+
+-- select *,hp_filesystem_node_sortkey_gen(file_id) as generated_sort_key,hp_filesystem_node_level_gen(file_id,0) as level
+-- from users_files order by generated_sort_key asc;
+
+
+
+-- returns a filename beginning with a slash, unless the file is user's root
+-- drop function hp_user_relative_filename(integer);
+create function hp_user_relative_filename(integer) returns varchar as '
+declare
+	filesystem_node alias for $1;
+	fullname	varchar;
+	parentid	integer;
+BEGIN
+        select into fullname filename from users_files
+		where file_id = filesystem_node;
+        select into parentid parent_id from users_files
+		where file_id = filesystem_node;
+	IF parentid is null or parentid = ''''
+	THEN 
+		return '''';
+	ELSE
+		return hp_user_relative_filename(parentid) || ''/'' || fullname;
+	END IF;	
+END;
+' language 'plpgsql';
+
+-- drop function hp_get_filesystem_root_node(integer);
+create function hp_get_filesystem_root_node(integer) returns integer as '
+declare
+	u_id alias      for $1;
+	root_id		integer;
+BEGIN
+        select into root_id file_id from users_files
+	        where filename = u_id::varchar
+        	and parent_id is null or parent_id = ''''::int4
+	        and owner_id = u_id;
+	return root_id;
+END;
+' language 'plpgsql';
+
+select hp_get_filesystem_root_node(1);
+
+create function hp_get_filesystem_node_owner(integer) returns integer as '
+declare
+	fsid alias      for $1;
+	owner_id	integer;
+BEGIN
+        select into owner_id owner_id from users_files
+		where file_id = fsid;
+	return owner_id;
+END;
+' language 'plpgsql';
+
+
+create function hp_get_filesystem_child_count(integer) returns integer as '
+declare
+	fsid alias      for $1;
+	counter		integer;
+BEGIN
+        select into counter count(*) from users_files
+		where parent_id = fsid;
+	return counter;
+END;
+' language 'plpgsql';
+
+
+-- drop function hp_access_denied_p(integer,integer);
+
+create function hp_access_denied_p(integer,integer) returns integer as '
+declare
+	fsid            alias for $1;
+	u_id            alias for $2;
+	o_id            integer;
+BEGIN
+        select into o_id owner_id from users_files
+		where file_id = fsid;
+	IF o_id = u_id
+	THEN
+		return 0;
+	ELSE
+		return 1;
+	END IF;
+END;
+' language 'plpgsql';
+
+-- select hp_access_denied_p(2,1);
+
+-- drop function hp_fs_node_from_rel_name(integer,varchar);
+
+create function hp_fs_node_from_rel_name(integer,varchar) returns integer as '
+declare
+	rootid          alias for $1;
+	rel_name        alias for $2;
+        id              integer;
+        rname           varchar;
+	slash_location  integer;
+	nodeid          integer;
+BEGIN
+        rname := rel_name;
+        id    := rootid;
+        LOOP
+             IF rname = '''' THEN
+                return id;
+             END IF;
+             slash_location := position(''/'' in rname);
+             IF slash_location = 0 THEN 
+                select into nodeid file_id 
+                  from users_files 
+                 where parent_id = id 
+                   and filename = rname;
+                return nodeid;
+             ELSE IF  slash_location = 1 THEN
+                rname := substr(rname,2);
+             ELSE
+                select into nodeid file_id 
+                  from users_files 
+                 where parent_id = id 
+                   and filename = SUBSTR(rname,1,slash_location - 1);
+                id    := nodeid;
+                rname := substr(rname,slash_location);
+             END IF;
+             END IF;
+        END LOOP;
+END;
+' language 'plpgsql';
+
+
+------------------------------------------
+-- ENDOF fileSystemManagement codeBlock --
+------------------------------------------
+
+
+---------------------------------------------
+-- BEGINNINGOF contentManagement codeBlock --
+---------------------------------------------
+
+
+create function hp_top_level_content_title(integer) returns varchar as '
+declare
+	filesystem_node         alias for $1;
+	managedp		varchar(1);	
+	fullname		varchar;
+	parentid		integer;
+	parent_managedp 	varchar(1);
+BEGIN
+        select into fullname file_pretty_name from users_files
+		where file_id = filesystem_node;
+        select into parentid parent_id from users_files
+		where file_id = filesystem_node;
+        select into managedp managed_p from users_files
+		where file_id = filesystem_node;
+	IF parentid is null or parentid = ''''
+	THEN 
+		return fullname;
+	END IF;
+	IF managedp = ''t''
+	THEN
+		select into parent_managedp managed_p 
+		from users_files
+		where file_id = parentid;
+		
+		IF parent_managedp = ''f''
+		THEN
+			return fullname;
+		ELSE
+			return hp_top_level_content_title(parentid);
+		END IF;
+	ELSE
+		return fullname;
+	END IF;	
+END;
+' language 'plpgsql';
+
+
+create function hp_top_level_content_node(integer) returns varchar as '
+declare
+	filesystem_node alias for $1;
+	managedp		varchar(1);	
+	parentid		integer;
+	parent_managedp 	varchar(1);
+BEGIN
+        select into parentid parent_id from users_files
+		where file_id = filesystem_node;
+        select into managedp managed_p from users_files
+		where file_id = filesystem_node;
+	IF parentid is null or parentid = ''''
+	THEN 
+		return filesystem_node;
+	END IF;
+	IF managedp = ''t''
+	THEN
+		select managed_p into parent_managedp
+		from users_files
+		where file_id = parentid;
+		
+		IF parent_managedp = ''f''
+		THEN
+			return filesystem_node;
+		ELSE
+			return hp_top_level_content_node(parentid);
+		END IF;
+	ELSE
+		return filesystem_node;
+	END IF;	
+END;
+' language 'plpgsql';
+
+
+create function hp_onelevelup_content_title(integer) returns varchar as '
+declare
+	filesystem_node         alias for $1;
+	managedp		varchar(1);	
+	dirp			varchar(1);	
+	parentid		integer;
+	fullname		varchar;
+BEGIN
+        select into fullname file_pretty_name from users_files
+		where file_id = filesystem_node;
+        select into parentid parent_id from users_files
+		where file_id = filesystem_node;
+        select into managedp managed_p from users_files
+		where file_id = filesystem_node;
+        select into dirp directory_p from users_files
+		where file_id = filesystem_node;
+
+	IF parentid is null or parentid = ''''
+	THEN 
+		return fullname;
+	END IF;
+	IF managedp = ''t''
+	THEN
+		IF dirp = ''t''
+		THEN
+			return fullname;
+		ELSE
+			return hp_onelevelup_content_title(parentid);
+		END IF;
+	ELSE
+		return fullname;
+	END IF;	
+END;
+' language 'plpgsql';
+
+
+create function hp_onelevelup_content_node(integer) returns varchar as '
+declare
+	filesystem_node alias for $1;
+	managedp		varchar(1);	
+	dirp			varchar(1);	
+	parentid		integer;
+BEGIN
+	select into parentid parent_id from users_files
+		where file_id = filesystem_node;
+	select into managedp managed_p from users_files
+		where file_id = filesystem_node;
+	select into dirp directory_p from users_files
+		where file_id = filesystem_node;
+	IF parentid is null or parentid = ''''
+	THEN 
+		return filesystem_node;
+	END IF;
+	IF managedp = ''t''
+	THEN
+		IF dirp = ''t''
+		THEN
+			return filesystem_node;
+		ELSE
+			return hp_onelevelup_content_node(parentid);
+		END IF;
+	ELSE
+		return filesystem_node;
+	END IF;	
+END;
+' language 'plpgsql';
+
+
+---------------------------------------
+-- ENDOF contentManagement codeBlock --
+---------------------------------------
+
+
+---------------------------------------------------
+-- BEGINNINGOF neighbourhoodManagement codeBlock --
+---------------------------------------------------
+
+
+create function hp_true_neighborhood_name(integer) returns varchar as '
+declare
+	neighborhood_node alias for $1;
+	fullname	varchar;
+	parentid	integer;
+BEGIN
+	select into fullname neighborhood_name from users_neighborhoods
+		where neighborhood_id = neighborhood_node;
+	select into parentid parent_id from users_neighborhoods
+		where neighborhood_id = neighborhood_node;
+
+	IF parentid is null or parentid = ''''
+	THEN 
+		return fullname;
+	ELSE
+		return hp_true_neighborhood_name(parentid) || '' : '' || fullname;
+	END IF;	
+END;
+' language 'plpgsql';
+
+
+create function hp_get_neighborhood_root_node() returns integer as '
+declare
+	root_id		integer;
+BEGIN
+	select into root_id neighborhood_id 
+ 		from users_neighborhoods
+        	where parent_id is null or parent_id = '''';
+	return root_id;
+END;
+' language 'plpgsql';
+
+
+create function hp_relative_neighborhood_name(integer) returns varchar as '
+declare
+	neighborhood_node alias for $1;
+	fullname	varchar;
+	parentid	integer;
+	root_node	integer;
+BEGIN
+	select into fullname neighborhood_name from users_neighborhoods
+		where neighborhood_id = neighborhood_node;
+	select into parentid parent_id from users_neighborhoods
+		where neighborhood_id = neighborhood_node;
+	select hp_get_neighborhood_root_node() 
+	into root_node;
+
+	IF neighborhood_node = root_node
+	THEN
+		return '''';
+	END IF;
+
+	IF parentid is null or parentid = ''''
+	THEN
+		return '''';
+	END IF;
+
+	IF parentid = root_node
+	THEN 
+		return fullname;
+	ELSE
+		return hp_relative_neighborhood_name(parentid) || '' : '' || fullname;
+	END IF;	
+END;
+' language 'plpgsql';
+
+
+-- generates a sort key for this neighbourhood. Can be used in 'connect by'
+-- with 'order by'.
+-- drop function hp_neighborhood_sortkey_gen(integer,integer);
+create function hp_neighborhood_sortkey_gen(integer,integer) 
+returns varchar as '
+declare
+	neighborhood_node alias for $1;
+        start             alias for $2;
+	fullname          varchar;
+	parentid          integer;
+BEGIN
+	select into fullname neighborhood_name from users_neighborhoods
+		where neighborhood_id = neighborhood_node;
+	select into parentid parent_id from users_neighborhoods
+		where neighborhood_id = neighborhood_node;
+	IF parentid = start or parentid is null or parentid = ''''
+	THEN 
+		return ''/'';
+	ELSE
+		return hp_neighborhood_sortkey_gen(parentid,start) || ''/'' || fullname;
+	END IF;	
+END;
+' language 'plpgsql';
+
+-- drop function hp_neighborhood_level_gen(integer,integer,integer);
+create function hp_neighborhood_level_gen(integer,integer,integer) 
+returns integer as '
+declare
+	neighborhood_node alias for $1;
+        count             alias for $2;
+        start             alias for $3;
+	parentid          integer;
+BEGIN
+	select into parentid parent_id from users_neighborhoods
+		where neighborhood_id = neighborhood_node;
+	IF parentid = start or parentid is null or parentid = ''''
+	THEN 
+		return count;
+	ELSE
+		return hp_neighborhood_level_gen(parentid,count+1,start);
+	END IF;	
+END;
+' language 'plpgsql';
+
+-- drop function hp_neighborid_is_subnode(integer,integer);
+create function hp_neighborid_is_subnode(integer,integer) 
+returns varchar as '
+declare
+        node              alias for $1;
+	neighborhood_node alias for $2;
+	parentid          integer;
+BEGIN
+        select into parentid parent_id
+                from users_neighborhoods
+		where neighborhood_id = node;
+
+	IF parentid is null THEN 
+		return ''f'';
+	ELSE IF parentid = neighborhood_node THEN
+                return ''t'';
+        ELSE
+		return hp_neighborid_is_subnode(parentid,neighborhood_node);
+	END IF;	
+        END IF;
+END;
+' language 'plpgsql';
+
+
+
+create function hp_get_nh_child_count(integer) returns integer as '
+declare
+	neighborhoodid alias for $1;
+	counter		integer;
+BEGIN
+	select into counter count(*) from users_neighborhoods
+		where parent_id = neighborhoodid;
+	return counter;
+END;
+' language 'plpgsql';
+
+
+create function hp_neighborhood_in_subtree_p(integer,integer) returns varchar as '
+declare
+	source_node alias for $1;
+	target_node alias for $2;
+	parentid	integer;
+BEGIN
+	select into parentid parent_id from users_neighborhoods
+		where neighborhood_id = target_node;
+	IF source_node = target_node
+	THEN
+		return ''t'';
+	END IF;
+	
+	IF parentid is null or parentid = ''''
+	THEN 
+		return ''f'';
+	ELSE
+		IF parentid = source_node
+		THEN
+			return ''t'';
+		ELSE
+			return hp_neighborhood_in_subtree_p(source_node, parentid);
+		END IF;
+	END IF;	
+END;
+' language 'plpgsql';
+
+
+---------------------------------------------
+-- ENDOF neighbourhoodManagement codeBlock --
+---------------------------------------------
+-- drop function mobin_function_definition2(integer);
+create function mobin_function_definition2(integer) returns integer as '
+declare
+	max_id          alias for $1;
+	total           integer;
+        id_rec          record;
+BEGIN
+        total := 0;
+        FOR id_rec IN select * from users
+		where user_id < max_id
+        LOOP
+
+		EXIT WHEN not found;
+                total := total + id_rec.user_id;		
+	END LOOP;
+	return total;	
+END;
+' language 'plpgsql';
+
+select mobin_function_definition2(5);
+-----------------------------------
+-- BEGINNINGOF useless codeBlock --
+-----------------------------------
+
+
+-- This is a function that I have hath use for ofttimes.
+create function mobin_function_definition(varchar) returns varchar as '
+declare
+	function_name alias for $1;
+        fn_rec          record;
+	fn_total	varchar(4000);
+BEGIN
+        fn_total := '''';
+        FOR fn_rec IN select * from USER_SOURCE
+		where Name = upper(function_name)
+		and Type = ''FUNCTION''
+		order by Line 
+        LOOP
+
+		EXIT WHEN not found;
+		fn_total := fn_total || fn_rec.Text;
+	END LOOP;
+	return fn_total;
+	
+END;
+' language 'plpgsql';
+
+
+-- A view I find rather useful
+-- create view hp_functions as
+-- select lower(Name) as function_name, count(*) as line_count 
+-- from USER_SOURCE
+-- where Type = 'FUNCTION'
+-- and Name like 'HP_%'
+-- and Name != 'HP_FUNCTIONS'
+-- group by Name;
+
+
+-----------------------------
+-- ENDOF useless codeBlock --
+-----------------------------
+
+
+----------------------------------
+-- BEGINNINGOF useful codeBlock --
+----------------------------------
+
+
+-- this function is so useful that I can't tell you!
+
+-- create function mobin_number_to_letter(integer) returns varchar as '
+
+--        set letter_no $1
+--        set decode_tbl [list null A B C D E F G H I J K L M N O P Q R S T U V W X Y Z]
+--        if { $letter_no < 1 || $letter_no > 26 } { return Z }
+--        return [lindex $decode_tbl $letter_no]
+-- ' language 'pltcl';
+
+----------------------------
+-- ENDOF useful codeBlock --
+----------------------------
+
+
+-----------------------------------------------
+-- BEGINNINGOF userQuotaManagement codeBlock --
+-----------------------------------------------
+
+
+create function hp_user_quota_max(integer,integer,integer,integer) 
+returns integer as '
+declare
+	userid                  alias for $1;
+	lesser_mortal_quota     alias for $2;
+	higher_mortal_quota     alias for $3;
+	higher_mortal_p         alias for $4;
+	quota_max		integer;
+	special_count		integer;
+	return_value		integer;
+BEGIN
+	select count(*) into special_count
+	from users_special_quotas
+        where user_id = userid;
+
+	IF special_count = 0
+	THEN
+		IF higher_mortal_p = 0
+		THEN
+			select trunc(lesser_mortal_quota * pow(2.0,20.0)) 
+			into return_value;
+			return return_value;
+		ELSE
+			select trunc(higher_mortal_quota * pow(2.0,20.0)) 
+			into return_value;
+			return return_value;
+		END IF;
+	ELSE
+		select max_quota into quota_max
+		from users_special_quotas
+                where user_id = userid;
+		select trunc(quota_max * pow(2.0,20.0)) 
+		into return_value;
+		return return_value;
+	END IF;
+END;
+' language 'plpgsql';
+
+-- drop function hp_user_quota_max_check_admin(integer,integer,integer);
+create function hp_user_quota_max_check_admin(integer,integer,integer) 
+returns integer as '
+declare
+	userid                  alias for $1;
+	lesser_mortal_quota     alias for $2;
+	higher_mortal_quota     alias for $3;
+	quota_max		integer;
+	special_count		integer;
+	return_value		integer;
+	higher_mortal_p		integer;
+BEGIN
+	select count(*) into special_count
+	from users_special_quotas
+        where user_id = userid;
+
+	select count(*) into higher_mortal_p
+	from user_group_map ugm
+	where ugm.user_id = userid
+	and ugm.group_id = system_administrator_group_id();
+
+	IF special_count = 0
+	THEN
+		IF higher_mortal_p = 0
+		THEN
+			select trunc(lesser_mortal_quota * pow(2.0,20.0)) 
+			into return_value;
+			return return_value;
+		ELSE
+			select trunc(higher_mortal_quota * pow(2.0,20.0)) 
+			into return_value;
+			return return_value;
+		END IF;
+	ELSE
+		select max_quota into quota_max
+		from users_special_quotas
+                where user_id = userid;
+		select trunc(quota_max * pow(2.0,20.0)) 
+		into return_value;
+		return return_value;
+	END IF;
+END;
+' language 'plpgsql';
+
+
+create function hp_user_quota_used(integer,integer) returns integer as '
+declare
+	userid                  alias for $1;
+	dir_requirement         alias for $2;
+	return_value		integer;
+	file_space		integer;
+	dir_space		integer;
+BEGIN
+	select (count(*) * dir_requirement) into dir_space 
+        from users_files
+        where directory_p = ''t''
+        and owner_id = userid;
+
+	select coalesce(sum(file_size),0) into file_space
+        from users_files
+        where directory_p = ''f''
+        and owner_id = userid;
+
+	return_value := dir_space + file_space;
+
+	return return_value;
+END;
+' language 'plpgsql';
+
+
+create function hp_user_quota_left(integer,integer,integer,integer,integer) 
+returns integer as '
+declare
+	userid                  alias for $1;
+	lesser_mortal_quota     alias for $2;
+	higher_mortal_quota     alias for $3;
+	higher_mortal_p         alias for $4;
+	dir_requirement         alias for $5;
+	return_value		integer;
+BEGIN
+	select (hp_user_quota_max(userid, lesser_mortal_quota, higher_mortal_quota, higher_mortal_p) - hp_user_quota_used(userid, dir_requirement))
+	into return_value;
+
+	return return_value;
+END;
+' language 'plpgsql';
+
+
+create function hp_user_quota_left_check_admin(integer,integer,integer,integer) returns integer as '
+declare
+	userid                  alias for $1;
+	lesser_mortal_quota     alias for $2;
+	higher_mortal_quota     alias for $3;
+	dir_requirement         alias for $4;
+	return_value		integer;
+BEGIN
+	select (hp_user_quota_max_check_admin(userid, lesser_mortal_quota, higher_mortal_quota) - hp_user_quota_used(userid, dir_requirement))
+	into return_value;
+
+	return return_value;
+END;
+' language 'plpgsql';
+
+-----------------------------------------
+-- ENDOF userQuotaManagement codeBlock --
+-----------------------------------------
+
+
+create function hp_screen_name(integer) returns varchar as '
+declare
+        id      alias for $1;
+        namein  varchar;
+begin
+        select into namein screen_name from users where user_id = id;
+        return namein;
+end;
+' language 'plpgsql';
+
+
+
+create function hp_users_files(integer) returns integer as '
+declare
+        id      alias for $1;
+        cnt     integer;
+begin
+        select into cnt count(*)
+        from users_files
+        where filename = id::varchar
+        and parent_id is null or parent_id = ''''
+        and owner_id = id;
+        return cnt;
+end;
+' language 'plpgsql';
+
+create function hp_dir_exists(varchar,integer) returns integer as '
+declare
+        dir_name      alias for $1;
+        node          alias for $2;
+        cnt           integer;
+begin
+        select into cnt count(*)
+        from users_files
+        where filename = dir_name
+        and parent_id = node;
+        return cnt;
+end;
+' language 'plpgsql';
+
+
+create function hp_quota_used(integer,integer) returns integer as '
+declare
+        id              alias for $1;
+        dir_space       alias for $2;
+        file_q          integer;
+        dir_q           integer;
+begin
+        select into dir_q count(*) * dir_space
+        from users_files
+        where directory_p = ''t''
+        and owner_id = id;
+        select into file_q coalesce(sum(file_size),0)
+        from users_files
+        where directory_p = ''f''
+        and owner_id = id;
+        return file_q + dir_q;
+end;
+' language 'plpgsql';
+
+
+create function hp_quota_max(integer,integer) returns integer as '
+declare
+        id              alias for $1;
+        max_quota       alias for $2;
+        cnt_q           integer;
+        max_q           integer;
+begin
+        select into cnt_q count(*) from
+                users_special_quotas
+                where user_id = id;
+        select into max_q max_quota from
+                 users_special_quotas
+                 where user_id = id;
+        if not found then
+          max_q := 0;
+        end if;
+        return (case when cnt_q = 0 then max_quota else max_q end);
+end;
+' language 'plpgsql';
+
+
+-- drop function hp_directory_exists(varchar,integer);
+create function hp_directory_exists(varchar,integer) returns integer as '
+declare
+        short_name      alias for $1;
+        node            alias for $2;
+        cnt             integer;
+begin
+        select into cnt count(*) 
+          from users_files
+         where filename = short_name
+           and parent_id = node;
+        return cnt;
+end;
+' language 'plpgsql';
+
+-- drop function hp_content_name_from_type(integer);
+create function hp_content_name_from_type(integer) returns varchar as '
+declare
+        c_type          alias for $1;
+        t_name          varchar;
+begin
+        select into t_name type_name 
+          from users_content_types
+         where type_id = c_type;
+        return t_name;                           
+end;
+' language 'plpgsql';
+
+-- drop function hp_content_type(integer);
+create function hp_content_type(integer) returns varchar as '
+declare
+        node            alias for $1;
+        t_name          varchar;
+begin
+        select into t_name type_name 
+          from users_content_types
+         where type_id = (select content_type
+                            from users_files
+                           where file_id = node);
+        return t_name;                           
+end;
+' language 'plpgsql';
+
+-- drop function hp_content_subtype(integer);
+create function hp_content_subtype(integer) returns varchar as '
+declare
+        node            alias for $1;
+        t_name          varchar;
+begin
+        select into t_name sub_type_name 
+          from users_content_types
+         where type_id = (select content_type
+                            from users_files
+                           where file_id = node);
+        return t_name;
+end;
+' language 'plpgsql';
+
+-- drop function power(integer,integer);
+create function power(integer,integer) returns float8 as '
+declare
+        base    alias for $1;
+        exp     alias for $2;
+begin
+        return pow(float8(base),float8(exp));
+end;
+' language 'plpgsql';
Index: web/openacs/www/doc/sql/intranet-drop.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/intranet-drop.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/intranet-drop.sql	17 Apr 2001 14:05:12 -0000	1.1
@@ -0,0 +1,59 @@
+drop sequence im_url_types_type_id_seq;
+drop sequence im_project_status_id_seq;
+drop sequence im_project_types_id_seq;
+drop sequence im_customer_status_seq;
+drop sequence im_partner_type_seq;
+
+delete from im_project_payments;
+delete from im_partners;
+delete from im_partner_types;
+
+delete from im_project_payments ;
+delete from im_project_payments_audit;
+delete from im_allocations;
+delete from im_allocations_audit;
+delete from im_employee_percentage_time; 
+delete from im_start_blocks;
+
+delete from im_project_url_map;
+delete from im_hours;
+
+delete from im_url_types;
+delete from im_projects;
+
+delete from im_project_status;
+delete from im_project_types;
+
+delete from im_customers;
+delete from im_customer_status;
+
+delete from im_employee_info;
+delete from im_offices;
+
+delete from user_group_map_queue where group_id in (select group_id from user_groups where group_type='intranet');
+delete from user_group_map_queue where group_id in (select group_id from user_groups where group_type='intranet');
+delete from user_group_map where group_id in (select group_id from user_groups where group_type='intranet');
+delete from user_group_member_fields where group_id in (select group_id from user_groups where group_type='intranet');
+delete from user_group_roles where group_id in (select group_id from user_groups where group_type='intranet');
+delete from user_group_action_role_map where group_id in (select group_id from user_groups where group_type='intranet');
+delete from user_group_actions where group_id in (select group_id from user_groups where group_type='intranet');
+
+delete from content_section_links
+where from_section_id in (select section_id
+                          from content_sections
+                          where group_id in (select group_id from user_groups where group_type='intranet'))
+or to_section_id in (select section_id
+                          from content_sections
+                          where group_id in (select group_id from user_groups where group_type='intranet'));
+
+delete from content_files
+where section_id in (select section_id
+                          from content_sections
+                          where group_id in (select group_id from user_groups where group_type='intranet'));
+
+delete from content_sections where group_id in (select group_id from user_groups where group_type='intranet');
+delete from faqs where group_id in (select group_id from user_groups where group_type='intranet');
+
+delete from user_groups where group_type='intranet';
+
+
Index: web/openacs/www/doc/sql/intranet-population.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/intranet-population.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/intranet-population.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,200 @@
+
+-- Create the basic groups for intranet
+select user_group_add ('intranet', 'Customers', 'customer', 'f'); 
+select user_group_add ('intranet', 'Projects', 'project', 'f'); 
+select user_group_add ('intranet', 'Offices', 'office', 'f'); 
+select user_group_add ('intranet', 'Employees', 'employee', 'f'); 
+select user_group_add ('intranet', 'Procedure', 'procedure', 'f'); 
+select user_group_add ('intranet', 'Partners', 'partner', 'f'); 
+select user_group_add ('intranet', 'Authorized Users', 'authorized_users', 'f'); 
+
+
+-- Set up the project types
+insert into im_project_types
+(project_type_id, project_type, display_order) 
+values
+(nextval('im_project_types_id_seq'), 'Client', 1);
+
+insert into im_project_types
+(project_type_id, project_type, display_order) 
+values
+(nextval('im_project_types_id_seq'), 'Sales', 2);
+
+insert into im_project_types
+(project_type_id, project_type, display_order) 
+values
+(nextval('im_project_types_id_seq'), 'Internal', 3);
+
+insert into im_project_types
+(project_type_id, project_type, display_order) 
+values
+(nextval('im_project_types_id_seq'), 'Toolkit', 4);
+
+-- set up the project status
+insert into im_project_status 
+(project_status_id, project_status, display_order) 
+values
+(nextval('im_project_status_id_seq'), 'Open', 1);
+
+insert into im_project_status 
+(project_status_id, project_status, display_order) 
+values
+(nextval('im_project_status_id_seq'), 'Future', 2);
+
+insert into im_project_status 
+(project_status_id, project_status, display_order) 
+values
+(nextval('im_project_status_id_seq'), 'Inactive', 3);
+
+insert into im_project_status 
+(project_status_id, project_status, display_order) 
+values
+(nextval('im_project_status_id_seq'), 'Closed', 4);
+
+insert into im_project_status 
+(project_status_id, project_status, display_order) 
+values
+(nextval('im_project_status_id_seq'), 'Deleted', 5);
+
+
+
+-- set up the types of urls we ask for
+insert into im_url_types
+(url_type_id, url_type, to_ask, to_display, display_order)
+values 
+(nextval('im_url_types_type_id_seq'), 'website', 'Service URL', 'URL', 1);
+
+insert into im_url_types
+(url_type_id, url_type, to_ask, to_display, display_order)
+values 
+(nextval('im_url_types_type_id_seq'), 'staff', 'Staff URL', 'Staff Server', 2);
+
+insert into im_url_types
+(url_type_id, url_type, to_ask, to_display, display_order)
+values 
+(nextval('im_url_types_type_id_seq'), 'development', 'Development URL', 'Development Server', 3);
+
+insert into im_url_types
+(url_type_id, url_type, to_ask, to_display, display_order)
+values 
+(nextval('im_url_types_type_id_seq'), 'staging', 'Staging URL', 'Staging Server', 4);
+
+insert into im_url_types
+(url_type_id, url_type, to_ask, to_display, display_order)
+values 
+(nextval('im_url_types_type_id_seq'), 'glassroom', 'Glassroom URL', 'Glassroom', 5);
+
+
+insert into im_customer_status
+(customer_status_id, customer_status, display_order)
+values
+(nextval('im_customer_status_seq'), 'Current', 1);
+
+insert into im_customer_status
+(customer_status_id, customer_status, display_order)
+values
+(nextval('im_customer_status_seq'), 'Inquiries', 2);
+
+insert into im_customer_status
+(customer_status_id, customer_status, display_order)
+values
+(nextval('im_customer_status_seq'), 'Creating Bid', 3);
+
+insert into im_customer_status
+(customer_status_id, customer_status, display_order)
+values
+(nextval('im_customer_status_seq'), 'Bid out', 4);
+
+insert into im_customer_status
+(customer_status_id, customer_status, display_order)
+values
+(nextval('im_customer_status_seq'), 'Bid and Lost', 5);
+
+insert into im_customer_status
+(customer_status_id, customer_status, display_order)
+values
+(nextval('im_customer_status_seq'), 'Past', 6);
+
+insert into im_customer_status
+(customer_status_id, customer_status, display_order)
+values
+(nextval('im_customer_status_seq'), 'Declined', 7);
+
+insert into im_customer_status
+(customer_status_id, customer_status, display_order)
+values
+(nextval('im_customer_status_seq'), 'Non-converted', 8);
+
+insert into im_customer_status
+(customer_status_id, customer_status, display_order)
+values
+(nextval('im_customer_status_seq'), 'Potential', 9);
+
+-- now for the different types a partner can have
+insert into im_partner_types
+(partner_type_id, partner_type,display_order)
+values
+(nextval('im_partner_types_seq'), 'Usability', 1);
+
+insert into im_partner_types
+(partner_type_id, partner_type,display_order)
+values
+(nextval('im_partner_types_seq'), 'Graphics', 2);
+
+insert into im_partner_types
+(partner_type_id, partner_type,display_order)
+values
+(nextval('im_partner_types_seq'), 'Strategy', 3);
+
+insert into im_partner_types
+(partner_type_id, partner_type,display_order)
+values
+(nextval('im_partner_types_seq'), 'Supplier', 4);
+
+insert into im_partner_types
+(partner_type_id, partner_type,display_order)
+values
+(nextval('im_partner_types_seq'), 'Sys-admin', 5);
+
+insert into im_partner_types
+(partner_type_id, partner_type,display_order)
+values
+(nextval('im_partner_types_seq'), 'Hosting', 6);
+
+insert into im_partner_types
+(partner_type_id, partner_type,display_order)
+values
+(nextval('im_partner_types_seq'), 'Systems Integrator', 7);
+
+insert into im_partner_status 
+(partner_status_id, partner_status, display_order)
+values
+(nextval('im_partner_status_id_seq'), 'Targeted', 1);
+
+insert into im_partner_status 
+(partner_status_id, partner_status, display_order)
+values
+(nextval('im_partner_status_id_seq'), 'In Discussion', 2);
+
+insert into im_partner_status 
+(partner_status_id, partner_status, display_order)
+values
+(nextval('im_partner_status_id_seq'), 'Active', 3);
+
+insert into im_partner_status 
+(partner_status_id, partner_status, display_order)
+values
+(nextval('im_partner_status_id_seq'), 'Announced', 4);
+
+insert into im_partner_status 
+(partner_status_id, partner_status, display_order)
+values
+(nextval('im_partner_status_id_seq'), 'Dormant', 5);
+
+insert into im_partner_status 
+(partner_status_id, partner_status, display_order)
+values
+(nextval('im_partner_status_id_seq'), 'Dead', 6);
+
+
+-- \i start-blocks.sql
Index: web/openacs/www/doc/sql/intranet.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/intranet.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/intranet.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,1194 @@
+-- /www/doc/sql/intranet.sql
+--
+-- A complete revision of June 1999 by dvr@arsdigita.com
+--
+-- mbryzek@arsdigita.com, January 2000
+--
+-- intranet.sql,v 3.4.2.6 2000/03/17 21:58:51 ron Exp
+
+
+--DRB: intranet apparently has been almost entirely rewritten.
+
+-- What states can our customers be in?
+create sequence im_customer_status_seq start 1;
+create table im_customer_status (
+	customer_status_id	integer primary key,
+	customer_status		varchar(100) not null unique,
+	display_order		integer default 1
+);
+
+
+-- we store simple information about a customer
+-- all contact information goes in the address book
+create table im_customers (
+	group_id 	 	integer primary key references user_groups,
+	deleted_p        	char(1) default('f') constraint im_customers_deleted_p check(deleted_p in ('t','f')),
+	customer_status_id      integer references im_customer_status,
+	primary_contact_id	integer references address_book,
+	note			varchar(4000),
+	-- keep track of when status is changed
+        status_modification_date datetime,
+	-- and what the old status was
+        old_customer_status_id  integer references im_customer_status
+);
+
+-- What are the different project types that we support
+create sequence im_project_types_id_seq start 1;
+create table im_project_types (
+	project_type_id		integer primary key,
+	project_type		varchar(200) not null unique,
+	display_order		integer default 1
+);
+
+-- In what states can our projects be?
+create sequence im_project_status_id_seq start 1;
+create table im_project_status (
+	project_status_id	integer primary key,
+	project_status		varchar(100) not null unique,
+	display_order		integer default 1
+);
+
+
+-- What types of urls do we ask for when creating a new project
+-- and in what order?
+create sequence im_url_types_type_id_seq start 1;
+create table im_url_types (
+	url_type_id		integer not null primary key,
+	url_type		varchar(200) not null unique,
+	-- we need a little bit of meta data to know how to ask 
+	-- the user to populate this field
+	to_ask			varchar(1000) not null,
+	-- if we put this information into a table, what is the 
+	-- header for this type of url?
+	to_display		varchar(100) not null,
+	display_order		integer default 1
+);
+	
+
+-----------------------------------------------------------
+-- Projects
+--
+-- 1) Each project can have any number of sub-projects
+--
+-- 2) Each (sub)project can be billed either hourly or
+-- monthly, but not both. If part of a contract is being
+-- billed hourly, create a top-level project specifying
+-- the monthly fee and a subproject for the work being done 
+-- hourly.
+
+create table im_projects (
+    -- each project is a subgroup of the group Projects of group_type intranet
+    -- the name of the project is the group_name
+    group_id                integer primary key references user_groups,
+    parent_id               integer references im_projects,
+    customer_id             integer references im_customers,
+    project_type_id	    integer not null references im_project_types,
+    project_status_id	    integer not null references im_project_status,
+    description             varchar(4000),
+    -- fees
+    fee_setup               float8,
+    fee_hosting_monthly     float8,	
+    fee_monthly             float8,
+    bill_hourly_p           char(1) default 't' check (bill_hourly_p in ('t','f')),
+    start_date              datetime,
+    end_date		    datetime,
+    -- make sure the end date is after the start date
+    -- constraint im_projects_date_const check( end_date - start_date >= 0::timespan ),	
+    note                    varchar(4000),
+    project_lead_id	    integer references users,
+    supervisor_id	    integer references users,
+    ticket_project_id       integer references ticket_projects
+);
+create index im_project_parent_id_idx on im_projects(parent_id);
+
+
+-- we store all urls and their types
+create table im_project_url_map (
+	group_id		integer not null references im_projects,
+	url_type_id		integer not null references im_url_types,
+	url			varchar(250),
+	-- each project can have exactly one type of url
+	primary key (group_id, url_type_id)
+);
+-- We need to create an index on url_type_id if we ever want to ask
+-- "What are all the staff servers?"
+create index im_proj_url_url_proj_idx on im_project_url_map(url_type_id, group_id);
+
+-- What states can our customers be in?
+
+create table im_employee_info (
+	user_id             integer primary key references users,
+	job_title           varchar(200),
+	job_description     varchar(4000),
+	-- is this person an official team leader?
+	team_leader_p	    char(1) 
+		constraint im_employee_team_lead_con check (team_leader_p in ('t','f')),
+	-- can this person lead projects?
+	project_lead_p      char(1) 
+		constraint im_employee_project_lead_con check (project_lead_p in ('t','f')),
+	-- percent of a full time person this person works
+	percentage	    integer,
+	supervisor_id       integer references users,
+	group_manages       varchar(100),
+	current_information   varchar(4000),
+	--- send email if their information is too old
+	last_modified       datetime default current_timestamp not null,
+	ss_number           varchar(20),
+	salary              float8,
+	salary_period       varchar(12) default 'month' 
+	      constraint im_employee_salary_period_con check (salary_period in ('hour','day','week','month','year')),
+	--- W2 information
+	dependant_p         char(1) 
+		constraint im_employee_dependant_p_con check (dependant_p in ('t','f')),
+	only_job_p          char(1) 
+		constraint im_employee_only_job_p_con check (only_job_p in ('t','f')),
+	married_p           char(1) 
+		constraint im_employee_married_p_con check (married_p in ('t','f')),
+	dependants          integer default 0,
+	head_of_household_p char(1) 
+		constraint im_employee_head_of_house_con check (head_of_household_p in ('t','f')),
+	birthdate           datetime,
+	skills              varchar(2000),
+	first_experience    datetime,	
+	years_experience    float8,
+	educational_history varchar(4000),
+	last_degree_completed    varchar(100),
+	resume			 text,
+	resume_html_p		 char(1) 
+		constraint im_employee_resume_html_p_con check (resume_html_p in ('t','f')),
+	start_date          datetime,
+	received_offer_letter_p	char(1) 
+		constraint im_employee_recv_offer_con check(received_offer_letter_p in ('t','f')),
+	returned_offer_letter_p char(1) 
+		constraint im_employee_return_offer_con check(returned_offer_letter_p in ('t','f')),
+	-- did s/he sign the confidentiality agreement?
+	signed_confidentiality_p char(1) 
+		constraint im_employee_conf_p_con check(signed_confidentiality_p  in ('t','f')),   
+	most_recent_review  datetime,
+	most_recent_review_in_folder_p char(1) 
+		constraint im_employee_recent_review_con check(most_recent_review_in_folder_p in ('t','f')),
+	featured_employee_approved_p char(1) 
+		constraint featured_employee_p_con check(featured_employee_approved_p in ('t','f')),
+	featured_employee_approved_by integer references users,
+	-- SCC: somebody eradicate the clob!
+	featured_employee_blurb varchar(4000),
+	featured_employee_blurb_html_p char(1) default 'f'
+		constraint featured_emp_blurb_html_p_con check (featured_employee_blurb_html_p in ('t','f')),
+	referred_by             integer references users
+);
+
+-- next two views were created to ease porting of outer joins.  The views allow
+-- constructs such as info.* to be retained.  See /intranet/users/view.tcl for
+-- an example of their usage.
+
+-- drop view im_employee_info_null;
+
+create view im_employee_info_null as 
+select 
+''::integer as user_id
+,''::varchar as job_title                      
+,''::varchar as job_description                
+,''::char as team_leader_p                  
+,''::char as project_lead_p                 
+,''::integer as percentage                     
+,''::integer as supervisor_id                  
+,''::varchar as group_manages                  
+,''::varchar as current_information            
+,''::varchar as last_modified                  
+,''::varchar as ss_number                      
+,''::float as salary8                         
+,''::varchar as salary_period                  
+,''::char as dependant_p                    
+,''::char as only_job_p                     
+,''::char as married_p                      
+,''::integer as dependants                     
+,''::char as head_of_household_p            
+,''::varchar as birthdate                      
+,''::varchar as skills                         
+,''::varchar as first_experience               
+,''::float as years_experience8               
+,''::varchar as educational_history            
+,''::varchar as last_degree_completed          
+,''::text as resume                         
+,''::char as resume_html_p                  
+,''::varchar as start_date                     
+,''::char as received_offer_letter_p        
+,''::char as returned_offer_letter_p        
+,''::char as signed_confidentiality_p       
+,''::varchar as most_recent_review             
+,''::char as most_recent_review_in_folder_p 
+,''::char as featured_employee_approved_p   
+,''::integer as featured_employee_approved_by  
+,''::varchar as featured_employee_blurb        
+,''::char as featured_employee_blurb_html_p 
+,''::integer as referred_by;
+
+
+-- drop view im_employee_info_view;
+
+create view im_employee_info_view as 
+select 
+user_id
+,job_title                      
+,job_description                
+,team_leader_p                  
+,project_lead_p                 
+,percentage                     
+,supervisor_id                  
+,group_manages                  
+,current_information            
+,to_char(last_modified,'YYYY-MM-DD') as last_modified
+,ss_number                      
+,salary                        
+,salary_period                  
+,dependant_p                    
+,only_job_p                     
+,married_p                      
+,dependants                     
+,head_of_household_p            
+,to_char(birthdate,'YYYY-MM-DD') as birthdate
+,skills                         
+,to_char(first_experience,'YYYY-MM-DD') as first_experience               
+,years_experience               
+,educational_history            
+,last_degree_completed          
+,resume                         
+,resume_html_p                  
+,to_char(start_date,'YYYY-MM-DD') as start_date                     
+,received_offer_letter_p        
+,returned_offer_letter_p        
+,signed_confidentiality_p       
+,to_char(most_recent_review,'YYYY-MM-DD') as most_recent_review             
+,most_recent_review_in_folder_p 
+,featured_employee_approved_p   
+,featured_employee_approved_by  
+,featured_employee_blurb        
+,featured_employee_blurb_html_p 
+,referred_by from im_employee_info;
+
+
+
+-- logic depends on this being null instead of 0 which seems to be the default
+-- for the null string
+create function im_projects_tr() returns opaque as '
+begin
+         if new.parent_id = '''' then
+            new.parent_id := null;
+         end if;
+  return new;
+end;
+' language 'plpgsql';
+
+create trigger im_projects_tr
+before insert or update on im_projects
+for each row execute procedure im_projects_tr();
+
+
+create function im_info_tr() returns opaque as '
+begin
+         if new.supervisor_id = '''' then
+            new.supervisor_id := null;
+         end if;
+  return new;
+end;
+' language 'plpgsql';
+
+create trigger im_info_tr
+before insert or update on im_employee_info
+for each row execute procedure im_info_tr();
+
+
+--- We record logged hours in the im_hours table.
+
+create table im_hours (
+    user_id          integer not null references users,
+    on_what_id       integer not null,
+    on_which_table   varchar(50),
+    note             varchar(4000),
+    day              datetime,
+    hours            float8,
+    billing_rate     float8,
+    primary key(user_id, on_which_table, on_what_id, day)
+);
+create index im_hours_table_id_idx on im_hours(on_which_table, on_what_id);
+
+create view im_hours_null as select
+NULL::integer as user_id,
+NULL::integer as on_what_id,
+NULL::char as on_which_table,
+NULL::char as note,
+NULL::datetime as day,
+NULL::float8 as hours,
+NULL::float8 as billing_rate;
+
+-- Offices - linked to user groups
+create table im_offices (
+	group_id               	integer primary key references user_groups,
+	phone                   varchar(50),
+	fax                     varchar(50),
+	address_line1           varchar(80),
+	address_line2           varchar(80),
+	address_city            varchar(80),
+	address_state           varchar(80),
+	address_postal_code     varchar(80),
+	address_country_code    char(2) references country_codes(iso),
+	contact_person_id       integer references users,
+	landlord                varchar(4000),
+	--- who supplies the security service, the code for
+	--- the door, etc.
+	security                varchar(4000),
+	note                    varchar(4000)
+);
+
+
+-- configure projects to have general comments
+insert into table_acs_properties 
+(table_name, section_name, user_url_stub, admin_url_stub) 
+values ('im_projects','intranet','/admin/intranet/projects/view.tcl?group_id=','/admin/intranet/projects/view.tcl?group_id=');
+
+
+create function salary_divisor(varchar) returns float8 as '
+declare
+	type_salary	alias for $1;
+begin
+	if type_salary = ''year'' then
+	   return 12;
+	else
+	   return 1;
+	end if;
+end;
+' language 'plpgsql';
+
+create view im_monthly_salaries
+as
+select user_id, salary/salary_divisor(salary_period) as salary
+from im_employee_info
+where salary_period in ('year','month');
+
+create function salary_multiplier(varchar) returns float8 as '
+declare
+	type_salary	alias for $1;
+begin
+	if type_salary = ''month'' then
+	   return 12;
+	else
+	   return 1;
+	end if;
+end;
+' language 'plpgsql';
+
+create view im_yearly_salaries
+as
+select user_id, round(salary * salary_multiplier(salary_period),2) as salary
+from im_employee_info
+where salary_period in ('month','year');
+
+
+
+-- We base our allocations, employee count, etc. around
+-- a fundamental unit or block.
+-- im_start_blocks record the dates these blocks
+-- will start for this system.
+
+create table im_start_blocks (
+	start_block   datetime not null primary key,
+	note          varchar(4000)
+);
+
+
+create table im_employee_percentage_time ( 
+	start_block 	datetime references im_start_blocks, 
+	user_id 	integer references users, 
+	percentage_time integer, 
+	note 		varchar(4000), 
+	primary key (start_block, user_id) 
+); 
+
+
+-- tracks the money coming into a contract over time
+
+create sequence im_project_payment_id_seq start 10000;
+
+create table im_project_payments (
+	payment_id   integer not null primary key,
+	group_id	integer references im_projects,
+	start_block	datetime references im_start_blocks,
+	fee             float8,
+	-- setup, monthly, monthly_hosting, hourly, stock, other
+        fee_type        varchar(50),
+	paid_p  	char(1) default 'f' check (paid_p in ('t','f')),
+	due_date	      datetime,
+	received_date	      datetime,
+	note		      varchar(4000),
+	last_modified           datetime not null,
+ 	last_modifying_user     integer not null references users,
+	modified_ip_address     varchar(20) not null
+);
+
+
+create table im_project_payments_audit (
+	payment_id   integer,
+	group_id	integer references im_projects,
+	start_block	datetime references im_start_blocks,
+	fee             float8,
+	-- setup, monthly, monthly_hosting, hourly, stock, other
+        fee_type        varchar(50),
+	paid_p  	char(1) default 'f' check (paid_p in ('t','f')),
+	due_date	      datetime,
+	received_date	      datetime,
+	note		      varchar(4000),
+	last_modified           datetime not null,
+ 	last_modifying_user     integer not null references users,
+	modified_ip_address     varchar(20) not null,
+	delete_p                char(1) default 'f' check (delete_p in ('t','f'))
+);
+
+create index im_proj_payments_aud_id_idx on im_project_payments_audit(payment_id);
+
+create function im_project_payments_audit_tr() returns opaque as '
+begin
+                  insert into im_project_payments_audit (
+                  payment_id,group_id, start_block, fee,
+	          fee_type, paid_p, due_date, received_date, note, 
+                  last_modified,
+                  last_modifying_user, modified_ip_address
+                  ) values (
+                  old.payment_id, old.group_id, old.start_block, old.fee,
+        	  old.fee_type, old.paid_p, old.due_date, 
+                  old.received_date, 
+		  old.note, old.last_modified,
+                  old.last_modifying_user, old.modified_ip_address
+                  );
+                  return new;
+end;
+' language 'plpgsql';
+
+
+create trigger im_project_payments_audit_tr
+          before update or delete on im_project_payments
+          for each row execute procedure im_project_payments_audit_tr();
+
+
+--- im_allocations is used to do predictions and tracking based on
+--- percentage of time/project. 
+
+-- im_allocations does not have a separate audit
+-- table because we want to take a snapshot of allocation 
+-- at a chosed times.
+
+
+create sequence im_allocations_id_seq;
+
+create table im_allocations (
+	--- allocation_id is not the primary key becase
+	--- an allocation may be over several blocks of
+	---  time.  We store a row per block.
+	---  To answer the question "what is the allocation for
+	--- this time block, query the most recent allocation
+	--- for either that allocation_id or user_id.
+	allocation_id    integer not null,
+	group_id       integer not null references im_projects,
+	-- this may be null because we will rows we need to store
+	-- rows that are currently not allocated (future hire or
+	-- decision is not made)
+	user_id		 integer  references users,
+	-- Allocations are divided up into blocks of time.
+	-- Valid dates for start_block must be separated
+	-- by the block unit.  For example, if your block unit
+	-- was a week, valid start_block dates may be "Sundays"
+	-- If the start_blocks don't align, reports get very difficult.
+	start_block      datetime references im_start_blocks,
+	percentage_time	 integer not null,
+	note		 varchar(1000),
+	last_modified           datetime not null,
+        last_modifying_user     integer not null references users,
+        modified_ip_address     varchar(20) not null
+);
+create index im_all_alloc_id_group_id_idx on im_allocations(allocation_id);
+create index im_all_group_id_group_id_idx on im_allocations(group_id);
+create index im_all_group_id_user_id_idx on im_allocations(user_id);
+create index im_all_group_id_last_mod_idx on im_allocations(last_modified);
+
+
+create table im_allocations_audit (
+	allocation_id    integer not null,
+	group_id       integer not null references im_projects,
+	user_id		 integer  references users,
+	-- Allocations are divided up into blocks of time.
+	-- Valid dates for start_block must be separated
+	-- by the block unit.  For example, if your block unit
+	-- was a week, valid start_block dates may be "Sundays"
+	-- If the start_blocks don't align, reports get very difficult.
+	start_block      datetime references im_start_blocks,
+	percentage_time	 integer not null,
+	note		 varchar(1000),
+	last_modified           datetime not null,
+        last_modifying_user     integer not null references users,
+        modified_ip_address     varchar(20) not null
+);
+
+
+--- we will put a row into the im_allocations_audit table if
+--- a) another row is added with the same allocation_id and start_block
+--- b) another row is added with the same user_id, group_id and start_block
+
+create function im_allocations_audit_tr() returns opaque as '
+begin
+        insert into im_allocations_audit (
+        allocation_id, group_id, user_id,  start_block, percentage_time,note, last_modified, last_modifying_user, modified_ip_address
+ 	) values (
+        old.allocation_id, old.group_id, old.user_id,  old.start_block, old.percentage_time,old.note, old.last_modified, old.last_modifying_user, old.modified_ip_address);
+  return new;
+end;
+' language 'plpgsql';
+
+
+create trigger im_allocations_audit_tr
+before update or delete on im_allocations
+for each row execute procedure im_allocations_audit_tr();
+
+
+
+create function get_start_week(datetime) returns datetime as '
+declare
+	v_start_date    alias for $1;
+        dow             integer;
+BEGIN
+        dow := date_part(''dow'',v_start_date);
+        return (v_start_date - dow)::datetime;
+end;
+' language 'plpgsql';
+
+
+-- calculate the monthly fee for a given start_block and end_block
+
+
+-- drop function im_projects_monthly_fee(integer,datetime,datetime);
+
+-- you might be wondering why not use sum(fee) instead?
+-- I couldn't get aggregates to work inside these functions with
+-- postgres 6.5.3, so I hacked these up to at least get the same 
+-- functionality.
+create function im_projects_monthly_fee(integer,datetime,datetime) 
+returns float8 as '
+declare
+	v_group_id      alias for $1;
+	v_start_block   alias for $2;
+	v_end_block     alias for $3;
+        monthly_fee     float8;
+        par_rec         record;
+BEGIN
+        monthly_fee = 0.0;
+        for par_rec in select *
+        from im_project_payments
+        where im_project_payments.group_id = v_group_id
+         and start_block >= v_start_block
+         and start_block <= v_end_block
+         and fee_type <> ''setup''
+         and fee_type <> ''stock''
+        loop
+          monthly_fee := monthly_fee + par_rec.fee;
+        end loop;
+        return monthly_fee;
+end;
+' language 'plpgsql';
+
+
+-- calulate the setup fee for a given start_block and end_block
+
+-- drop function im_projects_setup_fee(integer,datetime,datetime);
+
+-- you might be wondering why not use sum(fee) instead?
+-- I couldn't get aggregates to work inside these functions with
+-- postgres 6.5.3, so I hacked these up to at least get the same 
+-- functionality.
+create function im_projects_setup_fee(integer,datetime,datetime) 
+returns float8 as '
+declare
+	v_group_id      alias for $1;
+	v_start_block   alias for $2;
+	v_end_block     alias for $3;
+        monthly_fee     float8;
+        par_rec         record;
+BEGIN
+        monthly_fee := 0.0;
+        for par_rec in select * 
+        from im_project_payments
+        where im_project_payments.group_id = v_group_id
+        and start_block >= v_start_block
+        and start_block <= v_end_block
+        and fee_type = ''setup''
+        loop
+          monthly_fee := monthly_fee + par_rec.fee;
+        end loop;
+        return monthly_fee;
+end;
+' language 'plpgsql';
+
+
+-- calulate the stock for a given start_block and end_block
+
+-- you might be wondering why not use sum(fee) instead?
+-- I couldn't get aggregates to work inside these functions with
+-- postgres 6.5.3, so I hacked these up to at least get the same 
+-- functionality.
+
+-- drop function im_projects_stock_fee(integer,datetime,datetime);
+create function im_projects_stock_fee(integer,datetime,datetime) 
+returns float8 as '
+declare
+	v_group_id      alias for $1;
+	v_start_block   alias for $2;
+	v_end_block     alias for $3;
+        stock_fee      	float8;
+        par_rec         record;
+BEGIN
+        stock_fee := 0.0;
+        for par_rec in select *
+        from im_project_payments
+        where im_project_payments.group_id = v_group_id
+        and start_block >= v_start_block
+        and start_block <= v_end_block
+        and fee_type = ''stock''
+        loop
+          stock_fee := stock_fee + par_rec.fee;
+        end loop;
+        return stock_fee;
+end;
+' language 'plpgsql';
+
+
+
+create sequence im_partner_types_seq start 1;
+create table im_partner_types (
+	partner_type_id	        integer primary key,
+	partner_type		varchar(100) not null unique,
+	display_order		integer default 1
+);
+
+-- In what states can our projects be?
+create sequence im_partner_status_id_seq start 1;
+create table im_partner_status (
+	partner_status_id	integer primary key,
+	partner_status		varchar(100) not null unique,
+	display_order		integer default 1
+);
+
+
+-- we store simple information about a customer
+-- all contact information goes in the address book
+create table im_partners (
+	group_id 	 	integer primary key references user_groups,
+	deleted_p        	char(1) default('f') constraint im_partners_deleted_p check(deleted_p in ('t','f')),
+	partner_type_id         integer references im_partner_types,
+	partner_status_id       integer references im_partner_status,
+	primary_contact_id	integer references users,
+	url			varchar(200),
+	note			varchar(4000)
+);
+
+
+-- The various procedures. Note that user-groups don't really
+-- work here because of the meta data we 
+-- store (supervisor/certifier/long note)
+
+create sequence im_procedures_procedure_id_seq start 1;
+
+create table im_procedures (
+    procedure_id            integer not null primary key,
+    name                    varchar(200) not null,
+    note                    varchar(4000),
+    creation_date           datetime not null,
+    creation_user           integer not null references users,
+    last_modified           datetime,
+    last_modifying_user     integer references users
+);
+
+
+-- Users certified to do a certain procedure
+
+create table im_procedure_users (
+    procedure_id        integer not null references im_procedures,
+    user_id             integer not null references users,
+    note                varchar(400),
+    certifying_user     integer not null references users,
+    certifying_date     datetime not null,
+    primary key(procedure_id, user_id)
+);
+
+-- Occasions the procedure was done by a junior person,
+-- under the supervision of a certified person
+
+create sequence im_proc_event_id_seq;
+
+create table im_procedure_events (
+    event_id            integer not null primary key,
+    procedure_id        integer not null references im_procedures,
+    -- the person who did the procedure
+    user_id             integer not null references users,
+    -- the certified user who supervised
+    supervising_user    integer not null references users,
+    event_date          datetime not null,
+    note                varchar(1000)
+);
+
+
+
+-- Now the pls definitions
+
+-- Some helper functions to make our queries easier to read
+create function im_proj_type_from_id(integer) returns varchar as '
+declare
+	v_project_type_id alias for $1;
+  v_project_type    varchar;
+BEGIN
+  select project_type into v_project_type from im_project_types where project_type_id = v_project_type_id;
+  return v_project_type;
+END;
+' language 'plpgsql';
+
+
+create function im_proj_status_from_id(integer) returns varchar as '
+declare
+	v_project_status_id alias for $1;
+  v_project_status    varchar;
+BEGIN
+  select project_status into v_project_status from im_project_status where project_status_id = v_project_status_id;
+  return v_project_status;
+END;
+' language 'plpgsql';
+
+-- couldn't find out what this statement does. commented out for now.
+-- exception when others then null;
+create function im_proj_url_from_type(integer,varchar) returns varchar as '
+declare
+	v_group_id      alias for $1;
+	v_url_type      alias for $2;
+        v_url 		varchar;
+BEGIN
+  begin
+        select url into v_url 
+          from im_url_types, im_project_url_map
+         where group_id = v_group_id
+           and im_url_types.url_type_id = im_project_url_map.url_type_id
+           and url_type = v_url_type;
+  end;
+  return v_url;
+END;
+' language 'plpgsql';
+
+create function im_cust_status_from_id(integer) returns varchar as '
+declare
+	v_customer_status_id alias for $1;
+  v_customer_status    varchar;
+BEGIN
+  select customer_status into v_customer_status from im_customer_status where customer_status_id = v_customer_status_id;
+  return v_customer_status;
+END;
+' language 'plpgsql';
+
+
+--- Define an administration group for the Intranet
+
+select administration_group_add('Intranet Administration', 'intranet', 'intranet', '', 'f', '/admin/intranet/');
+
+
+-- Create a group type of intranet. Does nothing if the group type is already defined
+
+
+create function create_group_type_intranet() returns bool as '
+declare
+ n_system_group_types	integer;
+begin
+ select count(*) into n_system_group_types from user_group_types where group_type = ''intranet'';
+ if n_system_group_types = 0 then 
+   -- create the group type
+   insert into user_group_types
+     (group_type, pretty_name, pretty_plural, approval_policy, default_new_member_policy, group_module_administration)
+   values
+     (''intranet'', ''Intranet'', ''Intranet Groups'', ''closed'', ''closed'', ''full'');
+
+ end if;
+ return ''t'';
+end;
+' language 'plpgsql';
+
+select create_group_type_intranet();
+
+-- stuff we need for the Org Chart
+-- Oracle will pop a cap in our bitch ass if do CONNECT BY queries 
+-- on im_users without these indices
+
+create index im_employee_info_idx1 on im_employee_info(user_id, supervisor_id);
+create index im_employee_info_idx2 on im_employee_info(supervisor_id, user_id);
+
+-- you can't do a JOIN with a CONNECT BY so we need a PL/SQL proc to
+-- pull out user's name from user_id
+
+create function im_name_from_user_id(integer) returns varchar as '
+declare
+	v_user_id	alias for $1;
+	v_full_name	varchar(8000);
+BEGIN
+  select first_names || '' '' || last_name into v_full_name 
+   from users 
+   where user_id = v_user_id;
+  return v_full_name;
+end;
+' language 'plpgsql';
+
+
+-- couldn't find a place where this was actually being used, so I didn't 
+-- convert it.
+create function im_supervises_p(integer,integer) returns varchar as '
+declare
+	v_supervisor_id alias for $1;
+	v_user_id	alias for $2;
+	v_exists_p	char;
+BEGIN
+  select (case when count(*) = 0 then ''f'' else ''t'' end) into v_exists_p
+   from im_employee_info
+   where user_id = v_user_id
+   and level > 1
+   start with user_id = v_supervisor_id
+   connect by supervisor_id = PRIOR user_id;
+   return v_exists_p;
+end;
+' language 'plpgsql';
+
+
+-- drop function im_projects_gen_key(integer);
+create function im_projects_gen_key(integer) returns varchar as '
+declare
+        id      alias for $1;
+        str     varchar;
+        len     integer;
+begin
+        str := ''000000'' || text(id);
+        len := char_length(str);
+        return substr(str,len - 5);
+end;
+' language 'plpgsql';
+
+
+create function im_projects_connect_by(integer) returns varchar as '
+declare
+	id              alias for $1;
+        parentid        integer;
+BEGIN
+        select into parentid parent_id from im_projects where id = group_id;
+	IF parentid is null or parentid = ''''
+	THEN 
+		return im_projects_gen_key(id);
+	ELSE
+		return im_projects_connect_by(parentid) || ''/'' || im_projects_gen_key(id);
+	END IF;	
+END;
+' language 'plpgsql';
+
+
+create function im_projects_level(integer,integer) returns integer as '
+declare
+	id              alias for $1;
+        count           alias for $2;
+	parentid	integer;
+BEGIN
+        select into parentid parent_id
+                from im_projects
+		where group_id = id;
+
+	IF parentid is null or parentid = ''''
+	THEN 
+		return count;
+	ELSE
+		return im_projects_level(parentid,count+1);
+	END IF;	
+END;
+' language 'plpgsql';
+
+
+create view im_projects_view as 
+select p.*, im_projects_level(p.group_id,1) as level,
+       im_projects_connect_by(p.group_id) as connect_by_key
+from im_projects p;
+
+
+-- set sql "select user_group_name_from_id(group_id) as project_name,
+--                 group_id as project_id, level
+--            from im_projects p
+--           where exists (select 1 
+--                           from user_group_map ugm 
+--                        where p.group_id=ugm.group_id and ugm.user_id=$user_id)
+--      connect by prior group_id=parent_id
+--      start with parent_id is null"
+
+-- select user_group_name_from_id(group_id) as project_name, 
+--                group_id as project_id, level
+--           from im_projects_view p
+--          where exists (select 1 from user_group_map ugm 
+--                         where p.group_id=ugm.group_id 
+--                           and ugm.user_id=$user_id)
+--       order by connect_by_key
+--
+--
+
+
+create function im_org_chart_connect_by(integer,integer) returns varchar as '
+declare
+	id              alias for $1;
+        start           alias for $2;
+        parentid        integer;
+BEGIN
+        select into parentid supervisor_id from im_employee_info 
+        where id = user_id;
+
+	IF parentid is null or parentid = start or parentid = ''''
+	THEN 
+		return im_projects_gen_key(id);
+	ELSE
+		return im_org_chart_connect_by(parentid,start) || ''/'' || im_projects_gen_key(id);
+	END IF;	
+END;
+' language 'plpgsql';
+
+
+create function im_org_chart_level(integer,integer,integer) 
+returns integer as '
+declare
+	id              alias for $1;
+        count           alias for $2;
+        start           alias for $3;
+	parentid	integer;
+BEGIN
+        select into parentid supervisor_id
+                from im_employee_info
+		where user_id = id;
+
+	IF parentid is null or parentid = start or parentid = ''''
+	THEN 
+		return count;
+	ELSE
+		return im_org_chart_level(parentid,count+1,start);
+	END IF;	
+END;
+' language 'plpgsql';
+
+
+--  SCC: somebody check the plpgsql...
+-- drop function im_project_ticket_project_id(integer);
+create function im_project_ticket_project_id(integer)
+returns integer as '
+declare
+	v_group_id	alias for $1;
+	v_project_id	ticket_projects.project_id%TYPE;
+BEGIN
+  BEGIN
+    select project_id into v_project_id from ticket_projects where customer_id = v_group_id;
+
+  END;
+  if v_project_id is null then
+     return 0;
+  else
+     return v_project_id;
+  end if;
+END;
+' language 'plpgsql';
+
+
+
+-- a bunch of stuff for outer joins (BMA)
+create function im_employee_salary (integer)
+returns numeric as '
+DECLARE
+	v_user_id alias for $1;
+BEGIN
+	return salary from im_monthly_salaries where user_id= v_user_id;
+END;
+' language 'plpgsql';
+
+create function im_employee_n_years_experience (integer)
+returns numeric as '
+DECLARE
+	v_user_id alias for $1;
+	v_experience numeric;
+BEGIN
+	select (date_part(''year'',age(sysdate(),info.first_experience)) + date_part(''month'',age(sysdate(),info.first_experience))/12)::numeric into v_experience from im_employee_info info where user_id= v_user_id;
+	if v_experience is null
+	then return 0::numeric;
+	else return v_experience;
+	end if;
+END;
+' language 'plpgsql';
+
+create function im_employee_referals(integer) returns integer as '
+declare
+        id      alias for $1;
+        cnt     integer;
+begin
+        select into cnt count(1)
+          from im_employee_info
+         where referred_by = id;
+         return cnt;
+end;
+' language 'plpgsql';
+
+
+-- drop function mod_days(integer);
+create function mod_days(integer) returns integer as '
+declare
+        day     alias for $1;
+begin
+        if day >= 7 then
+           return day - 7;
+        else if day < 0 then
+           return day + 7;
+        else
+           return day;
+        end if;
+        end if;
+end;
+' language 'plpgsql';
+
+-- drop function delta_days(integer,varchar);
+create function delta_days(integer,varchar) returns integer as '
+declare
+        day_in          alias for $1;
+        pattern         alias for $2;
+        v_day           integer;
+        d_days          integer;
+        v_pat           varchar;
+begin
+        select into v_pat substr(upper(pattern),1,3);
+        select into v_day (case when v_pat = ''SUN'' then 0 else
+                           case when v_pat = ''MON'' then 1 else
+                           case when v_pat = ''TUE'' then 2 else
+                           case when v_pat = ''WED'' then 3 else
+                           case when v_pat = ''THU'' then 4 else
+                           case when v_pat = ''FRI'' then 5 else
+                           case when v_pat = ''SAT'' then 6
+                           end end end end end end end);
+                             
+       d_days := mod_days((v_day - day_in) + 7);
+       if d_days = 0 then 
+          return 7;
+       else
+          return d_days;
+       end if;
+end;
+' language 'plpgsql';
+
+
+-- drop function next_day(datetime,varchar);
+create function next_day(datetime,varchar) returns datetime as '
+declare
+       the_date      alias for $1;
+       pattern       alias for $2;
+       dow           integer;
+begin
+       dow    := date_part(''dow'',the_date);
+       return the_date + delta_days(dow,pattern); 
+end;
+' language 'plpgsql';
+
+create function trunc(timespan) returns varchar as '
+declare
+	inspan          alias for $1;
+begin
+        return date_part(''day'',inspan);
+end;
+' language 'plpgsql';
+
+-- drop function julian_zero_date();
+create function julian_zero_date() returns datetime as '
+begin
+	return ''4714-11-24 BC''::datetime;
+end;
+' language 'plpgsql';
+
+-- drop function julian_date(datetime);
+create function julian_date(datetime) returns varchar as '
+declare
+       indate    alias for $1;
+begin
+        return trunc(indate - julian_zero_date());
+end;
+' language 'plpgsql';
+
+-- drop function date_from_julian(integer);
+create function date_from_julian(integer) returns datetime as '
+declare
+                jdate   alias for $1;
+begin
+                return julian_zero_date() + jdate;
+end;
+' language 'plpgsql';
+
+
+
+-- Populate all the status/type/url with the different types of 
+-- data we are collecting
+\i intranet-population.sql
+
+
+-- drop function im_load_start_blocks(timestamp,integer,varchar);
+create function im_load_start_blocks(timestamp,integer,varchar) 
+returns integer as '
+declare
+        start_date      alias for $1;
+        number_of_weeks alias for $2;
+        comment         alias for $3;
+        the_date        timestamp;
+begin
+        the_date := next_day(start_date,''SUNDAY'');
+        for i in 0 .. number_of_weeks loop
+            insert into im_start_blocks (start_block,note)
+                                 values (the_date,comment);
+            the_date := the_date + 7;
+        end loop;            
+        return 0;
+end;
+' language 'plpgsql';
+
+
+
+-- Load the im_start_blocks.  This is setup to provide start blocks from 6 
+-- months in the past to 100 years in the future.  Edit the start_date and 
+-- the number_of_weeks if you want something different.  We're creating a Y2100
+-- problem here, but unix has a Y2047? problem already, so we're safe :).
+
+-- BMA: 100 years? That makes for ridiculous drop down boxes. I think having 2 years is plenty.
+-- The start blocks can be recalculated every now and then.
+-- select im_load_start_blocks(sysdate() - 26*7,52*100 + 26,'Week');
+
+select im_load_start_blocks(sysdate() - 26*7,52*2 + 26,'Week');
+
+
+-- More Pgsql for Postgres (BMA)
+create function im_hours_group_id_valid_p(integer, integer, char, integer)
+returns char
+as '
+DECLARE
+	v_group_id alias for $1;
+	v_user_id alias for $2;
+	v_on_which_table alias for $3;
+	v_julian_date alias for $4;
+	v_check integer;
+BEGIN
+	select count(*) into v_check from user_group_map where user_id= v_user_id and group_id= v_group_id;
+
+	if v_check > 0
+	then return ''t'';
+	end if;
+
+	select count(*) into v_check from im_hours where 
+	user_id= v_user_id and
+	on_which_table= v_on_which_table and
+	(im_hours.hours is not null or im_hours.note is not null) and day= date_from_julian(v_julian_date)
+	and on_what_id = v_group_id;
+
+	if v_check > 0
+	then return ''t'';
+	else return ''f'';
+	end if;
+END ;
+' language 'plpgsql';
Index: web/openacs/www/doc/sql/load-data-model.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/load-data-model.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/load-data-model.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,81 @@
+-- Run this file so:
+-- psql -f load-data-model.sql [your database name]
+--
+-- RBM: Alternatively, and for debugging purposes, you can do
+-- psql -f load-data-model.sql [your database name] 2> datamodel.txt
+-- which will output the results to the file datamodel.txt that can be
+-- edited to check if everything went well.
+--
+\i postgres.sql
+-- rank-for-search.sql allows dumb keyword searching of forums if no
+-- decent sitewide search mechanism is installed.  Probably too slow and
+-- dumb to use for all portions of a site, or with bboards with a large
+-- number of accumulated posts.  
+--
+-- You must configure postgres using --with-tcl and set UseOpenACSSearch to 1 in
+-- your OpenACS configuration file to use this. 
+-- \i rank-for-search.sql
+-- 
+\i lob.sql
+\i modules.sql
+\i community-core.sql
+\i user-groups.sql
+\i security.sql		
+\i content-sections.sql
+\i pl-sql.sql
+\i general-permissions.sql	
+\i news.sql
+\i calendar.sql
+\i bboard.sql
+\i classifieds.sql
+\i contest.sql
+\i display.sql
+\i download.sql
+\i adserver.sql
+-- We're using new-ticket for now
+-- \i ticket.sql
+\i notification.sql
+\i new-ticket.sql
+\i dw.sql
+\i faq.sql
+\i glassroom.sql
+\i homepage.sql
+\i pull-down-menus.sql
+\i pull-down-menu-data.sql
+\i survey-simple.sql		
+\i registry.sql
+\i spam.sql
+\i neighbor.sql
+\i address-book.sql
+\i bannerideas.sql
+\i chat.sql
+\i content-tagging.sql
+\i email-handler.sql
+\i glossary.sql
+\i intranet.sql
+\i partner.sql
+\i member-value.sql
+\i robot-detection.sql
+\i tools.sql
+\i file-storage.sql
+\i bookmarks.sql
+\i general-comments.sql
+\i general-links.sql
+\i portals.sql
+\i crm.sql
+\i user-custom.sql
+\i poll.sql
+\i press.sql
+\i curriculum.sql
+\i ecommerce.sql
+\i ecommerce-plsql.sql
+\i events.sql
+\i table-metadata.sql
+-- Education is no longer included by default because it causes too much
+-- trouble with all of its triggers. Load it up manually if you so desire
+-- BMA (v 3.2.4, 9/21/2000).
+-- \i education.sql
+\i wp.sql
+-- More stuff not in standard ACS
+\i todo.sql
+\i sdm.sql
Index: web/openacs/www/doc/sql/load-site-wide-search
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/load-site-wide-search,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/load-site-wide-search	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,15 @@
+#! /bin/sh
+
+# Usage: load-site-wide-search username password ctxsys-password 
+
+if [ $# != 3 ]; then
+    echo "usage: $0 username password ctxsys-password"
+    exit
+fi
+
+username=$1
+password=$2
+ctxsyspwd=$3
+
+sqlplus $username/$password @site-wide-search.sql $username $password $ctxsyspwd
+
Index: web/openacs/www/doc/sql/lob.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/lob.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/lob.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,82 @@
+-- SQL support for fake lobs for ACS/Postgres.
+-- Don Baccus February 2000
+
+-- for each user table my_table in which you want to stuff large
+-- amounts of data:
+
+-- define a column "lob integer references lobs"
+-- do "create trigger my_table_lob_trig before delete or update or insert
+-- on my_table for each row execute procedure on_lob_ref()"
+
+-- to initialize a row's lob column,  use empty_lob():
+
+-- insert into my_table (lob) values(empty_lob());
+
+-- deletes and updates on my_table use reference count information
+-- to delete data from lobs and lob_data when appropriate.
+
+
+create sequence lob_sequence;
+
+create table lobs (
+	lob_id			integer not null primary key,
+	refcount		integer not null default 0
+);
+
+create function on_lobs_delete() returns opaque as '
+begin
+	delete from lob_data where lob_id = old.lob_id;
+	return old;
+end;' language 'plpgsql';
+
+create trigger lobs_delete_trig before delete on lobs
+for each row execute procedure on_lobs_delete();
+
+create table lob_data (
+	lob_id			integer not null references lobs,
+	segment			integer not null,
+	byte_len		integer not null,
+	data			bytea not null,
+	primary key (lob_id, segment)
+);
+
+create index lob_data_index on lob_data(lob_id);
+
+-- Note - race conditions might cause problems here, but I 
+-- couldn't get locking to work consistently between PG 6.5
+-- and PG 7.0.  The ACS doesn't share LOBs between tables
+-- or rows within a table anyway, I don't think/hope.
+
+create function on_lob_ref() returns opaque as '
+begin
+	if TG_OP = ''UPDATE'' then
+		if new.lob = old.lob then
+			return new;
+		end if;
+	end if;
+
+	if TG_OP = ''INSERT'' or TG_OP = ''UPDATE'' then
+		if new.lob is not null then
+			insert into lobs select new.lob, 0
+				where 0 = (select count(*) from lobs where lob_id = new.lob);
+			update lobs set refcount = refcount + 1 where lob_id = new.lob;
+		end if;
+	end if;
+
+	if TG_OP <> ''INSERT'' then
+		if old.lob is not null then
+			update lobs set refcount = refcount - 1 where lob_id = old.lob;
+			delete from lobs where lob_id = old.lob and refcount = 0;
+		end if;
+	end if;
+
+	if TG_OP = ''INSERT'' or TG_OP = ''UPDATE'' then return new;
+	else return old;
+	end if;
+
+end;' language 'plpgsql';
+
+create function empty_lob() returns integer as '
+begin
+	return nextval(''lob_sequence'');
+end;' language 'plpgsql';
Index: web/openacs/www/doc/sql/member-value.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/member-value.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/member-value.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,217 @@
+--
+-- member-value.sql 
+-- 
+-- defined by philg@mit.edu on 8/18/98; 
+--  augmented for release into toolkit on February 12, 1999
+--
+-- some of the tables here will be prefixed "mv_" ("mv" = "member value")
+-- 
+
+-- if there is a monthly charge, we set different rates for different classes 
+-- of subscribers, these classes are arbitrary strings, though we suggest
+-- 'default' (the standard rate) and 'comp' (complimentary, often for 
+-- people at other publishing houses)
+
+-- if [ad_parameter "ChargeMonthlyP" "member-value"] is 0 
+-- then this table need not exist in the database
+
+create table mv_monthly_rates (
+	subscriber_class	varchar(30) not null primary key,
+	rate			float4 not null,
+	-- we use three digits because Cybercash does
+	currency	char(3) default 'USD'
+);
+
+-- one row per user
+
+create table users_payment (
+	user_id		integer not null unique references users,
+	-- this might be NULL for systems in which monthly billing
+	-- is disabled, or maybe not (perhaps we'll use this to give
+	-- people across-the-board discounts)
+	subscriber_class	varchar(30) references mv_monthly_rates,
+	name_on_card		varchar(100),
+	-- only really useful for US cardholders, but maybe useful in 
+	-- long run too
+	card_zip		varchar(20),
+	card_number		varchar(20),
+	-- store this in CyberCash format, e.g., "08/99"
+	card_exp		varchar(10)
+);
+
+-- we use this to collect up user charges
+
+create sequence users_order_id_sequence;
+
+-- you can't type this table into SQL*Plus 8.0.5 interactively; you 
+-- have to make sure that you're loading this file or this table
+-- via sqlplus / < member-value.sql 
+
+create table users_orders (
+        -- Goes into table at confirmation time:
+	order_id	integer primary key,
+	user_id		integer not null references users,
+	confirmed_date	datetime,
+	order_state	varchar(50) not null,
+	price_charged	money,
+	currency	char(3) default 'USD',
+	-- Goes into table at authorization time (columns named
+	-- cc_* refer to output from CyberCash):
+	authorized_date	datetime,
+	cc_auth_status	varchar(100),
+	cc_auth_txn_id	varchar(100),
+	cc_auth_errloc	varchar(100),
+	cc_auth_errmsg	varchar(200),
+	cc_auth_aux_msg	varchar(200),
+	cc_auth_auth_code	varchar(100),
+	cc_auth_action_code	char(3),
+	cc_auth_avs_code	varchar(3),
+	-- processor-specific and not obviously useful for cybercash
+	-- perhaps useful when looking at statements from 
+	-- merchant's bank 
+	cc_auth_ref_code	varchar(100),
+	-- Goes into table after querying for "settled" transaction type:
+	cc_sett_date	datetime,
+	cc_sett_status	varchar(100),
+	cc_sett_txn_id	varchar(100),
+	cc_sett_auth_code	varchar(100),
+	cc_sett_batch_id	varchar(100),
+	cc_sett_action_code	char(3),
+	cc_sett_avs_code	varchar(3),
+	cc_sett_ref_code	varchar(100),
+	-- Goes into table at return time (i.e. when we use
+	-- the API message "return" to mark the orders for return).
+	-- tried_to_return_date exists in case CyberCash doesn't
+	-- respond to our return attempt (in which case we can
+	-- retry later).  
+	-- Important note: "return" has no implicit connection with 
+	-- the product being received back (that would recorded in
+	-- the received_back_date column). 
+	tried_to_return_date  datetime,
+	return_date	datetime,
+	refunded_amount		money,
+	cc_retn_status	varchar(100),
+	cc_retn_txn_id	varchar(100),
+	cc_retn_errloc	varchar(100),
+	cc_retn_errmsg	varchar(200),
+	cc_retn_aux_msg	varchar(200),
+	cc_retn_auth_code	varchar(100),
+	cc_retn_action_code	char(3),
+	cc_retn_avs_code	varchar(3),
+	cc_retn_ref_code	varchar(100),
+	-- Goes into table after querying for "setlret" transaction type
+	-- (for returns that have been settled):
+	-- NOTE: I'm assuming that CyberCash is automatically settling
+	-- orders of type "markret" as it is orders of type "marked", since
+	-- we are in auto settle mode.  We will find out shortly.
+	cc_sret_date	datetime,
+	cc_sret_status	varchar(100),
+	cc_sret_txn_id	varchar(100),
+	cc_sret_auth_code	varchar(100),
+	cc_sret_batch_id	varchar(100),
+	cc_sret_action_code	char(3),
+	cc_sret_avs_code	varchar(3),
+	cc_sret_ref_code	varchar(100),
+	-- Goes into table when voiding a "marked" transaction
+	-- The CyberCash manual states that all of the standard
+	-- output fields are returned, although I've only witnessed
+	-- aux-msg, Mstatus, MErrMsg, and MErrLoc
+	tried_to_void_marked_date  datetime,
+	void_marked_date	datetime,
+	cc_vdmk_status	varchar(100),
+	cc_vdmk_txn_id	varchar(100),
+	cc_vdmk_errloc	varchar(100),
+	cc_vdmk_errmsg	varchar(200),
+	cc_vdmk_aux_msg	varchar(200),
+	cc_vdmk_auth_code	varchar(100),
+	cc_vdmk_action_code	char(3),
+	cc_vdmk_avs_code	varchar(3),
+	cc_vdmk_ref_code	varchar(100),
+	-- Goes into table when voiding a "markret" transaction
+	tried_to_void_markret_date  datetime,
+	void_markret_date	datetime,
+	cc_vdrn_status	varchar(100),
+	cc_vdrn_txn_id	varchar(100),
+	cc_vdrn_errloc	varchar(100),
+	cc_vdrn_errmsg	varchar(200),
+	cc_vdrn_aux_msg	varchar(200),
+	cc_vdrn_auth_code	varchar(100),
+	cc_vdrn_action_code	char(3),
+	cc_vdrn_avs_code	varchar(3),
+	cc_vdrn_ref_code	varchar(100),
+	-- did the consumer initiate a dispute from his end?
+        disputed_p              char(1) check (disputed_p in ('t','f')),
+        -- date on which we discovered the dispute
+        dispute_discovery_date  datetime,
+        -- if the consumer's bank got his money back from us forcibly
+        charged_back_p          char(1) check (charged_back_p in ('t','f')),
+	comments	varchar(4000)
+); 
+
+-- transaction charges
+
+-- charge_type will generally be one of the column names from
+-- member-values parameters with the "Rate" chopped off, e.g., "ClassifiedAd"
+-- for posting an ad, and then we change the style to our 
+-- standard DB key (lowercase words, underscores), e.g., "classified_ad"
+
+-- for the standard monthly subscription charge (if any), the 
+-- charge_type will be "monthly"
+
+-- charge_key will vary depending on charge_type; for something
+-- like a classified ad, it would be the classified_ad_id (an integer)
+-- for a bboard posting it would be the msg_id (char(6)).
+
+-- the amount is theoretically derivable from the charge_type but we
+-- keep it here because (1) rates might change over time, (2) the admins
+-- might decide to charge someone a non-standard rate
+
+create table users_charges (
+	user_id		integer not null references users,
+	-- if a human being decided to charge this person
+	admin_id	integer references users,
+	charge_type	varchar(30) not null,	
+	charge_key	varchar(100),
+	amount		money not null,
+	currency	char(3) default 'USD',
+	entry_date	datetime not null,
+	charge_comment	varchar(4000),
+	-- if we're trying to bill this out, order_id will be non-null
+	order_id	integer references users_orders
+);
+
+create index users_charges_by_user on users_charges(user_id);
+
+-- billing them all out every month (or whatever)
+
+-- we write a row in this table whenever the billing proc was
+-- completely successful (i.e., billed everyone who needed to be
+-- billed).  That way we know we don't have to sweep for 
+-- users who need to be billed
+
+-- we generate sweep_id with select max+1 rather than an Oracle
+-- sequence because we want them guaranteed sequential
+
+create table mv_billing_sweeps (
+	sweep_id	integer primary key,
+	start_time	datetime,
+	success_time	datetime,
+	n_orders	integer	
+);
+
+-- to bill correctly, we often need to query for charges that
+-- accumulated until the end of the last month, so we use < 1st of
+-- this month at midnight
+
+create function mv_first_of_month()
+returns datetime
+as '
+declare
+ current_year varchar(30);
+ current_month varchar(30);
+begin
+  current_year := to_char(current_timestamp,''YYYY'');
+  current_month := to_char(current_timestamp,''MM'');
+  return to_date(current_year || ''-'' || current_month || ''-01 00:00:00'',''YYYY-MM-DD HH24:MI:SS'');
+end mv_first_of_month;
+' language 'plpgsql';
Index: web/openacs/www/doc/sql/modules.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/modules.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/modules.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,141 @@
+-- File:     /doc/sql/modules.sql
+-- Date:     12/22/1999
+-- Contact:  tarik@arsdigita.com
+-- Purpose:  this file contains table, which contain data about the 
+--           ACS modules
+
+-- this table stores information about the acs modules (news, bboard, ...)
+create table acs_modules (
+	module_key		varchar(30) primary key,
+	pretty_name		varchar(200) not null,
+	-- this is the directory where module public files are stored. 
+	-- for the news module public_directory would be /news
+	public_directory	varchar(200),
+	-- this is the directory where module admin files are stored
+	-- for the news module admin_directory would be /admin/news
+	admin_directory		varchar(200),
+	-- this is the directory where system admin files are stored 
+	-- notice that this is not always same as the admin_directory
+	-- e.g. ticket module has admin directory /ticket/admin and
+	-- site admin directory /admin/ticket
+	site_wide_admin_directory	varchar(200),
+	-- if module_type=system, this module has all: public, admin and site_wide admin pages (e.g. faq, news)
+	-- notice that often admin and site_wide admin directory are merged together
+	-- if module_type=admin, this is admin module and has no public pages (e.g. display, content_sections)
+	-- notice that modules of this type have no public pages
+	-- if module_type=site_wide_admin, this is module for site wide administration of another module (e.g. news_admin, bboard_admin)
+	-- notice that having admin module for another module allows us to assign administration of modules to user groups
+	-- in this case public_directory will correspond to the directory where files for site wide administration of that
+	-- module are stored and admin_directory and site_wide_admin_directory are irrelevant 
+	module_type                    varchar(20) not null check(module_type in ('system', 'admin', 'site_wide_admin')),
+	-- does module support scoping
+	supports_scoping_p	char(1) default 'f' check(supports_scoping_p in ('t','f')),
+	-- this is short description describing what module is doing	
+	description		varchar(4000),
+	-- this is url of the html file containing module documentation
+	documentation_url	varchar(200),
+	-- this is url of the file containing date model of the module
+	data_model_url		varchar(200)
+);
+
+insert into acs_modules
+(module_key, pretty_name, public_directory, admin_directory, site_wide_admin_directory, module_type, supports_scoping_p, documentation_url, data_model_url, description)
+values
+('news', 'News', '/news', '/news/admin', '/admin/news', 'system', 't', '/doc/news.html', '/doc/sql/news.sql', 'A news item is something that is interesting for awhile and then should disappear into the archives without further administrator intervention. We want a news article to serve as the focus of user comments. You could use the /bboard system to accomplish the same function. If you did, you''d get the advantages of file attachments, group-based administration, etc. But we think that news truly is different from discussion. We want to present it by date, not by topic. The publisher probably wants to be very selective about what gets posted (as news if not as comments on news). So it gets a separate module.');
+
+insert into acs_modules
+(module_key, pretty_name, admin_directory, module_type, supports_scoping_p, data_model_url)
+values
+('content-sections', 'Content Sections', '/admin/content-sections', 'admin', 't', '/doc/sql/community-core.sql');
+
+insert into acs_modules
+(module_key, pretty_name, public_directory, admin_directory, module_type, supports_scoping_p, data_model_url)
+values
+('custom-sections', 'Custom Sections', '/custom-sections', '/admin/custom-sections', 'system', 't', '/doc/sql/community-core.sql');
+
+insert into acs_modules 
+(module_key, pretty_name, public_directory, admin_directory, site_wide_admin_directory, module_type, supports_scoping_p, 
+ documentation_url, data_model_url, description)
+values
+('address-book', 'Address Book', '/address-book', '/address-book', '/admin/address-book','system', 't', '/doc/address-book.html', '/doc/address-book.sql', 'This is a really simple address book which also does birthday reminders.');
+
+insert into acs_modules
+(module_key, pretty_name, public_directory, admin_directory, module_type, supports_scoping_p, 
+ documentation_url, data_model_url, description)
+values
+('display', 'Display', '/display', '/admin/display', 'admin', 't', 
+ '/doc/display.html', '/doc/sql/display.sql', 'Use this module if you want to give your pages easily changable display using cascaded style sheets and uploading logos.');
+
+insert into acs_modules
+(module_key, pretty_name, public_directory, module_type, supports_scoping_p)
+values
+('news_administration', 'News Administration', '/admin/news', 'site_wide_admin', 'f');
+
+insert into acs_modules
+(module_key, pretty_name, public_directory, admin_directory, site_wide_admin_directory, module_type, supports_scoping_p, documentation_url, data_model_url, description)
+values
+('faq', 'Frequently Asked Questions', '/faq', '/faq/admin', '/admin/faq', 'system', 't', '/doc/faq.html', '/doc/sql/faq.sql', 'Frequently Asked Questions');
+
+insert into acs_modules
+(module_key, pretty_name, public_directory, admin_directory, site_wide_admin_directory, module_type, supports_scoping_p, documentation_url, data_model_url, description)	
+values	
+('general-comments', 'General Comments', '/general-comments', '/general-comments/admin', '/admin/general-comments', 'admin', 't', '/doc/general-comments.html', '/doc/sql/general-comments.sql', 'General Comments Module');
+
+insert into acs_modules
+(module_key, pretty_name, public_directory, admin_directory, site_wide_admin_directory, module_type, supports_scoping_p, documentation_url, data_model_url, description)	
+values	
+('download', 'Download', '/download', '/download/admin', '/admin/download', 'system', 't', '/doc/download.html', '/doc/sql/download.sql', 'Download Module');
+
+insert into acs_modules
+(module_key, pretty_name, public_directory, admin_directory, site_wide_admin_directory, module_type, supports_scoping_p, documentation_url, data_model_url, description)
+values
+('calendar', 'Calendar', '/calendar', '/calendar/admin', '/admin/calendar', 'system', 't', '/doc/calendar.html', '/doc/sql/calendar.sql', 'A site like photo.net might want to offer a calendar of upcoming events. This has nothing to do with displaying things in a wall-calendar style format, as provided by the calendar widget. In fact, a calendar of upcoming events is usually better presented as a list. ');
+
+
+insert into acs_modules
+(module_key, pretty_name, public_directory, admin_directory, site_wide_admin_directory, module_type, supports_scoping_p, documentation_url, data_model_url, description)
+values
+('chat', 'Chat', '/chat', '/chat/admin', '/admin/chat', 'system', 't', '/doc/chat.html', '/doc/sql/chat.sql', 'Why is a chat server useful? As traditionally conceived, it isnt. The Internet is good at coordinating people who are separated in space and time. If a bunch of folks could all
+agree to meet at a specific time, the telephone would probably be a better way to support their interaction.');
+
+
+commit;
+
+create function section_type_from_module_key(varchar)
+returns varchar as '
+DECLARE
+	v_module_key alias for $1;
+	v_module_type acs_modules.module_type%TYPE;
+BEGIN
+	select module_type into v_module_type
+	from acs_modules
+	where module_key=v_module_key;
+
+	if v_module_type=''system'' then
+	    return ''system'';
+	elsif v_module_type=''admin'' then
+	    return ''admin'';
+	else
+	    return ''system'';
+	end if;
+END;
+' language 'plpgsql';
+
+create function pretty_name_from_module_key (varchar)
+returns varchar as '
+DECLARE
+	v_module_key alias for $1;
+	v_pretty_name acs_modules.pretty_name%TYPE;
+BEGIN
+	select pretty_name into v_pretty_name
+	from acs_modules
+	where module_key=v_module_key;
+
+	return v_pretty_name;
+END;
+' language 'plpgsql';
+
+
+
+
+
Index: web/openacs/www/doc/sql/neighbor.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/neighbor.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/neighbor.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,127 @@
+--
+-- data model for photo.net Neighbor to Neighbor system
+-- 
+-- philg@mit.edu (Philip Greenspun)
+-- created December 22, 1997 
+--  (adapted from older Illustra-based system)
+-- teadams@mit.edu (Tracy Adams) and philg@mit.edu
+-- ported to the commuity system in December 1998
+--
+-- philg hates to say this, but this system was never elegant to begin'
+-- with and now it is really growing hair
+
+-- the original idea was to have several sites running on the same db server
+-- (so there was a DOMAIN column).  Then each site would have several 
+-- neighbor services, e.g., my personal site could have a "photographic" 
+-- category and a "Web servers" category.  Within each category there would
+-- be subcategories, e.g., "Camera Shops" for "photographic".
+
+-- like all comprehensive ambitious systems designed and operated by
+-- stupid people, neighbor to neighbor never really blossomed.  I ended up 
+-- using it at http://photo.net/photo/ with a hardwired domain and a hardwired
+-- primary category.  I don't want to break links from all over the 
+-- Internet so I can't really change this now.  Thus there will have to 
+-- be a default primary_category in the ad.ini file.
+
+-- one good new thing about this port to the ACS: users can comment on
+-- neighbor to neighbor postings
+
+create sequence neighbor_sequence;
+
+-- set scan off
+
+-- now we can have an & in a comment and SQL*Plus won't get all hot
+-- and bothered
+
+create sequence n_to_n_primary_category_id_seq;
+
+create table n_to_n_primary_categories (
+	category_id		integer not null primary key,
+	primary_category	varchar(100),
+	top_title		varchar(100),
+	top_blurb		varchar(4000),
+	primary_maintainer_id	integer not null references users(user_id),
+	-- "open", "closed", "wait", just like in ad.ini
+	approval_policy		varchar(100),
+	-- how much interface to devote to regional options, 
+	-- e.g., "new postings by region"
+	regional_p		char(1) default 'f' check(regional_p in ('t','f')),
+	-- we can do interesting user interface widgets with
+	-- "country", "us_state", and "us_county"
+	region_type		varchar(100),
+	-- e.g., "merchant" for photo.net
+	noun_for_about		varchar(100),
+	-- a chunk of HTML to go in a table
+	decorative_photo	varchar(400),
+	-- what to say to people who are contributing a new posting
+	pre_post_blurb		varchar(4000),
+	-- should this category be shown to users
+	active_p		char(1) default 't' check(active_p in ('t','f'))
+);
+
+
+-- information that varies per subcategory, e.g., an addition
+-- photo or a regional_p that overrides the primary cat's
+
+-- oftentimes the publisher has static content to wish he or she 
+-- would point readers, e.g., "if primary_category = 'photographic' and 
+-- subcategory_1 = 'Processing Laboratories' then point readers to 
+-- http://photo.net/photo/labs.html; this goes into publisher_hint
+
+create sequence n_to_n_subcategory_id_seq;
+
+create table n_to_n_subcategories (
+	subcategory_id		integer not null primary key,
+	category_id		integer not null references n_to_n_primary_categories,
+	subcategory_1		varchar(100),
+	subcategory_2		varchar(100),
+	publisher_hint		varchar(4000),
+	regional_p		char(1) default 'f' check(regional_p in ('t','f')),
+	-- we can do interesting user interface widgets with
+	-- "country", "us_state", and "us_county"
+	region_type		varchar(100),
+	-- an extra photo to go at the top of the listings
+	decorative_photo	varchar(400)
+);
+
+create table neighbor_to_neighbor (
+	neighbor_to_neighbor_id	integer primary key,
+	poster_user_id		integer not null references users(user_id),
+	posted			datetime not null,
+	creation_ip_address	varchar(50) not null,
+	expires			datetime,	-- could be NULL
+	category_id		integer not null references n_to_n_primary_categories,
+	subcategory_id		integer not null references n_to_n_subcategories,
+	region			varchar(100),	-- state, for example
+	about			varchar(200),	-- merchant name
+	title			varchar(200) not null,
+	body			varchar(4000) not null,
+	html_p			char(1) default 'f' check(html_p in ('t','f')),
+	approved_p	char(1) default 'f' check(approved_p in ('t','f'))
+);
+
+-- should be a concatenated index for a real installation with
+-- multiple domains
+
+create index neighbor_main_index on neighbor_to_neighbor ( category_id, subcategory_id );
+
+create index neighbor_subcat_index on neighbor_to_neighbor ( subcategory_id );
+
+create index neighbor_by_user on neighbor_to_neighbor ( poster_user_id );
+
+
+-- audit table (we hold deletions, big changes, here)
+
+create table neighbor_to_neighbor_audit (
+	neighbor_to_neighbor_id	integer not null, -- no longer primary key (can have multiple entries)
+	audit_entry_time	datetime,
+	poster_user_id	        integer references users(user_id),
+	posted			datetime,
+	category_id		integer,
+	subcategory_id		integer,
+	about			varchar(200),
+	title			varchar(200),
+	body			varchar(4000),
+	html_p			char(1)
+);
+
Index: web/openacs/www/doc/sql/new-ticket.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/new-ticket.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/new-ticket.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,708 @@
+-- In the true Arsdigita spirit,AAAAAAA
+-- the ticket tracker contains parts
+-- of code by Eve, Jin, Ben, and Tracy!
+
+-- but this latest release is maintained by Henry Minsky (hqm@arsdigita.com)
+-- (from ACS 2.0, July 1999)
+
+-- massively changed and ported to PGSQL by Ben Adida (ben@openforce.net)
+
+-- Create an admin group for BITS
+select administration_group_add ('BITS Administration', 'bits', 'bits', '', 'f', '/team'); 
+
+-- create a group type for Teams
+insert into user_group_types 
+(group_type, pretty_name, pretty_plural, approval_policy, group_module_administration)
+values
+('team', 'Team', 'Teams', 'closed', 'full');
+
+
+-- first thing is first(we need to create ticket_issues before we reference it)  -js
+
+create sequence ticket_project_id_sequence;
+
+create table ticket_projects (
+        project_id      integer not null primary key,
+        parent_project_id       integer references ticket_projects,
+        title           varchar(100),
+        -- person who request the project and will be the owner
+        customer_id     integer not null references users,
+        start_date      datetime,
+        end_date        datetime,
+        -- person who gets defaultly assigned to new tickets in the project     
+        default_assignee integer references users
+);
+
+create index ticket_proj_parent_indx on ticket_projects(parent_project_id);
+
+create view open_ticket_projects as select * from ticket_projects where end_date is null;
+
+create table ticket_priorities (
+        priority                integer not null primary key,
+        name                    varchar(20)
+);
+
+insert into ticket_priorities values (3, 'low');
+insert into ticket_priorities values (2, 'medium');
+insert into ticket_priorities values (1, 'high');
+
+create sequence ticket_issue_id_sequence;
+
+create table ticket_issues (
+        msg_id                  integer not null primary key,
+        project_id              integer not null references ticket_projects,
+        user_id                 integer references users,
+        group_id                integer references user_groups,
+        root_project_id         integer references ticket_projects,
+        release_id              integer,
+        fixed_release_id        integer,
+        posting_time            datetime not null,
+        modification_time       datetime,
+        ticket_type             varchar(100),
+        one_line                varchar(700),
+        message                 varchar(6000),
+        indexed_stuff           varchar(6000),
+        close_date              datetime,
+        closed_by               integer references users,
+        fix_date                datetime,
+        fixed_by                integer references users,
+        -- When it is important for it to be finished.
+        deadline                datetime,
+        -- Status: open, development, fixed waiting approval, closed 
+        status                  varchar(100),
+        priority                integer references ticket_priorities,
+        severity                varchar(100),
+        -- A NEW FIELD for LEVEL of PRIVACY of issues
+        privacy                 integer,
+        -- who was responsible for creating this message
+        source                  varchar(100),
+        -- user name who last modified 
+        last_modified_by        integer references users,
+        -- When was the last "nag" notification sent 
+        last_notification       datetime,
+        -- Ticket author's contact info
+        contact_name            varchar(200),
+        contact_email           varchar(200),
+        contact_info1           varchar(700),
+        contact_info2           varchar(700),
+        -- product-specific fields
+        -- data1                        varchar(700),
+        -- data2                        varchar(700),
+        -- data3                        varchar(700),
+        -- data4                        varchar(700),
+        -- data5                        varchar(700),
+        -- is this ticket visible to customers
+        public_p                char(1) default 't' check(public_p in ('t','f')),
+        -- if notify_p is 't', member of that project will receive notification email
+        notify_p                char(1) default 't' check(notify_p in ('t','f'))
+);
+
+
+create view ticket_defects as select * from ticket_issues where ticket_type='Defect';
+create view ticket_enhancements as select * from ticket_issues where ticket_type='Enhancement Request';
+create view ticket_issues_issues as select * from ticket_issues where ticket_type='Issue';
+
+
+create sequence ticket_field_id_sequence start 1;
+
+create table ticket_projects_fields (
+       project_id		    integer not null,
+       field_id			    integer not null,
+       primary key(project_id, field_id),
+       field_name		    varchar(200) not null,
+       field_pretty_name	    varchar(200) not null,
+       view_in_list		    char(1) check (view_in_list in ('t','f')),
+       -- potential vals, separated by vertical bars
+       field_vals		    varchar(4000),
+       field_type		    varchar(100) not null
+);
+
+create unique index ticket_project_field_name_indx on ticket_projects_fields(project_id, field_name);
+
+-- We do things this way because creating a new table
+-- for every project seems pretty bad, and not that useful
+create table ticket_projects_field_vals (
+       project_id			integer not null,
+       field_id				integer not null,
+       foreign key (project_id, field_id) references ticket_projects_fields,
+       issue_id				  integer not null references ticket_issues,
+       primary key (project_id, field_id, issue_id),
+       field_val			  varchar(200)
+);
+
+create index ticket_proj_fval_issue_id on ticket_projects_field_vals(issue_id);
+
+create table ticket_project_teams (
+       project_id	integer not null primary key references ticket_projects,
+       team_id		integer not null references user_groups
+);
+
+--
+-- releases
+create table ticket_project_releases (
+       project_id	integer not null,
+       release_id	integer not null,
+       release		varchar(100) not null,
+       creation_date	datetime,
+       release_date	datetime,
+       build_file	varchar(200),
+       primary key (project_id, release_id)
+);
+
+create sequence release_id_sequence;
+
+-- a trigger to make sure that we always have releases at the top level
+create function trig_ticket_release_edit() returns opaque
+as '
+DECLARE
+BEGIN
+	NEW.project_id:= project_root_project_id(NEW.project_id);
+	return NEW;
+END;
+' language 'plpgsql';
+
+create trigger ticket_release_edit
+before insert or update on ticket_project_releases
+for each row
+execute procedure trig_ticket_release_edit();
+
+-- A table to assign people to projects
+
+create sequence ticket_assignment_id_sequence;
+
+create table ticket_assignments (
+	project_id	integer references ticket_projects,
+	user_id	 	integer references users,
+	rate		integer, -- e.g. 125
+	purpose		varchar(4000), -- e.g. "HTML, Java, etc..."
+	-- we add this active flag in case someone gets taken off the
+	-- project.
+	active_p	char(1) check (active_p in ('t','f')),
+	admin_p		char(1) default 'f' check (admin_p in ('t','f')),
+	primary key (project_id, user_id)
+);
+
+
+create table ticket_issue_user_interest_map (
+       msg_id			    integer not null references ticket_issues,
+       user_id			    integer not null references users,
+       primary key (msg_id, user_id),
+       start_date		datetime
+); 
+       
+       
+
+-- quick postgres hack
+create function parent_project_p(integer,integer)
+returns char as '
+DECLARE
+BEGIN
+	if $1 = $2
+	THEN return ''t'';
+	else return ''f'';
+	END IF;
+END;
+' language 'plpgsql';
+
+-- pl/sql for parent projects
+-- create function parent_project_p(integer, integer)
+-- returns char as '
+-- DECLARE
+-- 	v_parent_project_id alias for $1;
+-- 	v_project_id alias for $2;
+-- 	count_check integer;
+-- BEGIN
+-- 	select count(*) into count_check from ticket_projects where project_id=v_project_id connect by parent_project_id= prior project_id start with project_id=v_parent_project_id;
+
+-- 	if (count_check > 0)
+-- 	then return ''t'';
+-- 	else return ''f'';
+-- 	end if;
+-- END;
+-- ' language 'plpgsql';
+	
+-- pl/sql hack
+create function project_root_project_id(integer)
+returns integer as '
+DECLARE
+	p_id alias for $1;
+BEGIN
+	return p_id;
+END;
+' language 'plpgsql';
+
+-- pl/sql to get root project_id
+-- create function project_root_project_id(integer)
+-- returns integer as '
+-- DECLARE
+-- 	v_project_id alias for $1;
+-- 	return_project_id integer;
+-- BEGIN
+-- 	select project_id into return_project_id from ticket_projects where parent_project_id is NULL connect by project_id=prior parent_project_id start with project_id=v_project_id;
+-- 	return return_project_id;
+-- END;
+-- ' language 'plpgsql';
+
+-- pl/sql to get the full name
+-- quick postgres hack
+create function project_full_name(integer)
+returns varchar as '
+DECLARE
+	v_project_id alias for $1;
+	v_name varchar(200);
+BEGIN
+	select title into v_name from ticket_projects where project_id= v_project_id;
+	return(v_name);
+END;
+' language 'plpgsql';
+
+-- create function project_full_name(integer)
+-- returns char as '
+-- DECLARE
+-- 	v_project_id alias for $1;
+-- 	full_name varchar(4000);
+--       CURSOR select_parents is 
+-- 	     select title from ticket_projects 
+-- 	     connect by project_id= prior parent_project_id 
+-- 	     start with project_id= v_project_id;
+-- BEGIN
+-- 	full_name:= NULL;
+-- 	FOR one_record IN select_parents LOOP
+-- 	    IF full_name IS NOT NULL
+-- 	    THEN full_name:= '' // '' || full_name;
+-- 	    ELSE full_name:= '''';
+-- 	    END IF;
+
+-- 	    full_name:= one_record.title || full_name;
+-- 	END LOOP;
+
+-- 	return(full_name);
+-- END;
+-- ' language 'plpgsql';
+	
+
+-- pl/sql for permissions
+create function ticket_user_can_see_project_p(integer, integer)
+returns char as '
+DECLARE
+	v_user_id alias for $1;
+	v_project_id alias for $2;
+	count_check integer;
+BEGIN
+	if ad_admin_group_member_p(''bits'','''', v_user_id) = ''t''
+	then return ''t'';
+	end if;
+
+	select count(*) into count_check from user_group_map where user_id= v_user_id and group_id in (select team_id from ticket_project_teams where parent_project_p(project_id,v_project_id)=''t'');
+
+	IF count_check > 0
+	THEN return(''t'');
+	ELSE return(''f'');
+	END IF;
+END;
+' language 'plpgsql';
+	
+create function ticket_user_can_edit_project_p(integer, integer)
+returns char as '
+DECLARE
+	v_user_id alias for $1;
+	v_project_id alias for $2;
+	count_check integer;
+BEGIN
+	if ad_admin_group_member_p(''bits'','''', v_user_id) = ''t''
+	then return ''t'';
+	end if;
+
+	select count(*) into count_check from user_group_map where user_id= v_user_id and (role=''internal'' or role=''administrator'') and group_id in (select team_id from ticket_project_teams where parent_project_p(project_id,v_project_id)=''t'');
+
+	IF count_check > 0
+	THEN return(''t'');
+	ELSE return(''f'');
+	END IF;
+END;
+' language 'plpgsql';
+
+-- drop function ticket_user_can_close_issue_p(integer, integer);
+
+create function ticket_user_can_close_issue_p(integer, integer)
+returns char as '
+DECLARE
+	v_user_id alias for $1;
+	v_msg_id alias for $2;
+	msg_closeable record;
+BEGIN
+	if ad_admin_group_member_p(''bits'','''', v_user_id) = ''t''
+	then return ''t'';
+	end if;
+
+	select into msg_closeable
+               count(ti.msg_id) as chk,
+               max(ti.project_id) as pid 
+          from ticket_issues ti
+         where ti.user_id = v_user_id 
+           and ti.msg_id  = v_msg_id
+           and 0 < (select count(*) 
+                      from user_group_map 
+                     where user_id= v_user_id 
+                       and (role=''internal'' or role=''administrator'') 
+                       and group_id = (select tm.team_id 
+                                from ticket_project_teams tm
+                               where parent_project_p(tm.project_id,ti.project_id)=''t''));
+
+	IF msg_closeable.chk > 0
+	THEN return(''t'');
+	ELSE return(''f'');
+	END IF;
+END;
+' language 'plpgsql';	
+
+-------------- From The Community System ---------------
+-- table state, country_codes, users
+--------------------------------------------------------
+
+
+-- to make sure we keep the root_project_id synchronized
+create function trig_ticket_issue_modify() returns opaque
+AS '
+DECLARE
+BEGIN
+	NEW.root_project_id:= project_root_project_id(NEW.project_id);
+
+	IF NEW.status != ''fixed waiting approval'' AND NEW.status != ''closed''
+	THEN
+		NEW.fix_date:= NULL;
+		NEW.fixed_by:= NULL;
+	END IF;
+
+	IF TG_OP = ''INSERT''
+	THEN RETURN NEW;
+	END IF;
+
+	IF NEW.status = ''fixed waiting approval'' AND OLD.status != NEW.status
+	THEN
+		NEW.fix_date:= sysdate();
+		NEW.fixed_by:= NEW.last_modified_by;
+	END IF;
+
+	RETURN NEW;
+END;
+' language 'plpgsql';
+
+create trigger ticket_issue_modify
+before insert or update on ticket_issues
+for each row
+execute procedure trig_ticket_issue_modify();
+
+
+-- Reference the release table
+-- alter table ticket_issues add 
+-- (constraint R_issue_release foreign key (root_project_id, release_id)
+-- references ticket_project_releases);
+
+-- alter table ticket_issues add 
+-- (constraint R_issue_fixed_release foreign key (root_project_id, fixed_release_id)
+-- references ticket_project_releases);
+
+create function trig_ticket_modification_time() returns opaque
+as '
+DECLARE
+BEGIN
+	NEW.modification_time:= sysdate();
+	return NEW;
+END;
+' language 'plpgsql';
+
+create trigger ticket_modification_time
+before insert or update on ticket_issues
+for each row
+execute procedure trig_ticket_modification_time();
+
+-- the ticket_changes table can reference ticket_issues
+-- but only in Oracle 8.1.5 or newer; Oracle 8.0.5 gets 
+-- bent out of shape with a mutating trigger from
+-- ticket_activity_logger
+
+--- keep track of changes to a ticket
+create table ticket_changes (
+  msg_id    integer not null, -- references ticket_issues
+  who 	    varchar(256),
+  what      varchar(256),
+  old_value varchar(256),
+  new_value varchar(256),
+  modification_date  datetime
+);
+
+create index ticket_changes_by_msg_id on ticket_changes(msg_id);
+
+-- track changes to tickets
+create function trig_ticket_activity_logger() returns opaque
+as '
+DECLARE
+BEGIN
+  if (OLD.project_id != NEW.project_id) then
+   insert into ticket_changes (msg_id, who, what, old_value, new_value, modification_date)
+   values
+   (NEW.msg_id, NEW.last_modified_by, ''Project ID'', OLD.project_id, NEW.project_id, sysdate());
+  end if;
+
+  if (OLD.ticket_type != NEW.ticket_type) then
+   insert into ticket_changes (msg_id, who, what, old_value, new_value, modification_date)
+   values
+   (NEW.msg_id, NEW.last_modified_by, ''Ticket Type'', OLD.ticket_type, NEW.ticket_type, sysdate());
+  end if;
+
+  if (OLD.one_line != NEW.one_line) then
+   insert into ticket_changes (msg_id, who,what, old_value, new_value, modification_date) 
+   values
+   (NEW.msg_id, NEW.last_modified_by, ''Synopsis'', OLD.one_line, NEW.one_line, sysdate());
+  end if;
+
+  if (OLD.deadline != NEW.deadline) then
+   insert into ticket_changes (msg_id, who,what, old_value, new_value, modification_date) 
+   values
+   (NEW.msg_id, NEW.last_modified_by, ''Deadline'', OLD.deadline, NEW.deadline, sysdate());
+  end if;
+
+  if (OLD.status != NEW.status) then
+   insert into ticket_changes (msg_id, who,what, old_value, new_value, modification_date) 
+   values
+   (NEW.msg_id, NEW.last_modified_by, ''Status'', OLD.status, NEW.status, sysdate());
+  end if;
+
+  if (OLD.priority != NEW.priority) then
+   insert into ticket_changes (msg_id, who,what, old_value, new_value, modification_date) 
+   values
+   (NEW.msg_id, NEW.last_modified_by, ''Priority'', OLD.priority, NEW.priority, sysdate());
+  end if;
+
+  if (OLD.severity != NEW.severity) then
+   insert into ticket_changes (msg_id, who,what, old_value, new_value, modification_date) 
+   values
+   (NEW.msg_id, NEW.last_modified_by, ''Severity'', OLD.severity, NEW.severity, sysdate());
+  end if;
+
+  RETURN NEW;
+end;
+' language 'plpgsql';
+
+create trigger ticket_activity_logger
+before update on ticket_issues
+for each row
+execute procedure trig_ticket_activity_logger();
+
+
+-- attachments
+create table ticket_issues_attachments (
+       msg_id			       integer not null references ticket_issues,
+       attachment_name		       varchar(200),
+       filename			       varchar(200)
+);
+
+create index ticket_attachments_by_msg_id on ticket_issues_attachments(msg_id);
+
+
+-- For notification purposes
+insert into user_notification_classes (notification_class_id, notification_class, item_url, class_url, item_pretty_name, item_varname)
+values (nextval('notification_class_id_sequence'), 'Ticket Tracker', '/new-ticket/issue-view.tcl', '/new-ticket', 'Issue ID', 'msg_id');
+
+create function ticket_notification_class_id() returns integer
+as '
+DECLARE
+BEGIN
+	return notification_class_id from user_notification_classes where notification_class=''Ticket Tracker'';
+END;
+' language 'plpgsql';
+
+create function trig_ticket_change_insert() returns opaque
+as '
+DECLARE
+	v_check integer;
+BEGIN
+	v_check:= user_add_notification(ticket_notification_class_id(), NEW.msg_id, NEW.who || '' changed '' || NEW.what || '' from '' || NEW.old_value || '' to '' || NEW.new_value);
+
+	RETURN NEW;
+END;
+' language 'plpgsql';
+
+create trigger ticket_change_insert
+before insert on ticket_changes
+for each row
+execute procedure trig_ticket_change_insert();
+	
+
+--- a table to assign users to  issues
+--- the selection list for this will be the
+--- ticket_assignments table constratained by the appropriate project
+
+
+create table ticket_issue_assignments (
+	msg_id		integer not NULL references ticket_issues,
+	user_id		integer not null references users,
+	purpose		varchar(4000), -- e.g. "HTML, Java, etc..."
+	-- we add this active flag in case someone gets taken off the
+	-- issue.
+	active_p	char(1) check (active_p in ('t','f')),
+	unique (msg_id, user_id)
+);
+
+create function ticket_n_assigned(integer)
+returns integer as '
+DECLARE
+	v_msg_id alias for $1;
+	v_count integer;
+BEGIN
+	select count(*) into v_count from ticket_issue_assignments where msg_id= v_msg_id;
+	return v_count;
+END;
+' language 'plpgsql';
+	
+-- cross reference table mapping issues to other issues
+create table ticket_xrefs (
+       from_ticket integer not null references ticket_issues(msg_id),
+       to_ticket integer not null references ticket_issues(msg_id),
+       primary key (from_ticket,to_ticket)
+);
+
+
+create sequence ticket_response_id_sequence;
+
+create table ticket_issue_responses (
+        response_id             integer not null primary key,
+        response_to             integer not null references ticket_issues,
+        user_id                 integer references users,
+        posting_time            datetime not null,
+	public_p		char(1) default('t') check(public_p in ('t','f')),
+        message                 varchar(6000)
+);
+
+
+-- update the ticket's modification timestamp
+create function trig_ticket_response_mod_time() returns opaque
+as '
+DECLARE
+BEGIN
+	update ticket_issues set modification_time=sysdate() 
+	where msg_id= NEW.response_to;
+	return NEW;
+END;
+' language 'plpgsql';
+
+create trigger ticket_response_mod_time
+before insert or update on ticket_issue_responses
+for each row
+execute procedure trig_ticket_response_mod_time();
+
+
+create table ticket_issue_notifications (
+        msg_id                  integer not null references ticket_issues,
+        user_id                 integer not null references users,
+        primary key (msg_id, user_id)
+);
+
+
+-- called by /tcl/email-queue.tcl 
+-- and /ticket/issue-response-2.tcl 
+create function ticket_update_for_response(integer) returns integer
+AS '
+DECLARE
+	v_response_id alias for $1;
+	v_response_row ticket_issue_responses%ROWTYPE;
+BEGIN
+ select ticket_issue_responses.* into v_response_row
+   from ticket_issue_responses
+   where response_id = v_response_id;
+
+ if v_response_row.message is not null then 
+   update ticket_issues 
+   set
+   indexed_stuff= indexed_stuff || v_response_row.message
+   where msg_id= v_response_row.response_to;
+
+   return user_add_notification(ticket_notification_class_id(), v_response_row.response_to, ''New Response to issue:\n'' || v_response_row.message);
+ end if;
+
+ return 0;
+END;
+' language 'plpgsql';
+
+
+create function ticket_one_if_high_priority(integer, varchar)
+returns integer as '
+DECLARE
+	priority alias for $1;
+	status alias for $2;
+BEGIN
+	IF ((priority = 1) AND (status <> ''closed'') AND (status <> ''deferred'')) THEN
+	return 1;
+	ELSE
+	return 0;
+	END IF;
+END;
+' language 'plpgsql';
+
+create function ticket_one_if_blocker(varchar,varchar)
+returns integer as '
+DECLARE
+	severity alias for $1;
+	status alias for $2;
+BEGIN
+  IF ((severity = ''blocker'') AND (status <> ''closed'') AND (status <> ''deferred'')) THEN
+    return 1;
+  ELSE 
+    return 0;
+  END IF;
+END;
+' language 'plpgsql';
+
+
+create function ticket_assignees (integer)
+returns varchar as '
+DECLARE
+	v_msg_id alias for $1;
+	v_one_user users%ROWTYPE;
+	v_assignees varchar(1000);
+BEGIN
+	v_assignees:= '''';
+	FOR v_one_user IN select * from users where user_id in (select user_id from ticket_issue_assignments where msg_id= v_msg_id) LOOP
+		IF v_assignees != ''''
+		THEN v_assignees:= v_assignees || '', '';
+		END IF;
+		v_assignees := v_assignees || v_one_user.first_names || '' '' || substr(v_one_user.last_name, 1,1);
+	END LOOP;
+
+	return v_assignees;
+END;
+' language 'plpgsql';
+
+
+create function ticket_release_name(integer)
+returns varchar as '
+DECLARE
+	v_release_id alias for $1;
+	v_release varchar(100);
+BEGIN
+	select release into v_release from ticket_project_releases
+	where release_id= v_release_id;
+
+	return v_release;
+END;
+' language 'plpgsql';
+
+
+-- for custom field fetching
+create function ticket_fetch_custom_field (integer, integer, varchar)
+returns char
+as '
+DECLARE
+	v_msg_id alias for $1;
+	v_project_id alias for $2;
+	v_field alias for $3;
+	v_field_id integer;
+BEGIN
+	select field_id into v_field_id from ticket_projects_fields where project_id= v_project_id and field_name= v_field;
+
+	if v_field_id is null then return null; end if;
+
+	return field_val from ticket_projects_field_vals where field_id = v_field_id and project_id=v_project_id and issue_id= v_msg_id;
+END;
+' language 'plpgsql';
Index: web/openacs/www/doc/sql/news.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/news.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/news.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,61 @@
+--
+-- /www/doc/sql/news.sql
+-- 
+-- Supports a system for showing announcements to users
+--
+-- Author: Jesse Koontz, jkoontz@arsdigita.com March 8, 2000
+--         Philip Greenspun, philg@mit.edu
+--
+
+create sequence newsgroup_id_sequence start 4;
+
+create table newsgroups (
+	newsgroup_id	integer primary key,
+	-- if scope=all_users, this is the news for all newsgroups
+	-- is scope=registered_users, this is the news for all registered users
+	-- if scope=public, this is the news for the main newsgroup
+	-- if scope=group, this is news associated with a group
+	scope           varchar(20) not null,
+	group_id	integer references user_groups,
+	check ((scope='group' and group_id is not null) or
+	(scope='public') or
+	(scope='all_users') or
+	(scope='registered_users'))
+);
+
+create sequence news_item_id_sequence start 100000;
+
+create table news_items (
+	news_item_id            integer primary key,
+	newsgroup_id            integer references newsgroups not null,
+	title			varchar(100) not null,
+	body			varchar(4000) not null,
+	-- is the body in HTML or plain text (the default)
+	html_p			char(1) default 'f' check(html_p in ('t','f')),
+	approval_state          varchar(15) default 'unexamined' check(approval_state in ('unexamined','approved', 'disapproved')),
+	approval_date           date,
+	approval_user           integer references users(user_id),
+	approval_ip_address     varchar(50),
+	release_date		datetime not null,
+	expiration_date		datetime not null,
+	creation_date		datetime default current_timestamp not null,
+	creation_user		integer not null references users(user_id),
+	creation_ip_address	varchar(50) not null
+
+	-- Postgres not ready for this! (BMA)
+);
+
+--DRB: But they need to go up there because V7.0 WILL take them
+-- and won't take the add constraint, though that will be in V7.1
+-- it's a long wait.
+
+create index newsgroup_group_idx on newsgroups ( group_id );
+create index news_items_idx on news_items ( newsgroup_id );
+
+-- Create the default newsgroups
+
+insert into newsgroups (newsgroup_id, scope) values (1, 'all_users');
+insert into newsgroups (newsgroup_id, scope) values (2, 'registered_users');
+insert into newsgroups (newsgroup_id, scope) values (3, 'public');
+
+-- Create permissions for default newsgroups
Index: web/openacs/www/doc/sql/notification.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/notification.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/notification.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,122 @@
+
+--
+-- A data model for keeping notification information for users
+-- 
+-- ben@mit.edu
+--
+
+create sequence notification_class_id_sequence;
+
+create table user_notification_classes (
+       notification_class_id	       integer not null primary key,
+       notification_class	       varchar(200),
+       -- The item URL is the URL to get to one item that someone was notified about
+       item_url			       varchar(300),
+       class_url		       varchar(300),
+       -- The varname is the variable name to replace "item_id"
+       item_pretty_name		       varchar(100),
+       item_varname		       varchar(100)
+);
+
+create table user_notification_prefs (
+       user_id			     integer not null references users,
+       notification_class_id	     integer not null references user_notification_classes,
+       primary key (user_id, notification_class_id),
+       notification_pref	     varchar(50) default 'none' check (notification_pref in ('none','instant', 'hourly','daily','weekly'))
+);
+
+create table user_notifications (
+       user_id			     integer not null,
+       notification_class_id	     integer not null,
+       primary key (user_id, notification_class_id),
+       foreign key (user_id, notification_class_id) references user_notification_prefs,
+       notification_content	     lztext
+);
+
+create function trig_notif_addrow() returns opaque
+as '
+DECLARE
+	v_check integer;
+BEGIN
+	select count(*) into v_check
+	from user_notification_prefs where user_id= NEW.user_id and notification_class_id= NEW.notification_class_id;
+
+	IF v_check = 0
+	THEN
+	insert into user_notification_prefs (user_id, notification_class_id, notification_pref)
+	values (NEW.user_id, NEW.notification_class_id, ''instant'');
+	END IF;
+
+	RETURN NEW;
+END;
+' language 'plpgsql';
+
+create trigger notif_add_row
+before insert on user_notifications
+for each row
+execute procedure trig_notif_addrow();
+
+create table user_notification_interest_map (
+       user_id				    integer not null references users,
+       notification_class_id		    integer not null references user_notification_classes,
+       item_id				    integer not null,
+       primary key (user_id, notification_class_id, item_id)
+);
+       
+
+create function trig_notification_add_row() returns opaque
+as '
+DECLARE
+	v_check integer;
+BEGIN
+	select count(*) into v_check
+	from user_notifications where user_id= NEW.user_id and notification_class_id= NEW.notification_class_id;
+
+	IF v_check = 0
+	THEN
+	insert into user_notifications (user_id, notification_class_id, notification_content)
+	values (NEW.user_id, NEW.notification_class_id, '''');
+	END IF;
+
+	RETURN NEW;
+END;
+' language 'plpgsql';
+
+create trigger notification_add_row
+before insert on user_notification_interest_map
+for each row
+execute procedure trig_notification_add_row();
+
+-- PL/SQL to do notifications
+create function user_add_notification(integer, integer, varchar) returns integer
+as '
+DECLARE
+	v_class_id alias for $1;
+	v_item_id alias for $2;
+	v_message alias for $3;
+	v_one_class	user_notification_classes%ROWTYPE;
+BEGIN
+	select * into v_one_class from user_notification_classes where notification_class_id= v_class_id;
+
+	update user_notifications set
+	notification_content= coalesce(notification_content,'''') || to_char(sysdate(),''YYYY-MM-DD'') || '' '' || 
+			      v_one_class.item_pretty_name || '' #'' || v_item_id ||
+			      '': '' || v_message || ''\n'' || v_one_class.item_url || ''?'' || 
+			      v_one_class.item_varname || ''='' || v_item_id || ''\n\n''
+	where user_id in (select user_id from user_notification_interest_map where notification_class_id= v_class_id and item_id= v_item_id)
+	and notification_class_id= v_class_id;
+
+	return 1;
+END;
+' language 'plpgsql';
+
+
+create function notification_get_pref(integer,integer) returns char
+as '
+DECLARE
+	v_user_id alias for $1;
+	v_class_id alias for $2;
+BEGIN
+	return notification_pref from user_notification_prefs where user_id= v_user_id and notification_class_id= v_class_id;
+END;
+' language 'plpgsql';
Index: web/openacs/www/doc/sql/partner.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/partner.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/partner.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,119 @@
+-- we need a table that will let us dynamically create cobranded pages.
+-- we do this by stuffing some appearance variables in a table and 
+-- create some header and footer functions in the tcl directory for 
+-- every partner. The partner_id fields in the gs_partner table 
+-- will all be automatically registered to set a cookie and redirect
+-- to the appropriate page
+
+-- To kill ad-partner
+-- drop view ad_partner_header_procs;
+-- drop view ad_partner_footer_procs;
+-- drop table ad_partner_procs;
+-- drop table ad_partner_url;
+-- drop table ad_partner;
+
+create sequence ad_partner_partner_id_seq start 1000;
+create table ad_partner (
+        partner_id		integer primary key,
+	-- a human understandable name of the partner
+	partner_name		varchar(250) not null,
+	-- the cookie that will get set in the  ad_partner cookie (e.g. aol)
+	partner_cookie		varchar(50) not null,
+        -- now we start defining stuff that we use in the templates 
+        -- font face and color for standard text
+	default_font_face	varchar(100),
+	default_font_color	varchar(20),
+        -- font face and color for titles
+	title_font_face		varchar(100),
+	title_font_color	varchar(20),
+	group_id		integer references user_groups
+);
+create index ad_partner_partner_cookie on ad_partner(partner_cookie);
+create index ad_partner_partner_name_idx on ad_partner(partner_name);
+
+create sequence ad_partner_url_url_id_seq start 1000;
+create table ad_partner_url (
+	url_id			integer primary key,
+	partner_id  		integer not null references ad_partner(partner_id),
+	-- the url stub of the section(directory) we are cobranding (e.g. /search)
+        -- use a leading slash but don't include the partner_cookie
+	url_stub		varchar(50) not null,
+	unique(partner_id,url_stub)
+);
+create index ad_partner_url_url_stub on ad_partner_url(url_stub);
+
+create sequence ad_partner_procs_proc_id_seq start 1000;
+-- each partner can have multiple procs registered for displaying section
+-- headers. These will be called in order based on call_number
+create table ad_partner_procs (
+	proc_id			integer primary key,
+	url_id 			integer not null references ad_partner_url(url_id),
+	proc_name		varchar(100) not null,
+	call_number		integer not null,
+	proc_type		char(15) not null check(proc_type in ('header','footer')),
+	unique(call_number,url_id,proc_type)
+);
+
+create view ad_partner_header_procs as
+select u.partner_id, u.url_id, p.proc_name, p.call_number, p.proc_id
+from ad_partner_procs p, ad_partner_url u
+where proc_type='header'
+and p.url_id=u.url_id;
+-- order by call_number;
+
+create view ad_partner_footer_procs as
+select u.partner_id, u.url_id, p.proc_name, p.call_number, p.proc_id
+from ad_partner_procs p, ad_partner_url u
+where proc_type='footer'
+and p.url_id=u.url_id;
+-- order by call_number;
+
+
+create table ad_partner_group_map (
+	partner_id  	integer references ad_partner not null,
+	group_id	integer references user_groups not null,
+	primary key (group_id, partner_id)
+);
+
+
+create function ad_partner_get_cookie (integer)
+returns varchar
+as '
+DECLARE
+v_group_id as alias for $1;
+BEGIN
+  return  partner_cookie 
+    from ad_partner_group_map, ad_partner
+   where ad_partner_group_map.partner_id = ad_partner.partner_id
+     and ad_partner_group_map.group_id = v_group_id;
+END;' language 'plpgsql';
+
+-- Initial Population for ArsDigita (cookie = ad)
+
+insert into ad_partner 
+(partner_id,partner_cookie, partner_name, default_font_face, default_font_color, title_font_face, title_font_color)
+values
+('1',
+ 'ad',
+ 'ArsDigita',
+ '',
+ '',
+ '',
+ ''
+);
+
+insert into ad_partner_url 
+(url_id, partner_id, url_stub)
+values 
+(1,1,'/');
+
+insert into ad_partner_procs 
+(proc_id, url_id, proc_name, call_number, proc_type)
+values 
+(1,1,'ad_partner_generic_header',1,'header');
+
+insert into ad_partner_procs 
+(proc_id, url_id, proc_name, call_number, proc_type)
+values 
+(4,1,'ad_partner_generic_footer',1,'footer');
+
Index: web/openacs/www/doc/sql/patches.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/patches.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/patches.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,14 @@
+--
+-- patches.sql
+--
+
+-- created by philg@mit.edu on September 2, 1999
+
+-- this file holds ALTER TABLE statements and maybe INSERTs or
+-- UPDATES necessary to apply to the production system when releasing new
+-- software
+
+-- the file should be chronological and after every application to the
+-- production system, insert a line with the following form:
+
+-- *** above the line applied on 1999-MM-DD *** -- 
Index: web/openacs/www/doc/sql/photodb.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/photodb.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/photodb.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,265 @@
+--
+-- photodb.sql 
+-- 
+-- jkoontz@arsdigita.com
+--
+
+--
+-- data model for photo management service
+-- written by Group 4, 6.916, 3/4/99
+-- edited Oct, 1999
+
+-- create an administration group for photo database administration
+
+begin
+   administration_group_add ('Photo Database Staff', 'photodb', NULL, 'f', '/photodb/admin/');
+end;
+/
+
+create sequence ph_folder_type_id_sequence start with 1 increment by 1;
+
+create table ph_folder_types (
+	folder_type_id	integer not null primary key,
+	folder_type	varchar(50)
+);
+
+insert into ph_folder_types (folder_type_id, folder_type) values (
+	ph_folder_type_id_sequence.nextval,'Roll');
+insert into ph_folder_types (folder_type_id, folder_type) values (
+	ph_folder_type_id_sequence.nextval,'PhotoCD');
+insert into ph_folder_types (folder_type_id, folder_type) values (
+	ph_folder_type_id_sequence.nextval,'Folder');
+
+create sequence ph_folder_id_sequence start with 1 increment by 1;
+
+create table ph_folders (
+	folder_id	integer not null primary key,
+	user_id		integer not null references users,
+	title		varchar(50),
+	photo_cd_id	integer,
+	folder_type_id	integer not null references ph_folder_types
+);
+
+create index ph_folders_by_user_id_idx on ph_folders(user_id);
+
+-- The following table is for user preferences
+
+create table ph_user_preferences (
+	user_id			integer not null references users(user_id),
+	images_public_p		char(1) check (images_public_p in ('t','f')),
+	photos_sort_by		varchar(100),
+	default_image_size	char(1) check (default_image_size in ('s','m','l')),
+	prefer_text_p		char(1) check (prefer_text_p in ('t','f'))
+);
+
+create index ph_user_prefs_by_user_idx on ph_user_preferences(user_id);
+
+create sequence ph_camera_model_id_sequence start with 1 increment by 1;
+
+create table ph_camera_models (
+	camera_model_id		integer not null primary key,
+	manufacturer		varchar(50),	-- e.g., 'Nikon'
+	model			varchar(50),	-- e.g., '8008/F801'
+	variation		varchar(50),	-- e.g., 'titanium'
+	last_modified_date 	date,
+	last_modifying_user	references users,
+	modified_ip_address	varchar2(20)
+);
+
+-- to facilitate captioning photos with tech info, we keep track of which
+-- cameras each photographer owns (if they want to give us this info)
+
+create sequence ph_camera_id_sequence start with 1 increment by 1;
+
+create table ph_cameras (
+	camera_id		integer not null primary key,
+	user_id			integer not null references users,
+	camera_model_id		integer references ph_camera_models,
+	pretty_name		varchar(50),	-- e.g., "EOS-5 with date back"
+	serial_number		varchar(50),
+	date_purchased		date,
+	creation_date		date,	
+	-- the numbers below are just up until
+	-- date_surveyed; they are not kept up to date automagically
+	-- as users enter rolls
+	n_failures		integer,
+	n_rolls_exposed		integer,	-- "n sheets" for a view camera
+	purchased_new_p		char(1) check (purchased_new_p in ('t', 'f'))
+);
+
+create index ph_cameras_by_user_idx on ph_cameras(user_id);
+create index ph_cameras_by_model_idx on ph_cameras(camera_model_id);
+
+-- we go to all this trouble because we want to be able to ask "Show
+-- me all the Tri-X photos"
+
+create sequence ph_film_type_id_sequence start with 1 increment by 1;
+
+create table ph_film_types (
+	film_type_id 	integer not null primary key,
+	film_type	varchar(20)	-- e.g., e6, k14, c41-bw, bw
+);
+
+insert into ph_film_types (film_type_id, film_type) values (ph_film_type_id_sequence.nextval, 'Digital');
+
+insert into ph_film_types (film_type_id, film_type) values (ph_film_type_id_sequence.nextval, 'Black/White');
+
+insert into ph_film_types (film_type_id, film_type) values (ph_film_type_id_sequence.nextval, 'C41 (Color Negative)');
+
+insert into ph_film_types (film_type_id, film_type) values (ph_film_type_id_sequence.nextval, 'E6 (Color Slide)');
+
+insert into ph_film_types (film_type_id, film_type) values (ph_film_type_id_sequence.nextval, 'K14 (Kodachrome)');
+
+insert into ph_film_types (film_type_id, film_type) values (ph_film_type_id_sequence.nextval, 'Infrared');
+
+create sequence ph_film_id_sequence start with 1 increment by 1;
+
+create table ph_films (
+	film_id		integer not null primary key,
+	film_type_id	integer not null references ph_film_types,
+	manufacturer	varchar(50),	-- e.g., Kodak, Fuji, Ilford
+	full_name	varchar(50),	-- e.g., Ektachrome Professional Plus
+	abbrev		varchar(10),	-- e.g., EPP, RDP, VPS
+	last_modified_date 	date,
+	last_modifying_user	references users,
+	modified_ip_address	varchar2(20)
+);
+
+insert into ph_films (film_id, film_type_id, manufacturer, full_name, abbrev) 
+	values
+	(ph_film_id_sequence.nextval, 1, '(none)', 'Digital', 'Digital');
+
+create index ph_films_by_type_idx on ph_films(film_type_id);
+
+-- The following table is for custom fields tracking
+-- It allows us to do smart searching on fields, figure out
+-- which fields are active, and which are "deleted" (since
+-- we can't REALLY delete fields from Oracle).
+-- (Now that we are use 8i we can. 8/11/1999)
+
+create sequence ph_custom_field_id_sequence start with 1 increment by 1;
+
+create table ph_custom_photo_fields (
+        custom_field_id         integer not null primary key,
+        user_id                 integer not null references users(user_id),
+        field_name              varchar(200),
+        field_pretty_name       varchar(200),
+        field_type              varchar(200),
+        date_added              date,
+        field_active_p          char(1) check (field_active_p in ('t','f')),
+	field_comment		varchar2(4000)
+);
+
+create index ph_custom_fields_by_user_idx on ph_custom_photo_fields(user_id);
+create index ph_custom_fields_by_active_idx on ph_custom_photo_fields(field_active_p);
+
+-- A table ph_user_(user_id)_custom_info will be created to store custom photo
+-- info.
+-- It's columns include photo_id, data field's (being add on)
+
+create sequence ph_photo_id_sequence start with 1 increment by 1;
+
+create table ph_photos (
+	photo_id	integer not null primary key,
+	user_id		integer not null references users,
+	folder_id	integer not null references ph_folders,
+	-- Can this photo be seen in the community
+	photo_public_p	char(1) check (photo_public_p in ('t','f')),
+	camera_id	integer not null references ph_cameras,
+	film_id		integer references ph_films,
+	file_extension	varchar(10), -- eg .jpg .gif
+	size_available_sm 	char(1) check (size_available_sm in ('t','f')),
+	size_available_md	char(1) check (size_available_md in ('t','f')),
+	size_available_lg	char(1) check (size_available_lg in ('t','f')),
+	-- These are the sizes of the thumbnails. It allows the client
+	-- to display the whole page even if the thumbnails are not yet loaded
+	sm_width	integer,
+	sm_height	integer,
+	md_width	integer,
+	md_height	integer,
+	lg_width	integer,
+	lg_height	integer,
+	photo_cd_id	integer,
+	orphan_key	varchar(50),
+	exposure_date	date,
+	caption		varchar(4000),
+	tech_details	varchar(4000),	-- f-stop, shutter speed, film used
+	-- If a recognizable person is in the photo, is the
+	-- model_release info available
+	model_release_p char(1) check (model_release_p in ('t','f')),
+	-- rights grants -- we do this in six separate columns so that we can 
+	-- use an Oracle bitmap index to make queries faster
+	rights_personal_web_p	char(1) check (rights_personal_web_p in ('t','f')),
+	rights_personal_print_p	char(1) check (rights_personal_print_p in ('t','f')),
+	rights_nonprofit_web_p	char(1) check (rights_nonprofit_web_p in ('t','f')),
+	rights_nonprofit_print_p	char(1) check (rights_nonprofit_print_p in ('t','f')),
+	rights_comm_web_p	char(1) check (rights_comm_web_p in ('t','f')),
+	rights_comm_print_p	char(1) check (rights_comm_print_p in ('t','f')),
+ 	-- copyright_statement is an HTML fragment,  if they want to 
+	-- fundamentally refer people to their Web server, they can have
+	-- a simple sentence with a hyperlink
+	copyright_statement	varchar(4000),
+	file_size		number,
+	creation_date		date,
+	publisher_favorite_p char(1) default 'f' check (publisher_favorite_p in ('t','f'))
+);
+
+create index ph_photos_by_user_idx on ph_photos(user_id);
+create index ph_photos_by_folder_idx on ph_photos(folder_id);
+create index ph_photos_by_public_p_idx on ph_photos(photo_public_p);
+create index ph_photos_by_m_release_idx on ph_photos(model_release_p);
+create index ph_photos_by_r_pers_web_idx on ph_photos(rights_personal_web_p);
+create index ph_photos_by_r_pers_print_idx on ph_photos(rights_personal_print_p);
+create index ph_photos_by_r_nonp_web_idx on ph_photos(rights_nonprofit_web_p);
+create index ph_photos_by_r_nonp_print_idx on ph_photos(rights_nonprofit_print_p);
+create index ph_photos_by_r_comm_web_idx on ph_photos(rights_comm_web_p);
+create index ph_photos_by_r_comm_print_idx on ph_photos(rights_comm_print_p);
+
+
+create sequence ph_presentation_id_sequence start with 1 increment by 1;
+
+create table ph_presentations (
+	presentation_id integer not null primary key,
+	user_id		integer not null references users,
+	title		varchar(200),
+	public_p	char(1) check (public_p in ('t','f')),
+        beginning_note  varchar(4000),
+        ending_note     varchar(4000),
+        use_html_code_p char(1) check (use_html_code_p in ('t','f')),
+        html_code       clob,
+	creation_date	date
+);
+
+create index ph_presentation_by_user_idx on ph_presentations(user_id);
+
+create table ph_presentation_photo_map (
+	presentation_id integer not null references ph_presentations,
+	photo_id 	integer not null references ph_photos,
+        annotation	varchar(4000),
+        photo_order     integer
+);
+
+create index ph_prest_photo_by_present_idx on ph_presentation_photo_map(presentation_id);
+create index ph_prest_photo_by_photo_idx on ph_presentation_photo_map(photo_id);
+
+create table ph_presentation_user_map (
+	presentation_id integer not null references ph_presentations,
+	user_id		integer not null references users
+);
+
+create index ph_prest_user_by_present_idx on ph_presentation_user_map(presentation_id);
+create index ph_prest_user_by_user_idx on ph_presentation_user_map(user_id);
+
+-- Links to the General Comments module
+
+insert into table_acs_properties
+(table_name, section_name, user_url_stub, admin_url_stub)
+select 'ph_photos', 'photodb photos', '/photodb/photo.tcl?photo_id=','/photodb/admin/photo.tcl?photo_id='
+from dual 
+where 0 = (select count(*) from table_acs_properties where table_name = 'ph_photos');
+
+insert into table_acs_properties
+(table_name, section_name, user_url_stub, admin_url_stub)
+select 'ph_presentations', 'photodb presentations', '/photodb/presentation.tcl?presentation_id=','/photodb/admin/presentation.tcl?presentation_id='
+from dual
+where 0 = (select count(*) from table_acs_properties where table_name = 'ph_presentations');
Index: web/openacs/www/doc/sql/pl-sql.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/pl-sql.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/pl-sql.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,152 @@
+--
+-- pl-sql.sql 
+-- 
+-- created by philg on 11/18/98
+--
+-- useful pl/sql utility procedures 
+--
+
+-- MSB for some reason the top if isn't working
+--     doesn't look like it is needed by this 
+--     function, so i commented it out
+create function logical_negation(varchar)
+returns varchar as '
+declare
+	true_or_false alias for $1;
+BEGIN
+--  IF true_or_false is null THEN
+--    return null;
+  IF true_or_false = ''f'' THEN
+    return ''t'';   
+  ELSE 
+    return ''f'';   
+  END IF;
+END;
+' language 'plpgsql';
+
+-- these come originally from the classified ads system
+-- DRB: Ben's attempt didn't work, but this does.  Weird.
+
+create function expired_p(datetime) returns boolean as '
+declare
+	expiration_date alias for $1;
+begin
+  return expiration_date <= current_timestamp;
+end;
+' language 'plpgsql';
+
+-- DRB: These exploit the fact that subtracting dates returns
+-- the number of days separating them as an integer.  Subtracting
+-- datetimes returns a reltime of the form "'n days'", not what
+-- the calling scripts expect.
+
+create function days_since_posted(date) returns integer as '
+declare
+  posted alias for $1;
+begin
+	return current_timestamp::date - posted;
+end;
+' language 'plpgsql';
+
+
+-- useful for ecommerce and other situations where you want to
+-- know whether something happened within last N days (assumes query_date
+-- is in the past)
+
+create function one_if_within_n_days (datetime, integer)
+returns integer as '
+declare
+	query_date alias for $1;
+	n_days alias for $2;
+begin
+  IF current_timestamp::date - query_date::date <= n_days THEN 
+    return 1;
+  ELSE
+    return 0;
+  END IF;
+end;
+' language 'plpgsql';
+
+--drop function pseudo_contains( varchar, varchar) ;
+create function pseudo_contains (varchar, varchar)
+returns integer as '
+declare
+	indexed_stuff alias for $1;
+	space_sep_list_untrimmed alias for $2;
+  space_sep_list        text;
+  upper_indexed_stuff   text;
+  -- if you call this var START you get hosed royally
+  first_space           integer;
+  score                 integer;
+BEGIN 
+  space_sep_list := upper(ltrim(rtrim(space_sep_list_untrimmed)));
+  upper_indexed_stuff := upper(indexed_stuff);
+  score := 0;
+  IF space_sep_list is null or indexed_stuff is null THEN
+    RETURN score;  
+  END IF;
+  LOOP
+   first_space := position('' '' in space_sep_list);
+   IF first_space = 0 THEN
+     -- one token or maybe end of list
+     IF position(space_sep_list in upper_indexed_stuff) <> 0 THEN
+        RETURN score+10;
+     END IF;
+     RETURN score;
+   ELSE
+   -- first_space <> 0
+     IF position(substring(space_sep_list from 1 to first_space-1) in upper_indexed_stuff) <> 0 THEN
+        score := score + 10;
+     END IF;
+   END IF;
+    space_sep_list := substring(space_sep_list from first_space+1);
+  END LOOP;  
+END;
+' language 'plpgsql';
+
+--drop function add_months (datetime, integer) ;
+create function add_months (datetime, integer) returns datetime as '
+declare
+  base alias for $1;
+  months alias for $2;
+begin
+  return base + (months || ''months'')::timespan;
+end;
+' language 'plpgsql';
+
+-- Returns the interval in fractional days between two dates.
+-- Useful especially in ecommerce where there are checks for
+-- 0.95 parts of a day, etc.
+
+create function date_interval(datetime, datetime)
+ returns float as '
+declare
+  later alias for $1;
+  earlier alias for $2;
+begin
+  return
+    (date_part(''epoch'', later)-date_part(''epoch'', earlier))/86400.0;
+end;
+' language 'plpgsql';
+
+-- useful for working around outer joins involving users email.
+-- ticket tracker needed it, decided to make it non-specific as
+-- other modules probably do, too.
+
+create function email_or_null(integer) returns varchar
+as '
+begin
+  return email from users where user_id = $1;
+end;
+' language 'plpgsql';
+
+create function to_date_or_null(datetime) returns date
+as '
+begin
+  if $1 is null
+  then return null;
+  end if;
+  return $1::date;
+end;
+' language 'plpgsql';
+
Index: web/openacs/www/doc/sql/poll.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/poll.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/poll.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,69 @@
+--
+-- polls.sql - user opinion surveys
+--
+-- markd@arsdigita.com 9/7/99
+-- based on stuff by Ben Adida
+--
+-- (added integrity constraints, 9/27/99)
+--
+
+create sequence poll_id_sequence;
+
+create table polls (
+	poll_id		integer not null primary key,
+	name		varchar(100) not null,
+	description	varchar(4000),
+	-- make the dates NULL for an on-going poll
+	start_date	datetime,
+	end_date	datetime,
+	require_registration_p	char(1) default 'f' check (require_registration_p in ('t','f'))
+);
+
+
+create sequence poll_choice_id_sequence;
+
+
+create table poll_choices (
+	choice_id	integer not null primary key,
+	poll_id		integer not null references polls,
+	label		varchar(500) not null,
+	sort_order	integer
+);
+
+create index poll_choices_index on poll_choices(poll_id, choice_id);
+
+
+
+create table poll_user_choices (
+	poll_id		integer references polls not null,
+	choice_id	integer references poll_choices not null,
+	-- user_id can be NULL if we're not requiring registration
+	user_id		integer references users,
+	ip_address	varchar(50) not null,
+	choice_date	datetime not null
+);
+
+create index poll_user_choice_index on poll_user_choices(poll_id);
+create index poll_user_choices_choice_index on poll_user_choices(choice_id);
+
+
+create function poll_is_active_p(datetime, datetime) returns char as '
+declare
+	start_date alias for $1;
+	end_date alias for $2;
+	result_p char;
+begin
+	result_p:= ''t'';
+
+	if (trunc(start_date) > trunc(current_timestamp))
+	then result_p:=''f'';
+	end if;
+
+	if (trunc(end_date) < trunc(current_timestamp))
+	then result_p:=''f'';
+	end if;
+
+	return result_p;
+end;
+' language 'plpgsql';
+
Index: web/openacs/www/doc/sql/portals.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/portals.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/portals.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,147 @@
+--
+-- portals.sql
+--
+-- by aure@arsdigita.com
+-- 
+
+-- portal_tables are sections of information that will appear as tables
+-- on the portals pages
+
+-- DRB: Modified to remove clob, which is likely to reduce the
+-- usability of this feature until the new compressed text type
+-- is available (or we figure out how to backup lobs)
+
+create sequence portal_table_id_sequence;
+
+create table portal_tables (
+	table_id		integer primary key,
+	-- table_name is varchar(4000) because it may contain ADP 
+	table_name     		varchar(4000),
+	-- adp is where the content of the table is installed
+	adp			lztext not null,
+	-- if you don't want administrators to have direct access to 
+	-- the adp, admin_url should be not null
+	admin_url		varchar(1000),
+	creation_user		integer references users(user_id) on delete cascade,
+	modified_date		datetime
+);
+
+create sequence portal_page_id_sequence;
+
+create table portal_pages (
+	page_id			integer primary key,
+	-- define ownership of the page - either as a group page, or individual's page
+	-- one of (group_id, user_id) should not be null
+	group_id		integer references user_groups on delete cascade,
+	user_id			integer references users on delete cascade,
+	-- page_name may be null, in which case we use "Page #x" instead
+        page_name		varchar(300),
+        page_number             integer
+);
+   
+create table portal_table_page_map (
+	-- page_id and table_id are mapped to one another her
+	page_id			integer references portal_pages on delete cascade,
+	table_id	   	integer references portal_tables on delete cascade,
+	-- sort_key and page_side define location of the table on the page     	 
+	-- this defines an order within this side of this page
+	sort_key  	    	integer,
+	-- side of the page the table will displayed on
+	page_side       	char(1) check (page_side in ('l','r'))
+);
+
+
+-- the audit table and trigger
+
+create sequence portal_audit_id_sequence;
+
+create table portal_tables_audit  (
+	audit_id		integer primary key,
+	table_id		integer, 
+	-- table_name is varchar(4000) because it may contain ADP 
+	table_name     		varchar(4000),
+	-- adp is where the content of the table is installed
+	adp			lztext not null,
+	-- if you don't want administrators to have direct access to 
+	-- the adp, admin_url should be not null
+	admin_url		varchar(1000),
+	modified_date           datetime,
+	creation_user		integer references users(user_id) on delete cascade,
+	audit_time		datetime
+);
+
+create function portal_tables_audit_update() returns opaque as '
+begin
+    if ( (old.table_name is not null and (new.table_name is null or old.table_name <> new.table_name))
+        or (old.admin_url is not null and (new.admin_url is null or old.admin_url <> new.admin_url))
+	or (old.modified_date is not null and (new.modified_date is null or old.modified_date <> new.modified_date))
+ )
+     then
+       insert into portal_tables_audit 
+	(audit_id, table_id, table_name, adp, admin_url, modified_date, creation_user, audit_time)
+       values
+       	(nextval(''portal_audit_id_sequence''), old.table_id, old.table_name, old.adp, old.admin_url, old.modified_date, old.creation_user,  current_timestamp);
+     end if;
+     return new;
+end;
+' language 'plpgsql';
+
+create trigger portal_tables_audit_update_trigger
+before update on portal_tables
+  for each row execute procedure portal_tables_audit_update();
+
+create function portal_tables_audit_delete() returns opaque as '
+begin
+   insert into portal_tables_audit 
+      (audit_id, table_id, table_name, adp, admin_url, modified_date, creation_user, audit_time)
+       values
+       	(nextval(''portal_audit_id_sequence''), old.table_id, old.table_name, old.adp, old.admin_url, old.modified_date, old.creation_user,  current_timestamp);
+  return old;
+end;
+' language 'plpgsql';
+
+create trigger portal_tables_audit_delete_trigger
+before delete on portal_tables
+  for each row execute procedure portal_tables_audit_delete();
+
+create function count_tables(integer) returns integer as '
+begin
+  return count(*) from portal_table_page_map where table_id = $1;
+end;' language 'plpgsql';
+
+
+-- Some nice samples by aileen@arsdigita.com
+-- DRB: These only work if you load the education module.
+
+insert into portal_tables (table_id, table_name, adp, admin_url, creation_user, modified_date) 
+values 
+(nextval('portal_table_id_sequence'), 'Stock Quotes', '<% set html [DisplayStockQuotes $db]%>
+<%=$html%>', '', 1, sysdate());
+
+insert into portal_tables (table_id, table_name, adp, admin_url,
+creation_user, modified_date) 
+values 
+(nextval('portal_table_id_sequence'),'Current Weather', '<% set html [DisplayWeather $db]%>
+<%=$html%>
+', '', 1, sysdate());
+
+insert into portal_tables (table_id, table_name, adp,
+admin_url,creation_user, modified_date) 
+values 
+(nextval('portal_table_id_sequence'),'Classes', '<% set html [GetClassHomepages $db]%>
+<%=$html%>
+', '', 1, sysdate());
+
+insert into portal_tables (table_id, table_name, adp,
+admin_url,creation_user, modified_date) 
+values 
+(nextval('portal_table_id_sequence'),'Announcements', '<% set html [GetNewsItems $db]%>
+<%=$html%>', '', 1, sysdate());
+
+insert into portal_tables (table_id, table_name, adp,
+admin_url,creation_user, modified_date) 
+values 
+(nextval('portal_table_id_sequence'),'Calendar', '<% set html [edu_calendar_for_portal $db]%>
+<%= $html%>', '', 1, sysdate());
+
+
Index: web/openacs/www/doc/sql/postgres-pgtcl.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/postgres-pgtcl.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/postgres-pgtcl.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,407 @@
+--
+-- The Postgres specific hacks for emulating oracle date/char conversion 
+-- functions.
+--
+-- Uses/requires pltcl. configure postgres using --with-tcl and copy pltcl.so 
+-- to /usr/local/pgsql/lib.
+
+create function pltcl_call_handler() returns opaque
+	as '/usr/local/pgsql/lib/pltcl.so'
+	language 'C';
+
+create trusted procedural language 'pltcl'
+	handler pltcl_call_handler
+	lancompiler 'PL/Tcl';
+
+create function trunc(datetime,varchar) returns datetime as '
+declare
+        date_in         alias for $1;
+        part            alias for $2;
+begin
+        if lower(part) = ''yyyy'' then
+           return date_trunc(''year'',date_in);
+        end if;
+        return date_trunc(part,date_in);
+end;
+' language 'plpgsql';
+
+create function trunc(timespan) returns varchar as '
+declare
+	inspan          alias for $1;
+begin
+        return date_part(''day'',inspan);
+end;
+' language 'plpgsql';
+
+create function last_day(datetime) returns datetime as '
+begin
+       return date_trunc(''month'',(date_trunc(''month'',$1) + 31)::datetime) - 1;
+end;
+' language 'plpgsql';
+
+create function calc_days(varchar) returns integer as '
+       set span $1
+
+       if { ![regexp {([0\-9]+) [0\-9][0\-9]:[0\-9][0\-9]:[0\-9][0\-9]} $span {} days] } {
+          return 0
+       }
+       
+       return $days
+' language 'pltcl';
+
+
+create function round(timespan) returns integer as '
+declare
+        delta   alias for $1;
+        invar   varchar;
+begin
+        invar := delta;
+        return calc_days(invar);
+end;
+' language 'plpgsql';
+
+create function calc_months(varchar) returns integer as '
+
+       set timespan $1
+
+       if { ![regexp {([0\-9]+) years?} $timespan {} yr] } {
+          set yr 0
+       }
+
+       if { ![regexp {([0\-9]+) mons?}  $timespan {} mn] } { 
+          set mn 0
+       }
+       
+       return [expr ($yr * 12) + $mn]
+
+' language 'pltcl';
+
+
+create function months_between(datetime, datetime) returns integer as '
+declare
+        date1   alias for $1;
+        date2   alias for $2;
+        delta   varchar;
+begin
+        delta := age(date1,date2);
+        return calc_months(delta);
+end;
+' language 'plpgsql';
+
+
+create function sign(timespan) returns integer as '
+
+       if [regexp {ago} $1 {}] {
+          return -1
+       } else {
+          return 1
+       }
+
+' language 'pltcl';
+
+create function day_of_the_year(datetime) returns varchar as '
+declare
+        the_date        alias for $1;
+        new_date        datetime;
+        delta           varchar(80);
+        pos_blank       integer;
+begin
+        if date_trunc(''day'',the_date) = date_trunc(''year'',the_date) then
+           return ''1'';
+        else
+           new_date  := date_trunc(''day'',the_date + 1);
+           delta     := new_date \- date_trunc(''year'',the_date);
+           pos_blank := position('' '' in delta);
+           return substring(delta from 0 for pos_blank);
+        end if;
+end;
+' language 'plpgsql';
+
+-- I think the julian date starts in 4713BC, but this 
+-- date gives the correct answer.  I verified it by using two seperate
+-- julian date calculators that I found by searching on the net.
+create function julian_zero_date() returns datetime as '
+begin
+	return ''4714-11-25 BC''::datetime;
+end;
+' language 'plpgsql';
+
+create function julian_date(datetime) returns varchar as '
+declare
+       indate    alias for $1;
+begin
+        return trunc(indate - julian_zero_date());
+end;
+' language 'plpgsql';
+
+
+-- drop function to_char_work(datetime,varchar,varchar,varchar,varchar);
+create function to_char_work(datetime,varchar,varchar,varchar,varchar) 
+returns varchar as '
+
+       set indate       $1
+       set pattern      [string tolower $2]
+       set day_of_year  $3
+       set julian_date  $4
+       set day_of_week  $5
+       set month        ""
+       set day          ""
+
+       # pull apart the date/time string
+       regexp {^([0\-9][0\-9]([0\-9][0\-9]))\-([0\-9][0\-9])\-([0\-9][0\-9]) ([0\-9][0\-9]):([0\-9][0\-9]):([0\-9][0\-9])} $indate full_date year part_year month day hour minute second
+       
+       # calculate the quarter
+       switch \-regexp $month {
+         "0[1-3]" { set qtr 1 }
+         "0[4-6]" { set qtr 2 }
+         "0[7-9]" { set qtr 3 }
+         "1[0-2]" { set qtr 4 }
+         default  { set qtr 0 }
+       }
+       
+       switch $month {
+         "01"    { set p_month January }
+         "02"    { set p_month February }
+         "03"    { set p_month March }
+         "04"    { set p_month April }
+         "05"    { set p_month May }
+         "06"    { set p_month June }
+         "07"    { set p_month July }
+         "08"    { set p_month August }
+         "09"    { set p_month September }
+         "10"    { set p_month October }
+         "11"    { set p_month November }
+         "12"    { set p_month December }
+         default { set p_month void }
+       }
+
+       switch $day_of_week {
+         "0"      { set p_day Sunday }
+         "1"      { set p_day Monday }
+         "2"      { set p_day Tuesday }
+         "3"      { set p_day Wednesday }
+         "4"      { set p_day Thursday }
+         "5"      { set p_day Friday }
+         "6"      { set p_day Saturday }
+         default  { set p_day void }
+       }
+
+       # check for truncated year patterns
+       if { [regsub {yyyy} $pattern $year pattern] == 0 && 
+            [regexp {yy}   $pattern] } { 
+       
+          regsub {yy} $pattern $part_year pattern
+       }
+       
+       # handle all of the standard date/time patterns
+       regsub {fmdd}     $pattern $day         pattern
+       regsub {dd}       $pattern $day         pattern
+       if { [regsub {fmday} $pattern $p_day    pattern] == 0 } {
+              regsub {d}  $pattern $day         pattern
+       }
+       regsub {j}        $pattern $julian_date pattern
+       regsub {fmmonth}  $pattern $p_month     pattern
+       regsub {mon(th)?} $pattern $month       pattern
+       regsub {mm}       $pattern $month       pattern
+       regsub {hh24}     $pattern $hour        pattern
+       regsub {mi}       $pattern $minute      pattern
+       regsub {ss}       $pattern $second      pattern
+       regsub {q}        $pattern $qtr         pattern
+
+       return $pattern
+
+' language 'pltcl';
+
+drop function to_char(datetime,char);
+create function to_char(datetime,varchar) returns varchar as '
+declare 
+        indate  alias for $1;
+        pattern alias for $2;
+        
+        doy     varchar;
+        j_date  varchar; 
+        dow     varchar;
+begin
+        j_date :=  julian_date(indate);
+        doy    :=  day_of_the_year(indate);
+        dow    :=  date_part(''dow'',indate);
+        return to_char_work(indate,pattern,doy,j_date,dow);
+end;
+' language 'plpgsql';
+
+-- special case for inserting commas into numbers (e.g. 1,239 from 1239)
+create function to_char(integer,varchar) returns varchar as '
+
+       set l  [split $1 ""]
+       set nl [list]
+       
+       # reverse the string
+       foreach c $l {
+         set nl [linsert $nl 0 $c]
+       }
+
+       # convert the string back to its original direction and insert commas
+       set l [list]
+       set i 0
+       foreach c $nl {
+         incr i
+         set l [linsert $l 0 $c]
+         if { [expr $i % 3] == 0 } {set l [linsert $l 0 ","]}
+       }
+
+       # return the new string with commas inserted
+       return [join $l ""]
+
+' language 'pltcl';
+
+create function to_date_work(varchar,varchar) returns datetime as '
+       set      date_in  $1
+       set      pattern  [string tolower $2]
+       set      month ""
+
+       if ![regexp \-indices {yyyy} $pattern year_long] {
+
+          if [regexp \-indices {yy} $pattern year_short] {
+            set year "20[string range $date_in [lindex $year_short 0] [lindex $year_short 1]]"
+          } else {
+            set year "2000"
+          }
+
+       } else {
+          set year [string range $date_in [lindex $year_long 0] [lindex $year_long 1]]
+       }
+       if [regexp \-indices {mm} $pattern month] {
+          set month [string range $date_in [lindex $month 0] [lindex $month 1]]
+       } else {
+         set month "01"
+       }
+       if [regexp \-indices {dd} $pattern day] {
+          set day [string range $date_in [lindex $day 0] [lindex $day 1]]
+       } else {
+         set day "01"
+       }
+       if [regexp \-indices {hh} $pattern hour] {
+          set hour [string range $date_in [lindex $hour 0] [lindex $hour 1]]
+       } else {
+         set hour "00"
+       }
+       if [regexp \-indices {mi} $pattern minute] {
+          set minute [string range $date_in [lindex $minute 0] [lindex $minute 1]]
+       } else {
+         set minute "00"
+       }
+       if [regexp \-indices {ss} $pattern second] {
+          set second [string range $date_in [lindex $second 0] [lindex $second 1]]
+       }  else {
+         set second "00"
+       }     
+
+       return "$year-$month-$day $hour:$minute:$second+00"
+       
+' language 'pltcl';
+
+-- drop function sanitize_date(varchar);
+create function sanitize_date(varchar) returns varchar as '
+       
+       set date_in [string tolower $1]
+       set fancy_months(january)   01
+       set fancy_months(february)  02
+       set fancy_months(march)     03
+       set fancy_months(april)     04
+       set fancy_months(may)       05
+       set fancy_months(june)      06
+       set fancy_months(july)      07
+       set fancy_months(august)    08
+       set fancy_months(september) 09
+       set fancy_months(october)   10
+       set fancy_months(november)  11
+       set fancy_months(december)  12
+
+       regexp {(january|february|march|april|may|june|july|august|september|october|november|december)} $date_in match
+
+       if [info exists match] {
+              set month $fancy_months($match)
+	      regsub $match $date_in $month date_in
+       }
+
+       return $date_in
+' language 'pltcl';
+
+
+-- drop function to_date(varchar,varchar);
+create function to_date(varchar,varchar) returns datetime as '
+declare
+       date_string      alias for $1;
+       pattern          alias for $2;
+       clean_string     varchar;
+begin
+       clean_string := sanitize_date(date_string);
+       return to_date_work(clean_string,pattern);
+end;
+' language 'plpgsql';
+
+-- drop function to_date(datetime,varhchar);
+create function to_date(datetime,varchar) returns datetime as '
+declare
+       date_string      alias for $1;
+       pattern          alias for $2;
+       clean_string     varchar;
+begin
+       clean_string := date_string;
+       return to_date_work(clean_string,pattern);
+end;
+' language 'plpgsql';
+
+create function to_date(varchar) returns datetime as '
+declare 
+        date_string     alias for $1;
+begin
+        return date_string;
+end;
+' language 'plpgsql';
+
+
+create function to_date(integer,varchar) returns datetime as '
+declare
+                jdate   alias for $1;
+                pattern alias for $2;
+begin
+                return julian_zero_date() + jdate;
+end;
+' language 'plpgsql';
+
+-- drop function delta_days(integer,varchar);
+create function delta_days(integer,varchar) returns varchar as '
+
+       set day_in  $1
+       set pattern [string toupper $2]
+
+        switch \-regexp $pattern {
+        "SUN(DAY)?"    { set the_day 0 }
+        "MON(DAY)?"    { set the_day 1 }
+        "TUES(DAY)?"   { set the_day 2 }
+        "WED(NESDAY)?" { set the_day 3 }
+        "THURS(DAY)?"  { set the_day 4 }
+        "FRI(DAY)?"    { set the_day 5 }
+        "SAT(URDAY)?"  { set the_day 6 }
+        }
+
+
+       set d_days [expr (($the_day - $day_in) + 7) % 7]
+       return "$d_days day"
+
+' language 'pltcl';
+
+
+-- drop function next_day(datetime,varchar);
+create function next_day(datetime,varchar) returns datetime as '
+declare
+       the_date      alias for $1;
+       pattern       alias for $2;
+       dow           integer;
+begin
+       dow    := date_part(''dow'',the_date);
+       return the_date + delta_days(dow,pattern)::timespan; 
+end;
+' language 'plpgsql';
+
Index: web/openacs/www/doc/sql/postgres.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/postgres.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/postgres.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,200 @@
+--
+-- The Postgres specific hacks
+--
+-- Ben Adida (ben@adida.net)
+--
+
+-- Uncomment these two lines and comment the two below if
+-- you have the RPM version of PostgreSQL
+--
+--create function plpgsql_call_handler() RETURNS opaque
+--as '/usr/lib/pgsql/plpgsql.so' language 'c';
+--
+create function plpgsql_call_handler() RETURNS opaque
+as '/usr/local/pgsql/lib/plpgsql.so' language 'c';
+
+create trusted procedural language 'plpgsql'
+HANDLER plpgsql_call_handler
+LANCOMPILER 'PL/pgSQL';
+
+-- standard sysdate call
+create function date_standardize(datetime) returns varchar as '
+declare
+	the_date alias for $1;
+begin
+	return date_part(''year'',the_date) || ''-'' || lpad(date_part(''month'',the_date),2,''0'') || ''-'' || lpad(date_part(''day'',the_date),2,''0'');
+end;
+' language 'plpgsql';
+
+-- DRB sez: ''now''::datetime gets evaluated at compile time, due to
+-- the cast, apparently.  Not what we want!  ''now'' alone, cast
+-- implicitly when the call or a return is executed, appears to work.
+-- Gaack?  Yep.
+
+create function sysdate_standard() returns varchar as '
+begin
+	return date_standardize(''now'');
+end;
+' language 'plpgsql';
+
+-- sysdate hack to make things look somewhat alike
+create function sysdate() returns datetime as '
+begin
+	return ''now'';
+end;' language 'plpgsql';
+
+-- DRB's hack for the system table 'dual' - the call to sysdate()
+-- is executed each time dual's referenced.  Using a view like this
+-- means that "select sysdate from dual" works fine.  Since a single
+-- row is always returned, you can select any expression as well
+-- and it works.
+
+create view dual as select sysdate();
+ 
+-- date trunc
+create function trunc(datetime) returns datetime as '
+declare
+	the_date alias for $1;
+begin
+	return date_trunc(''day'',the_date);
+end;
+' language 'plpgsql';
+
+create function trunc(datetime, varchar) returns datetime
+as '
+DECLARE
+	the_date alias for $1;
+	the_pattern alias for $2;
+BEGIN
+	return date_trunc(the_pattern, the_date);
+END;
+' language 'plpgsql';
+
+-- Get the last day of a month
+create function last_day(datetime) returns datetime
+as '
+DECLARE
+	the_date alias for $1;
+BEGIN
+	return date_trunc(''Month'', the_date + ''1 month''::reltime) - ''1 day''::reltime;
+END;
+' language 'plpgsql';
+
+-- Julian date
+-- create function to_date_from_julian(numeric) 
+-- returns datetime as '
+-- DECLARE
+--	the_julian alias for $1;
+-- BEGIN
+-- 	return ''0000-01-01 12:00:00''::datetime + (( the_julian - 1721058 ) || '' day'')::reltime;
+-- END;
+-- ' language 'plpgsql';
+
+-- Julian date (as modified by Michael A. Cleverly, 30 mar 2000)
+-- May need to be checked and reconciled with the above
+create function to_date_from_julian(numeric) 
+returns date as '
+DECLARE
+	the_julian alias for $1;
+BEGIN
+	return ''0000-01-01''::date + ( the_julian - 1721060 );
+END;
+' language 'plpgsql';
+
+-- sign
+-- drop function sign(float4);
+create function sign(float4) returns integer as '
+declare
+	the_number alias for $1;
+begin
+	if the_number >=0 then return 1;
+	else return -1;
+	end if;
+end;
+' language 'plpgsql';
+
+-- drop function sign(interval);
+create function sign(interval) returns integer as '
+declare
+	the_interval alias for $1;
+begin
+	if date_part(''day'',the_interval) >=0 then return 1;
+	else return -1;
+	end if;
+end;
+' language 'plpgsql';
+
+
+-- date stuff
+create function date_num_days(timespan) returns numeric as '
+DECLARE
+	the_span alias for $1;
+	num_days numeric;
+BEGIN
+	num_days:= date_part(''day'', the_span);
+	num_days:= num_days + ((date_part(''hour'', the_span)/24)::numeric);
+
+	RETURN num_days;
+END;
+' language 'plpgsql';
+
+create function timespan_days(integer) returns timespan as '
+DECLARE
+	n_days alias for $1;
+BEGIN
+	return (n_days || '' days'')::timespan;
+END;
+' language 'plpgsql';
+
+-- Mimic Oracle's negation of character-based pseudo-bools
+
+create function logical_negation(char) returns char as '
+BEGIN
+	IF ($1 = ''f'') THEN RETURN ''t'';
+	ELSE RETURN ''f'';
+    END IF;
+END;
+' language 'plpgsql';
+
+-- Negate a REAL bool, in case we get smart and use SQL92's built-in
+-- bool type, which is fully supported by PG.  Of course, we should
+-- weed out calls to this function for efficiency reasons, but this
+-- will keep things running in the interim.
+
+create function logical_negation(bool) returns bool as '
+BEGIN
+	RETURN NOT $1;
+END;
+' language 'plpgsql';
+
+
+create function round(integer) returns integer
+as '
+DECLARE
+	the_int alias for $1;
+BEGIN
+	return round(the_int,0);
+END;
+' language 'plpgsql';
+
+-- Mimic Oracle's months_between built-in
+
+create function months_between(timestamp, timestamp) returns real
+as '
+begin
+    return date_part(''year'', age($1, $2)) * 12.0 + date_part(''month'', age($1, $2)) +
+        date_part(''day'', age($1, $2)) / 31.0;
+end;' language 'plpgsql';
+
+-- Mimic Oracle's user_tab_columns table (thanks Ken Mayer!)
+
+CREATE VIEW user_tab_columns AS
+SELECT upper(c.relname) AS table_name, 
+       upper(a.attname) AS column_name,
+       CASE WHEN (t.typprtlen > 0)
+       THEN t.typprtlen
+       ELSE (a.atttypmod - 4)
+       END AS data_length
+FROM pg_class c, pg_attribute a, pg_type t
+WHERE (a.attrelid = c.oid) AND (a.atttypid = t.oid) AND (a.attnum > 0);
+
Index: web/openacs/www/doc/sql/postgres65.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/postgres65.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/postgres65.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,26 @@
+-- a hack so things don't totally break
+
+create function to_char(datetime, char) returns varchar as '
+DECLARE
+	the_date alias for $1;
+BEGIN
+	return date_part(''year'', the_date) || ''-'' || date_part(''month'', the_date) || ''-'' || date_part(''day'', the_date);
+END;
+' language 'plpgsql';
+
+create function to_char(timespan) returns varchar as '
+DECLARE
+	the_span alias for $1;
+BEGIN
+	return date_part(''epoch'',the_span);
+END;
+' language 'plpgsql';
+
+create function pow(numeric, numeric)
+returns numeric
+as '
+DECLARE
+BEGIN
+	return power( $1 , $2);
+END;
+' language 'plpgsql';
Index: web/openacs/www/doc/sql/press.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/press.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/press.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,73 @@
+-- Data model for the press module
+--
+-- Author: ron@arsdigita.com, December 1999
+--
+-- press.sql,v 3.0 2000/02/06 03:29:04 ron Exp
+
+
+--
+-- Press release templates
+--
+
+create sequence press_template_id_sequence;
+
+create table press_templates (
+	template_id		integer primary key,
+	-- we use this to select the template
+	template_name		varchar(100) not null,
+	-- the adp code fraqment
+	template_adp		varchar(4000) not null
+);
+
+-- Initialize with one site-wide Default template
+-- (if executed twice, the second execution will fail due to 
+--  primary key constraint above; we won't end up with an 
+--  extra row in the db)
+
+insert into press_templates
+(template_id, 
+ template_name,
+ template_adp)
+values
+(nextval('press_template_id_sequence'), 
+'Default',
+'<b><%=$publication_name%></b> - <%=$article_title%><br>
+ <%=$publication_date%> - "<%=$abstract%>"');
+
+create sequence press_id_sequence;
+
+create table press (
+	press_id		integer primary key,
+	-- if scope=public, this is press coverage for the whole system
+        -- if scope=group, this is press coverage for a subcommunity
+        scope			varchar(20) not null,
+	-- will be NULL if scope=public 
+	group_id		integer references user_groups,
+	-- determines how the release is formatted
+	template_id		integer references press_templates,
+	-- if true, keep the release active after it would normally expire. 
+	important_p		char(1) default 'f' check (important_p in ('t','f')),
+	-- the name of the publication, e.g. New York Times
+	publication_name	varchar(100) not null,
+	-- the home page of the publication, e.g., http://www.nytimes.com
+	publication_link	varchar(200),
+	-- we use this for sorting
+	publication_date	datetime not null,
+	-- this will override publication_date where we need to say "Oct-Nov 1998 issue"
+	-- but will typically be NULL
+	publication_date_desc	varchar(100),
+	-- might be null if the entire publication is about the site or company
+	article_title		varchar(100),
+	-- if the article is Web-available
+	article_link		varchar(200),
+	-- optional page reference, e.g. page 100
+	article_pages		varchar(100),
+	-- quote from or summary of article
+	abstract		varchar(4000),
+	-- is the abstract in HTML or plain text (the default)
+	html_p			char(1) default 'f' check (html_p in ('t','f')),
+	creation_date		datetime not null,
+	creation_user		integer not null references users(user_id),
+	creation_ip_address	varchar(50) not null
+);
+
Index: web/openacs/www/doc/sql/proposals.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/proposals.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/proposals.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,27 @@
+-- proposals.sql
+--
+-- by tzumainn@mit.edu 9/18/99
+--
+-- supports 6.916/ArsDigita project proposal system in /proposals/
+--
+
+create sequence proposal_id_sequence start with 1;
+
+create table proposals (
+	proposal_id			integer primary key,
+	purpose				varchar(10) check (purpose in ('6.916','ArsDigita')),
+	title				varchar(100) not null,
+	user_classes			clob,
+	significant_new_capabilities	clob,
+	feature_list_complete		clob,
+	feature_list_ranking		clob,
+	dependencies			clob,
+	minimum_launchable_feature_set	clob,
+	promotion			clob,
+	name				varchar(100) not null,
+	email				varchar(100) not null,
+	phone				varchar(100),
+	date_submitted			date default sysdate,
+	deleted_p			char(1) default 'f' check(deleted_p in ('t','f'))
+);
+
Index: web/openacs/www/doc/sql/pull-down-menu-data.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/pull-down-menu-data.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/pull-down-menu-data.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,170 @@
+-- /doc/sql/pdm-data.sql
+--
+-- by aure@arsdigita.com, March 2000
+--
+-- Data to initialize the menus for the admin pages, and arsdigita-users bar
+-- for demonstration of the module
+--
+-- pull-down-menu-data.sql,v 1.1.2.2 2000/03/16 05:35:34 aure Exp
+
+--set define off;
+
+-- create the two horizontal pull-down menus
+
+insert into pdm_menus (menu_id, menu_key, default_p, orientation, x_offset, y_offset, element_height, element_width, main_menu_font_style, sub_menu_font_style, sub_sub_menu_font_style, main_menu_bg_img_url, main_menu_bg_color, main_menu_hl_img_url, main_menu_hl_color, sub_menu_bg_img_url, sub_menu_bg_color, sub_menu_hl_img_url, sub_menu_hl_color, sub_sub_menu_bg_img_url, sub_sub_menu_bg_color, sub_sub_menu_hl_img_url, sub_sub_menu_hl_color)
+    values (nextval('pdm_menu_id_sequence'), 'admin', 'f', 'horizontal', 10, 5, 18, 150, 'font-family: arial,helvetica,sans-serif;  font-size: 13px; font-weight: bold;text-decoration: none; line-height: 1.2em; color: #000000;', 'font-family: arial,helvetica,sans-serif;  font-size: 11px; text-decoration: none; line-height: 1em; color: #000000;', 'font-family: arial,helvetica,sans-serif;  font-size: 11px; text-decoration: none; line-height: 1em; color: #000000;', NULL, '#dddddd', NULL, '#9999cc', '/graphics/ad_at_angle.gif' , '#dddddd', NULL, '#9999cc', NULL, '#cccccc', NULL, '#9999cc');
+
+insert into pdm_menus (menu_id, menu_key, default_p, orientation, x_offset, y_offset, element_height, element_width, main_menu_font_style, sub_menu_font_style, sub_sub_menu_font_style, main_menu_bg_img_url, main_menu_bg_color, main_menu_hl_img_url, main_menu_hl_color, sub_menu_bg_img_url, sub_menu_bg_color, sub_menu_hl_img_url, sub_menu_hl_color, sub_sub_menu_bg_img_url, sub_sub_menu_bg_color, sub_sub_menu_hl_img_url, sub_sub_menu_hl_color)
+    values (nextval('pdm_menu_id_sequence'), 'www.arsdigita.com', 't', 'horizontal', 5, 5, 18, 160, 'font-family: arial,helvetica,sans-serif;  font-size: 13px; font-weight: bold;  text-decoration: none; line-height: 1.2em; color: #000000;', 'font-family: arial,helvetica,sans-serif;  font-size: 11px; text-decoration: none; line-height: 1em; color: #000000;', 'font-family: arial,helvetica,sans-serif;  font-size: 11px; text-decoration: none; line-height: 1em; color: #000000;', NULL, '#dddddd', NULL, '#9999cc', '/graphics/ad_at_angle.gif', '#dddddd', NULL, '#9999cc', NULL, '#cccccc', NULL, '#9999cc');
+
+
+-- insert items into the pull-down menus defined above
+
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '18', 'User Utility Modules', '/admin/#user_modules', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '20', 'Module Tools', '/admin/#module_tools', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '17', 'User Management', '/admin/#user_management', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1900', 'Ad Server', '/admin/adserver/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1800', 'Address Book', '/admin/address-book/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '2000', 'Comments on Static Pages', '/admin/comments/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1700', 'Categories', '/admin/categories/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '19', 'Site Wide Tools', '/admin/#site_tools', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1701', 'Customer Relationship Mgmt.', '/admin/crm/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1702', 'Users', '/admin/users/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1703', 'User Searches', '/admin/searches/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1704', 'User Groups', '/admin/ug/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '2001', 'General Comments', '/admin/general-comments/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '2002', 'General Links', '/admin/general-links/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '2003', 'Related Links', '/admin/links/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1801', 'Bulletin Boards', '/admin/bboard/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1802', 'Bookmarks', '/admin/bookmarks/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1803', 'Calendar', '/admin/calendar/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1804', 'Chat', '/admin/chat/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1805', 'Classifieds', '/admin/gc/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1806', 'Contests', '/admin/contest/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1807', 'Events', '/admin/events/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1808', 'Frequently Asked Questions', '/admin/faq/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1809', 'File Storage', '/admin/file-storage/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1810', 'Glossary', '/admin/glossary/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1811', 'Intranet', '/admin/intranet/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1812', 'Neighbor-to-Neighbor', '/admin/neighbor/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1813', 'News', '/admin/news/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1814', 'Polls', '/admin/poll/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1815', 'Press', '/admin/press/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1816', 'Stolen Equipment Registry', '/admin/registry/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1817', 'Ticket Tracker', '/admin/ticket/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1901', 'Banner Ideas', '/admin/bannerideas/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1902', 'Clickthroughs', '/admin/click/report.tcl', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1903', 'Co-Branding', '/admin/partner/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1904', 'Curriculum', '/admin/curriculum/element-list.tcl', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1905', 'Display', '/admin/display/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1906', 'Documentation', '/admin/documentation/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1907', 'Monitoring', '/admin/monitoring/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1908', 'Portals', '/admin/portals/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1909', 'Pull-down Menus', '/admin/pull-down-menus/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1910', 'Referrals', '/admin/referer/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1911', 'Robot Detection', '/admin/robot-detection/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1912', 'Spam', '/admin/spam/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 1, '1913', 'Static Content', '/admin/static/', 'f');
+
+
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '21', 'Everyone', '#', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '2101', 'Learn about ArsDigita', 'http://www.arsdigita.com/pages/about', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '23', 'Prospective Clients', '#', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '25', 'ACS Developers', '#', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '26', 'Other', '#', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '2502', 'Attend a boot camp', 'http://photo.net/teaching/boot-camp', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '2500', 'Download our software', 'http://www.arsdigita.com/register/index?return_url=%2fdownload%2findex%2etcl', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '2501', 'Join developer discussions', 'http://photo.net/wtr/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '2600', 'The ArsDigita Foundation', 'http://arsdigita.org/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '2601', 'ArfDigita.org', 'http://arfdigita.com/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '2300', 'Qualify us ', 'http://www.arsdigita.com/pages/qualify-us', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '2301', 'Get our sales pitch', 'http://www.arsdigita.com/pages/sales-pitch/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '230100', 'Why hire us?', 'http://www.arsdigita.com/pages/sales-pitch/#like-us', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '230101', 'The Competition', 'http://arsdigita.com/pages/sales-pitch/#competition', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '230102', 'References', 'http://arsdigita.com/pages/sales-pitch/#references', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '230103', 'Next Steps', 'http://arsdigita.com/pages/sales-pitch/#next-steps', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '230104', 'NDA', 'http://arsdigita.com/pages/NDA', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '2302', 'Check our references', 'http://www.arsdigita.com/pages/sales-pitch/#references', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '2303', 'Tell us about your project or idea', 'http://www.arsdigita.com/proposals/new', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '2100', 'Learn about the Web', 'http://www.arsdigita.com/pages/learn/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '210100', 'Contact Us', 'http://arsdigita.com/pages/contact-us', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '2102', 'Review Our Projects', 'ttp://www.arsdigita.com/pages/projects', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '2103', 'Review Our Services', 'http://www.arsdigita.com/pages/services', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '2104', 'Attend our classes and lectures', 'http://register.photo.net/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '2105', 'Use our free services', 'http://www.arsdigita.com/pages/free-services', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '24', 'Potential Employees', '#', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '2400', 'Job Openings', 'http://www.arsdigita.com/pages/jobs/', 'f');
+insert into pdm_menu_items (item_id, menu_id, sort_key, label, url, requires_registration_p)
+    values (nextval('pdm_item_id_sequence'), 2, '2401', 'Review our problem sets', 'http://photo.net/teaching/one-term-web', 'f');
Index: web/openacs/www/doc/sql/pull-down-menus.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/pull-down-menus.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/pull-down-menus.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,93 @@
+-- pull-down-menus.sql
+--
+-- by aure@arsdigita.com, February 2000
+--
+-- pull-down-menus.sql,v 3.1.2.1 2000/03/16 05:35:55 aure Exp
+
+create sequence pdm_menu_id_sequence;
+
+create table pdm_menus (
+	menu_id			integer primary key,
+	-- programmer friendly title used to call the menu
+	menu_key			varchar(20) unique not null,
+	-- is this the menu to show if no pdm_key is passed to ad_pdm?
+	default_p		char(1) default 'f' check (default_p in ('t','f')),
+	-- orientation of the menu, either "horizontal" or "vertical"
+	orientation		varchar(20) not null check (orientation in ('horizontal','vertical')),
+	-- distance from the left side of the display area
+	x_offset		integer not null,
+	-- distance from top of the display area
+	y_offset		integer not null,
+	-- dimensions of a single menu element
+	element_height		integer not null,
+	element_width		integer not null,
+	-- css-type style guides for the fonts in the menu
+	main_menu_font_style	varchar(4000),
+	sub_menu_font_style	varchar(4000),
+	sub_sub_menu_font_style varchar(4000),
+	-- main menu background images and background colors 
+	main_menu_bg_img_url	varchar(200),
+	main_menu_bg_color	varchar(12),
+	-- hl stands for "highlight" - these are what are shown when
+	-- someone mouses over the menu
+	main_menu_hl_img_url    varchar(200),
+	main_menu_hl_color	varchar(12),
+	-- background and color definitions for first level sub menu
+	sub_menu_bg_img_url	varchar(200),
+	sub_menu_bg_color	varchar(12),
+	sub_menu_hl_img_url	varchar(200),
+	sub_menu_hl_color	varchar(12),
+	-- background and color definitions for second level sub menu
+	sub_sub_menu_bg_img_url	varchar(200),
+	sub_sub_menu_bg_color	varchar(12),
+	sub_sub_menu_hl_img_url	varchar(200),
+	sub_sub_menu_hl_color	varchar(12)
+);
+
+create sequence pdm_item_id_sequence;
+
+create table pdm_menu_items (
+	item_id			integer primary key,
+	menu_id			integer references pdm_menus,
+	-- within one level, sort_key defines the order of the items
+	sort_key		varchar(50) not null,
+	-- text of the item to be displayed if no images are shown and
+	-- as alt text to the images
+	label			varchar(200) not null,
+	-- url may be null if this item is only used to store other items
+	url			varchar(500),
+	-- don't show certain elements to people who haven't registered
+	requires_registration_p char(1) default 'f' check (requires_registration_p in ('t','f'))
+);
+
+create function pdm_count_n_items(integer)
+returns integer
+as '
+DECLARE
+	v_menu_id alias for $1;
+BEGIN
+	return count(*) from pdm_menu_items where menu_id= v_menu_id;
+END;
+' language 'plpgsql';
+
+
+create function pdm_count_items_like(char)
+returns integer
+as '
+DECLARE
+	v_sortkey alias for $1;
+BEGIN
+	return count(*) from pdm_menu_items where sort_key like v_sortkey||''__'';
+END;
+' language 'plpgsql';
+
+create function pdm_parent_label(integer, char)
+returns char
+as '
+DECLARE
+	v_menu_id alias for $1;
+	v_sortkey alias for $2;
+BEGIN
+	return label from pdm_menu_items where menu_id= v_menu_id and sort_key= substr(v_sortkey,1, length(v_sortkey)-2);
+END;
+' language 'plpgsql';
Index: web/openacs/www/doc/sql/rank-for-search.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/rank-for-search.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/rank-for-search.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,44 @@
+-- This is a hack to allow a quick and dirty search implementation for OpenACS.
+-- It's based on the PL/SQL function 'bboard_contains' originally used to search
+-- photo.net's bulletin boards back in the pre-Context/Intermedia era.
+
+-- The return value ranges from 0-100, which is computed according to the
+-- algorithm du jour, currently just a simple keyword-type search.
+
+-- This will be slow, requiring a sequential scan - making an index on a date
+-- and restricting the search might be a good idea on big systems until we
+-- get a better search.  At least Pg/Tcl is smart enough to save the 8.*
+-- compiled bytes, which AOLserver is not for .tcl scripts!
+
+-- If you want things like email, etc to be searched along with a message
+-- then pass the concatenation to this routine.
+
+-- Remember this shouldn't be called with NULL so exclude those in your
+-- search query.
+
+-- Note: you must have Pg/Tcl installed to run this.  If you've not
+-- built Tcl support into Postgres, reconfigure with "--with-tcl" and
+-- rebuild and reinstall.
+
+-- Then enable Pg/Tcl for your database by running
+-- "createlang pgtcl <your database name>"
+
+-- The odd "increment by 10" code comes from the original PL/SQL, presumably
+-- to allow one some flexibility in assigning weights if you want to 
+-- customize this function.
+
+create function rank_for_search(varchar, varchar) returns integer as '
+
+    set search_words [split [string tolower $1] " "]
+    set candidate_string [string tolower $2]
+
+    set max_possible_score [expr [llength $search_words] * 10.0]
+    set score 0
+    foreach search_word $search_words {
+        if { [string first $search_word $candidate_string] != -1 } {
+            set score [expr $score+10]
+        }
+    }
+    set score [expr int(($score/$max_possible_score) * 100.0)]
+    return $score
+' language 'pltcl';
Index: web/openacs/www/doc/sql/registry.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/registry.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/registry.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,32 @@
+--
+-- Table definitions for stolen equipment registry
+--
+
+--
+-- Copyright 1996 Philip Greenspun (philg@mit.edu)
+--
+
+-- updated December 7, 1997 for Oracle
+
+create sequence stolen_registry_sequence;
+
+create table stolen_registry (
+	stolen_id		integer not null primary key,
+	user_id			integer references users,
+	additional_contact_info	varchar(400),
+	manufacturer		varchar(50),	-- e.g., 'Nikon'
+	model			varchar(100),	-- e.g., 'N90s'
+	serial_number		varchar(100),
+	value			money,
+	recovered_p		char(1) default 'f' check(recovered_p in ('f','t')),
+	recovered_by_this_service_p	char(1) default 'f' check(recovered_by_this_service_p in ('f','t')),
+	posted			datetime,
+	story			varchar(3000),	-- optional, free text
+	deleted_p		char(1) default 'f' check(deleted_p in ('f','t'))
+);
+
+CREATE VIEW stolen_registry_for_context 
+AS 
+SELECT stolen_id, s.deleted_p as deleted_p, recovered_p, manufacturer, model, serial_number, serial_number || ' ' || u.first_names || ' ' || u.last_name || ' ' || u.email || ' ' || manufacturer || ' ' || model || ' ' || story as indexedtext
+FROM stolen_registry s, users u
+WHERE u.user_id = s.user_id;
Index: web/openacs/www/doc/sql/robot-detection.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/robot-detection.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/robot-detection.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,65 @@
+--
+-- robot-detection.sql
+--
+-- created by michael@yoon.org on 05/27/1999
+--
+-- defines a table in which to store info from the Web Robots Database
+-- (http://info.webcrawler.com/mak/projects/robots/active.html), which
+-- is virtually a one-to-one mapping of the schema at:
+--
+-- http://info.webcrawler.com/mak/projects/robots/active/schema.txt
+--
+-- descriptions of each field can be found there.
+--
+create table robots (
+	--
+	-- robot_id is *not* a generated key.
+	--
+	robot_id			varchar(100) primary key,
+	robot_name			varchar(100) not null,
+	robot_details_url		varchar(200),
+	robot_cover_url			varchar(200),
+	robot_status			char(12),
+	-- check (robot_status in ('development', 'active', 'retired'))
+	robot_purpose			varchar(50),
+	robot_type			char(12),
+	-- check (robot_type in ('standalone', 'browser', 'plugin'))
+	robot_platform			varchar(50),
+	robot_availability		char(10),
+	-- check (robot_availability in ('source', 'binary', 'data', 'none')),
+	robot_exclusion_p		char(1),
+	-- check (robot_exclusion_p in ('t', 'f')),
+	robot_exclusion_useragent	varchar(100),
+	robot_noindex_p			char(1),
+	-- check (robot_exclusion_p in ('t', 'f')),
+	robot_host			varchar(100),
+	robot_from_p			char(1),
+	-- check (robot_exclusion_p in ('t', 'f')),
+	robot_useragent			varchar(100) not null,
+	robot_language			varchar(100),
+	robot_description		varchar(1000),
+	robot_history			varchar(1000),
+	robot_environment		varchar(1000),
+	--
+	-- note: modified_date and modified_by are *not* ACS audit trail
+	-- columns; rather, they are part of the schema defined by the
+	-- Web Robots DB.
+	modified_date			datetime,
+	modified_by			varchar(50),
+	--
+	-- insertion_date records when this row was actually inserted
+	-- used to determine if we need to re-populate the table from
+	-- the Web Robots DB.
+	insertion_date			datetime default current_timestamp not null
+);
+
+--
+-- A robot can have multiple owners, so we normalize out the owner info.
+--
+create table robot_owners (
+	robot_id		varchar(100) references robots(robot_id),
+	robot_owner_name	varchar(50),
+	robot_owner_url		varchar(200),
+	robot_owner_email	varchar(100),
+	primary key (robot_id, robot_owner_name)
+);
Index: web/openacs/www/doc/sql/sdm.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/sdm.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/sdm.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,741 @@
+
+-- This data model is for the Software Development Module (SDM)
+-- The tables were designed by Ben Adida (ben@mit.edu) and Philip Greenspun (philg@mit.edu)
+-- The details of the data model were done by Ben Adida (ben@mit.edu)
+
+-- packages
+-- packages are totally independent products. One package might
+-- be the ACS, while another is AOLServer.
+
+-- ported to Postgres by Ben Adida (ben@mit.edu)
+
+create sequence package_id_sequence;
+
+create table packages (
+	package_id		integer not null primary key,
+	package_name		varchar(100) not null,
+	private_p		char(1) check (private_p in ('t','f')),
+	description		varchar(4000)
+);
+
+create view public_packages as select * from packages where private_p='f';
+
+create sequence package_release_id_sequence;
+
+create table package_releases (
+	release_id			integer not null primary key,
+	package_id			integer not null references packages,
+	-- These version numbers are for 1.1.7, 2.0.1
+	major_version			integer not null,
+	minor_version			integer not null,
+	patch_version			integer not null,
+	beta_version			integer,
+	-- Release Dates
+	anticipated_release_date	datetime,
+	release_date			datetime,
+	manager				integer not null references users,
+	general_description		varchar(4000),
+	release_notes			lztext,
+	supported_platforms		varchar(250),
+	release_filename		varchar(250)
+);
+	
+alter table packages add
+	current_release		integer references package_releases;
+
+create table package_admins (
+	package_id		integer not null references packages,
+	user_id			integer not null references users,
+	primary key (package_id, user_id)
+);
+
+create sequence module_id_sequence;
+
+create table modules (
+	module_id		integer not null primary key,
+	package_id		integer references packages,
+	module_name		varchar(100) not null,
+	owner			integer not null references users,
+	private_p		char(1) check (private_p in ('t','f')),
+	description		varchar(4000)
+);
+
+create view public_modules as select * from modules where private_p='f';
+
+-- A table for assigning users to modules, so that they may see
+-- the module if the module is private, and later upload code to the
+-- module
+
+create table module_users (
+	module_id		integer not null references modules,
+	user_id			integer not null references users,
+	primary key(module_id, user_id)
+);
+
+
+-- procs to determine if a user can see/edit packages/modules.
+-- because of Oracle deadlock issues, these should be selected
+-- from dual and usually not at the same time as other columns
+-- are selected from tables.
+
+create function user_can_edit_package_p(integer, integer)
+returns char as '
+DECLARE
+	v_user_id alias for $1;
+	v_package_id alias for $2;
+	v_count integer;
+BEGIN
+	select count(*) into v_count from package_admins where package_id= v_package_id and user_id= v_user_id;
+	IF (v_count > 0)
+	THEN return(''t'');
+	ELSE return(''f'');
+	END IF;
+END;
+' language 'plpgsql';
+
+create function user_can_edit_module_p(integer, integer)
+returns char as '
+DECLARE
+	v_user_id alias for $1;
+	v_module_id alias for $2;
+	v_count integer;
+BEGIN
+	select count(*) into v_count from modules where module_id= v_module_id and owner= v_user_id;
+	if v_count > 0
+	THEN return(''t'');
+	END IF;	
+	
+	return(''f'');
+END;
+' language 'plpgsql';
+
+create function user_can_see_package_p(integer, integer)
+returns char as '
+DECLARE
+	v_user_id alias for $1;
+	v_package_id alias for $2;
+	v_count integer;
+BEGIN
+	select count(*) into v_count from public_packages where package_id= v_package_id;
+	IF (v_count > 0)
+	THEN return(''t'');
+	END IF;
+
+	select count(*) into v_count from module_users where module_id IN (select module_id from modules where package_id= v_package_id) and user_id= v_user_id;
+	IF (v_count > 0)
+	THEN return(''t'');
+	END IF;
+
+	IF (user_can_edit_package_p(v_user_id, v_package_id)=''t'')
+	THEN return(''t'');
+	END IF;
+
+	return(''f'');
+END;
+' language 'plpgsql';
+
+create function user_can_see_module_p(integer, integer)
+returns char as '
+DECLARE
+	v_user_id alias for $1;
+	v_module_id alias for $2;
+	v_count integer;
+	v_package_id integer;
+BEGIN
+	select count(*) into v_count from public_modules where module_id= v_module_id;
+	IF (v_count > 0)
+	THEN return(''t'');
+	END IF;
+
+	select count(*) into v_count from module_users where user_id= v_user_id and module_id= v_module_id;
+	IF (v_count > 0)
+	THEN return(''t'');
+	END IF;
+
+	select package_id into v_package_id from modules where module_id= v_module_id;
+	IF (user_can_edit_package_p(v_user_id, v_package_id)=''t'')
+	THEN return(''t'');
+	END IF;
+	
+	IF (user_can_edit_module_p(v_user_id, v_module_id)=''t'')
+	THEN return(''t'');
+	END IF;
+
+	return(''f'');
+		
+END;
+' language 'plpgsql';
+
+
+
+-- This table describes relationships between modules, and
+-- who owns the "glue" between them
+create table module_relationships (
+	first_module		integer not null references modules,
+	second_module		integer not null references modules,
+	owner			integer not null references users,
+	primary key (first_module, second_module)
+);
+
+create table package_release_downloads (
+	package_id			integer not null references packages,
+	release_id			integer not null references package_releases,
+	download_date			datetime,
+	ip_address			varchar(15)
+);
+
+create function release_lessthan_p(integer, integer, integer, integer, integer, integer, integer, integer)
+returns char as '
+DECLARE
+	first_major alias for $1;
+	first_minor alias for $2;
+	first_patch alias for $3;
+	first_beta alias for $4;
+	second_major alias for $5;
+	second_minor alias for $6;
+	second_patch alias for $7;
+	second_beta alias for $8;
+BEGIN	
+	IF first_major < second_major 
+	THEN RETURN ''t''; 
+	END IF;
+
+	IF first_major > second_major
+	THEN RETURN ''f'';
+	END IF;
+
+	IF first_minor < second_minor 
+	THEN RETURN ''t''; 
+	END IF;
+
+	IF first_minor > second_minor
+	THEN RETURN ''f'';
+	END IF;
+
+	IF first_patch < second_patch 
+	THEN RETURN ''t''; 
+	END IF;
+
+	IF first_patch > second_patch
+	THEN RETURN ''f'';
+	END IF;
+
+	IF first_beta is NULL
+	THEN RETURN ''f'';
+	END IF;
+
+	IF second_beta is NULL
+	THEN RETURN ''t'';
+	END IF;
+
+	IF first_beta > second_beta
+	THEN RETURN ''t'';
+	END IF;
+		
+	RETURN ''f'';
+END;
+' language 'plpgsql';
+
+create function release_name(integer,integer,integer,integer)
+returns varchar as '
+DECLARE
+	major_version alias for $1;
+	minor_version alias for $2;
+	patch_version alias for $3;
+	beta_version alias for $4;
+BEGIN
+	IF major_version IS NULL
+	THEN RETURN NULL;
+	END IF;
+
+	IF beta_version is NULL or beta_version=0
+	THEN
+	return (major_version || ''.'' || minor_version || ''.'' || patch_version);
+	ELSE
+	return (major_version || ''.'' || minor_version || ''.'' || patch_version || ''b'' || beta_version);
+	END IF;
+END;
+' language 'plpgsql';
+
+-- Note that a baf is a bug-and-feature.
+-- Since we don't want to write bug-and-feature everywhere
+-- we go, we'll call a bug-and-feature a "baf" from now on.
+create table baf_status (
+       baf_status_id	integer not null primary key,
+       baf_status	varchar(100)
+);
+
+insert into baf_status values (1, 'open');
+insert into baf_status values (2, 'fixed');
+insert into baf_status values (3, 'closed');
+insert into baf_status values (4, 'reopened');
+
+create sequence baf_id_sequence start 5;
+
+create table bugs_and_features (
+	baf_id				integer not null primary key,
+	old_baf_id			integer references bugs_and_features,
+	baf_type			varchar(20) not null check (baf_type in ('bug', 'feature')),
+	package_id			integer not null references packages,
+	module_id			integer references modules,
+	baf_status			integer not null references baf_status,
+	last_updated_by			integer references users,
+	-- who pointed this out
+	entered_by			integer not null references users,
+	-- who's working on this
+	-- we're moving to a mapping table
+	-- assigned_user			references users,
+	-- a priority between 1 and 9, 1 being the highest priority
+	severity		        varchar(20) not null,
+	insertion_date			datetime,
+	expected_completion		integer references package_releases,
+	completion			integer references package_releases,
+	description			lztext	
+);
+
+create index baf_type_index on bugs_and_features(baf_type);
+
+create view open_bafs as select * from bugs_and_features where completion is NULL;
+
+-- In case we want to easily view these separately
+create view bugs as select * from bugs_and_features where baf_type='bug';
+create view open_bugs as select * from bugs where completion is NULL;
+create view closed_bugs as select * from bugs where completion is not NULL;
+
+create view features as select * from bugs_and_features where baf_type='feature';
+create view open_features as select * from features where completion is NULL;
+create view closed_features as select * from features where completion is not NULL;
+
+
+-- BAF Auditing
+create table baf_audit (
+       baf_id	       integer not null,
+       who	       varchar(250),
+       what	       varchar(250),
+       old_value       varchar(250),
+       new_value       varchar(250),
+       audit_date       datetime
+);
+
+create index baf_audit_baf_id on baf_audit(baf_id);
+create index baf_audit_audit_date on baf_audit(audit_date);
+
+create function trig_baf_audit() returns opaque
+as '
+DECLARE
+	the_name	varchar(200);
+BEGIN
+	select first_names || '' '' || last_name into the_name
+	from users where user_id= NEW.last_updated_by;
+
+	IF OLD.baf_type != NEW.baf_type
+	THEN 
+	insert into baf_audit (baf_id, who, what, old_value, new_value, audit_date)
+	values (NEW.baf_id, the_name, ''baf_type'', OLD.baf_type, NEW.baf_type, sysdate());
+	END IF;
+
+	IF OLD.baf_status != NEW.baf_status
+	THEN 
+	insert into baf_audit (baf_id, who, what, old_value, new_value, audit_date)
+	values (NEW.baf_id, the_name, ''baf_status'', sdm_get_baf_status(OLD.baf_status), sdm_get_baf_status(NEW.baf_status), sysdate());
+	END IF;
+
+	IF OLD.severity != NEW.severity
+	THEN 
+	insert into baf_audit (baf_id, who, what, old_value, new_value, audit_date)
+	values (NEW.baf_id, the_name, ''severity'', OLD.severity, NEW.severity, sysdate());
+	END IF;
+
+	IF OLD.expected_completion != NEW.expected_completion
+	THEN 
+	insert into baf_audit (baf_id, who, what, old_value, new_value, audit_date)
+	values (NEW.baf_id, the_name, ''expected_completion'', fetch_release_name(OLD.expected_completion), fetch_release_name(NEW.expected_completion), sysdate());
+	END IF;
+
+	return NEW;
+END;
+' language 'plpgsql';
+
+create trigger baf_audit
+after update on bugs_and_features
+for each row
+execute procedure trig_baf_audit();
+
+create function trig_lowlevel_baf_audit() returns opaque
+as '
+DECLARE
+	v_baf_type_text varchar(100);
+	v_bogus integer;
+BEGIN
+	IF NEW.what=''baf_type''
+	THEN
+	v_bogus:= baf_edit_notification(NEW.baf_id::integer, ''This '' || NEW.old_value || '' is now classified as a '' || NEW.new_value);
+	ELSE
+	v_bogus:= baf_edit_notification(NEW.baf_id::integer, NEW.what || '' changed from '' || NEW.old_value || '' to '' || NEW.new_value);
+	END IF;
+	
+	RETURN NEW;
+END;
+' language 'plpgsql';
+
+create trigger lowlevel_baf_audit
+before insert on baf_audit
+for each row
+execute procedure trig_lowlevel_baf_audit();
+
+create function user_can_edit_baf_p(integer, integer)
+returns char
+as '
+DECLARE
+	v_user_id alias for $1;
+	v_baf_id alias for $2;
+	v_check integer;
+	v_check_char char(1);
+BEGIN
+	select user_can_edit_module_p(v_user_id, module_id) into v_check_char
+	from bugs_and_features where baf_id= v_baf_id;
+
+	if v_check_char = ''t''
+	then return ''t'';
+	end if;
+
+	select user_can_edit_package_p(v_user_id, package_id) into v_check_char
+	from bugs_and_features where baf_id= v_baf_id;
+
+	if v_check_char = ''t''
+	then return ''t'';
+	end if;
+
+	select count(*) into v_check from baf_assignments where baf_id= v_baf_id and user_id= v_user_id;
+	if v_check > 0
+	then return ''t'';
+	end if;
+
+	select count(*) into v_check from bugs_and_features where baf_id= v_baf_id and entered_by= v_user_id;
+	if v_check > 0
+	then return ''t'';
+	end if;
+
+	return ''f'';
+END;
+' language 'plpgsql';
+
+-- A way for users to rank the importance of a bug
+create table baf_ratings (
+       user_id		 integer not null references users,
+       baf_id		 integer not null references bugs_and_features,
+       primary key(user_id, baf_id),
+       rating		 integer not null check (rating between 1 and 10),
+       rating_date	 datetime
+);
+
+
+-- Who's assigned to what bugs
+create table baf_assignments (
+       baf_id		     integer not null references bugs_and_features,
+       user_id		     integer not null references users,
+       role		     varchar(100),
+       assignment_date	     datetime
+);       
+
+-- Sometimes, bugs apply to releases before the date when they were found.
+create table bug_release_map (
+	bug_id		integer not null references bugs_and_features,
+	release_id	integer not null references package_releases,
+	discovery_date	datetime ,
+	primary key (bug_id, release_id)
+);
+
+-- We want to map what a user might be interested in
+-- this is mostly for bugs/features, but might be for
+-- tasks
+-- for now, let's see how it works with just bafs.
+
+create table user_baf_interest_map (
+	user_id			integer not null references users,
+	baf_id			integer not null references bugs_and_features,
+	primary key (user_id, baf_id)
+);
+
+-- User Interests in Packages
+
+create table user_package_interest_map (
+       user_id			       integer not null references users,
+       package_id		       integer not null references packages,
+       primary key (user_id, package_id)
+);
+
+-- comments on bugs and features
+
+create view baf_comments as select * from general_comments where on_which_table='bugs_and_features';
+
+
+--
+-- Here we get into the source repository stuff
+-- ben@mit.edu
+--
+
+create table package_repositories (
+	package_id		integer not null primary key references packages,
+	repository_name		varchar(100) not null,
+	file_glob_patterns	varchar(200)
+);
+
+create function package_has_repository_p(integer)
+returns char as '
+DECLARE
+	v_package_id alias for $1;
+	v_count integer;
+BEGIN
+	select count(*) into v_count from package_repositories where package_id= v_package_id;
+
+	if (v_count > 0)
+	THEN return ''t'';
+	ELSE return ''f'';
+	END IF;
+END;
+' language 'plpgsql';
+
+
+--
+-- The CVS specific stuff
+
+create table cvs_package_data (
+	package_id		integer not null primary key references packages,
+	cvs_server		varchar(200),
+	cvs_username		varchar(100),
+	cvs_password		varchar(100),
+	cvs_path		varchar(200),
+	cvs_package_name	varchar(200)
+);
+
+--
+-- Spamming stuff
+-- 
+create table sdm_notification_prefs (
+       user_id			    integer not null primary key references users,
+       package_pref		    varchar(50) default 'none' check (package_pref in ('none', 'hourly', 'daily', 'weekly')),
+       baf_pref			    varchar(50) default 'none' check (baf_pref in ('none', 'hourly', 'daily', 'weekly'))
+);
+
+
+create table sdm_notifications (
+       user_id		       integer not null primary key references users,
+       baf_notifications       lztext,
+       package_notifications   lztext
+);
+
+-- PL/SQL to do notifications
+create function baf_edit_notification(integer, varchar) returns integer
+as '
+DECLARE
+	v_baf_id alias for $1;
+	v_message alias for $2;
+	v_one_baf	bugs_and_features%ROWTYPE;
+BEGIN
+	select * into v_one_baf from bugs_and_features where baf_id= v_baf_id;
+
+	update sdm_notifications set
+	baf_notifications= coalesce(baf_notifications,'''') || to_char(sysdate(),''YYYY-MM-DD'') || '' '' || v_one_baf.baf_type || '' #'' || v_baf_id ||
+			   '': '' || v_message || ''\n'' || substr(v_one_baf.description,0,60) || ''... \n\n''
+	where user_id in (select user_id from user_baf_interest_map where baf_id= v_baf_id);
+
+	return 1;
+END;
+' language 'plpgsql';
+
+create function package_edit_notification(integer, varchar) returns integer
+as '
+DECLARE
+	v_package_id alias for $1;
+	v_message alias for $2;
+	v_one_package	packages%ROWTYPE;
+BEGIN
+	select * into v_one_package from packages where package_id= v_package_id;
+	
+	update sdm_notifications set
+	package_notifications= coalesce(package_notifications,'''') || to_char(sysdate(),''YYYY-MM-DD'') || '' '' || v_one_package.package_name || '': '' ||
+			       v_message || ''\n''
+	where user_id in (select user_id from user_package_interest_map where package_id= v_package_id);
+
+	return 1;
+END;
+' language 'plpgsql';
+
+
+--
+-- VIEWS!
+--
+
+create view packages_with_cvs_data as select packages.*,cvs_server, cvs_username, cvs_password, cvs_path, cvs_package_name from packages,cvs_package_data where packages.package_id=cvs_package_data.package_id;
+
+
+--
+-- Procs for Postgres no Outer Joins
+--
+
+create function baf_module(integer)
+returns varchar as '
+DECLARE
+	v_baf_id alias for $1;
+	the_name varchar(100);
+BEGIN
+	select module_name into the_name from modules where module_id=
+	       (select module_id from bugs_and_features where baf_id= v_baf_id);
+
+	return the_name;
+END;
+' language 'plpgsql';
+
+
+create function fetch_release_name(integer)
+returns varchar as '
+DECLARE
+	v_release_id alias for $1;
+	v_release_name varchar(100);
+BEGIN
+	select release_name(major_version, minor_version, patch_version, beta_version)
+	into v_release_name
+	from package_releases where release_id = v_release_id;
+
+	return v_release_name;
+END;
+' language 'plpgsql';
+
+
+create function get_baf_status_id(varchar)
+returns integer as '
+DECLARE
+	status_name alias for $1;
+BEGIN
+	return baf_status_id from baf_status where baf_status= status_name;
+END;
+' language 'plpgsql';
+
+
+create function sdm_get_baf_status(integer)
+returns varchar as '
+DECLARE
+	v_baf_status_id alias for $1;
+BEGIN
+	return baf_status from baf_status where baf_status_id= v_baf_status_id;
+END;
+' language 'plpgsql';
+
+
+create function baf_rating(integer)
+returns numeric
+as '
+DECLARE
+	v_baf_id alias for $1;
+BEGIN
+	return avg(rating) from baf_ratings where baf_id= v_baf_id;
+END;
+' language 'plpgsql';
+
+create function baf_n_interested(integer)
+returns numeric
+as '
+DECLARE
+	v_baf_id alias for $1;
+BEGIN
+	return count(*) from user_baf_interest_map where baf_id= v_baf_id;
+END;
+' language 'plpgsql';
+
+-- Stuff about assignments
+create function sdm_baf_assigned(integer)
+returns varchar as '
+DECLARE
+	v_baf_id alias for $1;
+	v_assigned     varchar(200);
+	v_one_row      users%ROWTYPE;
+BEGIN
+	v_assigned:= '''';
+
+	FOR v_one_row IN select * from users where user_id in 
+	(select user_id from baf_assignments where baf_id= v_baf_id) LOOP
+	    IF v_assigned!=''''
+	    then v_assigned:= v_assigned || '', '';
+	    end if;
+
+	    v_assigned:= v_assigned || v_one_row.first_names || '' '' || v_one_row.last_name;
+	END LOOP;
+
+	IF v_assigned= ''''
+	then v_assigned:= ''(no one)'';
+	end if;
+
+	return v_assigned;
+END;
+' language 'plpgsql';
+
+-- another function for outer join problems
+create function sdm_completion_date(integer)
+returns datetime as '
+DECLARE
+	v_baf_id alias for $1;
+	v_completion integer;
+BEGIN
+	select completion into v_completion from bugs_and_features where baf_id= v_baf_id;
+	if v_completion is NULL
+	then return null;
+	else return sysdate();
+	end if;
+END;
+' language 'plpgsql';
+
+create function sdm_baf_due_date(integer)
+returns datetime as '
+DECLARE
+	v_baf_id alias for $1;
+	v_release_id integer;
+BEGIN
+	select expected_completion into v_release_id from bugs_and_features;
+
+	if v_release_id is null
+	then return NULL;
+	end if;
+
+	return anticipated_release_date from package_releases where release_id= v_release_id;
+END;
+' language 'plpgsql';
+
+
+-- Accepting patches
+
+create sequence sdm_patch_id_sequence;
+
+create table sdm_package_patches (
+       patch_id			 integer not null primary key,
+       user_id			 integer not null references users,
+       package_id		 integer not null references packages,
+       package_release_id	 integer not null references package_releases,
+       submission_date		 datetime,
+       patch_file		 varchar(200),
+       patch_description	 varchar(4000),
+       accepted_p		 char(1) check (accepted_p in ('t','f')),
+       action_user		 integer references users,
+       action_date		 datetime,
+       action_description	 varchar(4000)
+);
+
+create table sdm_package_patch_ratings (
+       patch_id			       integer not null references sdm_package_patches,
+       user_id			       integer not null references users,
+       primary key (patch_id, user_id),
+       numeric_rating		       integer check (numeric_rating between 1 and 10),
+       description		       varchar(4000),
+       rating_date		       datetime
+);
+
+create function sdm_package_patch_rating(integer)
+returns float
+as '
+DECLARE
+	v_patch_id alias for $1;
+BEGIN
+	return avg(numeric_rating) from sdm_package_patch_ratings where patch_id= v_patch_id;
+END;
+' language 'plpgsql';
+
Index: web/openacs/www/doc/sql/security.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/security.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/security.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,90 @@
+--
+-- data model for ACS security
+--
+-- created by jsalz@mit.edu on Feb 2, 2000
+-- adapted from code by kai@arsdigita.com
+--
+
+create table sec_sessions (
+    -- Unique ID (don't care if everyone knows this)
+    session_id            integer primary key,
+    user_id               integer references users,
+    -- A secret used for unencrypted connections
+    token                 varchar(50) not null,
+    -- A secret used for encrypted connections only. not generated until needed
+    secure_token          varchar(50),
+    browser_id            integer not null,
+    -- Make sure all hits in this session are from same host
+    last_ip               varchar(50) not null,
+    -- When was the last hit from this session? (seconds since the epoch)
+    last_hit              integer not null
+);
+
+create table sec_login_tokens (
+    -- A table to track tokens assigned for permanent login. The login_token
+    -- is isomorphic to the password, i.e., the user can use the login_token
+    -- to log back in.
+    user_id	integer references users not null,
+    password    varchar(30) not null,
+    login_token varchar(50) not null,
+    primary key(user_id, password)
+);
+
+-- When a user changes his password, delete any login tokens associated
+-- with the old password.
+create function trig_users_update_login_token()
+returns opaque as '
+DECLARE
+BEGIN
+	delete from sec_login_tokens
+	where user_id= NEW.user_id and password!= NEW.password;
+	return NEW;
+END;
+' language 'plpgsql';
+
+create trigger users_update_login_token
+before update on users
+for each row
+execute procedure trig_users_update_login_token();
+
+create table sec_session_properties (
+    session_id     integer references sec_sessions not null,
+    module         varchar(50) not null,
+    property_name  varchar(50) not null,
+    property_value varchar(4000),
+    -- transmitted only across secure connections?
+    secure_p       char(1) check(secure_p in ('t','f')),
+    primary key(session_id, module, property_name),
+    foreign key(session_id) references sec_sessions on delete cascade
+);
+
+create table sec_browser_properties (
+    browser_id     integer not null,
+    module         varchar(50) not null,
+    property_name  varchar(50) not null,
+    property_value varchar(4000),
+    -- transmitted only across secure connections?
+    secure_p       char(1) check(secure_p in ('t','f')),
+    primary key(browser_id, module, property_name)
+);
+
+create sequence sec_id_seq;
+
+create function sec_rotate_last_visit(integer, integer)
+returns integer as '
+DECLARE
+	v_browser_id alias for $1;
+	v_time alias for $2;
+BEGIN
+    delete from sec_browser_properties
+        where browser_id = v_browser_id and module = ''acs'' and property_name = ''second_to_last_visit'';
+    update sec_browser_properties
+        set property_name = ''second_to_last_visit''
+        where module = ''acs'' and property_name = ''last_visit'' and browser_id = v_browser_id;
+    insert into sec_browser_properties(browser_id, module, property_name, property_value, secure_p)
+        values(v_browser_id, ''acs'', ''last_visit'', v_time::char, ''f'');
+
+    return 1;
+end;
+' language 'plpgsql';
+
Index: web/openacs/www/doc/sql/site-wide-search.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/site-wide-search.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/site-wide-search.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,437 @@
+--
+-- site-wide-search.sql 
+--
+-- part of the ArsDigita Community System
+-- created by philg@mit.edu on March 13, 1999
+--
+-- modified by branimir@arsdigita.com 2000-02-02
+-- and lars@arsdigita.com March 14, 2000
+
+-- user datastore procedure for site wide index
+
+-- Note: execute this script by calling load-site-wide-search
+-- Expects three arguments: username password password-for-ctxsys
+
+-- Read /doc/site-wide-search.html and upgrade your InterMedia 
+-- to 8.1.5.1 or 8.1.6.
+
+
+connect &1/&2
+
+create table site_wide_index (
+	table_name	     	varchar(30) not null,
+	the_key		     	varchar(700) not null,
+	one_line_description 	varchar(4000) not null,
+	datastore		char(1) not null, -- place holder for datastore column
+	primary key (table_name, the_key)
+);
+
+connect ctxsys/&3
+
+CREATE OR replace procedure sws_user_datastore_proc ( rid IN ROWID, tlob IN OUT nocopy clob )
+IS
+   v_table_name  VARCHAR(30);
+   v_primary_key VARCHAR(700);
+   v_one_line VARCHAR(700);
+   v_static_pages_row &1..static_pages%ROWTYPE;
+   TYPE comment_rec IS RECORD (
+     message clob,
+     author_name VARCHAR(300));
+   v_comment_row comment_rec;
+   cursor bboard_cursor(v_msg_id CHAR) IS
+     SELECT one_line, message, u.first_names || ' ' || u.last_name AS author_name
+       FROM &1..bboard b, &1..users u
+       WHERE b.sort_key LIKE v_msg_id || '%'
+       AND b.user_id = u.user_id;
+       
+BEGIN
+     -- get various info on table and columns to index
+   SELECT table_name, the_key, one_line_description
+     INTO v_table_name, v_primary_key, v_one_line
+     FROM &1..site_wide_index
+     WHERE rid = site_wide_index.ROWID;
+   
+   -- clean out the clob we're going to stuff
+   dbms_lob.trim(tlob, 0);
+   
+   -- handle different sections
+   IF v_table_name = 'bboard' THEN
+
+      -- Get data from every message in the thread.
+      FOR bboard_record IN bboard_cursor(v_primary_key) LOOP
+	 IF bboard_record.one_line IS NOT NULL THEN
+	    dbms_lob.writeappend(tlob, length(bboard_record.one_line) + 1, bboard_record.one_line || ' ');
+	 END IF;
+	 dbms_lob.writeappend(tlob, length(bboard_record.author_name) + 1, bboard_record.author_name || ' ');
+         IF bboard_record.message IS NOT NULL THEN
+	     dbms_lob.append(tlob, bboard_record.message);
+	 END IF;
+      -- (branimir 2000-02-02 02:02:02) : Add a space so that the last word of this message doesn't get
+      -- glued together with the first word of the next message:
+      dbms_lob.writeappend(tlob, 1, ' ');
+      END LOOP;
+   ELSIF v_table_name = 'static_pages' THEN
+      SELECT * INTO v_static_pages_row
+	FROM &1..static_pages
+	WHERE page_id = v_primary_key;
+      
+      IF v_static_pages_row.page_title IS NOT NULL THEN
+	 dbms_lob.writeappend(tlob, length(v_static_pages_row.page_title) + 1, v_static_pages_row.page_title || ' ');
+      END IF;
+      dbms_lob.append(tlob, v_static_pages_row.PAGE_BODY);
+   ELSIF v_table_name = 'comments' THEN
+      SELECT message, u.first_names || ' ' || u.last_name INTO v_comment_row
+	FROM &1..comments c, &1..users u
+	WHERE c.user_id = u.user_id
+	AND c.comment_id = v_primary_key;
+      dbms_lob.writeappend(tlob, length(v_comment_row.author_name) + 1, v_comment_row.author_name || ' ');
+      dbms_lob.append(tlob, v_comment_row.message);
+   END IF;
+END;
+/
+show errors
+
+grant execute on sws_user_datastore_proc to &1;
+
+grant ctxapp to &1;
+
+-- stuff to make interMedia faster
+exec ctx_adm.set_parameter('max_index_memory', '1G');
+
+ 
+connect &1/&2
+
+-- BBoard indexing
+
+insert into table_acs_properties (table_name, section_name, user_url_stub, admin_url_stub)
+values ('bboard', 'Discussion Forums', '/bboard/redirect-for-sws.tcl?msg_id=', '/bboard/admin-q-and-a-fetch-msg.tcl');
+
+
+create or replace trigger bboard_sws_insert_tr
+  after insert on bboard for each row
+BEGIN
+  -- Only create new site wide index row if this is the start of
+  -- a new thread.
+  IF :NEW.refers_to IS NULL THEN
+     insert into site_wide_index (table_name, the_key, one_line_description, datastore)
+       values ('bboard', :new.msg_id, :new.one_line, 'a');
+  ELSE
+     -- Cause the datastore procedure to reindex this thread.
+     UPDATE site_wide_index SET datastore = 'a' 
+       WHERE table_name = 'bboard'
+       AND the_key = substr(:NEW.sort_key, 1, 6);
+  END IF;
+END;
+/
+show errors
+  
+  
+  -- No update trigger for bboard because
+  -- a) it is tricky because we are only keeping one index row per thread
+  -- b) it doesn't happen all that much, and doesn't matter when it does.
+  
+  
+CREATE OR replace trigger bboard_sws_delete_tr
+  after DELETE ON bboard FOR each row
+BEGIN
+  IF :old.refers_to IS NULL THEN
+     -- we're deleting the whole thread, remove the index row.
+     DELETE FROM site_wide_index
+       WHERE the_key = :old.msg_id
+       AND table_name = 'bboard';
+  ELSE
+     -- just reindex the thread
+     UPDATE site_wide_index
+       SET datastore = 'a'
+       WHERE the_key = substr(:old.sort_key, 1, 6)
+       AND table_name = 'bboard';
+  END IF;
+END;
+/
+show errors
+  
+  
+-- static pages indexing
+insert into table_acs_properties (table_name, section_name, user_url_stub, admin_url_stub)
+values ('static_pages', 'Static Pages', '/search/static-page-redirect.tcl?page_id=', '/admin/static/page-summary.tcl?page_id=');
+
+create or replace trigger static_pages_sws_insert_tr
+  after insert on static_pages for each row
+  WHEN (NEW.index_p = 't')
+BEGIN
+  -- we have to create a new row in the index table for this row.
+  insert into site_wide_index (table_name, the_key, one_line_description, datastore)
+    values ('static_pages', :new.page_id, :new.page_title, 'a');
+END;
+/
+show errors
+  
+
+CREATE OR replace trigger static_pages_sws_update_tr
+  after UPDATE ON static_pages FOR each row
+BEGIN
+  IF :old.index_p = 'f' AND :NEW.index_p = 't' THEN
+     insert into site_wide_index (table_name, the_key, one_line_description, datastore)
+       values ('static_pages', :new.page_id, :new.page_title, 'a');
+  ELSIF :old.index_p = 't' AND :NEW.index_p = 'f' THEN
+     DELETE FROM site_wide_index
+       WHERE table_name = 'static_pages'
+       AND the_key = :old.page_id;
+  ELSIF :NEW.index_p = 't' THEN
+     update site_wide_index 
+       set the_key = :new.page_id, one_line_description = coalesce(:new.page_title, '(no title)'), datastore = 'a'
+       where table_name = 'static_pages'
+       and the_key = :old.page_id;
+  END IF;
+end;
+/
+show errors
+  
+  
+CREATE OR replace trigger static_pages_sws_delete_tr
+  after DELETE ON static_pages FOR each row
+  WHEN (old.index_p = 't')
+BEGIN
+  DELETE FROM site_wide_index
+    WHERE table_name = 'static_pages'
+    AND the_key = :old.page_id;
+END;
+/
+show errors
+
+
+-- indexing for user comments
+insert into table_acs_properties (table_name, section_name, user_url_stub, admin_url_stub)
+  values ('comments', 'User Comments', '/comments/one.tcl?comment_id=', '/admin/comments/persistent-edit.tcl?comment_id=');
+
+CREATE OR replace FUNCTION subject_for_comment (v_page_id INTEGER) return VARCHAR IS
+   v_page_title static_pages.page_title%TYPE;
+BEGIN
+   SELECT 'Comment on <i>' || coalesce(page_title, 'untitled static page') || '</i>' INTO v_page_title
+     FROM static_pages
+     WHERE page_id = v_page_id;
+   RETURN v_page_title;
+END;
+/
+show errors
+  
+
+create or replace trigger comments_sws_insert_tr
+  after insert on comments for each row
+  WHEN (NEW.deleted_p = 'f' AND NEW.comment_type = 'alternative_perspective')
+BEGIN
+  insert into site_wide_index (table_name, the_key, one_line_description, datastore)
+    values ('comments', :new.comment_id, subject_for_comment(:NEW.page_id), 'a');
+END;
+/
+show errors
+
+CREATE OR replace trigger comments_sws_update_tr
+  after UPDATE ON comments
+  FOR each row
+  WHEN (NEW.comment_type = 'alternative_perspective')
+BEGIN
+  IF :old.deleted_p = 't' AND :NEW.deleted_p = 'f' THEN
+     insert into site_wide_index (table_name, the_key, one_line_description, datastore)
+       values ('comments', :new.comment_id, subject_for_comment(:NEW.page_id), 'a');
+  ELSIF :old.deleted_p = 'f' AND :NEW.deleted_p = 't' THEN
+     DELETE FROM site_wide_index
+       WHERE table_name = 'comments'
+       AND the_key = :old.comment_id;
+  ELSIF :NEW.deleted_p = 'f' THEN
+     update site_wide_index 
+       set the_key = :new.comment_id, one_line_description = subject_for_comment(:NEW.page_id), datastore = 'a'
+       where table_name = 'comments'
+       AND the_key = :old.comment_id;
+  END IF;
+end;
+/
+show errors
+  
+  
+CREATE OR replace trigger comments_sws_delete_tr
+  after DELETE ON comments FOR each row
+  WHEN (old.deleted_p = 'f' AND old.comment_type = 'alternative_perspective')
+BEGIN
+  DELETE FROM site_wide_index
+    WHERE table_name = 'comments'
+    AND the_key = :old.comment_id;
+END;
+/
+show errors
+  
+-- Table to support query by example. Session specific
+-- so we don't have to keep using new query_id's, as long
+-- as we clean up after each use.
+create global temporary table sws_result_table (
+	query_id	number,
+	theme		varchar(2000),
+	weight		number
+) on commit preserve rows;
+
+
+-- create intermedia index for site wide index
+begin
+  ctx_ddl.create_preference('sws_user_datastore', 'user_datastore');
+  ctx_ddl.set_attribute('sws_user_datastore', 'procedure', 'sws_user_datastore_proc');
+end;
+/
+
+create index sws_ctx_index on site_wide_index (datastore)
+indextype is ctxsys.context parameters ('datastore sws_user_datastore memory 250M');
+
+
+-- SQL to stuff the site wide index from scratch.
+-- insert into site_wide_index (table_name, the_key, one_line_description, datastore)
+-- select 'bboard', msg_id, coalesce(one_line, '(no subject)'), 'a'
+--   from bboard
+--   WHERE refers_to IS NULL;
+-- 
+-- insert into site_wide_index (table_name, the_key, one_line_description, datastore)
+-- select 'static_pages', page_id, coalesce(page_title, '(no title)'), 'a'
+-- from static_pages;
+
+-- INSERT INTO site_wide_index (table_name, the_key, one_line_description, datastore)
+--   SELECT 'comments', comment_id, subject_for_comment(page_id), 'a'
+--     FROM comments
+--     WHERE deleted_p = 'f'
+--     AND comment_type = 'alternative_perspective';
+
+
+
+-- Query to take free text user entered query and frob it into something
+-- that will make interMedia happy. Provided by Oracle.
+
+--Postgres hack (BMA)
+create function im_convert(varchar)
+returns varchar
+as '
+DECLARE
+BEGIN
+	return $1;
+END;
+' language 'plpgsql';
+
+create or replace function im_convert(
+	query in varchar2 default null
+	) return varchar2
+is
+  i   number :=0;
+  len number :=0;
+  char varchar2(1);
+  minusString varchar2(256);
+  plusString varchar2(256); 
+  mainString varchar2(256);
+  mainAboutString varchar2(500);
+  finalString varchar2(500);
+  hasMain number :=0;
+  hasPlus number :=0;
+  hasMinus number :=0;
+  token varchar2(256);
+  tokenStart number :=1;
+  tokenFinish number :=0;
+  inPhrase number :=0;
+  inPlus number :=0;
+  inWord number :=0;
+  inMinus number :=0;
+  completePhrase number :=0;
+  completeWord number :=0;
+  code number :=0;  
+begin
+  
+  len := length(query);
+
+-- we iterate over the string to find special web operators
+  for i in 1..len loop
+    char := substr(query,i,1);
+    if(char = '"') then
+      if(inPhrase = 0) then
+        inPhrase := 1;
+	tokenStart := i;
+      else
+        inPhrase := 0;
+        completePhrase := 1;
+	tokenFinish := i-1;
+      end if;
+    elsif(char = ' ') then
+      if(inPhrase = 0) then
+        completeWord := 1;
+        tokenFinish := i-1;
+      end if;
+    elsif(char = '+') then
+      inPlus := 1;
+      tokenStart := i+1;
+    elsif((char = '-') and (i = tokenStart)) then
+      inMinus :=1;
+      tokenStart := i+1;
+    end if;
+
+    if(completeWord=1) then
+      token := '{ '||substr(query,tokenStart,tokenFinish-tokenStart+1)||' }';      
+      if(inPlus=1) then
+        plusString := plusString||','||token||'*10';
+	hasPlus :=1;	
+      elsif(inMinus=1) then
+        minusString := minusString||'OR '||token||' ';
+	hasMinus :=1;
+      else
+        mainString := mainString||' NEAR '||token;
+	mainAboutString := mainAboutString||' '||token; 
+	hasMain :=1;
+      end if;
+      tokenStart  :=i+1;
+      tokenFinish :=0;
+      inPlus := 0;
+      inMinus :=0;
+    end if;
+    completePhrase := 0;
+    completeWord :=0;
+  end loop;
+
+  -- find the last token
+  token := '{ '||substr(query,tokenStart,len-tokenStart+1)||' }';
+  if(inPlus=1) then
+    plusString := plusString||','||token||'*10';
+    hasPlus :=1;	
+  elsif(inMinus=1) then
+    minusString := minusString||'OR '||token||' ';
+    hasMinus :=1;
+  else
+    mainString := mainString||' NEAR '||token;
+    mainAboutString := mainAboutString||' '||token; 
+    hasMain :=1;
+  end if;
+
+  
+  mainString := substr(mainString,6,length(mainString)-5);
+  mainAboutString := replace(mainAboutString,'{',' ');
+  mainAboutString := replace(mainAboutString,'}',' ');
+  plusString := substr(plusString,2,length(plusString)-1);
+  minusString := substr(minusString,4,length(minusString)-4);
+
+  -- we find the components present and then process them based on the specific combinations
+  code := hasMain*4+hasPlus*2+hasMinus;
+  if(code = 7) then
+    finalString := '('||plusString||','||mainString||'*2.0,about('||mainAboutString||')*0.5) NOT ('||minusString||')';
+  elsif (code = 6) then  
+    finalString := plusString||','||mainString||'*2.0'||',about('||mainAboutString||')*0.5';
+  elsif (code = 5) then  
+    finalString := '('||mainString||',about('||mainAboutString||')) NOT ('||minusString||')';
+  elsif (code = 4) then  
+    finalString := mainString;
+    finalString := replace(finalString,'*1,',NULL); 
+    finalString := '('||finalString||')*2.0,about('||mainAboutString||')';
+  elsif (code = 3) then  
+    finalString := '('||plusString||') NOT ('||minusString||')';
+  elsif (code = 2) then  
+    finalString := plusString;
+  elsif (code = 1) then  
+    -- not is a binary operator for intermedia text
+    finalString := 'totallyImpossibleString'||' NOT ('||minusString||')';
+  elsif (code = 0) then  
+    finalString := '';
+  end if;
+
+  return finalString;
+end;
+/
Index: web/openacs/www/doc/sql/spam.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/spam.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/spam.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,154 @@
+
+--
+-- spam.sql
+--
+-- created January 9, 1999 by Philip Greenspun (philg@mit.edu)
+-- modified by Tracy Adams on Sept 22, 1999 (teadams@mit.edu)
+-- modified by Henry Minsky (hqm@ai.mit.edu)
+--
+--
+-- a system for spamming classes of users and keeping track of 
+-- what the publisher said
+
+-- use this to prevent double spamming if user hits submit twice 
+
+create sequence spam_id_sequence;
+
+create table spam_history (
+	spam_id			integer primary key,
+	from_address		varchar(100),
+	pathname		varchar(700),
+	title			varchar(200),
+	template_p		char(1) default 'f' check (template_p in ('t','f')),
+	-- message body text in multiple formats
+	-- text/plain, text/aol-html, text/html
+ 	body_plain		lztext,
+ 	body_aol		lztext,
+ 	body_html		lztext,
+	-- query which over users_spammable.* to enumerate the recipients of this spam
+	user_class_query	varchar(4000),
+	creation_date		datetime not null,
+	-- to which users did we send this?
+	user_class_description	varchar(4000),
+	creation_user		integer not null references users(user_id),
+	creation_ip_address	varchar(50) not null,
+	send_date		datetime,
+	-- we'll increment this after every successful email
+	n_sent			integer default 0,
+	-- values: unsent, sending, sent, cancelled
+	status			varchar(16),
+	-- keep track of the last user_id we sent a copy of this spam to
+	-- so we can resume after a server restart
+	last_user_id_sent	integer references users(user_id),
+	begin_send_time		datetime,
+	finish_send_time	datetime
+);
+
+-- table for administrator to set up daily spam file locations
+create table daily_spam_files (
+	file_prefix 		varchar(400),
+	subject			varchar(2000),
+	target_user_class_id	integer,
+	user_class_description	varchar(4000),
+	from_address		varchar(200),
+	template_p		char(1) default 'f' check (template_p in ('t','f')),
+	period			varchar(64) default 'daily' check (period in ('daily','weekly', 'monthly', 'yearly'))
+);
+
+
+-- pl/sql proc to guess email type
+
+create table default_email_types  (
+ pattern 	varchar(200),
+ mail_type 	varchar(64)
+);
+
+-- Here are some default values. Overriden by server startup routine in /tcl/spam-daemon.tcl
+insert into default_email_types (pattern, mail_type) values ('%hotmail.com',  'text/html');
+insert into default_email_types (pattern, mail_type) values ('%aol.com',      'text/aol-html');
+insert into default_email_types (pattern, mail_type) values ('%netscape.net', 'text/html');
+
+-- function to guess an email type, using the default_email_types patterns table
+
+-- DRB: quick hack, the table's small so hitting twice should be no big
+-- deal.
+
+CREATE FUNCTION guess_user_email_type (varchar) RETURNS varchar AS '
+DECLARE
+  v_email alias for $1;
+  pattern_count integer;
+BEGIN
+  pattern_count := count(*) from default_email_types
+                   where upper(v_email) like upper(pattern);
+  IF (pattern_count > 0)
+  THEN
+    RETURN mail_type from default_email_types 
+      where upper(v_email) like upper(pattern) limit 1;
+  END IF;
+-- default 
+  RETURN ''text/plain'';
+END;' language 'plpgsql';
+
+-- DRB: how the hell would one recycle a user_id?  Even if you nuke and
+-- delete user doesn't know about your table, the sequence is monotonically
+-- increasing.  I simplied this.
+
+CREATE FUNCTION guess_email_pref() RETURNS opaque AS '
+BEGIN
+   INSERT INTO users_preferences (user_id, email_type) VALUES (new.user_id, guess_user_email_type(new.email));
+  RETURN new;
+END;' language 'plpgsql';
+
+-- Trigger on INSERT into users which guesses users preferred email type
+-- based on their email address
+CREATE TRIGGER guess_email_pref_tr 
+AFTER INSERT ON users
+FOR EACH ROW EXECUTE PROCEDURE guess_email_pref();
+
+-- DRB: We do need to handle the case of a user updating their e-mail, though,
+-- which is probably what was done by the previous PL/SQL code which I dissed
+-- above.
+
+CREATE FUNCTION guess_email_pref_update() RETURNS opaque AS '
+BEGIN
+   UPDATE users_preferences SET email_type = guess_user_email_type(new.email) WHERE user_id = new.user_id;
+  RETURN new;
+END;' language 'plpgsql';
+
+-- Trigger on UPDATE of users which guesses users preferred email type
+-- based on their email address
+CREATE TRIGGER guess_email_pref_update_tr 
+AFTER UPDATE ON users
+FOR EACH ROW EXECUTE PROCEDURE guess_email_pref_update();
+
+-- DRB: we'll do this one later...it's a conversion routine for existing intallations that
+-- predate the existence of the users_preferences tables (thus the INSERT) or the email_type
+-- column within the table (thus the UPDATE).  The lack of this shouldn't impact fresh
+-- installations.
+
+-- loop over all users, lookup users_prefs.email_type.
+-- if email_type is null, set it to default guess based on email addr.
+--CREATE OR REPLACE PROCEDURE init_email_types 
+--IS
+--   CURSOR c1 IS
+--      SELECT up.user_id as prefs_user_id, users.email, users.user_id from users, users_preferences up
+--	WHERE users.user_id = up.user_id(+);
+--   prefs_user_id users_preferences.user_id%TYPE;
+--
+--BEGIN
+--   FOR c1_val IN c1 LOOP
+--	-- since we did an outer join, if the user_prefs user_id field is null, then
+--	-- no record exists, so do an insert. Else do an update
+--	IF c1_val.prefs_user_id IS NULL THEN
+--	 INSERT INTO users_preferences (user_id, email_type) 
+--		values (c1_val.user_id, guess_user_email_type(c1_val.email));
+--	ELSE UPDATE users_preferences set email_type = guess_user_email_type(c1_val.email)
+--	 	WHERE user_id = c1_val.user_id;
+--	END IF;
+--   END LOOP;
+--   COMMIT;
+--END init_email_types;
+--/
+--show errors
+--
+
Index: web/openacs/www/doc/sql/survey-simple.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/survey-simple.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/survey-simple.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,165 @@
+-- /www/doc/sql/survey-simple.sql
+--
+-- based on student work from 6.916 in Fall 1999
+-- which was in turn based on problem set 4
+-- in http://photo.net/teaching/one-term-web.html
+--
+-- by philg@mit.edu and raj@alum.mit.edu on February 9, 2000
+-- 
+-- survey-simple.sql,v 1.5.2.1 2000/03/18 02:01:26 ron Exp 
+
+-- we expect this to be replaced with a more powerful survey
+-- module, to be developed by buddy@ucla.edu, so we prefix
+-- all of our Oracle structures with "survsimp"
+
+--drop sequence survsimp_survey_id_sequence;
+create sequence survsimp_survey_id_sequence start 1;
+
+--drop table survsimp_surveys;
+create table survsimp_surveys (
+	survey_id		integer primary key,
+	name			varchar(100) not null,
+	-- short, non-editable name we can identify this survey by
+	short_name		varchar(20) unique not null,
+	description		varchar(4000) not null,
+	creation_user		integer not null references users(user_id),
+	creation_date	      	date default sysdate(),
+	enabled_p               char(1) default 'f' check(enabled_p in ('t','f'))
+);
+
+
+
+--drop sequence survsimp_question_id_sequence;
+create sequence survsimp_question_id_sequence start 1;
+
+
+-- each question can be 
+
+--drop table survsimp_questions;
+create table survsimp_questions (
+	question_id		integer primary key,
+	survey_id		integer not null references survsimp_surveys,
+	sort_key		integer not null,
+--	question_text		clob not null,
+	question_text		lztext not null,
+	-- can be 'text', 'shorttext', 'boolean', 'number', 'integer', 'choice'
+        abstract_data_type      varchar(30) not null,
+	required_p		char(1) check (required_p in ('t','f')),
+	active_p		char(1) check (active_p in ('t','f')),
+	presentation_type	varchar(20) not null
+				check(presentation_type in ('textbox','textarea','select','radio', 'checkbox', 'date')),
+	-- for text, "small", "medium", "large" sizes
+	-- for textarea, "rows=X cols=X"
+	presentation_options	varchar(50),
+	presentation_alignment	varchar(15) default 'below'
+            			check(presentation_alignment in ('below','beside')),       
+	creation_user		integer references users not null,
+	creation_date		date default sysdate()
+);
+
+
+-- Categorization:  We'd like each question to belong
+-- to a category.  For example, if we write a survey
+-- about a client project, we want to categorize questions
+-- as "client" or "internal". Other surveys might want
+-- to group questions according to category.
+-- To categorize questions, we use the site wide
+-- category system.
+
+-- Categories will be stored in categories table
+-- with category_type as "survsimp"
+
+-- The site_wide_category_map table will map
+-- categories to individual surveys.  The site_wide_category_map
+-- will also map categories to individual questions.
+
+
+-- for when a question has a fixed set of responses
+
+--drop sequence survsimp_choice_id_sequence;
+create sequence survsimp_choice_id_sequence start 1;
+
+--drop table survsimp_question_choices;
+create table survsimp_question_choices (
+	choice_id	integer not null primary key,
+	question_id	integer not null references survsimp_questions,
+	-- human readable 
+	label		varchar(500) not null,
+	-- might be useful for averaging or whatever, generally null
+	numeric_value	numeric,
+	-- lower is earlier 
+	sort_order	integer
+);
+
+
+
+--drop sequence survsimp_response_id_sequence;
+create sequence survsimp_response_id_sequence start 1;
+
+-- this records a response by one user to one survey
+-- (could also be a proposal in which case we'll do funny 
+--  things like let the user give it a title, send him or her
+--  email if someone comments on it, etc.)
+
+--drop table survsimp_responses;
+create table survsimp_responses (
+	response_id		integer primary key,
+	survey_id		integer not null references survsimp_surveys,
+	-- scope is user, public or group
+	scope           varchar(20),
+	user_id			integer references users,
+	group_id		integer references user_groups,
+	constraint survsimp_responses_scopecheck check 
+		((scope='group' and group_id is not null) 
+                 or (scope='public' and group_id is null)
+		or (scope='user' and group_id is null)),
+	title			varchar(100),
+	submission_date		date default sysdate() not null,
+	ip_address		varchar(50),
+	-- do we sent email if 
+	notify_on_comment_p	char(1) default 'f'
+				check(notify_on_comment_p in ('t','f')),
+	-- proposal can be public, private, or deleted
+	proposal_state		varchar(30) default 'private'
+				check(proposal_state in ('public','private', 'deleted'))
+	-- This did not work for how we tried to use it
+	-- (we wanted users to take the survey each week).
+	-- If the survey should be unique to a user, this
+	-- should be handled by an ini parameter
+	-- unique (survey_id, user_id)
+);
+
+
+-- this table stores the answers to each question for a survey
+-- we want to be able to hold different data types in one long skinny table 
+-- but we also may want to do averages, etc., so we can't just use CLOBs
+
+--drop table survsimp_question_responses;
+create table survsimp_question_responses (
+	response_id		integer not null references survsimp_responses,
+	question_id		integer not null references survsimp_questions,
+	-- if the user picked a canned response
+	choice_id		integer references survsimp_question_choices,
+	boolean_answer		char(1) check(boolean_answer in ('t','f')),
+--	clob_answer		clob,
+	clob_answer		lztext,
+	number_answer		numeric,
+	varchar_answer		varchar(4000),
+	date_answer		date
+);
+
+--drop index survsimp_response_index;
+create index survsimp_response_index on survsimp_question_responses (response_id, question_id);
+
+-- used in survsimp/admin/one.tcl
+
+--drop view survsimp_category_map;
+create view survsimp_category_map 
+as
+select * 
+  from  site_wide_category_map
+  where site_wide_category_map.on_which_table = 'survsimp_questions';
+
+
+select administration_group_add ('Simple Survey System Staff', short_name_from_group_name('survsimp'), 'survsimp', '', 'f', '/survsimp/admin/');
+
Index: web/openacs/www/doc/sql/table-metadata.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/table-metadata.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/table-metadata.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,193 @@
+--
+-- /www/doc/sql/table-metadata.sql
+--
+-- This is the main table containing metadata about tables in the system.  Currently it's used
+-- only by the general permissions administration, in order to generate UI
+--
+-- Author: markc@arsdigita.com, March 2000
+-- 
+-- table-metadata.sql,v 3.1 2000/03/12 00:09:03 markc Exp
+--
+
+create table general_table_metadata (
+    table_name varchar(30) primary key,
+    -- pretty name for the type of object that inhabits this table. e.g. "user group"
+    pretty_table_name_singular varchar(50) not null,
+    -- same as above, but plural. e.g. "user groups"
+    pretty_table_name_plural varchar(50) not null,
+    id_column_name varchar(50) not null,
+    -- the name of a view created by joining this row with others that might
+    -- be useful for viewing, sorting, selecting on, etc.
+    -- if you don't have anything to join in, you can set this equal to the table name
+    denorm_view_name varchar(30) not null,
+    -- either a column from the denorm view or a valid SQL select
+    -- list item e.g. "first_names || ' '|| last_name" for the
+    -- users table.  This should be displayable in a single line.
+    one_line_row_descriptor varchar(4000) not null
+);
+
+--
+-- this table lists the columns from the denormalized 
+-- view that should be included in a standard view of the record
+--
+
+
+create table table_metadata_denorm_columns (
+    table_name varchar(30) references general_table_metadata,
+    -- this is a column in the denormalized view, not the base table
+    column_name varchar(50) not null,
+    column_pretty_name varchar(50) not null,
+    display_ordinal integer not null,
+    is_date_p char(1) default 'f' check (is_date_p in ('t','f')),
+    use_as_link_p char(1) default 'f' check (use_as_link_p in ('t','f')),
+    primary key(table_name,column_name)
+);
+
+
+create view fs_versions_denorm_view as (
+    select
+        fs_versions.file_id,
+        file_title,
+        folder_p,
+        owner_id,
+        public_p,
+        fs_versions.version_id,
+        version_description,
+        creation_date,
+        client_file_name,
+        file_type,
+        file_extension,
+        n_bytes, 
+        author_id,
+        author_user.first_names || ' ' || author_user.last_name as author_name,
+        owner_user.first_names || ' ' || owner_user.last_name as owner_name,
+        deleted_p
+    from
+        fs_versions,
+        fs_files,
+        users author_user,
+        users owner_user
+    where
+        fs_versions.author_id = author_user.user_id and
+        fs_files.owner_id = owner_user.user_id and
+        fs_versions.file_id = fs_files.file_id
+);
+
+
+insert into general_table_metadata (
+    table_name,
+    pretty_table_name_singular,
+    pretty_table_name_plural,
+    id_column_name,
+    denorm_view_name,
+    one_line_row_descriptor
+) values (
+    'FS_VERSIONS',
+    'stored file version',
+    'stored file versions',
+    'VERSION_ID',
+    'FS_VERSIONS_DENORM_VIEW',
+    'file_title || '' '' || author_name'   
+);
+
+
+
+
+insert into table_metadata_denorm_columns (
+    table_name,
+    column_name,
+    column_pretty_name,
+    display_ordinal,
+    is_date_p
+) values (
+    'FS_VERSIONS',
+    'version_id',
+    'Version ID',
+    0,
+    'f'
+);
+
+
+insert into table_metadata_denorm_columns (
+    table_name,
+    column_name,
+    column_pretty_name,
+    display_ordinal,
+    is_date_p,
+    use_as_link_p
+) values (
+    'FS_VERSIONS',
+    'file_title',
+    'File Title',
+    1,
+    'f',
+    't'
+);
+
+insert into table_metadata_denorm_columns (
+    table_name,
+    column_name,
+    column_pretty_name,
+    display_ordinal,
+    is_date_p
+) values (
+    'FS_VERSIONS',
+    'author_name',
+    'Author Name',
+    2,
+    'f'
+);
+
+insert into table_metadata_denorm_columns (
+    table_name,
+    column_name,
+    column_pretty_name,
+    display_ordinal,
+    is_date_p
+) values (
+    'FS_VERSIONS',
+    'creation_date',
+    'Creation Date',
+    3,
+    't'
+);
+
+insert into table_metadata_denorm_columns (
+    table_name,
+    column_name,
+    column_pretty_name,
+    display_ordinal,
+    is_date_p
+) values (
+    'FS_VERSIONS',
+    'version_description',
+    'Version Description',
+    4,
+    'f'
+);
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/doc/sql/threads.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/threads.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/threads.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,59 @@
+--
+-- Threads. A new way to organize your life.
+-- by Ben Adida (ben@adida.net)
+--
+
+create sequence thread_id_sequence;
+
+create table threads (
+       thread_id     integer not null primary key,
+       thread_name   varchar(200),
+       start_date     datetime,
+       end_date	     datetime,
+       priority	     integer not null check (priority >= 1 AND priority <= 9),
+       -- A thread can be: blocked if waiting input from someone else, suspended
+       -- if not important for now, and active if being actively pursued.
+       thread_state  varchar(100) not null check (thread_state in ('blocked', 'suspended', 'active')),
+       description   varchar(4000)
+);
+
+-- Who can access what thread
+create table thread_user_map (
+       thread_id	     integer not null references threads,
+       user_id		     integer not null references users,
+       primary key (thread_id, user_id)
+);
+
+create function user_can_see_thread_p(integer, integer)
+returns char as '
+DECLARE
+	v_user_id alias for $1;
+	v_thread_id alias for $2;
+	v_count integer;
+BEGIN
+	select count(*) into v_count from thread_user_map where thread_id= v_thread_id
+	and user_id= v_user_id;
+	if v_count > 0
+	then return ''t'';
+	else return ''f'';
+	end if ;
+END;
+' language 'plpgsql';
+
+create sequence note_id_sequence;
+
+create table notes (
+       note_id	   integer not null primary key,
+       user_id	   integer not null references users,
+       thread_id   integer not null references threads,
+       note_date   datetime,
+       content	   varchar(4000)
+);
+
+-- Some notes might link to a new thread
+create table note_thread_map (
+       note_id		     integer not null references notes,
+       thread_id	     integer not null references threads,
+       primary key (note_id, thread_id)
+);
+       
Index: web/openacs/www/doc/sql/ticket.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/ticket.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/ticket.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,321 @@
+-- Ticket tracker
+-- v 2.2
+-- create an administration group for ticket tracker administration
+
+begin
+   administration_group_add ('Ticket Admin Staff', short_name_from_group_name('ticket'), 'ticket', NULL, 'f', '/ticket/admin/');
+end;
+/
+
+
+create sequence ticket_project_id_sequence start with 1;
+
+create table ticket_projects (
+	project_id	integer not null primary key,
+	title		varchar(100),
+	-- person who request the project and will be the owner
+	customer_id	integer not null references users,
+	start_date	date,
+	end_date	date,
+	-- person who gets defaultly assigned to new tickets in the project	
+	default_assignee integer references users,
+	group_id	references user_groups
+);
+
+-- we need at least one project in any system, "Incoming" for 
+-- random incoming email
+
+-- since this has a hard-wired project_id, constrained to be primary 
+-- key, we're not in any danger of creating dupe projects
+
+insert into ticket_projects 
+(project_id, customer_id, title, start_date)
+values
+(0, system_user_id, 'Incoming', sysdate);
+
+-- A table to assign people to projects
+
+create sequence ticket_assignment_id_sequence;
+
+create table ticket_assignments (
+	assignment_id	integer not null primary key,
+	project_id	integer references ticket_projects,
+	user_id	 	integer references users,
+	rate		integer, -- e.g. 125
+	purpose		varchar(4000), -- e.g. "HTML, Java, etc..."
+	-- we add this active flag in case someone gets taken off the
+	-- project.
+	active_p	char(1) check (active_p in ('t','f'))
+);
+
+
+-------------- From The Community System ---------------
+-- table state, country_codes, users
+--------------------------------------------------------
+
+create table ticket_priorities (
+        priority                integer not null primary key,
+        name                    varchar(20)
+);
+
+insert into ticket_priorities values (3, 'low');
+insert into ticket_priorities values (2, 'medium');
+insert into ticket_priorities values (1, 'high');
+
+create sequence ticket_issue_id_sequence;
+
+create table ticket_issues (
+        msg_id                  integer not null primary key,
+        project_id              integer not null references ticket_projects,
+        user_id                 references users,
+	group_id		references user_groups,
+        posting_time            date not null,
+        modification_time       date,
+	ticket_type		varchar(100), -- {ticket, service_ticket, bug, feature_request}
+        one_line                varchar(700),
+        message                 clob default empty_clob(),
+        indexed_stuff           clob default empty_clob(), -- for context index
+        close_date              date,
+        closed_by               integer references users,
+        -- When it is important for it to be finished.
+        deadline                date,
+	-- Status: open, waiting assignment, development, fixed waiting approval, closed 
+	status			varchar(100),
+        priority                integer not null references ticket_priorities,
+	severity		varchar(100),
+	-- who was responsible for creating this message
+        source                  varchar(100), 
+	-- user name who last modified 
+        last_modified_by        varchar(200), 
+	-- When was the last "nag" notification sent 
+	last_notification	date,
+	-- Ticket author's contact info
+	contact_name		varchar(200),
+	contact_email		varchar(200),
+	contact_info1		varchar(700),
+	contact_info2		varchar(700),
+	-- product-specific fields
+	data1			varchar(700),
+	data2			varchar(700),
+	data3			varchar(700),
+	data4			varchar(700),
+	data5			varchar(700),
+	-- is this ticket visible to customers
+	public_p		char(1) default('t') check(public_p in ('t','f')),
+	-- if notify_p is 't', member of that project will receive notification email
+	notify_p		char(1) default('t') check(notify_p in ('t','f'))
+);
+
+
+create or replace trigger ticket_modification_time
+before insert or update on ticket_issues
+for each row
+when (new.modification_time is null)
+begin
+ :new.modification_time :=SYSDATE;
+end;
+/
+show errors
+
+-- the ticket_changes table can reference ticket_issues
+-- but only in Oracle 8.1.5 or newer; Oracle 8.0.5 gets 
+-- bent out of shape with a mutating trigger from
+-- ticket_activity_logger
+
+--- keep track of changes to a ticket
+create table ticket_changes (
+  msg_id    integer not null, -- references ticket_issues
+  who 	    varchar(256),
+  what      varchar(256),
+  old_value varchar(256),
+  new_value varchar(256),
+  modification_date  date
+);
+
+create index ticket_changes_by_msg_id on ticket_changes(msg_id);
+
+-- track changes to tickets
+create or replace trigger ticket_activity_logger
+after update on ticket_issues
+for each row
+begin
+  if (:old.project_id <> :new.project_id) then
+   insert into ticket_changes (msg_id, who, what, old_value, new_value, modification_date)
+   values
+   (:new.msg_id, :new.last_modified_by, 'Project ID', :old.project_id, :new.project_id, sysdate);
+  end if;
+
+  if (:old.ticket_type <> :new.ticket_type) then
+   insert into ticket_changes (msg_id, who, what, old_value, new_value, modification_date)
+   values
+   (:new.msg_id, :new.last_modified_by, 'Ticket Type', :old.ticket_type, :new.ticket_type, sysdate);
+  end if;
+
+  if (:old.one_line <> :new.one_line) then
+   insert into ticket_changes (msg_id, who,what, old_value, new_value, modification_date) 
+   values
+   (:new.msg_id, :new.last_modified_by, 'Synopsis', :old.one_line, :new.one_line, sysdate);
+  end if;
+
+  if (:old.deadline <> :new.deadline) then
+   insert into ticket_changes (msg_id, who,what, old_value, new_value, modification_date) 
+   values
+   (:new.msg_id, :new.last_modified_by, 'Deadline', :old.deadline, :new.deadline, sysdate);
+  end if;
+
+  if (:old.status <> :new.status) then
+   insert into ticket_changes (msg_id, who,what, old_value, new_value, modification_date) 
+   values
+   (:new.msg_id, :new.last_modified_by, 'Status', :old.status, :new.status, sysdate);
+  end if;
+
+  if (:old.priority <> :new.priority) then
+   insert into ticket_changes (msg_id, who,what, old_value, new_value, modification_date) 
+   values
+   (:new.msg_id, :new.last_modified_by, 'Priority', :old.priority, :new.priority, sysdate);
+  end if;
+
+  if (:old.severity <> :new.severity) then
+   insert into ticket_changes (msg_id, who,what, old_value, new_value, modification_date) 
+   values
+   (:new.msg_id, :new.last_modified_by, 'Severity', :old.severity, :new.severity, sysdate);
+  end if;
+
+-- These are custom fields -- the column title will need  to
+--  be kept up to date 
+-- manually 
+
+
+  if (:old.data1 <> :new.data1) then
+   insert into ticket_changes (msg_id, who,what, old_value, new_value, modification_date) 
+   values
+   (:new.msg_id, :new.last_modified_by, 'Hardware_model', :old.data1, :new.data1, sysdate);
+  end if;
+
+  if (:old.data2 <> :new.data2) then
+   insert into ticket_changes (msg_id, who,what, old_value, new_value, modification_date) 
+   values
+   (:new.msg_id, :new.last_modified_by, 'Software_version', :old.data2, :new.data2, sysdate);
+  end if;
+
+  if (:old.data3 <> :new.data3) then
+   insert into ticket_changes (msg_id, who,what, old_value, new_value, modification_date) 
+   values
+   (:new.msg_id, :new.last_modified_by, 'Software_version', :old.data2, :new.data2, sysdate);
+  end if;
+
+  if (:old.data4 <> :new.data4) then
+   insert into ticket_changes (msg_id, who,what, old_value, new_value, modification_date) 
+   values
+   (:new.msg_id, :new.last_modified_by, 'Build', :old.data4, :new.data4, sysdate);
+  end if;
+end;
+/
+show errors
+
+
+
+
+
+--- a table to assign users to  issues
+--- the selection list for this will be the
+--- ticket_assignments table constrained by the appropriate project
+
+
+create table ticket_issue_assignments (
+	msg_id		integer not NULL references ticket_issues,
+	user_id		integer not null references users,
+	purpose		varchar(4000), -- e.g. "HTML, Java, etc..."
+	-- we add this active flag in case someone gets taken off the
+	-- issue.
+	active_p	char(1) check (active_p in ('t','f')),
+	unique (msg_id, user_id)
+);
+
+-- cross reference table mapping issues to other issues
+create table ticket_xrefs (
+       from_ticket references ticket_issues(msg_id),
+       to_ticket references ticket_issues(msg_id)
+);
+
+
+create sequence ticket_response_id_sequence;
+
+create table ticket_issue_responses (
+        response_id             integer not null primary key,
+        response_to             integer not null references ticket_issues,
+        user_id                 references users,
+        posting_time            date not null,
+	public_p		char(1) default('t') check(public_p in ('t','f')),
+        message                 clob default empty_clob()
+);
+
+
+-- update the ticket's modification timestamp
+create or replace trigger response_modification_time
+before insert or update on ticket_issue_responses
+for each row
+begin
+  update ticket_issues set modification_time = SYSDATE 
+  where msg_id = :new.response_to;
+end;
+/
+show errors
+
+
+create table ticket_issue_notifications (
+        msg_id                  integer not null references ticket_issues,
+        user_id                 integer not null references users,
+        primary key (msg_id, user_id)
+);
+
+
+-- called by /tcl/email-queue.tcl 
+-- and /ticket/issue-response-2.tcl 
+create or replace procedure ticket_update_for_response(v_response_id IN integer)
+AS
+ v_response_row ticket_issue_responses%ROWTYPE;
+ v_indexed_stuff clob;
+BEGIN
+ select ticket_issue_responses.* into v_response_row
+   from ticket_issue_responses
+   where response_id = v_response_id;
+
+ if v_response_row.message is not null then 
+   select indexed_stuff into v_indexed_stuff
+     from ticket_issues
+     where msg_id = v_response_row.response_to
+     for update;
+   dbms_lob.append(v_indexed_stuff, v_response_row.message);
+ end if;
+END;
+/
+show errors
+
+
+create or replace function ticket_one_if_high_priority (priority IN integer, status IN varchar)
+return integer
+is
+BEGIN
+  IF ((priority = 1) AND (status <> 'closed') AND (status <> 'deferred')) THEN
+    return 1;
+  ELSE 
+    return 0;   
+  END IF;
+END ticket_one_if_high_priority;
+/
+show errors
+
+create or replace function ticket_one_if_blocker (severity IN varchar, status IN varchar)
+return integer
+is
+BEGIN
+  IF ((severity = 'showstopper') AND (status <> 'closed') AND (status <> 'deferred')) THEN
+    return 1;
+  ELSE 
+    return 0;   
+  END IF;
+END ticket_one_if_blocker;
+/
+show errors
+
Index: web/openacs/www/doc/sql/todo-ticket.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/todo-ticket.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/todo-ticket.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,262 @@
+
+--
+-- Integration of todo/ticket
+--
+
+create table todo_item_ticket_map (
+       item_id			  integer not null references todo_items,
+       issue_id			  integer not null references ticket_issues,
+       primary key(item_id, issue_id)
+);
+
+
+alter table todo_items add (
+      no_trigger       integer
+);
+
+alter table ticket_issues add (
+      no_trigger	  integer
+);
+
+
+-- a procedure to get the todo_list_id for issues for a particular user
+create function todo_get_ticket_list_id(integer)
+returns integer as '
+DECLARE
+	v_user_id alias for $1;
+	v_check integer;
+	v_list_id integer;
+BEGIN
+	select count(*) into v_check
+	from todo_lists where user_id=v_user_id and list_name=''TICKETS'';
+
+	if v_check=0
+	THEN 
+	     select nextval(''todo_list_id_sequence'') into v_list_id from dual;
+	     insert into todo_lists (list_id, user_id, list_name, creation_date)
+	     VALUES (v_list_id, v_user_id, ''TICKETS'', sysdate);
+	ELSE
+		select list_id into v_list_id from todo_lists where user_id=v_user_id
+		and list_name=''TICKETS'';
+	END IF;
+
+	return(v_list_id);
+END;
+' language 'plpgsql';
+
+
+-- a procedure to turn an issue into a todo
+create function issue_to_todo(integer, integer, datetime, datetime, varchar)
+returns void as '
+DECLARE
+	v_issue_id alias for $1;
+	v_user_id alias for $2;
+	deadline alias for $3;
+	close alias for $4;
+	subject alais for $5;
+	v_item_id integer;
+	v_list_id integer;
+	v_check integer;
+BEGIN
+	v_list_id:= todo_get_ticket_list_id(v_user_id);
+
+	select count(*) into v_check 
+	from todo_items, todo_item_ticket_map
+	where list_id= v_list_id and issue_id=v_issue_id 
+	and todo_items.item_id= todo_item_ticket_map.item_id;
+
+	if v_check = 0
+	THEN 
+	     select nextval(''todo_item_id_sequence'') into v_item_id from dual;
+	     INSERT INTO todo_items (item_id, list_id, priority, creation_date,
+				    due_date, completion_date, item_details) VALUES
+				    (v_item_id, v_list_id, 1, sysdate(),
+				    deadline, close,
+				    ''<a href=/ticket/issue-view.tcl?msg_id='' || v_issue_id || ''>TICKET '' || v_issue_id || ''</a>: '' || subject);
+	     INSERT INTO todo_item_ticket_map (item_id, issue_id) VALUES (v_item_id, v_issue_id);
+	ELSE
+		select todo_items.item_id into v_item_id
+		from todo_items, todo_item_ticket_map
+		where list_id= v_list_id and issue_id=v_issue_id 
+		and todo_items.item_id= todo_item_ticket_map.item_id;
+
+	     UPDATE todo_items set
+	     due_date= deadline,
+	     completion_date= close,
+	     no_trigger= 1
+	     WHERE item_id=v_item_id;
+	END IF;
+END;
+' language 'plpgsql';
+
+
+create function issue_remove_todo (integer, integer)
+returns void as '
+DECLARE
+	v_issue_id alias for $1;
+	v_user_id alias for $2;
+	v_item_id INTEGER;
+	v_list_id INTEGER;
+	v_check INTEGER;
+BEGIN
+	v_list_id:= todo_get_ticket_list_id(v_user_id);
+
+	select count(*) into v_check 
+	from todo_items, todo_item_ticket_map
+	where list_id= v_list_id and issue_id=v_issue_id 
+	and todo_items.item_id= todo_item_ticket_map.item_id;
+
+	if v_check > 0
+	then
+		select todo_items.item_id into v_item_id
+		from todo_items, todo_item_ticket_map
+		where list_id= v_list_id and issue_id=v_issue_id 
+		and todo_items.item_id= todo_item_ticket_map.item_id;
+
+		delete from todo_item_ticket_map where issue_id=v_issue_id
+		and item_id= v_item_id;
+		delete from todo_items where item_id=v_item_id;
+	END IF;
+END;
+' language 'plpgsql';
+
+-- a trigger when a user is assigned
+create function trig_ticket_update_todo() returns opaque
+as '
+DECLARE
+	CURSOR loop_through_users FOR
+	select user_id from ticket_issue_assignments where msg_id=OLD.msg_id;
+BEGIN
+	IF NEW.no_trigger is not null
+	THEN
+		NEW.no_trigger:= null;
+		RETURN;
+	END IF;
+
+	FOR user_data IN loop_through_users LOOP
+	    perform issue_to_todo(OLD.msg_id, user_data.user_id, NEW.deadline, NEW.fix_date, NEW.one_line);
+	END LOOP;
+
+	RETURN NEW;
+END;
+' language 'plpgsql';
+
+create trigger ticket_update_todo
+BEFORE UPDATE on ticket_issues
+FOR EACH ROW
+execute procedure trig_ticket_update_todo();
+
+
+-- trigger when removing an issue
+create function trig_ticket_delete_todo() returns opaque
+as ' 
+DECLARE
+	CURSOR loop_through_users FOR
+	select user_id from ticket_issue_assignments where msg_id=OLD.msg_id;
+BEGIN
+	FOR user_data IN loop_through_users LOOP
+	    issue_remove_todo(OLD.msg_id, user_data.user_id);
+	END LOOP;
+	
+	RETURN NEW;
+END;
+' language 'plpgsql';
+
+create trigger ticket_delete_todo
+BEFORE DELETE on ticket_issues
+FOR EACH ROW
+EXECUTE procedure trig_ticket_delete_todo();
+
+-- trigger on assignments
+create function trig_insert_ticket_assignment() returns opaque
+as '
+DECLARE
+	v_ticket_issue ticket_issues%ROWTYPE;
+BEGIN
+	select * into v_ticket_issue 
+	from ticket_issues
+	where msg_id= NEW.msg_id;
+
+	perform issue_to_todo(NEW.msg_id, NEW.user_id, v_ticket_issue.deadline, v_ticket_issue.close_date, v_ticket_issue.one_line);
+	
+	return NEW;
+END;
+' language 'plpgsql';
+
+CREATE trigger insert_ticket_assignment
+AFTER INSERT on ticket_issue_assignments
+FOR EACH ROW
+execute procedure trig_insert_ticket_assignment();
+
+-- delete an assignment
+create function trig_delete_ticket_assignment() returns opaque
+as '
+DECLARE
+BEGIN
+	perform issue_remove_todo(OLD.msg_id, OLD.user_id);
+	return NEW;
+END;
+' language 'plpgsql';
+
+CREATE trigger delete_ticket_assignment
+BEFORE DELETE on ticket_issue_assignments
+FOR EACH ROW
+execute procedure trig_delete_ticket_assignment();
+
+-- trigger on todo update
+create function trig_todo_update_ticket() returns opaque
+as '
+DECLARE
+	v_check INTEGER;
+	v_issue_id INTEGER;
+	v_user_id  INTEGER;
+BEGIN
+	IF NEW.no_trigger is not null
+	THEN
+		NEW.no_trigger:= null;
+		RETURN NULL;
+	END IF;
+
+	select count(*) into v_check from todo_item_ticket_map
+	where item_id=OLD.item_id;
+
+	if v_check > 0
+	THEN
+		select user_id into v_user_id from todo_lists where list_id=NEW.list_id;
+
+		select issue_id into v_issue_id from todo_item_ticket_map
+		where item_id=OLD.item_id;
+
+		update ticket_issues set
+		deadline= NEW.due_date,
+		status= case when NEW.completion_date is NULL then ''open'' else ''fixed waiting approval'' end,
+		modification_time= sysdate(),
+		last_modified_by= v_user_id,
+		no_trigger= 1
+		where
+		msg_id= v_issue_id;
+	END IF;
+	
+	RETURN NEW;
+END;
+' language 'plpgsql';
+
+CREATE trigger todo_update_ticket
+BEFORE UPDATE on todo_items
+FOR EACH ROW
+execute procedure trig_todo_update_ticket();
+
+-- a trigger for when a todo is deleted from the todo-list
+create function trig_todo_delete_ticket() returns opaque 
+as '
+DECLARE
+BEGIN
+	delete from todo_item_ticket_map where item_id= OLD.item_id;
+END;
+' language 'plpgsql';
+
+
+create trigger todo_delete_ticket
+BEFORE DELETE ON todo_items
+FOR EACH ROW
+execute procedure trig_todo_delete_ticket();
\ No newline at end of file
Index: web/openacs/www/doc/sql/todo.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/todo.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/todo.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,265 @@
+--
+-- a data model for "to do lists"
+--
+-- by Ben Adida (ben@mit.edu)
+
+create sequence todo_list_id_sequence;
+
+create table todo_lists (
+	list_id		integer not null primary key,
+	user_id		integer not null references users,
+	list_name	varchar(100),
+	list_details	varchar(4000),
+	creation_date	datetime,
+	public_p	char(1) default 'f' check (public_p in ('t', 'f')),
+	due_date	datetime
+);
+
+create index todo_lists_by_user_id on todo_lists(user_id);
+
+--
+-- A table that says which users are allowed to assign things
+-- to another list for another user
+--
+
+create table todo_list_user_map (
+	list_id			integer not null references todo_lists,
+	user_id			integer not null references users,
+	automatic_approval	char(1) default 't' check (automatic_approval in ('t','f')),
+	primary key (list_id, user_id)
+);
+
+create table todo_list_user_group_map (
+       list_id			integer not null references todo_lists,
+       user_group_id		integer not null references user_groups,
+       primary key (list_id, user_group_id)
+);
+
+create sequence todo_item_id_sequence;
+
+create table todo_items (
+	item_id		integer not null primary key,
+	list_id		integer not null references todo_lists,
+	-- properties
+	priority	integer check (priority between 1 and 5),
+	creation_date	datetime,
+	due_date	datetime,
+	completion_date	datetime,
+	deletion_date	datetime,
+	-- this can be assigned by someone else
+	assigned_by	integer references users,
+	approved_p	char(1) default 't' check (approved_p in ('t','f')),
+	item_details	varchar(4000)
+);
+
+
+create view deleted_todo_items as select * from todo_items where deletion_date is not null;
+create view viewable_todo_items as select * from todo_items where deletion_date is null;
+
+create view open_todo_items as select * from viewable_todo_items where completion_date is NULL;
+create view closed_todo_items as select * from viewable_todo_items where completion_date is NOT NULL;
+
+create view approved_todo_items as select * from viewable_todo_items where approved_p='t';
+create view unapproved_todo_items as select * from viewable_todo_items where approved_p='f';
+create view pending_todo_items as select * from viewable_todo_items where approved_p is NULL;
+
+-- user preferences
+create table todo_user_preferences (
+	user_id			integer not null primary key references users,
+	-- a bunch of todo preferences
+	-- an expiration for old items
+	old_item_expire		integer default 7 not null,
+	-- when sorting items, sort by
+	sort_by			varchar(100),
+	-- mail notification
+	notification_interval	integer default 1 not null,
+	-- last time user was notified
+	last_notification	datetime,
+	-- which time zone, and when does midnight start
+	time_offset		integer,
+	personal_midnight	integer,
+	-- separate the completed items or not
+	separate_completed_items_p	char(1) default 'f' check (separate_completed_items_p in ('t','f'))
+);
+
+
+-- A function to tell if two dates are on same day
+create function same_day_p(datetime, datetime, integer) returns char
+as '
+DECLARE
+	first_date alias for $1;
+	second_date alias for $2;
+	personal_midnight alias for $3;
+	first_day	char(2);
+	second_day	char(2);
+	difference	numeric;
+BEGIN
+	IF first_date is NULL or second_date is NULL
+	THEN return ''f'';
+	END IF;
+	
+	first_day:= date_part (''day'', first_date - (personal_midnight || '' hours'')::timespan);
+	second_day:= date_part (''day'', second_date - (personal_midnight || '' hours'')::timespan);
+
+	difference:= date_num_days(second_date - first_date);
+	
+	IF abs(difference)>1
+	THEN return(''f'');
+	END IF;
+
+
+	IF first_day != second_day
+	THEN return(''f'');
+	END IF;
+
+	return(''t'');
+END;
+' language 'plpgsql';
+
+	
+
+-- a table for correspondance between relative dates in pretty
+-- format, and what they're displayed as
+create table relative_date_pretty_text (
+	pretty_date		varchar(25),
+	min_days		integer,
+	max_days		integer,
+	days			integer
+);
+
+insert into relative_date_pretty_text 
+(pretty_date, min_days, max_days, days)
+values
+('in a month', 25, 35, 30);
+insert into relative_date_pretty_text 
+(pretty_date, min_days, max_days, days)
+values
+('in a week', 5, 9, 7);
+insert into relative_date_pretty_text 
+(pretty_date, min_days, max_days, days)
+values
+('in a few days', 2, 5, 3);
+insert into relative_date_pretty_text 
+(pretty_date, min_days, max_days, days)
+values
+('tomorrow', 1, 2, 1);
+insert into relative_date_pretty_text 
+(pretty_date, min_days, max_days, days)
+values
+('today', -1, 1, 0);
+
+
+
+-- a function to display the date in a nice way
+create function pretty_relative_date(datetime) returns varchar
+as '
+DECLARE
+BEGIN
+	return pretty_relative_date( $1,0);
+END;
+' language 'plpgsql';
+
+create function pretty_relative_date(datetime, integer) returns varchar
+as '
+DECLARE
+	v_date alias for $1;
+	midnight_offset alias for $2;
+	same_days		char(1);
+	difference_in_days	numeric;
+	v_pretty_date		varchar(25);
+BEGIN
+	IF v_date is NULL
+	THEN return(NULL);
+	END IF;
+
+	difference_in_days:= date_num_days(v_date-sysdate());
+	same_days:= same_day_p(sysdate(), v_date, midnight_offset);
+	
+	IF same_days=''f'' AND difference_in_days>= -1 AND difference_in_days<0
+ 	THEN difference_in_days:= -1.5;	
+	END IF;
+
+	IF same_days=''f'' AND difference_in_days>= 0 and difference_in_days<= 1
+	THEN difference_in_days:= 1.5;
+	END IF;
+
+	select pretty_date into v_pretty_date from relative_date_pretty_text where (min_days is NULL or min_days<= difference_in_days) AND (max_days is NULL or max_days> difference_in_days) AND days is NOT NULL;
+	
+	return(v_pretty_date);	
+END;
+' language 'plpgsql';
+
+--
+-- a function to get the days field from a number of days from the pretty text
+--
+create function todo_days_from_pretty(varchar) returns numeric
+as '
+DECLARE
+	pretty_text alias for $1;
+
+	return_num  numeric;
+BEGIN
+	select days into return_num from relative_date_pretty_text where pretty_date= pretty_text;
+
+	return(return_num);
+END;
+' language 'plpgsql';
+
+
+-- A function to find the min in the interval
+create function todo_interval_min(datetime, integer) returns integer
+as '
+DECLARE
+	v_date alias for $1;
+	midnight_offset alias for $2;
+	v_return_num integer;
+BEGIN
+	return(todo_days_from_pretty(pretty_relative_date(v_date, midnight_offset)));
+END;
+' language 'plpgsql';
+
+create function todo_interval_min(datetime) returns integer
+as '
+DECLARE
+BEGIN
+	return(todo_interval_min($1, 0));
+END;
+' language 'plpgsql';
+
+-- A function to check access
+create function user_can_access_list_p(integer, integer) returns char
+as '
+DECLARE
+	v_user_id alias for $1;
+	v_list_id alias for $2;
+	v_count	  integer;
+	v_public_p char(1);
+BEGIN
+	select public_p into v_public_p from todo_lists where list_id= v_list_id;
+	IF v_public_p = ''t''
+	then return(''t'');
+	end if;
+
+	select count(*) into v_count from todo_lists where user_id = v_user_id and list_id = v_list_id;
+
+	IF (v_count>0)
+	THEN return(''t'');
+	END IF;
+
+	select count(*) into v_count from todo_list_user_map where list_id= v_list_id and user_id= v_user_id;
+	
+	IF (v_count>0)
+	THEN return(''t'');
+	END IF;
+
+	select count(*) into v_count from todo_list_user_group_map where list_id= v_list_id and 0<(select count(*) from user_group_map where group_id= todo_list_user_group_map.user_group_id and user_id= v_user_id);
+
+	IF (v_count>0)
+	THEN return(''t'');
+	END IF;
+	
+	return(''f'');
+END;
+' language 'plpgsql';
+	
+
Index: web/openacs/www/doc/sql/tools.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/tools.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/tools.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,11 @@
+--
+-- tools.sql
+--
+-- by eveander@arsdigita.com, June 1999
+--
+
+
+-- for the spell checker
+create table ispell_words (
+    ispell_word    varchar(100) primary key
+);
Index: web/openacs/www/doc/sql/upgrade-1.6-2.0-1.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/upgrade-1.6-2.0-1.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/upgrade-1.6-2.0-1.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,64 @@
+-- upgrade from ACS 1.6 to 2.0 
+
+-- columns needed for the registration finite state machine
+
+alter table users add (
+   approved_date         date,
+   approving_note        varchar(4000),
+   deleted_date          date,
+   deleting_user         integer references users(user_id),
+   deleting_note         varchar(4000),
+   banned_date           date,
+   rejected_date         date,
+   rejecting_user        integer references users(user_id),
+   rejecting_note        varchar(4000),
+   email_verified_date   date,
+   user_state            varchar(100) check(user_state in ('need_email_verification_and_admin_approv', 'need_admin_approv', 'need_email_verification', 'rejected', 'authorized', 'banned', 'deleted')));
+
+create index users_user_state on users (user_state);
+
+-- seed the finite state machine 
+
+update users set user_state = 'banned' where banned_p = 't';
+update users set user_state = 'deleted' where deleted_p = 't' and user_state is null;
+update users set user_state = 'need_admin_aprov' where approved_p = 'f' and user_state is null;
+update users set user_state = 'authorized' where user_state is null;
+
+commit;
+
+-- these columns in the user table are now obsolete
+
+alter table users drop column approved_p;
+alter table users drop column deleted_p;
+alter table users drop column banned_p;
+	
+-- base views that change
+create or replace view users_alertable
+as
+select * 
+ from users 
+ where (on_vacation_until is null or 
+        on_vacation_until < sysdate)
+ and user_state = 'authorized'
+ and (email_bouncing_p is null or email_bouncing_p = 'f');
+
+create or replace view users_active
+as
+select * 
+ from users 
+ where user_state = 'authorized';
+
+create or replace view users_spammable
+as
+select u.* 
+ from users u, users_preferences up
+ where u.user_id = up.user_id(+)
+ and (on_vacation_until is null or 
+      on_vacation_until < sysdate)
+ and user_state = 'authorized'
+ and (email_bouncing_p is null or email_bouncing_p = 'f')
+ and (dont_spam_me_p is null or dont_spam_me_p = 'f');
+
+
+
+
Index: web/openacs/www/doc/sql/upgrade-2.0-2.1.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/upgrade-2.0-2.1.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/upgrade-2.0-2.1.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,121 @@
+-- upgrade from ACS 2.0 to 2.1
+-- started by philg@mit.edu on September 5, 1999
+
+-- general comments stuff
+
+create table general_comments_table_map (
+	table_name      varchar(30) primary key,
+	section_name	varchar(100) not null,
+	user_url_stub	varchar(200) not null,
+	admin_url_stub	varchar(200) not null
+);
+
+declare
+ n_news_rows		integer;
+ n_calendar_rows	integer;
+ n_classified_rows	integer;
+begin
+ select count(*) into n_news_rows from general_comments_table_map where table_name = 'news';
+ if n_news_rows = 0 then 
+   insert into general_comments_table_map
+    (table_name, section_name, user_url_stub, admin_url_stub)
+    values
+    ('news','News','/news/item.tcl?news_id=','/admin/news/item.tcl?news_id=');
+ end if;
+ select count(*) into n_calendar_rows from general_comments_table_map where table_name = 'calendar';
+ if n_calendar_rows = 0 then 
+   insert into general_comments_table_map
+    (table_name, section_name, user_url_stub, admin_url_stub)
+    values
+    ('calendar','Calendar','/calendar/item.tcl?calendar_id=','/admin/calendar/item.tcl?calendar_id=');
+ end if;
+ select count(*) into n_classified_rows from general_comments_table_map where table_name = 'classified_ads';
+ if n_classified_rows = 0 then 
+   insert into general_comments_table_map
+    (table_name, section_name, user_url_stub, admin_url_stub)
+    values
+    ('classified_ads','Classifieds','/gc/view-one.tcl?classified_ad_id=','/admin/gc/edit-ad.tcl?classified_ad_id=');
+ end if;
+end;
+/
+
+update general_comments 
+set one_line_item_desc = (select title from news where news_id = on_what_id)
+where one_line_item_desc is null
+and on_which_table = 'news' ;
+
+update general_comments 
+set one_line_item_desc = (select title from calendar where calendar_id = on_what_id)
+where one_line_item_desc is null
+and on_which_table = 'calendar' ;
+
+update general_comments 
+set one_line_item_desc = (select about || ' : ' || title from neighbor_to_neighbor where neighbor_to_neighbor_id = on_what_id)
+where one_line_item_desc is null
+and on_which_table = 'neighbor_to_neighbor' ;
+
+--- let's now make attachments work 
+
+alter table general_comments add (
+	attachment		blob,
+	client_file_name	varchar(500),
+	file_type		varchar(100),
+	file_extension		varchar(50),
+	caption			varchar(4000),
+	original_width		integer,
+	original_height		integer
+);
+
+-- let's allow comment titles
+
+alter table general_comments add (
+	one_line		varchar(200)
+);
+
+--- add the procedure stuff for the intranet
+
+
+create sequence intranet_procedure_id_seq;
+
+create table intranet_procedures (
+    procedure_id            integer not null primary key,
+    name                    varchar(200) not null,
+    note                    varchar(4000),
+    creation_date           date not null,
+    creation_user           integer not null references users,
+    last_modified           date,
+    last_modifying_user     integer references users
+);
+
+-- Users certified to do a certain procedure
+
+create table intranet_procedure_users (
+    procedure_id        integer not null references intranet_procedures,
+    user_id             integer not null references users,
+    note                varchar(400),
+    certifying_user     integer not null references users,
+    certifying_date     date not null,
+    primary key(procedure_id, user_id)
+);
+
+-- Occasions the procedure was done by a junior person,
+-- under the supervision of a certified person
+
+create sequence intranet_proc_event_id_seq;
+
+create table intranet_procedure_events (
+    event_id            integer not null primary key,
+    procedure_id        integer not null references intranet_procedures,
+    -- the person who did the procedure
+    user_id             integer not null references users,
+    -- the certified user who supervised
+    supervising_user    integer not null references users,
+    event_date          date not null,
+    note                varchar(1000)
+);
+
+-- allow file storage to take urls
+alter table fs_files add ( 
+   url varchar(200)
+);
+
Index: web/openacs/www/doc/sql/upgrade-2.1-2.2.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/upgrade-2.1-2.2.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/upgrade-2.1-2.2.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,121 @@
+-- upgrade from ACS 2.0 to 2.1
+-- started by philg@mit.edu on September 5, 1999
+
+alter table general_comments add (one_line_item_desc	varchar(200));
+
+create table general_comments_table_map (
+	table_name      varchar(30) primary key,
+	section_name	varchar(100) not null,
+	user_url_stub	varchar(200) not null,
+	admin_url_stub	varchar(200) not null
+);
+
+declare
+ n_news_rows		integer;
+ n_calendar_rows	integer;
+ n_classified_rows	integer;
+begin
+ select count(*) into n_news_rows from general_comments_table_map where table_name = 'news';
+ if n_news_rows = 0 then 
+   insert into general_comments_table_map
+    (table_name, section_name, user_url_stub, admin_url_stub)
+    values
+    ('news','News','/news/item.tcl?news_id=','/admin/news/item.tcl?news_id=');
+ end if;
+ select count(*) into n_calendar_rows from general_comments_table_map where table_name = 'calendar';
+ if n_calendar_rows = 0 then 
+   insert into general_comments_table_map
+    (table_name, section_name, user_url_stub, admin_url_stub)
+    values
+    ('calendar','Calendar','/calendar/item.tcl?calendar_id=','/admin/calendar/item.tcl?calendar_id=');
+ end if;
+ select count(*) into n_classified_rows from general_comments_table_map where table_name = 'classified_ads';
+ if n_classified_rows = 0 then 
+   insert into general_comments_table_map
+    (table_name, section_name, user_url_stub, admin_url_stub)
+    values
+    ('classified_ads','Classifieds','/gc/view-one.tcl?classified_ad_id=','/admin/gc/edit-ad.tcl?classified_ad_id=');
+ end if;
+end;
+/
+
+update general_comments 
+set one_line_item_desc = (select title from news where news_id = on_what_id)
+where one_line_item_desc is null
+and on_which_table = 'news' ;
+
+update general_comments 
+set one_line_item_desc = (select title from calendar where calendar_id = on_what_id)
+where one_line_item_desc is null
+and on_which_table = 'calendar' ;
+
+update general_comments 
+set one_line_item_desc = (select about || ' : ' || title from neighbor_to_neighbor where neighbor_to_neighbor_id = on_what_id)
+where one_line_item_desc is null
+and on_which_table = 'neighbor_to_neighbor' ;
+
+--- let's now make attachments work 
+
+alter table general_comments add (
+	attachment		blob,
+	client_file_name	varchar(500),
+	file_type		varchar(100),
+	file_extension		varchar(50),
+	caption			varchar(4000),
+	original_width		integer,
+	original_height		integer
+);
+
+-- let's allow comment titles
+
+alter table general_comments add (
+	one_line		varchar(200)
+);
+
+--- add the procedure stuff for the intranet
+
+
+create sequence intranet_procedure_id_seq;
+
+create table intranet_procedures (
+    procedure_id            integer not null primary key,
+    name                    varchar(200) not null,
+    note                    varchar(4000),
+    creation_date           date not null,
+    creation_user           integer not null references users,
+    last_modified           date,
+    last_modifying_user     integer references users
+);
+
+-- Users certified to do a certain procedure
+
+create table intranet_procedure_users (
+    procedure_id        integer not null references intranet_procedures,
+    user_id             integer not null references users,
+    note                varchar(400),
+    certifying_user     integer not null references users,
+    certifying_date     date not null,
+    primary key(procedure_id, user_id)
+);
+
+-- Occasions the procedure was done by a junior person,
+-- under the supervision of a certified person
+
+create sequence intranet_proc_event_id_seq;
+
+create table intranet_procedure_events (
+    event_id            integer not null primary key,
+    procedure_id        integer not null references intranet_procedures,
+    -- the person who did the procedure
+    user_id             integer not null references users,
+    -- the certified user who supervised
+    supervising_user    integer not null references users,
+    event_date          date not null,
+    note                varchar(1000)
+);
+
+-- allow file storage to take urls
+alter table fs_files add ( 
+   url varchar(200)
+);
+
Index: web/openacs/www/doc/sql/upgrade-2.2-2.2.1.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/upgrade-2.2-2.2.1.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/upgrade-2.2-2.2.1.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,54 @@
+-- upgrade from ACS 2.2 to 2.2.1
+
+alter table user_group_type_fields add (sort_key integer);
+create sequence sort_key_sequence;
+update user_group_type_fields set sort_key = sort_key_sequence.nextval;
+drop sequence sort_key_sequence;
+
+-- This table records additional fields to be recorded per user who belongs
+-- to a group of a particular type.
+create table user_group_type_member_fields (
+	group_type	varchar(20) references user_group_types,
+	field_name	varchar(200) not null,
+	field_type	varchar(20) not null, -- short_text, long_text, boolean, date, etc.
+	-- Sort key for display of columns.
+	sort_key		integer not null,
+	primary key (group_type, field_name)
+);
+
+-- Contains information about fields to gather per user for a user group.
+-- Cannot contain a field_name that appears in the
+-- user_group_type_member_fields table for the group type this group belongs to.
+
+create table user_group_member_fields (
+	group_id	integer references user_groups,
+	field_name	varchar(200) not null,
+	field_type	varchar(20) not null, -- short_text, long_text, boolean, date, etc.
+	sort_key	integer not null,
+	primary key (group_id, field_name)
+);
+
+-- View that brings together all field information for a user group, from
+-- user_group_type_member_fields and user_group_member_fields.
+-- We throw in the sort keys prepended by 'a' or 'b' so we can display
+-- them in the correct order, with the group type fields first.
+create or replace view all_member_fields_for_group as
+select group_id, field_name, field_type, 'a' || sort_key as sort_key
+from user_group_type_member_fields ugtmf, user_groups ug
+where ugtmf.group_type = ug.group_type
+union
+select group_id, field_name, field_type, 'b' || sort_key as sort_key
+from user_group_member_fields;
+
+
+-- Contains extra field information for a particular user. These fields
+-- were defined either in user_group_type_member_fields or 
+-- user_group_member_fields
+create table user_group_member_field_map (
+	group_id	integer references user_groups,
+	user_id		integer references users,
+	field_name	varchar(200) not null,
+	field_value	varchar(4000),
+	primary key (group_id, user_id, field_name)
+);
+
Index: web/openacs/www/doc/sql/upgrade-2.2-2.3.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/upgrade-2.2-2.3.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/upgrade-2.2-2.3.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,75 @@
+--
+-- upgrade a 2.2 ACS to 2.3 
+--
+-- started by philg@mit.edu ojn 9/24/99
+--
+
+-- for the user profiling system
+
+alter table categories add (
+	category_type	varchar(50),
+	parent_category_id  integer references categories,
+	profiling_weight	number default 1 check(profiling_weight >= 0));
+
+create index categories_parent_cat_id_idx on categories(parent_category_id);
+
+alter table users_interests add
+  (interest_level	integer default 5 check(interest_level between -10 and 10));
+
+create table crm_states (
+	state_name	varchar(50) not null primary key,
+	description	varchar(1000) not null -- for UI
+);
+
+create table crm_state_transitions (
+	state_name	not null references crm_states,
+	next_state	not null references crm_states,
+	triggering_order	integer not null,
+	-- a SQL fragment which will get called as:
+	-- update users set crm_state = <next_state>, crm_state_entered_date = sysdate where user_state = <state_name> and (<transition_condition>)
+	transition_condition	varchar(500) not null,
+	primary key (state_name, next_state)
+);
+
+-- add the CRM and also portraits fields to the users table
+
+alter table users add (
+	crm_state		references crm_states,
+	crm_state_entered_date	date, -- when the current state was entered
+	portrait		blob,
+	portrait_upload_date	date,
+	portrait_comment	varchar(4000),
+	-- file name including extension but not path
+	portrait_client_file_name	varchar(500),
+	portrait_file_type			varchar(100),	-- this is a MIME type (e.g., image/jpeg)
+	portrait_file_extension		varchar(50), 	-- e.g., "jpg"
+	portrait_original_width		integer,
+	portrait_original_height	integer,
+	-- if our server is smart enough (e.g., has ImageMagick loaded)
+	-- we'll try to stuff the thumbnail column with something smaller
+	portrait_thumbnail		blob,
+	portrait_thumbnail_width	integer,
+	portrait_thumbnail_height	integer
+);
+
+create index users_by_crm_state on users (crm_state);
+
+alter table general_comments_audit add (one_line varchar(200));
+
+--- dynamic user groupings
+create sequence user_class_id_seq;
+
+create table user_classes (
+	user_class_id    integer primary key,
+	name		 varchar(200) unique,
+	description      varchar(4000),
+	-- this query was written by our tcl procs, we'll
+	-- have an autogenerated description describing what it means.
+	sql_description   varchar(1000),
+	-- The sql that will follow the select clause.
+	-- for example, sql_post_select_list for 'select count(user_id) from
+	-- users' would be 'from users'.
+	-- We record this fragment instead of the complete sql
+	-- query so we can select a count of desired columns as desired.
+	sql_post_select    varchar(4000)	
+);
Index: web/openacs/www/doc/sql/upgrade-2.3-2.4.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/upgrade-2.3-2.4.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/upgrade-2.3-2.4.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,117 @@
+--
+-- upgrade-2.3-2.4.sql
+--
+-- by philg@mit.edu on October 29, 1999
+--
+
+alter table users_contact add (
+	fax		varchar(100),
+	priv_fax	integer
+);
+
+alter table categories add (
+	category_description    varchar(4000)
+);
+
+create table category_hierarchy (
+   parent_category_id     integer references categories,
+   child_category_id      integer references categories,
+   unique (parent_category_id, child_category_id)
+);
+
+
+
+-- migrate the parent-child relationships from the parent_category_id column of the
+-- categories table to the category_hierarchy table
+--
+-- we want a record in category_hierarchy even for those categories whose
+-- parent_category_id is null
+--
+
+declare
+ cursor cats is
+  select *
+  from categories;
+begin
+ for cat in cats loop
+  insert into category_hierarchy(child_category_id, parent_category_id)
+  values(cat.category_id, cat.parent_category_id);
+ end loop;
+end;
+/
+
+alter table categories drop column parent_category_id;
+
+
+-- this one will replace sws_table_to_section_map
+-- and general_comments_table_map
+create table table_acs_properties (
+             table_name      varchar(30) primary key,
+             section_name    varchar(100) not null,
+             user_url_stub   varchar(200) not null,
+             admin_url_stub  varchar(200) not null
+);
+
+-- copy 
+insert into table_acs_properties
+(table_name, section_name, user_url_stub, admin_url_stub)
+select table_name, section_name, user_url_stub, admin_url_stub
+from general_comments_table_map;
+
+-- you'll want to do these manually when you're satifisfied
+-- that everything is running
+-- drop table static_categories;
+-- drop table sws_table_to_section_map;
+-- drop table general_comments_table_map;
+
+create sequence site_wide_cat_map_id_seq;
+
+-- this table can represent "item X is related to category Y" for any
+-- item in the ACS; see /doc/user-profiling.html for examples
+
+create table site_wide_category_map (
+             map_id                  integer primary key,
+	     category_id             not null references categories,
+	     -- We are mapping a category in the categories table
+	     -- to another row in the database.  Which table contains
+	     -- the row?
+             on_which_table          varchar(30) not null,
+	     -- What is the primary key of the item we are mapping to?
+	     -- With the bboard this is a varchar so we can't make this
+	     -- and integer
+             on_what_id              varchar(500) not null,
+	     mapping_date	     date not null,
+	     -- how strong is this relationship?
+	     -- (we can even map anti-relationships with negative numbers)
+	     mapping_weight          integer default 5 
+				     check(mapping_weight between -10 and 10),
+	     -- A short description of the item we are mapping
+	     -- this enables us to avoid joining with every table
+	     -- in the ACS when looking for the most relevant content 
+	     -- to a users' interests
+	     -- (maintain one_line_item_desc with triggers.)
+             one_line_item_desc      varchar(200) not null,
+	     mapping_comment         varchar(200),
+	     -- only map a category to an item once
+             unique(category_id, on_which_table, on_what_id)
+);
+
+
+--- stuff to fix up site-wide search 
+
+alter table static_pages add (
+	index_p		char(1) default 't' check (index_p in ('t','f')),
+	index_decision_made_by	varchar(30) default 'robot' check(index_decision_made_by in ('human', 'robot'))
+);
+
+create sequence static_page_index_excl_seq;
+
+create table static_page_index_exclusion (
+	exclusion_pattern_id	integer primary key,
+	match_field		varchar(30) default 'url_stub' not null check(match_field in ('url_stub', 'page_title', 'page_body')),
+	like_or_regexp		varchar(30) default 'like' not null check(like_or_regexp in ('like', 'regexp')),
+	pattern			varchar(4000) not null,
+	pattern_comment		varchar(4000),
+	creation_user		not null references users,
+	creation_date		date default sysdate not null 
+);
Index: web/openacs/www/doc/sql/upgrade-2.4-3.0.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/upgrade-2.4-3.0.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/upgrade-2.4-3.0.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,1112 @@
+--
+-- upgrade-2.4-3.0.sql
+--
+-- by philg@mit.edu on December 17, 1999
+--
+
+-- NEW ACS MODULES TABLE (all acs modules should eventually be registered here)
+
+-- this table stores information about the acs modules (news, bboard, ...)
+create table acs_modules (
+	module_key		varchar(30) primary key,
+	pretty_name		varchar(200) not null,
+	-- this is the directory where module public files are stored. 
+	-- for the news module public_directory would be /news
+	public_directory	varchar(200),
+	-- this is the directory where module admin files are stored
+	-- for the news module admin_directory would be /admin/news
+	admin_directory		varchar(200),
+	-- this is the directory where system admin files are stored 
+	-- notice that this is not always same as the admin_directory
+	-- e.g. ticket module has admin directory /ticket/admin and
+	-- site admin directory /admin/ticket
+	site_wide_admin_directory	varchar(200),
+	-- if module_type=system, this module has all: public, admin and site_wide admin pages (e.g. faq, news)
+	-- notice that often admin and site_wide admin directory are merged together
+	-- if module_type=admin, this is admin module and has no public pages (e.g. display, content_sections)
+	-- notice that modules of this type have no public pages
+	-- if module_type=site_wide_admin, this is module for site wide administration of another module (e.g. news_admin, bboard_admin)
+	-- notice that having admin module for another module allows us to assign administration of modules to user groups
+	-- in this case public_directory will correspond to the directory where files for site wide administration of that
+	-- module are stored and admin_directory and site_wide_admin_directory are irrelevant 
+	module_type                    varchar(20) not null check(module_type in ('system', 'admin', 'site_wide_admin')),
+	-- does module support scoping
+	supports_scoping_p	char(1) default 'f' check(supports_scoping_p in ('t','f')),
+	-- this is short description describing what module is doing	
+	description		varchar(4000),
+	-- this is url of the html file containing module documentation
+	documentation_url	varchar(200),
+	-- this is url of the file containing date model of the module
+	data_model_url		varchar(200)
+);
+
+insert into acs_modules
+(module_key, pretty_name, public_directory, admin_directory, site_wide_admin_directory, module_type, supports_scoping_p, documentation_url, data_model_url, description)
+values
+('news', 'News', '/news', '/news/admin', '/admin/news', 'system', 't', '/doc/news.html', '/doc/sql/news.sql', 'A news item is something that is interesting for awhile and then should disappear into the archives without further administrator intervention. We want a news article to serve as the focus of user comments. You could use the /bboard system to accomplish the same function. If you did, you''d get the advantages of file attachments, group-based administration, etc. But we think that news truly is different from discussion. We want to present it by date, not by topic. The publisher probably wants to be very selective about what gets posted (as news if not as comments on news). So it gets a separate module.');
+
+insert into acs_modules
+(module_key, pretty_name, admin_directory, module_type, supports_scoping_p, data_model_url)
+values
+('content-sections', 'Content Sections', '/admin/content-sections', 'admin', 't', '/doc/sql/community-core.sql');
+
+insert into acs_modules
+(module_key, pretty_name, public_directory, admin_directory, module_type, supports_scoping_p, data_model_url)
+values
+('custom-sections', 'Custom Sections', '/custom-sections', '/admin/custom-sections', 'system', 't', '/doc/sql/community-core.sql');
+
+insert into acs_modules 
+(module_key, pretty_name, public_directory, admin_directory, site_wide_admin_directory, module_type, supports_scoping_p, 
+ documentation_url, data_model_url, description)
+values
+('address-book', 'Address Book', '/address-book', '/address-book', '/admin/address-book','system', 't', '/doc/address-book.html', '/doc/address-book.sql', 'This is a really simple address book which also does birthday reminders.');
+
+insert into acs_modules
+(module_key, pretty_name, public_directory, admin_directory, module_type, supports_scoping_p, 
+ documentation_url, data_model_url, description)
+values
+('display', 'Display', '/display', '/admin/display', 'admin', 't', 
+ '/doc/display.html', '/doc/sql/display.sql', 'Use this module if you want to give your pages easily changable display using cascaded style sheets and uploading logos.');
+
+insert into acs_modules
+(module_key, pretty_name, public_directory, module_type, supports_scoping_p)
+values
+('news_administration', 'News Administration', '/admin/news', 'site_wide_admin', 'f');
+
+insert into acs_modules
+(module_key, pretty_name, public_directory, admin_directory, site_wide_admin_directory, module_type, supports_scoping_p, documentation_url, data_model_url, description)
+values
+('faq', 'Frequently Asked Questions', '/faq', '/faq/admin', '/admin/faq', 'system', 't', '/doc/faq.html', '/doc/sql/faq.sql', 'Frequently Asked Questions');
+
+insert into acs_modules
+(module_key, pretty_name, public_directory, admin_directory, site_wide_admin_directory, module_type, supports_scoping_p, documentation_url, data_model_url, description)	
+values	
+('general-comments', 'General Comments', '/general-comments', '/general-comments/admin', '/admin/general-comments', 'admin', 't', '/doc/general-comments.html', '/doc/sql/general-comments.sql', 'General Comments Module');
+
+insert into acs_modules
+(module_key, pretty_name, public_directory, admin_directory, site_wide_admin_directory, module_type, supports_scoping_p, documentation_url, data_model_url, description)	
+values	
+('download', 'Download', '/download', '/download/admin', '/admin/download', 'system', 't', '/doc/download.html', '/doc/sql/download.sql', 'Download Module');
+
+
+commit;
+
+create or replace function section_type_from_module_key (v_module_key IN acs_modules.module_key%TYPE)
+     return varchar
+     IS
+	v_module_type acs_modules.module_type%TYPE;
+     BEGIN
+	select module_type into v_module_type
+	from acs_modules
+	where module_key=v_module_key;
+
+	if v_module_type='system' then
+	    return 'system';
+	elsif v_module_type='admin' then
+	    return 'admin';
+	else
+	    return 'system';
+	end if;
+     END section_type_from_module_key;
+/
+show errors
+
+create or replace function pretty_name_from_module_key (v_module_key IN acs_modules.module_key%TYPE)
+     return varchar
+     IS
+	v_pretty_name acs_modules.pretty_name%TYPE;
+     BEGIN
+	select pretty_name into v_pretty_name
+	from acs_modules
+	where module_key=v_module_key;
+
+	return v_pretty_name;
+
+     END pretty_name_from_module_key;
+/
+show errors
+
+
+-- ADDRESS BOOK SCOPIFICATION
+
+-- support for group_id and scope checking (user, group, public)
+create sequence address_book_id_sequence;
+alter table address_book add (
+	address_book_id	integer,
+        scope		varchar(20) not null,
+	group_id	references user_groups,
+	on_which_table  varchar(50),
+	on_what_id      integer
+);
+
+update address_book 
+set address_book_id=address_book_id_sequence.nextval;
+
+update address_book
+set scope='user'
+where user_id is not null;
+
+update address_book
+set scope='public'
+where user_id is null;
+
+commit;
+
+alter table address_book add constraint address_book_primary_id_check primary key(address_book_id);
+
+alter table address_book add constraint address_book_scope_check 
+check ((scope='group' and group_id is not null) or
+       (scope='user' and user_id is not null) or
+       (scope='table' and on_which_table is not null and on_what_id is not null) or
+       (scope='public'));
+
+-- add index on the group_id for the address_book table
+create index address_book_group_idx on address_book ( group_id );
+
+
+
+-- NEW DISPLAY MODULE
+
+-- notice that these two separate data models for css will be merged into 
+-- one in the next release of the acs (per jeff davis data model
+
+-- using this table makes writing user friendly css forms possible
+-- it limits how much you can do with css though, but it should
+-- suffice for most practical purposes
+create sequence css_simple_id_sequence;
+create table css_simple (
+        css_id  		  integer primary key,
+        -- if scope=public, this is the css for the whole system
+        -- if scope=group, this is the css for a particular group
+        -- is scope=user this is the css for particular user
+        scope   	          varchar(20) not null,
+        user_id			  references users,
+        group_id		  references user_groups,
+	css_bgcolor		  varchar(40),
+	css_textcolor		  varchar(40),
+	css_unvisited_link	  varchar(40),
+	css_visited_link	  varchar(40),
+	css_link_text_decoration  varchar(40),
+	css_font_type		  varchar(40)
+);
+
+alter table css_simple add constraint css_simple_scope_unique 
+unique(scope, user_id, group_id);
+
+alter table css_simple add constraint css_simple_data_scope_check check (
+	(scope='group' and group_id is not null and user_id is null) or
+        (scope='user' and user_id is not null and group_id is null) or
+        (scope='public'));
+
+-- if you need full control of how your css look like you should use 
+-- css_complete_version table which is capable of storing any css
+create sequence css_complete_id_sequence;
+create table css_complete (
+        css_id integer primary key,
+        -- if scope=public, this is the css for the whole system
+        -- if scope=group, this is the css for a particular group
+        -- is scope=user this is the css for particular user
+        scope           varchar(20) not null,
+        user_id		references users,
+        group_id	references user_groups,
+	-- e.g. A, H1, P, P.intro
+	selector varchar(60) not null,
+	-- e.g. color, bgcolor, font-family
+        property varchar(40) not null,
+	-- e.g. "Times Roman", "Verdana". notice that value can be rather
+	-- big (for example when specifying font-families)
+        value varchar(400) not null
+);
+
+alter table css_complete add constraint css_complete_data_scope_check check (
+	(scope='group' and group_id is not null and user_id is null) or
+        (scope='user' and user_id is not null and group_id is null) or
+        (scope='public'));
+
+-- selector and property must be unique for the appropriate scope
+alter table css_complete add constraint css_selector_property_unique 
+unique (scope, group_id, user_id, selector, property);
+
+
+-- this table stores the log that can be displayed on every page
+create sequence page_logos_id_sequence;
+create table page_logos (
+	logo_id 		integer primary key,
+       	-- if scope=public, this is the system-wide logo
+        -- if scope=group, this is the logo for a particular group
+        -- is scope=user this is the logo for a particular user
+        scope           	varchar(20) not null,
+        user_id			references users,
+        group_id		references user_groups,
+	logo_enabled_p		char(1) default 'f' check(logo_enabled_p in ('t', 'f')),
+	logo_file_type          varchar(100) not null,
+        logo_file_extension     varchar(50) not null,    -- e.g., "jpg"
+	logo			blob not null
+);
+
+alter table page_logos add constraint page_logos_scope_check check (
+	(scope='group' and group_id is not null and user_id is null) or
+        (scope='user' and user_id is not null and group_id is null) or
+        (scope='public'));
+
+alter table page_logos add constraint page_logos_scope_unique 
+unique(scope, user_id, group_id);
+
+
+
+-- CHANGES TO THE USER GROUP TABLE
+
+-- add short_name to the user_groups necessary for pretty url's and other purposes
+-- (e.g. http://photo.net/groups/travel for group with short name travel as opposed
+--  to http://photo.net/ug/groups.tcl?group_id=2314)
+-- note that short name is rather big (100 characters) in order to support backward
+-- compatibility because we want to generate short names for old data by taking out
+-- spaces from the group_name and then adding the key to ensure uniqueness.
+-- also, email at the bottom page of the group user pages can be potentially different for 
+-- each group. so, if admin_email in user_groups table is not null than admin_email should be used 
+-- at the bottom of each group user page and else if it is null than the SystemOwner email from
+-- parameters file should be used (this is to ensure backward compatibility).
+-- note that group admin pages should stil be signed by AdminOwner email (from parameters file)
+-- because group administrators will not have programming privileges (they will only be managing
+-- user data through provided web interface)
+
+alter table user_groups add (
+	short_name varchar(100),
+	admin_email varchar (100)
+);
+
+create or replace function user_group_group_type (v_group_id IN user_groups.group_id%TYPE)
+     return varchar
+     IS
+        v_group_type user_group_types.group_type%TYPE;
+
+     BEGIN
+	select group_type into v_group_type
+	from user_groups
+	where group_id=v_group_id;
+
+	return v_group_type;
+     END user_group_group_type;
+/
+show errors
+
+-- this is the helper function for function short_name_from_group_name bellow
+create or replace function short_name_from_group_name2
+(v_short_name IN user_groups.short_name%TYPE, v_identifier IN integer)
+     return varchar
+     IS
+        v_new_short_name user_groups.short_name%TYPE;
+
+	cursor c1 is select short_name
+	from user_groups
+	where short_name=v_short_name || decode(v_identifier, 0, '', v_identifier);
+     BEGIN
+	OPEN c1;
+	FETCH c1 into v_new_short_name;
+
+	if c1%NOTFOUND then
+	    select v_short_name || decode(v_identifier, 0, '', v_identifier) into v_new_short_name from dual;
+	    return v_new_short_name;
+        else	
+	    return short_name_from_group_name2(v_short_name, v_identifier+1);
+	end if;
+
+     END short_name_from_group_name2;
+/
+show errors
+
+-- this function generates unique short_name from the group_nams
+-- v_group_name is the group_name of the group, this function will first transform group_name by making it lower case, 
+-- and substituting spaces and underscores with dashes. thus, if group_name is Photographers, the transformed group_name
+-- will be photographers. then, this function will keep adding numbers to it until it makes it unique (e.g. if short_names
+-- photographers and photographers1 already exist this function will return photographers2)
+create or replace function short_name_from_group_name
+(v_group_name IN user_groups.group_name%TYPE)
+     return varchar
+     IS
+     BEGIN
+	return short_name_from_group_name2(lower(substr(translate(v_group_name, '_ ','--'), 1, 80)), 0);
+     END short_name_from_group_name;
+/
+show errors
+
+-- this procedure sets the short_name of all the groups in the user_group
+-- table using short_name_from_group_name function
+-- notice that simple update using short_name_from_group_name could not be
+-- performed because function short_name_from_group_name is used while
+-- user_groups is mutating (ORA-04091)
+create or replace procedure generate_short_names_for_group
+     IS
+        v_group_id user_groups.group_id%TYPE;
+	v_group_name user_groups.group_name%TYPE;
+	v_short_name user_groups.short_name%TYPE;
+
+	cursor c1 is 
+	select group_id, group_name
+	from user_groups;
+     BEGIN
+	OPEN c1;
+
+	LOOP
+           FETCH c1 INTO v_group_id, v_group_name;
+           EXIT WHEN c1%NOTFOUND;
+	
+	   v_short_name:= short_name_from_group_name(v_group_name);
+	   update user_groups set short_name=v_short_name where group_id=v_group_id;
+
+       END LOOP;
+     END generate_short_names_for_group;
+/
+show errors
+
+create or replace procedure administration_group_add (pretty_name IN varchar, v_short_name IN varchar, v_module IN varchar, v_submodule IN varchar, v_multi_role_p IN varchar, v_url IN varchar ) 
+IS
+  v_group_id	integer;
+  n_administration_groups integer;
+  v_system_user_id integer; 
+BEGIN
+  if v_submodule is null then
+      select count(group_id) into n_administration_groups
+        from administration_info 
+        where module = v_module 
+        and submodule is null;
+      else
+	select count(group_id) into n_administration_groups
+         from administration_info
+         where module = v_module 
+         and submodule = v_submodule;
+  end if;
+  if n_administration_groups = 0 then 
+     -- call procedure defined in community-core.sql to get system user
+     v_system_user_id := system_user_id;
+     select user_group_sequence.nextval into v_group_id from dual;
+     insert into user_groups 
+      (group_id, group_type, short_name, group_name, creation_user, creation_ip_address, approved_p, existence_public_p, new_member_policy, multi_role_p)
+      values
+      (v_group_id, 'administration', v_short_name, pretty_name, v_system_user_id, '0.0.0.0', 't', 'f', 'closed', v_multi_role_p);
+     insert into administration_info (group_id, module, submodule, url) values (v_group_id, v_module, v_submodule, v_url);
+   end if;
+end;
+/
+show errors
+
+-- generate short_names from existing group_names
+execute generate_short_names_for_group;
+
+-- short_name should be not null
+
+alter table user_groups add constraint user_groups_short_name_nnull check(short_name is not null);
+
+-- short name should be unique 
+
+alter table user_groups add constraint user_groups_short_name_unique unique(short_name);
+
+-- add various user group settings
+alter table user_groups add (
+	index_page_enabled_p	char(1) default 'f' check (index_page_enabled_p in ('t','f')),
+	-- this is index page content
+	body			clob,
+	-- html_p for the index page content
+	html_p	                char(1) default 'f' check (html_p in ('t','f'))
+);
+
+------------ philg added this to robot-detection.sql
+
+create or replace trigger robots_modified_date
+before insert or update on robots
+for each row
+when (new.modified_date is null)
+begin
+ :new.modified_date := SYSDATE;
+end;
+/
+show errors
+
+
+
+-- NEW AND IMPROVED CONTENT SECTIONS
+
+-- changes for new content sections table
+-- note that we have changed the primary key in the content_sections table
+-- so we will have to move data to new temporary table
+-- let's first create content_sections table, then insert data into it 
+-- from the old content_sections table, then drop the old content sections 
+-- table and finally rename content_sections table back to content_sections
+
+create sequence content_section_id_sequence;
+create table content_sections_temp (
+        section_id              integer primary key,
+        -- if scope=public, this is the content sections for the whole system
+        -- if scope=group this is the content sections for particular group
+        -- is scope=user this is the content sections for particular user
+        scope                   varchar(20) not null,
+	-- if section_type=system, this section corresponds to one of the system sections
+	-- such as news, bboard, ...
+	-- if section_type=custom, this section is custom section
+	-- custom sections serve like url directories. so if group administrator of group travel 
+	-- at photo.net defines custom section sweeden (e.g. photo.net/travel/sweeden), he will be 
+	-- able to then to upload files for this section (see content_files table) in order to display
+	-- the file photo.net/groups/travel/sweeden/stockholm.html
+	-- if section_type=static, this section is static section
+	-- static sections serve as html pages and address of html page is specified in section_url_stub
+	-- if you have file arsdigita.html in your carrers directory then section_url_stub should be
+	-- /carrers/arsdigita.html  
+	-- if section_type=admin, this section is system section but does not have associated public pages
+	-- it only has administration pages.
+	section_type                    varchar(20) not null,
+	-- does user have to be registered in order to access this page
+	requires_registration_p	char(1) default 'f' check(requires_registration_p in ('t','f')),
+	-- if visibility=public this content section is viewable by everybody
+	-- if visibility=private this content section is viewable be a user only if scope=user
+	-- or by group members only if scope=group
+	visibility		varchar(20) not null check(visibility in ('private', 'public')),
+        user_id                 references users,
+        group_id                references user_groups,
+        section_key             varchar(30) not null,
+	-- this is used only for system sections
+	-- each system sections is associated with an acs module
+	module_key		references acs_modules,
+        section_url_stub        varchar(200),
+        section_pretty_name     varchar(200) not null,
+        -- if we print lists of sections, where does this go?
+        -- two sections with same sort_key will sort 
+        -- by upper(section_pretty_name)
+        sort_key                integer,
+        enabled_p               char(1) default 't' check(enabled_p in ('t','f')),
+        intro_blurb		varchar(4000),
+        help_blurb      	varchar(4000),
+        index_page_enabled_p    char(1) default 'f' check (index_page_enabled_p in ('t','f')),
+        -- html content for customizing index page (this is used only for content sections of section_type custom)
+        body                    clob,
+        html_p                  char(1) default 'f' check(html_p in ('t','f'))
+);
+
+-- note that all old data from previous data model will have all of it's content sections 
+-- with scope=public and both user_id and group_id set to null
+-- also we don't have to specify values for body and html_p because they are new in this data model
+-- due to our constraint that static pages must have a section_url_stub (this is new constraint)
+-- we will insert / for section_url_stub where static_p='t'
+
+insert into content_sections_temp
+(section_id, scope, section_type, section_key, section_url_stub, requires_registration_p, visibility,
+ section_pretty_name, sort_key, enabled_p, intro_blurb, help_blurb)
+select content_section_id_sequence.nextval, 'public', 'static', section_key, 
+       decode(section_url_stub, NULL, '/', section_url_stub), requires_registration_p, 'public',
+       section_pretty_name, sort_key, enabled_p, intro_blurb, help_blurb
+from content_sections 
+where static_p='t';
+
+-- when static_p='f' we will assume it's system section (it didn't have much meaning before)
+-- don't have to worry about section_url_stub
+
+insert into content_sections_temp
+(section_id, scope, section_type, section_key, section_url_stub, requires_registration_p, visibility,
+ section_pretty_name, sort_key, enabled_p, intro_blurb, help_blurb)
+select content_section_id_sequence.nextval, 'public', 'system', section_key, 
+       section_url_stub, requires_registration_p, 'public', section_pretty_name,  
+       sort_key, enabled_p, intro_blurb, help_blurb
+from content_sections 
+where static_p='f';
+
+commit;
+
+-- now, that we have all the data in the content_sections table, 
+-- let's drop the old content_sections table and rename 
+-- content_sections table to content_sections
+
+drop table content_sections;
+alter table content_sections_temp rename to content_sections;
+
+-- now, let's add scope checking
+alter table content_sections add constraint content_sections_scope_check 
+check ((scope='group' and group_id is not null and user_id is null) or
+       (scope='user' and user_id is not null and group_id is null) or
+       (scope='public' and user_id is null and group_id is null));
+
+-- add check to make sure section_url_stub is always provided for the static sections
+-- also, system and admin sections must have associated acs module with them
+alter table content_sections add constraint content_sections_type_check 
+check ((section_type='static' and section_url_stub is not null) or
+       ((section_type='system' or section_type='admin') and module_key is not null) or 
+       (section_type='custom'));
+
+-- add checks for appropriate uniqueness
+alter table content_sections add constraint content_sections_unique_check
+unique(scope, section_key, user_id, group_id);
+
+-- returns t if section exists and is enabled
+create or replace function enabled_section_p 
+       ( v_section_id content_sections.section_id%TYPE)
+     return varchar
+     is
+       v_enabled_p char(1);
+     BEGIN
+       select enabled_p into v_enabled_p 
+         from content_sections
+         where section_id = v_section_id;
+
+      if v_enabled_p is null then
+         return 'f';
+       else 
+         return v_enabled_p;
+       end if;
+     END enabled_section_p;
+/
+show errors
+
+create or replace function content_section_id_to_key (v_section_id IN content_sections.section_id%TYPE)
+     return varchar
+     IS
+        v_section_key content_sections.section_key%TYPE;
+
+     BEGIN
+	select section_key into v_section_key
+	from content_sections
+	where section_id=v_section_id;
+
+	return v_section_key;
+     END content_section_id_to_key;
+/
+show errors
+
+
+-- CONTENT FILES TABLE USED BY CUSTOM SECTIONS MODULE
+
+
+create sequence content_file_id_sequence start with 1;
+create table content_files (
+	content_file_id 	integer primary key,
+	section_id 		references content_sections,
+	-- this will be part of url; should be a-zA-Z and underscore
+	file_name		varchar(30) not null,
+        -- this is a MIME type (e.g., text/html, image/jpeg)	
+        file_type               varchar(100) not null,
+        file_extension          varchar(50),    -- e.g., "jpg"
+	-- if file is text or html we need page_pretty_name, body and html_p
+	page_pretty_name        varchar(200),
+	body			clob,
+	html_p			char(1) default 'f' check(html_p in ('t','f')),
+	-- if the file is attachment we need use binary_data blob( e.g. photo, image)
+	binary_data             blob
+);
+
+alter table content_files add constraint content_file_names_unique
+unique(section_id, file_name);
+
+
+-- MODIFICATION TO USER GROUP TYPE TABLE
+
+alter table user_group_types add (
+	-- if group_module_administration=full, then group administrators have full control of which modules
+	-- they can use (they can add, remove, enable and disable all system modules)
+	-- if group_module_administration=enabling, then group administrators have authority to enable and 
+	-- disable modules but cannot add or remove modules
+	-- if group_module_administration=none, the group administrators have no control over modules
+	-- modules are explicitly set for the user group type by the system administrator 
+	group_module_administration	varchar(20)
+);
+
+update user_group_types 
+set group_module_administration='none';
+
+commit;
+
+
+-- MAPPING BETWEEN THE MODULES AND THE GROUP TYPES
+
+
+-- this table is used when group administrators are not allowed to handle module administration
+-- (allow_module_administration_p is set to 0 for this group type)
+-- all groups of this group type will have only modules set up for which mapping in this table exists
+create sequence group_type_modules_id_sequence start with 1;
+create table user_group_type_modules_map (
+	group_type_module_id 	integer primary key,	
+	group_type 		referenes user_group_types not null,
+	module_key		references acs_modules not null
+);
+
+-- this is the helper function for function uniq_group_module_section_key bellow
+create or replace function uniq_group_module_section_key2
+(v_module_key IN acs_modules.module_key%TYPE, v_group_id IN user_groups.group_id%TYPE, v_identifier IN integer)
+     return varchar
+     IS
+        v_new_section_key content_sections.section_key%TYPE;
+
+	cursor c1 is select section_key
+	from content_sections
+	where scope='group' 
+	and group_id=v_group_id
+	and section_key=v_module_key || decode(v_identifier, 0, '', v_identifier);
+     BEGIN
+	OPEN c1;
+	FETCH c1 into v_new_section_key;
+
+	if c1%NOTFOUND then
+	    select v_module_key || decode(v_identifier, 0, '', v_identifier) into v_new_section_key from dual;
+	    return v_new_section_key;
+        else	
+	    return uniq_group_module_section_key2(v_module_key, v_group_id, v_identifier+1);
+	end if;
+
+     END uniq_group_module_section_key2;
+/
+show errors
+
+-- this function generates unique section_key
+-- v_module_key is the proposed section_key, this function will keep adding numbers to it
+-- until it makes it unique (e.g. if sections news and news1 already exist for this groups, 
+-- and module_key is news this function will return news2)
+create or replace function uniq_group_module_section_key
+(v_module_key IN acs_modules.module_key%TYPE, v_group_id IN user_groups.group_id%TYPE)
+     return varchar
+     IS
+     BEGIN
+	return uniq_group_module_section_key2(v_module_key, v_group_id, 0);
+     END uniq_group_module_section_key;
+/
+show errors
+
+-- this function returns t if a section module identified by module_key
+-- is associated with the group identified by the group_id
+create or replace function group_section_module_exists_p
+(v_module_key IN acs_modules.module_key%TYPE, v_group_id IN user_groups.group_id%TYPE)
+     return char
+     IS
+        v_dummy integer;
+
+	cursor c1 is select 1
+	from content_sections
+	where scope='group' 
+	and group_id=v_group_id
+	and module_key=v_module_key;
+     BEGIN
+	OPEN c1;
+	FETCH c1 into v_dummy;
+
+	if c1%NOTFOUND then
+	    return 'f';
+        else	
+	    return 't';
+	end if;
+
+     END group_section_module_exists_p;
+/
+show errors
+
+
+-- SCOPIFICATION OF THE NEWS MODULE
+
+-- added scoping support for news module
+alter table news add ( 
+	scope 		varchar(20),
+	user_id		references users,
+	group_id	references user_groups,
+	on_which_table  varchar(50),
+	on_what_id      integer
+);
+
+update news set scope='public';
+
+commit;
+
+alter table news add constraint news_scope_not_null_check 
+check (scope is not null);
+
+alter table news add constraint news_scope_check 
+check ((scope='group' and group_id is not null) or
+       (scope='user' and user_id is not null) or
+       (scope='table' and on_which_table is not null and on_what_id is not null) or
+       (scope='public'));
+
+create index news_idx on news ( user_id );
+create index news_group_idx on news ( group_id );
+
+
+-- SCOPIFICATION OF THE GENERAL COMMENTS
+
+alter table general_comments add (
+	scope			varchar(20) default 'public' not null,
+	-- group_id of the group for which this general comment was submitted
+	group_id		references user_groups	
+);
+
+alter table add constraint general_comments_scope_check 
+check ((scope='group' and group_id is not null) or
+       (scope='public'));
+
+
+-- BBoard changes
+create sequence bboard_topic_id_sequence;
+
+alter table bboard_topics add (topic_id	integer);
+update bboard_topics set topic_id = bboard_topic_id_sequence.nextval;
+alter table bboard_topics modify (topic_id not null);
+-- drop references to topic so we can add primary key on topic_id
+alter table bboard_topics drop primary key cascade;
+alter table bboard_topics add (primary key (topic_id));
+
+alter table bboard_topics add (read_access	varchar(16) default 'any' check (read_access in ('any','public','group')));
+alter table bboard_topics add (write_access 	varchar(16) default 'public' check (write_access in ('public','group')));
+
+alter table bboard add (urgent_p        char(1) default 'f' not null check (urgent_p in ('t','f')));
+
+
+alter table bboard_q_and_a_categories add (topic_id references bboard_topics);
+update bboard_q_and_a_categories set topic_id = (select topic_id from bboard_topics where topic = bboard_q_and_a_categories.topic);
+alter table bboard_q_and_a_categories modify (topic_id not null);
+
+alter table bboard_bozo_patterns add (topic_id references bboard_topics);
+update bboard_bozo_patterns set topic_id = (select topic_id from bboard_topics where topic = bboard_bozo_patterns.topic);
+alter table bboard_bozo_patterns modify (topic_id not null);
+
+alter table bboard add (topic_id references bboard_topics);
+update bboard set topic_id = (select topic_id from bboard_topics where topic = bboard.topic);
+alter table bboard modify (topic_id not null);
+
+drop index bboard_for_new_questions;
+create index bboard_for_new_questions on bboard ( topic_id, refers_to, posting_time );
+
+drop index bboard_for_one_category;
+create index bboard_for_one_category on bboard ( topic_id, category, refers_to );
+
+create or replace view bboard_new_answers_helper 
+as
+select substr(sort_key,1,6) as root_msg_id, topic_id, posting_time from bboard
+where refers_to is not null;
+
+alter table bboard_email_alerts add (topic_id references bboard_topics);
+update bboard_email_alerts set topic_id = (select topic_id from bboard_topics where topic = bboard_email_alerts.topic);
+alter table bboard_email_alerts modify (topic_id not null);
+
+-- Create and populate bboard_thread_email_alerts
+create table bboard_thread_email_alerts (
+	thread_id	references bboard, -- references msg_id of thread root
+	user_id		references users,
+	primary key (thread_id, user_id)
+);
+
+insert into bboard_thread_email_alerts
+select distinct substr(sort_key, 1, 6), user_id
+from bboard
+where notify = 't';
+
+alter table bboard_topics add (unique(topic)); 
+
+-- Drop obsolete columns and tables.
+alter table bboard_topics drop column ns_perm_group;
+alter table bboard_topics drop column ns_perm_group_added_for_forum;
+alter table bboard_topics drop column restrict_to_workgroup_p;
+
+drop table bboard_authorized_maintainers;
+drop table bboard_workgroup;
+
+alter table bboard_bozo_patterns drop primary key;
+alter table bboard_bozo_patterns drop column topic;
+alter table bboard_bozo_patterns add primary key (topic_id, the_regexp);
+
+alter table bboard_bozo_patterns add primary key(topic_id);
+alter table bboard_email_alerts drop column topic;
+
+alter table bboard_q_and_a_categories drop primary key;
+alter table bboard_q_and_a_categories drop column topic;
+alter table bboard_q_and_a_categories add primary key (topic_id, category);
+
+alter table bboard drop column topic;
+
+
+--------- add an API call to the user group system
+
+create or replace function ad_group_member_p
+  (v_user_id	IN user_group_map.user_id%TYPE,
+   v_group_id	IN user_group_map.group_id%TYPE)
+return char
+IS
+  ad_group_member_p char(1);
+BEGIN
+  -- maybe we should check the validity of user_id and group_id;
+  -- we're not doing it for now, because it would slow this function
+  -- down with 2 extra queries
+
+  select decode(count(*), 0, 'f', 't')
+  into ad_group_member_p
+  from user_group_map 
+  where user_id = v_user_id
+  and group_id = v_group_id
+  and rownum < 2;
+
+  return ad_group_member_p;
+END ad_group_member_p;
+/
+show errors
+
+create or replace function ad_group_member_admin_role_p
+  (v_user_id IN integer, v_group_id IN integer)
+return varchar
+IS
+  n_rows  integer;
+BEGIN
+  select count(*) into n_rows
+   from user_group_map 
+   where user_id = v_user_id
+   and group_id = v_group_id
+   and lower(role) = 'administrator';
+  IF n_rows > 0 THEN
+    return 't';
+  ELSE
+    return 'f';
+  END IF;
+END;
+/
+show errors
+
+
+-- Support for persistent table customization, dimensional sliders,
+-- etc.   from user-custom.sql
+--  davis@arsdigita.com
+
+create table user_custom (
+        user_id         references users not null,
+        -- user entered name
+        item            varchar2(80) not null,
+        -- ticket_table etc
+        item_group      varchar2(80) not null,
+        -- table_view etc
+        item_type       varchar2(80) not null,
+        -- list nsset etc.
+        value_type      varchar2(80) not null,
+        value           clob default empty_clob(), 
+        primary key (user_id, item, item_group, item_type)
+);
+
+
+-- NEW FAQ MODULE
+
+-- faq.sql  
+
+-- a simple data model for holding a set of FAQs
+-- by dh@arsdigita.com
+
+-- Created Dec. 19 1999
+
+create sequence faq_id_sequence;
+
+create table faqs (
+	faq_id		integer primary key,
+	-- name of the FAQ.
+	faq_name	varchar(250) not null,
+	-- group the viewing may be restricted to 
+	group_id	integer references user_groups,
+	-- permissions can be expanded to be more complex later
+        scope		varchar(20),
+        -- insure consistant state 
+       	constraint faq_scope_check check ((scope='group' and group_id is not null) 
+                                          or (scope='public'))
+);
+
+create index faqs_group_idx on faqs ( group_id );
+
+create sequence faq_entry_id_sequence;
+
+create table faq_q_and_a (
+	entry_id	integer primary key,
+	 -- which FAQ
+	faq_id		integer references faqs not null,
+	question	varchar(4000) not null,
+	answer		varchar(4000) not null,
+	 -- determines the order of questions in a FAQ
+	sort_key	integer not null
+);
+
+create or replace trigger faq_entry_faq_delete_tr
+before delete on faqs
+for each row
+begin
+
+   delete from faq_q_and_a
+   where faq_id=:old.faq_id;
+
+end faq_entry_faq_delete_tr;
+/
+show errors
+
+
+-- NEW DOWNLOAD MODULE
+
+--
+-- download.sql
+-- 
+-- created by philg@mit.edu on 12/28/99
+--
+-- supports a system for keeping track of what .tar files or whatever
+-- are available to which users and who has downloaded what
+--
+-- e.g., we use this at ArsDigita to keep track of who has downloaded
+-- our open-source toolkit (so that we can later spam them with 
+-- upgrade notifications)
+-- 
+
+create sequence download_id_sequence start with 1;
+
+create table downloads (
+	download_id		integer primary key,
+	-- if scope=public, this is a download for the whole system
+        -- if scope=group, this is a download for/from a subcommunity
+        scope           varchar(20) not null,
+	-- will be NULL if scope=public 
+	group_id	references user_groups,
+	-- e.g., "Bloatware 2000"
+	download_name	varchar(100) not null,
+	directory_name	varchar(100) not null,
+	description		varchar(4000),
+	-- is the description in HTML or plain text (the default)
+	html_p			char(1) default 'f' check(html_p in ('t','f')),
+	creation_date		date default sysdate not null,
+	creation_user		not null references users(user_id),
+	creation_ip_address	varchar(50) not null,
+        -- state should be consistent
+	constraint download_scope_check check ((scope='group' and group_id is not null) 
+                                               or (scope='public'))
+);
+
+create index download_group_idx on downloads ( group_id );
+
+create sequence download_version_id_sequence start with 1;
+
+create table download_versions (
+	version_id	integer primary key,
+	download_id	not null references downloads,
+	-- when this can go live before the public
+	release_date	date not null,
+	pseudo_filename	varchar(100) not null,
+	-- might be the same for a series of .tar files, we'll serve
+	-- the one with the largest version_id
+	version		number,
+	status		varchar(30) check (status in ('promote', 'offer_if_asked', 'removed')),
+	creation_date		date default sysdate not null ,
+	creation_user		not null references users(user_id),
+	creation_ip_address	varchar(50) not null
+);
+
+create index download_versions_download_idx on download_versions ( download_id );
+
+create sequence download_rule_id_sequence start with 1;
+
+create table download_rules (
+	rule_id		integer primary key,
+	-- one of the following will be not null
+	version_id	references download_versions,
+	download_id	references downloads,
+	user_scope	varchar(30) check (user_scope in ('all', 'registered_users', 'purchasers', 'group_members', 'previous_purchasers')),
+	-- will be NULL unless user_scope is 'group_membes'
+	group_id	references user_groups,
+	-- price to purchase or upgrade, typically NULL
+	price		number,
+	-- currency code to feed to CyberCash or other credit card system
+	currency	varchar(3) default 'USD'
+);
+
+alter table download_rules add constraint download_version_null_check 
+check ( download_id is not null or version_id is not null);
+
+create index download_rules_version_idx on download_rules ( version_id );
+create index download_rules_download_idx on download_rules ( download_id );
+
+
+-- build a PL/SQL proc here 
+-- returns 't' if a user can download, 'f' if not 
+-- if supplied user_id is NULL, this is an unregistered user and we 
+-- look for rules accordingly
+
+create or replace function download_authorized_p (version_id IN integer, user_id IN integer)
+returns varchar
+begin
+  return 't';
+end download_authorized_p;
+/
+show errors
+
+-- history 
+
+create sequence download_log_id_sequence start with 1;
+
+create table download_log (
+	log_id		integer primary key,
+	version_id	not null references download_versions,
+	user_id		not null references users,
+	entry_date	date not null,
+	ip_address	varchar(50) not null
+);
+
+create index download_log_version_idx on download_log ( version_id );
+
+create or replace trigger download_versions_delete_info
+before delete on downloads
+for each row
+begin
+
+   delete from download_versions
+   where download_id=:old.download_id;
+
+end download_versions_delete_info;
+/
+show errors
+
+create or replace trigger downloads_rules_dload_del_tr
+before delete on downloads
+for each row
+begin
+
+   delete from download_rules
+   where download_id=:old.download_id;
+
+end downloads_rules_dload_del_tr;
+/
+show errors
+
+create or replace trigger downloads_rules_version_del_tr
+before delete on download_versions
+for each row
+begin
+
+   delete from download_rules
+   where version_id=:old.version_id;
+
+end downloads_rules_version_del_tr;
+/
+show errors
+
+create or replace trigger download_log_user_delete_tr
+before delete on users
+for each row
+begin
+
+   delete from download_log
+   where user_id=:old.user_id;
+
+end download_log_user_delete_tr;
+/
+show errors
+
+create or replace trigger download_log_version_delete_tr
+before delete on download_versions
+for each row
+begin
+
+   delete from download_log
+   where version_id=:old.version_id;
+
+end download_log_version_delete_tr;
+/
+show errors
+
+
+
+        
+
+                     
+
+
+
+
+
+
Index: web/openacs/www/doc/sql/upgrade-3.1-3.2.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/upgrade-3.1-3.2.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/upgrade-3.1-3.2.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,2080 @@
+--
+-- /www/doc/sql/upgrade-3.1-3.2.sql
+--
+-- Script to upgrade an ACS 3.1 database to ACS 3.2
+-- 
+-- upgrade-3.1-3.2.sql,v 3.17.2.24 2000/03/28 09:41:10 carsten Exp
+--
+
+-- BEGIN SECURITY --
+create table sec_sessions (
+    -- Unique ID (don't care if everyone knows this)
+    session_id            integer primary key,
+    user_id               integer references users,
+    -- A secret used for unencrypted connections
+    token                 varchar(50) not null,
+    -- A secret used for encrypted connections only. not generated until needed
+    secure_token          varchar(50),
+    browser_id            integer not null,
+    -- Make sure all hits in this session are from same host
+    last_ip               varchar(50) not null,
+    -- When was the last hit from this session? (seconds since the epoch)
+    last_hit              integer not null
+);
+
+create table sec_login_tokens (
+    -- A table to track tokens assigned for permanent login. The login_token
+    -- is isomorphic to the password, i.e., the user can use the login_token
+    -- to log back in.
+    user_id	integer references users not null,
+    password    varchar(30) not null,
+    login_token varchar(50) not null,
+    primary key(user_id, password)
+);
+
+-- When a user changes his password, delete any login tokens associated
+-- with the old password.
+create function trig_users_update_login_token()
+returns opaque as '
+DECLARE
+BEGIN
+	delete from sec_login_tokens
+	where user_id= NEW.user_id and password!= NEW.password;
+	return NEW;
+END;
+' language 'plpgsql';
+
+create trigger users_update_login_token
+before update on users
+for each row
+execute procedure trig_users_update_login_token();
+
+create table sec_session_properties (
+    session_id     integer references sec_sessions not null,
+    module         varchar(50) not null,
+    property_name  varchar(50) not null,
+    property_value varchar(4000),
+    -- transmitted only across secure connections?
+    secure_p       char(1) check(secure_p in ('t','f')),
+    primary key(session_id, module, property_name),
+    foreign key(session_id) references sec_sessions on delete cascade
+);
+
+create table sec_browser_properties (
+    browser_id     integer not null,
+    module         varchar(50) not null,
+    property_name  varchar(50) not null,
+    property_value clob,
+    -- transmitted only across secure connections?
+    secure_p       char(1) check(secure_p in ('t','f')),
+    primary key(browser_id, module, property_name)
+);
+
+create sequence sec_id_seq;
+
+create function sec_rotate_last_visit(integer, integer)
+returns integer as '
+DECLARE
+	v_browser_id alias for $1;
+	v_time alias for $2;
+BEGIN
+    delete from sec_browser_properties
+        where browser_id = v_browser_id and module = ''acs'' and property_name = ''second_to_last_visit'';
+    update sec_browser_properties
+        set property_name = ''second_to_last_visit''
+        where module = ''acs'' and property_name = ''last_visit'' and browser_id = v_browser_id;
+    insert into sec_browser_properties(browser_id, module, property_name, property_value, secure_p)
+        values(v_browser_id, ''acs'', ''last_visit'', v_time::char, ''f'');
+
+    return 1;
+end;
+' language 'plpgsql';
+
+-- END SECURITY --
+
+-- BEGIN USER GROUPS --
+
+-- Drop user_group_map's primary key (user_id + group_id),
+-- and replace it with a unique constraint on user_id +
+-- group_id + role.
+
+alter table user_group_map drop primary key;
+alter table user_group_map add unique (user_id, group_id, role);
+
+-- Drop user_group_type_member_fields's primary key (user_id +
+-- group_id), and replace it with a unique constraint on user_id +
+-- group_id + role, which is a new column.
+
+alter table user_group_type_member_fields add (role varchar(200));
+alter table user_group_type_member_fields drop primary key;
+alter table user_group_type_member_fields add unique (group_type, role, field_name);
+
+-- Rename user_group_regdate trigger to user_group_approved_p_tr
+
+drop trigger user_group_regdate;
+
+create or replace trigger user_group_approved_p_tr
+before insert on user_groups
+for each row
+declare
+  group_type_row user_group_types%ROWTYPE;
+begin
+  if :new.approved_p is null then 
+    select * into group_type_row from user_group_types ugt 
+      where ugt.group_type = :new.group_type;
+    if group_type_row.approval_policy = 'open' then
+      :new.approved_p := 't';
+    else 
+      :new.approved_p := 'f';
+    end if;
+  end if;  
+end;
+/
+show errors
+
+-- new proc ad_user_has_role_p
+
+create or replace function ad_user_has_role_p
+  (v_user_id	IN user_group_map.user_id%TYPE,
+   v_group_id	IN user_group_map.group_id%TYPE,
+   v_role	IN user_group_map.role%TYPE)
+return char
+IS
+  ad_user_has_role_p char(1);
+BEGIN
+  -- maybe we should check the validity of user_id and group_id;
+  -- we're not doing it for now, because it would slow this function
+  -- down with 2 extra queries
+
+  select decode(count(*), 0, 'f', 't')
+  into ad_user_has_role_p
+  from user_group_map 
+  where user_id = v_user_id
+  and group_id = v_group_id
+  and role = v_role;
+
+  return ad_user_has_role_p;
+END ad_user_has_role_p;
+/
+show errors
+
+-- Replace superfluous triggers with default values
+
+alter table user_groups modify (
+	registration_date       date default sysdate
+);
+
+drop trigger user_group_map_regdate;
+alter table user_group_map modify (
+	registration_date	date default sysdate
+);
+
+drop trigger user_group_roles_creation_date;
+alter table user_group_roles modify (
+	creation_date	date default sysdate
+);
+
+drop trigger user_group_actions_create_date;
+alter table user_group_actions modify (
+	creation_date	date default sysdate
+);
+
+drop trigger user_gr_action_role_map_date;
+alter table user_group_action_role_map modify (
+	creation_date	date default sysdate
+);
+
+drop trigger user_group_map_queue_date;
+alter table user_group_map_queue modify (
+	queue_date	date default sysdate
+);
+
+-- END USER GROUPS --
+
+-- BEGIN DOWNLOAD MODULE --
+ 
+-- Change the data type of version column from number to varchar
+
+alter table download_versions add ( temp_version varchar(30));
+
+update download_versions 
+set temp_version = to_char(version)
+where version is not null;
+
+alter table download_versions drop column version;
+
+alter table download_versions add ( version varchar(30));
+
+update download_versions
+set version = temp_version;
+
+alter table download_versions drop column temp_version;
+
+-- Add new columns
+
+alter table download_versions add (
+	version_description 	varchar(4000),
+	version_html_p		char(1) default 'f'
+				check (version_html_p in ('t','f'))
+);
+
+commit;
+
+-- END DOWNLOAD MODULE --
+
+-- BEGIN INTRANET MODULE --
+
+-- add partner status information to the intranet
+create sequence im_partner_status_id_seq start with 1;
+create table im_partner_status (
+	partner_status_id	integer primary key,
+	partner_status		varchar(100) not null unique,
+	display_order		integer default 1
+);
+
+alter table im_partners add partner_status_id references im_partner_status;
+
+-- populate the intranet partner status table
+insert into im_partner_status 
+(partner_status_id, partner_status, display_order)
+values
+(im_partner_status_id_seq.nextVal, 'Targeted', 1);
+
+insert into im_partner_status 
+(partner_status_id, partner_status, display_order)
+values
+(im_partner_status_id_seq.nextVal, 'In Discussion', 2);
+
+insert into im_partner_status 
+(partner_status_id, partner_status, display_order)
+values
+(im_partner_status_id_seq.nextVal, 'Active', 3);
+
+insert into im_partner_status 
+(partner_status_id, partner_status, display_order)
+values
+(im_partner_status_id_seq.nextVal, 'Announced', 4);
+
+insert into im_partner_status 
+(partner_status_id, partner_status, display_order)
+values
+(im_partner_status_id_seq.nextVal, 'Dormant', 5);
+
+insert into im_partner_status 
+(partner_status_id, partner_status, display_order)
+values
+(im_partner_status_id_seq.nextVal, 'Dead', 6);
+
+alter table im_employee_info add referred_by references users;
+create index im_employee_info_referred_idx on im_employee_info(referred_by);
+
+create or replace function im_project_ticket_project_id ( v_group_id IN integer )
+RETURN integer
+IS
+  v_project_id    ticket_projects.project_id%TYPE;
+BEGIN
+  v_project_id := 0;
+  BEGIN
+    select project_id
+    into v_project_id
+    from ticket_projects
+    where group_id = v_group_id;
+
+    EXCEPTION WHEN OTHERS THEN NULL;
+  END;
+  return v_project_id;
+END;
+/
+show errors;
+
+begin
+   user_group_add ('intranet', 'Partners', 'partner', 'f'); 
+   user_group_add ('intranet', 'Authorized Users', 'authorized_users', 'f'); 
+end;
+/
+show errors;
+
+alter table im_employee_info add (
+        featured_employee_approved_p char(1) 
+              constraint featured_employee_p_con check(featured_employee_approved_p in ('t','f')),
+        featured_employee_approved_by integer references users,
+        featured_employee_blurb clob,
+        featured_employee_blurb_html_p char(1) default 'f'
+              constraint featured_emp_blurb_html_p_con check (featured_employee_blurb_html_p in ('t','f'))
+);
+
+
+-- END INTRANET MODULE --
+
+-- BEGIN EVENTS MODULE --
+
+-- create a procedure for initializing a new sequence initialized
+-- to start with values from another sequence.
+
+create or replace procedure init_sequence (new_seq IN varchar, old_seq IN varchar)
+IS
+	i_seq_val	integer;
+	tmp_seq_val	integer;
+	sql_stmt	varchar(500);
+	i		integer;
+BEGIN
+	-- get the old sequence's value
+	sql_stmt := 'select ' || old_seq || '.nextval from dual';
+	EXECUTE IMMEDIATE sql_stmt INTO i_seq_val;
+
+	-- set the new sequence to be the old sequence's value
+	i := 0;
+        FOR i IN 0..i_seq_val LOOP
+	      EXECUTE IMMEDIATE
+               'select ' || new_seq || '.nextval from dual'
+              INTO tmp_seq_val;
+	END LOOP;
+END init_sequence;
+/
+show errors;
+
+---------------------------------------------
+-- create the new events module data model
+---------------------------------------------
+
+-- we store the ISO code in lower case, e.g,. 'us'
+
+-- if detail_url does not start with "HTTP://" then we assume
+-- it is a stub for information on our server and we grab it
+-- from the file system, starting at [ns_info pageroot]
+
+create or replace procedure administration_subgroup_add (pretty_name IN
+varchar, v_short_name IN varchar, v_module IN varchar, v_submodule IN
+varchar, v_multi_role_p IN varchar, v_url IN varchar, 
+v_parent_module IN varchar) 
+IS
+  v_group_id	integer;
+  n_administration_groups integer;
+  v_system_user_id integer; 
+  v_parent_id integer;
+BEGIN
+  if v_submodule is null then
+      select count(group_id) into n_administration_groups
+        from administration_info 
+        where module = v_module 
+        and submodule is null;
+      else
+	select count(group_id) into n_administration_groups
+         from administration_info
+         where module = v_module 
+         and submodule = v_submodule;
+  end if;
+  if n_administration_groups = 0 then 
+     -- call procedure defined in community-core.sql to get system user
+     v_system_user_id := system_user_id;
+     select user_group_sequence.nextval into v_group_id from dual;
+     insert into user_groups 
+      (group_id, group_type, short_name, group_name, creation_user, creation_ip_address, approved_p, existence_public_p, new_member_policy, multi_role_p)
+      values
+      (v_group_id, 'administration', v_short_name, pretty_name, v_system_user_id, '0.0.0.0', 't', 'f', 'closed', v_multi_role_p);
+     insert into administration_info (group_id, module, submodule, url) values (v_group_id, v_module, v_submodule, v_url);
+   end if;
+
+   Begin
+      select ai.group_id into v_parent_id
+      from administration_info ai, user_groups ug
+      where ai.module = v_parent_module
+      and ai.group_id != v_group_id
+      and ug.group_id = ai.group_id
+      and ug.parent_group_id is null;
+   Exception when others then null;
+   End;
+   
+   update user_groups
+   set parent_group_id = v_parent_id
+   where group_id = v_group_id;
+end;
+/
+show errors
+
+
+--- create the administration group for the Events module
+begin
+   administration_group_add ('Events Administration', 'events', 'events', '', 'f', '/admin/events/'); 
+end;
+/
+
+-- create a group type of "events"
+insert into user_group_types 
+(group_type, pretty_name, pretty_plural, approval_policy, group_module_administration)
+values
+('events_group', 'Event', 'Events', 'closed', 'full');
+
+create table events_group_info (
+       group_id primary key references user_groups
+);
+
+-- can't ever delete an event/activity because it might have been
+-- ordered and therefore the row in events_registrations would be hosed
+-- so we flag it
+
+create sequence events_activity_id_sequence;
+
+-- the activities
+create table events_activities (
+	activity_id	integer primary key,
+	-- activities are owned by user groups
+	group_id	integer references user_groups,
+	user_id		integer references users,
+        creator_id      integer not null references users,
+	short_name	varchar(100) not null,
+	default_price   number default 0 not null,
+	currency	char(3) default 'USD',
+	description	clob,
+        -- Is this activity occurring? If not, we can't assign
+        -- any new events to it.
+        available_p	char(1) default 't' check (available_p in ('t', 'f')),
+        deleted_p	char(1) default 'f' check (deleted_p in ('t', 'f')),
+        detail_url 	varchar(256) -- URL for more details,
+);
+
+create sequence events_venues_id_sequence;
+
+-- where the events occur
+create table events_venues (
+       venue_id		  integer primary key,
+       venue_name	  varchar(200) not null,
+       address1		  varchar(100),
+       address2		  varchar(100),
+       city		  varchar(100) not null,
+       usps_abbrev	  char(2),
+       postal_code	  varchar(20),
+       iso		  char(2) default 'us' references country_codes,
+       time_zone	  varchar(50),
+       needs_reserve_p	  char(1) default 'f' check (needs_reserve_p in ('t', 'f')),
+       max_people	  number,	
+       description	  clob
+);
+
+create sequence events_event_id_sequence;
+
+-- the events (instances of activities)
+create table events_events (
+        event_id              integer not null primary key,
+        activity_id	      integer not null references events_activities,
+	venue_id	      integer not null references events_venues,
+	-- the user group that is created for this event's registrants
+	group_id	      integer not null references user_groups,
+	creator_id	      integer not null references users,
+        -- HTML to be displayed after a successful order.
+        display_after         varchar(4000),
+        -- Date and time.
+        start_time            date not null,
+        end_time              date not null,
+	reg_deadline	      date not null,
+        -- An event may have been cancelled.
+        available_p	      char(1) default 't' check (available_p in ('t', 'f')),	
+        deleted_p	      char(1) default 'f' check (deleted_p in ('t', 'f')),
+        max_people	      number,
+	-- can someone cancel his registration?		
+	reg_cancellable_p     char(1) default 't' check (reg_cancellable_p in ('t', 'f')),
+	-- does a registration need approval to become finalized?
+	reg_needs_approval_p  char(1) default 'f' check (reg_needs_approval_p in ('t', 'f')),
+	-- notes for doing av setup
+	av_note		      clob,
+	-- notes for catering
+	refreshments_note     clob,
+	-- extra info about this event
+	additional_note	      clob,
+	-- besides the web, is there another way to register?
+	alternative_reg	      clob,
+        check (start_time < end_time),
+	check (reg_deadline <= start_time)
+);
+
+-- Each activity can have default custom fields registrants should enter.  
+create table events_activity_fields (
+	activity_id	not null references events_activities,
+	column_name	varchar(30) not null,
+	pretty_name	varchar(50) not null,
+	-- something generic and suitable for handing to AOLserver, 
+	-- e.g., boolean or text
+	column_type	varchar(50) not null,
+	-- something nitty gritty and Oracle-specific, e.g.,
+	-- char(1) instead of boolean
+	-- things like "not null"
+	column_actual_type	varchar(100) not null,
+	column_extra	varchar(100),
+	-- Sort key for display of columns.
+	sort_key	integer not null
+);
+
+
+-- Each event can have custom fields registrants should enter.  The
+-- event's custom fields are actually stored in the table,
+-- event_{$event_id}_info.  For example, the event with event_id == 5
+-- would have a corresponding table of event_5_info.  Furthermore, this
+-- table will contain a "user_id not null references users" column
+
+-- This table describes the columns that go into event_{$event_id}_info
+create table events_event_fields (
+	event_id	not null references events_events,
+	column_name	varchar(30) not null,
+	pretty_name	varchar(50) not null,
+	-- something generic and suitable for handing to AOLserver, 
+	-- e.g., boolean or text
+	column_type	varchar(50) not null,
+	-- something nitty gritty and Oracle-specific, e.g.,
+	-- char(1) instead of boolean
+	-- things like "not null"
+	column_actual_type	varchar(100) not null,
+	column_extra	varchar(100),
+	-- Sort key for display of columns.
+	sort_key	integer not null
+);
+
+-- the organizers for events
+create table events_organizers_map (
+       event_id		      integer not null references events_events,  
+       user_id		      integer not null references users,
+       role		      varchar(200) default 'organizer' not null,
+       responsibilities	      clob
+);
+
+create sequence events_price_id_sequence;
+
+create table events_prices (
+    price_id            integer primary key,
+    event_id            integer not null references events_events,
+    -- e.g., "Developer", "Student"
+    description         varchar(100) not null,
+    -- we also store the price here too in case someone doesn't want
+    -- to use the ecommerce module but still wants to have prices
+    price		number not null,
+    -- This is for hooking up to ecommerce.	
+    -- Each product is a different price for this event.  For example,
+    -- student price and normal price products for an event.
+--  product_id          integer references ec_products,
+    -- prices may be different for early, normal, late, on-site
+    -- admission,
+    -- depending on the date
+    expire_date	      date not null,
+    available_date    date not null
+);
+
+create sequence events_orders_id_sequence;
+
+create table events_orders (
+       order_id		integer not null primary key,
+--       ec_order_id	integer references ec_orders,
+       -- the person who made the order
+       user_id		integer not null references users,
+       paid_p		char(1) default null check (paid_p in ('t', 'f', null)),
+	payment_method	varchar(50),
+	confirmed_date	date,
+	price_charged	number,
+	-- the date this registration was refunded, if it was refunded
+	refunded_date	date,
+	price_refunded	number,	
+       	ip_address	varchar(50) not null
+);
+
+create sequence events_reg_id_sequence;
+
+create table events_registrations(
+        -- Goes into table at confirmation time:
+	reg_id		integer not null primary key,
+	order_id	integer not null references events_orders,
+	price_id	integer not null references events_prices,
+	-- the person registered for this reg_id (may not be the person
+	-- who made the order)
+	user_id		integer not null references users,
+	-- reg_states: pending, shipped, canceled, refunded
+	--pending: waiting for approval
+	--shipped: registration all set 
+	--canceled: registration canceled
+	--waiting: registration is wait-listed
+	reg_state	varchar(50) not null check (reg_state in ('pending', 'shipped', 'canceled',  'waiting')),
+	-- when the registration was made
+	reg_date	date,
+	-- when the registration was shipped
+	shipped_date	date,
+	org		varchar(4000),
+	title_at_org	varchar(4000),
+	attending_reason  clob,
+	where_heard	varchar(4000),
+	-- does this person need a hotel?
+        need_hotel_p	char(1) default 'f' check (need_hotel_p in ('t', 'f')),
+	-- does this person need a rental car?
+        need_car_p	char(1) default 'f' check (need_car_p in ('t', 'f')),
+	-- does this person need airfare?
+	need_plane_p	char(1) default 'f' check (need_plane_p in ('t', 'f')),
+	comments	clob
+);
+
+-- trigger for recording when a registration ships
+create or replace trigger event_ship_date_trigger
+before insert or update on events_registrations
+for each row
+when (old.reg_state <> 'shipped' and new.reg_state = 'shipped')
+begin
+	:new.shipped_date := sysdate;
+end;
+/
+show errors
+
+-- create a view that shows order states based upon each order's 
+-- registrations.  The order states are:
+-- void: All registrations canceled
+-- incomplete: This order is not completely fulfilled--some registrations
+-- are either canceled, waiting, or pending
+-- fulfilled: This order is completely fulfilled
+create or replace view events_orders_states 
+as
+select  o.*,
+o_states.order_state
+from events_orders o,
+ (select
+ order_id,
+ decode (floor(avg (decode (reg_state, 
+ 		   'canceled', 0,
+		   'waiting', 1,
+		   'pending', 2,
+		   'shipped', 3,
+		   0))),
+	     0, 'canceled',
+	     1, 'incomplete',
+	     2, 'incomplete',
+	     3, 'fulfilled',
+	     'void') as order_state
+ from events_registrations
+ group by order_id) o_states
+where o_states.order_id = o.order_id;
+
+create or replace view events_reg_not_canceled
+as 
+select * 
+from events_registrations
+where reg_state <> 'canceled';
+
+create or replace view events_reg_canceled
+as 
+select * 
+from events_registrations
+where reg_state = 'canceled';
+
+create or replace view events_reg_shipped
+as
+select *
+from events_registrations
+where reg_state = 'shipped';
+
+create sequence events_fs_file_id_seq start with 1;
+
+create table events_file_storage (
+	file_id			integer primary key,
+	file_title		varchar(300),
+	file_content		blob not null,
+	client_file_name		varchar(500),
+	file_type		varchar(100),
+	file_extension		varchar(50),
+	on_which_table		varchar(100) not null,
+	on_what_id		integer not null,
+	-- the size (kB) of the fileument
+	file_size		integer, 
+	created_by		references users,
+	creation_ip_address	varchar(100),
+	creation_date		date default sysdate 
+);
+	
+create index events_file_storage_id_idx on events_file_storage(on_which_table, on_what_id);
+
+-- Sync up the new sequences with the old ones.
+
+execute	init_sequence('events_activity_id_sequence', 'evreg_activity_id_sequence');
+execute	init_sequence('events_venues_id_sequence', 'evreg_venues_id_sequence');
+execute	init_sequence('events_event_id_sequence', 'evreg_event_id_sequence');
+
+----------------------------------
+-- copy the old events data
+----------------------------------
+
+--function for creating a user group for an event
+create or replace function create_event_group(
+ event_id_in integer
+)
+return integer
+IS
+	event_group_name	varchar(100);
+	event_short_name	varchar(100);
+	event_group_id		integer;
+	event_start		varchar(25);
+	short_name		varchar(100);
+	city varchar(100);
+	usps_abbrev		char(2);
+	iso			char(2);
+	pretty_location		varchar(100);
+BEGIN
+
+--	select 
+--	to_char(e.start_time, 'YYYY-MM-DD HH:MM:SS') into event_start,
+--	a.short_name into short_name,
+--	v.city into city,
+--	v.usps_abbrev into usps_abbrev,
+--	v.iso into iso
+
+	select 
+	to_char(e.start_time, 'YYYY-MM-DD HH:MM:SS'),
+	a.short_name, v.city, v.usps_abbrev, v.iso
+	into event_start, short_name, city, usps_abbrev, iso
+	from evreg_events e, evreg_activities a, evreg_venues v
+	where a.activity_id = e.activity_id
+	and v.venue_id = e.venue_id
+	and e.event_id = event_id_in;
+
+	IF iso = 'us' THEN
+	   pretty_location := city || ', ' || usps_abbrev;
+	ELSE
+	   pretty_location := city || ', ' || iso;
+	END IF;
+	
+	event_group_name := short_name || ' in ' || pretty_location || ' on ' || event_start;
+	event_short_name := short_name_from_group_name(event_group_name);
+
+	--create the user group now
+	user_group_add('events_group', event_group_name, 
+		       event_short_name, 't');
+
+        --get the group id
+	select group_id
+	into event_group_id
+	from user_groups
+	where short_name = event_short_name;
+
+	return event_group_id;
+end create_event_group;
+/
+show errors
+
+--procedure for creating the appropriate prices for events
+create or replace procedure create_event_prices
+IS
+	price_avail_time	date;
+	
+	cursor c1 is
+	select event_id, end_time, start_time
+	from events_events;
+BEGIN
+	FOR e IN c1 LOOP
+
+	    --see what to put for when this price is available
+	    IF sysdate < e.start_time THEN
+	       --this event hasn't taken place yet, so the price is
+	       --available now
+	       price_avail_time := sysdate;
+	    ELSE
+	       --event has already taken place, so arbitrarily 
+	       --use the start time - 1 day
+	       price_avail_time := e.start_time - 1;
+	    END IF;
+
+	    INSERT into events_prices
+	    (price_id, event_id, description, price, expire_date,
+	    available_date)
+	    VALUES
+	    (events_price_id_sequence.nextval, e.event_id,
+	    'Normal Price', 0, e.end_time, price_avail_time);
+
+	END LOOP;
+END create_event_prices;
+/
+show errors;
+
+--procedure to copy the registrations over
+create or replace procedure copy_registrations
+IS
+	i_order_id	integer;
+	v_reg_state	varchar(50);
+	i_price_id	integer;
+
+	cursor c1 is
+	select 
+	event_id, user_id, paid_p,
+	confirmed_date, ip_address, order_state,
+	org, title_at_org, attending_reason,
+	where_heard, need_hotel_p, need_car_p, 
+	need_plane_p, comments, canceled_p
+	from evreg_orders;
+BEGIN
+	FOR o in c1 LOOP
+
+	    --this depends on events_events having the same
+	    --event_id's as evreg_events
+	    select price_id into i_price_id
+	    from events_prices
+	    where event_id = o.event_id;
+
+	    --create the event order
+	    select events_orders_id_sequence.nextval into i_order_id
+	    from dual;
+
+	    INSERT into events_orders 
+	    (order_id, user_id, paid_p, confirmed_date,
+	    ip_address)
+	    VALUES
+	    (i_order_id, o.user_id, o.paid_p,
+	    o.confirmed_date, o.ip_address);
+
+	    --figure out the reg_state
+	    IF o.canceled_p = 't' THEN
+	       v_reg_state := 'canceled';
+	    ELSIF o.order_state = 'shipped' THEN
+	       v_reg_state := 'shipped';
+	    ELSE
+	       v_reg_state := 'pending';
+	    END IF;
+
+	    --copy the registration
+	    INSERT into events_registrations 
+	    (reg_id, order_id, price_id, user_id, reg_state, org,
+	    title_at_org, attending_reason, where_heard, need_hotel_p,
+	    need_car_p, need_plane_p, reg_date)
+	    VALUES
+	    (events_reg_id_sequence.nextval, i_order_id, i_price_id,
+	    o.user_id, v_reg_state, o.org, o.title_at_org,
+	    o.attending_reason, o.where_heard, o.need_hotel_p,
+	    o.need_car_p, o.need_plane_p, o.confirmed_date);
+
+	END LOOP;
+END copy_registrations;
+/
+show errors; 
+
+insert into events_activities
+(activity_id, group_id, creator_id, short_name,
+default_price, currency, description, available_p, deleted_p,
+detail_url)
+select activity_id, group_id, creator_id, short_name,
+0, 'USD', description, available_p, 'f', detail_url
+from evreg_activities;
+
+insert into events_venues
+(venue_id, venue_name, address1, address2,
+city, usps_abbrev, postal_code, iso, 
+needs_reserve_p, max_people, description)
+select venue_id, venue_name, address1, address2,
+city, usps_abbrev, postal_code, iso, 
+needs_reserve_p, max_people, description
+from evreg_venues;
+
+insert into events_events
+(event_id, activity_id, venue_id, display_after,
+max_people, av_note, refreshments_note, additional_note,
+start_time, end_time, reg_deadline, reg_cancellable_p, group_id,
+reg_needs_approval_p, creator_id)
+SELECT
+event_id, activity_id, venue_id, display_after,
+max_people, av_note, refreshments_note, additional_note,
+start_time, end_time, start_time, 't',
+create_event_group(event_id),
+'f', system_user_id
+from evreg_events;	
+
+insert into events_organizers_map
+(event_id, user_id, role, responsibilities)
+select event_id, user_id, role, responsibilities
+from evreg_organizers_map;
+
+execute create_event_prices();
+
+execute copy_registrations();
+
+INSERT into events_file_storage
+(file_id, file_title, file_content, client_file_name,
+file_type, file_extension, on_which_table, on_what_id,
+file_size, created_by, creation_ip_address, creation_date)
+SELECT
+file_id, file_title, file_content, client_file_name,
+file_type, file_extension, on_which_table, on_what_id,
+file_size, created_by, creation_ip_address, creation_date
+FROM evreg_file_storage;
+
+------------------------------------------
+-- delete the old events data model
+------------------------------------------
+drop sequence evreg_file_storage_file_id_seq;
+drop table evreg_file_storage;
+
+drop sequence evreg_order_id_sequence;
+drop view evreg_orders_not_canceled;
+drop view evreg_orders_canceled;
+drop table evreg_orders;
+
+drop table evreg_organizers_map; 
+
+drop sequence evreg_event_id_sequence;
+drop table evreg_events;
+
+drop table evreg_venues;
+drop sequence evreg_venues_id_sequence;
+
+drop table evreg_activities;
+drop sequence evreg_activity_id_sequence;
+
+--drop the helper procedures/function
+drop procedure init_sequence;
+drop function create_event_group;
+drop procedure create_event_prices;
+drop procedure copy_registrations;
+
+-- END EVENTS MODULE --
+
+
+-- BEGIN GENERAL-PERMISSIONS --
+
+-- The general-permissions data model has changed substantially,
+-- going from two tables to just one.
+
+-- First, we create a temporary table into which we migrate the
+-- legacy data. Then, we drop all the existing data model,
+-- create the new one (incl. triggers, view, package), copy data
+-- from the temporary table into the new table, and finally
+-- drop the temporary table.
+--
+create table general_permissions_temp (
+	permission_id		integer not null primary key,
+	on_what_id		integer not null,
+	on_which_table		varchar(30) not null,
+        scope           	varchar(20),
+	user_id			references users,
+	group_id		references user_groups,
+	role			varchar(200),
+	permission_type		varchar(20) not null,
+	check ((scope = 'user' and user_id is not null
+                and group_id is null and role is null) or
+	       (scope = 'group_role' and user_id is null
+                and group_id is not null and role is not null) or
+	       (scope = 'group' and user_id is null
+                and group_id is not null and role is null) or
+	       (scope in ('registered_users', 'all_users')
+                and user_id is null
+                and group_id is null and role is null)),
+	unique (on_what_id, on_which_table,
+                scope, user_id, group_id, role, permission_type)
+);
+
+declare
+ v_scope general_permissions_temp.scope%TYPE;
+begin
+ -- Turn each row in general_permissions into as many as three rows
+ -- in general_permissions_temp: public_read_p, public_write_p, and/or
+ -- public_comment_p. For all, the scope will be 'all_users'.
+ --
+ for perm in (select * from general_permissions) loop
+  if perm.public_read_p = 't' then
+   insert into general_permissions_temp
+    (permission_id, on_what_id, on_which_table, scope, permission_type)
+   values
+    (gp_id_sequence.nextval, perm.on_what_id, perm.on_which_table, 'all_users', 'read');
+  end if;
+
+  if perm.public_write_p = 't' then
+   insert into general_permissions_temp
+    (permission_id, on_what_id, on_which_table, scope, permission_type)
+   values
+    (gp_id_sequence.nextval, perm.on_what_id, perm.on_which_table, 'all_users', 'write');
+  end if;
+
+  if perm.public_comment_p = 't' then
+   insert into general_permissions_temp
+    (permission_id, on_what_id, on_which_table, scope, permission_type)
+   values
+    (gp_id_sequence.nextval, perm.on_what_id, perm.on_which_table, 'all_users', 'comment');
+  end if;
+ end loop;
+
+ -- Turn each row in permissions_ug_map into as many as four rows
+ -- in general_permissions_temp: read_p, write_p, comment_p, and/or
+ -- owner_p (which we will turn into 'administer' permission_type).
+ -- We will need to determine the scope for each row.
+ --
+ for perm in (select
+               p.on_what_id, p.on_which_table, pgm.user_id, pgm.group_id,
+               pgm.role, pgm.read_p, pgm.write_p, pgm.comment_p, pgm.owner_p
+              from permissions_ug_map pgm, general_permissions p
+              where pgm.permissions_id = p.permissions_id)
+ loop
+  if perm.user_id is not null then
+   v_scope := 'user';
+  elsif perm.group_id is not null then
+   if perm.role is not null then
+    v_scope := 'group_role';
+   else
+    v_scope := 'group';
+   end if;
+  end if;
+
+  if perm.read_p = 't' then
+   insert into general_permissions_temp
+    (permission_id, on_what_id, on_which_table,
+     user_id, group_id, role, scope, permission_type)
+   values
+    (gp_id_sequence.nextval, perm.on_what_id, perm.on_which_table,
+     perm.user_id, perm.group_id, perm.role, v_scope, 'read');
+  end if;
+
+  if perm.write_p = 't' then
+   insert into general_permissions_temp
+    (permission_id, on_what_id, on_which_table,
+     user_id, group_id, role, scope, permission_type)
+   values
+    (gp_id_sequence.nextval, perm.on_what_id, perm.on_which_table,
+     perm.user_id, perm.group_id, perm.role, v_scope, 'write');
+  end if;
+
+  if perm.comment_p = 't' then
+   insert into general_permissions_temp
+    (permission_id, on_what_id, on_which_table,
+     user_id, group_id, role, scope, permission_type)
+   values
+    (gp_id_sequence.nextval, perm.on_what_id, perm.on_which_table,
+     perm.user_id, perm.group_id, perm.role, v_scope, 'comment');
+  end if;
+
+  if perm.owner_p = 't' then
+   insert into general_permissions_temp
+    (permission_id, on_what_id, on_which_table,
+     user_id, group_id, role, scope, permission_type)
+   values
+    (gp_id_sequence.nextval, perm.on_what_id, perm.on_which_table,
+     perm.user_id, perm.group_id, perm.role, v_scope, 'administer');
+  end if;
+ end loop; 
+end;
+/
+show errors
+
+drop table permissions_ug_map;
+drop table general_permissions;
+drop table perm_change_state_rowids;
+
+create table general_permissions (
+	permission_id		integer not null primary key,
+	on_what_id		integer not null,
+	on_which_table		varchar(30) not null,
+        scope           	varchar(20),
+	user_id			references users,
+	group_id		references user_groups,
+	role			varchar(200),
+	permission_type		varchar(20) not null,
+	check ((scope = 'user' and user_id is not null
+                and group_id is null and role is null) or
+	       (scope = 'group_role' and user_id is null
+                and group_id is not null and role is not null) or
+	       (scope = 'group' and user_id is null
+                and group_id is not null and role is null) or
+	       (scope in ('registered_users', 'all_users')
+                and user_id is null
+                and group_id is null and role is null)),
+	unique (on_what_id, on_which_table,
+                scope, user_id, group_id, role, permission_type)
+);
+
+-- This trigger normalizes values in the on_which_table column to
+-- be all lowercase. This makes it easier to implement a case-
+-- insensitive API (since function-based indexes do not seem to
+-- work as advertised in Oracle 8.1.5). Just make sure to call
+-- LOWER whenever constructing a criterion involving
+-- on_which_table.
+--
+create or replace trigger gp_on_which_table_tr
+before insert or update on general_permissions
+for each row
+begin
+ :new.on_which_table := lower(:new.on_which_table);
+end gp_on_which_table_tr;
+/
+show errors
+
+-- This trigger normalizes values in the permission_type column to
+-- be all lowercase. This makes it easier to implement a case-
+-- insensitive API (since function-based indexes do not seem to
+-- work as advertised in Oracle 8.1.5). Just make sure to call
+-- LOWER whenever constructing a criterion involving
+-- permission_type.
+--
+create or replace trigger gp_permission_type_tr
+before insert or update on general_permissions
+for each row
+begin
+ :new.permission_type := lower(:new.permission_type);
+end gp_permission_type_tr;
+/
+show errors
+
+-- This view makes it simple to fetch a standard set of
+-- permission flags (true or false) for arbitrary rows
+-- in the database.
+--
+create or replace view general_permissions_grid
+as
+select
+ p.on_what_id, p.on_which_table,
+ p.scope, p.user_id, p.group_id, p.role,
+ decode(sum(decode(p.permission_type, 'read', 1, 0)), 0, 'f', 't')
+  as read_permission_p,
+ decode(sum(decode(p.permission_type, 'comment', 1, 0)), 0, 'f', 't')
+  as comment_permission_p,
+ decode(sum(decode(p.permission_type, 'write', 1, 0)), 0, 'f', 't')
+  as write_permission_p,
+ decode(sum(decode(p.permission_type, 'administer', 1, 0)), 0, 'f', 't')
+ as administer_permission_p
+from general_permissions p
+group by
+ p.on_what_id, p.on_which_table,
+ p.scope, p.user_id, p.group_id, p.role;
+
+create or replace package ad_general_permissions
+as
+ -- Returns 't' if the specified user has the specified permission on
+ -- the specified database row.
+ --
+ function user_has_row_permission_p (
+  v_user_id		general_permissions.user_id%TYPE,
+  v_permission_type	general_permissions.permission_type%TYPE,
+  v_on_what_id		general_permissions.on_what_id%TYPE,
+  v_on_which_table	general_permissions.on_which_table%TYPE
+ )
+ return char;
+
+ function grant_permission_to_user (
+  v_user_id		general_permissions.user_id%TYPE,
+  v_permission_type	general_permissions.permission_type%TYPE,
+  v_on_what_id		general_permissions.on_what_id%TYPE,
+  v_on_which_table	general_permissions.on_which_table%TYPE
+ )
+ return general_permissions.permission_id%TYPE;
+
+ function grant_permission_to_role (
+  v_group_id		general_permissions.group_id%TYPE,
+  v_role		general_permissions.role%TYPE,
+  v_permission_type	general_permissions.permission_type%TYPE,
+  v_on_what_id		general_permissions.on_what_id%TYPE,
+  v_on_which_table	general_permissions.on_which_table%TYPE
+ )
+ return general_permissions.permission_id%TYPE;
+
+ function grant_permission_to_group (
+  v_group_id		general_permissions.group_id%TYPE,
+  v_permission_type	general_permissions.permission_type%TYPE,
+  v_on_what_id		general_permissions.on_what_id%TYPE,
+  v_on_which_table	general_permissions.on_which_table%TYPE
+ )
+ return general_permissions.permission_id%TYPE;
+
+ function grant_permission_to_reg_users (
+  v_permission_type	general_permissions.permission_type%TYPE,
+  v_on_what_id		general_permissions.on_what_id%TYPE,
+  v_on_which_table	general_permissions.on_which_table%TYPE
+ )
+ return general_permissions.permission_id%TYPE;
+
+ function grant_permission_to_all_users (
+  v_permission_type	general_permissions.permission_type%TYPE,
+  v_on_what_id		general_permissions.on_what_id%TYPE,
+  v_on_which_table	general_permissions.on_which_table%TYPE
+ )
+ return general_permissions.permission_id%TYPE;
+
+ procedure revoke_permission (
+  v_permission_id	general_permissions.permission_id%TYPE
+ );
+
+ function user_permission_id (
+  v_user_id		general_permissions.user_id%TYPE,
+  v_permission_type	general_permissions.permission_type%TYPE,
+  v_on_what_id		general_permissions.on_what_id%TYPE,
+  v_on_which_table	general_permissions.on_which_table%TYPE
+ )
+ return general_permissions.permission_id%TYPE;
+
+ function group_role_permission_id (
+  v_group_id		general_permissions.group_id%TYPE,
+  v_role		general_permissions.role%TYPE,
+  v_permission_type	general_permissions.permission_type%TYPE,
+  v_on_what_id		general_permissions.on_what_id%TYPE,
+  v_on_which_table	general_permissions.on_which_table%TYPE
+ )
+ return general_permissions.permission_id%TYPE;
+
+ function group_permission_id (
+  v_group_id		general_permissions.group_id%TYPE,
+  v_permission_type	general_permissions.permission_type%TYPE,
+  v_on_what_id		general_permissions.on_what_id%TYPE,
+  v_on_which_table	general_permissions.on_which_table%TYPE
+ )
+ return general_permissions.permission_id%TYPE;
+
+ function reg_users_permission_id (
+  v_permission_type	general_permissions.permission_type%TYPE,
+  v_on_what_id		general_permissions.on_what_id%TYPE,
+  v_on_which_table	general_permissions.on_which_table%TYPE
+ )
+ return general_permissions.permission_id%TYPE;
+
+ function all_users_permission_id (
+  v_permission_type	general_permissions.permission_type%TYPE,
+  v_on_what_id		general_permissions.on_what_id%TYPE,
+  v_on_which_table	general_permissions.on_which_table%TYPE
+ )
+ return general_permissions.permission_id%TYPE;
+
+ procedure copy_permissions (
+  v_old_on_what_id	general_permissions.on_what_id%TYPE,
+  v_new_on_what_id	general_permissions.on_what_id%TYPE,
+  v_on_which_table	general_permissions.on_which_table%TYPE,
+  v_user_id1		general_permissions.user_id%TYPE,
+  v_user_id2		general_permissions.user_id%TYPE
+ );
+end ad_general_permissions;
+/
+show errors
+
+create or replace package body ad_general_permissions
+as
+ function user_has_row_permission_p (
+  v_user_id		general_permissions.user_id%TYPE,
+  v_permission_type	general_permissions.permission_type%TYPE,
+  v_on_what_id		general_permissions.on_what_id%TYPE,
+  v_on_which_table	general_permissions.on_which_table%TYPE
+ )
+ return char
+ is
+  user_has_row_permission_p char(1) := 'f';
+ begin
+
+  -- Return true if the user is a system administrator
+  -- or if the permission has been granted to at least one of:
+  --
+  -- * all users
+  -- * registered users if the user is logged in
+  -- * the user directly
+  -- * a role in a user group that the user plays
+  -- * an entire user group of which the user is a member
+  --
+  select ad_group_member_p(v_user_id, system_administrator_group_id)
+  into user_has_row_permission_p
+  from dual;
+
+  if user_has_row_permission_p = 'f' then
+   select decode(count(*), 0, 'f', 't')
+   into user_has_row_permission_p
+   from general_permissions gp
+   where gp.on_what_id = v_on_what_id
+   and gp.on_which_table = lower(v_on_which_table)
+   and gp.permission_type = lower(v_permission_type)
+   and ((gp.scope = 'all_users')
+        or (gp.scope = 'registered_users'
+            and v_user_id > 0)
+        or (gp.scope = 'group'
+            and exists (select 1
+                        from user_group_map ugm
+                        where ugm.user_id = v_user_id
+                        and ugm.group_id = gp.group_id))
+        or (gp.scope = 'group_role'
+            and exists (select 1
+                        from user_group_map ugm
+                        where ugm.user_id = v_user_id
+                        and ugm.group_id = gp.group_id
+                        and ugm.role = gp.role))
+        or (gp.scope = 'user'
+            and gp.user_id = v_user_id))
+   and rownum < 2;
+  end if;
+
+  return user_has_row_permission_p;
+ end user_has_row_permission_p;
+
+ function grant_permission_to_user (
+  v_user_id		general_permissions.user_id%TYPE,
+  v_permission_type	general_permissions.permission_type%TYPE,
+  v_on_what_id		general_permissions.on_what_id%TYPE,
+  v_on_which_table	general_permissions.on_which_table%TYPE
+ )
+ return general_permissions.permission_id%TYPE
+ is
+  v_permission_id	general_permissions.permission_id%TYPE;
+ begin
+  select gp_id_sequence.nextval into v_permission_id from dual;
+
+  insert into general_permissions
+   (permission_id, on_what_id, on_which_table,
+    scope, user_id, permission_type)
+  values
+   (v_permission_id, v_on_what_id, v_on_which_table,
+    'user', v_user_id, v_permission_type);
+
+  return v_permission_id;
+ end grant_permission_to_user;
+
+ function grant_permission_to_role (
+  v_group_id		general_permissions.group_id%TYPE,
+  v_role		general_permissions.role%TYPE,
+  v_permission_type	general_permissions.permission_type%TYPE,
+  v_on_what_id		general_permissions.on_what_id%TYPE,
+  v_on_which_table	general_permissions.on_which_table%TYPE
+ )
+ return general_permissions.permission_id%TYPE
+ is
+  v_permission_id	general_permissions.permission_id%TYPE;
+ begin
+  select gp_id_sequence.nextval into v_permission_id from dual;
+
+  insert into general_permissions
+   (permission_id, on_what_id, on_which_table,
+    scope, group_id, role, permission_type)
+  values
+   (v_permission_id, v_on_what_id, v_on_which_table,
+    'group_role', v_group_id, v_role, v_permission_type);
+
+  return v_permission_id;
+ end grant_permission_to_role;
+
+ function grant_permission_to_group (
+  v_group_id		general_permissions.group_id%TYPE,
+  v_permission_type	general_permissions.permission_type%TYPE,
+  v_on_what_id		general_permissions.on_what_id%TYPE,
+  v_on_which_table	general_permissions.on_which_table%TYPE
+ )
+ return general_permissions.permission_id%TYPE
+ is
+  v_permission_id	general_permissions.permission_id%TYPE;
+ begin
+  select gp_id_sequence.nextval into v_permission_id from dual;
+
+  insert into general_permissions
+   (permission_id, on_what_id, on_which_table,
+    scope, group_id, permission_type)
+  values
+   (v_permission_id, v_on_what_id, v_on_which_table,
+    'group', v_group_id, v_permission_type);
+
+  return v_permission_id;
+ end grant_permission_to_group;
+
+ function grant_permission_to_reg_users (
+  v_permission_type	general_permissions.permission_type%TYPE,
+  v_on_what_id		general_permissions.on_what_id%TYPE,
+  v_on_which_table	general_permissions.on_which_table%TYPE
+ )
+ return general_permissions.permission_id%TYPE
+ is
+  v_permission_id	general_permissions.permission_id%TYPE;
+ begin
+  select gp_id_sequence.nextval into v_permission_id from dual;
+
+  insert into general_permissions
+   (permission_id, on_what_id, on_which_table,
+    scope, permission_type)
+  values
+   (v_permission_id, v_on_what_id, v_on_which_table,
+    'registered_users', v_permission_type);
+
+  return v_permission_id;
+ end grant_permission_to_reg_users;
+
+ function grant_permission_to_all_users (
+  v_permission_type	general_permissions.permission_type%TYPE,
+  v_on_what_id		general_permissions.on_what_id%TYPE,
+  v_on_which_table	general_permissions.on_which_table%TYPE
+ )
+ return general_permissions.permission_id%TYPE
+ is
+  v_permission_id	general_permissions.permission_id%TYPE;
+ begin
+  select gp_id_sequence.nextval into v_permission_id from dual;
+
+  insert into general_permissions
+   (permission_id, on_what_id, on_which_table,
+    scope, permission_type)
+  values
+   (v_permission_id, v_on_what_id, v_on_which_table,
+    'all_users', v_permission_type);
+
+  return v_permission_id;
+ end grant_permission_to_all_users;
+
+ procedure revoke_permission (
+  v_permission_id	general_permissions.permission_id%TYPE
+ )
+ is
+ begin
+  delete from general_permissions
+  where permission_id = v_permission_id;
+ end revoke_permission;
+
+ function user_permission_id (
+  v_user_id		general_permissions.user_id%TYPE,
+  v_permission_type	general_permissions.permission_type%TYPE,
+  v_on_what_id		general_permissions.on_what_id%TYPE,
+  v_on_which_table	general_permissions.on_which_table%TYPE
+ )
+ return general_permissions.permission_id%TYPE
+ is
+  v_permission_id	general_permissions.permission_id%TYPE;
+ begin
+  select permission_id
+  into v_permission_id
+  from general_permissions
+  where on_what_id = v_on_what_id
+  and on_which_table = lower(v_on_which_table)
+  and scope = 'user'
+  and user_id = v_user_id
+  and permission_type = lower(v_permission_type);
+
+  return v_permission_id;
+
+ exception when no_data_found then
+  return 0;
+ end user_permission_id;
+
+ function group_role_permission_id (
+  v_group_id		general_permissions.group_id%TYPE,
+  v_role		general_permissions.role%TYPE,
+  v_permission_type	general_permissions.permission_type%TYPE,
+  v_on_what_id		general_permissions.on_what_id%TYPE,
+  v_on_which_table	general_permissions.on_which_table%TYPE
+ )
+ return general_permissions.permission_id%TYPE
+ is
+  v_permission_id	general_permissions.permission_id%TYPE;
+ begin
+  select permission_id
+  into v_permission_id
+  from general_permissions
+  where on_what_id = v_on_what_id
+  and on_which_table = lower(v_on_which_table)
+  and scope = 'group_role'
+  and group_id = v_group_id
+  and role = v_role
+  and permission_type = lower(v_permission_type);
+
+  return v_permission_id;
+
+ exception when no_data_found then
+  return 0;
+ end group_role_permission_id;
+
+ function group_permission_id (
+  v_group_id		general_permissions.group_id%TYPE,
+  v_permission_type	general_permissions.permission_type%TYPE,
+  v_on_what_id		general_permissions.on_what_id%TYPE,
+  v_on_which_table	general_permissions.on_which_table%TYPE
+ )
+ return general_permissions.permission_id%TYPE
+ is
+  v_permission_id	general_permissions.permission_id%TYPE;
+ begin
+  select permission_id
+  into v_permission_id
+  from general_permissions
+  where on_what_id = v_on_what_id
+  and on_which_table = lower(v_on_which_table)
+  and scope = 'group'
+  and group_id = v_group_id
+  and permission_type = lower(v_permission_type);
+
+  return v_permission_id;
+
+ exception when no_data_found then
+  return 0;
+ end group_permission_id;
+
+ function reg_users_permission_id (
+  v_permission_type	general_permissions.permission_type%TYPE,
+  v_on_what_id		general_permissions.on_what_id%TYPE,
+  v_on_which_table	general_permissions.on_which_table%TYPE
+ )
+ return general_permissions.permission_id%TYPE
+ is
+  v_permission_id	general_permissions.permission_id%TYPE;
+ begin
+  select permission_id
+  into v_permission_id
+  from general_permissions
+  where on_what_id = v_on_what_id
+  and on_which_table = lower(v_on_which_table)
+  and scope = 'registered_users'
+  and permission_type = lower(v_permission_type);
+
+  return v_permission_id;
+
+ exception when no_data_found then
+  return 0;
+ end reg_users_permission_id;
+
+ function all_users_permission_id (
+  v_permission_type	general_permissions.permission_type%TYPE,
+  v_on_what_id		general_permissions.on_what_id%TYPE,
+  v_on_which_table	general_permissions.on_which_table%TYPE
+ )
+ return general_permissions.permission_id%TYPE
+ is
+  v_permission_id	general_permissions.permission_id%TYPE;
+ begin
+  select permission_id
+  into v_permission_id
+  from general_permissions
+  where on_what_id = v_on_what_id
+  and on_which_table = lower(v_on_which_table)
+  and scope = 'all_users'
+  and permission_type = lower(v_permission_type);
+
+  return v_permission_id;
+
+ exception when no_data_found then
+  return 0;
+ end all_users_permission_id;
+
+
+ procedure copy_permissions (
+  v_old_on_what_id	general_permissions.on_what_id%TYPE,
+  v_new_on_what_id	general_permissions.on_what_id%TYPE,
+  v_on_which_table	general_permissions.on_which_table%TYPE,
+  v_user_id1		general_permissions.user_id%TYPE,
+  v_user_id2		general_permissions.user_id%TYPE
+ )
+ is
+ begin
+  insert into general_permissions
+    (permission_id, on_what_id, on_which_table, scope, user_id, 
+     group_id, role, permission_type)
+  select gp_id_sequence.nextval, v_new_on_what_id, lower(v_on_which_table),
+    scope, user_id, group_id, role, permission_type
+  from general_permissions
+  where on_what_id = v_old_on_what_id and 
+    on_which_table = lower(v_on_which_table) and
+    (user_id is null or not user_id in (v_user_id1, v_user_id2));
+ end copy_permissions;
+end ad_general_permissions;
+/
+show errors
+
+insert into general_permissions
+select * from general_permissions_temp;
+
+drop table general_permissions_temp;
+
+-- END GENERAL-PERMISSIONS --
+
+
+-- BEGIN BBOARD --
+
+alter table bboard_topics add group_id integer references user_groups;
+
+-- END BBOARD --
+
+
+-- BEGIN ECOMMERCE (EVEANDER 3/4/00) --
+
+alter table ec_products add (
+	color_list		varchar(4000),
+	size_list		varchar(4000),
+	style_list		varchar(4000)
+);
+
+alter table ec_items add (
+	color_choice	varchar(4000),
+	size_choice	varchar(4000),
+	style_choice	varchar(4000)
+);
+
+alter table ec_creditcards modify (
+	billing_zip_code  varchar(80)
+);
+
+-- END ECOMMERCE CHANGES --
+
+
+-- BEGIN SPAM --
+
+alter table spam_history add (
+	begin_send_time		date,
+	finish_send_time	date
+);
+
+
+alter table daily_spam_files add (
+	period	varchar(64) default 'daily'
+		check (period in ('daily','weekly', 'monthly', 'yearly'))
+);
+
+
+-- function to guess an email type, using the default_email_types patterns table
+CREATE OR REPLACE FUNCTION guess_user_email_type (v_email varchar)
+RETURN varchar
+IS
+cursor mail_cursor is select * from default_email_types;
+BEGIN
+  FOR mail_val IN mail_cursor LOOP
+    IF upper(v_email) LIKE upper(mail_val.pattern)  THEN
+	    RETURN mail_val.mail_type;
+    END IF;
+  END LOOP;
+-- default 
+  RETURN 'text/html';
+END guess_user_email_type;
+/
+show errors
+
+
+create sequence bulkmail_id_sequence start with 1;
+
+create table bulkmail_instances (
+	bulkmail_id	integer primary key,
+	description	varchar(400),
+	creation_date	date not null,
+	creation_user	references users(user_id),
+	end_date	date,
+	n_sent		integer
+);
+
+create table bulkmail_log (
+	bulkmail_id	references bulkmail_instances,
+	user_id		references users,
+	sent_date	date not null
+);
+
+create table bulkmail_bounces (
+	bulkmail_id	references bulkmail_instances,
+	user_id		references users,
+	creation_date	date default sysdate,
+	active_p	char(1) default 't' check(active_p in ('t', 'f'))
+);	
+	
+create index bulkmail_user_bounce_idx on bulkmail_bounces(user_id, active_p);
+
+-- END SPAM --
+
+
+-- BEGIN TICKET --
+
+alter table ticket_domains add (message_template varchar(4000));
+
+-- END TICKET --
+
+
+-- BEGIN NEWS --
+
+create sequence newsgroup_id_sequence start with 4;
+
+create table newsgroups (
+	newsgroup_id	integer primary key,
+        -- if scope=all_users, this is the news for all newsgroups
+        -- is scope=registered_users, this is the news for all registered users
+	-- if scope=public, this is the news for the main newsgroup
+	-- if scope=group, this is news associated with a group
+        scope           varchar(20) not null,
+	group_id	references user_groups,
+	check ((scope='group' and group_id is not null) or
+	(scope='public') or
+	(scope='all_users') or
+	(scope='registered_users'))
+);
+
+create sequence news_item_id_sequence start with 100000;
+
+create table news_items (
+	news_item_id		integer primary key,
+	newsgroup_id		references newsgroups not null,
+	title			varchar(200) not null,
+	body			clob not null,
+	-- is the body in HTML or plain text (the default)
+	html_p			char(1) default 'f' check(html_p in ('t','f')),
+	approval_state		varchar(15) default 'unexamined' check(approval_state in ('unexamined','approved', 'disapproved')),
+	approval_date		date,
+	approval_user		references users(user_id),
+	approval_ip_address	varchar(50),
+	release_date		date not null,
+	expiration_date		date not null,
+	creation_date		date not null,
+	creation_user		not null references users(user_id),
+	creation_ip_address	varchar(50) not null
+);
+
+create index newsgroup_group_idx on newsgroups ( group_id );
+create index news_items_idx on news_items ( newsgroup_id );
+
+-- Create the default newsgroups
+
+insert into newsgroups (newsgroup_id, scope) values (1, 'registered_users');
+insert into newsgroups (newsgroup_id, scope) values (2, 'all_users');
+insert into newsgroups (newsgroup_id, scope) values (3, 'public');
+
+-- Create permissions for default newsgroups
+
+-- Migration sql commands
+insert into newsgroups
+ (newsgroup_id, scope, group_id)
+select newsgroup_id_sequence.nextval, 'group', g.group_id
+from (select distinct(group_id) from news where group_id is not null) g;
+
+-- Insert group news items
+insert into news_items (news_item_id, newsgroup_id, title, body, html_p, 
+ approval_state, release_date, expiration_date, 
+ creation_date, creation_user, creation_ip_address) 
+select news_id, ng.newsgroup_id, title, body, html_p, 
+ decode(approved_p, 't', 'approved', 'f', 'disapproved', 'unexamined'), 
+ release_date, expiration_date, 
+ creation_date, creation_user, creation_ip_address 
+from news, newsgroups ng 
+where news.group_id = ng.group_id
+and news.scope = 'group';
+
+-- Insert public rows
+insert into news_items (news_item_id, newsgroup_id, title, body, html_p, 
+ approval_state, release_date, expiration_date, 
+ creation_date, creation_user, creation_ip_address) 
+select news_id, 3, title, body, html_p, 
+ decode(approved_p, 't', 'approved', 'f', 'disapproved', 'unexamined'), 
+ release_date, expiration_date, 
+ creation_date, creation_user, creation_ip_address 
+from news
+where scope = 'public';
+
+drop index news_idx;
+drop index news_group_idx;
+drop table news;
+drop sequence news_id_sequence;
+
+-- migrate the on_which_table, on_what_column in general_comments
+update general_comments
+set on_which_table = 'news_items'
+where on_which_table = 'news';
+
+-- END NEWS --
+
+
+-- BEGIN CONTEST --
+
+-- don't complain about constraints until we're done
+
+set constraints all deferred;
+
+-- add domain_id sequence
+
+create sequence contest_domain_id_sequence;
+
+-- add the domain_id column to contest domains and extra columns
+
+alter table contest_domains add (domain_id integer);
+alter table contest_extra_columns add (domain_id integer);
+
+-- populate it
+
+declare
+    cursor contest_cursor is
+      select domain from contest_domains;
+
+    new_domain_id integer;
+    domain_name contest_domains.domain%TYPE;
+begin
+
+    open contest_cursor;
+
+    loop
+        fetch contest_cursor into domain_name;
+        exit when contest_cursor%notfound;
+
+        select contest_domain_id_sequence.nextval 
+        into new_domain_id
+        from dual;
+
+        update contest_domains set domain_id = new_domain_id 
+        where domain = domain_name;
+
+        update contest_extra_columns set domain_id = new_domain_id
+        where domain = domain_name;
+
+    end loop;
+
+    close contest_cursor;
+
+end;
+/
+show errors;
+
+
+-- turn off primary keyness of domain in contest_domains
+-- and turn on primary keyness of domain_id in contest_domains
+
+alter table contest_domains drop primary key cascade;
+alter table contest_domains add (primary key(domain_id));
+
+
+-- turn on uniqueness of domain in contest_domains
+-- (this also creates an index, which helps when dealing with
+-- backwards-compatibility when pages use old domain key URLs
+
+alter table contest_domains add (unique(domain));
+
+
+-- set up the references relation from contest_extra_columns
+
+alter table contest_extra_columns
+add constraint contest_xcol_fk foreign key (domain_id) references contest_domains;
+
+
+-- nuke the domain column from contest_extra_columns
+
+alter table contest_extra_columns drop column domain;
+
+
+-- add not-nullness to domain_id columns
+
+alter table contest_domains modify (domain_id not null);
+alter table contest_extra_columns modify (domain_id not null);
+
+-- and the trick, she is done
+
+set constraints all immediate;
+
+-- END CONTEST  --
+
+
+-- BEGIN CLASSIFIEDS --
+
+-- The big picture:  add new integer primary keys for tables
+-- that don't have them.  The ad_domains table has a
+-- varchar primary key, so we need to change all the locations
+-- that refer to ad_domains.domain to refer to ad_domains.domain_id.
+-- This involves adding a new foreign key column to several tables,
+-- populating the values, and changing the foregin key constraints
+-- to refer to the new column.
+  
+-- drop primary key constraint and all referential
+-- integrity constraints that refer to 'domain'
+-- from other tables.  We will recreate these constraints
+-- one by one on the other tables as we add new domain_id
+-- foreign keys to them.
+alter table ad_domains drop primary key cascade;
+
+-- but 'domain' continues to be restricted to unique values
+alter table ad_domains add (unique(domain));
+
+-- add new 'domain_id' column, which will be the primary key;
+-- don't give it a primary key constraint yet, because it has
+-- no values.
+alter table ad_domains add (
+         domain_id               integer
+);
+
+-- add sequence to generate domain_id values
+create sequence ad_domain_id_seq start with 1;
+
+-- populate new domain_id columns
+update ad_domains set domain_id = ad_domain_id_seq.nextval;
+
+commit;
+
+-- now add primary key constraint, since the column has values
+alter table ad_domains add (primary key(domain_id));
+
+-- add new integer primary key and foreign key for domain_id
+-- (no need to drop primary key constraint since there wasn't one)
+alter table ad_integrity_checks  add (
+        integrity_check_id integer,
+        domain_id integer
+);
+
+create sequence ad_integrity_check_id_seq start with 1;
+
+-- populate new primary key column
+update ad_integrity_checks set integrity_check_id = ad_integrity_check_id_seq.nextval;
+
+-- and populate foreign key column
+update ad_integrity_checks
+set domain_id = (select domain_id
+                 from ad_domains
+                 where ad_domains.domain = ad_integrity_checks.domain);
+
+commit;
+
+-- add primary key and foreign key constraints
+alter table ad_integrity_checks add (primary key(integrity_check_id));
+
+alter table ad_integrity_checks add (foreign key(domain_id) references ad_domains(domain_id));
+
+-- add new integer primary key and foreign key for domain_id
+-- (no need to drop primary key constraint since there wasn't one)
+alter table ad_categories add (
+         category_id             integer,
+         domain_id integer
+);
+create sequence ad_category_id_seq start with 1;
+
+-- populate new primary key and foreign key columns
+update ad_categories set category_id = ad_category_id_seq.nextval;
+update ad_categories
+set domain_id = (select domain_id
+                 from ad_domains
+                 where ad_domains.domain = ad_categories.domain);
+commit;
+
+-- add primary key and foreign key constraints for new columns
+alter table ad_categories add (primary key(category_id));
+alter table ad_categories add (foreign key(domain_id) references ad_domains(domain_id));
+
+-- old ad_categories_unique index referred to 'domain' column;
+-- recreate index with new domain_id column
+drop index ad_categories_unique;
+create unique index ad_categories_unique on ad_categories ( domain_id, primary_category );
+
+-- add new domain_id foreign key to replace 'domain'
+alter table classified_ads add (
+        domain_id integer
+);
+-- populate foreign key
+update classified_ads
+set domain_id = (select domain_id
+                 from ad_domains
+                 where ad_domains.domain = classified_ads.domain);
+commit;
+
+-- add referential integrity constraint for new foreign key
+alter table classified_ads add (foreign key(domain_id) references ad_domains(domain_id));
+-- and allow old 'domain' column to be null
+-- (since we can't just drop the column)
+alter table classified_ads modify (domain null);
+
+-- add new domain_id foreign key to replace 'domain'
+alter table classified_ads_audit add (
+        domain_id integer
+);
+
+-- populate new column for old rows
+update classified_ads_audit
+set domain_id = (select domain_id
+                 from ad_domains
+                 where ad_domains.domain = classified_ads_audit.domain);
+commit;
+
+-- replace this view to change 'domain' column to 'domain_id'
+create or replace view classified_context_view as
+  select ca.classified_ad_id, ca.domain_id, ca.one_line, ca.expires, ca.one_line || ' ' || ca.full_ad || ' ' || u.email || ' ' || 
+u.first_names || ' ' || u.last_name || ' ' || ca.manufacturer || ' ' || ca.model || ' '  as indexed_stuff
+from classified_ads ca, users u
+where ca.user_id = u.user_id;
+
+-- add new domain_id foreign key to replace 'domain'
+alter table classified_auction_bids add (
+        bid_id                  integer
+);
+create sequence classified_auction_bid_id_seq start with 1;
+
+-- populate new bid_id column for old rows
+update classified_auction_bids set bid_id = classified_auction_bid_id_seq.nextval;
+commit;
+-- and add primary key constraint
+alter table classified_auction_bids add (primary key(bid_id));
+
+-- add new domain_id foreign key to replace 'domain'
+alter table classified_alerts_last_updates add (
+        update_id       integer
+);
+
+create sequence classified_alerts_l_u_id_seq start with 1;
+
+-- populate new primary key column for old rows
+update classified_alerts_last_updates set update_id = classified_alerts_l_u_id_seq.nextval;
+commit;
+-- and add primary key constraint
+alter table classified_alerts_last_updates add (primary key(update_id));
+
+-- add new integer primary key and foreign key columns
+alter table classified_email_alerts add (
+        alert_id        integer,
+        domain_id       integer
+);
+create sequence classified_email_alert_id_seq start with 1;
+
+-- populate primary key and foreign key columns for old rows
+update classified_email_alerts set alert_id = classified_email_alert_id_seq.nextval;
+update classified_email_alerts set domain_id = (select domain_id from ad_domains where ad_domains.domain = classified_email_alerts.domain);
+commit;
+
+-- add in primary key and foreign key constraints
+alter table classified_email_alerts add (primary key(alert_id));
+alter table classified_email_alerts add (foreign key(domain_id) references ad_domains(domain_id));
+alter table classified_email_alerts modify (domain null);
+
+-- END CLASSIFIEDS UPGRADE ----------------------------------------
+
+-- BEGIN CALENDAR --
+
+-- add extra user_id column to calendar_categories
+alter table calendar_categories add(user_id references users);
+alter table calendar_categories drop constraint calendar_category_scope_check;
+alter table calendar_categories add constraint
+calendar_category_scope_check check ((scope='group' and group_id is not
+null) or (scope='user' and user_id is not null) or (scope='public'));
+alter table calendar_categories drop constraint calendar_category_unique_check;
+alter table calendar_categories add constraint
+calendar_category_unique_check unique(scope, category, group_id, user_id);
+
+-- END CALENDAR UPGRADE -------------------------------------------
+
+
+------------------------------------------------------------
+-- SURVEY MODULE is all new
+------------------------------------------------------------
+
+@survey-simple
+
+
+------------------------------------------------------------
+-- PULL-DOWN MENUS are all new
+------------------------------------------------------------
+
+@pull-down-menus
+@pull-down-menu-data
+
+
+-----------------------------------------------------------
+-- Education module is  all new 
+-----------------------------------------------------------
+
+
+insert into portal_tables (table_id, table_name, adp, admin_url, creation_user, modified_date) 
+values 
+(portal_table_id_sequence.nextval, 'Stock Quotes', '<% set html [DisplayStockQuotes $db]%>
+<%=$html%>', '', 1, sysdate);
+
+insert into portal_tables (table_id, table_name, adp, admin_url,
+creation_user, modified_date) 
+values 
+(portal_table_id_sequence.nextval,'Current Weather', '<% set html [DisplayWeather $db]%>
+<%=$html%>
+', '', 1, sysdate);
+
+insert into portal_tables (table_id, table_name, adp,
+admin_url,creation_user, modified_date) 
+values 
+(portal_table_id_sequence.nextval,'Classes', '<% set html [GetClassHomepages $db]%>
+<%=$html%>
+', '', 1, sysdate);
+
+insert into portal_tables (table_id, table_name, adp,
+admin_url,creation_user, modified_date) 
+values 
+(portal_table_id_sequence.nextval,'Announcements', '<% set html [GetNewsItems $db]%>
+<%=$html%>', '', 1, sysdate);
+
+insert into portal_tables (table_id, table_name, adp,
+admin_url,creation_user, modified_date) 
+values 
+(portal_table_id_sequence.nextval,'Calendar', '<% set html [edu_calendar_for_portal $db]%>
+<%= $html%>', '', 1, sysdate);
+
+@education
+
+-------------------------------------------------------------
+-- Table metadata needed for general permissions
+-------------------------------------------------------------
+
+@table-metadata
Index: web/openacs/www/doc/sql/upgrade-openacs-3.2.2-3.2.4.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/upgrade-openacs-3.2.2-3.2.4.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/upgrade-openacs-3.2.2-3.2.4.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,217 @@
+
+-- upgrade an installation from 3.2.2 to 3.2.4
+-- Ben Adida (ben@mit.edu)
+--
+
+-- You should make sure you have PL/TCL enabled
+-- before you run this SQL script. If you enable OpenACS Search
+-- in your parameter file, you will then be able to do full-text search
+-- in the bboards
+
+-- \i rank-for-search.sql
+
+--
+-- bboard.sql
+--
+
+drop function bboard_contains (varchar, varchar, varchar, varchar, varchar);
+create function bboard_contains (varchar, varchar, varchar, varchar, varchar)
+returns integer as '
+declare
+  email alias for $1;
+  user_name alias for $2;
+  one_line alias for $3;
+  message alias for $4;
+  space_sep_list_untrimmed alias for $5;
+  space_sep_list        varchar(32000);
+  upper_indexed_stuff   varchar(32000);
+  -- if you call this var START you get hosed royally
+  first_space           integer;
+  score                 integer;
+BEGIN 
+  space_sep_list := upper(ltrim(rtrim(space_sep_list_untrimmed)));
+  upper_indexed_stuff := upper(email || user_name || one_line || substr(message,30000));
+  score := 0;
+  IF space_sep_list is null or upper_indexed_stuff is null THEN
+    RETURN score;  
+  END IF;
+  LOOP
+   first_space := position(space_sep_list in '' '');
+   IF first_space = 0 THEN
+     -- one token or maybe end of list
+     IF position(upper_indexed_stuff in space_sep_list) <> 0 THEN
+        RETURN score+10;
+     END IF;
+     RETURN score;
+   ELSE
+   -- first_space <> 0
+     IF position(upper_indexed_stuff in substr(space_sep_list,1,first_space-1)) <> 0 THEN
+        score := score + 10;
+     END IF;
+   END IF;
+    space_sep_list := substr(space_sep_list,first_space+1);
+  END LOOP;  
+END;
+' language 'plpgsql';
+
+-- Part of a series of security fixes
+-- (BMA, spec'ed by aD)
+create function bboard_user_can_view_topic_p (integer,integer)	
+returns char AS '
+DECLARE
+	v_user_id alias for $1;
+	v_topic_id alias for $2;
+	v_read_access varchar(16);	     
+	v_group_id    integer;
+	v_count       integer;
+BEGIN
+	select read_access, group_id into v_read_access, v_group_id
+	from bboard_topics
+	where topic_id = v_topic_id;
+
+	IF v_read_access = ''any'' or v_read_access = ''public'' THEN
+	RETURN ''t'';
+	END IF;
+
+	select count(*) into v_count
+	from user_group_map
+	where user_id = v_user_id
+	and group_id = v_group_id;      
+
+	IF v_count > 0 THEN
+	RETURN ''t'';
+	END IF;
+
+	RETURN ''f'';
+END;
+' language 'plpgsql';
+
+
+--
+-- New-ticket
+--
+
+-- The custom fields table
+alter table ticket_projects_fields add view_in_list char(1) check (view_in_list in ('t','f'));
+alter table ticket_projects_fields add field_vals varchar(4000);
+
+-- a unique index 
+create unique index ticket_project_field_name_indx on ticket_projects_fields(project_id, field_name);
+
+-- a proc to pull out a custom field
+-- for custom field fetching
+create function ticket_fetch_custom_field (integer, integer, varchar)
+returns char
+as '
+DECLARE
+	v_msg_id alias for $1;
+	v_project_id alias for $2;
+	v_field alias for $3;
+	v_field_id integer;
+BEGIN
+	select field_id into v_field_id from ticket_projects_fields where project_id= v_project_id and field_name= v_field;
+
+	if v_field_id is null then return null; end if;
+
+	return field_val from ticket_projects_field_vals where field_id = v_field_id and project_id=v_project_id and issue_id= v_msg_id;
+END;
+' language 'plpgsql';
+
+
+-- who can close an issue
+create function ticket_user_can_close_issue_p(integer, integer)
+returns char as '
+DECLARE
+	v_user_id alias for $1;
+	v_msg_id alias for $2;
+	msg_closeable record;
+BEGIN
+	if ad_admin_group_member_p(''bits'','''', v_user_id) = ''t''
+	then return ''t'';
+	end if;
+
+	select into msg_closeable
+               count(ti.msg_id) as chk,
+               max(ti.project_id) as pid 
+          from ticket_issues ti
+         where ti.user_id = v_user_id 
+           and ti.msg_id  = v_msg_id
+           and 0 < (select count(*) 
+                      from user_group_map 
+                     where user_id= v_user_id 
+                       and (role=''internal'' or role=''administrator'') 
+                       and group_id = (select tm.team_id 
+                                from ticket_project_teams tm
+                               where parent_project_p(tm.project_id,ti.project_id)=''t''));
+
+	IF msg_closeable.chk > 0
+	THEN return(''t'');
+	ELSE return(''f'');
+	END IF;
+END;
+' language 'plpgsql';	
+
+
+--
+-- Postgres.sql
+-- 
+
+-- Mimic Oracle's user_tab_columns table (thanks Ken Mayer!)
+
+CREATE VIEW user_tab_columns AS
+SELECT upper(c.relname) AS table_name, 
+       upper(a.attname) AS column_name,
+       CASE WHEN (t.typprtlen > 0)
+       THEN t.typprtlen
+       ELSE (a.atttypmod - 4)
+       END AS data_length
+FROM pg_class c, pg_attribute a, pg_type t
+WHERE (a.attrelid = c.oid) AND (a.atttypid = t.oid) AND (a.attnum > 0);
+
+
+--
+-- Pull Down Menus
+--
+
+create function pdm_count_items_like(char)
+returns integer
+as '
+DECLARE
+	v_sortkey alias for $1;
+BEGIN
+	return count(*) from pdm_menu_items where sort_key like v_sortkey||''__'';
+END;
+' language 'plpgsql';
+
+create function pdm_parent_label(integer, char)
+returns char
+as '
+DECLARE
+	v_menu_id alias for $1;
+	v_sortkey alias for $2;
+BEGIN
+	return label from pdm_menu_items where menu_id= v_menu_id and sort_key= substr(v_sortkey,1, length(v_sortkey)-2);
+END;
+' language 'plpgsql';
+
+
+--
+-- file storage
+--
+
+-- This function now returns text instead of varchar.
+drop function fs_connect_by(integer);
+create function fs_connect_by(integer) returns text as '
+declare
+	id              alias for $1;
+        pid             integer;
+BEGIN
+        select into pid parent_id from fs_files where id = file_id;
+	IF pid is null
+	THEN 
+		return fs_gen_key(id);
+	ELSE
+		return fs_connect_by(pid) || ''/'' || fs_gen_key(id);
+	END IF;	
+END;
+' language 'plpgsql';
Index: web/openacs/www/doc/sql/upgrade-openacs-3.2.4-3.2.5.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/upgrade-openacs-3.2.4-3.2.5.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/upgrade-openacs-3.2.4-3.2.5.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,53 @@
+
+-- upgrade an installation from 3.2.4 to 3.2.5
+-- Krzysztof Kowalczyk (krzysztofk@pobox.com)
+--
+
+-- 
+-- sdm.sql
+--
+
+drop function trig_baf_audit();
+
+create function trig_baf_audit() returns opaque
+as '
+DECLARE
+	the_name	varchar(200);
+BEGIN
+	select first_names || '' '' || last_name into the_name
+	from users where user_id= NEW.last_updated_by;
+
+	IF OLD.baf_type != NEW.baf_type
+	THEN 
+	insert into baf_audit (baf_id, who, what, old_value, new_value, audit_date)
+	values (NEW.baf_id, the_name, ''baf_type'', OLD.baf_type, NEW.baf_type, sysdate());
+	END IF;
+
+	IF OLD.baf_status != NEW.baf_status
+	THEN 
+	insert into baf_audit (baf_id, who, what, old_value, new_value, audit_date)
+	values (NEW.baf_id, the_name, ''baf_status'', sdm_get_baf_status(OLD.baf_status), sdm_get_baf_status(NEW.baf_status), sysdate());
+	END IF;
+
+	IF OLD.severity != NEW.severity
+	THEN 
+	insert into baf_audit (baf_id, who, what, old_value, new_value, audit_date)
+	values (NEW.baf_id, the_name, ''severity'', OLD.severity, NEW.severity, sysdate());
+	END IF;
+
+	IF OLD.expected_completion != NEW.expected_completion
+	THEN 
+	insert into baf_audit (baf_id, who, what, old_value, new_value, audit_date)
+	values (NEW.baf_id, the_name, ''expected_completion'', fetch_release_name(OLD.expected_completion), fetch_release_name(NEW.expected_completion), sysdate());
+	END IF;
+
+	return NEW;
+END;
+' language 'plpgsql';
+
+drop trigger baf_audit on bugs_and_features;
+
+create trigger baf_audit
+after update on bugs_and_features
+for each row
+execute procedure trig_baf_audit();
Index: web/openacs/www/doc/sql/upgrade-ticket-1.3-2.1.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/upgrade-ticket-1.3-2.1.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/upgrade-ticket-1.3-2.1.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,223 @@
+-- upgrades an ACS (v1.3) ticket tracker to the version in 
+-- ACS 2.1
+
+alter table ticket_issue_responses add (
+	public_p		char(1) default('t') check(public_p in ('t','f'))
+);
+
+
+alter table ticket_issues add (
+	group_id		references user_groups,
+        modification_time       date,
+	ticket_type		varchar(100),
+	severity		varchar(100),
+        source                  varchar(100), 
+        last_modified_by        varchar(200), 
+	last_notification	date,
+	contact_name		varchar(200),
+	contact_email		varchar(200),
+	contact_info1		varchar(700),
+	contact_info2		varchar(700),
+	-- product-specific fields
+	data1			varchar(700),
+	data2			varchar(700),
+	data3			varchar(700),
+	data4			varchar(700),
+	data5			varchar(700),
+	public_p		char(1) default('t') check(public_p in ('t','f'))
+);
+
+
+alter table ticket_projects add (
+	default_assignee integer references users
+);
+
+insert into ticket_projects 
+(project_id, customer_id, title, start_date)
+values
+(0, system_user_id, 'Incoming', sysdate);
+
+-- end of alter table commands
+
+
+
+begin
+   administration_group_add ('Ticket Admin Staff', 'ticket', NULL, 'f', '/ticket/admin/');
+end;
+/
+
+
+
+create or replace trigger ticket_modification_time
+before insert or update on ticket_issues
+for each row
+when (new.modification_time is null)
+begin
+ :new.modification_time :=SYSDATE;
+end;
+/
+show errors
+
+--- keep track of changes to a ticket
+create table ticket_changes (
+  msg_id    integer not null, -- references ticket_issues
+  who 	    varchar(256),
+  what      varchar(256),
+  old_value varchar(256),
+  new_value varchar(256),
+  modification_date  date
+);
+
+create index ticket_changes_by_msg_id on ticket_changes(msg_id);
+
+-- track changes to tickets
+create or replace trigger ticket_activity_logger
+after update on ticket_issues
+for each row
+begin
+  if (:old.project_id <> :new.project_id) then
+   insert into ticket_changes (msg_id, who, what, old_value, new_value, modification_date)
+   values
+   (:new.msg_id, :new.last_modified_by, 'Project ID', :old.project_id, :new.project_id, sysdate);
+  end if;
+
+  if (:old.ticket_type <> :new.ticket_type) then
+   insert into ticket_changes (msg_id, who, what, old_value, new_value, modification_date)
+   values
+   (:new.msg_id, :new.last_modified_by, 'Ticket Type', :old.ticket_type, :new.ticket_type, sysdate);
+  end if;
+
+  if (:old.one_line <> :new.one_line) then
+   insert into ticket_changes (msg_id, who,what, old_value, new_value, modification_date) 
+   values
+   (:new.msg_id, :new.last_modified_by, 'Synopsis', :old.one_line, :new.one_line, sysdate);
+  end if;
+
+  if (:old.deadline <> :new.deadline) then
+   insert into ticket_changes (msg_id, who,what, old_value, new_value, modification_date) 
+   values
+   (:new.msg_id, :new.last_modified_by, 'Deadline', :old.deadline, :new.deadline, sysdate);
+  end if;
+
+  if (:old.status <> :new.status) then
+   insert into ticket_changes (msg_id, who,what, old_value, new_value, modification_date) 
+   values
+   (:new.msg_id, :new.last_modified_by, 'Status', :old.status, :new.status, sysdate);
+  end if;
+
+  if (:old.priority <> :new.priority) then
+   insert into ticket_changes (msg_id, who,what, old_value, new_value, modification_date) 
+   values
+   (:new.msg_id, :new.last_modified_by, 'Priority', :old.priority, :new.priority, sysdate);
+  end if;
+
+  if (:old.severity <> :new.severity) then
+   insert into ticket_changes (msg_id, who,what, old_value, new_value, modification_date) 
+   values
+   (:new.msg_id, :new.last_modified_by, 'Severity', :old.severity, :new.severity, sysdate);
+  end if;
+
+-- These are custom fields -- the column title will need  to
+--  be kept up to date 
+-- manually 
+
+
+  if (:old.data1 <> :new.data1) then
+   insert into ticket_changes (msg_id, who,what, old_value, new_value, modification_date) 
+   values
+   (:new.msg_id, :new.last_modified_by, 'Hardware_model', :old.data1, :new.data1, sysdate);
+  end if;
+
+  if (:old.data2 <> :new.data2) then
+   insert into ticket_changes (msg_id, who,what, old_value, new_value, modification_date) 
+   values
+   (:new.msg_id, :new.last_modified_by, 'Software_version', :old.data2, :new.data2, sysdate);
+  end if;
+
+  if (:old.data3 <> :new.data3) then
+   insert into ticket_changes (msg_id, who,what, old_value, new_value, modification_date) 
+   values
+   (:new.msg_id, :new.last_modified_by, 'Software_version', :old.data2, :new.data2, sysdate);
+  end if;
+
+  if (:old.data4 <> :new.data4) then
+   insert into ticket_changes (msg_id, who,what, old_value, new_value, modification_date) 
+   values
+   (:new.msg_id, :new.last_modified_by, 'Build', :old.data4, :new.data4, sysdate);
+  end if;
+end;
+/
+show errors
+
+
+
+
+-- cross reference table mapping issues to other issues
+create table ticket_xrefs (
+       from_ticket references ticket_issues(msg_id),
+       to_ticket references ticket_issues(msg_id)
+);
+
+
+
+-- update the ticket's modification timestamp
+create or replace trigger response_modification_time
+before insert or update on ticket_issue_responses
+for each row
+begin
+  update ticket_issues set modification_time = SYSDATE 
+  where msg_id = :new.response_to;
+end;
+/
+show errors
+
+
+-- called by /tcl/email-queue.tcl 
+-- and /ticket/issue-response-2.tcl 
+create or replace procedure ticket_update_for_response(v_response_id IN integer)
+AS
+ v_response_row ticket_issue_responses%ROWTYPE;
+ v_indexed_stuff clob;
+BEGIN
+ select ticket_issue_responses.* into v_response_row
+   from ticket_issue_responses
+   where response_id = v_response_id;
+
+ if v_response_row.message is not null then 
+   select indexed_stuff into v_indexed_stuff
+     from ticket_issues
+     where msg_id = v_response_row.response_to
+     for update;
+   dbms_lob.append(v_indexed_stuff, v_response_row.message);
+ end if;
+END;
+/
+show errors
+
+
+create or replace function ticket_one_if_high_priority (priority IN integer, status IN varchar)
+return integer
+is
+BEGIN
+  IF ((priority = 1) AND (status <> 'closed') AND (status <> 'deferred')) THEN
+    return 1;
+  ELSE 
+    return 0;   
+  END IF;
+END ticket_one_if_high_priority;
+/
+show errors
+
+create or replace function ticket_one_if_blocker (severity IN varchar, status IN varchar)
+return integer
+is
+BEGIN
+  IF ((severity = 'showstopper') AND (status <> 'closed') AND (status <> 'deferred')) THEN
+    return 1;
+  ELSE 
+    return 0;   
+  END IF;
+END ticket_one_if_blocker;
+/
+show errors
+
Index: web/openacs/www/doc/sql/upgrade-ticket-2.1-2.2.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/upgrade-ticket-2.1-2.2.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/upgrade-ticket-2.1-2.2.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,6 @@
+
+
+alter table ticket_projects add (
+	group_id references user_groups
+);
+
Index: web/openacs/www/doc/sql/upgrade.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/upgrade.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/upgrade.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,48 @@
+drop function fs_connect_by(integer);
+create function fs_connect_by(integer) returns varchar as '
+declare
+	id              alias for $1;
+        pid             integer;
+BEGIN
+        select into pid parent_id from fs_files where id = file_id;
+	IF pid is null
+	THEN 
+		return fs_gen_key(id);
+	ELSE
+		return fs_connect_by(pid) || ''/'' || fs_gen_key(id);
+	END IF;	
+END;
+' language 'plpgsql';
+
+
+create function ticket_user_can_close_issue_p(integer, integer)
+returns char as '
+DECLARE
+	v_user_id alias for $1;
+	v_msg_id alias for $2;
+	msg_closeable record;
+BEGIN
+	if ad_admin_group_member_p(''bits'','''', v_user_id) = ''t''
+	then return ''t'';
+	end if;
+
+	select into msg_closeable
+               count(ti.msg_id) as chk,
+               max(ti.project_id) as pid 
+          from ticket_issues ti
+         where ti.user_id = v_user_id 
+           and ti.msg_id  = v_msg_id
+           and 0 < (select count(*) 
+                      from user_group_map 
+                     where user_id= v_user_id 
+                       and (role=''internal'' or role=''administrator'') 
+                       and group_id = (select tm.team_id 
+                                from ticket_project_teams tm
+                               where parent_project_p(tm.project_id,ti.project_id)=''t''));
+
+	IF msg_closeable.chk > 0
+	THEN return(''t'');
+	ELSE return(''f'');
+	END IF;
+END;
+' language 'plpgsql';	
Index: web/openacs/www/doc/sql/user-custom.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/user-custom.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/user-custom.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,20 @@
+--
+-- Support for persistent table customization, dimensional sliders,
+-- etc.
+--
+
+
+create table user_custom (
+        user_id         integer references users not null,
+        -- user entered name
+        item            varchar(80) not null,
+        -- ticket_table etc
+        item_group      varchar(80) not null,
+        -- table_view etc
+        item_type       varchar(80) not null,
+        -- list nsset etc.
+        value_type      varchar(80) not null,
+        value           text,
+        primary key (user_id, item, item_group, item_type)
+);
+                     
Index: web/openacs/www/doc/sql/user-groups.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/user-groups.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/user-groups.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,993 @@
+-- 
+-- /www/doc/sql/user-groups.sql
+--
+-- Author: Philip Greenspun (philg@mit.edu), 11/15/98
+--
+-- augmented 3/98 by Tracy Adams (teadams@mit.edu) 
+-- to handle
+--    a) Database-driven roles and action permissions
+--    b) Creates group_type "administration" for site and
+--       module administration
+--    c) Permission system that allows programmers to ask
+--       "Can user x do y?"
+--
+-- user-groups.sql,v 3.6.2.1 2000/03/15 09:36:44 michael Exp
+--
+
+-- allows administrators and users to set up groups of users
+-- and then place users in those groups with roles
+-- for example, the groups could be hospitals and then a user
+-- could be associated with Hospital X as "physician" and with 
+-- Hospital Y as "physician".
+--
+
+-- a group type might be 'hospital' or 'cardiac_center'
+-- or 'professional_society'
+
+-- we keep group_type short because we will be building tables
+-- with group_type as the name, e.g., "hospital_info" will store 
+-- the extra information specified in user_group_type_fields
+-- for groups of type "hospital"
+
+-- if pretty_name is "Cardiac Center" then pretty_plural
+-- is "Cardiac Centers"
+
+-- approval_policy of "open" means users can create groups of 
+-- this type and they are immediately live
+-- of "closed" means that only admins can create groups of this type
+-- of "wait" means that users are offered the option to create 
+-- but then an admin must approve
+
+create table user_group_types (
+	group_type 	varchar(20) primary key,
+	pretty_name	varchar(50) not null,
+	pretty_plural	varchar(50) not null,
+	approval_policy	varchar(30) not null,
+	default_new_member_policy	varchar(30) default 'open' not null,
+	-- if group_module_administration=full, then group administrators have full control of which modules
+	-- they can use (they can add, remove, enable and disable modules)
+	-- if group_module_administration=enabling, then group administrators have authority to enable and 
+	-- disable modules but cannot add or remove modules
+	-- if group_module_administration=none, the group administrators have no control over modules
+	-- modules are explicitly set for the user group type by the system administrator 
+	group_module_administration	varchar(20) default 'none',
+	-- does this group type support virtual group directories 	
+	-- if has_virtual_directory_p is t, then virtual url /$group_type can be used instead of /groups 
+	-- to access the groups of this type
+	has_virtual_directory_p		char(1) default 'f' check(has_virtual_directory_p in ('t','f')),
+	-- if has_virtual_directory_p is t and group_type_public_directory is not null, then files in 
+	-- group_type_public_directory will be used instead of files in default /groups directory
+	-- notice also that these files will be used only when the page is accessed through /$group_type url's
+	group_type_public_directory     varchar(200),
+	-- if has_virtual_directory_p is t and group_type_admin_directory is not null, then files in 
+	-- group_type_admin_directory will be used instead of files in default /groups/admin directory
+	-- notice also that these files will be used only when the page is accessed through /$group_type url's
+	group_type_admin_directory      varchar(200),
+	-- if has_virtual_directory_p is t and group_public_directory is not null, then files in 
+	-- group_public_directory will be used instead of files in default /groups/group directory
+	-- notice also that these files will be used only when the page is accessed through /$group_type url's
+	group_public_directory          varchar(200),
+	-- if has_virtual_directory_p is t and group_admin_directory is not null, then files in 
+	-- group_admin_directory will be used instead of files in default /groups/admin/group directory
+	-- notice also that these files will be used only when the page is accessed through /$group_type url's
+	group_admin_directory           varchar(200)
+	constraint group_type_module_admin_check check (
+	  (group_module_administration is not null)
+	   and (group_module_administration in ('full', 'enabling', 'none')))
+);
+
+
+-- fields of info that are required for each group type
+-- these will be stored in a separate table, called
+-- ${group_type}_info (e.g., "hospital_info")
+
+create table user_group_type_fields (
+	group_type	varchar(20) not null references user_group_types,
+	column_name	varchar(30) not null,
+	pretty_name	varchar(50) not null,
+	-- something generic and suitable for handing to AOLserver, 
+	-- e.g., boolean or text
+	column_type	varchar(50) not null,
+	-- something nitty gritty and Oracle-specific, e.g.,
+	-- char(1) instead of boolean
+	-- things like "not null"
+	column_actual_type	varchar(100) not null,
+	column_extra	varchar(100),
+	-- Sort key for display of columns.
+	sort_key		integer not null
+);
+
+
+-- this table is used when group administrators are not allowed to handle module administration
+-- (allow_module_administration_p is set to 0 for this group type)
+-- all groups of this group type will have only modules set up for which mapping in this table exists
+create sequence group_type_modules_id_sequence;
+create table user_group_type_modules_map (
+	group_type_module_id 	integer primary key,	
+	group_type 		varchar(20) references user_group_types not null,
+	module_key		varchar(30) references acs_modules not null
+);
+
+create sequence user_group_sequence;
+create table user_groups (
+	group_id	integer primary key,
+	group_type	varchar(20) not null references user_group_types,
+	group_name	varchar(100),
+	short_name 	varchar(100) unique not null,
+	admin_email 	varchar(100),
+	registration_date	datetime not null,
+	creation_user		integer not null references users(user_id),
+	creation_ip_address	varchar(50) not null,
+	approved_p 	char(1) check (approved_p in ('t','f')),
+	active_p	char(1) default 't' check(active_p in ('t','f')),
+	existence_public_p	char(1) default 't' check (existence_public_p in ('t','f')),
+	new_member_policy	varchar(30) default 'open' not null,
+	spam_policy		varchar(30) default 'open' not null,
+	constraint user_groups_spam_policy_check check(spam_policy in ('open','closed','wait')),
+	-- are the administrators notified of new membership?
+	email_alert_p		char(1) default 'f' check (email_alert_p in ('t','f')),
+	-- should we use the multi-role based
+	multi_role_p	char(1) default 'f' check (multi_role_p in ('t','f')),
+	-- can the user group administration control roles and actions?
+	-- If f, only site admin pages will have the functionality to modify role-action mappings.  This is a way to "lock in" permission system.
+	group_admin_permissions_p   char(1) default 'f' check (group_admin_permissions_p in ('t','f')),
+	index_page_enabled_p	char(1) default 'f' check (index_page_enabled_p in ('t','f')),
+	-- this is index page content
+	body			lztext,
+	-- html_p for the index page content
+	html_p	                char(1) default 'f' check (html_p in ('t','f')),
+        -- let's keep track of when these records are modified
+        modification_date   datetime,
+        modifying_user      integer references users,
+        -- add a parent_group_id to support subgroups
+        parent_group_id	integer references user_groups(group_id)
+);
+-- index parent_group_id to make parent lookups quick!
+create index user_groups_parent_grp_id_idx on user_groups(parent_group_id);
+
+
+create function user_group_group_type (integer)
+returns varchar as '
+DECLARE
+	v_group_id alias for $1;
+	v_group_type user_group_types.group_type%TYPE;
+BEGIN
+	select group_type into v_group_type
+	from user_groups
+	where group_id = v_group_id;
+
+	return v_group_type;
+END;
+' language 'plpgsql';
+
+-- this is the helper function for function short_name_from_group_name bellow
+create function short_name_from_group_name2(varchar, integer)
+returns varchar as '
+DECLARE
+	v_short_name alias for $1;
+	v_identifier alias for $2;
+	v_new_short_name user_groups.short_name%TYPE;
+	v_test_short_name user_groups.short_name%TYPE;
+BEGIN
+	select short_name into v_test_short_name
+	from user_groups
+	where short_name = v_short_name ||
+	case when v_identifier=0 then '''' else v_identifier end;
+
+	if NOT FOUND then
+	    IF v_identifier = 0
+	    then return v_short_name;
+	    else return v_short_name || v_identifier;
+	    end if;
+    else	
+	return short_name_from_group_name2(v_short_name, v_identifier+1);
+	end if;
+END;
+' language 'plpgsql';
+
+
+-- this function generates unique short_name from the group_nams
+-- v_group_name is the group_name of the group, this function will first transform group_name by making it lower case, 
+-- and substituting spaces and underscores with dashes. thus, if group_name is Photographers, the transformed group_name
+-- will be photographers. then, this function will keep adding numbers to it until it makes it unique (e.g. if short_names
+-- photographers and photographers1 already exist this function will return photographers2)
+
+create function short_name_from_group_name (varchar)
+returns varchar as '
+DECLARE
+	v_group_name alias for $1;
+BEGIN
+	return short_name_from_group_name2(lower(substr(translate(v_group_name, ''_ '',''--''), 1, 80)), 0);
+END;
+' language 'plpgsql';
+
+
+-- this procedure sets the short_name of all the groups in the user_group
+-- table using short_name_from_group_name function
+-- notice that simple update using short_name_from_group_name could not be
+-- performed because function short_name_from_group_name is used while
+-- user_groups is mutating (ORA-04091)
+create function generate_short_names_for_group()
+returns opaque as '
+DECLARE
+        v_group_id user_groups.group_id%TYPE;
+	v_group_name user_groups.group_name%TYPE;
+	v_short_name user_groups.short_name%TYPE;
+
+	cursor c1 is 
+	select group_id, group_name
+	from user_groups;
+BEGIN
+	OPEN c1;
+
+	LOOP
+           FETCH c1 INTO v_group_id, v_group_name;
+           EXIT WHEN c1%NOTFOUND;
+	
+	   v_short_name:= short_name_from_group_name(v_group_name);
+	   update user_groups set short_name=v_short_name where group_id=v_group_id;
+
+       END LOOP;
+END;
+' language 'plpgsql';
+
+create function set_user_group_regdate() returns opaque as '
+  declare
+    group_type_row user_group_types%ROWTYPE;
+  begin
+    if new.registration_date isnull then
+        new.registration_date := ''now'';
+    end if;
+    if new.approved_p isnull then
+    select * into group_type_row from user_group_types ugt 
+      where ugt.group_type = new.group_type;
+    if group_type_row.approval_policy = ''open'' then
+      new.approved_p := ''t'';
+    else 
+      new.approved_p := ''f'';
+    end if;
+  end if;  
+  return new;
+end;
+' language 'plpgsql';
+
+create trigger user_group_regdate
+before insert on user_groups
+for each row execute procedure set_user_group_regdate();
+
+-- role = 'administrator' is magic and lets the person add other
+-- members
+
+create table user_group_map (
+	group_id 	integer not null references user_groups,
+	user_id		integer not null references users,
+	-- define in this order because we want to 
+	-- quickly see if user X belongs to requested group
+	-- and/or which groups a user belongs to
+	role		varchar(200),
+	registration_date	datetime not null,
+	-- keep track of who did this and from where
+	mapping_user	integer not null references users(user_id),
+	-- store the string, separated by dots, e.g., 18.23.10.101
+	-- make it large enough to handle IPv6 (128 bits)
+	mapping_ip_address	varchar(50) not null,
+	primary key (group_id, user_id, role)
+);
+
+
+create function set_user_group_map_regdate() returns opaque as '
+  begin
+    if new.registration_date isnull then
+      new.registration_date := ''now'';
+    end if;
+    return new;
+  end;
+' language 'plpgsql';
+
+create trigger user_group_map_regdate
+before insert on user_group_map
+for each row execute procedure set_user_group_map_regdate();
+
+
+-- holds people who've asked to be in a group but aren't 
+-- approved yet
+
+create table user_group_map_queue (
+	group_id	integer references user_groups,
+	user_id		integer references users,
+	ip_address	varchar(50),
+	queue_date	datetime default current_timestamp,
+	primary key (group_id, user_id)
+);
+
+-- stores the roles used by each group
+-- only meaningful for groups that use a 
+-- multi_role permission system
+
+create table user_group_roles (
+	group_id	     integer not null references user_groups,
+	role		     varchar(200),
+	creation_date        datetime not null,
+	creation_user        integer not null references users,
+	creation_ip_address  varchar(200) not null,
+	primary key (group_id, role)
+);
+
+create function set_user_group_roles_creation_date() returns opaque as '
+  begin
+    if new.creation_date isnull then
+      new.creation_date := ''now'';
+    end if;
+    return new;
+  end;
+' language 'plpgsql';
+
+create trigger user_group_roles_creation_date
+before insert on user_group_roles
+for each row execute procedure set_user_group_roles_creation_date();
+
+-- stores the actions used by each group
+-- only used in multi-role mode
+
+create table user_group_actions (
+	group_id	     integer not null references user_groups,
+	action		     varchar(200),
+	creation_date        datetime not null,
+	creation_user        integer not null references users,
+	creation_ip_address  varchar(200) not null,
+	primary key (group_id, action));
+
+create function set_user_group_actions_create_date() returns opaque as '
+  begin
+    if new.creation_date isnull then
+      new.creation_date := ''now'';
+    end if;
+    return new;
+  end;
+' language 'plpgsql';
+
+create trigger user_group_actions_create_date
+before insert on user_group_actions
+for each row execute procedure set_user_group_actions_create_date();
+
+-- maps roles to allowed actions
+
+create table user_group_action_role_map (
+	group_id     	integer not null references user_groups,
+	role		varchar(200) not null,
+	action		varchar(200) not null,
+	creation_date        datetime not null,	
+	creation_user        integer not null references users,
+	creation_ip_address  varchar(200) not null,
+	primary key (group_id, role, action)
+);
+
+--- normal identifier is too long
+create function set_user_gr_action_role_date() returns opaque as '
+  begin
+    if new.creation_date is null then
+      new.creation_date := ''now'';
+    end if;
+    return new;
+  end;
+' language 'plpgsql';
+
+create  trigger user_gr_action_role_map_date
+before insert on user_group_action_role_map
+for each row execute procedure set_user_gr_action_role_date();
+
+create function set_user_group_map_queue_date() returns opaque as '
+  begin
+    if new.queue_date is null then
+      new.queue_date := ''now'';
+    end if;
+    return new;
+  end;
+' language 'plpgsql';
+
+create  trigger user_group_map_queue_date
+before insert on user_group_map_queue
+for each row execute procedure set_user_group_map_queue_date();
+
+---MODULE  ADMINISTRATION
+
+-- this table lets you ask "what is the user group that corresponds
+-- to a particular module/submodule of the ACS?"
+
+-- module would be something like "classifieds" and submodule
+-- would be a classifieds domain; for a bboard, the module would
+-- be "bboard" and the submodules individual bboard topics 
+
+-- NOTE: Most tables named grouptype_info are autogenerated
+-- This is the one _info table that is created by hand
+
+create table administration_info (
+ 	group_id	integer not null references user_groups,
+	module		varchar(300) not null,
+	submodule	varchar(300),
+	--- link to the module administration page
+	url		varchar(300),
+	unique(module, submodule)
+);
+
+create function init_system_group_types() returns integer as '
+begin
+ if count(*) = 0 from user_group_types where group_type = ''administration'' then
+   insert into user_group_types
+     (group_type, pretty_name, pretty_plural, approval_policy, default_new_member_policy, group_module_administration)
+   values
+     (''administration'', ''Administration'', ''Administration Groups'', ''closed'', ''closed'', ''full'');
+   insert into user_group_type_fields
+     (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key)
+   values
+     (''administration'', ''module'', ''Module'', ''text'', ''varchar(300)'', ''not null'', 1);
+   insert into user_group_type_fields
+     (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key)
+   values
+     (''administration'', ''submodule'', ''Submodule'', ''text'', ''varchar(300)'',null, 2);
+   -- so that we can offer admins links from their workspace 
+   insert into user_group_type_fields
+     (group_type, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key)
+   values
+     (''administration'', ''url'', ''URL'', ''text'', ''varchar(100)'','''',3);
+ end if;
+ return 1;
+end;
+' language 'plpgsql';
+
+select init_system_group_types();
+
+--
+-- A postgres function overload which is nice and neat for
+-- backwards compatibility when there is no short name
+create function administration_group_add(varchar,varchar,varchar,char,varchar)
+returns integer as '
+DECLARE
+BEGIN
+	return administration_group_add( $1 , short_name_from_group_name( $1), $2 , $3 , $4 , $5);
+END;
+' language 'plpgsql';
+
+-- creates a new group of type "administration"; does nothing if the group is
+-- already defined
+
+create  function administration_group_add (varchar, varchar, varchar, varchar, char, varchar )
+   returns integer as ' 
+declare
+  pretty_name alias for $1;
+  v_short_name alias for $2;
+  v_module alias for $3;
+  v_submodule alias for $4;
+  v_multi_role_p alias for $5;
+  v_url alias for $6;
+  v_group_id integer;
+  n_administration_groups integer;
+  v_system_user_id integer; 
+  v_submodule_kludge varchar;
+BEGIN
+  if v_submodule = '''' then
+      v_submodule_kludge := null;
+      select count(group_id) into n_administration_groups
+        from administration_info 
+        where module = v_module 
+        and submodule isnull;
+      else
+        v_submodule_kludge := v_submodule;
+	select count(group_id) into n_administration_groups
+         from administration_info
+         where module = v_module 
+         and submodule = v_submodule;
+  end if;
+  if n_administration_groups = 0 then 
+     -- call procedure defined in community-core.sql to get system user
+     v_system_user_id := system_user_id();
+     select nextval(''user_group_sequence'') into v_group_id;
+     insert into user_groups 
+      (group_id, group_type, short_name, group_name, creation_user, creation_ip_address, approved_p, existence_public_p, new_member_policy, multi_role_p)
+      values
+      (v_group_id, ''administration'', v_short_name, pretty_name, v_system_user_id, ''0.0.0.0'', ''t'', ''f'', ''closed'', v_multi_role_p);
+     insert into administration_info (group_id, module, submodule, url) values (v_group_id, v_module, v_submodule_kludge, v_url);
+   end if;
+   return 1;
+end;
+' language 'plpgsql';
+
+--- Define an administration group for site wide administration
+
+select
+   administration_group_add ('Site-Wide Administration', 'SWA', 'site_wide', '', 'f', '/admin/'); 
+
+--- returns the group_id of the site_wide administration group
+
+create  function system_administrator_group_id()
+returns integer as '
+declare
+  v_group_id	integer;
+begin
+  select group_id into v_group_id
+   from administration_info
+   where module = ''site_wide''
+   and submodule isnull;
+  return v_group_id;
+end;
+' language 'plpgsql';
+
+---  Add the system user to the site-wide administration group
+
+create function system_user_to_administrator_group() returns integer as '
+declare
+ v_system_group_id      integer;
+ v_system_user_id	integer;
+ n_user_id		integer;
+begin
+   v_system_user_id := system_user_id();
+   v_system_group_id := system_administrator_group_id();
+   select count(user_id) into n_user_id
+   from user_group_map 
+   where user_id = v_system_user_id
+     and group_id = v_system_group_id;
+   if n_user_id = 0 then
+	insert into user_group_map
+    	(group_id, user_id, role, mapping_user, mapping_ip_address)
+   	values 
+    	(v_system_group_id, v_system_user_id, ''administrator'', v_system_user_id, ''0.0.0.0'');
+   end if;
+   return 1;
+end;
+' language 'plpgsql';
+
+select system_user_to_administrator_group();
+
+--  Some query functions
+
+create function ad_group_member_p (integer, integer)
+returns varchar as '
+DECLARE
+	v_user_id alias for $1;
+	v_group_id alias for $2;
+	n_rows integer;
+BEGIN
+  select count(*) into n_rows
+   from user_group_map 
+   where user_id = v_user_id
+   and group_id = v_group_id;
+  IF n_rows > 0 THEN
+    return ''t'';
+  ELSE
+    return ''f'';
+  END IF;
+END;
+' language 'plpgsql';
+
+create function ad_user_has_role_p(integer,integer,varchar)
+returns char
+as '
+DECLARE
+	v_user_id alias for $1;
+	v_group_id alias for $2;
+	v_role alias for $3;
+  ad_user_has_role_p char(1);
+BEGIN
+  select case when count(*)=0 then ''f'' else ''t'' end
+  into ad_user_has_role_p
+  from user_group_map 
+  where user_id = v_user_id
+  and group_id = v_group_id
+  and role = v_role;
+
+  return ad_user_has_role_p;
+END;
+' language 'plpgsql';
+
+create function ad_group_member_admin_role_p (integer,integer)
+returns varchar as '
+DECLARE
+	v_user_id alias for $1;
+	v_group_id alias for $2;
+	n_rows integer;
+BEGIN
+  select count(*) into n_rows
+   from user_group_map 
+   where user_id = v_user_id
+   and group_id = v_group_id
+   and lower(role) = ''administrator'';
+  IF n_rows > 0 THEN
+    return ''t'';
+  ELSE
+    return ''f'';
+  END IF;
+END;
+' language 'plpgsql';
+
+create  function ad_admin_group_member_p (varchar, varchar, integer)
+returns varchar
+as '
+DECLARE
+  v_module alias for $1;
+  v_submodule alias for $2;
+  v_user_id alias for $3;
+  n_rows  integer;
+  v_submodule_kludge varchar;
+BEGIN
+  if v_submodule = '''' then
+    v_submodule_kludge := null;
+  else 
+    v_submodule_kludge := v_submodule;
+  end if;
+  select count(*) into n_rows
+   from user_group_map 
+   where user_id = v_user_id
+   and group_id in (select group_id from administration_info
+                    where (module = v_module and submodule = v_submodule)
+                    or module = ''site_wide'');
+  IF n_rows > 0 THEN
+    return ''t'';
+  ELSE
+    return ''f'';
+  END IF;
+END;
+' language 'plpgsql';
+
+
+-- This table records additional fields to be recorded per user who belongs
+-- to a group of a particular type.
+-- Each field can be associated with a role within a group.  This allows
+-- us to present a role-specific set of fields for users to add/edit.
+-- If the role field is empty we present the field to all members
+-- of the group of specified group_type. aegrumet@arsdigita.com, 2000-03-10
+create table user_group_type_member_fields (
+	group_type	varchar(20) references user_group_types,
+	role		varchar(200),
+	field_name	varchar(200) not null,
+	field_type	varchar(20) not null, -- short_text, long_text, boolean, date, etc.
+	-- Sort key for display of columns.
+	sort_key		integer not null,
+        -- We can't make this a primary key since role can be NULL.
+	-- The unique constraint creates an index.
+	unique (group_type, role, field_name)
+);
+
+
+-----------------------------------------------------------------------------------------------------------
+
+
+-- created by ahmeds@mit.edu on Thu Jan 13 21:29:11 EST 2000
+--
+-- supports a system for spamming members of a user group 
+--
+
+-- group_member_email_preferences table retains email preferences of members 
+-- that belong to a particular group 
+
+create table group_member_email_preferences (
+	group_id		integer references user_groups not null,
+	user_id			integer references users not null ,
+	dont_spam_me_p		char (1) default 'f' check(dont_spam_me_p in ('t','f')),
+	primary key (group_id, user_id)  
+);
+
+
+-- group_spam_history table holds the spamming log for this group 
+
+create sequence group_spam_id_sequence  start 1;
+
+create table group_spam_history (
+	spam_id			integer primary key,
+	group_id		integer references user_groups not null,
+	sender_id		integer references users(user_id) not null,
+	sender_ip_address	varchar(50) not null,
+	from_address		varchar(100),
+	subject			varchar(200),
+ 	body			lztext,
+	send_to			varchar (50) default 'members' check (send_to in ('members','administrators')), 
+	creation_date		datetime not null,
+	-- approved_p matters only for spam policy='wait'
+	-- approved_p = 't' indicates administrator approved the mail 
+	-- approved_p = 'f' indicates administrator disapproved the mail, so it won't be listed for approval again
+	-- approved_p = null indicates the mail is not approved/disapproved by the administrator yet 
+	approved_p		char(1) default null check (approved_p is null or approved_p in ('t','f')),
+	send_date		datetime,
+	-- this holds the number of intended recipients
+	n_receivers_intended	integer default 0,
+	-- we'll increment this after every successful email
+	n_receivers_actual	integer default 0
+);
+
+
+-- This function returns the number of members all of the subgroups of
+-- one group_id has. Note that since we made subgroups go 1 level down
+-- only, this function only looks for groups whose parent is the specified
+-- v_parent_group_id
+create function user_groups_number_subgroups (integer)
+returns integer AS '
+DECLARE
+  v_group_id alias for $1;
+BEGIN
+  return count(*) from user_groups where parent_group_id = v_group_id;
+END;' language 'plpgsql';
+
+
+-- We need to be able to answer "How many total members are there in all 
+-- of my subgroups?" 
+create function user_groups_number_submembers (integer)
+returns integer AS '
+DECLARE
+  v_parent_group_id alias for $1;
+BEGIN
+  return count(*)
+    from user_group_map 
+   where group_id in (select group_id 
+                        from user_groups 
+                       where parent_group_id = v_parent_group_id);
+END;' language 'plpgsql';
+
+
+-- While doing a connect by, we need to count the number of members in 
+-- user_group_map. Since we can't join with a connect by, we create 
+-- this function
+create function user_groups_number_members (integer) returns integer AS '
+DECLARE
+  v_group_id alias for $1;
+BEGIN
+  return count(*)
+    from user_group_map 
+   where group_id = v_group_id;
+END;' language 'plpgsql';
+
+
+-- easy way to get the user_group from an id. This is important when
+-- using connect by in your table and it also makes the code using 
+-- user subgroups easier to read (don't have to join an additional
+-- user_groups tables). However, it is recommended that you only
+-- use this pls function when you have to or when it truly saves you
+-- from some heinous coding
+create function user_group_name_from_id (integer) returns varchar AS '
+DECLARE
+  v_group_id alias for $1;
+BEGIN
+  return group_name from user_groups where group_id = v_group_id;
+END;' language 'plpgsql';
+
+
+-- With subgroups, we needed an easy way to add adminstration groups
+-- and tie them to parents
+-- DRB: NULL args don't work reliably in PG need to thing about this
+-- one...
+
+create function administration_subgroup_add(varchar, varchar, varchar, varchar, varchar, varchar, varchar)
+returns integer as '
+DECLARE
+	pretty_name alias for $1;
+	v_short_name alias for $2;
+	v_module alias for $3;
+	v_submodule_kludge alias for $4;
+	v_multi_role_p alias for $5;
+	v_url alias for $6;
+	v_parent_module alias for $7;
+	v_submodule	varchar(300);
+	v_group_id	integer;
+	n_administration_groups integer;
+	v_system_user_id integer; 
+	v_parent_id integer;
+BEGIN
+  if v_submodule_kludge = '''' then
+    v_submodule:= NULL;
+  else 
+    v_submodule:= v_submodule_kludge;
+  end if;
+
+  if v_submodule is null then
+      select count(group_id) into n_administration_groups
+        from administration_info 
+        where module = v_module 
+        and submodule is null;
+      else
+	select count(group_id) into n_administration_groups
+         from administration_info
+         where module = v_module 
+         and submodule = v_submodule;
+  end if;
+
+  if n_administration_groups = 0 then 
+     -- call procedure defined in community-core.sql to get system user
+     v_system_user_id := system_user_id();
+     select nextval(''user_group_sequence'') into v_group_id;
+     insert into user_groups 
+      (group_id, group_type, short_name, group_name, creation_user, creation_ip_address, approved_p, existence_public_p, new_member_policy, multi_role_p)
+      values
+      (v_group_id, ''administration'', v_short_name, pretty_name, v_system_user_id, ''0.0.0.0'', ''t'', ''f'', ''closed'', v_multi_role_p);
+     insert into administration_info (group_id, module, submodule, url) values (v_group_id, v_module, v_submodule, v_url);
+   end if;
+
+   -- Not sure what this begin exception end is supposed to
+   -- do, I am going to ignore it for now (BMA).
+   --   Begin
+      select ai.group_id into v_parent_id
+      from administration_info ai, user_groups ug
+      where ai.module = v_parent_module
+      and ai.group_id != v_group_id
+      and ug.group_id = ai.group_id
+      and ug.parent_group_id is null;
+   -- Exception when others then null;
+   -- End;
+   
+   update user_groups
+   set parent_group_id = v_parent_id
+   where group_id = v_group_id;
+
+   return 1;
+end;' language 'plpgsql';
+
+
+
+-- Adds the specified field_name and field_type to a group with group id v_group_id
+-- if the member field already exists for this group, does nothing
+-- if v_sort_key is not specified, the member_field will be added with sort_key
+--   1 greater than the current max
+create function user_group_member_field_add() returns integer as '
+declare
+  n_groups          integer;
+BEGIN
+  -- make sure we don''t violate the unique constraint of user_groups_member_fields
+  select decode(count(*),0,0,1) into n_groups
+    from all_member_fields_for_group
+   where group_id = v_group_id
+     and field_name = v_field_name;
+
+  if n_groups = 0 then 
+     -- member_field is new - add it
+
+     insert into user_group_member_fields 
+     (group_id, field_name, field_type, sort_key)
+     values
+     (v_group_id, v_field_name, v_field_type, v_sort_key);
+
+   end if;
+  return 1;
+end;
+' language 'plpgsql';
+
+
+
+-- function to create new groups of a specified type 
+-- This is useful mostly when loading your modules - simply use this 
+-- function to create the groups you need
+create function user_group_add (varchar, varchar, varchar, varchar)
+RETURNS integer AS '
+DECLARE
+  v_group_type alias for $1;
+  v_pretty_name alias for $2;
+  v_short_name alias for $3;
+  v_multi_role_p alias for $4;
+  v_system_user_id  integer; 
+BEGIN
+     -- call procedure defined in community-core.sql to get system user
+     v_system_user_id := system_user_id();
+     -- create the actual group
+     insert into user_groups 
+      (group_id, group_type, short_name, group_name, creation_user, creation_ip_address, approved_p, existence_public_p, new_member_policy, multi_role_p)
+     select nextval(''user_group_sequence''), v_group_type, v_short_name,
+       v_pretty_name, v_system_user_id, ''0.0.0.0'', ''t'', ''f'', ''closed'',
+       v_multi_role_p
+     where not exists (select * from user_groups
+       where upper(short_name) = upper(v_short_name));
+
+       RETURN 1;
+end;' language 'plpgsql';
+
+-- Contains information about fields to gather per user for a user group.
+-- Cannot contain a field_name that appears in the
+-- user_group_type_member_fields table for the group type this group belongs to.
+
+create table user_group_member_fields (
+	group_id	integer references user_groups,
+	field_name	varchar(200) not null,
+	field_type	varchar(20) not null, -- short_text, long_text, boolean, date, etc.
+	sort_key	integer not null,
+	primary key (group_id, field_name)
+);
+
+-- View that brings together all field information for a user group, from
+-- user_group_type_member_fields and user_group_member_fields.
+-- We throw in the sort keys prepended by 'a' or 'b' so we can display
+-- them in the correct order, with the group type fields first.
+create view all_member_fields_for_group as
+select group_id, field_name, field_type, 'a' || sort_key as sort_key
+from user_group_type_member_fields ugtmf, user_groups ug
+where ugtmf.group_type = ug.group_type;
+-- DRB
+
+-- 6.5.3 PostgreSQL doesn't implement views on unions, so the
+-- users of the above view will have to do the union themselves.
+-- There aren't that many pages that use this...
+
+--union
+--select group_id, field_name, field_type, 'b' || sort_key as sort_key
+--from user_group_member_fields;
+
+
+-- Contains extra field information for a particular user. These fields
+-- were defined either in user_group_type_member_fields or 
+-- user_group_member_fields
+create table user_group_member_field_map (
+	group_id	integer references user_groups,
+	user_id		integer references users,
+	field_name	varchar(200) not null,
+	field_value	varchar(4000),
+	primary key (group_id, user_id, field_name)
+);
+
+-- Sequence used to support a Terrible kludge to work around the
+-- inability to drop a column in Postgres.  See the ug admin script
+-- "field-delete-2.tcl" for a more complete explanation.
+
+create sequence user_group_deleted_seq start 1;
+
+-- Two little functions to help overcome lack of outer joins
+
+create function user_group_count_group_map(integer) returns integer as '
+begin
+    return count(*) from user_group_map where group_id = $1;
+end;
+' language 'plpgsql';
+
+create function user_group_count_groups(varchar) returns integer as '
+begin
+    return count(*) from user_groups where group_type = $1;
+end;
+' language 'plpgsql';
+
+create function user_group_short_name_from_id (integer) returns varchar AS '
+DECLARE
+  v_group_id alias for $1;
+BEGIN
+  return short_name from user_groups where group_id = v_group_id;
+END;' language 'plpgsql';
+
+create function user_group_hierarchy_level(integer, integer, integer)
+returns integer as '
+DECLARE
+	v_group_id alias for $1;
+	v_start_id alias for $2;
+	v_level alias for $3;
+	v_parent_id integer;
+BEGIN
+	IF v_group_id = v_start_id
+	then return v_level;
+	end if;
+
+	select parent_group_id into v_parent_id from user_groups where group_id= v_group_id;
+
+	if v_parent_id is null
+	then
+		if v_start_id= 0
+		then return v_level+1;
+		else return null;
+		end if;
+	end if;
+
+	return user_group_hierarchy_level(v_parent_id, v_start_id, 1+ v_level);
+END;
+' language 'plpgsql';
+
+create function user_group_hierarchy_sortkey(integer, integer, char)
+returns char as '
+DECLARE
+	v_group_id alias for $1;
+	v_start_id alias for $2;
+	v_sortkey alias for $3;
+	v_parent_id integer;
+BEGIN
+	IF v_group_id = v_start_id
+	then return (v_group_id::char || v_sortkey);
+	end if;
+
+	select parent_group_id into v_parent_id from user_groups where group_id= v_group_id;
+
+	if v_parent_id is null
+	then return null;
+	end if;
+
+	return user_group_hierarchy_sortkey(v_parent_id, v_start_id, ''/'' || v_group_id::char || v_sortkey);
+END;
+' language 'plpgsql';
\ No newline at end of file
Index: web/openacs/www/doc/sql/webmail.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/webmail.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/webmail.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,368 @@
+-- webmail.sql
+-- by Jin Choi <jsc@arsdigita.com>
+-- Feb 28, 2000
+
+-- Data model to support web based email system.
+
+-- Database user must have javasyspriv permission granted to it:
+-- connect system
+-- grant javasyspriv to <username>;
+
+-- ctxsys must grant EXECUTE on ctx_ddl to this Oracle user:
+-- connect ctxsys
+-- grant execute on ctx_ddl to <username>;
+
+-- webmail.sql,v 1.5 2000/03/10 05:02:25 jsc Exp
+
+
+-- Domains we receive email for.
+create table wm_domains (
+	-- short text key
+	short_name		varchar(100) not null primary key,
+	-- fully qualified domain name
+	full_domain_name	varchar(100) not null
+);
+
+
+-- Maps email accounts to ACS users.
+create table wm_email_user_map (
+	email_user_name	varchar(100) not null,
+	domain		varchar(100) references wm_domains,
+	user_id		integer not null references users,
+	primary key (email_user_name, domain, user_id)
+);
+
+-- Main mail message table. Stores body of the email, along
+-- with a parsed text version with markers for attachments for MIME
+-- messages.
+create table wm_message_lobs (
+       msg_id           integer,
+       lob              integer references lobs,
+       primary key (msg_id,lob)
+);
+
+create sequence wm_msg_id_sequence;
+create table wm_messages (
+        msg_id          integer primary key references wm_message_lobs(msg_id),
+        --body            clob,
+        body            integer references lobs,
+	-- plain text portions of MIME message; empty if 
+	-- entire message is of type text/*.
+	-- mime_text	clob,
+	mime_text	integer references lobs,
+        message_id      varchar(200), -- RFC822 Message-ID field
+	unique_id	integer -- for both POP3 UIDL and IMAP UID
+);
+
+create index wm_messages_by_message_id on wm_messages(message_id);
+
+
+create trigger wm_message_lobs_tr before delete or update or insert
+on wm_message_lobs for each row execute procedure on_lob_ref();
+
+-- drop function on_wm_lobs_delete();
+create function on_wm_lobs_delete() returns opaque as '
+begin
+	delete from wm_messages where msg_id = old.msg_id;
+	return old;
+end;' language 'plpgsql';
+
+
+-- drop trigger wm_lobs_delete_trig on wm_message_lobs;
+create trigger wm_lobs_delete_trig before delete on wm_message_lobs
+for each row execute procedure on_wm_lobs_delete();
+
+
+
+-- Stores attachments for MIME messages.
+create table wm_attachments (
+	msg_id		integer not null references wm_messages,
+	-- File name associated with attachment.
+	filename	varchar(600) not null,
+	-- MIME type of attachment.
+	content_type	varchar(100),
+--	data		blob,
+        lob             integer references lobs,
+	format		varchar(10) check (format in ('binary', 'text')), -- for interMedia INSO filter
+	primary key (msg_id, filename)
+);
+
+create trigger wm_attachments_tr before delete or update or insert
+on wm_attachments for each row execute procedure on_lob_ref();
+
+
+-- Maps mailboxes (folders, in more common terminology) to ACS users.
+create sequence wm_mailbox_id_sequence;
+
+create table wm_mailboxes (
+	mailbox_id	integer primary key,
+	name		varchar(100) not null,
+	creation_user	integer references users(user_id),
+	creation_date	timestamp,
+	uid_validity	integer, -- Needed for IMAP
+	unique(creation_user, name)
+);
+
+-- Maps messages to mailboxes (and thus to users).
+create table wm_message_mailbox_map (
+	mailbox_id	integer references wm_mailboxes,
+	msg_id		integer references wm_messages,
+	seen_p		char(1) default 'f' check(seen_p in ('t','f')),
+	answered_p	char(1) default 'f' check(answered_p in ('t','f')),
+	flagged_p	char(1) default 'f' check(flagged_p in ('t','f')),
+	deleted_p	char(1) default 'f' check(deleted_p in ('t','f')),
+	draft_p		char(1) default 'f' check(draft_p in ('t','f')),
+	recent_p	char(1) default 't' check(recent_p in ('t','f')),
+	primary key (msg_id, mailbox_id)
+);
+
+
+-- Parsed recipients for a message; enables search by recipient.
+create table wm_recipients (
+        msg_id          integer not null references wm_messages,
+        header          varchar(100) not null, -- to, cc, etc.
+        email           varchar(300) not null,
+        name            varchar(200)
+);
+
+create index wm_recipients_by_msg_id on wm_recipients(msg_id);
+
+
+-- Headers for a message.
+create table wm_headers (
+        msg_id          integer not null references wm_messages,
+	-- field name as specified in the email
+        name            varchar(100) not null,
+	-- lowercase version for case insensitive searches
+        lower_name      varchar(100) not null,
+        value           varchar(4000),
+        -- various parsed versions of the value
+        time_value      timestamp, -- date/time fields
+        -- email and name, for singleton address fields like From
+        email_value     varchar(300),
+        name_value      varchar(200),
+        -- original order of headers
+        sort_order      integer not null
+);
+
+create index wm_headers_by_msg_id_name on wm_headers (msg_id, lower_name);
+
+
+-- Table for recording messages that we failed to parse for whatever reason.
+create table wm_parse_errors (
+	filename		varchar(255) primary key not null, -- message queue file
+	error_message		varchar(4000),
+	first_parse_attempt	timestamp default sysdate() not null
+);
+
+-- Used for storing attachments for outgoing messages.
+-- Should be cleaned out periodically.
+
+create sequence wm_outgoing_msg_id_sequence;
+
+create table wm_outgoing_messages (
+	outgoing_msg_id		integer not null primary key,
+	body			text,  -- used to be a clob
+--	composed_message	text,  -- used to be a clob, needs to be a lob?
+        lob                     integer references lobs,
+	creation_date		timestamp default sysdate() not null,
+	creation_user		integer not null references users
+);
+
+create trigger wm_out_messages_tr before delete or update or insert
+on wm_outgoing_messages for each row execute procedure on_lob_ref();
+
+create table wm_outgoing_headers (
+	outgoing_msg_id		integer not null references wm_outgoing_messages on delete cascade,
+	name			varchar(100) not null,
+	value			varchar(4000),
+	sort_order		integer not null
+);
+
+create unique index wm_outgoing_headers_idx on wm_outgoing_headers (outgoing_msg_id, name);
+
+
+create sequence wm_outgoing_parts_sequence;
+create table wm_outgoing_message_parts (
+	outgoing_msg_id		integer not null references wm_outgoing_messages on delete cascade,
+--	data			blob,
+        lob                     integer not null references lobs,
+	filename		varchar(600) not null,
+	content_type		varchar(100), -- mime type of data
+	sort_order		integer not null,
+	primary key (outgoing_msg_id, sort_order)
+);
+
+create trigger wm_messages_tr before delete or update or insert
+on wm_outgoing_message_parts for each row execute procedure on_lob_ref();
+
+
+-- DanW - this functionality should be implemented by a scheduled process
+--        inside of aolserver
+
+-- Create a job to clean up orphaned outgoing messages every day.
+-- create or replace procedure wm_cleanup_outgoing_msgs as
+-- begin
+--   delete from wm_outgoing_messages
+--     where creation_date < sysdate() - 1;
+-- end;
+-- /
+
+-- declare
+--   job number;
+-- begin
+--   dbms_job.submit(job, 'wm_cleanup_outgoing_msgs;',
+-- 		  interval => 'sysdate() + 1');
+-- end;
+-- /
+
+-- variable jobno number;
+-- exec dbms_job.submit(:jobno, 'wm_cleanup_outgoing_msgs;', sysdate(), 'sysdate() + 1');
+
+-- Sean's POP3 server stuff (currently unused).
+create sequence wm_pop3_servers_seq;
+create table wm_pop3_servers (
+	server_id	integer primary key,
+	user_id		integer references users,
+	server_name	varchar(100) not null,
+	port_number	integer default 110,
+	user_name	varchar(200) not null,
+	password	varchar(200) not null,
+	last_uidl	varchar(200) default 'None',
+	mailbox_size 	integer default 0,
+	n_messages	integer default 0,
+	delete_on_download_p	char(1) default 'f' check (delete_on_download_p in ('t', 'f')),
+	delete_on_local_del_p	char(1) default 'f' check (delete_on_local_del_p in ('t', 'f'))
+);
+
+
+-- PL/SQL bindings for Java procedures
+-- create or replace procedure wm_process_queue (queuedir IN VARCHAR)
+-- as language java
+-- name 'com.arsdigita.mail.MessageParser.processQueue(java.lang.String)';
+-- /
+
+-- useful for debugging
+-- create or replace procedure wm_parse_message_from_file (filename IN VARCHAR)
+-- as language java
+-- name 'com.arsdigita.mail.MessageParser.parseMessageFromFile(java.lang.String)';
+-- /
+
+-- create or replace function wm_parse_date (datestr IN VARCHAR) return date
+-- as language java
+-- name 'com.arsdigita.mail.MessageParser.parseDate(java.lang.String)
+-- return java.sql.Timestamp';
+-- / 
+
+-- create or replace procedure wm_compose_message (outgoing_msg_id IN NUMBER)
+-- as language java
+-- name 'com.arsdigita.mail.MessageComposer.composeMimeMessage(int)';
+-- /
+
+
+-- Trigger to delete subsidiary rows when a message is deleted.
+-- drop function wm_messages_delete_tr();
+create function wm_messages_delete_tr() returns opaque as '
+begin
+  delete from wm_headers where msg_id = old.msg_id;
+  delete from wm_recipients where msg_id = old.msg_id;
+  delete from wm_message_mailbox_map where msg_id = old.msg_id;
+  delete from wm_attachments where msg_id = old.msg_id;
+  return old;
+end;
+' language 'plpgsql';
+
+-- drop trigger wm_messages_delete_trigger on wm_messages;
+create trigger wm_messages_delete_trigger
+before delete on wm_messages
+for each row execute procedure wm_messages_delete_tr();
+
+
+-- DanW - this functionality should be replicated in aolserver 
+--        with a scheduled process
+
+-- Parse the queue every minute. Queue directory is hardcoded.
+-- declare
+--   job number;
+-- begin
+--   dbms_job.submit(job, 'wm_process_queue(''/home/nsadmin/qmail/queue/new'');',
+-- 		  interval => 'sysdate() + 1/24/60');
+-- end;
+-- /
+
+
+-- Utility function to determine email address for a response.
+create function wm_response_address (integer) returns VARCHAR as '
+declare	
+        v_msg_id                alias for $1;
+        from_address            varchar(4000);
+        reply_to_address        varchar(4000);
+begin
+    select value into reply_to_address
+      from wm_headers
+      where msg_id = v_msg_id
+        and lower_name = ''reply-to'';
+
+    if found then 
+       return reply_to_address;
+    else 
+      select value into from_address
+        from wm_headers
+        where msg_id = v_msg_id
+          and lower_name = ''from'';
+      return from_address;
+    end if;
+end;
+' language 'plpgsql';
+
+create sequence wm_unique_file_id start 1;
+
+
+-- DanW - no can do intermedia in postgres.
+
+-- interMedia index on body of message
+-- create index wm_ctx_index on wm_messages (body)
+-- indextype is ctxsys.context parameters ('memory 250M');
+
+-- INSO filtered interMedia index for attachments.
+-- create index wm_att_ctx_index on wm_attachments (data)
+-- indextype is ctxsys.context parameters ('memory 250M filter ctxsys.inso_filter format column format');
+
+-- Trigger to update format column for INSO index.
+-- create or replace trigger wm_att_format_tr before insert on wm_attachments
+-- for each row
+-- declare
+--   content_type	varchar(100);
+-- begin
+--   content_type := lower(:new.content_type);
+--   if content_type like 'text/%' or content_type like 'application/msword%' then
+--     :new.format := 'text';
+--   else
+--     :new.format := 'binary';
+--   end if;
+-- end;
+-- /
+
+	
+
+  
+
+
+-- Resync the interMedia index every hour.
+
+-- declare
+--   job number;
+-- begin
+--   dbms_job.submit(job, 'ctx_ddl.sync_index(''wm_ctx_index'');',
+-- 		  interval => 'sysdate() + 1/24');
+--   dbms_job.submit(job, 'ctx_ddl.sync_index(''wm_att_ctx_index'');',
+-- 		  interval => 'sysdate() + 1/24');
+-- end;
+-- /
+
+-- Mailing list data model
+
+create table wm_lists (
+	list_name	varchar(100) not null primary key
+);
+
Index: web/openacs/www/doc/sql/wp.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/wp.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/wp.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,482 @@
+--
+-- Data model for WimpyPoint II.
+-- Even Wimpier than the Original(tm).
+--
+-- Jon Salz <jsalz@mit.edu>
+-- 13 Nov 1999
+--
+-- (c)1999 Jon Salz
+--
+
+-- Add WimpyPoint user group type.
+insert into user_group_types(group_type, pretty_name, pretty_plural, approval_policy, default_new_member_policy, group_module_administration)
+values('wp', 'WimpyPoint presentation', 'WimpyPoint presentations', 'closed', 'closed', 'none');
+
+create sequence wp_ids;
+
+-- Styles for presentations. We'll think more about this later if there's time -
+-- maybe allow ADPs for more flexibility.
+create table wp_styles (
+	style_id		integer primary key,
+	name			varchar(400) not null,
+	-- CSS source
+	css			lztext,
+	-- HTML style properties. Colors are in the form '192,192,255'.
+	text_color		varchar(20) check(text_color like '%,%,%'),
+	background_color	varchar(20) check(background_color like '%,%,%'),
+	background_image	varchar(200),
+	link_color		varchar(20) check(link_color like '%,%,%'),
+	alink_color		varchar(20) check(alink_color like '%,%,%'),
+	vlink_color		varchar(20) check(vlink_color like '%,%,%'),
+	-- public? Set directly by administrators - not accessible through web interface
+        public_p                boolean not null default 'f',
+	-- if provided by a user, his/her ID
+	owner			integer references users on delete cascade
+);
+
+create index wp_styles_by_owner on wp_styles(owner);
+
+-- Insert the magic, "default" style.
+insert into wp_styles(style_id, name, public_p, css)
+values(-1, 'Default (Plain)', 't',
+       'BODY { background-color: white; color: black } P { line-height: 120% } UL { line-height: 140% }');
+
+-- Images used for styles.
+create table wp_style_images (
+	style_id	integer not null references wp_styles on delete cascade,
+	lob			integer not null references lobs,
+--	image		blob not null,
+	file_size	integer not null,
+	file_name	varchar(200) not null,
+	mime_type	varchar(100) not null,
+	primary key (style_id, file_name)
+);
+
+create function wp_style_image_file_size(integer) returns integer
+as '
+begin
+  return count(file_size) from wp_style_images where style_id = $1;
+end;' language 'plpgsql';
+
+create index wp_style_images_idx on wp_style_images(style_id);
+
+-- DRB: PG doesn't allow this foreign key because it's non-standard.
+-- The names of the columns in both tables must be the same when
+-- you define a table-level foreign key.  I've fixed it using a
+-- trigger.
+
+--alter table wp_styles add 
+--	foreign key (style_id, background_image) references wp_style_images(style_id, file_name) on delete set null
+--;
+
+create trigger wp_style_images_trig before delete or update or insert
+on wp_style_images for each row execute procedure on_lob_ref();
+
+create function on_wp_style_image_delete() returns opaque as 
+'
+begin
+  update wp_styles set background_image = null
+  where style_id = old.style_id;
+  return old;
+end;' language 'plpgsql';
+
+create trigger wp_style_images_trig2 before delete on wp_style_images
+for each row execute procedure on_wp_style_image_delete();
+
+create table wp_presentations (
+	presentation_id		integer primary key,
+	-- The title of the presentation, as displayed to the user.
+	title			varchar(400) not null,
+	-- A signature on the bottom.
+	page_signature		varchar(200),
+	-- The copyright notice displayed on all pages.
+	copyright_notice	varchar(400),
+	-- Creation date and user. The creation user always has admin access to
+	-- a presentation.
+	creation_date		datetime not null,
+	creation_user		integer not null references users,
+	-- Style information.
+	style			integer references wp_styles on delete set null,
+	-- Show last-modified date for slides?
+	show_modified_p         boolean not null default 'f',
+	-- Can the public view the presentation?
+	public_p		boolean not null default 't',
+	-- Metainformation.
+	audience		varchar(4000),
+	background		varchar(4000),
+	-- The group used for access control on this presentation.
+	-- This group should have type 'wp' and group_name = our presentation_id.
+	group_id		integer references user_groups
+);
+
+create index wp_presentations_by_date on wp_presentations(creation_date);
+
+-- A list of checkpoints (frozen versions of a presentation).
+create table wp_checkpoints (
+	presentation_id		integer references wp_presentations on delete cascade not null,
+	checkpoint		integer not null,
+	description		varchar(200),
+	checkpoint_date		datetime,
+	primary key(presentation_id, checkpoint)
+);
+
+-- Slides belonging to presentations. When a slide is created, set checkpoint
+-- to the value of wp_presentations.checkpoint.
+create table wp_slides (
+	slide_id		integer primary key,
+	presentation_id 	integer references wp_presentations on delete cascade not null,
+	-- The slide_id which this was branched from. Used to preserve comments across
+	-- versions.
+	original_slide_id	integer references wp_slides on delete set null,
+	-- The minimum and maximum checkpoint for which a slide apply.
+        -- max_checkpoint = null is the "current" version. To search for
+	-- the slide used for checkpoint n, use condition
+	--   min_checkpoint <= n and (max_checkpoint is null or max_checkpoint >= n)
+	min_checkpoint		integer not null,
+	max_checkpoint		integer,
+	sort_key		numeric not null,
+	title			varchar(400),
+	preamble		lztext,
+	-- Store bullet items in a Tcl list.
+	bullet_items		lztext,
+	postamble		lztext,
+	include_in_outline_p	boolean not null default 't',
+	context_break_after_p	boolean not null default 'f',
+	modification_date	datetime not null,
+	-- Can override the style setting for the presentation.
+	style			integer references wp_styles
+);
+
+-- we use alter table because 6.5 doesn't know about foreign keys
+alter table wp_slides add
+        foreign key (presentation_id, min_checkpoint) references wp_checkpoints;
+
+alter table wp_slides add
+	foreign key (presentation_id, max_checkpoint) references wp_checkpoints;
+
+create function wp_slide_id_count(integer) returns integer 
+as '
+begin
+  return count(*) from wp_slides where presentation_id = $1
+  and max_checkpoint is null;
+end;' language 'plpgsql';
+
+create index wp_sorted_slides on wp_slides(presentation_id, max_checkpoint, sort_key);
+
+-- Keeps track of the sorting order for frozen sets of slides.
+create table wp_historical_sort (
+	slide_id	integer references wp_slides on delete cascade not null,
+        presentation_id integer not null,
+        checkpoint      integer not null,        
+	sort_key	numeric not null,
+	primary key (slide_id, checkpoint),
+	foreign key (presentation_id, checkpoint) references wp_checkpoints on delete cascade
+);
+
+create index wp_sorted_historical_slides on wp_historical_sort(presentation_id, checkpoint, sort_key);
+
+-- File attachments (including images).
+create table wp_attachments (
+	attach_id	integer primary key,
+	slide_id	integer references wp_slides on delete cascade not null,
+	lob			integer not null references lobs,
+--	attachment	blob not null,
+	file_size	integer not null,
+	file_name	varchar(200) not null,
+	mime_type	varchar(100) not null,
+	-- Display how? null for a link
+        display         varchar(20) check(display in ('preamble', 'bullets', 'postamble', 'top', 'after-preamble', 'after-bullets', 'bottom'))
+);
+
+create trigger wp_attachments_trig before delete or update or insert
+on wp_attachments for each row execute procedure on_lob_ref();
+
+create index wp_attachments_by_slide on wp_attachments(slide_id);
+
+-- A "ticket" which can be redeemed for an ACL entry. Useful for inviting
+-- someone to work on a presentation: we generate a ticket, send it to the
+-- invitee (along with the secret code), and when the user access WimpyPoint we
+-- grant him access based on issued tickets.
+create table wp_user_access_ticket (
+	invitation_id   integer primary key,
+	presentation_id	integer references wp_presentations on delete cascade not null,
+	role		varchar(10) not null check (role in('read','write','admin')),
+	name            varchar(200) not null,
+	email		varchar(200) not null,
+	-- secret is null if already redeemed
+	secret		varchar(50),
+        invite_date     datetime not null,
+	invite_user     integer references users on delete cascade not null
+);
+
+-- Functions.
+
+create function wp_real_user_p(numeric) returns boolean
+AS '
+DECLARE
+  n_slides alias for $1;
+BEGIN
+  IF n_slides < 5 THEN
+     return ''f'';
+  ELSE
+     return ''t'';
+  END IF;
+END;' language 'plpgsql';
+
+create function wp_previous_slide(numeric, integer, integer) returns integer
+as '
+declare
+  v_sort_key alias for $1;
+  v_presentation_id alias for $2;
+  v_checkpoint alias for $3;
+  ret integer;
+begin
+  if v_checkpoint < 0 then
+    select slide_id into ret
+    from   wp_slides
+    where  presentation_id = v_presentation_id
+    and    max_checkpoint is null
+    and    sort_key = (select max(sort_key) from wp_slides
+                       where  presentation_id = v_presentation_id
+                       and    max_checkpoint is null
+                       and    sort_key < v_sort_key);
+  else
+    select slide_id into ret
+    from   wp_historical_sort
+    where  presentation_id = v_presentation_id
+    and    checkpoint = v_checkpoint
+    and    sort_key = (select max(sort_key) from wp_historical_sort
+                       where  presentation_id = v_presentation_id
+                       and    checkpoint = v_checkpoint
+                       and    sort_key < v_sort_key);
+  end if;
+  return ret;
+end;' language 'plpgsql';
+
+create function wp_next_slide(numeric, integer, integer) returns integer
+as '
+declare
+  v_sort_key alias for $1;
+  v_presentation_id alias for $2;
+  v_checkpoint alias for $3;
+  ret integer;
+begin
+  if v_checkpoint < 0 then
+    select slide_id into ret
+    from   wp_slides
+    where  presentation_id = v_presentation_id
+    and    max_checkpoint is null
+    and    sort_key = (select min(sort_key) from wp_slides
+                       where  presentation_id = v_presentation_id
+                       and    max_checkpoint is null
+                       and    sort_key > v_sort_key);
+  else
+    select slide_id into ret
+    from   wp_historical_sort
+    where  presentation_id = v_presentation_id
+    and    checkpoint = v_checkpoint
+    and    sort_key = (select min(sort_key) from wp_historical_sort
+                       where  presentation_id = v_presentation_id
+                       and    checkpoint = v_checkpoint
+                       and    sort_key > v_sort_key);
+  end if;
+  return ret;
+end;' language 'plpgsql';
+
+-- Turns the read/write/admin role predicate into a numeric (used for ordering).
+-- Higher means more access.
+
+-- DRB: Function handler in PG can't handle return of NULL, so we'll
+-- return 0 instead
+
+create function wp_role_order(varchar) returns integer
+as '
+declare
+  v_role alias $1;
+begin
+  if v_role = ''read'' then
+    return 1;
+  elsif v_role = ''write'' then
+    return 2;
+  elsif v_role = ''admin'' then
+    return 3;
+  end if;
+
+  return 0;
+end;' language 'plpgsql';
+
+-- Given a min_checkpoint/max_checkpoint pair, determines whether the slide
+-- refers to a particular checkpoint. A max_checkpoint of null is considered
+-- infinitely high (i.e., the very latest).
+create function wp_between_checkpoints_p(integer, integer, integer)
+returns char as '
+declare
+  v_checkpoint alias for $1;
+  v_min_checkpoint alias for $2;
+  v_max_checkpoint alias for $3;
+begin
+  if v_checkpoint >= v_min_checkpoint AND (v_max_checkpoint < 0 OR v_checkpoint < v_max_checkpoint) then
+    return ''t'';
+  end if;
+
+  return ''f'';
+end;' language 'plpgsql';
+
+-- Returns the access rights for a presentation. Never returns an access
+-- level lower than v_role (e.g., if v_role = 'write' but we only have
+-- read access, returns null).
+
+-- DRB: We'll return '' for PG
+
+create function wp_access(integer, integer, varchar, boolean, integer, integer)
+returns varchar as '
+declare
+  v_presentation_id alias for $1;
+  v_user_id alias for $2;
+  v_role alias for $3;
+  v_public_p alias for $4;
+  v_creation_user alias for $5;
+  v_group_id alias for $6;
+  a_role user_group_map.role%TYPE;
+begin
+  if v_creation_user = v_user_id then
+    return ''admin'';
+  end if;
+  select role into a_role
+    from user_group_map
+    where group_id = v_group_id
+    and user_id = v_user_id;
+  if not found then
+    a_role := '''';
+  end if;
+  if v_role = ''write'' and a_role = ''read'' then
+    a_role := '''';
+  end if;
+  if v_role = ''admin'' and a_role <> ''admin'' then
+    a_role := '''';
+  end if;
+  if v_role = ''read'' and v_public_p = ''t'' and a_role = '''' then
+    a_role := ''read'';
+  end if;
+  return a_role;
+end;' language 'plpgsql';
+
+-- Reverts to a checkpoint in a presentation.
+create function wp_revert_to_checkpoint(integer, integer) returns integer
+as '
+declare
+   v_presentation_id alias for $1;
+   v_checkpoint alias for $2;
+  duplicate_sort_keys integer;
+begin
+  -- Fix old versions of slides. If min_checkpoint <= v_checkpoint < max_checkpoint,
+  -- the slide is now the most recent.
+  update wp_slides
+    set max_checkpoint = null
+    where presentation_id = v_presentation_id
+    and wp_between_checkpoints_p(v_checkpoint, min_checkpoint, max_checkpoint) = ''t'';
+  -- Restore sort_keys from wp_historical sort.
+  update wp_slides
+    set sort_key = (select sort_key
+                    from wp_historical_sort h
+                    where h.slide_id = wp_slides.slide_id
+                    and h.checkpoint = v_checkpoint)
+    where presentation_id = v_presentation_id
+    and max_checkpoint is null
+    and min_checkpoint <= v_checkpoint;
+  -- Delete wp_historical_sort info for the current checkpoint.
+  delete from wp_historical_sort
+    where presentation_id = v_presentation_id
+    and checkpoint = v_checkpoint;
+  -- Delete hosed slides.
+  delete from wp_slides
+    where presentation_id = v_presentation_id
+    and min_checkpoint > v_checkpoint;
+  -- Delete recent checkpoints. "on delete cascade" causes appropriate rows
+  -- in wp_historical_sort to be hosed. Gotta love cascading deletes!
+  delete from wp_checkpoints
+    where presentation_id = v_presentation_id
+    and checkpoint > v_checkpoint;
+  -- A little sanity checking: make sure sort_keys are unique in the most recent
+  -- version now. Use a self-join.
+
+  return 0::integer;
+
+end;' language 'plpgsql';
+
+-- DRB: not sure I can raise an exception in PG, need to check it out
+--  select  count(*) into duplicate_sort_keys
+--   from  wp_slides s1, wp_slides s2
+--    where s1.presentation_id = v_presentation_id
+--    and   s2.presentation_id = v_presentation_id
+--    and   s1.max_checkpoint is null
+--    and   s2.max_checkpoint is null
+--    and   s1.sort_key = s2.sort_key
+--    and   s1.slide_id <> s2.slide_id;
+--  if duplicate_sort_keys <> 0 then
+--    raise_application_error(-20000, ''Duplicate sort_keys'');
+--  end if;
+
+-- Sets a checkpoint in a presentation.
+create function wp_set_checkpoint(integer, varchar) returns integer
+as '
+declare
+   v_presentation_id alias for $1;
+   v_description alias for $2;
+  latest_checkpoint wp_checkpoints.checkpoint%TYPE;
+begin
+  select max(checkpoint) into latest_checkpoint
+    from  wp_checkpoints
+    where presentation_id = v_presentation_id;
+  update wp_checkpoints
+    set   description = v_description, checkpoint_date = sysdate()
+    where presentation_id = v_presentation_id
+    and   checkpoint = latest_checkpoint;
+  insert into wp_checkpoints(presentation_id, checkpoint)
+    values(v_presentation_id, latest_checkpoint + 1);
+  -- Save sort order.
+  insert into wp_historical_sort(slide_id, presentation_id, checkpoint, sort_key)
+    select slide_id, v_presentation_id, latest_checkpoint, sort_key
+    from   wp_slides
+    where  presentation_id = v_presentation_id
+    and    max_checkpoint is null;
+  return 0::integer;
+end;' language 'plpgsql';
+
+create function wp_migrate_slide(integer, integer) returns integer
+as '
+declare
+  v_presentation_id alias for $1;
+  v_slide_id alias for $2;
+  latest_checkpoint wp_checkpoints.checkpoint%TYPE;
+  should_migrate integer;
+  new_slide_id integer;
+begin
+  select max(checkpoint) into latest_checkpoint
+    from  wp_checkpoints
+    where presentation_id = v_presentation_id;
+  select count(*) into should_migrate
+    from wp_slides
+    where slide_id = v_slide_id
+    and min_checkpoint < (select max(checkpoint) from wp_checkpoints where presentation_id = v_presentation_id)
+    and max_checkpoint is null;
+  if should_migrate > 0 then
+    select nextval(''wp_ids'') into new_slide_id;
+    update wp_slides
+      set max_checkpoint = latest_checkpoint
+      where slide_id = v_slide_id;
+    insert into wp_slides(slide_id, presentation_id, modification_date, sort_key, min_checkpoint, include_in_outline_p, context_break_after_p,
+                          title, preamble, bullet_items, postamble, original_slide_id)
+    select new_slide_id, presentation_id, modification_date, sort_key, latest_checkpoint, include_in_outline_p, context_break_after_p,
+           title, preamble, bullet_items, postamble, coalesce(original_slide_id, slide_id)
+      from wp_slides
+      where slide_id = v_slide_id;
+    insert into wp_attachments(attach_id, slide_id, attachment, file_size, file_name, mime_type, display)
+      select nextval(''nextval''), new_slide_id, attachment, file_size, file_name, mime_type, display
+        from   wp_attachments
+        where  slide_id = v_slide_id;
+    return new_slide_id;
+  else
+    return v_slide_id;
+  end if;
+end;' language 'plpgsql';
Index: web/openacs/www/doc/sql/XMLPublisher/XMLPublisher.class
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/XMLPublisher/XMLPublisher.class,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/XMLPublisher/XMLPublisher.class	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,62 @@
+������-��������������������������������������������������������
+��H
+��H
+��H
+��H
+��H
+��I
+��J
+�
+�K
+��K
+��K
+��L
+��M��M
+��N
+��O
+��P��P
+��Q
+��R	�
+�S��T
+��U
+�	�U
+��V
+��W
+��X��Y
+��Z��[
+��\��]
+��^
+��_
+��`
+��a
+��b��c��d
+��e
+��f	��g	��h	��i	��j���q���y���z������{���������������q���~���n�������o���q���l���k���p���s���}���r���x���|���w���q�����������v���t���u�������m�����������������()Ljava/io/Reader;�()Ljava/io/Writer;�()Ljava/lang/String;�()Ljava/sql/Connection;�()Ljava/sql/ResultSet;�$()Loracle/xml/parser/v2/XMLDocument;�()V�()Z�(I)Ljava/lang/Object;�(II)V�(ILjava/lang/String;)V�(Ljava/io/OutputStream;)V�(Ljava/io/PrintWriter;)V�(Ljava/io/Reader;)V�!(Ljava/io/Reader;Ljava/net/URL;)V�(Ljava/io/Writer;)V�,(Ljava/lang/String;)Ljava/lang/StringBuffer;�0(Ljava/lang/String;)Ljava/sql/PreparedStatement;�8(Ljava/lang/String;)Loracle/xml/parser/v2/XSLStylesheet;�)(Ljava/lang/String;)Lorg/w3c/dom/Element;�(Ljava/lang/String;)V�.(Ljava/sql/PreparedStatement;)Ljava/io/Reader;�X(Loracle/xml/parser/v2/XMLDocument;Ljava/lang/String;)Loracle/xml/parser/v2/XMLDocument;�j(Loracle/xml/parser/v2/XMLDocument;Loracle/xml/parser/v2/XSLStylesheet;)Loracle/xml/parser/v2/XMLDocument;�f(Loracle/xml/parser/v2/XSLStylesheet;Loracle/xml/parser/v2/XMLDocument;)Lorg/w3c/dom/DocumentFragment;�&(Lorg/w3c/dom/Node;)Lorg/w3c/dom/Node;�(Z)V�<clinit>�<init>�Code�Could not access CLOB�
+Exceptions�LineNumberTable�Ljava/io/PrintStream;�Ljava/lang/String;�Ljava/sql/PreparedStatement;�
+SourceFile�XMLPublisher�XMLPublisher.java�append�appendChild�applyXSL�close�
+createElement�defaultConnection�err�executeQuery�flush�getCharacterOutputStream�getCharacterStream�getDocument�	getObject�getXSLStylesheet�html� http://w3.org/XSL/Transform/1.0/�java/io/PrintWriter�java/io/Reader�java/io/Writer�java/lang/Exception�java/lang/Object�java/lang/StringBuffer�java/lang/System�java/lang/Throwable�java/net/URL�java/sql/Connection�java/sql/PreparedStatement�java/sql/ResultSet�next�oracle/jdbc/driver/OracleDriver�oracle/sql/CLOB�oracle/xml/parser/v2/DOMParser� oracle/xml/parser/v2/XMLDocument�oracle/xml/parser/v2/XMLNode�oracle/xml/parser/v2/XMLParser�!oracle/xml/parser/v2/XSLProcessor�"oracle/xml/parser/v2/XSLStylesheet�org/w3c/dom/Node�parse�prepareStatement�print�printStackTrace�
+processXSL�readOneCLOB�(select doc from xmldocs where doc_id = ?�*select doc from xsldocs where doc_name = ?�setErrorStream�setInt�	setString�showWarnings�toString�xmlQueryString�xmlStmt�xslQueryString�xslStmt!������
+�������
+�������
+�������
+�����������q������������6��F��D��Y����.K*��F��:���G*��D��:���E��K*��<���
+�-�0�
+������2�����������
+��
+����!��-��0��1��5�
+����q�����������*���������������
+�	���u�������	������E��@���E��0�M,��8���
+��
+Y��#�,��6���N-��4:��Y��:��9��+,��,���5:+��):��E��0�M,��8�W,��6���N-��3:��Y��":��;��1��2,��,����������Z����%�
+�'��)��*�&�,�1�.�7�0�@�1�G�2�L�3�R�5�Y�7�a�:�j�;�q�<�|�>���?���@���A���C���I���#�������
+�	����������'�����+��7M*,��*���������
+����O��Q�������
+�	����������y�����A��Y�� M,��B,��/��?,+*��=N��Y��:��-:��'W-��(�W���������&�	���W��Y�
+�Z��\��^�$�`�-�a�5�c�>�e�������
+�	���}������i�����9��G*��A���G��>L��Y��Y��$*��&��C��%M��Y+,��!N+��+-�������������k�
+�l��o�(�n�)�q�3�s�7�u�������
+�
+����������b�����2*��0�L+��8���
+��
+Y��#�+��6���M,��4N+��,�-�������������{��}��~����%���*���0���������
+��������
\ No newline at end of file
Index: web/openacs/www/doc/sql/XMLPublisher/XMLPublisher.java
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/XMLPublisher/XMLPublisher.java,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/XMLPublisher/XMLPublisher.java	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,143 @@
+import java.io.*;
+import java.net.*;
+import java.sql.*; 
+import java.math.*;
+import java.util.*;
+
+import org.w3c.dom.*;
+
+import oracle.sql.*;
+import oracle.xml.parser.v2.*;
+import oracle.jdbc.driver.*;
+ 
+public abstract class XMLPublisher { 
+
+  private static PreparedStatement xslStmt, xmlStmt;
+
+  private static String xslQueryString = 
+    "select doc from xsldocs where doc_name = ?";
+  private static String xmlQueryString =
+    "select doc from xmldocs where doc_id = ?";
+
+  static {
+
+    try {  
+
+      Connection conn = new OracleDriver().defaultConnection();
+      xslStmt = conn.prepareStatement(xslQueryString);
+      xmlStmt = conn.prepareStatement(xmlQueryString);
+
+    } catch (Exception e) {
+      e.printStackTrace();
+    }
+  }
+
+  public static void applyXSL(int doc_id, String xslName) throws Exception {
+
+    // Read in the XML document
+
+    xmlStmt.setInt(1, doc_id);
+
+    ResultSet rs = xmlStmt.executeQuery();
+    
+    if (! rs.next())
+      throw new Exception("Could not access CLOB");
+
+    oracle.sql.CLOB clob = (CLOB) rs.getObject(1);
+
+    Reader in = clob.getCharacterStream();
+
+    DOMParser parser = new DOMParser();
+    parser.parse(in);
+    in.close();
+    rs.close();
+
+    XMLDocument xml = parser.getDocument();
+
+    // Apply the XSL transformation
+
+    xml = applyXSL(xml, xslName);
+
+    // Write the transformed document back to the temporary table
+
+    rs = xmlStmt.executeQuery();
+    rs.next();
+    clob = (CLOB) rs.getObject(1);
+
+    Writer writer = clob.getCharacterOutputStream();
+    PrintWriter pw = new PrintWriter(writer);
+    xml.print(pw);
+    writer.flush();
+    writer.close();
+    rs.close();
+  }
+
+  public static XMLDocument applyXSL(XMLDocument xml, String xslName) 
+    throws Exception {
+
+    XSLStylesheet xsl = getXSLStylesheet(xslName);
+
+    return applyXSL(xml, xsl);
+  }
+
+  public static XMLDocument applyXSL(XMLDocument xml, XSLStylesheet xsl) 
+    throws Exception {
+
+    XSLProcessor processor = new XSLProcessor();
+
+    processor.showWarnings(true);
+    processor.setErrorStream(System.err);
+
+    DocumentFragment result = processor.processXSL(xsl, xml);
+
+    XMLDocument out = new XMLDocument();
+
+    Element root = out.createElement("html");
+    out.appendChild(root);
+
+    root.appendChild(result);
+    
+    return out;
+  }
+
+  public static XSLStylesheet getXSLStylesheet(String name)
+    throws Exception {
+
+    xslStmt.setString(1, name);
+    Reader in = readOneCLOB(xslStmt);
+
+    URL xslURL = 
+      new URL("http://w3.org/XSL/Transform/1.0/" + name);
+
+    XSLStylesheet xsl = new XSLStylesheet(in, xslURL);
+
+    in.close();
+
+    return xsl;
+  }
+
+  private static Reader readOneCLOB(PreparedStatement stmt) 
+    throws Exception {
+
+    ResultSet rs = stmt.executeQuery();
+    
+    if (! rs.next())
+      throw new Exception("Could not access CLOB");
+
+    oracle.sql.CLOB clob = (CLOB) rs.getObject(1);
+    Reader in = clob.getCharacterStream();
+
+    rs.close();
+
+    return in;
+  }
+}
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/doc/sql/XMLPublisher/XMLPublisher.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/XMLPublisher/XMLPublisher.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/XMLPublisher/XMLPublisher.sql	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,7 @@
+create or replace procedure apply_xsl (doc_id number, xsl_name varchar2) 
+as language java name 'XMLPublisher.applyXSL(int, java.lang.String)';
+/
+show errors
+commit;
+
+
Index: web/openacs/www/doc/sql/XMLPublisher/readme.txt
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/doc/sql/XMLPublisher/readme.txt,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/doc/sql/XMLPublisher/readme.txt	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,4 @@
+To use this utility:
+
+$ loadjava -user user/passwd XMLPublisher.class
+$ sqlplus user/passwd < XMLPublisher.sql
Index: web/openacs/www/dw/defs.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/dw/defs.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/dw/defs.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,107 @@
+# defs.tcl,v 1.1.1.1.4.1 2000/02/03 09:47:14 ron Exp
+# definitions that are useful for data warehousing
+# defined by philg@mit.edu on December 25, 1998
+
+# this is the biggest limitation of the system right here; you can 
+# only really use it effectively if you can build one big view from all
+# of your tables
+
+proc_doc dw_table_name {} "Returns the name of the table that we typically use for data warehouse queries; may vary by user." {
+    # you will probably want to edit this to run ad_verify_and_get_user_id
+    # then return a particular view that is reasonable for that user
+    return [ad_parameter DefaultTable dw "ad_hoc_query_view"]
+}
+
+proc dw_system_name {} {
+    return [ad_parameter SystemName dw "[ad_system_name] data warehouse"]
+}
+
+proc_doc dw_table_columns {db table} "Returns a list of lists, one for each column in a table.  Each sublist is a column name and a data type." {
+    set size [ns_column count $db $table]
+    set list_of_lists [list]
+    for {set i 0} {$i < $size} {incr i} {
+	set sublist [list [ns_column name $db $table $i] [ns_column typebyindex $db $table $i]]
+	lappend list_of_lists $sublist
+    }
+    return $list_of_lists
+}
+
+proc_doc dw_build_sql {db query_id} "Returns the SQL code for a query, based on information in the query_columns table.  Returns a list of \$sql \$select_list_items \$order_clauses.    Returns 0 if there aren't enough columns specified to form a query." {
+    set select_list_items [list]
+    set group_by_items [list]
+
+    set selection [ns_db select $db "select column_name, pretty_name
+    from query_columns 
+    where query_id = $query_id
+    and what_to_do = 'select_and_group_by'"]
+
+    while { [ns_db getrow $db $selection] } {
+	set_variables_after_query
+	if [empty_string_p $pretty_name] {
+	    lappend select_list_items $column_name
+	} else {
+	    lappend select_list_items "$column_name as \"$pretty_name\""
+	}
+	lappend group_by_items $column_name
+    }
+
+    set selection [ns_db select $db "select column_name, pretty_name, value1
+    from query_columns 
+    where query_id = $query_id
+    and what_to_do = 'select_and_aggregate'"]
+
+    while { [ns_db getrow $db $selection] } {
+	set_variables_after_query
+	if [empty_string_p $pretty_name] {
+	    lappend select_list_items "${value1}($column_name)"
+	} else {
+	    lappend select_list_items "${value1}($column_name) as \"$pretty_name\""
+	}
+    }
+
+    set selection [ns_db select $db "select column_name, value1, value2
+    from query_columns 
+    where query_id = $query_id
+    and what_to_do = 'restrict_by'"]
+
+    set where_clauses [list]
+
+    while { [ns_db getrow $db $selection] } {
+	set_variables_after_query
+	lappend where_clauses "$column_name $value2 '[DoubleApos $value1]'"
+    }
+
+
+    set selection [ns_db select $db "select column_name
+    from query_columns 
+    where query_id = $query_id
+    and what_to_do = 'order_by'"]
+
+    set order_clauses [list]
+
+    while { [ns_db getrow $db $selection] } {
+	set_variables_after_query
+	lappend order_clauses "$column_name"
+    }
+
+    if { [llength $select_list_items] == 0 } {
+	return 0
+    }
+
+    set sql "SELECT [join $select_list_items ", "]
+FROM [dw_table_name]\n"
+
+    if { [llength $where_clauses] > 0 } {
+	append sql "WHERE [join $where_clauses " AND "]\n"
+    }
+
+    if { [llength $group_by_items] > 0 } {
+	append sql "GROUP BY [join $group_by_items ", "]\n"
+    }
+
+    if { [llength $order_clauses] > 0 } {
+	append sql "ORDER BY [join $order_clauses ", "]"
+    }
+
+    return [list $sql $select_list_items $order_clauses]
+}
Index: web/openacs/www/dw/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/dw/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/dw/index.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,32 @@
+# index.tcl,v 1.1.1.1.4.1 2000/02/03 09:47:15 ron Exp
+ReturnHeaders
+
+ns_write "
+[ad_header "Query [dw_system_name]"]
+
+<h2>Query</h2>
+
+<a href=/>[dw_system_name]</a>
+
+<hr>
+
+<ul>
+<li><a href=\"query-new.tcl\">define a new query</a>
+
+<p>
+"
+
+set db [ns_db gethandle]
+set selection [ns_db select $db "select * from queries order by definition_time desc"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    ns_write "<li><a href=\"query.tcl?query_id=$query_id\">$query_name</a>\n"
+}
+
+ns_write "
+
+</ul>
+
+[ad_footer]
+"
Index: web/openacs/www/dw/query-add-column-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/dw/query-add-column-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/dw/query-add-column-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,85 @@
+# query-add-column-2.tcl,v 1.1.1.1.4.1 2000/02/03 09:47:16 ron Exp
+set_the_usual_form_variables
+
+# query_id, column_name, what_to_do
+
+validate_integer query_id $query_id
+
+set exception_count 0
+set exception_text ""
+
+if { ![info exists column_name] || [empty_string_p $column_name] } {
+    incr exception_count
+    append exception_text "<li>You must pick a column.\n"
+}
+
+if { ![info exists what_to_do] || [empty_string_p $what_to_do] } {
+    incr exception_count
+    append exception_text "<li>You have to tell us what you want done with the column.\n"
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+ReturnHeaders
+
+set db [ns_db gethandle] 
+
+ns_write "
+[ad_header "Add $column_name"]
+
+<h2>Add $column_name</h2>
+
+to <a href=\"query.tcl?query_id=$query_id\">[database_to_tcl_string $db "select query_name from queries where query_id = $query_id"]</a>
+
+<hr>
+
+<form method=POST action=\"query-add-column-3.tcl\">
+[export_form_vars query_id column_name what_to_do]
+"
+
+if { $what_to_do == "select_and_aggregate" } {
+    ns_write "Pick an aggregation method for $column_name : <select name=value1> 
+<option>sum
+<option>avg
+<option>max
+<option>min
+<option>count
+</select>
+<p>
+"
+}
+
+
+if { $what_to_do == "select_and_group_by" || $what_to_do == "select_and_aggregate" } {
+    ns_write "If you don't wish your report to be headed by
+\"$column_name\", you can choose a different title:
+<input type=text name=pretty_name size=30>
+<P>
+"
+}
+
+if { $what_to_do == "restrict_by" } {
+    ns_write "Restrict reporting to sales where $column_name
+<select name=value2>
+<option>=</option>
+<option value=\">\">&gt;</option>
+<option value=\"<\">&lt;</option>
+</select>
+<input type=text size=15 name=value1>\n"
+}
+
+
+ns_write "
+
+<br>
+<br>
+
+<center>
+<input type=submit value=\"Confirm\">
+</center>
+</form>
+[ad_footer]
+"
Index: web/openacs/www/dw/query-add-column-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/dw/query-add-column-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/dw/query-add-column-3.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,30 @@
+# query-add-column-3.tcl,v 1.1.1.1.4.1 2000/02/03 09:47:18 ron Exp
+set_the_usual_form_variables
+
+# query_id, column_name, what_to_do, maybe pretty_name, value1, value2
+
+set target_columns [list query_id column_name what_to_do]
+set target_values [list $query_id "'$QQcolumn_name'" "'$QQwhat_to_do'"]
+
+if { [info exists pretty_name] && ![empty_string_p $pretty_name] } {
+    lappend target_columns pretty_name
+    lappend target_values "'$QQpretty_name'"
+}
+
+if { [info exists value1] && ![empty_string_p $value1] } {
+    lappend target_columns value1
+    lappend target_values "'$QQvalue1'"
+}
+
+if { [info exists value2] && ![empty_string_p $value2] } {
+    lappend target_columns value2
+    lappend target_values "'$QQvalue2'"
+}
+
+set db [ns_db gethandle]
+
+ns_db dml $db "insert into query_columns ([join $target_columns ", "]) 
+values 
+([join $target_values ", "])"
+
+ns_returnredirect "query.tcl?query_id=$query_id"
Index: web/openacs/www/dw/query-add-column.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/dw/query-add-column.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/dw/query-add-column.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,55 @@
+# query-add-column.tcl,v 1.1.1.1.4.1 2000/02/03 09:47:19 ron Exp
+set_the_usual_form_variables
+
+# query_id 
+
+validate_integer query_id $query_id
+
+ReturnHeaders
+
+set db [ns_db gethandle] 
+
+ns_write "
+[ad_header "Add Column"]
+
+<h2>Add Column</h2>
+
+to <a href=\"query.tcl?query_id=$query_id\">[database_to_tcl_string $db "select query_name from queries where query_id = $query_id"]</a>
+
+<hr>
+
+<form method=POST action=\"query-add-column-2.tcl\">
+[export_form_vars query_id]
+<table>
+<tr><th>Which Column<th>What to do with it</tr>
+<tr>
+<td>
+<select name=column_name size=8>
+"
+
+set list_of_lists [dw_table_columns $db [dw_table_name]]
+
+foreach sublist $list_of_lists {
+    ns_write "<option>[lindex $sublist 0]\n"
+}
+
+ns_write "
+</select>
+<td>
+<select name=what_to_do size=5>
+<option value=\"select_and_group_by\">Select and Group By
+<option value=\"select_and_aggregate\">Select and Aggregate (sum or average)
+<option value=\"restrict_by\">Restrict By
+<option value=\"order_by\">Order By
+<option value=\"subtotal_when_changes\">Subtotal when changes
+
+</select>
+</tr>
+</table>
+<center>
+<input type=submit value=\"Proceed\">
+</center>
+</form>
+
+[ad_footer]
+"
Index: web/openacs/www/dw/query-add-order-by.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/dw/query-add-order-by.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/dw/query-add-order-by.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,19 @@
+# query-add-order-by.tcl,v 1.1.1.1.4.1 2000/02/03 09:47:20 ron Exp
+# we get called from a query execution, so we add the order by and
+# redirect
+
+set_the_usual_form_variables
+
+# query_id, column_name
+
+validate_integer query_id $query_id
+
+set db [ns_db gethandle]
+
+ns_db dml $db "insert into query_columns 
+(query_id, column_name, what_to_do)
+values
+($query_id, '$QQcolumn_name', 'order_by')"
+
+ns_returnredirect "query-execute.tcl?query_id=$query_id"
+
Index: web/openacs/www/dw/query-delete-column.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/dw/query-delete-column.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/dw/query-delete-column.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,19 @@
+# query-delete-column.tcl,v 1.1.1.1.4.1 2000/02/03 09:47:22 ron Exp
+set_the_usual_form_variables
+
+# query_id, rowid
+# we use rowid rather than column_name because the same column could be spec'd
+# in a query twice for different reasons (or maybe even for the same reason)
+
+validate_integer query_id $query_id
+
+set db [ns_db gethandle]
+
+if { [database_to_tcl_string $db "select count(*) from query_columns where query_id = $query_id and rowid = '$QQrowid'"] == 0 } {
+    ad_return_error "Could not find column" "Could not find a column for this query; either the column was already deleted, something is wrong with your browser, or something is wrong with our programming."
+    return
+}
+
+ns_db dml $db "delete from query_columns where query_id = $query_id and rowid = '$QQrowid'"
+
+ns_returnredirect "query.tcl?query_id=$query_id"
Index: web/openacs/www/dw/query-delete-sql-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/dw/query-delete-sql-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/dw/query-delete-sql-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,12 @@
+# query-delete-sql-2.tcl,v 1.1.1.1.4.1 2000/02/03 09:47:23 ron Exp
+set_the_usual_form_variables
+
+# query_id
+
+validate_integer query_id $query_id
+
+set db [ns_db gethandle]
+
+ns_db dml $db "update queries set query_sql = NULL where query_id = $query_id"
+
+ns_returnredirect "query.tcl?[export_url_vars query_id]"
Index: web/openacs/www/dw/query-delete-sql.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/dw/query-delete-sql.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/dw/query-delete-sql.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,52 @@
+# query-delete-sql.tcl,v 1.1.1.1.4.1 2000/02/03 09:47:24 ron Exp
+set_the_usual_form_variables
+
+# query_id
+
+validate_integer query_id $query_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select query_name, definition_time, query_sql, first_names || ' ' || last_name as query_owner 
+from queries, users
+where query_id = $query_id
+and query_owner = users.user_id"]
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "
+[ad_header "Confirm deletion of hand-edited SQL for $query_name"]
+
+<h2>Confirm Deletion</h2>
+
+of hand-edited SQL for <a href=\"query.tcl?query_id=$query_id\">$query_name</a> 
+defined by $query_owner on [util_IllustraDatetoPrettyDate $definition_time]
+
+<hr>
+
+"
+
+if [empty_string_p $query_sql] {
+    ns_write "Hey, as far as we can tell, there is no hand-edited SQL for this query!\n[ad_footer]"
+    return 
+} 
+
+ns_write "<blockquote>
+<pre><code>
+$query_sql
+</code></pre>
+</blockquote>
+
+<br>
+<br>
+
+<form method=POST action=\"query-delete-sql-2.tcl\">
+[export_form_vars query_id]
+<center>
+<input type=submit value=\"Yes I really want to delete this\">
+</center>
+</form>
+
+[ad_footer]
+"
Index: web/openacs/www/dw/query-edit-sql-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/dw/query-edit-sql-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/dw/query-edit-sql-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,13 @@
+# query-edit-sql-2.tcl,v 1.1.1.1.4.1 2000/02/03 09:47:26 ron Exp
+set_the_usual_form_variables
+
+# query_id, query_sql 
+
+validate_integer query_id $query_id
+
+set db [ns_db gethandle]
+
+ns_db dml $db "update queries set query_sql = '$QQquery_sql' where query_id = $query_id"
+
+ns_returnredirect "query.tcl?[export_url_vars query_id]"
+
Index: web/openacs/www/dw/query-edit-sql.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/dw/query-edit-sql.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/dw/query-edit-sql.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,63 @@
+# query-edit-sql.tcl,v 1.1.1.1.4.1 2000/02/03 09:47:27 ron Exp
+set_the_usual_form_variables
+
+# query_id
+
+validate_integer query_id $query_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select query_name, definition_time, query_sql, first_names || ' ' || last_name as query_owner 
+from queries, users
+where query_id = $query_id
+and query_owner = users.user_id"]
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "
+[ad_header "Hand editing SQL for $query_name"]
+
+<h2>Hand editing SQL</h2>
+
+for <a href=\"query.tcl?query_id=$query_id\">$query_name</a> 
+defined by $query_owner on [util_IllustraDatetoPrettyDate $definition_time]
+
+<hr>
+
+"
+
+if [empty_string_p $query_sql] {
+    # this is the first time the user has hand-edited the SQL; generate it
+    set query_info [dw_build_sql $db $query_id]
+    set query_sql [lindex $query_info 0]
+} 
+
+ns_write "
+<form method=POST action=\"query-edit-sql-2.tcl\">
+[export_form_vars query_id]
+<textarea name=query_sql rows=10 cols=70>
+$query_sql
+</textarea>
+
+<br>
+<br>
+<center>
+<input type=submit value=\"Update\">
+</center>
+</form>
+"
+
+if { [database_to_tcl_string $db "select count(*) from query_columns where query_id = $query_id"] > 0 } {
+    ns_write "<p>
+
+If you wish to go back to the automatically generated query, you can
+<a href=\"query-delete-sql.tcl?query_id=$query_id\">delete this
+hand-edited SQL</a>.
+"
+}
+
+ns_write "
+
+[ad_footer]
+"
Index: web/openacs/www/dw/query-execute.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/dw/query-execute.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/dw/query-execute.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,90 @@
+# query-execute.tcl,v 1.1.1.1.4.1 2000/02/03 09:47:28 ron Exp
+set_the_usual_form_variables
+
+# query_id
+
+validate_integer query_id $query_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select query_name, definition_time, query_sql, first_names || ' ' || last_name as query_owner 
+from queries, users
+where query_id = $query_id
+and query_owner = users.user_id"]
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "
+[ad_header "Executing $query_name"]
+
+<h2>Executing</h2>
+
+<a href=\"query.tcl?query_id=$query_id\">$query_name</a> defined by $query_owner on [util_IllustraDatetoPrettyDate $definition_time]
+
+<hr>
+
+"
+
+if ![empty_string_p $query_sql] {
+    set sql $query_sql 
+    set edit_anchor "edit"
+} else {
+    ns_write "Let's build the SQL first...\n\n"
+
+    set query_info [dw_build_sql $db $query_id]
+    if { $query_info == 0 } {
+	ns_write "This query doesn't seem ready for prime time:  no columns have been designated for selection"
+	return
+    }
+    set sql [lindex $query_info 0]
+    set select_list_items [lindex $query_info 1]
+    set order_clauses [lindex $query_info 2]
+    set edit_anchor "edit SQL directly"
+}
+
+ns_write "
+
+<blockquote>
+<code><pre>
+$sql
+
+<a href=\"query-edit-sql.tcl?query_id=$query_id\">($edit_anchor)</a>
+</pre></code>
+</blockquote>
+
+<table border=1>
+<tr>
+"
+
+set selection [ns_db select $db $sql]
+
+set size [ns_set size $selection]
+for {set i 0} {$i < $size} {incr i} {
+    set header [ns_set key $selection $i]
+    if { [info exists order_clauses] && [lsearch $order_clauses $header] == -1 } {
+	# we're not already ordering by this column
+	ns_write "<th><a href=\"query-add-order-by.tcl?query_id=$query_id&column_name=[ns_urlencode $header]\">$header</a></th>"
+    } else {
+	ns_write "<th>$header</th>"
+    }
+}
+
+ns_write "</tr>\n"
+
+# we're done showing the header
+
+while { [ns_db getrow $db $selection] } {
+    ns_write "<tr>"
+    for {set i 0} {$i < $size} {incr i} {
+	ns_write "<td>[ns_set value $selection $i]</td>"
+    }
+    ns_write "</tr>\n"
+}
+
+ns_write "
+</table>
+
+
+[ad_footer]
+"
Index: web/openacs/www/dw/query-new-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/dw/query-new-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/dw/query-new-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,23 @@
+# query-new-2.tcl,v 1.1.1.1.4.1 2000/02/03 09:47:30 ron Exp
+set_the_usual_form_variables
+
+# query_name
+
+# put in some error checking here for empty name
+
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+   ns_returnredirect /register.tcl?return_url=[ns_urlencode /dw/query-new.tcl]
+   return
+}
+
+set db [ns_db gethandle]
+set query_id [database_to_tcl_string $db "select query_sequence.nextval from dual"]
+
+ns_db dml $db "insert into queries (query_id, query_name, query_owner, definition_time)
+values
+($query_id, '$QQquery_name', $user_id, sysdate)"
+
+ns_returnredirect "query.tcl?query_id=$query_id"
+
Index: web/openacs/www/dw/query-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/dw/query-new.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/dw/query-new.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,39 @@
+# query-new.tcl,v 1.1.1.1.4.1 2000/02/03 09:47:31 ron Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set user_id [ad_get_user_id]
+
+if {$user_id == 0} {
+   ns_returnredirect /register.tcl?return_url=[ns_urlencode /dw/query-new.tcl]
+   return
+}
+
+ReturnHeaders
+
+ns_write "
+[ad_header "Define New Query"]
+
+<h2>Define New Query</h2>
+
+for <a href=index.tcl>the query section</a> of [dw_system_name]
+
+<hr>
+
+<form method=POST action=\"query-new-2.tcl\">
+<table>
+<tr><th>Query Name<td><input type=text name=query_name size=30>
+</table>
+
+<br>
+
+<center>
+<input type=submit value=\"Define\">
+</center>
+</form>
+
+
+[ad_footer]
+"
Index: web/openacs/www/dw/query.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/dw/query.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/dw/query.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,96 @@
+# query.tcl,v 1.1.1.1.4.1 2000/02/03 09:47:32 ron Exp
+set_the_usual_form_variables
+
+# query_id
+
+validate_integer query_id $query_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select query_name, definition_time, query_sql, first_names || ' ' || last_name as query_owner 
+from queries, users
+where query_id = $query_id
+and query_owner = users.user_id"]
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "
+[ad_header "$query_name"]
+
+<h2>$query_name</h2>
+
+defined by $query_owner on [util_IllustraDatetoPrettyDate $definition_time]
+
+<hr>
+
+<ul>
+<li><a href=\"query-execute.tcl?query_id=$query_id\">Execute immediately</a>
+</ul>
+
+Here's what query execution would do right now...
+
+"
+
+if ![empty_string_p $query_sql] {
+    # user has hand-edited the SQL 
+    ns_write "<blockquote>
+<code><pre>
+$query_sql
+
+<a href=\"query-edit-sql.tcl?query_id=$query_id\">(edit)</a>
+</pre></code>
+</blockquote>
+"
+} else {
+    # look at the query_columns table
+    ns_write "
+<ul>
+
+"
+
+    set selection [ns_db select $db "select query_columns.*, rowid
+from query_columns
+where query_id = $query_id
+order by what_to_do"]
+set counter 0
+
+    while { [ns_db getrow $db $selection] } {
+	set_variables_after_query
+	incr counter
+	ns_write "<li>$column_name : "
+	if { $what_to_do == "select_and_aggregate" } {
+	    ns_write "select and aggregate using $value1"
+	}
+	if { $what_to_do == "select_and_group_by" } {
+	    ns_write "select and group by"
+	}
+	if { $what_to_do == "restrict_by" } {
+	    ns_write "limit to $value2 \"$value1\""
+	}
+	if { $what_to_do == "order_by" } {
+	    ns_write "order by"
+	}
+	if ![empty_string_p $pretty_name] {
+	    ns_write " (with a heading of \"$pretty_name\")"
+	}
+	ns_write " <a href=\"query-delete-column.tcl?[export_url_vars query_id rowid]\">delete</a> \n"
+    }
+
+    if { $counter == 0 } {
+	ns_write "actually we've not got any plans yet"
+    }
+
+    ns_write "
+
+<P>
+
+<li><a href=\"query-add-column.tcl?query_id=$query_id\">add a column</a>
+
+</ul>
+"
+}
+
+# we're done explaining what the query will do 
+
+ns_write [ad_footer]
Index: web/openacs/www/ecommerce/account.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/account.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/account.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,157 @@
+# account.tcl,v 3.1 2000/03/11 02:41:35 michael Exp
+set_form_variables 0
+# possibly usca_p
+
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+set user_session_id [ec_get_user_session_id]
+
+set db_pools [ns_db gethandle [philg_server_default_pool] 2]
+set db [lindex $db_pools 0]
+set db_sub [lindex $db_pools 1]
+ec_create_new_session_if_necessary
+# type1
+
+ec_log_user_as_user_id_for_this_session
+
+set selection [ns_db select $db "select order_id, confirmed_date from ec_orders
+where user_id=$user_id
+and order_state not in ('in_basket','void','expired')
+order by order_id"]
+
+set past_orders ""
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append past_orders "<li><a href=\"order.tcl?[export_url_vars order_id]\">$order_id</a>; [util_AnsiDatetoPrettyDate $confirmed_date]; [ec_order_status $db_sub $order_id]\n"
+}
+
+
+if { [llength $past_orders] == 0 } {
+    append past_orders "You have no orders."
+}
+
+# Gift Certificates
+# One Entry for each gift certificate
+# and the title only, if there is at least one
+set selection [ns_db select $db "select 
+gift_certificate_id, issue_date, amount
+from ec_gift_certificates
+where purchased_by=$user_id
+and gift_certificate_state in ('authorized','authorized_plus_avs','authorized_minus_avs', 'confirmed')"]
+
+set purchased_gift_certificates ""
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append purchased_gift_certificates "<li><a href=\"gift-certificate.tcl?[export_url_vars gift_certificate_id]\">$gift_certificate_id</a>; [util_AnsiDatetoPrettyDate $issue_date]; [ec_pretty_price $amount]; [ec_gift_certificate_status $db_sub $gift_certificate_id]\n"
+}
+
+if { ![empty_string_p $purchased_gift_certificates] } {
+    set purchased_gift_certificates "<h3>Gift Certificates Purchased by You for Others</h3>\n <ul> \n$purchased_gift_certificates\n</ul>"
+}
+
+
+set gift_certificate_balance [database_to_tcl_string $db "select ec_gift_certificate_balance($user_id) from dual"]
+
+if { $gift_certificate_balance > 0 } {
+    set gift_certificate_sentence_if_nonzero_balance "<li>You have [ec_pretty_price $gift_certificate_balance] in your gift certificate account!"
+} else {
+    set gift_certificate_sentence_if_nonzero_balance ""
+}
+
+# User Classes: this section will only show up if the user is allowed to view them and
+# if any user classes exist
+set user_classes ""
+if { [ad_parameter UserClassUserViewP ecommerce] == 1 && ![empty_string_p [database_to_tcl_string_or_null $db "select 1 from dual where exists (select 1 from ec_user_classes)"]]} {
+
+    set user_classes_to_display [ec_user_class_display $db $user_id]
+
+    append user_classes "<p><li>User Classes: $user_classes_to_display"
+
+    if { [ad_parameter UserClassAllowSelfPlacement ecommerce] } {
+	append user_classes " (<a href=\"update-user-classes.tcl\">[ec_decode $user_classes_to_display "" "sign up for one" "update"]</a>)"
+    }
+
+    append user_classes "\n"
+}
+
+# Mailing Lists
+set mailing_lists ""
+
+set selection [ns_db select $db "
+(select 
+ ml.category_id, 
+ c.category_name,
+ ml.subcategory_id, 
+ s.subcategory_name, 
+ ml.subsubcategory_id,
+ ss.subsubcategory_name
+from ec_cat_mailing_lists ml, 
+ ec_categories c,
+ ec_subcategories s,
+ ec_subsubcategories ss
+where ml.user_id = $user_id
+and ml.category_id = c.category_id
+and ml.subcategory_id = s.subcategory_id
+and ml.subsubcategory_id = ss.subsubcategory_id)
+union
+(select 
+ ml.category_id, 
+ c.category_name,
+ ml.subcategory_id, 
+ s.subcategory_name, 
+ ml.subsubcategory_id,
+ null as subsubcategory_name
+from ec_cat_mailing_lists ml, 
+ ec_categories c,
+ ec_subcategories s
+where ml.user_id = $user_id
+and ml.category_id = c.category_id
+and ml.subcategory_id = s.subcategory_id
+and ml.subsubcategory_id is null)
+union
+(select 
+ ml.category_id, 
+ c.category_name,
+ ml.subcategory_id, 
+ null as subcategory_name, 
+ ml.subsubcategory_id,
+ null as subsubcategory_name
+from ec_cat_mailing_lists ml, 
+ ec_categories c
+where ml.user_id = $user_id
+and ml.category_id = c.category_id
+and ml.subcategory_id is null
+and ml.subsubcategory_id is null) union
+(select 
+ ml.category_id, 
+ null as category_name,
+ ml.subcategory_id, 
+ null as subcategory_name, 
+ ml.subsubcategory_id,
+ null as subsubcategory_name
+from ec_cat_mailing_lists ml
+where ml.user_id = $user_id
+and ml.category_id is null
+and ml.subcategory_id is null
+and ml.subsubcategory_id is null)"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append mailing_lists "<li>$category_name [ec_decode $subcategory_name "" "" ": $subcategory_name"] [ec_decode $subsubcategory_name "" "" ": $subsubcategory_name"] (<a href=\"mailing-list-remove.tcl?[export_url_vars category_id subcategory_id subsubcategory_id]\">remove me</a>)"
+}
+
+if { [empty_string_p $mailing_lists] } {
+    set mailing_lists "<i>You are not currently subscribed to any mailing lists.</i>"
+}
+set mailing_lists "<h3>Mailing Lists</h3><ul>$mailing_lists</ul>\n"
+
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/ecommerce/category-browse-subcategory.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/category-browse-subcategory.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/category-browse-subcategory.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,223 @@
+# category-browse-subcategory.tcl,v 3.0 2000/02/06 03:38:56 ron Exp
+# This one file is used to browse not only categories,
+# but also subcategories and subsubcategories.
+
+set_the_usual_form_variables
+# category_id [subcategory_id [subsubcategory_id]]
+# maybe how_many, start, usca_p
+
+validate_integer category_id $category_id
+
+if { ![info exists how_many] } {
+    set how_many [ad_parameter ProductsToDisplayPerPage ecommerce]
+}
+
+if { ![info exists start] } {
+    set start 0
+}
+
+
+proc ident {x} {return $x}
+proc have {var} { upvar $var x; return [expr {[info exists x] && [string compare $x "0"] != 0}]}
+proc in_subcat    {} {return [uplevel {have subcategory_id}]}
+proc in_subsubcat {} {return [uplevel {have subsubcategory_id}]}
+proc at_bottom_level_p {} {return [uplevel in_subsubcat]}
+
+set sub ""
+if [in_subcat]    {append sub "sub"} else {set subcategory_id 0}
+if [in_subsubcat] {append sub "sub"} else {set subsubcategory_id 0}
+
+set product_map()       "ec_category_product_map"
+set product_map(sub)    "ec_subcategory_product_map"
+set product_map(subsub) "ec_subsubcategory_product_map"
+
+
+set user_session_id [ec_get_user_session_id]
+
+set db [ns_db gethandle]
+
+# see if they're logged in
+set user_id [ad_verify_and_get_user_id]
+if { $user_id != 0 } {
+    set user_name [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id=$user_id"]
+} else {
+    set user_name ""
+}
+
+# user sessions:
+# 1. get user_session_id from cookie
+# 2. if user has no session (i.e. user_session_id=0), attempt to set it if it hasn't been
+#    attempted before
+# 3. if it has been attempted before,
+#    (a) if they have no offer_code, then do nothing
+#    (b) if they have a offer_code, tell them they need cookies on if they
+#        want their offer price
+# 4. Log this category_id into the user session
+
+ec_create_new_session_if_necessary [export_url_vars category_id subcategory_id subsubcategory_id how_many start] cookies_are_not_required
+# type4
+
+if { [string compare $user_session_id "0"] != 0 } {
+    ns_db dml $db "insert into ec_user_session_info (user_session_id, category_id) values ($user_session_id, $category_id)"
+}
+
+set category_name [database_to_tcl_string $db "select category_name from ec_categories where category_id=$category_id"]
+
+set subcategory_name ""
+if [have subcategory_id] {
+    validate_integer subcategory_id $subcategory_id
+    
+    set subcategory_name [database_to_tcl_string $db "select subcategory_name from ec_subcategories where subcategory_id=$subcategory_id"]
+}
+
+set subsubcategory_name ""
+if [have subsubcategory_id] {
+    validate_integer subsubcategory_id $subsubcategory_id
+
+    set subsubcategory_name [database_to_tcl_string $db "select subsubcategory_name from ec_subsubcategories where subsubcategory_id=$subsubcategory_id"]
+}
+
+#==============================
+# recommendations
+
+# Recommended products in this category
+
+set recommendations ""
+
+set header_to_print "<b>We Recommend</b><p>"
+set header_printed 0
+
+if { [ad_parameter UserClassApproveP ecommerce] } {
+    set user_class_approved_p_clause "and user_class_approved_p = 't'"
+} else {
+    set user_class_approved_p_clause ""
+}
+
+set selection [ns_db select $db "select 
+ p.product_name, p.product_id, p.dirname, r.recommendation_text
+from ec_products_displayable p, ec_product_recommendations r
+where p.product_id = r.product_id
+and r.${sub}category_id=[eval "ident \$${sub}category_id"]
+and r.active_p='t'
+and (r.user_class_id is null or r.user_class_id in 
+      (select user_class_id 
+       from ec_user_class_user_map m 
+       where user_id=$user_id
+       $user_class_approved_p_clause))
+order by p.product_name"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { !$header_printed } {
+	append recommendations $header_to_print
+	incr header_printed
+    }
+    append recommendations "<table>
+<tr>
+<td valign=top>[ec_linked_thumbnail_if_it_exists $dirname "f" "t"]</td>
+<td valign=top><a href=\"product.tcl?[export_url_vars product_id]\">$product_name</a>
+<p>
+$recommendation_text
+</td>
+</tr>
+</table>
+"
+}
+
+#==============================
+# products
+
+# All products in the "category" and not in "subcategories"
+
+set exclude_subproducts ""
+if ![at_bottom_level_p] {
+  set exclude_subproducts "
+and not exists (
+select 'x' from $product_map(sub$sub) s, ec_sub${sub}categories c
+                 where p.product_id = s.product_id
+                   and s.sub${sub}category_id = c.sub${sub}category_id
+                   and c.${sub}category_id = [eval "ident \$${sub}category_id"])
+"
+}
+
+set selection [ns_db select $db "select p.product_id, p.product_name, p.one_line_description
+from ec_products_searchable p, $product_map($sub) m
+where p.product_id = m.product_id
+and m.${sub}category_id = [eval "ident \$${sub}category_id"]
+$exclude_subproducts
+order by p.product_name
+"]
+
+
+set products ""
+
+set have_how_many_more_p f
+set count 0
+while { [ns_db getrow $db $selection] } {
+    if { $count >= $start && [expr $count - $start] < $how_many } {
+	set_variables_after_query
+	append products "<table><tr valign=top><td>[expr $count + 1]</td><td><a href=\"product.tcl?product_id=$product_id\"><b>$product_name</b></a><br>$one_line_description</td></tr></table>\n"
+    }
+    incr count
+    if { $count > [expr $start + (2 * $how_many)] } {
+	# we know there are at least how_many more items to display next time
+	set have_how_many_more_p t
+	break
+    } else {
+	set have_how_many_more_p f
+    }
+}
+
+append products ""
+
+
+if { $start >= $how_many } {
+    set prev_link "<a href=[ns_conn url]?[export_url_vars category_id subcategory_id subsubcategory_id how_many]&start=[expr $start - $how_many]>Previous $how_many</a>"
+} else {
+    set prev_link ""
+}
+
+if { $have_how_many_more_p == "t" } {
+    set next_link "<a href=[ns_conn url]?[export_url_vars category_id subcategory_id subsubcategory_id how_many]&start=[expr $start + $how_many]>Next $how_many</a>"
+} else {
+    set number_of_remaining_products [expr $count - $start - $how_many]
+    if { $number_of_remaining_products > 0 } {
+	set next_link "<a href=[ns_conn url]?[export_url_vars category_id subcategory_id subsubcategory_id how_many]&start=[expr $start + $how_many]>Next $number_of_remaining_products</a>"
+    } else {
+	set next_link ""
+    }
+}
+
+if { [empty_string_p $next_link] || [empty_string_p $prev_link] } {
+    set separator ""
+} else {
+    set separator "|"
+}
+
+
+#==============================
+# subcategories
+
+set subcategories ""
+if ![at_bottom_level_p] {
+  set selection [ns_db select $db "
+SELECT * from ec_sub${sub}categories c
+ WHERE ${sub}category_id = '[eval "ident \$${sub}category_id"]'
+   AND exists (
+       SELECT 'x' from ec_products_displayable p, $product_map(sub$sub) s
+        where p.product_id = s.product_id
+          and s.sub${sub}category_id = c.sub${sub}category_id
+     )
+ ORDER BY sort_key, sub${sub}category_name
+"]
+
+  while { [ns_db getrow $db $selection] } {
+      set_variables_after_query
+      append subcategories "<li><a href=category-browse-sub${sub}category.tcl?[export_url_vars category_id subcategory_id subsubcategory_id]>[eval "ident \$sub${sub}category_name"]</a>"
+  }
+}
+
+set the_category_id   [eval "ident \$${sub}category_id"]
+set the_category_name [eval "ident \$${sub}category_name"]
+
+ad_return_template
Index: web/openacs/www/ecommerce/category-browse-subsubcategory.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/category-browse-subsubcategory.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/category-browse-subsubcategory.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,223 @@
+# category-browse-subsubcategory.tcl,v 3.0 2000/02/06 03:38:57 ron Exp
+# This one file is used to browse not only categories,
+# but also subcategories and subsubcategories.
+
+set_the_usual_form_variables
+# category_id [subcategory_id [subsubcategory_id]]
+# maybe how_many, start, usca_p
+
+validate_integer category_id $category_id
+
+if { ![info exists how_many] } {
+    set how_many [ad_parameter ProductsToDisplayPerPage ecommerce]
+}
+
+if { ![info exists start] } {
+    set start 0
+}
+
+
+proc ident {x} {return $x}
+proc have {var} { upvar $var x; return [expr {[info exists x] && [string compare $x "0"] != 0}]}
+proc in_subcat    {} {return [uplevel {have subcategory_id}]}
+proc in_subsubcat {} {return [uplevel {have subsubcategory_id}]}
+proc at_bottom_level_p {} {return [uplevel in_subsubcat]}
+
+set sub ""
+if [in_subcat]    {append sub "sub"} else {set subcategory_id 0}
+if [in_subsubcat] {append sub "sub"} else {set subsubcategory_id 0}
+
+set product_map()       "ec_category_product_map"
+set product_map(sub)    "ec_subcategory_product_map"
+set product_map(subsub) "ec_subsubcategory_product_map"
+
+
+set user_session_id [ec_get_user_session_id]
+
+set db [ns_db gethandle]
+
+# see if they're logged in
+set user_id [ad_verify_and_get_user_id]
+if { $user_id != 0 } {
+    set user_name [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id=$user_id"]
+} else {
+    set user_name ""
+}
+
+# user sessions:
+# 1. get user_session_id from cookie
+# 2. if user has no session (i.e. user_session_id=0), attempt to set it if it hasn't been
+#    attempted before
+# 3. if it has been attempted before,
+#    (a) if they have no offer_code, then do nothing
+#    (b) if they have a offer_code, tell them they need cookies on if they
+#        want their offer price
+# 4. Log this category_id into the user session
+
+ec_create_new_session_if_necessary [export_url_vars category_id subcategory_id subsubcategory_id how_many start] cookies_are_not_required
+# type4
+
+if { [string compare $user_session_id "0"] != 0 } {
+    ns_db dml $db "insert into ec_user_session_info (user_session_id, category_id) values ($user_session_id, $category_id)"
+}
+
+set category_name [database_to_tcl_string $db "select category_name from ec_categories where category_id=$category_id"]
+
+set subcategory_name ""
+if [have subcategory_id] {
+    validate_integer subcategory_id $subcategory_id
+
+    set subcategory_name [database_to_tcl_string $db "select subcategory_name from ec_subcategories where subcategory_id=$subcategory_id"]
+}
+
+set subsubcategory_name ""
+if [have subsubcategory_id] {
+    validate_integer subsubcategory_id $subsubcategory_id
+
+    set subsubcategory_name [database_to_tcl_string $db "select subsubcategory_name from ec_subsubcategories where subsubcategory_id=$subsubcategory_id"]
+}
+
+#==============================
+# recommendations
+
+# Recommended products in this category
+
+set recommendations ""
+
+set header_to_print "<b>We Recommend</b><p>"
+set header_printed 0
+
+if { [ad_parameter UserClassApproveP ecommerce] } {
+    set user_class_approved_p_clause "and user_class_approved_p = 't'"
+} else {
+    set user_class_approved_p_clause ""
+}
+
+set selection [ns_db select $db "select 
+ p.product_name, p.product_id, p.dirname, r.recommendation_text
+from ec_products_displayable p, ec_product_recommendations r
+where p.product_id = r.product_id
+and r.${sub}category_id=[eval "ident \$${sub}category_id"]
+and r.active_p='t'
+and (r.user_class_id is null or r.user_class_id in 
+      (select user_class_id 
+       from ec_user_class_user_map m 
+       where user_id=$user_id
+       $user_class_approved_p_clause))
+order by p.product_name"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { !$header_printed } {
+	append recommendations $header_to_print
+	incr header_printed
+    }
+    append recommendations "<table>
+<tr>
+<td valign=top>[ec_linked_thumbnail_if_it_exists $dirname "f" "t"]</td>
+<td valign=top><a href=\"product.tcl?[export_url_vars product_id]\">$product_name</a>
+<p>
+$recommendation_text
+</td>
+</tr>
+</table>
+"
+}
+
+#==============================
+# products
+
+# All products in the "category" and not in "subcategories"
+
+set exclude_subproducts ""
+if ![at_bottom_level_p] {
+  set exclude_subproducts "
+and not exists (
+select 'x' from $product_map(sub$sub) s, ec_sub${sub}categories c
+                 where p.product_id = s.product_id
+                   and s.sub${sub}category_id = c.sub${sub}category_id
+                   and c.${sub}category_id = [eval "ident \$${sub}category_id"])
+"
+}
+
+set selection [ns_db select $db "select p.product_id, p.product_name, p.one_line_description
+from ec_products_searchable p, $product_map($sub) m
+where p.product_id = m.product_id
+and m.${sub}category_id = [eval "ident \$${sub}category_id"]
+$exclude_subproducts
+order by p.product_name
+"]
+
+
+set products ""
+
+set have_how_many_more_p f
+set count 0
+while { [ns_db getrow $db $selection] } {
+    if { $count >= $start && [expr $count - $start] < $how_many } {
+	set_variables_after_query
+	append products "<table><tr valign=top><td>[expr $count + 1]</td><td><a href=\"product.tcl?product_id=$product_id\"><b>$product_name</b></a><br>$one_line_description</td></tr></table>\n"
+    }
+    incr count
+    if { $count > [expr $start + (2 * $how_many)] } {
+	# we know there are at least how_many more items to display next time
+	set have_how_many_more_p t
+	break
+    } else {
+	set have_how_many_more_p f
+    }
+}
+
+append products ""
+
+
+if { $start >= $how_many } {
+    set prev_link "<a href=[ns_conn url]?[export_url_vars category_id subcategory_id subsubcategory_id how_many]&start=[expr $start - $how_many]>Previous $how_many</a>"
+} else {
+    set prev_link ""
+}
+
+if { $have_how_many_more_p == "t" } {
+    set next_link "<a href=[ns_conn url]?[export_url_vars category_id subcategory_id subsubcategory_id how_many]&start=[expr $start + $how_many]>Next $how_many</a>"
+} else {
+    set number_of_remaining_products [expr $count - $start - $how_many]
+    if { $number_of_remaining_products > 0 } {
+	set next_link "<a href=[ns_conn url]?[export_url_vars category_id subcategory_id subsubcategory_id how_many]&start=[expr $start + $how_many]>Next $number_of_remaining_products</a>"
+    } else {
+	set next_link ""
+    }
+}
+
+if { [empty_string_p $next_link] || [empty_string_p $prev_link] } {
+    set separator ""
+} else {
+    set separator "|"
+}
+
+
+#==============================
+# subcategories
+
+set subcategories ""
+if ![at_bottom_level_p] {
+  set selection [ns_db select $db "
+SELECT * from ec_sub${sub}categories c
+ WHERE ${sub}category_id = '[eval "ident \$${sub}category_id"]'
+   AND exists (
+       SELECT 'x' from ec_products_displayable p, $product_map(sub$sub) s
+        where p.product_id = s.product_id
+          and s.sub${sub}category_id = c.sub${sub}category_id
+     )
+ ORDER BY sort_key, sub${sub}category_name
+"]
+
+  while { [ns_db getrow $db $selection] } {
+      set_variables_after_query
+      append subcategories "<li><a href=category-browse-sub${sub}category.tcl?[export_url_vars category_id subcategory_id subsubcategory_id]>[eval "ident \$sub${sub}category_name"]</a>"
+  }
+}
+
+set the_category_id   [eval "ident \$${sub}category_id"]
+set the_category_name [eval "ident \$${sub}category_name"]
+
+ad_return_template
Index: web/openacs/www/ecommerce/category-browse.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/category-browse.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/category-browse.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,223 @@
+# category-browse.tcl,v 3.0 2000/02/06 03:38:58 ron Exp
+# This one file is used to browse not only categories,
+# but also subcategories and subsubcategories.
+
+set_the_usual_form_variables
+# category_id [subcategory_id [subsubcategory_id]]
+# maybe how_many, start, usca_p
+
+validate_integer category_id $category_id
+
+if { ![info exists how_many] } {
+    set how_many [ad_parameter ProductsToDisplayPerPage ecommerce]
+}
+
+if { ![info exists start] } {
+    set start 0
+}
+
+
+proc ident {x} {return $x}
+proc have {var} { upvar $var x; return [expr {[info exists x] && [string compare $x "0"] != 0}]}
+proc in_subcat    {} {return [uplevel {have subcategory_id}]}
+proc in_subsubcat {} {return [uplevel {have subsubcategory_id}]}
+proc at_bottom_level_p {} {return [uplevel in_subsubcat]}
+
+set sub ""
+if [in_subcat]    {append sub "sub"} else {set subcategory_id 0}
+if [in_subsubcat] {append sub "sub"} else {set subsubcategory_id 0}
+
+set product_map()       "ec_category_product_map"
+set product_map(sub)    "ec_subcategory_product_map"
+set product_map(subsub) "ec_subsubcategory_product_map"
+
+
+set user_session_id [ec_get_user_session_id]
+
+set db [ns_db gethandle]
+
+# see if they're logged in
+set user_id [ad_verify_and_get_user_id]
+if { $user_id != 0 } {
+    set user_name [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id=$user_id"]
+} else {
+    set user_name ""
+}
+
+# user sessions:
+# 1. get user_session_id from cookie
+# 2. if user has no session (i.e. user_session_id=0), attempt to set it if it hasn't been
+#    attempted before
+# 3. if it has been attempted before,
+#    (a) if they have no offer_code, then do nothing
+#    (b) if they have a offer_code, tell them they need cookies on if they
+#        want their offer price
+# 4. Log this category_id into the user session
+
+ec_create_new_session_if_necessary [export_url_vars category_id subcategory_id subsubcategory_id how_many start] cookies_are_not_required
+# type4
+
+if { [string compare $user_session_id "0"] != 0 } {
+    ns_db dml $db "insert into ec_user_session_info (user_session_id, category_id) values ($user_session_id, $category_id)"
+}
+
+set category_name [database_to_tcl_string $db "select category_name from ec_categories where category_id=$category_id"]
+
+set subcategory_name ""
+if [have subcategory_id] {
+    validate_integer subcategory_id $subcategory_id
+
+    set subcategory_name [database_to_tcl_string $db "select subcategory_name from ec_subcategories where subcategory_id=$subcategory_id"]
+}
+
+set subsubcategory_name ""
+if [have subsubcategory_id] {
+    validate_integer subsubcategory_id $subsubcategory_id
+
+    set subsubcategory_name [database_to_tcl_string $db "select subsubcategory_name from ec_subsubcategories where subsubcategory_id=$subsubcategory_id"]
+}
+
+#==============================
+# recommendations
+
+# Recommended products in this category
+
+set recommendations ""
+
+set header_to_print "<b>We Recommend</b><p>"
+set header_printed 0
+
+if { [ad_parameter UserClassApproveP ecommerce] } {
+    set user_class_approved_p_clause "and user_class_approved_p = 't'"
+} else {
+    set user_class_approved_p_clause ""
+}
+
+set selection [ns_db select $db "select 
+ p.product_name, p.product_id, p.dirname, r.recommendation_text
+from ec_products_displayable p, ec_product_recommendations r
+where p.product_id = r.product_id
+and r.${sub}category_id=[eval "ident \$${sub}category_id"]
+and r.active_p='t'
+and (r.user_class_id is null or r.user_class_id in 
+      (select user_class_id 
+       from ec_user_class_user_map m 
+       where user_id=$user_id
+       $user_class_approved_p_clause))
+order by p.product_name"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { !$header_printed } {
+	append recommendations $header_to_print
+	incr header_printed
+    }
+    append recommendations "<table>
+<tr>
+<td valign=top>[ec_linked_thumbnail_if_it_exists $dirname "f" "t"]</td>
+<td valign=top><a href=\"product.tcl?[export_url_vars product_id]\">$product_name</a>
+<p>
+$recommendation_text
+</td>
+</tr>
+</table>
+"
+}
+
+#==============================
+# products
+
+# All products in the "category" and not in "subcategories"
+
+set exclude_subproducts ""
+if ![at_bottom_level_p] {
+  set exclude_subproducts "
+and not exists (
+select 'x' from $product_map(sub$sub) s, ec_sub${sub}categories c
+                 where p.product_id = s.product_id
+                   and s.sub${sub}category_id = c.sub${sub}category_id
+                   and c.${sub}category_id = [eval "ident \$${sub}category_id"])
+"
+}
+
+set selection [ns_db select $db "select p.product_id, p.product_name, p.one_line_description
+from ec_products_searchable p, $product_map($sub) m
+where p.product_id = m.product_id
+and m.${sub}category_id = [eval "ident \$${sub}category_id"]
+$exclude_subproducts
+order by p.product_name
+"]
+
+
+set products ""
+
+set have_how_many_more_p f
+set count 0
+while { [ns_db getrow $db $selection] } {
+    if { $count >= $start && [expr $count - $start] < $how_many } {
+	set_variables_after_query
+	append products "<table><tr valign=top><td>[expr $count + 1]</td><td><a href=\"product.tcl?product_id=$product_id\"><b>$product_name</b></a><br>$one_line_description</td></tr></table>\n"
+    }
+    incr count
+    if { $count > [expr $start + (2 * $how_many)] } {
+	# we know there are at least how_many more items to display next time
+	set have_how_many_more_p t
+	break
+    } else {
+	set have_how_many_more_p f
+    }
+}
+
+append products ""
+
+
+if { $start >= $how_many } {
+    set prev_link "<a href=[ns_conn url]?[export_url_vars category_id subcategory_id subsubcategory_id how_many]&start=[expr $start - $how_many]>Previous $how_many</a>"
+} else {
+    set prev_link ""
+}
+
+if { $have_how_many_more_p == "t" } {
+    set next_link "<a href=[ns_conn url]?[export_url_vars category_id subcategory_id subsubcategory_id how_many]&start=[expr $start + $how_many]>Next $how_many</a>"
+} else {
+    set number_of_remaining_products [expr $count - $start - $how_many]
+    if { $number_of_remaining_products > 0 } {
+	set next_link "<a href=[ns_conn url]?[export_url_vars category_id subcategory_id subsubcategory_id how_many]&start=[expr $start + $how_many]>Next $number_of_remaining_products</a>"
+    } else {
+	set next_link ""
+    }
+}
+
+if { [empty_string_p $next_link] || [empty_string_p $prev_link] } {
+    set separator ""
+} else {
+    set separator "|"
+}
+
+
+#==============================
+# subcategories
+
+set subcategories ""
+if ![at_bottom_level_p] {
+  set selection [ns_db select $db "
+SELECT * from ec_sub${sub}categories c
+ WHERE ${sub}category_id = '[eval "ident \$${sub}category_id"]'
+   AND exists (
+       SELECT 'x' from ec_products_displayable p, $product_map(sub$sub) s
+        where p.product_id = s.product_id
+          and s.sub${sub}category_id = c.sub${sub}category_id
+     )
+ ORDER BY sort_key, sub${sub}category_name
+"]
+
+  while { [ns_db getrow $db $selection] } {
+      set_variables_after_query
+      append subcategories "<li><a href=category-browse-sub${sub}category.tcl?[export_url_vars category_id subcategory_id subsubcategory_id]>[eval "ident \$sub${sub}category_name"]</a>"
+  }
+}
+
+set the_category_id   [eval "ident \$${sub}category_id"]
+set the_category_name [eval "ident \$${sub}category_name"]
+
+ad_return_template
Index: web/openacs/www/ecommerce/checkout-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/checkout-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/checkout-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,178 @@
+# checkout-2.tcl,v 3.1.2.1 2000/03/17 06:15:48 eveander Exp
+set_form_variables 0
+# possibly address_id, usca_p
+
+ec_redirect_to_https_if_possible_and_necessary
+
+# we need them to be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# user sessions:
+# 1. get user_session_id from cookie
+# 2. if user has no session (i.e. user_session_id=0), attempt to set it if it hasn't been
+#    attempted before
+# 3. if it has been attempted before, give them message that we can't do shopping carts
+#    without cookies
+
+set user_session_id [ec_get_user_session_id]
+
+set db_pools [ns_db gethandle [philg_server_default_pool] 2]
+set db [lindex $db_pools 0]
+set db_sub [lindex $db_pools 1]
+
+ec_create_new_session_if_necessary [export_url_vars address_id]
+# type5
+
+# make sure they have an in_basket order, otherwise they've probably
+# gotten here by pushing Back, so return them to index.tcl
+
+set order_id [database_to_tcl_string_or_null $db "select order_id from ec_orders where user_session_id=$user_session_id and order_state='in_basket'"]
+
+if { [empty_string_p $order_id] } {
+    # then they probably got here by pushing "Back", so just redirect them
+    # to index.tcl
+
+    ns_returnredirect index.tcl
+    return
+}
+
+# make sure the order belongs to this user_id (why?  because before this point there was no
+# personal information associated with the order (so it was fine to go by user_session_id), 
+# but now there is, and we don't want someone messing with their user_session_id cookie and
+# getting someone else's order)
+
+set order_owner [database_to_tcl_string $db "select user_id from ec_orders where order_id=$order_id"]
+
+if { $order_owner != $user_id } {
+    # either they managed to skip past checkout.tcl, or they messed w/their user_session_id cookie
+
+    ns_returnredirect checkout.tcl
+    return
+}
+
+# make sure there's something in their shopping cart, otherwise
+# redirect them to their shopping cart which will tell them
+# that it's empty.
+
+if { [database_to_tcl_string $db "select count(*) from ec_items where order_id=$order_id"] == 0 } {
+
+    ns_returnredirect shopping-cart.tcl
+    return
+}
+
+# either address_id should be a form variable, or it should already
+# be in the database for this order
+
+# make sure address_id, if it exists, belongs to them, otherwise 
+# they've probably gotten here by form surgery, in which case send
+# them back to checkout.tcl
+# if it is theirs, put it into the database for this order
+
+# if address_id doesn't exist, make sure there is an address for this order, 
+# otherwise they've probably gotten here via url surgery, so redirect them
+# to checkout.tcl
+
+if { [info exists address_id] && ![empty_string_p $address_id] } {
+    validate_integer address_id $address_id
+
+    set n_this_address_id_for_this_user [database_to_tcl_string $db "select count(*) from ec_addresses where address_id=$address_id and user_id=$user_id"]
+    if {$n_this_address_id_for_this_user == 0} {
+
+
+	ns_returnredirect checkout.tcl
+	return
+    }
+    # it checks out ok
+    ns_db dml $db "update ec_orders set shipping_address=$address_id where order_id=$order_id"
+} else {
+    set address_id [database_to_tcl_string_or_null $db "select shipping_address from ec_orders where order_id=$order_id"]
+    if { [empty_string_p $address_id] } {
+
+	ns_returnredirect checkout.tcl
+	return
+    }
+}
+
+# everything is ok now; the user has a non-empty in_basket order and an
+# address associated with it, so now get the other necessary information
+
+if { [ad_ssl_available_p] } {
+    set form_action "https://[ns_config ns/server/[ns_info server]/module/nsssl Hostname]/ecommerce/process-order-quantity-shipping.tcl"
+} else {
+    set form_action "http://[ns_config ns/server/[ns_info server]/module/nssock Hostname]/ecommerce/process-order-quantity-shipping.tcl"
+}
+
+set selection [ns_db select $db "
+(select p.product_name, p.one_line_description, p.product_id, count(*) as quantity, u.offer_code,
+i.color_choice, i.size_choice, i.style_choice
+from ec_orders o, ec_items i, ec_products p, ec_user_session_offer_codes u
+where i.product_id=p.product_id
+and u.user_session_id= $user_session_id
+and o.order_id=i.order_id
+and p.product_id=u.product_id
+and o.user_session_id=$user_session_id and o.order_state='in_basket'
+group by p.product_name, p.one_line_description, p.product_id, u.offer_code,
+i.color_choice, i.size_choice, i.style_choice)
+union 
+(select p.product_name, p.one_line_description, p.product_id, count(*) as quantity, null as offer_code,
+i.color_choice, i.size_choice, i.style_choice
+from ec_orders o, ec_items i, ec_products p
+where i.product_id=p.product_id
+and o.order_id=i.order_id
+and 0=(select count(*) from ec_user_session_offer_codes where user_session_id=$user_session_id)
+and o.user_session_id=$user_session_id and o.order_state='in_basket'
+group by p.product_name, p.one_line_description, p.product_id,
+i.color_choice, i.size_choice, i.style_choice)"]
+
+set rows_of_items ""
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    # PGsql 6.x for group by (BMA)
+    if {$product_id == ""} {
+	continue
+    }
+
+    set option_list [list]
+    if { ![empty_string_p $color_choice] } {
+	lappend option_list "Color: $color_choice"
+    }
+    if { ![empty_string_p $size_choice] } {
+	lappend option_list "Size: $size_choice"
+    }
+    if { ![empty_string_p $style_choice] } {
+	lappend option_list "Style: $style_choice"
+    }
+    set options [join $option_list ", "]
+
+
+    append rows_of_items "<tr>
+    <td><input type=text name=\"quantity([list $product_id $color_choice $size_choice $style_choice])\" value=\"$quantity\" size=4 maxlength=4></td>
+    <td><a href=\"product.tcl?product_id=$product_id\">$product_name</a>[ec_decode $options "" "" ", $options"]<br>
+    [ec_price_line $db_sub $product_id $user_id $offer_code]</td>
+    </tr>
+    "
+}
+
+set shipping_options ""
+
+if { [ad_parameter ExpressShippingP ecommerce] } {
+    append shipping_options "<p>
+    <b><li>Shipping method:</b>
+    <p>
+    <input type=radio name=shipping_method value=\"standard\" checked>Standard Shipping<br>
+    <input type=radio name=shipping_method value=\"express\">Express
+    <p>
+    "
+}
+
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/ecommerce/checkout-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/checkout-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/checkout-3.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,110 @@
+# checkout-3.tcl,v 3.1 2000/03/07 03:45:21 eveander Exp
+set_form_variables 0
+# possibly usca_p
+
+# they should get here from process-order-quantity-payment-shipping.tcl
+# this page just summarizes their order before they submit it
+
+ec_redirect_to_https_if_possible_and_necessary
+
+# Make sure we have all their necessary info, otherwise they probably got
+# here via url surgery or by pushing Back
+
+# 1. There should be an in_basket order for their user_session_id.
+# 2. The order should have the correct user_id associated with it.
+# 3. The order should contain items.
+# 4. The order should have an address associated with it.
+# 5. The order should have credit card and shipping method associated with it.
+
+# we need them to be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# make sure they have an in_basket order, otherwise they've probably
+# gotten here by pushing Back, so return them to index.tcl
+
+set user_session_id [ec_get_user_session_id]
+
+set db [ns_db gethandle]
+ec_create_new_session_if_necessary
+# type1
+
+set order_id [database_to_tcl_string_or_null $db "select order_id from ec_orders where user_session_id=$user_session_id and order_state='in_basket'"]
+
+if { [empty_string_p $order_id] } {
+    # then they probably got here by pushing "Back", so just redirect them
+    # to index.tcl
+    ns_returnredirect index.tcl
+    return
+}
+
+# make sure there's something in their shopping cart, otherwise
+# redirect them to their shopping cart which will tell them
+# that it's empty.
+
+if { [database_to_tcl_string $db "select count(*) from ec_items where order_id=$order_id"] == 0 } {
+    ns_returnredirect shopping-cart.tcl
+    return
+}
+
+# make sure the order belongs to this user_id, otherwise they managed to skip past checkout.tcl, or
+# they messed w/their user_session_id cookie
+set order_owner [database_to_tcl_string $db "select user_id from ec_orders where order_id=$order_id"]
+
+if { $order_owner != $user_id } {
+    ns_returnredirect checkout.tcl
+    return
+}
+
+# make sure there is an address for this order, otherwise they've probably
+# gotten here via url surgery, so redirect them to checkout.tcl
+
+set address_id [database_to_tcl_string_or_null $db "select shipping_address from ec_orders where order_id=$order_id"]
+if { [empty_string_p $address_id] } {
+    ns_returnredirect checkout.tcl
+    return
+}
+
+# make sure there is a credit card (or that the gift_certificate_balance covers the cost) and 
+# a shipping method for this order, otherwise
+# they've probably gotten here via url surgery, so redirect them to checkout-2.tcl
+
+set creditcard_id [database_to_tcl_string_or_null $db "select creditcard_id from ec_orders where order_id=$order_id"]
+
+if { [empty_string_p $creditcard_id] } {
+
+    # ec_order_cost returns price + shipping + tax - gift_certificate BUT no gift certificates have been applied to
+    # in_basket orders, so this just returns price + shipping + tax
+    set order_total_price_pre_gift_certificate [database_to_tcl_string $db "select ec_order_cost($order_id) from dual"]
+
+    set gift_certificate_balance [database_to_tcl_string $db "select ec_gift_certificate_balance($user_id) from dual"]
+    
+    if { $gift_certificate_balance < $order_total_price_pre_gift_certificate } {
+	set gift_certificate_covers_cost_p "f"
+    } else {
+	set gift_certificate_covers_cost_p "t"
+    }
+}
+
+set shipping_method [database_to_tcl_string_or_null $db "select shipping_method from ec_orders where order_id=$order_id"]
+
+
+if { [empty_string_p $shipping_method] || ([empty_string_p $creditcard_id] && (![info exists gift_certificate_covers_cost_p] || $gift_certificate_covers_cost_p == "f")) } {
+    ns_returnredirect checkout-2.tcl
+    return
+}
+
+## done with all the checks
+## their order is ready to go!
+## now show them a summary before they submit their order
+
+set order_summary [ec_order_summary_for_customer $db $order_id $user_id]
+
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/ecommerce/checkout.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/checkout.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/checkout.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,94 @@
+# checkout.tcl,v 3.1 2000/03/07 03:45:16 eveander Exp
+set_form_variables 0
+# possibly usca_p
+
+# we need them to be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# make sure they have an in_basket order, otherwise they've probably
+# gotten here by pushing Back, so return them to index.tcl
+
+set user_session_id [ec_get_user_session_id]
+
+set db_pools [ns_db gethandle [philg_server_default_pool] 2]
+set db [lindex $db_pools 0]
+set db_sub [lindex $db_pools 1]
+ec_create_new_session_if_necessary
+# type1
+
+ec_log_user_as_user_id_for_this_session
+
+set order_id [database_to_tcl_string_or_null $db "select order_id from ec_orders where user_session_id=$user_session_id and order_state='in_basket'"]
+
+if { [empty_string_p $order_id] } {
+    # then they probably got here by pushing "Back", so just redirect them
+    # to index.tcl
+    ns_returnredirect index.tcl
+    return
+} else {
+    ns_db dml $db "update ec_orders set user_id=$user_id where order_id=$order_id"
+}
+
+# see if there are any saved shipping addresses for this user
+
+set selection [ns_db select $db "select address_id, attn, line1, line2, city, usps_abbrev, zip_code, phone, country_code, full_state_name, phone_time
+from ec_addresses
+where user_id=$user_id
+and address_type='shipping'"]
+
+
+set saved_addresses ""
+
+set to_print_if_addresses_exist "<b>Please enter a shipping address.</b> You can select an address listed below as your shipping address or enter a new address.
+"
+if { [ad_parameter SaveCreditCardDataP ecommerce] } {
+    append to_print_if_addresses_exist "<p>
+If you select an address listed below, and have already used a credit card to pay for previous shipments to that address, you will be able to use that credit card without having to give us the credit card number again. 
+"
+}
+
+set address_counter 0
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    if { $address_counter == 0 } {
+	append saved_addresses "$to_print_if_addresses_exist
+	<p>
+	<table border=0 cellspacing=0 cellpadding=20>
+	"
+    }
+
+    if { [ad_ssl_available_p] } {
+	set address_link "https://[ns_config ns/server/[ns_info server]/module/nsssl Hostname]/ecommerce/checkout-2.tcl?[export_url_vars address_id]"
+    } else {
+	set address_link "http://[ns_config ns/server/[ns_info server]/module/nssock Hostname]/ecommerce/checkout-2.tcl?[export_url_vars address_id]"
+    }
+
+    append saved_addresses "
+    <tr>
+    <td>
+    [ec_display_as_html [ec_pretty_mailing_address_from_args $db_sub $line1 $line2 $city $usps_abbrev $zip_code $country_code $full_state_name $attn $phone $phone_time]]
+    </td>
+    <td>
+    <a href=\"$address_link\">\[use this address\]</a>
+    </td>
+    </tr>
+    "
+    
+    incr address_counter
+}
+
+if { $address_counter != 0 } {
+    append saved_addresses "</table>"
+}
+
+ad_return_template
Index: web/openacs/www/ecommerce/credit-card-correction-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/credit-card-correction-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/credit-card-correction-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,144 @@
+# credit-card-correction-2.tcl,v 3.1 2000/03/07 03:54:31 eveander Exp
+set_the_usual_form_variables
+# creditcard_number, creditcard_type, creditcard_expire_1, creditcard_expire_2, billing_zip_code
+
+# 1. do the normal url/cookie surgery checks
+# 2. insert credit card data into ec_creditcards
+# 3. update orders to use this credit card
+# 4. redirect to finalize-order.tcl to process this info
+
+# Doubleclick problem:
+# There is a small but finite amount of time between the time that the user runs
+# this script and the time that their order goes into the 'confirmed' state.
+# During this time, it is possible for the user to submit their credit card info
+# twice, thereby adding rows to ec_creditcards.
+# However, no order will be updated after it's confirmed, so this credit card info
+# will be unreferenced by any order and we can delete it with a cron job.
+
+ec_redirect_to_https_if_possible_and_necessary
+
+# first do the basic error checking
+# also get rid of spaces and dashes in the credit card number
+if { [info exists creditcard_number] } {
+    # get rid of spaces and dashes
+    regsub -all -- "-" $creditcard_number "" creditcard_number
+    regsub -all " " $creditcard_number "" creditcard_number
+}
+
+set exception_count 0
+set exception_text ""
+
+if { [regexp {[^0-9]} $creditcard_number] } {
+    # I've already removed spaces and dashes, so only numbers should remain
+    incr exception_count
+    append exception_text "<li> Your credit card number contains invalid characters."
+}
+
+if { ![info exists billing_zip_code] || [empty_string_p $billing_zip_code] } {
+    incr exception_count
+    append exception_text "<li> You forgot to enter your billing zip code."
+}
+
+if { ![info exists creditcard_type] || [empty_string_p $creditcard_type] } {
+    incr exception_count
+    append exception_text "<li> You forgot to enter your credit card type."
+}
+
+# make sure the credit card type is right & that it has the right number
+# of digits
+set additional_count_and_text [ec_creditcard_precheck $creditcard_number $creditcard_type]
+
+set exception_count [expr $exception_count + [lindex $additional_count_and_text 0]]
+append exception_text [lindex $additional_count_and_text 1]
+
+if { ![info exists creditcard_expire_1] || [empty_string_p $creditcard_expire_1] || ![info exists creditcard_expire_2] || [empty_string_p $creditcard_expire_2] } {
+    incr exception_count
+    append exception_text "<li> Please enter your full credit card expiration date (month and year)"
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# then do all the normal checks to make sure nobody is doing url
+# or cookie surgery to get here
+
+# we need them to be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]?[export_url_vars creditcard_number creditcard_type creditcard_expire_1 creditcard_expire_2 billing_zip_code]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# make sure they have an in_basket order
+# unlike previous pages, if they don't have an in_basket order
+# it may be because they tried to execute this code twice and
+# the order is already in the confirmed state
+# In this case, they should be redirected to the thank you
+# page for the most recently confirmed order, if one exists,
+# otherwise redirect them to index.tcl
+
+set user_session_id [ec_get_user_session_id]
+
+set db [ns_db gethandle]
+
+set order_id [database_to_tcl_string_or_null $db "select order_id from ec_orders where user_session_id=$user_session_id and order_state='in_basket'"]
+
+if { [empty_string_p $order_id] } {
+
+    # find their most recently confirmed order
+    set most_recently_confirmed_order [database_to_tcl_string_or_null $db "select order_id from ec_orders where user_id=$user_id and confirmed_date is not null and order_id=(select max(o2.order_id) from ec_orders o2 where o2.user_id=$user_id and o2.confirmed_date is not null)"]
+    if { [empty_string_p $most_recently_confirmed_order] } {
+	ns_returnredirect index.tcl
+    } else {
+	ns_returnredirect thank-you.tcl
+    }
+    return
+}
+
+# make sure there's something in their shopping cart, otherwise
+# redirect them to their shopping cart which will tell them
+# that it's empty.
+
+if { [database_to_tcl_string $db "select count(*) from ec_items where order_id=$order_id"] == 0 } {
+    ns_returnredirect shopping-cart.tcl
+    return
+}
+
+# make sure the order belongs to this user_id, otherwise they managed to skip past checkout.tcl, or
+# they messed w/their user_session_id cookie
+set order_owner [database_to_tcl_string $db "select user_id from ec_orders where order_id=$order_id"]
+
+if { $order_owner != $user_id } {
+    ns_returnredirect checkout.tcl
+    return
+}
+
+# done with all the checks!
+
+# do some inserts
+set creditcard_id [database_to_tcl_string $db "select ec_creditcard_id_sequence.nextval from dual"]
+
+ns_db dml $db "begin transaction"
+
+ns_db dml $db "insert into ec_creditcards
+(creditcard_id, user_id, creditcard_number, creditcard_last_four, creditcard_type, creditcard_expire, billing_zip_code)
+values
+($creditcard_id, $user_id, '$creditcard_number', '[string range $creditcard_number [expr [string length $creditcard_number] -4] [expr [string length $creditcard_number] -1]]', '$QQcreditcard_type','$creditcard_expire_1/$creditcard_expire_2','$QQbilling_zip_code')
+"
+
+# make sure order is still in the 'in_basket' state while doing the
+# insert because it could have been confirmed in the (small) time
+# it took to get from "set order_id ..." to here
+# if not, no harm done; no rows will be updated
+
+ns_db dml $db "update ec_orders set creditcard_id=$creditcard_id where order_id=$order_id and order_state='in_basket'"
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect finalize-order.tcl
\ No newline at end of file
Index: web/openacs/www/ecommerce/credit-card-correction.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/credit-card-correction.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/credit-card-correction.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,92 @@
+# credit-card-correction.tcl,v 3.1 2000/03/07 03:54:25 eveander Exp
+set_form_variables 0
+# possibly usca_p
+
+# Gives them a chance to correct the information for a credit card that CyberCash rejected
+
+# The order that we're trying to reauthorize is the 'in_basket' order for their user_session_id
+# because orders are put back into the 'in_basket' state when their authorization fails
+
+# We can't just update ec_creditcards with the new info because there might be a previous
+# order which points to this credit card, so insert a new row into ec_creditcards.
+# Obvious mistypes (wrong # of digits, etc.) will be weeded out before this point anyway,
+# so the ec_creditcards table shouldn't get too huge.
+
+ec_redirect_to_https_if_possible_and_necessary
+
+# do all the normal url/cookie surgery checks
+# except don't bother with the ones unneccessary for security (like "did they put in an address for
+# this order?") because finalize-order.tcl (which they'll be going through to authorize their credit
+# card) will take care of those.
+
+# we need them to be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# make sure they have an in_basket order
+
+set user_session_id [ec_get_user_session_id]
+
+set db [ns_db gethandle]
+ec_create_new_session_if_necessary
+# type1
+
+ec_log_user_as_user_id_for_this_session
+
+set order_id [database_to_tcl_string_or_null $db "select order_id from ec_orders where user_session_id=$user_session_id and order_state='in_basket'"]
+
+if { [empty_string_p $order_id] } {
+    ns_returnredirect index.tcl
+    return
+}
+
+# this isn't necessary for security, but might as well do it anyway,
+# so they don't get confused thinking the order they probably
+# just submitted before pressing Back failed again:
+# make sure there's something in their shopping cart, otherwise
+# redirect them to their shopping cart which will tell them
+# that it's empty.
+
+if { [database_to_tcl_string $db "select count(*) from ec_items where order_id=$order_id"] == 0 } {
+    ns_returnredirect shopping-cart.tcl
+    return
+}
+
+# make sure the order belongs to this user_id, otherwise they managed to skip past checkout.tcl, or
+# they messed w/their user_session_id cookie
+set order_owner [database_to_tcl_string $db "select user_id from ec_orders where order_id=$order_id"]
+
+if { $order_owner != $user_id } {
+    ns_returnredirect checkout.tcl
+    return
+}
+
+# make sure there is a credit card for this order, otherwise
+# they've probably gotten here via url surgery, so redirect them to checkout-2.tcl
+# and while we're here, get the credit card info to pre-fill the form
+
+set selection [ns_db 0or1row $db "select creditcard_type, creditcard_number, creditcard_expire, billing_zip_code from 
+ec_creditcards, ec_orders
+where ec_creditcards.creditcard_id=ec_orders.creditcard_id
+and order_id=$order_id"]
+
+if { [empty_string_p $selection] } {
+    ns_returnredirect checkout-2.tcl
+    return
+}
+
+# check done
+# set the credit card variables
+set_variables_after_query
+
+set ec_creditcard_widget [ec_creditcard_widget $creditcard_type]
+set ec_expires_widget "[ec_creditcard_expire_1_widget [string range $creditcard_expire 0 1]] [ec_creditcard_expire_2_widget [string range $creditcard_expire 3 4]]"
+
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/ecommerce/finalize-order.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/finalize-order.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/finalize-order.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,176 @@
+# finalize-order.tcl,v 3.1 2000/03/07 03:53:59 eveander Exp
+# this script will:
+# (1) put this order into the 'confirmed' state
+# (2) try to authorize the user's credit card info and either
+#     (a) redirect them to a thank you page, or
+#     (b) redirect them to a "please fix your credit card info" page
+
+# If they reload, we don't have to worry about the credit card
+# authorization code being executed twice because the order has
+# already been moved to the 'confirmed' state, which means that
+# they will be redirected out of this page.
+# We will redirect them to the thank you page which displays the
+# order with the most recent confirmation date.
+# The only potential problem is that maybe the first time the
+# order got to this page it was confirmed but then execution of
+# the page stopped before authorization of the order could occur.
+# This problem is solved by the scheduled procedure,
+# ec_query_for_cybercash_zombies, which will try to authorize
+# any 'confirmed' orders over half an hour old.
+
+ec_redirect_to_https_if_possible_and_necessary
+
+# first do all the normal checks to make sure nobody is doing url
+# or cookie surgery to get here
+
+# we need them to be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# make sure they have an in_basket order
+# unlike previous pages, if they don't have an in_basket order
+# it may be because they tried to execute this code twice and
+# the order is already in the confirmed state
+# In this case, they should be redirected to the thank you
+# page for the most recently confirmed order, if one exists,
+# otherwise redirect them to index.tcl
+
+# user session tracking
+set user_session_id [ec_get_user_session_id]
+
+set db [ns_db gethandle]
+
+ec_log_user_as_user_id_for_this_session
+
+
+set order_id [database_to_tcl_string_or_null $db "select order_id from ec_orders where user_session_id=$user_session_id and order_state='in_basket'"]
+
+if { [empty_string_p $order_id] } {
+
+    # find their most recently confirmed order
+    set most_recently_confirmed_order [database_to_tcl_string_or_null $db "select order_id from ec_orders where user_id=$user_id and confirmed_date is not null and order_id=(select max(o2.order_id) from ec_orders o2 where o2.user_id=$user_id and o2.confirmed_date is not null)"]
+    if { [empty_string_p $most_recently_confirmed_order] } {
+	ns_returnredirect index.tcl
+    } else {
+	ns_returnredirect thank-you.tcl
+    }
+    return
+}
+
+# make sure there's something in their shopping cart, otherwise
+# redirect them to their shopping cart which will tell them
+# that it's empty.
+
+if { [database_to_tcl_string $db "select count(*) from ec_items where order_id=$order_id"] == 0 } {
+    ns_returnredirect shopping-cart.tcl
+    return
+}
+
+# make sure the order belongs to this user_id, otherwise they managed to skip past checkout.tcl, or
+# they messed w/their user_session_id cookie
+set order_owner [database_to_tcl_string $db "select user_id from ec_orders where order_id=$order_id"]
+
+if { $order_owner != $user_id } {
+    ns_returnredirect checkout.tcl
+    return
+}
+
+# make sure there is an address for this order, otherwise they've probably
+# gotten here via url surgery, so redirect them to checkout.tcl
+
+set address_id [database_to_tcl_string_or_null $db "select shipping_address from ec_orders where order_id=$order_id"]
+if { [empty_string_p $address_id] } {
+    ns_returnredirect checkout.tcl
+    return
+}
+
+# make sure there is a credit card and shipping method for this order, otherwise
+# they've probably gotten here via url surgery, so redirect them to checkout-2.tcl
+
+# set creditcard_id [database_to_tcl_string_or_null $db "select creditcard_id from ec_orders where order_id=$order_id"]
+
+# set shipping_method [database_to_tcl_string_or_null $db "select shipping_method from ec_orders where order_id=$order_id"]
+
+# if { [empty_string_p $creditcard_id] || [empty_string_p $shipping_method] } {
+#     ns_returnredirect checkout-2.tcl
+#     return
+# }
+
+# make sure there is a credit card (or that the gift_certificate_balance covers the cost) and 
+# a shipping method for this order, otherwise
+# they've probably gotten here via url surgery, so redirect them to checkout-2.tcl
+
+set creditcard_id [database_to_tcl_string_or_null $db "select creditcard_id from ec_orders where order_id=$order_id"]
+
+if { [empty_string_p $creditcard_id] } {
+    # we only want price and shipping from this (to determine whether gift_certificate covers cost)
+    set price_shipping_gift_certificate_and_tax [ec_price_shipping_gift_certificate_and_tax_in_an_order $db $order_id]
+
+    set order_total_price_pre_gift_certificate [expr [lindex $price_shipping_gift_certificate_and_tax 0] + [lindex $price_shipping_gift_certificate_and_tax 1]]
+
+    set gift_certificate_balance [database_to_tcl_string $db "select ec_gift_certificate_balance($user_id) from dual"]
+    
+    if { $gift_certificate_balance < $order_total_price_pre_gift_certificate } {
+	set gift_certificate_covers_cost_p "f"
+    } else {
+	set gift_certificate_covers_cost_p "t"
+    }
+}
+
+set shipping_method [database_to_tcl_string_or_null $db "select shipping_method from ec_orders where order_id=$order_id"]
+
+
+if { [empty_string_p $shipping_method] || ([empty_string_p $creditcard_id] && (![info exists gift_certificate_covers_cost_p] || $gift_certificate_covers_cost_p == "f")) } {
+    ns_returnredirect checkout-2.tcl
+    return
+}
+
+
+# done with all the checks!
+
+# (1) put this order into the 'confirmed' state
+
+ns_db dml $db "begin transaction"
+
+ec_update_state_to_confirmed $db $order_id
+
+ns_db dml $db "end transaction"
+
+# (2) try to authorize the user's credit card info and either
+#     (a) send them email & redirect them to a thank you page, or
+#     (b) redirect them to a "please fix your credit card info" page
+
+set cc_result [ec_creditcard_authorization $db $order_id]
+
+if { $cc_result == "authorized_plus_avs" || $cc_result == "authorized_minus_avs" } {
+    ec_email_new_order $order_id
+    ec_update_state_to_authorized $db $order_id [ec_decode $cc_result "authorized_plus_avs" "t" "f"]
+}
+
+if { $cc_result == "authorized_plus_avs" || $cc_result == "authorized_minus_avs" || $cc_result == "no_recommendation" } {
+    ns_returnredirect thank-you.tcl
+    return
+} elseif { $cc_result == "failed_authorization" } {
+
+    # updates everything that needs to be updated if a confirmed offer fails
+    ec_update_state_to_in_basket $db $order_id
+
+    ns_returnredirect credit-card-correction.tcl
+    return
+} else {
+    # Then cc_result is probably "invalid_input".
+    # This should never occur unless I'm much stupider than I thought.
+    ns_log Notice "Order $order_id received a cc_result of $cc_result"
+    ns_return 200 text/html "[ad_header "Sorry"]
+<h2>Sorry</h2>
+There has been an error in the processing of your credit card information.  Please contact <a href=\"mailto:[ec_system_owner]\"><address>[ec_system_owner]</address></a> to report the error.
+[ad_footer]
+"
+}
\ No newline at end of file
Index: web/openacs/www/ecommerce/gift-certificate-claim-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/gift-certificate-claim-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/gift-certificate-claim-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,103 @@
+# gift-certificate-claim-2.tcl,v 3.0 2000/02/06 03:39:07 ron Exp
+set_the_usual_form_variables
+# claim_check
+
+# we need them to be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    set return_url "[ns_conn url]?[export_entire_form_as_url_vars]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# make sure they have an in_basket order and a user_session_id;
+# this will make it more annoying for someone who just wants to
+# come to this page and try random number after random number
+
+set user_session_id [ec_get_user_session_id]
+
+if { $user_session_id == 0 } {
+    ns_returnredirect "index.tcl"
+    return
+}
+
+set db [ns_db gethandle]
+
+set order_id [database_to_tcl_string_or_null $db "select order_id from ec_orders where user_session_id=$user_session_id and order_state='in_basket'"]
+if { [empty_string_p $order_id] } {
+    ns_returnredirect "index.tcl"
+    return
+}
+
+if { [empty_string_p $claim_check] } {
+    ad_return_complaint 1 "<li>You forgot to enter a claim check."
+    return
+}
+
+# see if there's a gift certificate with that claim check
+
+set gift_certificate_id [database_to_tcl_string_or_null $db "select gift_certificate_id from ec_gift_certificates where claim_check='$QQclaim_check'"]
+
+if { [empty_string_p $gift_certificate_id] } {
+    
+    ad_return_complaint 1 "The claim check you have entered is invalid.  Please re-check it.  The claim check is case sensitive; enter it exactly as shown on your gift certificate."
+
+    ns_db dml $db "insert into ec_problems_log
+    (problem_id, problem_date, problem_details)
+    values
+    (ec_problem_id_sequence.nextval, sysdate(), '[DoubleApos "Incorrect gift certificate claim check entered at [ns_conn url].  Claim check entered: $claim_check by user ID: $user_id.  They may have just made a typo but if this happens repeatedly from the same IP address ([ns_conn peeraddr]) you may wish to look into this."]')
+    "
+
+    return
+}
+
+# there is a gift certificate with that claim check;
+# now check whether it's already been claimed
+# and, if so, whether it was claimed by this user
+
+set selection [ns_db 1row $db "select user_id as gift_certificate_user_id, amount from ec_gift_certificates where gift_certificate_id=$gift_certificate_id"]
+set_variables_after_query
+
+if { [empty_string_p $gift_certificate_user_id ] } {
+    # then no one has claimed it, so go ahead and assign it to them
+    ns_db dml $db "update ec_gift_certificates set user_id=$user_id, claimed_date=sysdate() where gift_certificate_id=$gift_certificate_id"
+
+    ReturnHeaders
+    ns_write "[ad_header "Gift Certificate Claimed"]
+    [ec_header_image]<br clear=all>
+    <blockquote>
+    [ec_pretty_price $amount] has been added to your gift certificate account!
+    <p>
+    <a href=\"payment.tcl\">Continue with your order</a>
+    </blockquote>
+    [ec_footer $db]
+    "
+    return
+} else {
+    # it's already been claimed
+    ReturnHeaders
+    ns_write "[ad_header "Gift Certificate Already Claimed"]
+    [ec_header_image]<br clear=all>
+    <blockquote>
+    Your gift certificate has already been claimed.  Either you hit submit twice on the form, or it
+    was claimed previously.  Once you claim it, it goes into your gift
+    certificate balance and you don't have to claim it again.
+    <p>
+    <a href=\"payment.tcl\">Continue with your order</a>
+    </blockquote>
+    [ec_footer $db]
+    "
+
+    # see if it was claimed by a different user and, if so, record the problem
+    if { $user_id != $gift_certificate_user_id } {
+	ns_db dml $db "insert into ec_problems_log
+	(problem_id, problem_date, gift_certificate_id, problem_details)
+	values
+	(ec_problem_id_sequence.nextval, sysdate(), $gift_certificate_id, '[DoubleApos "User ID $user_id tried to claim gift certificate $gift_certificate_id at [DoubleApos [ns_conn url]], but it had already been claimed by User ID $gift_certificate_id."])
+	"
+    }
+    return
+}
+
Index: web/openacs/www/ecommerce/gift-certificate-claim.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/gift-certificate-claim.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/gift-certificate-claim.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,31 @@
+# gift-certificate-claim.tcl,v 3.0 2000/02/06 03:39:09 ron Exp
+# we need them to be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    set return_url "[ns_conn url]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+set db [ns_db gethandle]
+
+# make sure they have an in_basket order and a user_session_id;
+# this will make it more annoying for someone who just wants to
+# come to this page and try random number after random number
+
+set user_session_id [ec_get_user_session_id]
+
+if { $user_session_id == 0 } {
+    ns_returnredirect "index.tcl"
+    return
+}
+
+set order_id [database_to_tcl_string_or_null $db "select order_id from ec_orders where user_session_id=$user_session_id and order_state='in_basket'"]
+if { [empty_string_p $order_id] } {
+    ns_returnredirect "index.tcl"
+    return
+}
+
+ad_return_template
Index: web/openacs/www/ecommerce/gift-certificate-finalize-order.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/gift-certificate-finalize-order.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/gift-certificate-finalize-order.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,362 @@
+# gift-certificate-finalize-order.tcl,v 3.1.2.1 2000/03/16 01:19:18 eveander Exp
+# sorry, no ADP template for this page; too many "if statements"
+
+set_the_usual_form_variables
+# gift_certificate_id, certificate_to, certificate_from, certificate_message, amount, recipient_email,
+# creditcard_number, creditcard_type, creditcard_expire_1,
+# creditcard_expire_2, billing_zip_code
+
+validate_integer gift_certificate_id $gift_certificate_id
+
+# this script will:
+# (1) put this order into the 'confirmed' state
+# (2) try to authorize the user's credit card info and either
+#     (a) redirect them to a thank you page, or
+#     (b) redirect them to a "please fix your credit card info" page
+
+# If they reload, we don't have to worry about the credit card
+# authorization code being executed twice because the order has
+# already been moved to the 'confirmed' state, which means that
+# they will be redirected out of this page.
+# We will redirect them to the thank you page which displays the
+# order with the most recent confirmation date.
+# The only potential problem is that maybe the first time the
+# order got to this page it was confirmed but then execution of
+# the page stopped before authorization of the order could occur.
+# This problem is solved by the scheduled procedure,
+# ec_query_for_cybercash_zombies, which will try to authorize
+# any 'confirmed' orders over half an hour old.
+
+ec_redirect_to_https_if_possible_and_necessary
+
+# user must be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]?[export_entire_form_as_url_vars]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# first do all the usual checks
+
+set exception_count 0
+set exception_text ""
+
+
+if { [string length $certificate_message] > 200 } {
+    incr exception_count
+    append exception_text "<li>The message you entered was too long.  It needs to contain fewer than 200 characters (the current length is [string length $certificate_message] characters)."
+} elseif { [string length $certificate_to] > 100 } {
+    incr exception_count
+    append exception_text "<li>What you entered in the \"To\" field is too long.  It needs to contain fewer than 100 characters (the current length is [string length $certificate_to] characters)."
+} elseif { [string length $certificate_from] > 100 } {
+    incr exception_count
+    append exception_text "<li>What you entered in the \"From\" field is too long.  It needs to contain fewer than 100 characters (the current length is [string length $certificate_from] characters)."
+} elseif { [string length $recipient_email] > 100 } {
+    incr exception_count
+    append exception_text "<li>The recipient email address you entered is too long.  It needs to contain fewer than 100 characters (the current length is [string length $recipient_email] characters)."
+}
+
+if { [empty_string_p $amount] } {
+    incr exception_count
+    append exception_text "<li>You forgot to enter the amount of the gift certificate."
+} elseif { [regexp {[^0-9]} $amount] } {
+    incr exception_count
+    append exception_text "<li>The amount needs to be a number with no special characters."
+} elseif { $amount < [ad_parameter MinGiftCertificateAmount ecommerce] } {
+    incr exception_count
+    append exception_text "<li>The amount needs to be at least [ec_pretty_price [ad_parameter MinGiftCertificateAmount ecommerce]]"
+} elseif { $amount > [ad_parameter MaxGiftCertificateAmount ecommerce] } {
+    incr exception_count
+    append exception_text "<li>The amount cannot be higher than [ec_pretty_price [ad_parameter MaxGiftCertificateAmount ecommerce]]"
+}
+
+if { [empty_string_p $recipient_email] } {
+    incr exception_count
+    append exception_text "<li>You forgot to specify the recipient's email address (we need it so we can send them their gift certificate!)"
+} elseif {![philg_email_valid_p $recipient_email]} {
+    incr exception_count
+    append exception_text "<li>The recipient's email address that you typed doesn't look right to us.  Examples of valid email addresses are 
+<ul>
+<li>Alice1234@aol.com
+<li>joe_smith@hp.com
+<li>pierre@inria.fr
+</ul>
+"
+}
+
+if { [regexp {[^0-9]} $creditcard_number] } {
+    # I've already removed spaces and dashes, so only numbers should remain
+    incr exception_count
+    append exception_text "<li> Your credit card number contains invalid characters."
+}
+
+if { ![info exists creditcard_type] || [empty_string_p $creditcard_type] } {
+    incr exception_count
+    append exception_text "<li> You forgot to enter your credit card type."
+}
+
+# make sure the credit card type is right & that it has the right number
+# of digits
+# set additional_count_and_text [ec_creditcard_precheck $creditcard_number $creditcard_type]
+
+# set exception_count [expr $exception_count + [lindex $additional_count_and_text 0]]
+# append exception_text [lindex $additional_count_and_text 1]
+
+if { ![info exists creditcard_expire_1] || [empty_string_p $creditcard_expire_1] || ![info exists creditcard_expire_2] || [empty_string_p $creditcard_expire_2] } {
+    incr exception_count
+    append exception_text "<li> Please enter your full credit card expiration date (month and year)"
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+if { [empty_string_p $gift_certificate_id] } {
+    ns_returnredirect "gift-certificate-order-4.tcl?[export_entire_form_as_url_vars]"
+    return
+}
+
+# user session tracking
+set user_session_id [ec_get_user_session_id]
+
+set db [ns_db gethandle]
+
+ec_log_user_as_user_id_for_this_session
+
+# doubleclick protection
+if { [database_to_tcl_string $db "select count(*) from ec_gift_certificates where gift_certificate_id=$gift_certificate_id"] > 0 } {
+
+    # query the status of the gift certificate in the database
+    set gift_certificate_state [database_to_tcl_string $db "select gift_certificate_state from ec_gift_certificates where gift_certificate_id=$gift_certificate_id"]
+
+    if { $gift_certificate_state == "authorized_plus_avs" || $gift_certificate_state == "authorized_minus_avs" } {
+	set cybercash_status "success-reload"
+    } elseif { $gift_certificate_state == "failed_authorization" } {
+	set cybercash_status "failure-reload"
+    } elseif { $gift_certificate_state == "confirmed" } {
+	set cybercash_status "unknown-reload"
+    } else {
+	ns_db dml $db "insert into ec_problems_log
+	(problem_id, problem_date, problem_details, gift_certificate_id)
+	values
+	(ec_problem_id_sequence.nextval, sysdate(), 'Customer pushed reload on gift-certificate-finalize-order.tcl but gift_certificate_state wasn't authorized_plus_avs, authorized_minus_avs, failed_authorization, or confirmed',$gift_certificate_id)
+	"
+
+	ad_return_error "Unexpected Result" "We received an unexpected result when querying for the status of your gift certificate.  This problem has been logged.  However, it would be helpful if you could email <a href=\"mailto:[ad_system_owner]\">[ad_system_owner]</a> with the events that led up to this occurrence.  We apologize for this problem and we will correct it as soon as we can."
+	return
+    }
+} else {
+
+    # put in the credit card
+    # put in the gift certificate
+    # put in the transaction
+    # try to auth transaction
+    
+    ns_db dml $db "begin transaction"
+    
+    set creditcard_id [database_to_tcl_string $db "select ec_creditcard_id_sequence.nextval from dual"]
+    
+    ns_db dml $db "insert into ec_creditcards
+    (creditcard_id, user_id, creditcard_number, creditcard_last_four, creditcard_type, creditcard_expire, billing_zip_code)
+    values
+    ($creditcard_id, $user_id, '$creditcard_number', '[string range $creditcard_number [expr [string length $creditcard_number] -4] [expr [string length $creditcard_number] -1]]', '[DoubleApos $creditcard_type]','$creditcard_expire_1/$creditcard_expire_2','[DoubleApos $billing_zip_code]')
+    "
+    
+    # claim check is generated as follows:
+    # 1. username of recipient (part of email address up to the @ symbol) up to 10 characters
+    # 2. 10 character random string
+    # 3. gift_certificate_id
+    # all separated by dashes
+    
+    # The username is added as protection in case someone cracks the random number algorithm.
+    # The gift_certificate_id is added as a guarantee of uniqueness.
+
+    # philg_email_valid_p ensures that there will be an @ sign, thus a username will be set
+    regexp {(.+)@} $recipient_email match username
+
+    if { [string length $username] > 10 } {
+	set username [string range $username 0 9]
+    }
+
+    set random_string [ec_generate_random_string 10]
+
+    set claim_check "$username-$random_string-$gift_certificate_id"
+
+
+    ns_db dml $db "insert into ec_gift_certificates
+    (gift_certificate_id, gift_certificate_state, amount, issue_date, purchased_by, expires, claim_check, certificate_message, certificate_to, certificate_from, recipient_email, last_modified, last_modifying_user, modified_ip_address)
+    values
+    ($gift_certificate_id, 'confirmed', $amount, sysdate(), $user_id, add_months(sysdate(),[ad_parameter GiftCertificateMonths ecommerce]), '[DoubleApos $claim_check]', '[DoubleApos $certificate_message]', '[DoubleApos $certificate_to]', '[DoubleApos $certificate_from]', '[DoubleApos [string trim $recipient_email]]', sysdate(), $user_id, '[DoubleApos [ns_conn peeraddr]]')
+    "
+    
+    set transaction_id [database_to_tcl_string $db "select ec_transaction_id_sequence.nextval from dual"]
+    
+    ns_db dml $db "insert into ec_financial_transactions
+    (transaction_id, gift_certificate_id, creditcard_id, transaction_amount, transaction_type, inserted_date)
+    values
+    ($transaction_id, $gift_certificate_id, $creditcard_id, $amount, 'charge', sysdate())
+    "
+    
+    ns_db dml $db "end transaction"
+    
+    # try to authorize the transaction
+    set cc_args [ns_set new]
+    
+    ns_set put $cc_args "amount" "[ad_parameter Currency ecommerce] $amount"
+    ns_set put $cc_args "card-number" "$creditcard_number"
+    ns_set put $cc_args "card-exp" "$creditcard_expire_1/$creditcard_expire_2"
+    ns_set put $cc_args "card-zip" "$billing_zip_code"
+    ns_set put $cc_args "order-id" "$transaction_id"
+    
+    set ttcc_output [ec_talk_to_cybercash "mauthonly" $cc_args]
+    
+    # We're interested in the txn_status, errmsg (if any) and avs_code
+    set txn_status [ns_set get $ttcc_output "txn_status"]
+    set errmsg [ns_set get $ttcc_output "errmsg"]
+    set avs_code [ns_set get $ttcc_output "avs_code"]
+    
+    # If we get a txn_status of failure-q-or-cancel, it means there was a communications
+    # failure and we can retry it (right away).
+    
+    if { [empty_string_p $txn_status] } {
+	# that means we didn't hear back from CyberCash
+	set cybercash_status "unknown-no-response"
+    } elseif { $txn_status == "success" || $txn_status == "success-duplicate" } {
+	set cybercash_status "success"
+    } elseif { $txn_status == "failure-q-or-cancel" || $txn_status == "pending" } {
+	# we'll retry once
+	ns_log Notice "Retrying failure-q-or-cancel gift certificate # $gift_certificate_id (transaction # $transaction_id)"
+	
+	set cc_args [ns_set new]
+	
+	ns_set put $cc_args "txn-type" "auth"
+	ns_set put $cc_args "order-id" "$transaction_id"
+	
+	set ttcc_output [ec_talk_to_cybercash "retry" $cc_args]
+	set txn_status [ns_set get $ttcc_output "txn_status"]
+	set errmsg [ns_set get $ttcc_output "errmsg"]
+	set avs_code [ns_set get $ttcc_output "avs_code"]
+	
+	if {[regexp {success} $txn_status]} {
+	    set cybercash_status "success"
+	} else {
+	    set cybercash_status "failure"
+	}
+    } else {
+	set cybercash_status "failure"
+    }
+}
+
+# Now deal with the cybercash_status:
+# 1. If success, update transaction and gift certificate to authorized, 
+#    send gift certificate order email, and give them a thank you page.
+# 2. If failure, update gift certificate and transaction to failed,
+#    create a new gift certificate_id and give them a new credit card form.
+# 3. If unknown-no-response, give message saying that we didn't hear back
+#    from CyberCash and that a cron job will check.
+# 4. If unknown-reload, give message saying they're getting this message
+#    because they pushed reload and that a cron job will check.
+
+if { $cybercash_status == "success" || $cybercash_status == "success-reload" } {
+    # we only want to make database updates and send email if the user didn't push reload
+    if { $cybercash_status == "success" } {
+	if { [ ec_avs_acceptable_p $avs_code ] == 1 } {
+	    set cc_result "authorized_plus_avs"
+	} else {
+	    set cc_result "authorized_minus_avs"
+	}
+	
+	# update transaction and gift certificate to authorized
+	# setting to_be_captured_p to 't' will cause ec_unmarked_transactions to come along and mark it for capture
+	ns_db dml $db "update ec_financial_transactions set authorized_date=sysdate(), to_be_captured_p='t' where transaction_id=$transaction_id"
+	ns_db dml $db "update ec_gift_certificates set authorized_date=sysdate(), gift_certificate_state='$cc_result' where gift_certificate_id=$gift_certificate_id"
+	
+	# send gift certificate order email
+	ec_email_new_gift_certificate_order $gift_certificate_id
+    }
+
+    # give them a thank you page
+    ns_returnredirect "gift-certificate-thank-you.tcl"
+    return
+    
+} elseif { $cybercash_status == "failure" || $cybercash_status == "failure-reload" } {
+    # we only want to make database updates if the user didn't push reload
+    if { $cybercash_status == "failure" } {
+	# we probably don't need to do this update of to_be_captured_p because no cron jobs
+	# distinguish between null and 'f' right now, but it doesn't hurt and it might alleviate
+	# someone's concern when they're looking at ec_financial_transactions and wondering
+	# whether they should be concerned that failed_p is 't'
+	ns_db dml $db "update ec_financial_transactions set failed_p='t', to_be_captured_p='f' where transaction_id=$transaction_id"
+	ns_db dml $db "update ec_gift_certificates set gift_certificate_state='failed_authorization' where gift_certificate_id=$gift_certificate_id"
+    }
+
+    # give them a gift_certificate_id and a new form
+    set gift_certificate_id [database_to_tcl_string $db "select ec_gift_cert_id_sequence.nextval from dual"]
+    ReturnHeaders
+    ns_write "[ad_header "Credit Card Correction Needed"]
+    [ec_header_image]<br clear=all>
+    <blockquote>
+    At this time we are unable to receive authorization to charge your
+    credit card.  Please check the number and the expiration date and
+    try again or use a different credit card.
+    <p>
+    <form method=post action=gift-certificate-finalize-order.tcl>
+    [export_form_vars gift_certificate_id certificate_to certificate_from certificate_message amount recipient_email]
+    <table>
+    <tr>
+    <td>Credit card number:</td>
+    <td><input type=text name=creditcard_number size=17 value=\"$creditcard_number\"></td>
+    </tr>
+    <tr>
+    <td>Type:</td>
+    <td>[ec_creditcard_widget $creditcard_type]</td>
+    </tr>
+    <tr>
+    <td>Expires:</td>
+    <td>[ec_creditcard_expire_1_widget $creditcard_expire_1] [ec_creditcard_expire_2_widget $creditcard_expire_2]</td>
+    <tr>
+    <td>Billing zip code:</td>
+    <td><input type=text name=billing_zip_code value=\"$billing_zip_code\" size=5></td>
+    </tr>
+    </table>
+    <center>
+    <input type=submit value=\"Continue\">
+    </center>
+    </form>
+    </blockquote>
+    [ec_footer $db]
+    "
+} elseif { $cybercash_status == "unknown-no-response" } {
+    ReturnHeaders
+    ns_write "[ad_header "No Response from CyberCash"]
+    [ec_header_image]<br clear=all>
+    <blockquote>
+    We didn't receive confirmation from CyberCash about whether they were able to authorize the
+    payment for your gift certificate order.
+    <p>
+    We will query CyberCash within the next hour to see if they processed your transaction, and
+    we'll let you know by email.  We apologize for the inconvenience.
+    <p>
+    You can also <a href=\"gift-certificate.tcl?[export_url_vars gift_certificate_id]\">check on the status of
+    this gift certificate order</a>.
+    </blockquote>
+    [ec_footer $db]
+    "
+} elseif { $cybercash_status == "unknown-reload" } {
+    set n_seconds [database_to_tcl_string $db "select round((sysdate()-issue_date)*86400) as n_seconds from ec_gift_certificates where gift_certificate_id = $gift_certificate_id"]
+    ReturnHeaders
+    ns_write "[ad_header "Gift Certificate Order Already Processed"]
+    You've probably hit submit twice from the same form.  We are already
+in possession of a gift certificate order with id # $gift_certificate_id (placed $n_seconds
+seconds ago) and it is being processed.  You can <a
+href=\"gift-certificate.tcl?[export_url_vars gift_certificate_id]\">check on the status of
+this gift certificate order</a> if you like.
+
+    [ec_footer $db]
+    "
+}
\ No newline at end of file
Index: web/openacs/www/ecommerce/gift-certificate-order-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/gift-certificate-order-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/gift-certificate-order-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,22 @@
+# gift-certificate-order-2.tcl,v 1.1.4.1 2000/02/03 09:47:49 ron Exp
+# asks for gift certificate info like message, amount, recipient_email
+
+ec_redirect_to_https_if_possible_and_necessary
+
+# user must be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+set currency [ad_parameter Currency ecommerce]
+set minimum_amount [ec_pretty_price [ad_parameter MinGiftCertificateAmount ecommerce]]
+set maximum_amount [ec_pretty_price [ad_parameter MaxGiftCertificateAmount ecommerce]]
+
+set db [ns_db gethandle]
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/ecommerce/gift-certificate-order-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/gift-certificate-order-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/gift-certificate-order-3.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,83 @@
+# gift-certificate-order-3.tcl,v 3.1 2000/03/07 03:53:08 eveander Exp
+# asks for payment info
+
+set_the_usual_form_variables
+# certificate_to, certificate_from, certificate_message, amount, recipient_email
+
+ec_redirect_to_https_if_possible_and_necessary
+
+# user must be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]?[export_entire_form_as_url_vars]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# error checking
+
+set exception_count 0
+set exception_text ""
+
+if { [string length $certificate_message] > 200 } {
+    incr exception_count
+    append exception_text "<li>The message you entered was too long.  It needs to contain fewer than 200 characters (the current length is [string length $certificate_message] characters)."
+} 
+if { [string length $certificate_to] > 100 } {
+    incr exception_count
+    append exception_text "<li>What you entered in the \"To\" field is too long.  It needs to contain fewer than 100 characters (the current length is [string length $certificate_to] characters)."
+} 
+if { [string length $certificate_from] > 100 } {
+    incr exception_count
+    append exception_text "<li>What you entered in the \"From\" field is too long.  It needs to contain fewer than 100 characters (the current length is [string length $certificate_from] characters)."
+} 
+if { [string length $recipient_email] > 100 } {
+    incr exception_count
+    append exception_text "<li>The recipient email address you entered is too long.  It needs to contain fewer than 100 characters (the current length is [string length $recipient_email] characters)."
+}
+
+
+if { [empty_string_p $amount] } {
+    incr exception_count
+    append exception_text "<li>You forgot to enter the amount of the gift certificate."
+} elseif { [regexp {[^0-9]} $amount] } {
+    incr exception_count
+    append exception_text "<li>The amount needs to be a number with no special characters."
+} elseif { $amount < [ad_parameter MinGiftCertificateAmount ecommerce] } {
+    incr exception_count
+    append exception_text "<li>The amount needs to be at least [ec_pretty_price [ad_parameter MinGiftCertificateAmount ecommerce]]"
+} elseif { $amount > [ad_parameter MaxGiftCertificateAmount ecommerce] } {
+    incr exception_count
+    append exception_text "<li>The amount cannot be higher than [ec_pretty_price [ad_parameter MaxGiftCertificateAmount ecommerce]]"
+}
+
+if { [empty_string_p $recipient_email] } {
+    incr exception_count
+    append exception_text "<li>You forgot to specify the recipient's email address (we need it so we can send them their gift certificate!)"
+} elseif {![philg_email_valid_p $recipient_email]} {
+    incr exception_count
+    append exception_text "<li>The recipient's email address that you typed doesn't look right to us.  Examples of valid email addresses are 
+<ul>
+<li>Alice1234@aol.com
+<li>joe_smith@hp.com
+<li>pierre@inria.fr
+</ul>
+"
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+set db [ns_db gethandle]
+
+set ec_creditcard_widget [ec_creditcard_widget]
+set ec_expires_widget "[ec_creditcard_expire_1_widget] [ec_creditcard_expire_2_widget]"
+set zip_code [database_to_tcl_string_or_null $db "select zip_code from ec_addresses where address_id=(select max(address_id) from ec_addresses where user_id=$user_id)"]
+set hidden_form_variables [export_form_vars certificate_to certificate_from certificate_message amount recipient_email]
+
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/ecommerce/gift-certificate-order-4.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/gift-certificate-order-4.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/gift-certificate-order-4.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,133 @@
+# gift-certificate-order-4.tcl,v 3.1 2000/03/07 03:52:20 eveander Exp
+# dispays order summary
+
+set_the_usual_form_variables
+# certificate_to, certificate_from, certificate_message, amount, recipient_email,
+# creditcard_number, creditcard_type, creditcard_expire_1,
+# creditcard_expire_2, billing_zip_code
+
+ec_redirect_to_https_if_possible_and_necessary
+
+# get rid of spaces and dashes
+regsub -all -- "-" $creditcard_number "" creditcard_number
+regsub -all " " $creditcard_number "" creditcard_number
+
+# user must be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]?[export_entire_form_as_url_vars]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# error checking
+
+set exception_count 0
+set exception_text ""
+
+if { [string length $certificate_message] > 200 } {
+    incr exception_count
+    append exception_text "<li>The message you entered was too long.  It needs to contain fewer than 200 characters (the current length is [string length $certificate_message] characters)."
+} 
+if { [string length $certificate_to] > 100 } {
+    incr exception_count
+    append exception_text "<li>What you entered in the \"To\" field is too long.  It needs to contain fewer than 100 characters (the current length is [string length $certificate_to] characters)."
+} 
+if { [string length $certificate_from] > 100 } {
+    incr exception_count
+    append exception_text "<li>What you entered in the \"From\" field is too long.  It needs to contain fewer than 100 characters (the current length is [string length $certificate_from] characters)."
+} 
+if { [string length $recipient_email] > 100 } {
+    incr exception_count
+    append exception_text "<li>The recipient email address you entered is too long.  It needs to contain fewer than 100 characters (the current length is [string length $recipient_email] characters)."
+}
+
+
+if { [empty_string_p $amount] } {
+    incr exception_count
+    append exception_text "<li>You forgot to enter the amount of the gift certificate."
+} elseif { [regexp {[^0-9]} $amount] } {
+    incr exception_count
+    append exception_text "<li>The amount needs to be a number with no special characters."
+} elseif { $amount < [ad_parameter MinGiftCertificateAmount ecommerce] } {
+    incr exception_count
+    append exception_text "<li>The amount needs to be at least [ec_pretty_price [ad_parameter MinGiftCertificateAmount ecommerce]]"
+} elseif { $amount > [ad_parameter MaxGiftCertificateAmount ecommerce] } {
+    incr exception_count
+    append exception_text "<li>The amount cannot be higher than [ec_pretty_price [ad_parameter MaxGiftCertificateAmount ecommerce]]"
+}
+
+if { [empty_string_p $recipient_email] } {
+    incr exception_count
+    append exception_text "<li>You forgot to specify the recipient's email address (we need it so we can send them their gift certificate!)"
+} elseif {![philg_email_valid_p $recipient_email]} {
+    incr exception_count
+    append exception_text "<li>The recipient's email address that you typed doesn't look right to us.  Examples of valid email addresses are 
+<ul>
+<li>Alice1234@aol.com
+<li>joe_smith@hp.com
+<li>pierre@inria.fr
+</ul>
+"
+}
+
+if { [regexp {[^0-9]} $creditcard_number] } {
+    # I've already removed spaces and dashes, so only numbers should remain
+    incr exception_count
+    append exception_text "<li> Your credit card number contains invalid characters."
+}
+
+if { ![info exists creditcard_type] || [empty_string_p $creditcard_type] } {
+    incr exception_count
+    append exception_text "<li> You forgot to enter your credit card type."
+}
+
+# make sure the credit card type is right & that it has the right number
+# of digits
+# set additional_count_and_text [ec_creditcard_precheck $creditcard_number $creditcard_type]
+
+# set exception_count [expr $exception_count + [lindex $additional_count_and_text 0]]
+# append exception_text [lindex $additional_count_and_text 1]
+
+if { ![info exists creditcard_expire_1] || [empty_string_p $creditcard_expire_1] || ![info exists creditcard_expire_2] || [empty_string_p $creditcard_expire_2] } {
+    incr exception_count
+    append exception_text "<li> Please enter your full credit card expiration date (month and year)"
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+set db [ns_db gethandle]
+set gift_certificate_id [database_to_tcl_string $db "select ec_gift_cert_id_sequence.nextval from dual"]
+set user_email [database_to_tcl_string $db "select email from users where user_id=$user_id"]
+
+set hidden_form_variables [export_form_vars certificate_to certificate_from certificate_message amount recipient_email creditcard_number creditcard_type creditcard_expire_1 creditcard_expire_2 billing_zip_code gift_certificate_id]
+
+if { ![empty_string_p $certificate_to] } {
+    set to_row "<tr><td><b>To:</b></td><td>$certificate_to</td></tr>"
+} else {
+    set to_row ""
+}
+
+if { ![empty_string_p $certificate_from] } {
+    set from_row "<tr><td><b>From:</b></td><td>$certificate_from</td></tr>"
+} else {
+    set from_row ""
+}
+
+if { ![empty_string_p $certificate_message] } {
+    set message_row "<tr><td valign=top><b>Message:</b></td><td>[ec_display_as_html $certificate_message]</td></tr>"
+} else {
+    set message_row ""
+}
+
+set formatted_amount [ec_pretty_price $amount]
+set zero_in_the_correct_currency [ec_pretty_price 0]
+
+ad_return_template
Index: web/openacs/www/ecommerce/gift-certificate-order.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/gift-certificate-order.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/gift-certificate-order.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,17 @@
+# gift-certificate-order.tcl,v 3.1 2000/03/07 03:52:09 eveander Exp
+# describes gift certificates and presents a link to order a gift certificate
+
+set system_name [ad_system_name]
+set expiration_time [ec_decode [ad_parameter GiftCertificateMonths ecommerce] "12" "1 year" "24" "2 years" "[ad_parameter GiftCertificateMonths ecommerce] months"]
+set minimum_amount [ec_pretty_price [ad_parameter MinGiftCertificateAmount ecommerce]]
+set maximum_amount [ec_pretty_price [ad_parameter MaxGiftCertificateAmount ecommerce]]
+ 
+if { [ad_ssl_available_p] } {
+    set order_url "https://[ns_config ns/server/[ns_info server]/module/nsssl Hostname]/ecommerce/gift-certificate-order-2.tcl"
+} else {
+    set order_url "http://[ns_config ns/server/[ns_info server]/module/nssock Hostname]/ecommerce/gift-certificate-order-2.tcl"
+}
+
+
+set db [ns_db gethandle]
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/ecommerce/gift-certificate-thank-you.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/gift-certificate-thank-you.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/gift-certificate-thank-you.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,11 @@
+# gift-certificate-thank-you.tcl,v 3.1 2000/03/07 03:51:51 eveander Exp
+# the user is redirected to this page from gift-certificate-finalize-order.tcl if
+# their gift certificate order has succeeded
+
+# this page displays a thank you message
+
+set home_page "[ec_insecure_url][ad_parameter EcommercePath ecommerce]index.tcl"
+
+set db [ns_db gethandle]
+
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/ecommerce/gift-certificate.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/gift-certificate.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/gift-certificate.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,66 @@
+# gift-certificate.tcl,v 3.0 2000/02/06 03:39:19 ron Exp
+set_the_usual_form_variables
+# gift_certificate_id
+# possibly usca_p
+
+validate_integer gift_certificate_id $gift_certificate_id
+
+# we need them to be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]?[export_entire_form_as_url_vars]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+set db [ns_db gethandle]
+
+# user session tracking
+set user_session_id [ec_get_user_session_id]
+
+ec_create_new_session_if_necessary [export_url_vars gift_certificate_id]
+
+ec_log_user_as_user_id_for_this_session
+
+set selection [ns_db 0or1row $db "select purchased_by, amount, recipient_email, certificate_to, certificate_from, certificate_message from ec_gift_certificates where gift_certificate_id=$gift_certificate_id"]
+
+if { [empty_string_p $selection] } {
+    set gift_certificate_summary "Invalid Gift Certificate ID"
+} else {
+    set_variables_after_query
+
+    if { $user_id != $purchased_by } {
+	set gift_certificate_summary "Invalid Gift Certificate ID"
+    } else {
+
+	set gift_certificate_summary "
+	Gift Certificate #:
+	$gift_certificate_id
+	<p>
+	Status:
+	"
+	
+	set status [ec_gift_certificate_status $db $gift_certificate_id]
+	
+	if { $status == "Void" || $status == "Failed Authorization" } {
+	    append gift_certificate_summary "<font color=red>$status</font>"
+	} else {
+	    append gift_certificate_summary "$status"
+	}
+	
+	append gift_certificate_summary "<p>
+	Recipient:
+	$recipient_email
+	<p>
+	To: $certificate_to<br>
+	Amount:	[ec_pretty_price $amount]<br>
+	From: $certificate_from<br>
+	Message: $certificate_message
+	"
+    }
+}
+
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/ecommerce/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/index.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,154 @@
+# index.tcl,v 3.2 2000/03/07 03:51:13 eveander Exp
+set_form_variables 0
+# possibly usca_p, how_many, start, usca_p
+
+if { ![info exists how_many] } {
+    set how_many [ad_parameter ProductsToDisplayPerPage ecommerce]
+}
+
+if { ![info exists start] } {
+    set start 0
+}
+
+set db [ns_db gethandle]
+
+# see if they're logged in
+set user_id [ad_verify_and_get_user_id]
+if { $user_id != 0 } {
+    set user_name [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id=$user_id"]
+} else {
+    set user_name ""
+}
+
+# for the template
+if { $user_id == 0 } {
+    set user_is_logged_on 0
+} else {
+    set user_is_logged_on 1
+}
+
+# user session tracking
+
+set user_session_id [ec_get_user_session_id]
+
+ec_create_new_session_if_necessary "" cookies_are_not_required
+
+
+# Log the user as the user_id for this session
+if { $user_is_logged_on && [string compare $user_session_id "0"] != -1 } {
+    ns_db dml $db "update ec_user_sessions set user_id=$user_id where user_session_id = $user_session_id"
+}
+
+set ec_user_string ""
+set register_url "/register.tcl?return_url=[ns_urlencode /ecommerce]"
+
+# we'll show a search widget at the top iff there are categories to search in
+if { ![empty_string_p [database_to_tcl_string_or_null $db "select 1 from dual where exists (select 1 from ec_categories)"]] } {
+    set search_widget [ec_search_widget $db]
+} else {
+    set search_widget ""
+}
+
+set recommendations_if_there_are_any ""
+
+set header_to_print "<b>We Recommend</b><p><blockquote>"
+set header_printed 0
+
+if { [ad_parameter UserClassApproveP ecommerce] } {
+    set user_class_approved_p_clause "and user_class_approved_p = 't'"
+} else {
+    set user_class_approved_p_clause ""
+}
+
+set selection [ns_db select $db "select p.product_name, p.product_id, p.dirname, r.recommendation_text
+from ec_products_displayable p, ec_product_recommendations r
+where p.product_id=r.product_id
+and category_id is null 
+and subcategory_id is null 
+and subsubcategory_id is null
+and (r.user_class_id is null or r.user_class_id in (select user_class_id
+     from ec_user_class_user_map 
+     where user_id = $user_id
+     $user_class_approved_p_clause))
+and r.active_p='t'"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { !$header_printed } {
+        append recommendations_if_there_are_any $header_to_print
+	set header_printed 1
+    }
+    append recommendations_if_there_are_any "<table>
+<tr>
+<td valign=top>[ec_linked_thumbnail_if_it_exists $dirname "f" "t"]</td>
+<td valign=top><a href=\"product.tcl?[export_url_vars product_id]\">$product_name</a>
+<p>
+$recommendation_text
+</td>
+</tr>
+</table>
+"
+}
+
+append recommendations_if_there_are_any "</blockquote>"
+
+if { [ad_parameter SellGiftCertificatesP ecommerce] == 1 } {
+    set gift_certificates_are_allowed 1
+} else {
+    set gift_certificates_are_allowed 0
+}
+
+# find all top-level products (those that are uncategorized)
+set selection [ns_db select $db "select
+p.product_name, p.product_id, p.one_line_description
+from ec_products_searchable p
+where not exists (select 1 from ec_category_product_map m where p.product_id = m.product_id)
+order by p.product_name"]
+
+set products ""
+
+set have_how_many_more_p f
+set count 0
+while { [ns_db getrow $db $selection] } {
+    if { $count >= $start && [expr $count - $start] < $how_many } {
+	set_variables_after_query
+	append products "<table><tr valign=top><td>[expr $count + 1]</td><td><a href=\"product.tcl?product_id=$product_id\"><b>$product_name</b></a><br>$one_line_description</td></tr></table>\n"
+    }
+    incr count
+    if { $count > [expr $start + (2 * $how_many)] } {
+	# we know there are at least how_many more items to display next time
+	set have_how_many_more_p t
+	break
+    } else {
+	set have_how_many_more_p f
+    }
+}
+
+append products ""
+
+
+if { $start >= $how_many } {
+    set prev_link "<a href=[ns_conn url]?[export_url_vars category_id subcategory_id subsubcategory_id how_many]&start=[expr $start - $how_many]>Previous $how_many</a>"
+} else {
+    set prev_link ""
+}
+
+if { $have_how_many_more_p == "t" } {
+    set next_link "<a href=[ns_conn url]?[export_url_vars category_id subcategory_id subsubcategory_id how_many]&start=[expr $start + $how_many]>Next $how_many</a>"
+} else {
+    set number_of_remaining_products [expr $count - $start - $how_many]
+    if { $number_of_remaining_products > 0 } {
+	set next_link "<a href=[ns_conn url]?[export_url_vars category_id subcategory_id subsubcategory_id how_many]&start=[expr $start + $how_many]>Next $number_of_remaining_products</a>"
+    } else {
+	set next_link ""
+    }
+}
+
+if { [empty_string_p $next_link] || [empty_string_p $prev_link] } {
+    set separator ""
+} else {
+    set separator "|"
+}
+
+
+ad_return_template
Index: web/openacs/www/ecommerce/mailing-list-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/mailing-list-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/mailing-list-add-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,53 @@
+# mailing-list-add-2.tcl,v 3.1 2000/03/07 03:50:42 eveander Exp
+set_the_usual_form_variables
+# category_id, subcategory_id, and/or subsubcategory_id
+# possibly usca_p
+
+validate_integer category_id $category_id
+
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]?[export_form_vars category_id subcategory_id subsubcategory_id]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# user session tracking
+set user_session_id [ec_get_user_session_id]
+
+set db [ns_db gethandle]
+ec_create_new_session_if_necessary [export_entire_form_as_url_vars]
+# type2
+
+if { ![info exists subcategory_id] || [empty_string_p $subcategory_id] } {
+    set check_string "select count(*) from ec_cat_mailing_lists where user_id=$user_id and category_id=$category_id and subcategory_id is null"
+    set insert_string "insert into ec_cat_mailing_lists (user_id, category_id) values ($user_id, $category_id)"
+    set mailing_list_name [database_to_tcl_string $db "select category_name from ec_categories where category_id=$category_id"]
+} elseif { ![info exists subsubcategory_id] || [empty_string_p $subsubcategory_id] } {
+    set check_string "select count(*) from ec_cat_mailing_lists where user_id=$user_id and subcategory_id=$subcategory_id and subsubcategory_id is null"
+    set insert_string "insert into ec_cat_mailing_lists (user_id, category_id, subcategory_id) values ($user_id, $category_id, $subcategory_id)"
+    set mailing_list_name "[database_to_tcl_string $db "select category_name from ec_categories where category_id=$category_id"]: [database_to_tcl_string $db "select subcategory_name from ec_subcategories where subcategory_id=$subcategory_id"]"
+} elseif { [info exists subsubcategory_id] && ![empty_string_p $subsubcategory_id] } {
+    validate_integer subcategory_id $subcategory_id
+    validate_integer subsubcategory_id $subsubcategory_id
+
+    set check_string "select count(*) from ec_cat_mailing_lists where user_id=$user_id and subsubcategory_id=$subsubcategory_id"
+    set insert_string "insert into ec_cat_mailing_lists (user_id, category_id, subcategory_id, subsubcategory_id) values ($user_id, $category_id, $subcategory_id, $subsubcategory_id)"
+    set mailing_list_name "[database_to_tcl_string $db "select category_name from ec_categories where category_id=$category_id"]: [database_to_tcl_string $db "select subcategory_name from ec_subcategories where subcategory_id=$subcategory_id"]: [database_to_tcl_string $db "select subsubcategory_name from ec_subsubcategories where subsubcategory_id=$subsubcategory_id"]"
+} else {
+    set check_string "select count(*) from ec_cat_mailing_lists where user_id=$user_id and category_id is null"
+    set insert_string "insert into ec_cat_mailing_lists (user_id) values ($user_id)"
+}
+
+if { [database_to_tcl_string $db $check_string] == 0 } {
+    ns_db dml $db $insert_string
+}
+
+set remove_link "<a href=\"mailing-list-remove.tcl?[export_url_vars category_id subcategory_id subsubcategory_id]\">[ec_insecure_url][ad_parameter EcommercePath ecommerce]mailing-list-remove.tcl?[export_url_vars category_id subcategory_id subsubcategory_id]</a>"
+
+set continue_shopping_options [ec_continue_shopping_options $db]
+
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/ecommerce/mailing-list-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/mailing-list-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/mailing-list-add.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,64 @@
+# mailing-list-add.tcl,v 3.0 2000/02/06 03:39:23 ron Exp
+set_the_usual_form_variables
+# category_id, subcategory_id, and/or subsubcategory_id
+# (if subcategory_id exists, then category_id should exist;
+# if subsubcategory_id exists, then subcategory_id and
+# category_id should exist)
+
+validate_integer category_id $category_id
+
+# possibly usca_p
+
+# this page either redirects them to log on or asks them to confirm that
+# they are who we think they are
+
+set user_id [ad_verify_and_get_user_id]
+
+set return_url "[ad_parameter EcommercePath ecommerce]mailing-list-add-2.tcl?[export_url_vars category_id subcategory_id subsubcategory_id]"
+
+if {$user_id == 0} {
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# user session tracking
+set user_session_id [ec_get_user_session_id]
+
+set db [ns_db gethandle]
+ec_create_new_session_if_necessary [export_entire_form_as_url_vars]
+# type2
+
+ec_log_user_as_user_id_for_this_session
+
+set user_name [database_to_tcl_string $db "select first_names || ' ' || last_name as user_name from users where user_id=$user_id"]
+
+# if { [info exists category_id] } {
+#     set mailing_list_name [database_to_tcl_string $db "select category_name from ec_categories where category_id=$category_id"]
+# } elseif { [info exists subcategory_id] } {
+#     set mailing_list_name "[database_to_tcl_string $db "select category_name from ec_categories where category_id=$category_id"]: [database_to_tcl_string $db "select subcategory_name from ec_subcategories where subcategory_id=$subcategory_id"]"
+# } elseif { [info exists subsubcategory_id] } {
+#     set mailing_list_name "[database_to_tcl_string $db "select category_name from ec_categories where category_id=$category_id"]: [database_to_tcl_string $db "select subcategory_name from ec_subcategories where subcategory_id=$subcategory_id"]: [database_to_tcl_string $db "select subsubcategory_name from ec_subsubcategories where subsubcategory_id=$subsubcategory_id"]"
+# } else {
+#     ad_return_complaint 1 "You haven't specified which mailing list you want to be added to."
+#     return
+# }
+
+if { ![info exists subcategory_id] || [empty_string_p $subcategory_id] } {
+    set mailing_list_name [database_to_tcl_string $db "select category_name from ec_categories where category_id=$category_id"]
+} elseif { ![info exists subsubcategory_id] || [empty_string_p $subsubcategory_id] } {
+    set mailing_list_name "[database_to_tcl_string $db "select category_name from ec_categories where category_id=$category_id"]: [database_to_tcl_string $db "select subcategory_name from ec_subcategories where subcategory_id=$subcategory_id"]"
+} elseif { [info exists subsubcategory_id] && ![empty_string_p $subsubcategory_id] } {
+    validate_integer subcategory_id $subcategory_id
+    validate_integer subsubcategory_id $subsubcategory_id
+
+    set mailing_list_name "[database_to_tcl_string $db "select category_name from ec_categories where category_id=$category_id"]: [database_to_tcl_string $db "select subcategory_name from ec_subcategories where subcategory_id=$subcategory_id"]: [database_to_tcl_string $db "select subsubcategory_name from ec_subsubcategories where subsubcategory_id=$subsubcategory_id"]"
+} else {
+    ad_return_complaint 1 "You haven't specified which mailing list you want to be added to."
+    return
+}
+
+
+set register_link "/register.tcl?[export_url_vars return_url]"
+set hidden_form_variables [export_form_vars category_id subcategory_id subsubcategory_id]
+
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/ecommerce/mailing-list-remove.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/mailing-list-remove.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/mailing-list-remove.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,72 @@
+# mailing-list-remove.tcl,v 3.1 2000/03/07 03:50:03 eveander Exp
+set_the_usual_form_variables
+# category_id, subcategory_id, and/or subsubcategory_id
+# possibly usca_p
+
+validate_integer category_id $category_id
+
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]?[export_form_vars category_id subcategory_id subsubcategory_id]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# user session tracking
+set user_session_id [ec_get_user_session_id]
+
+set db [ns_db gethandle]
+ec_create_new_session_if_necessary [export_entire_form_as_url_vars]
+# type2
+
+
+set delete_string "delete from ec_cat_mailing_lists where user_id=$user_id"
+
+if { [info exists category_id] && ![empty_string_p $category_id] } {
+    append delete_string " and category_id=$category_id"
+    set mailing_list_name [database_to_tcl_string $db "select category_name from ec_categories where category_id=$category_id"]
+
+} else {
+    append delete_string " and category_id is null"
+}
+
+if { [info exists subcategory_id] && ![empty_string_p $subcategory_id] } {
+    
+    validate_integer subcategory_id $subcategory_id
+
+    append delete_string " and subcategory_id=$subcategory_id"
+    set mailing_list_name "[database_to_tcl_string $db "select category_name from ec_categories where category_id=$category_id"]: [database_to_tcl_string $db "select subcategory_name from ec_subcategories where subcategory_id=$subcategory_id"]"
+
+} else {
+    append delete_string " and subcategory_id is null"
+}
+ 
+
+if { [info exists subsubcategory_id] && ![empty_string_p $subsubcategory_id] } {
+
+    validate_integer subsubcategory_id $subsubcategory_id
+
+    append delete_string " and subsubcategory_id=$subsubcategory_id"
+    set mailing_list_name "[database_to_tcl_string $db "select category_name from ec_categories where category_id=$category_id"]: [database_to_tcl_string $db "select subcategory_name from ec_subcategories where subcategory_id=$subcategory_id"]: [database_to_tcl_string $db "select subsubcategory_name from ec_subsubcategories where subsubcategory_id=$subsubcategory_id"]"
+
+} else {
+    append delete_string " and subsubcategory_id is null"
+}
+
+if { ![info exists mailing_list_name] } {
+    ad_return_complaint 1 "You haven't specified which mailing list you want to be removed from."
+    return
+}
+
+ns_db dml $db $delete_string
+
+set re_add_link "<a href=\"mailing-list-add.tcl?[export_url_vars category_id subcategory_id subsubcategory_id]\">[ec_insecure_url][ad_parameter EcommercePath ecommerce]mailing-list-add.tcl?[export_url_vars category_id subcategory_id subsubcategory_id]</a>"
+
+set back_to_account_link "<a href=\"[ec_insecure_url][ad_parameter EcommercePath ecommerce]account.tcl\">Your Account</a>"
+
+set continue_shopping_options [ec_continue_shopping_options $db]
+
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/ecommerce/order.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/order.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/order.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,38 @@
+# order.tcl,v 3.0 2000/02/06 03:39:25 ron Exp
+set_the_usual_form_variables
+# order_id
+# possibly usca_p
+
+# we need them to be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# user session tracking
+set user_session_id [ec_get_user_session_id]
+
+set db [ns_db gethandle]
+
+ec_create_new_session_if_necessary [export_url_vars order_id]
+
+
+ec_log_user_as_user_id_for_this_session
+
+set order_summary "<pre>
+Order #:
+$order_id
+
+Status:
+[ec_order_status $db $order_id]
+</pre>
+
+[ec_order_summary_for_customer $db $order_id $user_id "t"]
+"
+
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/ecommerce/payment.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/payment.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/payment.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,158 @@
+# payment.tcl,v 3.1 2000/03/07 03:49:12 eveander Exp
+# This script has to check whether the user has a gift_certificate that can cover the
+# cost of the order and, if not, present credit card form
+
+ec_redirect_to_https_if_possible_and_necessary
+
+set_form_variables 0
+
+# we need them to be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# make sure they have an in_basket order, otherwise they've probably
+# gotten here by pushing Back, so return them to index.tcl
+
+# user session tracking
+set user_session_id [ec_get_user_session_id]
+
+set db_pools [ns_db gethandle [philg_server_default_pool] 2]
+set db [lindex $db_pools 0]
+set db_sub [lindex $db_pools 1]
+ec_create_new_session_if_necessary
+# type1
+
+
+ec_log_user_as_user_id_for_this_session
+
+set order_id [database_to_tcl_string_or_null $db "select order_id from ec_orders where user_session_id=$user_session_id and order_state='in_basket'"]
+
+if { [empty_string_p $order_id] } {
+    # then they probably got here by pushing "Back", so just redirect them
+    # to index.tcl
+    ns_returnredirect index.tcl
+    return
+}
+
+# make sure the order belongs to this user_id (why?  because before this point there was no
+# personal information associated with the order (so it was fine to go by user_session_id), 
+# but now there is, and we don't want someone messing with their user_session_id cookie and
+# getting someone else's order)
+
+set order_owner [database_to_tcl_string $db "select user_id from ec_orders where order_id=$order_id"]
+
+if { $order_owner != $user_id } {
+    # either they managed to skip past checkout.tcl, or they messed w/their user_session_id cookie
+    ns_returnredirect checkout.tcl
+    return
+}
+
+# make sure there's something in their shopping cart, otherwise
+# redirect them to their shopping cart which will tell them
+# that it's empty.
+
+if { [database_to_tcl_string $db "select count(*) from ec_items where order_id=$order_id"] == 0 } {
+    ns_returnredirect shopping-cart.tcl
+    return
+}
+
+# address_id should already be in the database for this order
+# otherwise they've probably gotten here via url surgery, so redirect them
+# to checkout.tcl
+
+set address_id [database_to_tcl_string_or_null $db "select shipping_address from ec_orders where order_id=$order_id"]
+if { [empty_string_p $address_id] } {
+    ns_returnredirect checkout.tcl
+    return
+}
+
+# everything is ok now; the user has a non-empty in_basket order and an
+# address associated with it, so now get the other necessary information
+
+if { [ad_ssl_available_p] } {
+    set form_action "[ec_secure_url][ad_parameter EcommercePath ecommerce]process-payment.tcl"
+} else {
+    set form_action "[ec_insecure_url][ad_parameter EcommercePath ecommerce]process-payment.tcl"
+}
+
+# ec_order_cost returns price + shipping + tax - gift_certificate BUT no gift certificates have been applied to
+# in_basket orders, so this just returns price + shipping + tax
+set order_total_price_pre_gift_certificate [database_to_tcl_string $db "select ec_order_cost($order_id) from dual"]
+
+# determine gift certificate amount
+set user_gift_certificate_balance [database_to_tcl_string $db "select ec_gift_certificate_balance($user_id) from dual"]
+
+# I know these variable names look kind of retarded, but I think they'll
+# make things clearer for non-programmers editing the ADP templates:
+set gift_certificate_covers_whole_order 0
+set gift_certificate_covers_part_of_order 0
+set customer_can_use_old_credit_cards 0
+
+set show_creditcard_form_p "t"
+if { $user_gift_certificate_balance >= $order_total_price_pre_gift_certificate } {
+    set gift_certificate_covers_whole_order 1
+
+    set show_creditcard_form_p "f"
+    
+} elseif { $user_gift_certificate_balance > 0 } {
+    set gift_certificate_covers_part_of_order 1
+
+    set certificate_amount [ec_pretty_price $user_gift_certificate_balance]
+}
+
+if { $show_creditcard_form_p == "t" } {
+    
+    set customer_can_use_old_credit_cards 0
+
+    # see if the administrator lets customers reuse their credit cards
+    if { [ad_parameter SaveCreditCardDataP ecommerce] } {
+	# then see if we have any credit cards on file for this user
+	# for this shipping address only (for security purposes)
+	
+	set selection [ns_db select $db "select c.creditcard_id, c.creditcard_type, c.creditcard_last_four, c.creditcard_expire
+	from ec_creditcards c
+	where c.user_id=$user_id
+	and c.creditcard_number is not null
+	and c.failed_p='f'
+	and 0 < (select count(*) from ec_orders o where o.creditcard_id=c.creditcard_id and o.shipping_address=$address_id)
+	order by c.creditcard_id desc"]
+	
+	set to_print_before_creditcards "<table>
+	<tr><td></td><td><b>Card Type</b></td><td><b>Last 4 Digits</b></td><td><b>Expires</b></td></tr>"
+	
+	set card_counter 0
+	set old_cards_to_choose_from ""
+	while { [ns_db getrow $db $selection] } {
+	    set_variables_after_query
+	    if { $card_counter == 0 } {
+		append old_cards_to_choose_from $to_print_before_creditcards
+	    }
+	    append old_cards_to_choose_from "<tr><td><input type=radio name=creditcard_id value=\"$creditcard_id\""
+	    if { $card_counter == 0 } {
+		append old_cards_to_choose_from " checked"
+	    }
+	    append old_cards_to_choose_from "></td><td>[ec_pretty_creditcard_type $creditcard_type]</td><td align=center>$creditcard_last_four</td><td align=right>$creditcard_expire</td></tr>\n
+	    "
+	    incr card_counter
+	}
+	if { $card_counter != 0 } {
+	    set customer_can_use_old_credit_cards 1
+	    append old_cards_to_choose_from "</table>
+	    "
+	}
+    }
+    
+    set ec_creditcard_widget [ec_creditcard_widget]
+    set ec_expires_widget "[ec_creditcard_expire_1_widget] [ec_creditcard_expire_2_widget]"
+    set zip_code [database_to_tcl_string $db "select zip_code from ec_addresses where address_id=$address_id"]
+
+}
+
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/ecommerce/process-order-quantity-shipping.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/process-order-quantity-shipping.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/process-order-quantity-shipping.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,188 @@
+# process-order-quantity-shipping.tcl,v 3.1 2000/03/07 03:49:01 eveander Exp
+# updates quantities, sets the shipping method,
+# and finalizes the prices (inserts them into ec_items)
+
+set_form_variables 0
+# possibly quantity([list $product_id $color_choice $size_choice $style_choide])
+# for each product_id w/color, size, style in the order
+# (if this is the first time cycling through this script, in
+# which case the quantities will be passed to shopping-cart-
+# quantities-change.tcl and then all variables except the quantity
+# array will be passed back to this script
+
+# possibly shipping_method, if express shipping is available
+# possibly usca_p
+
+ec_redirect_to_https_if_possible_and_necessary
+
+if {[info exists quantity]} {
+    set arraynames [array names quantity]
+    set fullarraynames [list]
+    foreach arrayname $arraynames {
+	lappend fullarraynames "quantity($arrayname)"
+    }
+    set return_url "process-order-quantity-shipping.tcl?[export_url_vars creditcard_id creditcard_number creditcard_type creditcard_expire_1 creditcard_expire_2 billing_zip_code shipping_method]"
+    ns_returnredirect "shopping-cart-quantities-change.tcl?[export_url_vars return_url]&[eval export_url_vars $fullarraynames]"
+    return
+}
+
+# we need them to be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+
+    set form [ns_conn form]
+    if { ![empty_string_p $form] } {
+        set return_url "[ns_conn url]?[export_entire_form_as_url_vars]"
+    } else {
+        set return_url "[ns_conn url]"
+    }
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# user sessions:
+# 1. get user_session_id from cookie
+# 2. if user has no session (i.e. user_session_id=0), attempt to set it if it hasn't been
+#    attempted before
+# 3. if it has been attempted before, give them message that we can't do shopping carts
+#    without cookies
+
+set user_session_id [ec_get_user_session_id]
+
+set db_pools [ns_db gethandle [philg_server_default_pool] 2]
+set db [lindex $db_pools 0]
+set db_sub [lindex $db_pools 1]
+ec_create_new_session_if_necessary [ec_export_entire_form_as_url_vars_maybe]
+# type3
+
+ec_log_user_as_user_id_for_this_session
+
+# make sure they have an in_basket order, otherwise they've probably
+# gotten here by pushing Back, so return them to index.tcl
+
+set order_id [database_to_tcl_string_or_null $db "select order_id from ec_orders where user_session_id=$user_session_id and order_state='in_basket'"]
+
+if { [empty_string_p $order_id] } {
+    # then they probably got here by pushing "Back", so just redirect them
+    # to index.tcl
+    ns_returnredirect index.tcl
+    return
+}
+
+# make sure there's something in their shopping cart, otherwise
+# redirect them to their shopping cart which will tell them
+# that it's empty.
+
+if { [database_to_tcl_string $db "select count(*) from ec_items where order_id=$order_id"] == 0 } {
+    ns_returnredirect shopping-cart.tcl
+    return
+}
+
+# make sure the order belongs to this user_id, otherwise they managed to skip past checkout.tcl, or
+# they messed w/their user_session_id cookie
+set order_owner [database_to_tcl_string $db "select user_id from ec_orders where order_id=$order_id"]
+
+if { $order_owner != $user_id } {
+    ns_returnredirect checkout.tcl
+    return
+}
+
+# make sure there is an address for this order, otherwise they've probably
+# gotten here via url surgery, so redirect them to checkout.tcl
+
+set address_id [database_to_tcl_string_or_null $db "select shipping_address from ec_orders where order_id=$order_id"]
+if { [empty_string_p $address_id] } {
+    ns_returnredirect checkout.tcl
+    return
+}
+
+if { ![info exists shipping_method] } {
+    set shipping_method "standard"
+}
+
+# everything is ok now; the user has a non-empty in_basket order and an
+# address associated with it, so now update shipping method
+
+
+# 1. update the shipping method
+ns_db dml $db "update ec_orders set shipping_method='[DoubleApos $shipping_method]' where order_id=$order_id"
+
+# 2. put the prices into ec_items
+
+# set some things to use as arguments when setting prices
+if { [ad_parameter UserClassApproveP ecommerce] } {
+    set additional_user_class_restriction "and user_class_approved_p = 't'"
+} else {
+    set additional_user_class_restriction "and (user_class_approved_p is null or user_class_approved_p='t')"
+}
+set user_class_id_list [database_to_tcl_list $db "select user_class_id from ec_user_class_user_map where user_id='$user_id' $additional_user_class_restriction"]
+set selection [ns_db 1row $db "select default_shipping_per_item, weight_shipping_cost from ec_admin_settings"]
+set_variables_after_query
+set selection [ns_db 1row $db "select add_exp_amount_per_item, add_exp_amount_by_weight from ec_admin_settings"]
+set_variables_after_query
+set usps_abbrev [database_to_tcl_string $db "select usps_abbrev from ec_addresses where address_id=$address_id"]
+if { ![empty_string_p $usps_abbrev] } {
+    set selection [ns_db 0or1row $db "select tax_rate, shipping_p from ec_sales_tax_by_state where usps_abbrev='$usps_abbrev'"]
+    if { ![empty_string_p $selection] } {
+	set_variables_after_query
+    } else {
+	set tax_rate 0
+	set shipping_p f
+    }
+} else {
+    set tax_rate 0
+    set shipping_p f
+}
+
+# set selection [ns_db select $db "select item_id, product_id
+# from ec_items
+# where order_id=$order_id"]
+
+set selection [ns_db select $db "
+(select i.item_id, i.product_id, u.offer_code
+from ec_items i, ec_user_session_offer_codes u
+where i.product_id=u.product_id
+and u.user_session_id= $user_session_id
+and i.order_id=$order_id) union
+(select i.item_id, i.product_id, null as offer_code
+from ec_items i
+where 0=(select count(*) from ec_user_session_offer_codes where user_session_id= $user_session_id)
+and i.order_id=$order_id)"]
+
+# these will be updated as we loop through the items
+set total_item_shipping_tax 0
+set total_item_price_tax 0
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    set everything [ec_price_price_name_shipping_price_tax_shipping_tax_for_one_item $db_sub $product_id $offer_code $item_id $order_id $shipping_method $user_class_id_list $default_shipping_per_item $weight_shipping_cost $add_exp_amount_per_item $add_exp_amount_by_weight $tax_rate $shipping_p]
+
+    set total_item_shipping_tax [expr $total_item_shipping_tax + [lindex $everything 4]]
+    set total_item_price_tax [expr $total_item_price_tax + [lindex $everything 3]]
+
+    ns_db dml $db_sub "update ec_items set price_charged=round([lindex $everything 0],2), price_name='[DoubleApos [lindex $everything 1]]', shipping_charged=round([lindex $everything 2],2), price_tax_charged=round([lindex $everything 3],2), shipping_tax_charged=round([lindex $everything 4],2) where item_id=$item_id"
+}
+
+
+# 3. Determine base shipping cost & put it into ec_orders
+
+
+set order_shipping_cost [database_to_tcl_string_or_null $db "select base_shipping_cost from ec_admin_settings"]
+if {$order_shipping_cost == ""} {
+    set order_shipping_cost 0
+}
+
+# add on the extra base cost for express shipping, if appropriate
+if { $shipping_method == "express" } {
+    set add_exp_base_shipping_cost [database_to_tcl_string $db "select coalesce(add_exp_base_shipping_cost,0) from ec_admin_settings"]
+    set order_shipping_cost [expr $order_shipping_cost + $add_exp_base_shipping_cost]
+}
+
+set tax_on_order_shipping_cost [database_to_tcl_string $db "select ec_tax(0,$order_shipping_cost,$order_id) from dual"]
+
+ns_db dml $db "update ec_orders set shipping_charged=round($order_shipping_cost,2), shipping_tax_charged=round($tax_on_order_shipping_cost,2) where order_id=$order_id"
+
+ns_returnredirect payment.tcl
Index: web/openacs/www/ecommerce/process-payment.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/process-payment.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/process-payment.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,209 @@
+# process-payment.tcl,v 3.1 2000/03/07 03:48:13 eveander Exp
+# puts in the credit card data
+set_form_variables 0
+# creditcard_number, creditcard_type, creditcard_expire_1,
+# creditcard_expire_2, billing_zip_code
+
+# possibly creditcard_id if they want to use a previous credit
+# card, but if there's anything in creditcard_number, that will
+# override the selection of a past credit card
+
+# possibly usca_p
+
+ec_redirect_to_https_if_possible_and_necessary
+
+if { [info exists creditcard_number] } {
+    # get rid of spaces and dashes
+    regsub -all -- "-" $creditcard_number "" creditcard_number
+    regsub -all " " $creditcard_number "" creditcard_number
+}
+
+
+# we need them to be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# user sessions:
+# 1. get user_session_id from cookie
+# 2. if user has no session (i.e. user_session_id=0), attempt to set it if it hasn't been
+#    attempted before
+# 3. if it has been attempted before, give them message that we can't do shopping carts
+#    without cookies
+
+set user_session_id [ec_get_user_session_id]
+
+set db_pools [ns_db gethandle [philg_server_default_pool] 2]
+set db [lindex $db_pools 0]
+set db_sub [lindex $db_pools 1]
+ec_create_new_session_if_necessary [ec_export_entire_form_as_url_vars_maybe]
+# type3
+
+ec_log_user_as_user_id_for_this_session
+
+# make sure they have an in_basket order, otherwise they've probably
+# gotten here by pushing Back, so return them to index.tcl
+
+set order_id [database_to_tcl_string_or_null $db "select order_id from ec_orders where user_session_id=$user_session_id and order_state='in_basket'"]
+
+if { [empty_string_p $order_id] } {
+    # then they probably got here by pushing "Back", so just redirect them
+    # to index.tcl
+    ns_returnredirect index.tcl
+    return
+}
+
+# make sure there's something in their shopping cart, otherwise
+# redirect them to their shopping cart which will tell them
+# that it's empty.
+
+if { [database_to_tcl_string $db "select count(*) from ec_items where order_id=$order_id"] == 0 } {
+    ns_returnredirect shopping-cart.tcl
+    return
+}
+
+# make sure the order belongs to this user_id, otherwise they managed to skip past checkout.tcl, or
+# they messed w/their user_session_id cookie
+set order_owner [database_to_tcl_string $db "select user_id from ec_orders where order_id=$order_id"]
+
+if { $order_owner != $user_id } {
+    ns_returnredirect checkout.tcl
+    return
+}
+
+# make sure there is an address for this order, otherwise they've probably
+# gotten here via url surgery, so redirect them to checkout.tcl
+
+set address_id [database_to_tcl_string_or_null $db "select shipping_address from ec_orders where order_id=$order_id"]
+if { [empty_string_p $address_id] } {
+    ns_returnredirect checkout.tcl
+    return
+}
+
+# make sure there is a shipping method for this order, otherwise they've probably
+# gotten here via url surgery, so redirect them to checkout-2.tcl
+
+set shipping_method [database_to_tcl_string $db "select shipping_method from ec_orders where order_id=$order_id"]
+if { [empty_string_p $shipping_method] } {
+    ns_returnredirect checkout-2.tcl
+    return
+}
+
+
+## now do error checking; It is required that either
+# (a) their gift_certificate_balance covers the total order price, or
+# (b) they've selected a previous credit card (and creditcard_number is null,
+#     otherwise we assume they want to use a new credit card), or
+# (c) *all* of the credit card information for a new card has been filled in
+
+# we only want price and shipping from this (to determine whether gift_certificate_balance covers cost)
+set price_shipping_gift_certificate_and_tax [ec_price_shipping_gift_certificate_and_tax_in_an_order $db $order_id]
+
+set order_total_price_pre_gift_certificate [expr [lindex $price_shipping_gift_certificate_and_tax 0] + [lindex $price_shipping_gift_certificate_and_tax 1]]
+
+set gift_certificate_balance [database_to_tcl_string $db "select ec_gift_certificate_balance($user_id) from dual"]
+
+
+if { $gift_certificate_balance >= $order_total_price_pre_gift_certificate } {
+    set gift_certificate_covers_cost_p "t"
+} else {
+    set gift_certificate_covers_cost_p "f"
+}
+
+if { $gift_certificate_covers_cost_p == "f" } {
+    
+    if { ![info exists creditcard_id] || ([info exists creditcard_number] && ![empty_string_p $creditcard_number]) } {
+	if { ![info exists creditcard_number] || [empty_string_p $creditcard_number] } {
+	    # then they haven't selected a previous credit card nor have they entered
+	    # new credit card info
+	    ad_return_complaint 1 "<li> You forgot to specify which credit card you'd like to use."
+	    return
+	} else {
+	    # then they are using a new credit card and we just have to check that they
+	    # got it all right
+	    
+	    set exception_count 0
+	    set exception_text ""
+	    
+	    if { [regexp {[^0-9]} $creditcard_number] } {
+		# I've already removed spaces and dashes, so only numbers should remain
+		incr exception_count
+		append exception_text "<li> Your credit card number contains invalid characters."
+	    }
+	    	    
+	    if { ![info exists creditcard_type] || [empty_string_p $creditcard_type] } {
+		incr exception_count
+		append exception_text "<li> You forgot to enter your credit card type."
+	    }
+	    
+	    # make sure the credit card type is right & that it has the right number
+	    # of digits
+	    set additional_count_and_text [ec_creditcard_precheck $creditcard_number $creditcard_type]
+	    
+	    set exception_count [expr $exception_count + [lindex $additional_count_and_text 0]]
+	    append exception_text [lindex $additional_count_and_text 1]
+	    
+	    if { ![info exists creditcard_expire_1] || [empty_string_p $creditcard_expire_1] || ![info exists creditcard_expire_2] || [empty_string_p $creditcard_expire_2] } {
+		incr exception_count
+		append exception_text "<li> Please enter your full credit card expiration date (month and year)"
+	    }
+	    
+	    if { $exception_count > 0 } {
+		ad_return_complaint $exception_count $exception_text
+		return
+	    }
+	}
+	
+    } else {
+	# they're using an old credit card, although we should make sure they didn't
+	# submit to us someone else's creditcard_id or a blank creditcard_id
+	if { [empty_string_p $creditcard_id] } {
+	    # probably form surgery
+	    ns_returnredirect checkout-2.tcl
+	    return
+	}
+	set creditcard_owner [database_to_tcl_string_or_null $db "select user_id from ec_creditcards where creditcard_id=$creditcard_id"]
+	if { $user_id != $creditcard_owner } {
+	    # probably form surgery
+	    ns_returnredirect checkout-2.tcl
+	    return
+	}
+    }
+}
+
+# everything is ok now; the user has a non-empty in_basket order and an
+# address associated with it, so now insert credit card info if needed
+
+ns_db dml $db "begin transaction"
+
+# If gift_certificate doesn't cover cost, either insert or update credit card
+
+if { $gift_certificate_covers_cost_p == "f" } {
+    if { ![info exists creditcard_number] || [empty_string_p $creditcard_number] } {
+	# using pre-existing credit card
+	ns_db dml $db "update ec_orders set creditcard_id=$creditcard_id where order_id=$order_id"
+    } else {
+	# using new credit card
+	set creditcard_id [database_to_tcl_string $db "select ec_creditcard_id_sequence.nextval from dual"]
+	ns_db dml $db "insert into ec_creditcards
+	(creditcard_id, user_id, creditcard_number, creditcard_last_four, creditcard_type, creditcard_expire, billing_zip_code)
+	values
+	($creditcard_id, $user_id, '$creditcard_number', '[string range $creditcard_number [expr [string length $creditcard_number] -4] [expr [string length $creditcard_number] -1]]', '[DoubleApos $creditcard_type]','$creditcard_expire_1/$creditcard_expire_2','[DoubleApos $billing_zip_code]')
+	"
+	ns_db dml $db "update ec_orders set creditcard_id=$creditcard_id where order_id=$order_id"
+    }
+} else {
+    # make creditcard_id be null (which it might not be if this isn't their first
+    # time along this path)
+    ns_db dml $db "update ec_orders set creditcard_id=null where order_id=$order_id"
+}
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect checkout-3.tcl
\ No newline at end of file
Index: web/openacs/www/ecommerce/product-search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/product-search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/product-search.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,90 @@
+# product-search.tcl,v 3.1 2000/03/07 03:47:47 eveander Exp
+# this page searches for products either within a category (if specified) or
+# within all products
+
+set_the_usual_form_variables
+# search_text
+# possibly category_id usca_p
+
+if { ![info exists category_id] } {
+    set category_id ""
+} else {
+    validate_integer category_id $category_id
+}
+
+set user_id [ad_verify_and_get_user_id]
+
+# user session tracking
+set user_session_id [ec_get_user_session_id]
+
+set db_pools [ns_db gethandle [philg_server_default_pool] 2]
+set db [lindex $db_pools 0]
+set db_sub [lindex $db_pools 1]
+
+# user sessions:
+# 1. get user_session_id from cookie
+# 2. if user has no session (i.e. user_session_id=0), attempt to set it if it hasn't been
+#    attempted before
+# 3. if it has been attempted before,
+#    (a) if they have no offer_code, then do nothing
+#    (b) if they have a offer_code, tell them they need cookies on if they
+#        want their offer price
+# 4. Log this category_id, search_text into the user session
+
+ec_create_new_session_if_necessary [export_url_vars category_id search_text] cookies_are_not_required
+# type6
+
+if { [string compare $user_session_id "0"] != 0 } {
+    ns_db dml $db "insert into ec_user_session_info (user_session_id, category_id, search_text) values ($user_session_id, [ns_dbquotevalue $category_id integer], '[DoubleApos $search_text]')"
+}
+
+
+if { ![empty_string_p $category_id] } {
+    set category_name [database_to_tcl_string $db "select category_name from ec_categories where category_id=$category_id"]
+} else {
+    set category_name ""
+}
+
+if { ![empty_string_p $category_id] } {
+    set selection [ns_db select $db "select p.product_name, p.product_id, p.dirname, p.one_line_description,pseudo_contains(p.product_name || p.one_line_description || p.detailed_description || p.search_keywords, '[DoubleApos $search_text]') as score
+    from ec_products_searchable p, ec_category_product_map c
+    where c.category_id=$category_id
+    and p.product_id=c.product_id
+    and pseudo_contains(p.product_name || p.one_line_description ||  p.detailed_description || p.search_keywords, '[DoubleApos $search_text]') > 0
+    order by score desc"]
+} else {
+    set selection [ns_db select $db "select p.product_name, p.product_id, p.dirname, p.one_line_description,pseudo_contains(p.product_name || p.one_line_description || p.detailed_description || p.search_keywords, '[DoubleApos $search_text]') as score
+    from ec_products_searchable p
+    where pseudo_contains(p.product_name || p.one_line_description ||  p.detailed_description || p.search_keywords, '[DoubleApos $search_text]') > 0
+    order by score desc"]
+}
+
+set search_string ""
+set search_count 0
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    incr search_count
+
+    append search_string "<table width=90%>
+<tr>
+<td valign=center>
+ <table>
+ <tr><td><a href=\"product.tcl?[export_url_vars product_id]\">$product_name</a></td></tr>
+ <tr><td>$one_line_description</td></tr>
+ <tr><td>[ec_price_line $db_sub $product_id $user_id ""]</td></tr>
+ </table>
+</td>
+<td align=right valign=top>[ec_linked_thumbnail_if_it_exists $dirname "t" "t"]</td>
+</tr>
+</table>
+"
+}
+
+if { $search_count == 0 } {
+    set search_results "No products found."
+} else {
+    set search_results " $search_count item[ec_decode $search_count "1" "" "s"] found.<p>$search_string"
+}
+
+ad_return_template
Index: web/openacs/www/ecommerce/product.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/product.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/product.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,124 @@
+# product.tcl,v 3.0 2000/02/06 03:39:33 ron Exp
+# product.tcl
+#
+# by eveander@arsdigita.com June 1999
+# 
+# display a single product and possibly comments on that
+# product or professional reviews
+
+set_the_usual_form_variables
+
+# product_id required; optional: offer_code and comments_sort_by
+# possibly usca_p
+
+validate_integer product_id $product_id
+
+# default to empty string (date)
+if { ![info exists comments_sort_by] } {
+    set comments_sort_by ""
+}
+
+# we don't need them to be logged in, but if they are they might get a lower price
+set user_id [ad_verify_and_get_user_id]
+
+# user sessions:
+# 1. get user_session_id from cookie
+# 2. if user has no session (i.e. user_session_id=0), attempt to set it if it hasn't been
+#    attempted before
+# 3. if it has been attempted before,
+#    (a) if they have no offer_code, then do nothing
+#    (b) if they have a offer_code, tell them they need cookies on if they
+#        want their offer price
+# 4. Log this product_id into the user session
+
+set user_session_id [ec_get_user_session_id]
+
+set db [ns_db gethandle]
+
+ec_create_new_session_if_necessary [export_url_vars product_id offer_code] cookies_are_not_required
+
+# valid offer codes must be <= 20 characters, so if it's more than 20 characters, pretend
+# it isn't there
+if { [info exists offer_code] && [string length $offer_code] <= 20 } {
+    ad_return_complaint 1 "You need to have cookies turned on in order to have special offers take effect (we use cookies to remember that you are a recipient of this special offer.
+    <p>
+    Please turn on cookies in your browser, or if you don't wish to take advantage of this offer, you can still <a href=\"index.tcl\">continue shopping at [ec_system_name]</a>"
+    return
+}
+
+if { [string compare $user_session_id "0"] != 0 } {
+    ns_db dml $db "insert into ec_user_session_info (user_session_id, product_id) values ($user_session_id, $product_id)"
+}
+
+
+if { [info exists offer_code] && [string compare $user_session_id "0"] != 0} {
+    # insert into or update ec_user_session_offer_codes
+    if { [database_to_tcl_string $db "select count(*) from ec_user_session_offer_codes where user_session_id=$user_session_id and product_id=$product_id"] == 0 } {
+	ns_db dml $db "insert into ec_user_session_offer_codes (user_session_id, product_id, offer_code) values ($user_session_id, $product_id, '[DoubleApos $offer_code]')"
+    } else {
+	ns_db dml $db "update ec_user_session_offer_codes set offer_code='[DoubleApos $offer_code]' where user_session_id=$user_session_id and product_id=$product_id"
+    }
+}
+
+if { ![info exists offer_code] && [string compare $user_session_id "0"] != 0} {
+    set offer_code [database_to_tcl_string_or_null $db "select offer_code from ec_user_session_offer_codes where user_session_id=$user_session_id and product_id=$product_id"]
+}
+
+if { ![info exists offer_code] } {
+    set offer_code ""
+}
+
+set currency [ad_parameter Currency ecommerce]
+set allow_pre_orders_p [ad_parameter AllowPreOrdersP ecommerce]
+
+# get all the information from both the products table
+# and any custom product fields added by this publisher
+
+set selection [ns_db 0or1row $db "select *
+from ec_products p, ec_custom_product_field_values v
+where p.product_id=$product_id
+and p.product_id = v.product_id"]
+
+if {$selection == ""} {
+    set selection [ns_db 0or1row $db "select *
+    from ec_products p
+    where p.product_id=$product_id"]
+}
+
+
+if { $selection == "" } {
+    ns_return 200 text/html "[ad_header "Product Not Found"]The product you have requested was not found in the database.  Please contact <a href=\"mailto:[ec_system_owner]\"><address>[ec_system_owner]</address></a> to report the error."
+    return
+}
+
+set_variables_after_query
+
+
+if { ![empty_string_p $template_id] } {
+
+    # Template specified by Url
+
+    set template [database_to_tcl_string $db "select template from ec_templates where template_id=$template_id"]
+
+} else {
+
+    # Template specified by Product category
+
+    set template_list [database_to_tcl_list $db "
+SELECT template FROM ec_templates t, ec_category_template_map ct, ec_category_product_map cp
+ WHERE t.template_id = ct.template_id
+   AND ct.category_id = cp.category_id
+   AND cp.product_id = $QQproduct_id"]
+
+    set template [lindex $template_list 0]
+
+    if [empty_string_p $template] {
+
+	# Template specified by... well, just use the default
+
+	set template [database_to_tcl_string $db "select template from ec_templates where template_id=(select default_template from ec_admin_settings)"]
+    }
+}
+
+ReturnHeaders
+ns_write [ns_adp_parse -string $template]
Index: web/openacs/www/ecommerce/review-submit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/review-submit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/review-submit-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,53 @@
+# review-submit-2.tcl,v 3.0 2000/02/06 03:39:34 ron Exp
+set_the_usual_form_variables
+# product_id, rating, one_line_summary, user_comment
+# possibly usca_p
+
+validate_integer product_id $product_id
+
+# we need them to be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]?[export_entire_form_as_url_vars]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+set exception_text ""
+set exception_count 0
+
+if { ![info exists rating] || [empty_string_p $rating] } {
+    append exception_text "<li>Please select a rating for the product.\n"
+    incr exception_count
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# user session tracking
+set user_session_id [ec_get_user_session_id]
+
+set db [ns_db gethandle]
+ec_create_new_session_if_necessary [export_entire_form_as_url_vars]
+# type2
+
+set product_name [database_to_tcl_string $db "select product_name from ec_products where product_id=$product_id"]
+set comment_id [database_to_tcl_string $db "select ec_product_comment_id_sequence.nextval from dual"]
+
+set hidden_form_variables [export_form_vars product_id rating one_line_summary user_comment comment_id]
+
+set review_as_it_will_appear "<b><a href=\"/shared/community-member.tcl?[export_url_vars user_id]\">[database_to_tcl_string $db "select email from users where user_id=$user_id"]</a></b> 
+rated this product  
+[ec_display_rating $rating] on <i>[database_to_tcl_string $db "select to_char(sysdate(),'Day Month DD, YYYY') from dual"]</i> and wrote:<br>
+<b>$one_line_summary</b><br>
+[ec_display_as_html $user_comment]
+"
+
+set system_name [ad_system_name]
+
+ad_return_template
Index: web/openacs/www/ecommerce/review-submit-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/review-submit-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/review-submit-3.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,43 @@
+# review-submit-3.tcl,v 3.0 2000/02/06 03:39:36 ron Exp
+set_the_usual_form_variables
+# product_id, rating, one_line_summary, user_comment, comment_id
+# possibly usca_p
+
+validate_integer comment_id $comment_id
+validate_integer product_id $product_id
+
+# we need them to be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+
+    set return_url "[ns_conn url]?[export_url_vars product_id prev_page_url prev_args_list altered_prev_args_list rating one_line_summary user_comment comment_id]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# user session tracking
+set user_session_id [ec_get_user_session_id]
+
+set db [ns_db gethandle]
+ec_create_new_session_if_necessary [export_entire_form_as_url_vars]
+# type2
+
+# see if the review is already in there, meaning they pushed reload,
+# in which case, just show the thank you message, otherwise insert the
+# review
+if { [database_to_tcl_string $db "select count(*) from ec_product_comments where comment_id = $comment_id"] == 0 } {
+    ns_db dml $db "insert into ec_product_comments
+(comment_id, product_id, user_id, user_comment, one_line_summary, rating, comment_date, last_modified, last_modifying_user, modified_ip_address)
+values
+($comment_id, $product_id, $user_id, '$QQuser_comment', '$QQone_line_summary', $rating, sysdate(), sysdate(), $user_id, '[DoubleApos [ns_conn peeraddr]]')
+"
+}
+
+set product_name [database_to_tcl_string $db "select product_name from ec_products where product_id=$product_id"]
+set comments_need_approval [ad_parameter ProductCommentsNeedApprovalP ecommerce]
+set system_owner_email [ec_system_owner]
+set product_link "product.tcl?[export_url_vars product_id]"
+
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/ecommerce/review-submit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/review-submit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/review-submit.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,33 @@
+# review-submit.tcl,v 3.0 2000/02/06 03:39:37 ron Exp
+set_the_usual_form_variables
+# product_id
+# possibly usca_p
+
+validate_integer product_id $product_id
+
+# we need them to be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]?[export_url_vars product_id prev_page_url prev_args_list]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# user session tracking
+set user_session_id [ec_get_user_session_id]
+
+set db [ns_db gethandle]
+ec_create_new_session_if_necessary [export_entire_form_as_url_vars]
+# type2
+
+ec_log_user_as_user_id_for_this_session
+
+set product_name [database_to_tcl_string $db "select product_name from ec_products where product_id=$product_id"]
+lappend altered_prev_args_list $product_name
+
+set rating_widget [ec_rating_widget]
+
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/ecommerce/shipping-address-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/shipping-address-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/shipping-address-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,70 @@
+# shipping-address-2.tcl,v 3.1 2000/03/07 03:47:14 eveander Exp
+set_the_usual_form_variables
+# attn, line1, line2, city, usps_abbrev, zip_code, phone, phone_time
+
+# attn, line1, city, usps_abbrev, zip_code, phone are mandatory
+
+set possible_exception_list [list [list attn name] [list line1 address] [list city city] [list usps_abbrev state] [list zip_code "zip code"] [list phone "telephone number"]]
+
+set exception_count 0
+set exception_text ""
+
+foreach possible_exception $possible_exception_list {
+    if { ![info exists [lindex $possible_exception 0]] || [empty_string_p [set [lindex $possible_exception 0]]] } {
+	incr exception_count
+	append exception_text "<li>You forgot to enter your [lindex $possible_exception 1]."
+    }
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# we need them to be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]?[export_entire_form_as_url_vars]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# make sure they have an in_basket order, otherwise they've probably
+# gotten here by pushing Back, so return them to index.tcl
+
+set user_session_id [ec_get_user_session_id]
+
+set db [ns_db gethandle]
+
+set order_id [database_to_tcl_string_or_null $db "select order_id from ec_orders where user_session_id=$user_session_id and order_state='in_basket'"]
+
+if { [empty_string_p $order_id] } {
+    # then they probably got here by pushing "Back", so just redirect them
+    # to index.tcl
+    ns_returnredirect index.tcl
+    return
+}
+
+set address_id [database_to_tcl_string $db "select ec_address_id_sequence.nextval from dual"]
+
+ns_db dml $db "begin transaction"
+
+ns_db dml $db "insert into ec_addresses
+(address_id, user_id, address_type, attn, line1, line2, city, usps_abbrev, zip_code, country_code, phone, phone_time)
+values
+($address_id, $user_id, 'shipping', '$QQattn', '$QQline1','$QQline2','$QQcity','$QQusps_abbrev','$QQzip_code','us','$QQphone','$QQphone_time')
+"
+
+ns_db dml $db "update ec_orders set shipping_address=$address_id where order_id=$order_id"
+
+ns_db dml $db "end transaction"
+
+if { [ad_ssl_available_p] } {
+    ns_returnredirect "https://[ns_config ns/server/[ns_info server]/module/nsssl Hostname]/ecommerce/checkout-2.tcl"
+} else {
+    ns_returnredirect "http://[ns_config ns/server/[ns_info server]/module/nssock Hostname]/ecommerce/checkout-2.tcl"
+}
+
Index: web/openacs/www/ecommerce/shipping-address-international-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/shipping-address-international-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/shipping-address-international-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,69 @@
+# shipping-address-international-2.tcl,v 3.1 2000/03/07 03:47:07 eveander Exp
+set_the_usual_form_variables
+# attn, line1, line2, city, full_state_name, zip_code, country_code, phone, phone_time
+
+# attn, line1, city, country_code, phone are mandatory
+
+set possible_exception_list [list [list attn name] [list line1 address] [list city city] [list country_code country] [list phone "telephone number"]]
+
+set exception_count 0
+set exception_text ""
+
+foreach possible_exception $possible_exception_list {
+    if { ![info exists [lindex $possible_exception 0]] || [empty_string_p [set [lindex $possible_exception 0]]] } {
+	incr exception_count
+	append exception_text "<li>You forgot to enter your [lindex $possible_exception 1]."
+    }
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# we need them to be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]?[export_entire_form_as_url_vars]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# make sure they have an in_basket order, otherwise they've probably
+# gotten here by pushing Back, so return them to index.tcl
+
+set user_session_id [ec_get_user_session_id]
+
+set db [ns_db gethandle]
+
+set order_id [database_to_tcl_string_or_null $db "select order_id from ec_orders where user_session_id=$user_session_id and order_state='in_basket'"]
+
+if { [empty_string_p $order_id] } {
+    # then they probably got here by pushing "Back", so just redirect them
+    # to index.tcl
+    ns_returnredirect index.tcl
+    return
+}
+
+set address_id [database_to_tcl_string $db "select ec_address_id_sequence.nextval from dual"]
+
+ns_db dml $db "begin transaction"
+
+ns_db dml $db "insert into ec_addresses
+(address_id, user_id, address_type, attn, line1, line2, city, full_state_name, zip_code, country_code, phone, phone_time)
+values
+($address_id, $user_id, 'shipping', '$QQattn', '$QQline1','$QQline2','$QQcity','$QQfull_state_name','$QQzip_code','$QQcountry_code','$QQphone','$QQphone_time')
+"
+
+ns_db dml $db "update ec_orders set shipping_address=$address_id where order_id=$order_id"
+
+ns_db dml $db "end transaction"
+
+if { [ad_ssl_available_p] } {
+    ns_returnredirect "https://[ns_config ns/server/[ns_info server]/module/nsssl Hostname]/ecommerce/checkout-2.tcl"
+} else {
+    ns_returnredirect "http://[ns_config ns/server/[ns_info server]/module/nssock Hostname]/ecommerce/checkout-2.tcl"
+}
Index: web/openacs/www/ecommerce/shipping-address-international.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/shipping-address-international.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/shipping-address-international.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,27 @@
+# shipping-address-international.tcl,v 3.0 2000/02/06 03:39:41 ron Exp
+set_form_variables 0
+# possibly usca_p
+
+# we need them to be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# user session tracking
+set user_session_id [ec_get_user_session_id]
+
+set db [ns_db gethandle]
+ec_create_new_session_if_necessary
+# type1
+
+set user_name_with_quotes_escaped [philg_quote_double_quotes [database_to_tcl_string $db "select first_names || ' ' || last_name as name from users where user_id=$user_id"]]
+
+set country_widget [ec_country_widget $db ""]
+
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/ecommerce/shipping-address.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/shipping-address.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/shipping-address.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,29 @@
+# shipping-address.tcl,v 3.0 2000/02/06 03:39:42 ron Exp
+set_form_variables 0
+# possibly usca_p
+
+# we need them to be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# user session tracking
+set user_session_id [ec_get_user_session_id]
+
+set db [ns_db gethandle]
+ec_create_new_session_if_necessary
+# type1
+
+ec_log_user_as_user_id_for_this_session
+
+set user_name_with_quotes_escaped [philg_quote_double_quotes [database_to_tcl_string $db "select first_names || ' ' || last_name as name from users where user_id=$user_id"]]
+
+set state_widget [state_widget $db]
+
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/ecommerce/shopping-cart-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/shopping-cart-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/shopping-cart-add.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,97 @@
+# shopping-cart-add.tcl,v 3.1 2000/03/07 03:45:58 eveander Exp
+set_the_usual_form_variables
+# product_id, size_choice, color_choice, style_choice
+# possibly usca_p
+
+validate_integer product_id $product_id
+
+## This adds an item to an 'in_basket' order, although if there exists a 'confirmed'
+## order for this user_session_id, the user is told they have to wait because
+## 'confirmed' orders can potentially become 'in_basket' orders (if authorization
+## fails), and we can only have one 'in_basket' order for this user_session_id at
+## a time.  Most orders are only in the 'confirmed' state for a few seconds, except
+## for those whose credit card authorizations are inconclusive.  Furthermore, it is
+## unlikely for a user to start adding things to their shopping cart right after they've
+## made an order.  So this case is unlikely to occur often.  I will include a ns_log Notice
+## so that any occurrences will be logged.
+
+set db [ns_db gethandle]
+
+# 1. get user_session_id
+# 1.5 see if there exists a 'confirmed' order for this user_session_id
+# 2. get order_id
+# 3. get item_id
+# 4. put item into ec_items, unless there is already an item with that product_id
+#    in that order (this is double click protection -- the only way they can increase
+#    the quantity of a product in their order is to click on "update quantities" on
+#    the shopping cart page (shopping-cart.tcl)
+# 5. ns_returnredirect them to their shopping cart
+
+set user_session_id [ec_get_user_session_id]
+
+ec_create_new_session_if_necessary [export_url_vars product_id]
+
+set n_confirmed_orders [database_to_tcl_string $db "select count(*) from ec_orders where user_session_id=$user_session_id and order_state='confirmed'"]
+
+if { $n_confirmed_orders > 0 } {
+    ad_return_complaint 1 "Sorry, you have an order for which credit card authorization has not yet taken place. Please wait for the authorization to complete before adding new items to your shopping cart. Thank you."
+    return
+}
+
+set order_id [database_to_tcl_string_or_null $db "select order_id from ec_orders where user_session_id=$user_session_id and order_state='in_basket'"]
+
+# This wasn't quite safe (e.g. if an in_basket order gets inserted between
+# the beginning of the if statement and the insert statement).
+
+# if { [empty_string_p $order_id] } {
+#     set order_id [database_to_tcl_string $db "select ec_order_id_sequence.nextval from dual"]
+#     # create the order
+#     ns_db dml $db "insert into ec_orders
+#     (order_id, user_session_id, order_state, in_basket_date)
+#     values
+#     ($order_id, $user_session_id, 'in_basket', sysdate)
+#     "
+# }
+
+# Here's the airtight way to do it: do the check on order_id, then insert
+# a new order where there doesn't exist an old one, then set order_id again
+# (because the correct order_id might not be the one set inside the if 
+# statement).  It should now be impossible for order_id to be the empty
+# string (if it is, log the error and redirect them to product.tcl).
+
+if { [empty_string_p $order_id] } {
+     set order_id [database_to_tcl_string $db "select ec_order_id_sequence.nextval from dual"]
+    # create the order (iff an in_basket order *still* doesn't exist)
+    ns_db dml $db "insert into ec_orders
+    (order_id, user_session_id, order_state, in_basket_date)
+    select $order_id, $user_session_id, 'in_basket', sysdate() from dual
+    where not exists (select 1 from ec_orders where user_session_id=$user_session_id and order_state='in_basket')"
+
+    # now either an in_basket order should have been inserted by the above
+    # statement or it was inserted by a different thread milliseconds ago
+    set order_id [database_to_tcl_string_or_null $db "select order_id from ec_orders where user_session_id=$user_session_id and order_state='in_basket'"]
+
+    if { [empty_string_p $order_id] } {
+	# I don't expect this to ever happen, but just in case, I'll log
+	# the problem and redirect them to product.tcl
+	ns_db dml $db "insert into ec_problems_log
+	(problem_id, problem_date, problem_details)
+	values
+	(nextval('ec_problem_id_sequence'), sysdate(), 'Null order_id on shopping-cart-add.tcl for user_session_id $user_session_id.  Please report this problem to eveander@arsdigita.com.')"
+	ns_returnredirect "product.tcl?[export_url_vars product_id]"
+	return
+    }
+}
+
+# Insert an item into that order iff an identical item doesn't
+# exist (this is double click protection).
+# If they want to update quantities, they can do so from the
+# shopping cart page.
+
+ns_db dml $db "insert into ec_items
+(item_id, product_id, color_choice, size_choice, style_choice, order_id, in_cart_date)
+select nextval('ec_item_id_sequence'), $product_id, '$QQcolor_choice', '$QQsize_choice', '$QQstyle_choice', $order_id, sysdate() from dual
+   where not exists (select 1 from ec_items where order_id=$order_id and product_id=$product_id and color_choice [ec_decode $color_choice "" "is null" "= '[DoubleApos $color_choice]'"] and size_choice [ec_decode $size_choice "" "is null" "= '[DoubleApos $size_choice]'"] and style_choice [ec_decode $style_choice "" "is null" "= '[DoubleApos $style_choice]'"])
+"
+
+ns_returnredirect shopping-cart.tcl
Index: web/openacs/www/ecommerce/shopping-cart-delete-from.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/shopping-cart-delete-from.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/shopping-cart-delete-from.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,22 @@
+# shopping-cart-delete-from.tcl,v 3.0 2000/02/06 03:39:45 ron Exp
+set_the_usual_form_variables
+# product_id
+
+validate_integer product_id $product_id
+
+set user_session_id [ec_get_user_session_id]
+
+set db [ns_db gethandle]
+
+set order_id [database_to_tcl_string_or_null $db "select order_id from ec_orders where user_session_id=$user_session_id and order_state='in_basket'"]
+
+if { [empty_string_p $order_id] } {
+    # then they probably got here by pushing "Back", so just redirect them
+    # into their empty shopping cart
+    ns_returnredirect shopping-cart.tcl
+    return
+}
+
+ns_db dml $db "delete from ec_items where order_id=$order_id and product_id=$product_id"
+
+ns_returnredirect shopping-cart.tcl
Index: web/openacs/www/ecommerce/shopping-cart-quantities-change.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/shopping-cart-quantities-change.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/shopping-cart-quantities-change.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,149 @@
+# shopping-cart-quantities-change.tcl,v 3.1 2000/03/07 03:45:46 eveander Exp
+set_the_usual_form_variables
+# quantity([list $product_id $color_choice $size_choice $style_choice]) for each of
+# the products in the cart and possibly return_url (because both shopping-cart.tcl and 
+# process-order-quantity-payment-shipping.tcl send quantities through this script
+
+# find the user_session_id and the order_id and then the product_ids in this
+# user's shopping basket
+
+set user_session_id [ec_get_user_session_id]
+
+set db [ns_db gethandle]
+
+if { $user_session_id == 0 } {
+    ns_return 200 text/html "[ad_header "No Cart Found"]<h2>No Shopping Cart Found</h2>
+    <p>
+    We could not find any shopping cart for you.  This may be because you have cookies 
+    turned off on your browser.  Cookies are necessary in order to have a shopping cart
+    system so that we can tell which items are yours.
+
+    <p>
+    <i>In Netscape 4.0, you can enable cookies from Edit -> Preferences -> Advanced. <br>
+
+    In Microsoft Internet Explorer 4.0, you can enable cookies from View -> 
+    Internet Options -> Advanced -> Security. </i>
+
+    <p>
+
+    [ec_continue_shopping_options $db]
+    "
+    return
+}
+
+set order_id [database_to_tcl_string_or_null $db "select order_id from ec_orders where order_state='in_basket' and user_session_id=$user_session_id"]
+
+# if order_id is null, this probably means that they got to this page by pushing back
+# so just return them to their empty cart
+
+if { [empty_string_p $order_id] } {
+    ns_returnredirect "shopping-cart.tcl"
+    return
+}
+
+set product_color_size_style_list [array names quantity]
+  
+# set product_id_list [database_to_tcl_list $db "select unique product_id from ec_items where order_id=$order_id"]
+  
+# # if product_id_list is empty, this probably means that they got to this page by pushing back
+# # so just return them to their empty cart
+  
+# if { [llength $product_id_list] == 0 } {
+#     ns_returnredirect "shopping-cart.tcl"
+#     return
+# }
+
+# now for the kind of tricky part: determine the quantity of each product (w/same color,size,style)
+# in this order in the ec_items table, compare it with quantity([list $product_id $color_choice $size_choice $style_choice]),
+# and then either add or remove the appropriate number of rows in ec_items
+
+set selection [ns_db select $db "select i.product_id, i.color_choice, i.size_choice, i.style_choice, count(*) as r_quantity
+from ec_orders o, ec_items i
+where o.order_id=i.order_id
+and o.user_session_id=$user_session_id and o.order_state='in_basket'
+group by i.product_id, i.color_choice, i.size_choice, i.style_choice"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    set real_quantity([list $product_id $color_choice $size_choice $style_choice]) $r_quantity
+}
+
+
+ns_db dml $db "begin transaction"
+
+foreach product_color_size_style $product_color_size_style_list {
+    # quantity_to_add might be negative
+    # also there are two special cases that may come about, for instace,
+    # when a user pushes "Back" to get here after having altered their cart
+    # (1) if quantity($product_id) exists but real_quantity($product_id)
+    #     doesn't exist, then ignore it (we're going to miss that
+    #     product_id anyway when looping through product_id_list)
+    # (2) if real_quantity($product_id) exists but quantity($product_id)
+    #     doesn't exist then quantity_to_add will be 0
+    
+    set product_id [lindex $product_color_size_style 0]
+    set color_choice [lindex $product_color_size_style 1]
+    set size_choice [lindex $product_color_size_style 2]
+    set style_choice [lindex $product_color_size_style 3]
+
+    if { [info exists quantity($product_color_size_style)] } {
+	if { [regexp {[^0-9]} $quantity($product_color_size_style)] } {
+	    # if the new quantity is non-numeric, just leave the quantity alone
+	    set quantity_to_add 0
+	} else {
+	    # if real_quantity([list $product_id $color_choice $size_choice $style_choice])
+	    # doesn't exist, that means that the products on the form don't correspond to
+	    # the products in the database, which implies that they had submitted an
+	    # out-of-date shopping-cart.tcl form, so just redirect them to shopping-cart.tcl
+	    
+	    if { ![info exists real_quantity([list $product_id $color_choice $size_choice $style_choice])] } {
+		if { [info exists return_url] } {
+		    ns_returnredirect $return_url
+		} else {
+		    ns_returnredirect shopping-cart.tcl
+		}
+		return
+	    }
+
+	    set quantity_to_add "[expr $quantity($product_color_size_style) - $real_quantity([list $product_id $color_choice $size_choice $style_choice])]"
+	}
+    } else {
+	set quantity_to_add 0
+    }
+
+    if { $quantity_to_add > 0 } {
+	set remaining_quantity $quantity_to_add
+	while { $remaining_quantity > 0 } {
+	    ns_db dml $db "insert into ec_items
+	    (item_id, product_id, color_choice, size_choice, style_choice, order_id, in_cart_date)
+	    values
+	    (nextval('ec_item_id_sequence'), $product_id, '[DoubleApos $color_choice]', '[DoubleApos $size_choice]', '[DoubleApos $style_choice]', $order_id, sysdate())
+	    "
+	    set remaining_quantity [expr $remaining_quantity - 1]
+	}
+    } elseif { $quantity_to_add < 0 } {
+	set remaining_quantity [expr abs($quantity_to_add)]
+	
+	set rows_to_delete [list]
+	while { $remaining_quantity > 0 } {
+	    # determine the rows to delete in ec_items (the last instance of this product within this order)
+	    if { [llength $rows_to_delete] > 0 } {
+		set extra_condition "and item_id not in ([join $rows_to_delete ", "])"
+	    } else {
+		set extra_condition ""
+	    }
+	    lappend rows_to_delete [database_to_tcl_string $db "select max(item_id) from ec_items where product_id=$product_id and color_choice [ec_decode $color_choice "" "is null" "= '[DoubleApos $color_choice]'"] and size_choice [ec_decode $size_choice "" "is null" "= '[DoubleApos $size_choice]'"] and style_choice [ec_decode $style_choice "" "is null" "= '[DoubleApos $style_choice]'"] and order_id=$order_id $extra_condition"]
+	    set remaining_quantity [expr $remaining_quantity - 1]
+	}
+	ns_db dml $db "delete from ec_items where item_id in ([join $rows_to_delete ", "])"
+    }
+    # otherwise, do nothing
+}
+
+ns_db dml $db "end transaction"
+
+if { [info exists return_url] } {
+    ns_returnredirect $return_url
+} else {
+    ns_returnredirect shopping-cart.tcl
+}
Index: web/openacs/www/ecommerce/shopping-cart-retrieve-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/shopping-cart-retrieve-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/shopping-cart-retrieve-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,64 @@
+# shopping-cart-retrieve-2.tcl,v 3.1 2000/03/07 08:15:04 eveander Exp
+set_form_variables 0
+# possibly usca_p
+
+# we need them to be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# Cases that have to be dealt with:
+# 1. User has no saved carts.
+# 2. User has saved cart(s) and no current cart.
+# 3. User has saved cart(s) and one current cart.
+
+set saved_carts ""
+
+# user session tracking
+set user_session_id [ec_get_user_session_id]
+
+set db [ns_db gethandle]
+
+ec_create_new_session_if_necessary "" shopping_cart_required
+# typeA
+
+set selection [ns_db select $db "select to_char(o.in_basket_date,'Month DD, YYYY') as formatted_in_basket_date, o.in_basket_date, o.order_id, count(*) as n_products
+from ec_orders o, ec_items i
+where user_id=$user_id
+and order_state='in_basket'
+and saved_p='t'
+and i.order_id=o.order_id
+group by o.order_id, to_char(o.in_basket_date,'Month DD, YYYY'), o.in_basket_date
+order by o.in_basket_date"]
+
+set cart_counter 0
+while { [ns_db getrow $db $selection] } {
+    incr cart_counter
+    set_variables_after_query
+
+    ## Pgsql 6.x hack for groupby (BMA)
+    if {$order_id == ""} {
+	continue
+    }
+
+    append saved_carts "<form method=post action=\"shopping-cart-retrieve-3.tcl\">
+    [export_form_vars order_id]
+    <li>$formatted_in_basket_date, $n_products item(s)
+    <input type=submit name=submit value=\"View\">
+    <input type=submit name=submit value=\"Retrieve\">
+    <input type=submit name=submit value=\"Discard\">
+    </form>
+    "
+}
+
+if {[empty_string_p $saved_carts] } {
+    append saved_carts "No shopping carts were found.\n"
+}
+
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/ecommerce/shopping-cart-retrieve-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/shopping-cart-retrieve-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/shopping-cart-retrieve-3.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,298 @@
+# shopping-cart-retrieve-3.tcl,v 3.1 2000/03/07 08:20:22 eveander Exp
+set_the_usual_form_variables
+# order_id, submit
+# possibly discard_confirmed_p
+# possibly usca_p
+
+validate_integer order_id $order_id
+
+# This script performs five functions, depending on which submit button
+# the user pushed.  It either displays the contents of a cart, retrieves
+# a cart (no current cart to get in the way), merges a saved cart with
+# a current cart, replaces a current cart with a saved cart, or discards a
+# saved cart.
+
+# we need them to be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+set db [ns_db gethandle]
+
+# make sure order exists (they might have discarded it then pushed back)
+if { 0 == [database_to_tcl_string $db "select count(*) from ec_orders where order_id=$order_id"] } {
+    ns_returnredirect shopping-cart.tcl
+    return
+}
+
+
+# make sure this order is theirs
+
+set order_theirs_p [database_to_tcl_string $db "select count(*) from ec_orders where order_id=$order_id and user_id=$user_id"]
+
+if { !$order_theirs_p } {
+    ns_return 200 text/html "[ad_header "Invalid Order"]<h2>Invalid Order</h2>The order you have selected either does not exist or does not belong to you.  Please contact <A HREF=\"mailto:[ec_system_owner]\">[ec_system_owner]</A> if this is incorrect.[ec_footer $db]"
+    return
+}
+
+# make sure the order is still a "saved shopping basket", otherwise they may have
+# have gotten here by pushing "Back"
+
+if { 0 == [database_to_tcl_string $db "select count(*) from ec_orders where order_id=$order_id and order_state='in_basket' and saved_p='t'"] } {
+    ns_returnredirect "shopping-cart.tcl"
+    return
+}
+
+# end security checks
+
+set user_session_id [ec_get_user_session_id]
+
+ec_create_new_session_if_necessary [export_url_vars order_id submit discard_confirmed_p] shopping_cart_required
+
+# Possible values of submit:
+# View, Retrieve, Merge, Replace, Discard
+
+if { $submit == "View" } {
+
+    set page_title "Your Saved Shopping Cart"
+    set page_function "view"
+    set shopping_cart_items ""
+    set hidden_form_variables [export_form_vars order_id]
+
+    set saved_date [database_to_tcl_string $db "select to_char(in_basket_date,'Month DD, YYYY') as formatted_in_basket_date from ec_orders where order_id=$order_id"]
+    set selection [ns_db select $db "select p.product_name, p.one_line_description, p.product_id, i.color_choice, i.size_choice, i.style_choice, count(*) as quantity
+    from ec_orders o, ec_items i, ec_products p
+    where i.product_id=p.product_id
+    and o.order_id=i.order_id
+    and o.order_id=$order_id
+    group by p.product_name, p.one_line_description, p.product_id, i.color_choice, i.size_choice, i.style_choice"]
+    
+    set product_counter 0
+    while { [ns_db getrow $db $selection] } {
+	set_variables_after_query
+	
+	if { $product_counter == 0 } {
+	    append shopping_cart_items "<tr bgcolor=\"cccccc\"><td>Shopping Cart Items</td><td>Options</td><td>Qty.</td><td>&nbsp;</td></tr>\n"
+	}
+	
+	set option_list [list]
+	if { ![empty_string_p $color_choice] } {
+	    lappend option_list "Color: $color_choice"
+	}
+	if { ![empty_string_p $size_choice] } {
+	    lappend option_list "Size: $size_choice"
+	}
+	if { ![empty_string_p $style_choice] } {
+	    lappend option_list "Style: $style_choice"
+	}
+	set options [join $option_list "<br>"]
+	
+	append shopping_cart_items "<tr><td>
+	<a href=\"product.tcl?product_id=$product_id\">$product_name</a><br>
+	$one_line_description</td>
+	<td>$options</td>
+	<td>$quantity</td>
+	</tr>
+	"
+	incr product_counter
+    }
+
+    ad_return_template
+    return
+
+} elseif { $submit == "Retrieve" } {
+    # first see if they already have a non-empty shopping basket, in which
+    # case we'll have to find out whether they want us to merge the two
+    # baskets or replace the current basket with the saved one
+    
+    set n_current_baskets [database_to_tcl_string $db "select count(*) from ec_orders where order_state='in_basket' and user_session_id=$user_session_id"]
+
+    if { $n_current_baskets == 0 } {
+	# the easy case
+	ns_db dml $db "begin transaction"
+	ns_db dml $db "update ec_orders set user_session_id=$user_session_id, saved_p='f' where order_id=$order_id"
+	# Well, the case *was* easy, but now we have to deal with special offer codes;
+	# we want to put any special offer codes the user had in a previous session into
+	# this session so that a retrieved cart doesn't end up having higher prices than
+	# it had before (it is possible that it will have lower prices).
+	# If they have more than one offer code for the same product, I'll put the lowest
+	# priced current offer into ec_user_session_offer_codes.
+
+	set selection [ns_db select $db "select o.offer_code, o.product_id
+	from ec_user_sessions s, ec_user_session_offer_codes o, ec_sale_prices_current p
+	where p.offer_code=o.offer_code
+	and s.user_session_id=o.user_session_id
+	and s.user_id=$user_id
+	order by p.sale_price"]
+
+	set offer_and_product_list [list]
+	while { [ns_db getrow $db $selection] } {
+	    set_variables_after_query
+	    lappend offer_and_product_list [list $offer_code $product_id]
+	}
+
+	# delete any current offer codes so no unique constraints will be violated
+	# (they'll be re-added anyway if they're the best offer the user has for the product)
+
+	ns_db dml $db "delete from ec_user_session_offer_codes where user_session_id=$user_session_id"
+
+	set old_offer_and_product_list [list "" ""]
+	foreach offer_and_product $offer_and_product_list {
+	    # insert it if the product hasn't been inserted before
+	    if { [string compare [lindex $old_offer_and_product_list 1] [lindex $offer_and_product_list 1]] != 0 } {
+		ns_db dml $db "insert into ec_user_session_offer_codes
+		(user_session_id, product_id, offer_code)
+		values
+		($user_session_id, [lindex $offer_and_product 1], '[DoubleApos [lindex $offer_and_product 0]]')
+		"
+	    }
+	    set old_offer_and_product_list $offer_and_product_list
+	}
+
+	ns_db dml $db "end transaction"
+	ns_returnredirect "shopping-cart.tcl"
+	return
+    } else {
+	# the hard case
+	# either they can merge their saved order with their current basket, or
+	# they can replace their current basket with the saved order
+
+	set page_title "Merge or Replace Your Current Shopping Cart?"
+	set page_function "retrieve"
+	set hidden_form_variables [export_form_vars order_id]
+
+	ad_return_template
+	return
+    }
+} elseif { $submit == "Merge" } {
+    # update all the items in the old order so that they belong to
+    # the current shopping basket
+    
+    # determine the current shopping basket
+    # (I use _or_null) in case they got here by pushing "Back"
+    set current_basket [database_to_tcl_string_or_null $db "select order_id from ec_orders where user_session_id=$user_session_id and order_state='in_basket'"]
+    if { [empty_string_p $current_basket] } {
+	ns_returnredirect shopping-cart.tcl
+	return
+    }
+    ns_db dml $db "begin transaction"
+    ns_db dml $db "update ec_items set order_id=$current_basket where order_id=$order_id"
+
+    # the same offer code thing as above
+    set selection [ns_db select $db "select o.offer_code, o.product_id
+    from ec_user_sessions s, ec_user_session_offer_codes o, ec_sale_prices_current p
+    where p.offer_code=o.offer_code
+    and s.user_session_id=o.user_session_id
+    and s.user_id=$user_id
+    order by p.sale_price"]
+    
+    set offer_and_product_list [list]
+    while { [ns_db getrow $db $selection] } {
+	set_variables_after_query
+	lappend offer_and_product_list [list $offer_code $product_id]
+    }
+    
+    # delete any current offer codes so no unique constraints will be violated
+    # (they'll be re-added anyway if they're the best offer the user has for the product)
+    
+    ns_db dml $db "delete from ec_user_session_offer_codes where user_session_id=$user_session_id"
+    
+    set old_offer_and_product_list [list "" ""]
+    foreach offer_and_product $offer_and_product_list {
+	# insert it if the product hasn't been inserted before
+	if { [string compare [lindex $old_offer_and_product_list 1] [lindex $offer_and_product_list 1]] != 0 } {
+	    ns_db dml $db "insert into ec_user_session_offer_codes
+	    (user_session_id, product_id, offer_code)
+	    values
+	    ($user_session_id, [lindex $offer_and_product 1], '[DoubleApos [lindex $offer_and_product 0]]')
+	    "
+	}
+	set old_offer_and_product_list $offer_and_product_list
+    }
+    ns_db dml $db "end transaction"
+    ns_returnredirect shopping-cart.tcl
+    return
+} elseif { $submit == "Replace" } {
+    # delete the items in the current basket and update the items in the saved order so
+    # that they're in the current basket
+
+    # determine the current shopping basket
+    # (I use _or_null) in case they got here by pushing "Back"
+    set current_basket [database_to_tcl_string_or_null $db "select order_id from ec_orders where user_session_id=$user_session_id and order_state='in_basket'"]
+    if { [empty_string_p $current_basket] } {
+	ns_returnredirect shopping-cart.tcl
+	return
+    }
+
+    ns_db dml $db "begin transaction"
+    ns_db dml $db "delete from ec_items where order_id=$current_basket"
+    ns_db dml $db "update ec_items set order_id=$current_basket where order_id=$order_id"
+
+    # the same offer code thing as above
+    set selection [ns_db select $db "select o.offer_code, o.product_id
+    from ec_user_sessions s, ec_user_session_offer_codes o, ec_sale_prices_current p
+    where p.offer_code=o.offer_code
+    and s.user_session_id=o.user_session_id
+    and s.user_id=$user_id
+    order by p.sale_price"]
+    
+    set offer_and_product_list [list]
+    while { [ns_db getrow $db $selection] } {
+	set_variables_after_query
+	lappend offer_and_product_list [list $offer_code $product_id]
+    }
+    
+    # delete any current offer codes so no unique constraints will be violated
+    # (they'll be re-added anyway if they're the best offer the user has for the product)
+    
+    ns_db dml $db "delete from ec_user_session_offer_codes where user_session_id=$user_session_id"
+    
+    set old_offer_and_product_list [list "" ""]
+    foreach offer_and_product $offer_and_product_list {
+	# insert it if the product hasn't been inserted before
+	if { [string compare [lindex $old_offer_and_product_list 1] [lindex $offer_and_product_list 1]] != 0 } {
+	    ns_db dml $db "insert into ec_user_session_offer_codes
+	    (user_session_id, product_id, offer_code)
+	    values
+	    ($user_session_id, [lindex $offer_and_product 1], '[DoubleApos [lindex $offer_and_product 0]]')
+	    "
+	}
+	set old_offer_and_product_list $offer_and_product_list
+    }
+    ns_db dml $db "end transaction"
+    
+    ns_returnredirect shopping-cart.tcl
+    return
+} elseif { $submit == "Discard" } {
+    if { [info exists discard_confirmed_p] && $discard_confirmed_p == "t" } {
+	ns_db dml $db "begin transaction"
+	ns_db dml $db "delete from ec_items where order_id=$order_id"
+	ns_db dml $db "delete from ec_orders where order_id=$order_id"
+	ns_db dml $db "end transaction"
+	ns_returnredirect "shopping-cart.tcl"
+	return
+    }
+    # otherwise I have to give them a confirmation page
+
+    set page_title "Discard Your Saved Shopping Cart?"
+    set page_function "discard"
+    set hidden_form_variables "[export_form_vars order_id]
+    [philg_hidden_input discard_confirmed_p "t"]"
+
+    ad_return_template
+    return
+} elseif { $submit == "Save it for Later" } {
+    ns_returnredirect "shopping-cart-retrieve-2.tcl"
+    return
+}
+
+# there shouldn't be any other cases, but log it if there are
+ns_log Notice "Error: /ecommerce/shopping-cart-retrieve-3.tcl was called with an unexpected value of submit: $submit"
+
+ns_returnredirect "shopping-cart.tcl"
\ No newline at end of file
Index: web/openacs/www/ecommerce/shopping-cart-retrieve.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/shopping-cart-retrieve.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/shopping-cart-retrieve.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,30 @@
+# shopping-cart-retrieve.tcl,v 3.0 2000/02/06 03:39:52 ron Exp
+set_form_variables 0
+# possibly usca_p
+
+# this page either redirects them to log on or asks them to confirm that
+# they are who we think they are
+
+set user_id [ad_verify_and_get_user_id]
+
+set return_url "[ad_parameter EcommercePath ecommerce]shopping-cart-retrieve-2.tcl"
+
+if {$user_id == 0} {
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# user session tracking
+set user_session_id [ec_get_user_session_id]
+
+set db [ns_db gethandle]
+
+ec_create_new_session_if_necessary "" shopping_cart_required
+# typeA
+
+ec_log_user_as_user_id_for_this_session
+
+set user_name [database_to_tcl_string $db "select first_names || ' ' || last_name as user_name from users where user_id=$user_id"]
+set register_link "/register.tcl?[export_url_vars return_url]"
+
+ad_return_template
Index: web/openacs/www/ecommerce/shopping-cart-save-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/shopping-cart-save-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/shopping-cart-save-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,46 @@
+# shopping-cart-save-2.tcl,v 3.0 2000/02/06 03:39:53 ron Exp
+# we need them to be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+set user_session_id [ec_get_user_session_id]
+
+set db [ns_db gethandle]
+
+if { $user_session_id == 0 } {
+    ns_return 200 text/html "[ad_header "No Cart Found"]<h2>No Shopping Cart Found</h2>
+    <p>
+    We could not find any shopping cart for you.  This may be because you have cookies 
+    turned off on your browser.  Cookies are necessary in order to have a shopping cart
+    system so that we can tell which items are yours.
+
+    <p>
+    <i>In Netscape 4.0, you can enable cookies from Edit -> Preferences -> Advanced. <br>
+
+    In Microsoft Internet Explorer 4.0, you can enable cookies from View -> 
+    Internet Options -> Advanced -> Security. </i>
+
+    <p>
+
+    [ec_continue_shopping_options $db]
+    "
+    return
+}
+
+# set the user_id of the order so that we'll know who it belongs to
+# and remove the user_session_id so that they can't mess with their
+# saved order (until they retrieve it, of course)
+
+ns_db dml $db "update ec_orders set user_id=$user_id, user_session_id=null, saved_p='t'
+where user_session_id=$user_session_id and order_state='in_basket'"
+
+# this should have only updated 1 row, or 0 if they reload, which is fine
+
+ad_return_template
Index: web/openacs/www/ecommerce/shopping-cart-save.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/shopping-cart-save.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/shopping-cart-save.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,19 @@
+# shopping-cart-save.tcl,v 3.0 2000/02/06 03:39:54 ron Exp
+# this page either redirects them to log on or asks them to confirm that
+# they are who we think they are
+
+set user_id [ad_verify_and_get_user_id]
+
+set return_url "[ad_parameter EcommercePath ecommerce]shopping-cart-save-2.tcl"
+
+if {$user_id == 0} {
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+set db [ns_db gethandle]
+
+set user_name [database_to_tcl_string $db "select first_names || ' ' || last_name as user_name from users where user_id=$user_id"]
+set register_link "/register.tcl?[export_url_vars return_url]"
+
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/ecommerce/shopping-cart.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/shopping-cart.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/shopping-cart.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,140 @@
+# shopping-cart.tcl,v 3.2 2000/03/07 07:49:13 eveander Exp
+set_form_variables 0
+# possibly usca_p
+
+set db_pools [ns_db gethandle [philg_server_default_pool] 2]
+set db [lindex $db_pools 0]
+set db_sub [lindex $db_pools 1]
+
+set cart_contents ""
+
+# we don't need them to be logged in, but if they are they might get a lower price
+set user_id [ad_verify_and_get_user_id]
+
+# user sessions:
+# 1. get user_session_id from cookie
+# 2. if user has no session (i.e. user_session_id=0), attempt to set it if it hasn't been
+#    attempted before
+# 3. if it has been attempted before, give them message that we can't do shopping carts
+#    without cookies
+
+set user_session_id [ec_get_user_session_id]
+
+ec_create_new_session_if_necessary
+
+set n_items_in_cart [database_to_tcl_string $db "select count(*) from
+ec_orders o, ec_items i
+where o.order_id=i.order_id
+and o.user_session_id=$user_session_id and o.order_state='in_basket'"]
+
+# set selection [ns_db select $db "select p.product_name, p.one_line_description, p.product_id, count(*) as quantity
+# from ec_orders o, ec_items i, ec_products p
+# where i.product_id=p.product_id
+# and o.order_id=i.order_id
+# and o.user_session_id=$user_session_id and o.order_state='in_basket'
+# group by p.product_name, p.one_line_description, p.product_id"]
+
+set selection [ns_db select $db "(select p.product_name, p.one_line_description, p.product_id, count(*) as quantity, u.offer_code, i.color_choice, i.size_choice, i.style_choice
+from ec_orders o, ec_items i, ec_products p, ec_user_session_offer_codes u
+where u.user_session_id= $user_session_id
+and i.product_id=p.product_id
+and o.order_id=i.order_id
+and p.product_id=u.product_id
+and o.user_session_id=$user_session_id and o.order_state='in_basket'
+group by p.product_name, p.one_line_description, p.product_id, u.offer_code, i.color_choice, i.size_choice, i.style_choice)
+union
+(select p.product_name, p.one_line_description, p.product_id, count(*) as quantity, '' as offer_code, i.color_choice, i.size_choice, i.style_choice
+from ec_orders o, ec_items i, ec_products p
+where 
+i.product_id=p.product_id
+and o.order_id=i.order_id
+and 0=(select count(*) from ec_user_session_offer_codes where user_session_id=$user_session_id and product_id=p.product_id)
+and o.user_session_id=$user_session_id and o.order_state='in_basket'
+group by p.product_name, p.one_line_description, p.product_id, i.color_choice, i.size_choice, i.style_choice)"]
+
+set product_counter 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    ## Pgsql 6.x group by hack (BMA)
+    if {$product_id == ""} {
+	continue
+    }
+
+    if { $product_counter == 0 } {
+	append cart_contents "<form method=post action=shopping-cart-quantities-change.tcl>
+	<center>
+	<table border=0 cellspacing=0 cellpadding=5>
+	<tr bgcolor=\"cccccc\"><td>Shopping Cart Items</td><td>Options</td><td>Qty.</td><td>&nbsp;</td><td>&nbsp;</td></tr>\n"
+    }
+
+    set option_list [list]
+    if { ![empty_string_p $color_choice] } {
+	lappend option_list "Color: $color_choice"
+    }
+    if { ![empty_string_p $size_choice] } {
+	lappend option_list "Size: $size_choice"
+    }
+    if { ![empty_string_p $style_choice] } {
+	lappend option_list "Style: $style_choice"
+    }
+    set options [join $option_list "<br>"]
+
+    append cart_contents "<tr><td>
+    <a href=\"product.tcl?product_id=$product_id\">$product_name</a></td>
+    <td>$options</td>
+    <td><input type=text name=\"quantity([list $product_id $color_choice $size_choice $style_choice])\" value=\"$quantity\" size=4 maxlength=4></td>
+    "
+    # deletions are done by product_id, color_choice, size_choice, style_choice,
+    # not by item_id because we want to delete the entire quantity of that product
+    append cart_contents "<td>[ec_price_line $db_sub $product_id $user_id $offer_code]</td>
+    <td><a href=\"shopping-cart-delete-from.tcl?[export_url_vars product_id color_choice size_choice style_choice]\">delete</a></td>
+    </tr>
+    "
+    incr product_counter
+}
+
+if { $product_counter != 0 } {
+    append cart_contents "<tr><td align=right>If you changed any quantities, please press this button to</td>
+    <td><input type=submit value=\"update\"></td><td></td><td></td></tr>"
+}
+
+if { $product_counter != 0 } {
+    append cart_contents "</table>
+    </center>
+    </form>
+    <center>
+    <form method=post action=\"checkout.tcl\">
+    <input type=submit value=\"Proceed to Checkout\"><br>
+    </form>
+    </center>
+    "
+} else {
+    append cart_contents "<center>Your Shopping Cart is empty.</center>
+    "
+}
+
+# bottom links:
+# 1) continue shopping (always)
+# 2) log in (if they're not logged in)
+# 3) retrieve a saved cart (if they are logged in and they have a saved cart)
+# 4) save their cart (if their cart is not empty)
+
+set bottom_links "<li><a href=\"index.tcl\">Continue Shopping</a>\n"
+
+if { $user_id == 0 } {
+    append bottom_links "<li><a href=\"/register/index.tcl?return_url=[ns_urlencode "/ecommerce/"]\">Log In</a>\n"
+} else {
+    # see if they have any saved carts
+    if { ![empty_string_p [database_to_tcl_string_or_null $db "select 1 from dual where exists (select 1 from ec_orders where user_id=$user_id and order_state='in_basket' and saved_p='t')"]] } {
+	append bottom_links "<li><a href=\"shopping-cart-retrieve-2.tcl\">Retrieve a Saved Cart</a>\n"
+    }
+}
+
+if { $product_counter != 0 } {
+    append bottom_links "<li><a href=\"shopping-cart-save.tcl\">Save Your Cart for Later</a>\n"
+}
+
+ad_return_template
+
+
Index: web/openacs/www/ecommerce/thank-you.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/thank-you.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/thank-you.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,39 @@
+# thank-you.tcl,v 3.0 2000/02/06 03:39:56 ron Exp
+set_form_variables 0
+# possibly usca_p
+
+# This is a "thank you for your order" page
+# displays order summary for the most recently confirmed order for this user
+
+# we need them to be logged in
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# user session tracking
+set user_session_id [ec_get_user_session_id]
+
+set db [ns_db gethandle]
+ec_create_new_session_if_necessary
+# type1
+
+ec_log_user_as_user_id_for_this_session
+
+# their most recently confirmed order (or the empty string if there is none)
+set order_id [database_to_tcl_string_or_null $db "select order_id from ec_orders where user_id=$user_id and confirmed_date is not null and order_id=(select max(o2.order_id) from ec_orders o2 where o2.user_id=$user_id and o2.confirmed_date is not null)"]
+
+if { [empty_string_p $order_id] } {
+    ns_returnredirect index.tcl
+    return
+}
+
+set order_summary [ec_order_summary_for_customer $db $order_id $user_id]
+
+ad_return_template
+
Index: web/openacs/www/ecommerce/track.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/track.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/track.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,71 @@
+# track.tcl,v 3.0 2000/02/06 03:39:35 ron Exp
+set_form_variables
+# shipment_id
+# possibly usca_p
+
+validate_integer shipment_id $shipment_id
+
+set user_id [ad_verify_and_get_user_id]
+set db [ns_db gethandle]
+
+if {$user_id == 0} {
+    set return_url "[ns_conn url]"
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# user session tracking
+set user_session_id [ec_get_user_session_id]
+
+ec_create_new_session_if_necessary [export_url_vars shipment_id]
+
+ec_log_user_as_user_id_for_this_session
+
+# Make sure this order belongs to the user.
+if { [database_to_tcl_string $db "select user_id from ec_orders o, ec_shipments s
+where o.order_id = s.order_id
+  and s.shipment_id = $shipment_id"] != $user_id } {
+    ad_return_error "Invalid Order ID" "Invalid Order ID"
+    return
+}
+
+set selection [ns_db 1row $db "select to_char(shipment_date, 'MMDDYY') as ship_date_for_fedex, to_char(shipment_date, 'MM/DD/YYYY') as pretty_ship_date, carrier, tracking_number
+from ec_shipments
+where shipment_id = $shipment_id"]
+
+set_variables_after_query
+
+set carrier_info ""
+
+if { $carrier == "FedEx" } {
+    set fedex_url "http://www.fedex.com/cgi-bin/track_it?airbill_list=$tracking_number&kurrent_airbill=$tracking_number&language=english&cntry_code=us&state=0"
+    with_catch errmsg {
+	set page_from_fedex [ns_httpget $fedex_url]
+	regexp {<!-- BEGIN TRACKING INFORMATION -->(.*)<!-- END TRACKING INFORMATION -->} $page_from_fedex match carrier_info
+    } {
+	set carrier_info "Unable to retrieve data from FedEx."
+    }
+} elseif { [string match "UPS*" $carrier] } {
+    set ups_url "http://wwwapps.ups.com/etracking/tracking.cgi?submit=Track&InquiryNumber1=$tracking_number&TypeOfInquiryNumber=T"
+    with_catch errmsg {
+	set first_ups_page [ns_httpget $ups_url]
+	# UPS needs this magic line1 to get to the more interesting detail page.
+	if { ![regexp {NAME="line1" VALUE="([^\"]+)"} $first_ups_page match line1] } {
+	    set carrier_info "Unable to parse summary information from UPS."
+	} else {
+	    set url "http://wwwapps.ups.com/etracking/tracking.cgi"
+	    set formvars "InquiryNumber1=$tracking_number&TypeOfInquiryNumber=T&line1=[ns_urlencode $line1]&tdts1=1"
+	    set second_ups_page [util_httppost $url $formvars]
+	    if { ![regexp {(<TR><TD[^>]*>Tracking Number:.*</TABLE>).*Tracking results provided by UPS} $second_ups_page match ups_info] } {
+		set carrier_info "Unable to parse detail data from UPS."
+	    } else {
+		set carrier_info "<table noborder>$ups_info" 
+	    }
+	}
+    } {
+	set carrier_info "Unable to retrieve data from UPS.
+    } 
+    
+}
+
+ad_return_template
Index: web/openacs/www/ecommerce/update-user-classes-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/update-user-classes-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/update-user-classes-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,83 @@
+# update-user-classes-2.tcl,v 3.0 2000/02/06 03:39:57 ron Exp
+set_form_variables 0
+# user_class_id, which is a select multiple
+# possibly usca_p
+
+set form [ns_getform]
+set form_size [ns_set size $form]
+set form_counter 0
+
+set user_class_id_list [list]
+
+while {$form_counter<$form_size} {
+    if {[ns_set key $form $form_counter]=="user_class_id"} {
+	lappend user_class_id_list [ns_set value $form $form_counter]
+    }
+    incr form_counter
+}
+
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+set user_session_id [ec_get_user_session_id]
+
+set db [ns_db gethandle]
+ec_create_new_session_if_necessary
+# type1
+
+ec_log_user_as_user_id_for_this_session
+
+# update User Class
+
+ns_db dml $db "begin transaction"
+
+# Get old user_class_ids
+set old_user_class_id_list [database_to_tcl_list $db "select user_class_id from ec_user_class_user_map where user_id = $user_id"]
+
+# Add the user_class if it is not already there
+foreach user_class_id $user_class_id_list {
+    if { [lsearch -exact $old_user_class_id_list $user_class_id] == -1 &&
+![empty_string_p $user_class_id] } {
+	set sql "insert into 
+	ec_user_class_user_map (
+	user_id, user_class_id, user_class_approved_p, last_modified, last_modifying_user, modified_ip_address
+	) values (
+	$user_id, $user_class_id, NULL, sysdate(), $user_id, '[DoubleApos [ns_conn peeraddr]]')"
+	
+	if [catch { ns_db dml $db $sql } errmsg] {
+	    ad_return_error "Ouch!" "The database choked on our update:
+	    <blockquote>
+	    $errmsg
+	    </blockquote>
+	    "
+	}
+    }
+}
+
+# Delete the user_class if it is not in the new list
+foreach old_user_class_id $old_user_class_id_list {
+    if { [lsearch -exact $user_class_id_list $old_user_class_id] == -1 &&
+![empty_string_p $old_user_class_id] } {
+	set sql "delete from ec_user_class_user_map where user_id = $user_id and user_class_id = $old_user_class_id"
+	
+	if [catch { ns_db dml $db $sql } errmsg] {
+	    ad_return_error "Ouch!" "The database choked on our update:
+	    <blockquote>
+	    $errmsg
+	    </blockquote>
+	    "
+	}
+	ad_audit_delete_row $db [list $user_id $old_user_class_id] [list user_id user_class_id] ec_user_class_user_map_audit
+    }
+}
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "account.tcl"
Index: web/openacs/www/ecommerce/update-user-classes.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/update-user-classes.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ecommerce/update-user-classes.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,31 @@
+# update-user-classes.tcl,v 3.0 2000/02/06 03:39:58 ron Exp
+set_form_variables 0
+# possibly usca_p
+
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    
+    set return_url "[ns_conn url]"
+
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+set user_session_id [ec_get_user_session_id]
+
+set db_pools [ns_db gethandle [philg_server_default_pool] 2]
+set db [lindex $db_pools 0]
+set db_sub [lindex $db_pools 1]
+ec_create_new_session_if_necessary
+# type1
+
+ec_log_user_as_user_id_for_this_session
+
+# two variables for the ADP page
+set user_classes_need_approval [ad_parameter UserClassApproveP ecommerce]
+
+set user_class_select_list [ec_user_class_select_widget $db [database_to_tcl_list $db "select user_class_id from ec_user_class_user_map where user_id = $user_id"]]
+
+ad_return_template
+
Index: web/openacs/www/ecommerce/graphics/add-to-cart.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/graphics/add-to-cart.gif,v
diff -u
Binary files differ
Index: web/openacs/www/ecommerce/graphics/star-empty.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/graphics/star-empty.gif,v
diff -u
Binary files differ
Index: web/openacs/www/ecommerce/graphics/star-full.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/graphics/star-full.gif,v
diff -u
Binary files differ
Index: web/openacs/www/ecommerce/graphics/star-half.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/graphics/star-half.gif,v
diff -u
Binary files differ
Index: web/openacs/www/ecommerce/graphics/stars/star-empty.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/graphics/stars/star-empty.gif,v
diff -u
Binary files differ
Index: web/openacs/www/ecommerce/graphics/stars/star-full.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/graphics/stars/star-full.gif,v
diff -u
Binary files differ
Index: web/openacs/www/ecommerce/graphics/stars/star-half.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ecommerce/graphics/stars/star-half.gif,v
diff -u
Binary files differ
Index: web/openacs/www/education/class/assignment-info.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/assignment-info.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/assignment-info.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,675 @@
+#
+# /www/education/class/assignment-info.tcl
+#
+# by randyg@arsdigita.com, aileen@arsdigita.com, January 2000
+#
+# this class shows a user the assigment requested as well as the solutions
+# and everything else related to this user and the pset.
+#
+
+ad_page_variables {
+    assignment_id
+}
+
+validate_integer assignment_id $assignment_id
+
+set db [ns_db gethandle]
+
+# lets get the class_id
+
+# get all of the assignments.  If there are solutions, get those.
+# if the student has uploaded their answers, get those as well
+
+set user_id [ad_verify_and_get_user_id]
+
+# set sql "select
+#              ea.class_id, 
+#              ea.assignment_name,
+#              ec.class_name,
+#              ea.teacher_id,
+#              first_names,
+#              last_name,
+#              ea.description,
+#              ea.date_assigned,
+#              ea.last_modified,
+#              ea.due_date,
+#              ea.grade_id,
+#              ea.weight,
+#              ea.electronic_submission_p,
+#              ea.requires_grade_p,
+#              ver.version_id, 
+#              ver.file_extension,
+#              ver.url,
+#              sol.version_id as solution_version_id, 
+#              sol.file_extension as solution_file_extension,
+#              sol.url as solution_url,
+#              answers.version_id as answers_version_id, 
+#              answers.file_extension as answers_file_extension,
+#              answers.url as answers_url,
+#              ec.public_p
+#         from edu_assignments ea,
+#              users,
+#              edu_current_classes ec,
+#              (select * from fs_versions_latest 
+#               where ad_general_permissions.user_has_row_permission_p($user_id, 'read', version_id, 'FS_VERSIONS') = 't') ver,
+#              (select file_extension, url, version_id, task_id 
+#                     from fs_versions_latest ver,
+#                          edu_task_solutions solutions
+#                    where ver.file_id = solutions.file_id
+#                      and ad_general_permissions.user_has_row_permission_p($user_id, 'read', version_id, 'FS_VERSIONS') = 't'
+#                      and task_id = $assignment_id) sol,
+#             (select file_extension, file_title, url, version_id, task_id
+#                     from fs_versions_latest ver,
+#                          edu_student_answers ans,
+#                          fs_files
+#                    where ver.file_id = ans.file_id 
+#                      and fs_files.file_id = ver.file_id
+#                      and student_id = $user_id
+#                      and ad_general_permissions.user_has_row_permission_p($user_id, 'read', version_id, 'FS_VERSIONS') = 't'
+#                      and task_id=$assignment_id) answers
+#        where ec.class_id = ea.class_id
+#          and users.user_id = ea.teacher_id
+#          and ea.assignment_id = $assignment_id
+#          and ea.file_id = ver.file_id(+)
+#          and ea.assignment_id = sol.task_id(+)
+#          and ea.assignment_id = answers.task_id(+)"
+
+set sql "select
+             ea.class_id, 
+             ea.assignment_name,
+             ec.class_name,
+             ea.teacher_id,
+             first_names,
+             last_name,
+             ea.description,
+             ea.date_assigned,
+             ea.last_modified,
+             ea.due_date,
+             ea.grade_id,
+             ea.weight,
+             ea.electronic_submission_p,
+             ea.requires_grade_p,
+             ver.version_id, 
+             ver.file_extension,
+             ver.url,
+             sol.version_id as solution_version_id, 
+             sol.file_extension as solution_file_extension,
+             sol.url as solution_url,
+             answers.version_id as answers_version_id, 
+             answers.file_extension as answers_file_extension,
+             answers.url as answers_url,
+             ec.public_p
+        from edu_assignments ea,
+             users,
+             edu_current_classes ec,
+             fs_versions_latest ver,
+             solution_files sol,   
+             student_answer_files answers                      
+       where ec.class_id = ea.class_id
+         and answers.student_id = $user_id
+         and answers.task_id = $assignment_id;
+         and user_has_row_permission_p($user_id, 'read', ver.version_id, 'FS_VERSIONS') = 't'
+         and users.user_id = ea.teacher_id
+         and sol.task_id = $assignment_id
+         and ea.assignment_id = $assignment_id
+         and ea.file_id = ver.file_id
+         and ea.assignment_id = sol.task_id
+         and ea.assignment_id = answers.task_id
+union
+select
+             ea.class_id, 
+             ea.assignment_name,
+             ec.class_name,
+             ea.teacher_id,
+             first_names,
+             last_name,
+             ea.description,
+             ea.date_assigned,
+             ea.last_modified,
+             ea.due_date,
+             ea.grade_id,
+             ea.weight,
+             ea.electronic_submission_p,
+             ea.requires_grade_p,
+             ver.version_id, 
+             ver.file_extension,
+             ver.url,
+             sol.version_id as solution_version_id, 
+             sol.file_extension as solution_file_extension,
+             sol.url as solution_url,
+             answers.version_id as answers_version_id, 
+             answers.file_extension as answers_file_extension,
+             answers.url as answers_url,
+             ec.public_p
+        from edu_assignments ea,
+             users,
+             edu_current_classes ec,
+             fs_versions_latest ver,
+             solution_files sol,   
+             student_answer_files answers                      
+       where ec.class_id = ea.class_id
+         and answers.student_id = $user_id
+         and answers.task_id = $assignment_id;
+         and user_has_row_permission_p($user_id, 'read', ver.version_id, 'FS_VERSIONS') = 't'
+         and users.user_id = ea.teacher_id
+         and sol.task_id = $assignment_id
+         and ea.assignment_id = $assignment_id
+         and ea.file_id = ver.file_id
+         and ea.assignment_id = sol.task_id
+         and not exists (select 1 from student_answer_files 
+                         where task_id = ea.assignment_id)
+union
+select
+             ea.class_id, 
+             ea.assignment_name,
+             ec.class_name,
+             ea.teacher_id,
+             first_names,
+             last_name,
+             ea.description,
+             ea.date_assigned,
+             ea.last_modified,
+             ea.due_date,
+             ea.grade_id,
+             ea.weight,
+             ea.electronic_submission_p,
+             ea.requires_grade_p,
+             ver.version_id, 
+             ver.file_extension,
+             ver.url,
+             sol.version_id as solution_version_id, 
+             sol.file_extension as solution_file_extension,
+             sol.url as solution_url,
+             answers.version_id as answers_version_id, 
+             answers.file_extension as answers_file_extension,
+             answers.url as answers_url,
+             ec.public_p
+        from edu_assignments ea,
+             users,
+             edu_current_classes ec,
+             fs_versions_latest ver,
+             solution_files sol,   
+             student_answer_files answers                      
+       where ec.class_id = ea.class_id
+         and answers.student_id = $user_id
+         and answers.task_id = $assignment_id;
+         and user_has_row_permission_p($user_id, 'read', ver.version_id, 'FS_VERSIONS') = 't'
+         and users.user_id = ea.teacher_id
+         and sol.task_id = $assignment_id
+         and ea.assignment_id = $assignment_id
+         and ea.file_id = ver.file_id
+         and not exists (select 1 from solution_files 
+                         where task_id = ea.assignment_id)
+         and ea.assignment_id = answers.task_id
+union
+select
+             ea.class_id, 
+             ea.assignment_name,
+             ec.class_name,
+             ea.teacher_id,
+             first_names,
+             last_name,
+             ea.description,
+             ea.date_assigned,
+             ea.last_modified,
+             ea.due_date,
+             ea.grade_id,
+             ea.weight,
+             ea.electronic_submission_p,
+             ea.requires_grade_p,
+             ver.version_id, 
+             ver.file_extension,
+             ver.url,
+             sol.version_id as solution_version_id, 
+             sol.file_extension as solution_file_extension,
+             sol.url as solution_url,
+             answers.version_id as answers_version_id, 
+             answers.file_extension as answers_file_extension,
+             answers.url as answers_url,
+             ec.public_p
+        from edu_assignments ea,
+             users,
+             edu_current_classes ec,
+             fs_versions_latest ver,
+             solution_files sol,   
+             student_answer_files answers                      
+       where ec.class_id = ea.class_id
+         and answers.student_id = $user_id
+         and answers.task_id = $assignment_id;
+         and user_has_row_permission_p($user_id, 'read', ver.version_id, 'FS_VERSIONS') = 't'
+         and users.user_id = ea.teacher_id
+         and sol.task_id = $assignment_id
+         and ea.assignment_id = $assignment_id
+         and ea.file_id = ver.file_id
+         and not exists (select 1 from solution_files 
+                         where task_id = ea.assignment_id)
+         and not exists (select 1 from student_answer_files 
+                         where task_id = ea.assignment_id)
+union
+select
+             ea.class_id, 
+             ea.assignment_name,
+             ec.class_name,
+             ea.teacher_id,
+             first_names,
+             last_name,
+             ea.description,
+             ea.date_assigned,
+             ea.last_modified,
+             ea.due_date,
+             ea.grade_id,
+             ea.weight,
+             ea.electronic_submission_p,
+             ea.requires_grade_p,
+             ver.version_id, 
+             ver.file_extension,
+             ver.url,
+             sol.version_id as solution_version_id, 
+             sol.file_extension as solution_file_extension,
+             sol.url as solution_url,
+             answers.version_id as answers_version_id, 
+             answers.file_extension as answers_file_extension,
+             answers.url as answers_url,
+             ec.public_p
+        from edu_assignments ea,
+             users,
+             edu_current_classes ec,
+             fs_versions_latest ver,
+             solution_files sol,   
+             student_answer_files answers                      
+       where ec.class_id = ea.class_id
+         and answers.student_id = $user_id
+         and answers.task_id = $assignment_id;
+         and user_has_row_permission_p($user_id, 'read', ver.version_id, 'FS_VERSIONS') = 't'
+         and users.user_id = ea.teacher_id
+         and sol.task_id = $assignment_id
+         and ea.assignment_id = $assignment_id
+         and not exists (select 1 from fs_versions_latest 
+                         where file_id = ea.file_id)
+         and ea.assignment_id = sol.task_id
+         and ea.assignment_id = answers.task_id
+union
+select
+             ea.class_id, 
+             ea.assignment_name,
+             ec.class_name,
+             ea.teacher_id,
+             first_names,
+             last_name,
+             ea.description,
+             ea.date_assigned,
+             ea.last_modified,
+             ea.due_date,
+             ea.grade_id,
+             ea.weight,
+             ea.electronic_submission_p,
+             ea.requires_grade_p,
+             ver.version_id, 
+             ver.file_extension,
+             ver.url,
+             sol.version_id as solution_version_id, 
+             sol.file_extension as solution_file_extension,
+             sol.url as solution_url,
+             answers.version_id as answers_version_id, 
+             answers.file_extension as answers_file_extension,
+             answers.url as answers_url,
+             ec.public_p
+        from edu_assignments ea,
+             users,
+             edu_current_classes ec,
+             fs_versions_latest ver,
+             solution_files sol,   
+             student_answer_files answers                      
+       where ec.class_id = ea.class_id
+         and answers.student_id = $user_id
+         and answers.task_id = $assignment_id;
+         and user_has_row_permission_p($user_id, 'read', ver.version_id, 'FS_VERSIONS') = 't'
+         and users.user_id = ea.teacher_id
+         and sol.task_id = $assignment_id
+         and ea.assignment_id = $assignment_id
+         and not exists (select 1 from fs_versions_latest 
+                         where file_id = ea.file_id)
+         and ea.assignment_id = sol.task_id
+         and not exists (select 1 from student_answer_files 
+                         where task_id = ea.assignment_id)
+union
+select
+             ea.class_id, 
+             ea.assignment_name,
+             ec.class_name,
+             ea.teacher_id,
+             first_names,
+             last_name,
+             ea.description,
+             ea.date_assigned,
+             ea.last_modified,
+             ea.due_date,
+             ea.grade_id,
+             ea.weight,
+             ea.electronic_submission_p,
+             ea.requires_grade_p,
+             ver.version_id, 
+             ver.file_extension,
+             ver.url,
+             sol.version_id as solution_version_id, 
+             sol.file_extension as solution_file_extension,
+             sol.url as solution_url,
+             answers.version_id as answers_version_id, 
+             answers.file_extension as answers_file_extension,
+             answers.url as answers_url,
+             ec.public_p
+        from edu_assignments ea,
+             users,
+             edu_current_classes ec,
+             fs_versions_latest ver,
+             solution_files sol,   
+             student_answer_files answers                      
+       where ec.class_id = ea.class_id
+         and answers.student_id = $user_id
+         and answers.task_id = $assignment_id;
+         and user_has_row_permission_p($user_id, 'read', ver.version_id, 'FS_VERSIONS') = 't'
+         and users.user_id = ea.teacher_id
+         and sol.task_id = $assignment_id
+         and ea.assignment_id = $assignment_id
+         and not exists (select 1 from fs_versions_latest 
+                         where file_id = ea.file_id)
+         and not exists (select 1 from solution_files 
+                         where task_id = ea.assignment_id)
+         and ea.assignment_id = answers.task_id
+union
+select
+             ea.class_id, 
+             ea.assignment_name,
+             ec.class_name,
+             ea.teacher_id,
+             first_names,
+             last_name,
+             ea.description,
+             ea.date_assigned,
+             ea.last_modified,
+             ea.due_date,
+             ea.grade_id,
+             ea.weight,
+             ea.electronic_submission_p,
+             ea.requires_grade_p,
+             ver.version_id, 
+             ver.file_extension,
+             ver.url,
+             sol.version_id as solution_version_id, 
+             sol.file_extension as solution_file_extension,
+             sol.url as solution_url,
+             answers.version_id as answers_version_id, 
+             answers.file_extension as answers_file_extension,
+             answers.url as answers_url,
+             ec.public_p
+        from edu_assignments ea,
+             users,
+             edu_current_classes ec,
+             fs_versions_latest ver,
+             solution_files sol,   
+             student_answer_files answers                      
+       where ec.class_id = ea.class_id
+         and answers.student_id = $user_id
+         and answers.task_id = $assignment_id;
+         and user_has_row_permission_p($user_id, 'read', ver.version_id, 'FS_VERSIONS') = 't'
+         and users.user_id = ea.teacher_id
+         and sol.task_id = $assignment_id
+         and ea.assignment_id = $assignment_id
+         and not exists (select 1 from fs_versions_latest 
+                         where file_id = ea.file_id)
+         and not exists (select 1 from solution_files 
+                         where task_id = ea.assignment_id)
+         and not exists (select 1 from student_answer_files 
+                         where task_id = ea.assignment_id)"
+
+set selection [ns_db 0or1row $db $sql]
+
+
+if {$selection == ""} {
+    ad_return_complaint 1 "There are no assignments corresponding to the provided identification number.  The most likely cause for this is that the course administrator has closed this course from the public."
+    return
+} else {
+    set_variables_after_query
+}
+    
+
+set return_url [ad_partner_url_with_query]
+
+
+# if the class is private, make sure the user is logged in correctly
+
+if {[string compare $public_p f] == 0} {
+    
+    set id_list [edu_group_security_check $db edu_class [edu_get_student_role_string]]
+    set user_id [lindex $id_list 0]
+    set actual_class_id [lindex $id_list 1]
+    set class_name [lindex $id_list 2]
+
+    if {[string compare $actual_class_id $class_id] != 0} {
+	# the user is logged in as member of a different class
+	ns_returnredirect "/education/util/group-select.tcl?group_name=$group_name&group_id=$group_id&type=$group_type&return_url=[ns_urlencode $return_url]"
+	return
+    }
+}
+
+
+set return_string "
+[ad_header "One Assignment @ [ad_system_name]"]
+
+<h2>$assignment_name</h2>
+
+[ad_context_bar_ws_or_index [list "" "All Classes"] [list "one.tcl" "$class_name Home"] "One Assignment"]
+
+<hr>
+<blockquote>
+
+
+<table BORDER=0>
+
+<tr>
+<th valign=top align=right> Assignment Name: </td>
+<td valign=top>
+"
+
+if {![empty_string_p $url]} {
+    append return_string "<a href=\"$url\">$assignment_name</a>"
+} elseif {![empty_string_p $version_id]} {
+    append return_string "<a href=\"/file-storage/download/$assignment_name.$file_extension?version_id=$version_id\">$assignment_name</a>"
+} else {
+    append return_string "$assignment_name"
+}
+
+append return_string "
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Description: </td>
+<td valign=top>
+[edu_maybe_display_text $description]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Due Date: </td>
+<td valign=top>
+[util_AnsiDatetoPrettyDate $due_date]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Date Assigned: </td>
+<td valign=top>
+[util_AnsiDatetoPrettyDate $date_assigned]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right>Will this assignment<br>be graded? </td>
+<td valign=top>
+[util_PrettyBoolean $requires_grade_p]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Fraction of Final Grade: </td>
+<td valign=top>"
+
+if {[empty_string_p $weight]} {
+    append return_string "N/A"
+} else {
+    append return_string "$weight"
+}
+
+append return_string "
+</td>
+</tr>
+<tr>
+<th align=right>Grade Group</th>
+<td>"
+
+if {![empty_string_p $grade_id]} {
+    set selection [ns_db 0or1row $db "select grade_name, weight from edu_grades where grade_id = $grade_id"]
+} else {
+    set selection ""
+}
+
+
+if {$selection!=""} {
+    set_variables_after_query
+} else {
+    set grade_name ""
+    set weight ""
+}
+
+append return_string "
+[edu_maybe_display_text $grade_name] [ec_decode $weight "" "" "- $weight %"]
+</td></tr>
+<tr>
+<th valign=top align=right>
+Will students submit <br>
+answers electronically?
+</td>
+<td valign=top>
+[util_PrettyBoolean $electronic_submission_p]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Assigned By: </td>
+<td valign=top>
+$first_names $last_name
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Last Modified: </td>
+<td valign=top>
+[util_AnsiDatetoPrettyDate $last_modified]
+</td>
+</tr>
+
+
+</table>
+"
+
+if {[string compare $electronic_submission_p t] == 0} {
+    set submit_solutions_text "Submit/Update Answers"
+    
+    if {![empty_string_p $answers_url]} {
+	append return_string "<p> <a href=\"$answers_url\">Your Answers</a>"
+	set submit_solutions_text "Update Your Answers"
+    } elseif {![empty_string_p $answers_version_id]} {
+	append return_string "<p> <a href=\"/file-storage/download/$assignment_name-Answers.$answers_file_extension?version_id=$answers_version_id\">Your Answers</a>"
+	set submit_solutions_text "Update Your Answers"
+    } 	    
+}
+
+
+if {![empty_string_p $solution_url]} {
+    append return_string "<p><a href=\"$solution_url\">Solutions</a>"
+} elseif {![empty_string_p $solution_version_id]} {
+    append return_string "<p><a href=\"/file-storage/download/$assignment_name-solutions.$solution_file_extension?version_id=$solution_version_id\">Solutions</a>"
+} else {
+    if {[string compare $electronic_submission_p t] == 0 && [ad_permission_p $db "" "" "Submit Tasks" $user_id $class_id]} {
+	append return_string "<p><a href=\"task-turn-in.tcl?task_id=$assignment_id&task_type=assignment&[export_url_vars return_url]\">$submit_solutions_text</a>"
+    }
+}
+
+
+
+# we get multiple rows because it could be the case that multiple people reviewed
+# the same student on the same assigment (e.g. a prof and a TA could both review
+# the same presentation
+
+set selection [ns_db select $db "select first_names || ' ' || last_name as grader_name, 
+       grade, 
+       user_id as grader_id,
+       comments, 
+       show_student_p, 
+       evaluation_date 
+  from edu_student_evaluations,
+       users
+ where task_id = $assignment_id 
+   and users.user_id = grader_id
+   and student_id = $user_id"]
+
+set public_eval_count 0
+set eval_string ""
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    if {[string compare $show_student_p t] == 0} {
+	append eval_string "
+	<li>
+	Grade:
+	[edu_maybe_display_text $grade]
+	</li>
+	
+	<li>
+	Comments:
+	[edu_maybe_display_text $comments]
+	</li>
+	
+	<li>
+	Graded By: $grader_name
+	</li>
+	<p>
+	"
+
+	incr public_eval_count
+    }
+}
+
+if {$public_eval_count > 0} {
+    if {$public_eval_count == 1} {
+	append return_string "<h3>Your Evaluation</h3>"
+    } else {
+	append return_string "<h3>Your Evaluations</h3>"
+    }
+    
+    append return_string "
+    <ul>
+    $eval_string
+    </ul>
+    "
+}
+
+
+append return_string "
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/class/exam-info.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/exam-info.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/exam-info.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,442 @@
+# 
+# /www/education/class/exam-info.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, February 2000
+#
+# this page displays information about a given exam
+#
+
+ad_page_variables {
+    exam_id
+}
+
+validate_integer exam_id $exam_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class student]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+# check the input
+
+set exception_text ""
+set exception_count 0
+
+if {![info exists exam_id] || [empty_string_p $exam_id]} {
+    append exception_text "<li>You must include an identification number for this exam."
+    incr exception_count
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+# set sql "select
+#              ea.class_id, 
+#              exam_name,
+#              class_name,
+#              teacher_id,
+#              first_names,
+#              last_name,
+#              ea.comments,
+#              ea.creation_date,
+#              last_modified,
+#              date_administered,
+#              grade_id,
+#              weight,
+#              fs.version_id, 
+#              fs.file_extension,
+#              fs.url,
+#              sol.version_id as sol_version_id, 
+#              sol.file_extension as sol_file_extension,
+#              sol.url as sol_url,
+#              online_p
+#         from edu_exams ea,
+#              users,
+#              edu_current_classes ec,
+#              (select * from fs_versions_latest 
+#               where ad_general_permissions.user_has_row_permission_p($user_id, 'read', version_id, 'FS_VERSIONS') = 't') fs,
+#              (select file_extension, url, version_id, task_id, ver.file_id 
+#                     from fs_versions_latest ver,
+#                          edu_task_solutions solutions
+#                    where ver.file_id = solutions.file_id
+#                      and ad_general_permissions.user_has_row_permission_p($user_id, 'read', version_id, 'FS_VERSIONS') = 't') sol
+#        where ec.class_id = ea.class_id
+#          and users.user_id = ea.teacher_id
+#          and ea.exam_id = $exam_id
+#          and ea.exam_id = sol.task_id(+)
+#          and ea.file_id = fs.file_id(+)"
+
+set sql "select
+             ea.class_id, 
+             exam_name,
+             class_name,
+             teacher_id,
+             first_names,
+             last_name,
+             ea.comments,
+             ea.creation_date,
+             last_modified,
+             date_administered,
+             grade_id,
+             weight,
+             fs.version_id, 
+             fs.file_extension,
+             fs.url,
+             sol.version_id as sol_version_id, 
+             sol.file_extension as sol_file_extension,
+             sol.url as sol_url,
+             online_p
+        from edu_exams ea,
+             users,
+             edu_current_classes ec,
+             fs_versions_latest fs,
+             task_files sol
+       where ec.class_id = ea.class_id
+         and user_has_row_permission_p($user_id, 'read', fs.version_id, 'FS_VERSIONS') = 't'
+         and users.user_id = ea.teacher_id
+         and ea.exam_id = $exam_id
+         and ea.exam_id = sol.task_id
+         and ea.file_id = fs.file_id
+union
+select
+             ea.class_id, 
+             exam_name,
+             class_name,
+             teacher_id,
+             first_names,
+             last_name,
+             ea.comments,
+             ea.creation_date,
+             last_modified,
+             date_administered,
+             grade_id,
+             weight,
+             fs.version_id, 
+             fs.file_extension,
+             fs.url,
+             '' as sol_version_id, 
+             '' as sol_file_extension,
+             '' as sol_url,
+             online_p
+        from edu_exams ea,
+             users,
+             edu_current_classes ec,
+             fs_versions_latest fs
+       where ec.class_id = ea.class_id
+         and user_has_row_permission_p($user_id, 'read', fs.version_id, 'FS_VERSIONS') = 't'
+         and users.user_id = ea.teacher_id
+         and ea.exam_id = $exam_id
+         and not exists (select 1 from task_files 
+                         where task_files = ea.exam_id)
+         and ea.file_id = fs.file_id
+union
+select
+             ea.class_id, 
+             exam_name,
+             class_name,
+             teacher_id,
+             first_names,
+             last_name,
+             ea.comments,
+             ea.creation_date,
+             last_modified,
+             date_administered,
+             grade_id,
+             weight,
+             fs.version_id, 
+             fs.file_extension,
+             fs.url,
+             sol.version_id as sol_version_id, 
+             sol.file_extension as sol_file_extension,
+             sol.url as sol_url,
+             online_p
+        from edu_exams ea,
+             users,
+             edu_current_classes ec,
+             fs_versions_latest fs,
+             task_files sol
+       where ec.class_id = ea.class_id
+         and user_has_row_permission_p($user_id, 'read', fs.version_id, 'FS_VERSIONS') = 't'
+         and users.user_id = ea.teacher_id
+         and ea.exam_id = $exam_id
+         and ea.exam_id = sol.task_id
+         and not exists (select 1 from fs_versions_latest
+                         where file_id = ea.file_id)
+union
+select
+             ea.class_id, 
+             exam_name,
+             class_name,
+             teacher_id,
+             first_names,
+             last_name,
+             ea.comments,
+             ea.creation_date,
+             last_modified,
+             date_administered,
+             grade_id,
+             weight,
+             fs.version_id, 
+             fs.file_extension,
+             fs.url,
+             '' as sol_version_id, 
+             '' as sol_file_extension,
+             '' as sol_url,
+             online_p
+        from edu_exams ea,
+             users,
+             edu_current_classes ec,
+             fs_versions_latest fs
+       where ec.class_id = ea.class_id
+         and user_has_row_permission_p($user_id, 'read', fs.version_id, 'FS_VERSIONS') = 't'
+         and users.user_id = ea.teacher_id
+         and ea.exam_id = $exam_id
+         and not exists (select 1 from task_files 
+                         where task_files = ea.exam_id)
+         and not exists (select 1 from fs_versions_latest
+                         where file_id = ea.file_id)"
+
+set selection [ns_db 0or1row $db $sql]
+
+
+if {$selection == ""} {
+    ad_return_complaint 1 "There are no exams corresponding to the provided identification number.  The most likely cause for this is that the course administrator has closed this web page from the public."
+    return
+} else {
+    set_variables_after_query
+}
+    
+
+
+
+set return_string "
+[ad_header "One Exam @ [ad_system_name]"]
+
+<h2>$exam_name</h2>
+
+[ad_context_bar_ws_or_index [list "one.tcl" "$class_name Home"] "One Exam"]
+
+<hr>
+<blockquote>
+
+
+<table BORDER=0>
+
+<tr>
+<th valign=top align=right> Exam Name: </td>
+<td valign=top>
+"
+
+if {![empty_string_p $url]} {
+    append return_string "<a href=\"$url\">$exam_name</a>"
+} elseif {![empty_string_p $version_id]} {
+    append return_string "<a href=\"/file-storage/download/$exam_name.$file_extension?version_id=$version_id\">$exam_name</a>"
+} else {
+    append return_string "$exam_name"
+}
+
+
+append return_string "
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Comments: </td>
+<td valign=top>
+[edu_maybe_display_text $comments]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Exam Date: </td>
+<td valign=top>
+[util_AnsiDatetoPrettyDate $date_administered]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Date Created: </td>
+<td valign=top>
+[util_AnsiDatetoPrettyDate $creation_date]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Fraction of Final Grade: </td>
+<td valign=top>"
+
+if {[empty_string_p $weight]} {
+    append return_string "N/A"
+} else {
+    append return_string "$weight"
+}
+
+append return_string "
+</td>
+</tr>
+<tr>
+<th valign=top align=right>
+Administered online?
+</td>
+<td valign=top>
+[util_PrettyBoolean $online_p]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Assigned By: </td>
+<td valign=top>
+$first_names $last_name
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Last Modified: </td>
+<td valign=top>
+[util_AnsiDatetoPrettyDate $last_modified]
+</td>
+</tr>
+</table>
+"
+# if the student was evaluated and the person wants to let
+# the student see this evaluation, show the student
+
+set selection [ns_db select $db "select first_names || ' ' || last_name as grader_name, 
+       grade, 
+       user_id as grader_id,
+       comments, 
+       evaluation_date 
+  from edu_student_evaluations,
+       users
+ where task_id = $exam_id 
+   and show_student_p = 't'
+   and users.user_id = grader_id
+   and student_id = $user_id"]
+
+set public_eval_count 0
+set eval_string ""
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    if {[string compare $show_student_p t] == 0} {
+	append eval_string "
+	<li>
+	Grade:
+	[edu_maybe_display_text $grade]
+	</li>
+	
+	<li>
+	Comments:
+	[edu_maybe_display_text $comments]
+	</li>
+	
+	<li>
+	Graded By: $grader_name
+	</li>
+	<p>
+	"
+
+	incr public_eval_count
+    }
+}
+
+if {$public_eval_count > 0} {
+    if {$public_eval_count == 1} {
+	append return_string "<h3>Your Evaluation</h3>"
+    } else {
+	append return_string "<h3>Your Evaluations</h3>"
+    }
+    
+    append return_string "
+    <ul>
+    $eval_string
+    </ul>
+    "
+}
+
+
+if {![empty_string_p $sol_url]} {
+    append return_string "<p><a href=\"$sol_url\">Solutions</a>"
+} elseif {![empty_string_p $sol_version_id]} {
+    append return_string "<p><a href=\"/file-storage/download/$exam_name-solutions.$sol_file_extension?version_id=$sol_version_id\">Solutions</a>"
+} 
+
+
+
+# we get multiple rows because it could be the case that multiple people reviewed
+# the same student on the same exam (e.g. a prof and a TA could both review
+# the same presentation
+
+set selection [ns_db select $db "select first_names || ' ' || last_name as grader_name, 
+       grade, 
+       user_id as grader_id,
+       comments, 
+       show_student_p, 
+       evaluation_date 
+  from edu_student_evaluations,
+       users
+ where task_id = $exam_id 
+   and users.user_id = grader_id
+   and student_id = $user_id"]
+
+set public_eval_count 0
+set eval_string ""
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    if {[string compare $show_student_p t] == 0} {
+	append eval_string "
+	<li>
+	Grade:
+	[edu_maybe_display_text $grade]
+	</li>
+	
+	<li>
+	Comments:
+	[edu_maybe_display_text $comments]
+	</li>
+	
+	<li>
+	Graded By: $grader_name
+	</li>
+	<p>
+	"
+
+	incr public_eval_count
+    }
+}
+
+if {$public_eval_count > 0} {
+    if {$public_eval_count == 1} {
+	append return_string "<h3>Your Evaluation</h3>"
+    } else {
+	append return_string "<h3>Your Evaluations</h3>"
+    }
+    
+    append return_string "
+    <ul>
+    $eval_string
+    </ul>
+    "
+}
+
+append return_string "
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
Index: web/openacs/www/education/class/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/index.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,68 @@
+#
+# /www/education/class/index.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this is the index page for the classes.  Right now, it
+# simply lists all of the ongoing classes.  We eventually
+# want to list the classes by departments and make it very
+# easy for people to browse through them
+#
+
+ad_page_variables {
+    {return_url "[edu_url]class/one.tcl"} 
+}
+
+set user_id [ad_verify_and_get_user_id]
+   
+if { $user_id == 0 } {
+   set return_url "[ns_conn url]?[ns_conn query]"
+   ns_returnredirect /register.tcl?return_url=[ns_urlencode $return_url]
+    return
+}
+
+set db [ns_db gethandle]
+
+set return_string "
+[ad_header "[ad_system_name] Classes"]
+
+<h2>[ad_system_name] Classes</h2>
+
+[ad_context_bar_ws Classes]
+
+<hr>
+<blockquote>
+
+<h3>Classes</h3>
+<ul>
+"
+
+set count 0
+
+set selection [ns_db select $db "select class_name, class_id from edu_current_classes order by lower(class_name)"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append return_string "<li><a href=\"../util/group-login.tcl?group_id=$class_id&group_type=edu_class&[export_url_vars return_url]\">$class_name</a>"
+    incr count
+}
+
+if {$count == 0} {
+    append return_string "There are currently no classes in the system."
+} else {
+    append return_string "<br>"
+}
+
+append return_string "
+</ul>
+</blockquote>
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
Index: web/openacs/www/education/class/one.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/one.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/one.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,1219 @@
+#
+# /www/education/class/one.tcl (as in one class)
+#
+# by randyg@arsdigita.com, aileen@arsdigita.com, January 2000
+#
+# this displays information about one class
+#
+
+set db [ns_db gethandle]
+
+set id_list [edu_user_security_check $db]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+
+# set sql "select 
+#                class_name,
+#                term_id,
+#                c.subject_id,
+#                start_date,
+#                end_date,
+#                nvl(c.description, s.description) as description,
+#                where_and_when,
+#                syllabus_id,
+#                version_id,
+#                file_extension,
+#                lecture_notes_folder_id,
+#                handouts_folder_id,
+#                assignments_folder_id,
+#                public_p,
+#                grades_p,
+#                teams_p,
+#                exams_p,
+#                final_exam_p,
+#                credit_hours, 
+#                prerequisites
+#           from edu_current_classes c,
+#                (select * from fs_versions_latest 
+#                 where ad_general_permissions.user_has_row_permission_p($user_id, 'read', version_id, 'FS_VERSIONS') = 't') ver,
+#                edu_subjects s
+#          where class_id = $class_id
+#            and syllabus_id = file_id(+)
+#            and c.subject_id = s.subject_id(+)"
+
+set sql "select 
+               class_name,
+               term_id,
+               c.subject_id,
+               start_date,
+               end_date,
+               coalesce(c.description, s.description) as description,
+               where_and_when,
+               syllabus_id,
+               version_id,
+               file_extension,
+               lecture_notes_folder_id,
+               handouts_folder_id,
+               assignments_folder_id,
+               public_p,
+               grades_p,
+               teams_p,
+               exams_p,
+               final_exam_p,
+               credit_hours, 
+               prerequisites
+          from edu_current_classes c,
+               fs_versions_latest ver,
+               edu_subjects s
+         where class_id = $class_id
+           and user_has_row_permission_p($user_id, 'read', ver.version_id, 'FS_VERSIONS') = 't'
+           and syllabus_id = file_id
+           and c.subject_id = s.subject_id
+union
+select 
+               class_name,
+               term_id,
+               c.subject_id,
+               start_date,
+               end_date,
+               coalesce(c.description, '') as description,
+               where_and_when,
+               syllabus_id,
+               version_id,
+               file_extension,
+               lecture_notes_folder_id,
+               handouts_folder_id,
+               assignments_folder_id,
+               public_p,
+               grades_p,
+               teams_p,
+               exams_p,
+               final_exam_p,
+               '' as credit_hours, 
+               '' as prerequisites
+          from edu_current_classes c,
+               fs_versions_latest ver
+         where class_id = $class_id
+           and user_has_row_permission_p($user_id, 'read', ver.version_id, 'FS_VERSIONS') = 't'
+           and syllabus_id = file_id
+           and not exists (select 1 from edu_subjects 
+                           where subject_id = c.subject_id)
+union
+select 
+               class_name,
+               term_id,
+               c.subject_id,
+               start_date,
+               end_date,
+               coalesce(c.description, s.description) as description,
+               where_and_when,
+               syllabus_id,
+               '' as version_id,
+               '' as file_extension,
+               lecture_notes_folder_id,
+               handouts_folder_id,
+               assignments_folder_id,
+               public_p,
+               grades_p,
+               teams_p,
+               exams_p,
+               final_exam_p,
+               credit_hours, 
+               prerequisites
+          from edu_current_classes c,
+                edu_subjects s
+         where class_id = $class_id
+           and not exists (select 1 from fs_versions_latest 
+                           where file_id = syllabus_id)
+           and c.subject_id = s.subject_id
+union
+select 
+               class_name,
+               term_id,
+               c.subject_id,
+               start_date,
+               end_date,
+               coalesce(c.description, '') as description,
+               where_and_when,
+               syllabus_id,
+               '' as version_id,
+               '' as file_extension,
+               lecture_notes_folder_id,
+               handouts_folder_id,
+               assignments_folder_id,
+               public_p,
+               grades_p,
+               teams_p,
+               exams_p,
+               final_exam_p,
+               '' as credit_hours, 
+               '' as prerequisites
+          from edu_current_classes c
+         where class_id = $class_id
+           and not exists (select 1 from fs_versions_latest 
+                           where file_id = syllabus_id)
+           and not exists (select 1 from edu_subjects 
+                           where subject_id = c.subject_id)"
+
+set selection [ns_db 0or1row $db $sql]
+
+
+if {$selection == ""} {
+    ad_return_complaint 1 "<li> The class you have requested either does not exist or is not longer available to the public."
+    return
+} else {
+    set_variables_after_query
+}
+
+set header "
+
+[ad_header "Classes @ [ad_system_name]"]
+
+<h2>$class_name</h2>
+
+[ad_context_bar_ws [list "" Classes] "One Class"]
+
+<hr>
+
+<blockquote>
+"
+
+
+set class_info_text "
+<table>
+<tr>
+<th valign=top align=left>
+Description:
+</td>
+<td valign=top>
+[edu_maybe_display_text $description]
+</td>
+</tr>
+"
+
+if {![empty_string_p $credit_hours]} {
+    append class_info_text "
+    <tr>
+    <th valign=top align=left>
+    Credit Hours:
+    </td>
+    <td valign=top>
+    $credit_hours
+    </td>
+    </tr>
+    "
+}
+
+if {![empty_string_p $prerequisites]} {
+    append class_info_text "
+    <tr>
+    <th valign=top align=left>
+    Prerequisites:
+    </td>
+    <td valign=top>
+    $prerequisites
+    </td>
+    </tr>
+    "
+}
+
+append class_info_text "</table>"
+
+
+#
+#
+# get information about the instructors
+#
+#
+
+
+# "select distinct fm.sort_key,
+#           role_map.role,
+#           role_map.sort_key,
+#           pretty_role,
+#           pretty_role_plural,
+#           first_names || ' ' || last_name as user_name,
+#           users.user_id, 
+#           email,
+#           url,
+#           fm.field_name, 
+#           fm.field_value
+#      from users,
+#           user_group_map map,
+#           edu_role_pretty_role_map role_map,
+#           (select distinct fm.field_name, 
+#                    fm.field_value,
+#                    tmf.sort_key,
+#                    fm.user_id
+#               from user_group_type_member_fields tmf,
+#                    user_group_member_field_map fm,
+#                    user_group_map map
+#              where group_type = 'edu_class'
+#                and fm.group_id = $class_id
+#                and map.user_id = $user_id
+#                and map.group_id = fm.group_id
+#                and (tmf.role is null or lower(tmf.role) = lower(map.role))
+#                and lower(tmf.field_name) = lower(fm.field_name)
+#                order by sort_key) fm
+#      where users.user_id = map.user_id
+#        and (lower(map.role) = lower('[edu_get_professor_role_string]') 
+#             or lower(map.role) = lower('[edu_get_ta_role_string]'))
+#        and map.group_id = $class_id
+#        and map.user_id=fm.user_id(+)
+#        and lower(role_map.role) = lower(map.role)
+#        and role_map.group_id = map.group_id
+#   order by role_map.sort_key, role_map.role, user_name, fm.sort_key"
+
+
+set sql "select distinct fm.sort_key,
+          role_map.role,
+          role_map.sort_key,
+          pretty_role,
+          pretty_role_plural,
+          first_names || ' ' || last_name as user_name,
+          users.user_id, 
+          email,
+          url,
+          fm.field_name, 
+          fm.field_value
+     from users,
+          user_group_map map,
+          edu_role_pretty_role_map role_map,
+          user_group_member_field_mapping fm
+     where users.user_id = map.user_id
+       and fm.group_id = $class_id
+       and fm.user_id = $user_id
+       and (lower(map.role) = lower('[edu_get_professor_role_string]') 
+            or lower(map.role) = lower('[edu_get_ta_role_string]'))
+       and map.group_id = $class_id
+       and map.user_id=fm.user_id
+       and lower(role_map.role) = lower(map.role)
+       and role_map.group_id = map.group_id
+union
+select distinct fm.sort_key,
+          role_map.role,
+          role_map.sort_key,
+          pretty_role,
+          pretty_role_plural,
+          first_names || ' ' || last_name as user_name,
+          users.user_id, 
+          email,
+          url,
+          fm.field_name, 
+          fm.field_value
+     from users,
+          user_group_map map,
+          edu_role_pretty_role_map role_map,
+          user_group_member_field_mapping fm
+     where users.user_id = map.user_id
+       and fm.group_id = $class_id
+       and fm.user_id = $user_id
+       and (lower(map.role) = lower('[edu_get_professor_role_string]') 
+            or lower(map.role) = lower('[edu_get_ta_role_string]'))
+       and map.group_id = $class_id
+       and not exists (select 1 from user_group_member_field_mapping
+                       where user_id = map.user_id)
+       and lower(role_map.role) = lower(map.role)
+       and role_map.group_id = map.group_id
+  order by role_map.sort_key, role_map.role, user_name, fm.sort_key"
+
+
+# get all instructors and things like their office hours (in field_values)
+set selection [ns_db select $db $sql]
+
+
+# we use old_user_id here because the above query can potentially
+# return more than one row for each user.  For instance, for a prof,
+# it will return one row for the office location, phone number, and
+# office hours.  Since we only want to display the name once, we only
+# add the text once.
+
+set teacher_text ""
+set old_user_id ""
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    if {$old_user_id!=$user_id} {
+	if {$old_user_id!=""} {
+	    append teacher_text "</ul>"
+	}
+	
+	if {![empty_string_p $url]} {
+	    set user_name "<a href=\"$url\">$user_name</a>"
+	}
+	append teacher_text "<li>$pretty_role - $user_name (<a href=mailto:$email>$email</a>) \n"
+	set old_user_id $user_id
+	append teacher_text "<ul>"
+    }
+
+    append teacher_text "<li><b>$field_name</b>: [edu_maybe_display_text $field_value] \n"
+}
+
+if {![empty_string_p $teacher_text]} {
+    set course_staff_text "
+    <h3>Course Staff</h3>
+    <ul>
+    $teacher_text
+    </ul>
+    </ul>
+    "
+} else {
+    set course_staff_text ""
+}
+
+
+# if there is a syllabus, show a link here
+
+if {![empty_string_p $syllabus_id]} {
+    set syllabus_text "<a href=\"/file-storage/download/Syllabus.$file_extension?version_id=$version_id\">Syllabus</a>"
+} else {
+    set syllabus_text ""
+}
+
+
+set selection [ns_db select $db "select title, 
+                              edu_textbooks.textbook_id 
+                         from edu_textbooks, 
+                              edu_classes_to_textbooks_map map 
+                        where edu_textbooks.textbook_id = map.textbook_id 
+                          and map.class_id = $class_id 
+                        order by title"]
+
+set textbook_text ""
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append textbook_text "<li><a href=\"textbook-info.tcl?textbook_id=$textbook_id\">$title</a> \n"
+}
+
+
+if {![empty_string_p $textbook_text]} {
+    textbook_text_to_show "
+    <h3>Textbooks</h3>
+    <ul>
+    $textbook_text
+    </ul>
+    "
+} else {
+    set textbook_text_to_show ""
+}
+
+#################################
+#                               #
+#  Begin displaying assignments #
+#                               #
+#################################
+
+
+set assignment_text "
+<h3>Assignments</h3>
+<ul>
+"
+set user_has_turn_in_permission_p [ad_permission_p $db "" "" "Submit Tasks" $user_id $class_id]
+
+
+# set sql "select edu_assignments.assignment_name, 
+#             edu_assignments.assignment_id, 
+#             edu_assignments.due_date, 
+#             pset.version_id, 
+#             pset.file_extension,
+#             pset.url,
+#             sol.url as sol_url,
+#             sol.file_extension as sol_file_extension,
+#             sol.version_id as sol_version_id,
+#             answers.url as ans_url,
+#             answers.file_extension as ans_file_extension,
+#             answers.file_title as ans_filename,
+#             answers.version_id as ans_version_id,
+#             edu_assignments.electronic_submission_p
+#        from edu_assignments,
+#             edu_assignments edu_assignments1,
+#             (select * from fs_versions_latest 
+#               where ad_general_permissions.user_has_row_permission_p($user_id, 'read', version_id, 'FS_VERSIONS') = 't') pset,
+#             (select file_extension, url, version_id, task_id 
+#                     from fs_versions_latest ver,
+#                          edu_task_solutions solutions
+#                    where ver.file_id = solutions.file_id
+#                      and ad_general_permissions.user_has_row_permission_p($user_id, 'read', version_id, 'FS_VERSIONS') = 't') sol,
+#             (select file_extension, file_title, url, version_id, task_id
+#                     from fs_versions_latest ver,
+#                          edu_student_answers ans,
+#                          fs_files
+#                    where ver.file_id = ans.file_id 
+#                      and fs_files.file_id = ver.file_id
+#                      and ad_general_permissions.user_has_row_permission_p($user_id, 'read', version_id, 'FS_VERSIONS') = 't'
+#                      and student_id = $user_id) answers
+#       where edu_assignments.class_id = $class_id 
+#         and edu_assignments.file_id = pset.file_id(+)
+#         and edu_assignments1.assignment_id = edu_assignments.assignment_id
+#         and edu_assignments1.assignment_id = answers.task_id(+)
+#         and edu_assignments.assignment_id = sol.task_id(+)
+#      order by due_date"
+
+set sql "select edu_assignments.assignment_name, 
+            edu_assignments.assignment_id, 
+            edu_assignments.due_date, 
+            pset.version_id, 
+            pset.file_extension,
+            pset.url,
+            sol.url as sol_url,
+            sol.file_extension as sol_file_extension,
+            sol.version_id as sol_version_id,
+            answers.url as ans_url,
+            answers.file_extension as ans_file_extension,
+            answers.file_title as ans_filename,
+            answers.version_id as ans_version_id,
+            edu_assignments.electronic_submission_p
+       from edu_assignments,
+            edu_assignments edu_assignments1,
+            fs_versions_latest pset,
+            solution_files sol,
+            student_answer_files answers
+      where edu_assignments.class_id = $class_id 
+        and answers.student_id = $user_id
+        and user_has_row_permission_p($user_id, 'read', pset.version_id, 'FS_VERSIONS') = 't'
+        and edu_assignments1.assignment_id = edu_assignments.assignment_id
+        and edu_assignments.file_id = pset.file_id
+        and edu_assignments1.assignment_id = answers.task_id
+        and edu_assignments.assignment_id = sol.task_id
+union
+select edu_assignments.assignment_name, 
+            edu_assignments.assignment_id, 
+            edu_assignments.due_date, 
+            pset.version_id, 
+            pset.file_extension,
+            pset.url,
+            null::varchar as sol_url,
+            null::varchar as sol_file_extension,
+            null::int4 as sol_version_id,
+            answers.url as ans_url,
+            answers.file_extension as ans_file_extension,
+            answers.file_title as ans_filename,
+            answers.version_id as ans_version_id,
+            edu_assignments.electronic_submission_p
+       from edu_assignments,
+            edu_assignments edu_assignments1,
+            fs_versions_latest pset,
+            student_answer_files answers
+      where edu_assignments.class_id = $class_id 
+        and answers.student_id = $user_id
+        and user_has_row_permission_p($user_id, 'read', pset.version_id, 'FS_VERSIONS') = 't'
+        and edu_assignments1.assignment_id = edu_assignments.assignment_id
+        and edu_assignments.file_id = pset.file_id
+        and edu_assignments1.assignment_id = answers.task_id
+        and not exists (select 1 from solution_files 
+                        where task_id = edu_assignments.assignment_id)
+union
+select edu_assignments.assignment_name, 
+            edu_assignments.assignment_id, 
+            edu_assignments.due_date, 
+            pset.version_id, 
+            pset.file_extension,
+            pset.url,
+            sol.url as sol_url,
+            sol.file_extension as sol_file_extension,
+            sol.version_id as sol_version_id,
+            null::varchar as ans_url,
+            null::varchar as ans_file_extension,
+            null::varchar as ans_filename,
+            null::int4 as ans_version_id,
+           edu_assignments.electronic_submission_p
+       from edu_assignments,
+            edu_assignments edu_assignments1,
+            fs_versions_latest pset,
+            solution_files sol
+      where edu_assignments.class_id = $class_id 
+        and user_has_row_permission_p($user_id, 'read', pset.version_id, 'FS_VERSIONS') = 't'
+        and edu_assignments1.assignment_id = edu_assignments.assignment_id
+        and edu_assignments.file_id = pset.file_id
+        and not exists (select 1 from student_answers
+                        where task_id = edu_assignments1.assignment_id
+                        and student_id = $user_id)
+        and edu_assignments.assignment_id = sol.task_id
+union
+select edu_assignments.assignment_name, 
+            edu_assignments.assignment_id, 
+            edu_assignments.due_date, 
+            pset.version_id, 
+            pset.file_extension,
+            pset.url,
+            null::varchar as sol_url,
+            null::varchar as sol_file_extension,
+            null::int4 as sol_version_id,
+            null::varchar as ans_url,
+            null::varchar as ans_file_extension,
+            null::varchar as ans_filename,
+            null::int4 as ans_version_id,
+            edu_assignments.electronic_submission_p
+       from edu_assignments,
+            edu_assignments edu_assignments1,
+            fs_versions_latest pset
+      where edu_assignments.class_id = $class_id 
+        and user_has_row_permission_p($user_id, 'read', pset.version_id, 'FS_VERSIONS') = 't'
+        and edu_assignments1.assignment_id = edu_assignments.assignment_id
+        and edu_assignments.file_id = pset.file_id
+        and not exists (select 1 from student_answers
+                        where task_id = edu_assignments1.assignment_id
+                        and student_id = $user_id)
+        and not exists (select 1 from solution_files 
+                        where task_id = edu_assignments.assignment_id)
+union
+select edu_assignments.assignment_name, 
+            edu_assignments.assignment_id, 
+            edu_assignments.due_date, 
+            pset.version_id, 
+            pset.file_extension,
+            pset.url,
+            sol.url as sol_url,
+            sol.file_extension as sol_file_extension,
+            sol.version_id as sol_version_id,
+            answers.url as ans_url,
+            answers.file_extension as ans_file_extension,
+            answers.file_title as ans_filename,
+            answers.version_id as ans_version_id,
+            edu_assignments.electronic_submission_p
+       from edu_assignments,
+            edu_assignments edu_assignments1,
+            fs_versions_latest pset,
+            solution_files sol,
+            student_answer_files answers
+      where edu_assignments.class_id = $class_id 
+        and answers.student_id = $user_id
+        and user_has_row_permission_p($user_id, 'read', pset.version_id, 'FS_VERSIONS') = 't'
+        and edu_assignments1.assignment_id = edu_assignments.assignment_id
+        and not exists (select 1 from fs_versions_latest
+                        where file_id = edu_assignments.file_id)
+        and edu_assignments1.assignment_id = answers.task_id
+        and edu_assignments.assignment_id = sol.task_id
+union
+select edu_assignments.assignment_name, 
+            edu_assignments.assignment_id, 
+            edu_assignments.due_date, 
+            pset.version_id, 
+            pset.file_extension,
+            pset.url,
+            null::varchar as sol_url,
+            null::varchar as sol_file_extension,
+            null::int4 as sol_version_id,
+            answers.url as ans_url,
+            answers.file_extension as ans_file_extension,
+            answers.file_title as ans_filename,
+            answers.version_id as ans_version_id,
+            edu_assignments.electronic_submission_p
+       from edu_assignments,
+            edu_assignments edu_assignments1,
+            fs_versions_latest pset,
+            student_answer_files answers
+      where edu_assignments.class_id = $class_id 
+        and answers.student_id = $user_id
+        and user_has_row_permission_p($user_id, 'read', pset.version_id, 'FS_VERSIONS') = 't'
+        and edu_assignments1.assignment_id = edu_assignments.assignment_id
+        and not exists (select 1 from fs_versions_latest
+                        where file_id = edu_assignments.file_id)
+        and edu_assignments1.assignment_id = answers.task_id
+        and not exists (select 1 from solution_files 
+                        where task_id = edu_assignments.assignment_id)
+union
+select edu_assignments.assignment_name, 
+            edu_assignments.assignment_id, 
+            edu_assignments.due_date, 
+            pset.version_id, 
+            pset.file_extension,
+            pset.url,
+            sol.url as sol_url,
+            sol.file_extension as sol_file_extension,
+            sol.version_id as sol_version_id,
+            null::varchar as ans_url,
+            null::varchar as ans_file_extension,
+            null::varchar as ans_filename,
+            null::int4 as ans_version_id,
+            edu_assignments.electronic_submission_p
+       from edu_assignments,
+            edu_assignments edu_assignments1,
+            fs_versions_latest pset,
+            solution_files sol
+      where edu_assignments.class_id = $class_id 
+        and user_has_row_permission_p($user_id, 'read', pset.version_id, 'FS_VERSIONS') = 't'
+        and edu_assignments1.assignment_id = edu_assignments.assignment_id
+        and not exists (select 1 from fs_versions_latest
+                        where file_id = edu_assignments.file_id)
+        and not exists (select 1 from student_answers
+                        where task_id = edu_assignments1.assignment_id
+                        and student_id = $user_id)
+        and edu_assignments.assignment_id = sol.task_id
+union
+select edu_assignments.assignment_name, 
+            edu_assignments.assignment_id, 
+            edu_assignments.due_date, 
+            pset.version_id, 
+            pset.file_extension,
+            pset.url,
+            null::varchar as sol_url,
+            null::varchar as sol_file_extension,
+            null::int4 as sol_version_id,
+            null::varchar as ans_url,
+            null::varchar as ans_file_extension,
+            null::varchar as ans_filename,
+            null::int4 as ans_version_id,
+            edu_assignments.electronic_submission_p
+       from edu_assignments,
+            edu_assignments edu_assignments1,
+            fs_versions_latest pset
+      where edu_assignments.class_id = $class_id 
+        and edu_assignments1.assignment_id = edu_assignments.assignment_id
+        and not exists (select 1 from fs_versions_latest
+                        where file_id = edu_assignments.file_id)
+        and not exists (select 1 from student_answers
+                        where task_id = edu_assignments1.assignment_id
+                        and student_id = $user_id)
+        and not exists (select 1 from solution_files 
+                        where task_id = edu_assignments.assignment_id)
+      order by due_date"
+
+# get all of the assignments.  If there are solutions, get those.
+# if the student has uploaded their answers, get those as well
+
+set selection [ns_db select $db $sql]
+
+set count 0
+set assignment_info "<table>"
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr count
+
+    if {![empty_string_p $url]} {
+	append assignment_info "<tr><td><a href=\"$url\">$assignment_name</a></td>"
+    } elseif {![empty_string_p $version_id]} {
+	append assignment_info "<tr><td><a href=\"/file-storage/download/[join $assignment_name "_"].$file_extension?version_id=$version_id\">$assignment_name</a></td>"
+    } else {
+	append assignment_info "<td>$assignment_name</td>"
+    }
+    
+    append assignment_info "
+    <td><a href=\"assignment-info.tcl?assignment_id=$assignment_id\">Details</a></td>
+    "
+
+
+    set submit_solutions_text "Submit Solutions"
+
+    if {[string compare $electronic_submission_p t] == 0} {
+	set submit_solutions_text "Submit/Update Answers"
+
+	if {![empty_string_p $ans_url]} {
+	    append assignment_info "<td><a href=\"$ans_url\">Your Answers</a></td>"
+	} elseif {![empty_string_p $ans_version_id]} {
+	    append assignment_info "<td><a href=\"/file-storage/download/$ans_filename.$ans_file_extension?version_id=$ans_version_id\">Your Answers</a></td>"
+	} else {
+ 	    append assignment_info "<td>[ad_space]</td>"
+	}
+    } else {
+	append assignment_info "<td>[ad_space]</td>"
+    }
+
+    if {[empty_string_p $sol_url] && [empty_string_p $sol_version_id]} {
+	append assignment_info "<td>Due: [util_AnsiDatetoPrettyDate $due_date]</td> \n"
+	if {[string compare $electronic_submission_p t] == 0 && $user_has_turn_in_permission_p} {
+	    append assignment_info "<td><a href=\"task-turn-in.tcl?task_id=$assignment_id&task_type=assignment\">$submit_solutions_text</a></td>"
+	} else {
+	    append assignment_info "<td>[ad_space]</td>"
+	}
+    } elseif {![empty_string_p $sol_url]} {
+	append assignment_info "<Td colspan=2 align=left><a href=\"$sol_url\">Solutions</a></td>"
+    } elseif {![empty_string_p $sol_version_id]} {
+	append assignment_info "<td colspan=2 align=left><a href=\"/file-storage/download/$assignment_name-solutions.$sol_file_extension?version_id=$sol_version_id\">Solutions</a></td>"
+    } 
+    append assignment_info "</tr>"
+}
+
+if {$count == 0} {
+    append assignment_text "None"
+} else {
+    append assignment_text "$assignment_info </table>"
+}
+
+append assignment_text "</ul>"
+
+
+
+
+
+#
+#
+#  Begin the code to generate lecture notes
+#
+#
+
+
+
+set lecture_notes_text "
+<h3>Lecture Notes</h3>
+<ul>
+"
+# we join with fs_versions_latest to make sure that
+# they have permission to view the handout
+
+set selection [ns_db select $db "select handout_id, 
+         edu_handouts.file_id, 
+         distribution_date, 
+         handout_name,
+         url
+    from edu_handouts,
+         fs_versions_latest ver
+   where lower(handout_type) = lower('lecture_notes') 
+     and class_id = $class_id 
+     and ver.file_id = edu_handouts.file_id
+     and user_has_row_permission_p($user_id, 'read', version_id, 'FS_VERSIONS') = 't'
+order by distribution_date"]
+
+
+set lecture_notes_count 0
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr lecture_notes_count
+
+    if {![empty_string_p $url]} {
+	append lecture_notes_text "<tr><td> <a href=\"$url\">$handout_name</a>"
+    } elseif {![empty_string_p $version_id]} {
+	append lecture_notes_text "<tr><td> <a href=\"/file-storage/download/[join $handout_name "_"].$file_extension?version_id=$version_id\">$handout_name</a>"
+    } else {
+	append lecture_notes_text "<tr><td> $handout_name"
+    }
+    
+    append lecture_notes_text "
+    <td>Distributed: 
+    [util_AnsiDatetoPrettyDate $distribution_date]
+    </td></tr>"
+}
+
+if {$lecture_notes_count == 0} {
+    append lecture_notes_text "<tr><td>There are currently no lecture notes.</td></tr>"
+}
+
+append lecture_notes_text "</table></ul>"
+
+
+#
+#
+#  Begin the code to generate Handouts
+#
+#
+
+
+
+set handouts_text "
+<h3>Handouts</h3>
+<ul>
+<table>
+"
+
+set selection [ns_db select $db "select version_id, 
+         edu_handouts.file_id, 
+         distribution_date, 
+         handout_name
+    from edu_handouts,
+         fs_versions_latest ver
+   where lower(handout_type) = lower('general') 
+     and ver.file_id = edu_handouts.file_id
+     and class_id = $class_id 
+     and user_has_row_permission_p($user_id, 'read', version_id, 'FS_VERSIONS') = 't'
+order by distribution_date"]
+
+set handouts_count 0
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr handouts_count
+
+    if {![empty_string_p $url]} {
+	append handouts_text "<tr><td> <a href=\"$url\">$handout_name</a>"
+    } elseif {![empty_string_p $version_id]} {
+	append handouts_text "<tr><td> <a href=\"/file-storage/download/[join $handout_name "_"].$file_extension?version_id=$version_id\">$handout_name</a>"
+    } else {
+	append handouts_text "<tr><td> $handout_name"
+    }
+    
+    append handouts_text "
+    <td>Distributed: 
+    [util_AnsiDatetoPrettyDate $distribution_date]
+    </td></tr>"
+}
+
+if {$handouts_count == 0} {
+    append handouts_text "<tr><td>There are currently no handouts.</td></tr>"
+}
+
+append handouts_text "</table></ul>"
+
+
+
+#################################
+#                               #
+#  Begin displaying exams       #
+#                               #
+#################################
+
+
+if {[string compare $exams_p t] == 0} {
+
+#     set sql "select exam_name, 
+#              e.exam_id,
+#              ver.version_id,
+#              ver.file_extension,
+#              ver.url,
+#              ver.file_id,
+#              sol.version_id as sol_version_id,
+#              sol.file_extension as sol_file_extension,
+#              sol.url as sol_url,
+#              sol.file_id as sol_file_id
+#         from edu_exams e,
+#              (select * from fs_versions_latest 
+#               where ad_general_permissions.user_has_row_permission_p($user_id, 'read', version_id, 'FS_VERSIONS') = 't') ver,
+#              (select file_extension, url, version_id, task_id, ver.file_id 
+#                     from fs_versions_latest ver,
+#                          edu_task_solutions solutions
+#                    where ver.file_id = solutions.file_id
+#                      and ad_general_permissions.user_has_row_permission_p($user_id, 'read', version_id, 'FS_VERSIONS') = 't') sol
+#     where e.class_id = $class_id
+#     and e.exam_id = sol.task_id(+)
+#     and e.file_id = ver.file_id(+)"
+
+    set sql "select exam_name, 
+             e.exam_id,
+             ver.version_id,
+             ver.file_extension,
+             ver.url,
+             ver.file_id,
+             sol.version_id as sol_version_id,
+             sol.file_extension as sol_file_extension,
+             sol.url as sol_url,
+             sol.file_id as sol_file_id
+        from edu_exams e,
+             fs_versions_latest ver,
+             task_files sol
+    where e.class_id = $class_id
+    and user_has_row_permission_p($user_id, 'read', ver.version_id, 'FS_VERSIONS') = 't'
+    and e.exam_id = sol.task_id
+    and e.file_id = ver.file_id
+  union
+ select exam_name, 
+             e.exam_id,
+             ver.version_id,
+             ver.file_extension,
+             ver.url,
+             ver.file_id,
+             sol.version_id as sol_version_id,
+             sol.file_extension as sol_file_extension,
+             sol.url as sol_url,
+             sol.file_id as sol_file_id
+        from edu_exams e,
+             fs_versions_latest ver,
+             task_files sol
+    where e.class_id = $class_id
+    and user_has_row_permission_p($user_id, 'read', ver.version_id, 'FS_VERSIONS') = 't'
+    and e.exam_id = sol.task_id
+    and not exists (select 1 from fs_versions_latest 
+                    where file_id = e.file_id)
+  union
+ select exam_name, 
+             e.exam_id,
+             ver.version_id,
+             ver.file_extension,
+             ver.url,
+             ver.file_id,
+             '' as sol_version_id,
+             '' as sol_file_extension,
+             '' as sol_url,
+             '' as sol_file_id
+        from edu_exams e,
+             fs_versions_latest ver
+    where e.class_id = $class_id
+    and user_has_row_permission_p($user_id, 'read', ver.version_id, 'FS_VERSIONS') = 't'
+    and not exists (select 1 from task_files 
+                    where task_id = e.exam_id)
+    and e.file_id = ver.file_id
+  union
+ select exam_name, 
+             e.exam_id,
+             ver.version_id,
+             ver.file_extension,
+             ver.url,
+             ver.file_id,
+             '' as sol_version_id,
+             '' as sol_file_extension,
+             '' as sol_url,
+             '' as sol_file_id
+        from edu_exams e,
+             fs_versions_latest ver    where e.class_id = $class_id
+    and user_has_row_permission_p($user_id, 'read', ver.version_id, 'FS_VERSIONS') = 't'
+    and not exists (select 1 from task_files 
+                    where task_id = e.exam_id)
+    and not exists (select 1 from fs_versions_latest 
+                    where file_id = e.file_id)"
+
+    set selection [ns_db select $db $sql]
+    
+    set n_exams 0
+
+    while {[ns_db getrow $db $selection]} {
+	set_variables_after_query
+	
+	if {!$n_exams} {
+	    set exam_text "
+	    <h3>Exams</h3>
+	    <ul>
+	    <table>"
+	}
+
+	if {![empty_string_p $sol_url]} {
+	    append exam_text "<tr><Td><a href=\"$sol_url\">solutions</a></td>"
+	} elseif {![empty_string_p $version_id]} {
+	    append exam_text "
+	    <tr><td><a href=\"/file-storage/download/$exam_name.$file_extension?version_id=$version_id\">$exam_name</a></td>"
+	} else {
+	    append exam_text "<tr><td>$exam_name</a></td>\n"
+	}
+
+	append exam_text "<td><a href=\"exam-info.tcl?exam_id=$exam_id\">Details</a></td>\n"
+	
+	if {[empty_string_p $sol_url] && ![empty_string_p $sol_version_id]} {
+	    # there are already solutions - a file in the file system
+	    append exam_text "
+	    <td><a href=\"/file-storage/download/$exam_name.$sol_file_extension?version_id=$sol_version_id\">solutions</a></td>"
+	} elseif {![empty_string_p $sol_url]} {
+	    # there are already solutions - a url
+	    append exam_text "<td><a href=\"$sol_url\">Solutions</a></td>"
+	} else {
+	    append exam_text "<td>[ad_space]</td>"
+	}
+	incr n_exams
+    }
+
+    if {$n_exams > 0} {
+	append exam_text "</table></ul>"
+    } else {
+	set exam_text ""
+    }
+
+    
+} else {
+    set exam_text ""
+}
+
+
+#################################
+#                               #
+#  Begin displaying projects    #
+#                               #
+#################################
+
+
+set projects_string ""
+set n_projects 0
+set selection [ns_db select $db "select project_name,
+       project_id
+from edu_projects
+where class_id = $class_id"]
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    incr n_projects
+    append projects_string "<li><a href=\"projects/one.tcl?[export_url_vars project_id]\">$project_name</a>\n"
+}
+
+if $n_projects {
+    set project_text "
+    <h3>Projects</h3>
+    <ul>
+    $projects_string
+    </ul>"
+} else {
+    set project_text ""
+}
+
+
+#################################
+#                               #
+#  Begin displaying teams       #
+#                               #
+#################################
+
+
+if {[string compare $teams_p t] == 0} {
+    set teams_string ""
+    
+    set n_teams [database_to_tcl_string $db "select count(team_id) from edu_teams where class_id = $class_id"]
+set user_id 0
+    if {![string compare $user_id 0] == 0} {
+	set selection [ns_db select $db "select team_name, team_id, project_name, project_description, project_url from edu_teams, user_group_map map where class_id = $class_id and map.user_id = $user_id and map.group_id = edu_teams.class_id"]
+	
+	while {[ns_db getrow $db $selection]} {
+	    set_variables_after_query
+	    incr n_teams -1
+	    if {$n_teams > 1} {
+		append teams_string "<br><br>"
+	    }
+	    append teams_string "
+	    <li>Team Name: <a href=\"team-info.tcl?team_id=$team_id\">$team_name</a>
+	    <li>Project Name: $project_name 
+	    <li>Project Description: $project_description 
+	    <li>Project URL: [edu_maybe_display_text "<a href=\"$project_url\">$project_url</a>"]
+	    "
+	}
+
+	if {$n_teams > 0} {
+	    # lets provide a link to view the rest of the teams
+	    append teams_string "<br><br>
+	    <a href=\"teams-view.tcl?class_id=$class_id\">View All Teams</a> - fix this so that this only shows up if all of the teams have not already been displayed.
+	    "
+	}
+    } else {
+	
+	# the user is not logged in or is not a member of any team 
+	# so list all of the teams by name
+
+	set selection [ns_db select $db "select team_name, team_id from edu_teams where class_id = $class_id"]
+
+	set n_teams 0
+	while {[ns_db getrow $db $selection]} {
+	    set_variables_after_query
+	    incr n_teams
+	    append teams_string "
+	    <li><a href=\"team-info.tcl?team_id=$team_id\">$team_name</a>\n"
+	}
+    }
+
+    if {![empty_string_p $teams_string]} {
+	set teams_text "
+	<h3>Teams</h3>
+	<ul>
+	$teams_string
+	</ul>
+	"
+    } else {
+	set teams_text ""
+    }
+} else {
+    set teams_text ""
+}
+
+
+#################################
+#                               #
+#  Begin displaying news        #
+#                               #
+#################################
+
+
+set news_string ""
+
+set query "select news_item_id, title, release_date
+from news_items, newsgroups
+where newsgroups.newsgroup_id = news_items.newsgroup_id
+and sysdate() between release_date and expiration_date
+and approval_state = 'approved'
+and group_id = $class_id
+and scope = 'group'
+order by release_date desc, creation_date desc"
+
+set selection [ns_db select $db $query]
+
+set counter 0 
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append news_string "<li>[util_AnsiDatetoPrettyDate $release_date]: <a href=\"/news/item.tcl?news_item_id=$news_item_id\">$title</a>\n"
+    incr counter 
+}
+
+if { $counter > 0 } {
+    set news_text "
+    <h3>News</h3>
+    <ul>$news_string</ul>"
+} else {
+    set news_text ""
+}
+
+
+################################################
+#                                              #
+#  Begin displaying collaboration items        #
+#                                              #
+################################################
+
+set chat_room_id [database_to_tcl_string_or_null $db "select chat_room_id from chat_rooms where group_id=$class_id"]
+
+# select the bboard topic that is accessible to students in the class
+# set bboard_cnt [database_to_tcl_string $db "
+# select count(*) 
+# from bboard_topics t,
+#      edu_role_pretty_role_map m1, edu_role_pretty_role_map m2 
+# where t.group_id=$class_id 
+# and t.role=m1.role
+# and m1.priority>=m2.priority
+# and m2.role='student'"]
+
+# if {$bboard_cnt>0} {
+#     set bboard_info "<li><a href=/bboard/index.tcl?group_id=$class_id>Q&A Forum</a>"
+#} else {
+    set bboard_info ""
+#}
+
+
+if {![empty_string_p $bboard_info] && ![empty_string_p $chat_room_id]} {
+    set collaboration_text "
+    <h3>Collaboration</h3>
+    <ul>
+    $bboard_info
+    [ec_decode $chat_room_id "" "" "<li><a href=/chat/enter-room.tcl?chat_room_id=$chat_room_id>Chat Room</a>"]
+    </ul>
+    "
+} else {
+    set collaboration_text ""
+}
+
+set selection [ns_db select $db "
+select grade_name, weight, grade_id
+from edu_grades where class_id=$class_id"]
+set count 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    if {$count == 0} {
+	set grades_text "
+	<h3>Grade Distribution</h3>
+	<ul>"
+    }
+    append grades_text "
+    <li>$grade_name - $weight\%"
+    incr count
+}    
+
+if {!$count} {
+    set grades_text ""
+} else {
+    append grades_text "</ul>"
+}
+
+
+
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "
+$header
+$news_text
+$class_info_text
+$course_staff_text
+$syllabus_text
+$textbook_text_to_show
+$assignment_text
+$lecture_notes_text
+$handouts_text
+$exam_text
+$grades_text
+$project_text
+$teams_text
+$collaboration_text
+</blockquote>
+[ad_footer]
+"
Index: web/openacs/www/education/class/student-register-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/student-register-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/student-register-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,101 @@
+#
+# /www/education/class/student-register.tcl
+#
+# user-side analogy of /education/class/admin/user-info-edit.tcl allows a student 
+# to register for a class. 
+#
+# aileen@arsdigita.com, randyg@arsdigita.com
+#
+# January, 2000
+
+# $field_names from user_group_type_member_fields where role in 
+# ugt_member_fields_to_role_map = 'student'
+# user_id class_id account_proc2 account_number (optional) 
+
+set_the_usual_form_variables
+
+validate_integer class_id $class_id
+
+set handles [edu_get_two_db_handles]
+set db [lindex $handles 0]
+set db_sub [lindex $handles 1]
+
+
+set selection [ns_db select $db "
+select field_name, sort_key 
+from user_group_type_member_fields f, ugt_member_fields_to_role_map m
+where group_type='edu_class'
+and m.field_id=f.member_field_id
+and m.role='student'
+order by sort_key"]
+
+set mail_string ""
+
+ns_db dml $db_sub "begin transaction"
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    
+    # this is just to be safe. we can't assume that student info isn't
+    # populated in places other than this script. so check if the values
+    # already exist
+    ns_db dml $db_sub "
+    delete from user_group_member_field_map
+    where user_id=$user_id 
+    and group_id=$class_id 
+    and field_name='[DoubleApos $field_name]'"
+
+    ns_db dml $db_sub "
+    insert into user_group_member_field_map
+    (field_name, user_id, group_id, field_value)
+    values
+    ('[DoubleApos $field_name]', $user_id, $class_id, '[DoubleApos [set $field_name]]')"
+
+    if {$field_name!="Student Account"} {
+	append mail_string "\n\n
+	$field_name: [set $field_name]"
+    } else {
+	set email_extra [$account_proc2 $db_sub [set $field_name]]
+    }
+}
+
+# add the student to the class if not already in:
+if {[database_to_tcl_string $db_sub "select count(*) from user_group_map where user_id=$user_id and group_id=$class_id"]==0} {
+    ns_db dml $db_sub "insert into user_group_map 
+    (group_id, user_id, role, registration_date, mapping_user, mapping_ip_address) 
+    values 
+    ($class_id, $user_id, 'student', sysdate(), $user_id, '[ns_conn peeraddr]')"
+}
+
+ns_db dml $db_sub "end transaction"
+
+
+
+set class_name [database_to_tcl_string $db "select class_name from edu_classes where class_id=$class_id"]
+
+set email [database_to_tcl_string $db "select email from users where user_id=$user_id"]
+
+ns_sendmail $email "registration-robot" "New Registration for $class_name" "You have successfully registered for $class_name with the following info: 
+$mail_string \n\n
+$email_extra
+"
+
+set return_string "
+[ad_header "$class_name @ [ad_system_name]"]
+
+<h2>Registration for $class_name Successful!</h2>
+
+[ad_context_bar_ws_or_index "Registration"]
+
+<hr>
+You have successfully registered for $class_name. A confirmation email has been sent to your email address $email.
+<p>
+<a href=/index.adp>Return to the class home page</a>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+ns_db releasehandle $db_sub
+
+
+ns_return 200 text/html $return_string
Index: web/openacs/www/education/class/student-register.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/student-register.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/student-register.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,103 @@
+#
+# /www/education/class/student-register.tcl
+#
+# user-side analogy of /education/class/admin/user-info-edit.tcl 
+# allows a student to register for a class. 
+#
+# aileen@arsdigita.com, randyg@arsdigita.com
+#
+# January, 2000
+
+# class_id, account_proc (optional) - a customizable procedure used to generate account numbers  
+# account_proc2 (optional) the same customizable procedure used on student-register-2.tcl
+ad_page_variables {
+    class_id
+    {account_proc edu_generate_student_account}
+    {account_proc2 edu_process_student_account}
+}
+
+validate_integer class_id $class_id
+
+set user_id [ad_verify_and_get_user_id]
+
+set curr_url [ns_conn url]?class_id=$class_id
+
+if {!$user_id} {
+    ns_returnredirect /register.tcl?return_url=$curr_url
+    return
+}
+
+set db [ns_db gethandle]
+
+set class_name [database_to_tcl_string $db "select class_name from edu_classes where class_id=$class_id"]
+
+
+set return_string "
+[ad_header "$class_name @ [ad_system_name]"]
+
+<h2>Register for $class_name</h2>
+
+[ad_context_bar_ws_or_index "Registration"]
+
+<hr>
+<blockquote>
+<form method=post action=\"student-register-2.tcl\">
+<table>
+"
+
+set email [database_to_tcl_string $db "
+select email from users where user_id=$user_id"]
+
+append return_string "
+<tr><th align=right>Email:</th>
+<td>$email</td></tr>
+"
+
+# get an account number or ask for user input. account_proc should signal an
+# error if an account number could not be generated.
+if {[catch {$account_proc $db} errmsg]} {
+    ad_return_complaint 1 "<li>$errmsg"
+    return
+}
+
+set selection [ns_db select $db "
+select field_name, sort_key 
+from user_group_type_member_fields f, ugt_member_fields_to_role_map m
+where group_type='edu_class'
+and m.field_id=f.member_field_id
+and m.role='student'
+order by sort_key"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    append return_string "
+    <tr>
+    <th align=right>$field_name</th>"
+
+    # if account number is not set then we assume we're getting input from user
+    if {$field_name=="Student Account" && [info exists account_number]} {
+	append return_string "<td>$account_number</td></tr>
+	<input type=hidden name=\"$field_name\" value=$account_number>"
+    } else {
+	append return_string "
+	<td><input type=text size=40 name=\"$field_name\"></td>
+	</tr>
+	"
+    }
+}
+
+append return_string "
+[export_form_vars user_id class_id account_number account_proc2]
+<tr><th></th>
+<td><input type=submit value=Register></td>
+</tr>
+</table>
+</blockquote>
+</form>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
Index: web/openacs/www/education/class/syllabus.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/syllabus.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/syllabus.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,33 @@
+#
+# /www/education/class/syllabus.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page serves the syllabus for the given class
+#
+
+set db [ns_db gethandle]
+
+
+set id_list [edu_user_security_check $db]
+set class_id [lindex $id_list 1]
+
+# this does not expect any arguemnts
+
+if {[database_to_tcl_string $db "select count(class_id) from edu_current_classes where class_id = $class_id and syllabus is not null"] == 0} {
+    ad_return_complaint 1 "<li>The syllabus you have requested either does not exist or access to it has been restricted by the course administrator."
+    return
+}
+
+set file_type [database_to_tcl_string $db "select syllabus_file_type from edu_current_classes where class_id = $class_id"]
+
+
+set syllabus [database_to_tcl_string $db "select syllabus from edu_classes where class_id = $class_id"]
+
+ReturnHeaders $file_type
+
+#ns_ora write_clob $db "select syllabus from edu_classes where class_id = $class_id"
+
+ns_write $syllabus
+
+ns_db releasehandle $db
Index: web/openacs/www/education/class/task-turn-in-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/task-turn-in-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/task-turn-in-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,85 @@
+#
+# /www/education/class/task-turn-in-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu
+#
+# this file updates the edu_student_tasks table to reflect the uploaded file
+# (aileen@mit.edu) - notice we don't insert until this last page - this is
+# to protect against users backing up in previous pages b/c the file stuff 
+# we do there isn't 100% fool-proof. so we update our tables here after we are
+# sure that the file insert were completed w/o error 
+
+ad_page_variables {
+    file_id
+    task_id
+    {return_url index.tcl}
+}    
+
+validate_integer file_id $file_id
+validate_integer task_id $task_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Submit Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+# lets make sure the student has write permission on this file.  If they do not
+# then the file obviously does not belong to them
+
+if {![database_to_tcl_string $db "select (case when user_has_row_permission_p($user_id, 'read', version_id, 'FS_VERSIONS') = 't' then 1 else 0 end) from fs_versions_latest where file_id = $file_id"]} {
+
+    # this only happens if someone is trying to do url surgery so lets try to 
+    # scare them a little bit.
+
+    ad_return_complaint 1 "<li>You are not authorized to claim this file as your own.  You really should think about the fact that you are trying to claim someone else's work as your own.  This has been recorded and the instructor will be notified if you try to do this again. $file_id"
+    return
+}
+
+
+set insert_sql "insert into edu_student_answers (
+       student_id,
+       task_id,
+       file_id,
+       last_modified,
+       modified_ip_address,
+       last_modifying_user)
+    values (
+       $user_id,
+       $task_id,
+       $file_id,
+       sysdate(),
+       '[ns_conn peeraddr]',
+       $user_id)"
+
+
+if {[catch { ns_db dml $db $insert_sql } errmsg] } {
+    # insert failed; let's see if it was because of duplicate submission
+    if {[database_to_tcl_string $db "select count(task_id) from edu_student_answers where task_id = $task_id and student_id = $user_id"] > 0} {
+	# it was a double click so redirect the user
+	ns_db releasehandle $db
+	ns_returnredirect $return_url
+    } else {
+	ns_log Error "[edu_url]class/task-turn-in-2.tcl choked:  $errmsg"
+	ad_return_error "Insert Failed" "The Database did not like what you typed.  This is probably a bug in our code.  Here's what the database said:
+	<blockquote>
+	<pre>
+	$errmsg
+	</pre>
+	</blockquote>
+	"
+	return
+    }
+}
+
+
+ns_db releasehandle $db
+
+ns_returnredirect $return_url
+
+
+
+
+
+
Index: web/openacs/www/education/class/task-turn-in.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/task-turn-in.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/task-turn-in.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,158 @@
+#
+# /www/education/class/task-turn-in.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, February 2000
+#
+# this page allows students to upload their answers to tasks
+#
+
+ad_page_variables {
+    task_id
+    task_type
+    {return_url one.tcl}
+}
+
+validate_integer task_id $task_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Submit Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+if {[empty_string_p $task_id]} {
+    ad_return_complaint 1 "<li>You must include an task for the solutions."
+    return
+} 
+
+
+# "select task_name, 
+#           answers.file_id,
+#           url,
+#           ${task_type}s_folder_id
+#      from edu_student_tasks tasks, 
+#           edu_current_classes class,
+#           (select ans.file_id, 
+#                  task_id,
+#                  url
+#             from edu_student_answers ans,
+#                  (select * from fs_versions_latest 
+#                   where ad_general_permissions.user_has_row_permission_p($user_id, 'read', version_id, 'FS_VERSIONS') = 't') ver
+#             where ver.file_id = ans.file_id
+#               and ans.student_id = $user_id) answers
+#     where tasks.task_id = $task_id 
+#       and tasks.class_id = $class_id
+#       and tasks.task_id = answers.task_id(+)
+#       and tasks.class_id = class.class_id"
+
+
+
+set sql "
+select task_name, 
+          answers.file_id,
+          url,
+          ${task_type}s_folder_id
+     from edu_student_tasks tasks, 
+          edu_current_classes class,
+          student_files answers
+    where tasks.task_id = $task_id 
+      and answers.student_id = $user_id
+      and tasks.class_id = $class_id
+      and tasks.task_id = answers.task_id
+      and tasks.class_id = class.class_id
+union
+select task_name, 
+          answers.file_id,
+          url,
+          ${task_type}s_folder_id
+     from edu_student_tasks tasks, 
+          edu_current_classes class,
+          student_files answers
+    where tasks.task_id = $task_id 
+      and answers.student_id = $user_id
+      and tasks.class_id = $class_id
+      and not exists (select 1 from student_files 
+                      where task_id = tasks.task_id)
+      and tasks.class_id = class.class_id"
+
+# lets make sure that the taskis in the class and lets see if this
+# is an add or an edit.
+set selection [ns_db 0or1row $db $sql]
+
+
+if {$selection == ""} {
+    ad_return_complaint 1 "The $task_type you have requested does not belong to this class or access to is has been restricted by the course administrator"
+    return
+} else {
+    set_variables_after_query
+}
+
+
+
+set read_permission [edu_get_ta_role_string]
+set write_permission [edu_get_professor_role_string]
+	
+
+if {[empty_string_p $file_id]} {
+    set target_url "upload-new.tcl"
+    set file_id [database_to_tcl_string $db "select fs_file_id_seq.nextval from dual"]
+    set return_url "task-turn-in-2.tcl?task_id=$task_id&file_id=$file_id&[export_url_vars return_url]"
+} else {
+    set target_url "upload-version.tcl"
+}
+
+
+set version_id [database_to_tcl_string $db "select fs_version_id_seq.nextval from dual"]
+set file_title "Student Solutions"
+
+
+set return_string "
+[ad_header "Upload Answers @ [ad_system_name]"]
+
+<h2>Upload Answers for $task_name</h2>
+
+[ad_context_bar_ws_or_index [list "" "All Classes"] [list "one.tcl" "$class_name Home"] "Upload Answers"]
+
+<hr>
+
+<blockquote>
+
+<form enctype=multipart/form-data method=POST action=\"$target_url\">
+
+[export_form_vars return_url file_id version_id read_permission write_permission parent_id file_title]
+
+<table>
+<tr>
+<td valign=top align=right><Br>URL: </td>
+<td><br><input type=input name=url value=\"\" size=40> (make sure to include the http://)</td>
+</tr>
+
+<tr>
+<td valign=top align=right><EM>or</EM> filename: </td>
+<td><input type=file name=upload_file size=20>
+<Br><FONT SIZE=-1>Use the \"Browse...\" button to locate your file, then click \"Open\".
+</FONT><br><Br></td>
+</tr>
+
+
+</td>
+</tr>
+<tr>
+<td colspan=2 align=center>
+<br>
+<input type=submit value=\"Upload Answers\">
+</td>
+</tr>
+</table>
+
+</form>
+
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
Index: web/openacs/www/education/class/team-info.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/team-info.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/team-info.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,162 @@
+#
+# /www/education/class/team-info.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, February 2000
+#
+# this page displays info about a given team
+#
+
+ad_page_variables {
+    team_id
+}
+
+validate_integer team_id $team_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_user_security_check $db]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+
+
+set exception_count 0
+set exception_text ""
+
+
+if {[empty_string_p $team_id]} {
+    incr exception_count
+    append exception_text "<li>You must provide a team number."
+} else {
+    set selection [ns_db 0or1row $db "select
+                     team_name,
+                     class_name,
+                     edu_current_classes.class_id
+                from edu_teams,
+                     edu_current_classes
+               where team_id = $team_id
+                 and edu_current_classes.class_id = edu_teams.class_id
+                 and edu_teams.class_id = $class_id"]
+
+    if {$selection == ""} {
+	incr exception_count
+	append exception_text "The team number that you have requested does not exist or access to this page has been restricted by the class administrator and you are not authorized."
+    } else {
+	set_variables_after_query
+    }
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+set return_string "
+[ad_header "View Team for $class_name @ [ad_system_name]"]
+<h2>$team_name</h2>
+Part of $class_name
+<p>
+[ad_context_bar_ws_or_index [list "" "All Classes"] [list "one.tcl" "$class_name Home"] [list "teams-view.tcl?class_id=$class_id" "View Teams"] "One Team"]
+
+<hr>
+
+<blockquote>
+
+<h3>Team Members</h3>
+<ul>
+"
+
+# if the current user is a team member or someone in the class
+# with "Spam Users" permissions
+
+set spam_user_permission_p [ad_permission_p $db "" "" "Spam Users" $user_id $class_id]
+
+set selection [ns_db select $db "select users.user_id as student_id, 
+             first_names || ' ' || last_name as student_name,
+             url as student_url 
+        from edu_teams, 
+             user_group_map map, 
+             users 
+       where team_id = map.group_id 
+         and map.user_id = users.user_id
+         and team_id = $team_id
+     order by last_name"]
+
+
+set count 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    if {[empty_string_p $student_url]} {
+	append return_string "<li>$student_name"
+    } else {
+	append return_string "<li><a href=\"$student_url\">$student_name</a>"
+    }
+    incr count
+
+    # if they are a member of the team, let them spam the team
+    if {$student_id == $user_id} {
+	set spam_user_permission_p 1
+    }
+}
+
+set show_spam_link_p 1
+
+if {$count == 0} {
+    append return_string "There are not currently any students assigned to this team."
+    set show_spam_link_p 0
+}
+
+if {$spam_user_permission_p && $show_spam_link_p} {
+    append return_string "<p><a href=\"spam.tcl?who_to_spam=member&subgroup_id=$team_id\">Spam Team Members</a>"
+}
+
+
+append return_string "
+</ul>
+
+<h4>Status Reports</h4>
+<ul>
+"
+
+
+set comment_permission_p [database_to_tcl_string_or_null $db "select 1 from users, 
+        user_group_map ug_map
+  where users.user_id = $user_id 
+    and ug_map.group_id = $team_id
+    and users.user_id = ug_map.user_id"]
+
+if {[empty_string_p $comment_permission_p]} {
+    set comment_permission_p [ad_permission_p $db "" "" "View Admin Pages" $user_id $class_id]
+}
+
+if {$comment_permission_p == 1} {
+    set progress_reports [ad_general_comments_list $db $team_id EDU_TEAM_INFO $team_name]
+} else {
+    set progress_reports "[ad_general_comments_summary_sorted $db $team_id EDU_TEAM_INFO $team_name]"
+}
+
+if {[string compare $progress_reports "<ul></ul>"] == 0} {
+    append return_string "No status reports available"
+} else {
+    append return_string "$progress_reports"
+}
+
+
+append return_string "
+</ul>
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
Index: web/openacs/www/education/class/teams-view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/teams-view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/teams-view.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,76 @@
+#
+# /www/education/class/teams-view.tcl
+#
+# by randyg@arsdigita.com, aileen@arsdigita.com, February 2000
+#
+# this page lists the teams in the class
+#
+
+# this page does not expect any input
+
+
+set db [ns_db gethandle]
+
+set id_list [edu_user_security_check $db]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+
+set selection [ns_db 0or1row $db "select class_name, class_id from edu_current_classes where class_id = $class_id"]
+
+if {$selection == ""} {
+    ad_return_complaint 1 "<li>The class identification number that you have provided is not valid either because it is an old class or because access to this page has been restricted by the class administrator."
+    return
+} else {
+    set_variables_after_query
+}
+
+
+set selection [ns_db select $db "
+select t.* from edu_teams t
+where class_id=$class_id"]
+
+set return_string "
+[ad_header "View Teams for $class_name"]
+
+<h2>Teams</h2>
+
+[ad_context_bar_ws_or_index [list "" "All Classes"] [list "one.tcl" "$class_name Home"] "View Teams"]
+
+<hr>
+
+<blockquote>
+"
+
+set team_string ""
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    append team_string "
+    <li><a href=\"team-info.tcl?team_id=$team_id\">$team_name</a>
+    "
+}
+
+if {[empty_string_p $team_string]} {
+    append return_string "
+    There are no teams for $class_name
+    "
+} else {
+    append return_string "$team_string"
+}
+
+append return_string "
+<br>
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
Index: web/openacs/www/education/class/textbook-info.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/textbook-info.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/textbook-info.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,77 @@
+#
+# /www/education/education/class/textbook-info.tcl
+#
+# this page allows users to see information about a given textbook
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+
+#
+# there is not a security check of any sort on this page because
+# this never displays any confidential or secret information
+#
+
+ad_page_variables {
+    textbook_id
+}
+
+validate_integer textbook_id $textbook_id
+
+if {[empty_string_p $textbook_id]} {
+    ad_return_complaint 1 "<li>You must provide a textbook identification number.
+    return
+}
+
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select title, author, publisher, isbn from edu_textbooks where textbook_id = $textbook_id"]
+
+if {$selection == ""} {
+    ad_return_complaint 1 "<li>The textbook identification number you have provided is not valid."
+    return
+} else {
+    set_variables_after_query
+}
+
+set return_string "
+[ad_header "Textbooks @ [ad_system_name]"]
+
+<h2>Textbook Information</h2>
+
+[ad_context_bar_ws_or_index [list "" "All Classes"] [list one.tcl "Class Home"] "Text Book Information"]
+
+<hr>
+<blockquote>
+
+<table>
+
+<tr>
+<th align=left>Title:</td>
+<td>$title
+</tr>
+
+<tr>
+<th align=left>Author:</td>
+<td>$author
+</tr>
+
+<tr>
+<th align=left>Publisher:</td>
+<td>$publisher
+</tr>
+
+<tr>
+<th align=left>ISBN:</td>
+<td>$isbn
+</tr>
+</table>
+
+</blockquote>
+
+[ad_footer]
+"
+
+ns_db relasehandle $db
+
+ns_return 200 text/html $return_string
Index: web/openacs/www/education/class/admin/action-role-map.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/action-role-map.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/action-role-map.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,57 @@
+#
+# /www/education/class/admin/action-role-map.tcl
+#
+# this page maps a role to an action
+# 
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+
+
+ad_page_variables {
+    role
+    action
+    group_id
+}
+
+validate_integer group_id $group_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Edit Permissions"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+
+# make sure the group_id = class_id
+
+if {[string compare $group_id $class_id] != 0} {
+    ad_return_complaint 1 "<li>You can only change the action role mappings for the class you are currently logged in as."
+    return
+}
+
+
+ns_db dml $db "
+insert into user_group_action_role_map 
+ (group_id, 
+  role, 
+  action, 
+  creation_user, 
+  creation_ip_address)
+select 
+  $group_id, 
+  '$QQrole', 
+  '$QQaction', 
+  $user_id, 
+  '[DoubleApos [ns_conn peeraddr]]' 
+from dual 
+where not exists (select 
+          role 
+     from user_group_action_role_map 
+    where group_id = $group_id 
+      and role = '$QQrole' 
+      and action = '$QQaction')"
+
+ns_db releasehandle $db
+
+ns_returnredirect "permissions.tcl"
+
+
Index: web/openacs/www/education/class/admin/action-role-unmap.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/action-role-unmap.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/action-role-unmap.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,39 @@
+#
+# /www/education/class/admin/action-role-unmap.tcl
+#
+# this page unmaps a role from an action
+# 
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+
+
+ad_page_variables {
+    role
+    action
+    group_id
+}
+
+validate_integer group_id $group_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Edit Permissions"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+
+# make sure the group_id = class_id
+
+if {[string compare $group_id $class_id] != 0} {
+    ad_return_complaint 1 "<li>You can only change the action role mappings for the class you are currently logged in as."
+    return
+}
+
+ns_db dml $db "delete from 
+user_group_action_role_map
+where group_id = $group_id 
+and role = '$QQrole' and action = '$QQaction'"
+
+ns_db releasehandle $db
+
+ns_returnredirect permissions.tcl
+
Index: web/openacs/www/education/class/admin/assignment-info.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/assignment-info.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/assignment-info.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,671 @@
+#
+# /www/education/class/admin/assignment-info.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page shows information for a given assignment
+#
+
+ad_page_variables {
+    assignment_id
+}
+
+validate_integer assignment_id $assignment_id
+
+set db [ns_db gethandle]
+
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "View Admin Pages"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+set return_url "[edu_url]class/admin/assignment-info.tcl?assignment_id=$assignment_id"
+
+
+
+# make sure that the person is logged in under the correct class.  If not,
+# tell them and give them the option to log in as the correct class if
+# applicable
+
+set assignment_class_id [database_to_tcl_string $db "select class_id from edu_assignments where assignment_id = $assignment_id"]
+
+if {[string compare $assignment_class_id $class_id] != 0} {
+    # lets see if the person has permission to view this assignment
+    # (Are they a member of the class that the assignment belongs to)
+
+    set class_member_p [database_to_tcl_string_or_null $db "select 1 from edu_classes, user_group_map where edu_classes.class_id = $assignment_class_id and user_group_map.group_id = edu_classes.class_id and user_group_map.user_id = $user_id"]
+
+    if {$class_member_p == 0} {
+	edu_display_not_authorized_message
+    } else {
+	# they are a member of the group so lets give them the option
+	# to log in as that group
+	ns_db releasehandle $db
+	ns_return 200 text/html "
+	[ad_header "Authorization Failed"]
+	<h3>Authorization Failed</h3>
+	in <a href=/>[ad_system_name]</a>
+	<hr>
+	<blockquote>
+	The assignment you have chosen does not belong to this class.
+If you would like to view this assignment, click <a
+href=\"/education/util/group-login.tcl?group_id=$assignment_class_id&group_type=edu_class&return_url=[ns_urlencode $return_url]\">here</a>
+to log in as a member of the correct class.
+	</blockquote>
+	[ad_footer]
+    "
+    }
+    return
+}
+
+
+# set sql "select
+#               ea.class_id, 
+#               assignment_id,
+#               ea.assignment_name,
+#               class_name,
+#               teacher_id,
+#               first_names,
+#               last_name,
+#               ea.description,
+#               ea.date_assigned,
+#               last_modified,
+#               due_date,
+#               grade_id,
+#               weight,
+#               electronic_submission_p,
+#               requires_grade_p,
+#               ver.version_id, 
+#               ver.file_extension,
+#               ver.url,
+#               ver.file_id,
+#               sol.file_id as sol_file_id,
+#               sol.version_id as sol_version_id,
+#               sol.url as sol_url,
+#               sol.file_extension as sol_file_extension,
+#               (case when sign(sysdate-due_date) = 1 then 1 else 0 end) as past_due_p
+#          from edu_assignments ea,
+#               users,
+#               edu_classes ec,
+#               (select * from fs_versions_latest 
+#                where ad_general_permissions.user_has_row_permission_p($user_id, 'read', version_id, 'FS_VERSIONS') = 't') ver,
+#               (select sol.file_id, version_id, file_extension, url, task_id
+#                from edu_task_solutions sol, 
+#                     fs_versions_latest ver
+#                where task_id = $assignment_id
+#                  and sol.file_id = ver.file_id
+#                  and ad_general_permissions.user_has_row_permission_p($user_id, 'read', version_id, 'FS_VERSIONS') = 't') sol
+#         where ec.class_id = ea.class_id
+#           and users.user_id = ea.teacher_id
+#           and ea.assignment_id = $assignment_id
+#           and ec.class_id = $class_id
+#           and ea.file_id = sol.file_id(+)
+#           and ea.file_id = ver.file_id(+)"
+
+set sql "select
+             ea.class_id, 
+             assignment_id,
+             ea.assignment_name,
+             class_name,
+             teacher_id,
+             first_names,
+             last_name,
+             ea.description,
+             ea.date_assigned,
+             last_modified,
+             due_date,
+             grade_id,
+             weight,
+             electronic_submission_p,
+             requires_grade_p,
+             ver.version_id, 
+             ver.file_extension,
+             ver.url,
+             ver.file_id,
+             sol.file_id as sol_file_id,
+             sol.version_id as sol_version_id,
+             sol.url as sol_url,
+             sol.file_extension as sol_file_extension,
+             (case when sign(sysdate()-due_date) = 1 then 1 else 0 end) as past_due_p
+        from edu_assignments ea,
+             users,
+             edu_classes ec,
+             fs_versions_latest ver,
+             solution_files sol
+       where ec.class_id = ea.class_id
+         and user_has_row_permission_p($user_id, 'read', ver.version_id, 'FS_VERSIONS') = 't'
+         and users.user_id = ea.teacher_id
+         and sol.task_id = $assignment_id
+         and ea.assignment_id = $assignment_id
+         and ec.class_id = $class_id
+         and ea.file_id = sol.file_id
+         and ea.file_id = ver.file_id
+union
+select
+             ea.class_id, 
+             assignment_id,
+             ea.assignment_name,
+             class_name,
+             teacher_id,
+             first_names,
+             last_name,
+             ea.description,
+             ea.date_assigned,
+             last_modified,
+             due_date,
+             grade_id,
+             weight,
+             electronic_submission_p,
+             requires_grade_p,
+             ver.version_id, 
+             ver.file_extension,
+             ver.url,
+             ver.file_id,
+             sol.file_id as sol_file_id,
+             sol.version_id as sol_version_id,
+             sol.url as sol_url,
+             sol.file_extension as sol_file_extension,
+             (case when sign(sysdate()-due_date) = 1 then 1 else 0 end) as past_due_p
+        from edu_assignments ea,
+             users,
+             edu_classes ec,
+             fs_versions_latest ver,
+             solution_files sol
+       where ec.class_id = ea.class_id
+         and user_has_row_permission_p($user_id, 'read', ver.version_id, 'FS_VERSIONS') = 't'
+         and users.user_id = ea.teacher_id
+         and sol.task_id = $assignment_id
+         and ea.assignment_id = $assignment_id
+         and ec.class_id = $class_id
+         and ea.file_id = sol.file_id
+         and not exists (select 1 from fs_versions_latest 
+                         where file_id = ea.file_id)
+union
+select
+             ea.class_id, 
+             assignment_id,
+             ea.assignment_name,
+             class_name,
+             teacher_id,
+             first_names,
+             last_name,
+             ea.description,
+             ea.date_assigned,
+             last_modified,
+             due_date,
+             grade_id,
+             weight,
+             electronic_submission_p,
+             requires_grade_p,
+             ver.version_id, 
+             ver.file_extension,
+             ver.url,
+             ver.file_id,
+             '' as sol_file_id,
+             '' as sol_version_id,
+             '' as sol_url,
+             '' as sol_file_extension,
+             (case when sign(sysdate()-due_date) = 1 then 1 else 0 end) as past_due_p
+        from edu_assignments ea,
+             users,
+             edu_classes ec,
+             fs_versions_latest ver
+       where ec.class_id = ea.class_id
+         and user_has_row_permission_p($user_id, 'read', ver.version_id, 'FS_VERSIONS') = 't'
+         and users.user_id = ea.teacher_id
+         and ea.assignment_id = $assignment_id
+         and ec.class_id = $class_id
+         and not exists (select 1 from solution_files
+                         where file_id = ea.file_id)
+         and ea.file_id = ver.file_id
+union
+select
+             ea.class_id, 
+             assignment_id,
+             ea.assignment_name,
+             class_name,
+             teacher_id,
+             first_names,
+             last_name,
+             ea.description,
+             ea.date_assigned,
+             last_modified,
+             due_date,
+             grade_id,
+             weight,
+             electronic_submission_p,
+             requires_grade_p,
+             '' as version_id, 
+             '' as file_extension,
+             '' as url,
+             '' as file_id,
+             '' as sol_file_id,
+             '' as sol_version_id,
+             '' as sol_url,
+             '' as sol_file_extension,
+             (case when sign(sysdate()-due_date) = 1 then 1 else 0 end) as past_due_p
+        from edu_assignments ea,
+             users,
+             edu_classes ec
+       where ec.class_id = ea.class_id
+         and users.user_id = ea.teacher_id
+         and ea.assignment_id = $assignment_id
+         and ec.class_id = $class_id
+         and not exists (select 1 from solution_files
+                         where file_id = ea.file_id)
+         and not exists (select 1 from fs_versions_latest 
+                         where file_id = ea.file_id)"
+
+set selection [ns_db 0or1row $db $sql]
+
+
+if {$selection == ""} {
+    ad_return_complaint 1 "There are no assignments corresponding to the provided identification number.  This is an error in our code.  Please contact <a href=mailto:[ad_system_owner]>[ad_system_owner]</a>."
+    return
+} else {
+    set_variables_after_query
+}
+    
+
+
+set return_string "
+[ad_header "One Assignment @ [ad_system_name]"]
+
+<h2>$assignment_name</h2>
+
+[ad_context_bar_ws_or_index [list "../one.tcl" "$class_name Home"] [list "" Administration] "One Assignment"]
+
+<hr>
+<blockquote>
+
+
+<table BORDER=0>
+
+<tr>
+<th valign=top align=right> Assignment Name: </td>
+<td valign=top>
+"
+
+if {![empty_string_p $url]} {
+    append return_string "<a href=\"$url\">$assignment_name</a>"
+} elseif {![empty_string_p $version_id]} {
+    append return_string "<a href=\"/file-storage/download/$assignment_name.$file_extension?version_id=$version_id\">$assignment_name</a>"
+} else {
+    append return_string "$assignment_name"
+}
+
+
+append return_string "
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Description: </td>
+<td valign=top>
+[edu_maybe_display_text $description]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Due Date: </td>
+<td valign=top>
+[util_AnsiDatetoPrettyDate $due_date]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Date Assigned: </td>
+<td valign=top>
+[util_AnsiDatetoPrettyDate $date_assigned]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right>Will this assignment<br>be graded? </td>
+<td valign=top>
+[util_PrettyBoolean $requires_grade_p]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Fraction of Final Grade: </td>
+<td valign=top>"
+
+if {[empty_string_p $weight]} {
+    append return_string "N/A"
+} else {
+    append return_string "$weight \%"
+}
+
+append return_string "
+</td>
+</tr>
+<tr>
+<th align=right>Grade Group</th>
+<td>"
+
+if {![empty_string_p $grade_id]} {
+    set selection [ns_db 0or1row $db "select grade_name, weight from edu_grades where grade_id = $grade_id"]
+} else {
+    set selection ""
+}
+
+
+if {$selection!=""} {
+    set_variables_after_query
+} else {
+    set grade_name ""
+    set weight ""
+}
+
+append return_string "
+[edu_maybe_display_text $grade_name] [ec_decode $weight "" "" "- $weight %"]
+</td></tr>
+<tr>
+<th valign=top align=right>
+Will students submit <br>
+answers electronically?
+</td>
+<td valign=top>
+[util_PrettyBoolean $electronic_submission_p]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Assigned By: </td>
+<td valign=top>
+$first_names $last_name
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Last Modified: </td>
+<td valign=top>
+[util_AnsiDatetoPrettyDate $last_modified]
+</td>
+</tr>
+
+
+</table>
+<br>
+"
+
+# we have several things that we want to display here
+# and what is displayed depends on several conditions
+# if the Assignment is not yet due:
+# 1. Edit Assignment
+# 2. Upload a new version of the assignment
+# 3. Delete the assignment
+# and we always want to show
+# 4. Upload solutions/new version of solutions
+# 5. if there are solutions, a link to them
+
+set task_type assignment
+set task_id $assignment_id
+
+set user_has_edit_permission_p [ad_permission_p $db "" "" "Edit Tasks" $user_id $class_id]
+
+set edit_list [list]
+
+if {$user_has_edit_permission_p && !$past_due_p} {
+    lappend edit_list "<a href=\"task-edit.tcl?task_id=$assignment_id&task_type=$task_type&return_url=[ns_urlencode $return_url]\">edit</a>"
+    if {![empty_string_p $file_id]} {
+	lappend edit_list "<a href=\"task-file-new.tcl?[export_url_vars return_url task_id task_type]\">upload new file</a>"
+    } else {
+	lappend edit_list "<a href=\"task-file-new.tcl?[export_url_vars return_url task_id task_type]\">upload associated file</a>"
+    }
+}
+
+if {[ad_permission_p $db "" "" "Delete Tasks" $user_id $class_id] && !$past_due_p} { 
+    lappend edit_list "<a href=\"task-delete.tcl?task_id=$assignment_id&task_type=$task_type\">delete $assignment_name</a>"
+}
+
+if {$user_has_edit_permission_p} {
+    if {![empty_string_p $sol_url]} {
+	lappend edit_list "<a href=\"$sol_url\">Solutions</a>"
+    } elseif {![empty_string_p $sol_version_id]} {
+	lappend edit_list "<a href=\"/file-storage/download/$assignment_name-solutions.$sol_file_extension?version_id=$sol_version_id\">solutions</a>"
+    }     
+
+    if {![empty_string_p $sol_file_id]} {
+	lappend edit_list "<a href=\"solutions-add-edit.tcl?[export_url_vars return_url task_id task_type]\">upload new solutions</a>"
+    } else {
+	lappend edit_list "<a href=\"solutions-add-edit.tcl?[export_url_vars return_url task_id task_type]\">upload solutions</a>"
+    }
+}
+
+
+##############################################
+#                                            #
+#  We are now going to list the students     #
+#  that have and have not been evaluated for #
+#  the given assignment                      #
+#                                            #
+##############################################
+
+
+
+append return_string "
+[join $edit_list " | "]
+</form>
+<p><br>
+<h3>The following students have not been evaluated for $assignment_name</h3>
+<ul>
+"
+
+# set sql "select users.user_id as student_id, 
+#                 first_names, 
+#                 last_name,
+#                 files.url,
+#                 files.file_extension,
+#                 files.version_id
+#            from users, 
+#                 user_group_map map, 
+#                 (select url, author_id as student_id,
+#                         file_extension, version_id 
+#                       from fs_versions_latest ver, 
+#                            edu_student_answers task  
+#                      where task_id = $assignment_id 
+#                        and task.file_id = '' as file_id
+#                        and user_has_row_permission_p($user_id, 'read', version_id, 'FS_VERSIONS') = 't') files 
+#           where map.user_id = users.user_id 
+#             and lower(map.role) = lower('[edu_get_student_role_string]') 
+#             and map.group_id = $class_id
+#             and users.user_id = files.student_id(+)
+#             and users.user_id not in (select student_id  
+#                            from edu_student_evaluations 
+#                           where task_id = $assignment_id
+#                             and student_id = users.user_id
+#                             and map.group_id = $class_id)"
+
+set sql "select users.user_id as student_id, 
+                first_names, 
+                last_name,
+                files.url,
+                files.file_extension,
+                files.version_id
+           from users, 
+                user_group_map map, 
+                student_files files 
+          where map.user_id = users.user_id 
+            and user_has_row_permission_p($user_id, 'read', files.version_id, 'FS_VERSIONS') = 't'
+            and files.task_id = $assignment_id 
+            and lower(map.role) = lower('[edu_get_student_role_string]') 
+            and map.group_id = $class_id
+            and users.user_id = files.student_id
+            and users.user_id not in (select student_id  
+                           from edu_student_evaluations 
+                          where task_id = $assignment_id
+                            and student_id = users.user_id
+                            and map.group_id = $class_id)
+union
+select users.user_id as student_id, 
+                first_names, 
+                last_name,
+                files.url,
+                files.file_extension,
+                files.version_id
+           from users, 
+                user_group_map map, 
+                student_files files 
+          where map.user_id = users.user_id 
+            and user_has_row_permission_p($user_id, 'read', files.version_id, 'FS_VERSIONS') = 't'
+            and files.task_id = $assignment_id 
+            and lower(map.role) = lower('[edu_get_student_role_string]') 
+            and map.group_id = $class_id
+            and not exists (select 1 from student_files 
+                            where student_id = users.user_id)
+            and users.user_id not in (select student_id  
+                           from edu_student_evaluations 
+                          where task_id = $assignment_id
+                            and student_id = users.user_id
+                            and map.group_id = $class_id)"
+
+# get the list of students
+
+# we outer join here with files so that we can display the student name
+# whether or not the student has uploaded answers
+
+set selection [ns_db select $db $sql]
+
+set student_count 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append return_string "<li><a href=\"users/student-evaluation-add-edit.tcl?task_id=$assignment_id&student_id=$student_id&return_url=$return_url\">$last_name, $first_names</a> \n"
+    if {![empty_string_p $url]} {
+	append return_string "&nbsp (<a href=\"$url\">student answers</a>)"
+    } elseif {![empty_string_p $version_id]} {
+	append return_string "&nbsp (<a href=\"/file-storage/download/$assignment_name.$file_extension?version_id=$version_id\">student answers</a>)"
+    }
+
+    incr student_count
+}
+
+if {$student_count == 0} {
+    append return_string "There are no students left to be evaluated."
+}
+
+
+
+
+append return_string "
+</ul>
+<h3>The following students have been evaluated for $assignment_name</h3>
+<ul>
+"
+
+
+# set sql "select users.user_id as student_id, 
+#                 first_names, 
+#                 last_name,
+#                 files.url,
+#                 files.file_extension,
+#                 files.version_id
+#            from users, 
+#                 user_group_map map, 
+#                 edu_student_evaluations evals,
+#                 (select url, author_id as student_id,
+#                         file_extension, version_id 
+#                       from fs_versions_latest ver, 
+#                            edu_student_answers task  
+#                      where task_id = $assignment_id 
+#                        and task.file_id = ver.file_id
+#                        and ad_general_permissions.user_has_row_permission_p($user_id, 'read', version_id, 'FS_VERSIONS') = 't') files 
+#           where map.user_id = users.user_id 
+#             and lower(map.role) = lower('[edu_get_student_role_string]') 
+#             and evals.task_id = $assignment_id
+#             and evals.student_id = users.user_id
+#             and class_id = map.group_id
+#             and map.group_id = $class_id
+#             and map.user_id = files.student_id(+)"
+
+set sql "select users.user_id as student_id, 
+                first_names, 
+                last_name,
+                files.url,
+                files.file_extension,
+                files.version_id
+           from users, 
+                user_group_map map, 
+                edu_student_evaluations evals,
+                student_files files
+          where map.user_id = users.user_id 
+            and user_has_row_permission_p($user_id, 'read', files.version_id, 'FS_VERSIONS') = 't'
+            and files.task_id = $assignment_id 
+            and lower(map.role) = lower('[edu_get_student_role_string]') 
+            and evals.task_id = $assignment_id
+            and evals.student_id = users.user_id
+            and class_id = map.group_id
+            and map.group_id = $class_id
+            and map.user_id = files.student_id
+union
+select users.user_id as student_id, 
+                first_names, 
+                last_name,
+                files.url,
+                files.file_extension,
+                files.version_id
+           from users, 
+                user_group_map map, 
+                edu_student_evaluations evals,
+                student_files files
+          where map.user_id = users.user_id 
+            and user_has_row_permission_p($user_id, 'read', files.version_id, 'FS_VERSIONS') = 't'
+            and files.task_id = $assignment_id 
+            and lower(map.role) = lower('[edu_get_student_role_string]') 
+            and evals.task_id = $assignment_id
+            and evals.student_id = users.user_id
+            and class_id = map.group_id
+            and map.group_id = $class_id
+            and not exists (select 1 from student_files 
+                            where student_id = map.user_id)"
+
+# get the list of students that have already been evaluated
+
+set selection [ns_db select $db $sql]
+
+
+
+set student_count 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append return_string "<li><a href=\"users/student-info.tcl?student_id=$student_id\">$last_name, $first_names</a> \n"
+    incr student_count
+
+    if {![empty_string_p $url]} {
+	append return_string "&nbsp (<a href=\"$url\">student answers</a>)"
+    } elseif {![empty_string_p $version_id]} {
+	append return_string "&nbsp (<a href=\"/file-storage/download/$assignment_name.$file_extension?version_id=$version_id\">student answers</a>)"
+    }
+}
+
+
+if {$student_count == 0} {
+    append return_string "No students have been evaluated."
+}
+
+
+append return_string "
+</ul>
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/exam-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/exam-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/exam-add-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,196 @@
+#
+# /www/education/class/admin/exam-add.tcl
+#
+# by aileen@mit.edu, randyg@arsdigita.com, January, 2000
+#
+# this page calls edu_file_upload_widget which outputs shared code from
+# /file-storage/upload-new.tcl. file_id is set by the caller of the widget
+#
+
+ad_page_variables {
+    {ColValue.date%5fadministered.day ""}
+    {ColValue.date%5fadministered.month ""}
+    {ColValue.date%5fadministered.year ""}
+    exam_name
+    {comments ""}
+    {weight ""}
+    {grade_id ""}
+    {online_p f}
+}
+
+if {![empty_string_p $grade_id]} {
+    validate_integer grade_id $grade_id
+}
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Add Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+# check the input
+
+set exception_text ""
+set exception_count 0
+
+if {[empty_string_p $exam_name]} {
+    append exception_text "<li>You must include a name for this exam."
+    incr exception_count
+}
+
+
+# put together date_administered, and do error checking
+
+set form [ns_getform]
+
+# ns_dbformvalue $form due_date date due_date will give an error
+# message if the day of the month is 08 or 09 (this octal number problem
+# we've had in other places).  So I'll have to trim the leading zeros
+# from ColValue.date%5fadministered.day and stick the new value into the $form
+# ns_set.
+
+set "ColValue.date%5fadministered.day" [string trimleft [set ColValue.date%5fadministered.day] "0"]
+ns_set update $form "ColValue.date%5fadministered.day" [set ColValue.date%5fadministered.day]
+
+if [catch  { ns_dbformvalue $form date_administered date date_administered} errmsg ] {
+    incr exception_count
+    append exception_text "<li>The date was specified in the wrong format.  The date should be in the format Month DD YYYY.\n"
+} elseif { [string length [set ColValue.date%5fadministered.year]] != 4 } {
+    incr exception_count
+    append exception_text "<li>The year needs to contain 4 digits.\n"
+} elseif {[database_to_tcl_string $db "select date_part('day',trunc(sysdate()) - to_date('$date_administered','YYYY-MM-DD')) from dual"] > 1} {
+    incr exception_count
+    append exception_text "<li>The exam date must be in the future."
+}
+
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+set default_read ""
+set default_write [edu_get_ta_role_string]
+
+# generate this here so that we avoid a double click error
+set exam_id [database_to_tcl_string $db "select edu_task_sequence.nextval from dual"]
+
+
+if {[empty_string_p $date_administered]} {
+    set date_string None
+} else {
+    set date_string [util_AnsiDatetoPrettyDate $date_administered]
+}
+
+
+set return_string "
+[ad_header "Add an Exam @ [ad_system_name]"]
+
+<h2>Add an Exam</h2>
+
+[ad_context_bar_ws_or_index [list "../one.tcl" "$class_name Home"] [list "" "Administration"] "Add an Exam"]
+
+<hr>
+<blockquote>
+
+<form method=post action=\"task-add-3.tcl\">
+[export_entire_form]
+<input type=hidden name=\"task_type\" value=\"exam\">
+<input type=hidden name=\"task_id\" value=\"$exam_id\">
+<input type=hidden name=\"task_name\" value=\"$exam_name\">
+<input type=hidden name=\"electronic_submission_p\" value=\"$online_p\">
+
+
+<table BORDER=0>
+
+<tr>
+<th valign=top align=right>Exam Name: </td>
+<td valign=top>
+$exam_name
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right>Comments: </td>
+<td valign=top>
+[edu_maybe_display_text $comments]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right>Exam Date: </td>
+<td valign=top>
+$date_string
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Fraction of Exam Grade: </td>
+<td valign=top>
+"
+
+if {[empty_string_p $weight]} {
+    append return_string "N/A"
+} else {
+    append return_string "$weight \%"
+}
+
+append return_string "
+</td>
+</tr>
+"
+
+if {![empty_string_p $grade_id]} {
+    set selection [ns_db 0or1row $db "select grade_name, weight from edu_grades where grade_id=$grade_id"]
+} else {
+    set selection ""
+}
+
+if {$selection!=""} {
+    set_variables_after_query
+} else {
+    set grade_name ""
+    set weight ""
+}
+
+append return_string "
+<tr><th valign=top align=right>Grade Policy Group</th>
+<td>[edu_maybe_display_text $grade_name] [ec_decode $weight "" "" "- $weight"]\%</td>
+<tr>
+<th valign=top align=right> 
+Administered online?
+</td>
+<td valign=top>
+[util_PrettyBoolean $online_p]
+</font>
+</td>
+</tr>
+
+<tr>
+<td colspan=2 align=center>
+<br>
+<input type=submit value=\"Add Exam\">
+</td>
+</tr>
+</table>
+
+</form>
+
+<p>
+
+</blockquote>
+[ad_footer]
+"
+
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
Index: web/openacs/www/education/class/admin/exam-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/exam-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/exam-add.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,116 @@
+#
+# /www/education/class/admin/exam-add.tcl
+#
+# by aileen@mit.edu, randyg@arsdigita.com, January, 2000
+#
+# this page is where teachers can go to issue exams.
+# they are able to upload a file/url into the file storage system.
+#
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Add Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set return_string "
+[ad_header "Add Exam @ [ad_system_name]"]
+
+<h2>Add an Exam</h2>
+
+[ad_context_bar_ws_or_index [list "../one.tcl" "$class_name Home"] [list "" "Administration"] "Add an Exam"]
+
+<hr>
+
+<blockquote>
+
+
+<form method=post action=\"exam-add-2.tcl\">
+<table>
+<tr>
+<th align=right>Exam Name: </td>
+<td valign=top>
+<input type=text size=30 maxsize=100 name=exam_name>
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right>Comments: </td>
+<td valign=top>
+[edu_textarea comments "" 40 4]
+</td>
+</tr>
+
+<tr>
+<th align=right>Exam Date: </td>
+<td valign=top>
+[ad_dateentrywidget date_administered [database_to_tcl_string $db "select sysdate() + 14 from dual"]]
+</td>
+</tr>
+
+<tr>
+<th align=right>Fraction of Exam Grades: </td>
+<td>
+<input type=text size=5 maxsize=10 name=weight>\% 
+<font size=-1>
+(This should be a percentage)
+</font>
+</td>
+</tr>
+<tr>
+<th align=right>Grade Policy Group</th>
+<td valign=top>
+<select name=grade_id>
+<option value=\"\">None
+"
+
+set selection [ns_db select $db "select grade_name, weight, grade_id from edu_grades where class_id=$class_id order by grade_name"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    append return_string "
+    <option value=$grade_id>$grade_name - $weight\%"
+}
+
+append return_string "
+</select>
+</td>
+</tr>
+<tr>
+<th align=right> 
+Administered online?
+</td>
+<td valign=top>
+<input type=radio name=online_p value=t> Yes
+<input type=radio name=online_p checked value=f> No
+</font>
+</td>
+</tr>
+
+</td>
+</tr>
+<tr>
+<td colspan=2 align=center>
+<br>
+<input type=submit value=\"Continue\">
+</td>
+</tr>
+</table>
+
+</form>
+
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
Index: web/openacs/www/education/class/admin/exam-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/exam-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/exam-edit-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,148 @@
+#
+# /www/education/class/admin/exam-edit-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page allows the user to edit the information about the exam.
+# it actually performs the update on the database
+
+ad_page_variables {
+    exam_id
+    exam_name
+    {ColValue.date%5fadministered.day ""}
+    {ColValue.date%5fadministered.month ""}
+    {ColValue.date%5fadministered.year ""}
+    {comments ""}
+    {weight ""} 
+    {grade_id ""}
+    {online_p f}
+    {return_url ""}
+}
+
+validate_integer exam_id $exam_id
+if {![empty_string_p $grade_id]} {
+    validate_integer grade_id $grade_id
+}
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Edit Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+# check the user input first
+
+set exception_text ""
+set exception_count 0
+
+
+if {[empty_string_p $exam_name]} {
+    append exception_text "<li>You must provide a name for this exam."
+    incr exception_count
+}
+
+
+# lets make sure that the passed in exam belongs to this class
+
+if {[database_to_tcl_string $db "select count(exam_id) from edu_exams where exam_id = $exam_id and class_id = $class_id"] == 0} {
+    incr exception_count
+    append exception_text "<li>The exam you are trying to edit does not belong to this class."
+}
+
+
+# put together date_administered, and do error checking
+
+set form [ns_getform]
+
+# ns_dbformvalue $form date_administered date date_administered will give an error
+# message if the day of the month is 08 or 09 (this octal number problem
+# we've had in other places).  So I'll have to trim the leading zeros
+# from ColValue.date%5fadministered.day and stick the new value into the $form
+# ns_set.
+
+set "ColValue.date%5fadministered.day" [string trimleft [set ColValue.date%5fadministered.day] "0"]
+ns_set update $form "ColValue.date%5fadministered.day" [set ColValue.date%5fadministered.day]
+
+if [catch  { ns_dbformvalue $form date_administered date date_administered} errmsg ] {
+    incr exception_count
+    append exception_text "<li>The date was specified in the wrong format.  The date should be in the format Month DD YYYY. $errmsg\n"
+} elseif { [string length [set ColValue.date%5fadministered.year]] != 4 } {
+    incr exception_count
+    append exception_text "<li>The year needs to contain 4 digits.\n"
+} elseif {[database_to_tcl_string $db "select date_part('day',trunc(sysdate()) - to_date('$date_administered','YYYY-MM-DD')) from dual"] > 1} {
+#    incr exception_count
+#    append exception_text "<li>The exam date must be in the future."
+}
+
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+
+
+###########################################
+#                                         #
+# Permissions and Input have been checked #
+# set up the exams update                 #
+#                                         #
+###########################################
+
+
+if {![empty_string_p $grade_id]} {
+    set grade_sql "grade_id=$grade_id,"
+} else {
+    set grade_sql ""
+}
+
+if {![empty_string_p $weight]} {
+    set weight_sql "weight=$weight,"
+} else {
+    set weight_sql ""
+}
+
+set exam_sql "update edu_exams
+           set teacher_id = $user_id,
+               exam_name = '$QQexam_name',
+               comments = '$QQcomments',
+               last_modified = sysdate(),
+               date_administered = '$date_administered',
+               $weight_sql
+               $grade_sql
+               online_p = '$online_p'
+         where exam_id = $exam_id"
+
+if {[catch { ns_db dml $db $exam_sql } errmsg] } {
+    # insert failed; we know it is not a duplicate error because this is an update
+    ns_log Error "[edu_url]class/admin/exam-edit-2.tcl choked:  $errmsg"
+    ad_return_error "Insert Failed" "The Database did not like what you typed.  This is probably a bug in our code.  Here's what the database said:
+    <blockquote>
+    <pre>
+    $errmsg
+    </pre>
+    </blockquote>
+    "
+    return
+}
+
+
+ns_db releasehandle $db
+
+# the updates went as planned so redirect
+ns_returnredirect $return_url
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/exam-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/exam-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/exam-edit.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,225 @@
+#
+# /www/education/class/admin/exam-edit.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, February 2000
+#
+#
+# this page is where teachers can go to issue exams.
+# basically, they are able to upload a file/url into the file storage
+# system and then associate a due date with it.
+#
+
+ad_page_variables {
+    exam_id
+    {return_url ""}
+}
+
+validate_integer exam_id $exam_id
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Edit Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+if {[empty_string_p $exam_id]} {
+    ad_return_complaint 1 "<li>You must include an exam to edit."
+    return
+}
+
+# set sql "select class_id as exam_class_id,
+#                             first_names as teacher_first_name,
+#                             last_name as teacher_last_name,
+#                             exam_name,
+#                             comments,
+#                             e.creation_date,
+#                             last_modified,
+#                             date_administered,
+#                             e.file_id,
+#                             weight,
+#                             grade_id,
+#                             online_p,
+#                             version_id
+#                        from edu_exams e, 
+#                             users,
+#                             fs_versions_latest
+#                       where exam_id = $exam_id
+#                         and class_id = $class_id
+#                         and e.file_id = fs_versions_latest.file_id(+) 
+#                         and e.teacher_id = users.user_id"
+
+set sql "select class_id as exam_class_id,
+                            first_names as teacher_first_name,
+                            last_name as teacher_last_name,
+                            exam_name,
+                            comments,
+                            to_char(e.creation_date,'YYYY-MM-DD') as creation_date,
+                            to_char(last_modified,'YYYY-MM-DD') as last_modified,
+                            to_char(date_administered,'YYYY-MM-DD') as date_administered,
+                            e.file_id,
+                            weight,
+                            grade_id,
+                            online_p,
+                            version_id
+                       from edu_exams e, 
+                            users,
+                            fs_versions_latest
+                      where exam_id = $exam_id
+                        and class_id = $class_id
+                        and e.file_id = fs_versions_latest.file_id
+                        and e.teacher_id = users.user_id
+union
+select class_id as exam_class_id,
+                            first_names as teacher_first_name,
+                            last_name as teacher_last_name,
+                            exam_name,
+                            comments,
+                            to_char(e.creation_date,'YYYY-MM-DD') as creation_date,
+                            to_char(last_modified,'YYYY-MM-DD') as last_modified,
+                            to_char(date_administered,'YYYY-MM-DD') as date_administered,
+                            e.file_id,
+                            weight,
+                            grade_id,
+                            online_p,
+                            '' as version_id
+                       from edu_exams e, 
+                            users
+                      where exam_id = $exam_id
+                        and class_id = $class_id
+                        and not exists (select 1 from fs_versions_latest 
+                                        where file_id = e.file_id) 
+                        and e.teacher_id = users.user_id"
+
+
+set selection [ns_db 0or1row $db $sql]
+
+if { $selection == "" } {
+    ad_return_complaint 1 "<li> The exam id you have provided does not exist.  Please check your identification number and try again."
+    return
+} else {
+    set_variables_after_query
+}
+
+set new_version_id [database_to_tcl_string $db "select fs_version_id_seq.nextval from dual"]
+
+ns_log Debug "date_administered = $date_administered"
+
+set return_string "
+[ad_header "Edit Exam @ [ad_system_name]"]
+
+<h2>Edit Exam</h2>
+
+[ad_context_bar_ws_or_index [list "../one.tcl" "$class_name Home"] [list "" "Administration"] "Edit Exam"]
+
+<hr>
+
+This exam was created by 
+$teacher_first_name $teacher_last_name on 
+[util_AnsiDatetoPrettyDate $creation_date].  It was last 
+updated on [util_AnsiDatetoPrettyDate $last_modified].<br><br>
+
+<blockquote>
+
+<form enctype=multipart/form-data method=POST action=\"exam-edit-2.tcl\">
+[export_form_vars return_url file_id exam_id new_version_id]
+
+<table>
+<tr>
+<th valign=top align=right> Exam Name: </td>
+<td valign=top>
+<input type=text size=30 maxsize=100 name=exam_name value=\"[philg_quote_double_quotes $exam_name]\">
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Comments: </td>
+<td valign=top>
+[edu_textarea comments $comments 40 4]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Exam Date: </td>
+<td valign=top>
+[ad_dateentrywidget date_administered [database_to_tcl_string $db "select to_char(sysdate() + 14,'YYYY-MM-DD') from dual"]]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Fraction of Exam Grade: </td>
+<td valign=top>
+<input type=text size=5 maxsize=10 name=weight value=\"$weight\">\%
+</font>
+</td>
+</tr>
+<tr>
+<th valign=top align=right>Grade Policy Group</th>
+<td valign=top>
+<select name=grade_id>
+<option value=\"\">None
+"
+
+set selection [ns_db select $db "select grade_name, weight, grade_id as select_grade_id from edu_grades where class_id=$class_id order by grade_name"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    
+    append return_string "
+    <option value=$select_grade_id"
+    
+    if {$grade_id==$select_grade_id} {
+	append return_string " selected"
+    }
+    append return_string "
+    >$grade_name - $weight\%"
+}
+
+append return_string "
+</select>
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> 
+Administered online?
+</td>
+<td valign=top>
+"
+
+if {[string compare $online_p t] == 0} {
+    append return_string "
+    <input type=radio name=online_p checked value=t> Yes
+    <input type=radio name=online_p value=f> No
+    "
+} else {
+    append return_string "
+    <input type=radio name=online_p value=t> Yes
+    <input type=radio name=online_p checked value=f> No
+    "
+}
+
+append return_string "
+<tr>
+<td colspan=2 align=center>
+<br>
+<input type=submit value=\"Edit Exam\">
+</td>
+</tr>
+</table>
+
+</form>
+
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
Index: web/openacs/www/education/class/admin/exam-info.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/exam-info.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/exam-info.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,589 @@
+#
+# /www/education/class/admin/exam-info.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, February 2000
+#
+# this page displays information about a given exam
+#
+
+ad_page_variables {
+    exam_id
+}
+
+validate_integer exam_id $exam_id
+
+set db [ns_db gethandle]
+
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "View Admin Pages"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+set return_url [ad_partner_url_with_query]
+
+# check the input
+
+set exception_text ""
+set exception_count 0
+
+if {[empty_string_p $exam_id]} {
+    append exception_text "<li>You must include an identification number for this exam."
+    incr exception_count
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+# set sql "select
+#              ea.class_id,
+#              files.file_id,
+#              exam_name,
+#              class_name,
+#              teacher_id,
+#              first_names,
+#              last_name,
+#              ea.comments,
+#              ea.creation_date,
+#              last_modified,
+#              date_administered,
+#              grade_id,
+#              weight,
+#              files.version_id, 
+#              files.file_extension,
+#              files.url,
+#              sol.file_id as sol_file_id,
+#              sol.version_id as sol_version_id, 
+#              sol.file_extension as sol_file_extension,
+#              sol.url as sol_url,
+#              online_p
+#         from edu_exams ea,
+#              users,
+#              edu_classes ec,
+#              (select * from fs_versions_latest 
+#               where ad_general_permissions.user_has_row_permission_p($user_id, 'read', version_id, 'FS_VERSIONS') = 't') files,
+#              (select sol.file_id, version_id, file_extension, url, task_id
+#               from edu_task_solutions sol, 
+#                    fs_versions_latest ver
+#               where task_id = $exam_id
+#                 and sol.file_id = ver.file_id
+#                 and ad_general_permissions.user_has_row_permission_p($user_id, 'read', version_id, 'FS_VERSIONS') = 't') sol
+#        where ec.class_id = ea.class_id
+#          and users.user_id = ea.teacher_id
+#          and ea.exam_id = $exam_id
+#          and ea.exam_id = sol.task_id(+)
+#          and ea.file_id = files.file_id(+)"
+
+set sql "select
+             ea.class_id,
+             files.file_id,
+             exam_name,
+             class_name,
+             teacher_id,
+             first_names,
+             last_name,
+             ea.comments,
+             ea.creation_date,
+             last_modified,
+             date_administered,
+             grade_id,
+             weight,
+             files.version_id, 
+             files.file_extension,
+             files.url,
+             sol.file_id as sol_file_id,
+             sol.version_id as sol_version_id, 
+             sol.file_extension as sol_file_extension,
+             sol.url as sol_url,
+             online_p
+        from edu_exams ea,
+             users,
+             edu_classes ec,
+             fs_versions_latest files,
+             solution_files sol             
+       where ec.class_id = ea.class_id
+         and sol.task_id = $exam_id 
+         and user_has_row_permission_p($user_id, 'read', files.version_id, 'FS_VERSIONS') = 't'
+         and users.user_id = ea.teacher_id
+         and ea.exam_id = $exam_id
+         and ea.exam_id = sol.task_id
+         and ea.file_id = files.file_id
+union
+select
+             ea.class_id,
+             NULL::integer as file_id,
+             exam_name,
+             class_name,
+             teacher_id,
+             first_names,
+             last_name,
+             ea.comments,
+             ea.creation_date,
+             last_modified,
+             date_administered,
+             grade_id,
+             weight,
+             NULL::integer as version_id, 
+             NULL::varchar as file_extension,
+             NULL::varchar as url,
+             sol.file_id as sol_file_id,
+             sol.version_id as sol_version_id, 
+             sol.file_extension as sol_file_extension,
+             sol.url as sol_url,
+             online_p
+        from edu_exams ea,
+             users,
+             edu_classes ec,
+             fs_versions_latest files,
+             solution_files sol             
+       where ec.class_id = ea.class_id
+         and sol.task_id = $exam_id 
+         and user_has_row_permission_p($user_id, 'read', files.version_id, 'FS_VERSIONS') = 't'
+         and users.user_id = ea.teacher_id
+         and ea.exam_id = $exam_id
+         and ea.exam_id = sol.task_id
+         and not exists (select 1 from fs_versions_latest
+                         where file_id = ea.file_id)
+union
+select
+             ea.class_id,
+             files.file_id,
+             exam_name,
+             class_name,
+             teacher_id,
+             first_names,
+             last_name,
+             ea.comments,
+             ea.creation_date,
+             last_modified,
+             date_administered,
+             grade_id,
+             weight,
+             files.version_id, 
+             files.file_extension,
+             files.url,
+             NULL::integer as sol_file_id,
+             NULL::integer as sol_version_id, 
+             NULL::varchar as sol_file_extension,
+             NULL::varchar as sol_url,
+             online_p
+        from edu_exams ea,
+             users,
+             edu_classes ec,
+             fs_versions_latest files    
+       where ec.class_id = ea.class_id
+         and user_has_row_permission_p($user_id, 'read', files.version_id, 'FS_VERSIONS') = 't'
+         and users.user_id = ea.teacher_id
+         and ea.exam_id = $exam_id
+         and not exists (select 1 from solution_files 
+                         where task_id = ea.exam_id)
+         and ea.file_id = files.file_id
+union
+select
+             ea.class_id,
+             NULL::integer as file_id,
+             exam_name,
+             class_name,
+             teacher_id,
+             first_names,
+             last_name,
+             ea.comments,
+             ea.creation_date,
+             last_modified,
+             date_administered,
+             grade_id,
+             weight,
+             NULL::integer as version_id, 
+             NULL::varchar as file_extension,
+             NULL::varchar as url,
+             NULL::integer as sol_file_id,
+             NULL::integer as sol_version_id, 
+             NULL::varchar as sol_file_extension,
+             NULL::varchar as sol_url,
+             online_p
+        from edu_exams ea,
+             users,
+             edu_classes ec          
+       where ec.class_id = ea.class_id
+         and users.user_id = ea.teacher_id
+         and ea.exam_id = $exam_id
+         and not exists (select 1 from solution_files 
+                         where task_id = ea.exam_id)
+         and not exists (select 1 from fs_versions_latest
+                         where file_id = ea.file_id)"
+
+set selection [ns_db 0or1row $db $sql]
+
+if {$selection == ""} {
+    ad_return_complaint 1 "There are no exams corresponding to the provided identification number.  This is an error in our code.  Please contact <a href=mailto:[ad_system_owner]>[ad_system_owner]</a>."
+    return
+} else {
+    set_variables_after_query
+}
+    
+
+
+
+set return_string "
+[ad_header "One Exam @ [ad_system_name]"]
+
+<h2>$exam_name</h2>
+
+[ad_context_bar_ws_or_index [list "../one.tcl" "$class_name Home"] [list "" Administration] "One Exam"]
+
+<hr>
+<blockquote>
+
+
+<table BORDER=0>
+
+<tr>
+<th valign=top align=right> Exam Name: </td>
+<td valign=top>
+"
+
+if {![empty_string_p $url]} {
+    append return_string "<a href=\"$url\">$exam_name</a>"
+} elseif {![empty_string_p $version_id]} {
+    append return_string "<a href=\"/file-storage/download/$exam_name.$file_extension?version_id=$version_id\">$exam_name</a>"
+} else {
+    append return_string "$exam_name"
+}
+
+append return_string "
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Comments: </td>
+<td valign=top>
+[edu_maybe_display_text $comments]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Exam Date: </td>
+<td valign=top>
+[util_AnsiDatetoPrettyDate $date_administered]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Date Created: </td>
+<td valign=top>
+[util_AnsiDatetoPrettyDate $creation_date]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Fraction within Grade Group: </td>
+<td valign=top>"
+
+if {[empty_string_p $weight]} {
+    append return_string "N/A"
+} else {
+    append return_string "$weight \%"
+}
+
+append return_string "
+</td>
+</tr>
+<tr>
+<th align=right>Grade Group</th>
+<td>"
+
+if {![empty_string_p $grade_id]} {
+    set selection [ns_db 0or1row $db "select grade_name, weight from edu_grades where grade_id = $grade_id"]
+} else {
+    set selection ""
+}
+
+
+if {$selection!=""} {
+    set_variables_after_query
+} else {
+    set grade_name ""
+    set weight ""
+}
+
+append return_string "
+[edu_maybe_display_text $grade_name] [ec_decode $weight "" "" "- $weight %"]
+</td></tr>
+<tr>
+<th valign=top align=right>
+Administered online?
+</td>
+<td valign=top>
+[util_PrettyBoolean $online_p]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Assigned By: </td>
+<td valign=top>
+$first_names $last_name
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Last Modified: </td>
+<td valign=top>
+[util_AnsiDatetoPrettyDate $last_modified]
+</td>
+</tr>
+
+
+</table>
+</form>
+<p>
+"
+
+set display_list [list]
+
+set user_has_edit_permission_p [ad_permission_p $db "" "" "Edit Tasks" $user_id $class_id]
+
+if {$user_has_edit_permission_p} { 
+    lappend display_list "<a href=\"exam-edit.tcl?&exam_id=$exam_id&[export_url_vars return_url]\">edit</a>"
+}
+
+set task_type exam
+set task_id $exam_id
+
+if {$user_has_edit_permission_p} {
+    if {![empty_string_p $file_id]} {
+	lappend display_list "<a href=\"task-file-new.tcl?task_id=$task_id&task_type=exam&[export_url_vars return_url]\">upload new file</a>"
+    } else {
+	lappend display_list "<a href=\"task-file-new.tcl?task_id=$task_id&task_type=exam&[export_url_vars return_url]\">upload associated file</a>"
+    }
+}
+
+if {[ad_permission_p $db "" "" "Delete Tasks" $user_id $class_id]} { 
+    lappend display_list "<a href=\"task-delete.tcl?task_id=$task_id&task_type=exam\">delete $exam_name</a>"
+}
+
+if {$user_has_edit_permission_p} {
+    if {![empty_string_p $sol_url]} {
+	lappend display_list "<a href=\"$sol_url\">Solutions</a>"
+    } elseif {![empty_string_p $sol_version_id]} {
+	lappend display_list "<a href=\"/file-storage/download/$exam_name-solutions.$sol_file_extension?version_id=$sol_version_id\">solutions</a>"
+    }     
+
+    if {![empty_string_p $sol_file_id]} {
+	lappend display_list "<a href=\"solutions-add-edit.tcl?[export_url_vars return_url task_id task_type]\">upload new solutions</a>"
+    } else {
+	lappend display_list "<a href=\"solutions-add-edit.tcl?[export_url_vars return_url task_id task_type]\">upload solutions</a>"
+    }
+}
+
+append return_string "
+
+[join $display_list " | "]
+
+<p><br>
+<h3>The following students have not been evaluated for $exam_name</h3>
+<ul>
+"
+
+# get the list of students
+
+# we outer join here with files so that we can display the student name
+# whether or not the student has uploaded answers
+
+# set sql "select distinct users.user_id as student_id, 
+#                 first_names, 
+#                 last_name,
+#                 files.url,
+#                 files.file_extension,
+#                 files.version_id
+#            from users, 
+#                 user_group_map map, 
+#                 fs_versions_latest files
+#           where map.user_id = users.user_id 
+#             and user_has_row_permission_p($user_id, 'read', files.version_id, 'FS_VERSIONS') = 't'
+#             and lower(map.role) = lower('[edu_get_student_role_string]') 
+#             and map.group_id = $class_id
+#             and users.user_id = files.author_id(+)
+#             and users.user_id not in (select student_id  
+#                            from edu_student_evaluations 
+#                           where task_id = $exam_id
+#                             and student_id = users.user_id
+#                             and class_id = map.group_id)"
+
+
+set sql "select distinct users.user_id as student_id, 
+                first_names, 
+                last_name,
+                files.url,
+                files.file_extension,
+                files.version_id
+           from users, 
+                user_group_map map, 
+                fs_versions_latest files
+          where map.user_id = users.user_id 
+            and user_has_row_permission_p($user_id, 'read', files.version_id, 'FS_VERSIONS') = 't'
+            and lower(map.role) = lower('[edu_get_student_role_string]') 
+            and map.group_id = $class_id
+            and users.user_id = files.author_id
+            and users.user_id not in (select student_id  
+                           from edu_student_evaluations 
+                          where task_id = $exam_id
+                            and student_id = users.user_id
+                            and class_id = map.group_id)
+union
+select distinct users.user_id as student_id, 
+                first_names, 
+                last_name,
+                NULL::varchar as url,
+                NULL::varchar as file_extension,
+                NULL::integer as version_id
+           from users, 
+                user_group_map map
+          where map.user_id = users.user_id 
+            and lower(map.role) = lower('[edu_get_student_role_string]') 
+            and map.group_id = $class_id
+            and not exists (select 1 from fs_versions_latest 
+                            where author_id = users.user_id)
+            and users.user_id not in (select student_id  
+                           from edu_student_evaluations 
+                          where task_id = $exam_id
+                            and student_id = users.user_id
+                            and class_id = map.group_id)"
+
+
+set selection [ns_db select $db $sql]
+
+set student_count 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append return_string "<li><a href=\"users/student-evaluation-add-edit.tcl?task_id=$exam_id&student_id=$student_id&return_url=$return_url&evaluation_type=exam\">$last_name, $first_names</a> \n"
+    if {![empty_string_p $url]} {
+	append return_string "&nbsp (<a href=\"$url\">student answers</a>)"
+    } elseif {![empty_string_p $version_id]} {
+	append return_string "&nbsp (<a href=\"/file-storage/download/$exam_name.$file_extension?version_id=$version_id\">student answers</a>)"
+    }
+
+    incr student_count
+}
+
+if {$student_count == 0} {
+    append return_string "There are no students left to be evaluated."
+}
+
+
+
+
+append return_string "
+</ul>
+<h3>The following students have been evaluated for $exam_name</h3>
+<ul>
+"
+
+
+# set sql "select users.user_id as student_id, 
+#                 first_names, 
+#                 last_name,
+#                 files.url,
+#                 files.file_extension,
+#                 files.version_id
+#            from users, 
+#                 user_group_map map, 
+#                 edu_student_evaluations evals,
+#                 fs_versions_latest files
+#           where map.user_id = users.user_id 
+#             and user_has_row_permission_p($user_id, 'read', files.version_id, 'FS_VERSIONS') = 't'
+#             and users.user_id = files.author_id(+)
+#             and lower(map.role) = '[edu_get_student_role_string]' 
+#             and evals.task_id = $exam_id
+#             and evals.student_id = users.user_id
+#             and class_id = map.group_id
+#             and map.group_id = $class_id"
+
+
+set sql "select users.user_id as student_id, 
+                first_names, 
+                last_name,
+                files.url,
+                files.file_extension,
+                files.version_id
+           from users, 
+                user_group_map map, 
+                edu_student_evaluations evals,
+                fs_versions_latest files
+          where map.user_id = users.user_id 
+            and user_has_row_permission_p($user_id, 'read', files.version_id, 'FS_VERSIONS') = 't'
+            and users.user_id = files.author_id
+            and lower(map.role) = '[edu_get_student_role_string]' 
+            and evals.task_id = $exam_id
+            and evals.student_id = users.user_id
+            and class_id = map.group_id
+            and map.group_id = $class_id
+union
+select users.user_id as student_id, 
+                first_names, 
+                last_name,
+                NULL::varchar as url,
+                NULL::varchar as file_extension,
+                NULL::integer as version_id
+           from users, 
+                user_group_map map, 
+                edu_student_evaluations evals
+          where map.user_id = users.user_id 
+            and not exists (select 1 from fs_versions_latest 
+                            where author_id = users.user_id)
+            and lower(map.role) = '[edu_get_student_role_string]' 
+            and evals.task_id = $exam_id
+            and evals.student_id = users.user_id
+            and class_id = map.group_id
+            and map.group_id = $class_id"
+
+
+# get the list of students that have already been evaluated
+
+set selection [ns_db select $db $sql]
+
+
+set student_count 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append return_string "<li><a href=\"users/student-info.tcl?student_id=$student_id\">$last_name, $first_names</a> \n"
+    incr student_count
+
+    if {![empty_string_p $url]} {
+	append return_string "&nbsp (<a href=\"$url\">student answers</a>)"
+    } elseif {![empty_string_p $version_id]} {
+	append return_string "&nbsp (<a href=\"/file-storage/download/$exam_name.$file_extension?version_id=$version_id\">student answers</a>)"
+    }
+}
+
+
+if {$student_count == 0} {
+    append return_string "No students have been evaluated."
+}
+
+
+append return_string "
+</ul>
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/grade-policy-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/grade-policy-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/grade-policy-edit-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,147 @@
+# 
+# /www/education/class/admin/grade-policy-edit-2.tcl
+#
+# by aileen@mit.edu, randyg@arsdigita.com, February 2000
+#
+# this page updates the database with the new information about the
+# particular grade ID
+#
+
+# comments_$grade_id, grade_name_$grade_id, weight_$grade_id and
+# new_comments_(1-5)
+# new_grade_name_(1-5), new_weight_(1-5)
+
+set_the_usual_form_variables
+set error_count 0
+set error_text ""
+
+set add_id_list ""
+set delete_id_list ""
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Evaluate"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+
+# check the input for each existing grade entry, they must have either
+# both the grade names and the weight filled in or neither (in which
+# case the entry will be deleted) 
+foreach grade_id $grade_id_list {
+    
+    validate_integer grade_id $grade_id
+
+    if {![info exists grade_name_$grade_id] || [empty_string_p [set grade_name_$grade_id]]} {
+	if {[info exists weight_$grade_id] && ![empty_string_p [set weight_$grade_id]]} {
+	    
+	    if {!$error_count} {
+		incr error_count
+		append error_text "<li>You must have both a name and weight for each grade entry. Leave both fields blank if you wish to delete that entry"
+	    }
+	} else {
+	    # both weight and grade_name are blank, so mark this entry for 
+	    # deletion
+	    lappend delete_id_list $grade_id
+	    continue
+	}
+	    
+    } elseif {![info exists weight_$grade_id] || [empty_string_p [set weight_$grade_id]]} {
+	if {!$error_count} {
+	    incr error_count
+	    append error_text "<li>You must have both a name and weight for each grade entry. Leave both fields blank if you wish to delete that entry"
+	}
+    }
+
+   lappend add_id_list $grade_id
+}
+
+set count 1
+set new_entries_list ""
+
+while {$count<=5} {
+    if {![info exist new_grade_name_$count] || [empty_string_p [set new_grade_name_$count]]} {
+	if {[info exists new_weight_$count] && ![empty_string_p [set new_weight_$count]]} {
+	    if {!$error_count} {
+		append error_text "<li>You must have both a name and weight for each grade entry. Leave both fields blank if you wish to delete that entry"
+		incr error_count
+	    }
+	} else {
+	    incr count
+	    continue
+	}
+    } elseif {![info exists new_weight_$count] || [empty_string_p [set new_weight_$count]]} {
+	if {!$error_count} {
+	    incr error_count
+	    append error_text "<li>You must have both a name and weight for each grade entry. Leave both fields blank if you wish to delete that entry"
+	}
+    }
+   
+    lappend new_entries_list $count
+    incr count
+}
+
+if {$error_count} {
+    ad_return_complaint $error_count $error_text
+    return
+}
+
+# now make sure the weights add up to 100%
+
+set sum 0
+
+foreach id $add_id_list {
+    set sum [expr $sum + [set weight_${id}]]
+}
+
+foreach id $new_entries_list {
+    set sum [expr $sum + [set new_weight_${id}]]
+}
+
+# in case we have decimals
+if {$sum>100 || $sum<100} {
+    ad_return_complaint 1 "<li>Weights of all grades must add up to 100%"
+    return
+}
+
+# input checks complete
+
+ns_db dml $db "begin transaction"
+
+foreach id $delete_id_list {
+    ns_db dml $db "delete from edu_grades where grade_id=$id"
+    ad_audit_delete_row $db [list $id] [list grade_id] edu_grades_audit
+}
+
+foreach id $add_id_list {
+    ns_db dml $db "
+    update edu_grades 
+    set grade_name='[set QQgrade_name_$id]',
+    weight=[set weight_$id],
+    comments='[set QQcomments_$id]',
+    modified_ip_address = '[ns_conn peeraddr]',
+    last_modifying_user = $user_id
+    where grade_id=$id"
+}
+
+foreach id $new_entries_list {
+    ns_db dml $db "
+    insert into edu_grades 
+    (grade_id, grade_name, weight, comments, class_id, last_modified, last_modifying_user, modified_ip_address)
+    values
+    (nextval('edu_grade_sequence'), '[set QQnew_grade_name_$id]', [set new_weight_$id], '[set QQnew_comments_$id]', $class_id, sysdate(), $user_id, '[ns_conn peeraddr]')"
+}
+
+ns_db dml $db "end transaction"
+
+ns_db releasehandle $db
+
+ns_returnredirect ""
+
+
Index: web/openacs/www/education/class/admin/grade-policy-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/grade-policy-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/grade-policy-edit.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,88 @@
+#
+# /www/education/class/admin/grade-policy-edit.tcl
+#
+# by aileen@mit.edu, randyg@arsdigita.com, February 2000
+#
+# this page allows the user to edit the way the grades are calculated
+#
+
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Evaluate"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set return_string "
+[ad_header "$class_name Grading Policy @ [ad_system_name]"]
+
+<h2>Edit Grading Policy for $class_name</h2>
+
+[ad_context_bar_ws_or_index [list "../one.tcl" "$class_name Home"] [list "" "Administration"] "Grading Policy"]
+
+<hr>
+<blockquote>
+<b>All weights must add up to 100%. * denotes required fields</b>
+<form method=post action=grade-policy-edit-2.tcl>
+<table cellpadding=2>
+<tr>
+<th align=left>Grade Name*</th>
+<th align=left>Weight*</th>
+<th align=left>Comments</th>
+</tr>
+"
+
+set selection [ns_db select $db "select * from edu_grades where class_id=$class_id"]
+
+set grade_id_list ""
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    append return_string "
+    <tr>
+    <td valign=top><input type=text size=30 value=\"$grade_name\" name=grade_name_$grade_id></td>
+    <td valign=top><input type=text size=5 value=\"$weight\" name=weight_$grade_id> \%</td>
+    <td>[edu_textarea comments_$grade_id $comments 40 3]</td>
+    </tr>"
+
+    lappend grade_id_list $grade_id
+}
+
+set count 1
+
+while {$count<=5} {
+    append return_string "
+    <tr>
+    <td valign=top><input type=text size=30 name=new_grade_name_$count></td>
+    <td valign=top><input type=text size=5 name=new_weight_$count> \%</td>
+    <td>[edu_textarea new_comments_$count "" 40 3]</td>
+    </tr>"
+    incr count
+}
+
+append return_string "
+[export_form_vars grade_id_list]
+[edu_empty_row]
+<tr><td colspan=3><input type=submit value=Submit></td></tr>
+</table>
+</form>
+</blockquote>
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
Index: web/openacs/www/education/class/admin/grades-view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/grades-view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/grades-view.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,178 @@
+#
+# /www/education/class/admin/grades-view.tcl
+#
+# by aileen@mit.edu, randyg@arsdigita.com, February 2000
+#
+# this page shows information about the particular grade item
+#
+
+
+ad_page_variables {
+    grade_id
+    {show_comments f}
+}
+
+set_the_usual_form_variables
+
+validate_integer grade_id $grade_id
+
+set db_handles [edu_get_two_db_handles]
+set db [lindex $db_handles 0]
+set db_sub [lindex $db_handles 1]
+
+set id_list [edu_group_security_check $db edu_class "Evaluate"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+set grade_name [database_to_tcl_string $db "select grade_name from edu_grades where grade_id=$grade_id"]
+
+set return_string "
+[ad_header "$class_name Grades @ [ad_system_name]"]
+
+<h2>$class_name $grade_name Grades</h2>
+
+[ad_context_bar_ws_or_index [list "../one.tcl" "$class_name Home"] [list "" "Administration"] "Grades"]
+
+<hr>
+<blockquote>
+"
+
+if {$show_comments=="f"} {
+    set show_comments "f"
+    append comment_string "
+    <a href=grades-view.tcl?grade_id=$grade_id&show_comments=t>Show Comments</a>"
+} else {
+    set show_comments "t"
+    append comment_string "
+    <a href=grades-view.tcl?grade_id=$grade_id&show_comments=f>Hide Comments</a>"
+}
+
+set header_row [list "<th align=left>Name</th>"]
+set task_id_list ""
+
+set selection [ns_db select $db "
+select task_type, task_id, task_name 
+from edu_student_tasks 
+where class_id=$class_id 
+and grade_id=$grade_id 
+order by task_name"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    
+    set str  "<th align=left><a href="
+
+    set type [string trimright $task_type s]
+
+    append str $type
+    append str "-info.tcl?"
+    append str $type
+    append str "_id=$task_id>$task_name</a></th>"
+    lappend header_row $str
+    lappend task_id_list $task_id
+}
+
+set selection [ns_db select $db "
+select a.task_name, a.task_id, se.student_id, u.first_names, 
+       u.last_name, se.grade, se.comments
+from edu_student_tasks a, edu_student_evaluations se, 
+     users u
+where a.class_id = $class_id
+and a.task_id = se.task_id
+and a.grade_id = $grade_id
+and se.student_id=u.user_id
+order by last_name, a.task_name"]
+
+# either there is an entry in evaluations with task_id=a.task_id
+# and student_id=u.user_id or such entry does not exist
+
+set header_done 0
+set old_student_id ""
+set data_list ""
+set task_index -1
+set old_task_id ""
+set row_list ""
+
+set count 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    # new row of data
+    if {$student_id!=$old_student_id} {
+	if {$old_student_id!=""} {	    
+	    while {$task_index!=[expr [llength $task_id_list] - 1]} {
+		lappend row_list "<td valign=top>Not graded</td>"
+		incr task_index
+	    }
+	    lappend data_list $row_list
+	}
+	   
+	set old_student_id $student_id
+	set row_list [list "<td valign=top><a href=\"users/student-info.tcl?student_id=$student_id\">$last_name, $first_names</a></td>"]
+	set task_index -1
+    } 
+
+    incr task_index
+
+    # determine whether the student has a grade for this task
+    while {[lindex $task_id_list $task_index]!=$task_id} {
+	incr task_index
+	lappend row_list "<td valign=top>Not graded</td>"
+    } 
+
+    lappend row_list "<td valign=top>$grade [ec_decode $show_comments "t" " - $comments" ""]</td>"
+    set old_task_id $task_id
+    incr count
+}
+
+while {$task_index!=[expr [llength $task_id_list] - 1]} {
+    lappend row_list "<td valign=top>Not graded</td>"
+    incr task_index
+}
+
+if {$count} {
+    lappend data_list $row_list
+    
+    append return_string "
+    $comment_string
+    <p>
+    <table cellpadding=2>
+    <tr>
+    "
+    
+    foreach header $header_row {
+	append return_string "
+	$header"
+    }
+    
+    append return_string "
+    </tr>
+    "
+    
+    foreach row $data_list {
+	append return_string "<tr>"
+	
+	foreach column $row {
+	    append return_string "$column"
+	}
+	
+	append return_string "</tr>"
+    }
+
+    append return_string "</table>"
+} else {
+    append return_string "
+    <p>There are no grades to show for this grade group. Please check your grade group settings for assignments, exams, and projects."
+}
+
+append return_string "   
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
Index: web/openacs/www/education/class/admin/group-user-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/group-user-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/group-user-add.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,52 @@
+#
+# /www/education/class/admin/group-user-add.tcl
+#
+# by randyg@arsdigita.com January 2000
+#
+# this page adds a user to a group
+#
+
+ad_page_variables {
+    {user_id ""}
+    {student_id ""}
+    group_id
+    {role member}
+    {return_url ""}
+}
+
+validate_integer group_id $group_id
+
+# either user_id or student_id must be not null
+
+
+if {[empty_string_p $user_id]} {
+    if {[empty_string_p $student_id]} {
+	ad_return_complaint 1 "<li>You must provide a user to be deleted from this group."
+	return
+    } else {
+	set user_id $student_id
+    }
+}
+
+validate_integer user_id $user_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+
+# need to make sure that the group is part of this class
+if {[database_to_tcl_string $db "select count(group_id) from user_groups where group_id = $group_id and (group_id = $class_id or parent_group_id = $class_id)"] == 0} {
+    ad_return_complaint 1 "<li>The group that you are trying to add the user to is not a member of this class."
+    return
+}
+
+
+# don't need to do a double-click check because the proc below does it 
+# for us
+
+ad_user_group_user_add $db $user_id $role $group_id
+
+ns_db releasehandle $db
+
+ns_returnredirect $return_url
Index: web/openacs/www/education/class/admin/group-user-remove.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/group-user-remove.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/group-user-remove.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,49 @@
+#
+# /www/education/class/admin/group-user-remove.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, February 2000
+#
+# this page removes a user from a group after checking to make sure that
+# the person trying to perform the action has permission to do so
+
+ad_page_variables {
+    {user_id ""}
+    {student_id ""}
+    group_id
+    {return_url ""}
+}
+
+validate_integer group_id $group_id
+
+# requires one of user_id or student_id
+
+if {[empty_string_p $user_id]} {
+    if {[empty_string_p $student_id]} {
+	ad_return_complaint 1 "<li>You must provide a user to remove from the group."
+	return
+    } else {
+	set user_id $student_id
+    }
+}
+
+validate_integer user_id $user_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+
+# want to check that the group is part of this class
+if {[database_to_tcl_string $db "select count(class_id) from user_groups where group_id = $group_id and (group_id = $class_id or parent_group_id = $class_id)"] == 0} {
+    ad_return_complaint 1 "<li>The group that you are trying to add the user to is not a member of this class."
+    return
+}
+
+# don't need to do a double-click check because unmapping a student 
+# multiple times does not cause a problem.
+
+ns_db dml $db "delete from user_group_map where user_id = $user_id and group_id = $group_id"
+
+ns_db releasehandle $db
+
+ns_returnredirect $return_url
Index: web/openacs/www/education/class/admin/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/index.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,563 @@
+#
+# /www/education/class/admin/index.tcl
+#
+# this page is the index page for the class administrators
+# 
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "View Admin Pages"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+# get properties for this class
+
+set selection [ns_db 0or1row $db "select start_date,
+	grades_p,
+	teams_p,
+	exams_p,
+	final_exam_p
+   from edu_classes
+  where class_id = $class_id"]
+
+if {$selection == ""} {
+    ad_return_complaint 1 "<li>The class you have requested does not exist."
+    return
+} else {
+    set_variables_after_query
+}
+
+
+set header "
+[ad_header "$class_name Administration @ [ad_system_name]"]
+
+<h2>$class_name Administration</h2>
+
+[ad_context_bar_ws_or_index [list "../one.tcl" "$class_name Home"] "Administration"]
+
+<hr>
+<blockquote>
+"
+
+#  Begin the code to generate News
+
+set news_text "
+<h3>News</h3>
+<ul>
+"
+
+set query "select news_item_id, title, release_date
+from news_items, newsgroups
+where newsgroups.newsgroup_id = news_items.newsgroup_id
+and sysdate() between release_date and expiration_date
+and approval_state = 'approved'
+and group_id = $class_id
+and scope = 'group'
+order by release_date desc, creation_date desc"
+
+set selection [ns_db select $db $query]
+
+set counter 0 
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append news_text "<li>[util_AnsiDatetoPrettyDate $release_date]: <a href=\"/news/item.tcl?news_item_id=$news_item_id\">$title</a>\n"
+    incr counter 
+}
+
+if {$counter == 0} {
+    append news_text "<li>No items found."
+}
+
+append news_text "
+<li><a href=/news/post-new.tcl?scope=group&group_id=$class_id>Add news item</a>
+</ul>
+"
+# <li><a href=/news/index.tcl?scope=group&group_id=646&archive_p=1>News archive</a>
+
+
+#
+#  Begin the code to generate Class Resources
+
+
+set class_resources "
+<h3>Manage Class Resources</h3>
+<ul>
+
+<li> <a href=properties-edit.tcl>Edit Class Properties</a>
+"
+
+
+# Get the Syllabus Information
+
+set selection [ns_db 0or1row $db "select version_id, 
+                          file_extension,
+                          file_id,
+                          url
+                     from fs_versions_latest, 
+                          edu_classes 
+                    where file_id = syllabus_id 
+                      and class_id = $class_id"] 
+
+if {$selection == ""} {
+    append class_resources "<li> <a href=\"syllabus-edit.tcl\">Add a Syllabus</a>"
+} else {
+    set_variables_after_query
+    if {![empty_string_p $url]} {
+	append class_resources "<li> <a href=\"$url\">Syllabus</a>"
+    } else {
+	append class_resources "
+	<li> <a href=\"/file-storage/download/syllabus.$file_extension?version_id=$version_id\">Syllabus</a>"
+    } 
+
+    append class_resources "[ad_space] | [ad_space] <a href=\"syllabus-edit.tcl\">upload new syllabus</a>"
+
+
+}
+
+
+set chat_room_id [database_to_tcl_string_or_null $db "
+select chat_room_id from chat_rooms where scope='group' and group_id=$class_id"]
+
+if {$chat_room_id!=""} {
+    set chat_info "<a href=/chat/enter-room.tcl?chat_room_id=$chat_room_id>Chat Room</a>"
+} else {
+    set chat_info "<a href=\"[edu_url]util/chat-room-create.tcl\">Create new chat room</a>"
+}
+
+#set bboard_count [database_to_tcl_string $db "
+#select count(*)  
+#from bboard_topics t
+#where t.group_id=$class_id"]
+
+# <li> <a href=\"/file-storage/group.tcl?group_id=$class_id\">View Class Documents</a>
+#<li> [ec_decode $bboard_count 0 "<a href=new-bboard-topic-add.tcl>Create new discussion board</a>" "<a href=/bboard/index.tcl?group_id=$class_id>Discussion Boards</a> | <a href=new-bboard-topic-add.tcl>Create new discussion board</a>"]
+
+append class_resources "
+<li> $chat_info
+<li> <a href=\"permissions.tcl\">Permissions</a>
+</ul>
+"
+
+
+#
+#
+#  Begin the code to generate assignments
+#
+#
+
+set assignments_text "
+<h3>Assignments</h3>
+<ul>
+"
+
+set selection [ns_db select $db "select assignment_name, assignment_id from edu_assignments where class_id = $class_id order by due_date"]
+
+set count 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr count
+    append assignments_text "<li><a href=\"assignment-info.tcl?assignment_id=$assignment_id\">$assignment_name</a> \n"
+
+}
+
+if {$count > 0} {
+    append assignments_text "<p>"
+}
+
+append assignments_text "
+<li> <a href=\"task-add.tcl?task_type=assignment\">Add an Assignment</a></li>
+</ul>
+"
+
+
+#
+#
+#  Begin the code to generate lecture notes
+#
+#
+
+
+
+set lecture_notes_text "
+<h3>Lecture Notes</h3>
+<ul>
+"
+
+set selection [ns_db select $db "select handout_id, 
+         edu_handouts.file_id, 
+         distribution_date, 
+         handout_name
+    from edu_handouts
+   where lower(handout_type) = lower('lecture_notes') 
+     and class_id = $class_id 
+order by distribution_date"]
+
+set lecture_notes_count 0
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr lecture_notes_count
+    append lecture_notes_text "
+    <li><a href=\"handouts/one.tcl?handout_id=$handout_id\">$handout_name</a>
+    "
+}
+
+if {$lecture_notes_count > 0} {
+    append lecture_notes_text "<p>"
+} 
+
+append lecture_notes_text "
+<li><a href=\"handouts/add.tcl?type=lecture_notes\">Upload New Lecture Notes</a></ul>
+"
+
+
+#
+#
+#  Begin the code to generate Handouts
+#
+#
+
+
+
+set handouts_text "
+<h3>Handouts</h3>
+<ul>
+"
+
+set selection [ns_db select $db "select handout_id, 
+         edu_handouts.file_id, 
+         distribution_date, 
+         handout_name
+    from edu_handouts
+   where lower(handout_type) = lower('general') 
+     and class_id = $class_id 
+order by distribution_date"]
+
+set handouts_count 0
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr handouts_count
+    append handouts_text "
+    <li><a href=\"handouts/one.tcl?handout_id=$handout_id\">$handout_name</a>
+    "
+}
+
+if {$handouts_count > 0} {
+    append handouts_text "<p>"
+} 
+
+append handouts_text "
+<li><a href=\"handouts/add.tcl?type=general\">Upload New Handout</a></ul>
+"
+
+
+
+#
+#
+#  Begin the code to generate user management stuff
+#
+#
+
+set n_profs [database_to_tcl_string $db "select count(user_id) from user_group_map where group_id = $class_id and role = '[edu_get_professor_role_string]'"]
+
+set n_tas [database_to_tcl_string $db "select count(user_id) from user_group_map where group_id = $class_id and role = '[edu_get_ta_role_string]'"]
+
+set n_students [database_to_tcl_string $db "select count(user_id) from user_group_map where group_id = $class_id and role = '[edu_get_student_role_string]'"]
+
+set n_dropped [database_to_tcl_string $db "select count(user_id) from user_group_map where group_id = $class_id and role = '[edu_get_dropped_role_string]'"]
+
+
+set manage_users_text "
+<h3>Manage <a href=\"users/\">Users</a></h3>
+<ul>
+<li> Total Students: <a href=\"users/students-view.tcl?view_type=all&target_url=[ns_urlencode "student-info.tcl"]\">[expr $n_students + $n_dropped]</a>"
+
+if {$n_dropped == 1} {
+    append manage_users_text "[ad_space] ($n_dropped has dropped)"
+} elseif {$n_dropped > 1} {
+    append manage_users_text "[ad_space] ($n_dropped have dropped)"
+}
+
+if {[string compare $teams_p t] == 0} {
+    append manage_users_text "<li>Student Teams: <a href=\"teams/\">[database_to_tcl_string $db "select count(team_id) from edu_teams where class_id = $class_id"]</a>"
+}
+
+append manage_users_text "
+</ul>
+"
+
+
+#
+#
+#  Begin the code to generate spam stuff
+#
+#
+
+set spam_permission_p [ad_permission_p $db "" "" "Spam Users" $user_id $class_id]
+if {$spam_permission_p && ($n_profs > 0 || $n_tas > 0 || $n_students > 0 || $n_dropped > 0)} {
+    set spam_text "
+    <h3>Spam</h3>
+    <ul>
+    "
+
+    if {$n_profs > 0} {
+	append spam_text "
+	<li><a href=\"spam.tcl?who_to_spam=[ns_urlencode [list [edu_get_professor_role_string]]]\">Spam all Professors</a></li>
+	"
+    }
+
+    if {$n_profs > 0 && $n_tas > 0} {
+	append spam_text "
+	<li><a href=\"spam.tcl?who_to_spam=[ns_urlencode [list [edu_get_professor_role_string] [edu_get_ta_role_string]]]\">Spam all Professors and TAs</a></li>
+	"
+    }
+
+    if {$n_students > 0} {
+	append spam_text "
+	<li><a href=\"spam.tcl?who_to_spam=[ns_urlencode [list [edu_get_student_role_string]]]\">Spam all Students</a></li>
+	"
+    }
+
+    append spam_text "
+    <li><a href=\"spam.tcl?who_to_spam=[ns_urlencode [list [edu_get_professor_role_string] [edu_get_ta_role_string] [edu_get_student_role_string]]]\">Spam the Entire Class</a></li>
+    "
+
+    if {$n_dropped > 0} {
+	append spam_text "
+	<li><a href=\"spam.tcl?who_to_spam=[ns_urlencode [list [edu_get_dropped_role_string]]]\">Spam all students who have dropped the class</a>
+	"
+    }
+
+    # only disply the history link when there is a history to show.
+
+    set n_spams_sent [database_to_tcl_string $db "select count(spam_id) from group_spam_history where group_id = $class_id"]
+
+    if {$n_spams_sent  > 0} {
+	append spam_text "
+	<p>
+	<li> Past Spams: <a href=\"spam-history.tcl?group_id=$class_id\">$n_spams_sent</a>
+	"
+    }
+
+    append spam_text "</ul>"
+} else {
+    set spam_text ""
+}
+
+#
+#
+#  Begin the code to generate projects
+#
+#
+
+set projects_text "
+<h3>Projects</h3>
+<ul>
+"
+
+# lets get the projects out of the database (if there are any)
+
+set project_list [database_to_tcl_list_list $db "select project_name, project_id from edu_projects where class_id = $class_id"]
+
+if {![empty_string_p $project_list]} {
+
+    foreach project $project_list {
+	append projects_text "<li><a href=\"projects/one.tcl?project_id=[lindex $project 1]\">[lindex $project 0]</a>"
+	
+	# now, if there are project instances, lets list them
+	set selection [ns_db select $db "select project_instance_name, project_instance_id from edu_project_instances where project_id = [lindex $project 1] and active_p = 't'"]
+
+	set n_subprojects 0
+	while {[ns_db getrow $db $selection]} {
+	    set_variables_after_query
+	    if {$n_subprojects == 0} {
+		append projects_text "<ul>"
+	    }
+	    append projects_text "<li><a href=\"projects/instance-info.tcl?project_instance_id=$project_instance_id\">$project_instance_name</a>"
+	    incr n_subprojects
+	}
+	
+	if {$n_subprojects > 0} {
+	    append projects_text "</ul>"
+	}
+    }
+
+    append projects_text "<p>"
+
+}
+
+append projects_text "
+<li> <a href=\"task-add.tcl?task_type=project\">Add a Project</a></li>
+</ul>
+"
+
+#
+#
+#  Begin the code to generate exams
+#
+#
+
+
+if {[string compare $exams_p t] == 0} {
+    set exam_text "
+    <h3>Exams</h3>
+    <ul>
+    "
+    
+    set selection [ns_db select $db "select exam_name, exam_id from edu_exams where class_id = $class_id order by date_administered"]
+
+
+    set count 0
+    
+    while {[ns_db getrow $db $selection]} {
+	set_variables_after_query
+	incr count
+	append exam_text "<li><a href=\"exam-info.tcl?exam_id=$exam_id\">$exam_name</a> \n"
+	set return_url [ns_conn url]
+    }
+    
+    if {$count > 0} {
+	append exam_text "<br><br>"
+    }
+    
+    append exam_text "
+    <li> <a href=\"exam-add.tcl\">Add an Exam</a>
+    </ul>
+    "
+} else {
+    set exam_text ""
+}
+
+#
+#
+#  Begin the code to generate textbooks
+#
+#
+
+
+set textbook_text "
+<h3>Textbooks</h3>
+<ul>
+"
+
+set selection [ns_db select $db "select title, 
+                          edu_textbooks.textbook_id 
+                     from edu_textbooks, 
+                          edu_classes_to_textbooks_map map 
+                    where edu_textbooks.textbook_id = map.textbook_id 
+                      and map.class_id = $class_id 
+                 order by title"]
+
+set count 0
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append textbook_text "<li><a href=\"/class/textbook-info.tcl?textbook_id=$textbook_id\">$title</a>
+    [ad_space 4] <a href=\"textbooks/remove.tcl?textbook_id=$textbook_id\">Remove</a>"
+     incr count
+}
+
+if {$count > 0} {
+    append textbook_text "<p>"
+}
+
+append textbook_text "
+<li> <a href=\"textbooks/add.tcl\">Add a Text Book</a>
+</ul>
+"
+
+#
+#
+#  Begin the code to generate Grades
+#
+#
+
+if {[string compare $grades_p t] == 0} {
+    set grades_text "
+    <h3>Grades</h3>
+    <ul>"
+    
+    set selection [ns_db select $db "
+    select grade_name, weight, grade_id
+    from edu_grades where class_id=$class_id"]
+    set count 0
+    
+    while {[ns_db getrow $db $selection]} {
+	set_variables_after_query
+	
+	append grades_text "
+	<li><a href=grades-view.tcl?grade_id=$grade_id>$grade_name</a> - $weight\%"
+	incr count
+    }
+    
+    if {!$count} {
+	append grades_text "
+	<p>No grade policy has been set"
+    }
+
+    append grades_text "
+    <p><a href=grade-policy-edit.tcl>Edit Grade Policy</a>
+    </ul>
+    "
+} else {
+    set grades_text ""
+}
+
+#
+#
+#  Begin the code to generate sections
+#
+#
+
+
+set section_text "
+<h3>Sections</h3>
+<ul>
+"
+
+set selection [ns_db select $db "select section_id, section_name from edu_sections where class_id = $class_id"]
+
+set n_sections 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr n_sections
+    append section_text "<li><a href=\"section-info.tcl?section_id=$section_id\">$section_name</a> \n"
+}
+
+if {$n_sections > 0} {
+    append section_text "<p>"
+}
+
+
+append section_text "
+<a href=\"users/index.tcl?target_url=[ns_urlencode "[edu_url]class/admin/section-add-edit.tcl"]&type=section_leader\">Add a Section</a>
+</ul>
+"
+
+
+
+ns_return 200 text/html "
+$header
+$news_text
+$class_resources
+$lecture_notes_text
+$handouts_text
+$assignments_text
+$manage_users_text
+$spam_text
+$projects_text
+$exam_text
+$textbook_text
+$grades_text
+$section_text
+</blockquote>
+[ad_footer]
+"
Index: web/openacs/www/education/class/admin/key-swap.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/key-swap.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/key-swap.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,37 @@
+#
+# /www/education/class/admin/key-swap.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page swaps the two keys in the edu_role_pretty_role_map
+#
+# it swaps key with key + 1
+
+ad_page_variables {
+    key
+    column
+}
+
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Edit Permissions"]
+set class_id [lindex $id_list 1]
+
+set next_key [expr $key + 1]
+
+with_catch errmsg {
+    ns_db dml $db "update edu_role_pretty_role_map
+    set $column = (case when $column = $key then $next_key else case when $column = $next_key then $key else $column end end)
+    where group_id = $class_id
+    and $column in ($key, $next_key)"
+
+    ns_returnredirect "permissions.tcl"
+} {
+    ad_return_error "Database error" "A database error occured while trying
+to swap your user group fields. Here's the error:
+<pre>
+$errmsg
+</pre>
+"
+}
Index: web/openacs/www/education/class/admin/new-bboard-topic-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/new-bboard-topic-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/new-bboard-topic-add-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,97 @@
+# /www/education/class/admin/add-new-bboard-topic-2.tcl
+# aileen@mit.edu, randyg@mit.edu
+# feb, 2000
+# based on add-new-topic-2.tcl,v 1.6.4.1 2000/02/03 09:19:01 ron Exp
+set_the_usual_form_variables
+
+# IE will BASH &not
+
+set notify_of_new_postings_p $iehelper_notify_of_new_postings_p
+set QQnotify_of_new_postings_p $QQiehelper_notify_of_new_postings_p
+
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Communications"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+set exception_text ""
+set exception_count 0
+
+if { ![info exists topic] || $topic == "" } {
+    append exception_text "<li>You must enter a topic name"
+    incr exception_count
+}
+
+if { [info exists topic] && [string match {*"*} $topic] } {
+    append exception_text "<li>Your topic name can't include string quotes.  It makes life too difficult for this collection of software."
+    incr exception_count
+}
+
+
+if { $exception_count> 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+# no exceptions found
+
+set extra_columns ""
+set extra_values ""
+set group_report ""
+
+with_transaction $db {
+    set topic_id [database_to_tcl_string $db "select bboard_topic_id_sequence.nextval from dual"]
+    ns_db dml $db "insert into bboard_topics (topic_id,topic,primary_maintainer_id,presentation_type,moderation_policy,notify_of_new_postings_p, role, group_id)
+values
+ ($topic_id,'$QQtopic',$user_id_from_search,'$QQpresentation_type','$QQmoderation_policy','$QQnotify_of_new_postings_p', '$QQrole', $group_id)"
+
+    # create the administration group for this topic
+    ad_administration_group_add $db "Administration Group for $topic BBoard" "bboard" $topic_id "/bboard/admin-home.tcl?[export_url_vars topic topic_id]"
+
+    # add the current user as an administrator
+    ad_administration_group_user_add $db $user_id_from_search "administrator" "bboard" $topic_id
+
+} {
+    # there was an error from the database
+    set count [database_to_tcl_string $db "select count(*) from bboard_topics where topic = '$QQtopic'"]
+    if { $count > 0 } {
+	set existing_topic_blather "There is already a discussion group named \"$topic\" in the database.  This is most likely why the database insert failed.  If you think
+you are the owner of that group, you can go to its <a
+href=\"/bboard/admin-home.tcl?topic=[ns_urlencode $topic]\">admin
+page</a>."
+    } else {
+	set existing_topic_blather ""
+    }
+    ad_return_error "Topic Not Added" "The database rejected the addition of discussion topic \"$topic\".  Here was
+the error message:
+
+<pre>
+$errmsg
+</pre>
+
+$existing_topic_blather
+"
+return 0 
+
+}
+
+
+ns_return 200 text/html "[bboard_header "Topic Added"]
+
+<h2>Topic Added</h2>
+
+There is now a discussion group for \"$topic\" in 
+<a href=\"/bboard/\">[bboard_system_name]</a>
+
+<hr>
+Visit the <a href=/bboard/admin-home.tcl?topic=[ns_urlencode $topic]>admin page</a>
+for $topic.
+<p>
+
+$group_report
+
+[bboard_footer]"
+
Index: web/openacs/www/education/class/admin/new-bboard-topic-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/new-bboard-topic-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/new-bboard-topic-add.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,154 @@
+#
+# /www/education/class/admin/new-bboard-topic-add.tcl
+# aileen@mit.edu, randyg@mit.edu
+# feb, 2000
+# based on add-new-topic.tcl,v 1.3.4.1 2000/02/03 09:19:03 ron Exp
+#
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Communications"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set return_string "
+
+[ad_header "Add New Topic"]
+
+<h2>Add New Topic</h2>
+[ad_context_bar_ws_or_index [list "../one.tcl" "$class_name Home"] [list "" "Administration"] "Add a new topic"]
+
+<hr>
+
+<form action=\"/admin/users/search.tcl\" method=get>
+<input type=hidden name=target value=\"[edu_url]class/admin/new-bboard-topic-add-2.tcl\">
+<input type=hidden name=passthrough value=\"topic presentation_type moderation_policy iehelper_notify_of_new_postings_p role group_id\">
+<input type=hidden name=custom_title value=\"Choose a Member to Add as an Administrator\">
+
+<h3>The Most Important Things</h3>
+
+What do you want to call your forum?  The topic name that you choose
+will appear in the alphabetical listing on the [bboard_system_name]
+home page.  It will appear on pages visible to users.  It will appear
+in URLs.  If you want to let other people link directly to your forum,
+they'll need to include this.  So it is probably best to pick some
+short and descriptive, e.g., \"darkroom technique\".  The software
+adds words like \"Q&A\" and \"forum\" so don't include those in your
+topic name.
+
+<P>
+
+New Topic Name:  <input type=text name=topic size=30>
+
+<P>
+<h3>Maintainer</h3>
+<p>
+Search for a user to be primary administrator of this domain by<br>
+<table border=0>
+<tr><td>Email address:<td><input type=text name=email size=40></tr>
+<tr><td colspan=2>or by</tr>
+<tr><td>Last name:<td><input type=text name=last_name size=40></tr>
+</table>
+<p>
+<h3>Group and Role-based Access Control</h3>
+<p>
+Select the group that this bboard is used for and set the access level for this bboard.
+<p><table>
+<tr><td>Group:</td><td>
+<select name=group_id>
+<option value=$class_id>$class_name
+"
+
+set selection [ns_db select $db "select team_id, team_name from edu_teams where class_id=$class_id"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    append return_string "
+    <option value=$team_id>$team_name
+    "
+}
+
+append return_string "
+</select>
+</tr><tr>
+<td>Role:</td>
+<td><select name=role>
+<option value=\"\">Public
+"
+
+set role_list [edu_get_roles_for_group $db $class_id]
+
+foreach role $role_list {
+    append return_string "<option value=[lindex $role 0]>[lindex $role 1]"
+}
+
+append return_string "
+</select>
+</tr></table>
+
+<h3>How this BBoard is presented to users</h3>
+
+You have to choose whether or not this is primarily a Q&A
+forum or a threads-based discussion group.  The user interfaces
+interoperate, i.e., a posting made a user in the Q&A interface will be
+seen in the threads interface and vice versa.  But my software still
+needs to know whether this is primarily threads or Q&A.  For example,
+if a user signs up for email alerts, this program will send out email
+saying \"come back to the forum at http://...\".  The \"come back
+URL\" is different for Q&A and threads.
+
+<ul>
+<li><input type=radio name=presentation_type value=threads> threads - classical USENET style 
+<li><input type=radio name=presentation_type value=q_and_a CHECKED> Q&A - questions and all answers appear on one page, use for discussion groups that tend to have short messages/responses
+<li><input type=radio name=presentation_type value=ed_com> Editorial - question and answers appear on separate pages,  answers are collasped by subject line as a default, use for discussion groups that tend to have longer messages/responses 
+</ul>
+
+<p>
+
+<br>
+
+(note: I personally greatly prefer the Q&A interface; if people liked
+threads, they'd have stuck with USENET.)
+
+<h3>Moderation Type</h3>
+
+What moderation category does this fall under?
+<select name=moderation_policy>"
+
+set optionlist [bboard_moderation_policy_order]
+
+append return_string "
+[ad_generic_optionlist $optionlist $optionlist]
+</select>
+
+<h3>Notification</h3>
+
+If your forum is inactive, you'll probably want this system to send
+the primary maintainer email every time someone adds a posting of any kind (new top-level
+question or reply).  If you're getting 50 new postings/day then you'll
+probably want to disable this feature
+
+<p>
+
+Notify me of all new postings?
+<input type=radio name=iehelper_notify_of_new_postings_p value=t CHECKED> Yes <input type=radio name=iehelper_notify_of_new_postings_p value=f> No
+
+<p>
+<center>
+
+<input type=submit value=\"Enter This New Topic in the Database\">
+
+</form>
+
+</center>
+
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
Index: web/openacs/www/education/class/admin/permissions.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/permissions.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/permissions.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,192 @@
+#
+# /www/education/class/admin/permissions.tcl
+#
+# this page is the index page for the class administrators
+# 
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Edit Permissions"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set html_to_return "
+[ad_header "$class_name Administration @ [ad_system_name]"]
+
+<h2>$class_name Administration</h2>
+
+[ad_context_bar_ws_or_index [list "../one.tcl" "$class_name Home"] [list "" "Administration"] "Class Permissions"]
+
+<hr>
+<blockquote>
+"
+
+
+append permissions_html "
+<h3>Permissions</h3>
+<ul>
+<li> <b> Manage Users </b> - Add or delete users from the class; change the role of a user within the class; add people to teams or sections.
+
+<li> <b> Add Tasks </b> - Add assignments, projects, or exams to the web page.
+<li> <b> Edit Tasks </b> - Edit the attributes of existing assignments, projects, or exams.
+<li> <b> Delete Tasks </b> - Delete assignments, projects, or exams.
+<li> <b> Edit Class Properties </b> - Edit the properties of the class such as description, scheduled meeting times, or title.
+<li> <b> Manage Communications </b> - Create Bulletin Boards and Chat rooms; post news messages.
+<li> <b> Edit Permissions </b> - View/change the contents of this page.
+<li> <b> Evaluate </b> - Assign grades/perform reviews on students.
+<li> <b> Spam Users </b> - Send email to groups of users within the class.  Users with this permission can also see all of the spam history for the class.  It is recommended that you only give this permission to TAs and Professors.
+<li> <b> Submit Tasks </b> - upload answers to a task from the user pages.
+<li> <b> View Admin Pages </b> - View anything within the class/admin/ directory; without permission for this, the role will not be able to perform any of the above actions.
+</ul>
+<p>"
+
+set actions_list [database_to_tcl_list $db "select action from user_group_actions where group_id = $class_id"]
+
+set roles_list [database_to_tcl_list_list $db "select roles.role, 
+         map.pretty_role,
+         sort_key
+    from user_group_roles roles, 
+         edu_role_pretty_role_map map 
+   where roles.group_id = $class_id 
+     and lower(roles.role) = lower(map.role) 
+     and roles.group_id = map.group_id 
+order by sort_key"]
+
+set role_swap_table "<table>"
+set action_table_title "<table border=1 cellpadding=2><tr><th>Action \\\\ Role</th>"
+
+set count 0
+set list_length [llength $roles_list]
+
+foreach role $roles_list {
+    append action_table_title "<th>[lindex $role 1]</th>"
+    append role_swap_table "<tr><td>[lindex $role 1]</td><td>"
+    if {$count < [expr $list_length - 1]} {
+	append role_swap_table "<a href=\"key-swap.tcl?key=[lindex $role 2]&column=sort_key\">swap with next</a>"
+    } else {
+	append role_swap_table "[ad_space]"
+    }
+    incr count
+    append role_swap_table "</td></tr>"
+}
+
+append action_table_title "</tr>"
+append role_swap_table "</table>"
+
+
+
+append action_table "<tr>"
+
+set roles_with_mapping ""
+set group_id $class_id
+
+foreach action $actions_list {
+    append action_table "<tr><th align=left>$action</th>\n"
+    
+    set allowed_roles_for_action [database_to_tcl_list $db "select role from user_group_action_role_map where group_id = $class_id and lower(action) = lower('[DoubleApos $action]')"]
+
+    foreach role_item $roles_list {
+	set role [lindex $role_item 0]
+	
+	if {[lsearch $allowed_roles_for_action $role] == -1} {
+	    append action_table "
+	    <td align=center>
+	    <a href=\"action-role-map.tcl?[export_url_vars action role group_id]\">
+	    Denied</a></td>\n"
+	} else {
+	    lappend actions_with_mapping $action
+	    append action_table "
+	    <td align=center>
+	    <a href=\"action-role-unmap.tcl?[export_url_vars action role group_id]\">
+	    Allowed</a></td>\n"
+	}
+    }
+
+    append action_table "</tr>"
+}
+
+
+
+
+
+append action_table "</table>"
+
+append permissions_html "
+$action_table_title
+$action_table
+"
+
+
+set role_swap_text "
+<p>[ad_space]<p>
+<h3>Role Display Order</h3>
+<ul>
+You may use this to alter the order roles
+are displayed on various pages throughout the system.
+<p>
+$role_swap_table
+</ul>
+"
+
+
+set file_permissions_hierarchy "
+<p>[ad_space]<p>
+<h3>File Permission Hierarchy</h3>
+<ul>
+This determines the order permissions are displayed when uploading a
+file.  For instance, if 'Professor' is the first on in the list, then
+someone with the role of 'Professor' will have all permissions on all
+files uploaded.
+<p>
+<table>
+"
+
+set roles_list [database_to_tcl_list_list $db "select roles.role, 
+         map.pretty_role,
+         priority
+    from user_group_roles roles, 
+         edu_role_pretty_role_map map 
+   where roles.group_id = $class_id 
+     and lower(roles.role) = lower(map.role) 
+     and roles.group_id = map.group_id 
+order by priority"]
+
+set count 0
+set list_length [llength $roles_list]
+
+foreach role $roles_list {
+    append file_permissions_hierarchy "<tr><td>[lindex $role 1]</td><td>"
+    if {$count < [expr $list_length - 1]} {
+	append file_permissions_hierarchy "<a href=\"key-swap.tcl?key=[lindex $role 2]&column=priority\">swap with next</a>"
+    } else {
+	append file_permissions_hierarchy "[ad_space]"
+    }
+    incr count
+    append file_permissions_hierarchy "</td></tr>"
+}
+
+append file_permissions_hierarchy "</table></ul>"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "
+$html_to_return
+$permissions_html
+$file_permissions_hierarchy
+$role_swap_text
+</blockquote>
+[ad_footer]
+"
+
+
+
+
Index: web/openacs/www/education/class/admin/properties-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/properties-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/properties-edit-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,253 @@
+# 
+# /www/education/class/admin/properties-edit-2.tcl
+#
+# by randyg@arsdigita.com, aillen@arsdigita.com
+#
+# This page displays the confirmation page so that the class admin can review
+# the changes about to be made
+#
+
+ad_page_variables {
+    class_name
+    {term_id ""}
+    {where_and_when ""}
+    {ColValue.start%5fdate.month ""}
+    {ColValue.start%5fdate.day ""}
+    {ColValue.start%5fdate.year ""}
+    {ColValue.end%5fdate.month ""}
+    {ColValue.end%5fdate.day ""}
+    {ColValue.end%5fdate.year ""}
+    {public_p t}
+    {grades_p t}
+    {exams_p t}
+    {final_exam_p t}
+    {teams_p f}
+    {description ""} 
+    {pretty_role_ta "Teaching Assistant"}
+    {pretty_role_professor Professor}
+    {pretty_role_student Student}
+    {pretty_role_dropped Dropped}
+    {pretty_role_plural_ta "Teaching Assistants"}
+    {pretty_role_plural_professor Professors}
+    {pretty_role_plural_student Students}
+    {pretty_role_plural_dropped Dropped}
+}
+
+validate_integer_or_null term_id $term_id
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Edit Class Properties"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set old_class_name [lindex $id_list 2]
+
+
+#check the input
+set exception_count 0
+set exception_text ""
+
+
+# put together due_date, and do error checking
+
+set form [ns_getform]
+
+# ns_dbformvalue $form start_date date start_date will give an error
+# message if the day of the month is 08 or 09 (this octal number problem
+# we've had in other places).  So I'll have to trim the leading zeros
+# from ColValue.start%5fdate.day and stick the new value into the $form
+# ns_set.
+
+set "ColValue.start%5fdate.day" [string trimleft [set ColValue.start%5fdate.day] "0"]
+ns_set update $form "ColValue.start%5fdate.day" [set ColValue.start%5fdate.day]
+
+if [catch  { ns_dbformvalue $form start_date date start_date} errmsg ] {
+    incr exception_count
+    append exception_text "<li>The date was specified in the wrong format.  The date should be in the format Month DD YYYY.\n"
+} elseif { [string length [set ColValue.start%5fdate.year]] != 4 } {
+    incr exception_count
+    append exception_text "<li>The year needs to contain 4 digits.\n"
+} 
+
+set "ColValue.end%5fdate.day" [string trimleft [set ColValue.end%5fdate.day] "0"]
+ns_set update $form "ColValue.end%5fdate.day" [set ColValue.end%5fdate.day]
+
+if [catch  { ns_dbformvalue $form end_date date end_date} errmsg ] {
+    incr exception_count
+    append exception_text "<li>The date was specified in the wrong format.  The date should be in the format Month DD YYYY.\n"
+} elseif { [string length [set ColValue.end%5fdate.year]] != 4 } {
+    incr exception_count
+    append exception_text "<li>The year needs to contain 4 digits.\n"
+} elseif {[database_to_tcl_string $db "select date_part('day',trunc(sysdate()) - to_date('$end_date','YYYY-MM-DD')) from dual"] > 1} {
+    incr exception_count
+    append exception_text "<li>The end date must be in the future."
+}
+
+if {[string compare $exception_count 0] == 0 && ![empty_string_p $start_date] && ![empty_string_p $end_date]} {
+    if {[database_to_tcl_string $db "select to_date('$end_date', 'YYYY-MM-DD') - to_date('$start_date', 'YYYY-MM-DD') from dual"] < 0 } {
+	incr exception_count
+	append exception_text "<li>The end date must be after the start day."
+    }
+}
+
+set variables_to_check [list [list class_name "Class Title"] [list grades_p "Grades"] [list exams_p "Exams"] [list final_exam_p "Final Exam"] [list term_id "Term"] [list teams_p Teams]]
+
+foreach var $variables_to_check {
+    if {![info exists [lindex $var 0]] || [empty_string_p [set [lindex $var 0]]]} {
+	incr exception_count
+	append exception_text "<li>You forgot to provide a value for the [lindex $var 1]"
+    }
+}
+
+if {![info exists description]} {
+    incr exception_count
+    append exception_text "<li>You must provide a description."
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+#now that we know we have valid input, we display the confirmation page
+
+
+set return_string "
+
+[ad_header "Class Administration @ [ad_system_name]"]
+
+<h2>Edit Class Properties for $old_class_name</h2>
+
+[ad_context_bar_ws_or_index [list "../one.tcl" "$old_class_name"] [list "" Administration] "Edit Properties"]
+
+
+<hr>
+<blockquote>
+<table>
+<form method=post action=\"properties-edit-3.tcl\">
+
+<tr><th align=right>Class Title:
+</td>
+<td>$class_name
+</tr>
+
+<tr><th align=right>Term: 
+</td>
+<td>
+[database_to_tcl_string $db "select term_name from edu_terms where term_id = $term_id"]
+</tr>
+
+<tr><th valign=top align=right>When/Where: </th>
+<td>$where_and_when</td>
+</tr>
+
+<tr><th align=right>Start displaying<br>web page: 
+<td valign=top>[util_AnsiDatetoPrettyDate $start_date]
+</td>
+</tr>
+
+<tr><th align=right>Stop displaying<br>web page: 
+<td valign=top>[util_AnsiDatetoPrettyDate $end_date]
+</td>
+</tr>
+
+<tr><th align=right>Make class documents public:
+<td valign=top>[util_PrettyBoolean $public_p]
+</td>
+</tr>
+
+<tr><th align=right>Grades:
+<td valign=top>[util_PrettyBoolean $grades_p]
+</td>
+</tr>
+
+<tr><th align=right>Student teams:
+<td valign=top>[util_PrettyBoolean $teams_p]
+</td>
+</tr>
+
+<tr><th align=right>Exams:
+<td valign=top>[util_PrettyBoolean $exams_p]
+</td>
+</tr>
+
+<tr><th align=right>Final exam:
+<td valign=top>[util_PrettyBoolean $final_exam_p]
+</td>
+
+<tr><th align=right valign=top>Class Description
+</td>
+"
+
+if {[empty_string_p $description]} {
+    append return_string "<td valign=top>None"
+} else {
+    append return_string "<td valign=top>$description"
+}
+
+append return_string "
+<tr>
+<th align=right valign=top>Staff Titles:</th>
+<td>
+
+<table>
+<tr>
+<th>&nbsp</th>
+<th align=left>Singular</th>
+<th align=left>Plural</th>
+</tr>
+"
+
+set selection [ns_db select $db "select role, pretty_role, pretty_role_plural from edu_role_pretty_role_map where group_id=$class_id and role != 'administrator' order by sort_key"]
+
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    append return_string "
+    <tr>
+    <th align=left>[capitalize $role]</th>
+    <td>
+    [set pretty_role_[string tolower [join $role "_"]]]
+    </td>
+    <td>
+    [set pretty_role_plural_[string tolower [join $role "_"]]]
+    </td>
+    </tr>
+    "
+}
+    
+
+append return_string "
+</table>
+</td>
+</tr>
+
+<tr>
+<td colspan=2 align=center>
+<br>
+[export_form_vars start_date end_date class_name term_id where_and_when public_p grades_p exams_p final_exam_p teams_p description pretty_role_ta pretty_role_professor pretty_role_student pretty_role_dropped pretty_role_plural_ta pretty_role_plural_professor pretty_role_plural_student pretty_role_plural_dropped]
+
+<input type=submit value=\"Edit Class Properties\"></td>
+
+</form>
+</td>
+</tr>
+</table>
+
+
+
+</blockquote>
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
Index: web/openacs/www/education/class/admin/properties-edit-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/properties-edit-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/properties-edit-3.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,93 @@
+# 
+# /www/education/class/admin/properties-edit-3.tcl
+#
+# by randyg@arsdigita.com, aillen@mit.edu
+#
+# This page actually updates the class_info table to reflect the changes in the
+# properties of the class
+#
+
+ad_page_variables {
+    class_name
+    {term_id ""}
+    {where_and_when ""}
+    {start_date ""}
+    {end_date ""}
+    {public_p t}
+    {grades_p t}
+    {exams_p t}
+    {final_exam_p t}
+    {teams_p f}
+    {description ""} 
+    pretty_role_ta
+    pretty_role_professor
+    pretty_role_student    
+    pretty_role_dropped
+    pretty_role_plural_ta
+    pretty_role_plural_professor
+    pretty_role_plural_student
+    pretty_role_plural_dropped
+}
+
+validate_integer_or_null term_id $term_id
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Edit Class Properties"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+
+
+#check the input
+set exception_count 0
+set exception_text ""
+
+ns_db dml $db "begin transaction"
+
+ns_db dml $db "update user_groups set group_name = [ns_dbquotevalue $class_name] where group_id = $class_id"
+
+ns_db dml $db "update edu_class_info
+                   set start_date  = '$start_date',
+                       end_date = '$end_date',
+	               term_id = $term_id,
+	               description = [ns_dbquotevalue $description],
+	               where_and_when = [ns_dbquotevalue $where_and_when],
+	               public_p = '$public_p',
+	               grades_p = '$grades_p',
+	               teams_p = '$teams_p',
+	               exams_p = '$exams_p',
+	               final_exam_p = '$final_exam_p',
+      	               last_modified = sysdate(),
+                       last_modifying_user = $user_id,
+                       modified_ip_address = '[ns_conn peeraddr]'                       
+                 where group_id = $class_id"
+
+set role_list [database_to_tcl_list $db "select role from user_group_roles where role != 'administrator' and group_id=$class_id"]
+
+foreach role $role_list {
+    ns_db dml $db "update edu_role_pretty_role_map 
+          set pretty_role=[ns_dbquotevalue [set [string tolower pretty_role_[join $role "_"]]]], 
+              pretty_role_plural =  [ns_dbquotevalue [set pretty_role_plural_[string tolower [join $role "_"]]]] 
+              where group_id=$class_id 
+                and lower(role)=lower('$role')"
+}
+
+ns_db dml $db "end transaction"
+
+ns_db releasehandle $db
+
+ns_returnredirect index.tcl
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/properties-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/properties-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/properties-edit.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,208 @@
+# 
+# /www/education/class/admin/properties-edit.tcl
+#
+# by randyg@arsdigita.com, aillen@mit.edu
+#
+# This page displays the form so that the class admin can edit the properties of
+# the class
+#
+
+# this does not require any variables to be passed in.
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Edit Class Properties"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+set selection [ns_db 0or1row $db "select class_id,
+	class_name,
+	term_id,
+	to_char(start_date,'YYYY-MM-DD') as start_date,
+	to_char(end_date,'YYYY-MM-DD') as end_date,
+	description,
+	where_and_when,
+	syllabus_id,
+	lecture_notes_folder_id,
+	handouts_folder_id,
+	assignments_folder_id,
+	public_p,
+	grades_p,
+	teams_p,
+	exams_p,
+	final_exam_p
+   from edu_classes
+  where class_id = $class_id"]
+
+if {$selection == ""} {
+    # this should never happen.
+    ad_return_complaint 1 "<li>The group you are logged in as is not a class.  Please log out and log back in."
+    return
+} else {
+    set_variables_after_query
+}
+
+
+set return_string "
+[ad_header "Edit Class Properties"]
+
+<h2>Edit Class Properties</h2>
+
+[ad_context_bar_ws [list "../one.tcl" "$class_name"] [list "" "Administration"] "Edit Class Properties"]
+
+<hr>
+<blockquote>
+
+<form method=post action=\"properties-edit-2.tcl\">
+
+<table>
+<tr><th align=right>Class Title
+<td><input type=text size=60 name=class_name maxsize=100 value=\"$class_name\"> 
+</tr>
+
+<tr><th align=right>Term: 
+<td>
+[edu_term_select_widget $db term_id $term_id]
+</tr>
+
+<tr><th valign=top align=right>Meeting time and place: 
+<br>(e.g. Lecture: TR10 (10-250) Recitation: WF10 (13-4101) or WF11 (13-4101))</th>
+<td>[edu_textarea where_and_when $where_and_when 50 4]</td>
+</tr>
+
+<tr><th align=right>Date to Start Displaying Class Web Page: 
+<td>[ad_dateentrywidget start_date $start_date]
+</tr>
+
+<tr><th align=right>Date to Stop Displaying Class Web Page: 
+<td>[ad_dateentrywidget end_date $end_date]
+</tr>
+
+<tr><th align=right>Will the class web page and documents be open to the public?
+</td><td>
+"
+
+if {[string compare $public_p t] == 0} {
+    append return_string "<input type=radio name=public_p checked value=t>Yes &nbsp;<input type=radio name=public_p value=f>No"
+} else {
+    append return_string "<input type=radio name=public_p value=t>Yes &nbsp;<input type=radio name=public_p value=f checked>No"
+}
+
+append return_string "
+</td></tr>
+<tr><th align=right>Do students recieve grades?
+</td><td>
+"
+
+if {[string compare $grades_p t] == 0} {
+    append return_string "<input type=radio name=grades_p value=t checked>Yes &nbsp;<input type=radio name=grades_p value=f>No"
+} else {
+    append return_string "<input type=radio name=grades_p value=t>Yes &nbsp;<input type=radio name=grades_p value=f checked>No"
+}
+
+append return_string "
+</td></tr>
+<tr><th align=right>Will the class have teams?
+</td><td>
+"
+
+if {[string compare $teams_p t] == 0} {
+    append return_string "<input type=radio name=teams_p value=t checked>Yes &nbsp;<input type=radio name=teams_p value=f>No"
+} else {
+    append return_string "<input type=radio name=teams_p value=t>Yes &nbsp;<input type=radio name=teams_p value=f checked>No"
+}
+
+append return_string "
+</td></tr>
+<tr><th align=right>Will the class have exams?
+</td><td>
+"
+
+if {[string compare $exams_p t] == 0} {
+    append return_string "<input type=radio name=exams_p value=t checked>Yes &nbsp;<input type=radio name=exams_p value=f>No"
+} else {
+    append return_string "<input type=radio name=exams_p value=t>Yes &nbsp;<input type=radio name=exams_p value=f checked>No"
+}
+
+append return_string "
+</td></tr>
+<tr><th align=right>Will the class have a final exam?
+</td><td>
+"
+
+if {[string compare $final_exam_p t] == 0} {
+    append return_string "<input type=radio name=final_exam_p value=t checked>Yes &nbsp;<input type=radio name=final_exam_p value=f>No"
+} else {
+    append return_string "<input type=radio name=final_exam_p value=t>Yes &nbsp;<input type=radio name=final_exam_p value=f checked>No"
+}
+
+append return_string "
+</td></tr>
+<tr><th align=right>Class Description
+<td>[edu_textarea description "$description"]
+</tr>
+<tr><td align=right valign=top colspan=2>
+
+<table>
+<tr>
+<th align=right valign=top>Staff Titles:</th>
+<td>
+
+<table>
+<tr>
+<th>[ad_space]</th>
+<th>Singular</th>
+<th>Plural</th>
+</tr>
+
+"
+
+set selection [ns_db select $db "select role, pretty_role, pretty_role_plural from edu_role_pretty_role_map where group_id=$class_id and role != 'administrator' order by sort_key"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    append return_string "
+    <tr>
+    <th>[capitalize $role]</th>
+    <td>
+    <input type=text name=pretty_role_[string tolower [join $role "_"]] value=\"$pretty_role\">
+    </td>
+    <td>
+    <input type=text name=pretty_role_plural_[string tolower [join $role "_"]] value=\"$pretty_role_plural\">
+    </td>
+    </tr>
+    "
+}
+    
+
+append return_string "
+</table>
+</td>
+</tr>
+</table>
+<tr><td colspan=2 align=center><input type=submit value=\"Continue\"></td>
+</tr>
+</table>
+</form>
+
+</blockquote>
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/section-add-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/section-add-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/section-add-edit-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,144 @@
+#
+# /www/education/class/admin/section-add-edit-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page allows a user to add information about a section
+# (e.g. a recitation or tutorial)
+#
+
+ad_page_variables {
+    {instructor_id ""}
+    {instructor_name ""}
+    {section_id ""}
+    section_name
+    section_time
+    section_place
+}
+
+validate_integer_or_null instructor_id $instructor_id
+validate_integer_or_null section_id $section_id
+
+# if this is a section-add then we need to have an instructor_id 
+#     and instructor_name
+# if this is a section-edit then we need to have a section_id
+
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set exception_count 0
+set exception_text ""
+
+
+if {![empty_string_p $section_id]} {
+    # this is an Edit
+    set prefix Edit
+    set instructor_text ""
+} elseif {![empty_string_p $instructor_id] && ![empty_string_p $instructor_name]} {
+    # this is an ADD
+
+    set instructor_text "
+    <tr>
+    <th valign=top align=right>
+    Instructor:
+    </td>
+    <td>
+    $instructor_name
+    </td>
+    </tr>
+    "
+    set section_id [database_to_tcl_string $db "select user_group_sequence.nextval from dual"]
+    set prefix Add
+} else {
+    append exception_text "<li>You must provide either a section id or a instructor id and an instructor name."
+    incr exception_count
+}
+
+
+if {[empty_string_p $section_name]} {
+    incr exception_count
+    append exception_text "<li>You must include a name for your section."
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+
+set return_string "
+[ad_header "$class_name @ [ad_system_name]"]
+
+<h2>Confirm Section Information</h3>
+
+[ad_context_bar_ws_or_index [list "../one.tcl" "$class_name Home"] [list "" "Administration"] "$prefix a Section"]
+
+<hr>
+<blockquote>
+
+<form method=post action=\"section-add-edit-3.tcl\">
+[export_form_vars instructor_id section_id section_name section_place section_time]
+<table>
+
+$instructor_text
+
+<tr>
+<th align=right>
+Section Name:
+</td>
+<td>
+$section_name
+</td>
+</tr>
+
+<tr>
+<th align=right>
+Section Location:
+</td>
+<td>
+$section_place
+</td>
+</tr>
+
+<tr>
+<th align=right>
+Section Time:
+</td>
+<td>
+$section_time
+</td>
+</tr>
+
+<tr>
+<td></td>
+<td >
+<Br>
+<input type=submit value=\"$prefix Section\">
+</td>
+</tr>
+
+</table>
+
+</form>
+
+</blockquote>
+
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
Index: web/openacs/www/education/class/admin/section-add-edit-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/section-add-edit-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/section-add-edit-3.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,69 @@
+#
+# /www/education/class/admin/section-add-edit-3.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page allows a user to add information about a section
+# (e.g. a recitation or tutorial)
+#
+
+ad_page_variables {
+    {instructor_id ""}
+    section_id
+    section_name
+    section_time
+    section_place
+}
+
+# if it is an add, we require section_id
+
+validate_integer_or_null instructor_id $instructor_id
+validate_integer section_id $section_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+set user_id [lindex $id_list 0]
+
+
+if {[database_to_tcl_string $db "select count(group_id) from user_groups where group_id = $section_id"] > 0} {
+    # this is an edit so do an update
+    
+    ns_db dml $db "begin transaction"
+
+    ns_db dml $db "update edu_section_info 
+                   set section_place = [ns_dbquotevalue $section_place],
+                       section_time = [ns_dbquotevalue $section_time]
+                 where group_id = $section_id"
+
+    ns_db dml $db "update user_groups set group_name = [ns_dbquotevalue $section_name] where group_id = $section_id"
+
+    ns_db dml $db "end transaction"
+                       
+
+} else {
+    # this is an add so do an insert
+    
+    set var_set [ns_set new]
+    
+    ns_set put $var_set class_id $class_id
+    ns_set put $var_set section_place $QQsection_place
+    ns_set put $var_set section_time $QQsection_time
+    
+    ad_user_group_add $db edu_section $QQsection_name t f closed f $var_set $section_id
+
+    ns_db dml $db "update user_groups set parent_group_id = $class_id where group_id = $section_id"
+
+    if {![empty_string_p $instructor_id]} {
+	# now, lets add the instructor as a member of the group	
+	ad_user_group_user_add $db $instructor_id administrator $section_id 
+    }
+
+}
+
+ns_db releasehandle $db
+
+ns_returnredirect "section-info.tcl?section_id=$section_id"
+
Index: web/openacs/www/education/class/admin/section-add-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/section-add-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/section-add-edit.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,147 @@
+#
+# /www/education/class/admin/section-add-edit.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page allows a user to add information about a section
+# (e.g. a recitation or tutorial)
+#
+
+ad_page_variables {
+    {instructor_id ""}
+    {section_id ""}
+}
+
+# if this is a section-add then we need to have an instructor_id
+# if this is a section-edit then we need to have a section_id
+
+validate_integer_or_null instructor_id $instructor_id
+validate_integer_or_null section_id $section_id
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+
+if {![empty_string_p $section_id]} {
+    # This is an EDIT
+    set selection [ns_db 0or1row $db "select section_name, 
+                          section_time,
+                          section_place
+                     from edu_sections
+                    where class_id = $class_id
+                      and section_id = $section_id"]
+
+    if {$selection == ""} {
+	ad_return_complaint 1 "<li>The section you have requested does not belong to this class."
+	return
+    } else {
+	set_variables_after_query
+	set prefix Edit
+	set instructor_text ""
+    }
+} elseif {![empty_string_p $instructor_id]} {
+    # this is an ADD
+
+    # we need the distinct because it may return multiple roles otherwise (because
+    # of user_group_map)
+    set instructor_name [database_to_tcl_string_or_null $db "select distinct first_names || ' ' || last_name from users, user_group_map map where users.user_id = $instructor_id and map.user_id = users.user_id and map.group_id = $class_id"]
+    if {[empty_string_p $instructor_name] } {
+	ad_return_complaint 1 "<li>The user you have provided does not belong to this class."
+	return
+    }
+
+    set instructor_text "
+    <tr>
+    <th valign=top align=right>
+    Instructor:
+    </td>
+    <td>
+    $instructor_name
+    </td>
+    </tr>
+    "
+    
+    set section_place ""
+    set section_time ""
+    set section_name ""
+    set prefix Add
+
+} else {
+    ad_return_complaint 1 "<li> You must include either a section id or an instructor id to have a section."
+    return
+}
+
+
+
+set return_string "
+[ad_header "$class_name @ [ad_system_name]"]
+
+<h2>$prefix a Section</h2>
+
+[ad_context_bar_ws_or_index [list "../one.tcl" "$class_name Home"] [list "" "Administration"] "$prefix a Section"]
+
+<hr>
+<blockquote>
+
+<form method=post action=\"section-add-edit-2.tcl\">
+[export_form_vars instructor_id section_id instructor_name]
+<table>
+
+$instructor_text
+
+<tr>
+<th align=right>
+Section Name:
+</td>
+<td>
+<input type=text maxsize=100 size=25 name=\"section_name\" value=\"[philg_quote_double_quotes $section_name]\">
+</td>
+</tr>
+
+<tr>
+<th align=right>
+Section Location:
+</td>
+<td>
+<input type=text maxsize=100 size=15 name=\"section_place\" value=\"[philg_quote_double_quotes $section_place]\">
+</td>
+</tr>
+
+<tr>
+<th align=right>
+Section Time:
+</td>
+<td>
+<input type=text maxsize=100 size=15 name=\"section_time\" value=\"[philg_quote_double_quotes $section_time]\">
+</td>
+</tr>
+
+<tr>
+<td></td>
+<td >
+<Br>
+<input type=submit value=\"Continue\">
+</td>
+</tr>
+
+</table>
+
+</form>
+
+</blockquote>
+
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
Index: web/openacs/www/education/class/admin/section-info.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/section-info.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/section-info.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,307 @@
+#
+# /www/education/class/admin/section-info.tcl
+#
+# randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page displays information about the section
+#
+
+ad_page_variables {
+    section_id
+}
+
+validate_integer section_id $section_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set exception_count 0
+set exception_text ""
+
+if {![info exists section_id] || [empty_string_p $section_id]} {
+    incr exception_count
+    append exception_text "<li>You must provide a section number."
+} else {
+    set selection [ns_db 0or1row $db "select
+                     section_name,
+                     section_place,
+                     section_time
+                from edu_sections
+               where section_id = $section_id
+                 and class_id = $class_id"]
+
+    if {$selection == ""} {
+	incr exception_count
+	append exception_text "<li>The section number that you have provided is not a section in this class."
+    } else {
+	set_variables_after_query
+    }
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+set return_string ""
+[ad_header "View Section for $class_name @ [ad_system_name]"]
+<h2>$class_name Teams</h2>
+
+[ad_context_bar_ws_or_index [list "../one.tcl" "$class_name Home"] [list "" Administration] "One Section"]
+
+<hr>
+
+<blockquote>
+
+<table>
+
+<tr>
+<th align=right>
+Section Name:
+</td>
+<td>
+$section_name
+</td>
+</tr>
+
+<tr>
+<th align=right>
+Section Location:
+</td>
+<td>
+$section_place
+</td>
+</tr>
+
+<tr>
+<th align=right>
+Section Time:
+</td>
+<td>
+$section_time
+</td>
+</tr>
+
+<tr>
+<td align=right>
+(<a href=\"section-add-edit.tcl?section_id=$section_id\">edit</a>)
+</td>
+<td>
+</td>
+</tr>
+
+</table>
+
+"
+
+
+# now, lets find the section leaders
+
+# we need the distinct so that we don't repeat for users that have
+# multiple roles in the group
+
+# set sql "select 
+#                      distinct users.user_id, 
+#                      first_names || ' ' || last_name as user_name,
+#                      fm.sort_key,
+#                      email,
+#                      url,
+#                      fm.field_name, 
+#                      fm.field_value
+#                 from users,
+#                      user_group_map map, 
+#                      (select fm.field_name, 
+#                              fm.field_value,
+#                              tmf.sort_key,
+#                              fm.user_id
+#                         from user_group_type_member_fields tmf,
+#                                user_group_member_field_map fm
+#                          where group_type = 'edu_class'
+#                            and fm.group_id = $class_id
+#                            and tmf.field_name = fm.field_name) fm
+#                where users.user_id = map.user_id
+#                  and (lower(map.role) = 'administrator' 
+#                      or lower(map.role) = lower('[edu_get_professor_role_string]')
+#                      or lower(map.role) = lower('[edu_get_ta_role_string]')) 
+#                  and map.group_id = $section_id
+#                  and map.user_id=fm.user_id(+)
+#             order by last_name, first_names, sort_key"
+
+set sql "\
+select 
+                     distinct users.user_id, 
+                     first_names || ' ' || last_name as user_name,
+                     fm.sort_key,
+                     email,
+                     url,
+                     fm.field_name, 
+                     fm.field_value
+                from users,
+                     user_group_map map, 
+                     member_field_mapping fm
+               where users.user_id = map.user_id
+                 and fm.group_type = 'edu_class'
+                 and fm.group_id = $class_id
+                 and (lower(map.role) = 'administrator' 
+                     or lower(map.role) = lower('[edu_get_professor_role_string]')
+                     or lower(map.role) = lower('[edu_get_ta_role_string]')) 
+                 and map.group_id = $section_id
+                 and map.user_id=fm.user_id
+union
+select 
+                     distinct users.user_id, 
+                     first_names || ' ' || last_name as user_name,
+                     fm.sort_key,
+                     email,
+                     url,
+                     fm.field_name, 
+                     fm.field_value
+                from users,
+                     user_group_map map, 
+                     member_field_mapping fm
+               where users.user_id = map.user_id
+                 and fm.group_type = 'edu_class'
+                 and fm.group_id = $class_id
+                 and (lower(map.role) = 'administrator' 
+                     or lower(map.role) = lower('[edu_get_professor_role_string]')
+                     or lower(map.role) = lower('[edu_get_ta_role_string]')) 
+                 and map.group_id = $section_id
+                 and not exists (select 1 from member_field_mapping 
+                                 where user_id = map.user_id=fm.user_id)
+            order by last_name, first_names, sort_key"
+
+set selection [ns_db select $db $sql]
+
+
+# we use old_user_id here because the above query can potentially
+# return more than one row for each user.  For instance, for a prof,
+# it will return one row for the office location, phone number, and
+# office hours.  Since we only want to display the name once, we only
+# add the text once.
+
+set teacher_text ""
+set old_user_id ""
+
+set leader_count 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    if {$old_user_id!=$user_id} {
+	incr leader_count
+	if {$old_user_id!=""} {
+	    append leader_text "<li><a href=\"section-user-remove.tcl?section_id=$section_id&leader_id=$old_user_id\">remove from section</a><br><br></ul>"
+	}
+
+	if {![empty_string_p $url]} {
+	    set user_name "<a href=\"$url\">$user_name</a>"
+	}
+	append leader_text "<li>$user_name (<a href=\"mailto:$email\">$email</a>) \n"
+	set old_user_id $user_id
+	append leader_text "<ul>"
+    } 
+
+    if {![empty_string_p $field_value]} {
+	append leader_text "<li><b>$field_name</b>: [edu_maybe_display_text $field_value] \n"
+    }
+}
+
+
+append return_string "
+<h3>Sections Leaders</h3>
+<ul>
+$leader_text
+"
+
+if {$leader_count > 0} {
+    append return_string "
+    <li><a href=\"section-user-remove.tcl?section_id=$section_id&leader_id=$user_id\">remove from section</a>
+    </ul>
+    "
+} else {
+    append return_string "There are no Leaders for this section."
+}
+
+# if there are TAs and/or Profs that are in the class but are not yet in the
+# section
+# we need the distinct because it is now possible for users to have several
+# roles in one group
+
+if {[database_to_tcl_string $db "select count(distinct user_id) from user_group_map where group_id = $class_id and (lower(role) = lower('[edu_get_ta_role_string]') or lower(role) = lower('administrator') or lower(role) = lower('[edu_get_professor_role_string]'))"] > $leader_count} {
+
+    set target_url "../section-user-add.tcl"
+    set target_url_params "section_id=$section_id"
+    append return_string "
+    <br>
+    <li><a href=\"users/index.tcl?section_id=$section_id&type=section_leader&[export_url_vars target_url_params target_url]\">Add a Leader</a>
+    "
+}
+
+append return_string "
+</ul>
+<h3>Section Members</h3>
+<ul>
+"
+
+set selection [ns_db select $db "select distinct users.user_id as student_id, 
+             last_name || ', ' || first_names as student_name 
+        from user_group_map map, 
+             users 
+       where map.user_id = users.user_id
+         and map.group_id = $section_id
+         and lower(map.role) = lower('member')
+     order by last_name"]
+
+set count 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append return_string "<li><a href=\"users/student-info.tcl?student_id=$student_id\">$student_name</a> &nbsp &nbsp (<a href=\"section-user-remove.tcl?student_id=$student_id&section_id=$section_id\">remove from section</a>)\n"
+    incr count
+}
+
+if {$count == 0} {
+    append return_string "There are not currently any students assigned to this section."
+}
+
+
+# if there are users in the class but not in the section then display the link
+
+if {[database_to_tcl_string $db "select count(distinct user_id) from user_group_map where group_id = $class_id and lower(role) = lower('[edu_get_student_role_string]')"] > $count} {
+    append return_string "
+    <p>
+    <a href=\"users/students-view.tcl?view_type=section&section_id=$section_id&target_url=[ns_urlencode "../section-user-add.tcl"]&target_url_vars=[ns_urlencode "section_id=$section_id"]\">Add a Section Member</a>
+    "
+}
+
+append return_string "
+</ul>
+"
+
+append return_string "
+<a href=\"spam.tcl?who_to_spam=[ns_urlencode [list administrator member]]&subgroup_id=$section_id\">Spam Section</a>
+
+</ul>
+
+</blockquote>
+
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/section-user-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/section-user-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/section-user-add.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,167 @@
+#
+# /www/education/class/admin/section-user-add.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, February 2000
+#
+# this page allows the user to add a student to the section
+#
+
+ad_page_variables {
+    section_id
+    {student_id ""}
+    {instructor_id ""}
+}
+
+validate_integer section_id $section_id
+validate_integer_or_null student_id $student_id
+validate_integer_or_null instructor_id $instructor_id
+
+# either student_id or instructor_id must be not null
+
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set exception_count 0
+set exception_text ""
+
+if {[empty_string_p $section_id]} {
+    incr exception_count
+    append exception_text "<li>You must provide a section number."
+}
+
+if {[empty_string_p $student_id] && [empty_string_p $instructor_id]} {
+    incr exception_count
+    append exception_text "<li>You must include the user to be added to the section."
+} else {
+    if {![info exists student_id] || [empty_string_p $student_id]} {
+	set phrase Leader
+	set member_sql_check "and not role = '[edu_get_student_role_string]'"
+	set user_id $instructor_id
+	set error_phrase "must be a TA or a professor to be a leader of this section."
+	set role administrator
+    } else {
+	set phrase Student
+	set member_sql_check ""
+	set error_phrase "is already a member of this section."
+	set user_id $student_id
+	set role member
+    }
+}
+
+
+if {$exception_count == 0} {
+
+    set selection [ns_db 0or1row $db "select section_name,
+             section_place,
+             section_time,
+             first_names || ' ' || last_name as student_name
+        from users,
+             edu_sections
+       where user_id = $user_id
+         and section_id = $section_id
+         and class_id = $class_id
+    group by section_name, first_names, last_name, section_place, section_time"]
+
+
+    if {$selection == ""} {
+	incr exception_count
+	append exception_text "<li>The section number that you have provided is not a section in this class."
+    } else {
+	set_variables_after_query
+
+	set member_p [database_to_tcl_string $db "select count(distinct group_id) from user_group_map where group_id = $section_id and user_id = $user_id $member_sql_check"]
+
+	if {$member_p != 0} {
+	    incr exception_count
+	    append exception_text "<li>$student_name $error_phrase"
+	}
+    }
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+set group_id $section_id
+
+set return_url "section-info.tcl?section_id=$section_id"
+
+set return_string "
+[ad_header "View Sections for $class_name @ [ad_system_name]"]
+<h2>Add a $phrase to $section_name</h2>
+
+[ad_context_bar_ws_or_index [list "../one.tcl" "$class_name Home"] [list "" Administration] [list "section-info.tcl?section_id=$section_id" "$section_name"] "Add $phrase"]
+
+<hr>
+
+<blockquote>
+
+<form method=post action=\"group-user-add.tcl\">
+[export_form_vars group_id user_id return_url role]
+
+Are you sure you wish to add <u>$student_name</u> to this section?
+
+<p>
+
+<table>
+
+<tr>
+<tr>
+<th align=right>
+Section Name:
+</td>
+<td>
+$section_name
+</td>
+</tr>
+
+
+<tr>
+<th align=right>
+Section Place
+</td>
+<td>
+$section_place
+</td>
+</tr>
+
+<tr>
+<th align=right>
+Section Time
+</td>
+<td>
+$section_time
+</td>
+</tr>
+
+<tr>
+<td colspan=2 align=center>
+<br>
+<input type=submit value=\"Add $phrase\">
+<td>
+</tr>
+
+</table>
+
+</blockquote>
+
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/section-user-remove.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/section-user-remove.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/section-user-remove.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,170 @@
+#
+# /www/education/class/admin/section-user-add.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, February 2000
+#
+# this page allows the user to add a student to the section
+#
+
+ad_page_variables {
+    section_id
+    {student_id ""}
+    {instructor_id ""}
+}
+
+validate_integer section_id $section_id
+validate_integer_or_null student_id $student_id
+validate_integer_or_null instructor_id $instructor_id
+
+# either student_id or instructor_id must be not null
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set exception_count 0
+set exception_text ""
+
+if {[empty_string_p $section_id]} {
+    incr exception_count
+    append exception_text "<li>You must provide a section number."
+}
+
+if {[empty_string_p $student_id] && [empty_string_p $leader_id]} {
+    incr exception_count
+    append exception_text "<li>You must include the student to be added to the section."
+} elseif {[empty_string_p $student_id]} {
+    set user_id $leader_id
+    set phrase Leader
+} else {
+    set user_id $student_id
+    set phrase Student
+}
+
+if {$exception_count == 0} {
+
+    # if the user is not a member of this section, lets just bounce back to the
+    # section information page
+
+#     set selection [ns_db 0or1row $db "select section_name,
+#              section_place,
+#              section_time,
+#              first_names || ' ' || last_name as student_name
+#         from users, 
+#              edu_sections, 
+#              (select distinct user_id from user_group_map where group_id = $section_id) section_members
+#        where users.user_id = $user_id
+#          and section_members.user_id = users.user_id
+#          and edu_sections.section_id = $section_id
+#          and edu_sections.class_id = $class_id
+#     group by section_name, first_names, last_name, section_place, section_time"]
+
+
+    set selection [ns_db 0or1row $db "select section_name,
+             section_place,
+             section_time,
+             first_names || ' ' || last_name as student_name
+        from users, 
+             edu_sections, 
+             user_group_map section_members
+       where users.user_id = $user_id
+         and section_members.group_id = $section_id
+         and section_members.user_id = users.user_id
+         and edu_sections.section_id = $section_id
+         and edu_sections.class_id = $class_id
+    group by section_name, first_names, last_name, section_place, section_time"]
+
+    if {$selection == ""} {
+	ns_returnredirect "section-info.tcl?section_id=$section_id"
+	return
+    } else {
+	set_variables_after_query
+    }
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+set group_id $section_id
+
+set return_url "section-info.tcl?section_id=$section_id"
+
+set return_string "
+[ad_header "Sections for $class_name @ [ad_system_name]"]
+<h2>Remove $phrase from Section</h2>
+
+[ad_context_bar_ws_or_index [list "../one.tcl" "$class_name Home"] [list "" Administration] [list "section-info.tcl?section_id=$section_id" "One Section"] "Remove $phrase"]
+
+<hr>
+
+<blockquote>
+
+<form method=post action=\"group-user-remove.tcl\">
+[export_form_vars group_id user_id return_url]
+
+<table>
+
+<tr>
+<td colspan=2 align=left>
+Are you sure you wish to remove <u>$student_name</u> from this section?
+<br><br>
+</td>
+</tr>
+
+<tr>
+<th align=right>
+Section Name:
+</td>
+<td>
+$section_name
+</td>
+</tr>
+
+<tr>
+<th align=right>
+Section Time
+</td>
+<td>
+$section_time
+</td>
+</tr>
+
+<tr>
+<th align=right>
+Section Location
+</td>
+<td>
+$section_place
+</td>
+</tr>
+
+<tr>
+<td colspan=2 align=center>
+<br>
+<input type=submit value=\"Remove $phrase\">
+<td>
+</tr>
+
+</table>
+
+</blockquote>
+
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/solutions-add-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/solutions-add-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/solutions-add-edit-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,53 @@
+#
+# /www/education/class/admin/solutions-add-edit-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, February 2000
+#
+# this file should be redirected from upload-new.tcl
+#
+
+ad_page_variables {
+    task_id
+    file_id
+    {final_return_url ""} 
+}
+
+validate_integer task_id $task_id
+validate_integer file_id $file_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Edit Tasks"]
+set class_id [lindex $id_list 1]
+
+# lets make sure that the task belongs to this class or one of its subgroups
+if {[database_to_tcl_string $db "select count(class_id) from user_groups, edu_student_tasks where class_id = user_groups.group_id and (group_id = $class_id or parent_group_id = $class_id)"] == 0} {
+    ad_return_complaint 1 "<li>You do not have permission to upload solutions for this task."
+    return
+}
+
+set insert_sql "insert into edu_task_solutions (task_id, file_id) values ($task_id, $file_id)"
+
+if {[catch { ns_db dml $db $insert_sql } errmsg] } {
+    # insert failed; let's see if it was because of duplicate submission
+    if {[database_to_tcl_string $db "select count(task_id) from edu_task_solutions where task_id = $task_id"] > 0} {
+	# it was a double click so redirect the user
+	ns_db releasehandle $db
+	ns_returnredirect $final_return_url
+    } else {
+	ns_log Error "[edu_url]class/admin/exam-edit-2.tcl choked:  $errmsg"
+	ad_return_error "Insert Failed" "The Database did not like what you typed.  This is probably a bug in our code.  Here's what the database said:
+	<blockquote>
+	<pre>
+	$errmsg
+	</pre>
+	</blockquote>
+	"
+	return
+    }
+}
+
+
+ns_db releasehandle $db
+
+ns_returnredirect $final_return_url
Index: web/openacs/www/education/class/admin/solutions-add-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/solutions-add-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/solutions-add-edit.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,213 @@
+#
+# /www/education/class/admin/solutions-add-edit.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, February 2000
+#
+# this page allows professors to upload solutions to the assignments
+# its action is upload-new.tcl from the file-storage module wiht return_url
+# set as solutions-add-edit-2.tcl because we also need to update 
+# edu_assignment_solutions table
+#
+
+ad_page_variables {
+    task_id
+    task_type
+    {return_url ""}
+}
+
+validate_integer task_id $task_id
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Edit Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+# we don't want to use the append command here because that would change
+# the acutal value of task_type, which we don't want to do
+set task_type_plural ${task_type}s
+set task_type_caps [capitalize $task_type]
+
+# set sql "select task_name as file_name,
+#            files.file_id,
+#            files.version_id,
+#            files.file_extension,           
+#            files.url
+#       from edu_student_tasks t,
+#            (select ver.file_id, 
+#                    version_id,
+#                    file_extension,
+#                    url,
+#                    task_id
+#               from edu_task_solutions sol,  
+#                    fs_versions_latest ver
+#              where sol.file_id = ver.file_id
+#                and sol.task_id = $task_id) files
+#      where t.task_id = $task_id 
+# and t.task_type = '$task_type'
+# and t.task_id = files.task_id(+)
+# and t.class_id = $class_id"
+
+set sql "\
+select task_name as file_name,
+           files.file_id,
+           files.version_id,
+           files.file_extension,           
+           files.url
+      from edu_student_tasks t,
+           task_files files
+     where t.task_id = $task_id 
+       and files.task_id = $task_id
+       and t.task_type = '$task_type'
+       and t.task_id = files.task_id
+       and t.class_id = $class_id
+union
+select task_name as file_name,
+           null::integer as file_id,
+           null::integer as version_id,
+           null::varchar as file_extension,           
+           null::varchar as url
+      from edu_student_tasks t
+     where t.task_id = $task_id 
+       and t.task_type = '$task_type'
+       and not exists (select 1 from task_files 
+                       where task_id = t.task_id)
+       and t.class_id = $class_id"
+
+# lets make sure that the task is in the right class and if of the
+# correct type
+set selection [ns_db 0or1row $db $sql]
+
+if {$selection == ""} {
+    ad_return_complaint 1 "<li>The $task_type you have requested does not belong to this class."
+    return
+} else {
+    set_variables_after_query
+}
+
+
+# in order to determine the defaults for the permissions, we want to see if there
+# is already a file for the assignment (or project).  If so, we want to use 
+# those as the default
+
+
+if {[empty_string_p $version_id]} {
+    set write_permission_default [edu_get_ta_role_string]
+    set read_permission_default ""
+} else {
+    # lets make sure that they can edit the file
+    if {![fs_check_edit_p $db $user_id $version_id $class_id]} {
+	ad_return_complaint 1 "<li>You are not authorized to edit this file."
+	return
+    }
+
+    # more often than not, the scope is going to be group_role so lets
+    # try that one first
+    set read_permission_default_list [database_to_tcl_list $db "select gp.role
+        from general_permissions gp,
+             edu_role_pretty_role_map map
+       where on_what_id = $version_id
+         and on_which_table = 'FS_VERSIONS'
+         and scope = 'group_role'
+         and gp.group_id = $class_id
+         and permission_type = 'read'
+         and gp.group_id = map.group_id
+         and lower(gp.role) = lower(map.role)
+       order by priority"]
+
+    # we want the lowest priority so lets just grab the first element
+    set read_permission_default [lindex $read_permission_default_list 0]
+    if {[empty_string_p $read_permission_default]} {
+	# if there is not a group_role item, we just set our normal default
+	# read role of ""
+	set read_permission_default ""
+    }
+
+
+    # now, we want to set our default write permissions and we do pretty much
+    # the same thing as when we did the read permissions.
+
+    set write_permission_default_list [database_to_tcl_list $db "select gp.role
+        from general_permissions gp,
+             edu_role_pretty_role_map map
+       where on_what_id = $version_id
+         and on_which_table = 'FS_VERSIONS'
+         and scope = 'group_role'
+         and gp.group_id = $class_id
+         and permission_type = 'write'
+         and gp.group_id = map.group_id
+         and lower(gp.role) = lower(map.role)
+       order by priority"]
+
+    # we want the lowest priority so lets just grab the first element
+    set write_permission_default [lindex $write_permission_default_list 0]
+    if {[empty_string_p $write_permission_default]} {
+	# there was not a group_role so lets check if it is public
+	set write_permission_public_p [database_to_tcl_string_or_null $db "select (case when public_permission_id('write', $version_id, 'FS_VERSIONS') = 0 then 0 else 1 end) from dual"]
+	if {$write_permission_public_p == 0} {
+	    # if write_permisssion_public_p is 0 then there is not a correct permissions
+	    # record so we go to our usual default of ta
+	    set write_permission_default [edu_get_ta_role_string]
+	} 
+    }
+}
+
+
+set version_id [database_to_tcl_string $db "select fs_version_id_seq.nextval from dual"]
+set file_title "$file_name Solutions"
+
+if {[empty_string_p $file_id]} {
+    set target_url "upload-new.tcl"
+    set file_id [database_to_tcl_string $db "select fs_file_id_seq.nextval from dual"]
+    set parent_id [database_to_tcl_string $db "select ${task_type}s_folder_id from edu_classes where class_id = $class_id"]
+    # we want to pass along the final destination
+    set final_return_url $return_url
+    set return_url "solutions-add-edit-2.tcl?[export_url_vars task_id file_id final_return_url]"
+} else {
+    set target_url "upload-version.tcl"
+}
+
+
+set return_string "
+[ad_header "Upload Solutions @ [ad_system_name]"]
+
+<h2>Upload Solutions for $file_name</h2>
+
+[ad_context_bar_ws_or_index [list "../one.tcl" "$class_name Home"] [list "" "Administration"] "Upload $task_type_caps Solutions"]
+
+<hr>
+
+<blockquote>
+
+<form enctype=multipart/form-data method=POST action=\"$target_url\">
+<table>
+[export_form_vars return_url file_id task_id file_title version_id parent_id]
+
+[edu_file_upload_widget $db $class_id $task_type_plural $read_permission_default $write_permission_default]
+
+<tr>
+<td colspan=2 align=center>
+<br>
+<input type=submit value=\"Upload Solutions\">
+</td>
+</tr>
+</table>
+
+</form>
+
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
Index: web/openacs/www/education/class/admin/syllabus-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/syllabus-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/syllabus-edit-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,51 @@
+#
+# /www/education/class/admin/syllabus-edit-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu
+#
+# this page update the class_info table to reflect the new syllabus
+#
+
+ad_page_variables {
+    file_id
+}
+
+validate_integer file_id $file_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Edit Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+# make sure the person has permission to edit the syllabus
+
+set version_id [database_to_tcl_string $db "select version_id from fs_versions_latest where file_id = $file_id"]
+
+if {! [fs_check_write_p $db $user_id $version_id $class_id]} {
+    incr exception_count
+    append exception_text "<li>You can't write into this file"
+}
+
+
+# the file upload has already been taken care of by either
+# upload-new.tcl or upload-version.tcl
+
+ns_db dml $db "update edu_class_info 
+               set syllabus_id = $file_id, 
+  	           last_modified = sysdate(),
+                   last_modifying_user = $user_id,
+                   modified_ip_address = '[ns_conn peeraddr]'                       
+             where group_id = $class_id"
+
+ns_db releasehandle $db
+
+ns_returnredirect ""
+
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/syllabus-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/syllabus-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/syllabus-edit.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,104 @@
+#
+# /www/education/class/admin/syllabus-edit.tcl
+#
+# by randy@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this allows you to select a file to be uploaded as the syllabus
+#
+# syllabus-edit.tcl,v 1.1.2.2 2000/03/16 06:20:32 aure Exp
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Edit Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+set selection [ns_db 0or1row $db "
+                   select version_id, 
+                          file_extension,
+                          file_id,
+                          url
+                     from fs_versions_latest, 
+                          edu_classes 
+                    where file_id = syllabus_id 
+                      and class_id = $class_id"] 
+
+if {$selection != ""} {
+    set_variables_after_query
+    set current_syllabus_string "View the <a href=\"/file-storage/download/syllabus.$file_extension?version_id=$version_id\">Current Syllabus</a><Br><Br>"
+    set target_url "upload-version.tcl"
+} else {
+    set current_syllabus_string ""
+    # since there is not already a file_id for the syllabus, generate one
+    set file_id [database_to_tcl_string $db "select fs_file_id_seq.nextval from dual"]
+    set target_url "upload-new.tcl"
+}
+
+
+set return_url "syllabus-edit-2.tcl?file_id=$file_id"
+set read_permission ""
+set write_permission ta
+set file_title Syllabus
+
+
+# lets get the version_id
+
+set version_id [database_to_tcl_string $db "select fs_version_id_seq.nextval from dual"]
+
+set parent_id [database_to_tcl_string $db "select handouts_folder_id from edu_classes where class_id = $class_id"]
+
+ns_db releasehandle $db
+
+set version_description ""
+
+set return_string "
+[ad_header "Class Syllabus @ [ad_system_name]"]
+
+<h2>Upload Class Syllabus</h2>
+
+[ad_context_bar_ws [list "../one.tcl" "$class_name"] [list "" "Administration"] "Upload Class Syllabus"]
+
+<hr>
+<blockquote>
+$current_syllabus_string
+
+<form enctype=multipart/form-data method=POST action=\"$target_url\">
+
+[export_form_vars file_id version_id read_permission write_permission return_url file_title parent_id version_description]
+
+Upload a New Syllabus:
+<br><br>
+
+URL: &nbsp &nbsp <input type=input name=url size=40>
+<Br><br>
+ - <i>or</i> -
+<br><Br>
+File Name:
+
+[ad_space]
+
+<input type=file name=upload_file size=20>
+<Br><FONT SIZE=-1>Use the \"Browse...\" button to locate your file, then click \"Open\".
+</FONT>
+
+<br><Br>
+
+<input type=submit value=\"Upload\">
+
+</blockquote>
+[ad_footer]
+"
+
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/task-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/task-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/task-add-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,201 @@
+#
+# /www/education/class/admin/task-add-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu
+#
+# this file displays a confirmation page for the user to review the
+# information they have just entered.
+# 
+
+ad_page_variables {
+    task_name
+    {description ""}
+    task_type
+    {ColValue.due%5fdate.day ""}
+    {ColValue.due%5fdate.month ""}
+    {ColValue.due%5fdate.year ""}
+    {weight ""}
+    {grade_id ""}
+    {requires_grade_p f}
+    {electronic_submission_p f}
+}    
+
+validate_integer_or_null grade_id $grade_id
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Add Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+# check the input
+
+set exception_text ""
+set exception_count 0
+
+
+# put together due_date, and do error checking
+
+set form [ns_getform]
+
+# ns_dbformvalue $form due_date date due_date will give an error
+# message if the day of the month is 08 or 09 (this octal number problem
+# we've had in other places).  So I'll have to trim the leading zeros
+# from ColValue.due%5fdate.day and stick the new value into the $form
+# ns_set.
+
+set "ColValue.due%5fdate.day" [string trimleft [set ColValue.due%5fdate.day] "0"]
+ns_set update $form "ColValue.due%5fdate.day" [set ColValue.due%5fdate.day]
+
+if [catch  { ns_dbformvalue $form due_date date due_date} errmsg ] {
+    incr exception_count
+    append exception_text "<li>The date was specified in the wrong format.  The date should be in the format Month DD YYYY.\n"
+} elseif { [string length [set ColValue.due%5fdate.year]] != 4 } {
+    incr exception_count
+    append exception_text "<li>The year needs to contain 4 digits.\n"
+} 
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+# generate the task_id here so that we avoid a double click error
+set task_id [database_to_tcl_string $db "select edu_task_sequence.nextval from dual"]
+
+
+if {[empty_string_p $due_date]} {
+    set date_string None
+} else {
+    set date_string [util_AnsiDatetoPrettyDate $due_date]
+}
+
+    
+
+if {[string compare $task_type project] == 0} {
+    set header "Add a Project"
+} elseif {[string compare $task_type assignment] == 0} {
+    set header "Add an Assignment"
+} else {
+    set header "Add Exam"
+}
+
+
+
+set return_string "
+[ad_header "$header @ [ad_system_name]"]
+
+<h2>$header</h2>
+
+[ad_context_bar_ws_or_index [list "../one.tcl" "$class_name Home"] [list "" "Administration"] "$header"]
+
+<hr>
+<blockquote>
+
+Please review the information you have entered.  You will be given an
+opportunity to upload an associated file once you add the $task_type.
+
+<form method=post action=\"task-add-3.tcl\">
+[export_form_vars task_name description due_date weight grade_id requires_grade_p electronic_submission_p task_id task_type]
+
+<table BORDER=0>
+
+<tr>
+<th valign=top align=right> [capitalize $task_type] Name: </td>
+<td valign=top>
+$task_name
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Description: </td>
+<td valign=top>
+[edu_maybe_display_text $description]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Due Date: </td>
+<td valign=top>
+$date_string
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right>Will this $task_type<br>be graded? </td>
+<td valign=top>
+[util_PrettyBoolean $requires_grade_p]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Fraction of [capitalize $task_type] Grade: </td>
+<td valign=top>
+"
+
+if {[empty_string_p $weight]} {
+    append return_string "N/A"
+} else {
+    append return_string "$weight"
+}
+
+append return_string "
+</td>
+</tr>
+"
+
+if {[empty_string_p $grade_id]} {
+    set selection ""
+} else {
+    set selection [ns_db 0or1row $db "select grade_name, weight from edu_grades where grade_id=$grade_id"]
+}
+
+if {$selection!=""} {
+    set_variables_after_query
+    set weight [expr round([expr $weight*100])]
+} else {
+    set grade_name ""
+    set weight ""
+}
+
+
+append return_string "
+<tr><th valign=top align=right>Grde Policy Group</th>
+<td>[edu_maybe_display_text $grade_name] [ec_decode $weight "" "" "- $weight"]</td>
+<tr>
+<th valign=top align=right> 
+Online submission?
+</th>
+<td valign=top>
+[util_PrettyBoolean $electronic_submission_p]
+</font>
+</td>
+</tr>
+<tr>
+<td colspan=2 align=center>
+<br>
+<input type=submit value=\"Add [capitalize $task_type]\">
+</td>
+</tr>
+</table>
+
+</form>
+
+<p>
+
+</blockquote>
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
Index: web/openacs/www/education/class/admin/task-add-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/task-add-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/task-add-3.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,149 @@
+#
+# /www/education/class/admin/task-add-3.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu
+#
+# this file displays a confirmation page for the user to review the
+# information they have just entered.
+#
+
+ad_page_variables {
+    task_type
+    task_name
+    {description ""}
+    {due_date ""}
+    task_id
+    {weight ""}
+    {grade_id ""}
+    {requires_grade_p f}
+    {electronic_submission_p f}
+    {return_url ""}
+}    
+
+validate_integer task_id $task_id
+validate_integer_or_null grade_id $grade_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Add Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set task_type_plural "[set task_type]s"
+
+set file_id [database_to_tcl_string $db "select fs_file_id_seq.nextval from dual"]
+
+set version_id [database_to_tcl_string $db "select fs_version_id_seq.nextval from dual"]
+
+set parent_id [database_to_tcl_string $db "select [set task_type_plural]_folder_id from edu_classes where class_id = $class_id"]
+
+set return_url "task-add-4.tcl?[export_url_vars file_id task_id]"
+
+set file_title "$task_name"
+
+# make this a general link to task-info.tcl?
+if {[string compare $task_type project] == 0} {
+    set link "project-info.tcl?project_id=$task_id"
+} else {
+    set link "${task_type}-info.tcl?${task_type}_id=$task_id"
+}
+
+if {![empty_string_p $grade_id]} {
+    set grade_insert "grade_id, "
+    set grade_value "$grade_id,"
+} else {
+    set grade_insert ""
+    set grade_value ""
+}
+
+if {[database_to_tcl_string $db "select count(task_id) from edu_student_tasks where task_id = $task_id"] == 0} {
+    
+
+    if {![empty_string_p $grade_id]} {
+	set grade_insert "grade_id, "
+	set grade_value "$grade_id,"
+    } else {
+	set grade_insert ""
+	set grade_value ""
+    }
+
+   ns_db dml $db "insert into edu_student_tasks (
+               task_id,
+               class_id,
+               assigned_by,
+               task_type,
+               task_name,
+               description,
+               date_assigned,
+               last_modified,
+               due_date,
+               weight,
+               $grade_insert
+               online_p,
+               file_id,
+               requires_grade_p)
+           values (
+               $task_id,
+               $class_id,
+               $user_id,
+               '$task_type',
+               [ns_dbquotevalue $task_name],
+               [ns_dbquotevalue $description],
+               sysdate(),
+               sysdate(),
+               timestamp(sysdate() + 7),
+               '$weight',
+               $grade_value
+               '$electronic_submission_p',
+               NULL,
+               '$requires_grade_p')"
+
+}
+
+
+set return_string "
+[ad_header "[capitalize $task_type] Added"]
+
+<h2>[capitalize $task_type] Added</h2>
+
+[ad_context_bar_ws_or_index [list "../one.tcl" "$class_name Home"] [list "" "Administration"] "[capitalize $task_type] Added"]
+
+<hr>
+
+You can now attach a file to the $task_type. Or <a
+href=\"\">return to the index page</a>.  This file can be a
+document, a photograph, or anything else on your computer.
+
+<form enctype=multipart/form-data method=POST action=\"upload-new.tcl\">
+[export_form_vars task_id task_type file_id version_id file_title return_url parent_id return_url]
+<blockquote>
+<table>
+[edu_file_upload_widget $db $class_id $task_type_plural "" [edu_get_ta_role_string]]
+</table>
+<p>
+<center>
+Uploading a new file may take a while. Please be patient.
+<p>
+<input type=submit value=\"Submit File\">
+</center>
+</blockquote>
+</form>
+
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/task-add-4.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/task-add-4.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/task-add-4.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,41 @@
+#
+# /www/education/class/admin/task-add-4.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu
+#
+# this file updates the edu_student_tasks table to reflect the uploaded file
+# (aileen@mit.edu) - notice we don't insert until this last page - this is
+# to protect against users backing up in previous pages b/c the file stuff 
+# we do there isn't 100% fool-proof. so we update our tables here after we are
+# sure that the file insert were completed w/o error 
+
+ad_page_variables {
+    file_id
+    task_id
+    {return_url ""}
+}    
+
+validate_integer file_id $file_id
+validate_integer task_id $task_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Add Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+# lets make sure the task belongs to this class
+if {[database_to_tcl_string $db "select count(task_id) from edu_student_tasks where task_id = $task_id and class_id = $class_id"] == 0} {
+    ad_return_compalint 1 "<li>You are not authorized to edit this task."
+    return
+}
+
+ns_db dml $db "update edu_student_tasks set file_id = $file_id where task_id = $task_id"
+
+ns_db releasehandle $db
+
+ns_returnredirect $return_url
+
+
+
Index: web/openacs/www/education/class/admin/task-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/task-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/task-add.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,137 @@
+#
+# /www/education/class/admin/task-add.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January, 2000
+#
+# this page is where teachers can go to issue tasks (assignments or projects)
+# basically, they are able to upload a file/url into the file storage
+# system and then associate a due date with it.
+#
+
+ad_page_variables {
+    {task_type assignment}
+}
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Add Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+if {[string compare $task_type project] == 0} {
+    set header "Add a Project"
+} elseif {[string compare $task_type assignment] == 0} {
+    set header "Add an Assignment"
+} else {
+    set header "Add an Exam"
+}
+
+
+
+set return_string "
+[ad_header "$header @ [ad_system_name]"]
+
+<h2>$header</h2>
+
+[ad_context_bar_ws_or_index [list "../one.tcl" "$class_name Home"] [list "" "Administration"] "$header"]
+
+<hr>
+
+<blockquote>
+
+
+<form method=post action=\"task-add-2.tcl\">
+[export_form_vars task_type]
+<table>
+<tr>
+<th align=right> [capitalize $task_type] Name: </td>
+<td valign=top>
+<input type=text size=30 maxsize=100 name=task_name>
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Description: </td>
+<td valign=top>
+[edu_textarea description "" 50 6]
+</td>
+</tr>
+
+<tr>
+<th align=right> Due Date: </td>
+<td valign=top>
+[ad_dateentrywidget due_date [database_to_tcl_string $db "select sysdate() + 14 from dual"]]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right>Will this $task_type<br>be graded? </td>
+<td valign=top>
+<input type=radio name=requires_grade_p checked value=t> Yes
+<input type=radio name=requires_grade_p value=f> No
+</tr>
+
+<tr>
+<th  align=right>Fraction of [capitalize $task_type] Grades: </td>
+<td valign=top>
+<input type=text size=5 maxsize=10 name=weight>\% 
+</td>
+</tr>
+<tr>
+<th align=right>Grade Policy Group</th>
+<td valign=top>
+<select name=grade_id>
+<option value=\"\">None
+"
+
+set selection [ns_db select $db "select grade_name, weight, grade_id from edu_grades where class_id=$class_id order by grade_name"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    append return_string "
+    <option value=$grade_id>$grade_name -$weight\%"
+}
+
+append return_string "
+</select>
+</td>
+</tr>
+<tr>
+<th valign=top align=right> 
+Will students submit <br>
+answers electronically?
+</td>
+<td valign=top>
+<input type=radio name=electronic_submission_p value=t> Yes
+<input type=radio name=electronic_submission_p checked value=f> No
+</font>
+</td>
+</tr>
+
+</td>
+</tr>
+<tr>
+<td colspan=2 align=center>
+<br>
+<input type=submit value=\"Continue\">
+</td>
+</tr>
+</table>
+
+</form>
+
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
Index: web/openacs/www/education/class/admin/task-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/task-delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/task-delete-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,44 @@
+#
+# /www/education/class/admin/task-delete-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, February 2000
+#
+# this page marks a task as inactive
+#
+
+
+ad_page_variables {
+    task_id
+    {return_url ""}
+}
+
+validate_integer task_id $task_id
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Delete Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+# lets make sure that the task belongs to this class.  If it does not,
+# let the user know that the input is not valid
+
+set valid_id_p [database_to_tcl_string $db "select count(task_id) from edu_student_tasks where task_id = $task_id and class_id = $class_id"]
+
+if {$valid_id_p == 0} {
+    ad_return_complaint 1 "<li>The task that you have requested be delelted does not belong to this class."
+    return
+}
+
+
+ns_db dml $db "update edu_student_tasks set active_p = 'f' where task_id = $task_id"
+
+ns_db releasehandle $db
+
+ns_returnredirect $return_url
Index: web/openacs/www/education/class/admin/task-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/task-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/task-delete.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,140 @@
+#
+# /www/education/class/admin/task-delete.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page is where teachers can go to edit assignments (or projects).
+# basically, they are able to upload a file/url into the file storage
+# system and then associate a due date with it.
+#
+
+ad_page_variables {
+    task_id
+    task_type
+    {return_url ""}
+}
+
+validate_integer task_id $task_id
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Delete Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+if {[empty_string_p $task_id] || [empty_string_p $task_type]} {
+    ad_return_complaint 1 "<li>You must include a task to edit."
+    return
+}
+
+set selection [ns_db 0or1row $db "select first_names as teacher_first_name,
+                            last_name as teacher_last_name,
+                            task_name,
+                            description,
+                            date_assigned,
+                            last_modified,
+                            due_date,
+                            edu_student_tasks.file_id,
+                            weight,
+                            grade_id,
+                            online_p,
+                            requires_grade_p
+                       from edu_student_tasks, 
+                            users
+                      where task_id = $task_id
+                        and class_id = $class_id
+                        and assigned_by = users.user_id"]
+
+if { $selection == "" } {
+    ad_return_complaint 1 "<li> The $task_type id you have provided does not exist.  Please check your identification number and try again."
+    return
+} else {
+    set_variables_after_query
+}
+
+
+set return_string "
+[ad_header "Delete [capitalize $task_type] @ [ad_system_name]"]
+
+<h2>Delete [capitalize $task_type]</h2>
+
+[ad_context_bar_ws_or_index [list "../one.tcl" "$class_name Home"] [list "" "Administration"] "Delete [capitalize $task_type]"]
+
+<hr>
+
+This $task_type was submitted by 
+$teacher_first_name $teacher_last_name on 
+[util_AnsiDatetoPrettyDate $date_assigned].  It was last 
+updated on [util_AnsiDatetoPrettyDate $last_modified].<br><br>
+
+<blockquote>
+
+<form method=POST action=\"task-delete-2.tcl\">
+
+[export_form_vars return_url file_id task_type task_id]
+
+<table>
+<tr>
+<th valign=top align=right> [capitalize $task_type] Name: </td>
+<td valign=top>
+$task_name
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Description: </td>
+<td valign=top>
+[edu_maybe_display_text $description]
+</td>
+</tr>
+
+<tr>
+<th align=right> Due Date: </td>
+<td valign=top>
+[util_AnsiDatetoPrettyDate $due_date]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right>Will this $task_type<br>be graded? </td>
+<td valign=top>
+[util_PrettyBoolean $requires_grade_p]
+<tr>
+<th align=right> Fraction of [capitalize $task_type] Grade: </td>
+<td valign=top>
+$weight \%
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> 
+Will students submit <br>
+answers electronically?
+</td>
+<td valign=top>
+[util_PrettyBoolean $online_p]
+</td>
+</tr>
+<tr>
+<td colspan=2 align=center>
+<br>
+<input type=submit value=\"Delete [capitalize $task_type]\">
+</td>
+</tr>
+</table>
+
+</form>
+
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
Index: web/openacs/www/education/class/admin/task-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/task-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/task-edit-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,132 @@
+#
+# /www/education/class/admin/task-edit-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page updates the information about the given task
+#
+
+ad_page_variables {
+    task_id
+    task_type
+    task_name
+    {return_url ""}
+    {grade_id ""}
+    {description ""}
+    {weight ""}
+    {ColValue.due%5fdate.day ""}
+    {ColValue.due%5fdate.month ""}
+    {ColValue.due%5fdate.year ""}
+    online_p
+    requires_grade_p
+}
+
+validate_integer task_id $task_id
+validate_integer_or_null grade_id $grade_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Edit Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+# check the user input first
+
+set exception_text ""
+set exception_count 0
+
+if {[empty_string_p $task_name]} {
+    append exception_text "<li>You must provide a name for this task."
+    incr exception_count
+}
+
+
+# lets make sure that the passed in task belongs to this class
+
+if {[database_to_tcl_string $db "select count(task_id) from edu_student_tasks where task_id = $task_id and class_id = $class_id"] == 0} {
+    incr exception_count
+    append exception_text "<li>The task you are trying to edit does not belong to this class."
+}
+
+
+# put together due_date, and do error checking
+
+set form [ns_getform]
+
+# ns_dbformvalue $form due_date date due_date will give an error
+# message if the day of the month is 08 or 09 (this octal number problem
+# we've had in other places).  So I'll have to trim the leading zeros
+# from ColValue.due%5fdate.day and stick the new value into the $form
+# ns_set.
+
+set "ColValue.due%5fdate.day" [string trimleft [set ColValue.due%5fdate.day] "0"]
+ns_set update $form "ColValue.due%5fdate.day" [set ColValue.due%5fdate.day]
+
+if [catch  { ns_dbformvalue $form due_date date due_date} errmsg ] {
+    incr exception_count
+    append exception_text "<li>The date was specified in the wrong format.  The date should be in the format Month DD YYYY.\n"
+} elseif { [string length [set ColValue.due%5fdate.year]] != 4 } {
+    incr exception_count
+    append exception_text "<li>The year needs to contain 4 digits.\n"
+} elseif {[database_to_tcl_string $db "select date_part('day',trunc(sysdate()) - to_date('$due_date','YYYY-MM-DD')) from dual"] > 1} {
+    incr exception_count
+    append exception_text "<li>The due date must be in the future."
+}
+
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+
+if {![info exists return_url] || [empty_string_p $return_url]} {
+    set return_url ""
+}
+
+
+###########################################
+#                                         #
+# Permissions and Input have been checked #
+# set up the tasks update           #
+#                                         #
+###########################################
+
+
+
+set task_sql "update edu_student_tasks
+           set assigned_by = $user_id,
+               task_name = [ns_dbquotevalue $task_name],
+               description = [ns_dbquotevalue $description],
+               last_modified = sysdate(),
+               due_date = '$due_date',
+               weight = [ns_dbquotevalue $weight],
+               grade_id='$grade_id',
+               online_p = '$online_p',
+               requires_grade_p = '$requires_grade_p'
+         where task_id = $task_id"
+
+if {[catch { ns_db dml $db "begin transaction"
+ns_db dml $db $task_sql 
+ns_db dml $db "end transaction" } errmsg] } {
+    # insert failed; let's see if it was because of duplicate submission
+    ns_log Error "[edu_url]class/admin/task-edit-2.tcl choked:  $errmsg"
+    ad_return_error "Insert Failed" "The Database did not like what you typed.  This is probably a bug in our code.  Here's what the database said:
+    <blockquote>
+    <pre>
+    $errmsg
+    </pre>
+    </blockquote>
+    "
+    return
+}
+
+ns_db releasehandle $db
+
+# the updates went as planned so redirect
+ns_returnredirect $return_url
+
+
+
Index: web/openacs/www/education/class/admin/task-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/task-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/task-edit.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,195 @@
+#
+# /www/education/class/admin/task-edit.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page is where teachers can go to edit assignments (or projects).
+# basically, they are able to upload a file/url into the file storage
+# system and then associate a due date with it.
+#
+
+ad_page_variables {
+    task_id
+    task_type
+    {return_url ""}
+}
+
+validate_integer task_id $task_id
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Edit Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+if {[empty_string_p $task_id] || [empty_string_p $task_type]} {
+    ad_return_complaint 1 "<li>You must include a task to edit."
+    return
+}
+
+set selection [ns_db 0or1row $db "select first_names as teacher_first_name,
+                            last_name as teacher_last_name,
+                            task_name,
+                            description,
+                            date_assigned,
+                            last_modified,
+                            due_date,
+                            edu_student_tasks.file_id,
+                            weight,
+                            grade_id,
+                            online_p,
+                            requires_grade_p
+                       from edu_student_tasks, 
+                            users
+                      where task_id = $task_id
+                        and class_id = $class_id
+                        and assigned_by = users.user_id"]
+
+if { $selection == "" } {
+    ad_return_complaint 1 "<li> The $task_type id you have provided does not exist.  Please check your identification number and try again."
+    return
+} else {
+    set_variables_after_query
+}
+
+
+set return_string "
+[ad_header "Edit [capitalize $task_type] @ [ad_system_name]"]
+
+<h2>Edit [capitalize $task_type]</h2>
+
+[ad_context_bar_ws_or_index [list "../one.tcl" "$class_name Home"] [list "" "Administration"] "Edit [capitalize $task_type]"]
+
+<hr>
+
+This $task_type was submitted by 
+$teacher_first_name $teacher_last_name on 
+[util_AnsiDatetoPrettyDate $date_assigned].  It was last 
+updated on [util_AnsiDatetoPrettyDate $last_modified].<br><br>
+
+<blockquote>
+
+<form method=POST action=\"task-edit-2.tcl\">
+[export_form_vars return_url file_id task_type task_id]
+
+<table>
+<tr>
+<th valign=top align=right> [capitalize $task_type] Name: </td>
+<td valign=top>
+<input type=text size=30 maxsize=100 name=task_name value=\"[philg_quote_double_quotes $task_name]\">
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Description: </td>
+<td valign=top>
+[edu_textarea description $description 40 4]
+</td>
+</tr>
+
+<tr>
+<th align=right> Due Date: </td>
+<td valign=top>
+[ad_dateentrywidget due_date [database_to_tcl_string $db "select date(sysdate() + 14) from dual"]]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right>Will this $task_type<br>be graded? </td>
+<td valign=top>
+"
+
+if {[string compare $requires_grade_p t] == 0} {
+    append return_string "
+    <input type=radio name=requires_grade_p checked value=t> Yes
+    <input type=radio name=requires_grade_p value=f> No
+    "
+} else {
+    append return_string "
+    <input type=radio name=requires_grade_p value=t> Yes
+    <input type=radio name=requires_grade_p checked value=f> No
+    "
+}
+
+append return_string "
+<tr>
+<th align=right> Fraction of [capitalize $task_type] Grade: </td>
+<td valign=top>
+<input type=text size=5 maxsize=10 name=weight value=\"$weight\"> \%
+<font size=-1>
+(This should be a number between 0 and 100)
+</font>
+</td>
+</tr>
+<tr>
+<th align=right>Grade Policy Group</th>
+<td valign=top>
+<select name=grade_id>
+<option value=\"\">None
+"
+
+set selection [ns_db select $db "select grade_name, weight, grade_id as select_grade_id from edu_grades where class_id=$class_id order by grade_name"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    
+    append return_string "
+    <option value=$select_grade_id"
+    
+    if {$grade_id==$select_grade_id} {
+	append return_string " selected"
+    }
+    append return_string "
+    >$grade_name - $weight\%"
+}
+
+
+append return_string "
+</select>
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> 
+Will students submit <br>
+answers electronically?
+</td>
+<td valign=top>
+"
+
+if {[string compare $online_p t] == 0} {
+    append return_string "
+    <input type=radio name=online_p checked value=t> Yes
+    <input type=radio name=online_p value=f> No
+    "
+} else {
+    append return_string "
+    <input type=radio name=online_p value=t> Yes
+    <input type=radio name=online_p checked value=f> No
+    "
+}
+
+append return_string "
+<tr>
+<td colspan=2 align=center>
+<br>
+<input type=submit value=\"Edit [capitalize $task_type]\">
+</td>
+</tr>
+</table>
+
+</form>
+
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
Index: web/openacs/www/education/class/admin/task-file-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/task-file-new.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/task-file-new.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,190 @@
+#
+# /www/education/class/admin/task-file-new.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu
+#
+# this file allows a user to upload a new file for an existing task
+#
+
+ad_page_variables {
+    task_id
+    task_type
+    {return_url ""}
+}    
+
+validate_integer task_id $task_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Edit Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set sql "\
+select task_name as file_title,
+               ver.file_id,
+               assignments_folder_id as parent_id,
+               version_id
+          from edu_classes,
+               edu_student_tasks,
+               fs_versions_latest ver
+         where edu_classes.class_id = $class_id
+           and edu_student_tasks.class_id = edu_classes.class_id
+           and task_id = $task_id
+           and edu_student_tasks.file_id = ver.file_id
+union
+select task_name as file_title,
+               NULL::integer as file_id,
+               assignments_folder_id as parent_id,
+               NULL::integer as version_id
+          from edu_classes,
+               edu_student_tasks
+         where edu_classes.class_id = $class_id
+           and edu_student_tasks.class_id = edu_classes.class_id
+           and task_id = $task_id
+           and not exists (select 1 from fs_versions_latest 
+                           where file_id = edu_student_tasks.file_id)"
+
+set selection [ns_db 0or1row $db $sql]
+
+if {$selection == ""} {
+    ad_return_complaint 1 "<li>The $task_type you have requested to edit does not belong to this class."
+    return
+} else {
+    set_variables_after_query
+}
+
+
+# in order to determine the defaults for the permissions, we want to see if there
+# is already a file for the assignment (or project).  If so, we want to use 
+# those as the default
+
+
+if {[empty_string_p $version_id]} {
+    set write_permission_default [edu_get_ta_role_string]
+    set read_permission_default ""
+} else {
+    # lets make sure that they can edit the file
+    if {![fs_check_edit_p $db $user_id $version_id $class_id]} {
+	ad_return_complaint 1 "<li>You are not authorized to edit this file."
+	return
+    }
+
+    # more often than not, the scope is going to be group_role so lets
+    # try that one first
+    set read_permission_default_list [database_to_tcl_list $db "select gp.role
+        from general_permissions gp,
+             edu_role_pretty_role_map map
+       where on_what_id = $version_id
+         and lower(on_which_table) = lower('FS_VERSIONS')
+         and scope = 'group_role'
+         and gp.group_id = $class_id
+         and permission_type = 'read'
+         and gp.group_id = map.group_id
+         and lower(gp.role) = lower(map.role)
+       order by priority desc"]
+
+    # we want the highest numerical priority so lets just grab the first element
+    set read_permission_default [lindex $read_permission_default_list 0]
+    if {[empty_string_p $read_permission_default]} {
+	# if there is not a group_role item, we just set our normal default
+	# read role of ""
+	set read_permission_default ""
+    }
+
+
+    # now, we want to set our default write permissions and we do pretty much
+    # the same thing as when we did the read permissions.
+
+    set write_permission_default_list [database_to_tcl_list $db "select gp.role
+        from general_permissions gp,
+             edu_role_pretty_role_map map
+       where on_what_id = $version_id
+         and lower(on_which_table) = lower('FS_VERSIONS')
+         and scope = 'group_role'
+         and gp.group_id = $class_id
+         and permission_type = 'write'
+         and gp.group_id = map.group_id
+         and lower(gp.role) = lower(map.role)
+       order by priority desc"]
+
+    # we want the highest numerical priority so lets just grab the first element
+    set write_permission_default [lindex $write_permission_default_list 0]
+    if {[empty_string_p $write_permission_default]} {
+	# there was not a group_role so lets check if it is public
+	set write_permission_public_p [database_to_tcl_string_or_null $db "select (case when public_permission_id('write', $version_id, 'FS_VERSIONS') = 0 then 0 else 1 end) from dual"]
+	if {$write_permission_public_p == 0} {
+	    # if write_permisssion_public_p is 0 then there is not a correct permissions
+	    # record so we go to our usual default of ta
+	    set write_permission_default [edu_get_ta_role_string]
+	} 
+    }
+}
+
+	
+
+if {[empty_string_p $file_id]} {
+    set target_url "upload-new.tcl"
+    set file_id [database_to_tcl_string $db "select fs_file_id_seq.nextval from dual"]
+    set parent_id [database_to_tcl_string $db "select ${task_type}s_folder_id from edu_classes where class_id = $class_id"]
+    if {![empty_string_p $return_url]} {
+	set return_url "task-add-4.tcl?task_id=$task_id&file_id=$file_id&[export_url_vars return_url]"
+    }
+} else {
+    set target_url "upload-version.tcl"
+}
+
+if {[empty_string_p $return_url]} {
+    set return_url "[edu_url]/class/admin/task-add-4.tcl?task_id=$task_id&file_id=$file_id"
+} 
+
+
+set version_id [database_to_tcl_string $db "select fs_version_id_seq.nextval from dual"]
+
+
+set return_string "
+[ad_header "Add [capitalize $task_type] File @ [ad_system_name]"]
+
+<h2>Add a File for the [capitalize $task_type]</h2>
+
+[ad_context_bar_ws_or_index [list "../one.tcl" "$class_name Home"] [list "" "Administration"] "Add File for [capitalize $task_type]"]
+
+<hr>
+
+Upload a new file for $file_title.
+
+<form enctype=multipart/form-data method=POST action=\"$target_url\">
+[export_form_vars task_id task_type file_id version_id file_title return_url parent_id]
+<blockquote>
+<table>
+[edu_file_upload_widget $db $class_id assignments $read_permission_default $write_permission_default]
+</table>
+<p>
+<center>
+Uploading a new file may take a while. Please be patient.
+<p>
+<input type=submit value=\"Submit File\">
+</center>
+</blockquote>
+</form>
+
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/handouts/add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/handouts/add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/handouts/add-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,320 @@
+# 
+# /www/education/class/admin/handouts/add-.tcl
+#
+# this is almost identical to the page /education/util/upload-new.tcl
+# there are a few changes that allow an an insert into edu_handouts to
+# occur.  There is an extra insert at the bottom of the page and then
+# it takes (and checks) some extra arguments in the ad_page_variables
+#
+# revised by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+
+
+ad_page_variables {
+    {upload_file ""}
+    {url ""}
+    file_title
+    file_id
+    version_id
+    parent_id
+    type
+    handout_id
+    {ColValue.distribution%5fdate.year ""}
+    {ColValue.distribution%5fdate.day ""}
+    {ColValue.distribution%5fdate.month ""}
+    {write_permission ta}
+    {read_permission ""}
+    {version_description ""}
+    {return_url ""}
+}
+
+validate_integer file_id $file_id
+validate_integer version_id $version_id
+validate_integer parent_id $parent_id
+validate_integer handout_id $handout_id
+
+# either the upload file or the url must be not null and the other one must be null
+
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Add Tasks"]
+set user_id [lindex $id_list 0]
+set group_id [lindex $id_list 1]
+set group_name [lindex $id_list 2]
+
+
+# check the user input first
+
+set exception_text ""
+set exception_count 0
+
+
+if {[empty_string_p $url] && (![info exists upload_file] || [empty_string_p $upload_file])} {
+    append exception_text "<li>You need to upload a file or enter a URL\n"
+    incr exception_count
+}
+
+if {![empty_string_p $url] && ![empty_string_p $upload_file]} {
+    append exception_text "<li>You can not both add a url and upload a file"
+    incr exception_count
+}
+
+
+if {[empty_string_p $file_title]} {
+    incr exception_count
+    append exception_text "<li>You must include a title for this file."
+}
+
+
+# put together due_date, and do error checking
+
+set form [ns_getform]
+
+# ns_dbformvalue $form due_date date due_date will give an error
+# message if the day of the month is 08 or 09 (this octal number problem
+# we've had in other places).  So I'll have to trim the leading zeros
+# from ColValue.due%5fdate.day and stick the new value into the $form
+# ns_set.
+
+set "ColValue.distribution%5fdate.day" [string trimleft [set ColValue.distribution%5fdate.day] "0"]
+ns_set update $form "ColValue.distribution%5fdate.day" [set ColValue.distribution%5fdate.day]
+
+if [catch  { ns_dbformvalue $form distribution_date date distribution_date} errmsg ] {
+    incr exception_count
+    append exception_text "<li>The date was specified in the wrong format.  The date should be in the format Month DD YYYY.\n"
+} elseif { [string length [set ColValue.distribution%5fdate.year]] != 4 } {
+    incr exception_count
+    append exception_text "<li>The year needs to contain 4 digits.\n"
+} 
+
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+
+if {[database_to_tcl_string $db "select count(version_id) from fs_versions where version_id = $version_id"] > 0 || [database_to_tcl_string $db "select count(file_id) from fs_files where file_id = $file_id"] > 0} {
+    # this was a double click
+    ns_returnredirect $return_url
+    return
+}
+
+
+# set the variables that are the same for all
+
+set public_p f
+
+
+if [empty_string_p $url] {
+
+    # get the file from the user.
+    # number_of_bytes is the upper-limit
+    set max_n_bytes [ad_parameter MaxNumberOfBytes fs]
+    
+    set tmp_filename [ns_queryget upload_file.tmpfile]
+    set version_content [read [open $tmp_filename] $max_n_bytes]
+    
+    set file_extension [string tolower [file extension $upload_file]]
+    # remove the first . from the file extension
+    regsub "\." $file_extension "" file_extension
+    
+    set guessed_file_type [ns_guesstype $upload_file]
+    
+    set n_bytes [file size $tmp_filename]
+    
+    # strip off the C:\directories... crud and just get the file name
+    if ![regexp {([^//\\]+)$} $upload_file match client_filename] {
+	# couldn't find a match
+	set client_filename $upload_file
+    }
+    
+    ns_db dml $db "begin transaction"
+
+    set lob_id [database_to_tcl_string $db "select empty_lob()"]
+
+    set file_insert "insert into fs_files
+    (file_id, file_title, owner_id, parent_id, sort_key, depth, group_id, public_p)
+    values
+    ($file_id, [ns_dbquotevalue $file_title], $user_id, [ns_dbquotevalue $parent_id],0,0, $group_id, '$public_p')
+    "
+    
+    set version_insert "insert into fs_versions
+    (version_id, file_id, version_description, creation_date, author_id, client_file_name, file_type, file_extension, n_bytes, lob)
+    values
+    ($version_id, $file_id, [ns_dbquotevalue $version_description], sysdate(), $user_id, '[DoubleApos $client_filename]', '$guessed_file_type', '$file_extension', $n_bytes, $lob_id)" 
+    
+    if {[catch { ns_db dml $db $file_insert } errmsg] } {
+         # insert failed; let's see if it was because of duplicate submission
+         if { [database_to_tcl_string $db "select count(*) from fs_files where file_id = $file_id"] == 0 } {
+	     ns_log Error "[edu_url]group/admin/upload-new.tcl choked:  $errmsg"
+	     ad_return_error "Insert Failed" "The Database did not like what you typed.  This is probably a bug in our code.  Here's what the database said:
+	     <blockquote>
+	     <pre>
+	     $errmsg
+	     </pre>
+	     </blockquote>
+	     "
+             return
+         }
+         ns_db dml $db "abort transaction"
+	 # we don't bother to handle the cases where there is a dupe 
+	 # submission because the user should be thanked or 
+	 # redirected anyway
+	 ns_returnredirect $return_url
+    }
+     
+    ns_db dml $db $version_insert
+
+    # don't need double-click protection here since we already did 
+    # that for previous statement
+    ns_pg blob_dml_file $db $lob_id $tmp_filename
+    
+} else {
+
+    set file_insert "insert into fs_files
+    (file_id, file_title, owner_id, parent_id, sort_key, depth, group_id, public_p)
+    values
+    ($file_id, [ns_dbquotevalue $file_title], $user_id, [ns_dbquotevalue $parent_id],0,0,$group_id, '$public_p')
+    "
+    
+    set version_insert "insert into fs_versions
+    (version_id, file_id, version_description, creation_date, author_id, url)
+    values
+    ($version_id, $file_id, [ns_dbquotevalue $version_description], sysdate(), $user_id, [ns_dbquotevalue $url])"
+    
+    
+    if {[catch { ns_db dml $db "begin transaction"
+ 	         ns_db dml $db $file_insert 
+                  ns_db dml $db $version_insert} errmsg] } {
+         # insert failed; let's see if it was because of duplicate submission
+         if { [database_to_tcl_string $db "select count(*) from fs_files where file_id = $file_id"] == 0 } {
+ 	    ns_log Error "[edu_url]group/admin/upload-new.tcl choked:  $errmsg"
+ 	    ad_return_error "Insert Failed" "The Database did not like what you typed.  This is probably a bug in our code.  Here's what the database said:
+	    <blockquote>
+	    <pre>
+	    $errmsg
+	    </pre>
+	    </blockquote>
+	    "
+            ns_db dml $db "abort transaction"
+            return
+        }
+    }
+}
+ 
+
+#
+# the permissions makes the assumption that the roles are a hierarchical 
+# by the priority column
+#
+
+# lets first give the uploading user permissions on the document
+
+# ns_ora exec_plsql $db "begin
+#  :1 := ad_general_permissions.grant_permission_to_user ( $user_id, 'read', $version_id, 'FS_VERSIONS' );
+#  :1 := ad_general_permissions.grant_permission_to_user ( $user_id, 'write', $version_id, 'FS_VERSIONS' );
+#  :1 := ad_general_permissions.grant_permission_to_user ( $user_id, 'comment', $version_id, 'FS_VERSIONS' );
+#  :1 := ad_general_permissions.grant_permission_to_user ( $user_id, 'administer', $version_id, 'FS_VERSIONS' );
+# end;"
+
+ns_db select $db "select grant_permission_to_user ( $user_id, 'read', $version_id, 'FS_VERSIONS' )"
+ns_db select $db "select grant_permission_to_user ( $user_id, 'write', $version_id, 'FS_VERSIONS' )"
+ns_db select $db "select grant_permission_to_user ( $user_id, 'comment', $version_id, 'FS_VERSIONS' )"
+ns_db select $db "select grant_permission_to_user ( $user_id, 'administer', $version_id, 'FS_VERSIONS' )"
+
+# lets do the write permissions next
+
+if {[empty_string_p $write_permission]} {
+    # insert write permission for the public
+    ns_db select $db "select grant_permission_to_all_users ( 'write', $version_id, 'FS_VERSIONS' )" 
+    ns_db select $db "select grant_permission_to_all_users ( 'read', $version_id, 'FS_VERSIONS' )"
+    ns_db select $db "select grant_permission_to_all_users ( 'comment', $version_id, 'FS_VERSIONS' )"
+
+    set write_permission_priority -1
+} else {
+    # a specific role has write permission.  In this case, we want to 
+    # give write permisison to every group with a priority greater than
+    # the given role
+    set write_permission_priority [database_to_tcl_string $db "select priority from edu_role_pretty_role_map where group_id = $group_id and lower(role) = lower('$write_permission')"]
+
+    set role_list [database_to_tcl_list $db "select role from edu_role_pretty_role_map where group_id = $group_id and priority <= $write_permission_priority"]
+
+    # now, lets go through the role_list and add write permissions
+    # but, if you want write permissions, you should also have read and comment permission
+    foreach role $role_list {
+        ns_db select $db "select grant_permission_to_role ( $group_id, '$role', 'write', $version_id, 'FS_VERSIONS' )"
+        ns_db select $db "select grant_permission_to_role ( $group_id, '$role', 'read', $version_id, 'FS_VERSIONS' )"
+        ns_db select $db "select grant_permission_to_role ( $group_id, '$role', 'comment', $version_id, 'FS_VERSIONS' )"
+    }
+}
+
+
+# now, we do read permissions pretty much the same way.  The general
+# permissions functions assume that if you have write, you automatically
+# have read so if the role has write, we are not going to add read again
+
+if {[empty_string_p $read_permission]} {
+    # insert write permission for the public
+    if {$write_permission_priority > -1} {
+	# the public cannot write
+	ns_db select $db "select grant_permission_to_all_users ( 'read', $version_id, 'FS_VERSIONS' )"
+        ns_db select $db "select grant_permission_to_all_users ( 'comment', $version_id, 'FS_VERSIONS' )"  
+    }
+} else {
+    # a specific role has write permission.  In this case, we want to 
+    # give write permisison to every group with a priority greater than
+    # the given role
+    set read_permission_priority [database_to_tcl_string $db "select priority from edu_role_pretty_role_map where group_id = $group_id and lower(role) = lower('$read_permission')"]
+
+    if {$read_permission_priority > $write_permission_priority} {
+	# there are users that should have read and do not already have write
+	set role_list [database_to_tcl_list $db "select role from edu_role_pretty_role_map where group_id = $group_id and priority > $write_permission_priority and priority <= $read_permission_priority"]
+
+	# now, lets go through the role_list
+	foreach role $role_list {
+	    ns_db select $db "select grant_permission_to_role ( $group_id, '$role', 'read', $version_id, 'FS_VERSIONS' )"
+            ns_db select $db "select grant_permission_to_role ( $group_id, '$role', 'comment', $version_id, 'FS_VERSIONS' )"
+	}
+    }
+}
+
+
+fs_order_files $db $user_id $group_id $public_p
+
+
+# the last thing that we want to do is the insert into edu_handouts
+
+ns_db dml $db "insert into edu_handouts (
+	handout_id,
+	class_id,
+	handout_name,
+	file_id,
+	handout_type,
+	distribution_date)
+    values (
+        $handout_id,
+        $group_id,
+        '$QQfile_title',
+        $file_id,
+        '$type',
+        '$distribution_date')"
+
+
+ns_db dml $db "end transaction"
+
+ns_db releasehandle $db
+
+ns_returnredirect $return_url
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/handouts/add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/handouts/add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/handouts/add.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,95 @@
+#
+# /www/education/class/admin/handouts/add.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January, 2000
+#
+# this page is where teachers can go to issue tasks (assignments or projects)
+# basically, they are able to upload a file/url into the file storage
+# system and then associate a due date with it.
+#
+
+ad_page_variables {
+    type
+}
+
+# we expect 'type' to be something like 'announcement' or 'lecture_notes'
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Add Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+set file_id [database_to_tcl_string $db "select fs_file_id_seq.nextval from dual"]
+set handout_id [database_to_tcl_string $db "select edu_handout_id_sequence.nextval from dual"]
+
+
+if {[string compare $type lecture_notes] == 0} {
+    set folder_type lecture_notes
+    set header "Upload New Lecture Notes"
+} else {
+    set folder_type handouts
+    set header "Upload New Handout"
+}    
+
+
+set return_string "
+[ad_header "$header @ [ad_system_name]"]
+
+<h2>$header</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" "Administration"] [list "" Handouts] "$header"]
+
+<hr>
+
+<blockquote>
+
+
+<form enctype=multipart/form-data method=post action=\"add-2.tcl\">
+[export_form_vars type file_id handout_id]
+<table>
+<tr>
+<th align=right>File Title: </td>
+<td valign=top>
+<input type=text size=30 maxsize=100 name=file_title>
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Description: </td>
+<td valign=top>
+[edu_textarea version_description "" 50 6]
+</td>
+</tr>
+
+<tr>
+<th align=right> Date Distributed: </td>
+<td valign=top>
+[ad_dateentrywidget distribution_date]
+</td>
+</tr>
+
+[edu_file_upload_widget $db $class_id $folder_type "" [edu_get_ta_role_string] f]
+
+<tr>
+<td colspan=2 align=center>
+<br>
+<input type=submit value=\"$header\">
+</td>
+</tr>
+</table>
+</form>
+
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
Index: web/openacs/www/education/class/admin/handouts/delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/handouts/delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/handouts/delete-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,52 @@
+#
+# /www/education/class/admin/handouts/delete-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, February 2000
+#
+# this page deletes a handout from edu_handouts but leaves
+# the file in fs_files and fs_versions just in case
+#
+
+
+ad_page_variables {
+    handout_id
+    {return_url ""}
+}
+
+validate_integer handout_id $handout_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Delete Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+# the first thing we want to do is check and make sure that 
+# the given handout is not null and a part of this class
+
+if {[empty_string_p $handout_id]} {
+    ad_return_complaint "<li>You must provide a way to identify your handout."
+    return
+}
+
+set delete_permission_p [database_to_tcl_string $db "select (case when count(handout_id) = 0 then 0 else 1 end)
+  from edu_handouts, fs_versions_latest ver
+ where class_id = $class_id
+   and user_has_row_permission_p($user_id, 'write', version_id, 'FS_VERSIONS') = 't'
+   and handout_id = $handout_id
+   and edu_handouts.file_id = ver.file_id"]
+
+
+if {!$delete_permission_p} {
+    ad_return_complaint 1 "<li>You do not have permission to delete this handout."
+    return
+} 
+
+
+ns_db dml $db "delete from edu_handouts where handout_id = $handout_id"
+
+ns_db releasehandle $db
+
+ns_returnredirect $return_url
Index: web/openacs/www/education/class/admin/handouts/delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/handouts/delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/handouts/delete.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,128 @@
+#
+# /www/education/class/admin/task-delete.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page is where teachers can go to edit assignments (or projects).
+# basically, they are able to upload a file/url into the file storage
+# system and then associate a due date with it.
+#
+
+ad_page_variables {
+    handout_id
+    {return_url ""}
+}
+
+validate_integer handout_id $handout_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Delete Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+if {[empty_string_p $handout_id]} {
+    ad_return_complaint "<li>You must provide a way to identify your handout."
+    return
+}
+
+set selection [ns_db 0or1row $db "select handout_name,
+       edu_handouts.file_id,
+       handout_type,
+       version_id,
+       file_extension,
+       version_description,
+       ver.url,
+       handout_type,
+       distribution_date,
+       first_names || ' ' || last_name as author_name
+  from edu_handouts,
+       fs_versions_latest ver,
+       users
+ where class_id = $class_id
+   and user_has_row_permission_p($user_id, 'write', version_id, 'FS_VERSIONS') = 't'
+   and handout_id = $handout_id
+   and users.user_id = ver.author_id
+   and edu_handouts.file_id = ver.file_id"]
+
+
+if {$selection == ""} {
+    ad_return_complaint 1 "<li>The handout you are trying to view is not part of this class and therefore you are not authorized to view it at this time."
+    return
+} else {
+    set_variables_after_query
+}
+
+
+#
+# the security has not been taken care of...let's display the handout
+#
+
+
+if {[string compare $handout_type lecture_notes] == 0} {
+    set pretty_type "Lecture Notes"
+} else {
+    set pretty_type "Handout"
+}
+
+
+set return_string "
+[ad_header "Delete $pretty_type @ [ad_system_name]"]
+
+<h2>Delete $pretty_type</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" "Administration"] [list "" Handouts] "One $pretty_type"]
+
+<hr>
+
+This $pretty_type was submitted by 
+$author_name on and distributed on 
+[util_AnsiDatetoPrettyDate $distribution_date].<p>
+
+<blockquote>
+
+<form method=POST action=\"delete-2.tcl\">
+
+[export_form_vars return_url handout_id]
+
+<table>
+<tr>
+<th valign=top align=right> File Title: </td>
+<td valign=top>
+$handout_name
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Description: </td>
+<td valign=top>
+[edu_maybe_display_text $version_description]
+</td>
+</tr>
+
+<tr>
+<th align=right> Date Distributed: </td>
+<td valign=top>
+[util_AnsiDatetoPrettyDate $distribution_date]
+</td>
+</tr>
+
+<tr>
+<td colspan=2 align=center>
+<br>
+<input type=submit value=\"Delete $pretty_type\">
+</td>
+</tr>
+</table>
+
+</form>
+
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
Index: web/openacs/www/education/class/admin/handouts/edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/handouts/edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/handouts/edit-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,105 @@
+#
+# /www/education/class/admin/handouts/edit-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this update the handouts table with the new information
+#
+
+ad_page_variables {
+    handout_id
+    file_title
+    {ColValue.distribution%5fdate.year ""}
+    {ColValue.distribution%5fdate.day ""}
+    {ColValue.distribution%5fdate.month ""}
+    {version_description ""}
+    {return_url ""}
+}
+
+validate_integer handout_id $handout_id
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Edit Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set exception_text ""
+set exception_count 0
+
+if {[empty_string_p $handout_id]} {
+    append exception_text "<li>You must provide a way to identify your handout."
+    incr exception_count
+}
+
+# put together due_date, and do error checking
+
+set form [ns_getform]
+
+# ns_dbformvalue $form due_date date due_date will give an error
+# message if the day of the month is 08 or 09 (this octal number problem
+# we've had in other places).  So I'll have to trim the leading zeros
+# from ColValue.due%5fdate.day and stick the new value into the $form
+# ns_set.
+
+set "ColValue.distribution%5fdate.day" [string trimleft [set ColValue.distribution%5fdate.day] "0"]
+ns_set update $form "ColValue.distribution%5fdate.day" [set ColValue.distribution%5fdate.day]
+
+if [catch  { ns_dbformvalue $form distribution_date date distribution_date} errmsg ] {
+    incr exception_count
+    append exception_text "<li>The date was specified in the wrong format.  The date should be in the format Month DD YYYY.\n"
+} elseif { [string length [set ColValue.distribution%5fdate.year]] != 4 } {
+    incr exception_count
+    append exception_text "<li>The year needs to contain 4 digits.\n"
+} 
+
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+
+set version_id [database_to_tcl_string_or_null $db "select version_id
+  from edu_handouts, fs_versions_latest ver
+ where class_id = $class_id
+   and user_has_row_permission_p($user_id, 'write', version_id, 'FS_VERSIONS') = 't'
+   and handout_id = $handout_id
+   and edu_handouts.file_id = ver.file_id"]
+
+
+if {[empty_string_p $version_id]} {
+    ad_return_complaint 1 "<li>The handout you are trying to view is not part of this class and therefore you are not authorized to view it at this time."
+    return
+} 
+
+# } else {
+#     set_variables_after_query
+# }
+
+
+#
+# lets update the rows
+#
+
+ns_db dml $db "begin transaction"
+
+ns_db dml $db "update edu_handouts
+set handout_name = '$QQfile_title',
+    distribution_date = '$distribution_date'
+where handout_id = $handout_id
+  and class_id = $class_id"
+
+ns_db dml $db "update fs_versions set version_description = '$QQversion_description' where version_id = $version_id"
+
+ns_db dml $db "end transaction"
+
+ns_db releasehandle $db
+
+ns_returnredirect $return_url
Index: web/openacs/www/education/class/admin/handouts/edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/handouts/edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/handouts/edit.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,119 @@
+#
+# /www/education/class/admin/handouts/edit.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page is where teachers can go to edit assignments (or projects).
+# basically, they are able to upload a file/url into the file storage
+# system and then associate a due date with it.
+#
+
+ad_page_variables {
+    handout_id
+    {return_url ""}
+}
+
+validate_integer handout_id $handout_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Edit Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+if {[empty_string_p $handout_id]} {
+    ad_return_complaint "<li>You must provide a way to identify your handout."
+    return
+}
+
+set selection [ns_db 0or1row $db "select handout_name,
+       edu_handouts.file_id,
+       handout_type,
+       version_id,
+       file_extension,
+       version_description,
+       url,
+       handout_type,
+       distribution_date
+  from edu_handouts, fs_versions_latest ver
+ where class_id = $class_id
+   and user_has_row_permission_p($user_id, 'write', version_id, 'FS_VERSIONS') = 't'
+   and handout_id = $handout_id
+   and edu_handouts.file_id = ver.file_id"]
+
+
+if {$selection == ""} {
+    ad_return_complaint 1 "<li>The handout you are trying to view is not part of this class and therefore you are not authorized to view it at this time."
+    return
+} else {
+    set_variables_after_query
+}
+
+
+
+if {[string compare $handout_type lecture_notes] == 0} {
+    set pretty_type "Lecture Notes"
+} else {
+    set pretty_type "Handout"
+}
+
+
+set return_string "
+[ad_header "Edit $pretty_type @ [ad_system_name]"]
+
+<h2>Edit $pretty_type</h2>
+
+[ad_context_bar_ws_or_index [list "../one.tcl" "$class_name Home"] [list "" "Administration"] [list "" Handouts] "Edit $pretty_type"]
+
+<hr>
+
+<blockquote>
+
+<form method=POST action=\"edit-2.tcl\">
+[export_form_vars return_url handout_id]
+
+<table>
+<tr>
+<th align=right>File Title: </td>
+<td valign=top>
+<input type=text size=30 maxsize=200 value=\"$handout_name\" name=file_title>
+</td>
+</tr>
+
+<tr>
+<th align=right>
+Date Distributed:
+</td>
+<td valign=top>
+[ad_dateentrywidget distribution_date $distribution_date]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right>
+Description:
+</td>
+<td>
+[edu_textarea version_description $version_description 50 6]
+</td>
+</tr>
+
+<tr>
+<td colspan=2 align=center>
+<br>
+<input type=submit value=\"Edit $pretty_type\">
+</td>
+</tr>
+</table>
+
+</form>
+
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
Index: web/openacs/www/education/class/admin/handouts/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/handouts/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/handouts/index.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,5 @@
+# /www/education/class/admin/handouts/index.tcl
+# just redirect the user to the class admin home page
+# by randyg@arsdigita.com, aileen@arsdigita.com January 2000
+
+ns_returnredirect ../
\ No newline at end of file
Index: web/openacs/www/education/class/admin/handouts/one.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/handouts/one.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/handouts/one.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,142 @@
+#
+# /www/education/class/admin/handouts/one.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January, 2000
+#
+# this page is where teachers can go to issue tasks (assignments or projects)
+# basically, they are able to upload a file/url into the file storage
+# system and then associate a due date with it.
+#
+
+ad_page_variables {
+    handout_id
+}
+
+validate_integer handout_id $handout_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Add Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+# the first thing we want to do is check and make sure that 
+# the given handout is not null and a part of this class
+
+if {[empty_string_p $handout_id]} {
+    ad_return_complaint "<li>You must provide a way to identify your handout."
+    return
+}
+
+set selection [ns_db 0or1row $db "select handout_name,
+       edu_handouts.file_id,
+       handout_type,
+       version_id,
+       file_extension,
+       version_description,
+       url,
+       handout_type,
+       distribution_date,
+       user_has_row_permission_p($user_id, 'write', version_id, 'FS_VERSIONS') as write_p
+  from edu_handouts,
+       fs_versions_latest ver
+ where class_id = $class_id
+   and user_has_row_permission_p($user_id, 'read', version_id, 'FS_VERSIONS') = 't'
+   and handout_id = $handout_id
+   and edu_handouts.file_id = ver.file_id"]
+
+
+if {$selection == ""} {
+    ad_return_complaint 1 "<li>The handout you are trying to view is not part of this class and therefore you are not authorized to view it at this time."
+    return
+} else {
+    set_variables_after_query
+}
+
+
+#
+# the security has not been taken care of...let's display the handout
+#
+
+
+if {[string compare $handout_type lecture_notes] == 0} {
+    set header "Lecture Notes"
+    set folder_type lecture_notes
+} else {
+    set header "Handout"
+    set folder_type handouts
+}
+
+
+set return_string "
+[ad_header "$header @ [ad_system_name]"]
+
+<h2>$handout_name</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" "Administration"] [list "" Handouts] "One $header"]
+
+<hr>
+
+<blockquote>
+
+<table>
+<tr>
+<th valign=top align=right>File Title: </td>
+<td valign=top>
+"
+
+if {![empty_string_p $url]} {
+    append return_string "<a href=\"$url\">$handout_name</a>"
+} elseif {![empty_string_p $version_id]} {
+    append return_string "<a href=\"/file-storage/download/[join $handout_name "_"].$file_extension?version_id=$version_id\">$handout_name</a>"
+} else {
+    append return_string "$handout_name"
+}
+
+
+append return_string "
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right>
+Date Distributed:
+</td>
+<td valign=top>
+[util_AnsiDatetoPrettyDate $distribution_date]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right>
+Description:
+</td>
+<td>
+[edu_maybe_display_text $version_description]
+</td>
+</tr>
+</table>
+<p>
+"
+
+if {[string compare $write_p t] == 0} {
+    append return_string "
+    <a href=\"edit.tcl?handout_id=$handout_id\">edit</a> 
+    |
+    <a href=\"upload-new-version.tcl?handout_id=$handout_id\">upload a new version</a>
+    |
+    "
+}
+
+append return_string "
+<a href=\"delete.tcl?handout_id=$handout_id\">delete</a>
+
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
Index: web/openacs/www/education/class/admin/handouts/upload-new-version.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/handouts/upload-new-version.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/handouts/upload-new-version.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,196 @@
+#
+# /www/education/class/admin/handouts/upload-new-version.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January, 2000
+#
+# this page allows the user to upload a new version of the handout
+#
+
+ad_page_variables {
+    handout_id
+    {return_url ""}
+}
+
+validate_integer handout_id $handout_id
+
+# we expect 'type' to be something like 'announcement' or 'lecture_notes'
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Add Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+if {[empty_string_p $handout_id]} {
+    ad_return_complaint "<li>You must provide a way to identify your handout."
+    return
+}
+
+set selection [ns_db 0or1row $db "select handout_name as file_title,
+       edu_handouts.file_id,
+       handout_type,
+       version_id,
+       file_extension,
+       version_description,
+       url,
+       handout_type,
+       distribution_date
+  from edu_handouts, fs_versions_latest ver
+ where class_id = $class_id
+   and user_has_row_permission_p($user_id, 'write', version_id, 'FS_VERSIONS') = 't'
+   and handout_id = $handout_id
+   and edu_handouts.file_id = ver.file_id"]
+
+
+if {$selection == ""} {
+    ad_return_complaint 1 "<li>The handout you are trying to view is not part of this class and therefore you are not authorized to view it at this time."
+    return
+} else {
+    set_variables_after_query
+}
+
+
+if {[string compare $handout_type lecture_notes] == 0} {
+    set header "Lecture Notes"
+    set folder_type lecture_notes
+} else {
+    set header "Handout"
+    set folder_type handouts
+}
+
+
+if {[empty_string_p $return_url]} {
+    set return_url "[edu_url]class/admin/handouts/one.tcl?handout_id=$handout_id"
+} 
+
+
+# in order to determine the defaults for the permissions, we want to see if there
+# is already a file for the assignment (or project).  If so, we want to use 
+# those as the default
+
+
+if {[empty_string_p $version_id]} {
+    set write_permission_default [edu_get_ta_role_string]
+    set read_permission_default ""
+} else {
+    # lets make sure that they can edit the file
+    if {![fs_check_edit_p $db $user_id $version_id $class_id]} {
+	ad_return_complaint 1 "<li>You are not authorized to edit this file."
+	return
+    }
+
+    # more often than not, the scope is going to be group_role so lets
+    # try that one first
+    set read_permission_default_list [database_to_tcl_list $db "select gp.role
+        from general_permissions gp,
+             edu_role_pretty_role_map map
+       where on_what_id = $version_id
+         and lower(on_which_table) = lower('FS_VERSIONS')
+         and scope = 'group_role'
+         and gp.group_id = $class_id
+         and permission_type = 'read'
+         and gp.group_id = map.group_id
+         and lower(gp.role) = lower(map.role)
+       order by priority desc"]
+
+    # we want the highest numerical priority so lets just grab the first element
+    set read_permission_default [lindex $read_permission_default_list 0]
+    if {[empty_string_p $read_permission_default]} {
+	# if there is not a group_role item, we just set our normal default
+	# read role of ""
+	set read_permission_default ""
+    }
+
+
+    # now, we want to set our default write permissions and we do pretty much
+    # the same thing as when we did the read permissions.
+
+    set write_permission_default_list [database_to_tcl_list $db "select gp.role
+        from general_permissions gp,
+             edu_role_pretty_role_map map
+       where on_what_id = $version_id
+         and lower(on_which_table) = lower('FS_VERSIONS')
+         and scope = 'group_role'
+         and gp.group_id = $class_id
+         and permission_type = 'write'
+         and gp.group_id = map.group_id
+         and lower(gp.role) = lower(map.role)
+       order by priority desc"]
+
+    # we want the highest numerical priority so lets just grab the first element
+    set write_permission_default [lindex $write_permission_default_list 0]
+    if {[empty_string_p $write_permission_default]} {
+	# there was not a group_role so lets check if it is public
+	set write_permission_public_p [database_to_tcl_string_or_null $db "select decode(case when all_users_permission_id('write', $version_id, 'FS_VERSIONS') = 0 then 0 else 1 end) from dual"]
+	if {$write_permission_public_p == 0} {
+	    # if write_permisssion_public_p is 0 then there is not a correct permissions
+	    # record so we go to our usual default of ta
+	    set write_permission_default [edu_get_ta_role_string]
+	} 
+    }
+}
+
+
+set return_string "
+[ad_header "$header @ [ad_system_name]"]
+
+<h2>Upload New Version</h2>
+
+of $file_title
+<p>
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" "Administration"] [list "" Handouts] "$header"]
+
+<hr>
+
+<blockquote>
+
+<form enctype=multipart/form-data method=post action=\"upload-version.tcl\">
+[export_form_vars file_id version_description file_title return_url]
+
+<table>
+<tr>
+<th align=right>File Title: </td>
+<td valign=top>
+$file_title
+</td>
+</tr>
+
+<tr>
+<th align=right> Date Distributed: </td>
+<td valign=top>
+[util_AnsiDatetoPrettyDate $distribution_date]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Description: </td>
+<td valign=top>
+[edu_maybe_display_text $version_description]
+</td>
+</tr>
+
+[edu_file_upload_widget $db $class_id $folder_type $read_permission_default $write_permission_default f]
+
+<tr>
+<td colspan=2 align=center>
+<br>
+<input type=submit value=\"Upload new $header\">
+</td>
+</tr>
+</table>
+</form>
+
+</blockquote>
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
Index: web/openacs/www/education/class/admin/projects/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/projects/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/projects/index.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1 @@
+ns_returnredirect ../
\ No newline at end of file
Index: web/openacs/www/education/class/admin/projects/instance-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/projects/instance-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/projects/instance-add-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,206 @@
+#
+# /www/education/class/admin/projects/instance-add-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page gathers the data, and then either
+# 1. stuffs it into a URL and redirects the user to select
+#    the student
+# or
+# 2. displays the information for selecting a team for this project
+
+ad_page_variables {
+    project_id
+    {project_instance_name ""}
+    project_type
+    {url ""}
+    {description ""}
+}
+
+validate_integer project_id $project_id
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Add Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set exception_count 0
+set exception_text ""
+
+if {[empty_string_p $project_id]} {
+    incr exception_count 
+    append exception_text "<li>You must provide the parent project identification number."
+} else {
+ set selection [ns_db 0or1row $db "select project_name
+        from edu_projects
+       where project_id = $project_id
+         and class_id = $class_id"]
+    
+    if {$selection == ""} {
+	incr exception_count
+	append exception_text"<li>There are no projects in this class corresponding to the provided identification number.  This is an error in our code.  Please contact <a href=mailto:[ad_system_owner]>[ad_system_owner]</a>."
+    } else {
+	set_variables_after_query
+    }
+}
+
+if {[empty_string_p $project_type]} {
+    incr exception_count
+    append exception_text "<li>You must select the type of this project."
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+if {[string compare $url "http://"] == 0} {
+    set url ""
+}
+
+
+# if the project is of type 'user' then we redirect to let
+# the admin select the appropriate student
+# else
+# we display this page which lets the admin select the correct team
+
+if {[string compare $project_type user] == 0} {
+    set target_url_vars [export_url_vars project_id project_instance_name project_type url description]
+    set target_url "[edu_url]class/admin/projects/instance-add-3.tcl"
+    set view_type project
+    set export_vars [export_url_vars target_url_vars target_url view_type project_instance_name]
+    ns_db releasehandle $db
+    ns_returnredirect "[edu_url]class/admin/users/students-view.tcl?$export_vars"
+    return
+}
+
+
+# if they have selected a team project, we need to have the
+# a project_instance_name
+
+if {[empty_string_p $project_instance_name]} {
+    ad_return_complaint 1 "<li>You must project a name for this project instance."
+    return
+}
+
+
+# this means that this is a team project
+
+set return_string "
+[ad_header "One Project @ [ad_system_name]"]
+
+<h2>Add a Project Instance</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" Administration] [list "" "All Projects"] "Add Project Instance"]
+
+<hr>
+for $project_name
+<blockquote>
+
+<form method=post action=\"instance-add-3.tcl\">
+[export_form_vars project_id project_instance_name project_type url description]
+
+<table>
+<tr>
+<th align=right>Project Instance Name:</th>
+<td>[edu_maybe_display_text $project_instance_name]
+</tr>
+
+<tr>
+<th align=right>URL:</th>
+<td>[edu_maybe_display_text $url]
+</tr>
+
+<tr>
+<th align=right>Description:</th>
+<td>[edu_maybe_display_text $description]
+</tr>
+
+<tr>
+<th align=right>Number of students:</th>
+<td>
+Min [ad_space] <input type=text name=min_body_count size=2 maxlength=2>
+[ad_space 2] Max [ad_space] <input type=text name=max_body_count size=2 maxlength=2>
+</td>
+
+<tr>
+<th align=right>
+Team Assignment:
+</th>
+<td>
+<select name=\"team_id_or_new_or_none\">
+<option value=\"new\">Create a new team
+"
+
+# set sql "select et.team_id,
+#        team_name
+# from edu_teams et,
+#      edu_project_user_map epum
+# where et.team_id = epum.team_id(+)
+#   and epum.team_id is null
+#   and et.class_id = $class_id"
+
+
+set sql "select et.team_id,
+       team_name
+from edu_teams et,
+     edu_project_user_map epum
+where et.team_id = epum.team_id
+  and epum.team_id is null
+  and et.class_id = $class_id
+union
+select et.team_id,
+       team_name
+from edu_teams et,
+     edu_project_user_map epum
+where not exists (select 1 from edu_project_user_map 
+                  where team_id = et.team_id)
+  and epum.team_id is null
+  and et.class_id = $class_id"
+
+# Get a list of teams in this class that haven't yet
+# been assigned to a project.
+set unassigned_team_list [database_to_tcl_list_list $db $sql]
+
+
+foreach unassigned_team $unassigned_team_list {
+    set team_id [lindex $unassigned_team 0]
+    set team_name [lindex $unassigned_team 1]
+    append return_string "<option value=\"$team_id\">$team_name
+"
+}
+
+append return_string "
+<option value=\"none\">None, will assign later
+</select>
+</td>
+
+<tr>
+<td colspan=2 align=center>
+<input type=submit value=\"Continue\">
+</td>
+</tr>
+</table>
+</form>
+</blockquote>
+
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/projects/instance-add-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/projects/instance-add-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/projects/instance-add-3.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,260 @@
+#
+# /www/education/class/admin/projects/instance-add-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page allows users to confirm their addition project instances. 
+#
+
+ad_page_variables {
+    project_id
+    project_type
+    {project_instance_name ""}
+    {url ""}
+    {description ""}
+    {max_body_count ""}
+    {min_body_count ""}
+    {team_id_or_new_or_none ""}
+    {student_id ""}
+}
+
+validate_integer project_id $project_id
+validate_integer_or_null team_id_or_new_or_none $team_id_or_new_or_none
+validate_integer_or_null student_id $student_id
+
+# if view_type = user then student_id must be not null.  If student_id
+# is 0 then the user has decided to select the student at a later point
+# in time.
+# if the view_type = team then the team_id_or_new_or_none must be not
+# null
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Add Tasks"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set exception_count 0
+set exception_text ""
+
+if {[string compare $project_type user] && [empty_string_p $student_id]} {
+    incr exception_count
+    append exception_text "<li>In order to have a user project, you must provide a user."
+}
+
+
+# Generate pretty strings for body counts.
+# We could use ad_page_variables defaulting (if it actually worked)
+# but then we'd be passing the pretty strings, yuk.
+if [empty_string_p $max_body_count] {
+    set pretty_max_body_count "unspecified"
+} else {
+    set pretty_max_body_count $max_body_count
+}
+if [empty_string_p $min_body_count] {
+    set pretty_min_body_count "unspecified"
+} else {
+    set pretty_min_body_count $min_body_count
+}
+
+
+
+set exception_count 0
+set exception_text ""
+
+if {[empty_string_p $project_id]} {
+    incr exception_count
+    append exception_text "<li>You must provide a project identification number"
+} else {
+
+ set selection [ns_db 0or1row $db "select project_name
+        from edu_projects
+       where project_id = $project_id
+         and class_id = $class_id"]
+    
+    if {$selection == ""} {
+	ad_return_complaint 1 "There are no projects in this class corresponding to the provided identification number.  This is an error in our code.  Please contact <a href=mailto:[ad_system_owner]>[ad_system_owner]</a>."
+	return
+    } else {
+	set_variables_after_query
+    }
+}
+
+
+set project_instance_id [database_to_tcl_string $db "select edu_project_instance_id_seq.nextval from dual"]
+
+
+if {[string compare $url "http://"] == 0 || [empty_string_p $url]} {
+    set url_to_show ""
+    set url ""
+} else {
+    set url_to_show $url
+}
+
+
+
+if {[string compare $project_type team] == 0} {
+    if { ![regexp {^[0-9]*$} $max_body_count] || \
+	    ![regexp {^[0-9]*$} $min_body_count] }  {
+	incr exception_count
+	append exception_text "<li>User numbers must be either integers or left blank.\n"
+    } elseif {![empty_string_p $max_body_count] && ![empty_string_p $min_body_count]} {
+	if {$min_body_count > $max_body_count} {
+	    incr exception_count
+	    append exception_text "<li>The minimum number of users on the project cannot be larger than the maximum number."
+	}
+    }
+    
+    if {[empty_string_p $project_instance_name]} {
+	incr exception_count
+	append exception_text "<li>You must provide a name for this project."
+    }
+
+    # Generate team_id and team_name from form input
+    set team_extra_text {}
+    switch $team_id_or_new_or_none {
+	none {
+	    set team_name "None, will assign later"
+	    set team_id ""
+	}
+	new {
+	    set team_name "$project_instance_name Team"
+	    set team_extra_text (new)
+	    set team_id [database_to_tcl_string $db "select user_group_sequence.nextval from dual"]
+	}
+	default {
+	    # We got a team_id, should be an integer.
+	    set team_id $team_id_or_new_or_none
+	    validate_integer team_id $team_id
+	    if { [catch { set team_name [database_to_tcl_string $db "select team_name
+	    from edu_teams
+	    where team_id = $team_id"] } errMsg] } {
+		# ouch!  Oracle choked.
+		ad_return_error "Team not found." "We could not find the team.  Here is what Oracle had to say:
+		<blockquote>
+		$errMsg
+		</blockquote>
+		"
+	    }
+	}
+    }
+    
+    # display the team information
+    set display_string "
+    <tr>
+    <th align=right>Number of students:</th>
+    <td>
+    Min: [ad_space] $pretty_min_body_count
+    [ad_space] Max: [ad_space] $pretty_max_body_count
+    </td>
+    </tr>
+    
+    <tr>
+    <th align=right>
+    Team Assignment:
+    </th>
+    <td>$team_name $team_extra_text</td>
+    </tr>
+    "
+} else {
+    set user_name [database_to_tcl_string_or_null $db "select first_names || ' ' || last_name from users where user_id = $student_id"]
+
+    if {[empty_string_p $user_name]} {
+	set user_name "None, will assign later."
+    }
+
+    if {[empty_string_p $project_instance_name]} {
+	set project_instance_name $user_name
+    }
+
+    set display_string "
+    <tr>
+    <th align=right>
+    User:
+    </th>
+    <td>$user_name</td>
+    </tr>
+    "
+}
+    
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+
+
+set return_string "
+[ad_header "One Project @ [ad_system_name]"]
+
+<h2>Add a Project Instance</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" Administration] [list "" "All Projects"] "Add Project Instance"]
+
+<hr>
+for $project_name
+<blockquote>
+
+<form method=post action=\"instance-add-4.tcl\">
+
+[export_form_vars project_id project_instance_id project_instance_name url description team_id team_name max_body_count min_body_count project_type student_id]
+
+Please confirm the information that you have entered.
+
+<table>
+
+<tr>
+<th align=right>
+Name:
+</td>
+<td>
+$project_instance_name
+</td>
+</tr>
+
+<tr>
+<th align=right>
+URL:
+</td>
+<td>
+[edu_maybe_display_text $url_to_show]
+</td>
+</tr>
+
+$display_string
+
+<tr>
+<th align=right valign=top>
+Description:
+</td>
+<td>
+[edu_maybe_display_text $description]
+</td>
+</tr>
+
+<tr>
+<td colspan=2 align=center>
+<input type=submit value=\"Add Project\">
+</td>
+</tr>
+
+</table>
+</form>
+
+</blockquote>
+
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/projects/instance-add-4.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/projects/instance-add-4.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/projects/instance-add-4.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,135 @@
+#
+# /www/education/class/admin/projects/instance-add-3.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# the actually adds the project instance to the database
+#
+
+ad_page_variables {
+    project_id
+    project_instance_name 
+    project_instance_id
+    project_type
+    {url ""}
+    {description ""}
+    {max_body_count ""}
+    {min_body_count ""}
+    {team_name ""}
+    {team_id ""}
+    {student_id ""}
+}
+
+validate_integer project_id $project_id
+validate_integer project_instance_id $project_instance_id
+validate_integer_or_null team_id $team_id
+validate_integer_or_null student_id $student_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Add Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set exception_count 0
+set exception_text ""
+
+if {[empty_string_p $project_id]} {
+    ad_return_complaint 1 "<li>You must provide a project identification number"
+} else {
+
+ set selection [ns_db 0or1row $db "select project_name
+        from edu_projects
+       where project_id = $project_id
+         and class_id = $class_id"]
+    
+    if {$selection == ""} {
+	ad_return_complaint 1 "There are no projects in this class corresponding to the provided identification number.  This is an error in our code.  Please contact <a href=mailto:[ad_system_owner]>[ad_system_owner]</a>."
+	return
+    } else {
+	set_variables_after_query
+    }
+}
+
+# ad_page_variables defaulting doesn't work when
+# the form var is defined but empty.
+if [empty_string_p $max_body_count] {
+    set max_body_count NULL
+}
+
+if [empty_string_p $min_body_count] {
+    set min_body_count NULL
+}
+
+
+set return_url "[edu_url]class/admin/projects/one.tcl?project_id=$project_id"
+
+# lets check for double click
+
+if {[database_to_tcl_string $db "select count(project_instance_id) from edu_project_instances where project_instance_id = $project_instance_id"] > 0} {
+    # it was a double click
+    ns_returnredirect $return_url
+    return
+}
+
+
+ns_db dml $db "insert into edu_project_instances (
+     project_instance_id, 
+     project_id, 
+     project_instance_name,  
+     project_instance_url, 
+     description, 
+     approved_p, 
+     approved_date, 
+     approving_user, 
+     max_body_count,
+     min_body_count,
+     active_p,
+     project_type) 
+  values (
+     $project_instance_id,
+     $project_id,
+     [ns_dbquotevalue $project_instance_name],
+     [ns_dbquotevalue $url],
+     [ns_dbquotevalue $description],
+     't',
+     sysdate(),
+     $user_id,
+     $max_body_count,
+     $min_body_count,
+     't',
+     '$project_type')"
+
+
+if {![empty_string_p $team_id]} {
+
+    # We got a team_id, add it to this instance
+    if { [database_to_tcl_string $db "select count(*) from edu_teams where team_id = $team_id"] > 0 } {
+        # The team exists.  Put an entry into the project_user_map.
+        if { [database_to_tcl_string $db "select count(*)
+from edu_project_user_map
+where project_instance_id = $project_instance_id
+and team_id = $team_id"]                          == 0 } {
+            # No entries in the map.  This is not a double click.
+            ns_db dml $db "insert into edu_project_user_map (project_instance_id, team_id) values ($project_instance_id, $team_id)"
+        }
+    } else {
+	# The team doesn't yet exist.  We need to create it and put an
+        # entry in the edu_project_user_map.
+	ns_returnredirect "[edu_url]class/admin/teams/create-3.tcl?[export_url_vars team_id team_name project_instance_id return_url]"
+	return
+    }
+}
+
+
+if {![empty_string_p $student_id] && $student_id > 0} {
+    # we have a student for the project
+    # we do the select to make sure that the user is a member of the class
+    ns_db dml $db "insert into edu_project_user_map (project_instance_id, student_id) select $project_instance_id, $student_id from users, user_group_map map where users.user_id = $student_id and users.user_id = map.user_id and map.group_id = $class_id"
+}
+
+ns_db releasehandle $db
+
+ns_returnredirect $return_url
Index: web/openacs/www/education/class/admin/projects/instance-add-7.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/projects/instance-add-7.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/projects/instance-add-7.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,202 @@
+#
+# /www/education/class/admin/projects/instance-add-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page allows users to confirm their addition project instances. 
+#
+
+ad_page_variables {
+    project_id
+    project_instance_name 
+    url 
+    description
+    {max_body_count ""}
+    {min_body_count ""}
+    team_id_or_new_or_none
+}
+
+validate_integer project_id $project_id
+validate_integer team_id_or_new_or_none $team_id_or_new_or_none
+
+# Generate pretty strings for body counts.
+# We could use ad_page_variables defaulting (if it actually worked)
+# but then we'd be passing the pretty strings, yuk.
+if [empty_string_p $max_body_count] {
+    set pretty_max_body_count "unspecified"
+} else {
+    set pretty_max_body_count $max_body_count
+}
+if [empty_string_p $min_body_count] {
+    set pretty_min_body_count "unspecified"
+} else {
+    set pretty_min_body_count $min_body_count
+}
+
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set exception_count 0
+set exception_text ""
+
+if {[empty_string_p $project_id]} {
+    incr exception_count
+    append exception_text "<li>You must provide a project identification number"
+} else {
+
+ set selection [ns_db 0or1row $db "select project_name
+        from edu_projects
+       where project_id = $project_id
+         and class_id = $class_id"]
+    
+    if {$selection == ""} {
+	ad_return_complaint 1 "There are no projects in this class corresponding to the provided identification number.  This is an error in our code.  Please contact <a href=mailto:[ad_system_owner]>[ad_system_owner]</a>."
+	return
+    } else {
+	set_variables_after_query
+    }
+}
+
+
+if {[empty_string_p $project_instance_name]} {
+    incr exception_count
+    append exception_text "<li>You must provide a name for this project."
+}
+
+if { ![regexp {^[0-9]*$} $max_body_count] || \
+	![regexp {^[0-9]*$} $min_body_count] }  {
+    incr exception_count
+    append exception_text "<li>Student numbers must be either integers or left blank.\n"
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+set project_instance_id [database_to_tcl_string $db "select edu_project_instance_id_seq.nextval from dual"]
+
+
+if {[string compare $url "http://"] == 0 || [empty_string_p $url]} {
+    set url_to_show ""
+    set url ""
+} else {
+    set url_to_show $url
+}
+
+# Generate team_id and team_name from form input
+set team_extra_text {}
+switch $team_id_or_new_or_none {
+    none {
+	set team_name "None, will assign later"
+	set team_id ""
+    }
+    new {
+	set team_name "$project_instance_name Team"
+	set team_extra_text (new)
+	set team_id [database_to_tcl_string $db "select user_group_sequence.nextval from dual"]
+    }
+    default {
+	# We got a team_id, should be an integer.
+	set team_id $team_id_or_new_or_none
+	validate_integer team_id $team_id
+	if { [catch { set team_name [database_to_tcl_string $db "select team_name
+from edu_teams
+where team_id = $team_id"] } errMsg] } {
+            # ouch!  Oracle choked.
+            ad_return_error "Team not found." "We could not find the team.  Here is what Oracle had to say:
+<blockquote>
+$errMsg
+</blockquote>
+"
+        }
+    }
+}
+
+
+set return_string "
+[ad_header "One Project @ [ad_system_name]"]
+
+<h2>Add a Project Instance</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" Administration] [list "" "All Projects"] "Add Project Instance"]
+
+<hr>
+for $project_name
+<blockquote>
+
+<form method=post action=\"instance-add-3.tcl\">
+
+[export_form_vars project_id project_instance_id project_instance_name url description team_id team_name max_body_count min_body_count]
+
+Please confirm the information that you have entered.
+
+<table>
+
+<tr>
+<th align=right>
+Name:
+</td>
+<td>
+$project_instance_name
+</td>
+
+<tr>
+<th align=right>
+URL:
+</td>
+<td>
+$url_to_show
+</td>
+
+<tr>
+<th align=right>Number of students:</th>
+<td>
+Min:&nbsp;$pretty_min_body_count
+&nbsp;&nbsp;Max:&nbsp;$pretty_max_body_count
+</td>
+
+<tr>
+<th align=right>
+Team Assignment:
+</th>
+<td>$team_name $team_extra_text</td>
+
+<tr>
+<th align=right valign=top>
+Description:
+</td>
+<td>
+$description
+</td>
+
+<tr>
+<td colspan=2 align=center>
+<input type=submit value=\"Add Project\">
+</td>
+</tr>
+
+</table>
+</form>
+
+</blockquote>
+
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/projects/instance-add-8.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/projects/instance-add-8.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/projects/instance-add-8.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,125 @@
+#
+# /www/education/class/admin/projects/instance-add-3.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# the actually adds the project instance to the database
+#
+
+ad_page_variables {
+    project_id
+    project_instance_name 
+    project_instance_id
+    project_type
+    {url ""}
+    {description ""}
+    {max_body_count ""}
+    {min_body_count ""}
+    {team_name ""}
+    {team_id ""}
+    {student_id ""}
+}
+
+validate_integer project_id $project_id
+validate_integer project_instance_id $project_instance_id
+validate_integer_or_null team_id $team_id
+validate_integer_or_null student_id $student_id
+
+# ad_page_variables defaulting doesn't work when
+# the form var is defined but empty.
+if [empty_string_p $max_body_count] {
+    set max_body_count NULL
+}
+if [empty_string_p $min_body_count] {
+    set max_body_count NULL
+}
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Add Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set exception_count 0
+set exception_text ""
+
+if {[empty_string_p $project_id]} {
+    ad_return_complaint 1 "<li>You must provide a project identification number"
+} else {
+
+ set selection [ns_db 0or1row $db "select project_name
+        from edu_projects
+       where project_id = $project_id
+         and class_id = $class_id"]
+    
+    if {$selection == ""} {
+	ad_return_complaint 1 "There are no projects in this class corresponding to the provided identification number.  This is an error in our code.  Please contact <a href=mailto:[ad_system_owner]>[ad_system_owner]</a>."
+	return
+    } else {
+	set_variables_after_query
+    }
+}
+
+
+# lets check for double click
+
+if {[database_to_tcl_string $db "select count(project_instance_id) from edu_project_instances where project_instance_id = $project_instance_id"] > 0} {
+    # it was a double click
+    ns_returnredirect "one.tcl?project_id=$project_id"
+    return
+}
+
+
+ns_db dml $db "insert into edu_project_instances (
+     project_instance_id, 
+     project_id, 
+     project_instance_name,  
+     project_instance_url, 
+     description, 
+     approved_p, 
+     approved_date, 
+     approving_user, 
+     max_body_count,
+     min_body_count,
+     active_p) 
+  values (
+     $project_instance_id,
+     $project_id,
+     [ns_dbquotevalue $project_instance_name],
+     [ns_dbquotevalue $url],
+     [ns_dbquotevalue $description],
+     't',
+     sysdate(),
+     $user_id,
+     $max_body_count,
+     $min_body_count,
+     't')"
+
+
+set return_url "/education/class/admin/projects/one.tcl?project_id=$project_id"
+
+if ![empty_string_p $team_id] {
+
+    # We got a team_id, add it to this instance
+    if { [database_to_tcl_string $db "select count(*)
+from edu_teams
+where team_id = $team_id"] > 0 } {
+        # The team exists.  Put an entry into the project_user_map.
+        if { [database_to_tcl_string $db "select count(*)
+from edu_project_user_map
+where project_instance_id = $project_instance_id
+and team_id = $team_id"]                          == 0 } {
+            # No entries in the map.  This is not a double click.
+            ns_db dml $db "insert into edu_project_user_map (project_instance_id, team_id) values ($project_instance_id, $team_id)"
+        }
+    } else {
+	# The team doesn't yet exist.  We need to create it and put an
+        # entry in the edu_project_user_map.
+	ns_returnredirect /education/class/admin/teams/create-3.tcl?[export_url_vars team_id team_name project_instance_id return_url]
+	return
+    }
+}
+
+ns_returnredirect $return_url
Index: web/openacs/www/education/class/admin/projects/instance-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/projects/instance-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/projects/instance-add.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,121 @@
+#
+# /www/education/class/admin/projects/instance-add.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page allows users to add project instances. 
+#
+
+ad_page_variables {
+    project_id
+}
+
+validate_integer project_id $project_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Add Tasks"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set exception_count 0
+set exception_text ""
+
+if {[empty_string_p $project_id]} {
+    ad_return_complaint 1 "<li>You must provide a project identification number"
+} else {
+
+ set selection [ns_db 0or1row $db "select project_name
+        from edu_projects
+       where project_id = $project_id
+         and class_id = $class_id"]
+    
+    if {$selection == ""} {
+	ad_return_complaint 1 "There are no projects in this class corresponding to the provided identification number.  This is an error in our code.  Please contact <a href=mailto:[ad_system_owner]>[ad_system_owner]</a>."
+	return
+    } else {
+	set_variables_after_query
+    }
+}
+
+set student_pretty_role [database_to_tcl_string $db "select pretty_role from edu_role_pretty_role_map where lower(role) = lower('[edu_get_student_role_string]') and group_id = $class_id"]
+
+
+set return_string "
+[ad_header "One Project @ [ad_system_name]"]
+
+<h2>Add a Project Instance</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" Administration] [list "" "View Projects"] "Add Project Instance"]
+
+<hr>
+for $project_name
+<blockquote>
+
+<form method=post action=\"instance-add-2.tcl\">
+[export_form_vars project_id]
+<table>
+
+<tr>
+<th align=right>
+Name:
+</td>
+<td>
+<input type=text size=30 name=project_instance_name>
+</td>
+
+<tr>
+<th align=right>
+URL:
+</td>
+<td>
+<input type=text size=30 name=url value=\"http://\">
+</td>
+
+<tr>
+<th align=right valign=top>
+Description:
+</td>
+<td>
+[edu_textarea description "" 50 6]
+</td>
+
+<tr>
+<th align=right>
+Project Type:
+</th>
+<td>
+<input type=radio name=project_type value=user checked>
+$student_pretty_role
+[ad_space 4]
+<input type=radio name=project_type value=team>
+Team
+</td>
+</tr>
+
+<tr>
+<td colspan=2 align=center>
+<input type=submit value=\"Continue\">
+</td>
+</tr>
+
+
+</table>
+</form>
+
+</blockquote>
+
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/projects/instance-info.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/projects/instance-info.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/projects/instance-info.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,220 @@
+#
+# /www/education/class/admin/projects/instance-info.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page displays information about a given project
+#
+
+ad_page_variables {
+    project_instance_id
+}
+
+validate_integer project_instance_id $project_instance_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "View Admin Pages"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set exception_count 0
+set exception_text ""
+
+if {[empty_string_p $project_instance_id]} {
+    ad_return_complaint 1 "<li>You must provide a project identification number"
+    return
+} else {
+    set selection [ns_db 0or1row $db "select
+	proj.project_id,
+        project_name,
+	project_instance_name,
+	project_instance_url,
+	proj.description,
+	approved_p,
+        approved_date,
+        approving_user,
+        max_body_count,
+        min_body_count,
+	active_p,
+        project_type
+   from edu_project_instances inst,
+        edu_projects proj
+  where inst.project_instance_id = $project_instance_id
+    and proj.project_id = inst.project_id
+    and proj.class_id = $class_id"]
+
+    
+    if {$selection == ""} {
+	ad_return_complaint 1 "There are no projects in this class corresponding to the provided identification number.  This is an error in our code.  Please contact <a href=mailto:[ad_system_owner]>[ad_system_owner]</a>."
+	return
+    } else {
+	set_variables_after_query
+    }
+}
+
+
+if {[string compare $project_type team] == 0} {
+    if [empty_string_p $max_body_count] {
+	set pretty_max_body_count "unspecified"
+    } else {
+	set pretty_max_body_count $max_body_count
+    }
+    if [empty_string_p $min_body_count] {
+	set pretty_min_body_count "unspecified"
+    } else {
+    set pretty_min_body_count $min_body_count
+    }
+
+    set display_text "
+    <tr>
+    <th align=right>Number of students:</th>
+    <td>
+    Min: [ad_space] $pretty_min_body_count
+    [ad_space] Max: [ad_space] $pretty_max_body_count
+    </td>
+    </tr>
+    "
+
+    # now, we want to show a list of teams that are assigned to this
+    # project
+    
+    set teams_list [database_to_tcl_list_list $db "select edu_teams.team_id, 
+                   team_name 
+              from edu_teams, 
+                   edu_project_instances, 
+                   edu_project_user_map map 
+             where map.team_id = edu_teams.team_id 
+      edu_project_instances.project_instance_id = $project_instance_id 
+               and map.project_instance_id = edu_project_instances.project_instance_id"]
+
+    append display_text "
+    <h3>Teams working on $project_instance_name</h3>
+    <ul>
+    "
+
+    if {[empty_string_p $teams_list]} {
+	append display_text "There are currently no teams assigned to this project.<p>
+	<li><a href=\"team-add.tcl?project_instance_id=$project_instance_id\">Add a team</a>"
+    } else {
+	append display_text "<table>"
+	foreach team $teams_list {
+	    append display_text "
+	<tr><td>
+	    <a href=\"../teams/one.tcl?team_id=[lindex $team 0]\">[lindex $team 1]</a> 
+	    </td><td>
+	    (<a href=\"team-remove.tcl?project_instance_id=$project_instance_id&team_id=[lindex $team 0]\">remove</a>)</tr>"
+	}
+	append display_text "
+	[edu_empty_row]
+	<tr><td colspa=2>
+	<a href=\"team-add.tcl?project_instance_id=$project_instance_id\">Add a team</a>
+	</td>
+	</tr>
+	</table>"
+    }
+    
+    append display_text "
+    </ul>
+    "
+
+} else {
+    set display_text ""
+    
+}
+
+
+set return_string "
+[ad_header "One Project @ [ad_system_name]"]
+
+<h2>$project_instance_name</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" Administration] [list "" "All Projects"] "One Project Instance"]
+
+<hr>
+a part of <a href=\"one.tcl?project_id=$project_id\">$project_name</a>
+<blockquote>
+
+
+<table BORDER=0>
+
+<tr>
+<th valign=top align=right> Name: </td>
+<td valign=top>
+$project_instance_name
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> URL: </td>
+<td valign=top>
+"
+
+if {[empty_string_p $project_instance_url]} {
+    append return_string "None"
+} else {
+    append return_string "<A href=\"$project_instance_url\">$project_instance_url</a>"
+}
+
+append return_string "
+</td>
+</tr>
+
+$display_text
+
+<tr>
+<th valign=top align=right> Description: </td>
+<td valign=top>
+[edu_maybe_display_text $description]
+</td>
+</tr>
+</table>
+ 
+<h4>Status Reports</h4>
+<ul>
+"
+
+
+set comment_permission_p [database_to_tcl_string_or_null $db "select 1 from users, 
+        user_group_map ug_map, 
+        edu_project_user_map map 
+  where users.user_id = $user_id 
+    and map.project_instance_id = $project_instance_id
+    and (users.user_id = map.student_id 
+         or (users.user_id = ug_map.user_id 
+             and ug_map.group_id = map.team_id))"]
+
+if {[empty_string_p $comment_permission_p]} {
+    set comment_permission_p [ad_permission_p $db "" "" "View Admin Pages" $user_id $class_id]
+}
+
+if {$comment_permission_p == 1} {
+    set progress_reports [ad_general_comments_list $db $project_instance_id EDU_PROJECT_INSTANCES $project_instance_name]
+} else {
+    set progress_reports "[ad_general_comments_summary_sorted $db $project_instance_id EDU_PROJECT_INSTANCES $project_instance_name]"
+}
+
+if {[string compare $progress_reports "<ul></ul>"] == 0} {
+    append return_string "No status reports available"
+} else {
+    append return_string "$progress_reports"
+}
+
+
+append return_string "
+</ul>
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/projects/one.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/projects/one.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/projects/one.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,311 @@
+#
+# /www/education/class/admin/projects/one.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page displays information about a given project
+#
+
+ad_page_variables {
+    project_id
+}
+
+validate_integer project_id $project_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set exception_count 0
+set exception_text ""
+
+if {[empty_string_p $project_id]} {
+    ad_return_complaint 1 "<li>You must provide a project identification number"
+} else {
+
+
+# set sql  "select
+#              ep.class_id, 
+#              ep.project_name,
+#              teacher_id,
+#              first_names,
+#              last_name,
+#              ep.description,
+#              ep.date_assigned,
+#              last_modified,
+#              due_date,
+#              grade_id,
+#              weight,
+#              electronic_submission_p,
+#              requires_grade_p,
+#              version_id, 
+#              file_extension,
+#              ver.url,
+#              ver.file_id
+#         from edu_projects ep,
+#              users,
+#              fs_versions_latest ver
+#        where users.user_id = ep.teacher_id
+#          and ep.project_id = $project_id
+#          and ep.class_id = $class_id
+#          and ep.file_id = ver.file_id(+)"
+
+set sql  "select
+             ep.class_id, 
+             ep.project_name,
+             teacher_id,
+             first_names,
+             last_name,
+             ep.description,
+             ep.date_assigned,
+             last_modified,
+             due_date,
+             grade_id,
+             weight,
+             electronic_submission_p,
+             requires_grade_p,
+             version_id, 
+             file_extension,
+             ver.url,
+             ver.file_id
+        from edu_projects ep,
+             users,
+             fs_versions_latest ver
+       where users.user_id = ep.teacher_id
+         and ep.project_id = $project_id
+         and ep.class_id = $class_id
+         and ep.file_id = ver.file_id
+union
+select
+             ep.class_id, 
+             ep.project_name,
+             teacher_id,
+             first_names,
+             last_name,
+             ep.description,
+             ep.date_assigned,
+             last_modified,
+             due_date,
+             grade_id,
+             weight,
+             electronic_submission_p,
+             requires_grade_p,
+             NULL::integer as version_id, 
+             NULL::varchar as file_extension,
+             '' as url,
+             '' as file_id
+        from edu_projects ep,
+             users
+       where users.user_id = ep.teacher_id
+         and ep.project_id = $project_id
+         and ep.class_id = $class_id
+         and not exists (select 1 from fs_versions_latest 
+                         where file_id = ep.file_id)"
+
+
+set selection [ns_db 0or1row $db $sql]
+
+    if {$selection == ""} {
+	ad_return_complaint 1 "There are no projects in this class corresponding to the provided identification number.  This is an error in our code.  Please contact <a href=mailto:[ad_system_owner]>[ad_system_owner]</a>."
+	return
+    } else {
+	set_variables_after_query
+    }
+}
+
+
+
+set return_string "
+[ad_header "One Project @ [ad_system_name]"]
+
+<h2>$project_name</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" Administration] [list "" "All Projects"] "One Project"]
+
+<hr>
+<blockquote>
+
+
+<table BORDER=0>
+
+<tr>
+<th valign=top align=right> Project Name: </th>
+<td valign=top>
+"
+
+if {![empty_string_p $version_id]} {
+    if {[fs_check_read_p $db $user_id $version_id $class_id]} {
+	if {![empty_string_p $url]} {
+	    append return_string "<a href=\"$url\">$project_name</a>"
+	} else {
+	    append return_string "<a href=\"/file-storage/download/$project_name.$file_extension?version_id=$version_id\">$project_name</a>"
+	}
+    } else {
+	append return_string "$project_name"
+    }
+} else {
+    append return_string "$project_name"
+}
+
+append return_string "
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Description: </th>
+<td valign=top>
+[edu_maybe_display_text $description]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Due Date: </th>
+<td valign=top>
+[util_AnsiDatetoPrettyDate $due_date]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Date Assigned: </th>
+<td valign=top>
+[util_AnsiDatetoPrettyDate $date_assigned]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right>Will this project<br>be graded? </th>
+<td valign=top>
+[util_PrettyBoolean $requires_grade_p]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Fraction of Final Grade: </th>
+<td valign=top>"
+
+if {[empty_string_p $weight]} {
+    append return_string "N/A"
+} else {
+    append return_string "$weight"
+}
+
+append return_string "
+</td>
+</tr>
+<tr>
+<th align=right>Grade Group</th>
+<td>"
+
+if {![empty_string_p $grade_id]} {
+    set selection [ns_db 0or1row $db "select grade_name, weight from edu_grades where grade_id = $grade_id"]
+} else {
+    set selection ""
+}
+
+
+if {$selection!=""} {
+    set_variables_after_query
+} else {
+    set grade_name ""
+    set weight ""
+}
+
+append return_string "
+[edu_maybe_display_text $grade_name] [ec_decode $weight "" "" "- $weight %"]
+</td></tr>
+<tr>
+<th valign=top align=right>
+Will students submit <br>
+answers electronically?
+</th>
+<td valign=top>
+[util_PrettyBoolean $electronic_submission_p]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Assigned By: </th>
+<td valign=top>
+$first_names $last_name
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Last Modified: </th>
+<td valign=top>
+[util_AnsiDatetoPrettyDate $last_modified]
+</td>
+</tr>
+
+
+</table>
+<br>
+"
+set task_type project
+set task_id $project_id
+
+if {![empty_string_p $file_id]} {
+    append return_string "<a href=\"../task-edit.tcl?task_id=$task_id&task_type=$task_type\">Edit $project_name</a> | <a href=[edu_url]class/admin/task-file-new.tcl?[export_url_vars return_url task_id task_type]>Upload new version</a>"
+} else {
+    append return_string "<a href=\"task-edit.tcl?task_id=$task_id&task_type=$task_type\">Edit $project_name</a> | <a href=[edu_url]class/admin/task-file-new.tcl?[export_url_vars return_url task_id task_type]>Upload associated file</a>"
+}
+
+
+
+##############################################
+#                                            #
+#  We are now going to list the students     #
+#  that have and have not been evaluated for #
+#  the given project                         #
+#                                            #
+##############################################
+
+
+append return_string "
+<h3>Project Instances</h3>
+<ul>
+"
+
+set selection [ns_db select $db "select project_instance_id, project_instance_name, project_instance_url, description from edu_project_instances where project_id = $task_id and active_p = 't'"] 
+
+set n_project_instances 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    append return_string "<li><a href=\"instance-info.tcl?project_instance_id=$project_instance_id\">$project_instance_name</a>"
+
+    if {![empty_string_p $url]} {
+	append return_string "&nbsp (<a href=\"$url\">$url</a>)"
+    }
+
+    incr n_project_instances
+}
+
+if {$n_project_instances == 0} {
+    append return_string "There are not currently any projects being worked on.<br><Br>"
+} else {
+    append return_string "<p>"
+}
+
+append return_string "
+<li><a href=\"instance-add.tcl?project_id=$project_id\">Add a project instance</a>
+</ul>
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/projects/team-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/projects/team-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/projects/team-add-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,95 @@
+#
+# /www/education/class/admin/projects/team-add-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# allows a user to associate a team with a project instance
+#
+
+ad_page_variables {
+    project_instance_id
+    team_id
+}
+
+validate_integer project_instance_id $project_instance_id
+validate_integer team_id $team_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set exception_count 0
+set exception_text ""
+
+if {[empty_string_p $project_instance_id]} {
+    ad_return_complaint 1 "<li>You must provide a project identification number"
+    return
+} else {
+    set selection [ns_db 0or1row $db "select
+	proj.project_id,
+	project_instance_name,
+	project_instance_url,
+	inst.description
+   from edu_project_instances inst,
+        edu_projects proj
+  where project_instance_id = $project_instance_id
+    and proj.project_id = inst.project_id 
+    and proj.class_id = $class_id"]
+
+    if {$selection == ""} {
+	ad_return_complaint 1 "There are no projects in this class corresponding to the provided identification number.  This is an error in our code.  Please contact <a href=mailto:[ad_system_owner]>[ad_system_owner]</a>."
+	return
+    } else {
+	set_variables_after_query
+    }
+}
+
+# lets make sure the team is a member of this class
+
+set team_name [database_to_tcl_string $db "select team_name from edu_teams where team_id = $team_id and class_id = $class_id"]
+
+if {[empty_string_p $team_name]} {
+    ad_return_complaint 1 "<li>The team you have requested does not belong to this class."
+    return
+}
+
+
+
+set return_string "
+[ad_header "One Project @ [ad_system_name]"]
+
+<h2>Add a Team</h2>
+to $project_instance_name
+<p>
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" Administration] [list "" "All Projects"] "Add Team"]
+
+<hr>
+<blockquote>
+
+Are you sure you wish to add $team_name to $project_instance_name?
+
+<form method=post action=\"team-add-3.tcl\">
+[export_form_vars project_instance_id team_id]
+
+<input type=submit value=\"Add Team\">
+
+</form>
+
+</blockquote>
+
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/projects/team-add-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/projects/team-add-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/projects/team-add-3.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,65 @@
+#
+# /www/education/class/admin/projects/team-add-3.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# allows a user to associate a team with a project instance
+#
+
+ad_page_variables {
+    project_instance_id
+    team_id
+}
+
+validate_integer project_instance_id $project_instance_id
+validate_integer team_id $team_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+if {[empty_string_p $team_id] || [empty_string_p $project_instance_id]} {
+    ad_return_complaint 1 "<li>You must provide both a team and a project instance."
+    return
+}
+
+
+# lets make sure that both the team and project belong to the same
+# class
+
+set same_class_p [database_to_tcl_string $db "select count(edu_teams.class_id) 
+     from edu_projects, 
+          edu_project_instances pi, 
+          edu_teams   
+   where edu_teams.class_id = edu_projects.class_id 
+     and edu_teams.class_id = $class_id 
+     and edu_projects.project_id = pi.project_id"]
+
+
+if {$same_class_p == 0} {
+    ad_return_complaint 1 "<li>The team and project must both be in the same class."
+    return
+}
+
+
+# now we want to check for a double click
+
+if {[database_to_tcl_string $db "select count(team_id) from edu_project_user_map where team_id = $team_id and project_instance_id = $project_instance_id"] > 0} {
+    ns_returnredirect "instance-info.tcl?project_instance_id=$project_instance_id"
+    return
+}
+
+
+ns_db dml $db "insert into edu_project_user_map (
+       project_instance_id,
+       team_id)
+    values (
+       $project_instance_id,
+       $team_id)"
+
+
+ns_db releasehandle $db
+
+ns_returnredirect "instance-info.tcl?project_instance_id=$project_instance_id"
Index: web/openacs/www/education/class/admin/projects/team-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/projects/team-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/projects/team-add.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,131 @@
+#
+# /www/education/class/admin/projects/team-add.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# allows a user to associate a team with a project instance
+#
+
+ad_page_variables {
+    project_instance_id
+}
+
+validate_integer project_instance_id $project_instance_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set exception_count 0
+set exception_text ""
+
+if {[empty_string_p $project_instance_id]} {
+    ad_return_complaint 1 "<li>You must provide a project identification number"
+    return
+} else {
+    set selection [ns_db 0or1row $db "select
+	proj.project_id,
+	project_instance_name,
+	project_instance_url,
+	inst.description
+   from edu_project_instances inst,
+        edu_projects proj
+  where project_instance_id = $project_instance_id
+    and proj.project_id = inst.project_id 
+    and proj.class_id = $class_id"]
+
+    
+    if {$selection == ""} {
+	ad_return_complaint 1 "There are no projects in this class corresponding to the provided identification number.  This is an error in our code.  Please contact <a href=mailto:[ad_system_owner]>[ad_system_owner]</a>."
+	return
+    } else {
+	set_variables_after_query
+    }
+}
+
+
+# lets get the list of teams that can be assigned to this project instance
+# if there are no teams available, we redirect to allow the use to
+# create a new team that is then associated with this
+
+set teams_list [database_to_tcl_list_list $db "select team_id, team_name from edu_teams where class_id = $class_id and not exists (select 1 from edu_project_user_map map where project_instance_id = $project_instance_id and map.team_id = edu_teams.team_id)"]
+
+if {[empty_string_p $teams_list]} {
+    set return_url "../projects/instance-info.tcl?project_instance_id=$project_instance_id"
+    ns_returnredirect "../teams/create.tcl?[export_url_vars return_url project_instance_id]"
+    return
+} elseif {[llength $teams_list] == 1} {
+    # there is only one team they can choose so force them to choose it
+    ns_returnredirect "team-add-2.tcl?team_id=[lindex [lindex $teams_list 0] 0]&project_instance_id=$project_instance_id"
+    return
+}
+
+
+
+set return_string "
+[ad_header "One Project @ [ad_system_name]"]
+
+<h2>Add a Team</h2>
+to $project_instance_name
+<p>
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" Administration] [list "" "All Projects"] "Add Team"]
+
+<hr>
+<blockquote>
+
+<table BORDER=0>
+
+<tr>
+<th valign=top align=right> Name: </td>
+<td valign=top>
+$project_instance_name
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> URL: </td>
+<td valign=top>
+[edu_maybe_display_text $project_instance_url]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Description: </td>
+<td valign=top>
+[edu_maybe_display_text $description]
+</td>
+</tr>
+</table>
+<h3>Available Teams</h3>
+<ul>
+"
+
+# lets display the list of teams to choose from
+
+foreach team $teams_list {
+    append return_string "<li><a href=\"team-add-2.tcl?project_instance_id=$project_instance_id&team_id=[lindex $team 0]\">[lindex $team 1]</a></li>\n"
+}
+
+
+append return_string "
+
+</ul>
+</blockquote>
+
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/projects/team-remove-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/projects/team-remove-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/projects/team-remove-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,53 @@
+#
+# /www/education/class/admin/projects/team-remove-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# allows a user to unassociate a team and a project instance
+#
+
+ad_page_variables {
+    project_instance_id
+    team_id
+    {return_url ""}
+}
+
+validate_integer project_instance_id $project_instance_id
+validate_integer team_id $team_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+if {[empty_string_p $return_url]} {
+    if {[empty_string_p $project_instance_id]} {
+	set return_url ""
+    } else {
+	set return_url "instance-info.tcl?project_instance_id=$project_instance_id"
+    }
+}
+
+
+# if project_instance_id or team_id is null, lets just do an appropriate
+# redirect.  Otherwise, make sure that the project is part of this class
+# and if so, do the delete.  We don't need to check to see if the team is 
+# assigned to the project because if they are not the delete will not do
+# anything
+
+if {![empty_string_p $project_instance_id] && ![empty_string_p $team_id]} {
+
+    if {[database_to_tcl_string $db "select count(proj.project_id) from edu_projects proj, edu_project_instances inst where inst.project_id = proj.project_id and proj.class_id = $class_id and inst.project_instance_id = $project_instance_id"] > 0} {
+	# then we are in the correct class
+	ns_db dml $db "delete from edu_project_user_map where project_instance_id = $project_instance_id and team_id = $team_id"
+    }
+}
+
+ns_db releasehandle $db
+
+ns_returnredirect $return_url
+
+
+
+
Index: web/openacs/www/education/class/admin/projects/team-remove.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/projects/team-remove.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/projects/team-remove.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,98 @@
+#
+# /www/education/class/admin/projects/team-remove.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# allows a user to unassociate a team and a project instance
+#
+
+ad_page_variables {
+    project_instance_id
+    team_id
+}
+
+validate_integer project_instance_id $project_instance_id
+validate_integer team_id $team_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set exception_count 0
+set exception_text ""
+
+if {[empty_string_p $project_instance_id]} {
+    ad_return_complaint 1 "<li>You must provide a project identification number"
+    return
+} else {
+    set selection [ns_db 0or1row $db "select
+	proj.project_id,
+	project_instance_name,
+	project_instance_url,
+	inst.description
+   from edu_project_instances inst,
+        edu_projects proj
+  where project_instance_id = $project_instance_id
+    and proj.project_id = inst.project_id 
+    and proj.class_id = $class_id"]
+
+    if {$selection == ""} {
+	ad_return_complaint 1 "There are no projects in this class corresponding to the provided identification number.  This is an error in our code.  Please contact <a href=mailto:[ad_system_owner]>[ad_system_owner]</a>."
+	return
+    } else {
+	set_variables_after_query
+    }
+}
+
+set team_name [database_to_tcl_string_or_null $db "select team_name from edu_teams where team_id = $team_id and class_id = $class_id"]
+
+
+ns_db releasehandle $db
+
+if {[empty_string_p $team_name]} {
+    # there is not team with the given id that belongs to this class so just
+    # redirect (we do this to make sure that a user that is not a member of this
+    # class cannot see the name of the team
+    ns_returnredirect "instance-info.tcl?project_instance_id=$project_instance_id"
+    return
+}
+
+
+set return_string "
+[ad_header "One Project @ [ad_system_name]"]
+
+<h2>Remove Team</h2>
+from $project_instance_name
+<p>
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" Administration] [list "" "All Projects"] "Remove Team"]
+
+<hr>
+<blockquote>
+
+Are you sure you wish to remove $team_name from $project_instance_name?
+
+<form method=post action=\"team-remove-2.tcl\">
+[export_form_vars project_instance_id team_id]
+
+<input type=submit value=\"Remove Team\">
+
+</form>
+
+</blockquote>
+
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/teams/create-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/teams/create-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/teams/create-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,87 @@
+# 
+# /www/education/class/admin/teams/create-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu
+#
+# this page is a confirmation to allow the user to check the information
+# about a team before it is created.
+#
+
+ad_page_variables {
+    {project_instance_id ""}
+    team_name
+    {student_id ""}
+    {return_url ""}
+}
+
+validate_integer_or_null project_instance_id $project_instance_id
+validate_integer_or_null student_id $student_id
+
+if {[empty_string_p $team_name]} {
+    ad_return_complaint 1 "<li>You must provide a name for your team"
+    return
+}
+
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+set user_id [lindex $id_list 0]
+
+
+# teams are groups so we get the next team_id from the group sequence
+
+set team_id [database_to_tcl_string $db "select user_group_sequence.nextval from dual"]
+
+# Now that we have a team_id we can assign a default return_url if none
+# was provided.
+if [empty_string_p $return_url] {
+    set return_url one.tcl?[export_url_vars team_id]
+}
+
+
+set return_stirng "
+[ad_header "Confirm New Team"]
+
+<h2>Confirm New Team</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" "Administration"] [list "" "Teams"] "Create New Team"]
+
+<hr>
+<blockquote>
+
+<form method=post action=\"create-3.tcl\">
+[export_form_vars project_instance_id team_name team_id return_url student_id]
+
+<table>
+<tr><th align=right>Team Name:</th>
+<td>$team_name</td>
+</tr>
+"
+
+if {![empty_string_p $project_instance_id]} {
+    set project_instance_name [database_to_tcl_string_or_null $db "select project_instance_name from edu_project_instances where project_instance_id = $project_instance_id"]
+
+    if {![empty_string_p $project_instance_name]} {
+	append return_stirng "
+	<tr>
+	<th align=right>Project Name:</th>
+	<td>$project_instance_name</td>
+	</tr>
+	"
+    }
+}
+
+append return_stirng "
+<tr><td align=center colspan=2><input type=submit value=Confirm></td></tr>
+</table>
+
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
Index: web/openacs/www/education/class/admin/teams/create-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/teams/create-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/teams/create-3.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,64 @@
+# 
+# /www/education/class/admin/teams/create-3.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu
+#
+# this page is a confirmation to allow the user to check the information
+# about a team before it is created.
+#
+
+ad_page_variables {
+    team_name
+    team_id
+    {student_id ""}
+    {return_url ""}
+    {project_instance_id ""}
+}
+
+validate_integer team_id $team_id
+validate_integer_or_null student_id $student_id
+validate_integer_or_null project_instance_id $project_instance_id
+
+if {[empty_string_p $return_url]} {
+    set return_url "one.tcl?team_id=$team_id"
+} 
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+set user_id [lindex $id_list 0]
+
+# check for a double click
+if {[database_to_tcl_string $db "select count(group_name) from user_groups where group_id = $team_id"] > 0} {
+    ns_returnredirect "$return_url"
+    return
+}
+
+
+
+ad_user_group_add $db edu_team $team_name t f closed f "" $team_id
+
+
+# the ad_user_group_add proc does not quite work because it does not
+# allow for subgroups so we do the update
+
+ns_db dml $db "update user_groups set parent_group_id = $class_id where group_id = $team_id"
+
+if {![empty_string_p $student_id]} {
+    ad_user_group_user_add $db $user_id member $class_id
+}
+
+if {![empty_string_p $project_instance_id]} {
+    ns_db dml $db "insert into edu_project_user_map (project_instance_id, team_id) values ($project_instance_id, $team_id)"
+}
+
+ns_db releasehandle $db
+
+ns_returnredirect $return_url
+
+
+
+
+
Index: web/openacs/www/education/class/admin/teams/create.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/teams/create.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/teams/create.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,97 @@
+#
+# /www/education/class/admin/teams/create.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# This page allows the user to create a team
+#
+
+ad_page_variables {
+    {student_id ""} 
+    {return_url ""}
+    {project_instance_id ""}
+}
+
+validate_integer_or_null student_id $student_id
+validate_integer_or_null project_instance_id $project_instance_id
+
+# optionally takes student_id of the first student in the team
+# project_instance_id is taken in the case that this team is being
+# created to implement a project instance
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+set user_id [lindex $id_list 0]
+
+
+set return_string "
+[ad_header "Create a New Team"]
+
+<h2>Create New Team</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" Administration] [list "" "Teams"] "Create New Team"]
+
+<hr>
+"
+
+if {![empty_string_p $project_instance_id]} {
+    set project_instance_name [database_to_tcl_string_or_null $db "select inst.project_instance_name from edu_project_instances inst, edu_projects proj where project_instance_id = $project_instance_id and class_id = $class_id and proj.project_id = inst.project_id"]
+    if {![empty_string_p $project_instance_name]} {
+	append return_string "to be added to $project_instance_name"
+    }
+}
+
+append return_string "
+<blockquote>
+<form method=post action=\"create-2.tcl\">
+
+[export_form_vars student_id return_url project_instance_id]
+
+<table>
+<tr>
+<th align=right>Team Name</th>
+<td><input type=text size=20 name=team_name></td>
+</tr>
+"
+
+set selection [ns_db select $db "select unique project_instance_name, project_instance_id from edu_project_instances epi, edu_student_tasks where class_id=$class_id and epi.project_id = edu_student_tasks.task_id"]
+
+set select_text ""
+set n_projects 0
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    append select_text "
+    <option value=\"$project_instance_id\">$project_instance_name
+    "
+
+}
+
+if {$n_projects > 0} {
+    append return_string "
+    <tr>
+    <th align=right valign=top>Select a project<br>for this team:</th>
+    <td><select name=project_instance_id>
+    <option value=\"None\">"
+    $select_text
+    </select>
+    </tr>
+    "
+}
+
+append return_string "
+[edu_empty_row]
+<tr><th></th><td><input type=submit value=Submit></td>
+</tr>
+</table>
+</form>
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
Index: web/openacs/www/education/class/admin/teams/edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/teams/edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/teams/edit-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,70 @@
+#
+# /www/education/class/admin/teams/edit-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, February 2000
+#
+# this page confirms the new name for the team
+#
+
+ad_page_variables {
+    team_name
+    team_id
+}
+
+validate_integer team_id $team_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+if {[empty_string_p $team_name]} {
+    ad_return_complaint 1 "<li>You must include a name for this team."
+    return
+} 
+
+if {[empty_string_p $team_id]} {
+    ad_return_complaint 1 "<li>You must provide a team to edit"
+    return
+}
+
+# lets ensure that this team is part of this class
+
+if {[database_to_tcl_string $db "select count(team_id) from edu_teams where team_id = $team_id and class_id = $class_id"] == 0} {
+    ad_return_complaint 1 "<li>The team that you are trying to edit does not belong to $class_name."
+    return
+}
+
+
+set return_string "
+[ad_header "Edit Team Information"]
+
+<h2>Edit Team Information</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" "Administration"] [list "" Teams] [list "one.tcl?team_id=$team_id" "One Team"] "Edit Team Information"]
+
+<hr>
+<blockquote>
+
+<form method=post action=\"edit-3.tcl\">
+
+[export_form_vars team_name team_id]
+
+<b>Team Name</b>:
+[ad_space 2]
+$team_name
+
+<p>
+
+<input type=submit value=\"Confirm Edit\">
+
+</blockquote>
+
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
Index: web/openacs/www/education/class/admin/teams/edit-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/teams/edit-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/teams/edit-3.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,40 @@
+#
+# /www/education/class/admin/teams/edit-3.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page updates the groups table to relect the new team name
+#
+
+ad_page_variables {
+    team_id
+    team_name
+}
+
+validate_integer team_id $team_id
+
+if {[empty_string_p $team_name]} {
+    ad_return_complaint 1 "<li>You must provide a new name for this team."
+    return
+}
+
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+# lets ensure that this team is part of this class
+
+if {[database_to_tcl_string $db "select count(team_id) from edu_teams where team_id = $team_id and class_id = $class_id"] == 0} {
+    ad_return_complaint 1 "<li>The team that you are trying to edit does not belong to $class_name."
+    return
+}
+
+ns_db dml $db "update user_groups set group_name = [ns_dbquotevalue $team_name] where group_id = $team_id"
+
+ns_db releasehandle $db
+
+ns_returnredirect "one.tcl?team_id=$team_id"
\ No newline at end of file
Index: web/openacs/www/education/class/admin/teams/edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/teams/edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/teams/edit.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,66 @@
+#
+# /www/education/class/admin/teams/edit.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page allows a user to edit the properties of a team
+#
+
+ad_page_variables {
+    team_id
+}
+
+validate_integer team_id $team_id
+
+if {[empty_string_p $team_id]} {
+    ad_return_complaint 1 "<li>You must provide a team to edit."
+    return
+}
+
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+set user_id [lindex $id_list 0]
+
+
+set team_name [database_to_tcl_string_or_null $db "select team_name from edu_teams where class_id = $class_id and team_id = $team_id"]
+
+if {[empty_string_p $team_name]} {
+    ad_return_complaint 1 "<li>The team you have requested is not associated with this class.
+    return
+} 
+
+
+set return_string "
+[ad_header "Edit Team Information @ [ad_system_name]"]
+
+<h2>Edit Team Information</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" "Administration"] [list "" Teams] [list "one.tcl?team_id=$team_id" "One Team"] "Edit Team Information"]
+
+<hr>
+<blockquote>
+
+<form method=post action=\"edit-2.tcl\">
+[export_form_vars team_id]
+
+<b>Team Name</b>:
+[ad_space 2]
+
+<input type=text size=30 maxsize=100 name=team_name value=\"$team_name\">
+
+<p>
+<input type=submit value=Continue>
+
+</form>
+
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
Index: web/openacs/www/education/class/admin/teams/evaluation-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/teams/evaluation-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/teams/evaluation-add-2.tcl	17 Apr 2001 14:05:13 -0000	1.1
@@ -0,0 +1,104 @@
+#
+# /www/education/class/admin/teams/evaluation-add-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# This is a confirmation page that allows the user to review the
+# team evaluation before submitting it
+#
+
+ad_page_variables {
+    team_id
+    evaluation_type
+    {grade ""}
+    comments
+    {show_team_p f}
+}
+
+validate_integer team_id $team_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set grader_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+set team_name [database_to_tcl_string_or_null $db "select team_name from edu_teams where team_id=$team_id"]
+
+if {$team_name==""} {
+    incr error_count
+    append error_text "<li>You must call this page with a valid Team ID"
+}
+
+set error_count 0
+set error_text ""
+
+if {[empty_string_p $grade] && [empty_string_p $comments]} {
+    incr error_count
+    append error_text "<li>You must enter either a grade or comments"
+}
+
+if {[empty_string_p $evaluation_type]} {
+    incr error_count
+    append error_text "<li>You must specify an evaluation type"
+}
+
+if {$error_count} {
+    ad_return_complaint $error_count $error_text
+    return
+}
+
+
+set evaluation_id [database_to_tcl_string $db "select edu_evaluation_id_sequence.nextval from dual"]
+
+
+set return_string "
+[ad_header "Team Evaluations @ [ad_system_name]"]
+
+<h2>Confirm Evaluation for $team_name</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" "Administration"] [list "" "Teams"] [list one.tcl?team_id=$team_id "One Team"] "Add Evaluation"]
+
+<hr>
+<blockquote>
+
+<form method=post action=\"evaluation-add-3.tcl\">
+
+[export_form_vars evaluation_id evaluation_type team_id comments grade show_team_p]
+
+<table>
+<tr>
+<th align=right>Evaluation Type</th>
+<td>$evaluation_type</td>
+</tr>
+<tr>
+<th align=right>Grade</th>
+<td>[edu_maybe_display_text $grade]</td>
+</tr>
+<tr>
+<th align=right>Comments</th>
+<td>[edu_maybe_display_text $comments]</td>
+</tr>
+<tr>
+<th align=right>Make Evaluation Visible to Team?</th>
+<td>[ec_PrettyBoolean $show_team_p]</td>
+</tr>
+<tr>
+<th></th>
+<td><input type=submit value=Confirm></td>
+</tr>
+</table>
+</form>
+</blockquote>
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
Index: web/openacs/www/education/class/admin/teams/evaluation-add-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/teams/evaluation-add-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/teams/evaluation-add-3.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,41 @@
+#
+# /www/education/class/admin/teams/evaluation-add-3.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page inserts the evaluation information for the team
+# into the database
+#
+
+ad_page_variables {
+    team_id
+    evaluation_type
+    grade
+    comments
+    show_team_p
+    evaluation_id
+}
+
+validate_integer team_id $team_id
+validate_integer evaluation_id $evaluation_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set grader_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+ns_db dml $db "
+insert into edu_student_evaluations
+(evaluation_id, grader_id, class_id, team_id, evaluation_type, 
+ grade, comments, show_student_p)
+values
+($evaluation_id, $grader_id, $class_id, $team_id, [ns_dbquotevalue $evaluation_type],
+ [ns_dbquotevalue $grade], [ns_dbquotevalue $comments], [ns_dbquotevalue $show_team_p])"
+
+ns_db releasehandle $db
+
+ns_returnredirect "one.tcl?team_id=$team_id"
+ 
+
Index: web/openacs/www/education/class/admin/teams/evaluation-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/teams/evaluation-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/teams/evaluation-add.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,72 @@
+#
+# /www/education/class/admin/teams/evaluation-add.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page allows the admin to add an evaluation for the team
+#
+
+ad_page_variables {
+    team_id
+}
+
+validate_integer team_id $team_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set grader_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+set team_name [database_to_tcl_string_or_null $db "select team_name from edu_teams where team_id=$team_id"]
+
+if {$team_name==""} {
+    ad_return_complaint 1 "<li>You must call this page with a valid Team ID"
+
+    return
+}
+
+
+set return_string "
+[ad_header "Team Evaluations @ [ad_system_name]"]
+
+<h2>Evaluation for $team_name</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" "Administration"] [list "" Teams] [list "one.tcl?team_id=$team_id" "One Team"] "Add Evaluation"]
+
+<hr>
+<blockquote>
+
+<form method=post action=\"evaluation-add-2.tcl\">
+<table>
+<tr>
+<th align=right>Evaluation Type</th>
+<td><input type=text size=40 name=evaluation_type></td>
+</tr>
+<tr>
+<th align=right>Grade</th>
+<td><input type=text size=5 name=grade></td>
+</tr>
+<tr>
+<th align=right>Comments</th>
+<td>[edu_textarea comments]</td>
+</tr>
+<tr>
+<th align=right>Make Evaluation Visible to Team?</th>
+<td><input type=checkbox name=show_team_p checked></td>
+</tr>
+[export_form_vars team_id]
+<tr>
+<th></th>
+<td><input type=submit value=Submit></td>
+</tr>
+</table>
+</form>
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
Index: web/openacs/www/education/class/admin/teams/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/teams/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/teams/index.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,120 @@
+#
+# /www/education/class/admin/teams/index.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# This lists all of the teams in the class with some information about each
+#
+
+# this does not expect to receive anything
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set return_string "
+[ad_header "View Teams for $class_name"]
+<h2>$class_name Teams</h2>
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" "Administration"] "Teams"]
+
+<hr>
+
+<blockquote>
+"
+
+
+# set sql "
+#     select count(distinct user_id) as n_members,
+#            team_name,
+#            team_id
+#       from edu_teams,
+#            user_group_map
+#      where team_id = group_id(+)
+#        and class_id = $class_id
+#    group by team_name, team_id"
+
+
+set sql "\
+select count(distinct user_id) as n_members,
+           team_name,
+           team_id
+      from edu_teams,
+           user_group_map
+     where team_id = group_id
+       and class_id = $class_id
+   group by team_name, team_id
+union
+select count(distinct user_id) as n_members,
+           team_name,
+           team_id
+      from edu_teams,
+           user_group_map
+     where not exists (select 1 from user_group_map
+                       where group_id = team_id)
+       and class_id = $class_id
+   group by team_name, team_id"
+
+set selection [ns_db select $db $sql]
+
+
+set count 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    if {!$count} {
+	append return_string "
+	<table border=1 cellpadding=2>
+	<tr>
+	<td>Team Name</td>
+	<td>Size of Team</td>
+	<td>&nbsp;</td>
+	</tr>"
+    }
+
+    append return_string "
+    <tr>
+    <td><a href=\"one.tcl?team_id=$team_id\">$team_name</a></td>
+    <td align=center>$n_members</td>
+    <td><a href=\"evaluation-add.tcl?[export_url_vars team_id]\">Comment</a> |  
+    <a href=\"edit.tcl?team_id=$team_id\">Edit</a>"
+
+    if {$n_members > 0} {
+	append return_string "
+	| <a href=\"spam.tcl?who_to_spam=member&subgroup_id=$team_id\">Spam</a>"
+    } 
+
+    append return_string "
+    </td>
+    </tr>"
+
+    incr count
+}
+
+if {$count} {
+    append return_string "</table>"
+} else {
+    append return_string " 
+    There are no teams for $class_name<Br>"
+}
+
+append return_string "
+<br>
+<a href=\"create.tcl\">Create a team</a>
+</blockquote>
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/teams/one.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/teams/one.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/teams/one.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,224 @@
+#
+# /www/education/class/admin/teams/one.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page displays information about a given team
+#
+
+ad_page_variables {
+    team_id
+}
+
+validate_integer team_id $team_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+set exception_count 0
+set exception_text ""
+
+if {[empty_string_p $team_id]} {
+    incr exception_count
+    append exception_text "<li>You must provide a team identification number"
+} else {
+    set selection [ns_db 0or1row $db "select
+                     team_name
+                from edu_teams
+               where team_id = $team_id
+                 and class_id = $class_id"]
+
+    if {$selection == ""} {
+	incr exception_count
+	append exception_text "<li>The team number that you have provided is not a team in this class."
+    } else {
+	set_variables_after_query
+    }
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+
+set return_string "
+[ad_header "One Team in $class_name @ [ad_system_name]"]
+<h2>$team_name</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" Administration] [list "" "Teams"] "One Team"]
+
+<hr>
+
+<blockquote>
+
+<table>
+
+<h3>Team Members</h3>
+<ul>
+"
+
+# Note: we don't explicitly use the last_name column but the query
+# breaks if you remove it.  See Oracle error ORA-01791.
+set selection [ns_db select $db "select distinct users.user_id as student_id, 
+             first_names || ' ' || last_name as student_name,
+             last_name
+        from edu_teams, 
+             user_group_map map, 
+             users 
+       where team_id = map.group_id 
+         and map.user_id = users.user_id
+         and team_id = $team_id
+     order by last_name"]
+
+set count 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append return_string "<li><a href=\"../users/student-info.tcl?student_id=$student_id\">$student_name</a> &nbsp &nbsp (<a href=\"user-remove.tcl?student_id=$student_id&team_id=$team_id\">remove from team</a>)\n"
+    incr count
+}
+
+if {$count == 0} {
+    append return_string "There are not currently any students assigned to this team.<br><Br>"
+} else {
+    append return_string "
+    <Br><Br>
+    <li><a href=\"../spam.tcl?who_to_spam=member&subgroup_id=$team_id\">Spam Team</a>
+    "
+
+    # if some spams have already been sent, lets link to them here
+    set n_spams_sent [database_to_tcl_string $db "select count(spam_id) from group_spam_history where group_id = $team_id"]
+    if {$n_spams_sent > 0} {
+	append return_string "[ad_space 1] (<a href=\"../spam-history.tcl?group_id=$team_id\">$n_spams_sent</a> sent)"
+    }
+}
+
+if {[database_to_tcl_string $db "select count(distinct user_id) from user_group_map where group_id = $class_id and role = '[edu_get_student_role_string]'"] > $count} {
+    set target_url "[edu_url]class/admin/teams/user-add.tcl"
+    set a [ns_conn urlv]
+    append return_string "
+    <li><a href=\"../users/students-view.tcl?view_type=team_student_add&team_id=$team_id&target_url=[ns_urlencode "$target_url"]&target_url_vars=[ns_urlencode "team_id=$team_id"]\">Add a Team Member</a>"
+}
+
+
+append return_string "
+</ul>
+
+
+<h3>Projects</h3>
+<ul>
+"
+
+set selection [ns_db select $db "select map.project_instance_id, 
+        project_instance_name, 
+        project_instance_url, 
+        coalesce(inst.description, proj.description) as description
+   from edu_project_instances inst, 
+        edu_project_user_map map,
+        edu_projects proj
+  where team_id = $team_id 
+    and map.project_instance_id = inst.project_instance_id
+    and inst.project_id = proj.project_id"]
+
+set n_projects 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr n_projects
+    append return_string "<li><a href=\"../projects/instance-info.tcl?project_instance_id=$project_instance_id\">$project_instance_name</a> - $description"
+    if {![empty_string_p $project_instance_url]} {
+	append return_string " (<a href=\"$project_instance_url\">$project_instance_url</a>)"
+    }
+}
+
+if {$n_projects == 0} {
+    append return_string "This team has not been assigned to any projects."
+}
+
+
+
+append return_string "
+<p>
+Project-add-team.tcl
+</ul>
+
+<h3>Evaluations</h3>
+<ul>"
+
+# now get the evaluations (excluding assignments) for the student
+
+set selection [ns_db select $db "
+select e.grader_id,
+first_names || ' ' || last_name as grader_name,
+evaluation_type,
+grade,
+comments,
+evaluation_date,
+evaluation_id
+from edu_student_evaluations e,
+users
+where e.team_id=$team_id
+and users.user_id = e.grader_id
+and e.class_id=$class_id"]
+
+set count 0
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    
+    incr count
+    append return_string "
+    <p>
+    <table>
+    <tr>
+    <th align=right>Evaluation Type:</th>
+    <td>$evaluation_type</td>
+    </tr>
+    <tr>
+    <th align=right>Grade:</th>
+    <td>$grade</td>
+    </tr>
+    <tr>
+    <th align=right>Comments:</th>
+    <td>$comments</td>
+    </tr>
+    <tr>
+    <th align=right>Evaluated By:</th>
+    <td><a href=\"../users/one.tcl?user_id=$grader_id\">$grader_name</a></td>
+    </tr>
+    <tr>
+    <th align=right>Evaluation Date:</th>
+    <td>[util_AnsiDatetoPrettyDate $evaluation_date]</td>
+    </tr>
+    </table>
+    </p>"
+}
+
+if {!$count} {
+    append return_string "No evaluations available."
+}
+
+append return_string "
+<p><a href=\"evaluation-add.tcl?team_id=$team_id\">Add an Evaluation</a>
+</ul>
+<p>
+<a href=\"edit.tcl?team_id=$team_id\">edit team name</a>
+</blockquote>
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/teams/user-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/teams/user-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/teams/user-add.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,131 @@
+#
+# /www/education/class/admin/teams/user-add.tcl
+#
+# randyg@arsdigita.com, aileen@mit.edu, February 2000
+#
+# this page confirms the addition of the student to the team
+#
+
+ad_page_variables {
+    team_id
+    student_id
+    {return_url ""}
+}
+
+validate_integer team_id $team_id
+validate_integer student_id $student_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set exception_count 0
+set exception_text ""
+
+if {[empty_string_p $team_id]} {
+    incr exception_count
+    append exception_text "<li>You must provide a team number."
+}
+
+if {[empty_string_p $student_id]} {
+    incr exception_count
+    append exception_text "<li>You must include the student to be added to the team."
+}
+
+if {$exception_count == 0} {
+
+    # we do an outer join here so we can see whether or not the user is 
+    # already a member of the team.
+
+#     set sql "select count(member_id) as member_p,
+#              team_name,
+#              first_names, 
+#              last_name 
+#         from users, 
+#              edu_teams, 
+#              (select distinct user_id as member_id from user_group_map where group_id = $team_id) team_members
+#        where users.user_id = $student_id
+#          and edu_teams.team_id = $team_id
+#          and edu_teams.class_id = $class_id
+#          and users.user_id = team_members.member_id(+)
+#     group by team_name, first_names, last_name"
+
+    set sql "select distinct count(ugm.user_id) as member_p,
+             team_name,
+             first_names, 
+             last_name 
+        from users, 
+             edu_teams, 
+             user_group_map ugm             
+       where users.user_id = $student_id
+         and ugm.group_id = $team_id
+         and edu_teams.team_id = $team_id
+         and edu_teams.class_id = $class_id
+    group by team_name, first_names, last_name"
+
+    set selection [ns_db 0or1row $db $sql]
+
+
+    if {$selection == ""} {
+	incr exception_count
+	append exception_text "<li>The team number that you have provided is not a team in this class."
+    } else {
+	set_variables_after_query
+
+	# in this case, we want to see if the user is already a member
+
+	if {$member_p != 0} {
+	    incr exception_count
+	    append exception_text "<li>$first_names $last_name is already a member of this team."
+	}
+    }
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+set group_id $team_id
+
+if {[empty_string_p $return_url]} {
+    set return_url "[edu_url]class/admin/teams/one.tcl?team_id=$team_id"
+}
+
+set return_string "
+[ad_header "Add a Student to $team_name @ [ad_system_name]"]
+<h2>Add a student to $team_name</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" Administration] [list "" "Teams"] [list "one.tcl?team_id=$team_id" "One Team"] "Add a User"]
+
+<hr>
+
+<blockquote>
+
+<form method=post action=\"../group-user-add.tcl\">
+[export_form_vars group_id student_id return_url]
+
+Are you sure you wish to add <u>$first_names $last_name</u> to $team_name?
+<p>
+<input type=submit value=\"Add Student\">
+
+</blockquote>
+
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/teams/user-remove.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/teams/user-remove.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/teams/user-remove.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,109 @@
+#
+# /www/education/class/admin/teams/user-remove.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this is the confirmation page to see if the person really wants
+# to remove the user from the team
+#
+
+ad_page_variables {
+    team_id
+    student_id
+}
+
+validate_integer team_id $team_id
+validate_integer student_id $student_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set exception_count 0
+set exception_text ""
+
+if {[empty_string_p $team_id]} {
+    incr exception_count
+    append exception_text "<li>You must provide a team number."
+}
+
+if {[empty_string_p $student_id]} {
+    incr exception_count
+    append exception_text "<li>You must include the student to be added to the team."
+}
+
+if {$exception_count == 0} {
+
+    # we do an outer join here so we can see whether or not the user is 
+    # already a member of the team.
+
+    set selection [ns_db 0or1row $db "select distinct team_name,
+             first_names, 
+             last_name 
+        from users, 
+             edu_teams, 
+             user_group_map map
+       where users.user_id = $student_id
+         and edu_teams.team_id = $team_id
+         and edu_teams.class_id = $class_id
+         and users.user_id = map.user_id
+         and map.group_id = edu_teams.team_id"]
+
+
+    if {$selection == ""} {
+	incr exception_count
+	append exception_text "<li>The student is not a member of this team."
+    } else {
+	set_variables_after_query
+    }
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+set group_id $team_id
+
+set return_url "teams/one.tcl?team_id=$team_id"
+
+set return_string "
+[ad_header "Teams for $class_name @ [ad_system_name]"]
+<h2>Remove User from Team</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" Administration] [list "" "Teams"] [list "one.tcl?team-id=$team_id" "One Team"] "Remove User"]
+
+<hr>
+
+<blockquote>
+
+<form method=post action=\"../group-user-remove.tcl\">
+[export_form_vars group_id student_id return_url]
+
+Are you sure you wish to remove <u>$first_names $last_name</u> from $team_name?
+
+<p>
+
+<input type=submit value=\"Remove Student\">
+
+</blockquote>
+
+[ad_footer]
+"
+
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/textbooks/add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/textbooks/add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/textbooks/add-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,142 @@
+#
+# /www/education/class/admin/textbooks/add.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page allows the user to confirm the information about the textbook
+# they are about to add
+
+ad_page_variables {
+    title
+    author
+    {isbn ""}
+    {comments ""}
+    {publisher ""}
+    {required_p f}
+}
+
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Edit Class Properties"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+#lets check the input
+set exception_text ""
+set exception_count 0
+
+if {[empty_string_p $title]} {
+    incr exception_count
+    append exception_text "<li>You must provide a title."
+}
+
+if {[empty_string_p $author]} {
+    incr exception_count
+    append exception_text "<li>You must provide an author."
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+if {[empty_string_p $isbn]} {
+    set actual_isbn "None Provided"
+} else {
+    set actual_isbn $isbn
+}
+
+
+
+set return_string "
+[ad_header "$class_name @ [ad_system_name]"]
+
+<h2>Add a Text Book</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" "Administration"] "Add a Text Book"]
+
+<hr>
+
+<blockquote>
+"
+
+# search if isbn is already in the db, if so, ask them if they just want to 
+# add the textbook
+set textbook_id [database_to_tcl_string_or_null $db "select textbook_id from edu_textbooks where isbn='$isbn'"]
+
+if {![empty_string_p $textbook_id]} {
+    ns_returnredirect "add-to-class.tcl?textbook_id=$textbook_id"
+    return
+} else {
+    set textbook_id [database_to_tcl_string $db "select edu_textbooks_sequence.nextval from dual"]
+}
+    
+if { [string compare $required_p  t ] == 0 } { 
+    set required_pretty 'Yes' 
+} else { 
+    set required_pretty 'No' 
+}
+
+append return_string "
+<form method=get action=\"add-3.tcl\">
+[export_form_vars title author isbn comments publisher required_p textbook_id]
+
+<table>
+
+<tr>
+<th align=right>Title:</td>
+<td>$title
+</tr>
+
+<tr>
+<th align=right>Author:</td>
+<td>$author
+</tr>
+
+<tr>
+<th align=right>Publisher:</td>
+<td>$publisher
+</tr>
+
+<tr>
+<th align=right>ISBN:</td>
+<td>$actual_isbn
+</tr>
+
+<tr>
+<th align=right>Comments:</td>
+<td>$comments
+</tr>
+
+<tr>
+<th align=right>Required?</td>
+<td>
+$required_pretty
+</td>
+</tr>
+<tr>
+<td colspan=2 align=center><input type=submit value=\"Add Textbook\">
+</td>
+</tr>
+</table>
+</form>
+
+</blockquote>
+
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
Index: web/openacs/www/education/class/admin/textbooks/add-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/textbooks/add-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/textbooks/add-3.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,106 @@
+#
+# /www/education/class/admin/textbooks/add-3.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# This page inserts the new textbook into the database
+
+ad_page_variables {
+    title
+    author
+    textbook_id
+    {isbn ""}
+    {comments ""}
+    {publisher ""}
+    {required_p f}
+}
+
+validate_integer textbook_id $textbook_id
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Edit Class Properties"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+#lets check the input
+set exception_text ""
+set exception_count 0
+
+if {[empty_string_p $title]} {
+    incr exception_count
+    append exception_text "<li>You must provide a title."
+}
+
+if {[empty_string_p $author]} {
+    incr exception_count
+    append exception_text "<li>You must provide an author."
+}
+
+if {[empty_string_p $textbook_id]} {
+    incr exception_count
+    append exception_text "<li>You must provide a text book identification number."
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# check for a double-click
+if {[database_to_tcl_string $db "select count(textbook_id) from edu_textbooks where textbook_id = $textbook_id"] > 0} {
+    ns_returnredirect ""
+    return
+}
+
+
+if {![empty_string_p $isbn]} {
+    #now lets trim the white space from the beginning and end of the isbn
+    set isbn [string trim $isbn]
+    
+    #now we want to strip out all '-' that may appear in the string
+    regsub -all {\-} $isbn "" isbn
+}
+
+
+ns_db dml $db "begin transaction"
+
+ns_db dml $db "insert into edu_textbooks (
+                               textbook_id,
+                               title,
+                               author,
+                               publisher,
+                               isbn)
+                           values (
+                               $textbook_id,
+                               [ns_dbquotevalue $title],
+                               [ns_dbquotevalue $author],
+                               [ns_dbquotevalue $publisher],
+                               '$isbn')"
+
+ns_db dml $db "insert into edu_classes_to_textbooks_map (
+                            class_id, 
+                            textbook_id,
+                            comments,
+                            required_p)
+                       values (
+                            $class_id,
+                            $textbook_id,
+                            [ns_dbquotevalue $comments],
+                            '$required_p')"
+
+ns_db dml $db "end transaction"
+
+ns_db releasehandle $db
+
+ns_returnredirect ""
+
+
+
Index: web/openacs/www/education/class/admin/textbooks/add-to-class-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/textbooks/add-to-class-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/textbooks/add-to-class-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,36 @@
+#
+# /www/education/class/admin/textbooks/add-to-class.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# associates an existing textbook to a class
+#
+
+ad_page_variables {
+    textbook_id
+    {comments ""}
+    {required_p f}
+}
+
+validate_integer textbook_id $textbook_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Edit Class Properties"]
+set class_id [lindex $id_list 1]
+
+# make sure this association does not already exist
+
+if {[database_to_tcl_string $db "select count(textbook_id) from edu_classes_to_textbooks_map where textbook_id=$textbook_id and class_id=$class_id"]==0} {
+
+    ns_db dml $db "insert into edu_classes_to_textbooks_map
+    (class_id, textbook_id, comments, required_p)
+    values
+    ($class_id, $textbook_id, '$QQcomments', '$required_p')
+    "
+
+}
+
+ns_db releasehandle $db
+
+ns_returnredirect ""
Index: web/openacs/www/education/class/admin/textbooks/add-to-class.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/textbooks/add-to-class.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/textbooks/add-to-class.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,99 @@
+#
+# /www/education/class/admin/textbooks/add-to-class.tcl
+#
+# this page confirms that you want to add the given text book to the given class
+# 
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+
+ad_page_variables {
+    textbook_id
+}
+
+validate_integer textbook_id $textbook_id
+
+if {[empty_string_p $textbook_id]} {
+    ad_return_complaint 1 "<li>You must include a textbook to be added."
+    return
+}
+
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Edit Class Properties"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+set selection [ns_db 0or1row $db "select * from edu_textbooks where textbook_id=$textbook_id"]
+
+if {$selection == ""} {
+    ad_return_complaint 1 "<li>You called this page with an invalid textbook ID"
+    return
+}
+
+set_variables_after_query
+
+
+set return_string "
+[ad_header "$class_name @ [ad_system_name]"]
+
+<h2>Add a Text Book</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" "Administration"] "Add a Text Book"]
+
+<hr>
+
+<blockquote>
+
+<form method=get action=\"add-to-class-2.tcl\">
+[export_form_vars textbook_id]
+
+<p>
+<table>
+<tr>
+<th align=right>Title:</td>
+<td>$title</td>
+</tr>
+
+<tr>
+<th align=right>Author:</td>
+    <td>$author</td>
+</tr>
+    
+<tr>
+<th align=right>Publisher:</td>
+<td>$publisher</td>
+</tr>
+
+<tr>
+<th align=right>ISBN:</td>
+<td>$isbn</td>
+</tr>
+
+<tr>
+<th align=right>Comments:</td>
+<td>[edu_textarea comments]</td>
+</tr>
+
+<tr>
+<th align=right>Required?</td>
+<td><input type=checkbox name=required_p value=t checked></td>
+</tr>
+
+<tr>
+<td colspan=2 align=center><input type=submit value=\"Add Textbook\">
+</td>
+</tr>
+</table>
+</form>
+</blockquote>
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
Index: web/openacs/www/education/class/admin/textbooks/add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/textbooks/add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/textbooks/add.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,94 @@
+#
+# /www/education/class/admin/textbooks/add.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page allows a prof to add a textbook for the class
+
+# it does not expect any input
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Edit Class Properties"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set return_string "
+[ad_header "$class_name @ [ad_system_name]"]
+
+<h2>Add a Text Book</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" "Administration"] "Add a Text Book"]
+
+<hr>
+
+To add a book, fill out the information below.  Providing the ISBN
+number allows the system to search online book stores and price
+compare.
+
+<h3>Search if the textbook is already in the database</h3>
+<form method=post action=\"search.tcl\">
+By Title/Author/Publisher: <input type=text size=40 name=search_string>
+<p>
+By ISBN: <input type=text size=40 name=search_isbn>
+<p>
+
+<input type=submit value=Search>
+</form>
+
+<hr>
+<form method=get action=\"add-2.tcl\">
+<table>
+
+<tr>
+<th align=right>Title:</td>
+<td><input type=text name=title size=30 maxsize=200></td>
+</tr>
+
+<tr>
+<th align=right>Author:</td>
+<td><input type=text name=author size=30 maxsize=400></td>
+</tr>
+
+<tr>
+<th align=right>Publisher:</td>
+<td><input type=text name=publisher size=30 maxsize=200></td>
+</tr>
+
+<tr>
+<th align=right>ISBN:</td>
+<td><input type=text name=isbn size=15 maxsize=30></td>
+</tr>
+
+<tr>
+<th align=right>Comments:</td>
+<td>[edu_textarea comments]</td>
+</tr>
+
+<tr>
+<th align=right>Required?</th>
+<td><input type=checkbox name=required_p value=t checked></td>
+</tr>
+<tr>
+<td colspan=2 align=center><input type=submit value=Continue>
+</td>
+</tr>
+</table>
+</form>
+
+</blockquote>
+
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
Index: web/openacs/www/education/class/admin/textbooks/edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/textbooks/edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/textbooks/edit-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,102 @@
+#
+# /www/education/class/admin/textbooks/edit.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu
+#
+# This confirms the information for the textbook
+#
+
+ad_page_variables {
+    textbook_id
+    publisher
+    isbn
+    author
+    title
+}
+
+validate_integer textbook_id $textbook_id
+
+set exception_count 0
+set exception_text ""
+
+if {[empty_string_p $title]} {
+    incr exception_count 
+    append exception_text "<li>You must include a title for this book."
+}
+
+
+if {[empty_string_p $textbook_id]} {
+    incr exception_count 
+    append exception_text "<li>You must include an identification number for the book."
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Edit Class Properties"]
+set class_id [lindex $id_list 1]
+
+set validation_sql "select count(tb.textbook_id)
+ from edu_textbooks tb,
+      edu_classes_to_textbooks_map map
+where tb.textbook_id = $textbook_id 
+  and map.textbook_id = tb.textbook_id
+  and map.class_id = $class_id"
+
+if {[database_to_tcl_string $db $validation_sql] == 0} {
+    ad_return_complaint 1 "<li>You are not authorized to edit this book."
+    return
+}
+
+
+set return_string "
+[ad_header "Textbooks @ [ad_system_name]"]
+
+<h2>Confirm Edit Textbook Information</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "Class Home"] [list "../../textbook-info.tcl?textbook_id=$textbook_id "Text Book Information"] "Confrim Edit"]
+
+<hr>
+<blockquote>
+
+<table>
+<form method=post action=\"edit-3.tcl\">
+<tr>
+<th align=right>Title:</th>
+<td>$title</td>
+</tr>
+<tr>
+<th align=right>Author:</th>
+<td>$author</td>
+</tr>
+<tr>
+<th align=right>Publisher:</th>
+<td>$publisher</td>
+</tr>
+<tr>
+<th align=right>ISBN:</th>
+<td>$isbn</td>
+</tr>
+[export_entire_form]
+<tr><th></th>
+<td><input type=submit value=Continue></td>
+</tr>
+</form>
+</table>
+
+</blockquote>
+
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
Index: web/openacs/www/education/class/admin/textbooks/edit-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/textbooks/edit-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/textbooks/edit-3.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,56 @@
+#
+# /www/education/class/admin/textbooks/edit-3.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page updates the textbooks table to reflect the changes
+#
+
+ad_page_variables {
+    author
+    title
+    isbn
+    textbook_id
+    publisher
+}
+
+validate_integer textbook_id $textbook_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Edit Class Properties"]
+set class_id [lindex $id_list 1]
+
+set validation_sql "select count(tb.textbook_id)
+ from edu_textbooks tb,
+      edu_classes_to_textbooks_map map
+where tb.textbook_id = $textbook_id 
+  and map.textbook_id = tb.textbook_id
+  and map.class_id = $class_id"
+
+if {[database_to_tcl_string $db $validation_sql] == 0} {
+    ad_return_complaint 1 "<li>You are not authorized to edit this book."
+    return
+}
+
+
+if {![empty_string_p $isbn]} {
+    #now lets trim the white space from the beginning and end of the isbn
+    set isbn [string trim $isbn]
+    
+    #now we want to strip out all '-' that may appear in the string
+    regsub -all {\-} $isbn "" isbn
+}
+
+
+ns_db dml $db "update edu_textbooks
+set title='$title', 
+    publisher='$publisher', 
+    isbn='$isbn', 
+    author='$author'
+where textbook_id=$textbook_id"
+
+ns_db releasehandle $db
+
+ns_returnredirect "../"
+
Index: web/openacs/www/education/class/admin/textbooks/edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/textbooks/edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/textbooks/edit.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,101 @@
+#
+# /www/education/class/admin/textbooks/edit.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu
+#
+# this page allows the user to edit the properties of a particular textbook
+#
+
+ad_page_variables {
+    textbook_id
+}
+
+validate_integer textbook_id $textbook_id
+
+if {[empty_string_p $textbook_id]} {
+    ad_return_complaint 1 "<li>You must provide a textbook identification number.
+    return
+}
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Edit Class Properties"]
+set class_id [lindex $id_list 1]
+
+set selection [ns_db 0or1row $db "select title, 
+      author, 
+      publisher, 
+      isbn 
+ from edu_textbooks tb,
+      edu_classes_to_textbooks_map map
+where tb.textbook_id = $textbook_id 
+  and map.textbook_id = tb.textbook_id
+  and map.class_id = $class_id"]
+
+
+if {$selection == ""} {
+    ad_return_complaint 1 "<li>The textbook identification number you have provided is not valid."
+    return
+} else {
+    set_variables_after_query
+}
+
+
+set return_string "
+[ad_header "Textbooks @ [ad_system_name]"]
+
+<h2>Edit Textbook Information</h2>
+
+[ad_context_bar_ws_or_index [list "../" "Class Home"] [list "../../textbook-info.tcl?textbook_id=$textbook_id" "Text Book Information"] "Edit"]
+
+<hr>
+<blockquote>
+
+<table>
+<form method=post action=\"edit-2.tcl\">
+<tr>
+<th align=right>Title:</th>
+<td><input type=text size=40 value=\"$title\" name=title></td>
+</tr>
+<tr>
+<th align=right>Author:</th>
+<td><input type=text size=40 value=\"$author\" name=author></td>
+</tr>
+<tr>
+<th align=right>Publisher:</th>
+<td><input type=text size=40 value=\"$publisher\" name=publisher></td>
+</tr>
+
+<tr>
+<th align=right>ISBN:</th>
+<td><input type=text size=40 value=\"$isbn\" name=isbn></td>
+</tr>
+
+[export_form_vars textbook_id]
+<tr><th></th>
+<td><input type=submit value=Submit></td>
+</tr>
+</form>
+</table>
+</blockquote>
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/textbooks/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/textbooks/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/textbooks/index.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1 @@
+ns_returnredirect ../
Index: web/openacs/www/education/class/admin/textbooks/remove-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/textbooks/remove-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/textbooks/remove-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,36 @@
+#
+# /www/education/class/admin/textbooks/remove-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page removes the book from the class to textbook mapping table 
+# and so is removing the book from the class
+#
+
+ad_page_variables {
+    textbook_id
+}
+
+validate_integer textbook_id $textbook_id
+
+if {[empty_string_p $textbook_id]} {
+    ad_return_complaint 1 "<li>You must include a textbook to remove."
+    return
+}
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Edit Class Properties"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+
+ns_db dml $db "delete from edu_classes_to_textbooks_map where class_id=$class_id and textbook_id=$textbook_id
+"
+
+ns_db releasehandle $db
+
+ns_returnredirect ""
Index: web/openacs/www/education/class/admin/textbooks/remove.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/textbooks/remove.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/textbooks/remove.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,86 @@
+#
+# /www/education/class/admin/textbooks/remove.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu
+#
+# this page confirms that the user wants to remove this textbook from the class
+#
+
+ad_page_variables {
+    textbook_id
+}
+
+validate_integer textbook_id $textbook_id
+
+if {[empty_string_p $textbook_id]} {
+    ad_return_complaint 1 "<li>You must provide a textbook identification number.
+    return
+}
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Edit Class Properties"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+set user_id [lindex $id_list 0]
+
+set selection [ns_db 0or1row $db "select title, author, publisher, isbn from edu_textbooks where textbook_id = $textbook_id"]
+
+if {$selection == ""} {
+    ad_return_complaint 1 "<li>The textbook identification number you have provided is not valid."
+    return
+} else {
+    set_variables_after_query
+}
+
+
+set return_string "
+[ad_header "Textbooks @ [ad_system_name]"]
+
+<h2>Remove a Textbook</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" "$class_name Administration"] "Remove Textbook"]
+
+<hr>
+<b>Are you sure you want to remove the following textbook from $class_name?</b>
+<p>
+<blockquote>
+<form method=post action=\"remove-2.tcl\">
+[export_form_vars textbook_id]
+
+<table>
+<tr><th align=right>Title:</th>
+<td>$title</td>
+</tr>
+
+<tr>
+<th align=right>Author:</th>
+<td>$author</td>
+</tr>
+
+<tr>
+<th align=right>Publisher:</th>
+<td>[edu_maybe_display_text $publisher]</td>
+</tr>
+
+<tr>
+<th align=right>ISBN:</th>
+<td>[edu_maybe_display_text $isbn]</td>
+</tr>
+
+<tr>
+<th></th>
+<td><input type=submit value=Confirm></td>
+</tr>
+</table>
+</form>
+</blockquote>
+
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
Index: web/openacs/www/education/class/admin/textbooks/search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/textbooks/search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/textbooks/search.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,152 @@
+#
+# /www/education/class/admin/textbooks/search.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# This page shows a list of textbooks that match the search criteria
+# 
+
+ad_page_variables {
+    search_string
+    search_isbn
+}
+
+# either search_string or isbn must be not null
+
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Edit Class Properties"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+if {[empty_string_p $search_string] && [empty_string_p $search_isbn]} {
+    ad_return_complaint 1 "<li>You need to enter either a search string or an ISBN number."
+    return
+} elseif {![empty_string_p $search_string] && ![empty_string_p $search_isbn]} {
+    ad_return_complaint 1 "<li>You must search by either a string or the ISBN.  You cannot search by both."
+    return
+}
+
+
+if { ![empty_string_p $search_string] } {
+    set search_text "Author/Title/Publisher \"$search_string\""
+    set search_clause "
+    lower(author) like [ns_dbquotevalue %[string tolower $search_string]%]
+    or lower(publisher) like [ns_dbquotevalue %[string tolower $search_string]%]
+    or lower(title) like [ns_dbquotevalue %[string tolower $search_string]%]"
+} else {
+    set search_text "ISBN \"$search_isbn\""
+    set search_clause "lower(isbn) like [ns_dbquotevalue %[string tolower $search_isbn]%]"
+}
+
+
+# lets get a list of books so we can see whether or not a
+# book matching the criteria in already in the class.  We do
+# not want to do a join because we want to display different
+# types of error messages
+
+set textbook_id_list [database_to_tcl_list $db "select map.textbook_id 
+      from edu_textbooks, 
+           edu_classes_to_textbooks_map map 
+     where class_id = $class_id 
+       and map.textbook_id = edu_textbooks.textbook_id"]
+
+set selection [ns_db select $db "
+select t.textbook_id, author, publisher, 
+       title, isbn
+  from edu_textbooks t
+ where $search_clause"]
+
+
+set return_string "
+[ad_header "$class_name @ [ad_system_name]"]
+
+<h2>Text Book Search Results</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" "Administration"] [list "add.tcl" "Add a Text Book"] "Textbook Search"]
+<hr>
+<blockquote>
+"
+
+set count 0
+# count of how many books is actually available for add
+set addable 0 
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    
+    if {!$count} {
+	append return_string "
+	<table cellpadding=2>
+	<tr><th align=left>Title</th>
+	<th align=left>Author</th>
+	<th align=left>Publisher</th>
+	<th align=left>ISBN</th>
+	<th align=left></th>
+	</tr>
+	"
+    }
+
+    append return_string "
+    <tr><td>$title</td>
+    <td>$author</td>
+    <td>$publisher</td>
+    <td>$isbn</td>
+    <td>"
+
+    if {[lsearch $textbook_id_list $textbook_id] == -1} {
+	append return_string "
+	<a href=\"add-to-class.tcl?textbook_id=$textbook_id\">Add to class</a>"
+	incr addable
+    } 
+
+    append return_string "
+    </td>
+    </tr>"
+    incr count
+}
+
+if {$count == 0} {
+    append return_string "
+    <p>
+    No textbooks matched your search criteria. Please <a href=\"add.tcl\">
+    Add the textbook</a>
+    </P>"
+} else {
+    append return_string "
+    </table>"
+
+    if {!$addable} {
+	append return_string "
+	<p>
+	All textbooks that matched your search criteria are already added to $class_name. <p>
+	<a href=\"add.tcl\">Add a new textbook</a>
+	</P>"
+    }
+
+}
+
+append return_string "
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/users/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/users/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/users/index.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,214 @@
+# 
+# /www/education/class/admin/users/index.tcl
+# 
+# by randyg@arsdigita.com, aileen@mit.edu January, 2000
+#
+# This file lists all of the users for a given class (group) and 
+# divides them by role.  In addition, it allows the caller to show
+# only people with "emails beginning with" or "last name beginning with"
+#
+
+ad_page_variables {
+    {target_url ""}
+    {type ""}
+    {target_url_params ""}
+    {section_id ""}
+}
+
+validate_integer section_id $section_id
+
+#This is a list of all the users in a given company and provides
+#links to different functions regarding those users
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+set sql_restriction ""
+
+if {![empty_string_p $target_url]} {
+    if {[string compare $type section_leader] == 0} {
+	set header_string "Select a Section Instructor"
+	set end_string ""
+    } else {
+	set header_string "$class_name Users"
+	set end_string "<a href=\"add.tcl\">Add a User</a>"	
+    }
+} else {
+    set target_url "one.tcl"
+    set header_string "$class_name Users"
+    set end_string "<a href=\"add.tcl\">Add a User</a>"
+}
+
+
+
+set return_string "
+[ad_header "$class_name @ [ad_system_name]"]
+
+
+<h2>$header_string</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" "Administration"] Users]
+
+<hr>
+<blockquote>
+"
+
+set threshhold 75
+
+#see if there are more than $threshhold users
+#if so, give search options
+#if not, list all of the users
+
+if {[database_to_tcl_string $db "select count(distinct user_id) from user_group_map where group_id = $class_id"] < $threshhold } {
+
+    append return_string "
+    <h3>Current Users</h3>
+    <blockquote>
+    "
+
+    # if there is a target url, make all users go to the same url
+    # otherwise, have them go to one.tcl
+
+    set spam_links t
+    set variable_name user_id
+    set sql_restriction ""
+    if {[empty_string_p $target_url]} {
+	set target_url one.tcl
+    }
+
+    if {[string compare $type section_leader] == 0} {
+	    if {![empty_string_p $section_id]} {
+		set sql_restriction "and user_group_map.user_id not in (select user_id from user_group_map where group_id = $section_id and lower(role) = 'administrator')"
+	    }
+	    set variable_name instructor_id
+	    set spam_links f
+
+	    set role_list_restriction "and (lower(roles.role) = lower('[edu_get_professor_role_string]') or lower(roles.role) = lower('[edu_get_ta_role_string]'))"
+    } else {
+	set role_list_restriction ""
+    }
+
+	set role_list [database_to_tcl_list_list $db "select 
+                   roles.role, 
+                   pretty_role_plural
+              from user_group_roles roles,
+                   edu_role_pretty_role_map map
+             where roles.group_id = $class_id 
+               and roles.group_id = map.group_id
+               and lower(roles.role) = lower(map.role) $role_list_restriction
+          order by sort_key"]
+
+
+    foreach role $role_list {
+
+	set selection [ns_db select $db "select distinct users.user_id, 
+                       first_names, 
+                       last_name,
+                       lower(last_name) as lower_last_name,
+                       lower(first_names) as lower_first_names
+                  from users, 
+                       user_group_map    
+                 where user_group_map.group_id = $class_id
+                       and users.user_id = user_group_map.user_id 
+                       and lower(role) = lower('[lindex $role 0]')
+	               $sql_restriction
+              order by lower_last_name, lower_first_names"]
+
+	append return_string "<h3>[lindex $role 1]</h3><ul>"
+
+	set counter 0
+	while {[ns_db getrow $db $selection]} {
+	    set_variables_after_query
+	    incr counter
+	    append return_string "
+	    <li><a href=\"$target_url?$target_url_params&$variable_name=$user_id\">$last_name, $first_names</a><br>\n"
+	}
+	
+	if {$counter == 0} {
+	    append return_string "The are currently no [lindex $role 1] in this class"
+	} elseif {[string compare $spam_links t] == 0} {
+	    append return_string "<br><li><a href=\"../spam.tcl?who_to_spam=[ns_urlencode [list [lindex $role 0]]]\">Spam the [lindex $role 1]</a>"
+	}
+
+
+	append return_string "</ul>\n"
+    }
+    append return_string "</blockquote>"
+
+} else {
+
+    set url_string [export_url_vars type section_id target_url target_url_params header_string]
+
+    append return_string "
+    <li>Browse by last name : 
+    <a href=\"list.tcl?begin=A&end=H&lastletter=G&browse_type=lastname&$url_string\">A - G</a> |
+    <a href=\"list.tcl?begin=H&end=N&lastletter=M&browse_type=lastname&$url_string\">H - M</a> |
+    <a href=\"list.tcl?begin=N&end=T&lastletter=S&browse_type=lastname&$url_string\">N - S</a> |
+    <a href=\"list.tcl?begin=T&end=z&lastletter=Z&browse_type=lastname&$url_string\">T - Z</a> 
+    <br><br>
+    <li>Browse by email address : 
+    <a href=\"list.tcl?begin=A&end=H&lastletter=G&browse_type=email&$url_string\">A - G</a> |
+    <a href=\"list.tcl?begin=H&end=N&lastletter=M&browse_type=email&$url_string\">H - M</a> |
+    <a href=\"list.tcl?begin=N&end=T&lastletter=S&browse_type=email&$url_string\">N - S</a> |
+    <a href=\"list.tcl?begin=T&end=z&lastletter=Z&browse_type=email&$url_string\">T - Z</a> 
+    <br><br>
+    <li><a href=\"list.tcl?begin=A&end=z&lastletter=Z&browse_type=all&$url_string\">Browse All Users</a>
+    <Br>
+    <br>
+    <form method=post action=\"search.tcl\">
+    [export_form_vars type section_id target_url target_url_params header_string]
+    <li>Search:
+    <br>
+    <table>
+    <tr>
+    <td align=right>
+    By last name: 
+    </td>
+    <td><input type=text name=last_name>
+    </td>
+    <tr>
+    <td align=right>
+    By email: 
+    </td>
+    <td>
+    <input type=text name=email>
+    </td>
+    </tr>
+    <tr>
+    <td colspan=2><input type=submit value=\"Search\">
+    </td>
+    </tr>
+    </table>
+    </form>
+    "
+}
+
+append return_string "
+<br>
+
+$end_string
+
+</blockquote>
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/users/info-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/users/info-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/users/info-edit-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,73 @@
+#
+# /www/education/class/admin/users/info-edit-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# This page lets the user review what is about to go into the database
+#
+
+# user_id email field_names from user_group_type_member_fields for edu_class
+
+set_the_usual_form_variables
+
+validate_integer user_id $user_id
+
+set db [ns_db gethandle]
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+set return_string "
+[ad_header "$class_name @ [ad_system_name]"]
+
+<h2>Confirm User Information Edit</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" "Administration"] [list "" Users] [list "one.tcl?user_id=$user_id" "One User"] "Edit"]
+
+<hr>
+<b>Note:</b> Not all fields are applicable to the user.
+<p>
+<blockquote>
+<form method=post action=\"info-edit-3.tcl\">
+[export_entire_form]
+<table>
+<tr><th align=right>Email:</th>
+<td>$email</td>
+</tr>
+"
+
+set selection [ns_db select $db "
+select distinct field_name, sort_key 
+from user_group_type_member_fields mf,
+     user_group_map map
+where map.user_id = $user_id
+  and (mf.role is null or lower(mf.role) = lower(map.role))
+  and map.group_id = $class_id
+  and mf.group_type='edu_class'
+order by sort_key"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    append return_string "
+    <tr>
+    <th align=right>$field_name</th>
+    <td>[set $field_name]</td>
+    </tr>
+    "
+}
+
+append return_string "
+<tr>
+<th></th>
+<td><input type=submit value=Confirm></td>
+</tr>
+</table>
+</form>
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
Index: web/openacs/www/education/class/admin/users/info-edit-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/users/info-edit-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/users/info-edit-3.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,60 @@
+#
+# /www/education/class/admin/users/info-edit-3.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page puts the new user information into the database
+#
+
+set_the_usual_form_variables
+
+# user_id field_names from user_group_type_member_fields for edu_class
+
+validate_integer user_id $user_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+set user_fields [database_to_tcl_list $db "
+select distinct mf.field_name
+from user_group_type_member_fields mf,
+     user_group_map map
+where map.user_id = $user_id
+  and (mf.role is null or lower(mf.role) = lower(map.role))
+  and map.group_id = $class_id
+  and mf.group_type='edu_class'"]
+
+ns_db dml $db "begin transaction"
+
+
+foreach field $user_fields {
+    
+    if {[info exists $field]} {
+	# we try to update it and then see how many
+	# rows were updated.  If it is zero, then we insert
+	ns_db dml $db "update user_group_member_field_map
+                       set field_value = '[DoubleApos [set $field]]'
+                       where user_id = $user_id
+                         and group_id = $class_id
+                         and field_name = '[DoubleApos $field]'"
+
+	set n_updated_rows [ns_pg ntuples $db]
+
+	if {$n_updated_rows == 0} {
+	    # we want to insert it
+	    ns_db dml $db "
+	    insert into user_group_member_field_map
+	    (field_name, user_id, group_id, field_value)
+	    values
+	    ('[DoubleApos $field]', $user_id, $class_id, '[DoubleApos [set $field]]')"
+	}
+    }
+}
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "one.tcl?user_id=$user_id"
+
Index: web/openacs/www/education/class/admin/users/info-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/users/info-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/users/info-edit.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,104 @@
+#
+# /www/education/class/admin/users/info-edit-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# This page lets the user review what is about to go into the database
+#
+
+
+# NOTE: every field mapped to user_id and class_id in 
+# user_group_member_field_map will be wiped out and updated using this script!
+# so be sure that all fields added to user_group_type_member_fields are 
+# included in this edit form
+
+ad_page_variables {
+    user_id
+}
+
+validate_integer user_id $user_id
+
+set db_handles [edu_get_two_db_handles]
+set db [lindex $db_handles 0]
+set db_sub [lindex $db_handles 1]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set return_string "
+[ad_header "$class_name @ [ad_system_name]"]
+
+<h2>Edit User Information</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" "Administration"] [list "" Users] [list "one.tcl?user_id=$user_id" "One User"] "Edit"]
+
+<hr>
+<b>Note:</b> Not all fields are applicable to the user.
+<p>
+<blockquote>
+<form method=post action=\"info-edit-2.tcl\">
+<table>
+"
+
+set email [database_to_tcl_string $db "
+select email from users where user_id=$user_id"]
+
+append return_string "
+<tr><th align=right>Email:</th>
+<td>$email</td></tr>
+"
+
+set selection [ns_db select $db "
+select distinct field_name, sort_key
+from user_group_type_member_fields mf,
+     user_group_map map
+where map.user_id = $user_id
+  and (mf.role is null or lower(mf.role) = lower(map.role))
+  and map.group_id = $class_id
+  and mf.group_type='edu_class'
+order by sort_key"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    append return_string "
+    <tr>
+    <th align=right>$field_name</th>
+    "
+
+    set sub_selection [ns_db 0or1row $db_sub "select distinct field_value 
+    from user_group_member_field_map
+    where field_name='[DoubleApos $field_name]' 
+    and user_id=$user_id
+    and group_id=$class_id"]
+
+    if {$sub_selection!=""} {
+	set_variables_after_subquery
+    } else {
+	set field_value ""
+    }
+    
+    append return_string "
+    <td><input type=text size=40 value=\"$field_value\" name=\"$field_name\"></td>
+    </tr>
+    "
+}
+
+append return_string "
+[export_form_vars user_id email]
+<tr><th></th>
+<td><input type=submit value=Edit></td>
+</tr>
+</table>
+</blockquote>
+</form>
+
+[ad_footer]
+"
+
+ns_db releasehandle $db
+ns_db releasehandle $db_sub
+
+ns_return 200 text/html $return_string
Index: web/openacs/www/education/class/admin/users/list.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/users/list.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/users/list.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,196 @@
+# 
+# /www/education/class/admin/users/user-list.tcl
+# 
+# by randyg@arsdigita.com, aileen@mit.edu January, 2000
+#
+# This file lists all of the users for a given class (group) and 
+# divides them by role.  In addition, it allows the caller to show
+# only people with "emails beginning with" or "last name beginning with"
+#
+
+
+ad_page_variables {
+    begin
+    end
+    header_string
+    browse_type
+    lastletter
+    {type ""}
+    {target_url ""}
+    {target_url_params ""}
+    {order_by "last_name, first_names, email"}
+    {section_id ""}
+}
+
+validate_integer_or_null section_id $section_id
+
+set db [ns_db gethandle]
+
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+
+if { ([string compare $begin a] == 0 || [string compare $begin A] == 0) && ([string compare $end z] == 0 || [string compare $end Z] == 0) } {
+    set header All
+    set spam_links_p t
+    set sql_suffix "and users.user_id > 2"
+    set order_by "last_name, first_names, email"
+    set no_one_found ""
+} else {
+    set no_one_found "matching your criteria."
+    set spam_links_p f
+
+    #This code assumes that the variable End is the correct case!!!
+    if {[string compare $browse_type lastname] == 0} {
+	set header "Last Names $begin through $lastletter"
+	set sql_suffix "and upper('$begin') < upper(last_name)
+                    and '$end' > upper(last_name)
+                       and users.user_id > 2"
+	set order_by "lower(last_name), lower(first_names), lower(email)"
+    } else {
+	set header "Emails $begin through $lastletter"
+	set sql_suffix "and upper('$begin') < upper(email)
+                    and '$end' > upper(email)
+                    and users.user_id > 2"
+	set order_by "lower(email), lower(last_name), lower(first_names)"
+    }
+}
+
+
+set export_vars [export_url_vars begin end browse_type lastletter]
+
+set count 0
+
+if {![empty_string_p $target_url_params]} {
+    set params [join $param_list "&"]
+    append target_url "?$params"
+    set middle_char &
+} else {
+    set middle_char ?
+}
+
+
+if {[string compare $type section_leader] == 0} {
+    set header_string "Select a Section Instructor"
+    set end_string ""
+    set nav_bar_value "Add a Section"
+} else {
+    set header_string "$class_name Users"
+    set end_string "<a href=user-add.tcl>Add a User</a>"
+    set nav_bar_value "Users"
+}
+
+
+set return_string "
+[ad_header "Add a Class @ [ad_system_name]"]
+
+<h2>$header_string - $header </h2>
+
+[ad_context_bar_ws [list "[edu_url]class/one.tcl" "$class_name Home"] [list "../" Administration] "$nav_bar_value"]
+
+
+<hr>
+
+<h3>Current Users</h3>
+
+<blockquote>
+"
+
+
+
+# if there is a target url, make all users go to the same url
+# otherwise, have them go to user-info
+
+set spam_links t
+set variable_name user_id
+set sql_restriction ""
+if {[empty_string_p $target_url]} {
+    set target_url one.tcl
+}
+
+if {[string compare $type section_leader] == 0} {
+    if {![empty_string_p $section_id]} {
+	set sql_restriction "and user_group_map.user_id not in (select user_id from user_group_map where group_id = $section_id and role = 'administrator')"
+    }
+    set variable_name instructor_id
+    set spam_links f
+    
+    set role_list [list Administrator [edu_get_professor_role_string] [edu_get_ta_role_string]]
+} else {
+    set temp_role_list [edu_get_class_roles_to_actions_map]
+    set role_list [list]
+    foreach role $temp_role_list {
+	lappend role_list [lindex $role 0]
+    }
+    # we have to do the lines above and not the line below because we want
+    # the roles to sort correctly
+    # set role_list [database_to_tcl_list $db "select distinct lower(role) from user_group_roles where group_id = $class_id"]
+}
+
+
+
+foreach role $role_list {
+    
+    set selection [ns_db select $db "select distinct users.user_id, 
+                       first_names, 
+                       last_name,
+                       email
+                  from users, 
+                       user_group_map    
+                 where user_group_map.group_id = $class_id
+                       and users.user_id = user_group_map.user_id 
+                       and lower(role) = lower('$role')
+                       $sql_suffix
+	               $sql_restriction
+              order by $order_by"]
+
+    if {[string compare [string tolower $role] dropped] == 0} {
+	set pretty_role "[capitalize $role]"
+    } else {
+	set pretty_role "[capitalize $role]s"
+    }
+
+    append return_string "<h3>$pretty_role</h3><ul>"
+    
+    set counter 0
+    while {[ns_db getrow $db $selection]} {
+	set_variables_after_query
+	if {$counter == 0} {
+	    append return_string "<table>"
+	}
+	incr counter
+	append return_string "
+	<tr><td><a href=\"${target_url}${middle_char}${variable_name}=$user_id\">$last_name, $first_names</a></td> <td>$email</td></tr>\n"
+    }
+    
+    if {$counter == 0} {
+	append return_string "The are currently no $pretty_role in this class $no_one_found"
+    } elseif {[string compare $spam_links t] == 0} {
+	append return_string "</table>"
+
+	if {[string compare $spam_links_p t] == 0} {
+	    append return_string "<br><li><a href=\"../spam.tcl?who_to_spam=[ns_urlencode $role]\">Spam the $pretty_role</a>"
+	}
+    }
+
+    append return_string "</ul>\n"
+}
+   
+append return_string "
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/users/one.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/users/one.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/users/one.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,338 @@
+#
+# /www/eduction/class/admin/users/one.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# This page displays information about the users.  If the user had a role
+# of 'student' for the given group then it redirects to student-info.tcl
+#
+
+ad_page_variables {
+    user_id
+}
+
+validate_integer user_id $user_id
+
+set authorized_user_id $user_id
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+if {$id_list == 0} {
+    return
+}
+
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+# let's find out the role and name of the user so that we can decide
+# whether or not to redirect.
+
+set selection [ns_db select $db "select first_names, 
+         last_name, 
+         email, 
+         map.role,
+         pretty_role,
+         url,
+         portrait_client_file_name as portrait,
+         '' as portrait_thumbnail
+    from users, 
+         user_group_map map,
+         edu_role_pretty_role_map role_map 
+   where users.user_id = $authorized_user_id 
+     and users.user_id = map.user_id 
+     and map.group_id=$class_id
+     and map.group_id = role_map.group_id
+     and lower(map.role) = lower(role_map.role)"]
+
+set count 0
+set role_list [list]
+set pretty_role_list [list]
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr count
+    lappend role_list [string tolower $role]
+    lappend pretty_role_list $pretty_role
+}
+
+if {$count == 0} {
+    ad_return_complaint 1 "<li>The user identification number recieved by this page is not valid.  Please try accessing the page through a different method. $user_id $class_id"
+    return
+} 
+
+
+# if the person that we are supposed to show is a student, lets redirect to 
+# student_info.tcl
+
+if {[lsearch $role_list [string tolower [edu_get_student_role_string]]] != -1 || [lsearch $role_list [string tolower [edu_get_dropped_role_string]]] != -1} {
+    ns_returnredirect "student-info.tcl?student_id=$authorized_user_id"
+    return
+}
+
+
+set return_string "
+[ad_header "$class_name @ [ad_system_name]"]
+
+<h2>Information for $first_names $last_name</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" "Administration"] [list "" Users] "One User"]
+
+
+<hr>
+<blockquote>
+<table>
+<tr>
+<td>
+
+<table>
+<tr><th align=right>Email:</th>
+<td><a href=\"mailto:$email\">$email</a></td>
+</tr>
+<tr><th align=right>URL:</th>
+<td> 
+"
+
+if {![empty_string_p $url]} {
+    append return_string "<a href=\"$url\">$url</a>"
+} else {
+    append return_string "None"
+}
+
+append return_string "
+</td>
+</tr>
+"
+
+set selection [ns_db select $db "
+select distinct mf.field_name, 
+       field_value
+  from user_group_member_field_map m,
+       user_group_type_member_fields mf,
+       user_group_map map
+ where m.user_id=$authorized_user_id 
+   and m.group_id=$class_id
+   and lower(mf.field_name) = lower(m.field_name)
+   and (mf.role is null or lower(mf.role) = lower(map.role))
+   and map.user_id = m.user_id
+   and map.group_id = m.group_id"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    
+    if {![empty_string_p $field_value]} {
+	append return_string "
+	<tr><th align=right>$field_name:</th>
+	<td>$field_value</td>
+	</tr>"    
+    }
+}
+ 
+
+append return_string "
+<tr><th align=right>User Role:</th> 
+<td>[join $pretty_role_list ", "]</td>
+</tr>
+</table>
+
+
+</td>
+<td>
+"
+
+if {![empty_string_p $portrait_thumbnail]} {
+    append return_string "
+    <a href=\"/shared/portrait.tcl?user_id=$authorized_user_id\"><img width=125 src=\"/shared/portrait-thumbnail-bits.tcl?user_id=$authorized_user_id\"></a>"
+} elseif {![empty_string_p $portrait]} {
+    append return_string "
+    <a href=\"/shared/portrait.tcl?user_id=$authorized_user_id\"><img width=125 src=\"/shared/portrait-bits.tcl?user_id=$authorized_user_id\"></a>"
+}
+
+append return_string "
+</td>
+</tr>
+</table>
+
+"
+
+if {[ad_permission_p $db "" "" "Evaluate" $user_id $class_id]} {
+
+    append return_string "
+    <h3>Evaluations given by $first_names</h3>
+    
+    <ul>
+    "
+
+    # lets first get all of the assignment and exam evaluations
+    
+#     set sql "select first_names || ' ' || last_name as student_name,
+#       grade,
+#       assignment_name,
+#       edu_assignments.assignment_id,
+#       users.user_id as student_id,
+#       evaluation_type
+#  from edu_student_evaluations eval,
+#       users,
+#       edu_assignments
+# where grader_id = $authorized_user_id
+#   and eval.class_id = $class_id
+#   and student_id = users.user_id
+#   and eval.task_id = edu_assignments.assignment_id(+)
+# order by evaluation_date"
+
+
+    set sql "select first_names || ' ' || last_name as student_name,
+      grade,
+      assignment_name,
+      edu_assignments.assignment_id,
+      users.user_id as student_id,
+      evaluation_type
+ from edu_student_evaluations eval,
+      users,
+      edu_assignments
+where grader_id = $authorized_user_id
+  and eval.class_id = $class_id
+  and student_id = users.user_id
+  and eval.task_id = edu_assignments.assignment_id
+union 
+select first_names || ' ' || last_name as student_name,
+      grade,
+      '' as assignment_name,
+      '' as assignment_id,
+      users.user_id as student_id,
+      evaluation_type
+ from edu_student_evaluations eval,
+      users,
+      edu_assignments
+where grader_id = $authorized_user_id
+  and eval.class_id = $class_id
+  and student_id = users.user_id
+  and not exists (select 1 from edu_assignments 
+                  where assignment_id = eval.task_id)
+order by evaluation_date"
+
+    set selection [ns_db select $db $sql]
+
+    set count 0
+
+    while {[ns_db getrow $db $selection]} {
+	set_variables_after_query
+	incr count
+	
+	append return_string "<li><a href=\"student-info.tcl?student_id=$student_id\">$student_name</a>, $grade on "
+	
+	if {[empty_string_p $assignment_name]} {
+	    append return_string "$evaluation_type"
+	} else {
+	    append return_string "<a href=\"../assignment-info.tcl?assignment_id=$assignment_id\">$assignment_name</a>"
+	}
+    }
+    
+    
+    # now lets see if they have given any team evaluations
+    
+#     set sql "select team_name,
+#       grade,
+#       assignment_name,
+#       edu_assignments.assignment_id,
+#       edu_teams.team_id,
+#       evaluation_type
+#  from edu_student_evaluations eval,
+#       edu_assignments,
+#       edu_teams
+# where grader_id = $authorized_user_id
+#   and edu_teams.class_id = $class_id
+#   and eval.team_id = edu_teams.team_id
+#   and eval.task_id = edu_assignments.assignment_id(+)
+# order by evaluation_date"
+
+    set sql "select team_name,
+      grade,
+      assignment_name,
+      edu_assignments.assignment_id,
+      edu_teams.team_id,
+      evaluation_type
+ from edu_student_evaluations eval,
+      edu_assignments,
+      edu_teams
+where grader_id = $authorized_user_id
+  and edu_teams.class_id = $class_id
+  and eval.team_id = edu_teams.team_id
+  and eval.task_id = edu_assignments.assignment_id
+union 
+select team_name,
+      grade,
+      '' as assignment_name,
+      '' as assignment_id,
+      edu_teams.team_id,
+      evaluation_type
+ from edu_student_evaluations eval,
+      edu_assignments,
+      edu_teams
+where grader_id = $authorized_user_id
+  and edu_teams.class_id = $class_id
+  and eval.team_id = edu_teams.team_id
+  and not exists (select 1 from edu_assignments
+                  where assignment_id = eval.task_id)
+order by evaluation_date"
+
+    set selection [ns_db select $db $sql]
+
+
+    while {[ns_db getrow $db $selection]} {
+	set_variables_after_query
+	incr count
+	
+	append return_string "<li><a href=\"../teams/one.tcl?team_id=$team_id\">$team_name</a>, $grade on "
+	
+	if {[empty_string_p $assignment_name]} {
+	    append return_string "$evaluation_type"
+	} else {
+	    append return_string "<a href=\"../assignment-info.tcl?assignment_id=$assignment_id\">$assignment_name</a>"
+	}
+    }
+    
+    
+    if {$count == 0} {
+	append return_string "No Evaluations given"
+    }
+
+    append return_string "
+    </ul>
+    "
+}
+
+
+set n_spams_sent [database_to_tcl_string $db "select count(spam_id) from group_spam_history where sender_id = $authorized_user_id and group_id in (select distinct group_id from user_groups where parent_group_id = $class_id)"]
+
+if {$n_spams_sent > 0} {
+    append return_string "
+    <p>
+    <li>$first_names has sent <a href=\"../spam-history.tcl?user_id=$authorized_user_id\">$n_spams_sent spams</a>"
+}
+
+append return_string " 
+
+<p>
+  <li><a href=\"info-edit.tcl?user_id=$authorized_user_id\">Edit user info</a>
+  <li><a href=\"role-change.tcl?user_id=$authorized_user_id\">Edit user's roles</a></li>
+  <li><a href=\"password-update.tcl?user_id=$authorized_user_id\">Update user's password</a></li>
+  <li><a href=\"delete.tcl?user_id=$authorized_user_id\">Remove user</a></li>
+
+</blockquote>
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
Index: web/openacs/www/education/class/admin/users/student-assign-to-team.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/users/student-assign-to-team.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/users/student-assign-to-team.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,80 @@
+#
+# /www/education/class/admin/users/student-assign-to-team.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this adds a user to an already existing team
+#
+
+ad_page_variables {
+    student_id
+    return_url
+}
+
+validate_integer student_id $student_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set full_name [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id=$student_id"]
+
+set selection [ns_db select $db "
+select t.team_name, t.team_id from edu_teams t
+where class_id=$class_id
+and team_id not in (select group_id from user_group_map where user_id = $student_id and class_id = $class_id)"]
+
+append return_string "
+[ad_header "Assign Student to a Team"]
+
+<h2>Assign Student to a Team</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" "Administration"] [list "students-view.tcl" "Students"] [list "student-info.tcl?student_id=$student_id" "One Student"] "Assign Team"]
+
+<hr>
+
+<blockquote>
+"
+
+set count 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    append return_string "
+    <li>$team_name [ad_space 2] - [ad_space 2]
+    <a href=\"../teams/user-add.tcl?[export_url_vars student_id team_id return_url]\">Assign</a>"
+
+    incr count
+}
+
+if {$count == 0} {
+    append return_string "
+    There are currently no teams for $class_name where $full_name is not already a member.<br>\n"
+}
+
+append return_string "
+<p><a href=\"../teams/create.tcl?student_id=$student_id&[export_url_vars return_url]\">Create a team</a>
+
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/users/student-evaluation-add-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/users/student-evaluation-add-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/users/student-evaluation-add-edit-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,140 @@
+#
+# /www/education/class/admin/users/student-evaluation-add-edit-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page allows the user to confirm the information entered as the 
+# student's evaluation
+#
+
+
+ad_page_variables {
+    student_id
+    task_id
+    evaluation_pretty_type
+    student_name
+    {return_url ""}
+    {grade ""}
+    {evaluation_id ""}
+    {comments ""}
+    {show_student_p t}
+    evaluation_type
+    {pretty_role Student}
+    {pretty_role_plural Students}
+}
+
+validate_integer student_id $student_id
+validate_integer task_id $task_id
+validate_integer_or_null evaluation_id $evaluation_id
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+if {[empty_string_p $evaluation_id]} {
+    set evaluation_id [database_to_tcl_string $db "select edu_evaluation_id_sequence.nextval from dual"]
+    set eval_action Add
+} else {
+    # if there is an evaluation_id, lets make sure it is an evaluation for this class
+    if {[database_to_tcl_string $db "select count(evaluation_id) from edu_student_evaluations where evaluation_id = $evaluation_id and class_id = $class_id"] == 0} {
+	ad_return_complaint 1 "<li> The evaluation you are trying to edit does not belong to this class."
+	return
+    }
+    set eval_action Edit
+}
+
+ns_db releasehandle $db
+
+
+if {[empty_string_p $evaluation_pretty_type]} {
+    set evaluation_pretty_type $evaluation_type
+}
+
+
+
+append string_return "
+[ad_header "Edit a $pretty_role Evaluation @ [ad_system_name]"]
+
+<h2>$eval_action $pretty_role Evaluation</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" Administration] "$eval_action $pretty_role Evaluation"]
+
+<hr>
+<blockquote>
+
+<form method=post action=\"student-evaluation-add-edit-3.tcl\">
+[export_form_vars student_id task_id student_name return_url evaluation_id grade comments show_student_p evaluation_type]
+
+<table>
+<tr>
+<th valign=top align=right>
+$pretty_role:
+</td>
+<td>$student_name</td>
+</tr>
+
+<tr>
+<th valign=top align=right>
+Evaluation Type:
+</td>
+<td>
+$evaluation_pretty_type
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right>
+Grade:
+</td>
+<td>$grade
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right>
+Comments:
+</td>
+<td>$comments
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right>
+Should the $pretty_role see <br>
+this evaluation?
+</td>
+<td>[util_PrettyBoolean $show_student_p]
+</td>
+</tr>
+
+<tr>
+<td colspan=2 align=center>
+<br><br>
+<input type=submit value=\"$eval_action Student Evaluation\">
+</td>
+</tr>
+
+</table>
+
+</form>
+
+</blockquote>
+[ad_footer]
+"
+
+
+ns_return 200 text/html $string_return
+
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/users/student-evaluation-add-edit-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/users/student-evaluation-add-edit-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/users/student-evaluation-add-edit-3.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,102 @@
+#
+# /www/education/class/admin/users/student-evaluation-add-edit-3.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page enters the evaluation into the database
+#
+
+
+ad_page_variables {
+    student_id
+    task_id
+    {return_url ""}
+    evaluation_id
+    {grade ""}
+    {comments ""}
+    {show_student_p t}
+    evaluation_type
+}
+
+validate_integer student_id $student_id
+validate_integer task_id $task_id
+validate_integer evaluation_id $evaluation_id
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set grader_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+
+if {[database_to_tcl_string $db "select count(evaluation_id) from edu_student_evaluations where evaluation_id = $evaluation_id"] == 0} {
+    # this is an add
+
+    ns_db dml $db "insert into edu_student_evaluations (
+     evaluation_id,
+     grader_id,
+     student_id,
+     class_id,
+     task_id,
+     evaluation_type,
+     grade,
+     comments,
+     show_student_p,
+     evaluation_date,
+     last_modified,
+     last_modifying_user,
+     modified_ip_address)
+  values (
+     $evaluation_id,
+     $grader_id,
+     $student_id,
+     $class_id,
+     [ns_dbquotevalue $task_id],
+     [ns_dbquotevalue $evaluation_type],
+     [ns_dbquotevalue $grade],
+     [ns_dbquotevalue $comments],
+     '$show_student_p',
+     sysdate(),
+     sysdate(),
+     $grader_id,
+     '[ns_conn peeraddr]')"
+
+} else {
+    # this is an edit.
+
+    ns_db dml $db "update edu_student_evaluations 
+     set grader_id = $grader_id,
+         grade = [ns_dbquotevalue $grade],
+         comments = [ns_dbquotevalue $comments],
+         show_student_p = '$show_student_p',
+         evaluation_date = sysdate(),
+         evaluation_type = [ns_dbquotevalue $evaluation_type]
+         last_modifying_user = $grader_id,
+         last_modified = sysdate(),
+         modified_ip_address = '[ns_conn peeraddr]'
+   where evaluation_id = $evaluation_id"
+}
+
+ns_db releasehandle $db
+
+if {[info exists return_url] && ![empty_string_p $return_url]} {
+    ns_returnredirect $return_url
+} else {
+    ns_returnredirect "student-info.tcl?student_id=$student_id"
+}
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/users/student-evaluation-add-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/users/student-evaluation-add-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/users/student-evaluation-add-edit.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,247 @@
+#
+# /www/education/class/admin/student-evaluation-add-edit.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# This page allows a user to add or edit an evaluation for a student
+#
+
+ad_page_variables {
+    {student_id ""}
+    {task_id ""}
+    {return_url ""}
+    {evaluation_id ""}
+}
+
+# we need for either (task_id and student_id) or evaluation_id to be not null
+
+validate_integer_or_null student_id $student_id
+validate_integer_or_null task_id $task_id
+validate_integer_or_null evaluation_id $evaluation_id
+
+set db [ns_db gethandle]
+
+# gets the class_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+# check the input
+
+set exception_text ""
+set exception_count 0
+
+
+if {![empty_string_p $evaluation_id]} {
+    ###################
+    #                 #
+    # this is an edit #
+    #                 #
+    ###################
+
+    set selection [ns_db 1row $db "select grade, 
+                    student_id, 
+                    task_id, 
+                    comments, 
+                    show_student_p,
+                    first_names || ' ' || last_name as student_name
+               from edu_student_evaluations,
+                    users
+              where evaluation_id = $evaluation_id 
+                and users.user_id = student_id
+                and class_id = $class_id"]
+
+    if {$selection == ""} {
+	append exception_text "<li>The evaluation you are trying to edit either does not exist or does not belong to this class."
+	incr exception_count
+    } else {
+	set_variables_after_query
+    }
+
+    set edit_p t
+    set eval_action Edit
+
+} else {
+    ##################
+    #                #
+    # this is an add #
+    #                #
+    ##################
+
+    if {![info exists student_id] || [empty_string_p $student_id]} {
+	append exception_text "<li>You must designate which student you would like to evaluate </li> \n"
+	incr exception_count
+    } else {
+	set student_name [database_to_tcl_string_or_null $db "select first_names || ' ' || last_name from users where user_id = $student_id"]
+	if {[empty_string_p $student_id]} {
+	    incr exception_count
+	    append exception_text "<li>The student you have provided does not exist."
+	}
+    }
+    
+    # This is an ADD so lets set the variables
+
+    set eval_action Add
+    set grade ""
+    set comments ""
+    set show_student_p t
+    set edit_p f
+
+}
+
+set pretty_roles [database_to_tcl_list $db "select pretty_role, pretty_role_plural from edu_role_pretty_role_map where lower(role) = lower('[edu_get_student_role_string]') and group_id = $class_id"]
+set pretty_role [lindex $pretty_roles 0]
+set pretty_role_plural [lindex $pretty_roles 1]
+
+# get the task information if it exists
+
+if {![empty_string_p $task_id]} {
+    if {![info exists student_name]} {
+	set student_name ""
+    }
+    set evaluation_pretty_type "[database_to_tcl_string_or_null $db "select task_name from edu_student_tasks where task_id = $task_id"]"
+    
+    # why do we have both evaluation_type and evaluation_pretty_type if they're both the same?
+    set evaluation_type $evaluation_pretty_type
+    if {[empty_string_p $evaluation_pretty_type]} {
+	incr exception_count
+	append exception_text "<li>The task you have requested does not exist."
+    }
+
+#    set export_string "[export_form_vars student_id task_id evaluation_pretty_type student_name return_url evaluation_id evaluation_type]"
+
+    set evaluation_type_string "
+    <tr>
+    <th valign=top align=right>
+    Evaluation Type:
+    </td>
+    <td>
+    $evaluation_pretty_type
+    </td>
+    </tr>
+    "
+    set export_string "[export_form_vars student_id evaluation_type task_id evaluation_pretty_type student_name return_url evaluation_id]"
+
+} else {
+    if {![empty_string_p $evaluation_id]} {
+	set evaluation_type [database_to_tcl_string $db "select evaluation_type from edu_student_evaluations where evaluation_id = $evaluation_id"]
+    } else {
+	set evaluation_type ""
+    }
+
+    set evaluation_type_string "
+    <tr>
+    <th align=right>
+    Evaluation Type:
+    </td>
+    <td>
+    <input type=text size=25 value=\"[philg_quote_double_quotes $evaluation_type]\" name=evaluation_type>
+    </td>
+    </tr>
+    "
+    
+    set evaluation_pretty_type "$evaluation_type"
+
+    # aileen - we shouldnt be passing around this many variables. we can derive evaluation_type and evaluation_pretty_type given the evaluation_id
+    set export_string "[export_form_vars student_id task_id evaluation_pretty_type student_name return_url evaluation_id evaluation_type pretty_role pretty_role_plural]"
+} else {
+    incr exception_count
+    append exception_text "<li>You must provide either an evaluation identification number or a task to be evaluated."
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+
+set return_string "
+[ad_header "$eval_action a Student Evaluation @ [ad_system_name]"]
+
+<h2>$eval_action $pretty_role Evaluation</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" Administration] "$eval_action $pretty_role Evaluation"]
+
+<hr>
+<blockquote>
+
+<form method=post action=\"student-evaluation-add-edit-2.tcl\">
+$export_string
+<table>
+<tr>
+<th valign=top align=right>
+$pretty_role:
+</td>
+<td>$student_name</td>
+</tr>
+
+$evaluation_type_string
+
+<tr>
+<th valign=top align=right>
+Grade:
+</td>
+<td><input type=text size=5 maxsize=5 name=grade value=\"[philg_quote_double_quotes $grade]\">
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right>
+Comments:
+</td>
+<td>[edu_textarea comments $comments]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right>
+Should the $pretty_role see<br>
+this evaluation?
+</td>
+<td>
+"
+
+if {[string compare $show_student_p t] == 0} {
+    append return_string "
+    <input type=radio name=show_student_p value=t checked>Yes
+    [ad_space 2] <input type=radio name=show_student_p value=f>No
+    "
+} else {
+    append return_string "
+    <input type=radio name=show_student_p value=t>Yes
+    [ad_space 2] <input type=radio name=show_student_p value=f checked>No
+    "
+}
+
+append return_string "
+</td>
+</tr>
+
+<tr>
+<td colspan=2 align=center>
+<input type=submit value=\"Continue\">
+</td>
+</tr>
+
+</table>
+
+</form>
+
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
Index: web/openacs/www/education/class/admin/users/student-info-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/users/student-info-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/users/student-info-edit-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,90 @@
+#
+# /www/education/class/admin/users/student-info-edit-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# This places the the student information into the database
+#
+
+ad_page_variables {
+    student_id
+    student_account
+    institution_id
+}
+
+validate_integer student_id $student_id
+validate_integer institution_id $institution_id
+
+set db [ns_db gethandle]
+
+# make sure the person is authorized
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+
+set exception_text ""
+set exception_count 0
+
+if {[empty_string_p $student_id]} {
+    incr exception_count
+    append exception_text "<li>You must include the identification number for the student.\n"
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+# lets find out if these should be updates or inserts
+
+if { [database_to_tcl_string $db "select count(field_value) from user_group_member_field_map where user_id = $student_id and group_id = $class_id and field_name = 'Institution ID'"] > 0} {
+    
+    # there is already a record so lets do an  update
+    
+    set institute_statement "update user_group_member_field_map
+                      set field_value = [ns_dbquotevalue $institution_id
+                    where group_id = $class_id 
+                      and user_id = $student_id
+                      and field_name = 'Institution ID'"
+} else {
+    set institute_statement "insert into user_group_member_field_map (group_id, user_id, field_name, field_value) values ($class_id, $student_id, 'Institution ID', [ns_dbquotevalue $institution_id])"
+}
+
+
+if { [database_to_tcl_string $db "select count(field_value) from user_group_member_field_map where user_id = $student_id and group_id = $class_id and field_name = 'Student Account'"] > 0} {
+    
+    # there is already a record so lets do an  update
+    
+    set account_statement "update user_group_member_field_map
+                      set field_value = [ns_dbquotevalue $student_account]
+                    where group_id = $class_id 
+                      and user_id = $student_id
+                      and field_name = 'Student Account'"
+} else {
+
+    set account_statement "insert into user_group_member_field_map (group_id, user_id, field_name, field_value) values ($class_id, $student_id, 'Student Account', [ns_dbquotevalue $student_account])"
+
+}
+
+
+# now that the information is checked, lets do the inserts
+
+if [catch { ns_db dml $db "begin transaction"
+            ns_db dml $db $institute_statement
+            ns_db dml $db $account_statement
+            ns_db dml $db "end transaction" } errmsg] {
+		ad_return_error "database choked" "The database choked on your insert:
+<blockquote>
+<pre>
+$errmsg
+</pre>
+</blockquote>
+You can back up, edit your data, and try again"
+return
+}
+		
+ns_db releasehandle $db
+
+ns_returnredirect "student-info.tcl?student_id=$student_id"
+
Index: web/openacs/www/education/class/admin/users/student-info-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/users/student-info-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/users/student-info-edit.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,111 @@
+#
+# /www/education/class/admin/users/student-info-edit.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# This page allows the admin to edit the student's information
+#
+
+ad_page_variables {
+    student_id
+}
+
+validate_integer student_id $student_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+set selection [ns_db 0or1row $db "select first_names, 
+         last_name, 
+         email as student_email,
+         map.role,
+         pretty_role,
+         pretty_role_plural
+    from users, 
+         user_group_map map,
+         edu_role_pretty_role_map role_map
+   where users.user_id = $student_id 
+     and users.user_id = map.user_id 
+     and role_map.group_id = map.group_id
+     and lower(role_map.role) = lower(map.role)
+     and lower(role_map.role) = lower('[edu_get_student_role_string]')
+     and map.group_id=$class_id"]
+
+
+if {$selection == ""} {
+    ad_return_complaint 1 "<li>You must call this page with a valid user id"
+    return
+} else {
+    set_variables_after_query
+}
+
+
+set institution_id [database_to_tcl_string_or_null $db "select field_value from user_group_member_field_map where user_id = $student_id and group_id = $class_id and field_name = 'Institution ID'"]
+
+set student_account [database_to_tcl_string_or_null $db "select field_value from user_group_member_field_map where user_id = $student_id and group_id = $class_id and field_name = 'Student Account'"]
+
+
+append return_string "
+[ad_header "$pretty_role Info @ [ad_system_name]"]
+
+<h2>$first_names $last_name</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" "Administration"] [list "students-view.tcl" "$pretty_role_plural"] "One $pretty_role"]
+
+<hr>
+<blockquote>
+
+<form method=post action=\"student-info-edit-2.tcl\">
+
+[export_form_vars student_id]
+
+<table>
+
+<tr>
+<th>
+Identification Number:
+</td>
+
+<td>
+<input type=input size=20 maxsize=100 name=institution_id value=\"[philg_quote_double_quotes $institution_id]\">
+</td>
+</tr>
+
+<tr>
+<th>
+Account Number:
+</td>
+
+<td>
+<input type=input size=20 maxsize=100 name=student_account value=\"[philg_quote_double_quotes $student_account]\">
+</td>
+</tr>
+
+<tr>
+<td colspan=2 align=center>
+<br>
+<input type=submit value=\"Edit $pretty_role Information\">
+</td>
+</tr>
+</table>
+
+</form>
+</blockquote>
+
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/users/student-info.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/users/student-info.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/users/student-info.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,486 @@
+#
+# /www/education/class/admin/users/student-info.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# This page allows the admin to see pretty much all of the
+# information relating to a student.
+
+ad_page_variables {
+    student_id
+}
+
+validate_integer student_id $student_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+set selection [ns_db select $db "select first_names, 
+         last_name, 
+         email as student_email,
+         url as student_url, 
+         map.role,
+         portrait_client_file_name as portrait,
+         '' as portrait_thumbnail,
+         pretty_role,
+         pretty_role_plural
+    from users, 
+         user_group_map map,
+         edu_role_pretty_role_map role_map
+   where users.user_id = $student_id 
+     and users.user_id = map.user_id 
+     and role_map.group_id = map.group_id
+     and lower(role_map.role) = lower(map.role)
+     and map.group_id=$class_id"]
+
+
+set count 0
+set role_list [list]
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append role_list [string tolower $role]
+    incr count
+}
+
+if {$count == 0} {
+    ad_return_complaint 1 "<li>You must call this page with a valid user id that is a member of $class_name"
+    return
+}
+
+if {[lsearch $role_list [string tolower [edu_get_student_role_string]]] == -1 && [lsearch $role_list [string tolower [edu_get_dropped_role_string]]] == -1} {
+    ns_returnredirect "one.tcl?user_id=$student_id"
+    return
+}
+
+
+set teams_p [database_to_tcl_string $db "select teams_p from edu_classes where class_id = $class_id"]
+
+set institution_id [database_to_tcl_string_or_null $db "select field_value from user_group_member_field_map where user_id = $student_id and group_id = $class_id and field_name = 'Institution ID'"]
+
+set student_account [database_to_tcl_string_or_null $db "select field_value from user_group_member_field_map where user_id = $student_id and group_id = $class_id and field_name = 'Student Account'"]
+
+
+set assignment_info [list]
+set team_info [list]
+set eval_info [list]
+
+
+# we want to list all of the assignments.  If there is a student file
+# associated with the file (the student's answers) then we want to give 
+# a link to that.  Finally, if there is an evaluation, we want to display
+# it inline.  We need to do outerjoins to make sure that we display 
+# all of the assignments even if evaluations have not yet been completed.
+
+# set sql "
+# select a.assignment_name, 
+#        first_names || ' ' || last_name as grader_name,
+#        answers.grader_id,
+#        answers.grade, 
+#        answers.comments, 
+#        answers.evaluation_id,
+#        answers.show_student_p,
+#        files.url,
+#        files.file_extension,
+#        files.version_id,
+#        a.assignment_id
+#   from edu_assignments a, 
+#        (select distinct version_id, url, file_extension, task_id
+#           from edu_student_answers ans, 
+#                fs_versions_latest ver
+#          where student_id = $student_id
+#            and ad_general_permissions.user_has_row_permission_p($user_id, 'read', version_id, 'FS_VERSIONS') = 't'
+#            and ver.file_id = ans.file_id) files,
+#        (select users.first_names,
+#                users.last_name,
+#                eval.grade,
+#                eval.comments,
+#                eval.evaluation_id,
+#                eval.show_student_p,
+#                eval.task_id,
+#                eval.grader_id
+#           from edu_student_evaluations eval,
+#                users
+#          where users.user_id = eval.grader_id
+#            and eval.student_id = $student_id) answers
+#  where a.class_id = $class_id
+#    and a.assignment_id = files.task_id(+)
+#    and a.assignment_id = answers.task_id(+)"
+
+
+set sql "
+select a.assignment_name, 
+       first_names || ' ' || last_name as grader_name,
+       answers.grader_id,
+       answers.grade, 
+       answers.comments, 
+       answers.evaluation_id,
+       answers.show_student_p,
+       files.url,
+       files.file_extension,
+       files.version_id,
+       a.assignment_id
+  from edu_assignments a, 
+       student_files files,       
+       student_answers answers
+ where a.class_id = $class_id
+   and answers.student_id = $student_id
+   and files.student_id = $student_id
+   and user_has_row_permission_p($user_id, 'read', files.version_id, 'FS_VERSIONS') = 't'
+   and a.assignment_id = files.task_id
+   and a.assignment_id = answers.task_id
+union
+select a.assignment_name, 
+       first_names || ' ' || last_name as grader_name,
+       answers.grader_id,
+       answers.grade, 
+       answers.comments, 
+       answers.evaluation_id,
+       answers.show_student_p,
+       files.url,
+       files.file_extension,
+       files.version_id,
+       a.assignment_id
+  from edu_assignments a, 
+       student_files files,       
+       student_answers answers
+ where a.class_id = $class_id
+   and answers.student_id = $student_id
+   and files.student_id = $student_id
+   and user_has_row_permission_p($user_id, 'read', files.version_id, 'FS_VERSIONS') = 't'
+   and a.assignment_id = files.task_id
+   and not exists (select 1 from student_answers 
+                   where task_id = a.assignment_id)
+union
+select a.assignment_name, 
+       first_names || ' ' || last_name as grader_name,
+       answers.grader_id,
+       answers.grade, 
+       answers.comments, 
+       answers.evaluation_id,
+       answers.show_student_p,
+       files.url,
+       files.file_extension,
+       files.version_id,
+       a.assignment_id
+  from edu_assignments a, 
+       student_files files,       
+       student_answers answers
+ where a.class_id = $class_id
+   and answers.student_id = $student_id
+   and files.student_id = $student_id
+   and user_has_row_permission_p($user_id, 'read', files.version_id, 'FS_VERSIONS') = 't'
+   and not exists (select 1 from student_files 
+                   where task_id = a.assignment_id)
+   and a.assignment_id = answers.task_id
+union
+select a.assignment_name, 
+       first_names || ' ' || last_name as grader_name,
+       answers.grader_id,
+       answers.grade, 
+       answers.comments, 
+       answers.evaluation_id,
+       answers.show_student_p,
+       files.url,
+       files.file_extension,
+       files.version_id,
+       a.assignment_id
+  from edu_assignments a, 
+       student_files files,       
+       student_answers answers
+ where a.class_id = $class_id
+   and answers.student_id = $student_id
+   and files.student_id = $student_id
+   and user_has_row_permission_p($user_id, 'read', files.version_id, 'FS_VERSIONS') = 't'
+   and not exists (select 1 from student_files 
+                   where task_id = a.assignment_id)
+   and not exists (select 1 from student_answers 
+                   where task_id = a.assignment_id)"
+
+
+set selection [ns_db select $db $sql]
+
+
+set assignment_info ""
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    set answers_string ""
+
+    if {![empty_string_p $url]} {
+	set answers_string "<li><a href=\"$url\">$pretty_role Answers</a>"
+    } elseif {![empty_string_p $version_id]} {
+	set answers_string "<li><a href=\"/file-storage/download/$assignment_name.$file_extension?version_id=$version_id\">$pretty_role Answers</a>"
+    }
+
+    append assignment_info "
+    <li><a href=\"../assignment-info.tcl?assignment_id=$assignment_id\"><b>$assignment_name</b></a>"
+
+    if {[empty_string_p $evaluation_id]} {
+	append assignment_info "&nbsp &nbsp (<a href=\"student-evaluation-add-edit.tcl?student_id=$student_id&task_id=$assignment_id&evaluation_type=assignment\">evaluate</a>)
+	"
+
+	if {![empty_string_p $answers_string]} {
+	    append assignment_info "
+	    $answers_string
+	    "
+	}
+
+	append assignment_info "
+	<ul>
+	<li>No Evaluation
+	</ul>
+	<br>
+	"
+    } else {	
+	append assignment_info "&nbsp &nbsp (<a href=\"student-evaluation-add-edit.tcl?evaluation_id=$evaluation_id\">edit this evaluation</a>)
+	<ul>
+	"
+
+	if {![empty_string_p $answers_string]} {
+	    append assignment_info "
+	    $answers_string
+	    "
+	}
+
+	append assignment_info "
+	<li>
+	Grade:
+	[edu_maybe_display_text $grade]
+	</li>
+	
+	<li>
+	Comments:
+	[edu_maybe_display_text $comments]
+	</li>
+	
+	<li>
+	Graded By:
+	<a href=\"one.tcl?user_id=$grader_id\">$grader_name</a>
+	</li>
+	
+	<li>
+	Show Evalution to $pretty_role:
+	[ad_html_pretty_boolean $show_student_p]
+	</li>
+	</ul>
+	<br>
+	"
+    }
+}
+
+
+# now get the team information is there are teams for this class
+
+if {[string compare $teams_p t] == 0} {
+    set teams_info [database_to_tcl_list_list $db "select distinct team_id,
+       team_name
+  from edu_teams team, 
+       user_group_map map
+ where team.class_id = $class_id
+   and team.team_id = map.group_id
+   and map.user_id = $student_id"]
+}
+
+
+
+# now get the evaluations (excluding assignments) for the student
+
+set eval_info [database_to_tcl_list_list $db "
+select se.grader_id,
+first_names || ' ' || last_name as grader_name,
+evaluation_type,
+grade,
+comments,
+evaluation_date,
+evaluation_id
+from edu_student_evaluations se,
+users
+where se.student_id=$student_id
+and users.user_id = se.grader_id
+and task_id is null
+and se.class_id=$class_id"]
+
+
+set return_string "
+[ad_header "$pretty_role Info @ [ad_system_name]"]
+<h2>$first_names $last_name</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" "Administration"] [list "students-view.tcl?view_type=all" "$pretty_role_plural"] "One $pretty_role"]
+
+<hr>
+<blockquote>
+
+<table>
+<tr>
+<td>
+<h3>Information
+"
+
+if {[lsearch $role_list [string tolower [edu_get_dropped_role_string]]] != -1} {
+    append return_string "[ad_space 2] <font color=red>Dropped</font>"
+}
+
+append return_string "
+</h3>
+<ul>ID: $institution_id
+<br>Account: $student_account
+<br>Email: $student_email
+<br>URL: 
+"
+
+if {![empty_string_p $student_url]} {
+    append return_string "<a href=\"$student_url\">$student_url</a>"
+} else {
+    append return_string "None"
+}
+
+append return_string "
+<br>
+(<a href=\"student-info-edit.tcl?student_id=$student_id\">edit</a>)
+</ul>
+</td>
+<td>
+"
+
+if {![empty_string_p $portrait_thumbnail]} {
+    append return_string "
+    <a href=\"/shared/portrait.tcl?user_id=$student_id\"><img width=125 src=\"/shared/portrait-thumbnail-bits.tcl?user_id=$student_id\"></a>"
+} elseif {![empty_string_p $portrait]} {
+    append return_string "
+    <a href=\"/shared/portrait.tcl?user_id=$student_id\"><img width=125 src=\"/shared/portrait-bits.tcl?user_id=$student_id\"></a>"
+}
+
+append return_string "
+</td>
+</tr>
+</table>
+
+<h3>Assignments</h3>
+<ul>
+"
+
+if {![empty_string_p $assignment_info]} {
+    append return_string "
+    $assignment_info
+    "
+} else {
+    append return_string "
+    No assignment info available"
+}
+
+set count 0
+
+append return_string "
+</ul>
+<h3>$pretty_role Evaluations</h3>
+<ul>
+"
+
+foreach evaluation $eval_info {
+    if {$count} {
+	append return_string "<p>"
+    }
+
+    append return_string "
+    <table cellpadding=2>
+    <tr>
+    <th align=right>Evaluation Type</th>
+    <td>[lindex $evaluation 2]</td>
+    </tr>
+    <tr>
+    <th align=right>Grade</th>
+    <td>[lindex $evaluation 3]</td>
+    </tr>
+    <tr>
+    <th align=right>Comments</th>
+    <td>[lindex $evaluation 4]</td>
+    </tr>
+    <tr>
+    <th align=right>Grader</th>
+    <td><a href=\"one.tcl?user_id=[lindex $evaluation 0]\">[lindex $evaluation 1]</a></td>
+    </tr>
+    <tr>
+    <th align=right>Date</th>
+    <td>[util_AnsiDatetoPrettyDate [lindex $evaluation 5]]</td>
+    </tr>
+    <tr><th></th>
+    <td><a href=student-evaluation-add-edit.tcl?evaluation_id=[lindex $evaluation 6]>Edit</a></td></tr>
+    </table>"
+    
+    incr count
+}
+
+if {!$count} {
+    append return_string "
+    No evaluation info available"
+}
+
+append return_string "<p><a href=\"student-evaluation-add-edit.tcl?student_id=$student_id\">Add an evaluation</a></p>"
+
+if {[string compare $teams_p t] == 0} {
+    
+    set team_count 0
+    
+    append return_string "
+    </ul>
+    <h3>$pretty_role Teams</h3>
+    <ul>
+    "
+    
+    if {![empty_string_p $teams_info]} {
+	foreach team $teams_info {
+	    append return_string "
+	    <li><a href=\"../teams/one.tcl?team_id=[lindex $team 0]\">[lindex $team 1]</a>"
+	}
+    } else {
+	append return_string "
+	No team info available"
+    }
+
+
+    set return_url "[ns_conn url]?[ns_conn query]"
+
+    # lets see if we should let them choose from existing teams or if they should
+    # be given the create a team page.
+    
+    if {[database_to_tcl_string $db "select count(team_id) from edu_teams where class_id = $class_id"] > $team_count} {
+	append return_string "
+	<p><a href=\"student-assign-to-team.tcl?[export_url_vars return_url student_id]\">Assign $first_names to a team</a>
+	"
+    } else {
+	append return_string "
+	<br><a href=\"../teams/create.tcl?[export_url_vars return_url student_id]\">Assign $first_names to a team</a>
+	"
+    }
+}
+
+
+set return_url "student-info.tcl?student_id=$student_id"
+
+set return_url [export_url_vars return_url]
+
+append return_string "
+</ul>
+<br>
+  <li><a href=\"role-change.tcl?user_id=$student_id&$return_url\">Edit user's roles</a></li>
+  <li><a href=\"password-update.tcl?user_id=$student_id&$return_url\">Update $pretty_role's password</a></li>
+  <li><a href=\"delete.tcl?user_id=$student_id&$return_url\">Remove $pretty_role</a></li>
+</blockquote>
+
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
Index: web/openacs/www/education/class/admin/users/students-view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/admin/users/students-view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/admin/users/students-view.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,224 @@
+#
+# /www/education/class/admin/users/students-view.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# This page should be used when we want to give a list of all of
+# the students in a class so that the user can select from the
+# list and then move on.
+#
+
+
+ad_page_variables {
+    {target_url "student-info.tcl"}
+    {view_type all}
+    {target_url_vars ""}
+    {order_by "last_name"}
+    {section_id ""}
+    {project_instance_name ""}
+}
+
+validate_integer_or_null section_id $section_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+
+set student_roles [database_to_tcl_list $db "select pretty_role, pretty_role_plural from edu_role_pretty_role_map where lower(role) = lower('[edu_get_student_role_string]') and group_id = $class_id"]
+
+set student_pretty_role [lindex $student_roles 0]
+set student_pretty_role_plural [lindex $student_roles 1]
+
+set exception_count 0
+set exception_text ""
+
+if {[string compare $view_type section] == 0} {
+    if {[empty_string_p $section_id]} {
+	incr exception_count
+	append exception_text "<li>In order to restrict by section, you must provide a section identification number."
+    } else {
+	# lets make sure the section provided is part of this class
+	set section_name [database_to_tcl_string_or_null $db "select section_name from edu_sections where section_id = $section_id and class_id = $class_id"]
+	if {[empty_string_p $section_name]} {
+	    incr exception_count
+	    append exception_text "<li>The section identification number you have provided is not a section of $class_name"
+	} else {
+	    # this means that section name was defined above
+	    set title "All $student_pretty_role_plural"
+	    set sub_title "in $class_name not in $section_name"
+	    set header "View All $student_pretty_role_plural not in $section_name"
+	    set sql_restriction "and map.user_id not in (select user_id from user_group_map where group_id = $section_id)"
+	}
+    }
+} elseif {[string compare $view_type project] == 0} {
+    set title "Select a $student_pretty_role"
+    set header "Select a $student_pretty_role for a project"
+    set sql_restriction ""
+    if {![empty_string_p $project_instance_name]} {
+	set sub_title "for $project_instance_name"
+    } else {
+	set sub_title ""
+    }
+} else {
+    # this is the base case where we want to show all students
+    set title "All $student_pretty_role_plural"
+    set header "View All $student_pretty_role_plural"
+    set sql_restriction ""
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+
+set return_string "
+[ad_header "$header"]
+
+<h2>$title</h2>
+"
+
+if {[info exists sub_title] && ![empty_string_p $sub_title]} {
+    append return_string "<p>$sub_title<p>"
+}
+
+append return_string "
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$class_name Home"] [list "../" Administration] "$student_pretty_role_plural"]
+
+<hr>
+
+<blockquote>
+"
+
+set export_string [export_url_vars target_url view_type target_url_vars section_id]
+
+
+if {[string compare $order_by "last_name desc"] == 0} {
+    set header "
+    <td><b><a href=\"students-view.tcl?$export_string&order_by=last_name\">Name</b></td>
+    <td><b><a href=\"students-view.tcl?$export_string&order_by=email\">Email</b></td>"
+    
+    set order_by "lower_last_name desc"
+} elseif {[string compare $order_by "email"] == 0} {
+    set order_by "lower_email"
+    set ordering "lower(email) desc"
+    set header "
+    <td><b><a href=\"students-view.tcl?$export_string&order_by=last_name\">Name</b></td>
+    <td><b><a href=\"students-view.tcl?$export_string&order_by=[ns_urlencode $ordering]\">Email</b></td>"
+    
+} elseif {[string compare $order_by "email desc"] == 0} {
+    
+    set order_by "lower_email desc"
+    set header "
+    <td><b><a href=\"students-view.tcl?$export_string&order_by=last_name\">Name</b></td>
+    <td><b><a href=\"students-view.tcl?$export_string&order_by=email\">Email</b></td>"
+    
+} else {
+    
+    set order_by "lower_last_name"
+
+    set ordering "last_name desc"
+    set header "
+    <td><b><a href=\"students-view.tcl?$export_string&order_by=[ns_urlencode $ordering]\">Name</b></td>
+    <td><b><a href=\"students-view.tcl?$export_string&order_by=email\">Email</b></td>"
+}
+
+# this query makes the assumption that no students have both the role
+# of "Student" and "Dropped" at the same time.  If they do, their
+# name will appear twice on the list and will be pretty stupid
+
+set selection [ns_db select $db "select 
+                 distinct map.user_id as student_id,
+                 last_name,
+                 first_names,
+                 email,
+                 role,
+                 lower(last_name) as lower_last_name,
+                 lower(email) as lower_email
+            from user_group_map map,
+                 users
+           where users.user_id = map.user_id
+             and (lower(map.role) = lower('[edu_get_student_role_string]')
+                  or lower(map.role) = lower('[edu_get_dropped_role_string]'))
+             $sql_restriction
+             and map.group_id = $class_id
+        order by $order_by"]
+
+
+set count 0
+
+
+set dropped_role_string [string tolower [edu_get_dropped_role_string]]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    if {!$count} {
+	append return_string "
+	<table cellpadding=2>
+	<tr>
+	$header
+	<td>[ad_space 1]</td>
+	</tr>
+	"
+    }
+
+    append return_string "
+    <tr>
+    <td><a href=\"$target_url?student_id=$student_id&$target_url_vars\">$last_name, $first_names</a></td>
+    <td>$email</td>
+    <td>[ad_space 1]
+    "
+    
+    if {[string compare [string tolower $role] $dropped_role_string] == 0} {
+	append return_string "<font color=red>Dropped</font>"
+    }
+
+    append return_string "</td></tr>"
+   
+    incr count
+}
+
+if {$count} {
+    append return_string "
+    </table>"
+} else {
+    append return_string "
+    <p>There are currently no $student_pretty_role_plural registered in the system</p>"
+}
+
+
+# if this is a project, we want to give the person the option of
+# assigning the student at a later date.  We set the student_id = 0
+# signifying that we have not selected a user.  
+
+if {[string compare $view_type project] == 0} {
+    append return_string "
+    <p>
+    <a href=\"$target_url?$target_url_vars&student_id=0\">Assign a [string tolower $student_pretty_role] at a later time</a>
+    "
+} elseif {[string compare $view_type section] != 0} {
+    append return_string "
+    <p>
+    <a href=\"add.tcl\">Add a User $view_type</a>"
+}
+
+append return_string "
+</blockquote>
+[ad_footer]"
+
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
Index: web/openacs/www/education/class/projects/instance-info.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/projects/instance-info.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/projects/instance-info.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,209 @@
+#
+# /www/education/class/admin/projects/instance-info.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page displays information about a given project
+#
+
+ad_page_variables {
+    project_instance_id
+}
+
+validate_integer project_instance_id $project_instance_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_user_security_check $db]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set exception_count 0
+set exception_text ""
+
+if {[empty_string_p $project_instance_id]} {
+    ad_return_complaint 1 "<li>You must provide a project identification number"
+    return
+} else {
+    set selection [ns_db 0or1row $db "select
+	proj.project_id,
+        project_name,
+	project_instance_name,
+	project_instance_url,
+	proj.description,
+	approved_p,
+        approved_date,
+        approving_user,
+        max_body_count,
+        min_body_count,
+	active_p,
+        project_type
+   from edu_project_instances inst,
+        edu_projects proj
+  where inst.project_instance_id = $project_instance_id
+    and proj.project_id = inst.project_id
+    and proj.class_id = $class_id"]
+
+    
+    if {$selection == ""} {
+	ad_return_complaint 1 "There are no projects in this class corresponding to the provided identification number.  This is an error in our code.  Please contact <a href=mailto:[ad_system_owner]>[ad_system_owner]</a>."
+	return
+    } else {
+	set_variables_after_query
+    }
+}
+
+
+if {[string compare $project_type team] == 0} {
+    if [empty_string_p $max_body_count] {
+	set pretty_max_body_count "unspecified"
+    } else {
+	set pretty_max_body_count $max_body_count
+    }
+    if [empty_string_p $min_body_count] {
+	set pretty_min_body_count "unspecified"
+    } else {
+    set pretty_min_body_count $min_body_count
+    }
+
+    set display_text "
+    <tr>
+    <th align=right>Number of students:</th>
+    <td>
+    Min: [ad_space] $pretty_min_body_count
+    [ad_space] Max: [ad_space] $pretty_max_body_count
+    </td>
+    </tr>
+    "
+
+    # now, we want to show a list of teams that are assigned to this
+    # project
+    
+    set teams_list [database_to_tcl_list_list $db "select edu_teams.team_id, 
+                   team_name 
+              from edu_teams, 
+                   edu_project_user_map map 
+             where map.team_id = edu_teams.team_id 
+               and map.project_instance_id = $project_instance_id"]
+
+    append new_display_text "
+    <h3>Teams working on $project_instance_name</h3>
+    <ul>
+    "
+
+    if {[empty_string_p $teams_list]} {
+	append new_display_text "There are currently no teams assigned to this project.<p>
+	<li><a href=\"team-add.tcl?project_instance_id=$project_instance_id\">Add a team</a>"
+    } else {
+	foreach team $teams_list {
+	    append new_display_text "
+	    <li><a href=\"../team-info.tcl?team_id=[lindex $team 0]\">[lindex $team 1]</a>"
+	}
+    }
+    
+    append new_display_text "
+    </ul>
+    "
+
+} else {
+    set display_text ""
+    set new_display_text ""
+}
+
+
+set return_string "
+[ad_header "One Project @ [ad_system_name]"]
+
+<h2>$project_instance_name</h2>
+
+[ad_context_bar_ws_or_index [list "../one.tcl" "$class_name Home"] [list "../one.tcl" "All Projects"] "One Project Instance"]
+
+<hr>
+a part of <a href=\"one.tcl?project_id=$project_id\">$project_name</a>
+<blockquote>
+
+
+<table BORDER=0>
+
+<tr>
+<th valign=top align=right> Name: </td>
+<td valign=top>
+$project_instance_name
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> URL: </td>
+<td valign=top>
+"
+
+if {[empty_string_p $project_instance_url]} {
+    append return_string "None"
+} else {
+    append return_string "<A href=\"$project_instance_url\">$project_instance_url</a>"
+}
+
+append return_string "
+</td>
+</tr>
+
+$display_text
+
+<tr>
+<th valign=top align=right> Description: </th>
+<td valign=top>
+[edu_maybe_display_text $description]
+</td>
+</tr>
+</table>
+ 
+$new_display_text
+
+<h4>Status Reports</h4>
+<ul>
+"
+
+
+set comment_permission_p [database_to_tcl_string_or_null $db "select 1 from users, 
+        user_group_map ug_map, 
+        edu_project_user_map map 
+  where users.user_id = $user_id 
+    and map.project_instance_id = $project_instance_id
+    and (users.user_id = map.student_id 
+         or (users.user_id = ug_map.user_id 
+             and ug_map.group_id = map.team_id))"]
+
+if {[empty_string_p $comment_permission_p]} {
+    set comment_permission_p [ad_permission_p $db "" "" "View Admin Pages" $user_id $class_id]
+}
+
+if {$comment_permission_p == 1} {
+    set progress_reports [ad_general_comments_list $db $project_instance_id EDU_PROJECT_INSTANCES $project_instance_name]
+} else {
+    set progress_reports "[ad_general_comments_summary_sorted $db $project_instance_id EDU_PROJECT_INSTANCES $project_instance_name]"
+}
+
+if {[string compare $progress_reports "<ul></ul>"] == 0} {
+    append return_string "No status reports available"
+} else {
+    append return_string "$progress_reports"
+}
+
+
+append return_string "
+</ul>
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
Index: web/openacs/www/education/class/projects/one.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/projects/one.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/projects/one.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,227 @@
+#
+# /www/education/class/projects/one.tcl
+#
+# by aegrumet@arsdigita.com, March 3, 2000
+#
+# this page displays information about a given project
+#
+
+ad_page_variables {
+    project_id
+}
+
+validate_integer project_id $project_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_user_security_check $db]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set exception_count 0
+set exception_text ""
+
+if {[empty_string_p $project_id]} {
+    ad_return_complaint 1 "<li>You must provide a project identification number"
+} else {
+
+
+# set sql "select
+#              class_id, 
+#              project_name,
+#              description,
+#              date_assigned,
+#              requires_grade_p,
+#              last_modified,
+#              due_date,
+#              weight,
+#              ver.file_id,
+#              file_extension,
+#              version_id,
+#              ver.url
+#         from edu_projects,
+#              fs_versions_latest ver
+#        where project_id = $project_id
+#          and edu_projects.file_id = ver.file_id(+)
+#          and class_id = $class_id"
+
+set sql "select
+             class_id, 
+             project_name,
+             description,
+             date_assigned,
+             requires_grade_p,
+             last_modified,
+             due_date,
+             weight,
+             ver.file_id,
+             file_extension,
+             version_id,
+             ver.url
+        from edu_projects,
+             fs_versions_latest ver
+       where project_id = $project_id
+         and edu_projects.file_id = ver.file_id
+         and class_id = $class_id
+       union 
+       select
+             class_id, 
+             project_name,
+             description,
+             date_assigned,
+             requires_grade_p,
+             last_modified,
+             due_date,
+             weight,
+             '' as file_id,
+             '' as file_extension,
+             '' as version_id,
+             '' as url
+        from edu_projects
+       where project_id = $project_id
+         and not exists (select 1 from fs_versions_latest
+                         where file_id = edu_projects.file_id)
+         and class_id = $class_id"
+
+
+set selection [ns_db 0or1row $db $sql]
+
+    if {$selection == ""} {
+	ad_return_complaint 1 "There are no projects in this class corresponding to the provided identification number.  This is an error in our code.  Please contact <a href=mailto:[ad_system_owner]>[ad_system_owner]</a>."
+	return
+    } else {
+	set_variables_after_query
+    }
+}
+
+
+
+set return_string "
+[ad_header "One Project @ [ad_system_name]"]
+
+<h2>$project_name</h2>
+
+[ad_context_bar_ws_or_index [list "../one.tcl" "$class_name Home"] [list "" "All Projects"] "One Project"]
+
+<hr>
+<blockquote>
+
+
+<table BORDER=0>
+
+<tr>
+<th valign=top align=right> Project Name: </td>
+<td valign=top>
+"
+if {![empty_string_p $url]} {
+    append return_string "<p> <a href=\"$url\">$project_name</a>"
+} elseif {![empty_string_p $version_id]} {
+    append return_string "<a href=\"/file-storage/download/$project_name.$file_extension?version_id=$version_id\">$project_name</a>"
+} else {
+    append return_string "$project_name"
+} 	    
+
+append return_string "
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Description: </td>
+<td valign=top>
+[edu_maybe_display_text $description]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Due Date: </td>
+<td valign=top>
+[util_AnsiDatetoPrettyDate $due_date]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Date Assigned: </td>
+<td valign=top>
+[util_AnsiDatetoPrettyDate $date_assigned]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right>Will this project<br>be graded? </td>
+<td valign=top>
+[util_PrettyBoolean $requires_grade_p]
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right> Fraction of Final Grade: </td>
+<td valign=top>"
+
+if {[empty_string_p $weight]} {
+    append return_string "N/A"
+} else {
+    append return_string "$weight"
+}
+
+append return_string "
+<tr>
+<th valign=top align=right> Last Modified: </td>
+<td valign=top>
+[util_AnsiDatetoPrettyDate $last_modified]
+</td>
+</tr>
+
+
+</table>
+<br>
+"
+set task_type project
+set task_id $project_id
+
+append return_string "
+<h3>Project Instances</h3>
+<ul>
+"
+
+set selection [ns_db select $db "select project_instance_id, project_instance_name, project_instance_url, description from edu_project_instances where project_id = $task_id and active_p = 't'"] 
+
+set n_project_instances 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    append return_string "<li><a href=\"instance-info.tcl?project_instance_id=$project_instance_id\">$project_instance_name</a>"
+
+    if {![empty_string_p $project_instance_url]} {
+	append return_string "&nbsp (<a href=\"$project_instance_url\">$project_instance_url</a>)"
+    }
+
+    incr n_project_instances
+}
+
+if {$n_project_instances == 0} {
+    append return_string "There are not currently any projects being worked on.<br><Br>"
+} else {
+    append return_string "<p>"
+}
+
+append return_string "
+<li><a href=\"instances/index.tcl?project_id=$project_id\">View assignments</a>
+</ul>
+
+</blockquote>
+
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
Index: web/openacs/www/education/class/projects/instances/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/class/projects/instances/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/class/projects/instances/index.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,128 @@
+#
+# /www/education/class/projects/instances/index.tcl
+#
+# by aegrumet@arsdigita.com, March 3, 2000
+#
+# this page displays project assignments and allows self-assignment
+# if the appropriate flag is set
+#
+
+ad_page_variables {
+    project_id
+}
+
+validate_integer project_id $project_id
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Manage Users"]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+set exception_count 0
+set exception_text ""
+
+if {[empty_string_p $project_id]} {
+    ad_return_complaint 1 "<li>You must provide a project identification number"
+    return
+} else {
+    set project_name [database_to_tcl_string $db "select project_name
+from edu_projects
+where project_id = $project_id"]
+    if [empty_string_p $project_name] {
+	ad_return_complaint 1 "There are no projects in this class corresponding to the provided identification number.  This is an error in our code.  Please contact <a href=mailto:[ad_system_owner]>[ad_system_owner]</a>."
+	return
+    }
+}
+
+# We found the project.
+
+# Get a list of project instances
+set instance_list [database_to_tcl_list_list $db "select project_instance_id,
+       project_instance_name
+from edu_project_instances
+where project_id = $project_id
+  and active_p = 't'"]
+
+# Loop through the list and construct the main table
+set main_table "
+<table width=100%>
+<tr>
+ <th align=left>Title</th>
+ <th>Students</th>
+</tr>
+"
+
+set n_instances 0
+foreach instance $instance_list {
+    set project_instance_id [lindex $instance 0]
+    set project_instance_name [lindex $instance 1]
+    incr n_instances   
+
+    if [expr ($n_instances+1) % 2] {
+	set bgcolor "#FFFFFF"
+    } else {
+	set bgcolor "#EEEEEE"
+    }
+
+    append main_table "
+<tr bgcolor=$bgcolor>
+  <td align=left><a href=\"project.adp?[export_url_vars project_instance_id]\">$project_instance_name</a></td>
+<td align=center>"
+
+    # Query for students assigned to the instance.
+    set selection [ns_db select $db "select user_id,
+       (first_names || ' ' || last_name) as full_name,
+       -1 as team_id
+from users,
+     edu_project_user_map
+where project_instance_id = $project_instance_id
+  and team_id is null
+  and user_id = student_id
+union
+select users.user_id,
+       (first_names || ' ' || last_name) as full_name,
+       team_id
+from users,
+     user_group_map,
+     edu_project_user_map
+where project_instance_id = $project_instance_id
+  and student_id is null
+  and team_id = group_id
+  and user_group_map.user_id = users.user_id"]
+
+    while { [ns_db getrow $db $selection] } {
+	set_variables_after_query
+	append main_table "
+$full_name<br>"
+    }
+
+    append main_table "
+</td></tr>"
+}
+
+if $n_instances {
+    append main_table "
+</table>"
+} else {
+    set main_table "There were no project instances in our database.\n"
+}
+
+set page_html "
+[ad_header "One Project @ [ad_system_name]"]
+
+<h2>$project_name Assignments</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl?class_id=$class_id" "$class_name Home"] [list "../" "All Projects"] [list ../one.tcl?[export_url_vars project_id] "One Project"] Assignments]
+
+<hr>
+
+$main_table
+
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $page_html
+
Index: web/openacs/www/education/department/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/department/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/department/index.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,109 @@
+#
+# /www/education/department/index.tcl
+# 
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page lists the departments.  It still needs a lot of work.
+#
+
+
+set db [ns_db gethandle]
+
+set return_string "
+
+[ad_header "[ad_system_name] Administration"]
+
+<h2>[ad_system_name] Departments</h2>
+
+[ad_context_bar_ws Departments]
+
+<hr>
+<blockquote>
+
+<h3>Departments</h3>
+<ul>
+"
+
+# if they are a site wide admin we want to give them all possible links
+
+set user_id [ad_verify_and_get_user_id]
+
+set site_wide_admin_p [ad_administrator_p $db]
+
+set count 0
+
+# set sql "select department_id, 
+#                      department_name, 
+#                      count(admin_list.group_id) as department_admin_p
+#                 from edu_departments dept,
+#                      (select group_id 
+#                              from user_group_map 
+#                             where user_id = $user_id) admin_list
+#                where dept.department_id = admin_list.group_id(+)
+#             group by department_id, 
+#                      department_name"
+
+set sql "select department_id, 
+                     department_name, 
+                     count(admin_list.group_id) as department_admin_p
+                from edu_departments dept, user_group_map admin_list
+               where dept.department_id = admin_list.group_id
+                 and admin_list.user_id = $user_id
+            group by department_id, 
+                     department_name
+               union
+              select department_id, 
+                     department_name, 
+                     count(admin_list.group_id) as department_admin_p
+                from edu_departments dept, user_group_map admin_list
+               where not exists (select 1 from user_group_map 
+                                 where group_id = dept.department_id)
+                 and admin_list.user_id = $user_id
+            group by department_id, 
+                     department_name"
+
+# do use an on-the-fly view so that we know if the user is a member
+# of the given deparment
+
+set selection [ns_db select $db $sql]
+
+
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append return_string "<li><a href=\"one.tcl?department_id=$department_id\">$department_name</a>"
+
+    if {$site_wide_admin_p == 1 || $department_admin_p > 0} {
+	append return_string "[ad_space] \[ <a href=\"/education/util/group-login.tcl?group_type=edu_department&group_id=$department_id\&return_url=[edu_url]department/admin/\">admin page</a> \]"
+    }
+
+    incr count
+}
+
+if {$count == 0} {
+    append return_string "There are currently no departments in the system."
+} else {
+    append return_string "<br>"
+}
+
+append return_string "
+</ul>
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/department/one.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/department/one.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/department/one.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,157 @@
+#
+# /www/education/department/one.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page displays information about a single department
+#
+
+set department_id [ad_get_client_property education edu_department]
+
+if {[empty_string_p $department_id]} {
+    ns_returnredirect "/education/util/group-select.tcl?group_type=edu_class&return_url=[ns_urlencode [ns_conn url]?[ns_conn query]]"
+    return
+}
+
+validate_integer department_id $department_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select department_name,
+                              department_number, 
+                              external_homepage_url,
+                              mailing_address,
+                              phone_number,
+                              fax_number, 
+                              inquiry_email,
+                              description,
+                              mission_statement
+                         from edu_departments
+                        where department_id = $department_id"]
+
+if {$selection == ""} {
+    ad_return_complaint 1 "<li> The department you have requested does not exist."
+    return
+} else {
+    set_variables_after_query
+}
+
+if {[string compare $external_homepage_url "http://"] == 0} {
+    set external_homepage ""
+} else {
+    set external_homepage "<a href=$external_homepage_url>$external_homepage_url</a>"
+}
+
+
+set return_string "
+[ad_header "Departments @ [ad_system_name]"]
+
+<h2>$department_name</h2>
+
+[ad_context_bar_ws_or_index [list "" Departments] "One Department"]
+
+<hr>
+<blockquote>
+
+<table>
+
+<tr>
+<th align=left valign=top>
+Department Name
+</td>
+<td>
+$department_name
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Department Number
+</td>
+<td>
+$department_number
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+External Homepage URL
+</td>
+<td>
+$external_homepage
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Mailing Address
+</td>
+<td>
+$mailing_address
+</td>
+</tr>
+
+
+<tr>
+<th align=left valign=top>
+Phone Number
+</td>
+<td>
+$phone_number
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Fax Number
+</td>
+<td>
+$fax_number
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Inquiry Email Address
+</td>
+<td>
+$inquiry_email
+</td>
+</tr>
+
+
+<tr>
+<th align=left valign=top>
+Description
+</td>
+<td>
+[address_book_display_as_html $description]
+</td>
+</tr>
+
+
+<tr>
+<th align=left valign=top>
+Mission Statement
+</td>
+<td>
+[address_book_display_as_html $mission_statement]
+</td>
+</tr>
+
+</table>
+
+</blockquote>
+
+[ad_footer]
+"
+
+ns_db releasehandle $db 
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
Index: web/openacs/www/education/department/admin/department-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/department/admin/department-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/department/admin/department-edit-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,209 @@
+#
+# /www/education/department/admin/department-edit-2.tcl
+#
+# by randyg@arsdigita.com, aileen@arsdigita.com, January 2000
+#
+# this page allows the user to edit informaiton about a department
+#
+
+ad_page_variables {
+    group_name
+    {department_number ""}
+    {external_homepage_url ""}
+    {mailing_address ""}
+    {phone_number ""}
+    {fax_number ""}
+    {inquiry_email ""}
+    {description ""}
+    {mission_statement ""}
+}
+
+# note that we do not require the department_id because we
+# get that from looking up the session_id
+
+
+set db [ns_db gethandle]
+
+# set the user and group information
+set id_list [edu_group_security_check $db edu_department]
+set user_id [lindex $id_list 0]
+set department_id [lindex $id_list 1]
+set department_name [lindex $id_list 2]
+
+
+set exception_text ""
+set exception_count 0
+
+if {[empty_string_p $group_name]} {
+    append exception_text "<li> You must provide a name for the new department."
+    incr exception_count
+}
+
+
+
+# if an email is provided, make sure that it is of the correct for.
+
+if {[info exists inquiry_email] && ![empty_string_p $inquiry_email] && ![philg_email_valid_p $inquiry_email]} {
+    incr exception_count
+    append exception_text "<li>The inquiry email address that you typed doesn't look right to us.  Examples of valid email addresses are 
+<ul>
+<li>Alice1234@aol.com
+<li>joe_smith@hp.com
+<li>pierre@inria.fr
+</ul>
+"
+}
+
+
+# if a phone number is provided, check its form
+
+if {![empty_string_p $phone_number] && ![edu_phone_number_p $phone_number]} {
+    incr exception_count
+    append exception_text "<li> The phone number you have entered is not in the correct form.  It must be of the form XXX-XXX-XXXX \n"
+}
+
+
+# if a fax nubmer is provided, check its form
+
+if {![empty_string_p $fax_number] && ![edu_phone_number_p $fax_number]} {
+    incr exception_count
+    append exception_text "<li> The fax number you have entered is not in the correct form.  It must be of the form XXX-XXX-XXXX \n"
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+if {[string compare $external_homepage_url "http://"] == 0} {
+    set external_homepage_url ""
+}
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "
+
+[ad_header "Department Administration @ [ad_system_name]"]
+<h2>Confirm Department Information</h2>
+
+[ad_context_bar_ws [list "/education/department/" "Departments"] [list "" "Department Administration"] "Edit Department Information"]
+
+<hr>
+<blockquote>
+
+<form method=post action=\"department-edit-3.tcl\">
+
+[export_form_vars group_name department_number external_homepage_url mailing_address phone_nubmer fax_number inquery_email description mission_statement]
+
+<table>
+
+<tr>
+<th align=left valign=top>
+Department Name
+</td>
+<td>
+$group_name
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Department Number
+</td>
+<td>
+$department_number
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+External Homepage URL
+</td>
+<td>
+$external_homepage_url
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Mailing Address
+</td>
+<td>
+$mailing_address
+</td>
+</tr>
+
+
+<tr>
+<th align=left valign=top>
+Phone Number
+</td>
+<td>
+$phone_number
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Fax Number
+</td>
+<td>
+$fax_number
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Inquiry Email Address
+</td>
+<td>
+$inquiry_email
+</td>
+</tr>
+
+
+<tr>
+<th align=left valign=top>
+Description
+</td>
+<td>
+[address_book_display_as_html $description]
+</td>
+</tr>
+
+
+<tr>
+<th align=left valign=top>
+Mission Statement
+</td>
+<td>
+[address_book_display_as_html $mission_statement]
+</td>
+</tr>
+
+<tr>
+<td colspan=2 align=center>
+<Br>
+<input type=submit value=\"Edit Department Information\">
+</td>
+</tr>
+
+</table>
+
+</form>
+
+</blockquote>
+[ad_footer]
+"
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/department/admin/department-edit-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/department/admin/department-edit-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/department/admin/department-edit-3.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,115 @@
+#
+# /www/education/department/admin/department-edit-3.tcl
+#
+# by randyg@arsdigita.com, aileen@arsdigita.com, January 2000
+#
+# this page allows the user to edit informaiton about a department
+#
+
+ad_page_variables {
+    group_name
+    {department_number ""}
+    {external_homepage_url ""}
+    {mailing_address ""}
+    {phone_number ""}
+    {fax_number ""}
+    {inquiry_email ""}
+    {description ""}
+    {mission_statement ""}
+}
+
+
+set db [ns_db gethandle]
+
+# set the user and group information
+set id_list [edu_group_security_check $db edu_department]
+set user_id [lindex $id_list 0]
+set department_id [lindex $id_list 1]
+set department_name [lindex $id_list 2]
+
+
+set exception_text ""
+set exception_count 0
+
+if {[empty_string_p $group_name]} {
+    append exception_text "<li> You must provide a name for the new department."
+    incr exception_count
+}
+
+# if an email is provided, make sure that it is of the correct for.
+
+if {[info exists inquiry_email] && ![empty_string_p $inquiry_email] && ![philg_email_valid_p $inquiry_email]} {
+    incr exception_count
+    append exception_text "<li>The inquiry email address that you typed doesn't look right to us.  Examples of valid email addresses are 
+<ul>
+<li>Alice1234@aol.com
+<li>joe_smith@hp.com
+<li>pierre@inria.fr
+</ul>
+"
+}
+
+
+# if a phone number is provided, check its form
+
+if {[info exists phone_number] && ![empty_string_p $phone_number] && ![edu_phone_number_p $phone_number]} {
+    incr exception_count
+    append exception_text "<li> The phone number you have entered is not in the correct form.  It must be of the form XXX-XXX-XXXX \n"
+}
+
+
+# if a fax nubmer is provided, check its form
+
+if {[info exists fax_number] && ![empty_string_p $fax_number] && ![edu_phone_number_p $fax_number]} {
+    incr exception_count
+    append exception_text "<li> The fax number you have entered is not in the correct form.  It must be of the form XXX-XXX-XXXX \n"
+}
+
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+if {[string compare $external_homepage_url "http://"] == 0} {
+    set QQexternal_homepage_url ""
+}
+
+
+# now that all of the input has been check, lets update the row
+
+
+ns_db dml $db "update edu_department_info 
+                   set department_number = '$QQdepartment_number',
+                       external_homepage_url = '$QQexternal_homepage_url',
+                       mailing_address = '$QQmailing_address',
+                       phone_number = '$QQphone_number',
+                       fax_number = '$QQfax_number',
+                       inquiry_email = '$QQinquiry_email',
+                       description = '$QQdescription',
+                       mission_statement = '$QQmission_statement',
+      	               last_modified = sysdate(),
+                       last_modifying_user = $user_id,
+                       modified_ip_address = '[ns_conn peeraddr]'                       
+                 where group_id = $department_id"
+
+
+ns_db releasehandle $db
+
+ns_returnredirect ""
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/department/admin/department-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/department/admin/department-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/department/admin/department-edit.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,165 @@
+#
+# /www/education/department/admin/department-edit.tcl
+#
+# by randyg@arsdigita.com, aileen@arsdigita.com, January 2000
+#
+# this page allows the user to edit informaiton about a department
+#
+
+# not expecting any variables
+
+set db [ns_db gethandle]
+
+# set the user and group information
+set id_list [edu_group_security_check $db edu_department]
+set user_id [lindex $id_list 0]
+set department_id [lindex $id_list 1]
+set department_name [lindex $id_list 2]
+
+
+set selection [ns_db 0or1row $db "select department_name, 
+                         department_number, 
+                         external_homepage_url,
+                         mailing_address,
+                         phone_number,
+                         fax_number,
+                         inquiry_email,
+                         description,
+                         mission_statement
+                    from edu_departments
+                   where department_id = $department_id"]
+
+if {$selection == ""} {
+    # this should never, ever happen because of the call to edu_group_security_check
+    ad_return_complaint 1 "<li> The group that you are logged in as is not a department.  Please return to <a href=\"/pvt/home.tcl\">your home page</a> and try again."
+    return
+} else {
+    set_variables_after_query
+}
+
+
+if {[empty_string_p $external_homepage_url]} {
+    set external_homepage_url "http://"
+}
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "
+[ad_header "Edit a Department @ [ad_system_name]"]
+<h2>Edit Department</h2>
+
+[ad_context_bar_ws [list "../" "Departments"] [list "" "$department_name Administration"] "Edit Department Information"]
+
+<hr>
+<blockquote>
+
+<form method=post action=\"department-edit-2.tcl\">
+
+<table>
+
+<tr>
+<th align=left valign=top>
+Department Name
+</td>
+<td>
+<input type=text name=group_name value=\"$department_name\" size=50 maxsize=100>
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Department Number
+</td>
+<td>
+<input type=text name=department_number value=\"$department_number\" size=20 maxsize=100>
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+External Homepage URL
+</td>
+<td>
+<input type=text name=external_homepage_url value=\"$external_homepage_url\" size=40 maxsize=200>
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Mailing Address
+</td>
+<td>
+<input type=text name=mailing_address value=\"$mailing_address\" size=40 maxsize=200>
+</td>
+</tr>
+
+
+<tr>
+<th align=left valign=top>
+Phone Number
+</td>
+<td>
+<input type=text name=phone_number value=\"$phone_number\" size=15 maxsize=20>
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Fax Number
+</td>
+<td>
+<input type=text name=fax_number value=\"$fax_number\" size=15 maxsize=20>
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Inquiry Email Address
+</td>
+<td>
+<input type=text name=inquiry_email value=\"$inquiry_email\" size=25 maxsize=50>
+</td>
+</tr>
+
+
+<tr>
+<th align=left valign=top>
+Description
+</td>
+<td>
+<textarea wrap cols=45 rows=5 name=description>$description</textarea>
+</td>
+</tr>
+
+
+<tr>
+<th align=left valign=top>
+Mission Statement
+</td>
+<td>
+<textarea wrap cols=45 rows=5 name=mission_statement>$mission_statement</textarea>
+</td>
+</tr>
+
+<tr>
+<td colspan=2 align=center>
+<input type=submit value=Continue>
+</td>
+</tr>
+
+</table>
+
+</form>
+
+</blockquote>
+[ad_footer]
+"
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/department/admin/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/department/admin/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/department/admin/index.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,279 @@
+#
+# /www/education/department/admin/index.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page displays the information for the department the person
+# is logged in as
+#
+
+set db [ns_db gethandle]
+
+# set the user and group information
+set id_list [edu_group_security_check $db edu_department]
+set user_id [lindex $id_list 0]
+set department_id [lindex $id_list 1]
+set department_name [lindex $id_list 2]
+
+set subject_threshhold 20000
+set class_threshhold 20000
+
+set selection [ns_db 0or1row $db "select department_name, 
+                         department_number, 
+                         external_homepage_url,
+                         mailing_address,
+                         phone_number,
+                         fax_number,
+                         inquiry_email,
+                         description,
+                         mission_statement
+                   from edu_departments
+                  where department_id = $department_id"]
+
+if {$selection == ""} {
+    # this should never, ever happen because of the call to edu_group_security_check
+    ad_return_complaint 1 "<li> The group that you are logged in as is not a department.  Please return to <a href=\"/pvt/home.tcl\">your home page</a> and try again."
+    return
+} else {
+    set_variables_after_query
+}
+
+
+
+set return_string "
+
+[ad_admin_header "Department Administration @ [ad_system_name]"]
+
+<h2>Department Administration</h2>
+
+
+[ad_context_bar_ws [list "../" "Departments"] "$department_name Administration"]
+
+
+<hr>
+<blockquote>
+
+<h3>$department_name</h3>
+<table>
+
+<tr>
+<th align=left valign=top>
+Department Number
+</td>
+<td>
+[edu_maybe_display_text $department_number]
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+External Homepage URL
+</td>
+<td>
+"
+
+if {![empty_string_p $external_homepage_url]} {
+    append return_string "<a href=\"$external_homepage_url\">$external_homepage_url</a>"
+} else {
+    append return_string "None"
+}
+
+append return_string "
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Mailing Address
+</td>
+<td>
+[edu_maybe_display_text $mailing_address]
+</td>
+</tr>
+
+
+<tr>
+<th align=left valign=top>
+Phone Number
+</td>
+<td>
+[edu_maybe_display_text $phone_number]
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Fax Number
+</td>
+<td>
+[edu_maybe_display_text $fax_number]
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Inquiry Email Address
+</td>
+<td>
+[edu_maybe_display_text $inquiry_email]
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Description
+</td>
+<td>
+[edu_maybe_display_text [address_book_display_as_html $description]]
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Mission Statement
+</td>
+<td>
+[edu_maybe_display_text [address_book_display_as_html $mission_statement]]
+</td>
+</tr>
+
+<tr>
+<td colspan=2 align=left>
+(<a href=\"department-edit.tcl\">edit</a>)
+</td>
+</tr>
+
+</table>
+
+<p>
+
+<a href=\"users/\">User Management</a>
+
+<p>
+"
+
+# set sql "select count(unique(map.subject_id)) as n_subjects, 
+#                         count(class_id) as n_classes 
+#                    from edu_classes, 
+#                         edu_subject_department_map map 
+#                   where map.subject_id = edu_classes.subject_id(+) 
+#                     and map.department_id = $department_id"
+
+
+set sqla "select count(distinct subject_id) as n_subjects 
+            from edu_subject_department_map 
+           where department_id = $department_id"
+
+set sqlb "select count(class_id) as n_classes from edu_classes"
+
+# now, lets list the subjects and classes in the department 
+
+ns_db dml $db "begin transaction"
+
+set selection [ns_db 1row $db $sqla]
+set_variables_after_query
+
+set selection [ns_db 1row $db $sqlb]
+set_variables_after_query
+
+ns_db dml $db "end transaction"
+
+set subject_text "
+<h3>Subjects</h3>
+<ul>
+
+"
+
+if {$n_subjects == 0} {
+    append subject_text "There currently are no subjects in this department."
+} elseif {$n_subjects < $subject_threshhold} {
+    # we want to list the subjects
+    set selection [ns_db select $db "select subject_name, 
+                        map.subject_number, 
+                        map.subject_id,
+                        map.grad_p
+                   from edu_subjects, 
+                        edu_subject_department_map map 
+                  where map.subject_id = edu_subjects.subject_id 
+                    and map.department_id = $department_id 
+               order by lower(subject_number), lower(subject_name)"]
+
+    while {[ns_db getrow $db $selection]} {
+	set_variables_after_query
+
+	if {[string compare $grad_p t] == 0} {
+	    set grad_tag G
+	} else {
+	    set grad_tag ""
+	}
+
+	append subject_text "<li> $subject_number $grad_tag $subject_name [ad_space 2]
+	\[ <a href=\"[edu_url]subject/one.tcl?subject_id=$subject_id\">home page</a> 
+	| <a href=\"[edu_url]subject/admin/index.tcl?subject_id=$subject_id\">admin page</a> 
+	| <a href=\"subject-remove.tcl?subject_id=$subject_id\">remove</a> 
+	| <a href=\"subject-status-edit.tcl?subject_id=$subject_id\">edit</a> \]\n"
+    }
+
+
+}
+
+
+    if {[database_to_tcl_string $db "select count(subject_id) from edu_subjects where subject_id not in (select subject_id from edu_subject_department_map where department_id = $department_id)"] > 0 } {
+	# only display this link if there are more subjects to add.
+	append subject_text "<br><Br><a href=\"subject-add-existing.tcl\">Add an Existing Subject</a> [ad_space] \n"
+    }
+    append subject_text "<br><br><a href=\"subject-add.tcl\">Add a New Subject</a></ul>"
+
+
+#
+# now do the classes
+#
+
+
+
+
+set class_text "
+<h3>Classes</h3>
+<ul>
+
+"
+
+if {$n_classes == 0} {
+    append class_text "There currently are no classes in this department.</ul>"
+} elseif {$n_classes < $class_threshhold} {
+    # we want to list the subjects
+    set selection [ns_db select $db "select class_name, 
+            class_id 
+       from edu_classes, 
+            edu_subjects, 
+            edu_subject_department_map map 
+      where map.subject_id = edu_classes.subject_id
+        and map.department_id = $department_id
+        and edu_subjects.subject_id = map.subject_id"]
+
+    set return_url "[edu_url]class/admin/"
+
+    while {[ns_db getrow $db $selection]} {
+	set_variables_after_query
+
+	append class_text "<li> $class_name [ad_space 2] 
+	\[<a href=\"/education/util/group-login.tcl?group_id=$class_id&group_type=edu_class&return_url=[ns_urlencode [edu_url]class/one.tcl]\">home page</a> 
+	| <a href=\"/education/util/group-login.tcl?group_id=$class_id&group_type=edu_class&[export_url_vars return_url]\">admin page</a>\]"
+    }
+
+    append class_text "</ul>"
+
+}
+
+append return_string "
+$subject_text
+$class_text
+</blockquote>
+
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
Index: web/openacs/www/education/department/admin/subject-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/department/admin/subject-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/department/admin/subject-add-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,145 @@
+#
+# /www/education/department/admin/subject-add-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this allows an admin to add a subject to the department
+#
+
+ad_page_variables {
+    subject_name
+    {description ""}
+    {credit_hours ""}
+    {prerequisites ""}
+    {professors_in_charge ""}
+    {subject_number ""}
+    {grad_p f}
+}
+
+
+if {[empty_string_p $subject_name]} {
+    ad_return_complaint 1 "<li>You must provide a name for the new subject."
+    return
+}
+
+
+set db [ns_db gethandle]
+
+# set the user and group information
+set id_list [edu_group_security_check $db edu_department]
+set user_id [lindex $id_list 0]
+set department_id [lindex $id_list 1]
+set department_name [lindex $id_list 2]
+
+
+# so we don't get hit by duplicates if the user double-submits,
+# let's generate the subject_id here
+
+set subject_id [database_to_tcl_string $db "select edu_subject_id_sequence.nextval from dual"]
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "
+
+[ad_header "Add a Subject"]
+<h2>Confirm Subject Information</h2>
+
+[ad_context_bar_ws [list "../" "Departments"] [list "" "$department_name"] "Add a Subject"]
+
+<hr>
+<blockquote>
+
+<table>
+
+<tr>
+<th align=left valign=top>
+Subject Name:
+</td>
+<td>
+$subject_name
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Description:
+</td>
+<td>
+[edu_maybe_display_text [address_book_display_as_html $description]]
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Credit Hours:
+</td>
+<td>
+[edu_maybe_display_text $credit_hours]
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Prerequisites:
+</td>
+<td>
+[edu_maybe_display_text [address_book_display_as_html $prerequisites]]
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Professors in Charge:
+</td>
+<td>
+[edu_maybe_display_text $professors_in_charge]
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Subject Number:
+</td>
+<td>
+[edu_maybe_display_text $subject_number]
+</td>
+</tr>
+
+<tr>
+<td align=left valign=top>
+<b>Is this a Graduate Class?</b>
+</td>
+<td align=left>
+[util_PrettyBoolean $grad_p]
+</td>
+</tr>
+
+<tr>
+<th align=center valign=top colspan=2>
+
+<form method=post action=subject-add-3.tcl>
+
+[export_form_vars subject_name description credit_hours prerequisites professors_in_charge subject_number grad_p subject_id]
+
+<br>
+<input type=submit value=\"Create Subject\">
+</form>
+
+</td>
+</tr>
+
+</table>
+
+</blockquote>
+[ad_footer]
+"
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/department/admin/subject-add-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/department/admin/subject-add-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/department/admin/subject-add-3.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,122 @@
+#
+# /www/education/department/admin/subject-add-3.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this allows an admin to add a subject to the department
+# this page does the actual insert
+
+ad_page_variables {
+    subject_name
+    subject_id
+    {description ""}
+    {credit_hours ""}
+    {prerequisites ""}
+    {professors_in_charge ""}
+    {subject_number ""}
+    {grad_p f}
+}
+
+validate_integer subject_id $subject_id
+
+# check and make sure we received all of the input we were supposed to
+
+set exception_text ""
+set exception_count 0
+
+if {[empty_string_p $subject_name]} {
+    append exception_text "<li> You must provide a name for the new subject."
+    incr exception_count
+}
+
+if {[empty_string_p $subject_id]} {
+    append exception_text "<li> You must provide an identification number for the new subject."
+    incr exception_count
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+set db [ns_db gethandle]
+
+# set the user and group information
+set id_list [edu_group_security_check $db edu_department]
+set user_id [lindex $id_list 0]
+set department_id [lindex $id_list 1]
+
+
+set subject_insert "insert into edu_subjects (
+subject_id,
+subject_name,
+description,
+credit_hours,
+prerequisites,
+professors_in_charge,
+last_modified,
+last_modifying_user,
+modified_ip_address)
+values (
+$subject_id,
+'$QQsubject_name',
+'$QQdescription',
+'$QQcredit_hours',
+'$QQprerequisites',
+'$QQprofessors_in_charge',
+sysdate(),
+$user_id,
+'[ns_conn peeraddr]')"
+
+
+set department_insert "insert into edu_subject_department_map (
+subject_id,
+subject_number,
+grad_p,
+department_id)
+values (
+$subject_id,
+'$QQsubject_number',
+'$grad_p',
+$department_id)"
+
+
+if [catch { ns_db dml $db "begin transaction"
+            ns_db dml $db $subject_insert
+            ns_db dml $db $department_insert
+            ns_db dml $db "end transaction" } errmsg] {
+		# something went wrong.  
+    
+		if {[database_to_tcl_string $db "select count(subject_id) from edu_subjects where subject_id = $subject_id"] > 0 } {
+		    # mapping was already in the tables
+		    ns_returnredirect ""
+		} else {
+		    ad_return_error "database choked" "The database choked on your insert:
+		    <blockquote>
+		    <pre>
+		    $errmsg
+		    </pre>
+		    </blockquote>
+		    You can back up, edit your data, and try again"
+		}
+		return
+}
+                              
+# insert went OK
+
+ns_db releasehandle $db
+
+ns_returnredirect ""
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/department/admin/subject-add-existing-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/department/admin/subject-add-existing-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/department/admin/subject-add-existing-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,87 @@
+#
+# /www/education/department/admin/subject-add-existing-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page allows the admin to add an existing subject to the department
+#
+
+ad_page_variables {
+    subject_id
+}
+
+if {[empty_string_p $subject_id]} {
+    ad_return_complaint 1 "<li>You must include a subject identification number."
+    return
+}
+
+validate_integer subject_id $subject_id
+
+set db [ns_db gethandle]
+
+# set the user and group information
+set id_list [edu_group_security_check $db edu_department]
+set user_id [lindex $id_list 0]
+set department_id [lindex $id_list 1]
+set department_name [lindex $id_list 2]
+
+
+# lets make sure that the subject_id provided does not map to the department
+
+if {[database_to_tcl_string $db "select count(department_id) from edu_subject_department_map where subject_id = $subject_id and department_id = $department_id"] > 0} {
+    ad_return_complaint 1 "<li> The subject you are trying to add already exists in this department."
+    return
+}
+
+
+set subject_name [database_to_tcl_string $db "select subject_name from edu_subjects where subject_id = $subject_id"]
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "
+
+[ad_header "Add an Existing Subject @ [ad_system_name]"]
+<h2>Add an Existing Subject</h2>
+
+[ad_context_bar_ws [list "../" "Departments"] [list "" "$department_name Administration"] "Add a Subject"]
+
+
+<hr>
+
+<blockquote>
+
+Please provide a subject number and graduate status for $subject_name.  Examples of subject nubmers include CS101 and 6.001.
+
+<form method=post action=\"subject-add-existing-3.tcl\">
+<b>Subject Number:</b> [ad_space] <input type=text size=15 maxsize=20 name=subject_number>
+[export_form_vars subject_id]
+<p>
+
+<b>Is this a Graduate Class?</b> [ad_space] 
+
+<input type=radio name=grad_p value=t> Yes
+<input type=radio name=grad_p value=f checked> No
+
+<p>
+<input type=submit value=\"Continue\">
+</form>
+
+
+</blockquote>
+[ad_footer]
+"
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/department/admin/subject-add-existing-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/department/admin/subject-add-existing-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/department/admin/subject-add-existing-3.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,94 @@
+#
+# /www/education/department/admin/subject-add-existing-3.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page confirms the information for adding an existing subject
+#
+
+ad_page_variables {
+    subject_id
+    {subject_number ""}
+    {grad_p f}
+}
+
+
+if {[empty_string_p $subject_id]} {
+    ad_return_complaint 1 "<li>You must include a subject identification number."
+    return
+}
+
+validate_integer subject_id $subject_id
+
+set db [ns_db gethandle]
+
+# set the user and group information
+set id_list [edu_group_security_check $db edu_department]
+set user_id [lindex $id_list 0]
+set department_id [lindex $id_list 1]
+set department_name [lindex $id_list 2]
+
+
+# lets make sure that the subject_id provided maps to the departments
+
+if {[database_to_tcl_string $db "select count(department_id) from edu_subject_department_map where subject_id = $subject_id and department_id = $department_id"] > 0} {
+    ad_return_complaint 1 "<li> The subject you are trying to add already exists in $department_name"
+    return
+}
+
+
+set subject_name [database_to_tcl_string $db "select subject_name from edu_subjects where subject_id = $subject_id"]
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "
+
+[ad_header "Add an Existing Subject @ [ad_system_name]"]
+<h2>Add an Existing Subject</h2>
+
+[ad_context_bar_ws [list "../" "Departments"] [list "" "$department_name Administration"] "Add a Subject"]
+
+
+<hr>
+<blockquote>
+
+Are you sure you wish to add $subject_name to the department $department_name?
+
+<form method=post action=\"subject-add-existing-4.tcl\">
+
+[export_form_vars subject_id subject_number grad_p]
+
+<b>Subject Name:</b> [ad_space] $subject_name
+
+<p>
+
+<b>Subject Number:</b> [ad_space] [edu_maybe_display_text $subject_number]
+
+<p>
+
+<b>Is this a Graduate Class?</b> [ad_space] [util_PrettyBoolean $grad_p]
+
+<p>
+
+<input type=submit name=button value=\"Add Subject\">
+</form>
+
+
+</blockquote>
+[ad_footer]
+"
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/department/admin/subject-add-existing-4.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/department/admin/subject-add-existing-4.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/department/admin/subject-add-existing-4.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,77 @@
+#
+# /www/education/department/admin/subject-add-existing-4.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page allows the admin to add an existing subject to the department
+# this does the actual insert
+
+ad_page_variables {
+    subject_id
+    {subject_number ""}
+    {grad_p f}
+}
+
+
+if {[empty_string_p $subject_id]} {
+    ad_return_complaint 1 "<li>You must include a subject identification number."
+    return
+}
+
+validate_integer subject_id $subject_id
+
+set db [ns_db gethandle]
+
+# set the user and group information
+set id_list [edu_group_security_check $db edu_department]
+set user_id [lindex $id_list 0]
+set department_id [lindex $id_list 1]
+set department_name [lindex $id_list 2]
+
+
+# lets make sure that the subject_id provided maps to the departments
+
+set insert_statement "insert into edu_subject_department_map (
+                    subject_id,
+                    subject_number,
+                    grad_p,
+                    department_id)
+                values (
+                    $subject_id,
+                   '$QQsubject_number',
+                   '$grad_p',
+                    $department_id)"    
+
+
+if { [catch { ns_db dml $db $insert_statement } errmsg ] } {
+    # something went wrong.  
+    if {[database_to_tcl_string $db "select count(subject_id) from edu_subject_department_map where subject_id = $subject_id and department_id = $department_id" > 0]} {
+	# mapping was already in the tables
+	ns_db releasehandle $db
+	ns_returnredirect ""
+    } else {
+	ad_return_error "database choked" "The database choked on your insert:
+	<blockquote>
+	<pre>
+	$errmsg
+	</pre>
+	</blockquote>
+	You can back up, edit your data, and try again"
+    }
+    return
+}
+                              
+# insert went OK
+
+ns_db releasehandle $db
+
+ns_returnredirect ""
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/department/admin/subject-add-existing.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/department/admin/subject-add-existing.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/department/admin/subject-add-existing.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,114 @@
+#
+# /www/education/department/admin/subject-add-existing.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page allows the admin to add an existing subject to the department
+#
+
+
+set db [ns_db gethandle]
+
+# set the user and group information
+set id_list [edu_group_security_check $db edu_department]
+set user_id [lindex $id_list 0]
+set department_id [lindex $id_list 1]
+set department_name [lindex $id_list 2]
+
+
+append return_string "
+
+[ad_header "Add an Existing Subject @ [ad_system_name]"]
+<h2>Add an Existing Subject</h2>
+
+[ad_context_bar_ws [list "/department/" "Departments"] [list "" "$department_name Administration"] "Add a Subject"]
+
+
+<hr>
+<blockquote>
+"
+
+set threshhold 40
+set display_text "Click on a subject to add<p>"
+
+
+# get then number of subjects that are not already in the department
+
+set n_subject [database_to_tcl_string $db "select count(subject_id) from edu_subjects where subject_id not in (select subject_id from edu_subject_department_map where department_id = $department_id)"]
+
+
+# if there are < $threshhold subjects we list all of the possible subjects
+# else, we provide both a broswe by subject name and a search functionality
+
+if { $n_subject < $threshhold } {
+    # display all of the subjects
+    
+    set selection [ns_db select $db "select subject_id, subject_name from edu_subjects where subject_id not in (select subject_id from edu_subject_department_map where department_id = $department_id) order by lower(subject_name)"]
+
+    append return_string "$display_text<ul>"
+
+    while {[ns_db getrow $db $selection]} {
+	set_variables_after_query
+	append return_string "
+	<li><a href=\"subject-add-existing-2.tcl?subject_id=$subject_id\">$subject_name</a> <br> \n"
+    }
+
+    append return_string "</ul>"
+
+} else {
+
+    # there are a lot of subjects so we want to let them browse or search
+    
+    set subjects_in_department_p f
+    set export_vars [export_url_vars target_url subjects_in_department_p display_text]
+
+    append return_string "
+    <li>Find subject by subject name : 
+    <a href=subject-list.tcl?begin=A&end=H&lastletter=G&$export_vars>A - G</a> |
+    <a href=subject-list.tcl?begin=H&end=N&lastletter=M&$export_vars>H - M</a> |
+    <a href=subject-list.tcl?begin=N&end=T&lastletter=S&$export_vars>N - S</a> |
+    <a href=subject-list.tcl?begin=T&end=z&lastletter=Z&$export_vars>T - Z</a> 
+    <br><br>
+    <li><a href=subject-list.tcl?begin=A&end=z&lastletter=Z&$export_vars>Show all subjects</a>
+
+    <Br>
+
+    <form method=get action=\"subject-search.tcl\">
+    [export_form_vars target_url subjects_in_department_p display_text]
+    
+    <li>Search through all subjects:
+    <table>
+    <tr><td align=right>by Subject Name</td>
+    <td><input type=text maxlength=100 size=30 name=subject_name><BR></td>
+    </td>
+    <tr>
+    <td colspan=2>
+    <center><input type=submit value=\"Search For a Subject\"></center>
+    </td>
+    </table>
+    </form>
+    "
+
+}
+
+
+append return_string "
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/department/admin/subject-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/department/admin/subject-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/department/admin/subject-add.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,123 @@
+#
+# /www/education/department/admin/subject-add.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this allows an admin to add a subject to the department
+#
+
+
+# no arguments are expected
+
+set db [ns_db gethandle]
+
+# set the user and group information
+set id_list [edu_group_security_check $db edu_department]
+set user_id [lindex $id_list 0]
+set department_id [lindex $id_list 1]
+set department_name [lindex $id_list 2]
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "
+
+[ad_header "Add a New Subject @ [ad_system_name]"]
+<h2>Add a New Subject</h2>
+
+[ad_context_bar_ws [list "../" "Departments"] [list "" "$department_name Administration"] "Add a New Subject"]
+
+<hr>
+<blockquote>
+
+<form method=post action=\"subject-add-2.tcl\">
+
+<table>
+
+<tr>
+<th align=left>
+Subject Name:
+</td>
+<td>
+<input type=text name=subject_name size=40 maxsize=100>
+</td>
+</tr>
+
+<tr>
+<th align=left>
+Description:
+</td>
+<td>
+[edu_textarea description]
+</td>
+</tr>
+
+<tr>
+<th align=left>
+Credit Hours:
+</td>
+<td>
+<input type=text name=credit_hours size=10 maxsize=50>
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Prerequisites:
+</td>
+<td>
+[edu_textarea prerequisites "" 60 4]
+</td>
+</tr>
+
+<tr>
+<th align=left>
+Professor(s) in Charge:
+</td>
+<td>
+<input type=text name=professors_in_charge size=40 maxsize=200>
+</td>
+</tr>
+
+<tr>
+<td align=left>
+<b>Subject Number: </b>
+</td><td align=left>
+<input type=text name=subject_number size=10 maxsize=20>
+</td>
+</tr>
+
+<tr>
+<td align=left colspan=2 valign=top>
+<b>Is this a Graduate Class?</b>
+<input type=radio name=grad_p value=t> Yes
+<input type=radio name=grad_p value=f checked> No
+</td>
+</tr>
+
+<tr>
+<th align=center valign=top colspan=2>
+<input type=submit value=Continue>
+</td>
+</tr>
+
+</table>
+</form>
+
+</blockquote>
+[ad_footer]
+"
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/department/admin/subject-list.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/department/admin/subject-list.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/department/admin/subject-list.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,155 @@
+#
+# /www/education/department/admin/subject-list.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# This page shows the list of subjects in the class that meet
+# the passed in conditions
+#
+
+ad_page_variable {
+    begin
+    end
+    {subjects_in_department_p t}
+    {target_url ""}
+    {display_text ""}
+}
+
+
+set db [ns_db gethandle]
+
+
+# set the user and group information
+set id_list [edu_group_security_check $db edu_department]
+set user_id [lindex $id_list 0]
+set department_id [lindex $id_list 1]
+set department_name [lindex $id_list 2]
+
+
+if {![info exists display_text]} {
+    set display_text ""
+}
+
+
+#check the input
+set exception_count 0 
+set exception_display_text ""
+
+if {[empty_string_p $begin] } {
+    incr exception_count
+    append exception_display_text "<li>You must have a starting letter\n"
+}
+
+if {[empty_string_p $end] } {
+    incr exception_count
+    append exception_display_text "<li>You must have a stopping letter\n"
+}
+
+if {[empty_string_p $lastletter] } {
+    incr exception_count
+    append exception_display_text "<li>You must provide a last letter\n"
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_display_text
+    return
+}
+
+
+
+if { [string compare [string tolower $begin] a] == 0) && [string compare [string tolower $end] z] == 0 } {
+    set header "All Subjects"
+    set sql_suffix ""
+} else {
+    set header "Subject Names $begin through $lastletter"
+    set sql_suffix "where upper('$begin') < upper(subject_name)
+               and upper('$end') > upper(subject_name)"
+}
+
+
+
+set return_string "
+[ad_header "Department Administration @ [ad_system_name]"]
+
+<h2> $header </h2>
+
+[ad_condisplay_text_bar_ws [list "../" "Departments"] [list "" "$department_name Administration"] "Subject List"]
+
+<hr>
+<blockquote>
+
+"
+
+set sql_tables ""
+
+if {[empty_string_p $sql_suffix]} {
+    set sql_prefix "where"
+} else {
+    set sql_prefix "and"
+}
+
+
+if {[string compare $subjects_in_department_p f] == 0} { 
+   append sql_suffix "$sql_prefix subject_id not in (select subject_id from edu_subject_department_map where department_id = $department_id)"
+} else {
+    append sql_tables ", edu_subject_department_map map "
+    append sql_suffix "$sql_prefix map.subject_id = edu_subjects.subject_id and map.department_id = $department_id"
+}
+
+
+set text_to_output ""
+    
+set selection [ns_db select $db "select edu_subjects.subject_id, 
+                                 subject_name 
+                            from edu_subjects 
+                                 $sql_tables
+                                 $sql_suffix
+                        order by lower(subject_name)"]
+
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    
+    if {![empty_string_p $target_url]} {
+	append text_to_output "
+	<li><a href=\"$target_url?subject_id=$subject_id\">$subject_name</a> <br> \n"
+    } else {
+	append text_to_output "
+	<li> $subject_number $subject_name [ad_space]
+	\[ <a href=\"/subject/one.tcl?subject_id=$subject_id\">home page</a> 
+	| <a href=\"/subject/admin/index.tcl?subject_id=$subject_id\">admin page</a> 
+	| <a href=\"subject-remove.tcl?subject_id=$subject_id\">remove</a> 
+	| <a href=\"subject-number-edit.tcl?subject_id=$subject_id\">edit subject number</a> \]"
+    }
+}
+
+
+if {[empty_string_p $display_text_to_output]} {
+    append return_string "There are no subjects that meet your criteria."
+} else {
+    append return_string "
+    $text
+    $text_to_output
+    "
+}
+    
+    append return_string "
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/department/admin/subject-remove-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/department/admin/subject-remove-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/department/admin/subject-remove-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,33 @@
+#
+# /www/education/department/subject-remove-2.tcl
+#
+# by randyg@arsdigita, aileen@mit.edu, January 2000
+#
+# this page removes a subject form the deparement/subject
+# mapping table
+#
+
+ad_page_variables {
+    subject_id
+}
+
+if {[empty_string_p $subject_id]} {
+    ad_return_complaint 1 "<li>You must include a subject identification number."
+    return
+}
+
+validate_integer subject_id $subject_id
+
+set db [ns_db gethandle]
+
+# set the user and group information
+set id_list [edu_group_security_check $db edu_department]
+set department_id [lindex $id_list 1]
+
+# let's delete the subject from the mapping table
+
+ns_db dml $db "delete from edu_subject_department_map where subject_id = $subject_id and department_id = $department_id"
+
+ns_db releasehandle $db 
+
+ns_returnredirect ""
Index: web/openacs/www/education/department/admin/subject-remove.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/department/admin/subject-remove.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/department/admin/subject-remove.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,66 @@
+#
+# /www/education/department/subject-remove.tcl
+#
+# by randyg@arsdigita, aileen@mit.edu, January 2000
+#
+# this page confirms that the user wants to remove
+# a subject form the deparement/subject mapping table
+#
+
+
+ad_page_variables {
+    subject_id
+}
+
+if {[empty_string_p $subject_id]} {
+    ad_return_complaint 1 "<li>You must include a subject identification number."
+    return
+}
+
+validate_integer subject_id $subject_id
+
+set db [ns_db gethandle]
+
+# set the user and group information
+set id_list [edu_group_security_check $db edu_department]
+set department_id [lindex $id_list 1]
+set department_name [lindex $id_list 2]
+
+
+# lets make sure that the subject_id provided maps to the department
+
+if {[database_to_tcl_string $db "select count(department_id) from edu_subject_department_map where subject_id = $subject_id and department_id = $department_id"] == 0} {
+    ad_return_complaint 1 "<li> The subject you are trying to delete does not belong to the department $department_name."
+    return
+}
+
+
+set subject_name [database_to_tcl_string $db "select subject_name from edu_subjects where subject_id = $subject_id"]
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "
+
+[ad_header "Department Administration @ [ad_system_name]"]
+
+<h2>Remove $subject_name</h2>
+
+[ad_context_bar_ws [list "../" "Departments"] [list "" "$department_name Administration"] "Remove Subject"]
+
+<hr>
+<blockquote>
+
+Are you sure you want to remove $subject_name from the department of $department_name?  
+
+<form method=post action=\"subject-remove-2.tcl\">
+[export_form_vars subject_id]
+<input type=submit name=button value=\"Remove Subject\">
+</form>
+
+</blockquote>
+[ad_footer]
+"
+
+
+
+
Index: web/openacs/www/education/department/admin/subject-search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/department/admin/subject-search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/department/admin/subject-search.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,133 @@
+#
+# /www/education/department/admin/subject-search.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this is a subject search page that is used in two different cases.
+# first, if someone is added a subject to the department then it
+# displays the subject name and links to the target_url
+# second, this could be someone in the department asking for information
+# about a particlar subject.  When this is the case, we want to provide
+# all of the necessary links.
+#
+
+ad_page_variables {
+    begin
+    end
+    {subjects_in_department_p t}
+    {target_url ""}
+    {text ""}
+}
+
+
+set db [ns_db gethandle]
+
+
+# set the user and group information
+set id_list [edu_group_security_check $db edu_department]
+set user_id [lindex $id_list 0]
+set department_id [lindex $id_list 1]
+set department_name [lindex $id_list 2]
+
+
+#check the input
+set exception_count 0 
+set exception_text ""
+
+
+
+if { (![info exists subject_name] || $subject_name == "") && (![info exists professor] || $professor == "") } {
+    incr exception_count
+    append exception_text "<li>You must specify either an subject_name or professor to search for.\n"
+}
+
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+if {[info exists subject_name] && $subject_name != "" && [info exists professor] && $professor != ""} {
+    set search_text "subject name \"$subject_name\" and professor \"$professor\""
+    set search_clause "lower(subject_name) like '%[string tolower $subject_name]%' and lower(professors_in_charge) like '%[string tolower $professor]%'"
+} elseif { [info exists subject_name] && $subject_name != "" } {
+    set search_text "subject name \"$subject_name\""
+    set search_clause "lower(subject_name) like '%[string tolower $subject_name]%'"
+} else {
+    set search_text "professor \"$last_name\""
+    set search_clause "lower(professors_in_charge) like '%[string tolower $professor]%'"
+}
+
+
+
+
+set return_string "
+[ad_header "Department Administration @ [ad_system_name]"]
+
+<h2> Subject Search </h2>
+$search_text
+<br><br>
+[ad_context_bar_ws [list "/department/" "Departments"] [list "" "$department_name Administration"] "Subject Search"]
+
+<hr>
+<blockquote>
+
+"
+
+set sql_tables ""
+
+
+if {[string compare $subjects_in_department_p f] == 0} { 
+   append search_clause "and subject_id not in (select subject_id from edu_subject_department_map where department_id = $department_id)"
+} else {
+    append sql_tables ", edu_subject_department_map map "
+    append search_clause "and map.subject_id = edu_subjects.subject_id and map.department_id = $department_id"
+}
+
+
+set text_to_output ""
+    
+set selection [ns_db select $db "select edu_subjects.subject_id, 
+                                 subject_name 
+                            from edu_subjects 
+                                 $sql_tables
+                                 where $search_clause
+                        order by lower(subject_name)"]
+
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    
+    if {![empty_string_p $target_url]} {
+	append text_to_output "
+	<li><a href=\"$target_url?subject_id=$subject_id\">$subject_name</a> <br> \n"
+    } else {
+	append text_to_output "<li> $subject_number $subject_name &nbsp &nbsp\[ <a href=\"/subject/one.tcl?subject_id=$subject_id\">home page</a> | <a href=\"/subject/admin/index.tcl?subject_id=$subject_id\">admin page</a> | <a href=\"subject-remove.tcl?subject_id=$subject_id\">remove</a> | <a href=\"subject-number-edit.tcl?subject_id=$subject_id\">edit subject number</a> \]"
+    }
+}
+
+
+if {[empty_string_p $text_to_output]} {
+    append return_string "There are no subjects that meet your criteria."
+} else {
+    append return_string "
+    $text
+    $text_to_output
+    "
+}
+    
+append return_string "
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
Index: web/openacs/www/education/department/admin/subject-status-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/department/admin/subject-status-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/department/admin/subject-status-edit-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,115 @@
+#
+# /www/education/department/admin/subject-status-edit-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page allows the admin to change the subject number and 
+# graduate status of the class
+#
+
+ad_page_variables {
+    subject_id
+    subject_number
+    grad_p
+}
+
+validate_integer subject_id $subject_id
+
+set exception_count 0
+set exception_text ""
+
+if {[empty_string_p $subject_id]} {
+    append exception_text "<li>You must include a subject identification number."
+    incr exception_count
+}
+
+if {[empty_string_p $subject_number]} {
+    appen exception_text "<li>You must include a subject number."
+    incr exception_count
+}
+
+if {[empty_string_p $grad_p]} {
+    append exception_text "<li>You must include the graduate status of the class."
+    incr exception_count
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+set db [ns_db gethandle]
+
+# set the user and group information
+set id_list [edu_group_security_check $db edu_department]
+set user_id [lindex $id_list 0]
+set department_id [lindex $id_list 1]
+set department_name [lindex $id_list 2]
+
+
+set selection [ns_db 0or1row $db "select subject_name,
+                 subject_number as old_subject_number 
+            from edu_subjects sub, 
+                 edu_subject_department_map map 
+           where sub.subject_id = map.subject_id 
+             and map.department_id = $department_id 
+             and sub.subject_id = $subject_id"]
+
+if { $selection == "" } {
+    # the department is not mapped to this subject
+    ad_return_complaint 1 "<li>The subject you have requested does not belong to this department."
+    return
+} else {
+    set_variables_after_query
+}
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "
+
+[ad_header "Edit an Existing Subject @ [ad_system_name]"]
+<h2>Edit Subject Number</h2>
+
+[ad_context_bar_ws [list "../" "Departments"] [list "" "$department_name Administration"] "Edit Subject Properties"]
+
+
+<hr>
+<blockquote>
+<form method=post action=\"subject-status-edit-3.tcl\">
+[export_form_vars subject_id subject_number grad_p]
+
+<b>Subject Name:</b> [ad_space 1] $subject_name
+
+<p>
+
+<b>Subject Number:</b> [ad_space 1] $subject_number
+
+<p>
+
+<b>Is this a Graduate Class?</b> [ad_space 1] [util_PrettyBoolean $grad_p]
+
+<p>
+
+<input type=submit value=\"Change Subject Status\">
+</form>
+
+
+</blockquote>
+[ad_footer]
+"
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/department/admin/subject-status-edit-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/department/admin/subject-status-edit-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/department/admin/subject-status-edit-3.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,57 @@
+#
+# /www/education/department/admin/subject-status-edit-3.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page allows the admin to change the subject number and 
+# graduate status of the class
+# this page does the actual insert
+#
+
+ad_page_variables {
+    subject_id
+    subject_number
+    grad_p
+}
+
+validate_integer subject_id $subject_id
+
+if {[empty_string_p $subject_id]} {
+    ad_return_complaint 1 "<li>You must include a subject identification number."
+    return
+}
+
+if {[empty_string_p $subject_number]} {
+    ad_return_complaint 1 "<li>You must include a subject number."
+    return
+}
+
+
+set db [ns_db gethandle]
+
+# set the user and group information
+set id_list [edu_group_security_check $db edu_department]
+set department_id [lindex $id_list 0]
+
+ns_db dml $db "update edu_subject_department_map 
+                  set subject_number = '$QQsubject_number',
+                      grad_p = '$grad_p'
+                where subject_id = $subject_id 
+                  and department_id = $department_id"
+
+
+ns_db releasehandle $db
+
+ns_returnredirect ""
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/department/admin/subject-status-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/department/admin/subject-status-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/department/admin/subject-status-edit.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,108 @@
+#
+# /www/education/department/admin/subject-status-edit.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page allows the admin to change the subject number and 
+# graduate status of the class
+#
+
+ad_page_variables {
+    subject_id
+}
+
+if {[empty_string_p $subject_id]} {
+    ad_return_complaint 1 "<li>You must include a subject identification number."
+    return
+}
+
+validate_integer subject_id $subject_id
+
+set db [ns_db gethandle]
+
+# set the user and group information
+set id_list [edu_group_security_check $db edu_department]
+set user_id [lindex $id_list 0]
+set department_id [lindex $id_list 1]
+set department_name [lindex $id_list 2]
+
+
+set selection [ns_db 0or1row $db "select subject_name, 
+              subject_number, 
+              grad_p 
+         from edu_subjects sub, 
+              edu_subject_department_map map 
+        where sub.subject_id = map.subject_id 
+          and map.department_id = $department_id 
+          and sub.subject_id = $subject_id"]
+
+if { $selection == "" } {
+    # the department is not mapped to this subject
+    ad_return_complaint 1 "<li>The subject you have requested does not belong to this department."
+    return
+} else {
+    set_variables_after_query
+}
+
+
+set return_string "
+
+[ad_header "Edit an Existing Subject @ [ad_system_name]"]
+<h2>Edit Subject Number</h2>
+
+[ad_context_bar_ws [list "../" "Departments"] [list "" "$department_name Administration"] "Edit Subject Properties"]
+
+
+<hr>
+<blockquote>
+<form method=post action=\"subject-status-edit-2.tcl\">
+
+<b>Subject Name:</b> [ad_space 1] $subject_name
+
+<p>
+
+<b>Subject Number:</b> [ad_space 1] <input type=text size=15 maxsize=20 value=\"$subject_number\" name=subject_number>
+
+<br><br>
+
+<b>Is this a Graduate Class?</b> [ad_space 1]
+"
+
+if {[string compare $grad_p t] == 0} {
+    append return_string "
+    <input type=radio name=grad_p value=t checked> Yes
+    <input type=radio name=grad_p value=f> No
+    "
+} else {
+    append return_string "
+    <input type=radio name=grad_p value=t> Yes
+    <input type=radio name=grad_p value=f checked> No
+    "
+}
+
+append return_string "
+[export_form_vars subject_id]
+<p>
+<input type=submit value=\"Continue\">
+</form>
+
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/department/admin/users/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/department/admin/users/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/department/admin/users/index.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,181 @@
+#
+# /www/education/department/admin/users/index.tcl
+# 
+# by randyg@arsdigita.com, aileen@mit.edu January, 2000
+#
+# This file lists all of the users for a given department (group) and 
+# divides them by role.  In addition, it allows the caller to show
+# only people with "emails beginning with" or "last name beginning with"
+#
+
+ad_page_variables {
+    {target_url one.tcl}
+    {type ""}
+    {target_url_params ""}
+}
+
+
+#This is a list of all the users in a given company and provides
+#links to different functions regarding those users
+
+set db [ns_db gethandle]
+
+# gets the department_id.  If the user is not an admin of the department, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the department_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_department]
+set user_id [lindex $id_list 0]
+set department_id [lindex $id_list 1]
+set department_name [lindex $id_list 2]
+
+set sql_restriction ""
+
+if {![empty_string_p $target_url]} {
+    set header_string "$department_name Users"
+    set end_string "<a href=\"add.tcl\">Add a User</a>"	
+} else {
+    set target_url "one.tcl"
+    set header_string "$department_name Users"
+    set end_string "<a href=\"add.tcl\">Add a User</a>"
+}
+
+
+
+set return_string "
+[ad_header "$department_name @ [ad_system_name]"]
+
+
+<h2>$header_string</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$department_name Home"] [list "../" "Administration"] Users]
+
+<hr>
+<blockquote>
+
+"
+
+set threshhold 75
+
+#see if there are more than $threshhold users
+#if so, give search options
+#if not, list all of the users
+
+if {[database_to_tcl_string $db "select count(distinct user_id) from user_group_map where group_id = $department_id"] < $threshhold } {
+
+    append return_string "
+    <h3>Current Users</h3>
+    <blockquote>
+    "
+
+    set selection [ns_db select $db "select distinct users.user_id, 
+                       first_names, 
+                       last_name,
+                       role,
+                       lower(role) as lower_role,
+                       lower(last_name) as lower_last_name,
+                       lower(first_names) as lower_first_names
+                  from users, 
+                       user_group_map    
+                 where user_group_map.group_id = $department_id
+                       and users.user_id = user_group_map.user_id 
+              order by lower_role, lower_last_name, lower_first_names"]
+
+
+    set counter 0
+    set previous_role member
+    while {[ns_db getrow $db $selection]} {
+	set_variables_after_query
+	if {[string compare [string tolower $role] $previous_role]} {
+	    if {$counter > 0} {
+		append return_string "</ul>"
+	    }
+	    append return_string "<h3>[capitalize $role]</h3><ul>"
+	}
+	append return_string "
+	<li><a href=\"$target_url?$target_url_params&user_id=$user_id\">$last_name, $first_names</a><br>\n"
+	incr counter
+    }
+    
+    if {$counter == 0} {
+	append return_string "The are currently no users in this department."
+    } else {
+	append return_string ""
+	#<br><li><a href=\"../spam.tcl?who_to_spam=[ns_urlencode $role]\">Spam the [capitalize $role]s</a> (link does not yet work) \n"
+    }
+
+    append return_string "</ul>"
+
+} else {
+
+    set url_string [export_url_vars type section_id target_url target_url_params header_string]
+
+    append return_string "
+    <li>Browse by last name : 
+    <a href=\"list.tcl?begin=A&end=H&lastletter=G&browse_type=lastname&$url_string\">A - G</a> |
+    <a href=\"list.tcl?begin=H&end=N&lastletter=M&browse_type=lastname&$url_string\">H - M</a> |
+    <a href=\"list.tcl?begin=N&end=T&lastletter=S&browse_type=lastname&$url_string\">N - S</a> |
+    <a href=\"list.tcl?begin=T&end=z&lastletter=Z&browse_type=lastname&$url_string\">T - Z</a> 
+    <br><br>
+    <li>Browse by email address : 
+    <a href=\"list.tcl?begin=A&end=H&lastletter=G&browse_type=email&$url_string\">A - G</a> |
+    <a href=\"list.tcl?begin=H&end=N&lastletter=M&browse_type=email&$url_string\">H - M</a> |
+    <a href=\"list.tcl?begin=N&end=T&lastletter=S&browse_type=email&$url_string\">N - S</a> |
+    <a href=\"list.tcl?begin=T&end=z&lastletter=Z&browse_type=email&$url_string\">T - Z</a> 
+    <br><br>
+    <li><a href=\"list.tcl?begin=A&end=z&lastletter=Z&browse_type=all&$url_string\">Browse All Users</a>
+
+    <p>
+
+    <form method=post action=\"search.tcl\">
+    [export_form_vars type section_id target_url target_url_params header_string]
+    <li>Search:
+    <br>
+    <table>
+    <tr>
+    <td align=right>
+    By last name: 
+    </td>
+    <td><input type=text name=last_name>
+    </td>
+    <tr>
+    <td align=right>
+    By email: 
+    </td>
+    <td>
+    <input type=text name=email>
+    </td>
+    </tr>
+    <tr>
+    <td colspan=2><input type=submit value=\"Search\">
+    </td>
+    </tr>
+    </table>
+    </form>
+    "
+}
+
+append return_string "
+<br>
+
+$end_string
+
+</ul>
+</blockquote>
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/department/admin/users/list.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/department/admin/users/list.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/department/admin/users/list.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,165 @@
+# 
+# /www/education/department/admin/users/list.tcl
+# 
+# by randyg@arsdigita.com, aileen@mit.edu January, 2000
+#
+# This file lists all of the users for a given class (group) and 
+# divides them by role.  In addition, it allows the caller to show
+# only people with "emails beginning with" or "last name beginning with"
+#
+
+
+ad_page_variables {
+    begin
+    end
+    header_string
+    browse_type
+    lastletter
+    {type ""}
+    {target_url "one.tcl"}
+    {target_url_params ""}
+    {order_by "last_name, first_names, email"}
+    {section_id ""}
+}
+
+validate_integer_or_null section_id $section_id
+
+set db [ns_db gethandle]
+
+
+set id_list [edu_group_security_check $db edu_department "Manage Users"]
+set user_id [lindex $id_list 0]
+set department_id [lindex $id_list 1]
+set department_name [lindex $id_list 2]
+
+
+
+if { ([string compare $begin a] == 0 || [string compare $begin A] == 0) && ([string compare $end z] == 0 || [string compare $end Z] == 0) } {
+    set header All
+    set spam_links_p t
+    set sql_suffix "and users.user_id > 2"
+    set order_by "last_name, first_names, email"
+    set no_one_found ""
+} else {
+    set no_one_found "matching your criteria."
+    set spam_links_p f
+
+    #This code assumes that the variable End is the correct case!!!
+    if {[string compare $browse_type lastname] == 0} {
+	set header "Last Names $begin through $lastletter"
+	set sql_suffix "and upper('$begin') < upper(last_name)
+                    and '$end' > upper(last_name)
+                       and users.user_id > 2"
+	set order_by "last_name, first_names, email"
+    } else {
+	set header "Emails $begin through $lastletter"
+	set sql_suffix "and upper('$begin') < upper(email)
+                    and '$end' > upper(email)
+                    and users.user_id > 2"
+	set order_by "email, last_name"
+    }
+}
+
+
+set export_vars [export_url_vars begin end browse_type lastletter]
+
+set count 0
+
+if {![empty_string_p $target_url_params]} {
+    set params [join $param_list "&"]
+    append target_url "?$params"
+    set middle_char &
+} else {
+    set middle_char ?
+}
+
+
+if {[string compare $type section_leader] == 0} {
+    set header_string "Select a Section Instructor"
+    set end_string ""
+    set nav_bar_value "Add a Section"
+} else {
+    set header_string "$department_name Users"
+    set end_string "<a href=user-add.tcl>Add a User</a>"
+    set nav_bar_value "Users"
+}
+
+
+
+set return_string "
+
+[ad_header "Add a Department @ [ad_system_name]"]
+
+<h2>$header_string - $header </h2>
+
+[ad_context_bar_ws [list "/department/one.tcl?department_id=$department_id" "$department_name Home"] [list "" Administration] "$nav_bar_value"]
+
+
+<hr>
+
+<h3>Current Users</h3>
+
+<blockquote>
+"
+
+
+
+# if there is a target url, make all users go to the same url
+# otherwise, have them go to user-info
+
+
+set selection [ns_db select $db "select distinct users.user_id, 
+                       first_names, 
+                       last_name,
+                       role,
+                       lower(role) as lower_role,
+                       lower(last_name) as lower_last_name,
+                       lower(first_names) as lower_first_names
+                  from users, 
+                       user_group_map    
+                 where user_group_map.group_id = $department_id
+                       and users.user_id = user_group_map.user_id 
+                       $sql_suffix
+                       
+              order by lower_role, lower_last_name, lower_first_names"]
+
+
+set counter 0
+set previous_role member
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    if {[string compare [string tolower $role] $previous_role]} {
+	if {$counter > 0} {
+	    append return_string "</ul>"
+	}
+	append return_string "<h3>[capitalize $role]</h3><ul>"
+    }
+    append return_string "
+    <li><a href=\"$target_url?$target_url_params&user_id=$user_id\">$last_name, $first_names</a><br>\n"
+    incr counter
+}
+
+if {$counter == 0} {
+    append return_string "The are currently no users in this department $department_id"
+} else {
+    append return_string "<br><li><a href=\"../spam.tcl?who_to_spam=[ns_urlencode $role]\">Spam the [capitalize $role]s</a> (link does not yet work) \n"
+}
+
+append return_string "
+</ul>
+
+</blockquote>
+
+[ad_footer]
+"
+
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
Index: web/openacs/www/education/department/admin/users/one.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/department/admin/users/one.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/department/admin/users/one.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,258 @@
+#
+# /www/education/department/admin/users/one.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# This page displays information about the users.  If the user had a role
+# of 'student' for the given group then it redirects to student-info.tcl
+#
+
+ad_page_variables {
+    user_id
+}
+
+validate_integer user_id $user_id
+
+set authorized_user_id $user_id
+
+set db [ns_db gethandle]
+
+# gets the department_id.  If the user is not an admin of the class, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the class_id to make sure it is valid
+
+set id_list [edu_group_security_check $db edu_department]
+set user_id [lindex $id_list 0]
+set department_id [lindex $id_list 1]
+set department_name [lindex $id_list 2]
+
+
+# let's find out the role and name of the user so that we can decide
+# whether or not to redirect.
+
+# set sql "select first_names, 
+#          last_name, 
+#          email, 
+#          map.role,
+#          url,
+#          portrait,
+#          portrait_thumbnail
+#     from users, 
+#          user_group_map map
+#    where users.user_id = $authorized_user_id 
+#      and users.user_id = map.user_id 
+#      and map.group_id=$department_id"
+
+set portrait_thumbnail ""
+
+set sql "select first_names, 
+         last_name, 
+         email, 
+         map.role,
+         url,
+         portrait_client_file_name
+    from users, 
+         user_group_map map
+   where users.user_id = $authorized_user_id 
+     and users.user_id = map.user_id 
+     and map.group_id=$department_id"
+
+set selection [ns_db select $db $sql]
+
+
+set count 0
+set role_list [list]
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr count
+    lappend role_list [capitalize $role]
+}
+
+if {$count == 0} {
+    ad_return_complaint 1 "<li>The user identification number recieved by this page is not valid.  Please try accessing the page through a different method. $user_id $department_id"
+    return
+} 
+
+
+# if the person that we are supposed to show is a student, lets redirect to 
+# student_info.tcl
+
+if {[lsearch $role_list [string tolower [edu_get_student_role_string]]] != -1 || [lsearch $role_list [string tolower [edu_get_dropped_role_string]]] != -1} {
+    ns_returnredirect "student-info.tcl?student_id=$authorized_user_id"
+    return
+}
+
+
+append return_string "
+[ad_header "$department_name @ [ad_system_name]"]
+
+<h2>Information for $first_names $last_name</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl?department_id=$department_id" "$department_name Home"] [list "../" "Administration"] [list "" Users] "One User"]
+
+
+<hr>
+<blockquote>
+<table>
+<tr>
+<td>
+
+<table>
+<tr><th align=right>Email:</th>
+<td><a href=\"mailto:$email\">$email</a></td>
+</tr>
+<tr><th align=right>URL:</th>
+<td> 
+"
+
+if {![empty_string_p $url]} {
+    append return_string "<a href=\"$url\">$url</a>"
+} else {
+    append return_string "None"
+}
+
+append return_string "
+</td>
+</tr>
+"
+
+set selection [ns_db select $db "
+select field_name, field_value from user_group_member_field_map m
+where m.user_id=$authorized_user_id 
+and m.group_id=$department_id"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    
+    if {![empty_string_p $field_value]} {
+	append return_string "
+	<tr><th align=right>$field_name:</th>
+	<td>$field_value</td>
+	</tr>"    
+    }
+}
+ 
+
+append return_string "
+<tr><th align=right>User Role:</th> 
+<td>[join $role_list ", "]</td>
+</tr>
+</table>
+
+
+</td>
+<td>
+"
+
+if {![empty_string_p $portrait_thumbnail]} {
+    append return_string "
+    <a href=\"/shared/portrait.tcl?user_id=$authorized_user_id\"><img width=125 src=\"/shared/portrait-thumbnail-bits.tcl?user_id=$authorized_user_id\"></a>"
+} elseif {![empty_string_p $portrait_client_file_name]} {
+    append return_string "
+    <a href=\"/shared/portrait.tcl?user_id=$authorized_user_id\"><img width=125 src=\"/shared/portrait-bits.tcl?user_id=$authorized_user_id\"></a>"
+}
+
+append return_string "
+</td>
+</tr>
+</table>
+
+"
+
+set n_spams_sent [database_to_tcl_string $db "select count(spam_id) 
+      from group_spam_history 
+     where sender_id = $authorized_user_id 
+       and group_id in (select distinct group_id 
+                        from user_groups 
+                       where parent_group_id = $department_id)"]
+
+if {$n_spams_sent > 0} {
+    append return_string "
+    <p>
+    <li>$first_names has sent <a href=\"../spam-history.tcl?user_id=$authorized_user_id\">$n_spams_sent spams</a>"
+}
+
+
+# set sql "select class_id, 
+#            term_name,
+#            class_name, 
+#            pretty_role
+#       from edu_classes,
+#            edu_terms,
+#            (select pretty_role, map.group_id
+#                from user_group_map map,
+#                     edu_role_pretty_role_map role_map
+#               where lower(role_map.role) = lower(map.role)
+#                 and role_map.group_id = map.group_id
+#                 and map.user_id = $authorized_user_id) groups
+#      where edu_classes.term_id = edu_terms.term_id(+)
+#        and groups.group_id = edu_classes.class_id
+#   order by lower(class_name), edu_classes.end_date, edu_terms.end_date"
+
+set sql "select class_id, 
+           term_name,
+           class_name, 
+           pretty_role
+      from edu_classes,
+           edu_terms,
+           role_mapping groups
+     where edu_classes.term_id = edu_terms.term_id
+       and groups.group_id = edu_classes.class_id
+       and groups.user_id = $authorized_user_id
+     union
+    select class_id, 
+           '' as term_name,
+           class_name, 
+           pretty_role
+      from edu_classes,
+           role_mapping groups
+     where not exists (select 1 from edu_terms 
+                       where term_id = edu_classes.term_id)
+       and groups.group_id = edu_classes.class_id
+       and groups.user_id = $authorized_user_id
+  order by lower(class_name), edu_classes.end_date"
+
+
+# lets get the list of classes that this person is associated with
+
+set selection [ns_db select $db $sql]
+     
+
+
+set count 0
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    if {$count == 0} {
+	append return_string "<h3>Classes</h3><ul>"
+    }
+    append return_string "<li><a href=\"/education/util/group-login.tcl?group_id=$class_id&group_type=edu_class&return_url=[ns_urlencode [edu_url]/class/one.tcl]\"> $class_name </a>"
+    if {![empty_string_p $term_name]} {
+	append return_string "[ad_space] ($term_name)"
+    }
+    append return_string " - $pretty_role\n"
+    incr count
+}
+
+if {$count > 0} {
+    append return_string "</ul>"
+}
+
+
+append return_string " 
+<p>
+<li><a href=\"role-change.tcl?user_id=$authorized_user_id\">Edit user's roles</a></li>
+<li><a href=\"password-update.tcl?user_id=$authorized_user_id\">Update user's password</a></li>
+<li><a href=\"delete.tcl?user_id=$authorized_user_id\">Remove user</a></li>
+
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
Index: web/openacs/www/education/news/news-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/news/news-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/news/news-add.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,69 @@
+# add news item for a group -- class, dept, or team
+# /education/news/news-add.tcl
+# aileen@mit.edu, randyg@mit.edu
+# feb 2000
+
+ad_page_variables {
+    group_id
+}
+
+validate_integer group_id $group_id
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+# maybe return_url, name
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+set user_id [ad_scope_authorize $db $scope all all all ]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register/index.tcl?[export_url_scope_vars]&return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+if { [ad_parameter ApprovalPolicy news] == "open"} {
+    set verb "Post"
+} elseif { [ad_parameter ApprovalPolicy news] == "wait"} {
+    set verb "Suggest"
+} else {
+    ns_returnredirect "index.tcl?[export_url_scope_vars]"
+    return
+}
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "
+[ad_scope_header "$verb News" $db]
+[ad_scope_page_title "$verb News" $db]
+
+for [ad_site_home_link]
+<hr>
+[ad_scope_navbar]
+
+<form method=post action=\"post-new-2.tcl\">
+[export_form_scope_vars]
+
+<table>
+<tr><th>Title <td><input type=text size=40 name=title>
+<tr><th>Full Story <td><textarea cols=60 rows=6 wrap=soft name=body></textarea>
+<tr><th align=left>Text above is
+<td><select name=html_p><option value=f>Plain Text<option value=t>HTML</select></td>
+</tr>
+<tr><th>Release Date <td>[philg_dateentrywidget release_date [database_to_tcl_string $db "select sysdate() from dual"]]
+<tr><th>Expire Date <td>[philg_dateentrywidget expiration_date [database_to_tcl_string $db "select sysdate() + [ad_parameter DefaultStoryLife news 30] from dual"]]
+</table>
+<br>
+<center>
+<input type=\"submit\" value=\"Submit\">
+</center>
+</form>
+[ad_scope_footer]
+"
+ 
Index: web/openacs/www/education/subject/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/subject/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/subject/index.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,91 @@
+#
+# /www/education/subject/index.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page displays a list of subjects
+#
+
+# optionally takes department_id.  If there is a department_id 
+# defined then it only lists subjects in that department
+
+ad_page_variables {
+    {department_id ""}
+}
+
+validate_integer department_id $department_id
+
+set db [ns_db gethandle]
+
+set threshhold 20000
+
+set return_string "
+
+[ad_header "[ad_system_name] - Subjects"]
+<h2>Subjects</h2>
+
+[ad_context_bar_ws "Subjects"]
+
+<hr>
+<blockquote>
+<ul>
+"
+
+if {![empty_string_p $department_id]} {
+    set selection [ns_db select $db "select count(subject_id) as n_subjects,
+        subject_id,
+        subject_name,
+        subject_number
+   from edu_subjects,
+        edu_subject_department_map map
+  where map.department_id = $department_id
+    and map.subject_id = edu_subjects.subject_id
+    group by subject_id, subject_name, subject_number
+    order by lower(subject_number), lower(subject_name)"] 
+} else {
+    # they want all subjects, not just one for particular departments
+    
+    set selection [ns_db select $db "select count(subject_id) as n_subjects,
+        subject_id,
+        subject_name
+   from edu_subjects
+    group by subject_id, subject_name
+    order by lower(subject_name)"]
+}
+
+# lets get the number of subjects
+
+if {![ns_db getrow $db $selection]} {
+    append return_string "</ul>There currently are no subjects in the system.<ul>"
+} else {
+    set_variables_after_query
+    append return_string "<li><a href=\"one.tcl?subject_id=$subject_id\">$subject_name</a> \n"
+    
+    if {$n_subjects < $threshhold} {
+
+        while {[ns_db getrow $db $selection]} {
+ 	    set_variables_after_query
+ 	    append return_string "<li><a href=\"one.tcl?subject_id=$subject_id\">$subject_name</a> \n"
+ 	}
+     }
+}
+
+append return_string "
+</ul>
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/subject/list.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/subject/list.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/subject/list.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,127 @@
+#
+# /www/education/subject/list.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page lists the subjects that meet the passed in criteria
+#
+
+ad_page_variables {
+    begin
+    end
+    {department_id ""}
+    {return_url ""}
+    {display_text ""}
+}
+
+validate_integer_or_null department_id $department_id
+
+set db [ns_db gethandle]
+
+
+
+#check the input
+set exception_count 0 
+set exception_text ""
+
+if {[empty_string_p $begin] } {
+    incr exception_count
+    append exception_text "<li>You must have a starting letter\n"
+}
+
+if {[empty_string_p $end] } {
+    incr exception_count
+    append exception_text "<li>You must have a stopping letter\n"
+}
+
+if {[empty_string_p $lastletter] } {
+    incr exception_count
+    append exception_text "<li>You must provide a last letter\n"
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+
+
+if { [string compare [string tolower $begin] a] == 0 && ([string compare [string tolower $end z] == 0 } {
+    set header "All Subject"
+    set sql_suffix ""
+} else {
+    set header "Subject Names $begin through $lastletter"
+    set sql_suffix "upper('$begin') < upper(subject_name)
+               and upper('$end') > upper(subject_name)"
+}
+
+
+set return_string "
+[ad_header "Subject Administration @ [ad_system_name]"]
+
+<h2> $header </h2>
+
+[ad_context_bar_ws [list "" Subjects] Subjects]
+
+<hr>
+<blockquote>
+
+"
+if {![empty_string_p $department_id]} {
+    set selection [ns_db select $db "select subject_id,
+        subject_name,
+        subject_number
+   from edu_subjects,
+        edu_subject_department_map map
+  where map.department_id = $department_id
+    and map.subject_id = edu_subjects.subject_id
+    and $sql_suffix
+    order by lower(subject_number), lower(subject_name)"] 
+} else {
+    # they want all subjects, not just one for particular departments
+    
+    set selection [ns_db select $db "select subject_id,
+        subject_name
+   from edu_subjects
+  where $sql_suffix
+  order by lower(subject_name)"]
+}
+
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query    
+    append text_to_output "<a href=\"one?subject_id=$subject_id\">$subject_name <br> \n"
+}
+
+
+if {[empty_string_p $text_to_output]} {
+    append return_string "There are no subjects that meet your criteria."
+} else {
+    append return_string "
+    $text
+    $text_to_output
+    "
+}
+    
+append return_string "
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/subject/one.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/subject/one.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/subject/one.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,159 @@
+#
+# /www/education/subject/one.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page show information about the requested subject
+#
+
+
+ad_page_variables {
+    subject_id 
+}
+
+validate_integer subject_id $subject_id
+
+if {[empty_string_p $subject_id]} {
+    ad_return_complaint 1 "<li> You must include a subject identification number."
+    return
+}
+
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select subject_name, description, credit_hours, prerequisites, professors_in_charge from edu_subjects where subject_id = $subject_id"]
+
+if {$selection == ""} {
+    ad_return_complaint 1 "<li> The subject identification number you have entered is not valid."
+    return
+} else {
+    set_variables_after_query
+}
+
+
+
+set return_string "
+
+[ad_header "[ad_system_name] - Add a Subject"]
+<h2>$subject_name</h2>
+
+[ad_context_bar_ws [list "" "Subjects"] "One Subject"]
+
+<hr>
+<blockquote>
+
+<table>
+
+<tr>
+<th align=left valign=top>
+Subject Name:
+</td>
+<td>
+$subject_name
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Description:
+</td>
+<td>
+[address_book_display_as_html $description]
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Credit Hours:
+</td>
+<td>
+$credit_hours
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Prerequisites:
+</td>
+<td>
+[address_book_display_as_html $prerequisites]
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Professors in Charge:
+</td>
+<td>
+$professors_in_charge
+</td>
+</tr>
+
+</table>
+
+<h3>Departments</h3>
+<ul>
+"
+
+set selection [ns_db select $db "select map.department_id, 
+      department_name, 
+      subject_number 
+ from edu_subject_department_map map, 
+      edu_departments 
+where edu_departments.department_id = map.department_id 
+  and map.subject_id = $subject_id"]
+
+
+set n_departments 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr n_departments
+    append return_string "<li><a href=\"../department/one.tcl?department_id=$department_id\">$department_name</a>; $subject_number \n"
+}
+
+if {$n_departments == 0} {
+    append return_string "<li>This subject is not currently affiliated with any department."
+}
+
+
+append return_string "
+</ul>
+<h3>Classes</h3>
+<ul>
+"
+
+set count 0
+set selection [ns_db select $db "select class_name, class_id, term_name
+from edu_terms t, edu_classes c
+where c.subject_id=$subject_id
+and c.term_id=t.term_id
+order by
+t.start_date"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr count
+    append return_string "
+    <li><a href=\"../class/one.tcl?[export_url_vars class_id]\">$class_name ($term_name)</a>"
+}
+
+if {$count == 0} {
+    append return_string "There are currently no classes in this subject."
+}
+
+append return_string "
+</ul>
+
+</blockquote>
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
Index: web/openacs/www/education/subject/admin/class-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/subject/admin/class-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/subject/admin/class-add-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,228 @@
+#
+# /www/education/subject/admin/class-add-2.tcl
+#
+# by randyg@arsdigita.com, aileen@arsdigita.com, January 2000
+#
+# this is the confirmation page for the addition of a subject.
+#
+
+ad_page_variables {
+    group_name
+    term_id
+    {where_and_when ""}
+    {ColValue.start%5fdate.day ""}
+    {ColValue.start%5fdate.month ""}
+    {ColValue.start%5fdate.year ""}
+    {ColValue.end%5fdate.day ""} 
+    {ColValue.end%5fdate.month ""}
+    {ColValue.end%5fdate.year ""}
+    {public_p t}
+    {grades_p t}
+    {exams_p t}
+    {final_exam_p t}
+    {description ""}
+    subject_id
+    instructor_id
+    {teams_p f}
+}
+
+validate_integer_or_null term_id $term_id
+validate_integer subject_id $subject_id
+validate_integer instructor_id $instructor_id
+
+set db [ns_db gethandle]
+
+set user_id [edu_subject_admin_security_check $db $subject_id]
+
+
+#check the input
+set exception_count 0
+set exception_text ""
+
+
+if {[empty_string_p $subject_id]} {
+    incr exception_count 
+    append exception_text "<li>You must include the subject identifiaction number."
+}
+
+if {[empty_string_p $group_name]} {
+    incr exception_count 
+    append exception_text "<li>You must name your class."
+}
+
+if {[empty_string_p $term_id]} {
+    incr exception_count
+    append exception_text "<li>You must choose a term."
+}
+
+# put together due_date, and do error checking
+
+set form [ns_getform]
+
+# ns_dbformvalue $form start_date date start_date will give an error
+# message if the day of the month is 08 or 09 (this octal number problem
+# we've had in other places).  So I'll have to trim the leading zeros
+# from ColValue.start%5fdate.day and stick the new value into the $form
+# ns_set.
+
+set "ColValue.start%5fdate.day" [string trimleft [set ColValue.start%5fdate.day] "0"]
+ns_set update $form "ColValue.start%5fdate.day" [set ColValue.start%5fdate.day]
+
+if [catch  { ns_dbformvalue $form start_date date start_date} errmsg ] {
+    incr exception_count
+    append exception_text "<li>The date was specified in the wrong format.  The date should be in the format Month DD YYYY.\n"
+} elseif { [string length [set ColValue.start%5fdate.year]] != 4 } {
+    incr exception_count
+    append exception_text "<li>The year needs to contain 4 digits.\n"
+} elseif {[database_to_tcl_string $db "select date_part('day',trunc(sysdate()) - to_date('$start_date','YYYY-MM-DD')) from dual"] > 1} {
+    incr exception_count
+    append exception_text "<li>The start date must be in the future."
+}
+
+
+set "ColValue.end%5fdate.day" [string trimleft [set ColValue.end%5fdate.day] "0"]
+ns_set update $form "ColValue.end%5fdate.day" [set ColValue.end%5fdate.day]
+
+if [catch  { ns_dbformvalue $form end_date date end_date} errmsg ] {
+    incr exception_count
+    append exception_text "<li>The date was specified in the wrong format.  The date should be in the format Month DD YYYY.\n"
+} elseif { [string length [set ColValue.end%5fdate.year]] != 4 } {
+    incr exception_count
+    append exception_text "<li>The year needs to contain 4 digits.\n"
+} elseif {[database_to_tcl_string $db "select date_part('day',sysdate() - to_date('$end_date','YYYY-MM-DD')) from dual"] > 1} {
+    incr exception_count
+    append exception_text "<li>The end date must be in the future."
+}
+
+if {[string compare $exception_count 0] == 0 && ![empty_string_p $start_date] && ![empty_string_p $end_date]} {
+    if {[database_to_tcl_string $db "select to_date('$end_date', 'YYYY-MM-DD') - to_date('$start_date', 'YYYY-MM-DD') from dual"] < 0 } {
+	incr exception_count
+	append exception_text "<li>The end date must be after the start day."
+    }
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+# now that we know we have valid input, we display the confirmation page
+
+set instructor_name [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id=$instructor_id"]
+
+set group_id [database_to_tcl_string $db "select user_group_sequence.nextval from dual"]
+
+set subject_name [database_to_tcl_string $db "select subject_name from edu_subjects where subject_id = $subject_id"]
+set term_string [database_to_tcl_string $db "select term_name from edu_terms where term_id = $term_id"]
+
+ns_db releasehandle $db
+
+set return_string "
+[ad_header "Add a Class @ [ad_system_name]"]
+
+<h2>Add a $subject_name Class</h2>
+
+[ad_context_bar_ws [list "../" "Subjects"] [list "" "Subject Administration"] "Add a Class"]
+
+
+
+<hr>
+<blockquote>
+<table>
+<tr><th align=right>Instructor:
+</td>
+<td>$instructor_name
+</tr>
+
+<tr><th align=right>Class Title:
+</td>
+<td>$group_name
+</tr>
+
+<tr><th align=right>Term: 
+</td>
+<td>
+$term_string
+</tr>
+
+<tr><th valign=top align=right>Meeting time and place: </th>
+<td>$where_and_when</td>
+</tr>
+
+<tr><th align=right>Date to Start Displaying<br>Class Web Page: 
+<td valign=top>[util_AnsiDatetoPrettyDate $start_date]
+</td>
+</tr>
+
+<tr><th align=right>Date to Stop Displaying<br>Class Web Page: 
+<td valign=top>[util_AnsiDatetoPrettyDate $end_date]
+</td>
+</tr>
+
+<tr><th align=right>Will the class web page and<br>documents be open to the public?
+<td valign=top>[util_PrettyBoolean $public_p]
+</td>
+</tr>
+
+<tr><th align=right>Do students recieve grades?
+<td valign=top>[util_PrettyBoolean $grades_p]
+</td>
+</tr>
+
+<tr><th align=right>Will the class have teams?
+<td valign=top>[util_PrettyBoolean $teams_p]
+</td>
+</tr>
+
+<tr><th align=right>Will the class have exams?
+<td valign=top>[util_PrettyBoolean $exams_p]
+</td>
+</tr>
+
+<tr><th align=right>Will the class have a final exam?
+<td valign=top>[util_PrettyBoolean $final_exam_p]
+</td>
+</tr>
+<tr><th align=right>Class Description
+</td>
+"
+
+if {[empty_string_p $description]} {
+    append return_string "<td valign=top>None"
+} else {
+    append return_string "<td valign=top>$description"
+}
+
+append return_string "
+</td>
+</tr>
+
+<tr>
+<td colspan=2 align=center>
+<br>
+<form method=post action=\"class-add-3.tcl\">
+[export_form_vars group_name term_id where_and_when start_date end_date public_p grades_p exams_p final_exam_p description subject_id instructor_id teams_p group_id]
+
+<input type=submit value=\"Create a New Class\"></td>
+
+</form>
+</td>
+</tr>
+</table>
+
+
+
+</blockquote>
+[ad_footer]
+"
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
Index: web/openacs/www/education/subject/admin/class-add-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/subject/admin/class-add-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/subject/admin/class-add-3.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,202 @@
+#
+# /www/education/subject/admin/class-add-3.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu
+#
+# this page inserts the class into the database as a member of
+# this subject
+#
+
+
+
+ad_page_variables {
+    group_name
+    group_id
+    term_id
+    subject_id
+    instructor_id
+    start_date
+    end_date
+    {where_and_when ""}
+    {public_p t}
+    {grades_p t}
+    {exams_p t}
+    {final_exam_p t}
+    {description ""}
+    {teams_p f}
+}
+
+validate_integer group_id $group_id
+validate_integer term_id $term_id
+validate_integer subject_id $subject_id
+validate_integer instructor_id $instructor_id
+
+
+#check the input
+set exception_count 0
+set exception_text ""
+
+
+set variables_to_check [list [list group_name "Class Title"] [list grades_p "Grades"] [list exams_p "Exams"] [list final_exam_p "Final Exam"] [list term_id "Term"] [list group_id "Group Identification Number"] [list start_date "Start Date"] [list end_date "End Date"]]
+
+foreach var $variables_to_check {
+    if {[empty_string_p [set [lindex $var 0]]]} {
+	incr exception_count
+	append exception_text "<li>You forgot to provide a value for the [lindex $var 1]"
+    }
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+
+set db [ns_db gethandle]
+
+set user_id [edu_subject_admin_security_check $db $subject_id]
+
+
+#lets check and make sure that it is not a double click
+if {[database_to_tcl_string $db "select count(group_id) from user_groups where group_id = $group_id"] > 0} {
+    ns_returnredirect "index.tcl?subject_id=$subject_id"
+    return
+}
+
+
+
+set term_name [database_to_tcl_string $db "select term_name from edu_terms where term_id = $term_id"]
+
+
+# we want to add a folder in the file system for the class and
+# within that folder we want to create a problem sets, lecture notes,
+# and handouts folder
+
+
+
+# we get IDs for class_folder, assignments_folder, lecture_notes_folder, 
+# handouts_folder and exams_folder...these are file_id and version_id and
+# we build a list to do the inserts
+
+# the class folder name has to be first because it is the parent of the rest
+# of the folders
+
+# we also build the sql update clause at the same time...the folder_name_list
+# is a list of lists corresponding to the folder name and a list of related columns
+
+set folder_name_list [list [list "$group_name Class Folder - $term_name"] [list "Assignments" assignments_folder_id] [list "Lecture Notes" lecture_notes_folder_id] [list "Handouts" handouts_folder_id] [list "Exams" exams_folder_id] [list "Projects" projects_folder_id]]
+
+set folder_id_list [list]
+set sql_update_statment [list]
+set folder_count 0
+
+while {[llength $folder_id_list] < [llength $folder_name_list]} {
+    set id_list [database_to_tcl_list_list $db "select fs_file_id_seq.nextval as a, fs_version_id_seq.nextval as b from dual"]
+    lappend folder_id_list "[list [lindex [lindex $folder_name_list $folder_count] 0] [lindex [lindex $id_list 0] 0] [lindex [lindex $id_list 0] 1]]"
+
+    if {[llength [lindex $folder_name_list $folder_count]] > 1} {
+	lappend sql_update_statment "[lindex [lindex $folder_name_list $folder_count] 1] = [lindex [lindex $id_list 0] 0]"
+    }
+
+    incr folder_count
+}
+
+
+# the order of this is as follows:
+# 1. stuff all of the edu_class_info variables into an ns_set
+# 2. create the class
+# 3. create the roles for the class
+# 4. create the four folders for the class
+# 5. place pointers to the folders into the edu_class_info table
+
+# we have to create the folders after we create the class because the
+# folders reference the class and doing it the other way around would
+# cause an error.
+
+
+ns_db dml $db "begin transaction"
+
+
+# throw all of the class variables into an ns_set so that the ad_user_group_add
+# will take care of putting them into the _info table
+
+set var_set [ns_set new]
+
+ns_set put $var_set term_id $term_id
+ns_set put $var_set where_and_when $where_and_when
+ns_set put $var_set start_date $start_date
+ns_set put $var_set end_date $end_date
+ns_set put $var_set public_p $public_p
+ns_set put $var_set grades_p $grades_p
+ns_set put $var_set exams_p $exams_p
+ns_set put $var_set final_exam_p $final_exam_p
+ns_set put $var_set description $description
+ns_set put $var_set teams_p $teams_p
+ns_set put $var_set subject_id $subject_id
+
+
+ad_user_group_add $db edu_class $group_name t t open t $var_set $group_id
+
+#create the role and actions for the class
+edu_set_class_roles_and_actions $db $group_id
+
+#finally, add the instructor to the class
+ad_user_group_user_add $db $instructor_id [edu_get_professor_role_string] $group_id 
+
+
+set depth 0
+set parent_id ""
+
+foreach folder $folder_id_list {
+    ns_db dml $db "insert into fs_files
+    (file_id, file_title, owner_id, parent_id, folder_p, sort_key, depth, public_p, group_id)
+    values
+    ([lindex $folder 1], '[DoubleApos [lindex $folder 0]]', $user_id, [ns_dbquotevalue $parent_id], 't',0,$depth, 'f', [ns_dbquotevalue $group_id])"
+
+    # this if statement makes the first folder inserted the parent of all of
+    # the rest of the folders.
+    if {[empty_string_p $parent_id]} {
+	set parent_id [lindex $folder 1]
+	set depth 1
+    }
+
+    # now we want to insert a "dummy" version so that we can also create the permission
+    # records
+
+    ns_db dml $db "insert into fs_versions
+    (version_id, file_id, creation_date, author_id)
+    values
+    ([lindex $folder 2], [lindex $folder 1], sysdate(), $user_id)"
+
+    ns_db select $db "select grant_permission_to_all_users ( 'read', [lindex $folder 2], 'FS_VERSIONS' )"
+    ns_db select $db "select grant_permission_to_all_users ( 'comment', [lindex $folder 2], 'FS_VERSIONS' )"
+
+}
+
+
+fs_order_files $db $user_id $group_id $public_p
+
+
+ns_db dml $db "update edu_class_info 
+                      set [join $sql_update_statment ","],
+       	                  last_modified = sysdate(),
+                          last_modifying_user = $user_id,
+                          modified_ip_address = '[ns_conn peeraddr]'                      
+                    where group_id = $group_id"
+
+
+# create a newsgroup for this class - richardl@arsdigita.com
+ns_db dml $db "insert into newsgroups(newsgroup_id, scope, group_id)
+               values(nextval('newsgroup_id_sequence'), 'group', $group_id)"
+
+ns_db dml $db "end transaction"
+
+ns_db releasehandle $db
+
+ns_returnredirect "index.tcl?subject_id=$subject_id"
+
+
+
+
Index: web/openacs/www/education/subject/admin/class-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/subject/admin/class-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/subject/admin/class-add.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,132 @@
+#
+# /www/education/subject/admin/class-add.tcl
+#
+# by randyg@arsdigita.com, aileen@arsdigita.com
+#
+# this page gives the user a form to fill out class information
+#
+
+ad_page_variables {
+    subject_id
+    user_id
+    {term_id ""}
+}
+
+validate_integer subject_id $subject_id
+validate_integer user_id $user_id
+validate_integer_or_null term_id $term_id
+
+set list_to_check [list [list user_id "an instructor"] [list subject_id "a subject"]]
+
+set exception_count 0
+set exception_text ""
+
+foreach item $list_to_check {
+    if {[empty_string_p [lindex $item 0]]} {
+	append exception_text "<li>You must specify [lindex $item 1]\n"
+	incr exception_count
+    }
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+set instructor_id $user_id
+
+if {![info exists term_id]} {
+    set term_id ""
+}
+
+
+set db [ns_db gethandle]
+
+set user_id [edu_subject_admin_security_check $db $subject_id]
+
+set subject_name [database_to_tcl_string $db "select subject_name from edu_subjects where subject_id = $subject_id"]
+
+
+set instructor_name [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id = $user_id"] 
+
+set term_select_string [edu_term_select_widget $db term_id $term_id]
+set date_widget_string [ad_dateentrywidget end_date [database_to_tcl_string $db "select date(add_months(sysdate(),12)) from dual"]]
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "
+[ad_header "Add a Class @ [ad_system_name]"]
+
+<h2>Add a $subject_name Class</h2>
+
+[ad_context_bar_ws [list "" "Subjects"] [list "index.tcl?[export_url_vars subject_id]" "Subject Administration"] "Add a Class"]
+
+<hr>
+<blockquote>
+
+<form method=post action=\"class-add-2.tcl\">
+[export_form_vars instructor_id subject_id]
+
+<table>
+<tr><th align=right>Instructor
+<td>$instructor_name
+</tr>
+
+<tr><th align=right>Class Title
+<td><input type=text size=60 name=group_name maxsize=100 value=\"$subject_name\"> 
+</tr>
+
+<tr><th align=right>Term: 
+<td>
+$term_select_string
+</tr>
+
+<tr><th valign=top align=right>Meeting time and place: 
+<br>(e.g. Lecture: TR10 (10-250) Recitation: WF10 (13-4101) or WF11 (13-4101))</th>
+<td>[edu_textarea where_and_when]</td>
+</tr>
+
+<tr><th align=right>Date to Start Displaying Class Web Page: 
+<td>[ad_dateentrywidget start_date]
+</tr>
+
+<tr><th align=right>Date to Stop Displaying Class Web Page: 
+<td>$date_widget_string
+</tr>
+
+<tr><th align=right>Will the class web page and documents be open to the public?
+<td><input type=radio name=public_p checked value=t>Yes &nbsp;<input type=radio name=public_p value=f>No
+</tr>
+
+<tr><th align=right>Do students recieve grades?
+<td><input type=radio name=grades_p value=t checked>Yes &nbsp;<input type=radio name=grades_p value=f>No
+</tr>
+
+<tr><th align=right>Will the class have teams?
+<td><input type=radio name=teams_p value=t>Yes &nbsp;<input type=radio name=teams_p value=f checked>No
+</tr>
+
+<tr><th align=right>Will the class have exams?
+<td><input type=radio name=exams_p value=t checked>Yes &nbsp;<input type=radio name=exams_p value=f>No
+</tr>
+
+<tr><th align=right>Will the class have a final exam?
+<td><input type=radio name=final_exam_p value=t checked>Yes &nbsp;<input type=radio name=final_exam_p value=f>No
+</tr>
+<tr><th align=right>Class Description
+<td><textarea wrap name=description rows=4 cols=50></textarea>
+</tr>
+
+<tr><td colspan=2 align=center><input type=submit value=\"Continue\"></td>
+</tr>
+</table>
+</form>
+
+</blockquote>
+[ad_footer]
+"
+
+
+
+
+
Index: web/openacs/www/education/subject/admin/department-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/subject/admin/department-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/subject/admin/department-add-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,127 @@
+#
+# /www/education/subject/admin/department-add.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 200
+#
+# this page allows the user to add more departments to the given subject
+#
+
+# expecting subject_id, and sparse arrays of grad_p_${department_id}
+# and department_id_${department_id} and subject_name
+
+set_the_usual_form_variables 
+
+# expecting  subject_id, subject_name
+# and a list of department_ids with values that are the subject name
+# (that is, the text boxes name on the form is the department id and it is the
+#  text box for the subject_name)
+
+set db [ns_db gethandle]
+
+# lets make sure it received both the subject_id and the subject_name
+set user_id [edu_subject_admin_security_check $db $subject_id]
+
+
+set exception_text ""
+set exception_count 0
+
+if {![info exists subject_id] || [empty_string_p $subject_id]} {
+    incr exception_count
+    append exception_text "<li> You must provide a subject identification number."
+}
+
+validate_integer subject_id $subject_id
+
+if {![info exists subject_name] || [empty_string_p $subject_name]} {
+    incr exception_count
+    append exception_text "<li> You must provide a subject name."
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+# lets loop through and get a list of department_id's that now have subject_names
+# we just grab all department_ids instead of doing the same query as the previous
+# page because there is only a small number of departments so it is quicker to
+# loop through them then to join 3 tables in a big select.
+
+set department_ids [database_to_tcl_list_list $db "select department_id, department_name from edu_departments order by lower(department_name)"]
+
+set department_list [list]
+
+foreach department_info $department_ids {
+    set department_id [lindex $department_info 0]
+    set department_name [lindex $department_info 1]
+    if {[info exists department_id_${department_id}] && ![empty_string_p [set department_id_${department_id}]]} {
+	
+	# here we make a list to pass to the next page.  This consists of,
+	# in order, the department_id, subject_number, department_name, and
+	# grad_p for the subject
+
+	lappend department_list [list $department_id "[set department_id_${department_id}]" "$department_name" [set grad_p_${department_id}]]
+    }
+}
+
+
+# if they did not select anything then redirect them back to the subject page
+
+if {[llength $department_list] == 0} {
+    ns_returnredirect "index.tcl?subject_id=$subject_id"
+    return
+}
+
+
+set return_string "
+[ad_header "[ad_system_name] Administration - Subjects"]
+
+<h2>Add $subject_name to a Department</h2>
+
+[ad_context_bar_ws [list "../" "Subjects"] [list "index.tcl?subject_id=$subject_id" "$subject_name Administration"] "Edit Subject"]
+
+<hr>
+<blockquote>
+
+<form method=post action=\"department-add-3.tcl\">
+
+[export_form_vars department_list subject_id]
+
+Are you sure you wish to add $subject_name to the following departments?
+<ul>
+"
+
+foreach department $department_list {
+    append return_string "
+    <li>[lindex $department 2]
+    <ul>
+    <li>Subject Number: [lindex $department 1] 
+    <li>Grad? [util_PrettyBoolean [lindex $department 3]]
+    </ul>
+    "
+
+}
+
+append return_string "
+</ul>
+<br>
+<input type=submit value=\"Add Department\">
+</form>
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/subject/admin/department-add-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/subject/admin/department-add-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/subject/admin/department-add-3.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,64 @@
+#
+# /www/education/subject/admin/department-add-3.tcl
+#
+# by randyg@arsdigita.com, aileen@arsdigita.com January 2000
+#
+# this page finally puts the departmental data into the database
+
+ad_page_variables {
+    subject_id
+    department_list
+}
+
+# department_list is a list of lists.
+# the first element is the department id, the second element is the subject_name
+# within the department and the third item is the department_name
+
+set db [ns_db gethandle]
+
+set user_id [edu_subject_admin_security_check $db $subject_id]
+
+set exception_text ""
+set exception_count 0
+
+if {[empty_string_p subject_id]} {
+    incr exception_count
+    append exception_text "<li> You must include the departmet list"
+}
+
+validate_integer subject_id $subject_id
+foreach department $department_list {
+    set department_id [lindex $department 0]
+    validate_integer department_id $department_id
+}
+unset department_id
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exceptiont_text
+    return
+}
+
+
+
+ns_db dml $db "begin transaction"
+
+foreach department $department_list {
+    ns_db dml $db "insert into edu_subject_department_map (
+                   department_id, 
+                   subject_id,
+                   grad_p,
+                   subject_number)
+                values (
+                   [lindex $department 0],
+                   $subject_id,
+                   '[lindex $department 3]',
+                   '[lindex $department 1]')"
+}
+
+ns_db dml $db "end transaction"
+
+ns_db releasehandle $db
+
+ns_returnredirect "index.tcl?subject_id=$subject_id"
+
+
Index: web/openacs/www/education/subject/admin/department-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/subject/admin/department-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/subject/admin/department-add.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,159 @@
+#
+# /www/education/subject/admin/department-add.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 200
+#
+# this page allows the user to add more departments to the given subject
+#
+
+ad_page_variables {
+    subject_id
+}
+
+
+set db [ns_db gethandle]
+
+set user_id [edu_subject_admin_security_check $db $subject_id]
+
+
+# lets make sure it received both the subject_id and the subject_name
+
+set exception_text ""
+set exception_count 0
+
+if {![info exists subject_id] || [empty_string_p $subject_id]} {
+    incr exception_count
+    append exception_text "<li> You must provide a subject identification number."
+}
+
+validate_integer subject_id $subject_id
+
+set subject_name [database_to_tcl_string_or_null $db "select subject_name from edu_subjects where subject_id = $subject_id"]
+
+if {[empty_string_p $subject_name]} {
+    incr exception_count
+    append exception_text "<li>The subject you have requested does not exist."
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+
+# if the person is a site-wide admin, give them the option to add any 
+# department in the system that does not already have the class
+# else,
+# give the person the option to add this subject to a department if they
+# are the admin of the department and the subject is not already in
+# the given deparmtment
+# else,
+# supply an error message
+
+set n_other_departments 0
+
+if { [ad_administrator_p $db $user_id] } {
+    set selection [ns_db select $db "select department_name, 
+                       department_id 
+                  from edu_departments 
+                 where department_id not in (select department_id 
+                                        from edu_subject_department_map map 
+                                       where map.department_id = edu_departments.department_id 
+                                         and subject_id = $subject_id)
+              order by lower(department_name)"] 
+
+} else {
+    # we want to select the departments that the person is a member of 
+    set selection [ns_db select $db "select dept.department_id,
+                                            dept.department_name
+                                from user_group_map map,
+                                     edu_departments dept
+                               where map.group_id = dept.department_id
+                                 and map.user_id = $user_id
+                                 and dept.department_id not in (select
+                                           sdmap.department_id
+                                           from edu_subject_department_map sdmap
+                                          where sdmap.subject_id = $subject_id)
+                            order by lower(department_name)"]
+}
+
+set n_departments 0
+
+
+set html "
+
+[ad_header "[ad_system_name] Administration - Subjects"]
+<h2>Add $subject_name to a Department</h2>
+
+[ad_context_bar_ws [list "../" "Subjects"] [list "index.tcl?subject_id=$subject_id" "$subject_name Administration"] "Edit Subject"]
+
+<hr>
+<blockquote>
+
+To add a department, enter in the course number.
+
+<form method=post action=\"department-add-2.tcl\">
+<table>
+<tr>
+<th align=left>Department Name<br><Br></td>
+<td valign=top align=center><b>Department<br>Number</b></td>
+<td valign=top align=center><b>Is this a Graduate<br>Subject?</b></td>
+</tr>
+"
+
+while {[ns_db getrow $db $selection]} {
+    incr n_departments
+    set_variables_after_query
+
+    append html "
+    <tr>
+    <td align=left>$department_name
+    </td>
+    <td align=center>
+    <input type=text size=10 name=department_id_${department_id} maxsize=20>
+    </td>
+    <td align=center>
+    <input type=radio name=grad_p_${department_id} value=t> Yes
+    <input type=radio name=grad_p_${department_id} value=f checked> No
+    </td>
+    </tr>"
+
+}
+
+
+if {$n_departments == 0} {
+    ad_return_complaint 1 "<li> There are no departments available for this class."
+    return
+}
+
+
+ns_db releasehandle $db     
+
+set return_string "
+$html
+<tr>
+<td colspan=2 align=center>
+<input type=submit value=\"Continue\">
+</td>
+</tr>
+</table>
+
+[export_form_vars subject_id subject_name]
+
+</form>
+</blockquote>
+[ad_footer]
+"
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/subject/admin/edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/subject/admin/edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/subject/admin/edit-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,136 @@
+#
+# /www/education/subject/admin/edit-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu
+#
+# this is a confirmation page to allow the user to review their proposed
+# changes to the subject properties
+#
+
+ad_page_variables {
+    subject_name
+    subject_id
+    {description ""}
+    {credit_hours ""}
+    {prerequisites ""}
+    {professors_in_charge ""}
+}
+
+# check and make sure we received all of the input we were supposed to
+
+set exception_text ""
+set exception_count 0
+
+if {[empty_string_p $subject_name]} {
+    append exception_text "<li> You must provide a name for the new subject."
+    incr exception_count
+}
+
+if {[empty_string_p $subject_id]} {
+    append exception_text "<li> You must provide the subject you wish to edit."
+    incr exception_count
+}
+
+validate_integer subject_id $subject_id
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+set db [ns_db gethandle]
+
+# set the user_id
+
+set user_id [edu_subject_admin_security_check $db $subject_id]
+
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "
+
+[ad_header "Subject Administration - Edit"]
+
+<h2>Confirm Subject Information</h2>
+
+[ad_context_bar_ws [list "../" "Subjects"] [list "index.tcl?subject_id=$subject_id" "$subject_name Administration"] "Edit Subject"]
+
+<hr>
+<blockquote>
+
+<table>
+
+<tr>
+<th align=left valign=top>
+Subject Name:
+</td>
+<td>
+$subject_name
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Description:
+</td>
+<td>
+[address_book_display_as_html $description]
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Credit Hours:
+</td>
+<td>
+$credit_hours
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Prerequisites:
+</td>
+<td>
+[address_book_display_as_html $prerequisites]
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Professors in Charge:
+</td>
+<td>
+[edu_maybe_display_text $professors_in_charge]
+</td>
+</tr>
+
+<tr>
+<td align=center valign=top colspan=2>
+
+<form method=post action=\"edit-3.tcl\">
+[export_form_vars subject_name subject_id description credit_hours prerequisites professors_in_charge]
+
+<br>
+<input type=submit value=\"Edit Subject\">
+</form>
+
+</td>
+</tr>
+
+</table>
+
+</blockquote>
+[ad_footer]
+"
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/subject/admin/edit-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/subject/admin/edit-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/subject/admin/edit-3.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,68 @@
+#
+# /www/education/subject/admin/edit-3.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this is a confirmation page to allow the user to review their proposed
+# changes to the subject properties
+#
+
+ad_page_variables {
+    subject_name
+    subject_id
+    {description ""}
+    {credit_hours ""}
+    {prerequisites ""}
+    {professors_in_charge ""}
+}
+
+
+# check and make sure we received all of the input we were supposed to
+
+set exception_text ""
+set exception_count 0
+
+if {[empty_string_p $subject_name]} {
+    append exception_text "<li> You must provide a name for the new subject."
+    incr exception_count
+}
+
+if {[empty_string_p $subject_id]} {
+    append exception_text "<li> You must provide an identification number for the new subject."
+    incr exception_count
+}
+
+validate_integer subject_id $subject_id
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+set db [ns_db gethandle]
+
+# set the user_id
+
+set user_id [edu_subject_admin_security_check $db $subject_id]
+
+
+ns_db dml $db "update edu_subjects 
+                  set subject_name = '$QQsubject_name',
+                      description = '$QQdescription',
+                      credit_hours = '$QQcredit_hours',
+                      prerequisites = '$QQprerequisites',
+                      professors_in_charge = '$QQprofessors_in_charge',
+    	              last_modified = sysdate(),
+                      last_modifying_user = $user_id,
+                      modified_ip_address = '[ns_conn peeraddr]'                      
+                where subject_id = $subject_id"
+
+
+ns_db releasehandle $db
+
+ns_returnredirect "index.tcl?subject_id=$subject_id"
+
+
+
+
Index: web/openacs/www/education/subject/admin/edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/subject/admin/edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/subject/admin/edit.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,88 @@
+#
+# /www/education/subject/admin/edit.tcl
+#
+# randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page allows the user to edit the properties of the passed in subject
+#
+
+ad_page_variables {
+    subject_id
+}
+
+
+if {[empty_string_p $subject_id]} {
+    ad_return_complaint 1 "<li>You must include a subject identification number."
+    return
+}
+
+validate_integer subject_id $subject_id
+
+set db [ns_db gethandle]
+
+set user_id [edu_subject_admin_security_check $db $subject_id]
+
+
+set selection [ns_db 0or1row $db "select subject_name, description, credit_hours, prerequisites, professors_in_charge from edu_subjects where subject_id = $subject_id"]
+
+if {$selection == ""} {
+    ad_return_complaint 1 "<li> The subject you have requested does not exist."
+    return
+} else {
+    set_variables_after_query
+}
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "
+
+[ad_header "[ad_system_name] Administration - Add a Subject"]
+
+<h2>Add a Subject</h2>
+
+[ad_context_bar_ws [list "../" "Subjects"] [list "index.tcl?subject_id=$subject_id" "$subject_name Administration"] "Edit Subject"]
+
+<hr>
+<blockquote>
+<form method=post action=\"edit-2.tcl\">
+[export_form_vars subject_id]
+<table>
+
+<tr>
+<th align=right>Subject Name</th>
+<td><input type=text size=40 name=subject_name value=\"$subject_name\"></td>
+</tr>
+
+<tr>
+<th align=right>Description</th>
+<td>[edu_textarea description $description]</td>
+</tr>
+<tr>
+<th align=right>Number of Units</th>
+<td><input type=text name=credit_hours size=8 value=\"$credit_hours\"></td>
+</tr>
+
+<tr>
+<th align=right>Prerequisites</th>
+<td>[edu_textarea prerequisites $prerequisites 60 4]</td>
+</tr>
+
+<tr>
+<th align=right>Professor(s) in Charge</th>
+<td><input type=text name=professors_in_charge size=40 maxsize=200 value=\"$professors_in_charge\">
+</tr>
+
+[edu_empty_row]
+<tr>
+<th></th>
+<td><input type=submit value=Continue></td>
+</tr>
+
+</table>
+</form>
+</blockquote>
+
+[ad_footer]
+"
+
Index: web/openacs/www/education/subject/admin/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/subject/admin/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/subject/admin/index.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,288 @@
+#
+# /www/education/subject/admin/index.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu
+#
+# this page is the front page seen by the person running the subject
+#
+
+ad_page_variables {
+    subject_id
+}
+
+
+if {[empty_string_p $subject_id]} {
+    ad_return_complaint 1 "<li> You must provide a subject identification number."
+    return
+}
+
+validate_integer subject_id $subject_id
+
+set db [ns_db gethandle]
+
+set user_id [edu_subject_admin_security_check $db $subject_id]
+
+set selection [ns_db 0or1row $db "select subject_name, description, credit_hours, prerequisites, professors_in_charge from edu_subjects where subject_id = $subject_id"]
+
+if {$selection == ""} {
+    ad_return_complaint 1 "<li> The subject identification number you have entered is not valid."
+    return
+} else {
+    set_variables_after_query
+}
+
+
+# if they are a site wide admin we want to give them all possible links
+
+set site_wide_admin_p [ad_administrator_p $db $user_id]
+
+
+
+set return_string "
+[ad_header "Subject Administration @ [ad_system_name]"]
+
+<h2>$subject_name</h2>
+
+[ad_context_bar_ws [list "../" "Subjects"] "Subject Administration"]
+
+<hr>
+<blockquote>
+
+<table>
+
+<tr>
+<th align=left valign=top>
+Subject Name:
+</td>
+<td>
+$subject_name
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Description:
+</td>
+<td>
+[address_book_display_as_html $description]
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Credit Hours:
+</td>
+<td>
+$credit_hours
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Prerequisites:
+</td>
+<td>
+[address_book_display_as_html $prerequisites]
+</td>
+</tr>
+
+<tr>
+<th align=left valign=top>
+Professors in Charge:
+</td>
+<td>
+$professors_in_charge
+</td>
+</tr>
+
+<tr>
+<td colspan=2 align=left valign=top>
+(<a href=\"edit.tcl?subject_id=$subject_id\">edit</a>)
+</tr>
+</table>
+
+<h3>Departments</h3>
+<ul>
+"
+
+# set sql "select map.department_id, 
+#                      department_name, 
+#                      subject_number,
+#                      grad_p,
+#                      count(admin_list.group_id) as department_admin_p
+#                 from edu_subject_department_map map, 
+#                      edu_departments dept,
+#                      (select group_id 
+#                              from user_group_map 
+#                             where user_id = $user_id 
+#                               and role = 'administrator') admin_list
+#                where dept.department_id = map.department_id 
+#                   and map.subject_id = $subject_id
+#                   and map.department_id = admin_list.group_id(+)
+#              group by map.department_id, 
+#                       department_name, 
+#                       subject_number, 
+#                       grad_p"
+
+set sql "select map.department_id, 
+                     department_name, 
+                     subject_number,
+                     grad_p,
+                     count(admin_list.group_id) as department_admin_p
+                from edu_subject_department_map map, 
+                     edu_departments dept,
+                     user_group_map admin_list
+               where dept.department_id = map.department_id 
+                  and admin_list.user_id = $user_id
+                  and admin_list.role = 'administrator'
+                  and map.subject_id = $subject_id
+                  and map.department_id = admin_list.group_id
+             group by map.department_id, 
+                      department_name, 
+                      subject_number, 
+                      grad_p
+union
+              select map.department_id, 
+                     department_name, 
+                     subject_number,
+                     grad_p,
+                     count(admin_list.group_id) as department_admin_p
+                from edu_subject_department_map map, 
+                     edu_departments dept,
+                     user_group_map admin_list
+               where dept.department_id = map.department_id 
+                 and admin_list.user_id = $user_id
+                 and admin_list.role = 'administrator'
+                 and map.subject_id = $subject_id
+                 and not exists (select 1 from user_group_map
+                                  where group_id = map.department_id)
+            group by map.department_id, 
+                     department_name, 
+                     subject_number, 
+                     grad_p"
+
+# we are doing the view on the fly so that we can tell if the person is
+# an admin for the given deparment so we know whether or not to show the
+# link
+
+set selection [ns_db select $db $sql]
+
+
+
+set n_departments 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr n_departments
+
+    if {[string compare $grad_p t] == 0} {
+	set grad_tag G
+    } else {
+	set grad_tag ""
+    }
+
+    append return_string "<li><a href=\"/education/util/group-login.tcl?group_id=$department_id&group_type=edu_department&return_url=[ns_urlencode "[edu_url]department/one.tcl"]\">$department_name</a>; $subject_number $grad_tag \n"
+
+    # if they are an admin, give them a link to the admin pages
+    if {$department_admin_p > 0 || $site_wide_admin_p} {
+	append return_string "[ad_space 2] \[ <a href=\"/education/util/group-login.tcl?group_id=$department_id&group_type=edu_department&return_url=[ns_urlencode [edu_url]department/admin/]\">admin page</a> \]"
+    }
+}
+
+if {$n_departments == 0} {
+    append return_string "<li>This subject is not currently affiliated with any department."
+}
+
+
+# if the person is a site-wide admin, give them the option to add a 
+# department if there are still departments that do not have this subject
+# else,
+# give the person the option to add this subject to a department if they
+# are the admin of the department and the subject is not already in
+# the given deparmtment
+# else,
+# don't give a link to add a department
+
+set n_other_departments 0
+
+if { $site_wide_admin_p == 1 } {
+    set n_other_departments [database_to_tcl_string $db "select count(department_id) from edu_departments"]
+} else {
+    # we want to select the departments that the person is admin for 
+    # but are not currently affiliated with the subject
+    set n_other_departments [database_to_tcl_string $db "select count(dept.department_id)
+                                from user_group_map map,
+                                     edu_departments dept
+                               where map.group_id = dept.department_id
+                                 and map.user_id = $user_id
+                                 and dept.department_id not in (select
+                                           sdmap.department_id
+                                           from edu_subject_department_map sdmap
+                                          where sdmap.subject_id = $subject_id)
+                            order by lower(department_name)"]
+}
+
+if {$n_departments < $n_other_departments} {
+    append return_string "
+    <br><br>
+    <li><a href=\"department-add.tcl?[export_url_vars subject_id subject_name]\">Add this subject to a department</a>
+    "
+}
+
+
+append return_string "
+<p>
+
+</ul>
+<h3>Classes</h3>
+<ul>
+"
+
+
+set classes [database_to_tcl_list_list $db "select class_name, 
+     class_id, 
+     term_name
+from edu_terms t, 
+     edu_classes c
+where c.subject_id=$subject_id
+and c.term_id=t.term_id
+order by
+t.start_date, lower(class_name)"]
+
+set return_url "[edu_url]class/admin/"
+
+foreach class $classes {
+    append return_string "
+    <li><a href=\"/education/util/group-login.tcl?group_id=[lindex $class 1]&group_type=edu_class&return_url=[ns_urlencode [edu_url]class/one.tcl]\">[lindex $class 0] ([lindex $class 2])</a>"
+
+    # we show the link to the admin page only if they have permission to see it
+
+    if {[ad_permission_p $db "" "" "View Admin Pages" $user_id [lindex $class 1]] || $site_wide_admin_p} {
+	append return_string "
+	[ad_space] \[ <a href=\"/education/util/group-login.tcl?group_type=edu_class&group_id=[lindex $class 1]\&[export_url_vars return_url]\">admin page</a> \] <br> \n"
+    }
+}
+
+set target_url "class-add.tcl"
+set param_list [list [export_url_vars subject_id]]
+
+set browse_type "select_instructor"
+
+append return_string "
+<BR>
+<a href=\"users.tcl?[export_url_vars target_url param_list subject_id browse_type]\">Add a Class</a>
+</ul>
+
+</blockquote>
+
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
Index: web/openacs/www/education/subject/admin/user-list.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/subject/admin/user-list.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/subject/admin/user-list.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,163 @@
+#
+# /www/education/subject/admin/user-list.tcl
+#
+# by randyg@arsdigita.com, aileen@arsdigita.com
+#
+# this page allows the person to select a user to lead a class
+#
+
+ad_page_variables {
+    begin
+    end
+    {order_by ""}
+    {target_url class-add.tcl}
+    {param_list ""}
+    {browse_type ""}
+    lastletter
+    type
+}
+
+
+# param_list should be any variables that need to be passed on
+# to the next page.  These variables should have already been
+# url encoded.  So, the calling page should have a line that looks like
+# set param_list [ns_urlencode var1 var2 ...] and then
+# [export_url_vars $param_list]
+
+
+set db [ns_db gethandle]
+
+if {![info exists order_by] || [empty_string_p $order_by]} {
+    set order_by name
+}
+
+if {[string compare [string tolower $browse_type] select_instructor] == 0} {
+    set begin_header "Select an Instructor/Moderator for the Class"
+    set nav_bar_value "Select Instructor"
+    set instructions "To select a user as the instructor, please click on their name."
+    } else {
+    set begin_header "Site Wide Users Search Results"
+    set nav_bar_value "Site Wide Users"
+    set instructions "To view information about a user, simply click on their name."
+}
+
+
+#check the input
+set exception_count 0 
+set exception_text ""
+
+if {[empty_string_p $begin] } {
+    incr exception_count
+    append exception_text "<li>You must have a starting letter\n"
+}
+
+if {[empty_string_p $end] } {
+    incr exception_count
+    append exception_text "<li>You must have a stopping letter\n"
+}
+
+if {[empty_string_p $type] } {
+    incr exception_count
+    append exception_text "<li>You must provide a type\n"
+}
+
+if {[empty_string_p $lastletter] } {
+    incr exception_count
+    append exception_text "<li>You must provide a last letter\n"
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    # terminate execution of this thread (a goto!)
+    return
+}
+
+
+
+
+if { [string compare [string tolower $begin] a] == 0 && [string compare [string tolower $end] z] == 0 } {
+    set header All
+    set sql_suffix "where user_id > 2"
+} else {
+    #This code assumes that the variable End is the correct case!!!
+    if {[string compare [string tolower $type] lastname] == 0} {
+	set header "Last Names $begin through $lastletter"
+	set sql_suffix "where upper('$begin') < upper(last_name)
+                    and '$end' > upper(last_name)
+                       and user_id > 2"
+    } else {
+	set header "Emails $begin through $lastletter"
+	set sql_suffix "where upper('$begin') < upper(email)
+                    and '$end' > upper(email)
+                    and user_id > 2"
+    }
+}
+
+
+
+
+set return_string "
+
+[ad_header "Add a Class @ [ad_system_name]"]
+
+<h2>$begin_header - $header </h2>
+
+[ad_context_bar_ws [list "../" "Subjects"] [list "" "Subject Administration"] "Add a Class"]
+
+
+<hr>
+"
+
+set export_vars [export_url_vars begin end type lastletter param_list]
+
+set count 0
+
+if {[string compare $order_by name] == 0} {
+    set sql_order_by " lower(last_name), lower(first_names) "
+    append return_string "<a href=\"user-list.tcl?order_by=email&[export_url_vars target_url browse_type]&$export_vars\">
+    sort by email address</a><ul>"
+} else {
+    set sql_order_by " lower(email) "
+    append return_string "<a href=\"user-list.tcl?l[export_url_vars target_url browse_type]&order_by=name&$export_vars\">
+    sort by last name</a><ul>"
+}
+
+#get only users that are affiliated with the company user group
+set sql_query "select users.user_id, 
+                       first_names, 
+                       last_name,
+                       email
+                  from users
+                       $sql_suffix
+                       order by $sql_order_by"
+
+
+set selection [ns_db select $db $sql_query]
+
+set count 0
+while { [ns_db getrow $db $selection] } {
+    incr count
+    set_variables_after_query
+    append return_string "<li><a href=\"$target_url?user_id=$user_id&$param_list\">$last_name, $first_names ($email)</a> $target_url"
+}
+
+if { $count == 0 } {
+    append return_string "</ul>You do not currently have any users meeting the requirements."
+} else {
+    append return_string "</ul>$instructions"
+}
+
+
+append return_string "
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
Index: web/openacs/www/education/subject/admin/user-search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/subject/admin/user-search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/subject/admin/user-search.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,149 @@
+#
+# /www/education/subject/admin/user-search.tcl
+#
+# by randyg@arsdigita.com, aileen@arsdigita.com
+#
+# this page allows the person to select a user to lead a class
+#
+
+ad_page_variables {
+    email
+    last_name
+    {target_url class-add.tcl}
+    {param_list ""}
+    {browse_type ""}
+}
+
+
+# param_list should be any variables that need to be passed on
+# to the next page.  These variables should have already been
+# url encoded.  So, the calling page should have a line that looks like
+# set param_list [ns_urlencode var1 var2 ...] and then
+# [export_url_vars $param_list]
+
+set db [ns_db gethandle]
+
+if {[string compare [string tolower $browse_type] select_instructor] == 0} {
+    set begin_header "Select an Instructor/Moderator for the Class"
+    set nav_bar_value "Select Instructor"
+    set instructions "To select a user as the instructor, please click on their name."
+    } else {
+    set begin_header "Site Wide Users Search Results"
+    set nav_bar_value "Site Wide Users"
+    set instructions "To view information about a user, simply click on their name."
+}
+
+set exception_count 0 
+set exception_text ""
+
+if { [empty_string_p $email] && [empty_string_p $last_name] } {
+    incr exception_count
+    append exception_text "<li>You need to search for a customer by either Last Name or Email\n"
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    # terminate execution of this thread (a goto!)
+    return
+}
+
+#lets strip the leading and trailing spaces off of the last_name and email
+if {[info exists last_name]} {
+    set bb last_name
+    regexp {[ ]*(.*[^ ])} $last_name match last_name
+}
+
+if {[info exists email]} {
+    regexp {[ ]*(.*[^ ])} $email match email
+    set aa '$email'
+}
+
+
+
+### search by last_name and email
+if { ![empty_string_p $last_name] && ![empty_string_p $email] } {
+    set query_string "select distinct users.user_id, first_names, last_name, email,
+    lower(last_name) as lower_last_name
+    from users, user_group_map
+    where upper(last_name) like '%[DoubleApos [string toupper $last_name]]%'
+    and upper(email) like '%[DoubleApos [string toupper $email]]%'
+    and user_group_map.user_id = users.user_id
+    order by lower_last_name, first_names"
+    set title "Users whose last name contains '$last_name' and email contains '$email'"
+}
+
+## search by email
+if { [empty_string_p $last_name] && ![empty_string_p $email] } {
+    set query_string "select distinct users.user_id, first_names, last_name, email,
+    lower(last_name) as lower_last_name
+    from users, user_group_map 
+    where upper(email) like '%[DoubleApos [string toupper $email]]%'
+    and user_group_map.user_id = users.user_id
+    order by lower_last_name, first_names"
+    set title "Users whose email contains '$email'"
+}
+
+## search by last_name
+if { ![empty_string_p $last_name] && [empty_string_p $email] } {
+    set query_string "select distinct users.user_id, first_names, last_name, email,
+    lower(last_name) as lower_last_name
+    from users, user_group_map 
+    where upper(last_name) like '%[DoubleApos [string toupper $last_name]]%'
+    and user_group_map.user_id = users.user_id
+    order by lower_last_name, first_names"
+    set title "Users whose last name contains '$last_name'"
+}
+
+set selection [ns_db select $db $query_string]
+
+
+set return_string "
+[ad_header "Add a Class @ [ad_system_name]"]
+<h2> $begin_header </h2>
+$title
+<br>
+<br>
+
+[ad_context_bar_ws [list "../" "Subjects"] [list "" "Subject Administration"] "Add a Class"]
+
+<hr>
+"
+
+set text ""
+set counter 0
+while { [ns_db getrow $db $selection] } {
+
+    set_variables_after_query
+    incr counter
+    append text "<li><a href=\"$target_url?user_id=$user_id&$param_list\">$last_name, $first_names ($email)</a>\n"
+}
+
+
+if { $counter > 0 } {
+
+    append return_string "
+    $title:
+    <ul>
+    $text
+    <br><br>
+    </ul>
+    $instructions
+    "
+} else {
+    append return_string "We found no matches to your query for $title, please check your information again\n"
+}
+
+
+append return_string "
+<br>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
Index: web/openacs/www/education/subject/admin/users.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/subject/admin/users.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/subject/admin/users.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,126 @@
+#
+# /www/education/subject/admin/users.tcl
+#
+# by randyg@arsdigita.com, aileen@arsdigita.com
+#
+# this page allows the person to select a user to lead a class
+#
+
+ad_page_variables {
+    {target_url class-add.tcl}
+    {param_list ""}
+    {browse_type ""}
+}
+
+
+set db [ns_db gethandle]
+
+if {[string compare [string tolower $browse_type] select_instructor] == 0} {
+    set header "Select an Instructor/Moderator for the Class"
+    set nav_bar_value "Select Instructor"
+    set footer ""
+    
+} else {
+    set header "Users"
+    set nav_bar_value "Site Wide Users"
+    set footer "<br><li><a href=user-add.tcl>Add a User</a>"
+}
+
+
+set return_string "
+[ad_header "Add a Class @ [ad_system_name]"]
+
+<h2> $header</h2>
+
+[ad_context_bar_ws [list "../" "Subjects"] [list "" "Subject Administration"] $nav_bar_value]
+
+<hr>
+<blockquote>
+"
+
+set threshhold 50
+
+
+#see if there are more than $threshhold users
+#if so, give search options
+#if not, list all of the users
+
+if {[database_to_tcl_string $db "select count(user_id) from users"] < $threshhold } {
+    set selection [ns_db select $db "select users.user_id, 
+                       first_names, 
+                       last_name
+                  from users
+                 where user_id > 2
+              order by last_name, first_names"]
+
+    append return_string "<h3>Current Users</h3><ul>"
+
+    while {[ns_db getrow $db $selection]} {
+	set_variables_after_query
+	append return_string "
+	<li><a href=\"${target_url}?user_id=$user_id&$param_list\">$last_name, $first_names</a><br>\n"
+    }
+
+} else {
+    set vars_to_pass [export_url_vars target_url browse_type param_list]
+    append return_string "
+    <ul>
+    <li>Browse by last name : 
+    <a href=user-list.tcl?begin=A&end=H&lastletter=G&type=lastname&$vars_to_pass>A - G</a> |
+    <a href=user-list.tcl?begin=H&end=N&lastletter=M&type=lastname&$vars_to_pass>H - M</a> |
+    <a href=user-list.tcl?begin=N&end=T&lastletter=S&type=lastname&$vars_to_pass>N - S</a> |
+    <a href=user-list.tcl?begin=T&end=z&lastletter=Z&type=lastname&$vars_to_pass>T - Z</a> 
+
+    <p>
+
+    <li>Browse by email address : 
+    <a href=user-list.tcl?begin=A&end=H&lastletter=G&type=email&$vars_to_pass>A - G</a> |
+    <a href=user-list.tcl?begin=H&end=N&lastletter=M&type=email&$vars_to_pass>H - M</a> |
+    <a href=user-list.tcl?begin=N&end=T&lastletter=S&type=email&$vars_to_pass>N - S</a> |
+    <a href=user-list.tcl?begin=T&end=z&lastletter=Z&type=email&$vars_to_pass>T - Z</a> 
+
+    <p>
+
+    <li><a href=user-list.tcl?begin=A&end=z&lastletter=Z&type=all&$vars_to_pass>Browse All Users</a>
+
+    <Br>
+
+    <form method=get action=user-search.tcl>
+     
+    <li>Search through all registered [ad_system_name] users:
+    <p>
+    <table>
+    [export_form_vars target_url param_list browse_type]
+    <tr><td align=right>by Email Address</td>
+    <td><input type=text maxlength=100 size=30 name=email><BR></td>
+    </td>
+    <tr><td align=right>by Last Name </td>
+    <td><input type=text maxlength=100 size=30 name=last_name><BR></td>
+    </tr>
+    <tr>
+    <td colspan=2>
+    <center><input type=submit value=\"Search For a User\"></center>
+    </td>
+    </table>
+    </form>
+    "
+}
+
+append return_string "
+$footer
+</ul>
+</blockquote>
+   
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
+
Index: web/openacs/www/education/util/chat-room-create-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/chat-room-create-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/chat-room-create-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,61 @@
+# /www/education/util/chat-room-create.tcl
+#
+# aileen@mit.edu, randyg@arsdigita.com
+#
+# Feb 2000
+#
+# based on /admin/chat/create-room.tcl but outside the /admin/ 
+# directory so a prof can create chat rooms
+
+set_the_usual_form_variables
+
+# chat_room_id pretty_name, moderated_p, expiration_days, active_p
+
+validate_integer chat_room_id $chat_room_id
+
+ad_maybe_redirect_for_registration
+
+set exception_count 0 
+set exception_text ""
+
+if {[empty_string_p $pretty_name]} {
+    incr exception_count
+    append exception_text "<li>Please name your chat room."
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+set db [ns_db gethandle]
+
+set id_list [edu_group_security_check $db edu_class "Add Tasks"]
+set group_id [lindex $id_list 1]
+
+if { [empty_string_p $group_id] } {
+    set scope_val "public"
+} else {
+    set scope_val "group"
+    # only allow 1 chat room per group
+    if {[database_to_tcl_string $db "select count(*) from chat_rooms where group_id=$group_id"]>0} {
+	ad_return_complaint 1 "<li>A chat room has already been created for this group"
+	return
+    }
+}
+
+ns_db dml $db "begin transaction"
+
+
+ns_db dml $db "insert into chat_rooms
+(chat_room_id, pretty_name, group_id, scope, moderated_p, expiration_days, active_p)
+values
+($chat_room_id, '$QQpretty_name', '$group_id', '$scope_val', '$moderated_p', '$expiration_days', '$active_p')"
+
+# create a new admin group within this transaction
+ad_administration_group_add $db "$pretty_name Moderation" chat $chat_room_id "/chat/moderate.tcl?chat_room_id=$chat_room_id" "f"
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "/chat/enter-room.tcl?[export_url_vars chat_room_id]"
Index: web/openacs/www/education/util/chat-room-create.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/chat-room-create.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/chat-room-create.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,66 @@
+# /www/education/util/chat-room-create.tcl
+#
+# aileen@mit.edu, randyg@arsdigita.com
+#
+# Feb 2000
+#
+# based on /admin/chat/create-room.tcl but outside the /admin/ directory so a prof can create chat rooms
+
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+set id_list [edu_group_security_check $db edu_class "Add Tasks"]
+set user_id [lindex $id_list 0]
+set class_id [lindex $id_list 1]
+set class_name [lindex $id_list 2]
+
+
+set title "Create a Chat Room for $class_name"
+set chat_room_id [database_to_tcl_string $db "select chat_room_id_sequence.nextval from dual"]
+
+ns_db releasehandle $db
+
+
+ns_return 200 text/html "
+
+[ad_header "$title"]
+
+<h2>$title</h2>
+
+[ad_context_bar_ws_or_index [list "[edu_url]class/" "$class_name Home"] [list "[edu_url]class/admin/" "Administration"] $title]
+
+<hr>
+<form action=\"chat-room-create-2.tcl\" method=POST>
+<table><tr><td align=right>
+Room Name:</td><td> <input name=pretty_name size=35></td>
+</tr>
+<tr><td align=right>
+Expire messages after </td><td><input type=text name=expiration_days value=\"\" size=4> days (or leave blank to archive messages indefinitely)
+</td></tr>
+<tr><td align=right>
+Active?</td>
+<td>
+<select name=active_p>
+    <option value=f>No</option>
+    <option value=t selected>Yes</option>
+</select>
+(pick \"No\" if you want to wait before launching this publicly)
+</td></tr>
+<tr><td align=right>
+Moderated?</td>
+<td><select name=moderated_p><option value=f selected>No</option>
+<option value=t>Yes</option>
+</select>
+</td></tr>
+</table>
+<P>
+<center>
+[export_form_vars chat_room_id]
+<input type=submit value=Create>
+</center>
+</form>
+
+[ad_admin_footer]
+"
+
+
Index: web/openacs/www/education/util/group-login.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/group-login.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/group-login.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,66 @@
+#
+# /www/education/util/group-login.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# This page allows the user to select which group to log in as
+#
+
+ad_page_variables {
+    return_url
+    group_id
+    group_type
+}
+
+validate_integer group_id $group_id
+
+set user_id [ad_verify_and_get_user_id] 
+    
+if {$user_id == 0} {
+    set return_url "[ns_conn url]?[export_entire_form_as_url_vars]"
+    ns_returnredirect "/register.tcl?[export_url_vars return_url]"
+    return
+}
+
+# make sure the user is in the group and that the group_id 
+# corresponds to the correct group_type
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select 1
+     from user_group_map map, 
+          user_groups ug 
+    where map.user_id = $user_id 
+      and ug.group_id = map.group_id 
+      and group_type = '$group_type'
+      and ug.active_p = 't' 
+      and map.group_id=$group_id"] 
+
+if { [info exists return_url] && ![empty_string_p $return_url] } {
+    set final_page $return_url
+} else {
+    set final_page "/"
+}
+
+if {$selection == ""} {
+    set site_admin_p [ad_administrator_p $db $user_id]
+} else {
+    set site_admin_p 0
+}
+
+if { ![empty_string_p $selection] || [string compare $site_admin_p 1] == 0} {
+    ad_set_client_property education $group_type $group_id
+    ns_returnredirect $return_url
+} else {
+    ad_return_error "Not authorized" "You are not authorized to enter this group."
+}
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/util/group-select.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/group-select.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/group-select.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,95 @@
+#
+# /www/education/util/group-select.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# This page allows the user to select which group to log in as
+#
+
+
+ad_page_variables {
+    return_url
+    group_type
+}
+
+set user_id [ad_verify_and_get_user_id]
+   
+if { $user_id == 0 } {
+   set return_url "[ns_conn url]?[ns_conn query]"
+   ns_returnredirect /register.tcl?return_url=[ns_urlencode $return_url]
+    return
+}
+
+set db [ns_db gethandle]
+
+if {[empty_string_p $group_type]} {
+    ns_return_complaint 1 "<li>You must provide the type of the group you want to select for"
+    return
+}
+
+if {[string compare $group_type edu_department] == 0} {
+    set suffix Department
+} else {
+    set suffix Class
+}
+
+# show them a group if they are a member 
+
+if {[ad_administrator_p $db $user_id]} {
+    set selection [ns_db select $db "select distinct group_id, group_name, lower(group_name) as lower_group_name from user_groups where lower(group_type) = '$group_type' and active_p = 't' order by lower_group_name"]
+} else {
+    set selection [ns_db select $db "select distinct ug.group_id, ug.group_name
+from user_group_map map, user_groups ug
+where (map.group_id = ug.group_id
+  and map.user_id = $user_id)
+and active_p = 't'
+and lower(group_type) = '$group_type'
+order by ug.group_name"]
+}
+
+set counter 0
+set html ""
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append html "<li><a href=\"group-login.tcl?[export_url_vars group_type group_id return_url]\">$group_name</a>\n"
+    incr counter
+}
+
+if { $counter == 1 } {
+    set url "group-login.tcl?[export_url_vars group_type group_id return_url]"
+    ns_returnredirect $url
+    return
+}
+
+
+set return_string "
+
+[ad_header "Select a $suffix"]
+
+<h2>Select a $suffix</h2>
+
+[ad_context_bar_ws_or_index "$suffix Selection"]
+
+<hr>
+<ul>
+"
+
+
+if { $counter == 0 } {
+    append return_string "<li>You are not listed as a member of any ${suffix}es."
+} else {
+    append return_string "$html"
+}
+
+append return_string "
+</ul>
+If you do not see a $suffix you are involved in,
+<a href=\"/groups/\">visit the groups section</a> to find 
+and join your $suffix.
+
+[ad_footer]"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
Index: web/openacs/www/education/util/group-type-view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/group-type-view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/group-type-view.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,67 @@
+# /groups/group-type-view.tcl
+#
+# just like /groups/index.tcl but specific to one input group_type
+#
+# aileen@arsdigita.com, randyg@arsdigita.com
+#
+# January, 2000
+
+# group_type
+set_the_usual_form_variables
+set db [ns_db gethandle]
+
+set user_id [ad_verify_and_get_user_id]
+
+#ns_log Notice "group type: $group_type"
+
+set selection [ns_db 0or1row $db "select pretty_plural, pretty_name from user_group_types where group_type='$group_type'"]
+
+if {$selection!=""} {
+    set_variables_after_query
+} else {
+    ad_return_complaint 1 "<li>You must call this page with a valid group type $group_type"
+    return
+}
+
+set html "
+[ad_header "$pretty_plural @ [ad_system_name]"]
+
+<h2>Select a $pretty_name to Join</h2>
+[ad_context_bar_ws_or_index "$pretty_plural"]
+
+<hr>
+<ul>"
+
+# basically an augmented version of the query in /groups/index.tcl specific for the classes group type
+set selection [ns_db select $db "
+select unique ug.group_name, ug.short_name, ug.group_id
+from user_groups ug, user_group_types ugt, edu_current_classes c
+where ug.group_type=ugt.group_type
+and ugt.group_type='$group_type'
+and c.class_id=ug.group_id
+and (select count(*) from user_group_map 
+        where user_id=$user_id 
+        and group_id=ug.group_id)=0
+order by upper(ug.group_name)"]
+
+set count 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    
+    append html "<li><a href=\"[ug_url]/[ad_urlencode $short_name]/member-add.tcl?role=student\">$group_name</a>\n"
+    incr count
+}
+
+if {!$count} {
+    append html "<li>There are currently no classes that you can join"
+}
+
+append html "</ul>
+[ad_footer]"
+
+ns_return 200 text/html $html
+
+
+
+
Index: web/openacs/www/education/util/readme.txt
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/readme.txt,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/readme.txt	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,12 @@
+This directory, /education/users/ is used by both
+the /class/admin/users/ directory and
+the /department/admin/users/ directory.  It has
+been combined in to one section because the code is
+virtually identical and it does not make sense to 
+put it in two separate places.
+
+
+The pages are served using ns_register_proc
+on the previously mentioned directories.
+
+randyg@arsdigita.com, February, 2000
\ No newline at end of file
Index: web/openacs/www/education/util/spam-confirm.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/spam-confirm.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/spam-confirm.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,203 @@
+#
+# /www/education/util/spam-confirm.tcl
+#
+# modified from /groups/group/spam-confirm.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# This page confirms that you want to send the email that you have just typed in
+#
+
+
+ad_page_variables {
+    subject
+    who_to_spam
+    header
+    message
+    from_address
+    {subgroup_id ""}
+}
+
+validate_integer_or_null subgroup_id $subgroup_id
+
+set db [ns_db gethandle]
+
+
+set group_pretty_type [edu_get_group_pretty_type_from_url]
+
+# right now, the proc above is only set up to recognize type 
+# group and department and the proc must be changed if this page
+# is to be used for URLs besides those.
+
+if {[empty_string_p $group_pretty_type]} {
+    ns_returnnotfound
+    return
+} else {
+
+    if {[string compare $group_pretty_type class] == 0} {
+	set id_list [edu_user_security_check $db]
+    } else {
+	# it is a department
+	set id_list [edu_group_security_check $db edu_department]
+    }
+}
+
+
+set sender_id [lindex $id_list 0]
+set group_id [lindex $id_list 1]
+set group_name [lindex $id_list 2]
+
+
+# lets make sure that they have permission to spam this group
+set spam_permission_p [ad_permission_p $db "" "" "Spam Users" $sender_id $group_id]
+
+if {!$spam_permission_p} {
+    # we do not check to see if they are part of the main group because we
+    # already know that from the checks above.  And, if they had permission
+    # to spam the users, spam_permission_p would already be 1 from the
+    # call to ad_permission_p
+
+    # lets see if they are a member of the subgroup
+    if {![empty_string_p $subgroup_id]} {
+	set spam_permission_p [database_to_tcl_string $db "select 
+              (case when count(user_id) = 0 then 0 else 1 end) 
+         from user_groups 
+        where user_id = $sender_id 
+          and group_id = $subgroup_id"]
+    }
+
+    if {!$spam_permission_p} {
+	ad_return_complaint 1 "<li>You do not currently have permission to spam the group you are trying to spam."
+	return
+    }
+}	
+
+#
+# if they have gotten past this point, they have the correct permissions,
+# assuming that the subgroup is part of the group.  We check that now
+#
+
+if {![empty_string_p $subgroup_id]} {
+    # make sure that the subgroup is part of this group
+
+    set subgroup_name [database_to_tcl_string $db "select group_name from user_groups where parent_group_id = $group_id and group_id = $subgroup_id"]
+
+    if {[empty_string_p $subgroup_name]} {
+	ad_return_complaint 1 "<li>You do not currently have permission to spam the group you are trying to spam."
+	return
+    }
+
+    set header_suffix " of $subgroup_name"
+} else {
+    set header_suffix ""
+}
+
+
+#
+# now, the security is taken care of
+#
+
+
+if {[empty_string_p $message]} {
+    ad_return_complaint 1 "<li>You must provide a message for this email."
+    return
+}
+
+if {[lsearch [ns_conn urlv] admin] == -1} {
+    set nav_bar "[ad_context_bar_ws_or_index [list "one.tcl" "$group_name Home"] "Confirm Spam"]"
+} else {
+    set nav_bar "[ad_context_bar_ws_or_index [list "../one.tcl" "$group_name Home"] [list "" "Administration"] "Confirm Spam"]"
+}
+
+
+set return_string "
+[ad_header "$group_name Administration @ [ad_system_name]"]
+
+<h2>Spam $header</h2>
+
+$nav_bar
+
+<hr>
+<blockquote>
+
+"
+
+set creation_date [database_to_tcl_string $db "select to_char(sysdate(), 'YYYY-MM-DD  HH:MI:SS am') from dual"]
+
+set spam_roles [list]
+
+foreach role $who_to_spam {
+    lappend spam_roles "'[string tolower $role]'"
+}
+
+if {![empty_string_p $subgroup_id]} {
+    set group_id $subgroup_id
+}
+
+set n_recipients [database_to_tcl_string $db "
+    select count(distinct ug.user_id)
+    from user_group_map ug, users_spammable u
+	where ug.group_id = $group_id
+        and lower(ug.role) in ([join $spam_roles ","])
+	and ug.user_id = u.user_id
+	and not exists ( select 1 
+	                 from group_member_email_preferences
+                         where group_id = $group_id
+	                 and user_id =  u.user_id 
+                         and dont_spam_me_p = 't')
+        and not exists ( select 1 
+	                 from user_user_bozo_filter
+                         where origin_user_id = u.user_id 
+	                 and target_user_id =  $sender_id)"]
+ 
+
+# generate unique key here so we can handle the "user hit submit twice" case
+set spam_id [database_to_tcl_string $db "select group_spam_id_sequence.nextval from dual"]
+
+
+ns_db releasehandle $db
+
+append return_string "
+
+<form method=POST action=\"spam-send.tcl\">
+[export_form_vars who_to_spam spam_id from_address subject message n_recipients header spam_roles group_id]
+
+<blockquote>
+
+<table border=0 cellpadding=5 >
+
+<tr><th align=right>Date</th><td>$creation_date </td></tr>
+
+<tr><th align=right>To </th><td>$header of $group_name</td></tr>
+<tr><th align=right>From </th><td>$from_address</td></tr>
+
+
+<tr><th align=right>Subject </th><td>$subject</td></tr>
+
+<tr><th align=right valign=top>Message </th><td>
+<pre>[ns_quotehtml $message]</pre>
+</td></tr>
+
+<tr><th align=right>Number of recipients </th><td>$n_recipients</td></tr>
+
+</table>
+
+</blockquote>
+"
+
+if {$n_recipients == 0} {
+    append return_string "No one will receive this email since there is no one in the selected group."
+} else {
+    append return_string "<center><input type=submit value=\"Send Email\"></center>"
+}
+
+append return_string "
+</blockquote>
+[ad_footer]
+"
+
+ns_return 200 text/html $return_string
+
+
+
+
Index: web/openacs/www/education/util/spam-history.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/spam-history.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/spam-history.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,310 @@
+#
+# /www/education/util/spam-history.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# borrows extensivley from /groups/group/spam-history.tcl
+#
+# this displays the history of spam sent by one user or one group.
+#
+
+ad_page_variables {
+    {user_id ""}
+    {group_id ""}
+}
+
+validate_integer_or_null user_id $user_id
+validate_integer_or_null group_id $group_id
+
+# user_id is the user whose history you wish to view
+# either user_id or group_id must be not null
+# and the other must be null
+
+if {[empty_string_p $group_id] && [empty_string_p $user_id]} {
+    ad_return_complaint 1 "<li>Either group id or user id must be not null"
+    return
+} elseif {![empty_string_p $group_id] && ![empty_string_p $user_id]} {
+    ad_return_complaint 1 "<li>You should only provide a group id or a user id"
+    return
+}
+
+
+set db_handles [edu_get_two_db_handles]
+set db [lindex $db_handles 0]
+set db_sub [lindex $db_handles 1]
+
+set group_pretty_type [edu_get_group_pretty_type_from_url]
+
+# right now, the proc above is only set up to recognize type 
+# group and department and the proc must be changed if this page
+# is to be used for URLs besides those.
+
+if {[empty_string_p $group_pretty_type]} {
+    ns_returnnotfound
+    return
+} else {
+
+    if {[string compare $group_pretty_type class] == 0} {
+	set id_list [edu_user_security_check $db]
+    } else {
+	# it is a department
+	set id_list [edu_group_security_check $db edu_department]
+    }
+}
+
+
+set actual_user_id [lindex $id_list 0]
+set user_group_id [lindex $id_list 1]
+set group_name [lindex $id_list 2]
+
+
+#
+# we want to make sure the user has permission to view this
+#
+
+set spam_permission_p [ad_permission_p $db "" "" "Spam Users" $user_id $group_id]
+
+if {!$spam_permission_p} {
+    # if user_id is not null and they do not have permission as 
+    # specified above then they should only see it if it is themselves
+    if {![empty_string_p $user_id]} {
+	if {[string compare $user_id $actual_user_id] != 0} {
+
+	}
+    } else {
+	# user_id is null so group_id is not...we made sure of that above
+	# we do not check to see if they are part of the main group because we
+	# already know that from the checks above.  And, if they had permission
+	# to spam the users, spam_permission_p would already be 1 from the
+	# call to ad_permission_p
+	
+	if {[string compare $group_id $user_group_id] != 0} {
+	    if {![database_to_tcl_string $db "select (case when count(user_id) = 0 then 0 else 1 end) from user_group_map where user_id = $user_id and group_id = $group_id"]} {
+		set spam_permission_p 1
+	    }
+	}
+    }
+}	
+
+
+# make sure that the group_id they are trying to view is part of the group
+# they are logged in as.
+
+if {![empty_string_p $group_id] && [string compare $group_id $user_group_id] != 0} {
+    # make sure that the subgroup is part of this group
+
+    set subgroup_name [database_to_tcl_string $db "select group_name from user_groups where parent_group_id = $user_group_id and group_id = $group_id"]
+
+    if {![empty_string_p $subgroup_name]} {
+	set spam_permission_p 1
+    }
+}
+
+
+if {!$spam_permission_p} {
+    ad_return_complaint 1 "<li>You do not currently have permission to spam the group you are trying to spam."
+    return
+}
+
+
+#
+# permisisons to view this page have been taken care of
+#
+
+
+if {![empty_string_p $user_id]} {
+    set name [database_to_tcl_string_or_null $db "select first_names || ' ' || last_name from users where user_id = $user_id"]
+    
+    set history_type user
+
+} else {
+    # this means that group_id must be not null
+    set name [database_to_tcl_string_or_null $db "select group_name from user_groups where group_id = $group_id"]
+    set history_type group
+}
+
+
+if {[empty_string_p $name]} {
+    ad_return_complaint 1 "<li>The $history_type you have requested is not a member of this group."
+    return
+}
+
+
+
+if {[lsearch [ns_conn urlv] admin] == -1} {
+    set nav_bar "[ad_context_bar_ws_or_index [list "one.tcl" "$group_name Home"] "Spam History"]"
+    set teams_link "teams/one.tcl"
+    set hyperlink_sender_p 0
+} else {
+    set nav_bar "[ad_context_bar_ws_or_index [list "../one.tcl" "$group_name Home"] [list "" "Administration"] "Spam History"]"
+    set teams_link "team-info.tcl"
+    set hyperlink_sender_p 1
+}
+
+
+set return_string "
+[ad_header "$group_name @ [ad_system_name]"]
+
+<h2>Spam History for $name</h2>
+
+$nav_bar
+
+<hr>
+
+"
+
+
+if {[empty_string_p $group_id] && ![empty_string_p $user_id]} {
+    # the first thing that we need to do is compile a list of groups the user
+    # may be sending mail to that are related to this group.  This includes the
+    # entire group, the teams, and the sections.  Once we do that, we do the
+    # select and then display the information to the user.
+    
+    set team_list [database_to_tcl_list $db "select team_id from edu_teams where group_id = $group_id"]
+
+    set section_list [database_to_tcl_list $db "select section_id from edu_sections where group_id = $group_id"]
+
+    set group_list [concat [list $group_id] $team_list $section_list]
+
+    set sql_suffix "sender_id = $user_id and user_groups.group_id in ([join $group_list ","])"
+
+} else {
+    set sql_suffix "user_groups.group_id = $group_id"
+    # lets find out what type of group this is
+    set group_type [database_to_tcl_string $db "select group_type from user_groups where group_id = $group_id"]
+    if {[string compare $group_type edu_team] == 0} {
+	set team_list [list $group_id]
+	set section_list [list]
+    } elseif {[string compare $group_type edu_section == 0} {
+	set team_list [list]
+	set section_list [list $group_id]
+    }
+}
+
+
+set selection [ns_db select $db "select 
+        user_groups.group_id as recipient_group_id,
+        group_name,
+        group_spam_history.approved_p,
+        send_date,
+        subject,
+        group_spam_history.body,     
+        group_spam_history.creation_date,
+        n_receivers_intended,
+        n_receivers_actual,
+        send_to_roles,
+        first_names || ' ' || last_name as sender_name,
+        sender_id,
+        from_address as sender_email,
+        spam_id
+from group_spam_history, users, user_groups
+where $sql_suffix
+and sender_id = users.user_id
+and user_groups.group_id = group_spam_history.group_id
+order by creation_date desc"]
+
+
+set counter 0
+
+append html "
+<table border=1 cellpadding=3>
+
+<tr>
+"
+
+if {![empty_string_p $group_id]} {
+    append html "<th>From Address</th>"
+} else {
+    append html "<th>Group Sent To</th>"
+}
+
+append html "
+<th>Roles Sent To</th>
+<th>Subject</th>
+<th>Send Date</th>
+<th><br>No. of Intended <br> Recipients</th>
+<th><br>No. of Actual <br> Recipients</th>
+</tr>
+"    
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    
+    incr counter
+    
+    set approved_string [ad_decode $send_date "" "N/A" $send_date]
+
+    set subject [ad_decode $subject "" None $subject]
+
+    if {$group_id == $user_group_id} {
+	set spam_group_table edu_classes
+    } elseif {[lsearch $team_list $recipient_group_id] > -1} {
+	set spam_group_table edu_teams
+	set url_to_send_to "$teams_link?team_id=$recipient_group_id"
+    } else {
+	set spam_group_table edu_sections
+	set url_to_send_to "section-info.tcl?section_id=$recipient_group_id"
+    }
+
+    append html "
+    <tr>
+    "
+
+    if {![empty_string_p $group_id]} {
+	if {$hyperlink_sender_p} {
+	    append html "<td><a href=\"users/one.tcl?user_id=$sender_id\">$sender_name</a><Br> ($sender_email)"
+	} else {
+	    append html "<td>$sender_name<Br> ($sender_email)"
+	}
+    } else {
+	append html "<td><a href=\"$url_to_send_to\">$group_name</a>"
+    }	
+
+
+    set send_to_pretty_roles [list]
+    foreach role $send_to_roles {
+	set pretty_role_plural "[database_to_tcl_string_or_null $db_sub "select pretty_role_plural from edu_role_pretty_role_map where lower(role) = lower('$role') and group_id = $group_id"]"
+	if {![empty_string_p $pretty_role_plural]} {
+	    lappend send_to_pretty_roles $pretty_role_plural
+	} else {
+	    lappend send_to_pretty_roles "[capitalize $role]s"
+	}
+    }
+    
+    set send_to_pretty_roles [join $send_to_pretty_roles ", "]
+
+
+    append html "
+    <td align=center>[ad_decode $send_to_roles "" "N/A" $send_to_pretty_roles]</td>
+    <td align=center><a href=\"spam-item.tcl?[export_url_vars spam_id spam_group_table]\">$subject</a>
+    <td align=center>$creation_date
+    <td align=center>$n_receivers_intended
+    <td align=center>$n_receivers_actual
+    </tr>
+    "
+}
+
+if { $counter > 0 } {
+    append html "</table>" 
+} else {
+    set html "No Email history of $name for $group_name group available in the database."
+}
+
+
+
+append return_string "
+<blockquote>
+$html
+</blockquote>
+<p><br>
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
+
+
Index: web/openacs/www/education/util/spam-item.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/spam-item.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/spam-item.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,207 @@
+#
+# /www/education/util/spam-item.tcl
+#
+# started with /groups/group/spam-item.tcl as the base
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# This page shows one email message corresponding to the passed in
+# spam_id
+#
+
+ad_page_variables {
+    spam_id
+    spam_group_table
+}
+
+validate_integer spam_id $spam_id
+
+# the spam_id is obvious
+# the spam_group_table says whether it was an email to the class, 
+# a team, or a section
+
+
+set db [ns_db gethandle]
+
+set group_pretty_type [edu_get_group_pretty_type_from_url]
+
+# right now, the proc above is only set up to recognize type 
+# group and department and the proc must be changed if this page
+# is to be used for URLs besides those.
+
+if {[empty_string_p $group_pretty_type]} {
+    ns_returnnotfound
+    return
+} else {
+
+    if {[string compare $group_pretty_type class] == 0} {
+	set id_list [edu_user_security_check $db]
+    } else {
+	# it is a department
+	set id_list [edu_group_security_check $db edu_department]
+    }
+}
+
+set user_id [lindex $id_list 0]
+set group_id [lindex $id_list 1]
+set group_name [lindex $id_list 2]
+
+
+set exception_text ""
+set exception_count 0
+
+if {[empty_string_p $spam_id]} {
+    incr exception_count
+    append exception_text "<li>No spam id was received."
+}
+
+if {[string compare $spam_group_table edu_classes] == 0} {
+    set sql_clause "and group_id = class_id and class_id = $group_id"
+    set subgroup_name class_name
+    set spam_group_id_name class_id
+} elseif {[string compare $spam_group_table edu_teams] == 0} {
+    set sql_clause "and group_id = team_id and class_id = $group_id"
+    set subgroup_name team_name
+    set spam_group_id_name team_id
+} elseif {[string compare $spam_group_table edu_sections] == 0} {
+    set sql_clause "and group_id = section_id and class_id = $group_id"
+    set subgroup_name section_name
+    set spam_group_id_name section_id
+} else {
+    incr exception_count
+    append exception_text "<li>No spam group table was received. $spam_group_table"
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+set selection [ns_db 0or1row  $db "select approved_p,
+        $subgroup_name as spam_group_name,
+        $spam_group_id_name as spam_group_id,
+        creation_date,
+        first_names || ' ' || last_name as sender_name,
+        from_address,
+        send_to_roles,
+        n_receivers_intended,
+        n_receivers_actual,
+        subject,
+        group_spam_history.body,
+        send_date,
+        sender_id    
+from group_spam_history, $spam_group_table, users
+where spam_id = $spam_id
+and users.user_id = sender_id
+$sql_clause"]
+
+
+if { [empty_string_p $selection ]} {
+    ad_return_complaint 1 "<li>No spam with spam id $spam_id was found in the database."
+    return
+} else {
+    set_variables_after_query
+}
+
+
+# now, lets make sure that the user has permission to view this spam
+set spam_permission_p [ad_permission_p $db "" "" "Spam Users" $user_id $group_id]
+
+if {!$spam_permission_p} {
+    # are they a member of the group the spam was sent to?
+    # if not, tell them they are not allowed to view the spam
+    if {[database_to_tcl_string $db "select count(user_id) from user_group_map where group_id = $spam_group_id and user_id = $user_id"] == 0} {
+    	ad_return_complaint 1 "<li>You do not currently have permission to spam the group you are trying to spam."
+	return
+    }
+}
+
+
+set status_string [ad_decode $approved_p "t" "Approved on [util_AnsiDatetoPrettyDate $send_date]" "f" "Disapproved" "Waiting for Approval"]
+
+
+set send_to_pretty_roles [list]
+foreach role $send_to_roles {
+    set pretty_role_plural "[database_to_tcl_string_or_null $db "select pretty_role_plural from edu_role_pretty_role_map where lower(role) = lower('$role') and group_id = $group_id"]"
+    if {![empty_string_p $pretty_role_plural]} {
+	lappend send_to_pretty_roles $pretty_role_plural
+    } else {
+	lappend send_to_pretty_roles "[capitalize $role]s"
+    }
+}
+
+ns_db releasehandle $db
+
+
+
+
+set send_to_pretty_roles [join $send_to_pretty_roles ", "]
+
+
+if {[lsearch [ns_conn urlv] admin] == -1} {
+    set nav_bar "[ad_context_bar_ws_or_index [list "one.tcl" "$group_name Home"] "One Email"]"
+    set hyperlink_user_p 0
+} else {
+    set nav_bar "[ad_context_bar_ws_or_index [list "../one.tcl" "$group_name Home"] [list "" "Administration"] "One Email"]"
+    set hyperlink_user_p 1
+}
+
+
+set return_string "
+[ad_header "$group_name Administration @ [ad_system_name]"]
+
+<h2>One Email</h2>
+
+$nav_bar
+
+<hr>
+
+<blockquote>
+
+<table border=0 cellpadding=3>
+
+<tr><th align=right>Status</th> 
+    <td>$status_string
+</tr>
+
+<tr><th align=right>Date</th><td>[util_AnsiDatetoPrettyDate $creation_date]</td></tr>
+
+<tr><th align=right>From </th><td>
+"
+
+if {$hyperlink_user_p} {
+    append return_string "
+    <a href=\"users/one.tcl?user_id=$sender_id\">$sender_name</a>
+    "
+} else {
+    append return_string  "$sender_name"
+}
+
+append return_string "
+($from_address) </td></tr>
+
+<tr><th align=right>To </th><td>$send_to_pretty_roles of $spam_group_name</td></tr>
+
+<tr><th align=right>No. of Intended Recipients </th><td>$n_receivers_intended</td></tr>
+
+<tr><th align=right>No. of Actual Recipients </th><td>$n_receivers_actual</td></tr>
+
+<tr><th align=right>Subject </th><td>$subject</td></tr>
+
+<tr><th align=right valign=top>Message </th><td>
+<pre>[ns_quotehtml $body]</pre>
+</td></tr>
+
+</table>
+
+</blockquote>
+
+[ad_footer]
+"
+
+
+ns_return 200 text/html $return_string
+
+
+
Index: web/openacs/www/education/util/spam-send.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/spam-send.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/spam-send.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,218 @@
+#
+# /www/education/class/admin/spam-send.tcl
+#
+# heavily taken from /groups/group/spam-send.tcl
+#
+# modified by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this actually sends the spam
+#
+
+
+ad_page_variables {
+    subject
+    who_to_spam
+    header
+    spam_roles
+    spam_id
+    message
+    from_address
+    n_recipients
+    group_id
+}
+
+
+validate_integer spam_id $spam_id
+validate_integer n_recipients $n_recipients
+validate_integer group_id $group_id
+
+set db [ns_db gethandle]
+
+
+set group_pretty_type [edu_get_group_pretty_type_from_url]
+
+# right now, the proc above is only set up to recognize type 
+# group and department and the proc must be changed if this page
+# is to be used for URLs besides those.
+
+if {[empty_string_p $group_pretty_type]} {
+    ns_returnnotfound
+    return
+} else {
+
+    if {[string compare $group_pretty_type class] == 0} {
+	set id_list [edu_user_security_check $db]
+    } else {
+	# it is a department
+	set id_list [edu_group_security_check $db edu_department]
+    }
+}
+
+set sender_id [lindex $id_list 0]
+set actual_group_id [lindex $id_list 1]
+set group_name [lindex $id_list 2]
+
+
+
+# now, lets make sure that the user has permission to view this spam
+set spam_permission_p [ad_permission_p $db "" "" "Spam Users" $sender_id $group_id]
+
+if {!$spam_permission_p} {
+    set spam_permission_p [ad_permission_p $db "" "" "Spam Users" $sender_id $actual_group_id]
+    if {!$spam_permission_p} {
+	# are they a member of the group the spam was sent to?
+	# if not, tell them they are not allowed to view the spam
+	if {[database_to_tcl_string $db "select count(user_id) from user_group_map where group_id = $group_id and user_id = $sender_id"] == 0} {
+	    ad_return_complaint 1 "<li>You do not currently have permission to spam the group you are trying to spam."
+	    return
+	}
+    }
+}
+
+
+if [catch { ns_ora clob_dml $db "insert into group_spam_history
+(spam_id, group_id, send_to_roles, from_address, subject, body, send_date, sender_id, sender_ip_address, approved_p, n_receivers_intended, creation_date)
+values
+($spam_id, $group_id, [ns_dbquotevalue $who_to_spam], [ns_dbquotevalue $from_address], [ns_dbquotevalue $subject], '', sysdate(), $sender_id, '[DoubleApos [ns_conn peeraddr]]', 't', [ns_dbquotevalue $n_recipients], sysdate())
+" $message } errmsg] {
+    # choked; let's see if it is because 
+    if { [database_to_tcl_string $db "select count(*) from spam_history where spam_id = $spam_id"] > 0 } {
+	ns_return 200 text/html "[ad_header "Double Click?"]
+
+<h2>Double Click?</h2>
+
+<hr>
+
+This spam has already been sent.  Perhaps you double clicked?  In any 
+case, you can check the progress of this spam on
+<a href=\"old.tcl?[export_url_vars spam_id]\">the history page</a>.
+
+[ad_footer]"
+    } else {
+	ad_return_error "Ouch!" "The database choked on your insert:
+<blockquote>
+$errmsg
+</blockquote>
+"
+    }
+    return
+}
+
+
+set email_list [database_to_tcl_list $db "
+    select distinct email
+    from user_group_map ug, users_spammable u
+	where ug.group_id = $group_id
+        and lower(ug.role) in ([join $spam_roles ","])
+	and ug.user_id = u.user_id
+	and not exists ( select 1 
+	                 from group_member_email_preferences
+                         where group_id = $group_id
+	                 and user_id =  u.user_id 
+                         and dont_spam_me_p = 't')
+        and not exists ( select 1 
+	                 from user_user_bozo_filter
+                         where origin_user_id = u.user_id 
+	                 and target_user_id =  $sender_id)"]
+
+
+set short_name [database_to_tcl_string $db "select short_name from user_groups where group_id=$group_id"]
+
+
+append message "
+
+--------------------------------------------------------- \n
+You've gotten this spam because you are a registered member of $group_name.\n\n
+
+To stop receiving any future spam from the $group_name mailing list:\n
+click <a href=[ad_url]/groups/$short_name/edit-preference.tcl?dont_spam_me_p=t>here</a>
+\n\n
+---------------------------------------------------------\n
+To stop receiving any future email from this specific sender:\n
+click <a href=[ad_url]/user-user-bozo-filter.tcl?[export_url_vars sender_id ]>here</a>
+"
+
+
+
+if {[lsearch [ns_conn urlv] admin] == -1} {
+    set nav_bar "[ad_context_bar_ws_or_index [list "one.tcl" "$group_name Home"] "Sending Spam"]"
+} else {
+    set nav_bar "[ad_context_bar_ws_or_index [list "../one.tcl" "$group_name Home"] [list "" "Administration"] "Sending Spam"]"
+}
+
+
+ReturnHeaders
+
+ns_write "
+[ad_header "$group_name Spam @ [ad_system_name]"]
+
+<h2>Spam $header</h2>
+
+$nav_bar
+
+<hr>
+<blockquote>
+
+Sending Spam to $header
+
+<P>
+Sending email to...
+<ul>
+"
+
+
+foreach email $email_list {
+    with_catch errmsg {
+	ns_sendmail $email $from_address $subject $message
+	# we succeeding sending this particular piece of mail
+	ns_write "$email ... <br>"
+	ns_db dml $db "update group_spam_history set n_receivers_actual = n_receivers_actual + 1 where spam_id = $spam_id"
+    } {
+	# email failed, let's see if it is because mail 
+	# service is completely wedged on this box
+	if { [string first "timed out" errmsg] != -1 } {
+	    # looks like we couldn't even talk to mail server
+	    # let's just give up and return so that this thread
+	    # doesn't have around for 10 minutes 
+	    ns_log Notice "timed out sending email; giving up on email alerts.  Here's what ns_sendmail returned:\n$errmsg"
+	    ns_write "</ul>
+	    
+	    Something is horribly wrong with the email handler on this computer so
+	    we're giving up on sending any email notifications.  Your posting
+	    will be enshrined in the database, of course.
+	    
+	    [ad_footer]"
+	    return
+	} else {
+	    ns_write  "Something is horribly wrong with 
+	    the email handler on this computer so
+	    we're giving up on sending any email notifications.  Your posting
+	    will be enshrined in the database, of course.
+	    
+	    
+	    <p>
+	    <blockquote>
+	    <pre>
+	    $errmsg
+	    </pre>
+	    </blockquote>"
+	    return
+	}
+    }
+}
+
+ns_db releasehandle $db
+    
+# we're done processing the email queue
+ns_write "
+</ul>
+<p>
+
+We're all done with the email notifications now.  If any of these
+folks typed in a bogus/misspelled/obsolete email address, you may get a
+bounced message in your inbox.
+</blockquote>
+[ad_footer]
+"
+
+
Index: web/openacs/www/education/util/spam.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/spam.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/spam.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,172 @@
+#
+# /www/education/util/spam.tcl
+# 
+# taken from /groups/group/spam.tcl
+#
+# modified extensively by randyg@arsdigita.com, aileen@mit.edu, February 2000
+#
+#
+
+ad_page_variables {
+    who_to_spam
+    {subgroup_id ""}
+}
+
+validate_integer subgroup_id $subgroup_id
+
+# who_to_spam should be a list of roles of people in this group we wish to spam.
+# an example would be [list ta professor] or [list ta professor student]
+
+# subgroup_id designates that we are spamming a subgroup of the class (e.g. a team or
+# a section) and it is the group_id of the subgroup we are spamming
+
+
+set db [ns_db gethandle]
+
+set group_pretty_type [edu_get_group_pretty_type_from_url]
+
+# right now, the proc above is only set up to recognize type 
+# group and department and the proc must be changed if this page
+# is to be used for URLs besides those.
+
+if {[empty_string_p $group_pretty_type]} {
+    ns_returnnotfound
+    return
+} else {
+
+    if {[string compare $group_pretty_type class] == 0} {
+	set id_list [edu_user_security_check $db]
+    } else {
+	# it is a department
+	set id_list [edu_group_security_check $db edu_department]
+    }
+}
+
+
+set user_id [lindex $id_list 0]
+set group_id [lindex $id_list 1]
+set group_name [lindex $id_list 2]
+
+# lets make sure that they have permission to spam this group
+set spam_permission_p [ad_permission_p $db "" "" "Spam Users" $user_id $group_id]
+
+if {!$spam_permission_p} {
+    # we do not check to see if they are part of the main group because we
+    # already know that from the checks above.  And, if they had permission
+    # to spam the users, spam_permission_p would already be 1 from the
+    # call to ad_permission_p
+
+    # lets see if they are a member of the subgroup
+    if {![empty_string_p $subgroup_id]} {
+	set spam_permission_p [database_to_tcl_string $db "select 
+              (case when count(user_id) = 0 then 0 else 1 end) 
+         from user_groups 
+        where user_id = $user_id 
+          and group_id = $subgroup_id"]
+    }
+
+    if {!$spam_permission_p} {
+	ad_return_complaint 1 "<li>You do not currently have permission to spam the group you are trying to spam."
+	return
+    }
+}	
+
+#
+# if they have gotten past this point, they have the correct permissions,
+# assuming that the subgroup is part of the group.  We check that now
+#
+
+if {![empty_string_p $subgroup_id]} {
+    # make sure that the subgroup is part of this group
+
+    set subgroup_name [database_to_tcl_string $db "select group_name from user_groups where parent_group_id = $group_id and group_id = $subgroup_id"]
+
+    if {[empty_string_p $subgroup_name]} {
+	ad_return_complaint 1 "<li>You do not currently have permission to spam the group you are trying to spam."
+	return
+    }
+
+    set header_suffix " of $subgroup_name"
+} else {
+    set header_suffix ""
+}
+
+
+if {[lsearch [ns_conn urlv] admin] == -1} {
+    set nav_bar "[ad_context_bar_ws_or_index [list "one.tcl" "$group_name Home"] Spam]"
+} else {
+    set nav_bar "[ad_context_bar_ws_or_index [list "../one.tcl" "$group_name Home"] [list "" "Administration"] Spam]"
+}
+
+
+# this will always return a row because we are getting the user_id out of the cookie
+set selection [ns_db 1row $db "select first_names || ' ' || last_name as sender_name, email as sender_email from users where user_id = $user_id"]
+
+set_variables_after_query
+
+set header [list]
+
+foreach role $who_to_spam {
+    set pretty_role_plural "[database_to_tcl_string_or_null $db "select pretty_role_plural from edu_role_pretty_role_map where lower(role) = lower('$role') and group_id = $group_id"]"
+    if {![empty_string_p $pretty_role_plural]} {
+	lappend header $pretty_role_plural
+    } else {
+	lappend header "[capitalize $role]s"
+    }
+}
+
+
+ns_db releasehandle $db
+
+set header "[join $header ", "] $header_suffix"
+
+ns_return 200 text/html "
+[ad_header "$group_name @ [ad_system_name]"]
+
+<h2>Spam $header</h2>
+
+$nav_bar
+
+<hr>
+<blockquote>
+
+
+<form method=POST action=\"spam-confirm.tcl\">
+[export_form_vars who_to_spam header subgroup_id]
+<table>
+
+<tr><th align=left>From:</th>
+<td><input name=from_address type=text size=25 value=\"$sender_email\"></td></tr>
+
+<tr><th align=left>Subject:</th><td><input name=subject type=text size=40></td></tr>
+
+<tr><th align=left valign=top>Message:</th><td>
+<textarea name=message rows=10 cols=50 wrap=hard></textarea>
+</td></tr>
+
+</table>
+
+<center>
+<p>
+<input type=submit value=\"Proceed\">
+
+</center>
+
+</form>
+<p>
+
+</blockquote>
+
+[ad_footer]
+"
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/util/upload-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/upload-new.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/upload-new.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,284 @@
+# 
+# /www/education/util/upload-new.tcl
+#
+# this is very similar to upload-new.tcl in the file-storage module
+# there are a few differences regarding how permissions are set.  This
+# one assumes that the permissions are passed in instead of redirecting the
+# user to set the permissions after the fact
+#
+# revised by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+
+
+ad_page_variables {
+    {upload_file ""}
+    {url ""}
+    file_title
+    file_id
+    version_id
+    parent_id
+    {write_permission ta}
+    {read_permission ""}
+    {version_description ""}
+    {return_url ""}
+}
+
+validate_integer file_id $file_id
+validate_integer version_id $version_id
+validate_integer parent_id $parent_id
+
+# either the upload file or the url must be not null and the other one must be null
+
+
+set db [ns_db gethandle]
+
+set group_pretty_type [edu_get_group_pretty_type_from_url]
+
+# right now, the proc above is only set up to recognize type 
+# class and department and the proc must be changed if this page
+# is to be used for URLs besides those.
+
+if {[empty_string_p $group_pretty_type]} {
+    ns_returnnotfound
+    return
+} else {
+
+    if {[string compare $group_pretty_type class] == 0} {
+	set id_list [edu_group_security_check $db edu_class "Add Tasks"]
+    } else {
+	# it is a department
+	set id_list [edu_group_security_check $db edu_department]
+    }
+}
+	
+
+# gets the group_id.  If the user is not an admin of the group, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the group_id to make sure it is valid
+
+set user_id [lindex $id_list 0]
+set group_id [lindex $id_list 1]
+set group_name [lindex $id_list 2]
+
+
+# check the user input first
+
+set exception_text ""
+set exception_count 0
+
+
+if {[empty_string_p $url] && (![info exists upload_file] || [empty_string_p $upload_file])} {
+    append exception_text "<li>You need to upload a file or enter a URL\n"
+    incr exception_count
+}
+
+if {![empty_string_p $url] && ![empty_string_p $upload_file]} {
+    append exception_text "<li>You can not both add a url and upload a file"
+    incr exception_count
+}
+
+
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+
+if {[database_to_tcl_string $db "select count(version_id) from fs_versions where version_id = $version_id"] > 0 || [database_to_tcl_string $db "select count(file_id) from fs_files where file_id = $file_id"] > 0} {
+    # this was a double click
+    ns_returnredirect $return_url
+    return
+}
+
+
+# set the variables that are the same for all
+
+set public_p f
+
+
+if {[empty_string_p $url]} {
+
+    # get the file from the user.
+    # number_of_bytes is the upper-limit
+    set max_n_bytes [ad_parameter MaxNumberOfBytes fs]
+    
+    set tmp_filename [ns_queryget upload_file.tmpfile]
+    set version_content [read [open $tmp_filename] $max_n_bytes]
+    
+    set file_extension [string tolower [file extension $upload_file]]
+    # remove the first . from the file extension
+    regsub "\." $file_extension "" file_extension
+    
+    set guessed_file_type [ns_guesstype $upload_file]
+    
+    set n_bytes [file size $tmp_filename]
+    
+    # strip off the C:\directories... crud and just get the file name
+    if {![regexp {([^//\\]+)$} $upload_file match client_filename]} {
+	# couldn't find a match
+	set client_filename $upload_file
+    }
+    
+    ns_db dml $db "begin transaction"
+
+    set lob_id [database_to_tcl_string $db "select empty_lob()"]
+
+    set file_insert "insert into fs_files
+    (file_id, file_title, owner_id, parent_id, sort_key, depth, group_id, public_p)
+    values
+    ($file_id, [ns_dbquotevalue $file_title], $user_id, [ns_dbquotevalue $parent_id],0,0, $group_id, '$public_p')"
+    
+    set version_insert "insert into fs_versions
+    (version_id, file_id, version_description, creation_date, author_id, client_file_name, file_type, file_extension, n_bytes, lob)
+    values
+    ($version_id, $file_id, [ns_dbquotevalue $version_description], sysdate(), $user_id, '[DoubleApos $client_filename]', '$guessed_file_type', '$file_extension', $n_bytes, $lob_id)" 
+    
+    if {[catch { ns_db dml $db $file_insert } errmsg] } {
+         # insert failed; let's see if it was because of duplicate submission
+         if { [database_to_tcl_string $db "select count(*) from fs_files where file_id = $file_id"] == 0 } {
+	     ns_log Error "[edu_url]group/admin/upload-new.tcl choked:  $errmsg"
+	     ad_return_error "Insert Failed" "The Database did not like what you typed.  This is probably a bug in our code.  Here's what the database said:
+	     <blockquote>
+	     <pre>
+	     $errmsg
+	     </pre>
+	     </blockquote>
+	     "
+             return
+         }
+         ns_db dml $db "abort transaction"
+	 # we don't bother to handle the cases where there is a dupe 
+	 # submission because the user should be thanked or 
+	 # redirected anyway
+	 ns_returnredirect $return_url
+    }
+     
+    # don't need double-click protection here since we already did 
+    # that for previous statement
+
+    ns_db dml $db $version_insert
+
+    ns_pg blob_dml_file $db $lob_id $tmp_filename
+    
+} else {
+
+    set file_insert "insert into fs_files
+    (file_id, file_title, owner_id, parent_id, sort_key, depth, group_id, public_p)
+    values
+    ($file_id, [ns_dbquotevalue $file_title], $user_id, [ns_dbquotevalue $parent_id],0,0,$group_id, '$public_p')
+    "
+    
+    set version_insert "insert into fs_versions
+    (version_id, file_id, version_description, creation_date, author_id, url)
+    values
+    ($version_id, $file_id, [ns_dbquotevalue $version_description], sysdate(), $user_id, [ns_dbquotevalue $url])"
+    
+    
+    if {[catch { ns_db dml $db "begin transaction"
+ 	         ns_db dml $db $file_insert 
+                  ns_db dml $db $version_insert} errmsg] } {
+         # insert failed; let's see if it was because of duplicate submission
+         if { [database_to_tcl_string $db "select count(*) from fs_files where file_id = $file_id"] == 0 } {
+ 	    ns_log Error "[edu_url]group/admin/upload-new.tcl choked:  $errmsg"
+ 	    ad_return_error "Insert Failed" "The Database did not like what you typed.  This is probably a bug in our code.  Here's what the database said:
+	    <blockquote>
+	    <pre>
+	    $errmsg
+	    </pre>
+	    </blockquote>
+	    "
+            ns_db dml $db "abort transaction"
+            return
+        }
+    }
+}
+ 
+
+#
+# the permissions makes the assumption that the roles are a hierarchical 
+# by the priority column
+#
+
+# lets first give the uploading user permissions on the document
+
+ns_db select $db "select grant_permission_to_user ( $user_id, 'read', $version_id, 'FS_VERSIONS' )"
+ns_db select $db "select grant_permission_to_user ( $user_id, 'write', $version_id, 'FS_VERSIONS' )"
+ns_db select $db "select grant_permission_to_user ( $user_id, 'comment', $version_id, 'FS_VERSIONS' )"
+ns_db select $db "select grant_permission_to_user ( $user_id, 'administer', $version_id, 'FS_VERSIONS' )"
+
+# lets do the write permissions next
+
+if {[empty_string_p $write_permission]} {
+
+    ns_db select $db "select grant_permission_to_all_users ( 'write', $version_id, 'FS_VERSIONS' )"
+    ns_db select $db "select grant_permission_to_all_users ( 'read', $version_id, 'FS_VERSIONS' )"
+    ns_db select $db "select grant_permission_to_all_users ( 'comment', $version_id, 'FS_VERSIONS' )"
+
+    set write_permission_priority -1
+} else {
+    # a specific role has write permission.  In this case, we want to 
+    # give write permisison to every group with a priority greater than
+    # the given role
+    set write_permission_priority [database_to_tcl_string $db "select priority from edu_role_pretty_role_map where group_id = $group_id and lower(role) = lower('$write_permission')"]
+
+    set role_list [database_to_tcl_list $db "select role from edu_role_pretty_role_map where group_id = $group_id and priority <= $write_permission_priority"]
+
+    # now, lets go through the role_list and add write permissions
+    # but, if you want write permissions, you should also have read and comment permission
+    foreach role $role_list {
+        ns_db select $db "select grant_permission_to_role ( $group_id, '$role', 'write', $version_id, 'FS_VERSIONS' )"
+        ns_db select $db "select grant_permission_to_role ( $group_id, '$role', 'read', $version_id, 'FS_VERSIONS' )"
+        ns_db select $db "select grant_permission_to_role ( $group_id, '$role', 'comment', $version_id, 'FS_VERSIONS' )"
+    }
+}
+
+
+# now, we do read permissions pretty much the same way.  The general
+# permissions functions assume that if you have write, you automatically
+# have read so if the role has write, we are not going to add read again
+
+if {[empty_string_p $read_permission]} {
+    # insert write permission for the public
+    if {$write_permission_priority > -1} {
+	# the public cannot write
+	ns_db select $db "select grant_permission_to_all_users ( 'read', $version_id, 'FS_VERSIONS' )"
+        ns_db select $db "select grant_permission_to_all_users ( 'comment', $version_id, 'FS_VERSIONS' )"  
+    }
+} else {
+    # a specific role has write permission.  In this case, we want to 
+    # give write permisison to every group with a priority greater than
+    # the given role
+    set read_permission_priority [database_to_tcl_string $db "select priority from edu_role_pretty_role_map where group_id = $group_id and lower(role) = lower('$read_permission')"]
+
+    if {$read_permission_priority > $write_permission_priority} {
+	# there are users that should have read and do not already have write
+	set role_list [database_to_tcl_list $db "select role from edu_role_pretty_role_map where group_id = $group_id and priority > $write_permission_priority and priority <= $read_permission_priority"]
+
+	# now, lets go through the role_list
+	foreach role $role_list {
+	    ns_db select $db "select grant_permission_to_role ( $group_id, '$role', 'read', $version_id, 'FS_VERSIONS' )"
+            ns_db select $db "select grant_permission_to_role ( $group_id, '$role', 'comment', $version_id, 'FS_VERSIONS' )"
+	}
+    }
+}
+
+
+fs_order_files $db $user_id $group_id $public_p
+
+ns_db dml $db "end transaction"
+
+ns_db releasehandle $db
+
+ns_returnredirect $return_url
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/education/util/upload-version.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/upload-version.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/upload-version.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,288 @@
+#
+# /www/education/util/upload-version.tcl
+#
+# by aure@arsdigita.com mid-1999
+#
+# extended in January 2000 by randyg@arsdigita.com
+# to accomodate general permission system
+#
+# modified by randyg@arsdigita.com to work with the permissions used by the
+# education module
+#
+
+ad_page_variables {
+    file_id
+    version_id
+    {upload_file ""}
+    {url ""}
+    {return_url ""}
+    {read_permission ""}
+    {write_permission ""}
+    {version_description ""}
+}
+
+# one but not both of upload_file and url must be not null
+
+validate_integer file_id $file_id
+validate_integer version_id $version_id
+
+set db [ns_db gethandle]
+
+set group_pretty_type [edu_get_group_pretty_type_from_url]
+
+# right now, the proc above is only set up to recognize type 
+# class and department and the proc must be changed if this page
+# is to be used for URLs besides those.
+
+if {[empty_string_p $group_pretty_type]} {
+    ns_returnnotfound
+    return
+} else {
+
+    if {[string compare $group_pretty_type class] == 0} {
+	set id_list [edu_group_security_check $db edu_class "Add Tasks"]
+    } else {
+	# it is a department
+	set id_list [edu_group_security_check $db edu_department]
+    }
+}
+	
+
+# gets the group_id.  If the user is not an admin of the group, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the group_id to make sure it is valid
+
+set user_id [lindex $id_list 0]
+set group_id [lindex $id_list 1]
+set group_name [lindex $id_list 2]
+
+
+# check the user input first
+
+set exception_text ""
+set exception_count 0
+
+if {[empty_string_p $url] && [empty_string_p $upload_file]} {
+    append exception_text "<li>You need to upload a file or enter a URL\n"
+    incr exception_count
+}
+
+if {![empty_string_p $url] && ![empty_string_p $upload_file]} {
+    append exception_text "<li>You can not both add a url and upload a file"
+    incr exception_count
+}
+
+
+
+# get the version_id for the item being replaced
+
+set selection [ns_db 1row $db "select version_id as old_version_id from fs_versions_latest where file_id = $file_id"]
+
+
+if {$selection == ""} {
+    incr exception_count
+    append exception_text "<li>The file you have provided does not exist."
+} else {
+    set_variables_after_query
+}
+
+
+if {! [fs_check_write_p $db $user_id $old_version_id $group_id]} {
+    incr exception_count
+    append exception_text "<li>You can't write into this file"
+}
+
+
+## return errors
+if { $exception_count> 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+
+
+if {[database_to_tcl_string $db "select count(version_id) from fs_versions where version_id = $version_id"] > 0} {
+    # this was a double click
+    ns_returnredirect $return_url
+    return
+}
+
+
+if [empty_string_p $url] {
+
+    # get the file from the user.
+    # number_of_bytes is the upper-limit
+    set max_n_bytes [ad_parameter MaxNumberOfBytes fs]
+
+    set tmp_filename [ns_queryget upload_file.tmpfile]
+    set version_content [read [open $tmp_filename] $max_n_bytes]
+
+    set file_extension [string tolower [file extension $upload_file]]
+    # remove the first . from the file extension
+    regsub "\." $file_extension "" file_extension
+
+    set guessed_file_type [ns_guesstype $upload_file]
+
+    set n_bytes [file size $tmp_filename]
+
+    # strip off the C:\directories... crud and just get the file name
+    if ![regexp {([^//\\]+)$} $upload_file match client_filename] {
+        # couldn't find a match
+        set client_filename $upload_file
+    }
+
+    ns_db dml $db "begin transaction"
+
+    set lob_id [database_to_tcl_string $db "select empty_lob()"]
+
+    set version_insert "insert into fs_versions
+(version_id, file_id, version_description, creation_date, author_id, client_file_name, file_type, file_extension, n_bytes, lob)
+values
+($version_id, $file_id, [ns_dbquotevalue $version_description], sysdate(), $user_id, '[DoubleApos $client_filename]', '$guessed_file_type', '$file_extension', $n_bytes, $lob_id)" 
+    
+    if {[catch { ns_db dml $db $version_insert 
+                 ns_pg blob_dml_file $db $lob_id $tmp_filename } errmsg] } {
+        # insert failed; let's see if it was because of duplicate submission
+        if { [database_to_tcl_string $db "select count(*) from fs_versions where version_id = $version_id"] == 0 } {
+	    ns_log Error "[edu_url]group/admin/upload-version.tcl choked:  $errmsg"
+	    ad_return_error "Insert Failed" "The Database did not like what you typed.  This is probably a bug in our code.  Here's what the database said:
+<blockquote>
+<pre>
+$errmsg
+</pre>
+</blockquote>
+"
+            return
+        }
+        ns_db dml $db "abort transaction"
+        # we don't bother to handle the cases where there is a dupe 
+        # submission because the user should be thanked or 
+        # redirected anyway
+        ns_returnredirect $return_url
+    }
+
+} else {
+
+    set version_insert "insert into fs_versions
+(version_id, file_id, version_description, creation_date, author_id, url)
+values
+($version_id, $file_id, [ns_dbquotevalue $version_description], sysdate(), $user_id, [ns_dbquotevalue $url])"
+
+
+    if {[catch { ns_db dml $db "begin transaction"
+                 ns_db dml $db $version_insert} errmsg] } {
+        # insert failed; let's see if it was because of duplicate submission
+        if { [database_to_tcl_string $db "select count(*) from fs_files where file_id = $file_id"] == 0 } {
+	    ns_log Error "/file-storage/create-folder-2.tcl choked:  $errmsg"
+	    ad_return_error "Insert Failed" "The Database did not like what you typed.  This is probably a bug in our code.  Here's what the database said:
+<blockquote>
+<pre>
+$errmsg
+</pre>
+</blockquote>
+"
+            ns_db dml $db "abort transaction"
+            return
+        }
+    }
+
+}
+
+
+# now that we are done with the insert, lets update the other file so that
+# it knows that is have been superseded
+
+ns_db dml $db  "update fs_versions 
+set superseded_by_id = $version_id
+where file_id = $file_id
+and version_id <> $version_id"
+
+
+
+##########################################
+#                                        #
+# Lets take care of the permissions here #
+#                                        #
+##########################################
+
+#
+# the permissions makes the assumption that the roles are a hierarchical 
+# by the priority column
+#
+
+# lets first give the uploading user permissions on the document
+
+ns_db select $db "select grant_permission_to_user ( $user_id, 'read', $version_id, 'FS_VERSIONS' )"
+ns_db select $db "select grant_permission_to_user ( $user_id, 'write', $version_id, 'FS_VERSIONS' )"
+ns_db select $db "select grant_permission_to_user ( $user_id, 'comment', $version_id, 'FS_VERSIONS' )"
+ns_db select $db "select grant_permission_to_user ( $user_id, 'administer', $version_id, 'FS_VERSIONS' )"
+
+
+# lets do the write permissions next
+
+if {[empty_string_p $write_permission]} {
+    # insert write permission for the public
+    ns_db select $db "select grant_permission_to_all_users ( 'write', $version_id, 'FS_VERSIONS' )"
+    ns_db select $db "select grant_permission_to_all_users ( 'read', $version_id, 'FS_VERSIONS' )"
+    ns_db select $db "select grant_permission_to_all_users ( 'comment', $version_id, 'FS_VERSIONS' )"
+
+    set write_permission_priority -1
+} else {
+    # a specific role has write permission.  In this case, we want to 
+    # give write permisison to every group with a priority greater than
+    # the given role
+    set write_permission_priority [database_to_tcl_string $db "select priority from edu_role_pretty_role_map where group_id = $group_id and lower(role) = lower('$write_permission')"]
+
+    set role_list [database_to_tcl_list $db "select role from edu_role_pretty_role_map where group_id = $group_id and priority <= $write_permission_priority"]
+
+    # now, lets go through the role_list and add write permissions
+    # but, if you want write permissions, you should also have read and comment permission
+    foreach role $role_list {
+        ns_db select $db "select grant_permission_to_role ( $group_id, '$role', 'write', $version_id, 'FS_VERSIONS' )"
+        ns_db select $db "select grant_permission_to_role ( $group_id, '$role', 'read', $version_id, 'FS_VERSIONS' )"
+        ns_db select $db "select grant_permission_to_role  ( $group_id, '$role', 'comment', $version_id, 'FS_VERSIONS' )"
+    }
+}
+
+
+# now, we do read permissions pretty much the same way.  The general
+# permissions functions assume that if you have write, you automatically
+# have read so if the role has write, we are not going to add read again
+
+if {[empty_string_p $read_permission]} {
+    # insert write permission for the public
+    if {$write_permission_priority > -1} {
+	# the public cannot write
+	ns_db select $db "select grant_permission_to_all_users ( 'read', $version_id, 'FS_VERSIONS' )"
+        ns_db select $db "select grant_permission_to_all_users ( 'comment', $version_id, 'FS_VERSIONS' )"  
+    }
+} else {
+    # a specific role has write permission.  In this case, we want to 
+    # give write permisison to every group with a priority greater than
+    # the given role
+    set read_permission_priority [database_to_tcl_string $db "select priority from edu_role_pretty_role_map where group_id = $group_id and lower(role) = lower('$read_permission')"]
+
+    if {$read_permission_priority > $write_permission_priority} {
+	# there are users that should have read and do not already have write
+	set role_list [database_to_tcl_list $db "select role from edu_role_pretty_role_map where group_id = $group_id and priority > $write_permission_priority and priority <= $read_permission_priority"]
+
+	# now, lets go through the role_list
+	foreach role $role_list {
+	    ns_db select $db "select grant_permission_to_role ( $group_id, '$role', 'read', $version_id, 'FS_VERSIONS' )"
+            ns_db select $db "select grant_permission_to_role ( $group_id, '$role', 'comment', $version_id, 'FS_VERSIONS' )"
+	}
+    }
+}
+
+
+
+fs_order_files $db $user_id $group_id f
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect $return_url
+
+
+
+
+
Index: web/openacs/www/education/util/users/add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/users/add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/users/add-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,136 @@
+#
+# /www/education/util/users/add-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page displays the search results
+#
+
+ad_page_variables {
+    {email ""}
+    {last_name ""}
+}
+
+
+set db [ns_db gethandle]
+
+set group_pretty_type [edu_get_group_pretty_type_from_url]
+
+# right now, the proc above is only set up to recognize type 
+# class and department and the proc must be changed if this page
+# is to be used for URLs besides those.
+
+if {[empty_string_p $group_pretty_type]} {
+    ns_returnnotfound
+    return
+} else {
+
+    if {[string compare $group_pretty_type class] == 0} {
+	set id_list [edu_group_security_check $db edu_class "Manage Users"]
+    } else {
+	# it is a department
+	set id_list [edu_group_security_check $db edu_department]
+    }
+}
+
+
+
+# gets the group_id.  If the user is not an admin of the group, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the group_id to make sure it is valid
+
+set user_id [lindex $id_list 0]
+set group_id [lindex $id_list 1]
+set group_name [lindex $id_list 2]
+
+
+# either email or last_name must be not null
+
+set exception_count 0 
+set exception_text ""
+
+if { [empty_string_p $email] && [empty_string_p $last_name] } {
+    incr exception_count
+    append exception_text "<li>You need to search for administrator by either Last Name or Email\n"
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    # terminate execution of this thread (a goto!)
+    return
+}
+
+
+set sql_suffix "and user_id not in (select user_id from user_group_map where group_id = $group_id)"
+
+### search by last_name and email
+if { ![empty_string_p $last_name] && ![empty_string_p $email] } {
+    set query_string "select user_id as user_id_to_add, first_names, last_name, email from users 
+    where upper(last_name) like '%[string toupper $last_name]%'
+    and upper(email) like '%[string toupper $email]%' $sql_suffix"
+    set title "Users whose last name contains $last_name and email contains $email:"
+}
+
+## search by email
+if { [empty_string_p $last_name] && ![empty_string_p $email] } {
+    set query_string "select user_id as user_id_to_add, first_names, last_name, email from users 
+    where upper(last_name) like '%[string toupper $last_name]%'
+    and upper(email) like '%[string toupper $email]%' $sql_suffix"
+    set title "Users whose email contains $email:"
+}
+
+## search by last_name
+if { ![empty_string_p $last_name] && [empty_string_p $email] } {
+    set query_string "select user_id as user_id_to_add, first_names, last_name, email from users 
+    where upper(last_name) like '%[string toupper $last_name]%'
+    and upper(email) like '%[string toupper $email]%' $sql_suffix"
+    set title "Users whose last name contains $last_name:"
+}
+
+
+
+set return_string "
+[ad_header "$group_name @ [ad_system_name]"]
+
+<h2>Add a user for $group_name</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$group_name Home"] [list "../" "Administration"] [list "" Users] "Add a User"]
+
+<hr>
+"
+
+set selection [ns_db select $db $query_string]
+
+set text ""
+set counter 0
+while { [ns_db getrow $db $selection] } {
+
+    set_variables_after_query
+    incr counter
+    append text "<li><a href=\"add-3.tcl?[export_url_vars user_id_to_add last_name first_names]\">$last_name, $first_names ($email)</a>\n"
+}
+
+
+if { $counter > 0 } {
+    append return_string "
+    $title
+    <ul>
+    $text
+    </ul>
+    To make the community memeber a group member, click on the name above.
+    "
+} else {
+    append return_string "We found no matches to your query, please check your information again\n"
+}
+
+
+append return_string "
+<br>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
+
Index: web/openacs/www/education/util/users/add-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/users/add-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/users/add-3.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,108 @@
+#
+# /www/education/util/users/add-3.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# This page allows the admin to select a role for the new user
+#
+
+ad_page_variables {
+    first_names
+    last_name
+    user_id_to_add
+}
+
+validate_integer user_id_to_add $user_id_to_add
+
+set group_pretty_type [edu_get_group_pretty_type_from_url]
+
+# right now, the proc above is only set up to recognize type 
+# group and department and the proc must be changed if this page
+# is to be used for URLs besides those.
+
+if {[empty_string_p $group_pretty_type]} {
+    ns_returnnotfound
+    return
+} else {
+
+    set db [ns_db gethandle]
+
+    if {[string compare $group_pretty_type class] == 0} {
+	set id_list [edu_group_security_check $db edu_class "Manage Users"]
+    } else {
+	# it is a department
+	set id_list [edu_group_security_check $db edu_department]
+    }
+}
+
+# gets the group_id.  If the user is not an admin of the group, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the group_id to make sure it is valid
+
+set user_id [lindex $id_list 0]
+set group_id [lindex $id_list 1]
+set group_name [lindex $id_list 2]
+
+
+set exception_text ""
+set exception_count 0
+
+set list_to_check [list [list user_id_to_add "user id"] [list first_names "first name"] [list last_name "last name"]]
+
+foreach item $list_to_check {
+    if {[empty_string_p [set [lindex $item 0]]]} {
+	incr exception_count
+	append exception_text "<li>You must provide the user's [lindex $item 1]\n"
+    }
+}
+
+if { ![info exists user_id_to_add] || [empty_string_p $user_id_to_add] } {
+    incr exception_count
+    append exception_text "<li>You need to supply the user identification number\n"
+} else {
+    if {[ad_user_group_member $db $group_id $user_id_to_add] && $exception_count == 0} {
+	incr exception_count
+	append exception_text "<li>User $first_names $last_name is already an user for $group_name."
+    }
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+set return_string "
+[ad_header "Add User"]
+
+<h2> Add User for $group_name</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$group_name Home"] [list "../" "Administration"] [list "" Users] "Add a User"]
+
+<hr>
+
+<blockquote>
+
+Roles for $first_names $last_name
+
+<form method=post action=\"add-4.tcl\">
+
+[export_form_vars first_names last_name user_id_to_add]
+
+[edu_group_user_role_select_widget $db role $group_id $user_id_to_add]
+
+<p>
+
+<input type=submit value=\"Select Role\">
+
+</form>
+
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $return_string
+
Index: web/openacs/www/education/util/users/add-4.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/users/add-4.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/users/add-4.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,102 @@
+#
+# /www/education/util/users/add-4.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# This is the confirmation page before adding a user with the
+# selected role to the group
+#
+
+ad_page_variables {
+    first_names
+    last_name
+    user_id_to_add
+    role
+}
+
+validate_integer user_id_to_add $user_id_to_add
+
+set group_pretty_type [edu_get_group_pretty_type_from_url]
+
+# right now, the proc above is only set up to recognize type 
+# group and department and the proc must be changed if this page
+# is to be used for URLs besides those.
+
+if {[empty_string_p $group_pretty_type]} {
+    ns_returnnotfound
+    return
+} else {
+
+    set db [ns_db gethandle]
+
+    if {[string compare $group_pretty_type class] == 0} {
+	set id_list [edu_group_security_check $db edu_class "Manage Users"]
+    } else {
+	# it is a department
+	set id_list [edu_group_security_check $db edu_department]
+    }
+}
+
+
+# gets the group_id.  If the user is not an admin of the group, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the group_id to make sure it is valid
+
+set user_id [lindex $id_list 0]
+set group_id [lindex $id_list 1]
+set group_name [lindex $id_list 2]
+
+ns_db releasehandle $db
+
+set exception_count 0 
+set exception_text ""
+
+
+if { [empty_string_p $first_names] } {
+    incr exception_count
+    append exception_text "<li>You need to supply the first name\n"
+}
+
+if { [empty_string_p $last_name] } {
+    incr exception_count
+    append exception_text "<li>You need to supply the last name\n"
+}
+
+if { [empty_string_p $role] } {
+    incr exception_count
+    append exception_text "<li>You need to supply a role for the new user\n"
+}
+
+
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    # terminate execution of this thread (a goto!)
+    return
+}
+
+
+ns_return 200 text/html "
+[ad_header "Add User"]
+
+<h2> Confirm Add User for $group_name</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$group_name Home"] [list "../" "Administration"] [list "" Users] "Add a User"]
+
+<hr>
+<blockquote>
+<li><u> $first_names $last_name</u> will be added as a user for $group_name as a [capitalize $role]
+<p>
+
+<form method=post action=\"add-5.tcl\">
+
+[export_form_vars user_id_to_add role first_names last_name]
+
+<center><input type=submit value=\"Add User\"></center>
+</form>
+
+</blockquote>
+
+[ad_footer]
+"
+
Index: web/openacs/www/education/util/users/add-5.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/users/add-5.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/users/add-5.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,80 @@
+#
+# /www/education/util/users/add-5.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page inserts the user into the group
+#
+
+ad_page_variables {
+    user_id_to_add
+    role
+    first_names
+    last_name
+}
+
+validate_integer user_id_to_add $user_id_to_add
+
+set group_pretty_type [edu_get_group_pretty_type_from_url]
+
+# right now, the proc above is only set up to recognize type 
+# group and department and the proc must be changed if this page
+# is to be used for URLs besides those.
+
+if {[empty_string_p $group_pretty_type]} {
+    ns_returnnotfound
+    return
+} else {
+
+    set db [ns_db gethandle]
+
+    if {[string compare $group_pretty_type class] == 0} {
+	set id_list [edu_group_security_check $db edu_class "Manage Users"]
+    } else {
+	# it is a department
+	set id_list [edu_group_security_check $db edu_department]
+    }
+}
+
+# gets the group_id.  If the user is not an admin of the group, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the group_id to make sure it is valid
+
+set user_id [lindex $id_list 0]
+set group_id [lindex $id_list 1]
+set group_name [lindex $id_list 2]
+
+# we do not need to worry about whether or not the user is already in
+# the group because the proc just changes the role is that is the case
+
+ad_user_group_user_add $db $user_id_to_add $role $group_id
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "
+[ad_header "Add User"]
+
+<h2> Confirm Add User for $group_name</h2>
+
+[ad_context_bar_ws_or_index [list "../../" "$group_name Home"] [list "../" "Administration"] [list "" Users] "User Added"]
+
+<hr>
+<blockquote>
+$first_names $last_name has been added to $group_name.
+<br>
+<br>
+You may now
+<a href=\"one.tcl?user_id=$user_id_to_add\">
+
+View User Information</a> for $first_names $last_name
+
+or
+
+<a href=\"\">Return to the Users Page</a>
+</blockquote>
+
+[ad_footer]
+"
+
+
+
Index: web/openacs/www/education/util/users/add-new-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/users/add-new-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/users/add-new-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,140 @@
+#
+# /www/education/util/users/add-new-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page is a confirmation page so the admin can make sure that
+# all of the information is correct.
+#
+
+ad_page_variables {
+    email
+    first_names
+    last_name
+    {user_url ""}
+    role
+}
+
+
+set db [ns_db gethandle]
+
+set group_pretty_type [edu_get_group_pretty_type_from_url]
+
+# right now, the proc above is only set up to recognize type 
+# group and department and the proc must be changed if this page
+# is to be used for URLs besides those.
+
+if {[empty_string_p $group_pretty_type]} {
+    ns_returnnotfound
+    return
+} else {
+
+    if {[string compare $group_pretty_type class] == 0} {
+	set id_list [edu_user_security_check $db]
+    } else {
+	# it is a department
+	set id_list [edu_group_security_check $db edu_department]
+    }
+}
+
+
+set user_id [lindex $id_list 0]
+set group_id [lindex $id_list 1]
+set group_name [lindex $id_list 2]
+
+
+set exception_text ""
+set exception_count 0
+
+set list_to_check [list [list email email] [list first_names "first name"] [list last_name "last name"] [list role Role]]
+
+foreach item $list_to_check {
+    if {[empty_string_p [set [lindex $item 0]]]} {
+	incr exception_count
+	append exception_text "<li>You must provide the user's [lindex $item 1]\n"
+    }
+}
+
+
+if {[string compare $user_url "http://"] == 0} {
+    set user_url ""
+}
+
+if {![philg_email_valid_p $email]} {
+    incr exception_count
+    append exception_text "<li>The email address that you typed doesn't look right to us.  Examples of valid email addresses are 
+<ul>
+<li>Alice1234@aol.com
+<li>joe_smith@hp.com
+<li>pierre@inria.fr
+</ul>
+"
+}
+
+
+if {![empty_string_p $user_url] && ![philg_url_valid_p $user_url] } {
+    # there is a URL but it doesn't match our REGEXP
+    incr exception_count
+    append exception_text "<li>You URL doesn't have the correct form.  A valid URL would be something like \"http://photo.net/philg/\"."
+}
+
+
+#see if the email address is already in use
+#make it so that it is not case sensative
+
+set used_email [database_to_tcl_string_or_null $db "select email from users where lower(email) = lower('$email')"]
+
+if {![empty_string_p $used_email]} {
+    incr exception_count
+    append exception_text "<li>The person owning the email address $email is already a user of [ad_system_name].  To add this person to your company, please use the search function provided at the <a href=user-add.tcl>add user</a> page."
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+#create the user_id
+set new_user_id [database_to_tcl_string $db "select user_id_sequence.nextval from dual"]
+
+
+set return_string "
+[ad_header "$group_name @ [ad_system_name]"]
+
+<h2>Verify User Information</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$group_name Home"] [list "../" "Administration"] [list "" Users] "Add a New User"]
+
+<hr>
+
+<blockquote>
+
+<p>
+<B>New user's email address:</b> $email
+<p>
+<B>Full name:</b> $first_names $last_name
+<p>
+<b>Role:</b> [capitalize $role]
+<p>
+
+When you add a user, the user receives email notification and
+a temporary password.
+
+</p>
+
+<form method=post action=\"add-new-3.tcl\">
+
+[export_form_vars new_user_id role email first_names last_name user_url]
+
+<input type=submit name=action value=\"Add User\"></form>
+
+</blockquote>
+
+[ad_footer]
+"
+
+ns_return 200 text/html $return_string
+
+
Index: web/openacs/www/education/util/users/add-new-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/users/add-new-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/users/add-new-3.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,202 @@
+#
+# /www/education/util/users/add-new-3.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page enters the new user into the database and the class
+# it then mails the user a temporary password to access the site
+#
+
+ad_page_variables {
+    email
+    first_names
+    last_name
+    {user_url ""}
+    new_user_id
+    role
+}
+
+validate_integer new_user_id $new_user_id
+
+set db [ns_db gethandle]
+
+set group_pretty_type [edu_get_group_pretty_type_from_url]
+
+# right now, the proc above is only set up to recognize type 
+# group and department and the proc must be changed if this page
+# is to be used for URLs besides those.
+
+if {[empty_string_p $group_pretty_type]} {
+    ns_returnnotfound
+    return
+} else {
+
+    if {[string compare $group_pretty_type class] == 0} {
+	set id_list [edu_user_security_check $db]
+    } else {
+	# it is a department
+	set id_list [edu_group_security_check $db edu_department]
+    }
+}
+
+
+set user_id [lindex $id_list 0]
+set group_id [lindex $id_list 1]
+set group_name [lindex $id_list 2]
+
+
+set exception_text ""
+set exception_count 0
+
+set list_to_check [list [list email email] [list first_names "first name"] [list last_name "last name"] [list new_user_id "User Id"] [list role Role]]
+
+foreach item $list_to_check {
+    if {[empty_string_p [set [lindex $item 0]]]} {
+	incr exception_count
+	append exception_text "<li>You must provide the user's [lindex $item 1].\n"
+    }
+}
+
+if {[string compare $user_url "http://"] == 0} {
+    set user_url ""
+}
+
+#see if the email address is already in use
+#make it so that it is not case sensative
+set used_email [database_to_tcl_string_or_null $db "select email from users where lower(email) = lower('$email')"]
+
+if {![empty_string_p $used_email]} {
+    incr exception_count
+    append exception_text "<li>The person owning the email address $email is already a user of [ad_system_name].  To add this person to your $group_pretty_type, please use the search function provided at the <a href=\"add.tcl\">add user</a> page."
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+if {[ad_parameter RegistrationRequiresApprovalP "" 0] || [ad_parameter RegistrationRequiresEmailVerification "" 0]} {
+    # we require approval by site admin before registration is 
+    # effective
+    set approved_p "f"
+} else {
+    # let this guy go live immediately
+    # (approving_user will be NULL)
+    set approved_p "t"
+}
+
+
+
+# Autogenerate a password
+
+set password [ad_generate_random_string]
+
+# If we are encrypting passwords in the database, convert
+if  [ad_parameter EncryptPasswordsInDBP "" 0] { 
+    set password_for_database [DoubleApos [ns_crypt $password [ad_crypt_salt]]]
+} else {
+    set password_for_database $password
+}
+
+
+set insert_statement  "insert into users 
+(user_id,email,password,first_names,last_name,url,registration_date,registration_ip, user_state) 
+values 
+($new_user_id,[ns_dbquotevalue $email],[ns_dbquotevalue $password_for_database],[ns_dbquotevalue $first_names],[ns_dbquotevalue $last_name],[ns_dbquotevalue $user_url], sysdate(), '[ns_conn peeraddr]', 'authorized')"
+
+
+
+# let's look for other required tables
+
+set insert_statements_sup ""
+
+set other_tables [ad_parameter_all_values_as_list RequiredUserTable]
+foreach table_name $other_tables {
+    lappend insert_statements_sup "insert into $table_name (user_id) values ($new_user_id)"
+}
+
+set double_click_p 0
+
+if [catch { ns_db dml $db "begin transaction"
+            ns_db dml $db $insert_statement
+    } errmsg] {
+	# if it was not a double click, produce an error
+	if { [database_to_tcl_string $db "select count(user_id) from users where user_id = $new_user_id"] == 0 } {
+	    ad_return_error "Insert Failed" "We were unable to create your user record in the database.  Here's what the error looked like:
+<blockquote>
+<pre>
+$errmsg
+</pre>
+</blockquote>"
+return 
+       } else {
+	   # assume this was a double click
+	   set double_click_p 1
+       }
+   }
+
+
+
+if { $double_click_p == 0 } {
+    if [catch { 
+	foreach statement $insert_statements_sup {
+	    ns_db dml $db $statement
+	}
+	ns_db dml $db "end transaction"
+    } errmsg] {
+	ad_return_error "Insert Failed" "We were unable to create your user record in the database.  Here's what the error looked like:
+<blockquote>
+<pre>
+$errmsg
+</pre>
+</blockquote>"
+return
+    }
+}
+
+
+#This is the email of the person adding the new user
+set selection [ns_db 1row $db "select email as admin_email, first_names as admin_first_names, last_name as admin_last_name from users where user_id = '$user_id'"]
+set_variables_after_query
+
+
+if { !$double_click_p } {
+    set rowid [database_to_tcl_string $db "select rowid from users where user_id = $new_user_id"]
+    # the user has to come back and activate their account
+    ns_sendmail  "$email" "$admin_email" "Welcome to [ad_system_name]" "$admin_first_names $admin_last_name has added you as a user of [ad_system_name] and a member of $group_name.  To confirm your registration, please go to [ad_parameter SystemURL]/register/email-confirm.tcl?[export_url_vars rowid]
+
+Your password is '$password'  Please change this the first time you log in."
+}
+
+
+ad_user_group_user_add $db $new_user_id $role $group_id
+
+
+set return_string "
+[ad_header "Add User @ [ad_system_name]"]
+
+<h2> Confirm Add User for $group_name</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$group_name Home"] [list "../" "Administration"] [list "" Users] "Add a New User"]
+
+<hr>
+<blockquote>
+
+$first_names $last_name has been added to $group_name.
+
+<p>
+
+You may now
+<a href=\"one.tcl?user_id=$new_user_id\">
+View User Information</a> for $first_names $last_name
+or
+<a href=\"\">Return to the Users Page</a>
+</blockquote>
+
+[ad_footer]
+"
+
+ns_return 200 text/html $return_string
+
Index: web/openacs/www/education/util/users/add-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/users/add-new.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/users/add-new.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,143 @@
+#
+# /www/education/util/users/add-new.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page allows the admin to select the correct role for the
+# user and it also checks to make sure the user is not already in
+# the system
+#
+
+ad_page_variables {
+    email
+    first_names
+    last_name
+    {user_url ""}
+}
+
+
+set db [ns_db gethandle]
+
+set group_pretty_type [edu_get_group_pretty_type_from_url]
+
+# right now, the proc above is only set up to recognize type 
+# group and department and the proc must be changed if this page
+# is to be used for URLs besides those.
+
+if {[empty_string_p $group_pretty_type]} {
+    ns_returnnotfound
+    return
+} else {
+
+    if {[string compare $group_pretty_type class] == 0} {
+	set id_list [edu_user_security_check $db]
+    } else {
+	# it is a department
+	set id_list [edu_group_security_check $db edu_department]
+    }
+}
+
+
+set user_id [lindex $id_list 0]
+set group_id [lindex $id_list 1]
+set group_name [lindex $id_list 2]
+
+
+set exception_text ""
+set exception_count 0
+
+set list_to_check [list [list email email] [list first_names "first name"] [list last_name "last name"]]
+
+foreach item $list_to_check {
+    if {[empty_string_p [set [lindex $item 0]]]} {
+	incr exception_count
+	append exception_text "<li>You must provide the user's [lindex $item 1]\n"
+    }
+}
+
+
+if {[string compare $user_url "http://"] == 0} {
+    set user_url ""
+}
+
+set email [string trim $email]
+
+if {![philg_email_valid_p $email]} {
+    incr exception_count
+    append exception_text "<li>The email address that you typed doesn't look right to us.  Examples of valid email addresses are 
+<ul>
+<li>Alice1234@aol.com
+<li>joe_smith@hp.com
+<li>pierre@inria.fr
+</ul>
+"
+}
+
+
+if {![empty_string_p $user_url] && ![philg_url_valid_p $user_url] } {
+    # there is a URL but it doesn't match our REGEXP
+    incr exception_count
+    append exception_text "<li>You URL doesn't have the correct form.  A valid URL would be something like \"http://photo.net/philg/\"."
+}
+
+
+# see if the email address is already in use
+# make it so that it is not case sensitive
+set used_email [database_to_tcl_string_or_null $db "select email from users where lower(email) = lower('$email')"]
+
+if {![empty_string_p $used_email]} {
+
+    #if this is the case, bounce the person over so that it is like they
+    #performed the search on the user.
+    set selection [ns_db 1row $db "select user_id as user_id_to_add, first_names, last_name, deleting_user, banning_user from users where lower(email) = lower ('$email')"]
+    set_variables_after_query
+
+    if { [empty_string_p $banning_user] && [empty_string_p $deleting_user] } {
+	ns_returnredirect user-add-3.tcl?[export_url_vars user_id_to_add first_names last_name user_url]
+	return
+    } else {
+	# This user was deleted or banned
+	incr exception_count
+	append exception_text "<li>User $email was deleted or banned.\n"
+    }
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+#NOW THAT THE AUTHORIZATION IS TAKEN CARE, GET OF THE ROLE
+
+set return_string "
+[ad_header "$group_name @ [ad_system_name]"]
+
+
+<h2>Select Roles for $first_names $last_name</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$group_name Home"] [list "../" "Administration"] [list "" Users] "Add a New User"]
+
+<hr>
+
+
+<form method=post action=\"add-new-2.tcl\">
+[export_entire_form]
+
+<blockquote>
+
+[edu_group_user_role_select_widget $db role $group_id ""]
+
+<p>
+<input type=submit name=action value=\"Continue\">
+
+</form>
+</blockquote>
+
+[ad_footer]
+"
+
+ns_db releasehandle $db 
+
+ns_return 200 text/html $return_string
Index: web/openacs/www/education/util/users/add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/users/add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/users/add.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,95 @@
+#
+# /www/education/util/users/add.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page allows the admin to input information about the user
+# they want to add to the group
+#
+
+set group_pretty_type [edu_get_group_pretty_type_from_url]
+
+# right now, the proc above is only set up to recognize type 
+# class and department and the proc must be changed if this page
+# is to be used for URLs besides those.
+
+if {[empty_string_p $group_pretty_type]} {
+    ns_returnnotfound
+    return
+} else {
+
+    set db [ns_db gethandle]
+
+    if {[string compare $group_pretty_type class] == 0} {
+	set id_list [edu_group_security_check $db edu_class "Manage Users"]
+    } else {
+	# it is a department
+	set id_list [edu_group_security_check $db edu_department]
+    }
+}
+	
+
+# gets the group_id.  If the user is not an admin of the group, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the group_id to make sure it is valid
+
+set user_id [lindex $id_list 0]
+set group_id [lindex $id_list 1]
+set group_name [lindex $id_list 2]
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "
+[ad_header "$group_name @ [ad_system_name]"]
+
+<h2>Add a New User</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$group_name Home"] [list "../" "Administration"] [list "" Users] "Add a User"]
+
+<hr>
+
+<blockquote>
+
+<form method=get action=\"add-2.tcl\">
+  Search through all registered [ad_system_name] users for someone to add:
+  <table>
+  <tr><th align=right>by Email Address <td><input type=text maxlength=100 size=30 name=email><BR>
+  <tr><th align=right>by Last Name <td><input type=text maxlength=100 size=30 name=last_name><BR>
+  <tr><td colspan=2 align=center><input type=submit value=\"Search For a User\"></td></tr>
+  </table>
+  </form>
+  <br>
+
+  <br>
+
+<form method=get action=\"add-new.tcl\">
+Or, input a new user into the system.
+  <table>
+    <tr>
+      <th align=right>New user's email address:</th>
+      <td><input type=text name=email size=30></td>
+    <tr>
+    <tr>
+      <th align=right>First name:</th>
+      <td><input type=text name=first_names size=20></td>
+    </tr>
+    <tr>
+      <th align=right>Last name:</th>
+      <td><input type=text name=last_name size=25></td>
+    </tr>
+    <tr>
+      <th align=right>Personal Home Page URL:  
+      <td><input type=text name=user_url size=50 value=\"http://\"></td>
+    </tr>
+    <tr>
+      <td align=center colspan=2><input type=submit name=action value=Continue></td>
+    </tr>
+  </table>
+</form>
+
+</blockquote>
+
+[ad_footer]
+"
+
+
Index: web/openacs/www/education/util/users/delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/users/delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/users/delete-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,96 @@
+#
+# /www/education/util/users/delete-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, February 2000
+#
+# this class allows the admin to remove the user from the 
+# user_group_map table
+#
+#
+# Note that deleting a user does not actually delete all of the user's
+# stuff.  It only deletes the person from the mapping table.  So, when
+# you list all items turned in, etc. you should still check and make
+# sure that the student is still part of the class
+#
+
+ad_page_variables {
+    user_id
+    first_names
+    last_name
+}
+
+validate_integer user_id $user_id
+
+set db [ns_db gethandle]
+
+set group_pretty_type [edu_get_group_pretty_type_from_url]
+
+# right now, the proc above is only set up to recognize type 
+# group and department and the proc must be changed if this page
+# is to be used for URLs besides those.
+
+if {[empty_string_p $group_pretty_type]} {
+    ns_returnnotfound
+    return
+} else {
+
+    if {[string compare $group_pretty_type class] == 0} {
+	set id_list [edu_group_security_check $db edu_class "Manage Users"]
+    } else {
+	# it is a department
+	set id_list [edu_group_security_check $db edu_department]
+    }
+}
+
+# gets the group_id.  If the user is not an admin of the group, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the group_id to make sure it is valid
+
+set group_id [lindex $id_list 1]
+set group_name [lindex $id_list 2]
+
+
+
+if {[empty_string_p $user_id]} {
+    ad_return_complaint 1 "<li>You must provide an user identificaiton number in order to delete an user."
+    return
+}
+
+
+# now, lets delete the user.  It does not matter if the user is a memeber
+# of the group or not because the delete has the same outcome either way
+# we want to delete the person from the group and from all of the teams
+# and sections the user was in.
+
+ns_db dml $db "delete from user_group_map 
+       where user_id = $user_id 
+         and (group_id = $group_id 
+              or group_id in (select group_id
+                              from user_groups 
+                              where parent_group_id = $group_id))"
+
+
+
+ns_db releasehandle $db 
+
+ns_return 200 text/html "
+[ad_header "Delete User"]
+
+
+<h2> User Deleted from $group_name</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$group_name Home"] [list "../" "Administration"] [list "" Users] "User Deleted"]
+
+<hr>
+<blockquote>
+$first_names $last_name has been removed from $group_name.
+<br>
+<br>
+You may now
+<a href=\"\">return to the users page</a>.
+</blockquote>
+
+[ad_footer]
+"
+
+
Index: web/openacs/www/education/util/users/delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/users/delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/users/delete.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,105 @@
+#
+# /www/education/util/users/delete.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, February 2000
+#
+# this class allows the admin to remove the user from the 
+# user_group_map table
+#
+# Note that deleting a user does not actually delete all of the user's
+# stuff.  It only deletes the person from the mapping table.  So, when
+# you list all items turned in, etc. you should still check and make
+# sure that the student is still part of the class
+
+ad_page_variables {
+    user_id
+}
+
+validate_integer user_id $user_id
+
+set db [ns_db gethandle]
+
+set group_pretty_type [edu_get_group_pretty_type_from_url]
+
+# right now, the proc above is only set up to recognize type 
+# group and department and the proc must be changed if this page
+# is to be used for URLs besides those.
+
+if {[empty_string_p $group_pretty_type]} {
+    ns_returnnotfound
+    return
+} else {
+
+    if {[string compare $group_pretty_type class] == 0} {
+	set id_list [edu_group_security_check $db edu_class "Manage Users"]
+    } else {
+	# it is a department
+	set id_list [edu_group_security_check $db edu_department]
+    }
+}
+
+# gets the group_id.  If the user is not an admin of the group, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the group_id to make sure it is valid
+
+set group_id [lindex $id_list 1]
+set group_name [lindex $id_list 2]
+
+
+set exception_count 0 
+set exception_text ""
+
+if {[empty_string_p $user_id]} {
+    incr exception_count 
+    append exception_text "<li>You must provide an user identificaiton number in order to delete an user."
+}
+
+
+set selection [ns_db 0or1row $db "select distinct users.user_id,
+         first_names, 
+         last_name, 
+         email,
+         url
+    from users,
+         user_group_map map 
+   where map.user_id=$user_id 
+     and map.user_id = users.user_id
+     and group_id = $group_id"]
+
+if { $selection == "" } {
+    incr exception_count
+    append exception_text "<li>The user identificaiton number provided was not valid.  Please select a valid id number."
+} else {
+    set_variables_after_query
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    # terminate execution of this thread (a goto!)
+    return
+}
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "
+[ad_header "$group_name @ [ad_system_name]"]
+
+<h2> Confirm User Removal</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$group_name Home"] [list "../" "Administration"] [list "" Users] "Delete User"]
+
+<hr>
+<ul>
+<li>Click OK to remove <u>$first_names $last_name</u> as an authorized user from $group_name.</li>
+</ul>
+<form method=post action=\"delete-2.tcl\">
+
+[export_form_vars user_id first_names last_name]
+
+<center><input type=submit value=\"OK\"></center>
+</form>
+
+[ad_footer]
+"
+
Index: web/openacs/www/education/util/users/password-update-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/users/password-update-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/users/password-update-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,117 @@
+#
+# /www/education/util/users/password-update-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page updates the user's password and tells the user it has done so
+#
+
+ad_page_variables {
+    password_1
+    password_2
+    user_id
+    first_names
+    last_name
+    {return_url ""}
+}
+
+validate_integer user_id $user_id
+
+set db [ns_db gethandle]
+
+set group_pretty_type [edu_get_group_pretty_type_from_url]
+
+# right now, the proc above is only set up to recognize type 
+# group and department and the proc must be changed if this page
+# is to be used for URLs besides those.
+
+if {[empty_string_p $group_pretty_type]} {
+    ns_returnnotfound
+    return
+} else {
+
+    if {[string compare $group_pretty_type class] == 0} {
+	set id_list [edu_group_security_check $db edu_class "Manage Users"]
+    } else {
+	# it is a department
+	set id_list [edu_group_security_check $db edu_department]
+    }
+}
+
+# gets the group_id.  If the user is not an admin of the group, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the group_id to make sure it is valid
+
+set group_id [lindex $id_list 1]
+set group_name [lindex $id_list 2]
+
+
+set exception_text ""
+set exception_count 0
+
+if {[empty_string_p $user_id]} {
+    incr exception_count
+    append exception_text "<li>You must provide an user identification number for this page to be displayed."
+}
+
+
+if { [empty_string_p $password_1] } {
+    append exception_text "<li>You need to type in a password\n"
+    incr exception_count
+}
+
+if { [empty_string_p $password_2] } {
+    append exception_text "<li>You need to confirm the password that you typed.  (Type the same thing again.) \n"
+    incr exception_count
+}
+
+
+if { [string compare $password_2 $password_1] != 0 } {
+    append exception_text "<li>Your passwords don't match!  Presumably, you made a typo while entering one of them.\n"
+    incr exception_count
+}
+
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+# If we are encrypting passwords in the database, do it now.
+if  [ad_parameter EncryptPasswordsInDBP "" 0] { 
+    set password_1 [ns_crypt $password_1 [ad_crypt_salt]]
+}
+
+set sql "update users set password = [ns_dbquotevalue $password_1] where user_id = $user_id"
+
+if [catch { ns_db dml $db $sql } errmsg] {
+    ad_return_error "Ouch!"  "The database choked on our update:
+<blockquote>
+$errmsg
+</blockquote>
+"
+} else {
+
+    if {[info exists return_url] && ![empty_string_p $return_url]} {
+	set return_url_var $return_url
+    } else {
+	set return_url_var "one.tcl?user_id=$user_id"
+    }
+
+    ns_return 200 text/html "[ad_header "$group_name @ [ad_system_name]"]
+
+<h2>Password Updated</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$group_name Home"] [list "../" Administration] [list "" Users] "Update Password"]
+
+<hr>
+<blockquote>
+
+You can return to <a href=\"$return_url_var\">$first_names $last_name</a>
+
+</blockquote>
+
+[ad_footer]
+"
+}
Index: web/openacs/www/education/util/users/password-update.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/users/password-update.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/users/password-update.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,138 @@
+#
+# /www/education/util/users/password-update.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this lets an admin update a user's password
+#
+
+ad_page_variables {
+    user_id
+    {return_url ""}
+}
+
+validate_integer user_id $user_id
+
+set db [ns_db gethandle]
+
+set exception_count 0 
+set exception_text ""
+
+if {[empty_string_p $user_id]} {
+    incr exception_count 
+    append exception_text "<li>You must provide an user identificaiton number in order to delete an user."
+}
+
+
+set group_pretty_type [edu_get_group_pretty_type_from_url]
+
+# right now, the proc above is only set up to recognize type 
+# group and department and the proc must be changed if this page
+# is to be used for URLs besides those.
+
+if {[empty_string_p $group_pretty_type]} {
+    ns_returnnotfound
+    return
+} else {
+
+    if {[string compare $group_pretty_type class] == 0} {
+	set id_list [edu_group_security_check $db edu_class "Manage Users"]
+    } else {
+	# it is a department
+	set id_list [edu_group_security_check $db edu_department]
+    }
+}
+
+# gets the group_id.  If the user is not an admin of the group, it
+# displays the appropriate error message and returns so that this code
+# does not have to check the group_id to make sure it is valid
+
+set group_id [lindex $id_list 1]
+set group_name [lindex $id_list 2]
+
+
+# lets make sure the user is in this group
+
+set selection [ns_db 0or1row $db "select distinct first_names, 
+         last_name, 
+         email,
+         url
+    from users,
+         user_group_map map 
+   where map.user_id=$user_id 
+     and map.user_id = users.user_id
+     and group_id = $group_id"]
+
+if { $selection == "" } {
+    incr exception_count
+    append exception_text "<li>The user identification number provided was not valid.  Please select a valid id number."
+} else {
+    set_variables_after_query
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    # terminate execution of this thread (a goto!)
+    return
+}
+
+
+if {[empty_string_p $return_url]} {
+    set return_url "one.tcl?user_id=$user_id"
+}
+
+
+set return_string "
+[ad_header "$group_name @ [ad_system_name]"]
+
+<h2>Update Password</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$group_name Home"] [list "../" Administration] [list "" Users] "Update Password"]
+
+<hr>
+<blockquote>
+
+<p>Type the new password. Type it again to Confirm, then click OK.</p>
+
+<form method=POST action=\"password-update-2.tcl\">
+  <table>
+[export_form_vars user_id first_names last_name return_url]
+    <tr>
+      <th align=right>Name:</th>
+      <td>$first_names $last_name</td>
+    </tr>
+    <tr>
+      <th align=right>Email:</th>
+      <td>$email</a>
+    </tr>
+    <tr>
+      <th align=right>Url:</th>
+      <td>[edu_maybe_display_text $url]</td>
+    </tr>
+      <th align=right>New password:</th>
+      <td align=left><input type=password name=password_1 size=15></td>
+    </tr>
+    <tr>
+      <th align=right>Confirm:</th>
+      <td align=left><input type=password name=password_2 size=15></td>
+    </tr>
+    <tr>
+      <td></td>
+      <td><input type=submit value=\"OK\"></td>
+  </table>
+</form>
+
+</blockquote>
+
+[ad_footer]
+"
+
+ns_db releasehandle $db 
+
+ns_return 200 text/html $return_string
+
+
+
+
+
+
Index: web/openacs/www/education/util/users/role-change-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/users/role-change-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/users/role-change-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,78 @@
+#
+# /www/education/util/users/role-change-2.tcl
+#
+# by randyg@arsdigita.com, aileen@mit.edu, Januray 2000
+#
+# this changes the user's role in the group
+#
+
+ad_page_variables {
+    {return_url ""}
+    role
+    user_id
+}
+
+validate_integer user_id $user_id
+
+set db [ns_db gethandle]
+
+set exception_text ""
+set exception_count 0
+
+if {[empty_string_p $user_id]} {
+    incr exception_count
+    append exception_text "<li>You must provide an employee identification number for this page to be displayed."
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+set group_pretty_type [edu_get_group_pretty_type_from_url]
+
+# right now, the proc above is only set up to recognize type 
+# group and department and the proc must be changed if this page
+# is to be used for URLs besides those.
+
+if {[empty_string_p $group_pretty_type]} {
+    ns_returnnotfound
+    return
+} else {
+
+    if {[string compare $group_pretty_type class] == 0} {
+	set id_list [edu_group_security_check $db edu_class "Manage Users"]
+    } else {
+	# it is a department
+	set id_list [edu_group_security_check $db edu_department]
+    }
+}
+
+set group_id [lindex $id_list 1]
+set group_name [lindex $id_list 2]
+
+ns_db dml $db "begin transaction"
+
+##### aileen: this page does not delete the user's previous roles from
+#### the group. a user should only have 1 role per group_id!
+ns_db dml $db "delete from user_group_map where user_id=$user_id and group_id=$group_id"
+
+
+# we do not check to see if the user is a member of the group because
+# if they are not, this proc will make them a user of the group
+
+ad_user_group_user_add $db $user_id $role $group_id
+
+ns_db dml $db "end transaction"
+ns_db releasehandle $db
+
+if {[info exists return_url] && ![empty_string_p $return_url]} {
+    ns_returnredirect $return_url
+} else {
+    ns_returnredirect "/education/class/admin/users/one.tcl?user_id=$user_id"
+}
+
+
+
Index: web/openacs/www/education/util/users/role-change.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/users/role-change.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/users/role-change.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,84 @@
+#
+# /www/education/util/users/role-change.tcl
+#
+# randyg@arsdigita.com, aileen@mit.edu, January 2000
+#
+# this page allows the admin to change the role of the given user
+#
+
+ad_page_variables {
+    user_id
+    {return_url ""}
+}
+
+validate_integer user_id $user_id    
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select first_names, last_name, email from users where users.user_id = $user_id"]
+
+if {$selection == ""} {
+    ad_return_complaint 1 "Invalid User ID" "The user identification number recieved by this page is not valid.  Please try accessing the page through a different method."
+    return
+} else {
+    set_variables_after_query
+}
+
+set group_pretty_type [edu_get_group_pretty_type_from_url]
+
+# right now, the proc above is only set up to recognize type 
+# group and department and the proc must be changed if this page
+# is to be used for URLs besides those.
+
+if {[empty_string_p $group_pretty_type]} {
+    ns_returnnotfound
+    return
+} else {
+
+    if {[string compare $group_pretty_type class] == 0} {
+	set id_list [edu_group_security_check $db edu_class "Manage Users"]
+    } else {
+	# it is a department
+	set id_list [edu_group_security_check $db edu_department]
+    }
+}
+
+set group_id [lindex $id_list 1]
+set group_name [lindex $id_list 2]
+
+
+set return_string "
+[ad_header "$group_name @ [ad_system_name]"]
+
+<h2>Change User's Role</h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$group_name Home"] [list "../" "Administration"] [list "" Users] "Change User's Role"]
+
+<hr>
+
+<blockquote>
+
+User name: $first_names $last_name
+
+<br>
+
+User email: $email
+
+<form method=get action=\"role-change-2.tcl\">
+
+[export_form_vars return_url user_id]
+
+[edu_group_user_role_select_widget $db role $group_id $user_id]
+
+<p>
+
+<input type=submit value=\"Change Role\">
+
+</form>
+</blockquote>
+
+[ad_footer]
+"
+
+ns_return 200 text/html $return_string
+
Index: web/openacs/www/education/util/users/search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/education/util/users/search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/education/util/users/search.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,211 @@
+# 
+# /www/education/util/users/user-search.tcl
+# 
+# by randyg@arsdigita.com, aileen@mit.edu January, 2000
+#
+# This file lists the users for a given class (group) that match the search criteria 
+# and divides them by role.  In addition, it allows the caller to show
+# only people with "emails beginning with" or "last name beginning with"
+#
+
+
+ad_page_variables {
+    {email ""}
+    {last_name ""}
+    {target_url "user-info.tcl"}
+    {type ""}
+    {target_url_params ""}
+    {section_id ""}
+}
+
+
+
+set db [ns_db gethandle]
+
+set group_pretty_type [edu_get_group_pretty_type_from_url]
+
+# right now, the proc above is only set up to recognize type 
+# group and department and the proc must be changed if this page
+# is to be used for URLs besides those.
+
+if {[empty_string_p $group_pretty_type]} {
+    ns_returnnotfound
+    return
+} else {
+
+    if {[string compare $group_pretty_type class] == 0} {
+	set id_list [edu_user_security_check $db]
+    } else {
+	# it is a department
+	set id_list [edu_group_security_check $db edu_department]
+    }
+}
+
+
+set user_id [lindex $id_list 0]
+set group_id [lindex $id_list 1]
+set group_name [lindex $id_list 2]
+
+
+if {[string compare $type section_leader] == 0} {
+    set header_string "Select a Section Instructor"
+    set end_string ""
+    set nav_bar_value "Select Section Leader"
+    set instructions "To select a user, simply click on their name."
+    set var_name instructor_id
+    set sql_restriction "and role <> '[edu_get_student_role_string]'"
+
+} else {
+    set header_string "$group_name Users"
+    set end_string "<br><a href=\"add.tcl\">Add a User</a>"
+    set nav_bar_value "Users"
+    set instructions "To view information about a user, simply click on their name."
+    set var_name user_id
+    set sql_restriction ""
+}
+
+
+if {![empty_string_p $target_url_params]} {
+    set middle_char &
+    set target_url "$target_url?$target_url_params"
+} else {
+    set middle_char ?
+}
+
+
+set exception_count 0 
+set exception_html ""
+
+if { [empty_string_p $email] && [empty_string_p $last_name] } {
+    incr exception_count
+    append exception_html "<li>You need to search for a customer by either Last Name or Email\n"
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_html
+    # terminate execution of this thread (a goto!)
+    return
+}
+
+
+
+#lets strip the leading and trailing spaces off of the last_name and email
+regexp {[ ]*(.*[^ ])} $last_name match last_name
+regexp {[ ]*(.*[^ ])} $email match email
+
+
+set begin_query_string "select distinct users.user_id, first_names, last_name, email from users, user_group_map where user_group_map.group_id = $group_id and user_group_map.user_id = users.user_id"
+
+
+if {![empty_string_p $section_id]} {
+    append sql_restriction "and user_group_map.user_id not in (select user_id from user_group_map where group_id = $section_id and role = 'administrator')
+}
+
+
+
+### search by last_name and email
+if { ![empty_string_p $last_name] && ![empty_string_p $email] } {
+    set query_string "
+          and upper(last_name) like '%[DoubleApos [string toupper $last_name]]%'
+          and upper(email) like '%[DoubleApos [string toupper $email]]%'
+          and user_group_map.user_id = users.user_id
+          $sql_restriction
+     order by last_name, first_names"
+    set title "Users whose last name contains '$last_name' and email contains '$email'"
+}
+
+## search by email
+if { [empty_string_p $last_name] && ![empty_string_p $email] } {
+    set query_string "
+          and upper(email) like '%[DoubleApos [string toupper $email]]%'
+          and user_group_map.user_id = users.user_id
+          $sql_restriction
+     order by last_name, first_names"
+    set title "Users whose email contains '$email'"
+}
+
+## search by last_name
+if { ![empty_string_p $last_name] && [empty_string_p $email] } {
+    set query_string "
+          and upper(last_name) like '%[DoubleApos [string toupper $last_name]]%'
+          and user_group_map.user_id = users.user_id
+          $sql_restriction
+     order by last_name, first_names"
+    set title "Users whose last name contains '$last_name'"
+}
+
+
+append html "
+[ad_header "Add a [capitalize $group_pretty_type] Member @ [ad_system_name]"]
+<h2> $header_string </h2>
+
+[ad_context_bar_ws_or_index [list "../../one.tcl" "$group_name Home"] [list "../" "Administration"] [list "" Users] $nav_bar_value"]
+
+<hr>
+<blockquote>
+"
+
+set counter 0
+
+set selection [ns_db select $db "$begin_query_string $query_string"]
+
+set text ""
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    
+    if {$counter == 0} {
+	append text "
+	<table>
+	<tr><td><B>Name</b></td><td><B>Email</b></td></tr>
+	"
+    }
+
+    incr counter
+
+    append text "
+    <tr>
+    <td><a href=\"$target_url${middle_char}${var_name}=$user_id\">$last_name, $first_names</a>
+    </td>
+    <td>
+    $email
+    </td>
+    </tr>
+    "
+}
+
+
+if { $counter > 0 } {
+    append html "
+    $title:
+    <ul>
+    $text
+    </table>
+    <br><br>
+    </ul>
+    $instructions
+    "
+} else {
+    append html "
+    We found no matches to your query for $title, 
+    please check your information again \n
+    "
+}
+
+
+append html "
+<br>
+$end_string
+</blockquote>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $html
+
+
+
+
+
+
Index: web/openacs/www/events/activity.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/activity.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/activity.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,162 @@
+set_the_usual_form_variables 0
+
+# activity_id
+
+validate_integer_or_null activity_id $activity_id
+
+if { ![info exists activity_id] || $activity_id == "" } {
+    ns_return 200 text/html "[ad_header "No activity id"]
+
+<h2>No activity id</h2>
+
+specified for [ad_system_name]
+
+<hr>
+
+We can't tell you what this activity is going to be like because this
+request came in with no activity id.  Please notify the maintainer of
+the preceding page.
+
+[ad_footer]
+"
+    return
+}
+
+validate_integer activity_id $activity_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select 
+a.short_name, a.description, a.detail_url, a.available_p
+from events_activities a
+where activity_id = $activity_id"]
+
+if { $selection == "" } {
+    ns_db releasehandle $db
+    ns_return 200 text/html "[ad_header "Could not find activity"]
+
+<h2>Could not find activity</h2>
+
+in [ad_system_name]
+
+<hr>
+
+We can't tell you what this activity is going to be like because we
+can't find activity $activity_id in the database.  Please notify the
+maintainer of the preceding page.
+
+[ad_footer]
+"
+    return
+}
+
+# we have a valid activity id
+
+set_variables_after_query
+
+# we have all the description info from the RDBMS
+
+if { $available_p == "f" } {
+    ns_db releasehandle $db
+    # activity has been discontinued
+     ns_return 200 text/html "[ad_header "Activity Discontinued"]
+
+<h2>Activity Discontinued</h2>
+
+in [ad_system_name]
+
+<hr>
+
+$short_name is no longer available.  You're
+probably using an old bookmarked page.
+
+[ad_footer]
+"
+    return
+}
+
+# we're here and we've got all the relevant stuff
+
+if [regexp -nocase {^http://.*} $detail_url] {
+    ns_log Notice "event.tcl trying to fetch $detail_url"
+    # we have to go to a foreign server to get the stuff
+    if [catch { set raw_foreign_page [ns_httpget $detail_url] } errmsg] {
+	# we got an error fetching the page
+	ns_log Notice "event.tcl failed to get $detail_url for event "
+    } else {
+	regexp -nocase {<body>(.*)</body>} $raw_foreign_page match fancy_promo_text
+    }
+} 
+
+if { ![info exists fancy_promo_text] && ![regexp -nocase {^http://.*} $detail_url] } {
+    ns_log Notice "event.tcl trying to pull $detail_url from the local file system"
+    # let's try to pull it from our file system
+    if [catch { append full_file_name [ns_info pageroot] $detail_url
+                set stream [open $full_file_name r]
+                set raw_local_page [read $stream]
+                close $stream
+              } errmsg] {
+	# we got an error fetching the page
+	ns_log Notice "event.tcl failed to read $full_file_name for event "
+    } else {
+	regexp -nocase {<body[^>]*>(.*)</body>} $raw_local_page match fancy_promo_text
+    }
+}
+
+if { ![info exists fancy_promo_text] } {
+    # let's construct a generic page from what was in the database
+    set fancy_promo_text "<h2>$short_name</h2>
+<hr>
+$description
+"
+
+ns_db releasehandle $db
+
+set db_pools [ns_db gethandle subquery 2]
+set db [lindex $db_pools 0]
+set db_sub [lindex $db_pools 1]
+
+# let's display the upcoming events for this activity
+set selection [ns_db select $db "select 
+e.event_id, 
+v.city, 
+v.usps_abbrev, 
+v.iso,
+e.start_time, 
+to_char(e.start_time,'fmDay') as pretty_day,
+to_char(e.start_time,'HH12:MI AM') as pretty_start_hour_minute
+from events_events e, events_activities a, events_venues v
+where a.activity_id = e.activity_id
+and a.activity_id = $activity_id
+and e.start_time > sysdate()
+and e.available_p <> 'f'
+and v.venue_id = e.venue_id
+order by e.start_time"]
+    set table_rows ""
+    while { [ns_db getrow $db $selection] } {
+	set_variables_after_query
+	append table_rows "
+	<tr>
+	 <td><a href=\"order-one.tcl?event_id=$event_id\">
+ 	 [events_pretty_location $db_sub $city $usps_abbrev $iso]</a>
+         <td>$pretty_day, [util_AnsiDatetoPrettyDate $start_time]\n"
+    }
+    if ![empty_string_p $table_rows] {
+    append fancy_promo_text "
+<h3>Upcoming Events</h3>
+<table cellspacing=15>
+$table_rows
+</table>\n"
+    }
+}
+
+ns_db releasehandle $db
+ns_db releasehandle $db_sub
+
+ReturnHeaders
+
+ns_write "[ad_header "$short_name"]
+
+$fancy_promo_text
+[ad_footer]
+"
Index: web/openacs/www/events/download.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/download.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/download.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,18 @@
+# Download a file
+
+set_the_usual_form_variables 
+# file_id
+
+validate_integer file_id $file_id
+
+set db [ns_db gethandle]
+set file_type [database_to_tcl_string $db \
+	"select file_type
+           from events_file_storage
+          where file_id=$file_id"]
+
+ReturnHeaders $file_type
+
+ns_ora write_blob $db "select file_content 
+                       from   events_file_storage
+                       where  file_id=$file_id" 
Index: web/openacs/www/events/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/index.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,154 @@
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+#collect the whole page
+set whole_page "[ad_header "[ad_system_name] Events"]
+
+<h2>[ad_system_name] Events</h2>
+
+[ad_context_bar_ws "Events"]
+
+<hr>
+
+<ul>
+"
+
+set db_pools [ns_db gethandle subquery 2]
+set db [lindex $db_pools 0]
+set db_sub [lindex $db_pools 1]
+
+
+set selection [ns_db select $db "select
+  evnt.event_id, 
+  evnt.start_time, 
+  to_char(evnt.start_time,'fmDay') as pretty_day,
+  to_char(evnt.start_time,'HH12:MI AM') as pretty_start_hour_minute,
+  evnt.activity_id,
+  act.short_name,
+  v.city,
+  v.usps_abbrev,
+  v.iso
+from events_events evnt, events_activities act, 
+user_groups grps, events_venues v
+where evnt.reg_deadline > sysdate()
+and act.activity_id = evnt.activity_id
+and act.group_id is null
+and v.venue_id = evnt.venue_id
+and evnt.available_p <> 'f'
+order by upper(group_name), evnt.start_time, v.city
+"]
+
+set event_count 0
+
+append whole_page "<h4>[ad_system_name] Events</h4><table>"
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append whole_page "
+    <tr>
+     <td><a href=\"order-one.tcl?event_id=$event_id\">$short_name</a> &nbsp;
+     <td valign=top>[events_pretty_location $db_sub $city $usps_abbrev $iso]
+     <td>$pretty_day, [util_AnsiDatetoPrettyDate $start_time]
+    "
+    incr event_count
+}
+
+append whole_page "</table>"
+    
+
+
+set selection [ns_db select $db "select 
+  evnt.event_id, 
+  evnt.start_time, 
+  to_char(evnt.start_time,'fmDay') as pretty_day,
+  to_char(evnt.start_time,'HH12:MI AM') as pretty_start_hour_minute,
+  evnt.start_time as full_datetime,
+  evnt.activity_id,
+  act.short_name,
+  grps.group_name,
+  v.city,
+  v.usps_abbrev,
+  v.iso
+from events_events evnt, events_activities act, user_groups grps, events_venues v
+where evnt.start_time > sysdate()
+and act.activity_id = evnt.activity_id
+and grps.group_id = act.group_id
+and v.venue_id = evnt.venue_id
+and evnt.available_p <> 'f'
+order by upper(group_name), evnt.start_time, v.city"]
+
+
+#order by upper(group_name), decode(usrs.last_name,'Tufte',0,1), upper(usrs.last_name), upper(usrs.first_names), lecs.start_time"]
+
+
+#set last_organizer ""
+set last_group ""
+set first_iteration_p 1
+set last_city_state ""
+set last_activity_id ""
+
+while { [ns_db getrow $db $selection] } {
+    incr event_count
+    set_variables_after_query
+
+    if {![exists_and_not_null group_name]} {
+	set group_name "Public"
+    }
+
+    if { $last_group != $group_name } {
+	if !$first_iteration_p {
+	    append whole_page "</table>"
+	}
+	append whole_page "<h4>$group_name</h4><table>"
+	#append whole_page "<h4>$organizer_name</h4><table>"
+	
+	set last_group $group_name
+	#set last_organizer $organizer_name
+        set last_city_state ""
+        set need_separation_p 0
+    } else {
+	# another row from the same organizer, so we'll need
+	# a separator row if we move to a new city	
+	set need_separation_p 1
+    }
+    
+
+    set city_state [events_pretty_location $db_sub $city $usps_abbrev $iso]
+    
+    set last_activity_id $activity_id
+    if $need_separation_p {
+	# print a separator row
+	append whole_page "<tr><td colspan=3>&nbsp;</tr>\n"
+    }
+    # print most of the row but leave the last cell open
+    append whole_page "<tr>
+    <td><a href=\"order-one.tcl?event_id=$event_id\">$short_name</a> &nbsp;
+    <td valign=top>$city_state
+    <td>$full_datetime
+    "
+    
+    if { [string match "*PM*" $pretty_start_hour_minute] } {
+	# starts in the afternoon
+	append whole_page " at [string trimleft $pretty_start_hour_minute "0"]\n"
+    }
+    set last_city_state $city_state
+    set first_iteration_p 0
+}
+
+if !$first_iteration_p {
+    append whole_page "</table>"
+}
+
+
+
+if {$event_count == 0} {
+    append whole_page "<li>There are no events currently available."
+}
+
+append whole_page "</ul>
+[ad_footer]"
+
+ns_db releasehandle $db
+ns_db releasehandle $db_sub
+
+ReturnHeaders
+ns_write $whole_page
Index: web/openacs/www/events/order-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/order-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/order-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1 @@

\ No newline at end of file
Index: web/openacs/www/events/order-cancel-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/order-cancel-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/order-cancel-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,52 @@
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_the_usual_form_variables
+#reg_id
+
+validate_integer reg_id $reg_id
+
+set db [ns_db gethandle]
+
+
+
+set selection [ns_db 0or1row $db "select 1 from
+events_registrations
+where reg_id = $reg_id
+and user_id = $user_id
+"]
+
+if {[empty_string_p $selection]} {
+    ns_db releasehandle $db
+    ReturnHeaders
+    ns_write "
+    [ad_header "Could not find registration"]
+    <h2>Could not find Registration</h2>
+    [ad_context_bar_ws [list "index.tcl" "Events"] Register]
+    <hr>
+    Registration $reg_id was not found in the database or does not belong
+    to you.
+
+    [ad_footer]"
+
+    return
+}
+
+ns_db dml $db "update events_registrations
+set reg_state = 'canceled'
+where reg_id = $reg_id"
+
+#collect the page for output
+set whole_page "[ad_header "Registration Canceled"]
+<h2>Registration Canceled</h2>
+[ad_context_bar_ws [list "index.tcl" "Events"] Register]
+<hr>
+Your registration has been canceled.
+<p>
+<a href=\"index.tcl\">Return to events</a>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+ReturnHeaders
+ns_write $whole_page
\ No newline at end of file
Index: web/openacs/www/events/order-cancel.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/order-cancel.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/order-cancel.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,59 @@
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_the_usual_form_variables
+#reg_id
+
+validate_integer reg_id $reg_id
+
+set db [ns_db gethandle]
+
+ReturnHeaders
+
+set selection [ns_db 0or1row $db "select r.user_id, a.short_name,
+p.event_id
+from events_registrations r, events_activities a, events_events e,
+events_prices p
+where r.reg_id = $reg_id
+and r.user_id = $user_id
+and e.event_id = p.event_id
+and p.price_id = r.price_id
+and a.activity_id = e.activity_id"]
+
+if {[empty_string_p $selection]} {
+    ns_db releasehandle $db
+    ns_write "
+    [ad_header "Could not find registration"]
+    <h2>Could not find registration</h2>
+    [ad_context_bar_ws [list "index.tcl" "Events"] Register]
+    <hr>
+    Registration $reg_id was not found in the database or does not belong
+    to you.
+
+    [ad_footer]"
+
+    return
+}
+
+set_variables_after_query
+
+#collect the page for output
+set whole_page "
+[ad_header "Cancel Registration"]
+<h2>Cancel Registration for $short_name</h2>
+[ad_context_bar_ws [list "index.tcl" "Events"] Register]
+<hr>
+<form method=post action=\"order-cancel-2.tcl\">
+[export_form_vars reg_id]
+Are you sure that you want to cancel this registration for
+[events_pretty_event $db $event_id]?
+<p>
+<center>
+<input type=submit value=\"Yes, Cancel Registration\">
+</center>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+ReturnHeaders
+ns_write $whole_page
\ No newline at end of file
Index: web/openacs/www/events/order-check.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/order-check.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/order-check.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,105 @@
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_the_usual_form_variables
+# we expect to get one argument:  reg_id
+
+validate_integer reg_id $reg_id
+
+if {![exists_and_not_null reg_id] } {
+    ns_return 200 text/html "[ad_header "No registration id"]
+
+<h2>No registration id</h2>
+[ad_context_bar_ws [list "index.tcl" "Events"] Register]
+<hr>
+
+Registration id needed.  This request came in with no
+registration id.
+
+[ad_footer]
+"
+    return
+}
+
+set db [ns_db gethandle]
+
+# We will only give them reg_state for the privacy of
+# the customers (i.e. we don't want to return a customer's
+# name if somebody is typing in random reg id's).
+set selection [ns_db 0or1row $db "select r.reg_state, 
+p.event_id, 
+r.user_id, a.short_name
+from events_registrations r, events_activities a, events_events e,
+events_prices p
+where r.reg_id = $reg_id
+and r.user_id = $user_id
+and e.event_id = p.event_id
+and p.price_id = r.price_id
+and a.activity_id = e.activity_id
+"]
+
+
+if { $selection == "" } {
+     ns_return 200 text/html "[ad_header "Could not find registration"]
+
+<h2>Could not find registration</h2>
+[ad_context_bar_ws [list "index.tcl" "Events"] Register]
+<hr>
+
+Registration $reg_id was not found in the database or does not belong
+to you.
+
+[ad_footer]
+"
+    return
+}
+
+# we have a valid reg id
+
+set_variables_after_query
+
+#collect the whole page for output
+set whole_page "[ad_header "Status of Registration"]
+
+<h2>Status of Registration for $short_name</h2>
+[ad_context_bar_ws [list "index.tcl" "Events"] Register]
+<hr>
+"
+
+if {$reg_state == "canceled"} {
+    set status_sentence "Your registration has been canceled.  If you want, you
+    may <a href=\"order-one.tcl?event_id=$event_id\">place a new registration</a>."    
+} elseif { $reg_state == "shipped" } {
+    set selection [ns_db 1row $db "select
+    display_after, v.description, v.venue_name
+    from events_events e, events_venues v
+    where v.venue_id = e.venue_id
+    and e.event_id = $event_id"]
+    
+    set_variables_after_query
+
+    set status_sentence "Your place is reserved.
+    <p>
+    $display_after
+    <h3>Directions to $venue_name</h3>
+    $description
+"
+} elseif { $reg_state == "pending" } {
+    set status_sentence "We have received your registration and are currently
+    reviewing it to decide if it will be approved.  We will notify you
+    by e-mail once your registrating status changes."
+} elseif { $reg_state == "waiting" } {
+    set status_sentence "You are on the waiting list for this event.  We will
+    notify you by e-mail if your registration status changes."
+}
+
+append whole_page "
+
+$status_sentence
+
+[ad_footer]
+"
+
+ns_db releasehandle $db
+ReturnHeaders
+ns_write $whole_page
\ No newline at end of file
Index: web/openacs/www/events/order-one-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/order-one-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/order-one-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,393 @@
+set_the_usual_form_variables
+# reg_id, event_id, price_id, bunch of user-entered stuff, order_id
+
+validate_integer reg_id $reg_id
+validate_integer event_id $event_id
+validate_integer price_id $price_id
+validate_integer order_id $order_id
+
+#force ssl
+#events_makesecure 
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+
+#check to see if this person has already registered
+set selection [ns_db 0or1row $db "select 
+reg_id, reg_date, reg_cancellable_p
+from events_registrations r, events_prices p,
+events_events e
+where p.price_id = r.price_id
+and p.event_id=$event_id
+and r.user_id=$user_id
+and e.event_id = $event_id
+and reg_state <> 'canceled'
+"]
+
+if {![empty_string_p $selection]} {
+    set_variables_after_query
+    #he's already registered
+
+    ns_db releasehandle $db
+    ReturnHeaders
+    ns_write "
+    [ad_header "Already Registered"]
+    <h2>Already Registered</h2>
+    <a href=\"index.tcl\">[ad_system_name] events</a> 
+    <hr>
+    You have already registered for this event on 
+    [util_AnsiDatetoPrettyDate $reg_date].
+    <p>
+    If you'd like, you may:
+    <ul>
+    <li><a href=\"order-check.tcl?[export_url_vars reg_id]\">Review your registration</a>
+"
+if {$reg_cancellable_p == "t"} {
+    ns_write "
+    <li><a href=\"order-cancel.tcl?[export_url_vars reg_id]\">Cancel your registration</a>"
+}
+
+ns_write "
+    </ul>
+    [ad_footer]"
+    return;
+}
+
+# check for errors
+
+set exception_count 0
+set exception_text ""
+
+if { ![info exists phone_number] || [string compare $phone_number ""] == 0 } {
+    incr exception_count 
+    append exception_text "<li>You forgot to enter your telephone number\n"
+}
+
+if { [info exists attending_reason] && [string length $attending_reason] > 4000 } {
+    incr exception_count 
+    append exception_text "<li>Please limit your reason for attending to 4000 characters.\n"
+}
+
+
+if { [info exists where_heard] && [string length $where_heard] > 4000 } {
+    incr exception_count 
+    append exception_text "<li>Please keep where you heard about this activity to less than 4000 characters.\n"
+}
+
+if { ![info exists line1] || [string compare $line1 ""] == 0 } {
+    incr exception_count 
+    append exception_text "<li>You forgot to enter your address\n"
+}
+
+if { ![info exists city] || [string compare $city ""] == 0 } {
+    incr exception_count 
+    append exception_text "<li>You forgot to enter your city\n"
+}
+
+if {$country_code == "us" && ![exists_and_not_null state]} {
+    incr exception_count 
+    append exception_text "<li>You forgot to enter your state\n"
+
+}
+
+#reallocate the handles now that we're done with ad_headers
+ns_db releasehandle $db
+set db_pools [ns_db gethandle subquery 2]
+set db [lindex $db_pools 0]
+set db_sub [lindex $db_pools 1]
+
+
+set selection [ns_db 0or1row $db "select
+a.short_name, 
+a.activity_id,
+e.display_after, 
+e.start_time, 
+e.end_time,
+e.max_people as max_people,
+e.venue_id,
+v.description as venue_description,
+v.venue_name
+from events_events e, events_activities a, events_venues v
+where e.event_id = $event_id 
+and a.activity_id = e.activity_id
+and v.venue_id = e.venue_id
+"]
+
+
+if {[empty_string_p $selection]} {
+    incr exception_count
+    append exception_text "<li>We couldn't find this event in our database."
+} else {
+    # got a row back from the db
+    # set some Tcl vars for use below (bleah)
+    set_variables_after_query
+    set product_description "$short_name in 
+    [events_pretty_venue $db $venue_id]
+    from [util_AnsiDatetoPrettyDate $start_time] to
+    [util_AnsiDatetoPrettyDate $end_time]"
+}
+
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+#make sure these values exist
+if {![exists_and_not_null need_hotel_p]} {
+    set need_hotel_p "f"
+}
+if {![exists_and_not_null need_car_p]} {
+    set need_car_p "f"
+}
+if {![exists_and_not_null need_plane_p]} {
+    set need_plane_p "f"
+}
+
+set reg_state ""
+#register the user
+#if [catch {
+    ns_db dml $db "begin transaction"
+
+    #try to store the user's contact info
+    ns_db dml $db "update users_contact
+    set home_phone = '$QQphone_number',
+    ha_line1 = '$QQline1',
+    ha_line2 = '$QQline2', 
+    ha_city = '$QQcity', 
+    ha_state = '$state', 
+    ha_postal_code = '$QQpostal_code', 
+    ha_country_code = '$country_code'
+    where user_id = $user_id
+    "
+
+    if {[db_resultrows $db] == 0} {
+	ns_db dml $db "insert into users_contact
+	(user_id, home_phone, ha_line1, ha_line2, ha_city, ha_state, 
+	ha_postal_code, ha_country_code)
+	values
+	($user_id, '$QQphone_number', '$QQline1', '$QQline2',
+	'$QQcity', '$state','$QQpostal_code', 
+	'$country_code')"
+    }
+       
+    #create the order
+    ns_db dml $db "insert into events_orders
+    (order_id, user_id, ip_address)
+    values
+    ($order_id, $user_id, '[DoubleApos [ns_conn peeraddr]]')"
+
+    #create the registration
+
+    #need to lock the table for check registrations
+    ns_db dml $db "lock table events_registrations in exclusive mode"
+    
+    #make sure there is room for registration
+    set selection [ns_db 0or1row $db "select count(reg_id) as num_registered
+    from events_registrations r, events_prices p
+    where p.event_id = $event_id
+    and r.price_id = p.price_id"]
+    set_variables_after_query
+
+    if {![empty_string_p $max_people] && $num_registered >= $max_people} {
+	set reg_state "waiting"
+    } else {
+	set reg_state [database_to_tcl_string $db "select 
+	case when reg_needs_approval_p='t' then 'pending'
+	     when reg_needs_approval_p='f' then 'shipped' else 'shipped' end
+	from events_events where event_id = $event_id
+	"]
+    }
+
+    ns_db dml $db "insert into events_registrations
+    (reg_id, order_id, price_id, user_id, reg_state, org,
+    title_at_org, attending_reason, where_heard, need_hotel_p,
+    need_car_p, need_plane_p, reg_date)
+    values
+    ($reg_id, $order_id, $price_id, $user_id, '$reg_state',
+    '$QQorg', '$QQtitle_at_org', '$QQattending_reason', 
+    '$QQwhere_heard', '$need_hotel_p',
+    '$need_car_p', '$need_plane_p', [db_sysdate])"
+    
+    #store the custom fields
+    set column_name_list [database_to_tcl_list $db "
+    select column_name
+    from events_event_fields
+    where event_id = $event_id
+    order by sort_key"]
+
+    # doesn't need to be inside the loop
+    set table_name "event_"
+       append table_name $event_id; append table_name "_info"
+    # prepare for the coming foreach { append ... } loop
+    set columns_for_insert "("
+    set values_for_insert "("
+
+    foreach column_name $column_name_list {
+        append columns_for_insert "$column_name, "
+        append values_for_insert "'[set $column_name]', "
+    }
+    append columns_for_insert "user_id)"
+    append values_for_insert "$user_id)"
+
+    ns_db dml $db "insert into $table_name
+    $columns_for_insert
+    values
+    $values_for_insert"
+
+
+    #perhaps add the person to the event's user group and venue's user group
+    if {$reg_state == "shipped"} {
+	events_group_add_user $db $event_id $user_id
+	#venues_group_add_user $db $venue_id $user_id
+    }
+
+    ns_db dml $db "end transaction"
+#} err_msg] {
+#    ad_return_error "Database Error" "We were unable to 
+#    process you registration
+#    <p>$err_msg" 
+#    return
+#}
+
+#release the db handles for writing ad_header
+ns_db releasehandle $db
+ns_db releasehandle $db_sub
+
+set whole_page "[ad_header "Thanks for Registering"]"
+
+#get the db handle once more
+set db [ns_db gethandle]
+
+append whole_page "
+<h2>Register</h2>
+for <a href=\"activity.tcl?activity_id=$activity_id\"><i>$short_name</i></a>
+in [events_pretty_venue $db $venue_id]<br>
+
+<hr>
+"
+
+if {$reg_state == "waiting"} {
+    append whole_page "
+    Thank you for your registration.  Unfortunately, all spaces
+    for this event were filled before you placed your registration.
+    So, you have been placed on a waiting list.
+    <p>
+    We will e-mail you if you a space opens up for you.  
+    Thank you for your interest in $short_name.
+    "
+
+} elseif {$reg_state == "pending"} {
+    append whole_page "
+    Thank you for your registration.  This event requires final approval
+    for your registration from one of the event organizers.  You have
+    been placed on a registration queue, and we will notify you shortly
+    if your registration has been approved.  You will, in the mean time,
+    receive an e-mail confirming that we have received your
+    registration.
+    <p>
+    Thank you for your interest in $short_name.
+    "
+} else {
+    append whole_page "
+    Thank you for your registration--we have placed it in our
+    database.
+    $display_after
+    <h3>Directions to $venue_name</h3>
+    $venue_description"
+}
+
+#append whole_page "[ad_footer]"
+#ns_conn close
+
+# send email to the event's creator (high-volume sites will want to comment this out)
+set creator_email [database_to_tcl_string $db "select
+u.email from users u, events_events e
+where e.event_id = $event_id
+and u.user_id = e.creator_id"]
+
+set user_email [database_to_tcl_string $db "select
+email from users
+where user_id=$user_id"]
+
+set admin_subject "New reservation at [ad_parameter SystemURL]"
+set admin_body "$user_email reserved a  space for \n\n   $product_description \n\nat [ad_parameter SystemURL]" 
+
+if {$reg_state == "waiting"} {
+    append admin_body "
+
+    Since registration for this event is full, he has been placed on
+    a waiting list."
+} elseif {$reg_state == "pending"} {
+    append admin_body "
+
+    This event requires registrations to be approved.  Please come
+    either approve or deny the request for registration:
+
+    [ad_parameter SystemURL]/events/admin/reg-view.tcl?reg_id=$reg_id
+    "
+}
+
+
+if [catch { ns_sendmail $creator_email $creator_email $admin_subject $admin_body} errmsg] {
+    append whole_page "<p>failed sending email to $creator_email: $errmsg"
+    ns_log Error "failed sending email to $creator_email: $errmsg"
+} 
+
+if {$reg_state == "waiting"} {
+    set email_subject "Waiting list for $product_description"
+
+    set email_body "
+    You have been placed on the waiting list for
+    
+    $product_description
+    
+    We will e-mail you if a space opens up.
+    
+    If you would like to cancel your registration, you may visit
+    [ad_parameter SystemURL]/events/order-cancel.tcl?[export_url_vars reg_id]
+    "
+} elseif {$reg_state == "shipped"} {	
+    # send email to the registrant 
+    
+    set email_subject "directions to $product_description"
+    
+    set email_body "Your place is reserved in
+    
+    $product_description
+    
+    You'll get spammed with a reminder email a day or two before the 
+    event.
+    
+    $display_after
+    
+    Venue description and directions:
+
+    $venue_name\n
+
+    $venue_description\n
+    
+    If you would like to cancel your order, you may visit
+    [ad_parameter SystemURL]/events/order-cancel.tcl?[export_url_vars reg_id]
+    "
+} else {
+    set email_subject "Registration Received"
+    set email_body "We have received your request for registration for 
+
+    $product_description
+
+    We will notify you shortly if your registration is approved.
+    
+    If you would like to cancel your order, you may visit
+    [ad_parameter SystemURL]/events/order-cancel.tcl?[export_url_vars reg_id]
+    "
+}
+if [catch { ns_sendmail $user_email $creator_email $email_subject $email_body } errmsg] {
+    append whole_page "<p>failed sending confirmation email to customer: $errmsg"
+    ns_log Notice "failed sending confirmation email to customer: $errmsg"
+} 
+
+append whole_page "[ad_footer]"
+
+ns_db releasehandle $db
+ReturnHeaders
+ns_write $whole_page
Index: web/openacs/www/events/order-one.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/order-one.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/order-one.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,429 @@
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_the_usual_form_variables
+#event_id
+
+validate_integer event_id $event_id
+
+#events_makesecure 
+
+if {![exists_and_not_null event_id] } {
+    ns_return 200 text/html "[ad_header "No event id"]
+
+<h2>No event id</h2>
+
+specified for [ad_system_name]
+
+<hr>
+
+We can't build you an order form because this request came in with no
+event id.  Please hassle the person who built the preceding page.
+
+[ad_footer]
+"
+    return
+}
+
+validate_integer event_id $event_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "
+select 
+ha_line1, ha_line2, ha_city, ha_state,
+ha_postal_code, ha_country_code,
+home_phone,
+email,
+first_names || ' ' || last_name as user_name
+from users_contact uc, users u
+where u.user_id = uc.user_id
+and u.user_id = $user_id
+union
+select 
+null as ha_line1, null as ha_line2, null as ha_city, null as ha_state,
+null as ha_postal_code, null as ha_country_code,
+null as home_phone,
+email,
+first_names || ' ' || last_name as user_name
+from users u
+where 0=(select count(*) from users_contact where user_id= u.user_id)
+and u.user_id = $user_id
+"]
+set_variables_after_query
+
+if {[empty_string_p $ha_country_code]} {
+    set ha_country_code "us"
+}
+
+
+set selection [ns_db 0or1row $db "select 
+  a.short_name, 
+  v.city, 
+  v.usps_abbrev, 
+  v.iso,
+  v.venue_id,
+  e.start_time, 
+  e.end_time,
+  e.reg_deadline,
+  e.alternative_reg,
+  e.max_people as max_people,
+  e.reg_needs_approval_p,
+  to_char(e.start_time,'fmDay') as pretty_start_day, 
+  to_char(e.end_time,'fmDay') as pretty_end_day, 
+  to_char(e.reg_deadline,'fmDay') as pretty_reg_day, 
+  to_char(e.start_time,'HH12:MI AM') as pretty_start_hour_minute,
+  to_char(e.end_time,'HH12:MI AM') as pretty_end_hour_minute,
+  to_char(e.reg_deadline,'HH12:MI AM') as pretty_reg_hour_minute,
+  a.activity_id, 
+  a.description,
+  a.detail_url, 
+  e.available_p,
+  e.reg_cancellable_p
+from events_events e, events_activities a,  events_venues v
+where e.event_id = $event_id
+and e.available_p <> 'f'
+and a.activity_id = e.activity_id
+and v.venue_id = e.venue_id
+and sysdate() <= reg_deadline
+"]
+
+if { [empty_string_p $selection]} {
+     ns_return 200 text/html "[ad_header "Could not find event"]
+
+<h2>Could not find event</h2>
+
+in [ad_system_name]
+
+<hr>
+
+We can't build you an order form because event
+$event_id is not being offered.
+
+[ad_footer]
+"
+    return
+}
+
+# we have a valid event id
+set_variables_after_query
+
+# we have all the description info from the RDBMS
+
+if { $available_p == "f" } {
+    # event has been discontinued
+     ns_return 200 text/html "[ad_header "Event Discontinued"]
+
+<h2>Event Discontinued</h2>
+
+in [ad_system_name]
+
+<hr>
+
+This event for $short_name is no longer available.  You're
+probably using an old bookmarked page.
+
+[ad_footer]
+"
+    return
+}
+
+# OK, we're set now!
+
+# we generate a reg_id here so that we can trivially detect
+# duplicate submissions
+
+set reg_id [database_to_tcl_string $db "select events_reg_id_sequence.nextval from dual"]
+set order_id [database_to_tcl_string $db "select events_orders_id_sequence.nextval from dual"]
+
+#collect the whole page
+set whole_page "[ad_header "Register"]
+
+<h2>Register</h2>
+
+for <a href=\"activity.tcl?activity_id=$activity_id\"><i>$short_name</i></a>
+in [events_pretty_location $db $city $usps_abbrev $iso]<br>
+
+<hr>
+
+"
+
+set selection [ns_db 0or1row $db "select count(reg_id) as num_registered
+from events_registrations r, events_prices p
+where p.event_id = $event_id
+and r.price_id = p.price_id"]
+set_variables_after_query
+
+if {$reg_cancellable_p != "t"} {
+    append whole_page "<p><font color=red>Note: Registrations for this event cannot 
+    be canceled.  Once you register, you are committed to coming.</font>"
+}
+
+if {![empty_string_p $max_people]} {
+    if {$num_registered >= $max_people} {
+	append whole_page "<p><font color=red>Note: This event has already
+	received its maximum number of registrations.  If you register
+	for this event, you will be placed on a waiting list.</font>"
+    }
+}
+
+if {$reg_needs_approval_p == "t"} {
+    append whole_page "<p><font color=red>Note: A registration for this event
+    requires final approval from an administrator.  If you sign up
+    for $short_name, your final registration will be pending
+    administrator approval.</font>"
+}
+
+if { [string length $description] > 400 } {
+    append whole_page "<blockquote>
+In a hurry?  <a href=\"#aboutorder\">skip to the registration form</a>
+</blockquote>
+"
+}
+
+
+set target_url "order-one-2.tcl"
+set submit_button "Register"
+
+
+append whole_page "
+<form method=post action=\"$target_url\">
+[export_form_vars reg_id user_id order_id]
+
+<h3>About the Activity</h3>
+
+<ul>
+"
+
+if { ![empty_string_p $description] } {
+    append whole_page "<li>
+$description
+"
+}
+
+if { ![empty_string_p $detail_url] } {
+    append whole_page "<br><br>\n(<a href=\"$detail_url\">Related web-site</a>)"
+}
+
+append whole_page "<p><li>Start Date:  $pretty_start_day, [util_AnsiDatetoPrettyDate $start_time], [string trimleft $pretty_start_hour_minute "0"]
+<input type=hidden name=event_id value=$event_id>
+<li>End Date:  $pretty_end_day, [util_AnsiDatetoPrettyDate $end_time], [string trimleft $pretty_end_hour_minute "0"]
+<li><b>Registration Deadline</b>:  $pretty_reg_day, [util_AnsiDatetoPrettyDate $reg_deadline], [string trimleft $pretty_reg_hour_minute "0"]
+
+"
+
+append whole_page "<li>[events_pretty_location $db $city $usps_abbrev $iso]
+(you'll get specifics after you register)
+
+
+"
+
+set agenda_text "<li>Event Agendas:
+<ul>"
+
+set return_url "/events/order-one.tcl?event_id=$event_id"
+set on_which_table "events_events"
+set on_what_id "$event_id"
+
+set selection [ns_db select $db "select 
+file_title, file_id 
+from events_file_storage
+where on_which_table = '$on_which_table'
+and on_what_id = '$on_what_id'"]
+
+set agenda_counter 0
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append agenda_text "<li>
+    <a href=\"/attach-file/download.tcl?[export_url_vars file_id]\">
+    $file_title</a>\n"
+    
+    incr agenda_counter
+}
+if {$agenda_counter > 0} {
+    append agenda_text "\n</ul>"
+    append whole_page $agenda_text
+}
+
+append whole_page "\n</ul></ul>\n
+"
+
+#get the pricing info
+#<a name=\"aboutorder\">
+set order_html "
+
+<h3>About Your Order</h3>
+"
+set order_price_html "
+Please select the price for which you would like to register.
+<p>
+<table cellpadding=5>
+"
+
+set selection [ns_db select $db "select
+price_id,
+case when price= 0 then 'free'::char else price::float8::char end as a_price,
+description as product_name, expire_date
+from events_prices
+where event_id = $event_id
+order by price_id
+"]
+
+set price_count 0
+set get_credit_card_p 0
+
+set price_count 0
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    if {$a_price != "free"} {
+	set a_price "$[util_commify_number $a_price]"
+	set get_credit_card_p 1
+    }
+
+    if {$price_count == 0} {
+	append order_price_html "
+	<tr>
+	<td><input type=radio checked name=price_id value=$price_id>
+	$product_name: $a_price
+	"
+    } else {
+	append order_price_html "
+	<tr>
+	<td><input type=radio name=price_id value=$price_id>
+	$product_name: $a_price
+	"
+    }
+   
+    incr price_count
+}
+
+
+if {$get_credit_card_p} {
+    if {$price_count == 1} {
+	append whole_page $order_html
+	append whole_page "<li>Register for $product_name ($a_price)"
+	append whole_page "</table>
+	[philg_hidden_input price_id $price_id]
+	"
+    } elseif {$price_count >= 1} {
+	append whole_page $order_html
+	append whole_page $order_price_html
+	append whole_page "</table>"
+    }
+    
+    if {$price_count > 1} {
+	append whole_page "
+	<font color=red>If you register with a price for which you do
+	not qualify, you will still be charged that price.  But, you may 
+	be asked to leave the event.</font>"
+    }
+} else {
+    append whole_page "</table><ul><li>Cost: FREE</ul>
+    [philg_hidden_input price_id $price_id]"
+}
+
+
+append whole_page "
+<a name=\"aboutorder\">
+<h3>About You</h3>
+</a>
+
+<table>
+<tr>
+ <td>Name</td>
+ <td>$user_name
+<tr>
+ <td>Email</td>
+ <td>$email
+<tr>
+ <td>Telephone number</td>
+ <td><input type=text size=15 name=phone_number value=\"$home_phone\"></td>
+<tr>
+ <td valign=top>What is your organization?
+ <td><input type=text name=org size=30>
+<tr>
+ <td valign=top>What is your title or main job description?
+ <td><input type=text name=title_at_org size=50>
+<tr>
+ <td valign=top>Where did you hear<br>about this activity?<br>
+ <td><input type=text name=where_heard size=50>
+<tr>
+ <td valign=top>Reason for attending:<br>
+ <td><textarea name=attending_reason cols=40 rows=5 wrap=soft></textarea>
+<tr>
+ <td>Need a hotel?
+ <td><input type=checkbox name=need_hotel_p value=t>
+<tr>
+ <td>Need a rental car?
+ <td><input type=checkbox name=need_car_p value=t>
+<tr>
+ <td>Need a flight?
+ <td><input type=checkbox name=need_plane_p value=t>
+"    
+set selection [ns_db select $db "
+select column_name, pretty_name,
+column_type, column_actual_type, column_extra,
+sort_key
+from events_event_fields
+where event_id = $event_id
+order by sort_key
+"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    
+    append whole_page "
+    <tr>
+     <td>$pretty_name
+     <td>[ad_user_group_type_field_form_element $column_name $column_type]"
+}
+
+
+
+append whole_page "</table><h3>Mailing Address</h3>\n\n"
+
+
+append whole_page "
+<table>
+<tr>
+  <td>Line 1
+  <td><input type=text size=60 name=line1 value=\"$ha_line1\">
+<tr>
+  <td>Line 2
+  <td><input type=text size=60 name=line2 value=\"$ha_line2\">
+<tr>
+  <td>City
+  <td><input type=text size=15 name=city value=\"$ha_city\">
+      State <input type=text size=15 name=state value=\"$ha_state\">
+      Postal Code <input type=text size=10 name=postal_code value=\"$ha_postal_code\">
+<tr>
+  <td>Country
+  <td>[country_widget $db $ha_country_code]
+</table>
+
+
+"
+append whole_page "
+<br>
+<br>
+
+<center>
+<input type=submit value=\"$submit_button\">
+</center>
+</form>
+"
+
+#see if there is another way to register
+if {![empty_string_p $alternative_reg]} {
+    append whole_page "<p>
+    <h4>Alternative Registration</h4>
+    $alternative_reg"
+}
+
+append whole_page "
+[ad_footer]
+"
+
+ns_db releasehandle $db
+ReturnHeaders
+ns_write $whole_page
\ No newline at end of file
Index: web/openacs/www/events/order-search-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/order-search-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/order-search-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,62 @@
+# order-search-2.tcl,v 1.1.4.1 2000/02/03 09:48:43 ron Exp
+#
+# /order-search-2.tcl
+#
+# by michael@yoon.org, 1999-11-04
+#
+# quick and dirty search pages to make life easier when people
+# who claim never to have received confirmation by email call
+# to check on their reservations
+#
+
+set_the_usual_form_variables
+# last_name
+
+set last_name [string trim $last_name]
+
+set errmsg ""
+
+if { [empty_string_p $last_name] } {
+    set errmsg "no last name"
+} elseif { [regexp {%} $last_name match] } {
+    set errmsg "no percentage signs permitted in last name"
+}
+
+# ad_return_complaint doesn't exist on this server!
+
+if { ![empty_string_p $errmsg] } {
+    ReturnHeaders
+    ns_write $errmsg
+    return
+}
+
+set db [ctq_gethandle]
+
+ReturnHeaders
+
+ns_write "[ctq_header "Order Search Results"]
+
+<h2>Order Search Results for \"$last_name\"</h2>
+
+<hr>
+
+<table border=0 cellpadding=4>
+<tr><th>Order ID</th><th>Full Name</th><th>Talk</th><th>City</th><th>Date</th><th>Order State</th></tr>
+"
+
+set selection [ns_db select $db "select o.order_id, o.lecture_id, o.first_names || ' ' || o.last_name as full_name, t.detail_url, t.short_name as talk, l.city, to_char(l.start_time, 'Mon fmDD, YYYY') as talk_date, o.order_state, o.confirmed_date
+from ctq_orders o, ctq_lectures l, ctq_talks t
+where lower(o.last_name) like '%[string tolower $QQlast_name]%'
+and o.lecture_id = l.lecture_id
+and l.talk = t.talk_id"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    ns_write "<tr align=center><td><a href=\"order-check.tcl?[export_url_vars order_id]\">$order_id</a></td><td>$full_name</td><td><a href=\"$detail_url\">$talk</a></td><td>$city</td><td>$talk_date</td><td>$order_state</td></tr>\n"
+}
+
+ns_write "</table>
+
+[ctq_footer]
+"
Index: web/openacs/www/events/order-search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/order-search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/order-search.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,25 @@
+# order-search.tcl,v 1.1.4.1 2000/02/03 09:48:44 ron Exp
+#
+# /order-search.tcl
+#
+# by michael@yoon.org, 1999-11-04
+#
+# quick and dirty search pages to make life easier when people
+# who claim never to have received confirmation by email call
+# to check on their reservations
+#
+
+ReturnHeaders
+
+ns_write "[ctq_header "Order Search"]
+
+<h2>Order Search</h2>
+
+<hr>
+
+<form action=order-search-2.tcl>
+Search by last name: <input type=text name=last_name size=30>
+</form>
+
+[ctq_footer]
+"
Index: web/openacs/www/events/order.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/order.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/order.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1 @@

\ No newline at end of file
Index: web/openacs/www/events/admin/activities.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/activities.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/activities.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,74 @@
+set user_id [ad_maybe_redirect_for_registration]
+
+set db [ns_db gethandle]
+
+ReturnHeaders
+
+ns_write "[ad_header "[ad_system_name]: Activities"]
+
+<h2>Activities</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] "Activities"]
+<hr>
+
+<h3>Current Activities</h3>
+<ul>
+"
+
+#set speaker_id [events_speaker_id_for_login $db [ns_conn authuser]]
+
+set selection [ns_db select $db "select 
+a.activity_id, a.short_name, a.available_p
+from events_activities a, user_groups ug, user_group_map ugm
+where a.group_id = ugm.group_id
+and ugm.group_id = ug.group_id
+and ugm.user_id = $user_id
+union
+select activity_id, short_name, available_p
+from events_activities
+where group_id is null
+order by available_p desc
+"]
+
+
+set i 0
+set flag 1
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    
+    if {$flag && $available_p == "f"} {
+	ns_write "
+	</ul>	
+	<h3>Discontinued Activities</h3>
+	<ul>
+	"
+	set flag 0
+    }
+    ns_write "<li><a href=\"activity.tcl?activity_id=$activity_id\">$short_name</a>\n"
+    incr i
+}
+
+ns_write "</ul>
+<a href=\"activity-add.tcl\">Add a New Activity</a>
+"
+
+if { $i == 0 } {
+    ns_write "No current activities.\n"
+}
+
+if {$flag} {
+    ns_write "
+    <h3>Discontinued Activities</h3>
+    <ul>
+    <li>No discontinued activities.\n
+    </ul>"
+}
+
+
+
+ns_write "
+[ad_footer]
+"
+
+
+
+
Index: web/openacs/www/events/admin/activity-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/activity-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/activity-add-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,50 @@
+set db [ns_db gethandle]
+
+set_the_usual_form_variables
+
+#activity_id, group_id, creator_id, short_name, description, available_p, details_url
+
+validate_integer activity_id $activity_id
+validate_integer creator_id $creator_id
+
+#error check
+set exception_count 0
+set exception_text ""
+
+#if {![valid_number_p $default_price]} {
+#    append exception_text  "<li>You did not enter a valid number for the price"
+#    incr exception_count
+#}
+
+
+if {[empty_string_p ${short_name}]} {
+    append exception_text "<li>Please enter an activity name\n"
+    incr exception_count
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint exception_count $exception_text
+    return 0
+}
+
+if {[exists_and_not_null group_id]} {
+    validate_integer group_id $group_id
+    
+    ns_db dml $db "insert into events_activities
+    (activity_id, group_id, creator_id, short_name, description, 
+    available_p, detail_url, default_price)
+    values
+    ($activity_id, $group_id, $creator_id, '$QQshort_name', '$QQdescription', 
+    '$QQavailable_p', '$QQdetail_url', 0)"
+} else {
+    ns_db dml $db "insert into events_activities
+    (activity_id, creator_id, short_name, description, 
+    available_p, detail_url, default_price)
+    values
+    ($activity_id, $creator_id, '$QQshort_name', '$QQdescription', 
+    '$QQavailable_p', '$QQdetail_url', 0)"
+}
+#default_price
+
+ns_returnredirect "activities.tcl"
+
Index: web/openacs/www/events/admin/activity-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/activity-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/activity-add.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,60 @@
+set user_id [ad_maybe_redirect_for_registration]
+
+set db [ns_db gethandle]
+
+ReturnHeaders
+
+set new_activity_id [database_to_tcl_string $db "select events_activity_id_sequence.nextval from dual"]
+
+ns_write "[ad_header "Add a new activity"]
+
+<h2>Add a New Activity</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "activities.tcl" Activities] "Add Activity"]
+
+<hr>
+
+<h3>Activity Description</h3>
+
+<form method=post action=activity-add-2.tcl>
+[philg_hidden_input activity_id $new_activity_id]
+[philg_hidden_input creator_id $user_id]
+
+<table>
+<tr>
+  <td>Activity Name
+  <td><input type=text size=30 name=short_name>
+<tr>
+  <td>Owning Group
+  <td>[events_member_groups_widget $db $user_id]
+<tr>
+  <td>Details URL:
+  <td><input type=text size=30 name=detail_url>
+<tr>
+  <td>(link to page with more details)
+"
+
+#<tr>
+# <td>Default Price: 
+# <td><input type=text size=10 name=default_price value=0>
+
+ns_write "
+<tr>
+  <td>Description
+  <td><textarea name=description rows=8 cols=70 wrap=soft></textarea>
+[philg_hidden_input available_p t]
+</table>
+
+<br>
+<br>
+
+<center>
+<input type=submit value=\"Add Activity\">
+</center>
+
+
+[ad_footer]
+"
+
+
+
+
Index: web/openacs/www/events/admin/activity-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/activity-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/activity-edit-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,37 @@
+set_the_usual_form_variables
+
+#activity_id, short_name, description, available_p, group_id, default_price
+
+validate_integer activity_id $activity_id
+
+#if {![valid_number_p $default_price]} {
+#    ad_return_complaint 1 "<li>You did not enter a valid number for the price"
+#    return
+#}
+
+set db [ns_db gethandle]
+
+if {[exists_and_not_null group_id]} {
+    
+    validate_integer group_id $group_id
+
+    ns_db dml $db "update events_activities set
+    group_id = $group_id,
+    short_name='$QQshort_name', 
+    description='$QQdescription', 
+    available_p='$QQavailable_p',
+    detail_url='$QQdetail_url'
+    where activity_id = $activity_id"
+} else {
+    ns_db dml $db "update events_activities set
+    group_id=null,
+    short_name='$QQshort_name', 
+    description='$QQdescription', 
+    available_p='$QQavailable_p',
+    detail_url='$QQdetail_url'
+    where activity_id = $activity_id"
+}
+#    default_price=$default_price
+
+ns_returnredirect "activity.tcl?activity_id=$activity_id"
+
Index: web/openacs/www/events/admin/activity-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/activity-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/activity-edit.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,87 @@
+set user_id [ad_maybe_redirect_for_registration]
+
+set_the_usual_form_variables
+
+#activity_id
+
+validate_integer activity_id $activity_id
+
+ReturnHeaders
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select short_name, description, available_p,
+u.first_names || ' ' || u.last_name as creator_name,
+detail_url, group_id
+from events_activities, users u
+where activity_id = $activity_id
+and creator_id = u.user_id
+"]
+
+set_variables_after_query
+
+ns_write "[ad_header "Edit $short_name"]
+
+<h2>Edit $short_name</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "activities.tcl" Activities] [list "activity.tcl?[export_url_vars activity_id]" Activity] "Edit Activity"]
+<hr>
+
+<h3>Activity Description</h3>
+
+<form method=post action=activity-edit-2.tcl>
+[philg_hidden_input activity_id $activity_id]
+
+<table>
+<tr>
+  <td>Activity Name
+  <td><input type=text size=30 name=short_name value=\"[philg_quote_double_quotes $short_name]\">
+<tr>
+  <td>Creator
+  <td>$creator_name
+<tr>
+  <td>Owning Group
+  <td>[events_member_groups_widget $db $user_id $group_id]
+<tr>
+"
+
+# <td>Default Price
+# <td><input type=text size=10 name=default_price value=\"$default_price\">
+
+ns_write "
+<tr>
+ <td>URL
+ <td><input type=text size=30 name=detail_url value=\"$detail_url\">
+<tr>
+  <td>Description
+  <td><textarea name=description rows=8 cols=70 wrap=soft>$description</textarea>
+<tr>
+  <td>Current or Discontinued
+"
+if {$available_p == "t"} {
+    ns_write "<td><input type=radio name=available_p value=t CHECKED>Current
+      <input type=radio name=available_p value=f>Discontinued
+    "
+} else {
+    ns_write "<td><input type=radio name=available_p value=t>Current
+      <input type=radio name=available_p value=f CHECKED>Discontinued
+    "
+}
+ns_write "
+</table>
+Note: Discontinuing an activity will not cancel an activity's 
+existing events. It only prevents you from adding <i>new</i> events 
+to the activity.
+<br>
+<br>
+
+<center>
+<input type=submit value=\"Edit Activity\">
+</center>
+</form>
+
+[ad_footer]
+"
+
+
+
+
Index: web/openacs/www/events/admin/activity-field-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/activity-field-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/activity-field-add-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,77 @@
+set_the_usual_form_variables
+
+# activity_id, column_name, pretty_name, column_type, column_actual_type
+# column_extra, after (optional)
+
+validate_integer activity_id $activity_id
+
+set db [ns_db gethandle]
+
+if { [exists_and_not_null after] } {
+    set sort_key [expr $after + 1]
+    set update_sql "update events_activity_fields 
+    set sort_key = sort_key + 1
+    where activity_id = $activity_id
+    and sort_key > $after"
+} else {
+    set sort_key 1
+    set update_sql ""
+}
+
+
+set insert_sql "insert into events_activity_fields (activity_id, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key)
+values
+( $activity_id, '$QQcolumn_name', '$QQpretty_name','$QQcolumn_type', '$QQcolumn_actual_type', [ns_dbquotevalue $column_extra text], $sort_key)"
+
+with_transaction $db {
+    if { ![empty_string_p $update_sql] } {
+	ns_db dml $db $update_sql
+    }
+    ns_db dml $db $insert_sql
+} {
+    # an error
+    ad_return_error "Database Error" "Error while trying to customize the activity.
+	
+Tried the following SQL:
+	    
+<blockquote>
+<pre>
+$alter_sql
+$update_sql
+$insert_sql    
+</pre>
+</blockquote>	
+
+and got back the following:
+	
+<blockquote>
+<pre>
+$errmsg
+</pre>
+</blockquote>"
+    return
+}
+
+# database stuff went OK
+ns_return 200 text/html "[ad_header "Field Added"]
+
+<h2>Field Added</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "activities.tcl" Activities] [list "activity.tcl?[export_url_vars activity_id]" Activity] "Custom Field"]
+<hr>
+
+The following action has been taken:
+
+<ul>
+
+<li>a row has been added to the SQL table events_activity_fields
+reflecting that 
+
+<ul>
+
+<li>this field has the pretty name (for user interface) of \"$pretty_name\"
+
+</ul>
+</ul>
+
+[ad_footer]
+"
Index: web/openacs/www/events/admin/activity-field-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/activity-field-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/activity-field-add.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,66 @@
+set_the_usual_form_variables
+
+# activity_id, after (optional)
+
+validate_integer activity_id $activity_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select 
+activity_id, short_name as activity_name
+from events_activities
+where activity_id = $activity_id
+"]
+
+set_variables_after_query
+
+ReturnHeaders 
+
+ns_write "[ad_header "Add a field to $activity_name"]
+
+<h2>Add a field</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "activities.tcl" Activities] [list "activity.tcl?[export_url_vars activity_id]" Activity] "Custom Field"]
+<hr>
+<p>
+Add a field to the activity, $activity_name.
+<p>
+<form action=\"activity-field-add-2.tcl\" method=POST>
+[export_form_vars activity_id after]
+
+Column Actual Name:  <input name=column_name type=text size=30>
+<br>
+<i>no spaces or special characters except underscore</i>
+
+<p>
+
+Column Pretty Name:  <input name=pretty_name type=text size=30>
+
+<p>
+
+
+Column Type:  [ad_user_group_column_type_widget]
+<p>
+
+Column Actual Type:  <input name=column_actual_type type=text size=30>
+(used to feed Oracle, e.g., <code>char(1)</code> instead of boolean)
+
+
+<p>
+
+If you're a database wizard, you might want to add some 
+extra SQL, such as \"not null\"<br>
+Extra SQL: <input type=text size=30 name=column_extra>
+
+<p>
+
+(note that you can only truly add not null columns when the table is
+empty, i.e., before anyone has entered the contest)
+
+<p>
+
+<input type=submit value=\"Add this new column\">
+
+</form>
+
+[ad_footer]
+"
Index: web/openacs/www/events/admin/activity-field-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/activity-field-delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/activity-field-delete-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,37 @@
+set_the_usual_form_variables
+
+# activity_id, column_name
+
+validate_integer activity_id $activity_id
+
+set db [ns_db gethandle]
+
+with_transaction $db {
+    ns_db dml $db "delete from events_activity_fields
+where activity_id = $activity_id
+and column_name = '$QQcolumn_name'"
+} {
+    ad_return_error "Deletion Failed" "We were unable to drop the column $column_name from the activity due to a database error:
+<pre>
+$errmsg
+</pre>
+"
+    return
+}
+
+ns_return 200 text/html "[ad_header "Field Removed"]
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "activities.tcl" Activities] [list "activity.tcl?[export_url_vars activity_id]" Activity] "Custom Field"]
+<h2>Field Removed</h2>
+
+from the activity.
+
+<hr>
+
+The following action has been taken:
+
+<ul>
+<li>a row was removed from the table events_activity_fields.
+</ul>
+
+[ad_footer]
+"
\ No newline at end of file
Index: web/openacs/www/events/admin/activity-field-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/activity-field-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/activity-field-delete.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,33 @@
+set_the_usual_form_variables
+# activity_id, column_name, pretty_name
+
+validate_integer activity_id $activity_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select 
+activity_id, short_name as activity_name
+from events_activities
+where activity_id = $activity_id
+"]
+
+set_variables_after_query
+
+ns_return 200 text/html "[ad_header "Delete Field From $activity_name"]
+
+<h2>Delete Column $column_name</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "activities.tcl" Activities] [list "activity.tcl?[export_url_vars activity_id]" Activity] "Custom Field"]
+<hr>
+
+<form action=\"activity-field-delete-2.tcl\" method=POST>
+[export_form_vars activity_id column_name]
+
+Do you really want to remove this field from the activity, $activity_name?
+<p>
+You may not be able to undo this action.
+<center>
+<input type=submit value=\"Yes, Remove This Field\">
+</center>
+
+[ad_footer]
+"
\ No newline at end of file
Index: web/openacs/www/events/admin/activity-field-swap.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/activity-field-swap.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/activity-field-swap.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,26 @@
+# Swaps two sort keys for group_type, sort_key and sort_key + 1.
+
+set_the_usual_form_variables
+# activity_id, sort_key
+
+validate_integer activity_id $activity_id
+
+set db [ns_db gethandle]
+
+set next_sort_key [expr $sort_key + 1]
+
+with_catch errmsg {
+    ns_db dml $db "update events_activity_fields
+set sort_key = decode(sort_key, $sort_key, $next_sort_key, $next_sort_key, $sort_key)
+where activity_id = $activity_id
+and sort_key in ($sort_key, $next_sort_key)"
+
+    ns_returnredirect "activity.tcl?activity_id=$activity_id"
+} {
+    ad_return_error "Database error" "A database error occured while trying
+to swap your activity fields. Here's the error:
+<pre>
+$errmsg
+</pre>
+"
+}
\ No newline at end of file
Index: web/openacs/www/events/admin/activity.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/activity.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/activity.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,194 @@
+set_the_usual_form_variables
+#activity_id
+
+validate_integer activity_id $activity_id
+
+set db [ns_db gethandle]
+
+ReturnHeaders
+
+#activities.default_price,
+set selection [ns_db 1row $db "select activities.short_name, 
+activities.creator_id, 
+activities.description, 
+activities.detail_url,
+activities.available_p,
+u.user_id,
+u.first_names || ' ' || u.last_name as creator
+from events_activities activities, users u
+where activity_id = $activity_id
+and u.user_id = activities.creator_id"]
+
+set_variables_after_query
+
+#release the handles here for ad_header, then get them again
+ns_db releasehandle $db
+#ns_db releasehandle $db_sub
+
+ns_write "[ad_header $short_name]
+
+<h2>$short_name</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "activities.tcl" Activities] "Activity"]
+<hr>
+
+<h3>Events for this Activity</h3>
+"
+
+#get the handles again
+set db_pools [ns_db gethandle subquery 2]
+set db [lindex $db_pools 0]
+set db_sub [lindex $db_pools 1]
+
+
+set selection [ns_db select $db "
+select e.event_id, v.city,
+v.usps_abbrev, v.iso, e.start_time, count(reg_id) as n_orders
+from
+events_events e, events_reg_not_canceled r, events_venues v, events_prices p 
+where e.activity_id = $activity_id 
+and p.price_id = r.price_id
+and e.event_id = p.event_id
+and v.venue_id = e.venue_id 
+group by e.event_id, v.city, v.usps_abbrev, v.iso, e.start_time 
+union
+select e.event_id, v.city,
+v.usps_abbrev, v.iso, e.start_time, 0 as n_orders
+from
+events_events e, events_venues v, events_prices p 
+where e.activity_id = $activity_id 
+and (0=(select count(*) from events_reg_not_canceled where price_id=p.price_id))
+and e.event_id = p.event_id
+and v.venue_id = e.venue_id 
+group by e.event_id, v.city, v.usps_abbrev, v.iso, e.start_time
+union
+select e.event_id, v.city,
+v.usps_abbrev, v.iso, e.start_time, 0 as n_orders
+from
+events_events e, events_venues v
+where e.activity_id = $activity_id 
+and 0=(select count(*) from events_prices where event_id= e.event_id)
+and v.venue_id = e.venue_id 
+group by e.event_id, v.city, v.usps_abbrev, v.iso, e.start_time
+order by start_time
+"]
+
+ns_write "<ul>\n"
+
+set count 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    ## PG 6.5 hack (BMA)
+    if {$event_id == ""} {
+	continue
+    }
+
+    incr count
+    ns_write "<li><a href=\"event.tcl?event_id=$event_id\">[events_pretty_location $db_sub $city $usps_abbrev $iso]</a> [util_AnsiDatetoPrettyDate $start_time]\n (registration: $n_orders)"
+}
+if { $count == 0 } {
+    ns_write "No events for this activity have been created.\n"
+}
+
+if {$available_p == "t"} {
+    ns_write "<p>
+    <a href=\"event-add.tcl?activity_id=$activity_id\">Add an Event</a>
+    "
+} 
+
+ns_write "
+</ul>
+<h3>Activity Description</h3>
+<table>
+<tr>
+  <th valign=top>Name</th>
+  <td valign=top>$short_name</td>
+</tr>
+<tr>
+  <th valign=top>Creator</th>
+  <td valign=top>$creator</td>
+</tr>
+"
+
+#<tr>
+# <th valign=top>Default Price
+# <td valign=top>$[util_commify_number $default_price]
+
+ns_write "
+<tr>
+ <th valign=top>URL
+ <td valign=top>$detail_url
+<tr>
+  <th valign=top>Description</th>
+  <td valign=top>$description</td>
+</tr>
+<tr>
+  <th valign=top>Current or Discontinued</th>
+"
+if {[string compare $available_p "t"] == 0} {
+    ns_write "<td valign=top>Current</td>"
+} else {
+    ns_write "<td valign=top>Discontinued</td>"
+}
+
+ns_write "
+</table>
+
+<p>
+<ul>
+<li><a href=\"activity-edit.tcl?[export_url_vars activity_id]\">Edit Activity</a>
+</ul>
+"
+
+ns_write "
+<h3>Activity Custom Fields</h3>
+You may define default custom fields which you would like to
+collect from registrants for this activity type.
+<p>
+<table>
+"
+
+set number_of_fields [database_to_tcl_string $db "select count(*) from events_activity_fields where activity_id=$activity_id"]
+
+set selection [ns_db select $db "select 
+column_name, pretty_name, column_type, column_actual_type,
+column_extra, sort_key
+from events_activity_fields
+where activity_id = $activity_id
+order by sort_key
+"]
+
+set counter 0 
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    incr counter 
+
+    if { $counter == $number_of_fields } {
+	ns_write "<tr><td><ul><li>$column_name ($pretty_name), $column_actual_type ($column_type) $column_extra<td><font size=-1 face=\"arial\">\[&nbsp;<a href=\"activity-field-add.tcl?activity_id=$activity_id&after=$sort_key\">insert&nbsp;after</a>&nbsp;|&nbsp;<a href=\"activity-field-delete.tcl?[export_url_vars activity_type column_name activity_id]\">delete</a>&nbsp;\]</font></ul>\n"
+    } else {
+	ns_write "<tr><td><ul><li>$column_name ($pretty_name), $column_actual_type ($column_type) $column_extra<td><font size=-1 face=\"arial\">\[&nbsp;<a href=\"activity-field-add.tcl?activity_id=$activity_id&after=$sort_key\">insert&nbsp;after</a>&nbsp;|&nbsp;<a href=\"activity-field-swap.tcl?activity_id=$activity_id&sort_key=$sort_key\">swap&nbsp;with&nbsp;next</a>&nbsp;|&nbsp;<a href=\"activity-field-delete.tcl?[export_url_vars activity_id column_name]\">delete</a>&nbsp;\]</font></ul>\n"
+    }
+}
+
+if { $counter == 0 } {
+    ns_write "
+    <tr><td><ul><li>no custom fields currently collected</ul>
+    "
+}
+
+ns_write "
+</table>
+<p>
+<ul>
+<li><a href=\"activity-field-add.tcl?[export_url_vars activity_id]\">add a field</a>
+</ul>
+"
+
+ns_write "
+<h3>Accounting</h3>
+<ul>
+<li><a href=\"order-history-one-activity.tcl?activity_id=$activity_id\">View All Orders for this Activity</a>
+
+</ul>
+
+[ad_footer]"
Index: web/openacs/www/events/admin/event-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/event-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/event-add-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,107 @@
+set db [ns_db gethandle]
+
+set_the_usual_form_variables
+# activity_id, venue_id
+
+validate_integer activity_id $activity_id
+validate_integer venue_id $venue_id
+
+ReturnHeaders
+
+set new_event_id [database_to_tcl_string $db "select events_event_id_sequence.nextval from dual"]
+
+#set new_product_id [database_to_tcl_string $db "select ec_product_id_sequence.nextval from dual"]
+
+set new_price_id [database_to_tcl_string $db "select events_price_id_sequence.nextval from dual"]
+
+set selection [ns_db 1row $db "select short_name as activity_name,
+default_price
+from events_activities where activity_id = $activity_id"]
+set_variables_after_query
+
+set selection [ns_db 1row $db "select city, usps_abbrev, iso, max_people
+from events_venues where venue_id=$venue_id"]
+set_variables_after_query
+
+ns_write "[ad_header "Add a New Event"]
+<h2>Add a New Event for $activity_name</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "activities.tcl" Activities] [list "activity.tcl?[export_url_vars activity_id]" Activity] "Add Event"]
+
+<hr>
+
+<form method=get action=event-add-3.tcl>
+[export_form_vars activity_id venue_id]
+[philg_hidden_input event_id $new_event_id]
+
+[philg_hidden_input price_id $new_price_id]
+
+<table>
+<tr>
+ <td align=right>Location:
+ <td>[events_pretty_location $db $city $usps_abbrev $iso]
+<tr>
+  <td align=right>Start Time:
+  <td>[_ns_dateentrywidget start_time] [_ns_timeentrywidget start_time]
+<tr>
+  <td align=right>End Time:
+  <td>[_ns_dateentrywidget end_time][_ns_timeentrywidget end_time]
+<tr>
+  <td align=right>Registration Deadline:
+  <td>[_ns_dateentrywidget reg_deadline][_ns_timeentrywidget reg_deadline]
+(at latest the Start Time)
+<tr>
+ <td align=right>Registration Cancellable?
+ <td><select name=reg_cancellable_p>
+     <option SELECTED value=\"t\">yes
+     <option value=\"f\">no
+     </select>
+ (Can someone cancel his registration?)
+<tr>
+ <td align=right>Registration Needs Approval?
+ <td><select name=reg_needs_approval_p>
+     <option SELECTED value=\"t\">yes
+     <option value=\"f\">no
+     </select>
+ (Does a registration need to be approved?)
+<tr>
+ <td align=right>Maximum Capacity:
+ <td><input type=text size=20 name=max_people value=$max_people>
+"
+
+
+#<tr>
+# <td align=right>Normal Price:
+# <td><input type=text size=10 name=price value=$default_price>
+
+ns_write "
+<tr>
+ <td align=left>Something to display <br>
+after someone has registered <br>
+for this event:
+ <td><textarea name=display_after rows=8 cols=70 wrap=soft></textarea>
+<tr>
+ <td align=right>Refreshment Notes:
+ <td><textarea name=refreshments_note rows=8 cols=70 wrap=soft></textarea>
+<tr>
+ <td align=right>Audio/Visual Notes:
+ <td><textarea name=av_note rows=8 cols=70 wrap=soft></textarea>
+<tr>
+ <td align=right>Additional Notes:
+ <td><textarea name=additional_note rows=8 cols=70 wrap=soft></textarea>
+
+</table>
+
+<br>
+<br>
+
+<center>
+<input type=submit value=\"Add Event\">
+</center>
+
+
+[ad_footer]
+"
+
+
+
+
Index: web/openacs/www/events/admin/event-add-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/event-add-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/event-add-3.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,160 @@
+set user_id [ad_maybe_redirect_for_registration]
+set db_pools [ns_db gethandle subquery 2]
+set db [lindex $db_pools 0]
+set db_sub [lindex $db_pools 1]
+
+
+
+set_the_usual_form_variables
+# event_id, activity_id, venue_id, display_after
+# start_time, end_time (from date/time entry widgets), prodcut_id, price_id, price, reg_cancellable_p
+
+validate_integer event_id $event_id
+validate_integer activity_id $activity_id
+validate_integer venue_id $venue_id
+validate_integer price_id $price_id
+
+set exception_text ""
+set exception_count 0
+
+#if {![valid_number_p $price]} {
+#    append exception_text  "<li>You did not enter a valid number for the price"
+#    incr exception_count
+#}
+
+if { [catch {ns_dbformvalue [ns_conn form] reg_deadline datetime reg_deadline_value} err_msg]} {
+    incr exception_count
+    append exception_text "<li>Strange... couldn't parse the registration deadline.\n"
+}
+
+if { [catch {ns_dbformvalue [ns_conn form] start_time datetime start_time_value} err_msg]} {
+    incr exception_count
+    append exception_text "<li>Strange... couldn't parse the start time.\n"
+}
+
+if { [catch {ns_dbformvalue [ns_conn form] end_time datetime end_time_value} err_msg]} {
+    incr exception_count
+    append exception_text "<li>Strange... couldn't parse the end time.\n"
+}
+
+if {[exists_and_not_null max_people]} {
+    if {[catch {set max_people [validate_integer "max_people" $max_people]}]} {
+	incr exception_count
+	append exception_text "<li>You must enter a number for maximum capacity"
+    }
+} else {
+    set max_people "null"
+}
+
+
+if { ![info exists display_after] || $display_after == "" } {
+    incr exception_count
+    append exception_text "<li>Please enter a message for people who register.\n"
+}
+
+#check the dates
+set selection [ns_db 1row $db "select case when '$start_time_value'::datetime > '$end_time_value'::datetime then 1 else 0 end as problem_1, case when '$reg_deadline_value'::datetime >= '$start_time_value'::datetime then 1 else 0 end as problem_2"]
+set_variables_after_query
+
+if {$problem_1 || $problem_2} {
+    incr exception_count
+    append exception_text "<li>Please make sure your start time is before your
+    end time and your registration deadline is no later than your start time.\n"
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+ns_db dml $db "begin transaction"
+#create the user group for this event
+set name [database_to_tcl_string $db "select short_name
+from events_activities where activity_id = $activity_id"]
+set location [events_pretty_venue $db $venue_id]
+set group_id [events_group_create $db $name $start_time_value $location]
+
+
+if {$group_id == 0} {
+    ns_db dml $db "abort transaction"
+    ad_return_error "Couldn't create group" "We were unable to create a user group for your new event."
+    return
+}
+
+#make this user an administrator of the user group
+ns_db dml $db "insert into user_group_map 
+(group_id, user_id, role, mapping_user, mapping_ip_address) 
+select $group_id, $user_id, 'administrator', 
+$user_id, '[DoubleApos [ns_conn peeraddr]]'
+from dual where not exists 
+ (select user_id 
+ from user_group_map 
+ where group_id = $group_id and 
+ user_id = $user_id)"
+
+#create the event
+ns_db dml $db "insert into events_events
+(event_id, activity_id, venue_id, display_after,
+max_people, av_note, refreshments_note, additional_note,
+start_time, end_time, reg_deadline, reg_cancellable_p, group_id,
+reg_needs_approval_p, creator_id
+)
+values
+($event_id, $activity_id, $venue_id,  '$QQdisplay_after', 
+$max_people, '$QQav_note', '$QQrefreshments_note',
+'$QQadditional_note',
+'$start_time_value'::datetime, 
+'$end_time_value'::datetime,
+'$reg_deadline_value'::datetime,
+'$reg_cancellable_p', $group_id, '$reg_needs_approval_p',
+$user_id
+)"
+
+#create the ec product
+#ns_db dml $db "insert into ec_products
+#(product_id, product_name, creation_date, price, available_date,
+#last_modified, last_modifying_user, modified_ip_address)
+#values
+#($product_id, 'Normal Price', sysdate(), $price, sysdate(),
+#sysdate, $user_id, '[DoubleApos [ns_conn peeraddr]]')"
+
+#create the event price
+ns_db dml $db "insert into events_prices
+(price_id, event_id, description, price, expire_date, available_date)
+values
+($price_id, $event_id, 'Normal Price', 0, 
+to_date('$reg_deadline_value', 'YYYY-MM-DD HH24:MI:SS'),
+sysdate())"
+
+#create the event's fields table and add the default fields
+#from the activity
+set table_name [events_helper_table_name $event_id]
+ns_db dml $db "create table $table_name (
+user_id integer not null references users)"
+
+set selection [ns_db select $db "select
+column_name, pretty_name, column_type, column_actual_type,
+column_extra, sort_key
+from events_activity_fields
+where activity_id = $activity_id"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    ns_db dml $db_sub "insert into events_event_fields
+    (event_id, column_name, pretty_name, column_type, column_actual_type,
+    column_extra, sort_key)
+    values
+    ($event_id, '[DoubleApos $column_name]', '[DoubleApos $pretty_name]', 
+    '[DoubleApos $column_type]', 
+    '[DoubleApos $column_actual_type]',
+    '[DoubleApos $column_extra]', $sort_key)"
+
+    ns_db dml $db_sub "alter table $table_name
+    add ($column_name $column_actual_type $column_extra)"
+}
+    
+ns_db dml $db "end transaction"
+
+ns_returnredirect "event.tcl?event_id=$event_id"
+
+
Index: web/openacs/www/events/admin/event-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/event-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/event-add.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,67 @@
+set db_pools [ns_db gethandle subquery 2]
+set db [lindex $db_pools 0]
+set db_sub [lindex $db_pools 1]
+
+
+set_form_variables
+# activity_id
+
+validate_integer activity_id $activity_id
+
+ReturnHeaders
+
+set selection [ns_db 1row $db "select short_name as activity_name from events_activities where activity_id = $activity_id"]
+set_variables_after_query
+
+set return_url "/events/admin/event-add-2.tcl?activity_id=$activity_id"
+
+set venues_widget [events_venues_widget $db $db_sub]
+
+#release the db handle for ad_header
+ns_db releasehandle $db
+ns_db releasehandle $db_sub
+ns_write "[ad_header "Add a New Event"]"
+
+#get the handles again
+set db [ns_db gethandle]
+
+ns_write "
+<h2>Add a New Event</h2>
+for $activity_name<br>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "activities.tcl" Activities] [list "activity.tcl?[export_url_vars activity_id]" Activity] "Add Event"]
+<hr>
+<form action=\"event-add-2.tcl\" method=get>
+[export_form_vars activity_id]
+<P>
+<h3>Choose a Venue</h3>
+<p>
+<form method=post action=\"event-add-2.tcl\">
+<table>
+<tr>
+ <td valign=top>Select a venue for your new event: 
+ <td valign=top>$venues_widget"
+
+if {![empty_string_p $venues_widget]} {
+    ns_write "
+    <tr>
+    <td><br>
+    <tr>
+    <td>
+    <td><center>
+    <input type=submit value=\"Continue\">
+    </center>
+    "
+} else {
+    ns_write "<tr><td><br><ul><li>There are no venues in the system</ul>"
+}
+
+ns_write "
+</table>
+<p>
+If you do not see your venue above, you may 
+<a href=\"venues-ae.tcl?[export_url_vars return_url]\">add a new venue</a>.
+
+
+[ad_footer]
+"
+
Index: web/openacs/www/events/admin/event-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/event-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/event-edit-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,111 @@
+#actually takes all the stuff from the forms and updates the database
+#getting all the form stuff passed in along with the event_id to be changed.
+
+set_the_usual_form_variables
+# event_id, venue_id, display_after, max_people
+# start_time, end_time, reg_deadline (from date/time entry widgets),
+#reg_cancellable_p, reg_needs_approval_p
+
+
+validate_integer event_id $event_id
+validate_integer venue_id $venue_id
+
+set db [ns_db gethandle]
+
+# check user input 
+
+set exception_count 0
+set exception_text ""
+
+
+if { [ns_dbformvalue [ns_conn form] start_time datetime start_time_value] <= 0 } {
+    incr exception_count
+    append exception_text "<li>Strange... couldn't parse the start time.\n"
+}
+
+if { [ns_dbformvalue [ns_conn form] end_time datetime end_time_value] <= 0 } {
+    incr exception_count
+    append exception_text "<li>Strange... couldn't parse the end time.\n"
+}
+
+if { [ns_dbformvalue [ns_conn form] reg_deadline datetime reg_deadline_value] <= 0 } {
+    incr exception_count
+    append exception_text "<li>Strange... couldn't parse the registration deadline.\n"
+}
+
+
+if { ![info exists display_after] || $display_after == "" } {
+    incr exception_count
+    append exception_text "<li>You forgot to enter a confirmation message.\n"
+}
+
+if { [ns_dbformvalue [ns_conn form] start_time datetime start_time_value] <= 0 } {
+    incr exception_count
+    append exception_text "<li>Strange... couldn't parse the start time.\n"
+}
+#check the dates
+set selection [ns_db 0or1row $db "select 1 from dual 
+where to_date('$start_time_value', 'YYYY-MM-DD HH24:MI:SS') < 
+to_date('$end_time_value', 'YYYY-MM-DD HH24:MI:SS')
+and
+to_date('$reg_deadline_value', 'YYYY-MM-DD HH24:MI:SS') <=
+to_date('$start_time_value', 'YYYY-MM-DD HH24:MI:SS')
+
+"]
+if {[empty_string_p $selection]} {
+    incr exception_count
+    append exception_text "<li>Please make sure your start time is before your
+    end time and your registration deadline is no later than your start time.\n"
+}
+
+if {[exists_and_not_null max_people]} {
+    if {[catch {set max_people [validate_integer "max_people" $max_people]}]} {
+	incr exception_count
+	append exception_text "<li>You must enter a number for maximum capacity"
+    }
+} else {
+    set max_people "null"
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+
+# ok, so everything is filled in completely; want to insert the info
+# into the db
+
+set update_sql "update events_events
+set venue_id = $venue_id,
+display_after = '$QQdisplay_after',
+max_people = $max_people,
+start_time = to_date('$start_time_value', 'YYYY-MM-DD HH24:MI:SS'), 
+end_time = to_date('$end_time_value', 'YYYY-MM-DD HH24:MI:SS'),
+reg_deadline = to_date('$reg_deadline_value', 'YYYY-MM-DD HH24:MI:SS'),
+reg_cancellable_p = '$reg_cancellable_p',
+reg_needs_approval_p = '$reg_needs_approval_p'
+where event_id = $event_id"
+
+ns_db dml $db $update_sql
+
+#if [catch {ns_db dml $db $update_sql} errmsg] {
+#    ns_return 200 text/html  "
+#<body bgcolor=\"#FFFFFF\">
+#<h2>  Error in Updating information</h2> 
+#for this <a href=\"event.tcl?event_id=$event_id\">event</a>
+#<p>
+#Here is the error it reported:
+#<p>
+#<blockquote>
+#$errmsg
+#</blockquote>
+#</p>
+#</html>" }
+
+ns_returnredirect "event.tcl?event_id=$event_id"
+
+
+
+
Index: web/openacs/www/events/admin/event-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/event-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/event-edit.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,128 @@
+#being called with the event_id, so know what row is going to be edited.
+#want all the pieces of the form filled in, so you can then change the ones 
+#you want 
+
+set db [ns_db gethandle]
+
+set_the_usual_form_variables
+# event_id, maybe venue_id
+
+validate_integer event_id $event_id
+if {[info exists venue_id]} {
+    validate_integer_or_null venue_id $venue_id
+}
+
+set selection [ns_db 0or1row $db "select 
+a.short_name,
+a.activity_id,
+v.venue_id,
+e.display_after, e.start_time, e.max_people,
+to_char(e.start_time,'YYYY-MM-DD HH24:MI:SS') as start_timestamp, 
+to_char(e.end_time,'YYYY-MM-DD HH24:MI:SS') as end_timestamp,
+to_char(e.reg_deadline,'YYYY-MM-DD HH24:MI:SS') as deadline_timestamp,
+reg_cancellable_p, reg_needs_approval_p
+from events_events e, events_venues v, events_activities a
+where e.event_id= $event_id
+and v.venue_id = e.venue_id
+and a.activity_id = e.activity_id
+"]
+
+set_variables_after_query
+
+#call this again to override venue_id
+set_the_usual_form_variables
+# event_id, maybe venue_id
+
+
+set time_elements "<tr>
+  <th align=right>Start:
+  <td>[_ns_dateentrywidget start_time] [_ns_timeentrywidget start_time]
+<tr>
+  <th align=right>End:
+  <td>[_ns_dateentrywidget end_time][_ns_timeentrywidget end_time]
+<tr>
+  <th align=right>Registration Deadline:
+  <td>[_ns_dateentrywidget reg_deadline][_ns_timeentrywidget reg_deadline]
+"
+
+set stuffed_with_start [ns_dbformvalueput $time_elements "start_time" "timestamp" $start_timestamp]
+set stuffed_with_se [ns_dbformvalueput $stuffed_with_start "end_time" "timestamp" $end_timestamp]
+set stuffed_with_all_times [ns_dbformvalueput $stuffed_with_se "reg_deadline" "timestamp" $deadline_timestamp]
+
+#set up html stuff
+ReturnHeaders
+
+set return_url "event-edit.tcl?event_id=$event_id"
+
+#release the handle for ad_header
+ns_db releasehandle $db
+ns_write "
+[ad_header "Edit Event"]"
+
+set db_pools [ns_db gethandle subquery 2]
+set db [lindex $db_pools 0]
+set db_sub [lindex $db_pools 1]
+
+
+ns_write "
+<h2>Edit Event</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "activities.tcl" Activities] [list "activity.tcl?[export_url_vars activity_id]" Activity] [list "event.tcl?[export_url_vars event_id]" "Event"] "Edit Event"]
+<hr>
+$short_name on [util_AnsiDatetoPrettyDate $start_time]
+<form method=POST action=event-edit-2.tcl?event_id=$event_id>
+[export_form_vars event_id]
+<table>
+<tr>
+  <th align=right>Venue:
+  <td>[events_venues_widget $db $db_sub $venue_id]
+  <td align=left><a href=\"venues-ae.tcl?[export_url_vars return_url]\">Add a New Venue</a>
+<tr>
+ <th align=right>Maximum Capacity:
+ <td><input type=text size=20 name=max_people value=$max_people>
+<tr>
+ <th align=right>Registration Cancellable?
+ <td><select name=reg_cancellable_p>
+"
+if {$reg_cancellable_p == "t"} {
+    ns_write "
+    <option SELECTED value=\"t\">yes
+    <option value=\"f\">no"
+} else {
+    ns_write "
+    <option value=\"t\">yes
+    <option SELECTED value=\"f\">no"
+}
+
+ns_write "
+    </select>
+ (Can someone cancel his registration?)
+<tr>
+ <th align=right>Registration Needs Approval?
+ <td><select name=reg_needs_approval_p>
+"
+
+if {$reg_needs_approval_p == "t"} {
+    ns_write "
+     <option SELECTED value=\"t\">yes
+     <option value=\"f\">no"
+} else {
+    ns_write "
+     <option value=\"t\">yes
+     <option SELECTED value=\"f\">no"
+}
+ns_write "
+     </select>
+ (Does a registration need to be approved?)
+<tr>
+  <th>Confirmation Message
+  <td colspan=2><textarea name=display_after rows=8 cols=70 wrap=soft>$display_after</textarea>
+$stuffed_with_all_times
+
+</table>
+<p>
+<center>
+<input type=submit value=\"Update\">
+</center>
+</form>
+[ad_footer]"
+
Index: web/openacs/www/events/admin/event-field-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/event-field-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/event-field-add-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,93 @@
+set_the_usual_form_variables
+
+# event_id, column_name, pretty_name, column_type, column_actual_type
+# column_extra, after (optional)
+
+validate_integer event_id $event_id
+
+set db [ns_db gethandle]
+
+set table_name [events_helper_table_name $event_id]
+
+set alter_sql "alter table $table_name add ($column_name $column_actual_type $column_extra)"
+
+if { [exists_and_not_null after] } {
+    set sort_key [expr $after + 1]
+    set update_sql "update events_event_fields 
+    set sort_key = sort_key + 1
+    where event_id = $event_id
+    and sort_key > $after"
+} else {
+    set sort_key 1
+    set update_sql ""
+}
+
+
+set insert_sql "insert into events_event_fields (event_id, column_name, pretty_name, column_type, column_actual_type, column_extra, sort_key)
+values
+( $event_id, '$QQcolumn_name', '$QQpretty_name','$QQcolumn_type', '$QQcolumn_actual_type', [ns_dbquotevalue $column_extra text], $sort_key)"
+
+with_transaction $db {
+    ns_db dml $db $alter_sql
+    if { ![empty_string_p $update_sql] } {
+	ns_db dml $db $update_sql
+    }
+    ns_db dml $db $insert_sql
+} {
+    # an error
+    ad_return_error "Database Error" "Error while trying to customize the event.
+	
+Tried the following SQL:
+	    
+<blockquote>
+<pre>
+$alter_sql
+$update_sql
+$insert_sql    
+</pre>
+</blockquote>	
+
+and got back the following:
+	
+<blockquote>
+<pre>
+$errmsg
+</pre>
+</blockquote>"
+    return
+}
+
+# database stuff went OK
+ns_return 200 text/html "[ad_header "Field Added"]
+
+<h2>Field Added</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "activities.tcl" Activities] [list "activity.tcl?[export_url_vars activity_id]" Activity] [list "event.tcl?[export_url_vars event_id]" Event] "Custom Field"]
+<hr>
+
+The following action has been taken:
+
+<ul>
+
+<li>a column called \"$column_name\" has been added to the
+table $table_name in the database.  The sql was
+<P>
+<code>
+<blockquote>
+$alter_sql
+</blockquote>
+</code>
+
+<p>
+
+<li>a row has been added to the SQL table events_event_fields
+reflecting that 
+
+<ul>
+
+<li>this field has the pretty name (for user interface) of \"$pretty_name\"
+
+</ul>
+</ul>
+
+[ad_footer]
+"
Index: web/openacs/www/events/admin/event-field-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/event-field-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/event-field-add.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,72 @@
+set_the_usual_form_variables
+
+# event_id, after (optional)
+
+validate_integer event_id $event_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select 
+a.activity_id, a.short_name as activity_name, v.city,
+v.usps_abbrev, v.iso, display_after, 
+to_char(start_time, 'fmDay, fmMonth DD, YYYY') as compact_date
+from events_events e, events_activities a, 
+events_venues v
+where e.event_id = $event_id
+and e.activity_id = a.activity_id
+and v.venue_id = e.venue_id
+"]
+
+set_variables_after_query
+set pretty_location [events_pretty_location $db $city $usps_abbrev $iso]
+
+ReturnHeaders 
+
+ns_write "[ad_header "Add a field to $activity_name"]
+
+<h2>Add a field</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "activities.tcl" Activities] [list "activity.tcl?[export_url_vars activity_id]" Activity] [list "event.tcl?[export_url_vars event_id]" Event] "Custom Field"]
+<hr>
+<p>
+Add a field to the event, $activity_name, occurring on $compact_date in $pretty_location.
+<p>
+<form action=\"event-field-add-2.tcl\" method=POST>
+[export_form_vars event_id after]
+
+Column Actual Name:  <input name=column_name type=text size=30>
+<br>
+<i>no spaces or special characters except underscore</i>
+
+<p>
+
+Column Pretty Name:  <input name=pretty_name type=text size=30>
+
+<p>
+
+
+Column Type:  [ad_user_group_column_type_widget]
+<p>
+
+Column Actual Type:  <input name=column_actual_type type=text size=30>
+(used to feed Oracle, e.g., <code>char(1)</code> instead of boolean)
+
+
+<p>
+
+If you're a database wizard, you might want to add some 
+extra SQL, such as \"not null\"<br>
+Extra SQL: <input type=text size=30 name=column_extra>
+
+<p>
+
+(note that you can only truly add not null columns when the table is
+empty, i.e., before anyone has entered the contest)
+
+<p>
+
+<input type=submit value=\"Add this new column\">
+
+</form>
+
+[ad_footer]
+"
Index: web/openacs/www/events/admin/event-field-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/event-field-delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/event-field-delete-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,43 @@
+set_the_usual_form_variables
+
+# event_id, column_name
+
+validate_integer event_id $event_id
+
+set db [ns_db gethandle]
+
+set table_name [events_helper_table_name $event_id]
+
+with_transaction $db {
+    ns_db dml $db "delete from events_event_fields
+where event_id = $event_id
+and column_name = '$QQcolumn_name'"
+    ns_db dml $db "alter table $table_name drop column $column_name"
+} {
+    ad_return_error "Deletion Failed" "We were unable to drop the column $column_name from the event due to a database error:
+<pre>
+$errmsg
+</pre>
+"
+    return
+}
+
+ns_return 200 text/html "[ad_header "Field Removed"]
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "activities.tcl" Activities] [list "activity.tcl?[export_url_vars activity_id]" Activity] [list "event.tcl?[export_url_vars event_id]" Event] "Custom Field"]
+<h2>Field Removed</h2>
+
+from the event.
+
+<hr>
+
+The following action has been taken:
+
+<ul>
+
+<li>the column \"$column_name\" was removed from the table
+$table_name.
+<li>a row was removed from the table events_event_fields.
+</ul>
+
+[ad_footer]
+"
\ No newline at end of file
Index: web/openacs/www/events/admin/event-field-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/event-field-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/event-field-delete.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,38 @@
+set_the_usual_form_variables
+# event_id, column_name, pretty_name
+
+validate_integer event_id $event_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select 
+a.activity_id, a.short_name as activity_name, v.city,
+v.usps_abbrev, v.iso, display_after, 
+to_char(start_time, 'fmDay, fmMonth DD, YYYY') as compact_date
+from events_events e, events_activities a, 
+events_venues v
+where e.event_id = $event_id
+and e.activity_id = a.activity_id
+and v.venue_id = e.venue_id
+"]
+
+set_variables_after_query
+set pretty_location [events_pretty_location $db $city $usps_abbrev $iso]
+
+ns_return 200 text/html "[ad_header "Delete Field From Event"]
+
+<h2>Delete Column $column_name</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "activities.tcl" Activities] [list "activity.tcl?[export_url_vars activity_id]" Activity] [list "event.tcl?[export_url_vars event_id]" Event] "Custom Field"]
+<hr>
+
+<form action=\"event-field-delete-2.tcl\" method=POST>
+[export_form_vars event_id column_name]
+
+Do you really want to remove this field from the event, $activity_name, occurring on $compact_date in $pretty_location?<p>
+You may not be able to undo this action.
+<center>
+<input type=submit value=\"Yes, Remove This Field\">
+</center>
+
+[ad_footer]
+"
\ No newline at end of file
Index: web/openacs/www/events/admin/event-field-swap.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/event-field-swap.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/event-field-swap.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,26 @@
+# Swaps two sort keys for group_type, sort_key and sort_key + 1.
+
+set_the_usual_form_variables
+# event_id, sort_key
+
+validate_integer event_id $event_id
+
+set db [ns_db gethandle]
+
+set next_sort_key [expr $sort_key + 1]
+
+with_catch errmsg {
+    ns_db dml $db "update events_event_fields
+set sort_key = decode(sort_key, $sort_key, $next_sort_key, $next_sort_key, $sort_key)
+where event_id = $event_id
+and sort_key in ($sort_key, $next_sort_key)"
+
+    ns_returnredirect "event.tcl?event_id=$event_id"
+} {
+    ad_return_error "Database error" "A database error occured while trying
+to swap your event fields. Here's the error:
+<pre>
+$errmsg
+</pre>
+"
+}
\ No newline at end of file
Index: web/openacs/www/events/admin/event-price-ae-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/event-price-ae-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/event-price-ae-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,106 @@
+#not supporting prices at this time
+return
+
+set user_id [ad_maybe_redirect_for_registration]
+
+set_the_usual_form_variables
+#event_id, maybe product_id, product_name, price, available_date, expire_date, price_id
+
+validate_integer event_id $event_id
+validate_integer price_id $price_id
+
+set db [ns_db gethandle]
+
+set exception_count 0
+set exception_text ""
+
+if { [ns_dbformvalue [ns_conn form] available_time datetime available_time_value] <= 0 } {
+    incr exception_count
+    append exception_text "<li>Strange... couldn't parse the available time.\n"
+}
+
+if { [ns_dbformvalue [ns_conn form] expire_time datetime expire_time_value] <= 0 } {
+    incr exception_count
+    append exception_text "<li>Strange... couldn't parse the expiration
+time.\n"
+}
+
+if {![exists_and_not_null product_name]} {
+    incr exception_count
+    append exception_text "<li>Please enter a price description.\n"
+}
+
+if {![exists_and_not_null price]} {
+    incr excpetion_count
+    append exception_text "<li>Please enter a price.\n"
+}
+
+if {![valid_number_p $price]} {
+    incr exception_count
+    append exception_text "<li>Please enter a valid number for the price.\n"
+}
+    
+
+#check the dates
+set selection [ns_db 0or1row $db "select 1 from dual, events_events
+where to_date('$available_time_value', 'YYYY-MM-DD HH24:MI:SS') <
+to_date('$expire_time_value', 'YYYY-MM-DD HH24:MI:SS')
+and
+to_date('$expire_time_value', 'YYYY-MM-DD HH24:MI:SS') <=
+end_time
+and event_id = $event_id"]
+
+if {[empty_string_p $selection]} {
+    incr exception_count
+    append exception_text "<li>
+    Please make sure your avaiable time is before your
+    expiration time and your expiration time no later than 
+    your event's end time.\n"
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+#ns_db dml $db "begin transaction"
+
+#ns_db dml $db "update ec_products
+#set product_name = '$QQproduct_name',
+#price = $price,
+#last_modified = sysdate,
+#last_modifying_user = $user_id,
+#modified_ip_address = '[DoubleApos [ns_conn peeraddr]]',
+#available_date = to_date('$available_time_value', 'YYYY-MM-DD HH24:MI:SS')
+#where product_id = $product_id"
+
+ns_db dml $db "update events_prices
+set expire_date = to_date('$expire_time_value', 'YYYY-MM-DD HH24:MI:SS'),
+available_date = to_date('$available_time_value', 'YYYY-MM-DD HH24:MI:SS'),
+description='$QQproduct_name',
+price = $price
+where price_id = $price_id
+"
+
+if {[ns_ora resultrows $db] == 0} {
+#    ns_db dml $db "insert into ec_products
+#    (product_id, product_name, creation_date, price, available_date,
+#    last_modified, last_modifying_user, modified_ip_address)
+#    values
+#    ($product_id, '$QQproduct_name', sysdate, $price,
+#    to_date('$available_time_value', 'YYYY-MM-DD HH24:MI:SS'),
+#    sysdate, $user_id, '[DoubleApos [ns_conn peeraddr]]')"
+    
+    ns_db dml $db "insert into events_prices
+    (price_id, event_id, description, expire_date,
+    available_date, price)
+    values
+    ($price_id, $event_id, '$QQproduct_name', 
+    to_date('$expire_time_value', 'YYYY-MM-DD HH24:MI:SS'),
+    to_date('$available_time_value', 'YYYY-MM-DD HH24:MI:SS'),
+    $price)"
+}
+
+#ns_db dml $db "end transaction"
+
+ns_returnredirect "event.tcl?[export_url_vars event_id]"
Index: web/openacs/www/events/admin/event-price-ae.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/event-price-ae.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/event-price-ae.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,91 @@
+#not supporting prices at this time
+return
+
+set_the_usual_form_variables
+#event_id, maybe price_id
+
+validate_integer event_id $event_id
+
+
+set db [ns_db gethandle]
+
+set time_elements "
+<tr>
+ <td>Date available:
+ <td>[_ns_dateentrywidget available_time] [_ns_timeentrywidget available_time]
+<tr>
+ <td>Date expires:
+ <td>[_ns_dateentrywidget expire_time] [_ns_timeentrywidget expire_time]
+"
+
+if {[exists_and_not_null price_id]} {
+    #we're editing
+    set adding_p 0
+    
+    validate_integer price_id $price_id
+
+    set page_title "Edit Price"
+    set submit_text "Update Price"
+    set selection [ns_db 1row $db "select
+    product_id, price, description as product_name, 
+    to_char(available_date, 'YYYY-MM-DD HH24:MI:SS') as available_timestamp,
+    to_char(expire_date, 'YYYY-MM-DD HH24:MI:SS') as expire_timestamp,
+    price_id
+    from events_prices
+    where price_id = $price_id"]
+
+    set_variables_after_query
+
+    set end_time [database_to_tcl_string $db "
+    select to_char(end_time, 'YYYY-MM-DD HH24:MI:SS')
+    from events_events
+    where event_id = $event_id"]
+
+} else {
+    #we're adding
+    set adding_p 1
+
+    set page_title "Add New Price"
+    set submit_text "Add Price"
+#    set product_id [database_to_tcl_string $db "select ec_product_id_sequence.nextval from dual"]
+    set product_name ""
+    set price ""
+    set price_id [database_to_tcl_string $db "select events_price_id_sequence.nextval from dual"]
+
+    set selection [ns_db 1row $db "select
+    to_char(sysdate, 'YYYY-MM-DD HH24:MI:SS') as available_timestamp,
+    to_char(end_time, 'YYYY-MM-DD HH24:MI:SS') as expire_timestamp
+    from events_events, dual
+    where event_id = $event_id"]
+    set_variables_after_query
+    
+    set end_time $expire_timestamp
+}
+
+set stuffed_with_a [ns_dbformvalueput $time_elements "available_time" "timestamp" $available_timestamp]
+set times [ns_dbformvalueput $stuffed_with_a "expire_time" "timestamp" $expire_timestamp]
+
+set context_bar "[ad_admin_context_bar [list "index.tcl" "Events"] "Pricing"]"
+
+ReturnHeaders
+ns_write "
+[ad_partner_header]
+<form method=post action=\"event-price-ae-2.tcl\">
+[export_form_vars price_id product_id event_id]
+
+<table cellpadding=5>
+<tr>
+ <td>Price Description:
+ <td><input type=text size=30 name = \"product_name\" value=\"$product_name\">
+<tr>
+ <td>Price:
+ <td><input type=text size=10 name = \"price\" value=\"$price\">
+$times
+<td>(Expiration date can be no later than $end_time)
+</table>
+<p>
+<center>
+<input type=submit value=\"$submit_text\">
+</center>
+</form>
+[ad_partner_footer]"
Index: web/openacs/www/events/admin/event-toggle-available-p.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/event-toggle-available-p.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/event-toggle-available-p.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,12 @@
+set_the_usual_form_variables
+
+# event_id
+
+validate_integer event_id $event_id
+
+set db [ns_db gethandle]
+
+ns_db dml $db "update events_events 
+set available_p = logical_negation(available_p) where event_id = $event_id"
+
+ns_returnredirect "event.tcl?event_id=$event_id"
Index: web/openacs/www/events/admin/event-update-additional-note.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/event-update-additional-note.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/event-update-additional-note.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,13 @@
+set_the_usual_form_variables
+
+# event_id, additional_note
+
+validate_integer event_id $event_id
+
+set db [ns_db gethandle]
+
+ns_db dml $db "update events_events 
+set additional_note = '$QQadditional_note'
+where event_id = $event_id"
+
+ns_returnredirect "event.tcl?event_id=$event_id"
Index: web/openacs/www/events/admin/event-update-av-note.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/event-update-av-note.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/event-update-av-note.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,13 @@
+set_the_usual_form_variables
+
+# event_id, av_note
+
+validate_integer event_id $event_id
+
+set db [ns_db gethandle]
+
+ns_db dml $db "update events_events 
+set av_note = '$QQav_note'
+where event_id = $event_id"
+
+ns_returnredirect "event.tcl?event_id=$event_id"
Index: web/openacs/www/events/admin/event-update-refreshments-note.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/event-update-refreshments-note.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/event-update-refreshments-note.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,13 @@
+set_the_usual_form_variables
+
+# event_id, refreshments_note
+
+validate_integer event_id $event_id
+
+set db [ns_db gethandle]
+
+ns_db dml $db "update events_events 
+set refreshments_note = '$QQrefreshments_note'
+where event_id = $event_id"
+
+ns_returnredirect "event.tcl?event_id=$event_id"
Index: web/openacs/www/events/admin/event.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/event.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/event.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,356 @@
+set_the_usual_form_variables
+# event_id
+
+validate_integer event_id $event_id
+
+ReturnHeaders
+
+set db_pools [ns_db gethandle subquery 2]
+set db [lindex $db_pools 0]
+set db_sub [lindex $db_pools 1]
+
+
+set selection [ns_db 1row $db "select 
+a.activity_id, a.short_name, v.city,
+v.usps_abbrev, v.iso, display_after, 
+to_char(start_time, 'Day, Month DD, YYYY') as compact_date, 
+to_char(start_time, 'YYYY-MM-DD HH24:MI') as start_pretty_time, 
+to_char(end_time, 'YYYY-MM-DD HH24:MI') as end_pretty_time,
+to_char(reg_deadline, 'YYYY-MM-DD HH24:MI') as deadline_pretty_time,  
+u.first_names || ' ' || u.last_name as creator_name,
+e.available_p,
+e.max_people,
+e.refreshments_note, 
+e.av_note,
+e.additional_note,
+case when e.reg_cancellable_p= 't' then 'yes'
+     when e.reg_cancellable_p= 'f' then 'no' else 'no' end
+   as reg_cancellable_p,
+case when e.reg_needs_approval_p= 't' then 'yes'
+     when e.reg_needs_approval_p= 'f' then 'no' else 'no' end
+   as reg_needs_approval_p
+from events_events e, events_activities a, users u,
+events_venues v
+where e.event_id = $event_id
+and e.activity_id = a.activity_id
+and v.venue_id = e.venue_id
+and u.user_id = e.creator_id
+"]
+
+set_variables_after_query
+set pretty_location [events_pretty_location $db_sub $city $usps_abbrev $iso]
+
+#release the handles for ad_header
+ns_db releasehandle $db
+ns_db releasehandle $db_sub
+
+ns_write "[ad_header "$pretty_location: $compact_date"]"
+
+set db [ns_db gethandle]
+
+ns_write "
+<h2>$pretty_location: $compact_date</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "activities.tcl" Activities] [list "activity.tcl?[export_url_vars activity_id]" Activity] "Event"]
+<hr>
+
+<ul>
+"
+
+set n_orders [database_to_tcl_string $db "select count(*) 
+from events_reg_not_canceled e, events_prices p
+where p.price_id = e.price_id
+and p.event_id = $event_id
+"]
+
+set sql_post_select "from users, events_registrations r, events_prices p
+where p.event_id = $event_id
+and users.user_id = r.user_id
+and p.price_id = r.price_id
+"
+
+if { $n_orders > 1 } {
+    ns_write "<li><a href=\"order-history-one-event.tcl?event_id=$event_id\">View All $n_orders Orders for this Event</a>\n
+"
+} elseif { $n_orders == 1 } {
+    ns_write "<li><a href=\"order-history-one-event.tcl?event_id=$event_id\">View the Single Order for this Event</a>\n
+"
+} else {
+    ns_write "<li>There have been no orders for this event\n"
+}
+
+ns_write "<li><a href=\"/events/order-one.tcl?event_id=$event_id\">View the page that users see</a>
+<li><a href=\"spam-selected-event.tcl?event_id=$event_id\">Spam this event</a>
+
+</ul>
+
+
+<table cellpadding=3>
+<tr>
+  <th valign=top>Creator</th>
+  <td valign=top>$creator_name</td>
+<tr>
+  <th valign=top>Location</th>
+  <td valign=top>$pretty_location</td>
+</tr>
+<tr>
+  <th valign=top>Confirmation Message</th>
+  <td valign=top>$display_after</td>
+</tr>
+<tr>
+  <th valign=top>Start Time</th>
+  <td valign=top>$start_pretty_time</td>
+<tr>
+  <th valign=top>End Time</th>
+  <td valign=top>$end_pretty_time</td>
+</tr>
+<tr>
+  <th valign=top>Registration Deadline</th>
+  <td valign=top>$deadline_pretty_time</td>
+</tr>
+<tr>
+ <th valign=top>Maximum Capacity
+ <td valign=top>$max_people
+<tr>
+ <th valign=top>Registration Cancellable?
+ <td valign=top>$reg_cancellable_p
+<tr>
+ <th valign=top>Registration Needs Approval?
+ <td valign=top>$reg_needs_approval_p
+<tr>
+  <th valign=top>Availability Status</th>
+"
+if {[string compare $available_p "t"] == 0} {
+    ns_write "<td valign=top>Current"
+} else {
+    ns_write "<td valign=top>Discontinued"
+}
+
+ns_write " &nbsp; (<a href=\"event-toggle-available-p.tcl?event_id=$event_id\">toggle</a>)
+"
+if {[string compare $available_p "f"] == 0 && $n_orders > 0} {
+    ns_write "
+    <br><font color=red>You may want to 
+    <a href=\"spam/action-choose.tcl?[export_url_vars sql_post_select]\">spam the registrants for this event</a>
+    to notify them the event is canceled.</font>"
+}
+
+
+ns_write "
+</table>
+<ul><li><a href=\"event-edit.tcl?[export_url_vars event_id]\">
+     Edit Event Properties</a></ul>"
+
+#ns_write "
+#<h3>Pricing</h3>
+#<ul>
+#"
+
+#set selection [ns_db select $db "select
+#price_id, description as product_name,
+#decode (price, 0, 'free', price) as pretty_price, 
+#description, available_date,
+#expire_date
+#from events_prices
+#where event_id = $event_id"]
+#
+#while {[ns_db getrow $db $selection]} {
+#    set_variables_after_query
+#
+#    if {$pretty_price != "free"} {
+#	set pretty_price  $[util_commify_number $pretty_price]
+#    }
+#
+#    ns_write "<li>
+#    <a href=\"event-price-ae.tcl?[export_url_vars event_id price_id]\">
+#    $product_name</a>: $pretty_price
+#    (available [util_AnsiDatetoPrettyDate $available_date] to
+#    [util_AnsiDatetoPrettyDate $expire_date])"
+#}
+#
+#ns_write "
+#<br><br>
+#<li><a href=\"event-price-ae.tcl?[export_url_vars event_id]\">
+#Add a special price</a> 
+#(student discount, late price, etc.)
+#</ul>"
+
+ns_write "
+<h3>Custom Fields</h3>
+You may define custom fields which you would like to
+collect from registrants.
+<p>
+<table>
+"
+
+set number_of_fields [database_to_tcl_string $db "select count(*) from events_event_fields where event_id=$event_id"]
+
+set selection [ns_db select $db "select 
+column_name, pretty_name, column_type, column_actual_type,
+column_extra, sort_key
+from events_event_fields
+where event_id = $event_id
+order by sort_key
+"]
+
+set counter 0 
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    incr counter 
+
+    if { $counter == $number_of_fields } {
+	ns_write "<tr><td><ul><li>$column_name ($pretty_name), $column_actual_type ($column_type) $column_extra<td><font size=-1 face=\"arial\">\[&nbsp;<a href=\"event-field-add.tcl?event_id=$event_id&after=$sort_key\">insert&nbsp;after</a>&nbsp;|&nbsp;<a href=\"event-field-delete.tcl?[export_url_vars event_type column_name event_id]\">delete</a>&nbsp;\]</font></ul>\n"
+    } else {
+	ns_write "<tr><td><ul><li>$column_name ($pretty_name), $column_actual_type ($column_type) $column_extra<td><font size=-1 face=\"arial\">\[&nbsp;<a href=\"event-field-add.tcl?event_id=$event_id&after=$sort_key\">insert&nbsp;after</a>&nbsp;|&nbsp;<a href=\"event-field-swap.tcl?event_id=$event_id&sort_key=$sort_key\">swap&nbsp;with&nbsp;next</a>&nbsp;|&nbsp;<a href=\"event-field-delete.tcl?[export_url_vars event_id column_name]\">delete</a>&nbsp;\]</font></ul>\n"
+    }
+}
+
+if { $counter == 0 } {
+    ns_write "
+    <tr><td><ul><li>no custom fields currently collected</ul>
+    "
+}
+
+
+ns_write "
+</table>
+<p>
+<ul>
+<li><a href=\"event-field-add.tcl?[export_url_vars event_id]\">add a field</a>
+</ul>
+<h3>Organizers</h3>
+<ul>
+"
+
+set selection [ns_db select $db "select 
+u.first_names || ' ' || u.last_name as organizer_name,
+u.user_id,
+om.role
+from events_organizers_map om, users u
+where event_id=$event_id
+and u.user_id = om.user_id
+"]
+
+set org_counter 0
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    ns_write "<li><a href=\"organizer-edit.tcl?[export_url_vars user_id event_id]\">$organizer_name: $role</a>\n"
+    incr org_counter
+}
+
+if {$org_counter == 0} {
+    ns_write "<li>There are no organizers for this event"
+}
+
+set sql_post_select "from users, events_organizers_map m
+where m.event_id = $event_id
+and users.user_id = m.user_id"
+
+ns_write "<br><br>
+<li><a href=\"organizer-add.tcl?[export_url_vars event_id]\">Add another organizer</a>
+"
+if {$org_counter > 0} {
+    ns_write "<li><a href=\"spam/action-choose.tcl?[export_url_vars sql_post_select]\">Spam all the organizers for this event</a>"
+}
+
+ns_write "</ul>"
+
+set return_url "/events/admin/event.tcl?event_id=$event_id"
+set on_which_table "events_events"
+set on_what_id "$event_id"
+
+ns_write "
+<h3>Agenda Files</h3>
+<ul>
+"
+
+set selection [ns_db select $db "select 
+file_title, file_id 
+from events_file_storage
+where on_which_table = '$on_which_table'
+and on_what_id = '$on_what_id'"]
+
+set agenda_count 0
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    ns_write "<li>
+    <a href=\"attach-file/download.tcl?[export_url_vars file_id]\">
+    $file_title</a> |
+    <a href=\"attach-file/file-remove.tcl?[export_url_vars file_id return_url]\">
+    Remove this file\n
+    "
+    incr agenda_count
+}
+
+if {$agenda_count == 0} {
+    ns_write "<li>There are no agenda files for this event"
+}
+
+ns_write "<br><br>
+<li><a href=\"attach-file/upload.tcl?[export_url_vars return_url on_which_table on_what_id]\">Upload an agenda file</a>
+</ul>
+"
+
+set group_link [ad_urlencode [database_to_tcl_string $db "select
+ug.short_name from user_groups ug, events_events e
+where ug.group_id = e.group_id
+and e.event_id = $event_id"]]
+
+ns_write "<h3>Event User Group</h3>
+You may manage the user group for this event.
+<ul>
+<li><a href=\"/groups/admin/$group_link/\">Manage this event's user
+group</a>
+</ul>
+"
+
+#set selection [ns_db select $db "select 1 from
+#events_calendar_seeds
+#where activity_id = $activity_id"]
+
+#if {![empty_string_p $selection]} {
+#    ns_write "<h3>Event Calendars</h3>
+#    This event's activity has a default calendar.  You may populate
+#    this event's calendar or the site calendar based upon this default
+#    activity calendar.
+#    <p>
+#    <ul>
+#    <li><a href=\"calendars/index.tcl?[export_url_vars event_id]\">Manage event calendars</a>
+#    </ul>
+#    "
+#}
+
+ns_write "
+<h3>Event Notes</h3>
+<table>
+<tr>
+  <th valign=top>Refreshments Note</th>
+  <td><form method=POST action=\"event-update-refreshments-note.tcl\">
+      [export_form_vars event_id]
+      <textarea name=refreshments_note rows=6 cols=65 wrap=soft>$refreshments_note</textarea>
+      <br>
+      <input type=submit value=\"Update\">
+      </form>
+</tr>
+<tr>
+  <th valign=top>Audio/Visual Note</th>
+  <td><form method=POST action=\"event-update-av-note.tcl\">
+      [export_form_vars event_id]
+      <textarea name=av_note rows=6 cols=65 wrap=soft>$av_note</textarea>
+      <br>
+      <input type=submit value=\"Update\">
+      </form>
+</tr>
+<tr>
+  <th valign=top>Additional Note</th>
+  <td><form method=POST action=\"event-update-additional-note.tcl\">
+      [export_form_vars event_id]
+      <textarea name=additional_note rows=6 cols=65 wrap=soft>$additional_note</textarea>
+      <br>
+      <input type=submit value=\"Update\">
+      </form>
+</tr>
+</table>
+[ad_footer]"
+
+
+
Index: web/openacs/www/events/admin/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/index.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,117 @@
+set admin_id [ad_maybe_redirect_for_registration]
+
+
+ReturnHeaders
+
+ns_write "[ad_header "[ad_system_name] Events Administration"]"
+
+set db_pools [ns_db gethandle subquery 2]
+set db [lindex $db_pools 0]
+set db_sub [lindex $db_pools 1]
+
+
+#this is for stuffing into the spam module
+set sql_post_select "from users, events_reg_shipped r
+where users.user_id = r.user_id
+"
+
+ns_write "
+<h2>Events Administration</h2>
+[ad_context_bar_ws "Events Administration"]
+
+
+<hr>
+<ul>
+<li><a href=\"activities.tcl\">View/Add/Edit Activities</a>
+<li><a href=\"venues.tcl\">View/Add/Edit Venues</a>
+<li><a href=\"order-history.tcl\">Order History</a>
+<li><a href=\"spam/action-choose.tcl?[export_url_vars sql_post_select]\">Spam Everyone</a>
+<li><a href=\"spam-selected-events.tcl\">Spam Selected Events</a>
+</ul>
+
+<h3>Current Events Registration Status</h3>
+<table cellpadding=5>
+<blockquote><table cellpadding=5>
+<tr>
+ <th>Event
+ <th>Confirmed 
+ <th>Pending 
+ <th>Wait-Listed
+</tr>
+"
+
+set selection [ns_db select $db "
+select e.event_id, v.city, 
+e.start_time, 
+events_count_reg_shipped_by_price_id(p.price_id) as n_orders,
+events_count_pending_orders_by_price_id(p.price_id) as n_pending,
+events_count_waiting_orders_by_price_id(p.price_id) as n_waiting
+from events_events e, events_activities a,
+events_venues v, events_prices p
+where e.start_time > sysdate()
+and e.activity_id = a.activity_id
+and v.venue_id = e.venue_id
+and e.available_p = 't'
+and p.event_id = e.event_id
+and a.group_id in (select distinct group_id
+                   from user_group_map
+                   where user_id = $admin_id)
+union
+select e.event_id, v.city, 
+e.start_time, 
+events_count_reg_shipped_by_price_id(p.price_id) as n_orders,
+events_count_pending_orders_by_price_id(p.price_id) as n_pending,
+events_count_waiting_orders_by_price_id(p.price_id) as n_waiting
+from events_events e, events_activities a,
+events_venues v, events_prices p
+where e.start_time > sysdate()
+and e.activity_id = a.activity_id
+and v.venue_id = e.venue_id
+and e.available_p = 't'
+and a.group_id is null
+and p.event_id = e.event_id
+order by start_time
+
+"]
+#    <td><a href=\"event.tcl?[export_url_vars event_id]\">
+#    $city, [util_AnsiDatetoPrettyDate $start_time]</a>\n
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    ## PG 6.5 kludge fix
+    if {$event_id == ""} {
+	continue
+    }
+
+    set event [events_pretty_event $db_sub $event_id]
+    regsub -all " from " $event "<br>from " event
+    ns_write "
+    <tr>\n
+    <td><a href=\"event.tcl?event_id=$event_id\">$event</a>
+    <td><a href=\"order-history-one-event.tcl?[export_url_vars event_id]\">
+    $n_orders</a>\n
+    "
+    if {$n_pending > 0} {
+	ns_write "    
+	<td><a href=\"reg-pending.tcl?[export_url_vars event_id]\">
+	$n_pending</a>\n"
+    } else {
+	ns_write "
+	<td>$n_pending\n"
+    }
+
+    if {$n_waiting > 0} {
+	ns_write "    
+	<td><a href=\"reg-waiting.tcl?[export_url_vars event_id]\">
+	$n_waiting</a>\n"
+    } else {
+	ns_write "
+	<td>$n_waiting\n"
+    }
+
+}
+
+ns_write "</table></blockquote>"
+
+
+ns_write "[ad_footer]"
Index: web/openacs/www/events/admin/order-cancel-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/order-cancel-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/order-cancel-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,81 @@
+# order-cancel-2.tcl,v 1.1.4.2 2000/02/03 09:49:09 ron Exp
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_the_usual_form_variables
+#order_id
+
+validate_integer order_id $order_id
+
+set db [ns_db gethandle]
+
+
+
+set selection [ns_db 0or1row $db "select 1 from
+evreg_orders
+where order_id = $order_id
+"]
+
+if {[empty_string_p $selection]} {
+    ReturnHeaders
+    ns_write "
+    [ad_header "Could not find order"]
+    <h2>Already Registered</h2>
+    <a href=\"index.tcl\">[ad_system_name] events</a> 
+    <hr>
+    Order $order_id was not found in the database.
+
+    [ad_footer]"
+
+    return
+}
+
+ns_db dml $db "update evreg_orders
+set canceled_p = 't'
+where order_id = $order_id"
+
+ns_write "[ad_header "Registration Canceled"]
+<h2>Registration Canceled</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] "Order History"]
+<hr>
+This registration has been canceled.
+<p>
+<a href=\"index.tcl\">Return to events administration</a>
+[ad_footer]
+"
+
+ns_conn close
+
+#e-mail the registrant to let him know we canceled his registration
+set from_email [database_to_tcl_string $db "select email from
+users where user_id = $user_id"]
+
+set to_email [database_to_tcl_string $db "select 
+u.email
+from users u, evreg_orders o
+where o.order_id = $order_id
+and u.user_id = o.user_id"]
+
+set selection [ns_db 1row $db "select
+a.short_name, e.start_time,
+v.city, v.usps_abbrev, v.iso
+from evreg_activities a, evreg_orders o, evreg_events e, evreg_venues v
+where o.order_id = $order_id
+and e.event_id = o.event_id
+and a.activity_id = e.activity_id
+and v.venue_id = e.venue_id"]
+set_variables_after_query
+
+set email_subject "Registration Canceled"
+set email_body "Your registration for:\n
+$short_name
+[evreg_pretty_location $db $city $usps_abbrev $iso]
+[util_AnsiDatetoPrettyDate $start_time]\n
+has been canceled.\n
+
+[ad_parameter SystemURL]/events/
+"
+
+if [catch { ns_sendmail $to_email $from_email $email_subject $email_body } errmsg] {
+    ns_log Notice "failed sending confirmation email to customer: $errmsg"
+} 
Index: web/openacs/www/events/admin/order-cancel.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/order-cancel.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/order-cancel.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,44 @@
+# order-cancel.tcl,v 1.1.4.2 2000/02/03 09:49:10 ron Exp
+set_the_usual_form_variables
+#order_id
+
+validate_integer order_id $order_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select a.short_name
+from evreg_orders o, evreg_activities a, evreg_events e
+where order_id = $order_id
+and e.event_id = o.event_id
+and a.activity_id = e.activity_id"]
+
+if {[empty_string_p $selection]} {
+    ReturnHeaders
+    ns_write "
+    [ad_header "Could not find order"]
+    <h2>Already Registered</h2>
+    <a href=\"index.tcl\">[ad_system_name] events</a> 
+    <hr>
+    Order $order_id was not found in the database.
+
+    [ad_footer]"
+
+    return
+}
+
+set_variables_after_query
+
+ns_write "
+[ad_header "Cancel Registration"]
+<h2>Cancel Registration for $short_name</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] "Cancel Registration"]
+<hr>
+<form method=post action=\"order-cancel-2.tcl\">
+[export_form_vars order_id]
+Are you sure that you want to cancel this registration for $short_name?
+<p>
+<center>
+<input type=submit value=\"Yes, Cancel Registration\">
+</center>
+[ad_footer]
+"
\ No newline at end of file
Index: web/openacs/www/events/admin/order-comments-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/order-comments-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/order-comments-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,15 @@
+# order-comments-2.tcl,v 1.1.4.1 2000/02/03 09:49:11 ron Exp
+set_the_usual_form_variables
+
+#order_id, comments
+
+validate_integer order_id $order_id
+
+set db [ns_db gethandle]
+
+ns_db dml $db "update evreg_orders set
+comments='$QQcomments'
+where order_id = $order_id"
+
+ns_returnredirect "order-view.tcl?order_id=$order_id"
+
Index: web/openacs/www/events/admin/order-comments.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/order-comments.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/order-comments.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,51 @@
+# order-comments.tcl,v 1.1.4.2 2000/02/03 09:49:12 ron Exp
+set_the_usual_form_variables
+
+#order_id
+
+validate_integer order_id $order_id
+
+ReturnHeaders
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select o.comments, 
+a.short_name, 
+u.first_names, u.last_name, o.confirmed_date
+from evreg_orders o, evreg_activities a, evreg_events e, users u
+where o.event_id = e.event_id
+and e.activity_id = a.activity_id
+and u.user_id = o.user_id
+and o.order_id = $order_id"]
+
+set_variables_after_query
+
+ns_write "[ad_header "Add/Edit Comments Regarding Order #$order_id"]
+
+<h2>Add/Edit Comments Regarding Order #$order_id</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] "Order History"]
+
+<hr>
+
+<h3>Comments</h3>
+
+on this order from $first_names $last_name on $confirmed_date for $short_name
+
+<form method=post action=order-comments-2.tcl>
+[philg_hidden_input order_id $order_id]
+
+<textarea name=comments rows=4 cols=70 wrap=soft>$comments</textarea>
+
+<br>
+<br>
+
+<center>
+<input type=submit value=\"Submit Comments\">
+</center>
+</form>
+[ad_footer]
+"
+
+
+
+
Index: web/openacs/www/events/admin/order-history-activity.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/order-history-activity.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/order-history-activity.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,72 @@
+set admin_id [ad_maybe_redirect_for_registration]
+
+ReturnHeaders
+
+ns_write "[ad_header "[ad_system_name] Events Administration: Order History - By Activity"]
+
+<h2>Order History - By Activity</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "order-history.tcl" "Order History"] "By Activity"]
+
+<hr>
+
+<table border=2 cellpadding=5>
+<tr>
+<th align=center>Activity #
+<th align=center>Name
+<th align=center>Registrations
+"
+
+set db [ns_db gethandle]
+
+# count the number of orders (in events_registrations) for each activity_id in 
+# events_activities
+
+set selection [ns_db select $db "select 
+a.short_name, a.activity_id, 
+count(r.reg_id) as n_reg
+from events_activities a, events_registrations r, events_events e,
+events_prices p
+where p.event_id = e.event_id
+and p.price_id = r.price_id
+and a.activity_id = e.activity_id
+and a.group_id in (select distinct group_id
+		   from user_group_map
+		   where user_id = $admin_id)
+group by a.activity_id, a.short_name
+union
+select 
+a.short_name, a.activity_id, 
+0 as n_reg
+from events_activities a, events_events e,
+events_prices p
+where p.event_id = e.event_id
+and 0=(select count(*) from events_registrations where price_id= p.price_id)
+and a.activity_id = e.activity_id
+and a.group_id is null
+group by a.activity_id, a.short_name
+order by activity_id
+"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    ns_write "
+    <tr>
+     <td align=left>$activity_id
+     <td align=center>$short_name
+    "
+    if {$n_reg > 0} {
+	ns_write "
+	<td align=right><a href=\"order-history-one-activity.tcl?activity_id=$activity_id\">$n_reg</a></tr>\n"
+    } else {
+	ns_write "<td align=right>$n_reg"
+    }
+}
+ns_write "
+</table>
+
+[ad_footer]
+"
+
+
+
+
Index: web/openacs/www/events/admin/order-history-date.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/order-history-date.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/order-history-date.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,87 @@
+set admin_id [ad_maybe_redirect_for_registration]
+
+set_form_variables 0
+
+# optional reg_year and reg_month
+
+if [info exists reg_year] {
+    # assume that we got a month also
+    set page_title "Orders in $reg_month $reg_year"
+    set where_clause "
+where to_char(reg_date,'Month') = '$reg_month' 
+and to_char(reg_date,'YYYY') = '$reg_year'
+and "
+} else {
+    set page_title "Orders by Date"
+    set where_clause "where"
+}
+
+ReturnHeaders
+
+ns_write "[ad_header $page_title]
+
+<h2>$page_title</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "order-history.tcl" "Order History"] "By Date"]
+
+<hr>
+
+<table border=2 cellpadding=5>
+<tr>
+<th align=center>Date
+<th align=center>Orders
+"
+
+#set db [ns_db gethandle]
+set db_pools [ns_db gethandle subquery 2]
+set db [lindex $db_pools 0]
+set db_sub [lindex $db_pools 1]
+
+
+
+# count the number of orders (in events_registrations) for each date in 
+# events_registrations
+
+
+set selection [ns_db select $db "
+select 
+trunc(reg_date) as reg_date, 
+count(reg_id) as n_orders
+from events_registrations r, events_events e,
+events_prices p
+$where_clause
+p.event_id = e.event_id
+and p.price_id = r.price_id
+and r.reg_id not in 
+    (select distinct r.reg_id
+    from events_registrations r,events_activities a, events_events e,
+    events_prices p
+    $where_clause
+    p.event_id = e.event_id
+    and e.activity_id = a.activity_id
+    and p.price_id = r.price_id
+    and a.group_id not in
+     (select group_id from user_group_map
+      where user_id != $admin_id)
+)
+group by trunc(reg_date)
+order by reg_date desc"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    ns_write "<tr>
+    <td align=left>[util_IllustraDatetoPrettyDate $reg_date]
+    <td align=right><a href=\"order-history-one-date.tcl?reg_date=[ns_urlencode $reg_date]\">$n_orders</a>\n"
+   
+}
+
+
+ns_write "
+</table>
+
+[ad_footer]
+"
+
+
+
+
Index: web/openacs/www/events/admin/order-history-id.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/order-history-id.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/order-history-id.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,55 @@
+set admin_id [ad_maybe_redirect_for_registration]
+
+ReturnHeaders
+
+ns_write "[ad_header "[ad_system_name] Events Administration: Order History - By Registration Number"]
+
+<h2>Order History - By Registration Number</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "order-history.tcl" "Order History"] "By Registration Number"]
+
+<hr>
+<ul>
+"
+
+set db [ns_db gethandle]
+
+set selection [ns_db select $db "select 
+r.reg_id, r.reg_date, r.reg_state, 
+u.first_names, u.last_name, a.short_name
+from events_registrations r, events_activities a, events_events e, users u,
+events_prices p,
+user_group_map ugm
+where p.event_id = e.event_id
+and e.activity_id = a.activity_id
+and u.user_id = r.user_id
+and a.group_id = ugm.group_id
+and ugm.user_id = $admin_id
+and p.price_id = r.price_id
+union
+select 
+r.reg_id, r.reg_date, r.reg_state, 
+u.first_names, u.last_name, a.short_name
+from events_registrations r, events_activities a, events_events e, users u,
+events_prices p
+where p.event_id = e.event_id
+and e.activity_id = a.activity_id
+and u.user_id = r.user_id
+and a.group_id is null
+and p.price_id = r.price_id
+order by reg_id desc"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    ns_write "\n<li>"
+    events_write_order_summary
+}
+
+ns_write "
+</ul>
+
+[ad_footer]
+"
+
+
+
+
Index: web/openacs/www/events/admin/order-history-month.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/order-history-month.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/order-history-month.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,63 @@
+set admin_id [ad_maybe_redirect_for_registration]
+
+ReturnHeaders
+
+ns_write "[ad_header "[ad_system_name] Events Administration: Order History - By Month"]
+
+<h2>Order History - By Month</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "order-history.tcl" "Order History"] "By Month"]
+
+<hr>
+<table border=2 cellpadding=5>
+<tr>
+<th align=center>Month
+<th align=center>Orders
+"
+
+set db [ns_db gethandle]
+set selection [ns_db select $db "
+select 
+to_char(reg_date,'YYYY') as reg_year, 
+to_char(reg_date,'Month') as reg_month, 
+to_char(reg_date,'MM') as reg_month_number, 
+count(reg_id) as n_orders
+from events_registrations r, events_events e,
+events_prices p
+where p.event_id = e.event_id
+and p.price_id = r.price_id
+and r.reg_id not in 
+    (select distinct r.reg_id
+    from events_registrations r,events_activities a, events_events e,
+    events_prices p
+    where
+    p.event_id = e.event_id
+    and e.activity_id = a.activity_id
+    and p.price_id = r.price_id
+    and a.group_id not in
+     (select group_id from user_group_map
+      where user_id != $admin_id)
+)
+group by to_char(reg_date,'YYYY'), 
+to_char(reg_date,'Month'), to_char(reg_date,'MM')
+order by reg_year,reg_month
+"]
+
+# count the number of orders (in events_registrations) for each date in 
+# events_registrations
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    ns_write "<tr>
+    <td align=left>$reg_month $reg_year
+    <td align=right><a href=\"order-history-date.tcl?reg_month=[ns_urlencode $reg_month]&reg_year=[ns_urlencode $reg_year]\">$n_orders</a></tr>\n"
+}
+
+ns_write "
+</table>
+
+[ad_footer]
+"
+
+
+
+
Index: web/openacs/www/events/admin/order-history-one-activity.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/order-history-one-activity.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/order-history-one-activity.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,72 @@
+set_the_usual_form_variables
+#activity_id
+
+validate_integer activity_id $activity_id
+
+ReturnHeaders
+
+ns_write "[ad_header "[ad_system_name] Events Administration: Order History - By Activity"]"
+
+set db_pools [ns_db gethandle subquery 2]
+set db [lindex $db_pools 0]
+set db_sub [lindex $db_pools 1]
+
+set short_name [database_to_tcl_string $db "select short_name from events_activities where activity_id=$activity_id"]
+
+ns_write "
+<h2>Order History - For Activity # $activity_id ($short_name)</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "order-history.tcl" "Order History"] [list "order-history-activity.tcl" "By Activity"] "Activity"]
+
+<hr>
+
+<table border cellpadding=5>
+<tr>
+ <th>Event Location
+ <th>Date
+ <th>Number of Registrations
+"
+
+set selection [ns_db select $db "
+select 
+e.event_id, e.start_time, v.city, v.usps_abbrev, v.iso, 
+count(r.reg_id) as n_reg 
+from events_activities a, events_events e, events_registrations r,
+events_venues v, events_prices p
+where e.activity_id = a.activity_id
+and a.activity_id = $activity_id
+and p.event_id = e.event_id
+and p.price_id = r.price_id
+and v.venue_id = e.venue_id
+group by e.event_id, e.start_time, v.city, v.usps_abbrev, v.iso
+union
+select 
+e.event_id, e.start_time, v.city, v.usps_abbrev, v.iso, 
+0 as n_reg 
+from events_activities a, events_events e,
+events_venues v, events_prices p
+where e.activity_id = a.activity_id
+and a.activity_id = $activity_id
+and p.event_id = e.event_id
+and 0=(select count(*) from events_registrations where price_id = p.price_id)
+and v.venue_id = e.venue_id
+group by e.event_id, e.start_time, v.city, v.usps_abbrev, v.iso
+order by e.start_time desc"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    ns_write "<tr>
+    <td><a href=\"order-history-one-event.tcl?event_id=$event_id\">
+    [events_pretty_location $db_sub $city $usps_abbrev $iso]</a>
+    <td>[util_AnsiDatetoPrettyDate $start_time]
+    <td>$n_reg registrations"
+}
+  
+ns_write "
+</table>
+
+[ad_footer]
+"
+
+
+
+
Index: web/openacs/www/events/admin/order-history-one-date.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/order-history-one-date.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/order-history-one-date.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,58 @@
+set admin_id [ad_maybe_redirect_for_registration]
+
+set_the_usual_form_variables
+# reg_date
+
+ReturnHeaders
+
+ns_write "[ad_header "Orders for [util_IllustraDatetoPrettyDate $reg_date]"]
+
+<h2>Orders for [util_IllustraDatetoPrettyDate $reg_date]</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "order-history.tcl" "Order History"] "By Date"]
+
+<hr>
+
+<ul>
+"
+
+set db [ns_db gethandle]
+
+set selection [ns_db select $db "select r.reg_id,
+r.reg_state, u.first_names, u.last_name, a.short_name
+from events_registrations r, events_activities a, events_events e, users u,
+events_prices p, user_group_map ugm
+where trunc(reg_date) = '$reg_date'
+and e.activity_id = a.activity_id
+and p.event_id = e.event_id
+and u.user_id = r.user_id
+and a.group_id = ugm.group_id
+and ugm.user_id = $admin_id
+and p.price_id = r.price_id
+union
+select r.reg_id,
+r.reg_state, u.first_names, u.last_name, a.short_name
+from events_registrations r, events_activities a, events_events e, users u,
+events_prices p
+where trunc(reg_date) = '$reg_date'
+and e.activity_id = a.activity_id
+and p.event_id = e.event_id
+and u.user_id = r.user_id
+and a.group_id is null
+and p.price_id = r.price_id
+order by reg_id desc"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    ns_write "\n<li>"
+    events_write_order_summary
+}
+  
+ns_write "
+</ul>
+
+[ad_footer]
+"
+
+
+
+
Index: web/openacs/www/events/admin/order-history-one-event.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/order-history-one-event.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/order-history-one-event.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,132 @@
+set admin_id [ad_maybe_redirect_for_registration]
+
+set_the_usual_form_variables
+
+# event_id, maybe order_by
+
+validate_integer event_id $event_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select 
+a.short_name, a.activity_id,
+v.city, v.usps_abbrev, v.iso,
+to_char(e.start_time, 'YYYY-MM-DD') as start_date, 
+to_char(e.start_time, 'HH:MI AM') as start_pretty_time
+from events_events e, events_activities a, events_venues v
+where e.activity_id = a.activity_id
+and e.event_id = $event_id
+and v.venue_id = e.venue_id
+"]
+set_variables_after_query
+
+ReturnHeaders
+
+
+ns_write "
+<h2>Order History - For Event # $event_id ($short_name)</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "order-history.tcl" "Order History"] [list "order-history-activity.tcl" "By Activity"] [list "order-history-one-activity.tcl?[export_url_vars activity_id]" "Activity"] "Event"]
+
+
+<hr>
+[events_pretty_location $db $city $usps_abbrev $iso]
+on [util_AnsiDatetoPrettyDate $start_date] at $start_pretty_time
+<p>
+"
+
+if { [info exists order_by] && $order_by == "name" } {
+    set order_by_clause "last_name, first_names"
+    set option "<a href=\"order-history-one-event.tcl?event_id=$event_id&order_by=reg_id\">sort by time of order</a>"
+} else {
+    set order_by_clause "reg_id desc"
+    set option "<a href=\"order-history-one-event.tcl?event_id=$event_id&order_by=name\">sort by last name</a>"
+}
+
+ns_write "
+
+$option
+
+<ul>
+"
+
+set selection [ns_db select $db "select 
+r.reg_id, r.reg_state,
+u.first_names || ' ' || u.last_name as user_name, u.last_name, u.first_names,
+u.email, r.reg_date,
+r.org, r.title_at_org, r.where_heard
+from events_registrations r, users u,
+events_activities a, events_events e, events_prices p,
+user_group_map ugm
+where p.event_id = $event_id
+and p.price_id = r.price_id
+and u.user_id = r.user_id
+and e.activity_id = a.activity_id
+and a.group_id = ugm.group_id
+and ugm.user_id = $admin_id
+union
+select 
+r.reg_id, r.reg_state,
+u.first_names || ' ' || u.last_name as user_name, u.last_name, u.first_names,
+u.email, r.reg_date,
+r.org, r.title_at_org, r.where_heard
+from events_registrations r, users u,
+events_activities a, events_events e, events_prices p
+where p.event_id = $event_id
+and p.price_id = r.price_id
+and u.user_id = r.user_id
+and e.activity_id = a.activity_id
+and a.group_id is null
+order by $order_by_clause
+"]
+
+set counter 0
+set registrants ""
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    if {$reg_state == "canceled"} {
+	set canceled_text " <font color=red>(canceled)</font>"
+    } else {
+	set canceled_text ""
+    }
+
+    incr counter
+    # we don't use events_write_order_summary because it would repeat too
+    # much info from the above title
+    append registrants "<li><a href=\"reg-view.tcl?reg_id=$reg_id\">$reg_id</a> from $user_name ($email) on $reg_date\n"
+
+    if ![empty_string_p $org] {
+	append registrants ", from $org"
+    } 
+
+    if ![empty_string_p $title_at_org] {
+	append registrants " ($title_at_org)"
+    }
+
+    append registrants "$canceled_text"
+
+#    if ![empty_string_p $attending_reason] {
+#	append registrants "<blockquote><b>reason:</b> $attending_reason</blockquote>"
+#    }
+
+    if ![empty_string_p $where_heard] {
+	append registrants "<blockquote><b>where heard:</b> $where_heard</blockquote>"
+    }
+}
+  
+if { $counter == 0 } {
+    ns_write "no orders found"
+} else {
+    ns_write $registrants
+}
+
+ns_write "
+</ul>
+
+[ad_footer]
+"
+
+
+
+
Index: web/openacs/www/events/admin/order-history-one-state.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/order-history-one-state.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/order-history-one-state.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,63 @@
+set admin_id [ad_maybe_redirect_for_registration]
+
+set_the_usual_form_variables
+# reg_state
+
+ReturnHeaders
+
+ns_write "[ad_header "[ad_system_name] Events Administration: Order History - By Registration State"]
+
+<h2>Order History - For Registration State \"$reg_state\"</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "order-history.tcl" "Order History"] [list "order-history-state.tcl" "By Registration State"] "$reg_state"]
+
+<hr>
+
+<ul>
+"
+
+set db [ns_db gethandle]
+
+set selection [ns_db select $db "select 
+r.reg_id, r.reg_state, 
+u.first_names, u.last_name, a.short_name
+from events_registrations r, events_prices p,
+events_activities a, events_events e, users u,
+user_group_map ugm
+where p.event_id = e.event_id
+and p.price_id = r.price_id
+and e.activity_id = a.activity_id
+and u.user_id = r.user_id
+and reg_state = '$reg_state'
+and a.group_id = ugm.group_id
+and ugm.user_id = $admin_id
+union
+select 
+r.reg_id, r.reg_state, 
+u.first_names, u.last_name, a.short_name
+from events_registrations r, events_prices p,
+events_activities a, events_events e, users u
+where p.event_id = e.event_id
+and p.price_id = r.price_id
+and e.activity_id = a.activity_id
+and u.user_id = r.user_id
+and reg_state = '$reg_state'
+and a.group_id is null
+order by reg_id desc"]
+
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    ns_write "\n<li>"
+    events_write_order_summary
+
+}
+  
+ns_write "
+</ul>
+
+[ad_footer]
+"
+
+
+
+
Index: web/openacs/www/events/admin/order-history-one-ug.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/order-history-one-ug.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/order-history-one-ug.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,72 @@
+set_the_usual_form_variables 0
+#maybe group_id
+
+set db [ns_db gethandle]
+
+ReturnHeaders
+
+if {[exists_and_not_null group_id]} {
+    validate_integer group_id $group_id
+
+    set group_name [database_to_tcl_string $db "select group_name
+    from user_groups
+    where group_id = $group_id"]
+} else {
+    set group_name "<i>No Group</i>"
+}
+
+ns_write "[ad_header "Orders for $group_name"]
+
+<h2>Orders for $group_name</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "order-history.tcl" "Order History"] [list "order-history-ug.tcl" "User Groups"] "User Group"]
+<hr>
+
+<ul>
+"
+
+
+if {[exists_and_not_null group_id]} {
+    set selection [ns_db select $db "select 
+    r.reg_id, r.reg_state, 
+    u.first_names, u.last_name, a.short_name
+    from events_registrations r, events_activities a, events_events e, users u,
+    events_prices p
+    where a.group_id = $group_id
+    and e.activity_id = a.activity_id
+    and p.event_id = e.event_id
+    and p.price_id = r.price_id
+    and u.user_id = r.user_id
+    order by reg_id desc"]
+} else {
+    set selection [ns_db select $db "select 
+    r.reg_id, r.reg_state, 
+    u.first_names, u.last_name, a.short_name
+    from events_registrations r, events_activities a, events_events e, users u,
+    events_prices p
+    where a.group_id is null
+    and e.activity_id = a.activity_id
+    and p.event_id = e.event_id
+    and p.price_id = r.price_id
+    and u.user_id = r.user_id
+    order by reg_id desc"]
+}
+
+set counter 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    ns_write "\n<li>"
+    events_write_order_summary
+    incr counter
+}
+
+if {$counter == 0} {
+    ns_write "<li>No orders found"
+}
+  
+ns_write "
+</ul>
+
+[ad_footer]
+"
+
+
Index: web/openacs/www/events/admin/order-history-state.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/order-history-state.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/order-history-state.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,60 @@
+set admin_id [ad_maybe_redirect_for_registration]
+
+ReturnHeaders
+
+ns_write "[ad_header "[ad_system_name] Events Administration: Order History - By Order State"]
+
+<h2>Order History - By Registration State</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "order-history.tcl" "Order History"] "By Registration State"]
+
+<hr>
+
+<table border=2 cellpadding=5>
+<tr>
+<th align=center>Registration State
+<th align=center>Registrations
+"
+
+set db [ns_db gethandle]
+
+# count the number of orders (in events_registrations) for each order_state in 
+# events_registrations
+
+set selection [ns_db select $db "select 
+reg_state, count(reg_id) as n_orders
+from events_registrations r, events_activities a, events_events e,
+events_prices p,
+user_group_map ugm
+where p.event_id = e.event_id
+and p.price_id = r.price_id
+and e.activity_id = a.activity_id
+and a.group_id = ugm.group_id
+and ugm.user_id = $admin_id
+group by reg_state
+union
+select 
+reg_state, count(reg_id) as n_orders
+from events_registrations r, events_activities a, events_events e,
+events_prices p
+where p.event_id = e.event_id
+and p.price_id = r.price_id
+and e.activity_id = a.activity_id
+and a.group_id is null
+group by reg_state
+"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    ns_write "<tr><td align=left>$reg_state<td align=right><a href=\"order-history-one-state.tcl?[export_url_vars reg_state]\">$n_orders</a></tr>\n"
+}
+
+
+ns_write "
+</table>
+
+[ad_footer]
+"
+
+
+
+
Index: web/openacs/www/events/admin/order-history-ug.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/order-history-ug.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/order-history-ug.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,84 @@
+set user_id [ad_maybe_redirect_for_registration]
+ReturnHeaders
+
+ns_write "[ad_header "[ad_system_name] Events Administration: Order History - By User Group"]
+
+<h2>Order History - By User Group</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "order-history.tcl" "Order History"] "By User Group"]
+
+<hr>
+<table border=2 cellpadding=5>
+<tr>
+ <th>User Group
+ <th>Orders
+"
+
+set db [ns_db gethandle]
+
+#create a bunch of views to do this select...
+set selection [ns_db select $db "select 
+group_name, um.group_id, sum(group_orders) as n_orders
+from user_groups ug, user_group_map um,
+ (select group_id, sum(ev_num) as group_orders from events_activities a,
+  (select activity_id, sum(num) as ev_num from events_events e,
+   (select p.event_id, count(1) as num 
+    from events_registrations r, events_prices p
+    where p.price_id = r.price_id
+    group by event_id
+   ) order_count
+   where e.event_id = order_count.event_id(+)
+   group by activity_id
+  ) ev_count
+ where a.activity_id = ev_count.activity_id(+)
+ group by group_id
+ ) group_count
+where ug.group_id = group_count.group_id(+)
+and um.user_id = $user_id
+and ug.group_id = um.group_id
+group by group_name, um.group_id
+order by group_name
+"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    if {[empty_string_p $n_orders]} {
+	ns_write "<tr>
+	<td>$group_name
+	<td>0"
+    } else {
+	ns_write "<tr>
+	<td>$group_name
+	<td><a href=\"order-history-one-ug.tcl?[export_url_vars group_id]\">$n_orders</a>\n"
+    }
+}
+
+set selection [ns_db 1row $db "select 
+decode(sum(group_orders), null, 0, sum(group_orders)) as n_orders
+from 
+ (select group_id, sum(ev_num) as group_orders from events_activities a,
+  (select activity_id, sum(num) as ev_num from events_events e,
+   (select p.event_id, count(1) as num 
+    from events_registrations r, events_prices p
+    where p.price_id = r.price_id
+    group by event_id
+   ) order_count
+   where e.event_id = order_count.event_id(+)
+   group by activity_id
+  ) ev_count
+ where a.activity_id = ev_count.activity_id(+)
+ group by group_id
+ ) group_count
+where group_count.group_id is null"]
+
+set_variables_after_query
+ns_write "<tr>
+<td><i>No group</i>
+"
+if {$n_orders > 0 } {
+    ns_write "
+    <td><a href=\"order-history-one-ug.tcl\">$n_orders</a>\n"
+} else {
+    ns_write "<td>0"
+}
+
+ns_write "</table>[ad_footer]"
\ No newline at end of file
Index: web/openacs/www/events/admin/order-history.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/order-history.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/order-history.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,32 @@
+ReturnHeaders
+
+ns_write "[ad_header "[ad_system_name] Events Administration: Events Order History"]
+
+<h2>Order History</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] "Order History"]
+
+<hr>
+
+<h3>View Orders/Statistics by:</h3>
+<ul>
+<li><a href=\"order-history-activity.tcl\">Activity</a>
+<li><a href=\"order-history-month.tcl\">Month</a> | <a href=\"order-history-date.tcl\">Day</a>
+<li><a href=\"order-history-ug.tcl\">User Group</a>
+<li><a href=\"order-history-id.tcl\">Registration Number</a>
+<li><a href=\"order-history-state.tcl\">Registration State</a>
+</ul>
+
+<br>
+<h3>Search For an Individual Registration:</h3>
+
+<form method=post action=order-search.tcl>
+Enter either the registration number <b>or</b> the customer's last name for the order you wish to view:<br>
+<ul><table><tr><td><input type=text size=5 name=id_query></td><td><input type=text size=15 name=name_query></td><td rowspan=2 valign=middle> &nbsp;&nbsp;&nbsp;&nbsp;<input type=submit value=\"Search For Registration\"></td></tr><tr><td align=center>Registration #</td><td align=center>Last Name</td></tr></table></ul>
+</form>
+
+[ad_footer]
+"
+
+
+
+
Index: web/openacs/www/events/admin/order-same-person.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/order-same-person.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/order-same-person.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,68 @@
+set admin_id [ad_maybe_redirect_for_registration]
+
+set_the_usual_form_variables
+# urlencoded first_names and last_name
+#user_id
+
+validate_integer user_id $user_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select
+first_names, last_name
+from users
+where user_id = $user_id"]
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "[ad_header "Orders by $first_names $last_name"]
+
+<h2>Orders by $first_names $last_name</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] "Order History"]
+
+<hr>
+
+<ul>
+"
+
+set selection [ns_db select $db "select r.reg_id, 
+r.reg_state, a.short_name, 
+r.reg_date
+from events_registrations r, events_activities a, events_events e,
+user_groups ug, user_group_map ugm, events_prices p
+where p.event_id = e.event_id
+and r.price_id = p.price_id
+and e.activity_id = a.activity_id
+and r.user_id = $user_id
+and a.group_id = ugm.group_id
+and ugm.group_id = ug.group_id
+and ugm.user_id = $admin_id
+union
+select r.reg_id, 
+r.reg_state, a.short_name, 
+r.reg_date
+from events_registrations r, events_activities a, events_events e,
+user_groups ug, user_group_map ugm, events_prices p
+where p.event_id = e.event_id
+and r.price_id = p.price_id
+and e.activity_id = a.activity_id
+and r.user_id = $user_id
+and a.group_id is null
+order by reg_id desc"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    ns_write "\n<li>"
+    events_write_order_summary
+}
+  
+ns_write "
+</ul>
+
+[ad_footer]
+"
+
+
+
+
Index: web/openacs/www/events/admin/order-search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/order-search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/order-search.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,72 @@
+set admin_id [ad_maybe_redirect_for_registration]
+
+set_the_usual_form_variables
+
+# id_query, name_query
+
+if { [info exists id_query] && [string compare $id_query ""] != 0 } {
+    ns_returnredirect "reg-view.tcl?reg_id=$id_query"
+    return
+} elseif { ![info exists name_query] || [string compare $name_query ""] == 0 } {
+    ad_return_error "Please enter search info"  "Please enter either an order # or the customer's last name"
+    return
+} 
+  
+ReturnHeaders
+ns_write "[ad_header "Orders with Last Name Containing \"$name_query\""]
+
+<h2>Orders with Last Name Containing \"$name_query\"</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "order-history.tcl" "Order History"] "Search"]
+
+<hr>
+<ul>
+
+"
+set db [ns_db gethandle]
+
+set selection [ns_db select $db "select 
+u.first_names, u.last_name, 
+r.reg_id, r.reg_state, 
+a.short_name, v.city, v.usps_abbrev, v.iso
+from events_registrations r, events_activities a, events_events e,
+events_prices p, events_venues v, users u,
+user_groups ug, user_group_map ugm
+where p.event_id = e.event_id
+and e.activity_id = a.activity_id
+and v.venue_id = e.venue_id
+and u.user_id = r.user_id
+and upper(u.last_name) like upper('%$QQname_query%')
+and a.group_id = ugm.group_id
+and ugm.group_id = ug.group_id
+and ugm.user_id = $admin_id
+and p.price_id = r.price_id
+union
+select 
+u.first_names, u.last_name, 
+r.reg_id, r.reg_state, 
+a.short_name, v.city, v.usps_abbrev, v.iso
+from events_registrations r, events_activities a, events_events e,
+events_prices p, events_venues v, users u
+where p.event_id = e.event_id
+and e.activity_id = a.activity_id
+and v.venue_id = e.venue_id
+and u.user_id = r.user_id
+and upper(u.last_name) like upper('%$QQname_query%')
+and a.group_id is null
+order by reg_id"]
+    set n_rows_found 0
+    while { [ns_db getrow $db $selection] } {
+	set_variables_after_query
+	incr n_rows_found
+	ns_write "<li>"
+	events_write_order_summary
+    }
+    if { $n_rows_found == 0 } {
+	ns_write "no orders found"
+    }
+    ns_write "</ul>
+    
+[ad_footer]
+"
+
+
Index: web/openacs/www/events/admin/order-view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/order-view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/order-view.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,273 @@
+# order-view.tcl,v 1.2.2.2 2000/02/03 09:49:34 ron Exp
+# we expect to get one argument:  order_id
+
+set order_id [ns_queryget order_id]
+
+validate_integer_or_null order_id $order_id
+
+if { $order_id == "" } {
+    ns_return 200 text/html "[ad_header "No order id"]
+
+<h2>No order id</h2>
+
+specified for [ad_system_name]
+
+<hr>
+
+Order id needed.  This request came in with no
+order id.
+
+[ad_footer]
+"
+    return
+}
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select 
+u.user_id,
+a.activity_id, a.short_name, 
+o.order_state, 
+o.need_hotel_p, o.need_plane_p, o.need_car_p,
+o.canceled_p,
+to_char(o.confirmed_date,'YYYY-MM-DD HH24:MI:SS') as confirmed_date, 
+u.first_names, u.last_name, u.email, uc.home_phone, 
+uc.ha_line1, uc.ha_line2, 
+uc.ha_city, uc.ha_state, 
+uc.ha_postal_code, uc.ha_country_code,
+o.attending_reason, o.where_heard, o.comments
+from evreg_orders o, evreg_activities a, evreg_events e,
+users u, users_contact uc
+where order_id = $order_id
+and a.activity_id = e.activity_id
+and e.event_id = o.event_id
+and u.user_id = o.user_id
+and uc.user_id = o.user_id
+"]
+
+if { $selection == "" } {
+     ns_return 200 text/html "[ad_header "Could not find order"]
+
+<h2>Could not find order</h2>
+
+in [ad_system_name]
+
+<hr>
+
+Order $order_id was not found in the database.
+
+[ad_footer]
+"
+    return
+}
+
+# we have a valid order id
+
+set_variables_after_query
+
+if {$canceled_p == "t"} {
+    set canceled_text "(canceled)"
+} else {
+    set canceled_text ""
+}
+
+set short_name [database_to_tcl_string $db "select short_name from evreg_activities where activity_id='$activity_id'"]
+
+# we have all the description info from the RDBMS
+
+ReturnHeaders
+
+ns_write "[ad_header "Order # $order_id $canceled_text" ]
+
+<h2>Order # $order_id $canceled_text</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "order-history.tcl" "Order History"] "Order"]
+
+<hr>
+
+<table width=100%>
+<tr><td valign=top>
+
+<h3>Activity Information</h3>
+<table>
+<tr>
+ <td>Activity #</td>
+ <td>$activity_id ($short_name)</td>
+"
+
+
+ns_write "
+</table>
+
+<h3>Order Information</h3>
+<table>
+<tr>
+ <td>Order State</td>
+ <td>$order_state
+<tr>
+ <td>Confirmed Date</td>
+ <td>$confirmed_date</td>
+"
+
+ns_write "
+</table>
+
+</td><td valign=top>
+
+<h3>Customer Information</h3>
+
+<table>
+<tr>
+ <td>Name
+ <td><a href=\"order-same-person.tcl?[export_url_vars user_id]\">$first_names $last_name</a></td>
+<tr>
+ <td>Email
+ <td><a href=\"mailto:$email\">$email</a>
+<tr>
+ <td>Telephone number
+ <td>$home_phone
+<tr>
+  <td>Address
+  <td>$ha_line1
+"
+if {$ha_line2 != ""} {
+    ns_write "<tr><td>&nbsp;<td>$ha_line2"
+}
+
+ns_write "
+<tr>
+  <td>&nbsp;</td>
+  <td>$ha_city, $ha_state $ha_postal_code"
+
+if { [info exists ha_country_code] && $ha_country_code != "" && $ha_country_code != "us"} {
+    set ha_country_name [database_to_tcl_string $db "select country_name from ad_country_codes where iso='$country_code'"]
+    ns_write "&nbsp;&nbsp;&nbsp;&nbsp;$ha_country_name"
+}
+
+ns_write "
+<tr>
+  <td valign=top>Attending reason
+  <td>$attending_reason
+<tr>
+  <td valign=top>Heard from
+  <td>$where_heard
+"
+
+set needs_text "<tr><td valign=top>Needs<td><ul>"
+if {$need_hotel_p == "t"} {
+    append needs_text "<li>Needs Hotel"
+}
+if {$need_car_p == "t"} {
+    append needs_text "<li>Needs a car"
+}
+if {$need_plane_p == "t"} {
+    append needs_text "<li>Needs a plane ticket"
+}
+
+append needs_text "</ul></table>"
+
+ns_write $needs_text
+
+if { [info exists comments] && $comments != ""} {
+    ns_write "
+    <tr>
+     <td colspan=2>
+     <h3>Comments</h3>
+     <pre>$comments</pre>
+    "
+}
+
+ns_write "
+</table>
+
+<h2>Order Maintenance</h2>
+
+<ul>
+<li><a href=\"order-comments.tcl?order_id=$order_id\">Add/Edit Comments</a>
+"
+if {[empty_string_p $canceled_text]} {
+    ns_write "<li>
+    <a href=\"order-cancel.tcl?order_id=$order_id\">Cancel Order</a>"
+}
+
+
+ns_write "
+</ul>
+
+<hr>
+<h2>All info in evreg_orders table regarding order # $order_id</h2>
+This is probably only worth looking at if there's a problem with the order.
+<p>
+"
+
+set selection [ns_db 0or1row $db "select order_id,
+event_id, user_id, paid_p,
+confirmed_date, ip_address, order_state, org, title_at_org,
+attending_reason, where_heard,
+need_hotel_p, need_car_p,
+need_plane_p, comments, canceled_p
+from evreg_orders
+where order_id = $order_id"]
+
+set_variables_after_query
+
+ns_write "
+<table>
+<tr>
+ <td>order_id
+ <td>$order_id
+<tr>
+ <td>event_id
+ <td>$event_id
+<tr>
+ <td>user_id
+ <td>$user_id
+<tr>
+ <td>paid_p
+ <td>$paid_p
+<tr>
+ <td>ip_address
+ <td>$ip_address
+<tr>
+ <td>order_state
+ <td>$order_state
+<tr>
+ <td>org
+ <td>$org
+<tr>
+ <td>title_at_org
+ <td>$title_at_org
+<tr>
+ <td>attending_reason
+ <td>$attending_reason
+<tr>
+ <td>where_heard
+ <td>$where_heard
+<tr>
+ <td>need_hotel_p
+ <td>$need_hotel_p
+<tr>
+ <td>need_car_p
+ <td>$need_car_p
+<tr>
+ <td>need_plane_p
+ <td>$need_plane_p
+<tr>
+ <td>comments
+ <td>$comments
+<tr>
+ <td>canceled_p
+ <td>$canceled_p
+</table>
+[ad_footer]
+"
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/events/admin/organizer-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/organizer-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/organizer-add-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,76 @@
+set_the_usual_form_variables
+#user_id_from_search, first_names_from_search, last_name_from_search, email_from_search, event_id
+
+validate_integer user_id_from_search $user_id_from_search
+validate_integer event_id $event_id
+
+set db [ns_db gethandle]
+
+# check if this guy is already a organizer
+set selection [ns_db 0or1row $db "select 1 from
+events_organizers_map
+where user_id = $user_id_from_search
+and event_id = $event_id
+"]
+if {![empty_string_p $selection]} {
+    set org_name [database_to_tcl_string $db "select 
+    first_names || ' ' || last_name
+    from users
+    where user_id=$user_id_from_search"]
+    ad_return_error "Organizer Already Exists" "You have already 
+    given $org_name an organizing role for this event.  You may
+    <ul>
+     <li><a href=\"organizer-edit.tcl?user_id=$user_id_from_search&event_id=$event_id\">view/edit
+     this organizer's responsibilities</a>
+     <li><a href=\"index.tcl\">return to administration</a>
+    </ul>"
+    return
+}
+
+set bio [database_to_tcl_string $db "select bio from users 
+where user_id = $user_id_from_search"]
+
+set selection [ns_db 1row $db "select a.short_name as event_name,
+a.activity_id
+from events_activities a, events_events e
+where e.event_id = $event_id
+and a.activity_id = e.activity_id"]
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "[ad_header "Add a New Organizer"]
+<h2>Add a New Organizer</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "activities.tcl" Activities] [list "activity.tcl?[export_url_vars activity_id]" Activity] [list "event.tcl?[export_url_vars event_id]" "Event"] "Add Organizer"]
+<hr>
+
+<form method=post action=organizer-add-3.tcl>
+[export_form_vars event_id]
+<input type=hidden name=user_id value=\"$user_id_from_search\">
+You have selected $first_names_from_search
+$last_name_from_search ($email_from_search) to be your organizer for the
+$event_name event.
+Please provide the following information:
+<p>
+<table>
+<tr>
+ <th align=left>Role
+ <td><input type=text name= role size=20>
+<tr>
+ <th align=left>Responsibilities
+ <td><textarea name=responsibilities rows=10 cols=70></textarea>
+<tr>
+ <th align=left>Biography
+ <td><textarea name=bio rows=10 cols=70>$bio</textarea>
+</table>
+<p>
+<center>
+<input type=submit value=\"Add Organizer\">
+</center>
+</form>
+[ad_footer]
+"
+
+
+
+
Index: web/openacs/www/events/admin/organizer-add-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/organizer-add-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/organizer-add-3.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,59 @@
+
+set_the_usual_form_variables
+
+#event_id, user_id, biography, role, responsibilities
+
+validate_integer event_id $event_id
+validate_integer user_id $user_id
+
+set db [ns_db gethandle]
+
+# check if this guy is already a organizer
+set selection [ns_db 0or1row $db "select 1 from
+events_organizers_map
+where user_id = $user_id
+and event_id = $event_id
+"]
+if {![empty_string_p $selection]} {
+    set org_name [database_to_tcl_string $db "select 
+    first_names || ' ' || last_name
+    from users
+    where user_id=$user_id_from_search"]
+    ad_return_error "Organizer Already Exists" "You have already 
+    given $org_name an organizing role for this event.  You may
+    <ul>
+     <li><a href=\"organizer-edit.tcl?user_id=$user_id_from_search&event_id=$event_id\">view/edit
+     this organizer's responsibilities</a>
+     <li><a href=\"index.tcl\">return to administration</a>
+    </ul>"
+    return
+}
+
+#error check
+set exception_text ""
+set exception_count 0
+
+if {![exists_and_not_null role]} {
+    incr exception_count
+    append exception_text "<li>You must enter a role"
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+ns_db dml $db "begin transaction"
+ns_db dml $db "insert into events_organizers_map
+(event_id, user_id, role, responsibilities)
+values ($event_id, $user_id, '$QQrole', '$QQresponsibilities')" 
+ns_db dml $db "update users 
+set bio='$QQbio'
+where user_id = $user_id"
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "event.tcl?[export_url_vars event_id]"
+
+
Index: web/openacs/www/events/admin/organizer-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/organizer-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/organizer-add.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,45 @@
+set db [ns_db gethandle]
+
+set_the_usual_form_variables
+#event_id
+
+validate_integer event_id $event_id
+
+set selection [ns_db 1row $db "select a.short_name as event_name,
+a.activity_id
+from events_activities a, events_events e
+where e.event_id = $event_id
+and a.activity_id = e.activity_id"]
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "[ad_header "Add a New Organizer"]
+<h2>Add a New Organizer</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "activities.tcl" Activities] [list "activity.tcl?[export_url_vars activity_id]" Activity] [list "event.tcl?[export_url_vars event_id]" "Event"] "Add Organizer"]
+<hr>
+
+<form action=\"/user-search.tcl\" method=get>
+<input type=hidden name=target value=\"/events/admin/organizer-add-2.tcl\">
+<input type=hidden name=custom_title value=\"Choose a Member to Add as a Organizer for the $event_name event\">
+<input type=hidden name=event_id value=$event_id>
+<input type=hidden name=passthrough value=event_id>
+
+<P>
+<h3>Identify Organizer</h3>
+<p>
+Search for a user to be the organizer of the $event_name event by:<br>
+<table border=0>
+<tr><td>Email address:<td><input type=text name=email size=40></tr>
+<tr><td colspan=2>or by</tr>
+<tr><td>Last name:<td><input type=text name=last_name size=40></tr>
+</table>
+<p>
+<center>
+<input type=submit value=\"Search for a organizer\">
+</center>
+</form>
+<p>
+[ad_footer]
+"
+
Index: web/openacs/www/events/admin/organizer-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/organizer-delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/organizer-delete-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,13 @@
+set db [ns_db gethandle]
+
+set_the_usual_form_variables
+#user_id, event_id
+
+validate_integer user_id $user_id
+validate_integer event_id $event_id
+
+ns_db dml $db "delete from events_organizers_map
+where event_id = $event_id
+and user_id = $user_id"
+
+ns_returnredirect "event.tcl?[export_url_vars event_id]"
\ No newline at end of file
Index: web/openacs/www/events/admin/organizer-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/organizer-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/organizer-delete.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,39 @@
+set db [ns_db gethandle]
+
+set_the_usual_form_variables
+#event_id, user_id
+
+validate_integer event_id $event_id
+validate_integer user_id $user_id
+
+set selection [ns_db 1row $db "select 
+u.first_names || ' ' || u.last_name as org_name,
+m.role,
+a.short_name,
+a.activity_id
+from users u, events_events e, events_activities a, events_organizers_map m
+where m.event_id = $event_id
+and m.user_id = $user_id
+and e.event_id = m.event_id
+and a.activity_id = e.activity_id
+and u.user_id = m.user_id"]
+set_variables_after_query
+
+ReturnHeaders
+ns_write "[ad_header "Remove Organizer from $short_name"]
+
+<h2>Remove $org_name from $short_name</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "activities.tcl" Activities] [list "activity.tcl?[export_url_vars activity_id]" Activity] [list "event.tcl?[export_url_vars event_id]" "Event"] "Edit Event"]
+<hr>
+
+<h3>Remove Organizer</h3>
+
+<form method=post action=organizer-delete-2.tcl>
+[export_form_vars event_id user_id]
+Are you sure you want to remove $org_name from being $role for $short_name?
+<p>
+<center>
+<input type=submit value=\"Remove $org_name\">
+</center>
+</form>
+[ad_footer]"
\ No newline at end of file
Index: web/openacs/www/events/admin/organizer-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/organizer-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/organizer-edit-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,20 @@
+set db [ns_db gethandle]
+
+set_the_usual_form_variables
+#event_id, user_id, role, responsibilities, bio
+
+validate_integer event_id $event_id
+validate_integer user_id $user_id
+
+ns_db dml $db "begin transaction"
+ns_db dml $db "update events_organizers_map
+set role='$QQrole',
+responsibilities='$QQresponsibilities'
+where event_id = $event_id
+and user_id = $user_id"
+ns_db dml $db "update users 
+set bio='$QQbio'
+where user_id = $user_id"
+ns_db dml $db "end transaction"
+
+ns_returnredirect "event.tcl?[export_url_vars event_id]"
\ No newline at end of file
Index: web/openacs/www/events/admin/organizer-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/organizer-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/organizer-edit.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,78 @@
+set db [ns_db gethandle]
+
+set_the_usual_form_variables
+#event_id, user_id
+
+validate_integer event_id $event_id
+validate_integer user_id $user_id
+
+set selection [ns_db 1row $db "select 
+m.role, m.responsibilities,
+u.bio, u.first_names || ' ' || u.last_name as org_name,
+u.email,
+a.short_name,
+a.activity_id,
+v.city, v.usps_abbrev, v.iso,
+to_char(e.start_time, 'fmDay, fmMonth DD, YYYY') as compact_date
+from events_organizers_map m, events_events e, users u, events_activities a,
+events_venues v
+where m.event_id = $event_id
+and m.user_id = $user_id
+and e.event_id = m.event_id
+and v.venue_id = e.venue_id
+and a.activity_id = e.activity_id
+and u.user_id = m.user_id"]
+set_variables_after_query
+
+ReturnHeaders
+ns_write "[ad_header "Edit Organizer for $short_name"]
+
+<h2>Edit Organizer for $short_name</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "activities.tcl" Activities] [list "activity.tcl?[export_url_vars activity_id]" Activity] [list "event.tcl?[export_url_vars event_id]" "Event"] "Organizer"]
+
+<hr>
+
+<h3>Organizer Description</h3>
+
+<form method=post action=organizer-edit-2.tcl>
+[export_form_vars event_id user_id]
+
+<table>
+<tr>
+ <th align=left>Organizer:
+ <td>$org_name ($email)
+<tr>
+ <th align=left>Event name:
+ <td>$short_name
+<tr>
+ <th align=left>Event location:
+ <td>[events_pretty_location $db $city $usps_abbrev $iso]
+<tr>
+ <th align=left>Event date:
+ <td>$compact_date
+<tr>
+ <th align=left>Role:
+ <td><input name=role type=text size=20 value=\"$role\">
+<tr>
+ <th align=left>Responsibilities:
+ <td><textarea name=responsibilities rows=10 cols=70 wrap=soft>$responsibilities</textarea>
+<tr>
+ <th align=left>Biography:
+ <td><textarea name=bio rows=10 cols=70 wrap=soft>$bio</textarea>
+</table>
+</form>
+<p>
+<center>
+<input type=submit value=\"Update Organizer\">
+</center>
+<hr>
+You may also remove this organizer from this event:
+<form method=post action=organizer-delete.tcl>
+[export_form_vars event_id user_id]
+
+<center>
+<input type=submit value=\"Remove Organizer\">
+</form>
+[ad_footer]"
+
+
Index: web/openacs/www/events/admin/reg-approve-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/reg-approve-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/reg-approve-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,88 @@
+set user_id [ad_maybe_redirect_for_registration]
+
+set_the_usual_form_variables
+#reg_id
+
+validate_integer reg_id $reg_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select 1 from
+events_registrations
+where reg_id = $reg_id
+"]
+
+ReturnHeaders
+
+if {[empty_string_p $selection]} {
+    ns_write "
+    [ad_header "Could not find registration"]
+    <h2>Couldn't find registration</h2>
+    <a href=\"index.tcl\">[ad_system_name] events</a> 
+    <hr>
+    Registration $reg_id was not found in the database.
+
+    [ad_footer]"
+
+    return
+}
+
+ns_db dml $db "update events_registrations
+set reg_state = 'shipped'
+where reg_id = $reg_id"
+
+set to_email [database_to_tcl_string $db "select 
+u.email
+from users u, events_registrations r
+where r.reg_id = $reg_id
+and u.user_id = r.user_id"]
+
+ns_write "[ad_header "Registration Approved"]
+<h2>Registration Approved</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] "Order History"]
+<hr>
+$to_email's registration has been approved.
+<p>
+<a href=\"index.tcl\">Return to events administration</a>
+[ad_footer]
+"
+
+ns_conn close
+
+#e-mail the registrant to let him know we canceled his registration
+set from_email [database_to_tcl_string $db "select email from
+users where user_id = $user_id"]
+
+set selection [ns_db 1row $db "select 
+u.email as to_email, e.display_after, e.event_id,
+v.description, v.venue_name
+from users u, events_registrations r, events_prices p,
+events_events e, events_venues v
+where r.reg_id = $reg_id
+and u.user_id = r.user_id
+and p.price_id = r.price_id
+and e.event_id = p.event_id
+and v.venue_id = e.venue_id
+"]
+
+set_variables_after_query
+
+set email_subject "Registration Approved"
+set email_body "Your registration for:\n
+[events_pretty_event $db $event_id]\n
+has been approved.\n
+
+$display_after\n
+
+Venue description and directions:
+
+$venue_name\n
+
+$description\n
+
+[ad_parameter SystemURL]/events/
+"
+
+if [catch { ns_sendmail $to_email $from_email $email_subject $email_body } errmsg] {
+    ns_log Notice "failed sending confirmation email to customer: $errmsg"
+} 
Index: web/openacs/www/events/admin/reg-approve.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/reg-approve.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/reg-approve.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,47 @@
+set_the_usual_form_variables
+#reg_id
+
+validate_integer reg_id $reg_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select p.event_id, u.email
+from events_registrations r, events_prices p, users u
+where r.reg_id = $reg_id
+and p.price_id = r.price_id
+and u.user_id = r.user_id
+"]
+
+ReturnHeaders
+
+if {[empty_string_p $selection]} {
+    ns_write "
+    [ad_header "Could not find registration"]
+    <h2>Registration not found</h2>
+    <a href=\"index.tcl\">[ad_system_name] events</a> 
+    <hr>
+    Registration $reg_id was not found in the database.
+
+    [ad_footer]"
+
+    return
+}
+
+set_variables_after_query
+
+set event_name [events_event_name $db $event_id]
+
+ns_write "
+[ad_header "Approve Registration"]
+<h2>Approve Registration for $event_name</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] "Approve Registration"]
+<hr>
+<form method=post action=\"reg-approve-2.tcl\">
+[export_form_vars reg_id]
+Are you sure that you want to approve $email's registration for $event_name?
+<p>
+<center>
+<input type=submit value=\"Yes, Approve Registration\">
+</center>
+[ad_footer]
+"
\ No newline at end of file
Index: web/openacs/www/events/admin/reg-cancel-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/reg-cancel-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/reg-cancel-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,80 @@
+set user_id [ad_maybe_redirect_for_registration]
+
+set_the_usual_form_variables
+#reg_id
+
+validate_integer reg_id $reg_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select 1 from
+events_registrations
+where reg_id = $reg_id
+"]
+
+ReturnHeaders
+
+if {[empty_string_p $selection]} {
+    ns_write "
+    [ad_header "Could not find registration"]
+    <h2>Couldn't find registration</h2>
+    <a href=\"index.tcl\">[ad_system_name] events</a> 
+    <hr>
+    Registration $reg_id was not found in the database.
+
+    [ad_footer]"
+
+    return
+}
+
+ns_db dml $db "update events_registrations
+set reg_state = 'canceled'
+where reg_id = $reg_id"
+
+set to_email [database_to_tcl_string $db "select 
+u.email
+from users u, events_registrations r
+where r.reg_id = $reg_id
+and u.user_id = r.user_id"]
+
+ns_write "[ad_header "Registration Canceled"]
+<h2>Registration Canceled</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] "Order History"]
+<hr>
+$to_email's registration has been canceled.
+<p>
+<a href=\"index.tcl\">Return to events administration</a>
+[ad_footer]
+"
+
+ns_conn close
+
+#e-mail the registrant to let him know we canceled his registration
+set from_email [database_to_tcl_string $db "select email from
+users where user_id = $user_id"]
+
+set to_email [database_to_tcl_string $db "select 
+u.email
+from users u, events_registrations r
+where r.reg_id = $reg_id
+and u.user_id = r.user_id"]
+
+set selection [ns_db 1row $db "select
+event_id
+from events_registrations r, events_prices p
+where r.reg_id = $reg_id
+and p.price_id = r.price_id"]
+
+set_variables_after_query
+
+set email_subject "Registration Canceled"
+set email_body "Your registration for:\n
+[events_pretty_event $db $event_id]\n
+has been canceled.\n
+
+[ad_parameter SystemURL]/events/
+"
+
+if [catch { ns_sendmail $to_email $from_email $email_subject $email_body } errmsg] {
+    ns_log Notice "failed sending confirmation email to customer: $errmsg"
+} 
Index: web/openacs/www/events/admin/reg-cancel.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/reg-cancel.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/reg-cancel.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,47 @@
+set_the_usual_form_variables
+#reg_id
+
+validate_integer reg_id $reg_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select p.event_id, u.email
+from events_registrations r, events_prices p, users u
+where r.reg_id = $reg_id
+and p.price_id = r.price_id
+and u.user_id = r.user_id
+"]
+
+ReturnHeaders
+
+if {[empty_string_p $selection]} {
+    ns_write "
+    [ad_header "Could not find registration"]
+    <h2>Registration not found</h2>
+    <a href=\"index.tcl\">[ad_system_name] events</a> 
+    <hr>
+    Registration $reg_id was not found in the database.
+
+    [ad_footer]"
+
+    return
+}
+
+set_variables_after_query
+
+set event_name [events_event_name $db $event_id]
+
+ns_write "
+[ad_header "Cancel Registration"]
+<h2>Cancel Registration for $event_name</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] "Cancel Registration"]
+<hr>
+<form method=post action=\"reg-cancel-2.tcl\">
+[export_form_vars reg_id]
+Are you sure that you want to cancel $email's registration for $event_name?
+<p>
+<center>
+<input type=submit value=\"Yes, Cancel Registration\">
+</center>
+[ad_footer]
+"
\ No newline at end of file
Index: web/openacs/www/events/admin/reg-comments-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/reg-comments-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/reg-comments-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,14 @@
+set_the_usual_form_variables
+
+#reg_id, comments
+
+validate_integer reg_id $reg_id
+
+set db [ns_db gethandle]
+
+ns_db dml $db "update events_registrations set
+comments='$QQcomments'
+where reg_id = $reg_id"
+
+ns_returnredirect "reg-view.tcl?reg_id=$reg_id"
+
Index: web/openacs/www/events/admin/reg-comments.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/reg-comments.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/reg-comments.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,52 @@
+set_the_usual_form_variables
+
+#reg_id
+
+validate_integer reg_id $reg_id
+
+ReturnHeaders
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select r.comments, 
+p.event_id, r.reg_date,
+u.first_names, u.last_name
+from events_registrations r, events_events e, users u, events_prices p
+where p.event_id = e.event_id
+and u.user_id = r.user_id
+and r.reg_id = $reg_id
+and p.price_id = r.price_id
+"]
+
+set_variables_after_query
+
+ns_write "[ad_header "Add/Edit Comments Regarding Registration #$reg_id"]
+
+<h2>Add/Edit Comments Regarding Registration #$reg_id</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] "Order History"]
+
+<hr>
+
+<h3>Comments</h3>
+
+on this order from $first_names $last_name on $reg_date for 
+[events_event_name $db $event_id]
+
+<form method=post action=reg-comments-2.tcl>
+[philg_hidden_input reg_id $reg_id]
+
+<textarea name=comments rows=4 cols=70 wrap=soft>$comments</textarea>
+
+<br>
+<br>
+
+<center>
+<input type=submit value=\"Submit Comments\">
+</center>
+</form>
+[ad_footer]
+"
+
+
+
+
Index: web/openacs/www/events/admin/reg-pending.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/reg-pending.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/reg-pending.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,41 @@
+set_the_usual_form_variables
+#event_id
+
+validate_integer event_id $event_id
+
+set db [ns_db gethandle]
+
+if {![exists_and_not_null event_id]} {
+    ad_return_error "No event_id" "This page came in without an event_id"
+    return
+}
+
+ReturnHeaders
+ns_write "[ad_header "Pending Registrations"]
+<h2>Pending Registrations for [events_pretty_event $db $event_id]</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] "Pending Registrations"]
+
+<hr>
+<ul>
+"
+
+set selection [ns_db select $db "select 
+r.reg_id, email, reg_date
+from events_registrations r, users u, events_prices p
+where p.event_id = $event_id
+and r.price_id = p.price_id
+and u.user_id = r.user_id
+and reg_state='pending'
+order by reg_date asc
+"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    ns_write "<li><a href=\"reg-view.tcl?[export_url_vars reg_id] \">
+    $email ([util_AnsiDatetoPrettyDate $reg_date])</a>"
+}
+
+ns_write "</ul> [ad_footer]"
+
+    
\ No newline at end of file
Index: web/openacs/www/events/admin/reg-view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/reg-view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/reg-view.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,336 @@
+set_the_usual_form_variables
+#reg_id
+
+if { ![exists_and_not_null reg_id]} {
+    ns_return 200 text/html "[ad_header "No registration id"]
+
+<h2>No registration id</h2>
+
+specified for [ad_system_name]
+
+<hr>
+
+Registration id needed.  This request came in with no
+registration id.
+
+[ad_footer]
+"
+    return
+}
+
+validate_integer reg_id $reg_id
+
+set db_pools [ns_db gethandle subquery 2]
+set db [lindex $db_pools 0]
+set db_sub [lindex $db_pools 1]
+
+set selection [ns_db 0or1row $db "select 
+u.user_id,
+e.event_id,
+r.reg_state, 
+r.need_hotel_p, r.need_plane_p, r.need_car_p,
+to_char(r.reg_date,'YYYY-MM-DD HH24:MI:SS') as reg_date, 
+to_char(r.shipped_date,'YYYY-MM-DD HH24:MI:SS') as shipped_date, 
+u.first_names, u.last_name, u.email, uc.home_phone, 
+uc.ha_line1, uc.ha_line2, 
+uc.ha_city, uc.ha_state, 
+uc.ha_postal_code, uc.ha_country_code,
+r.attending_reason, r.where_heard, r.comments
+from events_registrations r, events_events e,
+users u, users_contact uc, events_prices p
+where r.reg_id = $reg_id
+and p.price_id = r.price_id
+and e.event_id = p.event_id
+and u.user_id = r.user_id
+and uc.user_id = r.user_id
+"]
+
+if { $selection == "" } {
+     ns_db releasehandle $db
+     ns_db releasehandle $db_sub
+     ns_return 200 text/html "[ad_header "Could not find registration"]
+
+<h2>Could not find registration</h2>
+
+in [ad_system_name]
+
+<hr>
+
+Registration $reg_id was not found in the database.
+
+[ad_footer]
+"
+    return
+}
+
+# we have a valid order id
+
+set_variables_after_query
+
+#if {$canceled_p == "t"} {
+#    set canceled_text "(canceled)"
+#} else {
+#    set canceled_text ""
+#}
+
+# we have all the description info from the RDBMS
+
+set event [events_pretty_event $db $event_id]
+regsub -all " from " $event "<br>from " event
+
+#release the handles for ad_header
+ns_db releasehandle $db
+ns_db releasehandle $db_sub
+ReturnHeaders
+
+ns_write "[ad_header "Registration # $reg_id ($reg_state)" ]"
+
+set db_pools [ns_db gethandle subquery 2]
+set db [lindex $db_pools 0]
+set db_sub [lindex $db_pools 1]
+
+
+ns_write "
+<h2>Registration # $reg_id ($reg_state)</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "order-history.tcl" "Order History"] "Registration"]
+
+<hr>
+
+<table width=100%>
+<tr><td valign=top>
+
+<h3>Event Information</h3>
+$event
+"
+
+
+ns_write "
+
+<h3>Registration Information</h3>
+<table>
+<tr>
+ <th>Registration State</td>
+"
+if {$reg_state == "pending"} {
+    ns_write "<td><font color=red>$reg_state</font>"
+} else {
+    ns_write "<td>$reg_state"
+}
+ns_write "
+<tr>
+ <th>Registration Date</td>
+ <td>$reg_date</td>
+"
+
+ns_write "
+</table>
+
+</td><td valign=top>
+
+<h3>Customer Information</h3>
+
+<table>
+<tr>
+ <th>Name</th>
+ <td><a href=\"order-same-person.tcl?[export_url_vars user_id]\">$first_names $last_name</a></td>
+</tr>
+<tr>
+ <th>Email</th>
+ <td><a href=\"mailto:$email\">$email</a></td>
+</tr>
+<tr>
+ <th>Telephone number</th>
+ <td>$home_phone</td>
+</th>
+<tr>
+  <th>Address</th>
+  <td>$ha_line1</td>
+</tr>
+"
+if {$ha_line2 != ""} {
+    ns_write "<tr><td>&nbsp;</td><td>$ha_line2</td>"
+}
+
+ns_write "
+<tr>
+  <td>&nbsp;</td>
+  <td>$ha_city, $ha_state $ha_postal_code</td>"
+
+if { [info exists ha_country_code] && $ha_country_code != "" && $ha_country_code != "us"} {
+#    set ha_country_name [database_to_tcl_string $db "select country_name from ad_country_codes where iso='$country_code'"]
+#    ns_write "&nbsp;&nbsp;&nbsp;&nbsp;$ha_country_name"
+
+    set ha_country_name [database_to_tcl_string $db "
+       select country_name from country_codes 
+       where iso='$ha_country_code'"]
+    ns_write "    $ha_country_name"
+
+}
+
+ns_write "
+<tr>
+  <th valign=top>Attending reason</th>
+  <td>$attending_reason</td>
+</tr>
+<tr>
+  <th valign=top>Heard from</th>
+  <td>$where_heard</td>
+</tr>
+"
+
+set needs_text "<tr><th valign=top>Needs</th><td><ul>"
+if {$need_hotel_p == "t"} {
+    append needs_text "<li>Needs Hotel"
+}
+if {$need_car_p == "t"} {
+    append needs_text "<li>Needs a car"
+}
+if {$need_plane_p == "t"} {
+    append needs_text "<li>Needs a plane ticket"
+}
+
+#ns_write "</td></tr>"
+
+set selection [ns_db select $db "
+select column_name, pretty_name,
+sort_key
+from events_event_fields
+where event_id = $event_id
+order by sort_key
+"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    set table_name "event_"
+    append table_name $event_id
+    append table_name "_info"
+
+    set sub_selection [ns_db 1row $db_sub "
+    select $column_name 
+    from 
+    $table_name
+    where user_id = $user_id"]
+    
+    set_variables_after_subquery
+    
+    ns_write "
+    <tr>
+     <th>$pretty_name</th>
+     <td>[set $column_name]</td>
+    </tr>"
+}
+
+
+append needs_text "</ul></table>"
+
+ns_write $needs_text
+
+if { [info exists comments] && $comments != ""} {
+    ns_write "
+    <tr>
+     <td colspan=2>
+     <h3>Comments</h3>
+     <pre>$comments</pre>
+    "
+}
+
+ns_write "
+</table>
+
+<h2>Registration Maintenance</h2>
+
+<ul>
+"
+
+if {$reg_state == "pending" || $reg_state == "waiting"} {
+    ns_write "<li>
+    <a href=\"reg-approve.tcl?reg_id=$reg_id\">Approve Registration</a>
+    |
+    <a href=\"reg-cancel.tcl?reg_id=$reg_id\">Deny Registration</a>"
+} elseif {$reg_state != "canceled"} {
+    ns_write "<li>
+    <a href=\"reg-cancel.tcl?reg_id=$reg_id\">Cancel Registration</a>"
+} elseif {$reg_state == "canceled"} {
+    ns_write "<li>
+    <a href=\"reg-approve.tcl?reg_id=$reg_id\">Approve Registration</a>"
+}
+
+
+ns_write "
+<li><a href=\"reg-comments.tcl?reg_id=$reg_id\">Add/Edit Comments</a>
+</ul>
+
+<hr width=50%>
+<h2>All info in events_registrations table regarding registration # $reg_id</h2>
+This is probably only worth looking at if there's a problem with the registration.
+<p>
+"
+
+set selection [ns_db 0or1row $db "select *
+from events_registrations
+where reg_id = $reg_id"]
+
+set_variables_after_query
+
+ns_write "
+<table>
+<tr>
+ <th>REG_ID 				  
+ <td>$reg_id
+<tr>
+ <th>ORDER_ID
+ <td>$order_id
+<tr>
+ <th>PRICE_ID
+ <td>$price_id
+<tr>
+ <th>USER_ID
+ <td>$user_id
+<tr>
+ <th>REG_STATE
+ <td>$reg_state
+<tr>
+ <th>ORG 
+ <td>$org
+<tr>
+ <th>TITLE_AT_ORG
+ <td>$title_at_org
+<tr>
+ <th>ATTENDING_REASON				
+ <td>$attending_reason
+<tr>
+ <th>WHERE_HEARD	
+ <td>$where_heard				
+<tr>
+ <th>NEED_HOTEL_P
+ <td>$need_hotel_p					
+<tr>
+ <th>NEED_CAR_P		
+ <td>$need_car_p
+<tr>
+ <th>NEED_PLANE_P					
+ <td>$need_plane_p
+<tr>
+ <th>COMMENTS		
+ <td>$comments			
+<tr>
+ <th>REG_DATE	
+ <td>$reg_date				
+<tr>
+ <th>SHIPPED_DATE					
+ <td>$shipped_date
+</table>
+[ad_footer]
+"
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/events/admin/reg-waiting.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/reg-waiting.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/reg-waiting.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,39 @@
+set_the_usual_form_variables
+#event_id
+
+validate_integer event_id $event_id
+
+set db [ns_db gethandle]
+
+if {![exists_and_not_null event_id]} {
+    ad_return_error "No event_id" "This page came in without an event_id"
+    return
+}
+
+ReturnHeaders
+ns_write "[ad_header "Waiting Registrations"]
+<h2>Waiting Registrations for [events_pretty_event $db $event_id]</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] "Waiting Registrations"]
+
+<hr>
+<ul>
+"
+
+set selection [ns_db select $db "select 
+r.reg_id, email, reg_date
+from events_registrations r, users u, events_prices p
+where p.event_id = $event_id
+and r.price_id = p.price_id
+and u.user_id = r.user_id
+and reg_state = 'waiting'
+order by reg_date asc
+"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    ns_write "<li><a href=\"reg-view.tcl?[export_url_vars reg_id] \">
+    $email ([util_AnsiDatetoPrettyDate $reg_date])</a>"
+}
+
+ns_write "</ul> [ad_footer]"
\ No newline at end of file
Index: web/openacs/www/events/admin/spam-selected-event.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/spam-selected-event.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/spam-selected-event.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,75 @@
+set_the_usual_form_variables
+#event_id
+
+validate_integer event_id $event_id
+
+set admin_id [ad_maybe_redirect_for_registration]
+
+ReturnHeaders
+
+ns_write "[ad_header "Spam Event"]"
+
+set db_pools [ns_db gethandle subquery 2]
+set db [lindex $db_pools 0]
+set db_sub [lindex $db_pools 1]
+
+
+ns_write "
+
+<h2>Spam Event</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] "Spam Event"]
+
+<hr>
+
+[events_pretty_event $db $event_id]<br>
+Spam:
+<ul>
+"
+set sql_post_select "from users, events_reg_shipped r, events_prices p
+where p.event_id = $event_id
+and users.user_id = r.user_id
+and p.price_id = r.price_id
+"
+
+ns_write "
+<li><a href=\"spam/action-choose.tcl?[export_url_vars sql_post_select]\">
+Confirmed Registratants</a>
+"
+
+set sql_post_select "from users, events_registrations r, events_prices p
+where p.event_id = $event_id
+and users.user_id = r.user_id
+and p.price_id = r.price_id
+and r.reg_state = 'pending'
+"
+
+ns_write "
+<li><a href=\"spam/action-choose.tcl?[export_url_vars sql_post_select]\">
+Pending Registratants</a>
+"
+
+set sql_post_select "from users, events_registrations r, events_prices p
+where p.event_id = $event_id
+and users.user_id = r.user_id
+and p.price_id = r.price_id
+and r.reg_state = 'waiting'
+"
+
+ns_write "
+<li><a href=\"spam/action-choose.tcl?[export_url_vars sql_post_select]\">
+Wait-listed Registratants</a>
+"
+
+set sql_post_select "from users, events_registrations r, events_prices p
+where p.event_id = $event_id
+and users.user_id = r.user_id
+and p.price_id = r.price_id
+"
+
+ns_write "
+<li><a href=\"spam/action-choose.tcl?[export_url_vars sql_post_select]\">
+All Registrants</a>
+"
+
+
+ns_write "</ul>[ad_footer]"
\ No newline at end of file
Index: web/openacs/www/events/admin/spam-selected-events.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/spam-selected-events.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/spam-selected-events.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,67 @@
+set admin_id [ad_maybe_redirect_for_registration]
+
+ReturnHeaders
+
+
+ns_write "[ad_header "Spam Event"]"
+
+set db_pools [ns_db gethandle subquery 2]
+set db [lindex $db_pools 0]
+set db_sub [lindex $db_pools 1]
+
+
+ns_write "
+<h2>Spam Event</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] "Spam Event"]
+
+<hr>
+Select the event you would like to spam:
+<ul>
+"
+
+set selection [ns_db select $db "select
+a.short_name,
+e.start_time, e.event_id,
+v.city, v.usps_abbrev, v.iso
+from events_activities a, events_events e, events_venues v,
+user_groups ug, user_group_map ugm
+where a.activity_id = e.activity_id
+and v.venue_id = e.venue_id
+and a.group_id = ugm.group_id
+and ugm.group_id = ug.group_id
+and ugm.user_id = $admin_id
+union
+select
+a.short_name,
+e.start_time, e.event_id,
+v.city, v.usps_abbrev, v.iso
+from events_activities a, events_events e, events_venues v
+where a.activity_id = e.activity_id
+and v.venue_id = e.venue_id
+and a.group_id is null
+order by short_name, start_time
+"]
+
+set counter 0
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    set sql_post_select "from users, events_reg_shipped r, events_prices p
+    where p.event_id = $event_id
+    and users.user_id = r.user_id
+    and p.price_id = r.price_id
+    "
+
+    ns_write "<li>
+    <a href=\"spam-selected-event.tcl?[export_url_vars event_id]\">$short_name:
+    [events_pretty_location $db_sub $city $usps_abbrev $iso]
+    on [util_AnsiDatetoPrettyDate $start_time] </a>"
+    
+    incr counter
+}
+
+if {$counter == 0} {
+    ns_write "<li>There are no events in the system"
+}
+
+ns_write "</ul>[ad_footer]"
\ No newline at end of file
Index: web/openacs/www/events/admin/venues-ae-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/venues-ae-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/venues-ae-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,87 @@
+
+set_the_usual_form_variables
+#venue_id, venue_name, address1, address2, city, usps_abbrev, postal_code, iso, needs_reserve_p, max_people, description, (maybe return_url)
+
+validate_integer venue_id $venue_id
+
+set db [ns_db gethandle]
+
+#do some error checking
+set exception_text ""
+set exception_count 0
+
+if {[exists_and_not_null max_people]} {
+    if {[catch {set max_people [validate_integer "max_people" $max_people]} errmsg]} {
+	incr exception_count
+	append exception_text "<li>You must enter a number for maximum capacity"
+    }
+} else {
+    set max_people "null"
+}
+
+
+if {![info exists venue_name] || [empty_string_p $venue_name]} {
+    incr exception_count
+    append exception_text "<li>You must name your venue"
+}
+
+if {![info exists city] || [empty_string_p $city]} {
+    incr exception_count
+    append exception_text "<li>You must enter a city"
+}
+
+if {![info exists iso] || [empty_string_p $iso]} {
+    incr exception_count
+    append exception_text "<li>You must select a country"
+}
+
+if {[string compare $iso "us"] == 0} {
+    if {![info exists usps_abbrev] || [empty_string_p $usps_abbrev]} {
+	incr exception_count
+	append exception_text "<li>You must enter a state"
+    }
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+if {![info exists needs_reserve_p] } {
+    set needs_reserve_p "f"
+}
+
+ns_db dml $db "begin transaction"
+
+ns_db dml $db "update events_venues set
+venue_name='$QQvenue_name',
+address1='$QQaddress1',
+address2='$QQaddress2',
+city='$QQcity',
+usps_abbrev='$usps_abbrev',
+postal_code='$QQpostal_code',
+iso='$QQiso',
+needs_reserve_p='$needs_reserve_p',
+max_people=$max_people,
+description='$QQdescription'
+where venue_id=$venue_id"
+
+if {[ns_pg ntuples $db] == 0} {
+    ns_db dml $db "insert into events_venues
+    (venue_id, venue_name, address1, address2, city, usps_abbrev, postal_code,
+    iso, needs_reserve_p, max_people, description)
+    values
+    ($venue_id, '$QQvenue_name', '$QQaddress1', '$QQaddress2', '$QQcity',
+    '$usps_abbrev', '$QQpostal_code', '$iso', '$needs_reserve_p',
+    $max_people, '$QQdescription')"
+}
+
+#create the user group for this venue
+
+ns_db dml $db "end transaction"
+
+if {[info exists return_url] && ![empty_string_p $return_url]} {
+    ns_returnredirect "$QQreturn_url&[export_url_vars venue_id]"
+} else {
+    ns_returnredirect "venues.tcl"
+}
Index: web/openacs/www/events/admin/venues-ae.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/venues-ae.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/venues-ae.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,88 @@
+set db [ns_db gethandle]
+
+set_the_usual_form_variables 0
+#venue_id if we're editing, return_url if we're adding
+
+ReturnHeaders
+if {[info exists venue_id] && ![empty_string_p $venue_id]} {
+
+    validate_integer venue_id $venue_id
+
+    #we're editing
+    set title "Update a  Venue"
+    set submit_text "Update Venue"
+    set selection [ns_db 1row $db "select venue_name, address1, address2, 
+    city, usps_abbrev, postal_code, iso, needs_reserve_p, max_people,
+    description
+    from events_venues
+    where venue_id = $venue_id"]
+    set_variables_after_query
+} else {
+    set title "Add a New Venue"
+    set submit_text "Add Venue"
+    set venue_id [database_to_tcl_string $db "select events_venues_id_sequence.nextval from dual"]
+    set venue_name ""
+    set address1 ""
+    set address2 ""
+    set city ""
+    set usps_abbrev ""
+    set postal_code ""
+    set iso ""
+    set needs_reserve_p "f"
+    set max_people ""
+    set description ""    
+}
+
+
+ns_write "[ad_header "$title"]
+<h2>$title</h2>
+
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] [list "venues.tcl" "Venues"] "Venue"]
+
+<hr>
+<form method=post action=\"venues-ae-2.tcl\">
+<input type=hidden name=venue_id value=\"$venue_id\">
+[export_form_vars venue_id return_url]
+
+<table cellpadding=5>
+<tr>
+ <td>Venue Name:
+ <td><input type=text size=20 name=venue_name value=\"$venue_name\">
+<tr>
+ <td>Address 1:
+ <td><input type=text size=50 name=address1 value=\"$address1\">
+<tr>
+ <td>Address 2:
+ <td><input type=text size=50 name=address2 value=\"$address2\">
+<tr>
+ <td>City:
+ <td><input type=text size=50 name=city value=\"$city\">
+<tr>
+ <td>State:
+ <td><input type=text size=2 name=usps_abbrev value=\"$usps_abbrev\">
+<tr>
+ <td>Zip Code:
+ <td><input type=text size=20 name=postal_code value=\"$postal_code\">
+<tr>
+ <td>Country:
+ <td>[country_widget $db us iso $iso]
+<tr>
+ <td>Maximum Capacity:
+ <td><input type=text size=20 name=max_people value=\"$max_people\">
+<tr>
+ <td>Needs Reservation?
+ <td>"
+if {[string compare $needs_reserve_p "t"] == 0} {
+    set rbox "<input type=checkbox checked name=needs_reserve_p value=\"t\">"
+} else {
+    set rbox "<input type=checkbox name=needs_reserve_p value=\"t\">"
+}
+ns_write "$rbox
+<tr>
+ <td>Description<br>(Include directions)
+ <td><textarea name=description rows=8 cols=70 wrap=soft>$description</textarea>
+</table>
+<p>
+<center><input type=submit value=\"$submit_text\"></center>
+[ad_footer]
+"
\ No newline at end of file
Index: web/openacs/www/events/admin/venues.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/venues.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/venues.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,31 @@
+ReturnHeaders
+ns_write "[ad_header "[ad_system_name] Administration"]"
+
+set db_pools [ns_db gethandle subquery 2]
+set db [lindex $db_pools 0]
+set db_sub [lindex $db_pools 1]
+
+ns_write "
+<h2>Venues</h2>
+[ad_context_bar_ws [list "index.tcl" "Events Administration"] "Venues"]
+<hr>
+<form method=post action=\"venues-ae.tcl\">
+<table cellpadding=5>
+"
+
+set venues_widget [events_venues_widget $db $db_sub]
+
+if {![empty_string_p $venues_widget]} {
+    ns_write "<tr><td valign=top>view/edit a venue:
+    <td valign=top>$venues_widget
+    <td valign=top><input type=submit value=\"View Venue\">
+"
+}
+
+ns_write "
+</select>
+<p>
+<tr><td valign=top><a href=\"venues-ae.tcl\">Add a new venue</a>
+</table>
+</form>
+[ad_footer]"
Index: web/openacs/www/events/admin/attach-file/download.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/attach-file/download.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/attach-file/download.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,19 @@
+# download.tcl,v 1.2.2.1 2000/02/03 09:49:48 ron Exp
+# Download a file
+
+set_the_usual_form_variables 
+# form_id
+
+validate_integer form_id $form_id
+
+set db [ns_db gethandle]
+set file_type [database_to_tcl_string $db \
+	"select file_type
+           from events_file_storage
+          where file_id=$file_id"]
+
+ReturnHeaders $file_type
+
+ns_ora write_blob $db "select file_content 
+                       from   events_file_storage
+                       where  file_id=$file_id" 
Index: web/openacs/www/events/admin/attach-file/file-remove-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/attach-file/file-remove-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/attach-file/file-remove-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,15 @@
+# file-remove-2.tcl,v 1.1.2.1 2000/02/03 09:49:50 ron Exp
+set_the_usual_form_variables
+#file_id, return_url
+
+validate_integer file_id $file_id
+
+set db [ns_db gethandle]
+
+if [catch {ns_db dml $db "delete from events_file_storage
+where file_id = $file_id"} errmsg] {
+#do nothing
+}
+
+
+ns_returnredirect $return_url
\ No newline at end of file
Index: web/openacs/www/events/admin/attach-file/file-remove.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/attach-file/file-remove.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/attach-file/file-remove.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,31 @@
+# file-remove.tcl,v 1.1.2.3 2000/02/03 09:49:51 ron Exp
+set_the_usual_form_variables
+#file_id, return_url
+
+validate_integer file_id $file_id
+
+set db [ns_db gethandle]
+set file_title [database_to_tcl_string $db "
+select file_title from events_file_storage
+where file_id=$file_id"]
+
+ns_db releasehandle $db
+
+set title "Remove a File"
+
+ReturnHeaders
+
+ns_write "
+[ad_header $title]
+<h2> $title </h2>
+[ad_context_bar_ws [list "../index.tcl" "Events Administration"] "Agenda File"]
+<hr>
+Are you sure you want to remove the file, <i>$file_title</i>?
+<p>
+<form method=post action=file-remove-2.tcl>
+[export_form_vars file_id return_url]
+<center>
+<input type=submit value=\"Remove file\">
+</center>
+</form>
+[ad_footer]"
\ No newline at end of file
Index: web/openacs/www/events/admin/attach-file/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/attach-file/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/attach-file/index.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,36 @@
+# index.tcl,v 1.1.2.1 2000/02/03 09:49:53 ron Exp
+# This script allows a user to upload a file with a title
+# and attach that file to another table/id in acs
+
+set_form_variables 0
+# on_which_table on_what_id return_url
+
+validate_integer on_what_id $on_what_id
+
+set title "Upload a file"
+
+ReturnHeaders
+
+ns_write "
+[ad_header $title]
+
+<h2> $title </h2>
+
+<hr>
+
+<form method=POST action=upload.tcl>
+[export_form_vars return_url]
+1. Attach File to what table?
+  <br><dd><input type=text size=30 name=on_which_table [export_form_value on_which_table]>
+
+<p>
+2. Attach File to what ID?
+  <br><dd><input type=text size=30 name=on_what_id [export_form_value on_what_id]>
+
+<p>
+<input type=submit>
+</form>
+
+[ad_footer]
+"
+
Index: web/openacs/www/events/admin/attach-file/success.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/attach-file/success.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/attach-file/success.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,15 @@
+# success.tcl,v 1.1.2.1 2000/02/03 09:49:54 ron Exp
+set title "File Uploaded"
+
+ReturnHeaders
+
+ns_write "
+[ad_header $title]
+
+<h2> $title </h2>
+
+<hr>
+
+Your file was successfully uploaded. <a href=view.tcl?[export_ns_set_vars url]>View</a> it now.
+
+[ad_footer] "
Index: web/openacs/www/events/admin/attach-file/upload-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/attach-file/upload-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/attach-file/upload-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,97 @@
+# upload-2.tcl,v 1.2.2.1 2000/02/03 09:49:56 ron Exp
+# upload-2.tcl
+# 
+# by mbryzek@arsdigita.com, January 2000
+#
+# upload a picture into a table and associate it with another table/id
+# 
+
+ad_page_variables {
+    upload_file
+    file_title
+    file_id
+    on_what_id
+    on_which_table
+    return_url
+}
+
+# upload_file, file_title, file_id, on_what_id, on_which_table, return_url
+
+validate_integer file_id $file_id
+validate_integer on_what_id $on_what_id
+
+set db [ns_db gethandle]
+# check the user input first
+
+set exception_text ""
+set exception_count 0
+
+if { ![exists_and_not_null on_which_table] } {
+    incr exception_count
+    append exception_text "<li>No table was specified"
+} 
+if { ![exists_and_not_null on_what_id] } {
+    incr exception_count
+    append exception_text "<li>No ID was specified"
+} 
+if { ![exists_and_not_null file_id] } {
+    incr exception_count
+    append exception_text "<li>No fileument ID was specified"
+} 
+if { ![exists_and_not_null file_title] } {
+    incr exception_count
+    append exception_text "<li>No fileument title was specified"
+} 
+
+## return errors
+if { $exception_count> 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+# get the file from the user.
+# number_of_bytes is the upper-limit
+# on the size of the file we will read. 1024*1024*2= 2097142
+set max_n_bytes [ad_parameter MaxNumberOfBytes fs]
+
+set tmp_file_name [ns_queryget upload_file.tmpfile]
+set file_content [read [open $tmp_file_name] $max_n_bytes]
+
+set file_extension [string tolower [file extension $upload_file]]
+# remove the first . from the file extension
+regsub "\." $file_extension "" file_extension
+
+# Guess a mime type for this file.
+
+set guessed_file_type [ns_guesstype $upload_file]
+
+set n_kbytes [expr [file size $tmp_file_name] / 1024]
+
+# strip off the C:\directories... crud and just get the file name
+if ![regexp {([^/\\]+)$} $upload_file match client_file_name] {
+    # couldn't find a match
+    set client_file_name $upload_file
+}
+
+set file_insert "
+insert into events_file_storage
+(file_id, file_title, file_content, client_file_name, file_type, file_extension, on_which_table, on_what_id, file_size, created_by, creation_ip_address, creation_date)
+values
+($file_id, '$QQfile_title', empty_blob(), '[DoubleApos $client_file_name]', '$guessed_file_type', '$file_extension', '$QQon_which_table', '$QQon_what_id', $n_kbytes, [ad_get_user_id], '[DoubleApos [ns_conn peeraddr]]', sysdate)
+returning file_content into :1
+"
+
+ns_ora blob_dml_file $db $file_insert $tmp_file_name
+
+# (version_id, file_id, version_description, creation_date, author_id, client_file_name, file_type, file_extension, n_kbytes, file_content)
+# values
+# ($version_id, $file_id, '$QQversion_description', sysdate, $user_id, '[DoubleApos $client_file_name]', '$guessed_file_type', '$file_extension', $n_bytes, empty_blob())
+# returning file_content into :1" 
+
+
+if { [exists_and_not_null return_url] } {
+    ns_returnredirect $return_url
+} else {
+    ns_returnredirect "success.tcl?[export_url_vars on_what_id on_which_table]"
+}
+
Index: web/openacs/www/events/admin/attach-file/upload.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/attach-file/upload.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/attach-file/upload.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,56 @@
+# upload.tcl,v 1.4.2.3 2000/02/03 09:49:59 ron Exp
+# This script allows a user to upload a file with a title
+# and attach that file to another table/id in acs
+
+set_form_variables 0
+# on_which_table on_what_id return_url
+
+validate_integer on_what_id $on_what_id
+
+if { ![exists_and_not_null on_which_table] || \
+	![exists_and_not_null on_what_id] } {
+    ns_returnredirect "index.tcl?[export_ns_set_vars url]"
+    return
+}
+
+set db [ns_db gethandle]
+set file_id [database_to_tcl_string $db \
+	"select events_fs_file_id_seq.nextVal from dual"]
+ns_db releasehandle $db
+
+set title "Upload a File"
+
+ReturnHeaders
+
+ns_write "
+[ad_header $title]
+<h2> $title </h2>
+[ad_context_bar_ws [list "../index.tcl" "Events Administration"] "Agenda File"]
+<hr>
+
+<form enctype=multipart/form-data method=POST action=upload-2.tcl>
+[export_form_vars on_which_table on_what_id return_url file_id]
+<table>
+<tr>
+<td valign=top align=right>File: </td>
+<td>
+<input type=file name=upload_file size=30><br>
+Use the \"Browse...\" button to locate your File, then click \"Open\".
+</td>
+</tr>
+<tr>
+  <td valign=top align=right>Title: </td>
+  <td><input type=text name=file_title size=45> </td>
+</tr>
+<tr>
+<td></td>
+<td><input type=submit value=\"Upload\">
+</td>
+</tr>
+</table>
+
+</form>
+
+[ad_footer]
+"
+
Index: web/openacs/www/events/admin/attach-file/view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/attach-file/view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/attach-file/view.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,51 @@
+# view.tcl,v 1.2.2.1 2000/02/03 09:50:00 ron Exp
+# View a file based on table and ID
+
+set_the_usual_form_variables 0
+# on_which_table on_what_id
+
+validate_integer on_what_id $on_what_id
+
+if { ![exists_and_not_null on_which_table] || \
+	![exists_and_not_null on_what_id] } {
+    ad_return_error "Missing Information" "You must specify both the table and id for which to display files"
+    return
+}
+
+
+
+
+set db [ns_db gethandle]
+set selection [ns_db select $db \
+	"select file_id, file_title 
+           from events_file_storage
+          where on_which_table='$QQon_which_table'
+            and on_what_id='$QQon_what_id'
+       order by lower(file_title), creation_date desc"]
+
+set results ""
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append results "  <li> <a href=download.tcl?[export_url_vars file_id]>$file_title</a>\n"
+}
+
+ns_db releasehandle $db
+
+
+set title "View file"
+
+ReturnHeaders
+
+ns_write "
+[ad_header $title]
+
+<h2> $title </h2>
+
+<hr>
+
+<ul>
+$results
+</ul>
+
+[ad_footer]
+"
Index: web/openacs/www/events/admin/spam/action-choose.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/spam/action-choose.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/spam/action-choose.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,110 @@
+# action-choose.tcl,v 1.1.2.2 2000/02/03 09:50:01 ron Exp
+
+set_the_usual_form_variables
+
+# maybe user_class_id (to indicate a previousely-selected class of users)
+# maybe a whole host of user criteria
+
+set admin_user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+# we get a form that specifies a class of user
+
+set users_description [ad_user_class_description [ns_conn form]]
+
+ReturnHeaders 
+
+ns_write "[ad_admin_header "Spam"]
+
+<h2>Spam</h2>
+
+[ad_context_bar_ws [list "../index.tcl" "Events Administration"] "Spam"]
+
+<hr>
+
+<P>
+
+"
+
+set db [ns_db gethandle]
+
+set query [ad_user_class_query_count_only [ns_conn form]]
+if [catch {set n_users [database_to_tcl_string $db $query]} errmsg] {
+    ns_write  "The query
+    <blockquote>
+    $query 
+    </blockquote>
+    is invalid.
+    [ad_footer]"
+    return
+}
+
+if {$n_users == 0} {
+    ns_write "There are no people to e-mail.[ad_footer]"
+    return
+}
+
+set action_heading ""
+if {$n_users == 1} {
+    append action_heading "You are e-mailing $n_users person."
+} else {
+    append action_heading "You are e-mailing [util_commify_number $n_users] people."
+}
+
+
+# generate unique key here so we can handle the "user hit submit twice" case
+set spam_id [database_to_tcl_string $db "select spam_id_sequence.nextval from dual"]
+
+# Generate the SQL query from the user_class_id, if supplied, or else from the 
+# pile of form vars as args to ad_user_class_query
+
+set users_sql_query [ad_user_class_query [ns_getform]]
+regsub {from users} $users_sql_query {from users_spammable users} users_sql_query
+
+ns_write "
+
+<form method=POST action=\"spam-confirm.tcl\">
+[export_form_vars spam_id users_sql_query users_description]
+
+From: <input name=from_address type=text size=30 value=\"[database_to_tcl_string $db "select email from users where user_id = $admin_user_id"]\">
+
+<p>To: $action_heading
+" 
+if {$n_users > 0} {
+    ns_write "
+    <a href=\"spamees-view.tcl?[export_url_vars sql_post_select]\">
+    View whom you're spamming</a>
+    "
+}
+ns_write "
+<p>Send Date:</th><td>[_ns_dateentrywidget "send_date"]<br>
+Send Time:[_ns_timeentrywidget "send_date"]
+
+
+<p>
+
+Subject:  <input name=subject type=text size=50>
+
+<p>
+
+Message:
+
+<p>
+
+<textarea name=message rows=10 cols=80 wrap=soft></textarea>
+
+<p>
+
+<center>
+
+<input type=submit value=\"Send Email\">
+
+</center>
+
+</form>
+<p>
+
+
+[ad_footer]
+"
Index: web/openacs/www/events/admin/spam/spam-confirm.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/spam/spam-confirm.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/spam/spam-confirm.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,136 @@
+# spam-confirm.tcl,v 1.1.2.2 2000/02/03 09:50:02 ron Exp
+# spam-confirm.tcl
+#
+# hqm@arsdigita.com
+#
+# A good thing to do before sending out 100,000 emails:
+# ask user to confirm the outgoing spam before queuing it.
+#
+
+set_the_usual_form_variables
+
+validate_integer spam_id $spam_id
+
+# spam_id, from_address, subject, 
+# message, (optional) message_html, message_aol
+# maybe send_date
+# 
+# if from_file_p=t, then get message texts from default filesystem location 
+#
+#
+# maybe: users_sql_query     The SQL needed to get the list of target users
+#        users_description   English descritpion of target users
+# or else user_class_id, which can be passed to ad_user_class_query to generate a SQL query.
+#
+# maybe: template_p   If == 't', then run subst on the message subject and body. A scary
+# prospect, but spam can only be created by site admins anyhow)
+
+set db [ns_db gethandle]
+
+set admin_user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+if {[info exists from_file_p] && [string compare $from_file_p "t"] == 0} {
+    set message [get_spam_from_filesystem "plain"]
+    set message_html [get_spam_from_filesystem "html"]
+    set message_aol [get_spam_from_filesystem "aol"]
+}
+
+set exception_count 0
+set exception_text ""
+
+if {[catch {ns_dbformvalue [ns_conn form] send_date datetime send_date} errmsg]} {
+    incr exception_count
+    append exception_text "<li>Please make sure your date is valid."
+}
+
+
+
+if {$exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+ns_dbformvalue [ns_conn form] send_date datetime send_date
+
+if {[info exists template_p] && [string match $template_p "t"]} {
+   set template_pretty "Yes"
+} else {
+    set template_p "f"
+    set template_pretty "No" 
+}
+
+ReturnHeaders
+
+append pagebody "[ad_admin_header "Confirm sending spam"]
+<h2>Confirm Sending Spam</h2>
+[ad_context_bar_ws [list "../index.tcl" "Events Administration"]  "Confirm Spam"]
+
+<hr>
+
+The following spam will be queued for delivery:
+
+
+<p>
+"
+#
+set message [spam_wrap_text $message 80]
+
+append pagebody "
+
+<form method=POST action=\"spam.tcl\">
+
+<blockquote>
+<table border=1>
+
+</td></tr>
+<tr><th align=right>Date:</th><td> $send_date </td></tr>
+
+<tr><th align=right>From:</th><td>$from_address</td></tr>
+<tr><th align=right>Subject:</th><td>$subject</td></tr>
+<tr><th align=right valign=top>Plain Text Message:</th><td>
+<pre>[ns_quotehtml $message]</pre>
+</td></tr>
+
+"
+if {[info exists message_html] && ![empty_string_p $message_html]} {
+    append pagebody "<tr><th align=right valign=top>HTML Message:</th>
+<td>
+$message_html
+</td>
+</tr>"
+}
+
+if {[info exists message_aol] && ![empty_string_p $message_aol]} {
+    append pagebody "<tr><th align=right valign=top>AOL Message:</th>
+<td>
+$message_aol
+</td>
+</tr>"
+}
+
+
+append pagebody "
+</table>
+
+</blockquote>
+"
+
+set count_users_query "select count(*) from ($users_sql_query)"
+set total_users [database_to_tcl_string $db $count_users_query]
+
+
+append pagebody "
+You will send email to $total_users users.
+<p>
+<center>
+<input type=submit value=\"Send Spam\">
+
+</center>
+
+[export_form_vars users_sql_query spam_id from_address subject message message_html message_aol send_date template_p users_description]
+</form>
+[ad_footer]"
+
+
+ns_write $pagebody
Index: web/openacs/www/events/admin/spam/spam.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/spam/spam.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/spam/spam.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,133 @@
+# spam.tcl,v 1.1.2.2 2000/02/03 09:50:04 ron Exp
+# spam.tcl
+#
+# hqm@arsdigita.com
+#
+# Queues an outgoing spam message to a group of users,
+# by adding it to the spam_history table
+
+set_the_usual_form_variables
+
+ns_log Notice "spam.tcl: entering page"
+
+validate_integer spam_id $spam_id
+
+# spam_id, from_address, subject, 
+# message (optionally message_html, message_aol)
+# maybe send_date
+# from_file_p
+# template_p
+#
+# users_sql_query     The SQL needed to get the list of target users
+# users_description   English descritpion of target users
+
+set admin_user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+# Strip all ^M's out of any itneractively entered text message.
+# This is because Windows browsers insist on inserting CRLF at
+# the end of each line of a TEXTAREA.
+if {[info exists message]} {
+    regsub -all "\r" $message "" message 
+}
+
+if {[info exists from_file_p] && [string compare $from_file_p "t"] == 0} {
+    set message [get_spam_from_filesystem "plain"]
+    set message_html [get_spam_from_filesystem "html"]
+    set message_aol [get_spam_from_filesystem "aol"]
+}
+
+if {[info exists template_p] && [string match $template_p "t"]} {
+} else {
+    set template_p "f"
+}
+
+if {![info exists send_date]} {
+    set send_date ""
+}
+
+if {![info exists message_html]} {
+    set message_html ""
+}
+
+if {![info exists message_aol]} {
+    set message_aol ""
+}
+
+set exception_count 0
+set exception_text ""
+
+if {[empty_string_p $subject] && [empty_string_p $message] && [empty_string_p $message_html] && [empty_string_p $message_aol]} {
+    incr exception_count
+    append exception_text "<li>The contents of your message and subject line is the empty string. You must send something in the message body"
+}
+
+
+if {$exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+set db [ns_db gethandle]
+
+if [catch { ns_ora clob_dml $db "insert into spam_history
+(spam_id, template_p, from_address, title, body_plain, body_html, body_aol, user_class_description, user_class_query, send_date, creation_date, creation_user, creation_ip_address, status)
+values
+($spam_id, '$template_p', '$QQfrom_address', '$QQsubject', empty_clob(),empty_clob(),empty_clob(), '[DoubleApos $users_description]', [ns_dbquotevalue $users_sql_query], nvl(to_date('$send_date', 'YYYY-MM-DD HH24:MI:SS'), sysdate), sysdate, $admin_user_id, '[DoubleApos [ns_conn peeraddr]]', 'unsent')
+returning body_plain, body_html, body_aol into :1, :2, :3" $message $message_html $message_aol } errmsg] {
+    # choked; let's see if it is because 
+    if { [database_to_tcl_string $db "select count(*) from spam_history where spam_id = $spam_id"] > 0 } {
+	ns_return 200 text/html "[ad_admin_header "Double Click?"]
+
+<h2>Double Click?</h2>
+
+<hr>
+
+This spam has already been sent.  Perhaps you double clicked?  In any 
+case, you can check the progress of this spam on
+<a href=\"old.tcl?[export_url_vars spam_id]\">the history page</a>.
+
+[ad_footer]"
+    } else {
+	ad_return_error "Ouch!" "The database choked on your insert:
+<blockquote>
+$errmsg
+</blockquote>
+"
+    }
+    return
+}
+
+
+ReturnHeaders 
+
+append pagebody "
+[ad_admin_header "Spamming Users"]
+
+<h2>Spamming Users</h2>
+[ad_context_bar_ws [list "../index.tcl" "Events Administration"]  "Spam Execution"]
+
+<hr>
+Message to be sent:
+
+<ul>
+<li>from: $from_address
+<li>subject:  $subject
+<li>send on:  $send_date
+<li>body: <blockquote><pre>$message</pre></blockquote>
+
+</ul>
+
+"
+
+
+append pagebody "
+
+
+Queued for delivery by the spam sending daemon.
+<p>
+
+[ad_footer]
+"
+ns_write $pagebody
+
Index: web/openacs/www/events/admin/spam/spamees-view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/events/admin/spam/spamees-view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/events/admin/spam/spamees-view.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,29 @@
+# spamees-view.tcl,v 1.1.2.2 2000/02/03 09:50:05 ron Exp
+set_the_usual_form_variables
+#sql_post_select
+
+if {![exists_and_not_null sql_post_select]} {
+    ad_return_complaint 1 "<li>You have entered this page without
+    a sql_post_select variable"
+}
+
+ReturnHeaders 
+
+ns_write "[ad_admin_header "Spam"]
+
+<h2>Spam</h2>
+
+[ad_context_bar_ws [list "../index.tcl" "Events Administration"] [list "action-choose.tcl?[export_url_vars sql_post_select]" "Spam"] "Spamees"]
+
+<hr>
+You are spamming the following people:
+<ul>
+"
+set db [ns_db gethandle]
+set selection [ns_db select $db "select users.email $sql_post_select"]
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    ns_write "<li>$email"
+}
+
+ns_write "</ul>[ad_footer]"
Index: web/openacs/www/faq/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/faq/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/faq/index.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,108 @@
+# /faq/index.tcl
+#
+# dh@arsdigita.com, December, 1999
+#
+# Purpose: shows a list of user-viewable FAQs.
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+#
+# index.tcl,v 3.4.2.3 2000/03/16 04:23:06 dh Exp
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (group_id)
+
+ad_scope_error_check
+
+set db_pool [ns_db gethandle [philg_server_default_pool] 2]
+set db  [ lindex $db_pool 0]
+set db2 [ lindex $db_pool 1]
+
+set user_id [ad_scope_authorize $db $scope all group_member none]
+
+# get the FAQs this person can see
+switch $scope {
+    public {
+	if { $user_id==0 } {
+	    # user not logged in, so show only public faqs
+	    
+	    set selection [ns_db select $db "
+	    select distinct faq_name, faq_id, scope as faq_scope, faqs.group_id as faq_group_id
+	    from faqs
+	    where faqs.scope = 'public' 
+	    order by faq_name"]
+	} else {
+	    # user is logged in, so show public faqs and the faqs of the groups user beolngs to
+	    # for group faqs, make sure that they are enabled (in content sections table)
+	    set selection [ns_db select $db "
+	    select distinct faq_name, faq_id, faqs.scope as faq_scope, faqs.group_id as faq_group_id
+	    from faqs, user_group_map
+	    where faqs.scope = 'public' 
+	    or (    ad_group_member_p ( $user_id, faqs.group_id ) = 't'
+                and faqs.scope='group' )
+	    order by faq_name"]
+	}
+    }
+    group {
+	# for group faqs, make sure that they are enabled (in content sections table)
+	set selection [ns_db select $db "
+	select distinct faq_name, faq_id , faqs.scope as faq_scope, faqs.group_id as faq_group_id
+	from faqs, content_sections cs
+	where faqs.scope = 'group' and faqs.group_id=$group_id
+	order by faq_name"]
+    }
+}
+    
+set faq_count 0
+set faq_list ""
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    incr faq_count
+
+    if { $faq_scope == "public" } {
+	set link_url "one?[export_url_scope_vars faq_id]"
+    } else {
+	set short_name [database_to_tcl_string $db2 "select short_name
+                                                    from user_groups
+                                                     where group_id = $faq_group_id"]  
+	set link_url "/[ad_parameter GroupsDirectory ug]/[ad_urlencode $short_name]/faq/one?[export_url_scope_vars faq_id]&scope=$faq_scope&group_id=$faq_group_id"
+    }
+
+    append faq_list "<li><a href=$link_url>$faq_name</a>\n"
+}
+
+if { $faq_count == 0 } {    
+    set faq_list "There are currently no FAQs available for you to see."
+}
+
+set header_content "[ad_scope_header "FAQs" $db]
+[ad_scope_page_title "FAQs" $db]
+[ad_scope_context_bar_ws_or_index "FAQs"]
+<hr>
+"
+
+ns_db releasehandle $db2
+ns_db releasehandle $db
+
+# --serve the page--------------------------------
+
+ns_return 200 text/html "
+
+$header_content
+
+[ad_scope_navbar]
+<p>
+<ul>
+$faq_list
+</ul>
+<p>
+[ad_scope_footer]"
+
+
+
+
+
+
Index: web/openacs/www/faq/one.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/faq/one.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/faq/one.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,117 @@
+# /faq/one.tcl
+# 
+# dh@arsdigita.com, December 1999
+# 
+# displays the FAQ
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+#
+# one.tcl,v 3.1.2.1 2000/03/15 20:16:23 aure Exp
+
+set_the_usual_form_variables
+# faq_id
+# maybe scope, maybe scope related variables (group_id)
+
+validate_integer faq_id $faq_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+
+# check that this user can see the faq --------------
+faq_authorize $db $faq_id
+
+# check if the user can maintain this faq and generate appropriate maintainers url --------
+if { [faq_maintaner_p $db $faq_id] } {
+
+    if { $scope == "public" } {
+	set admin_url "/faq/admin"
+    } else {
+	set short_name [database_to_tcl_string $db "select short_name
+                                                    from user_groups
+                                                     where group_id = $group_id"] 
+	set admin_url "/[ad_parameter GroupsDirectory ug]/[ad_parameter GroupsAdminDirectory ug]/[ad_urlencode $short_name]/faq"
+    }
+   
+    append helper_args [list "$admin_url/one?[export_url_vars faq_id]" "Maintain this FAQ"]
+} else {
+    # user is not authorized to mantain this faq
+    set helper_args ""
+}
+
+# get the faq_name ----------------------------------
+set faq_name [database_to_tcl_string $db "
+select faq_name
+from faqs 
+where faq_id = $faq_id"]
+
+# get the faq from the database
+set selection [ns_db select $db "
+select question, 
+       answer,
+       entry_id,
+       sort_key
+from   faq_q_and_a 
+where  faq_id = $faq_id
+order by sort_key"]
+
+set q_and_a_list ""
+set q_list ""
+set question_number 0
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr question_number
+    append q_list "<li><a href=#$question_number>$question</a>\n"
+    append q_and_a_list "
+   <li><a name=$question_number></a>
+       <b>Q: </b><i>$question</i><p>
+       <b>A: </b>$answer<p><br><p>"
+}
+
+
+# --serve the page ----------
+append html "
+[ad_scope_header $faq_name $db]
+[ad_scope_page_title $faq_name $db]
+[ad_scope_context_bar_ws_or_index [list "index?[export_url_scope_vars]" "FAQs"] "One FAQ"]
+
+<hr>
+[help_upper_right_menu $helper_args]
+[ad_scope_navbar]
+<p>
+"
+
+if {![empty_string_p $q_list] } {
+    append html "
+    Frequently Asked Questions:
+    <ol>
+    $q_list
+    </ol>
+    <hr>
+    "
+    if {![empty_string_p $q_and_a_list] } {
+	append html "
+	Questions and Answers:
+	<ol>
+	$q_and_a_list
+	</ol>
+	<p>
+	"    }
+} else {
+    append html "
+    <p>
+    No Questions/Answers available
+    <p>" 
+}
+
+append html "
+
+[ad_scope_footer]"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $html
+
Index: web/openacs/www/faq/admin/add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/faq/admin/add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/faq/admin/add-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,123 @@
+# /faq/admin/add-2.tcl
+# 
+# Records new question/answers into the faq table
+#
+# by dh@arsdigita.com, created on 12/19/99
+#
+# add-2.tcl,v 3.0.4.1 2000/03/16 01:49:49 dh Exp
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+ad_page_variables { 
+    { question -- QQ } 
+    { answer -- QQ } 
+    new_entry_id 
+    last_entry_id
+    faq_id }
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (group_id)
+
+validate_integer new_entry_id $new_entry_id
+# validate_integer last_entry_id $last_entry_id
+validate_integer faq_id $faq_id
+
+ad_scope_error_check
+set db [ns_db gethandle]
+faq_admin_authorize $db $faq_id
+
+# -- form validation -----------------
+set error_count 0
+set error_text ""
+if {![info exists question] || [empty_string_p [string trim $question] ] } {
+    incr error_count
+    append error_text "<li>You must supply a question"
+}
+
+if {![info exists answer] || [empty_string_p [string trim $answer] ] } {
+    incr error_count
+    append error_text "<li>You must supply an answer"
+}
+
+if {$error_count >0 } {
+    ad_scope_return_complaint $error_count $error_text $db
+    return
+}
+
+# ------------------------------------
+
+ns_db dml $db "begin transaction"
+
+# check if this is a double click
+set double_click_p [database_to_tcl_string  $db "
+select count(*) 
+from faq_q_and_a
+where entry_id = $new_entry_id"]
+
+if {$double_click_p == "0" } {
+    # this isn't a double click
+    # go ahead and do the inserts.
+
+    if {$last_entry_id != "-1"} {
+	# this q+a being added after an existing question
+	# make room - then do the insert 
+    
+        set old_sort_key [database_to_tcl_string $db "select sort_key 
+	from faq_q_and_a
+	where entry_id = $last_entry_id"]
+
+	set sql_update_q_and_a "
+	update faq_q_and_a
+	set sort_key = sort_key + 1
+	where sort_key > $old_sort_key"
+
+	ns_db dml $db $sql_update_q_and_a
+    
+	if {$old_sort_key == ""} {
+	    set old_sort_key 0
+	}
+
+	set sql_insert_q_and_a "
+	insert into faq_q_and_a
+	(entry_id, question, answer, sort_key, faq_id)
+	values
+	($new_entry_id,'$QQquestion','$QQanswer',$old_sort_key+1, $faq_id) "
+	
+	ns_db dml $db $sql_insert_q_and_a
+		
+    } else {
+	# this q+a being added at the end of the FAQ
+    
+	set max_sort_key [database_to_tcl_string $db "select max(sort_key) 
+	from faq_q_and_a "]
+
+	if {$max_sort_key == ""} {
+	    set max_sort_key 0
+	}
+
+	set sql_update_q_and_a "
+	insert into faq_q_and_a 
+	(entry_id, question, answer, sort_key, faq_id)
+	values
+	($new_entry_id, '$QQquestion','$QQanswer',$max_sort_key+1, $faq_id) "
+	
+	ns_db dml $db $sql_update_q_and_a
+    }
+
+}
+ns_db dml $db "end transaction"
+
+ns_returnredirect "one?[export_url_scope_vars faq_id]"
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/faq/admin/add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/faq/admin/add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/faq/admin/add.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,107 @@
+# /faq/admin/add.tcl
+# 
+# Purpose:  allows the user to add a new questions and answers
+#
+# dh@arsdigita.com created on 12/19/99
+#
+# add.tcl,v 3.0.4.2 2000/03/16 03:56:49 dh Exp
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (group_id)
+# faq_id 
+# maybe: entry_id
+
+validate_integer faq_id $faq_id
+
+ad_scope_error_check
+set db [ns_db gethandle]
+faq_admin_authorize $db $faq_id
+
+if {[info exists entry_id] } {
+    validate_integer entry_id $entry_id
+    set last_entry_id $entry_id
+} else {
+    set last_entry_id "-1"
+}
+
+set new_entry_id [database_to_tcl_string $db "select faq_id_sequence.nextval from dual"]
+
+# get the faq_name
+set selection [ns_db 1row $db "
+select f.faq_name
+from faqs f
+where   f.faq_id = $faq_id"]
+
+set_variables_after_query
+
+if {[info exists scope]&& $scope=="group"} {
+    set context_bar "[ad_scope_admin_context_bar  \
+	     [list index?[export_url_scope_vars] "FAQ Admin"]\
+	      [list "one?[export_url_scope_vars faq_id]" $faq_name]\
+	    "Add"]"
+} else {
+    set context_bar "[ad_scope_context_bar_ws \
+	    [list ../index?[export_url_scope_vars] "FAQs"] \
+	    [list "index?[export_url_scope_vars]" "Admin"] \
+	    [list "one?[export_url_scope_vars faq_id]" $faq_name]\
+	    "Add"]"
+}
+
+
+set header_content "
+[ad_scope_admin_header "Add Q and A" $db]
+[ad_scope_admin_page_title "Add a Question to $faq_name" $db]
+"
+
+ns_db releasehandle $db
+
+# --serve the page -----------
+
+ns_return 200 text/html "
+
+$header_content
+
+$context_bar
+
+<hr>
+
+Please enter the new Question and Answer for the FAQ:
+
+<table>
+
+<form action=add-2.tcl method=post>
+[export_form_scope_vars last_entry_id new_entry_id faq_id]
+
+<tr>
+ <td valign=top align=right><b>Question:</b></td>
+ <td><textarea rows=3 cols=50 wrap name=\"question\"></textarea></td>
+</tr>
+<tr>
+ <td valign=top align=right><b>Answer:</b></td>
+ <td><textarea rows=10 cols=50 wrap name=\"answer\"></textarea></td>
+</tr>
+<tr>
+ <td colspan=2 align=center><input type=submit value=\"Submit\"></td>
+</tr>
+</table>
+</form>
+
+<p>
+
+[ad_scope_admin_footer]"
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/faq/admin/delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/faq/admin/delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/faq/admin/delete-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,40 @@
+# /faq/admin/delete-2.tcl
+#
+# Deletes a q/a from the faq table
+#
+# by dh@arsdigita.com, created on 12/19/99
+#
+# delete-2.tcl,v 3.0.4.1 2000/03/16 02:00:43 dh Exp
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+ad_page_variables {entry_id faq_id}
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (group_id)
+
+validate_integer entry_id $entry_id
+validate_integer faq_id $faq_id
+
+ad_scope_error_check
+set db [ns_db gethandle]
+faq_admin_authorize $db $faq_id
+
+ns_db dml $db "delete from faq_q_and_a where entry_id = $entry_id"
+
+ns_db releasehandle $db
+
+ns_returnredirect "one?[export_url_scope_vars faq_id]"
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/faq/admin/delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/faq/admin/delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/faq/admin/delete.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,79 @@
+# /faq/admin/delete.tcl
+# 
+# Delete verification page
+#
+# by dh@arsdigita.com, created on 12/19/99
+#
+# delete.tcl,v 3.0.4.2 2000/03/16 03:57:23 dh Exp
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+ad_page_variables {entry_id faq_id}
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (group_id)
+
+validate_integer entry_id $entry_id
+validate_integer faq_id $faq_id
+
+ad_scope_error_check
+set db [ns_db gethandle]
+faq_admin_authorize $db $faq_id
+
+# get the faq_name and faq_id
+
+set selection [ns_db 1row $db "
+select f.faq_name, 
+       f.faq_id
+from faqs f, faq_q_and_a fqa
+where fqa.entry_id = $entry_id
+and   fqa.faq_id = f.faq_id "]
+
+set_variables_after_query
+
+if {[info exists scope]&& $scope=="group"} {
+    set context_bar "[ad_scope_admin_context_bar  \
+	    [list index?[export_url_scope_vars] "FAQ Admin"]\
+	    [list "one?[export_url_scope_vars faq_id]" $faq_name]\
+	    [list "more?[export_url_scope_vars faq_id entry_id]" "One Question"]\
+	    "Delete"]"
+} else {
+    set context_bar "[ad_scope_context_bar_ws \
+	    [list "../index?[export_url_scope_vars]" "FAQs"]\
+	    [list "index?[export_url_scope_vars]" "Admin"]\
+	    [list "one?[export_url_scope_vars faq_id]" $faq_name]\
+	    [list "more?[export_url_scope_vars faq_id entry_id]" "One Question"]\
+	    "Delete"]"
+}
+
+set header_content "
+[ad_scope_admin_header "Delete" $db]
+[ad_scope_admin_page_title "Delete" $db] "
+
+ns_db releasehandle $db 
+
+# --serve the page ---------------------------
+ns_return 200 text/html "
+
+$header_content
+
+$context_bar
+
+<hr>
+
+<form action=delete-2.tcl method=post>
+[export_form_scope_vars entry_id faq_id]
+Are you sure you want to delete this FAQ question and answer?<P>
+<input type=submit value=\"Yes, Delete\">
+</form>
+
+[ad_scope_admin_footer]"
+
+
+
+
+
+
+
+
Index: web/openacs/www/faq/admin/edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/faq/admin/edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/faq/admin/edit-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,66 @@
+# /faq/admin/edit-2.tcl
+#
+# Records a FAQ edit in the database
+#
+# by dh@arsdigita.com, created on 12/19/99
+#
+# edit-2.tcl,v 3.0.4.1 2000/03/16 01:55:20 dh Exp
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+ad_page_variables { 
+    { question "" QQ}
+    { answer "" QQ}
+    entry_id 
+    faq_id }
+
+validate_integer entry_id $entry_id
+validate_integer faq_id $faq_id
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (group_id)
+# entry_id
+
+ad_scope_error_check
+set db [ns_db gethandle]
+faq_admin_authorize $db $faq_id
+
+# -- form validation -----------------
+set error_count 0
+set error_text ""
+if {![info exists question] || [empty_string_p [string trim $question] ] } {
+    incr error_count
+    append error_text "<li>You must supply a question"
+}
+
+if {![info exists answer] || [empty_string_p [string trim $answer ] ] } {
+    incr error_count
+    append error_text "<li>You must supply an answer"
+}
+
+if {$error_count >0 } {
+    ad_scope_return_complaint $error_count $error_text $db
+    return
+}
+
+# ------------------------------------
+
+
+ns_db dml $db "update faq_q_and_a
+set question = '$QQquestion',
+    answer   = '$QQanswer'
+where entry_id = $entry_id"
+
+ns_db releasehandle $db
+
+ns_returnredirect "one?[export_url_scope_vars faq_id]"
+
+
+
+
+
+
+
Index: web/openacs/www/faq/admin/edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/faq/admin/edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/faq/admin/edit.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,92 @@
+# /faq/admin/edit.tcl
+#
+# Edits a FAQ entry
+#
+# by dh@arsdigita.com, created on 12/19/99
+#
+# edit.tcl,v 3.0.4.2 2000/03/16 03:57:55 dh Exp
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+ad_page_variables {entry_id faq_id}
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (group_id)
+
+validate_integer entry_id $entry_id
+validate_integer faq_id $faq_id
+
+ad_scope_error_check
+set db [ns_db gethandle]
+faq_admin_authorize $db $faq_id
+
+set selection [ns_db 1row $db  "
+select question, answer 
+from faq_q_and_a 
+where entry_id=$entry_id"]
+
+set_variables_after_query
+
+set faq_name [database_to_tcl_string $db "
+select faq_name from faqs where faq_id = $faq_id"]
+
+if {[info exists scope]&& $scope=="group"} {
+    set context_bar "[ad_scope_admin_context_bar  \
+	    [list index?[export_url_scope_vars] "FAQ Admin"]\
+	    [list "one?[export_url_scope_vars faq_id]" $faq_name]\
+	    [list "more?[export_url_scope_vars faq_id entry_id]" "One Question"]\
+	    "Edit"]"
+} else {
+    set context_bar "[ad_scope_context_bar_ws \
+	    [list "../index?[export_url_scope_vars]" "FAQs"] \
+	    [list "index?[export_url_scope_vars]" "Admin"]\
+	    [list "one?[export_url_scope_vars faq_id]" $faq_name]\
+	    [list "more?[export_url_scope_vars faq_id entry_id]" "One Question"]\
+	    "Edit"]"
+}
+
+set header_content "
+[ad_scope_admin_header "Edit Q and A" $db]
+[ad_scope_admin_page_title "Edit a Question" $db]"
+
+ns_db releasehandle $db
+# --serve the page ----------
+
+ns_return 200 text/html "
+
+$header_content
+
+$context_bar
+
+
+<hr>
+
+Please edit the Question and Answer for the FAQ $faq_name:
+
+<table>
+<form action=edit-2.tcl method=post>
+[export_form_scope_vars entry_id faq_id]
+
+<tr>
+ <td valign=top align=right><b>Question:</b></td>
+ <td><textarea rows=3 cols=50 wrap name=\"question\">[ns_quotehtml $question]</textarea></td>
+</tr>
+<tr>
+ <td valign=top align=right><b>Answer:</b></td>
+ <td><textarea rows=10 cols=50 wrap name=\"answer\">[ns_quotehtml $answer]</textarea></td>
+</tr>
+<tr>
+ <td></td>
+ <td><input type=submit value=\"Submit\"></td>
+</tr>
+</table>
+
+</form>
+
+[ad_scope_admin_footer]"
+
+
+
Index: web/openacs/www/faq/admin/faq-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/faq/admin/faq-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/faq/admin/faq-add-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,86 @@
+# /faq/admin/faq-add-2.tcl
+# 
+#
+# Purpose:  creates a new faq in the database after checking the input
+#           use a catch around the insert so double-clicks wont give an error
+#
+# dh@arsdigita.com created on 12/19/99
+#
+# faq-add-2.tcl,v 3.0.4.2 2000/03/16 01:39:08 dh Exp#
+
+
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (group_id)
+
+ad_page_variables {
+    {next_faq_id}
+    {faq_name "" qq}
+    {scope}
+}
+
+validate_integer next_faq_id $next_faq_id
+
+ad_scope_error_check
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope admin group_admin none
+
+# -- form validation ------------------
+
+set error_count 0
+set error_text ""
+
+if {![info exists faq_name] || [empty_string_p [string trim $faq_name] ] } {
+    incr error_count
+    append error_text "<li>You must supply a name for the new FAQ."
+}
+
+if {$error_count > 0 } {
+    ad_scope_return_complaint $error_count $error_text $db
+    return
+}
+
+#-------------------------------------
+
+set err_msg ""
+
+set sql "
+insert into faqs
+(faq_id, faq_name, [ad_scope_cols_sql])
+values
+($next_faq_id, '$QQfaq_name', [ad_scope_vals_sql])"
+
+ns_db dml $db "begin transaction"
+
+set double_click_p [database_to_tcl_string $db "
+select count(*)
+from faqs
+where faq_id = $next_faq_id"]
+
+
+if {$double_click_p == "0"} {
+    # not a double click
+    
+    # make the new faq in the faqs table
+    ns_db dml $db $sql
+
+}
+
+
+ns_db dml $db "end transaction"
+
+
+ns_db releasehandle $db
+
+
+ns_returnredirect "index?[export_url_scope_vars]"
+
+
+
+
+
+
Index: web/openacs/www/faq/admin/faq-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/faq/admin/faq-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/faq/admin/faq-add.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,80 @@
+# /faq/admin/faq-add.tcl
+#
+#  A form for creating a new faq (just the name and associated group)
+#
+# by dh@arsdigita.com, created on 12/19/99
+#
+# faq-add.tcl,v 3.0.4.4 2000/03/16 03:58:35 dh Exp#
+
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (group_id)
+
+ad_scope_error_check
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope admin group_admin none
+
+
+# get the next faq_id
+set next_faq_id [database_to_tcl_string $db "select faq_id_sequence.nextval from dual"]
+
+if {[info exists scope]&& $scope=="group"} {
+    set context_bar "[ad_scope_admin_context_bar  \
+	     [list index?[export_url_scope_vars] "FAQ Admin"]\
+	     "Create a FAQ"\
+	    ]"
+} else {
+    set context_bar "[ad_scope_context_bar_ws \
+	    [list "../index?[export_url_scope_vars]" "FAQs"]\
+	    [list index?[export_url_scope_vars] "Admin"]\
+	    "Create a FAQ"\
+	    ]"
+}
+
+set header_content "
+[ad_scope_admin_header "Create a FAQ" $db]
+[ad_scope_admin_page_title "Create a FAQ" $db]
+"
+
+ns_db releasehandle $db
+
+# -- serve the page -------------------------------
+
+ns_return 200 text/html "
+
+$header_content
+
+$context_bar
+
+<hr>
+
+<form action=faq-add-2.tcl  method=post>
+[export_form_scope_vars next_faq_id]
+<table>
+<tr>
+ <td><b>FAQ Name</b>:</td>
+ <td><input type=text name=faq_name></td>
+</tr>
+
+ <td></td>
+<tr>
+</tr>
+<tr>
+ <td></td>
+ <td><input type=submit value=\"Submit\"></td>
+</tr>
+</table>
+
+
+[ad_scope_admin_footer]"
+
+
+
+
+
+
+
Index: web/openacs/www/faq/admin/faq-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/faq/admin/faq-delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/faq/admin/faq-delete-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,36 @@
+# faq-delete-2.tcl,v 3.0 2000/02/06 03:41:43 ron Exp
+# File:     /faq/admin/faq-delete-2.tcl
+# Date:     12/19/99
+# Contact:  dh@arsdigita.com
+# Purpose:  deletes a FAQ (defined by faq_id) from the database
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+ad_page_variables {faq_id}
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (group_id)
+# faq_id
+
+validate_integer faq_id $faq_id
+
+ad_scope_error_check
+set db [ns_db gethandle]
+faq_admin_authorize $db $faq_id
+
+ns_db dml $db "begin transaction"
+
+# delete the contents of the FAQ (question and answers)
+ns_db dml $db "delete from faq_q_and_a where faq_id = $faq_id"
+
+# delete the FAQ properties (name, associated group, scope)
+ns_db dml $db "delete from faqs where faq_id = $faq_id"
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect index.tcl?[export_url_scope_vars]
+
+
Index: web/openacs/www/faq/admin/faq-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/faq/admin/faq-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/faq/admin/faq-delete.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,69 @@
+# /faq/admin/faq-delete.tcl
+#
+# Asks are you sure you want to delete this FAQ?
+#
+# by dh@arsdigita.com, created on 12/19/99
+#
+# faq-delete.tcl,v 3.0.4.2 2000/03/16 04:19:04 dh Exp
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (group_id)
+
+ad_page_variables {faq_id}
+
+validate_integer faq_id $faq_id
+
+ad_scope_error_check
+set db [ns_db gethandle]
+faq_admin_authorize $db $faq_id
+
+set faq_name [database_to_tcl_string $db "select faq_name from faqs where faq_id = $faq_id"]
+
+
+if {[info exists scope]&& $scope=="group"} {
+    set context_bar "[ad_scope_admin_context_bar  \
+	    [list index?[export_url_scope_vars] "FAQ Admin"]\
+	    [list "one?[export_url_scope_vars faq_id]" $faq_name]\
+	    "Delete a FAQ "\
+	    ]"
+} else {
+    set context_bar "[ad_scope_context_bar_ws \
+	    [list "../index?[export_url_scope_vars]" "FAQs"]\
+	    [list index?[export_url_scope_vars] "Admin"]\
+	    [list "one?faq_id=$faq_id" "$faq_name"]\
+	    "Delete a FAQ"\
+	    ]"
+}
+
+set header_content "
+[ad_scope_admin_header "Delete a FAQ" $db]
+[ad_scope_admin_page_title "Delete a FAQ" $db]
+"
+
+ns_db releasehandle $db
+
+# --serve the page ------------------------------
+
+ns_return 200 text/html "
+
+$header_content
+
+$context_bar
+
+<hr>
+
+<P>
+<form action=faq-delete-2.tcl method=post>
+[export_form_scope_vars faq_id]
+Are you sure you want to delete the FAQ <i><b>$faq_name?</b></i><p>
+<input type=submit value=\"Yes, Delete\">
+</form>
+
+<P>
+
+[ad_scope_admin_footer]"
Index: web/openacs/www/faq/admin/faq-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/faq/admin/faq-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/faq/admin/faq-edit-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,64 @@
+# /faq/admin/faq-edit-2.tcl
+# 
+# Deletes a FAQ (defined by faq_id) from the database
+#
+# by dh@arsdigita.com, created on 12/19/99
+#
+# faq-edit-2.tcl,v 3.0.4.1 2000/03/16 02:09:36 dh Exp
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+ad_page_variables {faq_id}
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (group_id)
+# faq_id , faq_name
+
+validate_integer faq_id $faq_id
+
+ad_scope_error_check
+set db [ns_db gethandle]
+faq_admin_authorize $db $faq_id
+
+# -- form validation ------------------
+
+set error_count 0
+set error_text ""
+
+
+if {![info exists faq_id] || [empty_string_p $faq_id] } {
+    incr error_count
+    append error_text "<li>FAQ id was not supplied."
+}
+
+if {![info exists faq_name] || [empty_string_p [string trim $faq_name]] } {
+    incr error_count
+    append error_text "<li>You must supply a name for the new FAQ."
+}
+
+if {$error_count > 0 } {
+    ad_scope_return_complaint $error_count $error_text $db
+    return
+}
+
+#-------------------------------------
+
+
+# updates the name of the FAQ
+ns_db dml $db "
+update faqs 
+set faq_name='$QQfaq_name' 
+where faq_id = $faq_id "
+
+
+ns_db releasehandle $db
+
+ns_returnredirect "one?[export_url_scope_vars faq_id]"
+
+
+
+
+
Index: web/openacs/www/faq/admin/faq-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/faq/admin/faq-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/faq/admin/faq-edit.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,90 @@
+# /faq/admin/faq-edit.tcl
+# 
+# Asks are you sure you want to delete this FAQ?
+#
+# by dh@arsdigita.com, created on 12/19/99
+#
+# faq-edit.tcl,v 3.0.4.2 2000/03/16 04:20:18 dh Exp
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (group_id)
+
+validate_integer faq_id $faq_id
+
+ad_scope_error_check
+set db [ns_db gethandle]
+faq_admin_authorize $db $faq_id
+
+set faq_name [database_to_tcl_string $db "
+select faq_name 
+from faqs
+where faq_id = $faq_id"] 
+
+if {[info exists scope]&& $scope=="group"} {
+    set context_bar "[ad_scope_admin_context_bar  \
+	    [list index?[export_url_scope_vars] "FAQ Admin"]\
+	    [list "one?[export_url_scope_vars faq_id]" $faq_name]\
+	    "Edit FAQ $faq_name"]"
+} else {
+    set context_bar "[ad_scope_context_bar_ws \
+	    [list "../index?[export_url_scope_vars]" "FAQs"] \
+	    [list index?[export_url_scope_vars] "Admin"] \
+	    [list "one?faq_id=$faq_id" "$faq_name"]\
+	    "Edit FAQ $faq_name "\
+	    ]"
+}
+
+set header_content "
+[ad_scope_admin_header "Edit FAQ $faq_name" $db]
+[ad_scope_admin_page_title "Edit FAQ $faq_name" $db] "
+
+ns_db releasehandle $db
+
+# -- serve the page -------------------------------
+
+
+
+ns_return 200 text/html "
+
+$header_content
+
+$context_bar
+<hr>
+
+<form action=faq-edit-2.tcl  method=post>
+[export_form_scope_vars faq_id]
+<table>
+<tr>
+ <td><b>FAQ Name</b>:</td>
+ <td><input type=text name=faq_name value=\"[philg_quote_double_quotes $faq_name]\"></td>
+</tr>
+
+ <td></td>
+<tr>
+</tr>
+<tr>
+ <td></td>
+ <td><input type=submit value=\"Submit\"></td>
+</tr>
+</table>
+
+
+[ad_scope_admin_footer]"
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/faq/admin/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/faq/admin/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/faq/admin/index.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,93 @@
+# /faq/admin/index.tcl
+# 
+# gives a list of FAQs that this user_id may edit
+# if the user is allowed to create/delete a FAQ - that option is given
+# to him here.
+#
+# dh@arsdigita.com, December 1999
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+#
+# index.tcl,v 3.0.4.5 2000/03/16 04:21:15 dh Exp
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (group_id)
+
+ad_scope_error_check
+
+# this page will show all the faqs associated with the particular group
+
+set db [ns_db gethandle]
+# this pages should be used for administration of group faqs only
+# public pages can be administered at the /faq/admin by the site wide administrator
+set user_id [ad_scope_authorize $db $scope admin group_admin none]
+
+# just show the list of the faqs that group administrator of the group 
+# identified by group_id can administer
+set selection [ns_db select $db "
+select distinct faq_name, faq_id 
+from   faqs
+where  [ad_scope_sql faqs]
+order by faq_name"]
+
+set avail_faq_count 0
+set avail_faq_list "You may maintain the following FAQs
+<ul>\n"
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr avail_faq_count
+    append avail_faq_list "<li><a href=one?[export_url_scope_vars faq_id]>$faq_name</a>\n"
+}
+append avail_faq_list "</ul>\n"
+
+if { $avail_faq_count == 0} {
+    set avail_faq_list "<p> There are no FAQs in the database right now."
+}
+
+if {[info exists scope]&& $scope=="group"} {
+    set context_bar "[ad_scope_admin_context_bar  "FAQ Admin"]"
+} else {
+    set context_bar "[ad_scope_context_bar_ws  \
+	    [list "../index?[export_url_scope_vars]" "FAQs"] "Admin"]"
+}
+
+set header_content "
+[ad_scope_admin_header "Admin" $db]
+[ad_scope_admin_page_title "FAQs Admin" $db]"
+
+# release the database handle
+
+ns_db releasehandle $db
+
+# -- serve the page ----------------------
+ns_return 200 text/html "
+
+$header_content
+
+$context_bar
+
+<hr>
+<blockquote>
+$avail_faq_list
+<p>
+
+<li><a href=faq-add>Add</a> a new FAQ.
+<P>
+</blockquote>
+[ad_scope_admin_footer]"
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/faq/admin/more.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/faq/admin/more.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/faq/admin/more.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,79 @@
+# /faq/admin/more.tcl
+#
+# Displays a given Q and A
+# Gives the option to edit or delete
+#
+# by dh@arsdigita.com, created on 12/19/99
+#
+# more.tcl,v 3.0.4.2 2000/03/16 04:21:57 dh Exp
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+ad_page_variables {faq_id entry_id}
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (group_id)
+
+validate_integer faq_id $faq_id
+validate_integer entry_id $entry_id
+
+ad_scope_error_check
+set db [ns_db gethandle]
+faq_admin_authorize $db $faq_id
+
+set selection [ns_db 1row $db "
+select question, answer, faq_id 
+from faq_q_and_a
+where entry_id = $entry_id"]
+set_variables_after_query
+
+set faq_name [database_to_tcl_string $db "select faq_name 
+from faqs 
+where faq_id = $faq_id"]
+
+if {[info exists scope]&& $scope=="group"} {
+    set context_bar "[ad_scope_admin_context_bar  \
+	    [list index?[export_url_scope_vars] "FAQ Admin"]\
+	    [list "one?[export_url_scope_vars faq_id]" $faq_name]\
+	    "One Question"]"
+} else {
+    set context_bar "[ad_scope_context_bar_ws \
+	    [list "../index?[export_url_scope_vars]" "FAQs"]\
+	    [list "index?[export_url_scope_vars]" "Admin"]\
+	    [list "one?[export_url_scope_vars faq_id]" $faq_name]\
+	    "One Question"\
+	    ]"
+}
+
+set header_content "
+[ad_scope_admin_header "One Question" $db]
+[ad_scope_admin_page_title "One Question" $db] "
+
+ns_db releasehandle $db
+
+# --serve the page ---------------
+
+ns_return 200 text/html "
+
+$header_content
+
+$context_bar
+
+<hr>
+
+<b>Q:</b> $question
+<P>
+<b>A:</b> $answer
+<p>
+<a href=edit?[export_url_scope_vars entry_id faq_id]>Edit</a> | <a href=delete?[export_url_scope_vars entry_id faq_id]>Delete</a>
+<p>
+[ad_scope_admin_footer]
+"
+
+
+
+
+
Index: web/openacs/www/faq/admin/one.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/faq/admin/one.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/faq/admin/one.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,126 @@
+# /faq/admin/one.tcl
+# 
+# Purpose:  displays Questions from a given  FAQ  (faq_id)
+#           allows for reordering and editing and deletion
+#
+# by dh@arsdigita.com, created on 12/19/99
+#
+# one.tcl,v 3.0.4.1 2000/03/16 02:33:20 dh Exp
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_form_variables
+# maybe scope, maybe scope related variables (group_id)
+# faq_id
+
+validate_integer faq_id $faq_id
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+
+faq_admin_authorize $db $faq_id
+
+set faq_name [database_to_tcl_string $db "
+select faq_name
+from faqs
+where faq_id=$faq_id"]
+
+set total_question_count [database_to_tcl_string $db "
+select count(*)
+from faq_q_and_a
+where faq_id = $faq_id"]
+
+# get the FAQ from the database
+set selection [ns_db select $db "select question, 
+       answer,
+       entry_id,
+       sort_key
+from  faq_q_and_a
+where faq_id = $faq_id
+order by sort_key"]
+
+set q_and_a_list ""
+set question_number 0
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr question_number
+    append q_and_a_list "
+<tr>
+ <td>$question_number. <a href=more?[export_url_scope_vars faq_id entry_id]>[expr {[string length $question]>40?"[string range $question 0 40] ... ":"$question"}]</a></td>
+ <td> <font face=\"MS Sans Serif, arial,helvetica\"  size=\"1\"><a href=add?[export_url_scope_vars entry_id faq_id]>insert after</a> [expr {$question_number < $total_question_count ?"| <a href=swap?[export_url_scope_vars entry_id faq_id]>swap with next</a>":""}]</td>
+</tr>"
+      
+}
+
+
+if {[info exists scope]&& $scope=="group"} {
+    set context_bar "[ad_scope_admin_context_bar  \
+	     [list index?[export_url_scope_vars] "FAQ Admin"]\
+	     "$faq_name FAQ"\
+	    ]"
+} else {
+    set context_bar "[ad_scope_context_bar_ws \
+	    [list "../index?[export_url_scope_vars]" "FAQs"]\
+	    [list index?[export_url_scope_vars] "Admin"]\
+	    "$faq_name FAQ"\
+	    ]"
+}
+
+
+append page_content "
+[ad_scope_admin_header "FAQ Admin" $db]
+[ad_scope_admin_page_title "New FAQ Administration" $db]
+
+$context_bar
+<hr>
+"
+
+# release database handle
+ns_db releasehandle $db
+
+
+switch $scope {
+    public {
+	append html "
+	<a href=\"/faq/one?[export_url_scope_vars faq_id]\">$faq_name FAQ user page</a>
+	"
+    }
+    group {
+	append html "
+	<a href=\"[ns_set get $group_vars_set group_public_url]/faq/one?[export_url_scope_vars faq_id]\">$faq_name FAQ user page</a>
+	"
+    }
+}
+
+append html "
+<table>
+$q_and_a_list
+</table>
+
+<p>
+
+<li><a href=add?[export_url_scope_vars faq_id]>Add</a> a new question and answer.<br>
+<li><a href=faq-edit?[export_url_scope_vars faq_id]>Edit</a> the FAQ
+<li><a href=faq-delete?[export_url_scope_vars faq_id]>Delete</a> the FAQ
+"
+
+append page_content "
+<blockquote>
+$html
+</blockquote>
+[ad_scope_admin_footer]
+"
+    
+ns_return 200 text/html $page_content
+
+
+
+
+
+
+
+
Index: web/openacs/www/faq/admin/swap.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/faq/admin/swap.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/faq/admin/swap.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,66 @@
+# /faq/admin/swap.tcl
+# 
+# Swaps a faq entry with the following entry
+#
+# by dh@arsdigita.com, created on 12/19/99
+#
+# swap.tcl,v 3.0.4.1 2000/03/16 02:16:53 dh Exp
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+ad_page_variables {entry_id faq_id}
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (group_id)
+
+validate_integer entry_id $entry_id
+validate_integer faq_id $faq_id
+
+ad_scope_error_check
+set db [ns_db gethandle]
+faq_admin_authorize $db $faq_id
+
+# get the sort_key for this entry_id, faq_id 
+set selection [ns_db 1row $db "
+select sort_key as current_sort_key, faq_id
+from   faq_q_and_a 
+where  entry_id = $entry_id"]
+set_variables_after_query
+
+
+ns_db dml $db "begin transaction"
+
+# I want the next sort_key 
+set sql "
+select entry_id as next_entry, sort_key as next_sort_key
+from faq_q_and_a
+where sort_key = (select min(sort_key)
+                  from faq_q_and_a 
+                  where sort_key > $current_sort_key
+                  and faq_id = $faq_id)
+and faq_id = $faq_id
+for update "
+
+set selection [ns_db 1row $db $sql]
+set_variables_after_query
+
+ns_db dml $db "
+update faq_q_and_a
+set sort_key = $next_sort_key
+where entry_id = $entry_id"
+
+ns_db dml $db "
+update faq_q_and_a
+set sort_key = $current_sort_key
+where entry_id = $next_entry"
+
+ns_db dml $db "end transaction"
+
+ns_db releasehandle $db
+
+ns_returnredirect "one?[export_url_scope_vars faq_id]" 
+
+
Index: web/openacs/www/file-storage/all-public.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/all-public.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/all-public.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,111 @@
+# /file-storage/all-public.tcl
+#
+# by philg@mit.edu July 24, 1999
+# 
+# provide an interface to the public files of all the users
+#
+# modified by randyg@arsdigita.com, January 2000 to make use of the 
+# general permissions module
+#
+# all-public.tcl,v 3.3.2.1 2000/03/27 17:30:34 carsten Exp
+
+set local_user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+set page_content "[ad_header "Public files summary"]
+
+<h2>Public files summary</h2>
+
+[ad_context_bar_ws [list "" [ad_parameter SystemName fs]] "Publically accessible files"]
+
+<hr>
+
+Users with files/folders in their personal directories:
+
+"
+
+# get the names of users who have stuff in their personal space
+
+set selection [ns_db select $db "select u.user_id,
+            u.first_names,
+            u.last_name,
+            count ( distinct fsf.file_id ) as n_files,
+            round ( float8(sum ( fsvl.n_bytes )) / 1024.0 ) as n_kbytes
+       from users u,
+            fs_files fsf,
+            fs_versions_latest fsvl
+      where fsf.file_id = fsvl.file_id
+        and fsf.owner_id = u.user_id
+        and ( fsf.public_p = 'f' or fsf.public_p is null )
+        and fsf.group_id is null
+        and ( fsf.folder_p = 'f' or fsf.folder_p is null )
+        and fsf.deleted_p = 'f'
+        and user_has_row_permission_p ( $local_user_id, 'read', fsvl.version_id, 'FS_VERSIONS' ) = 't'
+   group by u.user_id,
+            u.first_names,
+            u.last_name
+   order by upper ( last_name ), upper ( first_names )"]
+
+set persons_html "" 
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append persons_html "<li><a href=\"public-one-person?owner_id=$user_id\">$first_names $last_name</a>: $n_files files; $n_kbytes Kbytes\n"
+}
+
+append page_content "<ul> $persons_html </ul>"
+
+set selection [ns_db select $db "select ug.group_id,
+            ug.group_name,
+            round ( float8(sum ( fsvl.n_bytes )) / 1024.0 ) as n_kbytes
+       from user_groups ug,
+            fs_files fsf,
+            fs_versions_latest fsvl
+      where fsf.file_id = fsvl.file_id
+        and ( fsf.public_p = 'f' or fsf.public_p is null )
+        and fsf.deleted_p = 'f'
+        and ( fsf.folder_p = 'f' or fsf.folder_p is null )
+        and fsf.group_id = ug.group_id
+        and user_has_row_permission_p ( $local_user_id, 'read', fsvl.version_id, 'FS_VERSIONS' ) = 't'
+   group by ug.group_id,
+            ug.group_name"]
+
+set group_html ""
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append group_html "<li><a href=\"public-one-group?[export_url_vars group_id]\">$group_name</a>:  $n_kbytes Kbytes\n"
+}
+
+if { ![empty_string_p $group_html] } {
+    append page_content  "<nobr>Groups with files/folders stored: <ul>$group_html</ul>\n"
+} 
+
+if [ad_parameter PublicDocumentTreeP fs] {
+
+    append page_content "<p>
+Documents that are shared system wide:
+<ul>
+<li><a href=\"\">Shared [ad_system_name] document tree</a>
+</ul>
+<p>"  
+  
+}
+
+
+append page_content "
+[ad_footer [fs_system_owner]]
+"
+
+# release the database handle
+
+ns_db releasehandle $db 
+
+# serve the page
+
+ns_return 200 text/html $page_content
+
+
Index: web/openacs/www/file-storage/create-folder-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/create-folder-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/create-folder-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,128 @@
+# /file-storage/create-folder-2.tcl
+#
+# created by aure@arsdigita.com, July, 1999
+#
+# modified by randyg@arsdigita.com, January, 2000 to use the
+# general permissions module
+#
+# this file creates a new folder
+#
+# create-folder-2.tcl,v 3.2.2.1 2000/03/16 14:36:21 carsten Exp
+
+ad_page_variables {
+    {file_id}
+    {file_title}
+    {group_id ""}
+    {parent_id}
+    {public_p "f"}
+    {return_url}
+    {version_id}
+} 
+
+set user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+
+# check the user input first
+
+set exception_text ""
+set exception_count 0
+
+if [empty_string_p $file_title] {
+    append exception_text "<li>You must give a title to the folder\n"
+    incr exception_count
+}
+
+if {$public_p == "t" && ![ad_parameter PublicDocumentTreeP fs]} {
+    append exception_text "
+        <li>[ad_system_name] does not support a public directory tree."
+    incr exception_count
+}
+
+
+if ![empty_string_p $group_id] {
+
+    set check [database_to_tcl_string $db "
+        select ad_group_member_p ($user_id, $group_id) from dual"]
+
+    if { [string compare $check "f"] == 0 } {
+	append exception_text "<li>You are not a member of this group $group_id\n"
+	incr exception_count
+    }
+
+} else {
+    set group_id ""
+}
+
+if { $exception_count> 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+set file_insert "
+insert into fs_files (
+    file_id, 
+    file_title, 
+    owner_id, 
+    parent_id, 
+    folder_p,  
+    sort_key, 
+    depth, 
+    public_p, 
+    group_id)
+values (
+    $file_id, 
+    '[DoubleApos $file_title]', 
+    $user_id, 
+    [ns_dbquotevalue $parent_id], 
+    't', 
+    0, 
+    0, 
+    '$public_p', 
+    '[DoubleApos $group_id]')"
+
+# now we want to insert a "dummy" version so that we can also create the permission
+# records
+
+set version_insert "
+    insert into fs_versions
+    (version_id, file_id, creation_date, author_id)
+    values
+    ($version_id, $file_id, sysdate(), $user_id)"
+
+ns_db dml $db "begin transaction"
+
+if { [ catch { ns_db dml $db $file_insert 
+               ns_db dml $db $version_insert
+               ns_db select $db "select grant_permission_to_all_users('read', $version_id, 'FS_VERSIONS')"
+               ns_db select $db "select grant_permission_to_all_users('comment', $version_id, 'FS_VERSIONS')"
+             } errmsg] } {
+    # insert failed; let's see if it was because of duplicate submission
+    if { [database_to_tcl_string $db "select count(*) from fs_files where file_id = $file_id"] == 0 } {
+	ns_log Error "/file-storage/create-folder-2.tcl choked:  $errmsg"
+	ad_return_error "Insert Failed" "The Database did not like what you 
+	                 typed.  This is probably a bug in our code.  Here's what 
+                         the database said:
+	                 <blockquote>
+                         <pre>$errmsg</pre>
+	                 </blockquote>"
+        return
+    }
+
+    ns_db dml $db "abort transaction"
+
+    # we don't bother to handle the cases where there is a dupe submission
+    # because the user should be thanked or redirected anyway
+    ns_returnredirect $return_url
+
+}
+
+
+fs_order_files $db
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect $return_url
Index: web/openacs/www/file-storage/create-folder.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/create-folder.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/create-folder.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,137 @@
+# /file-storage/create-folder.tcl
+#
+# created by aure@arsdigita.com, July, 1999
+#
+# this file allows a user to select a title and location for
+# a new folder
+#
+# modified by randyg@arsdigita.com, January, 2000 to use the general
+# permissions module
+#
+# create-folder.tcl,v 3.2.2.1 2000/03/31 15:18:08 carsten Exp
+
+ad_page_variables {
+    {return_url}
+    {group_id ""}
+    {public_p ""}
+    {current_folder ""}
+}
+
+set user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+set title "Create New Folder"
+
+# Determine if we are uploading to a Group or to our personal area
+# this is based if no group_id was sent - then we are uploading
+# to our personal area - otherwise the default group defined by group_id
+
+set exception_text ""
+set exception_count 0
+
+
+if { $public_p == "t" && ![ad_parameter PublicDocumentTreeP fs] } {
+    append exception_text "
+        <li>[ad_system_name] does not support a public directory tree."
+    incr exception_count
+}
+
+set db [ns_db gethandle]
+
+if { ![empty_string_p $group_id] } {
+
+    set group_name [database_to_tcl_string $db "
+	select group_name 
+	from   user_groups 
+	where  group_id = $group_id"]
+
+    # we are in the group tree
+
+    if { ![ad_user_group_member $db $group_id $user_id] } {
+
+	append exception_text "
+	    <li>You are not a member of group <cite>$group_name</cite>\n"
+
+	incr exception_count
+
+    } else {
+
+	set navbar [ad_context_bar_ws \
+		[list "" [ad_parameter SystemName fs]] \
+		[list $return_url "$group_name document tree"] \
+		$title]
+
+    }
+
+    set public_p "f"
+
+} elseif { $public_p == "t" } { 
+
+    # we are in the public document tree
+
+    set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]] $title]
+    set group_id ""
+
+} else {
+
+    # we are in the personal document tree
+
+    set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]]\
+	                          [list "personal" "Personal document tree"]\
+				  $title]
+    set group_id ""
+    set public_p "f"
+
+}
+
+if { $exception_count> 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+set file_id [database_to_tcl_string $db "select fs_file_id_seq.nextval from dual"]
+set version_id [database_to_tcl_string $db "select fs_version_id_seq.nextval from dual"]
+
+set page_content "[ad_header $title]
+
+<h2>$title</h2>
+
+$navbar
+
+
+<hr>
+<form  method=POST action=create-folder-2>
+[export_form_vars file_id version_id return_url group_id public_p]
+
+
+<table>
+<tr>
+<td align=right>Folder Name: </td>
+<td><input size=30 name=file_title></td>
+</tr>
+
+<tr>
+<td align=right>Location:</td>
+<td>[fs_folder_def_selection $db $user_id $group_id $public_p "" $current_folder]</td>
+</tr>
+
+<tr>
+<td>&nbsp;</td>
+<td><input type=submit value=\"Create\">
+</td>
+</tr>
+
+</table>
+
+</form>
+
+[ad_footer [fs_system_owner]]"
+
+# release the database handle
+
+ns_db releasehandle $db
+
+# serve the page
+
+ns_return 200 text/html $page_content
Index: web/openacs/www/file-storage/delete-file-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/delete-file-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/delete-file-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,108 @@
+# delete-file-2.tcl,v 1.5.2.1 2000/02/03 09:50:34 ron Exp
+# delete-2.tcl
+#
+# by aure@arsdigita.com, July 1999
+#
+# marks a file deleted (but does not actually remove anything 
+# from the database); if a folder, marks the entire subtree deleted
+#
+# modified by randyg@arsdigita, January, 2000 to use the general permissions module
+#
+
+set_the_usual_form_variables
+
+# file_id,  return_url, maybe group_id
+
+set user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle ]
+# Determine if we are working in a Group, or our personal space
+# this is based if no group_id was sent - then we are in
+# our personal area - otherwise the group defined by group_id
+set exception_text ""
+set exception_count 0
+
+set exception_text ""
+set exception_count 0
+
+if {(![info exists file_id])||([empty_string_p $file_id])} {
+    incr exception_count
+    append exception_text "<li>No file was specified"
+}
+
+set version_id [database_to_tcl_string $db "select version_id from fs_versions_latest where file_id = $file_id"]
+
+if {![info exists group_id]} {
+    set group_id ""
+}
+
+if {! [fs_check_edit_p $db $user_id $version_id $group_id]} {
+    incr exception_count
+    append exception_text "<li>You do not own this file"
+}
+
+## return errors
+if { $exception_count> 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+
+if { ![info exists group_id] } {
+    set group_id ""
+}
+
+# is this a folder ? Get all its children
+set folder_p [database_to_tcl_string $db "select folder_p from fs_files where file_id=$file_id"]
+
+ns_db dml $db "begin transaction"
+
+if {$folder_p=="t"} {
+
+#     set sql_query "
+#       select file_id
+#       from   fs_files
+#       connect by prior file_id = parent_id
+#       start with file_id = $file_id "
+
+    set sql_query "
+      select file_id
+      from   fs_files
+      where fs_node_is_child($file_id,file_id) = 't'"
+
+    # note that the "children" list includes the top-level folder
+    set children_list [database_to_tcl_list $db $sql_query]
+    set children_list [join $children_list ", "]
+    
+    set sql_faux_delete "
+      update fs_files
+      set    deleted_p = 't'
+      where  file_id in ( $children_list ) "
+    
+    
+} else {
+    set sql_faux_delete "
+       update fs_files
+       set    deleted_p = 't'
+       where   file_id = $file_id"
+}
+
+
+ns_db dml $db $sql_faux_delete
+
+fs_order_files $db $user_id $group_id
+
+ns_db dml $db "end transaction"
+
+ns_db releasehandle $db 
+
+if {[info exists group_id] && ![empty_string_p $group_id]} {
+    ns_returnredirect group.tcl?group_id=$group_id
+} else {
+    ns_returnredirect index.tcl
+}
+
+
+
Index: web/openacs/www/file-storage/delete-file.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/delete-file.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/delete-file.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,123 @@
+# delete-file.tcl,v 1.6.2.1 2000/02/03 09:50:35 ron Exp
+# /file-storage/delete-file.tcl
+#
+# created by aure@arsdigita.com, July 1999
+#
+# modified by randyg@arsidgita.com, January, 2000 to use the general permissions
+# system
+#
+# this page makes sure that a user wants to delete a file or a folder.  
+# If a folder is deleted, all of the children are also deleted.
+#
+
+
+set_the_usual_form_variables 
+
+# file_id, object_type, return_url, maybe group_id
+ 
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set title "Delete $object_type"
+set db [ns_db gethandle ]
+
+set exception_text ""
+set exception_count 0
+
+if {(![info exists file_id])||([empty_string_p $file_id])} {
+    incr exception_count
+    append exception_text "<li>No file was specified"
+}
+
+set version_id [database_to_tcl_string $db "select version_id from fs_versions_latest where file_id = $file_id"]
+
+if {![info exists group_id]} {
+    set group_id ""
+}
+
+if {! [fs_check_edit_p $db $user_id $version_id $group_id]} {
+    incr exception_count
+    append exception_text "<li>You do not own this file $user_id $version_id $group_id [ad_g_write_p $db [ad_g_permissions_id $db $version_id FS_VERSIONS] $user_id]"
+}
+
+if {(![info exists object_type])||([empty_string_p $object_type])} {
+    incr exception_count 
+    incr exception_text "<li>This page may only be accessed from the edit page"
+}
+
+## return errors
+if { $exception_count> 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+set file_title [database_to_tcl_string $db "select file_title from fs_files where file_id=$file_id"]
+
+
+if { [info exists group_id] && ![empty_string_p $group_id]} {
+    set navbar [ad_context_bar_ws [list "index.tcl" [ad_parameter SystemName fs]]  $title]
+} else {
+    set navbar [ad_context_bar_ws [list "index.tcl" [ad_parameter SystemName fs]] $title]
+    set return_url index.tcl
+}
+
+set html "[ad_header $title ]
+
+<h2> $title </h2>
+
+$navbar
+
+<hr>
+
+<blockquote>
+"
+
+set number_of_children 0
+
+# if this is a folder - get the number of childern
+if {$object_type=="Folder"} {
+#     set sql_child_count "Select count(*)-1
+#                          from   fs_files
+#                          connect by prior file_id = parent_id
+#                          start with file_id=$file_id "
+    set sql_child_count "
+      select count(*) - 1
+      from   fs_files
+      where fs_node_is_child($file_id,file_id) = 't'"
+    set number_of_children [database_to_tcl_string $db $sql_child_count]
+    append html "This folder has $number_of_children sub-folders/files. <p>"
+}
+
+
+if {$number_of_children > 0} {
+    append html "
+    Are you sure you want to delete $file_title and all of it sub-folders/files?
+    "
+} else {
+    append html "
+     Are you sure you want to delete $file_title?
+    "
+}
+
+append html "
+     <form action=$return_url method=post>
+      <input type=submit value=\"No, Don't Delete\" >
+    </form>
+    <form action=delete-file-2.tcl method=post >
+     <input type=submit value=\"Yes, Delete!\" >
+     [export_form_vars group_id file_id]
+    </form>
+
+</blockquote>
+[ad_footer [fs_system_owner]]
+"
+
+ns_db releasehandle $db 
+
+ns_return 200 text/html $html
+
+
+
+
+
+
Index: web/openacs/www/file-storage/download-file.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/download-file.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/download-file.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,63 @@
+# download-file.tcl,v 1.5.2.1 2000/02/03 09:50:37 ron Exp
+# download-file.tcl
+#
+# by aure@arsdigita.com July 1999
+#
+# see if this person is authorized to read the file in question
+# guess the MIME type from the original client filename
+# have the Oracle driver grab the BLOB and write it to the connection
+#
+# modified by randyg@arsdigita.com, January 2000 to use the general
+# permissions module
+#
+
+set_the_usual_form_variables
+
+# version_id
+
+set user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+set exception_text ""
+set exception_count 0
+
+if {(![info exists version_id])||([empty_string_p $version_id])} {
+    incr exception_count
+    append exception_text "<li>No file was specified"
+}
+
+set group_id [ad_get_group_id]
+if {$group_id == 0} {
+    set group_id ""
+}
+
+if { ![fs_check_read_p $db $user_id $version_id $group_id]} {
+    incr exception_count
+    append exception_text "<li>You can't read this file"
+}
+
+## return errors
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+ReturnHeaders $file_type
+
+# ns_ora write_blob $db "select version_content 
+#                        from   fs_versions
+#                        where  version_id=$version_id" 
+
+
+
+with_transaction $db {
+
+    set blob_id [database_to_tcl_string $db "select lob from fs_versions where version_id=$version_id"]
+    ns_pg blob_write $db $blob_id
+
+}
+
+ns_db releasehandle $db
Index: web/openacs/www/file-storage/download.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/download.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/download.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,62 @@
+# /file-storage/download.tcl
+#
+# by aure@arsdigita.com July 1999
+#
+# see if this person is authorized to read the file in question
+# guess the MIME type from the original client filename
+# have the Oracle driver grab the BLOB and write it to the connection
+#
+# modified by randyg@arsdigita.com, January 2000 to use the general
+# permissions module
+#
+# download.tcl,v 3.1 2000/03/11 06:48:17 aure Exp
+
+ad_page_variables {
+    {version_id ""}
+}
+
+set user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+set exception_text ""
+set exception_count 0
+
+if [empty_string_p $version_id] {
+    incr exception_count
+    append exception_text "<li>No file was specified"
+}
+
+set group_id [ad_get_group_id]
+if {$group_id == 0} {
+    set group_id ""
+}
+
+if ![fs_check_read_p $db $user_id $version_id $group_id] {
+    incr exception_count
+    append exception_text "<li>You can't read this file"
+}
+
+## return errors
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+ReturnHeaders $file_type
+
+# ns_ora write_blob $db "
+#     select version_content 
+#     from   fs_versions
+#     where  version_id=$version_id"
+
+with_transaction $db {
+
+    set blob_id [database_to_tcl_string $db "select lob from fs_versions where version_id=$version_id"]
+    ns_pg blob_write $db $blob_id
+
+}
+
+ns_db releasehandle $db
Index: web/openacs/www/file-storage/edit-file-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/edit-file-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/edit-file-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,96 @@
+# edit-file-2.tcl,v 1.6.2.1 2000/02/03 09:50:38 ron Exp
+# edit-file-2.tcl
+#
+# by dh@arsdigita.com July 1999
+# 
+# updates information for a file and then recalculates order
+#
+#
+# modified by randyg@arsdigita.com January 2000 to use the general permissions system
+#
+
+set_the_usual_form_variables
+
+# file_id, return_url, maybe group_id (lots of things)
+# parent_id, file_type
+
+set db [ns_db gethandle]
+
+set user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+# check the user input first
+
+set exception_text ""
+set exception_count 0
+
+if {(![info exists file_id])||([empty_string_p $file_id])} {
+    incr exception_count
+    append exception_text "<li>No file was specified"
+} 
+
+if {![info exists group_id]} {
+    set group_id ""
+}
+
+if {![info exists version_id] || [empty_string_p $version_id]} {
+    incr exception_count
+    append exception_text "<li>You must provide a version for this file you wish to update."
+} elseif {![fs_check_edit_p $db $user_id $version_id $group_id]} {
+    incr exception_count
+    append exception_text "<li>You do not own this file"
+}
+
+if {![info exists file_title] || [empty_string_p $file_title] } {
+    append exception_text "<li>You must give a title to the file\n"
+    incr exception_count
+}
+
+if { [info exists object_type] && $object_type == "file" && (![info exists file_type] || [empty_string_p $file_type]) } {
+    append exception_text "<li>You cannot leave the type unspecified.\n"
+    incr exception_count
+}
+
+if {![info exists return_url]} {
+    append exception_text "<li>The return url was missing"
+    incr exception_count
+}
+
+if { ![info exists group_id]} {
+    set group_id ""
+}
+
+
+if { $exception_count> 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+
+set public_p [database_to_tcl_string $db "select public_read_p from general_permissions where on_what_id = $version_id and on_which_table = 'FS_VERSIONS'"]
+
+
+ns_db dml $db "begin transaction"
+
+ns_db dml $db "
+     update  fs_files
+     set     file_title = '$QQfile_title',
+             parent_id=[ns_dbquotevalue $parent_id]
+      where  file_id=$file_id 
+      and    owner_id=$user_id
+"
+
+if { [info exists object_type] && $object_type == "file" && [info exists file_type] && [empty_string_p $file_type] } {
+    ns_db dml $db "update fs_versions
+    set file_type = '$QQfile_type'
+    where file_id = $file_id
+    and superseded_by_id is null"
+}
+
+fs_order_files $db $user_id $group_id $public_p
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect $return_url
+
Index: web/openacs/www/file-storage/edit-file.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/edit-file.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/edit-file.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,131 @@
+# edit-file.tcl,v 1.6.2.1 2000/02/03 09:50:39 ron Exp
+# edit-file-2.tcl
+#
+# by dh@arsdigita.com July 1999
+# 
+# allows the user to edit information about a file
+#
+#
+# modified by randyg@arsdigita.com January 2000 to use the general permissions system
+#
+
+set_the_usual_form_variables
+
+# return url and maybe group_id
+# file_id
+
+set db [ns_db gethandle]
+
+set user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+set title "Edit Properties"
+
+set exception_text ""
+set exception_count 0
+
+if { ![info exists file_id] || [empty_string_p $file_id] } {
+    incr exception_count
+    append exception_text "<li>No file was specified"
+}
+
+set version_id [database_to_tcl_string_or_null $db "select version_id from fs_versions_latest where file_id = $file_id"]
+
+if {![info exists group_id]} {
+    set group_id ""
+}
+
+if {[empty_string_p $version_id]} {
+    incr exception_count
+    append exception_text "<li>The file you have requested does not exist."
+} elseif { ![fs_check_edit_p $db $user_id $version_id $group_id] } {
+    incr exception_count
+    append exception_text "<li>You do not own this file"
+}
+
+
+
+## return errors
+if { $exception_count> 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+set selection [ns_db 1row $db "select file_title, (case when f.folder_p = 't' then 'Folder' else 'File' end) as object_type, file_type, gp.public_read_p, public_p
+from fs_files f, fs_versions_latest v, general_permissions gp
+where f.file_id = $file_id
+  and gp.on_what_id = v.version_id
+  and gp.on_which_table = 'FS_VERSIONS'
+  and f.file_id = v.file_id"]
+
+set_variables_after_query
+
+if { [info exists group_id] && ![empty_string_p $group_id]} {
+    set group_name [database_to_tcl_string $db "
+    select group_name 
+    from   user_groups 
+    where  group_id=$group_id"]
+    
+    set navbar [ad_context_bar_ws [list "index.tcl" [ad_parameter SystemName fs]] [list "group.tcl?group_id=$group_id" $group_name] [list $return_url "One File"] "$title"]
+} else {
+    set navbar [ad_context_bar_ws [list "index.tcl" [ad_parameter SystemName fs]] [list $return_url "One File"] $title]
+    set group_id ""
+}
+
+set html "[ad_header $title]
+
+<h2>$title</h2>
+
+$navbar
+
+<hr>
+<blockquote>
+<form method=POST action=edit-file-2.tcl>
+
+[export_form_vars file_id version_id return_url group_id ]
+
+<table>
+<tr>
+<td align=right>$object_type Title: </td>
+<td><input size=30 name=file_title value=\"$file_title\"></td>
+</tr>
+"
+
+if { $object_type == "File" } {
+    append html "<tr>
+<td align=right>File Type: </td>
+<td><input size=30 name=file_type value=\"$file_type\"></td>
+"
+}
+
+append html "<tr>
+<td align=right>Location:</td>
+<td>[fs_folder_selection $db $user_id $group_id $public_p $file_id]</td>
+</tr>
+
+<tr>
+<td></td>
+<td><input type=submit value=\"Update\">
+</td>
+</tr>
+</table>
+
+</form>
+
+<h3>Severe actions</h3>
+
+<ul>
+<li><a href=delete-file.tcl?[export_url_vars group_id file_id return_url object_type]>Delete this $object_type</a>
+
+</ul>
+</blockquote>
+[ad_footer [fs_system_owner]]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $html
+
+
+
Index: web/openacs/www/file-storage/file-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/file-delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/file-delete-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,102 @@
+# /file-storage/file-delete-2.tcl
+#
+# by aure@arsdigita.com, July 1999
+#
+# marks a file deleted (but does not actually remove anything 
+# from the database); if a folder, marks the entire subtree deleted
+#
+# modified by randyg@arsdigita, January, 2000 to use the general permissions module
+#
+# file-delete-2.tcl,v 3.2.2.2 2000/03/24 02:35:18 aure Exp
+
+ad_page_variables {
+    {file_id}
+    {group_id ""}
+    {source ""}
+}
+
+set user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle ]
+# Determine if we are working in a Group, or our personal space
+# this is based if no group_id was sent - then we are in
+# our personal area - otherwise the group defined by group_id
+
+set exception_text ""
+set exception_count 0
+
+set version_id [database_to_tcl_string $db "
+    select version_id from fs_versions_latest where file_id = $file_id"]
+
+if {! [fs_check_edit_p $db $user_id $version_id $group_id]} {
+    incr exception_count
+    append exception_text "<li>You do not own this file"
+}
+
+## return errors
+if { $exception_count> 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+
+# is this a folder ? Get all its children
+set folder_p [database_to_tcl_string $db "
+    select folder_p from fs_files where file_id=$file_id"]
+
+ns_db dml $db "begin transaction"
+
+if {$folder_p=="t"} {
+
+#     set children_query "
+#         select file_id
+#         from   fs_files
+#         connect by prior file_id = parent_id
+#         start with file_id = $file_id"
+
+    set children_query "
+      select file_id
+      from   fs_files
+      where fs_node_is_child($file_id,file_id) = 't'"
+
+    # note that the "children" list includes the top-level folder
+    set children_list [database_to_tcl_list $db $children_query]
+    
+    set sql_faux_delete "
+        update fs_files
+        set    deleted_p = 't'
+        where  file_id in ( [join $children_list ", "] ) "
+    
+    
+} else {
+    set sql_faux_delete "
+        update fs_files
+        set    deleted_p = 't'
+        where  file_id = $file_id"
+}
+
+
+ns_db dml $db $sql_faux_delete
+
+fs_order_files $db
+
+ns_db dml $db "end transaction"
+
+ns_db releasehandle $db 
+
+if {[info exists group_id] && ![empty_string_p $group_id]} {
+    ns_returnredirect group?group_id=$group_id
+} else {
+    ns_returnredirect /file-storage/$source
+}
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/file-storage/file-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/file-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/file-delete.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,119 @@
+# /file-storage/file-delete.tcl
+#
+# created by aure@arsdigita.com, July 1999
+#
+# modified by randyg@arsidgita.com, January, 2000 to use the general permissions
+# system
+#
+# this page makes sure that a user wants to delete a file or a folder.  
+# If a folder is deleted, all of the children are also deleted.
+#
+# file-delete.tcl,v 3.1.2.1 2000/03/24 02:35:18 aure Exp
+
+ad_page_variables {
+    {file_id}
+    {object_type}
+    {return_url}
+    {group_id ""}
+    {source ""}
+}
+ 
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set title "Delete $object_type"
+set db [ns_db gethandle ]
+
+set exception_text ""
+set exception_count 0
+
+if [empty_string_p $file_id] {
+    incr exception_count
+    append exception_text "<li>No file was specified"
+}
+
+set version_id [database_to_tcl_string $db "
+    select version_id from fs_versions_latest where file_id = $file_id"]
+
+if {! [fs_check_edit_p $db $user_id $version_id $group_id]} {
+    incr exception_count
+    append exception_text "<li>You do not own this file $user_id $version_id $group_id [ad_g_write_p $db [ad_g_permissions_id $db $version_id FS_VERSIONS] $user_id]"
+}
+
+if [empty_string_p $object_type] {
+    incr exception_count 
+    incr exception_text "<li>This page may only be accessed from the edit page"
+}
+
+## return errors
+if { $exception_count> 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+set file_title [database_to_tcl_string $db "
+    select file_title from fs_files where file_id=$file_id"]
+
+
+if { [info exists group_id] && ![empty_string_p $group_id]} {
+    set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]]  $title]
+} else {
+    set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]] $title]
+    set return_url ""
+}
+
+set page_content "[ad_header $title ]
+
+<h2> $title </h2>
+
+$navbar
+
+<hr>
+
+<blockquote>"
+
+set number_of_children 0
+
+# if this is a folder - get the number of childern
+if {$object_type=="Folder"} {
+#     set sql_child_count "
+#         select count(*)-1
+#         from   fs_files
+#         connect by prior file_id = parent_id
+#         start with file_id = $file_id"
+    set sql_child_count "
+      select count(*) - 1
+      from   fs_files
+      where fs_node_is_child($file_id,file_id) = 't'"
+    set number_of_children [database_to_tcl_string $db $sql_child_count]
+    append page_content "This folder has $number_of_children sub-folders/files. <p>"
+}
+
+if {$number_of_children > 0} {
+    append page_content "
+    Are you sure you want to delete $file_title and all of it sub-folders/files?"
+} else {
+    append page_content "
+     Are you sure you want to delete $file_title?"
+}
+
+append page_content "
+<form action=file-delete-2 method=post>
+
+[export_form_vars group_id file_id source]
+
+<input type=submit value=\"Yes, Delete!\" >
+
+</form>
+
+</blockquote>
+[ad_footer [fs_system_owner]]"
+
+# release the database handle
+
+ns_db releasehandle $db 
+
+# serve the page
+
+ns_return 200 text/html $page_content
+
Index: web/openacs/www/file-storage/file-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/file-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/file-edit-2.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,81 @@
+# /file-storage/file-edit-2.tcl
+#
+# by dh@arsdigita.com July 1999
+# 
+# updates information for a file and then recalculates order
+#
+#
+# modified by randyg@arsdigita.com January 2000 to use the general permissions system
+#
+# file-edit-2.tcl,v 3.2.2.3 2000/03/16 14:36:22 carsten Exp
+
+ad_page_variables {
+    {file_id}
+    {file_title}
+    {version_id ""}
+    {return_url}
+    {group_id ""}
+    {parent_id}
+    {object_type}
+    {file_type ""}
+}
+
+set db [ns_db gethandle]
+
+set user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+# check the user input first
+
+set exception_text ""
+set exception_count 0
+
+if [empty_string_p $version_id] {
+    incr exception_count
+    append exception_text "<li>You must provide a version for this file you wish to update."
+} elseif {![fs_check_edit_p $db $user_id $version_id $group_id]} {
+    incr exception_count
+    append exception_text "<li>You do not own this file"
+}
+
+if [empty_string_p $file_title] {
+    append exception_text "<li>You must give a title to the file\n"
+    incr exception_count
+}
+
+if { $object_type == "File" && (![info exists file_type] || [empty_string_p $file_type]) } {
+    append exception_text "<li>You cannot leave the type unspecified.\n"
+    incr exception_count
+}
+
+if { $exception_count> 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+set public_p [database_to_tcl_string $db "
+    select user_has_row_permission_p ( $user_id, 'read', $version_id, 'FS_VERSIONS' ) from dual"]
+
+ns_db dml $db "begin transaction"
+
+ns_db dml $db "
+    update fs_files
+    set    file_title = '$QQfile_title',
+           parent_id = [ns_dbquotevalue $parent_id]
+    where  file_id = $file_id"
+
+if { [info exists object_type] && $object_type == "File" && [info exists file_type] && ![empty_string_p $file_type] } {
+
+    ns_db dml $db "
+        update fs_versions
+        set    file_type = '[DoubleApos $file_type]'
+        where  file_id = $file_id
+        and    superseded_by_id is null"
+}
+
+fs_order_files $db
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect $return_url
Index: web/openacs/www/file-storage/file-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/file-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/file-edit.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,141 @@
+# /file-storage/file-edit.tcl
+#
+# by dh@arsdigita.com July 1999
+# 
+# allows the user to edit information about a file
+#
+#
+# modified by randyg@arsdigita.com January 2000 to use the general permissions system
+#
+# file-edit.tcl,v 3.2 2000/03/11 08:14:33 aure Exp
+
+ad_page_variables {
+    {return_url}
+    {file_id}
+    {group_id ""}
+}
+
+set db [ns_db gethandle]
+
+set user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+set title "Edit Properties"
+
+set exception_text ""
+set exception_count 0
+
+if [empty_string_p $file_id]  {
+    incr exception_count
+    append exception_text "<li>No file was specified"
+}
+
+set version_id [database_to_tcl_string_or_null $db "
+    select version_id from fs_versions_latest where file_id = $file_id"]
+
+if {[empty_string_p $version_id]} {
+
+    incr exception_count
+    append exception_text "<li>The file you have requested does not exist."
+
+} elseif { ![fs_check_edit_p $db $user_id $version_id $group_id] } {
+
+    incr exception_count
+    append exception_text "<li>You do not own this file"
+
+}
+
+## return errors
+if { $exception_count> 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+set selection [ns_db 1row $db "
+    select fsf.file_title,
+           (case when fsf.folder_p = 't' then 'Folder' else 'File' end) as object_type,
+           fsvl.file_type,
+           user_has_row_permission_p ( $user_id, 'read', fsvl.version_id, 'FS_VERSIONS' ) as public_read_p,
+           fsf.public_p
+    from   fs_files fsf,
+           fs_versions_latest fsvl
+    where  fsf.file_id = $file_id
+    and    fsf.file_id = fsvl.file_id"]
+
+set_variables_after_query
+
+if ![empty_string_p $group_id] {
+    set group_name [database_to_tcl_string $db "
+    select group_name 
+    from   user_groups 
+    where  group_id=$group_id"]
+    
+    set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]]\
+	                          [list "group?group_id=$group_id" $group_name]\
+				  [list $return_url "One File"]\
+				  $title]
+} else {
+    set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]]\
+	                          [list $return_url "One File"]\
+				  $title]
+}
+
+set page_content "[ad_header $title]
+
+<h2>$title</h2>
+
+$navbar
+
+<hr>
+<blockquote>
+<form method=POST action=file-edit-2>
+
+[export_form_vars file_id version_id return_url group_id object_type]
+
+<table>
+<tr>
+<td align=right>$object_type Title: </td>
+<td><input size=30 name=file_title value=\"$file_title\"></td>
+</tr>"
+
+if { $object_type == "File" } {
+    append page_content "
+    <tr>
+    <td align=right>File Type: </td>
+    <td><input size=30 name=file_type value=\"$file_type\"></td>"
+}
+
+append page_content "
+
+<tr>
+<td align=right>Location:</td>
+<td>[fs_folder_selection $db $user_id $group_id $public_p $file_id]</td>
+</tr>
+
+<tr>
+<td></td>
+<td><input type=submit value=\"Update\">
+</td>
+</tr>
+</table>
+
+</form>
+
+<h3>Severe actions</h3>
+
+<ul>
+<li><a href=file-delete?[export_url_vars group_id file_id return_url object_type]>Delete this $object_type</a>
+
+</ul>
+</blockquote>
+[ad_footer [fs_system_owner]]"
+
+# release the database handle
+
+ns_db releasehandle $db
+
+# serve the page
+
+ns_return 200 text/html $page_content
+
Index: web/openacs/www/file-storage/group.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/group.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/group.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,315 @@
+# /file-storage/group.tcl
+# 
+# by aure@arsdigita.com, June 1999
+#
+# modified by randyg@arsdigita.com, January 2000
+#
+# This file displays all group wide files that the user has permission to see
+#
+# group.tcl,v 3.2.2.3 2000/03/31 16:11:13 carsten Exp
+
+ad_page_variables {
+    {group_id ""}
+}
+
+set local_user_id [ad_get_user_id]
+
+# group_id
+
+if { $group_id == "all_public" } {
+    ns_returnredirect "all-public"
+    return
+}
+
+if { $group_id == "personal" } {
+    ns_returnredirect "personal"
+    return
+}
+
+
+if { $group_id == "public_tree" } {
+    ns_returnredirect ""
+    return
+}
+
+if { [lindex $group_id 0] == "user_id" } {
+    ns_returnredirect "private-one-person?owner_id=[lindex $group_id 1]"
+    return
+}
+
+if { [lindex $group_id 0] == "private_group" } {
+    ns_returnredirect "private-one-group?group_id=[lindex $group_id 1]"
+    return
+}
+
+if { [lindex $group_id 0] == "public_group" } {
+    ns_returnredirect "public-one-group?group_id=[lindex $group_id 1]"
+    return
+}
+
+
+set return_url "group?[ns_conn query]"
+
+set db [ns_db gethandle]
+
+set user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+if [empty_string_p $group_id] {
+    ad_return_complaint 1 "<li>Please choose a group" 
+    return
+}
+
+if { ![ad_user_group_member $db $group_id $user_id] } {
+    ad_return_error "Unauthorized" "You're not a member of this group"
+    return
+}
+
+set current_group_id $group_id
+set current_group_name [database_to_tcl_string $db "select group_name from user_groups where group_id=$group_id"]
+
+set title "$current_group_name's document tree"
+
+set page_content  "
+
+<script runat=client>
+function launch_window(file) {
+    window.open(file,'files','toolbar=no,location=no,directories=no,status=no,scrollbars=auto,resizable=yes,copyhistory=no,width=450,height=250')
+}
+</script>
+
+[ad_header $title]
+
+<h2> $title </h2>
+
+[ad_context_bar_ws [list "" [ad_parameter SystemName fs]] "One Group"]
+
+<hr>
+
+<ul>
+   <li><a href=upload-new?[export_url_vars return_url group_id]>
+       Upload a new file</a> to this group
+   <li><a href=create-folder?[export_url_vars return_url group_id]>
+       Create New Folder</a> (for storing group files)
+</ul>
+
+<blockquote>"
+
+# get the group's files from the database and parse the output 
+# to reflect the folder stucture
+
+set sorted_query "
+    select fsf.file_id,
+           fsf.file_title,
+           fsf.folder_p,
+           fsf.depth * 24 as n_pixels_in,
+           round ( float8(fsvl.n_bytes) / 1024 ) as n_kbytes,
+           to_char ( fsvl.creation_date, '[fs_date_picture]' ) as creation_date,
+           coalesce ( fsvl.file_type, upper ( fsvl.file_extension ) || ' File' ) as file_type,
+           u.user_id,
+           u.first_names || ' ' || u.last_name as owner_name,
+           fsf.sort_key
+    from   fs_files fsf,
+           fs_versions_latest fsvl,
+           users u
+    where  fsf.file_id = fsvl.file_id
+    and    fsf.owner_id = u.user_id
+    and    deleted_p = 'f'
+    and    fsf.group_id = $group_id
+    and    (user_has_row_permission_p ($user_id, 'read', fsvl.version_id, 'FS_VERSIONS') = 't' or fsf.owner_id = $user_id)
+    order by fsf.sort_key"
+            
+set file_html ""
+set file_count 0
+
+set selection [ns_db select $db $sorted_query]
+
+set font "<nobr>[ad_parameter FileInfoDisplayFontTag fs]"
+set header_color [ad_parameter HeaderColor fs]
+
+append page_content "
+<table border=1 bgcolor=white  cellpadding=0 cellspacing=0>
+<tr>
+<td><table bgcolor=white cellspacing=1 border=0 cellpadding=0>
+    <tr>
+    <td colspan=5 bgcolor=#666666>
+        $font &nbsp;<font color=white> $current_group_name's files</td>
+    </tr>
+    <tr>
+    <td bgcolor=$header_color>$font &nbsp; Name</td>
+    <td bgcolor=$header_color>$font &nbsp; Author &nbsp;</td>
+    <td bgcolor=$header_color align=right>$font &nbsp; Size &nbsp;</td>
+    <td bgcolor=$header_color>$font &nbsp; Type &nbsp;</td>
+    <td bgcolor=$header_color>$font &nbsp; Modified &nbsp;</td>
+    </tr>" 
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+     if { $n_pixels_in == 0 } {
+	set spacer_gif ""
+    } else {
+	set spacer_gif "<img src=\"/graphics/file-storage/spacer.gif\" width=$n_pixels_in height=1>"
+    }
+    if {$folder_p=="t"} {
+
+	append file_html "
+	<tr>
+	<td valign=top>&nbsp; $spacer_gif $font
+	<a href=\"one-folder?[export_url_vars file_id group_id]&source=group\">
+	<img border=0 src=/graphics/file-storage/ftv2folderopen.gif align=top></a>
+	<a href=\"one-folder?[export_url_vars file_id group_id]&source=group\">$file_title</a></td>
+	<td align=right></td>
+	<td>&nbsp;</td>
+	<td>$font &nbsp; File Folder &nbsp;</td>
+	<td>&nbsp;</td>
+	</tr>\n"
+    
+    } else {
+
+	append file_html "
+	<tr>
+	<td valign=top>&nbsp; $spacer_gif $font
+	<a href=\"one-file?[export_url_vars file_id group_id]&source=group\">
+	<img \n border=0 src=/graphics/file-storage/ftv2doc.gif align=top></a>
+	<a href=\"one-file?[export_url_vars file_id group_id]&source=group\">$file_title</a>&nbsp;</td>
+	<td>$font <a href=/shared/community-member?[export_url_vars user_id]>$owner_name</a>&nbsp;</td>
+	<td align=right>$font &nbsp; $n_kbytes KB &nbsp;</td>
+	<td>$font &nbsp; $file_type &nbsp;</td>
+	<td>$font &nbsp; $creation_date &nbsp;</td></tr>\n"
+
+    }
+    
+    incr file_count
+}
+
+if {$file_count!=0} {
+
+    append page_content $file_html
+
+} else {
+
+    append page_content "
+    <tr>
+    <td>&nbsp; No files available in this group. &nbsp;</td>
+    </tr>"
+
+}
+
+append page_content "<tr><td colspan=5 bgcolor=#bbbbbb align=right>"
+
+set group_count 0
+set group_query "
+    select group_id as member_group_id, 
+           group_name
+    from   user_groups
+    where  ad_group_member_p ( $local_user_id, group_id ) = 't'
+    and    group_id <> $current_group_id
+    order by group_name"
+
+set selection [ns_db select $db $group_query]
+
+set group_html ""
+
+while {[ns_db getrow $db $selection]} {
+
+    set_variables_after_query
+
+    append group_html "
+        <option value=$member_group_id>
+        $group_name group document tree</option>\n"
+
+    incr group_count
+
+    lappend group_id_list $member_group_id
+
+}
+
+
+# now, we want to get a list of folders containing files that the user can see
+# but are stored in a directory to which the user does not normally have access
+
+# first, get group folders
+
+set group_query "
+    select ug.group_id,
+           ug.group_name 
+    from   user_groups ug, 
+           fs_files fsf,
+           fs_versions_latest fsvl
+    where  fsf.file_id = fsvl.file_id
+    and    fsf.group_id = ug.group_id
+    and    ad_group_member_p ( $local_user_id, fsf.group_id ) = 'f'
+    group by ug.group_id, ug.group_name
+    order by group_name"
+
+set selection [ns_db select $db $group_query]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append group_html "
+        <option value=\"[list public_group $group_id]\">
+        $group_name group document tree</option>\n"
+}
+
+set user_query "
+    select distinct u.user_id as folder_user_id, 
+           u.first_names || ' ' || u.last_name as user_name
+    from   users u,
+           fs_files fsf,
+           fs_versions_latest fsvl
+    where  fsf.file_id = fsvl.file_id
+    and not fsf.owner_id = $user_id
+    and    fsf.owner_id = u.user_id
+    and    fsf.group_id is null
+    and    (fsf.public_p <> 't' or fsf.public_p is null)
+    and    user_has_row_permission_p ($user_id, 'read', fsvl.version_id, 'FS_VERSIONS') = 't'
+    order by user_name"
+
+set selection [ns_db select $db $user_query]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append group_html "
+        <option value=\"[list user_id $folder_user_id]\"> 
+        $user_name's private document tree</option>\n"
+}
+
+
+
+set public_html ""
+if [ad_parameter PublicDocumentTreeP fs] {
+    set public_html "<option value=public_tree>[ad_system_name] shared document tree"
+}
+
+append page_content  "
+<form action=group>
+<nobr>$font Go to  
+<select name=group_id>
+
+<option value=\"$current_group_id\">$current_group_name group document tree</option>
+$public_html
+$group_html
+<option value=\"all_public\">All publically accessible files</option>
+
+</select>
+
+<input type=submit value=go>
+</td></tr></table></td></tr></table>
+
+</blockquote>
+</form>
+
+This system lets you keep your files on [ad_parameter SystemName],
+access them from any computer connected to the internet, and
+collaborate with others on file creation and modification.
+
+[ad_footer [fs_system_owner]]"
+
+# release the database handle
+
+ns_db releasehandle $db 
+
+# serve the page
+
+ns_return 200 text/html $page_content 
Index: web/openacs/www/file-storage/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/index.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,343 @@
+# /file-storage/index.tcl
+#
+# by aure@arsdigita.com, July 1999
+# 
+# this will show the shared document tree
+# public_p = 't' and group_id is null
+#
+# index.tcl,v 3.5.2.5 2000/03/31 16:11:15 carsten Exp
+
+set cookies [get_cookie_set]
+set folders_open_p [ns_set get $cookies folders_open_p]
+if [empty_string_p $folders_open_p] {
+    set folders_open_p 1
+}
+
+set user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+set return_url ""
+
+if ![ad_parameter PublicDocumentTreeP fs] {
+    # we are not maintaining a public site wide tree
+    ns_returnredirect "personal"
+    return
+}
+
+if ![info exists folders_open_p] {
+    set folders_open_p 1
+}
+
+set db [ns_db gethandle]
+
+set title "Shared [ad_system_name] document tree"
+set public_p "t"
+
+set page_content  "
+[ad_header $title]
+
+<h2> $title </h2>
+
+[ad_context_bar_ws [ad_parameter SystemName fs]]
+
+<hr>
+
+<ul>
+<li><a href=upload-new?[export_url_vars return_url public_p]>
+    Add a URL / Upload a file</a>
+<li><a href=create-folder?[export_url_vars return_url public_p]>
+    Create New Folder</a> 
+
+<form action=search method=get>"
+
+
+# Display search field 
+
+if { [ad_parameter UseIntermediaP fs 0] } {
+    append page_content "<li> Search file names and contents for: "
+} else {
+    append page_content "<li> Search file names for: "
+}
+
+append page_content "<input name=search_text type=text size=20>[export_form_vars return_url] <input type=submit value=Search> </form>
+</ul>
+
+<blockquote>"
+
+
+
+# get the user's files from the database and parse the 
+# output to reflect the folder stucture
+
+if {! $folders_open_p} {
+   set depth_restriction "\n and depth < 1\n"
+} else {
+   set depth_restriction ""
+}
+
+
+# a file is considered public if the public_p flag is 't' and
+# there are not any entries for the file in the psermissions_ug_map
+
+# fetch all files readable by this user
+set sorted_query "
+    select fsf.file_id,
+           fsf.file_title,
+           fsvl.url,
+           fsf.folder_p,
+           fsf.depth * 24 as n_pixels_in,
+           round ( float8(fsvl.n_bytes) / 1024.0 ) as n_kbytes,
+           to_char ( fsvl.creation_date, '[fs_date_picture]' ) as creation_date,
+           coalesce ( fsvl.file_type, upper ( fsvl.file_extension ) || ' File' ) as file_type,
+           fsf.sort_key
+    from   fs_files fsf,
+           fs_versions_latest fsvl
+    where  fsf.public_p = 't'
+    and    fsf.file_id = fsvl.file_id
+    and    (user_has_row_permission_p ( $user_id, 'read', fsvl.version_id, 'FS_VERSIONS' ) = 't' or fsf.owner_id = $user_id )
+    and    deleted_p = 'f'$depth_restriction
+    order by fsf.sort_key"
+
+set file_html ""
+set group_id ""
+set file_count 0
+
+set selection [ns_db select $db $sorted_query]
+
+set font "<nobr>[ad_parameter FileInfoDisplayFontTag fs]"
+
+set header_color [ad_parameter HeaderColor fs]
+
+# we start with an outer table to get little white lines in 
+# between the elements 
+
+append page_content "
+<table border=1 bgcolor=white  cellpadding=0 cellspacing=0>
+ <tr>
+ <td><table bgcolor=white cellspacing=1 border=0 cellpadding=0>
+      <tr>
+      <td colspan=4 bgcolor=#666666> $font &nbsp;<font color=white> 
+                                     Shared [ad_system_name] document tree</td>
+      </tr>
+      <tr>
+      <td bgcolor=$header_color>$font &nbsp; Name</td>
+      <td bgcolor=$header_color align=right>$font &nbsp; Size &nbsp;</td>
+      <td bgcolor=$header_color>$font &nbsp; Type &nbsp;</td>
+      <td bgcolor=$header_color>$font &nbsp; Modified &nbsp;</td>
+      </tr>" 
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    if { $n_pixels_in == 0 } {
+	set spacer_gif ""
+    } else {
+	set spacer_gif "<img src=\"/graphics/file-storage/spacer.gif\" width=$n_pixels_in height=1>"
+    }
+
+    if {$folders_open_p} {
+        set folder_icon "ftv2folderopen.gif"
+    } else {
+        set folder_icon "ftv2folderclosed.gif"
+    }
+
+    if {$folder_p=="t"} {
+
+	# write a row for a file folder
+
+        append file_html "
+	<tr>
+	<td valign=top>&nbsp; $spacer_gif $font
+	 <a href=\"one-folder?[export_url_vars file_id]\">
+	 <img border=0 src=/graphics/file-storage/$folder_icon align=top></a>
+	 <a href=\"one-folder?[export_url_vars file_id]\">$file_title</a></td>
+	<td align=right></td>
+	<td>$font &nbsp; File Folder &nbsp;</td>
+	<td></td>
+	</tr>\n"
+
+    } elseif ![empty_string_p $url] {
+	
+	# write a row for a URL
+
+        append file_html "
+	<tr>
+	<td valign=top>&nbsp; $spacer_gif $font 
+	 <a href=\"one-file?[export_url_vars file_id]\">
+	 <img border=0 src=/graphics/file-storage/ftv2doc.gif align=top></a>
+	 <a href=\"one-file?[export_url_vars file_id]\">$file_title</a>&nbsp;</td>
+	<td align=right></td>
+	<td>$font &nbsp; URL &nbsp;</td>
+	<td>$font &nbsp; $creation_date &nbsp;</td>
+	</tr>\n"
+
+    } else {
+
+	# write a row for a file
+
+        append file_html "
+	<tr>
+	<td valign=top>&nbsp; $spacer_gif $font
+	 <a href=\"one-file?[export_url_vars file_id]\">
+	 <img border=0 src=/graphics/file-storage/ftv2doc.gif align=top></a>
+	 <a href=\"one-file?[export_url_vars file_id]\">$file_title</a>&nbsp;</td>
+	<td align=right>$font &nbsp; $n_kbytes KB &nbsp;</td>
+	<td>$font &nbsp; [fs_pretty_file_type $file_type] &nbsp;</td>
+	<td>$font &nbsp; $creation_date &nbsp;</td>
+	</tr>\n"
+    }
+
+    incr file_count
+}
+
+if {$file_count!=0} {
+
+    append page_content "$file_html"
+
+} else {
+
+    append page_content "
+    <tr>
+    <td>There are no [ad_system_name] files stored in the database. </td>
+    </tr>"
+
+}
+
+# Show the user a pull-down menu of all other available document trees.
+# First list groups he is a member of.
+
+append page_content "<tr><td colspan=4 bgcolor=#bbbbbb align=right>"
+
+set group_query "
+    select user_groups.group_id, group_name
+    from   user_groups
+    where  ad_group_member_p ( $user_id, user_groups.group_id ) = 't'
+    order by group_name"
+set selection [ns_db select $db $group_query]
+
+set group_option_tags ""
+set group_id_list [list]
+
+while {[ns_db getrow $db $selection]} {
+
+    set_variables_after_query
+
+    lappend group_id_list $group_id
+
+    append group_option_tags "
+    <option value=$group_id> $group_name group document tree</option>\n"
+
+}
+
+# now, we want to get a list of folders containing files that the user can see
+# but are stored in a directory to which the user does not normally have access
+
+# do this for group folders first
+
+if {[llength $group_id_list] > 0} {
+    set group_clause "\n and ug.group_id not in ([join $group_id_list ","])\n"
+} else {
+    set group_clause ""
+}
+
+set group_query "
+    select ug.group_id,
+           ug.group_name 
+    from   user_groups ug, 
+           fs_files fsf,
+           fs_versions_latest fsvl
+    where  fsf.file_id = fsvl.file_id
+    and    user_has_row_permission_p ($user_id, 'read', fsvl.version_id, 'FS_VERSIONS') = 't'
+    and    fsf.group_id = ug.group_id $group_clause
+    group by ug.group_id, ug.group_name
+    order by group_name"
+
+set selection [ns_db select $db $group_query]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append group_option_tags "
+        <option value=\"[list public_group $group_id]\">
+        $group_name group document tree
+        </option>\n"
+}
+
+
+# now, get personal folders
+
+# Ben: There was a conflict here and I am too tired to figure it out.
+# acs-3.2.2 query:
+set user_query "
+    select users.user_id as folder_user_id,
+           first_names||' '||last_name as user_name
+    from   users,
+           fs_files,
+           fs_versions_latest ver
+    where  ver.file_id = fs_files.file_id
+    and    not fs_files.owner_id = $user_id
+    and    fs_files.owner_id = users.user_id
+    and    fs_files.group_id is null
+    and    folder_p = 'f'
+    and    (fs_files.public_p <> 't' or fs_files.public_p is null)
+    and    ad_general_permissions.user_has_row_permission_p ($user_id, 'read', ver.version_id, 'FS_VERSIONS') = 't'
+    group by users.user_id, first_names, last_name
+    order by user_name"
+# existing query:
+set user_query "
+    select distinct u.user_id as folder_user_id, 
+           u.first_names || ' ' || u.last_name as user_name
+    from   users u,
+           fs_files fsf,
+           fs_versions_latest fsvl
+    where  fsf.file_id = fsvl.file_id
+    and    fsf.owner_id = $user_id
+    and    fsf.group_id is null
+    and    ( fsf.public_p <> 't' or fsf.public_p is null )
+    and    user_has_row_permission_p ($user_id, 'read', fsvl.version_id, 'FS_VERSIONS' ) = 't'
+    order by user_name"
+
+set selection [ns_db select $db $user_query]
+
+while {[ns_db getrow $db $selection]} {
+
+    set_variables_after_query
+
+    append group_option_tags "
+        <option value=\"[list user_id $folder_user_id]\">
+        $user_name's private document tree
+        </option>\n"
+}
+
+
+
+append page_content  "
+<form action=group>
+<nobr> $font 
+Go to 
+<select name=group_id>
+<option value=\"public_tree\" selected>$title</option>
+<option value=\"personal\">Your personal document tree</option>
+
+$group_option_tags
+
+<option value=\"all_public\">All publically accessible files</option>
+</select> 
+<input type=submit value=go></td></tr>
+</table></td></tr></table></blockquote>
+</form>
+
+This system lets you keep your files on [ad_parameter SystemName],
+access them from any computer connected to the internet, and
+collaborate with others on file creation and modification.
+
+<p>
+
+[ad_footer [fs_system_owner]]"
+
+# release the database handle
+
+ns_db releasehandle $db 
+
+# serve the page
+
+ns_return 200 text/html $page_content 
Index: web/openacs/www/file-storage/one-file.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/one-file.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/one-file.tcl	17 Apr 2001 14:05:14 -0000	1.1
@@ -0,0 +1,393 @@
+# /file-storage/one-file.tcl
+#
+# by aure@arsdigita.com July 1999 
+# (rewritten by philg@mit.edu) 
+# philg@mit.edu added commentability on December 19, 1999
+#
+# modified by randyg@arsdigita.com January, 2000
+#
+# summary of one file, with options to download, edit properties, or
+# upload new version
+#
+# one-file.tcl,v 3.5.2.8 2000/04/10 15:22:49 carsten Exp
+
+ad_page_variables {
+    {file_id}
+    {group_id ""}
+    {owner_id ""}
+    {source ""}
+    {show_all 0}
+}
+
+set local_user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+set exception_text ""
+set exception_count 0
+
+set latest_version_id [database_to_tcl_string $db "
+    select version_id from fs_versions_latest where file_id = $file_id"]
+
+if { ![fs_check_read_p $db $local_user_id $latest_version_id $group_id]} {
+    incr exception_count
+    append exception_text "<li>You can't read this file"
+}
+
+## return errors
+if { $exception_count> 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+set on_which_table "FS_VERSIONS"
+
+# set file_info_query "
+#     select count ( fsv.version_id ) as n_versions,
+#            fsf1.file_title,
+#            fsf2.file_title as parent_title,
+#            fsf1.folder_p,
+#            fsf1.parent_id,
+#            fsvl.url,
+#            u.first_names || ' ' || u.last_name as owner_name,
+#            user_has_row_permission_p ($local_user_id, 'read', fsvl.version_id, '$on_which_table' ) as public_read_p
+#     from   fs_files fsf1,
+#            fs_files fsf2,
+#            fs_versions fsv,
+#            fs_versions_latest fsvl,
+#            users u
+#     where  fsf1.file_id = $file_id
+#     and    fsf1.parent_id = fsf2.file_id (+)
+#     and    fsf1.file_id = fsvl.file_id
+#     and    user_has_row_permission_p ($local_user_id, 'read', fsvl.version_id, '$on_which_table' ) = 't'
+#     and    fsf1.owner_id = u.user_id
+#     group by fsf1.file_title,
+#            fsf2.file_title,
+#            fsf1.folder_p,
+#            fsf1.parent_id,
+#            fsvl.url,
+#            u.first_names,
+#            u.last_name,
+#            ad_general_permissions.user_has_row_permission_p ($local_user_id, 'read', fsvl.version_id, '$on_which_table' )"
+
+
+set file_info_query "
+    select count ( fsv.version_id ) as n_versions,
+           fsf1.file_title,
+           fsf1.folder_p,
+           fsf1.parent_id,
+           fsvl.url,
+           u.first_names || ' ' || u.last_name as owner_name,
+           user_has_row_permission_p ($local_user_id, 'read', fsvl.version_id, '$on_which_table' ) as public_read_p
+    from   fs_files fsf1,
+           fs_files fsf2,
+           fs_versions fsv,
+           fs_versions_latest fsvl,
+           users u
+    where  fsf1.file_id = $file_id
+    and    fsf1.file_id = fsvl.file_id
+    and    user_has_row_permission_p ($local_user_id, 'read', fsvl.version_id, '$on_which_table' ) = 't'
+    and    fsf1.owner_id = u.user_id
+    group by fsf1.file_title,
+           fsf1.folder_p,
+           fsf1.parent_id,
+           fsvl.url,
+           u.first_names,
+           u.last_name,
+           user_has_row_permission_p ($local_user_id, 'read', fsvl.version_id, '$on_which_table' )"
+
+ns_db dml $db "begin transaction"
+
+    set selection [ns_db 0or1row $db $file_info_query]
+    if [empty_string_p $selection] {
+        ad_return_error "File not found" "Could not find file $file_id; it may have been deleted."
+        ns_db dml $db "end transaction"
+        return
+    }
+    
+    set_variables_after_query
+
+    set sql "
+     select fsf2.file_title as parent_title
+     from   fs_files fsf1,
+            fs_files fsf2,
+            fs_versions fsv,
+            fs_versions_latest fsvl,
+            users u
+     where  fsf1.file_id = $file_id
+     and    fsf1.parent_id = fsf2.file_id
+     and    fsf1.file_id = fsvl.file_id
+     and    user_has_row_permission_p ($local_user_id, 'read', fsvl.version_id, '$on_which_table' ) = 't'
+     and    fsf1.owner_id = u.user_id
+     group by fsf2.file_title"
+
+    set parent_title [database_to_tcl_string_or_null $db $sql]
+
+ns_db dml $db "end transaction"
+
+if { $folder_p == "t" } {
+    # we got here by mistake, push them out into the right place 
+    # (this shouldn't happen!)
+    ns_log Error "User was sent to /file-storage/one-file.tcl to view a FOLDER (#$file_id)"
+    ns_returnredirect "one-folder?[export_entire_form_as_url_vars]"
+    return
+}
+
+if { ![empty_string_p $group_id] } {
+    set group_name [database_to_tcl_string $db "
+    select group_name 
+    from   user_groups 
+    where  group_id=$group_id"]
+
+    set tree_name "$group_name document tree"
+} else {
+    if {$public_read_p == "t"} {
+	set tree_name "Shared [ad_system_name] document tree"
+    } else {
+	set tree_name "Your personal document tree"
+    }
+}
+
+
+set object_type File
+
+set title $file_title
+
+if {[empty_string_p $parent_title]} {
+    set parent_title "Root (Top Level)"
+}
+
+
+# the navbar is determined by where they just came from
+
+switch $source {
+    "personal" {
+	set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]] [list "personal" "Personal document tree"] "One File"]
+}
+    "group" { 
+	set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]] [list "group?group_id=$group_id" "$group_name document tree"] "One File"]
+    }
+    "public_individual" {
+	set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]] [list "public-one-person?[export_url_vars owner_id]" "$owner_name's publically accessible files"] "One File"]
+    }
+    "public_group" {
+	set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]] [list "public-one-group?[export_url_vars group_id]" "$group_name publically accessible files"]  "One File"]
+    }
+    default {
+	set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]] "One File"]
+    }
+}
+
+# We use return_url to create links to other pages that should
+# return back here.
+#
+set return_url "[ns_conn url]?[ns_conn query]"
+
+# We pass the title of this file to /gp/administer-permissions.tcl as
+# object_name.
+#
+set object_name $title
+
+set page_content "
+[ad_header $title ]
+
+<h2> $title </h2>
+
+$navbar
+<hr>"
+
+set action_list [list]
+
+
+if {[fs_check_edit_p $db $local_user_id $latest_version_id $group_id]} {
+    if [empty_string_p $url] {
+        lappend action_list "<a href=\"version-upload?[export_url_vars return_url file_id]\">upload new version</a>"
+        lappend action_list "<a href=\"file-edit?[export_url_vars group_id file_id return_url]\">edit file</a>"
+        lappend action_list "<a href=\"file-delete?[export_url_vars group_id file_id return_url source object_type]\">delete this file (including all versions)</a>"
+    } else {
+        lappend action_list "<a href=\"url-delete?[export_url_vars group_id file_id return_url source]\">delete</a>"
+    }
+}
+
+append page_content "
+<ul>
+<li> Title: $file_title
+<li> Owner: $owner_name
+<li> Located in: $tree_name / $parent_title "
+
+if { [llength $action_list] > 0 } {
+    append page_content "
+    <p>
+    <li>Actions:  [join $action_list " | "]\n"
+}
+
+append page_content "
+</ul>
+<blockquote>"
+
+set version_html ""
+set version_count 0
+
+if { $show_all } {
+    set limit_clause ""
+} else {
+    set limit_clause " limit 1"
+}
+
+# this query replaces the monster that follows.
+# its purpose is to extract all versions of this file (with some extra information)
+# and also with permission information
+set selection [ns_db select $db "
+    select fsv.version_id,
+           fsv.version_description,
+           fsv.client_file_name,
+           round (float8(fsv.n_bytes) / 1024.0) as n_kbytes,
+           u.first_names || ' ' || u.last_name as creator_name,
+           to_char ( fsv.creation_date, '[fs_date_picture]' ) as creation_date,
+           coalesce (fsv.file_type, upper (fsv.file_extension) || ' File') as file_type,
+           fsv.author_id,
+           (case when user_has_row_permission_p ($local_user_id, 'read', fsv.version_id, '$on_which_table') = 't' then 1 else 0 end) as read_p,
+           (case when user_has_row_permission_p ($local_user_id, 'write', fsv.version_id, '$on_which_table') = 't' then 1 else 0 end) as write_p,
+           (case when user_has_row_permission_p ($local_user_id, 'administer', fsv.version_id, '$on_which_table') = 't' then 1 else 0 end) as administer_p
+    from   fs_versions fsv,
+           users u
+    where  fsv.file_id = $file_id
+    and    fsv.author_id = u.user_id
+    order by fsv.creation_date desc $limit_clause"]
+
+set font "<font face=arial,helvetica>"
+
+set header_color [ad_parameter HeaderColor fs]
+
+if [empty_string_p $url] {
+    append page_content "
+    <table border=1 bgcolor=white  cellpadding=0 cellspacing=0>
+    <tr>
+    <td><table bgcolor=white cellspacing=1 border=0 cellpadding=2>
+        <tr>
+        <td colspan=8 bgcolor=#666666>$font &nbsp;<font color=white> "
+    if { $show_all } {
+        append page_content "All Versions of $file_title</td>"
+    } else {
+        append page_content "Latest version of $file_title</td>"
+    }
+    append page_content "
+ 
+        </tr>
+        <tr>
+        <td colspan=2 bgcolor=$header_color>$font &nbsp; Name &nbsp;</td>
+        <td bgcolor=$header_color>$font &nbsp; Author &nbsp;</td>
+        <td bgcolor=$header_color align=right>$font &nbsp; Size &nbsp;</td>
+        <td bgcolor=$header_color>$font &nbsp; Type &nbsp;</td>
+        <td bgcolor=$header_color>$font &nbsp; Modified &nbsp;</td>
+        <td bgcolor=$header_color>$font &nbsp; Version Notes &nbsp;</td>
+        <td bgcolor=$header_color>$font &nbsp; Permissions &nbsp;</td>
+        </tr>" 
+
+    set graphic "<img border=0 align=top src=/graphics/file-storage/ftv2doc.gif>"
+
+    while {[ns_db getrow $db $selection]} {
+        set_variables_after_query
+	incr version_count
+	set page_name "$file_title: version [expr $n_versions - $version_count + 1]"
+
+        regexp {.*\\([^\\]+)} $client_file_name match client_file_name
+	regsub -all {[^-_.0-9a-zA-Z]+} $client_file_name "_" pretty_file_name
+
+	set permissions_list [list]
+
+	if {$read_p > 0} {
+	    append version_html "
+	    <tr>
+	    <td valign=top>&nbsp;<a href=\"download/$pretty_file_name?[export_url_vars version_id]\">$graphic</a></td>
+	    <td valign=top>$font <a href=\"download/$pretty_file_name?[export_url_vars version_id]\">$client_file_name</a> &nbsp;</td>"
+	    lappend permissions_list "<a href=\"download/$pretty_file_name?[export_url_vars version_id]\">read</a>"
+	} else {
+	    append version_html "
+	    <tr><td valign=top>&nbsp; $font $graphic</td>
+	    <td valign=top>$client_file_name &nbsp;</td>"
+	}
+
+	if {$write_p > 0} {
+	    lappend permissions_list "<a href=\"version-upload?[export_url_vars return_url file_id]\">write</a>"
+	}
+
+	if {$administer_p > 0} {
+	    lappend permissions_list "<a href=\"/gp/administer-permissions?on_what_id=$latest_version_id&[export_url_vars on_which_table return_url object_name]\">administer</a>"
+	}
+
+	if {![empty_string_p $n_kbytes]} {
+	    set n_kbytes "$n_kbytes KB"
+	}
+
+	if { [llength $permissions_list] > 0} {
+	    set permissions_string "[join $permissions_list " | "]"
+	} else {
+	    set permissions_string "None"
+	}
+
+	append version_html "
+	    <td valign=top>$font <a href=/shared/community-member?user_id=$author_id>$creator_name</a></td>
+	    <td align=right valign=top>$font $n_kbytes</td>
+	    <td valign=top align=center>$font [fs_pretty_file_type $file_type]</td>
+	    <td valign=top>$font $creation_date</td>
+	    <td valign=top>$font $version_description</td>
+	    <td valign=top align=center>$font $permissions_string </td>
+	    </tr>\n"
+    }
+
+    append page_content "$version_html</table>"
+
+} else {
+    append page_content "<a href=\"$url\">$url</A>"
+}
+
+append page_content "</td></tr></table></blockquote><center>"
+
+if { $show_all } {
+    append page_content "<a href=\"one-file?[export_url_vars file_id group_id owner_id source]\">Hide old versions of this file</a><br>"
+} else {
+    append page_content "<a href=\"one-file?[export_url_vars file_id group_id owner_id source]&show_all=1\">Show all versions of this file</a><br>"
+}
+
+append page_content "</center>"
+
+set comments_read_p 0
+set comments_write_p 0
+
+if {[ad_parameter CommentPermissionsP gp]} {
+    set query "
+	select count(fs_files.file_id) from fs_files 
+	where fs_files.file_id = $file_id and fs_files.owner_id = $local_user_id"
+
+    if {[database_to_tcl_string $db $query] > 0} {
+	set comments_read_p 1
+	set comments_write_p 1
+    } else {
+	set comments_read_p 1
+	set comments_write_p [ad_user_has_row_permission_p $db $local_user_id \
+	    "comment" $latest_version_id $on_which_table]
+    }
+}
+
+if {$comments_read_p} {
+    append page_content "
+	[ad_general_comments_list $db $file_id "fs_files" $file_title fs "" "" {} \
+	 $comments_write_p]"
+}
+
+
+append page_content "
+</ul>
+
+[ad_footer [fs_system_owner]]"
+
+# release the database handle
+
+ns_db releasehandle $db
+
+# serve the page
+
+ns_return 200 text/html $page_content
Index: web/openacs/www/file-storage/one-folder.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/one-folder.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/one-folder.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,397 @@
+# /file-storage/one-folder.tcl
+#
+# by philg@mit.edu July 23 1999 
+#
+# summary of one folder
+#
+# modified by randyg@arsdigita.com January, 2000 to use 
+# the general permissions system
+#
+# one-folder.tcl,v 3.3.2.1 2000/03/15 20:27:58 carsten Exp
+
+ad_page_variables {
+    {file_id}
+    {group_id ""}
+    {source ""}
+    {owner_id ""}
+}
+
+set return_url "one-folder?[ns_conn query]"
+
+set user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+set exception_text ""
+set exception_count 0
+
+if [empty_string_p $file_id] {
+    incr exception_count
+    append exception_text "<li>No folder was specified"
+}
+
+set version_id [database_to_tcl_string $db "
+    select version_id 
+    from   fs_versions_latest 
+    where  file_id = $file_id"]
+
+if { ![fs_check_read_p $db $user_id $version_id $group_id] } {
+    incr exception_count
+    append exception_text "<li>You don't have authority to read this folder"
+}
+
+## return errors
+if { $exception_count> 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+
+# set sql "
+#     select fsf1.file_title,
+#            fsf2.file_title as parent_title,
+#            fsf1.folder_p,
+#            fsf1.parent_id,
+#            u.first_names || ' ' || u.last_name as owner_name,
+#            user_has_row_permission_p ( fsf1.owner_id, 'read', fsvl.version_id, 'FS_VERSIONS' ) as public_read_p
+#     from   fs_files fsf1,
+#            fs_files fsf2,
+#            fs_versions_latest fsvl,
+#            users u
+#     where  fsf1.file_id = $file_id
+#     and    fsf1.file_id = fsvl.file_id
+#     and    fsf1.parent_id = fsf2.file_id (+)
+#     and    fsf1.owner_id = u.user_id"
+
+
+set sql "
+    select fsf1.file_title,
+           fsf2.file_title as parent_title,
+           fsf1.folder_p,
+           fsf1.parent_id,
+           u.first_names || ' ' || u.last_name as owner_name,
+           user_has_row_permission_p ( fsf1.owner_id, 'read', fsvl.version_id, 'FS_VERSIONS' ) as public_read_p
+    from   fs_files fsf1,
+           fs_files fsf2,
+           fs_versions_latest fsvl,
+           users u
+    where  fsf1.file_id = $file_id
+    and    fsf1.file_id = fsvl.file_id
+    and    fsf1.parent_id = fsf2.file_id
+    and    fsf1.owner_id = u.user_id
+    union
+    select fsf1.file_title,
+           '' as parent_title,
+           fsf1.folder_p,
+           fsf1.parent_id,
+           u.first_names || ' ' || u.last_name as owner_name,
+           user_has_row_permission_p ( fsf1.owner_id, 'read', fsvl.version_id, 'FS_VERSIONS' ) as public_read_p
+    from   fs_files fsf1,
+           fs_versions_latest fsvl,
+           users u
+    where  fsf1.file_id = $file_id
+    and    fsf1.file_id = fsvl.file_id
+    and    not exists (select 1 from fs_files 
+                       where file_id = fsf1.parent_id)
+    and    fsf1.owner_id = u.user_id"
+
+
+set selection [ns_db 0or1row $db $sql]
+ 
+if [empty_string_p $selection] {
+    ad_return_error "Folder not found" "Could not find 
+        folder $file_id; it may have been deleted."
+    return
+}
+
+set_variables_after_query
+
+if { $folder_p != "t" } {
+    # we got here by mistake, push them out into the right place 
+    # (this shouldn't happen!)
+    ns_log Error "User was sent to /file-storage/one-file.tcl to view a FILE (#$file_id)"
+    ns_returnredirect "one-file?[export_entire_form_as_url_vars]"
+    return
+}
+
+
+set object_type "Folder"
+
+set title $file_title
+
+if { [empty_string_p $parent_title] } {
+    set parent_title "Root (Top Level)"
+}
+
+if { ![empty_string_p $group_id]} {
+    set group_name [database_to_tcl_string $db "
+    select group_name 
+    from   user_groups 
+    where  group_id=$group_id"]
+
+    set tree_name "$group_name document tree"
+
+} else {
+    if {$public_read_p == "t"} {
+	set tree_name "Shared [ad_system_name] document tree"
+    } else {
+	set tree_name "Your personal document tree"
+    }
+}
+
+
+# the navbar is determined by where the just came from
+
+set sql_suffix ""
+
+switch $source {
+    "personal" {
+	set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]] [list "personal" "Personal Document Tree"] "One File"]
+	set sql_suffix "and fsf.public_p = 'f' and fsf.owner_id = $user_id and fsf.group_id is null"
+	set public_p f
+}
+    "group" { 
+	set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]] [list "group?group_id=$group_id" "$group_name document tree"] "One File"]
+	set sql_suffix "and fsf.group_id = $group_id"
+	set public_p t
+    }
+    "public_individual" {
+	set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]] [list "public-one-person?[export_url_vars owner_id]" "$owner_name's publically accessible files"] "One File"]
+	set sql_suffix "and user_has_row_permission_p ( $owner_id, 'read', fsvl.version_id, 'FS_VERSIONS' ) = 't' and fsf.owner_id = $owner_id and fsf.group_id is null"
+	set public_p t
+    }
+    "public_group" {
+	set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]] [list "public-one-group?[export_url_vars group_id]" "$group_name publically accessible files"] "One File"]
+	set sql_suffix "and user_has_row_permission_p ( $owner_id, 'read', fsvl.version_id, 'FS_VERSIONS' ) = 't' and fsf.group_id = $group_id"
+	set public_p t
+    }
+    "private_individual" {
+	set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]] [list "private-one-person?[export_url_vars owner_id]" "$owner_name's privately accessible files"] "One File"]
+	set sql_suffix "and fsf.owner_id = $owner_id and fsf.public_p = 'f'"
+	set public_p f
+    }
+    "private_group" {
+	set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]] [list "private-one-group?[export_url_vars group_id]" "$group_name privately accessible files"] "One File"]
+	set sql_suffix "and user_has_row_permission_p ( $owner_id, 'read', fsvl.version_id, 'FS_VERSIONS' ) = 'f' and fsf.group_id = $group_id"
+	set public_p f
+    }
+    default {
+	set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]] "One File"]
+	set public_p t
+    }
+}
+ 
+set page_content  "
+[ad_header $title ]
+
+<h2> $title </h2>
+
+$navbar
+
+<hr>
+"
+
+## determine if the user owns the folder - user_id is the owner_id?
+set action_list [list]
+
+
+if [fs_check_edit_p $db $user_id $version_id $group_id] {
+    # If she owns it, provide links for folder editing, file upload and
+    # creation of subfolders.
+
+    set current_folder $file_id
+    set url_vars [export_url_vars return_url public_p current_folder group_id]
+
+    lappend action_list "<a href=\"file-edit?[export_url_vars group_id file_id return_url]\">edit</a>" \
+    "<a href=upload-new?$url_vars>Add a URL / Upload a file</a>" \
+    "<a href=create-folder?$url_vars>Create New Folder</a>"
+}
+
+
+if {[llength $action_list] >0} {
+    set actions_option "<p><li>Actions:  [join $action_list " | "]"
+} else {
+    set actions_option ""
+}
+
+append page_content "
+
+<ul>
+<li> $object_type Title: $file_title
+<li> Owner: $owner_name
+<li> Located in: $tree_name / $parent_title
+
+$actions_option
+
+</ul>"
+
+set tree_walk "
+select file_id,	
+       file_title,
+       sort_key,
+       depth,   
+       folder_p,
+       owner_id,
+       group_id,
+       public_p,
+       parent_id,
+       level as the_level
+from   fs_files
+where  deleted_p = 'f'
+connect by parent_id = prior file_id start with file_id = $file_id
+"
+
+# get the files from the database and parse 
+# the output to reflect the folder stucture
+# Only show files the user has permission to read
+
+# set sorted_query "
+#     select desired.file_id,
+#            desired.file_title,
+#            desired.folder_p,
+#            desired.depth * 24 as n_pixels_in,
+#            round (fsvl.n_bytes / 1024) as n_kbytes,
+#            to_char (fsvl.creation_date, '[fs_date_picture]') as creation_date,
+#            coalesce (fsvl.file_type, upper (fsvl.file_extension) || ' File') as file_type,
+#            desired.sort_key
+#     from   fs_versions_latest fsvl,
+# 	   ($tree_walk) desired
+#     where  fsvl.file_id = desired.file_id
+#     and    (user_has_row_permission_p ($user_id, 'read', fsvl.version_id, 'FS_VERSIONS') = 't' or owner_id = $user_id or folder_p = 't')
+#     order by sort_key"
+
+#DanW - since tree_walk only gets the children of the $file_id, we don't have to worry about the 
+# connect by statement.  We can just use the pl/sql function fs_node_is_child to identify the children
+# join fs_files directly with fs_versions_latest.  The ordering is determined by sort_key which must be 
+# calculated and inserted into the table at some other point.  Need to check this.
+
+set sorted_query "
+    select desired.file_id,
+           desired.file_title,
+           desired.folder_p,
+           desired.depth * 24 as n_pixels_in,
+           round (float8(fsvl.n_bytes) / 1024.0) as n_kbytes,
+           to_char (fsvl.creation_date, '[fs_date_picture]') as creation_date,
+           coalesce (fsvl.file_type, upper (fsvl.file_extension) || ' File') as file_type,
+           desired.sort_key
+    from   fs_versions_latest fsvl,
+	   fs_files desired
+    where  fsvl.file_id = desired.file_id
+    and    desired.deleted_p = 'f'
+    and    fs_node_is_child($file_id,desired.file_id) = 't'
+    and    (user_has_row_permission_p ($user_id, 'read', fsvl.version_id, 'FS_VERSIONS') = 't' or owner_id = $user_id or folder_p = 't')
+    order by sort_key"
+
+set file_html ""
+set file_count 0
+
+set selection [ns_db select $db $sorted_query]
+
+set font "<nobr><font face=arial,helvetica size=-1>"
+
+set header_color [ad_parameter HeaderColor fs]
+
+append page_content "
+<blockquote>
+<table border=1 bgcolor=white  cellpadding=0 cellspacing=0>
+ <tr>
+ <td><table bgcolor=white cellspacing=1 border=0 cellpadding=0>
+     <tr>
+     <td colspan=4 bgcolor=#666666>$font &nbsp;<font color=white>files in $file_title</td>
+     </tr>
+     <tr>
+     <td bgcolor=$header_color>$font &nbsp; Name</td>
+     <td bgcolor=$header_color align=right>$font &nbsp; Size &nbsp;</td>
+     <td bgcolor=$header_color>$font &nbsp; Type &nbsp;</td>
+     <td bgcolor=$header_color>$font &nbsp; Modified &nbsp;</td>
+     </tr>" 
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    # We ignore the first element's indentation and shift all rows left by
+    # that many pixels.
+    if !$file_count {
+	set initial_pixels $n_pixels_in
+    }
+    set n_pixels_in [expr $n_pixels_in - $initial_pixels]
+
+     if { $n_pixels_in == 0 } {
+	set spacer_gif ""
+     } else {
+	set spacer_gif "<img src=\"/graphics/file-storage/spacer.gif\" width=$n_pixels_in height=1>"
+    }
+
+    set one_file_url "one-file?[export_url_vars file_id group_id owner_id source]"
+
+    if {$folder_p=="t"} {
+
+        append file_html "<tr><td valign=top>&nbsp; $spacer_gif $font"
+        if $file_count { append file_html "<a href=\"one-folder?[export_url_vars file_id]\">" }
+        append file_html "<img border=0 src=/graphics/file-storage/ftv2folderopen.gif align=top>"
+        if $file_count { append file_html "</a> <a href=\"one-folder?[export_url_vars file_id]\">" }
+        append file_html $file_title
+        if $file_count { append file_html "</a>" }
+        append file_html "</td>
+	<td align=right>&nbsp;</td>
+	<td>$font &nbsp; File Folder &nbsp;</td>
+	<td>&nbsp;</td>
+	</tr>\n"
+
+    } elseif {[empty_string_p $n_kbytes]} {
+
+        append file_html "
+	<tr>
+	<td valign=top>&nbsp; $spacer_gif $font
+	<a href=\"$one_file_url\">
+	<img border=0 src=/graphics/file-storage/ftv2doc.gif align=top></a>
+	<a href=\"$one_file_url\">$file_title</a>&nbsp;</td>
+	<td align=right>&nbsp;</td>
+	<td>$font &nbsp; URL &nbsp;</td>
+	<td>$font &nbsp; $creation_date &nbsp;</td>
+	</tr>\n"
+
+    } else {
+
+        append file_html "
+	<tr>
+	<td valign=top>&nbsp; $spacer_gif $font
+	<a href=\"$one_file_url\">
+	<img border=0 src=/graphics/file-storage/ftv2doc.gif align=top></a>
+	<a href=\"$one_file_url\">$file_title</a>&nbsp;</td>
+	<td align=right>$font &nbsp; $n_kbytes KB &nbsp;</td>
+	<td>$font &nbsp; [fs_pretty_file_type $file_type] &nbsp;</td>
+	<td>$font &nbsp; $creation_date &nbsp;</td>
+	</tr>\n"
+
+    }
+
+    incr file_count
+}
+
+if {$file_count!=0} {
+    append page_content "$file_html"
+} else {
+    append page_content "
+    <tr>
+    <td>You don't have any files stored in this folder. </td>
+    </tr>"
+}
+
+append page_content "
+</table></td></tr></table></blockquote>
+
+</ul>
+
+[ad_footer [fs_system_owner]]"
+
+# release the database handle
+
+ns_db releasehandle $db
+
+# serve the page
+
+ns_return 200 text/html $page_content
+
Index: web/openacs/www/file-storage/personal.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/personal.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/personal.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,284 @@
+# /file-storage/personal.tcl
+# 
+# by aure@arsdigita.com, July 1999
+#
+# this file displays all files in the user's personal folder
+#
+# modified by randyg@arsdigita.com, January, 2000 to use the general 
+# permissions module
+#
+# personal.tcl,v 3.2.2.5 2000/03/31 16:11:16 carsten Exp
+
+set user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+set cookies [get_cookie_set]
+set folders_open_p [ns_set get $cookies folders_open_p]
+if [empty_string_p $folders_open_p] {
+    set folders_open_p 1
+}
+
+set return_url "personal"
+
+set db [ns_db gethandle]
+
+set name_query "select first_names||' '||last_name as name 
+               from   users 
+               where  user_id = $user_id"
+set name [database_to_tcl_string $db $name_query]
+
+set title "$name's Documents"
+
+set public_p "f"
+
+set page_content  "
+[ad_header $title ]
+
+<h2> $title </h2>
+
+[ad_context_bar_ws [list "" [ad_parameter SystemName fs]] "Personal document tree"]
+
+<hr>
+
+<ul>
+   <li><a href=upload-new?[export_url_vars return_url public_p]>Add a URL / Upload a new file</a>
+   <li><a href=create-folder?[export_url_vars return_url public_p]>Create New Folder</a> (for storing personal files)
+
+   <form action=search method=post>
+"
+
+if { [ad_parameter UseIntermediaP fs 0] } {
+    append page_content "<li> Search file names and contents for: "
+} else {
+    append page_content "<li> Search file names for: "
+}
+
+append page_content "<input name=search_text type=text size=20>[export_form_vars return_url]<input type=submit value=Search></form>
+
+</ul>
+<blockquote>"
+
+# get the user's files from the database and parse the output to 
+# reflect the folder stucture
+
+set sorted_query "
+    select fsf.file_id,
+           fsf.file_title,
+           fsvl.url,
+           fsf.folder_p,
+           fsf.depth * 24 as n_pixels_in,
+           round ( float8(fsvl.n_bytes) / 1024.0 ) as n_kbytes,
+           to_char ( fsvl.creation_date, '[fs_date_picture]' ) as creation_date,
+           coalesce ( fsvl.file_type, upper ( fsvl.file_extension ) || ' File' ) as file_type
+    from   fs_files fsf,
+           fs_versions_latest fsvl
+    where  fsf.file_id = fsvl.file_id
+    and    deleted_p = 'f'
+    and    fsf.owner_id = $user_id
+    and    fsf.group_id is null
+    and    (fsf.public_p = 'f' or fsf.public_p is null)
+    order by fsf.sort_key"
+
+set file_html ""
+set group_id ""
+set file_count 0
+
+set selection [ns_db select $db $sorted_query]
+
+set font "<nobr>[ad_parameter FileInfoDisplayFontTag fs]"
+
+set header_color [ad_parameter HeaderColor fs]
+
+# we start with an outer table to get little white lines in 
+# between the elements 
+
+append page_content "
+<table border=1 bgcolor=white  cellpadding=0 cellspacing=0>
+<tr>
+<td><table bgcolor=white cellspacing=1 border=0 cellpadding=0>
+    <tr>
+    <td colspan=4 bgcolor=#666666>
+    $font &nbsp;<font color=white> Your personal files</td>
+    </tr>
+    <tr>
+    <td bgcolor=$header_color>$font &nbsp; Name</td>
+    <td bgcolor=$header_color align=right>$font &nbsp; Size &nbsp;</td>
+    <td bgcolor=$header_color>$font &nbsp; Type &nbsp;</td>
+    <td bgcolor=$header_color>$font &nbsp; Modified &nbsp;</td>
+    </tr>" 
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    if { $n_pixels_in == 0 } {
+	set spacer_gif ""
+    } else {
+	set spacer_gif "<img src=\"/graphics/file-storage/spacer.gif\" width=$n_pixels_in height=1>"
+    }
+    if {$folder_p=="t"} {
+
+	append file_html "
+	<tr>
+	<td valign=top>&nbsp; $spacer_gif $font
+	<a href=\"one-folder?[export_url_vars file_id group_id]&source=personal\">
+	<img border=0 src=/graphics/file-storage/ftv2folderopen.gif align=top></a>
+	<a href=\"one-folder?[export_url_vars file_id]&source=personal\">$file_title</a></td><td align=right></td>
+	<td>$font &nbsp; File Folder &nbsp;</td>
+	<td>&nbsp;</td>
+	</tr>\n"    
+
+    } else {
+
+	if {![empty_string_p $n_kbytes]} {
+	    set n_kbytes "$n_kbytes KB"
+	}
+	append file_html "
+	<tr>
+	<td valign=top>&nbsp; $spacer_gif $font
+	<a href=\"one-file?[export_url_vars file_id group_id]&source=personal\">
+	<img \n border=0 src=/graphics/file-storage/ftv2doc.gif align=top></a>
+	<a href=\"one-file?[export_url_vars file_id]&source=personal\">$file_title</a>&nbsp;</td>
+	<td align=right>$font &nbsp; $n_kbytes &nbsp;</td>
+	<td>$font &nbsp; [fs_pretty_file_type $file_type] &nbsp;</td>
+	<td>$font &nbsp; $creation_date &nbsp;</td>
+	</tr>\n"    
+    }
+    
+    incr file_count
+}
+
+if {$file_count!=0} {
+    append page_content $file_html
+} else {
+    append page_content "
+        <tr>
+        <td>You don't have any files stored in the database. </td>
+        </tr>"
+}
+
+append page_content "<tr><td colspan=4 bgcolor=#bbbbbb align=right>"
+
+set group_count 0
+set group_query "
+    select group_id, 
+           group_name
+    from   user_groups
+    where  ad_group_member_p ($user_id, group_id) = 't'
+    order by group_name"
+
+set selection [ns_db select $db $group_query]
+
+set group_html ""
+set group_id_list [list]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append group_html "<option value=$group_id> 
+        $group_name group document tree</option>\n"
+    incr group_count
+    lappend group_id_list $group_id
+}
+
+
+# now, we want to get a list of folders containing files that the user can see
+# but are stored in a directory to which the user does not normally have access
+
+# first, get group folders
+
+if {[llength $group_id_list] > 0} {
+    set group_clause "and ug.group_id not in ([join $group_id_list ","])"
+} else {
+    set group_clause ""
+}
+
+set group_query "
+    select ug.group_id,
+           ug.group_name 
+    from   user_groups ug, 
+           fs_files fsf,
+           fs_versions_latest fsvl
+    where  fsf.file_id = fsvl.file_id
+    and    fsf.group_id = ug.group_id
+    $group_clause
+    group by ug.group_id, ug.group_name
+    order by group_name"
+
+set selection [ns_db select $db $group_query]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append group_html "<option value=\"[list public_group $group_id]\"> 
+        $group_name group document tree</option>\n"
+}
+
+
+# now, get personal folders
+
+set user_query "
+    select distinct u.user_id as folder_user_id, 
+           u.first_names || ' ' || u.last_name as user_name
+    from   users u,
+           fs_files fsf,
+           fs_versions_latest fsvl
+    where  fsf.file_id = fsvl.file_id
+    and    not fsf.owner_id = $user_id
+    and    fsf.owner_id = u.user_id
+    and    fsf.group_id is null
+    and    (fsf.public_p = 'f' or fsf.public_p is null)
+    and    user_has_row_permission_p ($user_id, 'read', fsvl.version_id, 'FS_VERSIONS') = 't'
+    order by user_name"
+
+set selection [ns_db select $db $user_query]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append group_html "<option value=\"[list user_id $folder_user_id]\"> 
+        $user_name's private document tree</option>\n"
+}
+
+
+
+set public_html ""
+if [ad_parameter PublicDocumentTreeP fs] {
+    set public_html "<option value=public_tree>
+        [ad_system_name] shared document tree"
+}
+
+
+append page_content  "
+<form action=group>
+<nobr>$font Go to  
+
+<select name=group_id>
+
+<option value=personal>Your personal files</option>
+$public_html
+$group_html
+<option value=\"all_public\">All publically accessible files</option>
+
+</select>
+
+<input type=submit value=go>
+
+</td></tr></table></td></tr></table>
+
+</blockquote>
+
+</form>
+
+This system lets you keep your files on [ad_parameter SystemName],
+access them from any computer connected to the internet, and
+collaborate with others on file creation and modification.
+
+[ad_footer [fs_system_owner]]"
+
+# release the database handle
+
+ns_db releasehandle $db 
+
+# Serve the page.
+# Because we are called without parameters, we add a Pragma: no-cache.
+
+ns_set put [ns_conn outputheaders] "Pragma" "no-cache"
+ReturnHeaders
+ns_write $page_content
Index: web/openacs/www/file-storage/private-one-group.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/private-one-group.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/private-one-group.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,334 @@
+# /file-storage/private-one-group.tcl
+#
+# by randyg@arsdigita.com, January, 2000
+#
+# This file shows files that belong to groups to users that are not in the
+# group but have permission to see the file
+#
+# private-one-group.tcl,v 3.3.2.3 2000/03/27 12:57:44 carsten Exp
+
+ad_page_variables {
+    {group_id}
+}
+
+set return_url "private-one-group?[ns_conn query]"
+
+set db [ns_db gethandle]
+
+set user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+if { [ad_user_group_member $db $group_id $user_id] } {
+    ns_returnredirect "group?group_id=$group_id"
+    return
+}
+
+set current_group_id $group_id
+set current_group_name [database_to_tcl_string $db "
+    select group_name 
+    from   user_groups 
+    where  group_id=$group_id"]
+
+set title "$current_group_name's document tree"
+
+set page_content  "
+<script runat=client>
+function launch_window(file) {
+    window.open(file,'files','toolbar=no,location=no,directories=no,status=no,scrollbars=auto,resizable=yes,copyhistory=no,width=450,height=250')
+}
+</script>
+
+[ad_header $title]
+
+<h2> $title </h2>
+
+[ad_context_bar_ws [list "" [ad_parameter SystemName fs]] "One Group"]
+
+<hr>
+
+<blockquote>"
+
+# get the group's files from the database and parse the output 
+# to reflect the folder stucture
+
+# walk the tree from all nodes with permissions up to the root.
+# we do this walk so that we can show all of the folders leading
+# up to the files that the user has permission to see
+
+
+# set backwards_tree_walk "
+# select file_id,	
+#        file_title,
+#        sort_key,
+#        depth,   
+#        folder_p,
+#        owner_id,
+#        deleted_p,
+#        group_id,
+#        public_p,
+#        parent_id,
+#        level as the_level
+# from   fs_files
+# connect by fs_files.file_id = prior parent_id
+# start with fs_files.file_id in (
+#     select distinct fs_files.file_id from fs_files, 
+#            fs_versions_latest
+#     where  (fs_files.public_p <> 't' or fs_files.public_p is null)
+#     and    fs_files.group_id = $group_id
+#     and    folder_p = 'f'
+#     and    fs_files.deleted_p='f'            
+#     and    fs_files.file_id=fs_versions_latest.file_id
+#     and    user_has_row_permission_p ($user_id, 'read', fs_versions_latest.version_id, 'FS_VERSIONS') = 't')"
+
+
+# set sorted_query "
+#     select distinct desired_files.file_id, 
+#            desired_files.sort_key,
+#            file_title, 
+#            folder_p, 
+#            depth * 24 as n_pixels_in, 
+#            to_char(fs_versions_latest.creation_date,'[fs_date_picture]') as creation_date,
+#            round(n_bytes/1024) as n_kbytes, 
+#            coalesce(file_type,upper(file_extension)||' File') as file_type,
+#            first_names||' '||last_name as owner_name
+#     from   ($backwards_tree_walk) desired_files, 
+#            fs_versions_latest,
+#            users
+#     where  fs_versions_latest.file_id = desired_files.file_id
+#     and    desired_files.owner_id = users.user_id
+#     order by desired_files.sort_key"
+
+set start_node_sql "
+    select distinct fs_files.file_id from fs_files, 
+           fs_versions_latest
+    where  (fs_files.public_p <> 't' or fs_files.public_p is null)
+    and    fs_files.group_id = $group_id
+    and    folder_p = 'f'
+    and    fs_files.deleted_p='f'            
+    and    fs_files.file_id=fs_versions_latest.file_id
+    and    user_has_row_permission_p ($user_id, 'read', fs_versions_latest.version_id, 'FS_VERSIONS') = 't'"
+
+set sorted_query "
+    select distinct desired_files.file_id, 
+           desired_files.sort_key,
+           file_title, 
+           folder_p, 
+           depth * 24 as n_pixels_in, 
+           to_char(fs_versions_latest.creation_date,'[fs_date_picture]') as creation_date,
+           round(float8(n_bytes)/1024.0) as n_kbytes, 
+           coalesce(file_type,upper(file_extension)||' File') as file_type,
+           first_names||' '||last_name as owner_name
+    from   fs_files desired_files, 
+           fs_versions_latest,
+           users
+    where  fs_versions_latest.file_id = desired_files.file_id
+    and    fs_node_is_child(%s,desired_files.file_id)
+    and    desired_files.owner_id = users.user_id
+    order by desired_files.sort_key"
+
+set file_html ""
+set file_count 0
+
+with_transaction $db {
+
+    set start_node [database_to_tcl_string $db $start_node_sql]
+
+    set selection [ns_db select $db [format $sorted_query $start_node]]
+
+    set font "<nobr>[ad_parameter FileInfoDisplayFontTag fs]"
+    set header_color [ad_parameter HeaderColor fs]
+
+    append page_content "
+<table border=1 bgcolor=white  cellpadding=0 cellspacing=0>
+<tr>
+<td><table bgcolor=white cellspacing=1 border=0 cellpadding=0>
+    <tr>
+    <td colspan=5 bgcolor=#666666> $font &nbsp;<font color=white> 
+     $current_group_name's files</td>
+    </tr>
+    <tr>
+    <td bgcolor=$header_color>$font &nbsp; Name</td>
+    <td bgcolor=$header_color>$font &nbsp; Author &nbsp;</td>
+    <td bgcolor=$header_color align=right>$font &nbsp; Size &nbsp;</td>
+    <td bgcolor=$header_color>$font &nbsp; Type &nbsp;</td>
+    <td bgcolor=$header_color>$font &nbsp; Modified &nbsp;</td>
+    </tr>" 
+
+    while {[ns_db getrow $db $selection]} {
+        set_variables_after_query
+        if { $n_pixels_in == 0 } {
+            set spacer_gif ""
+        } else {
+            set spacer_gif "<img src=\"/graphics/file-storage/spacer.gif\" width=$n_pixels_in height=1>"
+        }
+        if {$folder_p=="t"} {
+
+            append file_html "
+	<tr>
+	<td valign=top>&nbsp; $spacer_gif $font
+	 <a href=\"one-folder?[export_url_vars file_id group_id]&source=group\">
+	 <img border=0 src=/graphics/file-storage/ftv2folderopen.gif align=top></a>
+	 <a href=\"one-folder?[export_url_vars file_id group_id]&source=group\">
+	 $file_title</a></td>
+	<td align=right></td>
+	<td>&nbsp</td>
+	<td>$font &nbsp; File Folder &nbsp;</td>
+	<td>&nbsp;</td>
+	</tr>\n"    
+
+        } else {
+
+            append file_html "
+	<tr>
+	<td valign=top>&nbsp; $spacer_gif $font
+	 <a href=\"one-file?[export_url_vars file_id group_id]&source=group\">
+	 <img \n border=0 src=/graphics/file-storage/ftv2doc.gif align=top></a>
+	 <a href=\"one-file?[export_url_vars file_id group_id]&source=group\">
+	 $file_title</a>&nbsp;</td>
+	<td>$font <a href=/shared/community-member?[export_url_vars user_id]>$owner_name</a>&nbsp;</td>
+	<td align=right>$font &nbsp; $n_kbytes KB &nbsp;</td>
+	<td>$font &nbsp; $file_type &nbsp;</td>
+	<td>$font &nbsp; $creation_date &nbsp;</td>
+	</tr>\n"    
+        }
+        
+        incr file_count
+    }
+}
+if {$file_count!=0} {
+    append page_content "$file_html"
+} else {
+    append page_content "
+        <tr>
+        <td>&nbsp; No files available in this group. &nbsp;</td>
+        </tr>"
+}
+
+append page_content "<tr><td colspan=5 bgcolor=#bbbbbb align=right>"
+
+set group_count 0
+set group_query "
+    select user_groups.group_id as member_group_id, 
+           group_name
+    from   user_groups, user_group_map
+    where  user_id=$user_id
+    and    user_groups.group_id=user_group_map.group_id
+    and    user_groups.group_id <> $group_id
+    order by group_name"
+
+set selection [ns_db select $db $group_query]
+
+set group_id_list [list]
+set group_html ""
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append group_html "<option value=$member_group_id> 
+        $group_name group document tree</option>\n"
+    incr group_count
+    lappend group_id_list $member_group_id
+}
+
+
+# now, we want to get a list of folders containing files that the user can see
+# but are stored in a directory to which the user does not normally have access
+
+# first, get group folders
+
+if {[llength $group_id_list] > 0} {
+    set group_clause "and user_groups.group_id not in ([join $group_id_list ","])"
+} else {
+    set group_clause ""
+}
+
+set group_query "
+    select user_groups.group_id, 
+           group_name 
+    from   user_groups, 
+           fs_files,
+           fs_versions_latest ver
+    where  ver.file_id = fs_files.file_id
+    and    fs_files.group_id = user_groups.group_id
+    and    user_has_row_permission_p ( $user_id, 'read', ver.version_id, 'FS_VERSIONS' ) = 't'
+    and    not user_groups.group_id = $group_id
+    $group_clause
+    group by user_groups.group_id, group_name
+    order by group_name"
+
+set selection [ns_db select $db $group_query]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append group_html "<option value=\"[list private_group $group_id]\"> 
+        $group_name group document tree</option>\n"
+}
+
+
+# now, get personal folders
+
+set user_query "
+    select users.user_id as folder_user_id, 
+           first_names||' '||last_name as user_name
+    from   users,
+           fs_files,
+           fs_versions_latest ver
+    where  ver.file_id = fs_files.file_id
+    and    not fs_files.owner_id = $user_id
+    and    fs_files.owner_id = users.user_id
+    and    fs_files.group_id is null
+    and    folder_p = 'f'
+    and    user_has_row_permission_p ( $user_id, 'read', ver.version_id, 'FS_VERSIONS' ) = 't'
+    and    (fs_files.public_p <> 't' or fs_files.public_p is null)
+    group by users.user_id, first_names, last_name
+    order by user_name"
+
+set selection [ns_db select $db $user_query]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append group_html "<option value=\"[list user_id $folder_user_id]\"> 
+        $user_name's private document tree</option>\n"
+}
+
+
+
+set public_html ""
+if [ad_parameter PublicDocumentTreeP fs] {
+    set public_html "<option value=public_tree>
+        Shared [ad_system_name] document tree"
+}
+
+append page_content  "
+<form action=group>
+<nobr>$font Go to  
+
+<select name=group_id>
+
+<option value=\"private_group $current_group_id\">$current_group_name group document tree</option>
+$public_html
+$group_html
+<option value=\"all_public\">All publically accessible files</option>
+
+</select>
+
+<input type=submit value=go></td></tr> 
+
+</table></td></tr></table></blockquote>
+
+</form>
+
+This system lets you keep your files on [ad_parameter SystemName],
+access them from any computer connected to the internet, and
+collaborate with others on file creation and modification.
+
+[ad_footer [fs_system_owner]]"
+
+# release the database handle
+
+ns_db releasehandle $db 
+
+# serve the page
+
+ns_return 200 text/html $page_content 
+
Index: web/openacs/www/file-storage/private-one-person.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/private-one-person.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/private-one-person.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,301 @@
+# /file-storage/private-one-person.tcl
+#
+# by randyg@arsdigita.com January, 2000
+# 
+# list the private files of one user that the logged in user is allowed to view
+#
+# private-one-person.tcl,v 3.4.2.3 2000/03/31 16:11:17 carsten Exp
+
+ad_page_variables {owner_id}
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+if {$owner_id == $user_id} {
+    ns_returnredirect "personal"
+    return
+}
+
+set owner_name [database_to_tcl_string $db "
+    select first_names || ' ' || last_name 
+    from   users 
+    where  user_id = $owner_id"]
+
+set page_content  "[ad_header "Private files owned by $owner_name"]
+
+<h2>$owner_name's Files</h2>
+
+[ad_context_bar_ws [list "" [ad_parameter SystemName fs]] "One Person's Private Files"]
+
+<hr>
+
+<blockquote>"
+
+# get the user's files from the database and parse the output to 
+# reflect the folder stucture
+
+# walk the tree from all nodes with permissions up to the root.
+# we do this walk so that we can show all of the folders leading
+# up to the files that the user has permission to see
+
+
+# set backwards_tree_walk "
+# select file_id,	
+#        file_title,
+#        sort_key,
+#        depth,   
+#        folder_p,
+#        owner_id,
+#        deleted_p,
+#        group_id,
+#        public_p,
+#        parent_id,
+#        level as the_level
+# from   fs_files
+# connect by fs_files.file_id = prior parent_id
+# start with fs_files.file_id in (
+#     select distinct fs_files.file_id from fs_files, 
+#            fs_versions_latest ver
+#     where  (fs_files.public_p <> 't' or fs_files.public_p is null)
+#     and    fs_files.group_id is null
+#     and    fs_files.owner_id = $owner_id
+#     and    fs_files.deleted_p='f'            
+#     and    fs_files.file_id=ver.file_id
+#     and    user_has_row_permission_p ($user_id, 'read', ver.version_id, 'FS_VERSIONS') = 't')"
+
+
+# set sorted_query "
+#     select distinct desired_files.file_id, desired_files.sort_key,
+#            file_title, 
+#            folder_p, 
+#            depth * 24 as n_pixels_in, 
+#            to_char(fs_versions_latest.creation_date,'[fs_date_picture]') as creation_date,
+#            round(n_bytes/1024) as n_kbytes, 
+#            coalesce(file_type,upper(file_extension)||' File') as file_type
+#     from   ($backwards_tree_walk) desired_files, 
+#            fs_versions_latest
+#     where  fs_versions_latest.file_id = desired_files.file_id
+#     order by desired_files.sort_key"
+
+set start_node_sql "select distinct fs_files.file_id from fs_files, 
+           fs_versions_latest ver
+    where  (fs_files.public_p <> 't' or fs_files.public_p is null)
+    and    fs_files.group_id is null
+    and    fs_files.owner_id = $owner_id
+    and    fs_files.deleted_p='f'            
+    and    fs_files.file_id=ver.file_id
+    and    user_has_row_permission_p ($user_id, 'read', ver.version_id, 'FS_VERSIONS') = 't'"
+
+set sorted_query "
+    select distinct desired_files.file_id, desired_files.sort_key,
+           file_title, 
+           folder_p, 
+           depth * 24 as n_pixels_in, 
+           to_char(fs_versions_latest.creation_date,'[fs_date_picture]') as creation_date,
+           round(float8(n_bytes)/1024.0) as n_kbytes, 
+           coalesce(file_type,upper(file_extension)||' File') as file_type
+    from   fs_files desired_files, 
+           fs_versions_latest
+    where  fs_versions_latest.file_id = desired_files.file_id
+     and   fs_node_is_child(%s,desired.file_id) = 't'
+    order by desired_files.sort_key"
+
+set file_html ""
+set file_count 0
+
+with_transaction $db {
+
+    set start_node [database_to_tcl_string $db $start_node_sql]
+    set selection [ns_db select $db [format $sorted_query $start_node]]
+
+    set font "<nobr><font face=arial,helvetica size=-1>"
+    set header_color "#cccccc"
+
+    append page_content "
+<table border=1 bgcolor=white  cellpadding=0 cellspacing=0>
+<tr>
+<td><table bgcolor=white cellspacing=1 border=0 cellpadding=0>
+    <tr>
+    <td colspan=5 bgcolor=#666666>
+     $font &nbsp;<font color=white> $owner_name's private files</td>
+    </tr>
+    <tr>
+    <td bgcolor=$header_color>$font &nbsp; Name</td>
+    <td bgcolor=$header_color>$font &nbsp; Author &nbsp;</td>
+    <td bgcolor=$header_color align=right>$font &nbsp; Size &nbsp;</td>
+    <td bgcolor=$header_color>$font &nbsp; Type &nbsp;</td>
+    <td bgcolor=$header_color>$font &nbsp; Modified &nbsp;</td>
+    </tr>" 
+
+    while {[ns_db getrow $db $selection]} {
+        set_variables_after_query
+        if { $n_pixels_in == 0 } {
+            set spacer_gif ""
+        } else {
+            set spacer_gif "<img src=\"/graphics/file-storage/spacer.gif\" width=$n_pixels_in height=1>"
+        }
+
+        if { $folder_p == "t" } {
+
+            append file_html "
+	<tr>
+	<td>&nbsp; ${spacer_gif}$font
+	<a href=one-folder?[export_url_vars file_id owner_id]&source=private_individual>
+	<img align=top border=0 src=/graphics/file-storage/ftv2folderopen.gif></a>
+	<a href=one-folder?[export_url_vars file_id group_id owner_id]&source=private_individual>$file_title</a></td>
+	<td align=right></td>
+	<td>&nbsp;</td>
+	<td>$font &nbsp; File Folder &nbsp;</td>
+	<td>&nbsp;</td>
+	</tr>\n"    
+
+        } else {
+
+            append file_html "
+	<tr>
+	<td>&nbsp; ${spacer_gif}$font
+	<a href=one-file?[export_url_vars file_id owner_id]&source=private_individual>
+	<img align=top border=0 src=/graphics/file-storage/ftv2doc.gif></a>
+	<a href=one-file?[export_url_vars file_id owner_id]&source=private_individual>$file_title</a>&nbsp;</td>
+	<td>$font <a href=\"/shared/community-member?user_id=$owner_id\">$owner_name</a>&nbsp;</td>\
+	<td align=right>$font &nbsp; $n_kbytes KB &nbsp;</td>
+	<td>$font &nbsp; [fs_pretty_file_type $file_type] &nbsp;</td>
+	<td>$font &nbsp; $creation_date &nbsp;</td>
+	</tr>\n"    
+
+        }
+        
+        incr file_count
+    }
+}
+
+if { $file_count != 0 } {
+    append page_content $file_html
+} else {
+    append page_content "
+        <tr>
+        <td>&nbsp; No files available in this group. &nbsp;</td>
+        </tr>"
+}
+
+append page_content "
+</td></tr>
+<tr><td colspan=5 bgcolor=#bbbbbb align=right>"
+
+set group_count 0
+set group_query "
+    select group_id as member_group_id, 
+           group_name  
+    from   user_groups
+    where  ad_group_member_p ($user_id, group_id) = 't'
+    order by group_name"
+
+set selection [ns_db select $db $group_query]
+
+set group_id_list [list]
+set group_html ""
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append group_html "<option value=$member_group_id> 
+        $group_name group document tree</option>\n"
+    incr group_count
+    lappend group_id_list $member_group_id
+}
+
+
+# now, we want to get a list of folders containing files that the user can see
+# but are stored in a directory to which the user does not normally have access
+
+# first, get group folders
+
+if { [llength $group_id_list] > 0 } {
+    set group_clause "and user_groups.group_id not in ([join $group_id_list ","])"
+} else {
+    set group_clause ""
+}
+
+set group_query "
+    select user_groups.group_id, 
+           group_name 
+    from   user_groups, 
+           fs_files,
+           fs_versions_latest ver
+    where  ver.file_id = fs_files.file_id
+    and    fs_files.group_id = user_groups.group_id
+    $group_clause
+    and    user_has_row_permission_p ($user_id, 'read', ver.version_id, 'FS_VERSIONS') = 't'
+    group by user_groups.group_id, group_name
+    order by group_name"
+
+set selection [ns_db select $db $group_query]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append group_html "<option value=\"[list public_group $group_id]\"> 
+        $group_name group document tree</option>\n"
+}
+
+# now, get personal folders
+
+set group_query "
+    select users.user_id as folder_user_id, 
+           first_names||' '||last_name as user_name
+    from   users,
+           fs_files,
+           fs_versions_latest ver
+    where  ver.file_id = fs_files.file_id
+    and    not fs_files.owner_id = $user_id
+    and    fs_files.owner_id = users.user_id
+    and    fs_files.group_id is null
+    and    users.user_id <> $owner_id
+    and    folder_p = 'f'
+    and    (fs_files.public_p <> 't' or fs_files.public_p is null)
+    and    user_has_row_permission_p ($user_id, 'read', ver.version_id, 'FS_VERSIONS') = 't'
+    group by users.user_id, first_names, last_name
+    order by user_name"
+
+set selection [ns_db select $db $group_query]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append group_html "<option value=\"[list user_id $folder_user_id]\"> 
+        $user_name's private document tree</option>\n"
+}
+
+set public_html ""
+
+if [ad_parameter PublicDocumentTreeP fs] {
+    set public_html "<option value=public_tree>
+        [ad_system_name] shared document tree"
+}
+
+append page_content  "
+<form action=group>
+<nobr>$font Go to  
+<select name=group_id>
+
+<option value=\"user_id $owner_id\">$owner_name's private document tree</option>
+$public_html
+$group_html
+<option value=\"all_public\">All publically accessible files</option>
+
+</select>
+
+<input type=submit value=go>
+</td></tr></table></td></tr></table>
+
+</blockquote>
+
+[ad_footer [fs_system_owner]]"
+
+# release the database handle
+
+ns_db releasehandle $db 
+
+# serve the page
+
+ns_return 200 text/html $page_content 
+
Index: web/openacs/www/file-storage/public-one-group.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/public-one-group.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/public-one-group.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,220 @@
+# /file-storage/public-one-group.tcl
+#
+# by philg@mit.edu on July 24, 1999
+# 
+# show the public files owned by a group
+#
+# modified by randyg@arsdigita.com, January, 2000 to use the general 
+# permissions system
+#
+# public-one-group.tcl,v 3.4.2.1 2000/03/27 17:30:34 carsten Exp
+
+ad_page_variables {
+    {group_id ""}
+}
+
+set return_url "public-one-group?[ns_conn query]"
+
+set db [ns_db gethandle]
+
+set local_user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+if { ![info exists group_id] || [empty_string_p $group_id] } {
+    ad_return_complaint 1 "<li>Please choose a group" 
+    return
+}
+
+set group_name [database_to_tcl_string $db "
+    select group_name from user_groups where group_id=$group_id"]
+
+set title "$group_name's public files"
+
+set page_content  "[ad_header $title]
+
+<h2> $title </h2>
+
+[ad_context_bar_ws [list "" [ad_parameter SystemName fs]]\
+	           [list "all-public" "Publically accessible files"]\
+		   "One Group"]
+
+<hr>
+
+<blockquote>"
+
+# get the user's files from the database and parse the 
+# output to reflect the folder stucture
+
+
+# walk the tree from all nodes with permissions up to the root.
+# we do this walk so that we can show all of the folders leading
+# up to the files that the user has permission to see
+
+
+# set backwards_tree_walk "
+# select file_id,	
+#        file_title,
+#        sort_key,
+#        depth,   
+#        folder_p,
+#        owner_id,
+#        deleted_p,
+#        group_id,
+#        public_p,
+#        parent_id,
+#        level as the_level
+# from   fs_files
+# connect by fs_files.file_id = prior parent_id
+# start with fs_files.file_id in (
+#     select distinct fs_files.file_id 
+#     from   fs_files, 
+#            fs_versions_latest ver
+#     where  fs_files.public_p = 'f'
+#     and    fs_files.group_id = $group_id
+#     and    folder_p = 'f'
+#     and    fs_files.deleted_p='f'            
+#     and    fs_files.file_id=ver.file_id
+#     and    user_has_row_permission_p ($local_user_id, 'read', ver.version_id, 'FS_VERSIONS') = 't')"
+
+
+# set sorted_query "
+#     select distinct desired_files.file_id, 
+#            desired_files.sort_key,
+#            file_title, 
+#            folder_p, 
+#            depth * 24 as n_pixels_in, 
+#            to_char(fs_versions_latest.creation_date,'[fs_date_picture]') as creation_date,
+#            round(n_bytes/1024) as n_kbytes, 
+#            coalesce(file_type,upper(file_extension)||' File') as file_type,
+#            first_names||' '||last_name as owner_name
+#     from   ($backwards_tree_walk) desired_files, 
+#            fs_versions_latest,
+#            users
+#     where  fs_versions_latest.file_id = desired_files.file_id
+#     and    desired_files.owner_id = users.user_id
+#     order by desired_files.sort_key"
+
+set sorted_query "
+    select distinct desired_files.file_id, 
+           desired_files.sort_key,
+           file_title, 
+           folder_p, 
+           depth * 24 as n_pixels_in, 
+           to_char(fs_versions_latest.creation_date,'[fs_date_picture]') as creation_date,
+           round(float8(n_bytes)/1024.0) as n_kbytes, 
+           coalesce(file_type,upper(file_extension)||' File') as file_type,
+           first_names||' '||last_name as owner_name
+    from   ($backwards_tree_walk) desired_files, 
+           fs_versions_latest,
+           users
+    where  fs_versions_latest.file_id = desired_files.file_id
+    and    fs_node_is_child(%s,desired.file_id) = 't'
+    and    desired_files.owner_id = users.user_id
+    order by desired_files.sort_key"
+
+set start_node_sql "
+select distinct fs_files.file_id 
+    from   fs_files, 
+           fs_versions_latest ver
+    where  fs_files.public_p = 'f'
+    and    fs_files.group_id = $group_id
+    and    folder_p = 'f'
+    and    fs_files.deleted_p='f'            
+    and    fs_files.file_id=ver.file_id
+    and    user_has_row_permission_p ($local_user_id, 'read', ver.version_id, 'FS_VERSIONS') = 't'"
+
+set file_html ""
+set file_count 0
+
+with_transaction $db {
+
+    set start_node [database_to_tcl_string $db $start_node_sql]
+    set selection [ns_db select $db $sorted_query]
+
+    set font "<nobr>[ad_parameter FileInfoDisplayFontTag fs]"
+    set header_color [ad_parameter HeaderColor fs]
+
+    append page_content "
+<table border=1 bgcolor=white  cellpadding=0 cellspacing=0>
+<tr>
+<td><table bgcolor=white cellspacing=1 border=0 cellpadding=0>
+    <tr>
+    <td colspan=5 bgcolor=#666666> $font &nbsp;<font color=white> 
+     $group_name's files</td>
+    </tr>
+    <tr>
+    <td bgcolor=$header_color>$font &nbsp; Name</td>
+    <td bgcolor=$header_color>$font &nbsp; Author &nbsp;</td>
+    <td bgcolor=$header_color align=right>$font &nbsp; Size &nbsp;</td>
+    <td bgcolor=$header_color>$font &nbsp; Type &nbsp;</td>
+    <td bgcolor=$header_color>$font &nbsp; Modified &nbsp;</td>
+    </tr>" 
+
+    while {[ns_db getrow $db $selection]} {
+        set_variables_after_query
+
+        if { $n_pixels_in == 0 } {
+            set spacer_gif ""
+        } else {
+            set spacer_gif "<img src=\"/graphics/file-storage/spacer.gif\" width=$n_pixels_in height=1>"
+        }
+
+        if {$folder_p=="t"} {
+
+            append file_html "
+	<tr>
+	<td valign=top>&nbsp; ${spacer_gif}$font
+	<a href=\"one-folder?[export_url_vars file_id group_id]&source=public_group\">
+	<img border=0 src=/graphics/file-storage/ftv2folderopen.gif align=top></a>
+	<a href=\"one-folder?[export_url_vars file_id group_id]&source=public_group\">$file_title</a></td>
+	<td align=right></td>
+	<td>&nbsp;</td>
+	<td>$font &nbsp; File Folder &nbsp;</td>
+	<td>&nbsp;</td>
+	</tr>\n"    
+
+        } else {
+
+            append file_html "
+	<tr>
+	<td valign=top>&nbsp; ${spacer_gif}$font
+	<a href=\"one-file?[export_url_vars file_id group_id]&source=public_group\">
+	<img \n border=0 src=/graphics/file-storage/ftv2doc.gif align=top></a>
+	<a href=\"one-file?[export_url_vars file_id group_id]&source=public_group\">$file_title</a>&nbsp;</td>
+	<td>$font <a href=/shared/community-member?[export_url_vars user_id]>$owner_name</a>&nbsp;</td>
+	<td align=right>$font &nbsp; $n_kbytes KB &nbsp;</td>
+	<td>$font &nbsp; $file_type &nbsp;</td>
+	<td>$font &nbsp; $creation_date &nbsp;</td>
+	</tr>\n"    
+
+        }
+        
+        incr file_count
+    }
+}
+
+if {$file_count!=0} {
+    append page_content $file_html
+} else {
+    append page_content "
+        <tr>
+        <td>&nbsp; No files available in this group. &nbsp;</td>
+        </tr>"
+}
+
+append page_content "
+</td></tr></table></td></tr></table></blockquote>
+
+</form>
+
+[ad_footer [fs_system_owner]]"
+
+# release the database handle
+
+ns_db releasehandle $db 
+
+# serve the page
+
+ns_return 200 text/html $page_content 
+
Index: web/openacs/www/file-storage/public-one-person.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/public-one-person.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/public-one-person.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,203 @@
+# /file-storage/public-one-person.tcl
+#
+# by philg@mit.edu July 24, 1999
+# 
+# list the public files of one user
+#
+# modified by randyg@arsdigita.com January, 2000 to use the
+# general permissions module
+#
+# public-one-person.tcl,v 3.3 2000/03/12 07:37:43 aure Exp
+
+ad_page_variables {owner_id}
+
+set user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+set owner_name [database_to_tcl_string $db "
+    select first_names || ' ' || last_name from users where user_id = $owner_id"]
+
+set page_content  "[ad_header "Public files owned by $owner_name"]
+
+<h2>$owner_name's Files</h2>
+
+[ad_context_bar_ws [list "" [ad_parameter SystemName fs]] \
+	           [list "all-public" "Publically accessible files"]\
+		   "One Person's"]
+
+<hr>
+
+<blockquote>"
+
+# get the user's files from the database and parse the output 
+# to reflect the folder stucture
+
+# walk the tree from all nodes with permissions up to the root.
+# we do this walk so that we can show all of the folders leading
+# up to the files that the user has permission to see
+
+
+# set backwards_tree_walk "
+# select file_id,	
+#        file_title,
+#        sort_key,
+#        depth,   
+#        folder_p,
+#        owner_id,
+#        deleted_p,
+#        group_id,
+#        public_p,
+#        parent_id,
+#        level as the_level
+# from   fs_files
+# connect by fs_files.file_id = prior parent_id
+# start with fs_files.file_id in (
+#     select distinct fs_files.file_id 
+#     from   fs_files, 
+#            fs_versions_latest ver
+#     where  owner_id = $owner_id
+#     and    folder_p = 'f'
+#     and    fs_files.file_id=ver.file_id
+#     and    (fs_files.public_p = 'f' or fs_files.public_p is null)
+#     and    fs_files.group_id is null
+#     and    (user_has_row_permission_p ($user_id, 'read', ver.version_id, 'FS_VERSIONS') = 't'
+#     and    fs_files.deleted_p='f'))"
+
+
+# set sorted_query "
+# select   distinct desired_files.file_id, 
+#          desired_files.sort_key,
+#          file_title, 
+#          folder_p, 
+#          depth * 24 as n_pixels_in, 
+#          to_char(fs_versions_latest.creation_date,'[fs_date_picture]') as creation_date,
+#          round(n_bytes/1024) as n_kbytes, 
+#          coalesce(file_type,upper(file_extension)||' File') as file_type
+# from     ($backwards_tree_walk) desired_files, 
+#          fs_versions_latest
+# where    fs_versions_latest.file_id = desired_files.file_id
+# order by desired_files.sort_key, desired_files.file_title"
+
+
+set sorted_query "
+select   distinct desired_files.file_id, 
+         desired_files.sort_key,
+         file_title, 
+         folder_p, 
+         depth * 24 as n_pixels_in, 
+         to_char(fs_versions_latest.creation_date,'[fs_date_picture]') as creation_date,
+         round(float8(n_bytes)/1024.0) as n_kbytes, 
+         coalesce(file_type,upper(file_extension)||' File') as file_type
+from     fs_files desired_files, 
+         fs_versions_latest
+where    fs_versions_latest.file_id = desired_files.file_id
+and      fs_node_is_child(%s,desired.file_id) = 't'
+order by desired_files.sort_key, desired_files.file_title"
+
+set start_node_sql "
+    select distinct fs_files.file_id 
+    from   fs_files, 
+           fs_versions_latest ver
+    where  owner_id = $owner_id
+    and    folder_p = 'f'
+    and    fs_files.file_id=ver.file_id
+    and    (fs_files.public_p = 'f' or fs_files.public_p is null)
+    and    fs_files.group_id is null
+    and    (user_has_row_permission_p ($user_id, 'read', ver.version_id, 'FS_VERSIONS') = 't'
+    and    fs_files.deleted_p='f')"
+
+set file_html ""
+set file_count 0
+
+with_transaction $db {
+
+    set start_node [database_to_tcl_string $db $start_node_sql]
+    set selection [ns_db select $db $sorted_query]
+
+    set font "<nobr><font face=arial,helvetica size=-1>"
+    set header_color "#cccccc"
+
+    append page_content "
+<table border=1 bgcolor=white  cellpadding=0 cellspacing=0>
+<tr>
+<td><table bgcolor=white cellspacing=1 border=0 cellpadding=0>
+    <tr>
+    <td colspan=5 bgcolor=#666666>$font &nbsp;<font color=white> $owner_name's public files</td>
+    </tr>
+    <tr>
+    <td bgcolor=$header_color>$font &nbsp; Name</td>
+    <td bgcolor=$header_color align=right>$font &nbsp; Size &nbsp;</td>
+    <td bgcolor=$header_color>$font &nbsp; Type &nbsp;</td>
+    <td bgcolor=$header_color>$font &nbsp; Modified &nbsp;</td>
+    </tr>" 
+
+    if [empty_string_p $selection] {
+        ns_returnredirect ""
+        return
+    }
+
+    while {[ns_db getrow $db $selection]} {
+        set_variables_after_query
+        if { $n_pixels_in == 0 } {
+            set spacer_gif ""
+        } else {
+            set spacer_gif "<img src=\"/graphics/file-storage/spacer.gif\" width=$n_pixels_in height=1>"
+        }
+
+        if {$folder_p=="t"} {
+
+            append file_html "
+	<tr>
+	<td valign=top>&nbsp; ${spacer_gif}$font
+	<a href=one-folder?[export_url_vars file_id owner_id]&source=public_individual>
+	<img border=0 src=/graphics/file-storage/ftv2folderopen.gif align=top></a>
+	<a href=one-folder?[export_url_vars file_id group_id owner_id]&source=public_individual>$file_title</a></td>
+	<td>&nbsp;</td>
+	<td>$font &nbsp; File Folder &nbsp;</td>
+	<td>&nbsp;</td>
+	</tr>\n"    
+
+        } else {
+
+            append file_html "
+	<tr>
+	<td valign=top>&nbsp; ${spacer_gif}$font
+	<a href=one-file?[export_url_vars file_id owner_id]&source=public_individual>
+	<img \n border=0 src=/graphics/file-storage/ftv2doc.gif align=top></a>
+	<a href=one-file?[export_url_vars file_id owner_id]&source=public_individual>$file_title</a>&nbsp;</td>
+	<td align=right>$font &nbsp; $n_kbytes KB &nbsp;</td>
+	<td>$font &nbsp; [fs_pretty_file_type $file_type] &nbsp;</td>
+	<td>$font &nbsp; $creation_date &nbsp;</td>
+	</tr>\n"    
+
+        }
+        
+        incr file_count
+    }
+}
+
+if { $file_count != 0 } {
+    append page_content $file_html
+} else {
+    append page_content "
+        <tr>
+        <td>&nbsp; No files available in this group. &nbsp;</td>
+        </tr>"
+}
+
+append page_content "
+</td></tr></table></td></tr></table></blockquote>
+
+[ad_footer [fs_system_owner]]"
+
+# release the database handle
+
+ns_db releasehandle $db 
+
+# serve the page
+
+ns_return 200 text/html $page_content 
+
Index: web/openacs/www/file-storage/search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/search.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,180 @@
+# /file-storage/search.tcl
+# 
+# by aure@arsdigita.com, July 1999
+#
+# looks through file names, version descriptions, client file names
+# case-insensitive but stupid
+#
+# modified by randyg@arsdigita.com to use the general permissions system
+#
+# search.tcl,v 3.2.2.1 2000/04/03 16:38:15 carsten Exp
+
+ad_page_variables {
+    {search_text "" qq}
+    {return_url}
+    {group_id ""}
+}
+
+set db [ns_db gethandle]
+
+set user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+set title "Search for \"$search_text\""
+
+set page_content "[ad_header $title]
+<h2>$title</h2>
+[ad_context_bar_ws [list $return_url [ad_parameter SystemName fs]] $title]
+<hr>
+<blockquote>\n"
+
+# Parameterize for interMedia 
+# DanW - Not converted for pg, because we don't have support for intermedia
+if { [ad_parameter UseIntermediaP fs 0] } {
+    set score_column "score(1) as the_score,"
+    set intermedia_clause " or contains(version_content, '$QQsearch_text', 1) > 0"
+    set order_clause "order by (case when owner_id = user_id then 0 else 1 end), 1 desc"
+    set search_explanation "We do a case-insensitive phrase search through
+file titles, client filenames (what these files were called on the
+original system), and any version descriptions or comments.
+
+<p>
+
+In addition, we do a full-text search through the bodies of all
+uploaded documents.
+
+<p>
+
+[ad_intermedia_text_searching_hints]
+" } else {
+    set score_column ""
+    set intermedia_clause ""
+    set order_clause "order by (case when owner_id = $user_id then 0 else 1 end), file_title"
+    set search_explanation "We do a case-insensitive phrase search through
+file titles, client filenames (what these files were called on the
+original system), and any version descriptions or comments."
+}
+
+# this select gets readable files that match user's request 
+# (one's belonging to the user first)
+
+# the ways a user can see a file
+# 1. the user is the owner (f.owner_id = $user_id)
+# 2. the public is allowed to read the file (public_read_p = 't')
+# 3. there is a permissions record to allow someone to read (pum.read_p = 't')
+#    4. and that somone is the user (map.user_id = $user_id)
+#    5. and that somone if a group that the user belongs to
+
+set sql_query "
+select distinct file_title, $score_column 
+       f.file_id, 
+       round(float8(n_bytes)/1024.0) as n_kbytes, 
+       file_type, 
+       to_char(v.creation_date,'[fs_date_picture]') as creation_date,
+       (case when owner_id = $user_id then 0 else 1 end) as belongs_to_someone_else_p, 
+       owner_id, folder_p
+from   fs_files f, fs_versions v
+where  f.file_id = v.file_id
+and    v.superseded_by_id is null
+and    user_has_row_permission_p ($user_id, 'read', v.version_id, 'FS_VERSIONS') = 't'
+and deleted_p='f'
+and (upper(version_description) like upper('%$QQsearch_text%')
+     or upper(file_title) like upper('%$QQsearch_text%')
+     or upper(client_file_name) like upper('%$QQsearch_text%')
+     $intermedia_clause)
+group by file_title, f.file_id, n_bytes, file_type, v.creation_date, owner_id, folder_p
+$order_clause"
+
+set selection [ns_db select $db $sql_query]
+
+set file_count 0
+set file_html ""
+
+set font "<nobr>[ad_parameter FileInfoDisplayFontTag fs]"
+set header_color [ad_parameter HeaderColor fs]
+
+# we start with an outer table to get little white lines in 
+# between the elements 
+
+set wrote_personal_header_p 0
+set wrote_other_header_p 0
+
+append page_content "<table border=1 bgcolor=white  cellpadding=0 cellspacing=0>
+<tr>
+  <td>
+  <table bgcolor=white cellspacing=1 border=0 cellpadding=0>
+" 
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    if { $belongs_to_someone_else_p == 0 && !$wrote_personal_header_p } {
+	set wrote_personal_header_p 1
+	append file_html "
+          <tr><td colspan=4 bgcolor=#666666>
+              $font &nbsp;<font color=white> Personal files matching \"$search_text\"
+              </td>
+          </tr>\n"
+	append file_html [fs_header_row_for_files]
+    }
+    if { $belongs_to_someone_else_p == 1 && !$wrote_other_header_p } {
+	set wrote_other_header_p 1
+	append file_html "
+          <tr><td colspan=4 bgcolor=#666666>
+              $font &nbsp;<font color=white> Other readable files matching \"$search_text\"
+              </td>
+          </tr>\n"
+	append file_html [fs_header_row_for_files]
+    }
+
+    if { $folder_p == "t" } {
+	set file_url "one-folder?[export_url_vars file_id group_id]"
+	set image "ftv2folderclosed.gif"
+    } else {
+	set file_url "one-file?[export_url_vars file_id group_id]"
+	set image "ftv2doc.gif"
+    }
+
+    append file_html "
+    <tr>
+    <td valign=top>&nbsp; $font
+    <a href=\"$file_url\">
+    <img border=0 src=/graphics/file-storage/$image align=top></a>
+    <a href=\"$file_url\">$file_title</a>&nbsp;</td>
+    <td align=right>"
+
+    if { $folder_p == "f" } { append file_html "$font &nbsp; $n_kbytes KB &nbsp;" }
+
+    append file_html "
+    </td><td>$font &nbsp; [fs_pretty_file_type $file_type] &nbsp;</td>
+    <td>$font &nbsp; $creation_date &nbsp;</td>
+    </tr>\n"    
+     
+    incr file_count
+}
+
+if {$file_count!=0} {
+    append page_content "$file_html"
+} else {
+    append page_content "<tr><td>No files matched your search. </td></tr>"
+}
+append page_content "
+</table></td></tr></table></blockquote>
+
+<p>
+
+<blockquote>
+$search_explanation
+</blockquote>
+
+[ad_footer [fs_system_owner]]"
+
+# release the database handle
+
+ns_db releasehandle $db
+
+# serve the page
+
+ns_return 200 text/html $page_content
+
Index: web/openacs/www/file-storage/upload-new-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/upload-new-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/upload-new-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,316 @@
+# /file-storage/upload-new-2.tcl
+# 
+# by aure@arsdigita.com, July 1999
+#
+# insert both a file and a version into the database
+#
+#
+# ADDED 8/20: the ability to upload a url. We take either
+# a url or a file, but not both. We look for an URL first.
+#
+# modified by randyg@arsdigita.com, January 2000 
+# to use the general permissions system
+#
+# files, urls and folders all have at least one record in fs_vesion so that the
+# permissions will work properly.  In addition, this leaves itself open to the
+# options of placing permissions on the folders
+# 
+# upload-new-2.tcl,v 3.5.2.2 2000/03/23 16:04:43 michael Exp
+
+ad_page_variables {
+    {file_id}
+    {file_title}
+    {group_id ""}
+    {parent_id}
+    {public_p "f"}
+    {return_url}
+    {upload_file}
+    {url}
+    {version_id}
+    {version_description "" qq}
+}
+
+
+set db [ns_db gethandle]
+
+set user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+# check the user input first
+
+set exception_text ""
+set exception_count 0
+
+if [empty_string_p $file_title] {
+    append exception_text "<li>You must give a title\n"
+    incr exception_count
+}
+
+if {[empty_string_p $url] && (![info exists upload_file] || [empty_string_p $upload_file])} {
+    append exception_text "<li>You need to upload a file or enter a URL\n"
+    incr exception_count
+}
+
+if {[info exists url] && ![empty_string_p $url] && [info exists upload_file] && ![empty_string_p $upload_file]} {
+    append exception_text "<li>You can not both add a url and upload a file"
+    incr exception_count
+}
+
+if {$public_p == "t" && ![ad_parameter PublicDocumentTreeP fs]} {
+    append exception_text "<li> [ad_system_name] does not support a public directory tree. \n"
+    incr exception_count
+} 
+
+if ![empty_string_p $group_id] {
+    if { ![ad_user_group_member $db $group_id $user_id] } {
+	append exception_text "<li>You are not a member of this group.\n"
+	incr exception_count
+    }
+} else {
+    set group_id ""
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+
+if {[string compare $public_p t] == 0} {
+    set public_read_p t
+    set public_write_p t
+    set public_comment_p t
+} else {
+    set public_read_p f
+    set public_write_p f
+    set public_comment_p f
+}
+
+
+
+if [empty_string_p $url] {
+
+    # get the file from the user.
+    # number_of_bytes is the upper-limit
+    set max_n_bytes [ad_parameter MaxNumberOfBytes fs]
+
+    set tmp_filename [ns_queryget upload_file.tmpfile]
+
+    if { ![empty_string_p $max_n_bytes] && ([file size $tmp_filename] > $max_n_bytes) } {
+	ad_return_complaint 1 "Your file is larger than the maximum permissible upload size:  [util_commify_number $max_n_bytes] bytes"
+	return 0
+    }
+
+    set file_extension [string tolower [file extension $upload_file]]
+    # remove the first . from the file extension
+    regsub "\." $file_extension "" file_extension
+
+    set guessed_file_type [ns_guesstype $upload_file]
+
+    set n_bytes [file size $tmp_filename]
+
+    # strip off the C:\directories... crud and just get the file name
+    if ![regexp {([^//\\]+)$} $upload_file match client_filename] {
+        # couldn't find a match
+        set client_filename $upload_file
+    }
+
+    ns_db dml $db "begin transaction"
+
+    set lob_id [database_to_tcl_string $db "select empty_lob()"]
+
+    set file_insert "
+    insert into fs_files (
+        file_id, 
+        file_title, 
+        owner_id, 
+        parent_id, 
+        sort_key, 
+        depth, 
+        group_id, 
+        public_p)
+    values (
+        $file_id, 
+        '[DoubleApos $file_title]', 
+        $user_id, 
+        [ns_dbquotevalue $parent_id],
+        0,
+        0, 
+        '[DoubleApos $group_id]', 
+        '$public_p')"
+
+    set version_insert "
+    insert into fs_versions (
+        version_id, 
+        file_id, 
+        version_description, 
+        creation_date, 
+        author_id, 
+        client_file_name, 
+        file_type, 
+        file_extension, 
+        n_bytes, 
+        lob)
+    values (
+        $version_id, 
+        $file_id, 
+        '$QQversion_description', 
+        sysdate(), 
+        $user_id, 
+        '[DoubleApos $client_filename]', 
+        '$guessed_file_type', 
+        '$file_extension', 
+        $n_bytes, 
+        $lob_id)" 
+
+
+    if {[catch { ns_db dml $db $file_insert } errmsg] } {
+
+        # insert failed; let's see if it was because of duplicate submission
+
+        if { [database_to_tcl_string $db "select count(*) from fs_files where file_id = $file_id"] == 0 } {
+
+	    ns_log Error "/file-storage/create-folder-2.tcl choked:  $errmsg"
+
+	    ad_return_error "Insert Failed" "The Database did not like what 
+	        you typed.  This is probably a bug in our code.  Here's what 
+	        the database said:
+	        <blockquote>
+	        <pre>$errmsg</pre>
+	        </blockquote>"
+
+            return
+        }
+
+        ns_db dml $db "abort transaction"
+
+        # we don't bother to handle the cases where there is a dupe 
+        # submission because the user should be thanked or 
+        # redirected anyway
+
+	# return/redirect Netscape users, but give MSIE users a redirecting page
+
+	if [regexp "MSIE" [ns_set get [ns_conn headers] User-Agent]] {
+	    ns_return 200 text/html "<meta http-equiv=\"refresh\" content=\"0; URL=$return_url\">"
+	} else {
+	    ns_returnredirect $return_url
+	}
+    }
+
+    # don't need double-click protection here since we already did 
+    # that for previous statement
+
+    ns_db dml $db $version_insert
+
+    ns_pg blob_dml_file $db $lob_id $tmp_filename
+
+    # now that the version has been inserted, let's set up the permissions
+
+    if { [string compare $public_p t] == 0 } {
+        
+        ns_db select $db "select grant_permission_to_all_users('read', $version_id, 'FS_VERSIONS')"
+        ns_db select $db "select grant_permission_to_all_users('write', $version_id, 'FS_VERSIONS')"
+        ns_db select $db "select grant_permission_to_all_users('comment', $version_id, 'FS_VERSIONS')"       
+    }
+
+    
+    ns_db select $db "select grant_permission_to_user($user_id, 'read', $version_id, 'FS_VERSIONS')"
+    ns_db select $db "select grant_permission_to_user($user_id, 'write', $version_id, 'FS_VERSIONS')"
+    ns_db select $db "select grant_permission_to_user($user_id, 'comment', $version_id, 'FS_VERSIONS')"
+    ns_db select $db "select grant_permission_to_user($user_id, 'administer', $version_id, 'FS_VERSIONS')"
+
+    fs_order_files $db
+   
+    ns_db dml $db "end transaction"
+
+    set return_url "/file-storage/$return_url"
+    set object_name "$file_title"
+    set on_what_id $version_id
+    set on_which_table FS_VERSIONS
+    set return_url "/gp/administer-permissions?[export_url_vars return_url object_name on_what_id on_which_table]"
+
+    if [regexp "MSIE" [ns_set get [ns_conn headers] User-Agent]] {
+	ReturnHeaders
+	ns_write "<meta http-equiv=\"refresh\" content=\"0; URL=$return_url\">"
+    } else {
+	ns_returnredirect $return_url
+    }
+
+} else {
+
+    set file_insert "
+    insert into fs_files (
+        file_id, 
+        file_title, 
+        owner_id, 
+        parent_id, 
+        sort_key, 
+        depth, 
+        group_id, 
+        public_p)
+    values (
+        $file_id, 
+        '[DoubleApos $file_title]',
+        $user_id, 
+        [ns_dbquotevalue $parent_id],
+        0,
+        0, 
+        '[DoubleApos $group_id]', 
+        '$public_p')"
+
+    set version_insert "
+    insert into fs_versions
+    (version_id, file_id, version_description, creation_date, author_id, url)
+    values
+    ($version_id, $file_id, '$QQversion_description', sysdate(), $user_id, '$QQurl')"
+
+
+    if {[catch { ns_db dml $db "begin transaction"
+	         ns_db dml $db $file_insert 
+                 ns_db dml $db $version_insert} errmsg] } {
+        # insert failed; let's see if it was because of duplicate submission
+        if { [database_to_tcl_string $db "select count(*) from fs_files where file_id = $file_id"] == 0 } {
+	    ns_log Error "/file-storage/create-folder-2.tcl choked:  $errmsg"
+	    ad_return_error "Insert Failed" "The Database did not like what you 
+	        typed.  This is probably a bug in our code.  Here's what the 
+	        database said:
+	        <blockquote>
+	        <pre>$errmsg</pre>
+	        </blockquote>"
+
+            ns_db dml $db "abort transaction"
+            return
+        }
+    }
+
+    # now that the version has been inserted, let's set up the permissions
+    if { [string compare $public_p t] == 0 } {
+
+        ns_db select $db "select grant_permission_to_all_users('read', $version_id, 'FS_VERSIONS')"
+        ns_db select $db "select grant_permission_to_all_users('write', $version_id, 'FS_VERSIONS')"
+        ns_db select $db "select grant_permission_to_all_users('comment', $version_id, 'FS_VERSIONS')"
+    }
+
+    ns_db select $db "select grant_permission_to_user($user_id, 'read', $version_id, 'FS_VERSIONS')"
+    ns_db select $db "select grant_permission_to_user($user_id, 'write', $version_id, 'FS_VERSIONS')"
+    ns_db select $db "select grant_permission_to_user($user_id, 'comment', $version_id, 'FS_VERSIONS')"
+    ns_db select $db "select grant_permission_to_user($user_id, 'administer', $version_id, 'FS_VERSIONS')"
+
+    fs_order_files $db
+
+    ns_db dml $db "end transaction"
+
+    set return_url "/file-storage/$return_url"
+    set object_name "$file_title"
+    set on_what_id $version_id
+    set on_which_table FS_VERSIONS
+    set return_url "/gp/administer-permissions?[export_url_vars return_url object_name on_what_id on_which_table]"
+
+    if [regexp "MSIE" [ns_set get [ns_conn headers] User-Agent]] {
+	ns_return 200 text/html "<meta http-equiv=\"refresh\" content=\"0; URL=$return_url\">"
+    } else {
+	ns_returnredirect $return_url
+    }
+}
+
Index: web/openacs/www/file-storage/upload-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/upload-new.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/upload-new.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,168 @@
+# /file-storage/upload-new.tcl
+# 
+# by aure@arsdigita.com, July 1999
+#
+# serve the user a form to upload a new file or URL
+# 
+# modified by randyg@arsdigita.com, January 2000 to use the general permisisons system
+#
+# upload-new.tcl,v 3.2.2.1 2000/03/31 15:18:09 carsten Exp
+
+ad_page_variables {
+    {return_url}
+    {group_id ""}
+    {public_p ""}
+    {current_folder ""}
+}
+
+set db [ns_db gethandle]
+
+set user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+set title "Upload New File/URL"
+
+# Determine if we are uploading to a Group, the public area, or personal area
+
+# if public_p = 't', we are uploading to the public area
+# if  a group_id was sent - then we are uploading to a group defined
+#           by group_id
+# otherwise, to our personal area
+
+set exception_text ""
+set exception_count 0
+
+if {$public_p == "t" && ![ad_parameter PublicDocumentTreeP fs]} {
+    incr exception_count
+    append exception_text "
+        [ad_system_name] does not support a public directory tree."
+}
+
+if { ![empty_string_p $group_id]} {
+
+    set group_name [database_to_tcl_string $db "
+	select group_name 
+	from   user_groups 
+	where  group_id = $group_id"]
+
+    # we are in the group tree
+
+    if { ![ad_user_group_member $db $group_id $user_id] } {
+
+	append exception_text "
+	    <li>You are not a member of group <cite>$group_name</cite>\n"
+
+	incr exception_count
+
+    } else {
+
+	set navbar [ad_context_bar_ws \
+		[list "" [ad_parameter SystemName fs]] \
+		[list $return_url "$group_name document tree"] \
+		$title]
+
+    }
+
+    set public_p "f"
+
+} elseif { $public_p == "t" } {
+ 
+    # we are in the public tree
+
+    set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]] $title]
+    set group_id ""
+
+} else  {
+
+    # we are in the personal tree
+
+    set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]]\
+	                          [list "personal" "Personal document tree"]\
+				  $title]
+    set group_id ""
+    set public_p "f"
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+# get the next sequence values for double click protection
+
+set file_id    [database_to_tcl_string $db "
+    select fs_file_id_seq.nextval from dual"]
+set version_id [database_to_tcl_string $db "
+    select fs_version_id_seq.nextval from dual"]
+
+set page_content "
+[ad_header $title]
+
+<h2>$title</h2>
+
+$navbar
+
+<hr>
+
+<form enctype=multipart/form-data method=POST action=upload-new-2>
+
+[export_form_vars file_id version_id return_url group_id public_p]
+
+<table border=0>
+<tr>
+<td align=right>URL: </td>
+<td><input type=input name=url size=40></td>
+</tr>
+
+<tr>
+<td align=right><EM>or</EM> filename: </td>
+<td><input type=file name=upload_file size=20></td>
+</tr>
+
+<tr>
+<td>&nbsp;</td>
+<td><font size=-1>Use the \"Browse...\" button to locate your file, 
+    then click \"Open\". </font></td>
+</tr>
+
+<tr>
+<td>&nbsp;</td>
+<td>&nbsp;</td>
+</tr>
+
+<tr>
+<td align=right> Title: </td>
+<td><input size=30 name=file_title></td>
+</tr>
+
+<tr>
+<td valign=top align=right> Description: </td>
+<td colspan=2><textarea rows=5 cols=50 name=version_description wrap></textarea></td>
+</tr>
+
+<tr>
+<td align=right>Location:</td>
+<td>[fs_folder_def_selection $db $user_id $group_id $public_p "" $current_folder]</td>
+</tr>
+
+<tr>
+<td></td>
+<td><input type=submit value=\"Submit and Upload\">
+</td>
+</tr>
+
+</table>
+
+</form>
+
+[ad_footer [fs_system_owner]]"
+
+# release the database handle
+
+ns_db releasehandle $db 
+
+# serve the page
+
+ns_return 200 text/html $page_content
+
Index: web/openacs/www/file-storage/upload-version-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/Attic/upload-version-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/upload-version-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,208 @@
+# upload-version-2.tcl,v 1.6.2.2 2000/02/03 09:50:56 ron Exp
+#
+# /file-storage/upload-version-2.tcl
+#
+# by aure@arsdigita.com mid-1999
+#
+# extended in January 2000 by randyg@arsdigita.com
+# to accomodate general permission system
+#
+
+set_the_usual_form_variables
+
+# upload_file, file_id, return_url, maybe group_id (lots of things)
+
+set user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+
+# check the user input first
+
+set exception_text ""
+set exception_count 0
+
+if {(![info exists file_id])||([empty_string_p $file_id])} {
+    incr exception_count
+    append exception_text "<li>No file was specified"
+}
+
+set selection [ns_db 1row $db "select version_id as old_version_id, 
+          public_read_p, 
+          public_write_p, 
+          public_comment_p 
+     from fs_versions_latest, 
+          general_permissions 
+    where file_id = $file_id 
+      and general_permissions.on_what_id = version_id 
+      and on_which_table='FS_VERSIONS'"]
+
+set_variables_after_query
+
+if {![info exists group_id]} {
+    set group_id ""
+}
+
+if {! [fs_check_write_p $db $user_id $old_version_id $group_id]} {
+    incr exception_count
+    append exception_text "<li>You can't write into this file"
+}
+
+if { ![info exists upload_file] || [empty_string_p $upload_file] } {
+    append exception_text "<li>You need to upload a file\n"
+    incr exception_count
+}
+
+## return errors
+if { $exception_count> 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+if { ![info exists group_id] } {
+    set group_id ""
+}
+
+# get the file from the user.
+# number_of_bytes is the upper-limit
+# on the size of the file we will read. 1024*1024*2= 2097142
+set max_n_bytes [ad_parameter MaxNumberOfBytes fs]
+
+set tmp_filename [ns_queryget upload_file.tmpfile]
+set version_content [read [open $tmp_filename] $max_n_bytes]
+
+set file_extension [string tolower [file extension $upload_file]]
+# remove the first . from the file extension
+regsub "\." $file_extension "" file_extension
+
+# Guess a mime type for this file. If it turns out to be text/plain (the
+# default for anything ns_guesstype doesn't understand), retain the old
+# file type on the assumption that the user has edited the type.
+
+set guessed_file_type [ns_guesstype $upload_file]
+
+if { $guessed_file_type == "text/plain" } {
+    set guessed_file_type [database_to_tcl_string $db "select file_type from fs_versions_latest
+where file_id = $file_id"]
+}
+
+
+set n_bytes [file size $tmp_filename]
+
+# strip off the C:\directories... crud and just get the file name
+if ![regexp {([^//\]+)$} $upload_file match client_filename] {
+    # couldn't find a match
+    set client_filename $upload_file
+}
+
+
+
+     ns_db dml $db "begin transaction"
+     set lob_id [database_to_tcl_string $db "select empty_lob()"]
+
+     ns_db dml $db "insert into fs_versions
+(version_id, file_id, version_description, creation_date, author_id, client_file_name, file_type, file_extension, n_bytes, lob)
+values
+($version_id, $file_id, '$QQversion_description', sysdate(), $user_id, '[DoubleApos $client_filename]', '$guessed_file_type', '$file_extension', $n_bytes, $lob_id)
+" 
+
+    if {[catch { ns_pg blob_dml_file $db $lob_id $tmp_filename } errmsg] } {
+        # insert failed; let's see if it was because of duplicate submission
+        if { [database_to_tcl_string $db "select count(*) from fs_files where file_id = $file_id"] == 0 } {
+	    ns_log Error "/file-storage/create-folder-2.tcl choked:  $errmsg"
+	    ad_return_error "Insert Failed" "The Database did not like what you typed.  This is probably a bug in our code.  Here's what the database said:
+<blockquote>
+<pre>
+$errmsg
+</pre>
+</blockquote>
+"
+            return
+        }
+        ns_db dml $db "abort transaction"
+        # we don't bother to handle the cases where there is a dupe 
+        # submission because the user should be thanked or 
+        # redirected anyway
+        
+	if [regexp "MSIE" [ns_set get [ns_conn headers] User-Agent]] {
+	    ReturnHeaders
+	    ns_write "<meta http-equiv=\"refresh\" content=\"0; URL=$return_url\">"
+	} else {
+	    ns_returnredirect $return_url
+	}
+
+    }
+
+    ns_db dml $db  "update fs_versions 
+    set superseded_by_id = $version_id 
+    where file_id = $file_id
+    and version_id <> $version_id"
+
+
+    # now that the version has been inserted, lets set up the permissions
+
+    # we don't need double-click protection here since we already did 
+    # that for previous statement
+
+    ad_g_create_permission_record $db $version_id FS_VERSIONS $user_id "" "" $public_read_p $public_write_p $public_comment_p
+
+    # lets copy the permissions records for the parent file
+    # we need the "and not map.user_id = $user_id" because the call eo
+    # ad_g_create_permission_record inserts that line for us
+
+    set permissions_id [ad_g_permissions_id $db $version_id FS_VERSIONS]
+
+    ns_db dml $db "insert into permissions_ug_map (
+         permissions_id, 
+         user_id, 
+         group_id, 
+         role, 
+         read_p, 
+         write_p, 
+         comment_p, 
+         owner_p) 
+     select 
+         $permissions_id, 
+         user_id, 
+         group_id, 
+         role, 
+         read_p, 
+         write_p,  
+         comment_p, 
+         owner_p 
+    from permissions_ug_map map, 
+         general_permissions gp
+   where gp.permissions_id = map.permissions_id
+     and on_what_id=$old_version_id
+     and on_which_table='FS_VERSIONS'
+     and (not map.user_id = $user_id
+          or user_id is null)"
+
+
+ns_db dml $db "end transaction"
+
+set page_url "/file-storage/$return_url"
+set page_name [database_to_tcl_string $db "select file_title from fs_files where file_id = $file_id"]
+set on_what_id $version_id
+set on_which_table "FS_VERSIONS"
+
+ns_db releasehandle $db
+
+set return_url "/gp/edit-page-permissions.tcl?[export_url_vars page_url page_name on_what_id on_which_table]"
+
+if [regexp "MSIE" [ns_set get [ns_conn headers] User-Agent]] {
+    ReturnHeaders
+    ns_write "<meta http-equiv=\"refresh\" content=\"0; URL=$return_url\">"
+} else {
+    ns_returnredirect $return_url
+}
+
+
+
+
+
+
+
+
Index: web/openacs/www/file-storage/upload-version.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/Attic/upload-version.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/upload-version.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,101 @@
+# upload-version.tcl,v 1.5.2.1 2000/02/03 09:50:58 ron Exp
+#
+# /file-storage/upload-version-2.tcl
+#
+# by aure@arsdigita.com mid-1999
+#
+# extended in January 2000 by randyg@arsdigita.com
+# to accomodate general permission system
+#
+
+set_the_usual_form_variables
+
+# return url, file_id
+
+set db [ns_db gethandle]
+
+set user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+set exception_text ""
+set exception_count 0
+
+if {(![info exists file_id])||([empty_string_p $file_id])} {
+    incr exception_count
+    append exception_text "<li>No file was specified"
+}
+
+set version_id [database_to_tcl_string $db "select version_id from fs_versions_latest where file_id = $file_id"]
+
+if {![info exists group_id]} {
+    set group_id ""
+}
+
+if {! [fs_check_write_p $db $user_id $version_id $group_id]} {
+    incr exception_count
+    append exception_text "<li>You can't write into this file"
+}
+
+## return errors
+if { $exception_count> 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+
+
+if { $exception_count> 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+set title "Upload New Version of "
+
+append title [database_to_tcl_string $db "select file_title from fs_files where file_id=$file_id"]
+
+set navbar [ad_context_bar_ws [list "index.tcl" [ad_parameter SystemName fs]] "Upload New Version"]
+
+set version_id [database_to_tcl_string $db "select fs_version_id_seq.nextval from dual"]
+
+ns_db releasehandle $db
+
+set html "[ad_header $title]
+
+<h2>$title</h2>
+
+$navbar
+
+<hr>
+<form enctype=multipart/form-data method=POST action=upload-version-2.tcl>
+
+<form  method=POST action=upload-version-2.tcl>
+[export_form_vars file_id version_id return_url]
+
+<table>
+<tr>
+<td align=right>Filename: </td>
+<td>
+<input type=file name=upload_file size=20><br>
+Use the \"Browse...\" button to locate your file, then click \"Open\".
+</td>
+</tr>
+<tr>
+<td align=right>
+Version Notes:</td>
+<td><input type=text size=50  name=version_description></td>
+</tr>
+<tr>
+<td></td>
+<td><input type=submit value=\"Update\">
+</td>
+</tr>
+</table>
+
+</form>
+
+[ad_footer [fs_system_owner]]
+"
+
+ns_return 200 text/html $html
+
Index: web/openacs/www/file-storage/url-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/url-delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/url-delete-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,60 @@
+# /file-storage/url-delete-2.tcl
+#
+# by aure@arsdigita.com, July 1999
+#
+# marks a file deleted (but does not actually remove anything 
+# from the database); if a folder, marks the entire subtree deleted
+#
+# modified by randyg@arsdigita.com, January, 2000 to use the 
+# general permissions module
+#
+# url-delete-2.tcl,v 3.2.2.1 2000/03/24 02:35:20 aure Exp
+
+ad_page_variables {
+    {file_id}
+    {group_id ""}
+    {return_url}
+    {source ""}
+}
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+# Determine if we are working in a Group, or our personal space
+# this is based if no group_id was sent - then we are in
+# our personal area - otherwise the group defined by group_id
+
+set exception_text ""
+set exception_count 0
+
+if [empty_string_p $file_id] {
+    incr exception_count
+    append exception_text "<li>No file was specified"
+}
+
+set version_id [database_to_tcl_string $db "
+    select version_id from fs_versions_latest where file_id = $file_id"]
+
+if {! [fs_check_edit_p $db $user_id $version_id $group_id]} {
+    incr exception_count
+    append exception_text "<li>You do not own this file"
+}
+
+## return errors
+if { $exception_count> 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+ns_db dml $db "update fs_files set deleted_p = 't' where file_id = $file_id"
+
+if {[info exists group_id] && ![empty_string_p $group_id]} {
+    ns_returnredirect group?group_id=$group_id
+} else {
+    ns_returnredirect /file-storage/$source
+}
+
+
+
Index: web/openacs/www/file-storage/url-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/url-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/url-delete.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,87 @@
+# /file-storage/url-delete.tcl
+#
+# created by aure@arsdigita.com, June, 1999
+#
+# modified by randyg@arsdigita.com, January, 2000 to use the 
+# general permissions module
+#
+# url-delete.tcl,v 3.3.2.1 2000/03/24 02:35:20 aure Exp
+
+ad_page_variables {
+    {file_id}
+    {return_url}
+    {group_id ""}
+    {source ""}
+}
+ 
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set title "Delete URL"
+set db [ns_db gethandle ]
+
+set exception_text ""
+set exception_count 0
+
+set version_id [database_to_tcl_string $db "
+    select version_id from fs_versions_latest where file_id = $file_id"]
+
+if ![fs_check_edit_p $db $user_id $version_id $group_id] {
+    incr exception_count
+    append exception_text "<li>You do not own this URL."
+}
+
+## return errors
+if { $exception_count> 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+set file_title [database_to_tcl_string $db "
+    select file_title from fs_files where file_id = $file_id"]
+
+if ![empty_string_p $group_id] {
+    set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]]  $title]
+} else {
+    set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]] $title]
+#    set return_url ""
+}
+
+# release the database handle
+
+ns_db releasehandle $db
+
+# serve the page
+
+ns_return 200 text/html "[ad_header $title ]
+
+<h2> $title </h2>
+
+$navbar
+
+<hr>
+
+<blockquote>
+
+Are you sure you want to delete $file_title?
+
+<form action=url-delete-2 method=post>
+[export_form_vars group_id file_id return_url source]
+
+<input type=submit value=\"Yes, Delete!\" >
+
+</form>
+
+</blockquote>
+
+[ad_footer [fs_system_owner]]"
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/file-storage/version-upload-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/version-upload-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/version-upload-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,171 @@
+# /file-storage/version-upload-2.tcl
+#
+# by aure@arsdigita.com July, 1999
+#
+# extended in January 2000 by randyg@arsdigita.com
+# to accomodate general permission system
+#
+# version-upload-2.tcl,v 3.1.2.3 2000/03/28 09:45:22 carsten Exp
+
+ad_page_variables {
+    {file_id}
+    {group_id ""}
+    {return_url}
+    {upload_file}
+    {version_id}
+    {version_description "" qq}
+}
+
+set local_user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+# check the user input first
+
+set exception_text ""
+set exception_count 0
+
+if [empty_string_p $file_id] {
+    incr exception_count
+    append exception_text "<li>No file was specified"
+}
+
+set selection [ns_db 1row $db "
+    select version_id as old_version_id, author_id as old_author_id
+    from fs_versions_latest
+    where file_id = $file_id
+"]
+
+set_variables_after_query
+
+if {! [fs_check_write_p $db $local_user_id $old_version_id $group_id]} {
+    incr exception_count
+    append exception_text "<li>You can't write into this file"
+}
+
+if [empty_string_p $upload_file] {
+    append exception_text "<li>You need to upload a file\n"
+    incr exception_count
+}
+
+## return errors
+if { $exception_count> 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+# get the file from the user.
+# number_of_bytes is the upper-limit
+# on the size of the file we will read. 1024*1024*2= 2097142
+set max_n_bytes [ad_parameter MaxNumberOfBytes fs]
+
+set tmp_filename [ns_queryget upload_file.tmpfile]
+set version_content [read [open $tmp_filename] $max_n_bytes]
+
+if { ![empty_string_p $max_n_bytes] && ([file size $tmp_filename] > $max_n_bytes) } {
+    ad_return_complaint 1 "Your file is larger than the maximum permissible upload size:  [util_commify_number $max_n_bytes] bytes"
+    return 0
+}
+
+
+set file_extension [string tolower [file extension $upload_file]]
+# remove the first . from the file extension
+regsub "\." $file_extension "" file_extension
+
+# Guess a mime type for this file. If it turns out to be text/plain (the
+# default for anything ns_guesstype doesn't understand), retain the old
+# file type on the assumption that the user has edited the type.
+
+set guessed_file_type [ns_guesstype $upload_file]
+
+if { $guessed_file_type == "text/plain" } {
+    set guessed_file_type [database_to_tcl_string $db "select file_type from fs_versions_latest
+where file_id = $file_id"]
+}
+
+
+set n_bytes [file size $tmp_filename]
+
+# strip off the C:\directories... crud and just get the file name
+if ![regexp {([^//\\]+)$} $upload_file match client_filename] {
+    # couldn't find a match
+    set client_filename $upload_file
+}
+
+ns_db dml $db "begin transaction"
+set lob_id [database_to_tcl_string $db "select empty_lob()"]
+
+ns_db dml $db "insert into fs_versions
+(version_id, file_id, version_description, creation_date, author_id, client_file_name, file_type, file_extension, n_bytes, lob)
+values
+($version_id, $file_id, '$QQversion_description', sysdate(), $local_user_id, '[DoubleApos $client_filename]', '$guessed_file_type', '$file_extension', $n_bytes, $lob_id)" 
+
+    if {[catch { ns_pg blob_dml_file $db $lob_id $tmp_filename } errmsg] } {
+        # insert failed; let's see if it was because of duplicate submission
+        if { [database_to_tcl_string $db "select count(*) from fs_files where file_id = $file_id"] == 0 } {
+	    ns_log Error "/file-storage/create-folder-2.tcl choked:  $errmsg"
+	    ad_return_error "Insert Failed" "The Database did not like what you 
+	                     typed.  This is probably a bug in our code.  Here's 
+	                     what the database said:
+	                     <blockquote>
+	                     <pre>$errmsg</pre>
+	                     </blockquote>"
+            return
+        }
+
+        ns_db dml $db "abort transaction"
+        # we don't bother to handle the cases where there is a dupe 
+        # submission because the user should be thanked or 
+        # redirected anyway
+        
+	if [regexp "MSIE" [ns_set get [ns_conn headers] User-Agent]] {
+	    ReturnHeaders
+	    ns_write "<meta http-equiv=\"refresh\" content=\"0; URL=$return_url\">"
+	} else {
+	    ns_returnredirect $return_url
+	}
+
+    }
+
+    ns_db dml $db  "
+        update fs_versions 
+        set   superseded_by_id = $version_id 
+        where file_id = $file_id
+        and   version_id <> $version_id"
+
+
+    # now that the version has been inserted, lets set up the permissions
+
+    # we don't need double-click protection here since we already did 
+    # that for previous statement
+
+
+    # Copy the previous version's permissions, except for rows regarding
+    # the current user and the previous version's owner.
+    #ns_db select $db "select copy_permissions($old_version_id, $version_id, 'FS_VERSIONS',$local_user_id, $old_author_id)"
+    ns_db select $db "select grant_permission_to_user($local_user_id, 'read', $version_id, 'FS_VERSIONS')"
+    ns_db select $db "select grant_permission_to_user($local_user_id, 'write', $version_id, 'FS_VERSIONS')"
+    ns_db select $db "select grant_permission_to_user($local_user_id, 'comment', $version_id, 'FS_VERSIONS')"
+    ns_db select $db "select grant_permission_to_user($local_user_id, 'administer', $version_id, 'FS_VERSIONS')"
+
+ns_db dml $db "end transaction"
+
+set object_name [database_to_tcl_string $db "
+    select file_title 
+    from   fs_files 
+    where  file_id = $file_id"]
+set on_what_id $version_id
+set on_which_table "FS_VERSIONS"
+
+ns_db releasehandle $db
+
+set return_url "/gp/administer-permissions?[export_url_vars return_url object_name on_what_id on_which_table]"
+
+if [regexp "MSIE" [ns_set get [ns_conn headers] User-Agent]] {
+    ReturnHeaders
+    ns_write "<meta http-equiv=\"refresh\" content=\"0; URL=$return_url\">"
+} else {
+    ns_returnredirect $return_url
+}
Index: web/openacs/www/file-storage/version-upload.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/file-storage/version-upload.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/file-storage/version-upload.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,101 @@
+# /file-storage/version-upload-2.tcl
+#
+# by aure@arsdigita.com mid-1999
+#
+# extended in January 2000 by randyg@arsdigita.com
+# to accomodate general permission system
+#
+# version-upload.tcl,v 3.1 2000/03/11 07:59:48 aure Exp
+
+ad_page_variables {
+    {return_url}
+    {file_id}
+    {group_id ""}
+}
+
+set db [ns_db gethandle]
+
+set user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+set exception_text ""
+set exception_count 0
+
+set version_id [database_to_tcl_string $db "
+    select version_id from fs_versions_latest where file_id = $file_id"]
+
+if ![fs_check_write_p $db $user_id $version_id $group_id] {
+    incr exception_count
+    append exception_text "<li>You can't write into this file"
+}
+
+## return errors
+if { $exception_count> 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+if { $exception_count> 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return 0
+}
+
+set title "Upload New Version of [database_to_tcl_string $db "select file_title from fs_files where file_id=$file_id"]"
+
+set navbar [ad_context_bar_ws [list "" [ad_parameter SystemName fs]] "Upload New Version"]
+
+set version_id [database_to_tcl_string $db "select fs_version_id_seq.nextval from dual"]
+
+# release the database handle
+
+ns_db releasehandle $db
+
+# serve the page
+
+ns_return 200 text/html "
+
+[ad_header $title]
+
+<h2>$title</h2>
+
+$navbar
+
+<hr>
+<form enctype=multipart/form-data method=POST action=version-upload-2>
+
+<form  method=POST action=version-upload-2>
+[export_form_vars file_id version_id return_url]
+
+<table>
+<tr>
+<td align=right>Filename: </td>
+<td>
+<input type=file name=upload_file size=20>
+</td>
+</tr>
+<tr>
+<td>&nbsp;</td>
+<td>
+Use the \"Browse...\" button to locate your file, then click \"Open\".
+</td>
+</tr>
+
+<tr>
+<td align=right>
+Version Notes:</td>
+<td><input type=text size=50  name=version_description></td>
+</tr>
+
+<tr>
+<td></td>
+<td><input type=submit value=\"Update\">
+</td>
+</tr>
+</table>
+
+</form>
+
+[ad_footer [fs_system_owner]]"
+
+
Index: web/openacs/www/gc/add-alert-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/add-alert-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/add-alert-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,77 @@
+# add-alert-2.tcl,v 3.1.2.1 2000/03/15 05:03:48 curtisg Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+
+# domain, frequency,  howmuch
+
+validate_integer domain_id $domain_id
+
+set db [gc_db_gethandle]
+
+set selection [ns_db 1row $db [gc_query_for_domain_info $domain_id]]
+set_variables_after_query
+
+set alert_id [database_to_tcl_string $db "select classified_email_alert_id_seq.nextval from dual"]
+
+append html "[gc_header "Add Alert (Form 2)"]
+
+<h2>Add an Alert</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" [gc_system_name]] [list "domain-top.tcl?[export_url_vars domain]" $full_noun] "Add Alert, Step 2"]
+
+
+<form method=POST action=\"add-alert-3.tcl\">
+[export_form_vars alert_id domain_id frequency howmuch]
+
+<table>
+<tr>
+<td><input name=alert_type type=radio value=all></td><td>Ask for
+all new ads</td>
+<td></td>
+</tr>
+
+<tr>
+<td><input name=alert_type type=radio
+value=category></td><td>Choose a category</td>
+<td><select name=primary_category>
+<option>Choose a Category
+"
+
+set selection [ns_db select $db "select primary_category,
+upper(primary_category)
+from ad_categories
+where domain_id = $domain_id
+order by 2"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append page_content  "<option>$primary_category\n"
+}
+
+append html "$page_content
+</select></td>
+</tr>
+
+<tr valign=top>
+<td><input name=alert_type type=radio value=keywords></td><td
+width=45%>Any ad with the following keywords (separated by
+spaces):</td>
+<td valign=bottom><input type=text size=30
+name=query_string></td>
+</tr>
+
+</table>
+
+<p>
+<center>
+<input type=submit value=\"Add This Alert\">
+</center>
+
+</form>
+"
+  
+ns_return 200 text/html $html
Index: web/openacs/www/gc/add-alert-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/add-alert-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/add-alert-3.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,75 @@
+# add-alert-3.tcl,v 3.1 2000/03/10 23:58:20 curtisg Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+
+# alert_id, domain_id, frequency, howmuch, submit_type
+# also query_string, primary_category
+
+validate_integer alert_id $alert_id
+validate_integer domain_id $domain_id
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [gc_db_gethandle]
+
+if { [info exists alert_type] && [string compare all $alert_type] == 0 } {
+    # user wants all the new ads
+    ns_db dml $db "insert into classified_email_alerts
+      (alert_id, domain_id, user_id, alert_type, expires, howmuch, frequency)
+      values
+      ($alert_id, $domain_id, $user_id, '$alert_type',sysdate()+timespan_days(180), '$howmuch',
+      '$frequency')"
+
+} elseif { [info exists alert_type] && [string compare category $alert_type] == 0 } {
+    if { $primary_category == "Choose a Category" } {
+        ad_return_complaint 1 "<li>you need to choose a category\n"
+        return
+    } else {
+        ns_db dml $db "insert into classified_email_alerts
+      (alert_id, domain_id, user_id, alert_type, category, expires, howmuch,
+      frequency)
+      values
+      ($alert_id, $domain_id,
+      $user_id,'$alert_type','$QQprimary_category',sysdate()+timespan_days(180),
+      '$howmuch', '$frequency')"
+
+    }
+} elseif { [info exists alert_type] &&  [string compare keywords $alert_type] == 0  } {
+    if { $query_string == "" } {
+        ad_return_complaint 1 "<li>please choose at least one keyword\n"
+        return
+    } else {
+        ns_db dml $db "insert into classified_email_alerts
+      (alert_id, domain_id, user_id, alert_type, keywords, expires, howmuch,
+      frequency)
+      values
+      ($alert_id, $domain_id, $user_id,'$alert_type','$QQquery_string',sysdate()+timespan_days(180),
+      '$howmuch', '$frequency')"
+    }
+} else {
+    # no alert_type
+    ad_return_complaint 1 "You did not choose whether you want
+      to get all ads, 
+          ads within a category, or ads with some keywords. Please
+      choose one of those 3 options."
+    return
+}
+
+set selection [ns_db 1row $db [gc_query_for_domain_info $domain_id]]
+set_variables_after_query
+
+ns_return 200 text/html "[ad_header "Alert Added"]
+
+<h2>Alert Added</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" [gc_system_name]] [list "domain-top.tcl?[export_url_vars domain_id]" $full_noun] "Alert Added"]
+
+<hr>
+
+Mail will be sent to [database_to_tcl_string $db "select email from users where user_id=$user_id"] [gc_PrettyFrequency $frequency].
+
+[ad_footer $maintainer_email]"
Index: web/openacs/www/gc/add-alert.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/add-alert.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/add-alert.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,101 @@
+# add-alert.tcl,v 3.1 2000/03/10 23:58:21 curtisg Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+
+# domain_id
+
+validate_integer domain_id $domain_id
+
+#get the user's Id and send user to registration if necessary
+
+#check for the user cookie
+set user_id [ad_get_user_id]
+
+if {$user_id == 0} {
+    ns_returnredirect /register/index.tcl?return_url=[ns_urlencode /gc/add-alert.tcl?domain_id=[ns_urlencode $domain_id]]
+}
+
+
+
+set db [gc_db_gethandle]
+
+set selection [ns_db 1row $db [gc_query_for_domain_info $domain_id]]
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "[gc_header "Add Alert"]
+
+[ad_decorate_top "<h2>Add an Alert</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" [gc_system_name]] [list "domain-top.tcl?[export_url_vars domain_id]" $full_noun] "Add Alert"]
+" [ad_parameter AddAlertDecoration gc]]
+
+<hr>
+
+If you're too busy to come to them, 
+<a href=\"domain-top.tcl?domain_id=[ns_urlencode $domain_id]\">$full_noun</a>
+will come to you.  By filling out this form, you can
+get an email notification of new ads that fit your interests.
+
+<p>
+
+<form method=POST action=\"add-alert-2.tcl\">
+<input name=domain_id type=hidden value=\"$domain_id\">
+
+Step 1: decide how often you'd like to have your mailbox
+spammed by our server:
+
+<P>
+
+<blockquote>
+
+<input name=frequency value=instant type=radio> Instant
+<input name=frequency value=daily type=radio> Daily 
+<input name=frequency value=monthu type=radio checked> Monday and Thursday
+<input name=frequency value=weekly type=radio> Weekly
+
+</blockquote>
+
+<p>
+
+Step 2: decide how much of each advertisement would you like to get in the
+email message:
+
+<P>
+
+<blockquote>
+
+<input name=howmuch value=one_line type=radio checked> Subject line and email address
+<input name=howmuch value=everything type=radio> The whole enchilada
+
+</blockquote>
+
+<p>
+
+\[Note: if you opt for subject line only, you'll also get a URL that
+will bring up a page from our server with all of the ads so you can
+browse the full text.\]
+
+<p>
+
+<center>
+<input type=submit value=\"Proceed\">
+</center>
+
+</form>
+
+<p>
+
+<h3>Edit Previous Alerts</h3>
+
+Found your dream?  Going on vacation?  You can put your alerts
+on hold with <a href=\"edit-alerts.tcl\">the edit alert page</a>.
+
+
+[gc_footer $maintainer_email]
+"
Index: web/openacs/www/gc/add-to-basket.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/add-to-basket.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/add-to-basket.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,28 @@
+# add-to-basket.tcl,v 3.0 2000/02/06 03:42:29 ron Exp
+set_form_variables
+
+# ad_id is the only interesting one
+
+validate_integer ad_id $ad_id
+
+set db [gc_db_gethandle]
+
+set headers [ns_conn headers]
+set cookie [ns_set get $headers Cookie]
+if { $cookie == "" || 
+     ( $cookie != "" && ![regexp {HearstClassifiedBasketEmail=([^;]*)$} $cookie match just_the_cookie] ) } {
+    # there was no cookie header or there was, but it didn't match for us
+    ns_returnredirect "enter-basket-email.tcl?ad_id=$ad_id"
+    return
+} 
+
+# we get the last one if there are N
+regexp {HearstClassifiedBasketEmail=([^;]*)$} $cookie match just_the_cookie
+set key $just_the_cookie
+
+set insert_sql "insert into user_picks (email, ad_id) 
+                values ('[DoubleApos $key]',$ad_id)"
+
+ns_db dml $db $insert_sql
+
+ns_returnredirect "basket-home.tcl"
Index: web/openacs/www/gc/add.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/add.gif,v
diff -u
Binary files differ
Index: web/openacs/www/gc/alert-disable.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/alert-disable.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/alert-disable.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,51 @@
+# alert-disable.tcl,v 3.1 2000/03/10 23:58:21 curtisg Exp
+set_the_usual_form_variables
+
+# alert_id
+# if they have a really old email message, rowid
+
+validate_integer alert_id $alert_id
+
+set user_id [ad_verify_and_get_user_id]
+
+if {[info exists alert_id]} {
+    if {![valid_number_p $alert_id]} {
+        ad_return_error "Error Disabling Alert" "You must enter a valid alert number."
+        return
+    }
+    set condition "alert_id = $alert_id"
+    set condition_url "alert_id=$alert_id"
+} else {
+    set condition "oid = '$QQoid'"
+    set condition_url "oid=[ns_urlencode $oid]"
+}
+
+if {$user_id == 0} {
+    ns_returnredirect /register/index.tcl?return_url=[ns_urlencode /gc/alert-disable.tcl?$condition_url]
+    return
+}
+
+set db [gc_db_gethandle]
+
+if [catch {ns_db dml $db "update classified_email_alerts set valid_p = 'f' where $condition and user_id = $user_id"} errmsg] {
+    ad_return_error "Error Disabling Alert" "Here's the error that the database logged:
+
+<blockquote><code>
+$errmsg
+</blockquote></code>"
+return
+} else {
+    # success
+    ns_return 200 text/html "[gc_header "Success"]
+
+<h2>Success!</h2>
+
+disabling your email alert in <a href=index.tcl>[gc_system_name]</a>
+
+<hr>
+
+You can return to <a href=\"edit-alerts.tcl\">your [gc_system_name]
+alerts page</a> or [ad_pvt_home_link].
+
+[gc_footer [gc_system_owner]]"
+}
Index: web/openacs/www/gc/alert-extend.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/alert-extend.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/alert-extend.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,49 @@
+# alert-extend.tcl,v 3.1 2000/03/10 23:58:21 curtisg Exp
+set_form_variables
+set_form_variables_string_trim_DoubleAposQQ
+
+# alert_id, or if they have an old URL, oid
+
+validate_integer alert_id $alert_id
+
+set db [gc_db_gethandle]
+
+if {[info exists alert_id]} {
+    if {![valid_number_p $alert_id]} {
+        ad_return_error "Error Disabling Alert" "You must enter a valid alert number."
+        return
+    }
+    set condition "alert_id = $alert_id"
+} else {
+    set condition "oid = '$QQoid'"
+}
+
+if [catch {ns_db dml $db "update classified_email_alerts 
+set expires = sysdate() + timespan_days(180)
+where $condition"} errmsg] {
+    ad_return_error "Error Extending Alert" "in <a href=index.tcl>[gc_system_name]</a>
+
+<p>
+
+Here's the error from the database:
+
+<blockquote><code>
+$errmsg
+</blockquote></code>
+
+"
+} else {
+    # success
+    ns_return 200 text/html "[gc_header "Success"]
+
+<h2>Success!</h2>
+
+extending your email alert in <a href=index.tcl>[gc_system_name]</a>
+
+<hr>
+
+Your alert will expire six months from now.
+
+
+[gc_footer [gc_system_owner]]"
+}
Index: web/openacs/www/gc/alert-reenable.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/alert-reenable.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/alert-reenable.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,48 @@
+# alert-reenable.tcl,v 3.1 2000/03/10 23:58:21 curtisg Exp
+set_form_variables
+set_form_variables_string_trim_DoubleAposQQ
+
+# oid
+
+
+set db [gc_db_gethandle]
+
+if {[info exists alert_id]} {
+    if {![valid_number_p $alert_id]} {
+        ad_return_error "Error Disabling Alert" "You must enter a valid alert number."
+        return
+    }
+    set condition "alert_id = $alert_id"
+} else {
+    set condition "oid = '$QQoid'"
+}
+
+if [catch {ns_db dml $db "update classified_email_alerts set valid_p = 't' where $condition"} errmsg] {
+   ad_return_error "Error Re-Enabling Alert" "in <a href=index.tcl>[gc_system_name]</a>
+
+<p>
+
+Here's the error that the database logged:
+
+<blockquote><code>
+$errmsg
+</blockquote></code>
+
+"
+    return
+} else {
+    # success
+    ns_return 200 text/html "[gc_header "Success"]
+
+<h2>Success!</h2>
+
+re-enabling your email alert in <a href=index.tcl>[gc_system_name]</a>
+
+<hr>
+
+You can return to <a href=\"edit-alerts.tcl\">your [gc_system_name]
+alerts page</a> or [ad_pvt_home_link].
+
+
+[gc_footer [gc_system_owner]]"
+}
Index: web/openacs/www/gc/alert-summary.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/alert-summary.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/alert-summary.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,47 @@
+# alert-summary.tcl,v 3.1 2000/03/10 23:58:21 curtisg Exp
+set_form_variables
+
+# the only interesting one is $id_list
+
+foreach id $id_list {
+    validate_integer id $id
+}
+
+set db [gc_db_gethandle]
+
+set sql "select classified_ad_id, users.email as poster_email, one_line, posted
+from classified_ads, users
+where classified_ads.user_id = users.user_id
+and classified_ad_id in ([join $id_list ","])
+order by classified_ad_id desc"
+   
+append html "[gc_header "Ads that matched your alert"]
+
+<h2>Ads that matched your alert</h2>
+
+in <a href=index.tcl>[gc_system_name]</a>
+
+<hr>
+<ul>
+"
+
+set selection [ns_db select $db $sql]
+
+set counter 0
+
+while {[ns_db getrow $db $selection]} {
+    incr counter
+    set_variables_after_query
+    append html "<li><a href=\"view-one.tcl?classified_ad_id=$classified_ad_id\">$one_line</a>
+"
+}
+
+if { $counter == 0 } {
+    append html "<li>No matching ads"
+}
+
+append html "
+</ul>
+[gc_footer [gc_system_owner]]"
+
+ns_return 200 text/html $html
\ No newline at end of file
Index: web/openacs/www/gc/auction-hot.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/auction-hot.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/auction-hot.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,78 @@
+# auction-hot.tcl,v 3.1 2000/03/10 23:58:21 curtisg Exp
+# /gc/auction-hot.tcl
+#
+# by philg@mit.edu in 1997 or 1998 
+# 
+# list the ads that are attracting a lot of auction bids 
+# 
+
+set_the_usual_form_variables
+
+# domain_id
+
+validate_integer domain_id $domain_id
+
+set db [gc_db_gethandle]
+set selection [ns_db 1row $db [gc_query_for_domain_info $domain_id]]
+set_variables_after_query
+
+set simple_headline "<h2>Hot Auctions</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" [gc_system_name]] [list "domain-top.tcl?[export_url_vars domain_id]" $full_noun] "Active Auctions"]
+"
+
+if ![empty_string_p [ad_parameter HotAuctionsDecoration gc]] {
+    set full_headline "<table cellspacing=10><tr><td>[ad_parameter HotAuctionsDecoration gc]<td>$simple_headline</tr></table>"
+} else {
+    set full_headline $simple_headline
+}
+
+set whole_page ""
+
+append whole_page "[gc_header "Hot Auctions in $domain"]
+
+$full_headline
+
+<hr>
+<p>
+
+<ul>
+"
+
+set selection [ns_db select $db "select ca.classified_ad_id, ca.one_line, count(*) as bid_count
+from classified_ads ca, classified_auction_bids cab
+where ca.classified_ad_id = cab.classified_ad_id
+and ca.expires::date > sysdate()::date
+and ca.domain_id = '$domain_id'
+group by ca.classified_ad_id, ca.one_line
+having count(*) > [ad_parameter HotAuctionThreshold gc 1]
+and age(sysdate(),max(bid_time)) < '7 days'
+order by count(*) desc"]
+
+set counter 0
+set items ""
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+    append items "<li>$bid_count bids on <a href=\"view-one.tcl?classified_ad_id=$classified_ad_id\">
+$one_line</a>
+"
+
+}
+
+if { $counter == 0 } {
+    append whole_page "there aren't any actively auctioned (2 or more bids) items right now"
+} else {
+    append whole_page $items
+}
+
+
+
+append whole_page "</ul>
+
+[gc_footer $maintainer_email]"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $whole_page
+
Index: web/openacs/www/gc/basket-home.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/basket-home.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/basket-home.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,65 @@
+# basket-home.tcl,v 3.1 2000/03/10 23:58:21 curtisg Exp
+set db [gc_db_gethandle]
+
+set headers [ns_conn headers]
+set cookie [ns_set get $headers Cookie]
+if { $cookie == "" || 
+     ( $cookie != "" && ![regexp {HearstClassifiedBasketEmail=([^;]*)$} $cookie match just_the_cookie] ) } {
+    # there was no cookie header or there was, but it didn't match for us
+    ns_return 200 text/html "couldn't find a cookie header; this feature only works with cookie-compatible browsers (mostly Netscape)"
+    return
+} else {
+    # we get the last one if there are N
+    regexp {HearstClassifiedBasketEmail=([^;]*)$} $cookie match just_the_cookie
+    set key $just_the_cookie
+}
+
+append html "<html>
+<head>
+<title>Basket for $key</title>
+</head>
+<body bgcolor=#ffffff text=#000000>
+<h2>Basket for $key</h2>
+
+
+<p>
+
+"
+#set selection [ns_db select $db "select distinct a.ad_id,headline,print_text,web_text
+#from user_picks up, ads a
+#where up.ad_id = a.ad_id
+#and up.email = '[DoubleApos $key]'"]
+
+# would have been nice to "order by up.tmin desc" but that means we
+# end up with duplicate rows because Illustra requires order by 
+# columns to be in the SELECT list
+
+# here's a hairy fix with GROUP BY out the wazoo...
+
+set selection [ns_db select $db "select a.ad_id,headline,print_text,web_text,
+max(up.tmin) as last_marked_time
+from user_picks up, ads a
+where up.ad_id = a.ad_id
+and up.email = '[DoubleApos $key]'
+group by a.ad_id,headline,print_text,web_text
+order by 5 desc"]
+
+while {[ns_db getrow $db $selection]} {
+
+    set_variables_after_query
+    if { $web_text == "" } {
+	set full_text "<b>$headline</b> $print_text"
+    } else {
+	set full_text $web_text
+    }
+    append html "<a href=\"remove-from-basket.tcl?ad_id=$ad_id\">
+<img src=add.gif width=32 height=32 hspace=5 vspace=0 align=right></a>
+$full_text
+<hr width=300><br clear=right>\n"
+
+}
+
+append html "[gc_footer [gc_system_owner]]
+"
+
+ns_return 200 text/html $html
Index: web/openacs/www/gc/controversial-ads.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/controversial-ads.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/controversial-ads.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,78 @@
+# controversial-ads.tcl,v 3.1 2000/03/10 23:58:21 curtisg Exp
+# /gc/controversial-ads.tcl
+#
+# by philg@mit.edu in 1997 or 1998 
+# 
+# list the ads that are attracting a lot of comments
+# 
+
+set_the_usual_form_variables
+
+# domain_id
+
+validate_integer domain_id $domain_id
+
+set db [gc_db_gethandle]
+set selection [ns_db 1row $db [gc_query_for_domain_info $domain_id]]
+set_variables_after_query
+
+set simple_headline "<h2>Controversial Ads</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" [gc_system_name]] [list "domain-top.tcl?[export_url_vars domain_id]" $full_noun] "Controversial Ads"]
+"
+
+if ![empty_string_p [ad_parameter ControversialAdsDecoration gc]] {
+    set full_headline "<table cellspacing=10><tr><td>[ad_parameter ControversialAdsDecoration gc]<td>$simple_headline</tr></table>"
+} else {
+    set full_headline $simple_headline
+}
+
+set whole_page ""
+
+append whole_page "[gc_header "Controversial Ads in $domain"]
+
+$full_headline
+
+<hr>
+<p>
+
+<ul>
+"
+
+set selection [ns_db select $db "select ca.classified_ad_id, ca.one_line, count(*) as comment_count
+from classified_ads ca, general_comments gc
+where ca.classified_ad_id = gc.on_what_id
+and gc.on_which_table = 'classified_ads'
+and gc.approved_p = 't'
+and ca.expires > sysdate()
+and ca.domain_id = $domain_id
+group by ca.classified_ad_id, ca.one_line
+having count(*) > 1
+order by count(*) desc"]
+
+set counter 0
+set items ""
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+    append items "<li>$comment_count comments on <a href=\"view-one.tcl?classified_ad_id=$classified_ad_id\">$one_line</a>
+"
+
+}
+
+if { $counter == 0 } {
+    append whole_page "there aren't any controversial (2 or more comments) right now"
+} else {
+    append whole_page $items
+}
+
+
+
+append whole_page "</ul>
+
+[gc_footer $maintainer_email]"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $whole_page
+
Index: web/openacs/www/gc/convert-old-alerts.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/convert-old-alerts.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/convert-old-alerts.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,45 @@
+# convert-old-alerts.tcl,v 3.1 2000/03/10 23:58:21 curtisg Exp
+set db [gc_db_gethandle]
+
+append html "<html><head><title>Convert</title></head> 
+<body>
+<ul>"
+
+set selection [ns_db select $db "select oid,* from classified_email_alerts"]
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append html "<li>for $email (oid: $oid)
+<ul>
+<li>Old query:  $query"
+    regsub {and[^a-zA-Z]+primary_category = 'photographic'} $query "" without_primary
+    append html "<li>without primary:  $without_primary"
+    regsub {subcategory_1} $without_primary "primary_category" final_query
+    append html "<li>final:  $final_query"
+    append html "</ul>"
+    lappend updates "update classified_email_alerts 
+set query = '[DoubleApos $final_query]'
+where oid='$oid'"
+
+}
+
+append html "</ul>
+
+<p>
+<h3>Now for the updates</h3>
+
+<ul>
+
+"
+
+foreach update $updates {
+    ns_db dml $db $update
+    append html "<li>Completed $update\n"
+}
+
+append html "</ul>
+
+
+</body>
+</html>"
+
+ns_return 200 text/html $html
Index: web/openacs/www/gc/define-new-category-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/define-new-category-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/define-new-category-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,25 @@
+# define-new-category-2.tcl,v 3.1.2.2 2000/03/15 04:59:08 curtisg Exp
+# we get here when user is placing ad
+
+set_form_variables
+set_form_variables_string_trim_DoubleAposQQ
+
+# category_id, domain_id, primary_category, ad_placement_blurb
+
+validate_integer category_id $category_id
+validate_integer domain_id $domain_id
+
+if { $primary_category == "" || $ad_placement_blurb == "" } {
+    ns_return 200 text/html "Please back up and fill in the form completely"
+    return
+}
+
+# we have full data
+
+set insert_sql "insert into ad_categories (category_id, domain_id, primary_category, ad_placement_blurb)
+values ($category_id, $domain_id, '$QQprimary_category', '$QQad_placement_blurb')"
+
+set db [gc_db_gethandle]
+ns_db dml $db $insert_sql
+
+ns_returnredirect "place-ad-2.tcl?domain_id=[ns_urlencode $domain_id]&primary_category=[ns_urlencode $primary_category]"
Index: web/openacs/www/gc/define-new-category.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/define-new-category.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/define-new-category.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,53 @@
+# define-new-category.tcl,v 3.1 2000/03/10 23:58:22 curtisg Exp
+# we get here when user is placing ad
+
+set_the_usual_form_variables
+
+# domain_id
+
+validate_integer domain_id $domain_id
+
+set db [gc_db_gethandle]
+set selection [ns_db 1row $db [gc_query_for_domain_info $domain_id]]
+set_variables_after_query
+
+set category_id [database_to_tcl_string $db "select ad_category_id_seq.nextval from dual"]
+
+append html "[gc_header "Define New Category for $full_noun"]
+
+<h2>Define a New Category</h2>
+
+in <a href=\"domain-top.tcl?[export_url_vars domain_id]\">$full_noun</a>
+
+<hr>
+
+Category Name should be descriptive and plural, e.g., \"Camera Parts\"
+or \"Professorships\".  Placement blurb is something to jog the users
+minds when they are placing an ad.  For example, if the new category
+were \"Automobiles, Sports\" you could have \"Remember to include
+engine size, maximum speed, and number of dyed blondes obtained\".
+
+
+<form method=post action=define-new-category-2.tcl>
+[export_form_vars domain_id category_id]
+<table>
+<tr><th>Category Name<td><input type=text name=primary_category size=40></tr>
+<tr><th>Placement Blurb<br>
+<td><textarea name=ad_placement_blurb wrap=soft rows=6 cols=50>
+Remember to include... 
+</textarea>
+</tr>
+</table>
+<p>
+<center>
+<input type=submit value=submit>
+</center>
+</form>
+
+"
+
+append html "
+
+[gc_footer $maintainer_email]"
+
+ns_return 200 text/html $html
Index: web/openacs/www/gc/delete-ad-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/delete-ad-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/delete-ad-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,85 @@
+# delete-ad-2.tcl,v 3.1 2000/03/10 23:58:22 curtisg Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+set_the_usual_form_variables
+
+# classified_ad_id
+
+validate_integer classified_ad_id $classified_ad_id
+
+if { [ad_get_user_id] == 0 } {
+    ns_returnredirect /register/index.tcl?return_url=[ns_urlencode /gc/delete-ad-2.tcl?[export_url_vars classified_ad_id]]
+}
+
+set db [gc_db_gethandle]
+
+set selection [ns_db 0or1row $db "select ca.user_id, ca.domain_id, ad_deletion_blurb, email as maintainer_email
+from classified_ads ca, ad_domains, users
+where ca.domain_id = ad_domains.domain_id
+and classified_ad_id = $classified_ad_id
+and ad_domains.primary_maintainer_id = users.user_id"]
+
+if { $selection == "" } {
+    ad_return_error "Could not find Ad $classified_ad_id" "Could not find this ad in <a href=index.tcl>[gc_system_name]</a>
+
+<p>
+
+Probably the ad was deleted already (maybe you double clicked?).
+
+<p>
+
+Start from <a href=\"/gc/\">the top level classifieds area</a> 
+and then click down to review your ads to
+see if this ad is still there.
+"
+       return 
+}
+set_variables_after_query
+
+if { $user_id != [ad_verify_and_get_user_id] } {
+    ad_return_error "Unauthorized" "You are not authorized to edit this ad."
+    return
+}
+
+
+if [catch { ns_db dml $db "begin transaction"
+            ns_db dml $db [gc_audit_insert $classified_ad_id]
+            ns_db dml $db "delete from classified_auction_bids where classified_ad_id = $classified_ad_id"
+            ns_db dml $db "delete from classified_ads where classified_ad_id = $classified_ad_id"
+            ns_db dml $db "end transaction" } errmsg] {
+	# we shouldn't be able to get here except because of 
+	# violating integrity constraints
+	ad_return_error "Error Deleting Ad" "I think my code must have a serious bug.
+The error message from the database was
+
+<blockquote><code>
+$errmsg
+</blockquote></code>
+[gc_footer $maintainer_email]"
+        return
+}
+
+ns_return 200 text/html "[gc_header "Ad $classified_ad_id Deleted"]
+
+<h2>Ad $classified_ad_id Deleted</h2>
+
+from [ad_site_home_link]
+
+<hr>
+
+Deletion of ad $classified_ad_id confirmed.
+
+<p>
+
+$ad_deletion_blurb
+
+<p>
+
+You might want to <a href=\"edit-ad-2.tcl?[export_url_vars domain_id]\">review your remaining ads</a>.
+
+[gc_footer $maintainer_email]
+"
Index: web/openacs/www/gc/delete-ad.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/delete-ad.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/delete-ad.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,57 @@
+# delete-ad.tcl,v 3.1 2000/03/10 23:58:22 curtisg Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+
+# classified_ad_id
+
+validate_integer classified_ad_id $classified_ad_id
+
+set db [gc_db_gethandle]
+set selection [ns_db 0or1row $db "select 
+classified_ads.*
+from classified_ads
+where classified_ad_id = $classified_ad_id"]
+
+if { $selection == "" } {
+    ad_return_error "Could not find Ad $classified_ad_id" "Could not find Ad $classified_ad_id.
+
+<p>
+
+Either you are fooling around with the Location field in your browser,
+this ad is already delted,  or this code has a serious bug. "
+     return 
+}
+
+# OK, we found the ad in the database if we are here...
+set_variables_after_query
+
+set selection [ns_db 1row $db [gc_query_for_domain_info $domain_id]]
+set_variables_after_query
+
+ReturnHeaders
+ns_write "[gc_header "Delete \"$one_line\""]
+
+<h2>Delete \"$one_line\"</h2>
+
+ad number $classified_ad_id in 
+<a href=\"domain-top.tcl?[export_url_vars domain_id]\">$full_noun</a>
+
+<hr>
+
+Are you sure that you want to delete this ad?
+
+<ul>
+<li><a href=\"delete-ad-2.tcl?[export_url_vars classified_ad_id]\">yes, I'm sure</a>
+
+<p>
+
+<li><a href=\"edit-ad-2.tcl?[export_url_vars domain_id]\">no; let me look at my ads again</a>
+
+</ul>
+
+
+[gc_footer $maintainer_email]"
Index: web/openacs/www/gc/domain-all.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/domain-all.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/domain-all.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,73 @@
+# domain-all.tcl,v 3.1 2000/03/10 23:58:23 curtisg Exp
+set_the_usual_form_variables
+
+# domain_id, by_category_p, wtb_p
+
+validate_integer domain_id $domain_id
+
+set db [gc_db_gethandle]
+
+set selection [ns_db 1row $db [gc_query_for_domain_info $domain_id]]
+set_variables_after_query
+
+
+append html "[gc_header "$full_noun Ads"]
+
+<h2>All Ads</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" [gc_system_name]] [list "domain-top.tcl?[export_url_vars domain_id]" $full_noun] "All Ads"]
+
+<hr>
+
+<ul>
+"
+
+set list_items ""
+
+if { $by_category_p == "t" } {
+    set order_by "order by primary_category"
+} else {
+    set order_by "order by classified_ad_id desc"
+}
+
+if { [info exists wtb_p] && $wtb_p == "f" } {
+   set wtb_restriction "and wanted_p = 'f'"
+} else {
+   set wtb_restriction ""
+}
+
+set selection [ns_db select $db "select classified_ad_id,one_line,primary_category as category
+from classified_ads
+where domain_id = $domain_id $wtb_restriction
+and (sysdate() <= expires or expires is null)
+$order_by"]
+
+set last_category_printed ""
+set first_loop_flag 1
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    if { $category != $last_category_printed && $by_category_p == "t" } {
+	append list_items "</ul><h3>$category</h3>\n<ul>"
+	set last_category_printed $category
+    }
+    append list_items "<li><a href=\"view-one.tcl?classified_ad_id=$classified_ad_id\">
+$one_line</a>
+"
+    set first_loop_flag 0
+}
+
+if { $first_loop_flag  == 1 } {
+    # we never even got one row
+    append list_items "there aren't any unexpired ads in this domain"
+}
+
+ns_db releasehandle $db
+
+append html "$list_items
+
+</ul>
+
+[gc_footer $maintainer_email]"
+
+ns_return 200 text/html $html
Index: web/openacs/www/gc/domain-top.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/domain-top.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/domain-top.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,174 @@
+# domain-top.tcl,v 3.1 2000/03/10 23:58:23 curtisg Exp
+# 
+# /gc/domain-top.tcl 
+# 
+# by philg@mit.edu in 1995 and then abused by teadams@mit.edu
+# and others
+# 
+# the top-level page for one section within classifieds
+#
+
+# parameters
+
+set how_many_recent_ads_to_display [ad_parameter HowManyRecentAdsToDisplay gc 5]
+
+set_the_usual_form_variables
+
+# domain_id
+
+validate_integer domain_id $domain_id
+
+set db [gc_db_gethandle]
+set selection [ns_db 0or1row $db [gc_query_for_domain_info $domain_id "blurb, blurb_bottom,"]]
+
+if [empty_string_p $selection] {
+    ad_return_complaint 1 "<li>Couldn't find a classifieds ad domain of \"$domain\" on this server.  Perhaps you got a mangled link?"
+    return
+}
+
+set_variables_after_query
+
+set simple_headline "<h2>$full_noun</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" [gc_system_name]] $full_noun]
+"
+
+if ![empty_string_p [ad_parameter DomainTopDecorationTop gc]] {
+    set full_headline "<table cellspacing=10><tr><td>[ad_parameter DomainTopDecorationTop gc]<td>$simple_headline</tr></table>"
+} else {
+    set full_headline $simple_headline
+}
+
+set whole_page ""
+
+append whole_page "[gc_header "$full_noun"]
+
+$full_headline
+
+<hr>
+
+\[ <a href=\"place-ad.tcl?domain_id=$domain_id\">Place An Ad</a> |
+
+<a href=\"edit-ad.tcl?domain_id=$domain_id\">Edit Old Ad</a> |
+
+<a href=\"add-alert.tcl?domain_id=$domain_id\">Add/Edit Alert</a>
+
+"
+
+if { $auction_p == "t" } {
+    append whole_page "|\n\n<a href=\"auction-hot.tcl?domain_id=$domain_id\">Hot Auctions</a>\n\n"
+}
+
+if [ad_parameter SolicitCommentsP gc 0] {
+    # there might be comments
+    append whole_page "|\n\n<a href=\"controversial-ads.tcl?domain_id=$domain_id\">Controversies</a>\n\n"
+}
+
+if ![empty_string_p [ad_second_to_last_visit_ut]] {
+    append whole_page "|\n\n<a href=\"new-since-last-visit.tcl?domain_id=$domain_id\">New Since Last Visit</a>\n\n"
+}
+
+append whole_page "
+
+\]
+
+
+<p>
+
+$blurb
+<p>
+
+<h3>Recent Ads</h3>
+
+<ul>
+
+"
+
+# rownum won't work to limit rows for this (because of the ORDER BY clause) 
+
+set selection [ns_db select $db "select classified_ad_id,one_line
+from classified_ads
+where domain_id = $domain_id
+and (sysdate() <= expires or expires is null)
+order by classified_ad_id desc"]
+
+set counter 0
+set items ""
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append items "<li><a href=\"view-one.tcl?classified_ad_id=$classified_ad_id\">
+$one_line
+</a>
+"
+    incr counter
+    if { $counter ==  $how_many_recent_ads_to_display } {
+	ns_db flush $db
+	break
+    }
+}
+
+append whole_page "
+$items
+<p><li><a href=\"domain-all.tcl?domain_id=$domain_id&by_category_p=f&wtb_p=f\">All Ads Chronologically</a>
+"
+
+if { [info exists wtb_common_p] && $wtb_common_p == "t" } {
+    append whole_page "
+(<a href=\"domain-all.tcl?domain_id=$domain_id&by_category_p=f&wtb_p=t\">including wanted to buy</a>)"
+}
+
+append whole_page "
+
+</ul>
+
+"
+
+if { $counter >=  $how_many_recent_ads_to_display } {
+    # there are more ads than shown above
+    append whole_page "
+
+<h3>Ads by Category</h3>
+
+<ul>"
+
+    # this call to util_memoize is safe because the domain has been validated
+    # in the database management system
+    append whole_page [util_memoize "gc_categories_for_one_domain {$domain_id}" 600]
+
+    append whole_page "<p><li><a href=\"domain-all.tcl?domain_id=$domain_id&by_category_p=t&wtb_p=t\">All Ads by Category</a>
+
+</ul>"
+
+    if {$geocentric_p == "t"} {
+	append whole_page "<h3>Ads by Location</h3>
+    <form action=view-location.tcl method=post>
+    By Country<br>
+    [country_widget $db "" "country"]<br>
+    By State<br>
+    [state_widget $db "" "state"]<br>
+    <input type=hidden name=domain_id value=\"$domain_id\">
+    <input type=submit name=submit value=\"List by Location\">
+    </form>
+	"
+
+    }
+}
+
+if [gc_search_active_p] {
+    append whole_page "
+<form method=post action=search.tcl method=get>
+<input type=hidden name=domain_id value=\"$domain_id\">
+or ask for a full text search:  <input type=text size=30 name=query_string>
+<input type=submit name=submit value=\"Search\">
+</form>"
+}
+
+append whole_page "
+$blurb_bottom
+
+[gc_footer "$maintainer_email"]"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $whole_page
+
Index: web/openacs/www/gc/edit-ad-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/edit-ad-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/edit-ad-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,56 @@
+# edit-ad-2.tcl,v 3.1 2000/03/10 23:58:23 curtisg Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+
+# domain_id
+
+validate_integer domain_id $domain_id
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [gc_db_gethandle]
+set selection [ns_db 1row $db [gc_query_for_domain_info $domain_id]]
+set_variables_after_query
+
+append html "[gc_header "Your Postings"]
+
+[ad_decorate_top "<h2>Your Postings</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" [gc_system_name]] [list "domain-top.tcl?[export_url_vars domain_id]" $full_noun] "Review Postings"]
+" [ad_parameter EditAd2Decoration gc]]
+
+<hr>
+
+<ul>
+"
+
+set selection [ns_db select $db "select *
+from classified_ads ca
+where domain_id = $domain_id
+and user_id=$user_id
+order by classified_ad_id desc"]
+
+set counter 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append html "<li><a href=\"edit-ad-3.tcl?classified_ad_id=$classified_ad_id\">
+$one_line
+</a> (posted [util_AnsiDatetoPrettyDate $posted] in $primary_category)
+"
+    incr counter
+} 
+
+if { $counter == 0 } { 
+    append html "<li>You have not posted any ads"
+}
+
+append html "</ul>
+
+[gc_footer $maintainer_email]"
+
+ns_return 200 text/html $html
Index: web/openacs/www/gc/edit-ad-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/edit-ad-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/edit-ad-3.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,104 @@
+# edit-ad-3.tcl,v 3.1 2000/03/10 23:58:23 curtisg Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+
+# classified_ad_id
+
+validate_integer classified_ad_id $classified_ad_id
+
+set auth_user_id [ad_verify_and_get_user_id]
+
+if { $auth_user_id == 0 } {
+    ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode /gc/edit-ad-3.tcl?[export_url_vars classified_ad_id]]"
+}
+
+set db [gc_db_gethandle]
+set selection [ns_db 0or1row $db "select 
+classified_ads.*
+from classified_ads
+where classified_ad_id = $classified_ad_id"]
+
+if { $selection == "" } {
+    ad_return_error "Could not find Ad $classified_ad_id" "Could not find Ad $classified_ad_id.
+
+<p>
+
+Either you are fooling around with the Location field in your browser,
+the ad has been deleted, or this code has a serious bug."
+       return 
+}
+
+# OK, we found the ad in the database if we are here...
+set_variables_after_query
+
+set selection [ns_db 1row $db [gc_query_for_domain_info $domain_id]]
+set_variables_after_query
+
+append html "[gc_header "Edit \"$one_line\""]
+
+<h2>Edit \"$one_line\"</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" [gc_system_name]] [list "domain-top.tcl?[export_url_vars domain_id]" $full_noun] "Edit Ad #$classified_ad_id"]
+
+<hr>
+
+<p>
+
+<h3>The Ad</h3>
+
+<ul>
+<li>One-line Summary:  $one_line
+
+<p>
+
+<li>What people see when they click on the above:
+<blockquote>
+[util_maybe_convert_to_html $full_ad $html_p]
+</blockquote>
+
+<li>Expires:  [util_AnsiDatetoPrettyDate $expires]
+
+<li>Category: $primary_category
+<p>"
+
+
+# geocentric data
+
+if { $geocentric_p == "t" } {
+
+    if {$state != ""} {
+	append html "<li>State:  [ad_state_name_from_usps_abbrev $db $state]<br>"
+    }
+
+    if {$country != ""} {
+	append html "<li>Country:  [ad_country_name_from_country_code $db $country] <br>"
+    }
+    
+}
+
+append html "
+</ul>
+
+<form method=post action=edit-ad-4.tcl>
+
+<input type=hidden name=classified_ad_id value=$classified_ad_id>
+
+
+<h3>Actions</h3>
+
+<ul>
+<li><a href=\"edit-ad-4.tcl?[export_url_vars classified_ad_id]\">edit</a>
+
+<p>
+
+<li><a href=\"delete-ad.tcl?[export_url_vars classified_ad_id]\">delete</a>
+
+</ul>
+
+[gc_footer $maintainer_email]"
+
+ns_return 200 text/html $html
\ No newline at end of file
Index: web/openacs/www/gc/edit-ad-4.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/edit-ad-4.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/edit-ad-4.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,134 @@
+# edit-ad-4.tcl,v 3.1 2000/03/10 23:58:24 curtisg Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+
+# classified_ad_id
+
+validate_integer classified_ad_id $classified_ad_id
+
+set auth_user_id [ad_verify_and_get_user_id]
+
+if { $auth_user_id == 0 } {
+    ns_returnredirect /register/index.tcl?return_url=[ns_urlencode /gc/edit-ad-4.tcl?[export_url_vars classified_ad_id]]
+}
+
+
+set db [gc_db_gethandle]
+set selection [ns_db 0or1row $db "select ca.*, to_char(expires,'YYYY-MM-DD') as ansi_expires
+from classified_ads ca
+where classified_ad_id = $classified_ad_id"]
+
+if { $selection == "" } {
+    ad_return_error "Could not find Ad $classified_ad_id" "in <a href=index.tcl>[gc_system_name]</a>
+
+<p>
+
+Either you are fooling around with the Location field in your browser
+or my code has a serious bug.  The error message from the database was
+
+<blockquote><code>
+$errmsg
+</blockquote></code>"
+       return 
+}
+
+# OK, we found the ad in the database if we are here...
+# the variable SELECTION holds the values from the db
+set_variables_after_query
+
+# we use subquery because we have to hold the seletion to make the form with bt_mergepiece
+set sub_selection [ns_db 1row $db [gc_query_for_domain_info $domain_id "insert_form_fragments,ad_deletion_blurb,"]]
+set_variables_after_subquery
+
+
+#check to see the user has the correct authentication cookie
+
+if { $auth_user_id != $user_id } {
+    ad_return_error "Unauthorized" "You are not authorized to edit this ad."
+    return
+}
+
+# OK, the response from the user matched
+# the variable SELECTION still holds the values from the db
+
+
+set raw_form "<form method=post action=edit-ad-5.tcl>
+<input type=hidden name=classified_ad_id value=$classified_ad_id>
+<input type=hidden name=user_id value=$user_id>
+
+<table>"
+
+
+if { [string first "one_line" $insert_form_fragments] == -1 } {
+	append raw_form "<tr><th align=left>One Line Summary<br>
+<td><input type=text name=one_line size=50 value=\"[philg_quote_double_quotes $one_line]\">
+</tr>
+"
+}
+
+if { [string first "full_ad" $insert_form_fragments] == -1 } {
+	append raw_form "<tr><th align=left>Full Ad<br>
+<td><textarea name=full_ad wrap=hard rows=6 cols=50>[philg_quote_double_quotes $full_ad]</textarea>
+</tr>
+<tr><th align=left>Text above is
+<td><select name=html_p><option value=f>Plain Text<option value=t>HTML</select></td>
+</tr>
+"
+}
+
+
+
+append raw_form "$insert_form_fragments
+"
+
+
+set selection_without_nulls [remove_nulls_from_ns_set $selection]
+
+set final_form [bt_mergepiece $raw_form $selection_without_nulls]
+
+ReturnHeaders
+append html "[gc_header "Edit \"$one_line\""]
+
+<h2>Edit \"$one_line\"</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" [gc_system_name]] [list "domain-top.tcl?[export_url_vars domain_id]" $full_noun] "Edit Ad #$classified_ad_id"]
+
+<hr>
+
+<p>
+$final_form
+"
+
+if {$geocentric_p == "t"} {
+    append html "<tr><th>State<td>
+    [state_widget $db $state "state"] 
+    <tr><th>Country<td>
+    [country_widget $db $country "country"]"
+}
+
+append html "<tr><th>Expires<td>
+<input name=expires type=text size=11 value=\"$ansi_expires\">  YYYY-MM-DD \[format must be exact\]
+<tr><th>Category<td>
+<select name=primary_category>
+[db_html_select_options $db "select primary_category
+from ad_categories
+where domain_id = $domain_id
+order by primary_category" $primary_category]
+</select>
+</table>
+<p>
+
+<center>
+
+<input type=submit value=\"Update Ad\">
+
+</center>
+
+</form>
+[gc_footer $maintainer_email]"
+
+ns_write $html
Index: web/openacs/www/gc/edit-ad-5.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/edit-ad-5.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/edit-ad-5.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,125 @@
+# edit-ad-5.tcl,v 3.1 2000/03/10 23:58:24 curtisg Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+
+# bunch of stuff including user_id
+
+validate_integer user_id $user_id
+
+proc gc_magic_update {db table_name primary_key_name primary_key_value form} {
+    set form_size [ns_set size $form]
+    set form_counter_i 0
+    while {$form_counter_i<$form_size} {
+	set form_var_name [ns_set key $form $form_counter_i]
+	set value [ns_set value $form $form_counter_i]
+	if { $form_var_name != $primary_key_name } {
+	    set column_type [ns_column type $db $table_name $form_var_name]
+	    if {[regexp {date|time} $column_type]&&[regexp -nocase {current} $value]} {
+		# we're using Illustra and a system function
+		set quoted_value $value
+	    } elseif { $column_type == "date" && [regexp -nocase {oracle} [ns_db dbtype $db]]} {
+		# we're using Oracle
+		if { [string tolower $value] == "sysdate" } {
+		    # wants the sysdate function, no quotes
+		    set quoted_value $value
+		} else {
+		    set quoted_value "TO_DATE('$value','YYYY-MM-DD')"
+		}
+	    } else {
+		set quoted_value [ns_dbquotevalue $value $column_type]
+	    }
+	    lappend the_sets "$form_var_name = $quoted_value"
+	}
+	incr form_counter_i
+    }
+    set primary_key_type [ns_column type $db $table_name $primary_key_name]
+    return "update $table_name\nset [join $the_sets ",\n"] \n where $primary_key_name = [ns_dbquotevalue $primary_key_value $primary_key_type]"
+}
+
+set db [gc_db_gethandle]
+
+if [catch { set selection [ns_db 1row $db "select * from classified_ads 
+where classified_ad_id = $classified_ad_id"] } errmsg ] {
+    ad_return_error "Could not find Ad $classified_ad_id" "in <a href=index.tcl>[gc_system_name]</a>
+
+<p>
+
+Either you are fooling around with the Location field in your browser
+or my code has a serious bug.  The error message from the database was
+
+<blockquote><code>
+$errmsg
+</blockquote></code>"
+       return 
+}
+
+# OK, we found the ad in the database if we are here...
+# the variable SELECTION holds the values from the db
+set_variables_after_query
+
+set selection [ns_db 1row $db [gc_query_for_domain_info $domain_id]]
+set_variables_after_query
+
+
+set auth_user_id [ad_verify_and_get_user_id]
+
+if { $auth_user_id != $user_id } {
+    ad_return_error "Unauthorized" "You are not authorized to edit this ad."
+    return
+}
+
+
+# person is authorized
+
+set update_sql [gc_magic_update $db classified_ads classified_ad_id $classified_ad_id [ns_conn form]]
+
+if [catch { ns_db dml $db "begin transaction"
+            ns_db dml $db [gc_audit_insert $classified_ad_id]
+            ns_db dml $db $update_sql 
+            ns_db dml $db "end transaction" } errmsg] {
+    # something went a bit wrong
+    set_variables_after_query
+    ad_return_error "Error Updating Ad $classified_ad_id" "<h2>Error Updating Ad $classified_ad_id</h2>
+
+in <a href=index.tcl>[gc_system_name]</a>
+
+<p>
+
+Tried the following SQL:
+
+<pre>
+$update_sql
+</pre>
+
+and got back the following:
+
+<blockquote><code>
+$errmsg
+</blockquote></code>
+
+[gc_footer $maintainer_email]"
+    return
+ } else {
+    # everything went nicely 
+    ns_return 200 text/html "[gc_header "Success"]
+
+<h2>Success!</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" [gc_system_name]] [list "domain-top.tcl?[export_url_vars domain_id]" $full_noun] "Ad Updated"]
+
+<hr>
+
+There isn't really a whole lot more to say...
+
+<p>
+
+If you'd like to check your ad, then take a look 
+at <a href=\"view-one.tcl?classified_ad_id=$classified_ad_id\">the public page</a>.
+
+
+[gc_footer $maintainer_email]"
+}
Index: web/openacs/www/gc/edit-ad.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/edit-ad.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/edit-ad.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,18 @@
+# edit-ad.tcl,v 3.1 2000/03/10 23:58:25 curtisg Exp
+set_form_variables
+set_form_variables_string_trim_DoubleAposQQ
+
+# domain_id
+
+validate_integer domain_id $domain_id
+
+#check for the user cookie
+set user_id [ad_get_user_id]
+
+if {$user_id != 0} {
+    ns_returnredirect "edit-ad-2.tcl?[export_url_vars domain_id user_id]"
+} else {
+    ns_returnredirect /register/index.tcl?return_url=[ns_urlencode /gc/edit-ad-2.tcl?domain_id=$domain_id]
+}
+
+
Index: web/openacs/www/gc/edit-alerts.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/edit-alerts.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/edit-alerts.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,94 @@
+# edit-alerts.tcl,v 3.1 2000/03/10 23:58:25 curtisg Exp
+#
+# edit-alerts.tcl
+#
+# built in 1998 by teadams@mit.edu and philg@mit.edu 
+#
+# fixed October 30, 1999 by philg to URLencode the rowid
+#
+# modified March 10, 2000 by curtisg@arsdigita.com
+# to use new alert_id primary key instead of rowid 
+#
+# displays a page summarizing a user's email alerts and offering
+# opportunities to disable or reenable them
+#
+
+set user_id [ad_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect /register/index.tcl?return_url=[ns_urlencode /gc/edit-alerts.tcl]
+}
+
+set db [gc_db_gethandle]
+set email [database_to_tcl_string $db "select email from users where user_id=$user_id"]
+
+append html "[gc_header "Edit Alerts for $email"]
+
+<h2>Edit Alerts for $email</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" [gc_system_name]] "Edit Alerts"]
+
+<hr>
+
+<blockquote>
+
+"
+
+
+set selection [ns_db select $db "select cea.*, ad.domain
+from classified_email_alerts cea, ad_domains ad
+where user_id=$user_id
+and ad.domain_id = cea.domain_id
+and sysdate() <= expires
+order by expires desc"]
+
+set alert_rows ""
+set counter 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+    if { $valid_p == "f" } {
+	# alert has been disabled for some reason
+	set status "Off"
+	set action "<a href=\"alert-reenable.tcl?[export_url_vars alert_id]\">Re-enable</a>"
+    } else {
+	# alert is enabled
+	set status "<font color=red>On</font>"
+	set action "<a href=\"alert-disable.tcl?[export_url_vars alert_id]\">Disable</a>"
+    }
+    append alert_rows "<tr><td>$status<td>$action<td>$domain<td>
+<a href=\"alert-extend.tcl?[export_url_vars alert_id]\">$expires</a>
+<td>[gc_PrettyFrequency $frequency]<td>$alert_type"
+    if { $alert_type == "all" } {
+	append alert_rows "<td>--</tr>\n"
+    } elseif { $alert_type == "keywords" } {
+	append alert_rows "<td>$keywords</tr>\n"
+    } elseif { $alert_type == "category" } {
+	append alert_rows "<td>$category</tr>\n"
+    }
+}
+
+if { $counter > 0 } {
+    append html "
+<table cellspacing=4><tr><th>Status</tr><th>Action</th><th>Domain<th>Expires</th><th>Frequency</th><th>Alert Type</th><th>type-specific info</tr>
+$alert_rows
+</table>
+"
+} else {
+    append html "currently, the database does not have any classified alerts for you"
+}
+
+append html "
+
+</blockquote>
+
+<P>
+
+<i>Note: check <a href=\"/pvt/alerts.tcl\">your site-wide alerts
+page</a> for a list of alerts that you might have in other subsystems.</i>
+
+[gc_footer [gc_system_owner]]"
+
+
+ns_return 200 text/html $html
Index: web/openacs/www/gc/email-response.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/email-response.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/email-response.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,84 @@
+# email-response.tcl,v 3.1 2000/03/10 23:58:26 curtisg Exp
+set_form_variables
+
+# classified_ad_id
+
+validate_integer classified_ad_id $classified_ad_id
+
+set db [gc_db_gethandle]
+if [catch { set selection [ns_db 1row $db "select ca.*, ad.domain
+from classified_ads ca, ad_domains ad
+where classified_ad_id = $classified_ad_id
+and ad.domain_id = ca.domain_id"] } errmsg ] {
+    ad_return_error  "Could not find Ad $classified_ad_id" "in <a href=index.tcl>[gc_system_name]</a>
+
+<p>
+
+Either you are fooling around with the Location field in your browser
+or my code has a serious bug.  The error message from the database was
+
+<blockquote><code>
+$errmsg
+</blockquote></code>
+
+[gc_footer]
+"
+       return 
+}
+
+# OK, we found the ad in the database if we are here...
+# the variable SELECTION holds the values from the db
+set_variables_after_query
+
+set selection [ns_db 1row $db "select maintainer_email, maintainer_name, backlink_title from ad_domains
+where domain_id = $domain_id"]
+set_variables_after_query
+
+set subject "Response (password) for ad $classified_ad_id"
+
+regexp {(.*/)[^/]*$} [ns_conn url] match just_the_dir
+
+append come_back_url [ns_conn location] $just_the_dir "edit-ad-3.tcl?classified_ad_id=$classified_ad_id"
+
+set body "Here's what I know about ad $classified_ad_id:
+
+Challenge:  $challenge
+Response:   $response
+One Line:   $one_line
+
+Come back to the $backlink_title Classifieds and edit your ad.
+
+The URL is $come_back_url
+"
+
+if [catch { ns_sendmail $poster_email "$maintainer_name <$maintainer_email>" $subject $body } errmsg] {
+    # couldn't send email
+    ns_return 500 text/html "[gc_header "This is not your day"]
+
+<h2>This is not your day</h2>
+
+(re: Ad $classified_ad_id in <a href=index.tcl>[gc_system_name]</a>)
+
+<p>
+
+We couldn't even mail you your password!  Here's the error message we got:
+<blockquote><code>
+$errmsg
+</blockquote></code>
+
+[gc_footer]"
+    return
+} else {
+    ns_return 200 text/html "[gc_header "Go and read your mail now"]
+
+<h2>Go and read your mail now</h2>
+
+<p>
+
+Because you'll find a message from $maintainer_email with the correct response to 
+Ad $classified_ad_id ($one_line).
+
+[gc_footer]"
+
+}
+
Index: web/openacs/www/gc/enter-basket-email-final.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/enter-basket-email-final.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/enter-basket-email-final.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,20 @@
+# enter-basket-email-final.tcl,v 3.0 2000/02/06 03:42:58 ron Exp
+set_form_variables
+set_form_variables_string_trim_DoubleAposQQ
+
+# ad_id, email
+
+validate_integer ad_id $ad_id
+
+set insert_sql "insert into user_picks (email, ad_id) 
+                values ('$QQemail',$QQad_id)"
+
+set db [gc_db_gethandle]
+
+ns_db dml $db $insert_sql
+
+ns_write "HTTP/1.0 302 Found
+Location: basket-home.tcl
+MIME-Version: 1.0
+Set-Cookie:  HearstClassifiedBasketEmail=$email; path=/;
+"
Index: web/openacs/www/gc/enter-basket-email.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/enter-basket-email.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/enter-basket-email.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,24 @@
+# enter-basket-email.tcl,v 3.1 2000/03/10 23:58:26 curtisg Exp
+set_form_variables
+
+# ad_id is the only interesting one
+
+validate_integer ad_id $ad_id
+
+ns_return 200 text/html "<html>
+<head>
+<title>Enter Email Address</title>
+</head>
+<body bgcolor=#ffffff text=#000000>
+<h2>Enter Email Address</h2>
+
+<p>
+We need your email address before we can build you a shopping basket.
+
+<form method=POST action=enter-basket-email-final.tcl>
+<input type=hidden name=ad_id value=$ad_id>
+Your full Internet email address: <input type=text name=email size=30>
+</form>
+<p>
+[gc_footer [gc_system_owner]]
+"
Index: web/openacs/www/gc/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/index.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,51 @@
+# index.tcl,v 3.1 2000/03/10 23:58:27 curtisg Exp
+set simple_headline "<h2>Welcome to [gc_system_name] </h2>
+
+[ad_context_bar_ws_or_index [gc_system_name]]
+"
+
+if ![empty_string_p [ad_parameter IndexPageDecorationTop gc]] {
+    set full_headline "<table cellspacing=10><tr><td>[ad_parameter IndexPageDecorationTop gc]<td>$simple_headline</tr></table>"
+} else {
+    set full_headline $simple_headline
+}
+
+
+append html "[gc_header [gc_system_name]]
+
+$full_headline
+
+<hr>
+
+[ad_parameter IndexPageDecorationSide gc]
+
+<ul>
+
+"
+
+set db [gc_db_gethandle]
+
+set selection [ns_db select $db "select * from ad_domains 
+where (active_p = 't' or active_p is null)
+order by upper(domain)"]
+
+set counter 0
+set items ""
+while {[ns_db getrow $db $selection]} {
+    incr counter
+    set_variables_after_query
+    append items "<li><a href=\"domain-top.tcl?domain_id=$domain_id\">$full_noun</a>\n"
+}
+
+if { $counter == 0 } {
+    append items "no domains found; looks like someone hasn't really set this up yet"
+}
+
+append html "$items
+</ul>
+
+<br clear=right>
+
+[gc_footer [ad_system_owner]]
+"
+ns_return 200 text/html $html
Index: web/openacs/www/gc/new-since-last-visit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/new-since-last-visit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/new-since-last-visit.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,100 @@
+# new-since-last-visit.tcl,v 3.1.2.1 2000/03/15 04:57:08 curtisg Exp
+set_the_usual_form_variables
+
+# domain_id
+
+validate_integer domain_id $domain_id
+
+set second_to_last_visit [ad_second_to_last_visit_ut]
+
+if [empty_string_p $second_to_last_visit] {
+    set second_to_last_visit [expr [ns_time] - 86400]
+    set explanation "We didn't find a cookie header with your last visit info, so we're going to show you ads posted or modified within the last 24 hours."
+} else {
+    set explanation "These are ads posted or modified since your last visit, which we think was [ns_fmttime $second_to_last_visit "%x %X %Z"]"
+}
+
+set db [gc_db_gethandle]
+set selection [ns_db 1row $db [gc_query_for_domain_info $domain_id]]
+set_variables_after_query
+
+append html "[gc_header "Ads Since Your Last Visit"]
+
+<h2>Ads Since Your Last Visit</h2>
+
+in the <a href=\"domain-top.tcl?domain_id=$domain_id\">$domain Classifieds</a>
+
+<hr>
+
+$explanation
+
+
+<ul>
+
+"
+
+set selection [ns_db select $db "select classified_ad_id,one_line,posted
+from classified_ads
+where domain_id = $domain_id
+and last_modified > '[ns_fmttime $second_to_last_visit "%Y-%m-%d %H:%M:%S"]'::datetime
+and (sysdate() <= expires or expires is null)
+order by classified_ad_id desc"]
+
+set items ""
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append items "<li><a href=\"view-one.tcl?classified_ad_id=$classified_ad_id\">$one_line</a> ([util_AnsiDatetoPrettyDate $posted])
+"
+}
+
+if { ![empty_string_p $items] } {
+    ns_db releasehandle $db
+    append html "$items\n\n</ul>\n\n[gc_footer  $maintainer_email]\n"
+    ns_return 200 text/html $html
+    return
+} 
+
+
+# couldn't get any ads; let's solder on
+
+append html "</ul>
+
+<p> 
+
+No new adds since [ns_fmttime $second_to_last_visit "%x %X %Z"].
+Anyway, so that you're not disappointed, here are ads from the last 24
+hours:
+
+<ul>
+"
+
+set selection [ns_db select $db "select classified_ad_id,one_line,posted
+from classified_ads
+where domain_id = $domain_id
+and last_modified > sysdate() - timespan_days(1)
+and (sysdate() <= expires or expires is null)
+order by classified_ad_id desc"]
+
+set last_24_hours_items ""
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append last_24_hours_items "<li><a href=\"view-one.tcl?classified_ad_id=$classified_ad_id\">$one_line</a>
+    "
+}
+
+ns_db releasehandle $db
+
+if { [empty_string_p $last_24_hours_items] } {
+    append html "No ads have been placed in the last 24 hours."
+} else {
+    append html $last_24_hours_items
+}
+
+append html "</ul>
+[gc_footer  $maintainer_email]
+"
+
+ns_return 200 text/html $html
+
+
+
Index: web/openacs/www/gc/place-ad-2.bu-tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/place-ad-2.bu-tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/place-ad-2.bu-tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,32 @@
+# nobody should be calling this anymore
+# it is a legacy URL from the days when 
+# a user had to tell us his or her name/email/password
+# -- philg 11/19/98
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+
+# domain_id, primary_category
+
+validate_integer domain_id $domain_id
+
+#check for the user cookie
+set user_id [ad_get_user_id]
+
+
+
+if {$user_id != 0} {
+    set db [ns_db gethandle]
+    ns_returnredirect place-ad-3.tcl?domain_id=$domain_id&primary_category=[ns_urlencode $primary_category]
+} else {
+    ns_returnredirect /register.tcl?return_url=[ns_urlencode  place-ad-3.tcl?domain_id=$domain_id&primary_category=$primary_category] }
+
+
+
+
+
+
Index: web/openacs/www/gc/place-ad-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/place-ad-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/place-ad-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,119 @@
+# place-ad-2.tcl,v 3.1 2000/03/10 23:58:29 curtisg Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+
+# domain_id, primary_category
+
+validate_integer domain_id $domain_id
+
+#check for the user cookie
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode "/gc/place-ad-2.tcl?[export_url_vars domain_id primary_category]"]"
+}
+
+set db [gc_db_gethandle]
+
+set selection [ns_db 1row $db [gc_query_for_domain_info $domain_id "insert_form_fragments, (sysdate() + default_expiration_days)::date as default_expiration_date,"]]
+set_variables_after_query
+
+set selection [ns_db 1row $db "select ad_placement_blurb from ad_categories 
+where domain_id = $domain_id
+and primary_category = '$QQprimary_category'"]
+set_variables_after_query
+
+append html "[gc_header "Place $primary_category Ad"]
+
+[ad_decorate_top "<h2>Place $primary_category Ad</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" [gc_system_name]] [list "domain-top.tcl?[export_url_vars domain_id]" $full_noun] "Place Ad, Step 2"]
+" [ad_parameter PlaceAd2Decoration gc]]
+
+<hr>
+"
+
+if {[string length $ad_placement_blurb] > 0} {
+    append html "Hints:  $ad_placement_blurb"
+}
+
+append html "
+
+<form method=post action=place-ad-3.tcl>
+[export_form_vars domain_id primary_category]
+<table>
+"
+
+if { [string first "one_line" $insert_form_fragments] == -1 } {
+    append html "<tr><th align=left>One Line Summary<br>
+<td><input type=text name=one_line size=50>
+</tr>
+"
+}
+
+if { [string first "full_ad" $insert_form_fragments] == -1 } {
+    append html "<tr><th align=left>Full Ad<br>
+<td><textarea name=full_ad wrap=hard rows=6 cols=50></textarea>
+</tr>
+<td><select name=html_p><option value=f>Plain Text<option value=t>HTML</select></td>
+</tr>
+"
+} elseif  { [string first "html_p" $insert_form_fragments] == -1 } {
+    # there was full-ad in the form fragments, but there is no corresponding html_p
+    append insert_form_fragments "<tr><th align=left>The full ad above is</td><td> <select name=html_p><option value=f>Plain Text<option value=t>HTML</select></td>
+</tr>
+"
+}
+
+append html "$insert_form_fragments
+
+<tr>
+<th align=left>Expires</th>
+<td align=left>[philg_dateentrywidget expires $default_expiration_date]
+"
+ 
+if {$geocentric_p == "t"} {
+    append html "<tr><th align=left  valign=top>State</th>
+<td align=left>[state_widget $db "" "state"]</td></tr>
+<tr><th align=left>Country</th>
+<td align=left>[country_widget $db "" "country"]</td></tr>"
+}
+
+
+
+if {$wtb_common_p == "t" && [string first "wanted_p" $insert_form_fragments] == -1 } {
+    append html "<tr><th align=left>Do you want to buy or sell?</th>
+<td align=left>
+<input name=wanted_p type=radio value=f Checked> Sell
+<input name=wanted_p type=radio value=t> Buy
+</td></tr>"
+}
+
+
+if {$auction_p == "t"} {
+    append html "<tr><th align=left>Auction?</th>
+<td align=left>
+<input name=auction_p type=radio value=t CHECKED> Yes
+<input name=auction_p type=radio value=f> No
+ (this allows members to place bids) </td></tr>"
+}
+
+append html "
+<tr><th align=left>Category</th><td>$primary_category</td></tr>
+</table>
+
+<br>
+<br>
+<center>
+<input type=submit value=\"Proceed\">
+</center>
+</form>
+
+[gc_footer $maintainer_email]
+"
+
+ns_return 200 text/html $html
Index: web/openacs/www/gc/place-ad-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/place-ad-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/place-ad-3.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,210 @@
+# place-ad-3.tcl,v 3.1 2000/03/10 23:58:29 curtisg Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+
+
+# domain_id, primary_category, html_p, lots of others
+
+validate_integer domain_id $domain_id
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [gc_db_gethandle]
+
+set selection [ns_db 1row $db [gc_query_for_domain_info $domain_id]]
+set_variables_after_query
+
+# OK, let's check the input
+
+set exception_text ""
+set exception_count 0
+
+if { ![info exists primary_category] || [empty_string_p $primary_category] } {
+    append exception_text "<li>Category is NULL.  It looks like your browser isn't passing through all the variables."
+    incr exception_count
+}
+
+
+if [catch  { ns_dbformvalue [ns_conn form] expires date expires } errmsg] {
+    incr exception_count
+    append exception_text "<li>Please make sure your expiration date is valid."
+}
+
+
+if { ![info exists expires] || $expires == "" } {
+    append exception_text "<li>Please type in an expiration date."
+    incr exception_count
+}
+
+if { [info exists full_ad] && ([empty_string_p $full_ad] || ![regexp {[A-Za-z]} $full_ad]) } {
+    append exception_text "<li>You forget to type anything for your ad"
+    incr exception_count
+}
+
+
+if { [info exists full_ad] && [string length $full_ad] > 3600} {
+    append exception_text "<li>Please limit your ad to 3600 characters"
+    incr exception_count
+}
+
+if { [info exists one_line] && [string match "*<*" $one_line] } {
+    append exception_text "<li>Please don't put any &lt; or &gt; characters in the subject line; you risk screwing up the entire forum by adding HTML tags to the subject.\n"
+    incr exception_count
+}
+
+if { [info exists one_line] && ([empty_string_p $one_line] || ![regexp {[A-Za-z]} $one_line]) } {
+    append exception_text "<li>You forget to type anything for your one-line summary.  So your ad won't be viewable from the main page."
+    incr exception_count
+}
+
+set disallow_uppercase_p [ad_parameter DisallowAllUppercase gc 1]
+
+if { $disallow_uppercase_p && [info exists full_ad] && $full_ad != "" && ![regexp {[a-z]} $full_ad] } {
+    append exception_text "<li>Your ad appears to be all uppercase.  ON THE INTERNET THIS IS CONSIDERED SHOUTING.  IT IS ALSO MUCH HARDER TO READ THAN MIXED CASE TEXT.  So we don't allow it, out of decorum and consideration for people who may be visually impaired."
+    incr exception_count
+}
+
+if { $disallow_uppercase_p && [info exists one_line] && $one_line != "" && ![regexp {[a-z]} $one_line] } {
+    append exception_text "<li>Your one line summary appears to be all uppercase.  ON THE INTERNET THIS IS CONSIDERED SHOUTING.  IT IS ALSO MUCH HARDER TO READ THAN MIXED CASE TEXT.  So we don't allow it, out of decorum and consideration for people who may be visually impaired."
+    incr exception_count
+}
+
+if { [ad_parameter DisallowReducedInSubject gc 0] && [info exists one_line] && [string first "reduced" [string tolower $one_line]] != -1 } {
+    append exception_text "<li>Your ad contains the word \"reduced\" in the subject line.  Since you're posting an ad for the first time, it is difficult to see how the price could have been reduced.  Also, it is unclear as to why any buyer would care.  The price is either fair or not fair.  Whether you were at one time asking a higher price doesn't matter."
+    incr exception_count
+}
+
+if { [ad_parameter DisallowExclamationPointInSubject gc 0] && [info exists one_line] && [string first "!" [string tolower $one_line]] != -1 } {
+    append exception_text "<li>Your ad contains an exclamation point.  That isn't really consistent with the design of this Web service, which is attempting to be subtle."
+    incr exception_count
+}
+
+set ebay_note "<li>You ad contains the string \"ebay\".  We assume that you're talking about the eBay auction Web service.  That's a wonderful service and we're very happy that you're using it.  But presumably the other people using [gc_system_name] are doing so because they aren't thrilled with eBay."
+
+if { [ad_parameter DisalloweBay gc 0] && [info exists one_line] && ([string first "ebay" [string tolower $one_line]] != -1) } {
+    append exception_text $ebay_note
+    incr exception_count
+}
+
+if { [ad_parameter DisalloweBay gc 0] && [info exists full_ad] && ([string first "ebay" [string tolower $full_ad]] != -1) } {
+    append exception_text $ebay_note
+    incr exception_count
+}
+
+set selection [ns_db select $db "select * from ad_integrity_checks where domain_id = $domain_id"]
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    # the interesting ones are $check_code (a piece of Tcl to be
+    # executed) and $error_message, in case the code returns true
+    if $check_code {
+	append exception_text $error_message
+	incr exception_count
+    }
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+append html "[gc_header "Approve Ad"]
+
+<h2>Approve Ad</h2>
+
+
+[ad_context_bar_ws_or_index [list "index.tcl" [gc_system_name]] [list "domain-top.tcl?[export_url_vars domain_id]" $full_noun] "Place Ad, Step 3"]
+
+<hr>
+
+
+<h3>One-line Summary</h3>
+
+This is the only thing that someone looking at a listing of ads will
+see.  It really needs to contain the product and the price and a \"WTB\"
+out front if this is a wanted to buy ad.
+
+<p>
+
+Here's what folks will see:  
+<blockquote>
+<b>$one_line</b>
+</blockquote>
+
+<h3>The Full Ad</h3>
+
+<blockquote>
+
+[util_maybe_convert_to_html $full_ad $html_p]
+
+</blockquote>"
+
+
+if { [info exists html_p] && $html_p == "t" } {
+
+    append html "Note: if the story has lost all of its paragraph breaks then you
+probably should have selected \"Plain Text\" rather than HTML.  Use
+your browser's Back button to return to the submission form.
+"
+
+} else {
+    append html " Note: if the story has a bunch of visible HTML tags then you probably should have selected \"HTML\" rather than \"Plain Text\".  Use your browser's Back button to return to the submission form.  " 
+}
+
+
+append html "<p>"
+
+if {$geocentric_p == "t"} {
+    append html "<h3>Location</h3>
+    <blockquote>"
+    
+    if {[string length $state] > 0} {
+	append html "State: [ad_state_name_from_usps_abbrev $db $state] <br>"
+    }
+    
+    if {[string length $country] > 0} {
+	append html "Country: [ad_country_name_from_country_code $db $country] <br>"
+    }
+}
+
+append html "</blockquote>
+<h3>Option 1:  \"I don't like this!\"</h3>
+
+If you don't like the way this ad looks, if the information isn't
+correct, if the information isn't sufficient (especially in the
+one-line summary), then just use the Back button on your browser to go
+back.
+
+<h3>Option 2:  \"This looks fine\"</h3>
+
+If everything looks ok, then just press the big button below and your ad
+will be placed.
+
+<p>
+<center>
+
+<form method=post action=\"place-ad-4.tcl\">
+
+"
+
+# generate ad_id here so that we can trap double submissions
+set classified_ad_id [database_to_tcl_string $db "select classified_ad_id_sequence.nextval from dual"]
+
+append html "
+<input type=hidden name=classified_ad_id value=\"$classified_ad_id\">
+[export_form_vars expires]
+[export_entire_form]
+
+<input type=submit value=\"Place Ad\">
+</form>
+
+</center>
+
+[gc_footer $maintainer_email]
+"
+
+ns_return 200 text/html $html
Index: web/openacs/www/gc/place-ad-4.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/place-ad-4.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/place-ad-4.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,249 @@
+# place-ad-4.tcl,v 3.1 2000/03/10 23:58:30 curtisg Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+proc philg_ns_set_to_tcl_string_cat_values {set_id} {
+    set result_list [list]
+    for {set i 0} {$i<[ns_set size $set_id]} {incr i} {
+	lappend result_list "[ns_set value $set_id $i]"
+    }
+    return [join $result_list " "]
+}
+
+set_the_usual_form_variables
+
+
+# classified_ad_id, domain_id, primary_category, html_p, expires
+# plus whatever stuff we have that is custom for each domain
+
+validate_integer classified_ad_id $classified_ad_id
+validate_integer domain_id $domain_id
+
+set user_id [ad_verify_and_get_user_id]
+
+
+# we have to do a bunch of simple integrity tests here because 
+# an AOL-type browser might have dropped the hidden vars
+
+set exception_text ""
+set exception_count 0
+
+if { ![info exists primary_category] || [empty_string_p $primary_category] } {
+    append exception_text "<li>Category is NULL.  It looks like your browser isn't passing through all the variables.  The AOL browser has been known to screw up like this.  Probably it is time to get Netscape...\n"
+    incr exception_count
+}
+
+
+if { ![info exists expires] || $expires == "" } {
+    append exception_text "<li>Expiration Date is missing.  It looks like your browser isn't passing through all the variables.  Probably time to switch to Netscape Navigator.\n"
+    incr exception_count
+}
+
+
+if { ![info exists one_line] || [empty_string_p $one_line] } {
+    append exception_text "<li>Your browser dropped your one-line ad summary.\n"
+    incr exception_count
+}
+
+
+if { ![info exists full_ad] || [empty_string_p $full_ad] } {
+    append exception_text "<li>Your browser dropped your ad.  You need to upgrade to Netscape."
+    incr exception_count
+}
+
+
+if { [info exists full_ad] && [string length $full_ad] > 3600} {
+    append exception_text "<li>Please limit your ad to 3600 characters"
+    incr exception_count
+}
+
+
+if { $exception_count > 0 } {
+    ns_log Notice "Ad posting failed at place-ad-5.tcl because of dropped field.  Browser was [util_GetUserAgentHeader]"
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+ns_set put [ns_conn form] user_id $user_id
+set poster_user_id $user_id
+
+# to provide some SPAM-proofing, we record the IP address
+set originating_ip [ns_conn peeraddr]
+
+set db [gc_db_gethandle]
+
+set selection [ns_db 1row $db [gc_query_for_domain_info $domain_id]]
+set_variables_after_query
+
+set poster_email [database_to_tcl_string $db "select email
+from users where user_id = $poster_user_id"]
+
+set form [ns_conn form]
+
+# add stuff that wasn't just in the form
+
+ns_set cput $form originating_ip $originating_ip
+
+# we don't need to add the posted time because an Oracle trigger
+# will do that
+
+# remove stuff that shouldn't be in the INSERT
+
+ns_set delkey $form ColValue.expires.month
+ns_set delkey $form ColValue.expires.day
+ns_set delkey $form ColValue.expires.year
+
+set insert_sql [util_prepare_insert $db classified_ads classified_ad_id $classified_ad_id $form]
+
+
+if [catch { ns_db dml $db $insert_sql } errmsg] {
+    # something went a bit wrong
+    if { [database_to_tcl_string $db "select count(*) from classified_ads where classified_ad_id = $classified_ad_id"] >= 0 } {
+	# user hit submit twice, use this to suppress email alerts
+	set user_hit_submit_twice_p 1
+    } else {
+	# not just the user hitting submit twice
+	ad_return_error "Error placing $primary_category Ad" "Tried the following SQL:
+
+<pre>
+$insert_sql
+</pre>
+
+and got back the following:
+
+<blockquote><code>
+$errmsg
+</blockquote></code>
+"
+       return
+    }
+}
+
+# everything went nicely and/or it is a duplicate submission but who cares
+
+append html "[gc_header "Success"]
+
+<h2>Success!</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" [gc_system_name]] [list "domain-top.tcl?[export_url_vars domain_id]" $full_noun] "Ad Placed"]
+
+<hr>
+
+OK, you got your new ad in (#$classified_ad_id).  
+You might want to take a moment 
+to <a href=\"edit-ad-2.tcl?domain_id=$domain_id\">review your older ads</a> (of which there are [database_to_tcl_string $db "select count(*) from classified_ads 
+where domain_id = $domain_id
+and user_id = $user_id"], including this one)
+
+"
+
+# Go ahead and write out the HTML,
+# so they will have something to look at while we do the emailing.
+
+ReturnHeaders
+ns_write $html
+set html {}
+
+if { [info exists user_hit_submit_twice_p] && $user_hit_submit_twice_p } {
+    # don't bother emailing
+    ns_write "[gc_footer $maintainer_email]\n"
+} else {
+    ns_write "
+
+<p>
+
+Now we're going to look for people who've said that they wanted to be
+instantly alerted of new classified ads....
+
+<ul>
+
+"
+
+set selection [ns_db select $db "select classified_email_alerts.oid as rowid, domain_id, alert_id, frequency, users_alertable.user_id as alert_user_id, alert_type, category, keywords, expires, email as alert_email
+from classified_email_alerts, users_alertable
+where classified_email_alerts.user_id= users_alertable.user_id
+and domain_id = $domain_id
+and frequency = 'instant'
+and valid_p = 't'
+and sysdate() < expires
+order by users_alertable.user_id"]
+
+# mush together everything in the form, separated by spaces
+
+set stuff_to_search [philg_ns_set_to_tcl_string_cat_values [ns_conn form]]
+
+set counter 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+    # ns_log Notice "processing instant classified alert ($alert_email, $domain, $alert_type, category: $category, keywords: $keywords)"
+
+    if { $alert_type == "all" || ( $alert_type == "category" && $category == $primary_category) || ($alert_type == "keywords" && [philg_keywords_match $keywords $stuff_to_search]) } {
+	ns_write "<li>sending email to $alert_email ... "
+	# ns_log Notice "sending email to $alert_email"
+
+	if [catch {
+	    ns_sendmail $alert_email   $poster_email $one_line "[ns_striphtml $full_ad]
+
+Note:  this message was sent to you because you have 
+an instant alert in the $domain classifieds.  If you 
+want to disable the alert that generated this message,
+visit
+
+[gc_system_url]alert-disable.tcl?alert_id=[ns_urlencode $alert_id]
+
+Here are the parameters for this alert:
+
+domain:      $domain
+alert type   $alert_type
+category     $category
+keywords     $keywords
+expires      $expires
+
+" } errmsg] {
+    ns_write "<p>
+Something is horribly wrong with the email handler on this 
+computer so we're giving up on sending any email
+notifications. Your posting will be enshrined in the database, of course. 
+
+<blockquote>
+$errmsg
+</blockquote>
+
+</ul>
+
+[ad_footer]"
+
+        ns_return 200 text/html $html
+        return
+        }
+        append html "...  success\n"
+    }
+}
+
+ns_write "
+
+</ul>
+
+"
+
+if { $counter == 0 } {
+    ns_write "<p>Nobody has an alert whose parameters match this ad."
+} else {
+    ns_write "<p>Note that if any of these people have changed
+their email address (or typed it wrong in the first place), you'll get a 
+bounce from my mail server.  Ignore it.  Your ad still went into the database.
+The reason the bounce comes to you instead of me is that this server forges
+email from \"$poster_email\" so that if the potential buyer hits Reply 
+the message will go to you and not [gc_system_owner]. "
+}
+
+ns_write "
+
+[gc_footer $maintainer_email]" 
+}
+
Index: web/openacs/www/gc/place-ad.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/place-ad.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/place-ad.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,64 @@
+# place-ad.tcl,v 3.1 2000/03/10 23:58:30 curtisg Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+
+# domain_id
+
+validate_integer domain_id $domain_id
+
+if { [ad_get_user_id] == 0 } {
+    ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode "[ns_conn url]?[export_url_vars domain_id]"]"
+    return
+}
+
+set db [gc_db_gethandle]
+set selection [ns_db 1row $db [gc_query_for_domain_info $domain_id "user_extensible_cats_p, "]]
+set_variables_after_query
+
+append html "[gc_header "Place Ad"]
+
+[ad_decorate_top "<h2>Place an Ad</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" [gc_system_name]] [list "domain-top.tcl?[export_url_vars domain_id]" $full_noun] "Place Ad"]
+" [ad_parameter PlaceAdDecoration gc]]
+
+
+<hr>
+
+<h3>Choose a Category</h3>
+
+<ul>
+"
+
+set selection [ns_db select $db "select primary_category
+from ad_categories
+where domain_id = $domain_id
+order by primary_category"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    set url "place-ad-2.tcl?domain_id=$domain_id&primary_category=[ns_urlencode $primary_category]"
+    append html "<li><a href=\"$url\">$primary_category</a>"
+}
+
+if { $user_extensible_cats_p == "t" } {
+
+    append html "<p>
+<li>None of these categories fit my ad; I'd like to 
+<a href=\"define-new-category.tcl?domain_id=$domain_id\">
+define a new one</a>"
+
+}
+
+append html "
+
+</ul>
+
+[gc_footer $maintainer_email]
+"
+
+ns_return 200 text/html $html
Index: web/openacs/www/gc/place-bid-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/place-bid-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/place-bid-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,126 @@
+# place-bid-2.tcl,v 3.1 2000/03/10 23:58:31 curtisg Exp
+set_the_usual_form_variables
+
+# bid_id, location, bid, currency
+
+validate_integer bid_id $bid_id
+
+set user_id [ad_get_user_id]
+
+# strip the dollar sign out of the bid
+
+regsub -all {\$} $bid "" sanitized_bid
+set bid [string trim $sanitized_bid]
+
+set exception_text ""
+set exception_count 0
+
+
+if { ![info exists bid] || $bid == "" } {
+    append exception_text "<li>You did not enter your bid.  This makes an auction kind of tough.\n"
+    incr exception_count
+}
+
+if { ![info exists bid] || [regexp {[^0-9.]} $bid] } { 
+    append exception_text "<li>A bid should just be a number, e.g., \"50\" or \"325.95\".  Do not put any kind of currency symbol, e.g., a dollar sign, in front, or any spaces in the middle.  Otherwise the database is going to reject the bid.\n"
+    incr exception_count
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+set db [gc_db_gethandle]
+
+# get stuff for user interface
+
+set selection [ns_db 1row $db "select domain_id, days_since_posted(posted), users.email as poster_email, users.first_names || ' ' || users.last_name as poster_name, one_line, posted, full_ad, auction_p, users.user_id as poster_user_id
+from classified_ads, users
+where classified_ads.user_id = users.user_id
+and classified_ad_id = $classified_ad_id"]
+
+set_variables_after_query
+
+# now domain_id is set, so we'll get info for a backlink
+
+set selection [ns_db 1row $db [gc_query_for_domain_info $domain_id]]
+set_variables_after_query
+
+set insert_sql "insert into classified_auction_bids (bid_id, classified_ad_id,bid,currency,bid_time,location,user_id)
+values
+($bid_id, $classified_ad_id,$bid,'$QQcurrency',sysdate(),'$QQlocation',$user_id)"
+
+if [catch { ns_db dml $db $insert_sql } errmsg] {
+    # something went a bit wrong
+    ns_return 200 text/html "[gc_header "Error placing Bid"]
+
+<h2>Error Placing Bid</h2>
+
+in <a href=\"domain-top.tcl?domain_id=$domain_id\">$full_noun Classifieds</a>
+
+<p>
+
+Tried the following SQL:
+
+<pre>
+$insert_sql
+</pre>
+
+and got back the following:
+
+<blockquote><code>
+$errmsg
+</blockquote></code>
+
+[gc_footer $maintainer_email]"
+    return 0
+}
+
+
+# insert went OK
+
+ad_get_user_info
+
+if [catch { ns_sendmail $poster_email $email "Bid for $bid $currency on $one_line" "$first_names $last_name placed a bid of $bid $currency on
+
+$one_line
+
+Come back to 
+
+[ad_url]/gc/view-one.tcl?classified_ad_id=$classified_ad_id 
+
+to see all of the bids on this item.
+
+This message was sent by a robot, though if you reply you will be doing
+so to the bidder.
+
+"} errmsg] {
+    # we couldn't send email
+    set email_blurb "We were unable to send email to $poster_email:
+
+$errmsg
+"} else {
+    set email_blurb "We notified <A HREF=\"/shared/community-member.tcl?user_id=$poster_user_id\">$poster_name</a> of your bid."
+}
+
+
+ns_return 200 text/html "[gc_header "Success"]
+
+<h2>Success!</h2>
+
+<hr>
+placing a bid on ad number $classified_ad_id in the <a href=\"domain-top.tcl?domain_id=$domain_id\">$full_noun Classifieds</a>
+
+<p>
+
+$email_blurb
+
+<p>
+
+There isn't really a whole lot more to say...  You might want to 
+have a look at <a href=\"view-one.tcl?classified_ad_id=$classified_ad_id\">the 
+ad page</a> to see how your bid looks.
+
+
+[gc_footer $maintainer_email]"
Index: web/openacs/www/gc/place-bid.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/place-bid.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/place-bid.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,101 @@
+# place-bid.tcl,v 3.2 2000/03/10 23:58:32 curtisg Exp
+set_form_variables
+
+# classified_ad_id is the key
+
+validate_integer classified_ad_id $classified_ad_id
+
+# check for the user cookie
+
+set user_id [ad_get_user_id]
+
+if {$user_id == 0} {
+    ns_returnredirect /register/index.tcl?return_url=[ns_urlencode /gc/place-bid.tcl?classified_ad_id=$classified_ad_id]
+}
+
+
+set db [gc_db_gethandle]
+
+if [catch {set selection [ns_db 1row $db "select domain_id, days_since_posted(posted) as days_since_posted, users.email as poster_email, users.first_names || ' ' || users.last_name as poster_name, users.user_id as poster_id, html_p, one_line, posted, full_ad, auction_p, users.user_id as poster_user_id
+from classified_ads, users
+where users.user_id=classified_ads.user_id
+and classified_ad_id = $classified_ad_id"]} errmsg] {
+    # error getting stuff from db
+    ad_return_error "Ad missing" "from <a href=\"index.tcl\">[gc_system_name]</a>
+
+<p>
+
+My theory is that the following occurred:
+
+<ul>
+<li>you bookmarked an ad that you thought was interesting awhile ago
+<li>someone else thought the ad was interesting and bought the item
+<li>the person who posted the ad deleted it.
+</ul>
+
+Anyway, the database choked on your request and here's what it said.. 
+
+<blockquote><code>
+$errmsg
+</blockquote></code>"
+    return
+
+}
+
+set_variables_after_query
+
+# now domain_id is set, so we'll get info for a backlink
+
+
+set selection [ns_db 1row $db [gc_query_for_domain_info $domain_id]]
+set_variables_after_query
+
+set bid_id [database_to_tcl_string $db "select classified_auction_bid_id_seq.nextval from dual"]
+
+switch $days_since_posted { 
+    0 { set age_string "today" }
+    1 { set age_string "yesterday" }
+    default { set age_string "$days_since_posted days ago" }
+} 
+
+ReturnHeaders
+
+ns_write "[gc_header "Bid on $one_line"]
+
+<h2>Place a Bid</h2>
+
+on <a href=\"view-one.tcl?[export_url_vars classified_ad_id]\">$one_line</a>
+
+<hr>
+
+advertised $age_string by <a href=\"/shared/community-member.tcl?user_id=$poster_user_id\">$poster_name</a> 
+
+<p>
+
+<form method=post action=place-bid-2.tcl>
+[export_form_vars bid_id classified_ad_id]
+<table>
+<tr><th>Your Bid<td><input type=text name=bid size=10>
+<tr><th>Currency<td><input type=text name=currency value=\"US dollars\" size=10>
+<tr><th>Your Location<td><input type=text name=location size=20> (e.g., \"New York City\")
+
+</table>
+
+<br>
+
+<center>
+<input type=submit value=\"Place Bid\">
+</center>
+</form>
+
+<h3>Just to remind you...</h3>
+
+<blockquote>
+
+[util_maybe_convert_to_html $full_ad $html_p]
+
+</blockquote>
+
+[gc_footer $maintainer_email]
+"
+
Index: web/openacs/www/gc/search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/search.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,96 @@
+# search.tcl,v 3.1 2000/03/10 23:58:32 curtisg Exp
+#
+# /gc/search.tcl
+#
+# by teadams@arsdigita.com and philg@mit.edu
+# ported from ancient (1995) crud
+#
+# displays a list of classified ads in a particular domain that match a query string
+#
+
+set_the_usual_form_variables
+
+# domain_id, query_string
+
+validate_integer domain_id $domain_id
+
+set db [gc_db_gethandle]
+
+
+set selection [ns_db 1row $db [gc_query_for_domain_info $domain_id]]
+set_variables_after_query
+
+append html "[gc_header "$full_noun Search Results"]
+
+<h2>$full_noun Search Results</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" [gc_system_name]] [list "domain-top.tcl?[export_url_vars domain_id]" $full_noun] "Search Results"]
+
+<hr>
+
+Ads matching \"$query_string\":
+
+<ul>
+"
+
+regsub -all {,+} [string trim $QQquery_string] " " final_query_string
+
+if [catch {set selection [ns_db select $db "select pseudo_contains(indexed_stuff, '$final_query_string') as the_score, ccv.*
+from classified_context_view ccv
+where pseudo_contains (indexed_stuff, '$final_query_string') > 0
+and domain_id=$domain_id
+and (expires is null or sysdate()::date <= expires::date)
+order by the_score desc"]} errmsg] {
+
+
+    ad_return_error "Error in your search" "We couldn't complete your search. Here is what the database returned:
+<p>
+<blockquote>
+<pre>
+$errmsg
+</pre>
+</blockquote>
+"
+return 
+
+}
+
+set counter 0 
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+    if { ![info exists max_score] } {
+	# first iteration, this is the highest score
+	set max_score $the_score
+    }
+
+    if {[ad_context_end_output_p $counter $the_score $max_score] == 1} {
+	ns_db flush $db
+	break
+    }
+
+    set display_string $one_line
+    append html "<li>$the_score: <a href=\"view-one.tcl?classified_ad_id=$classified_ad_id\">$display_string</a>\n"
+}
+
+    set user_id [ad_get_user_id]
+    ad_record_query_string $query_string $db "classifieds-$domain" $counter $user_id
+
+if { $counter == 0 } {
+    set search_items "ads"
+    set url "search.tcl?domain_id=$domain_id"
+    append html "[ad_context_no_results]
+    <form method=POST action=search.tcl target=\"_top\">
+    <input type=hidden name=domain_id value=\"$domain_id\">
+    New Search:  <input type=text name=query_string size=40 value=\"$query_string\">
+    </form>"
+}
+
+
+append html "</ul>
+
+[gc_footer $maintainer_email]
+"
+
+ns_return 200 text/html $html
Index: web/openacs/www/gc/view-ad-history.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/view-ad-history.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/view-ad-history.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,82 @@
+# view-ad-history.tcl,v 3.1 2000/03/10 23:58:32 curtisg Exp
+# this page is used to show a deleted ad (for community member history)
+# or an old version of a current ad (so that people can see if someone
+# is playing stupid games by adding REDUCED to an ad
+
+set_form_variables
+
+# classified_ad_id is the key
+
+validate_integer classified_ad_id $classified_ad_id
+
+append html "[gc_header "Ad $classified_ad_id"]
+
+<h2>Ad $classified_ad_id</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" [gc_system_name]] "Ad History"]
+
+<hr>
+
+<ul>
+
+"
+
+set db [gc_db_gethandle]
+
+set selection [ns_db 0or1row $db "select one_line, full_ad, html_p, last_modified 
+from classified_ads
+where classified_ad_id = $classified_ad_id"]
+
+if { $selection != "" } {
+    set_variables_after_query
+    append html "<li>Current (last modified $last_modified): $one_line
+<blockquote>
+[util_maybe_convert_to_html $full_ad $html_p]
+</blockquote>
+"
+}
+
+set selection [ns_db select $db "select domain_id, days_since_posted(posted) as days_since_posted, one_line, posted, full_ad, auction_p, html_p, caa.last_modified,
+u.user_id as poster_user_id, u.email as poster_email, u.first_names || ' ' || u.last_name as poster_name
+from classified_ads_audit caa, users u
+where classified_ad_id = $classified_ad_id
+and caa.user_id = u.user_id
+order by caa.last_modified desc"]
+
+set history_items ""
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append history_items "<li>$last_modified: $one_line
+<blockquote>
+[util_maybe_convert_to_html $full_ad $html_p]
+</blockquote>
+"
+}
+
+if ![empty_string_p $poster_user_id] {
+    set user_credit "Originally posted $posted 
+by <a href=\"/shared/community-member.tcl?user_id=$poster_user_id\">$poster_email</a> ($poster_name)
+"
+} else {
+    set user_credit ""
+}
+
+append html "$history_items
+</ul>
+
+$user_credit 
+
+<p>
+
+<blockquote><i>
+Note: this page shows the full ad history, including all intermediate
+edits before the ad was deleted.  This can help community members
+judge whether an advertiser is engaging in deceptive practices such as 
+claiming that an item has been reduced in price.
+</i></blockquote>
+
+</body>
+</html>
+"
+
+ns_return 200 text/html $html
Index: web/openacs/www/gc/view-category.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/view-category.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/view-category.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,95 @@
+# view-category.tcl,v 3.1 2000/03/10 23:58:33 curtisg Exp
+#
+# /gc/view-category.tcl
+#
+# by philg@mit.edu in 1995
+#
+# list ads within one category within one domain in the classifieds
+#
+
+set_the_usual_form_variables
+
+# domain_id, primary_category
+
+validate_integer domain_id $domain_id
+
+if { ![info exists domain_id] || [empty_string_p $domain_id] } {
+    # we don't know which domain this is
+    ns_returnredirect "/gc/"
+    return
+}
+
+if { ![info exists primary_category] || [empty_string_p $primary_category] } {
+    # we don't know which category this is
+    ns_returnredirect "domain-top.tcl?[export_url_vars domain_id]"
+    return
+}
+
+
+set whole_page ""
+
+append whole_page "[gc_header "$primary_category Ads"]
+
+<h2>$primary_category Ads</h2>"
+
+
+
+set db [gc_db_gethandle]
+set selection [ns_db 1row $db [gc_query_for_domain_info $domain_id]]
+set_variables_after_query
+
+append whole_page "
+[ad_context_bar_ws_or_index [list "index.tcl" [gc_system_name]] [list "domain-top.tcl?[export_url_vars domain_id]" $full_noun] "One Category"]
+
+
+<hr>
+
+<ul>
+"
+
+if { [info exists wtb_common_p] && $wtb_common_p == "t" } {
+    set order_by "order by wanted_p, classified_ad_id desc"
+} else {
+    set order_by "order by classified_ad_id desc"
+}
+
+set selection [ns_db select $db "select classified_ad_id,one_line, wanted_p
+from classified_ads
+where domain_id = $domain_id
+and primary_category = '$QQprimary_category'
+and ([db_sysdate] <= expires or expires is null)
+$order_by"]
+
+set counter 0
+set wanted_p_yet_p 0
+
+set items ""
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+    if { [info exists wtb_common_p] && $wtb_common_p == "t" && !$wanted_p_yet_p && $counter > 0 && $wanted_p == "t" } {
+	# we've not seen a wanted_p ad before but this isn't the first
+	# row, so write a headline
+	append items "<h4>Wanted to Buy</h4>\n"
+    }
+    if { $wanted_p == "t" } {
+	# we'll probably do this a bunch of times but that is OK
+	set wanted_p_yet_p 1
+    }
+    append items "<li><a href=\"view-one.tcl?classified_ad_id=$classified_ad_id\">
+$one_line
+</a>
+"
+
+}
+
+ns_db releasehandle $db
+
+append whole_page $items
+
+append whole_page "</ul>
+
+[gc_footer $maintainer_email]"
+
+ns_return 200 text/html $whole_page
Index: web/openacs/www/gc/view-location.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/view-location.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/view-location.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,97 @@
+# view-location.tcl,v 3.1 2000/03/10 23:58:33 curtisg Exp
+set_form_variables
+set_form_variables_string_trim_DoubleAposQQ
+
+# domain_id, country, state
+
+validate_integer domain_id $domain_id
+
+# Error Count and List
+set exception_count 0
+set exception_text ""
+
+if {$state == "" && $country == ""} {
+    incr exception_count
+    append exception_text "<li> Please select a country or state."
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+set db [gc_db_gethandle]
+
+if {$state != ""} {
+    set state_name  " [ad_state_name_from_usps_abbrev $db $state]"
+} else {
+    set state_name ""
+}
+
+
+if {$country != ""} {
+    set country_name  " [ad_country_name_from_country_code $db $country]"
+} else {
+    set country_name ""
+}
+
+
+append html "[gc_header "Ads in  $country_name $state_name"]
+
+<h2>Ads in $country_name $state_name</h2>
+
+
+<p>
+
+<ul>
+"
+
+set selection [ns_db 1row $db [gc_query_for_domain_info $domain_id]]
+set_variables_after_query
+
+
+if { [info exists wtb_common_p] && $wtb_common_p == "t" } {
+    set order_by "order by wanted_p, classified_ad_id desc"
+} else {
+    set order_by "order by classified_ad_id desc"
+}
+
+#  if an ad is listed as 'Iowa' and no county, it will still turn up
+#  under a state for US and state Iowa (seach by state overrides)
+
+set selection [ns_db select $db "select classified_ad_id,one_line, wanted_p
+from classified_ads
+where domain_id = $domain_id
+and (state = '$state' or '$state' is null)
+and (country = '$country' or '$country' is null or '$state' is not null) 
+and ([db_sysdate] <= expires or expires is null)
+$order_by"]
+
+set counter 0
+set wanted_p_yet_p 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+    if { [info exists wtb_common_p] && $wtb_common_p == "t" && !$wanted_p_yet_p && $counter > 0 && $wanted_p == "t" } {
+	# we've not seen a wanted_p ad before but this isn't the first
+	# row, so write a headline
+	append html "<h4>Wanted to Buy</h4>\n"
+    }
+    if { $wanted_p == "t" } {
+	# we'll probably do this a bunch of times but that is OK
+	set wanted_p_yet_p 1
+    }
+    append html "<li><a href=\"view-one.tcl?classified_ad_id=$classified_ad_id\">
+$one_line
+</a>
+"
+
+}
+
+append html "</ul>
+
+[gc_footer $maintainer_email]"
+
+ns_return 200 text/html $html
Index: web/openacs/www/gc/view-one.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/view-one.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/view-one.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,164 @@
+# view-one.tcl,v 3.1 2000/03/10 23:58:34 curtisg Exp
+# this page is used to display one ad to a user; we do not sign the page
+# with the maintainer email of the realm because otherwise naive users
+# will send that person bids on items
+
+set_form_variables
+
+# classified_ad_id is the key
+
+validate_integer classified_ad_id $classified_ad_id
+
+set db [gc_db_gethandle]
+
+if [catch {set selection [ns_db 1row $db "select employer, salary_range, classified_ads.state, classified_ads.country, domain_id, html_p, days_since_posted(posted) as days_since_posted, reply_to_poster_p,  one_line, posted, full_ad, auction_p as ad_auction_p, users.email as poster_email, users.first_names || ' ' || users.last_name as poster_name, users.user_id as poster_id
+from classified_ads, users
+where classified_ads.user_id = users.user_id
+and classified_ad_id = $classified_ad_id"]} errmsg] {
+    # error getting stuff from db
+    ns_return 404 text/html "[gc_header "Ad missing"]
+
+<h2>Ad missing</h2>
+
+<p>
+
+Perhaps:
+
+<ul>
+<li>you bookmarked an ad that you thought was interesting awhile ago
+<li>someone else thought the ad was interesting and bought the item
+<li>the person who posted the ad deleted it.
+</ul>
+
+Anyway, the database choked on your request and here's what it said.. 
+
+<blockquote><code>
+$errmsg
+</blockquote></code>
+
+[gc_footer [ad_system_owner]]"
+     return
+}
+
+set_variables_after_query
+
+# now domain_id is set
+
+set selection [ns_db 1row $db [gc_query_for_domain_info $domain_id]]
+set_variables_after_query
+
+switch $days_since_posted { 
+    0 { set age_string "today" }
+    1 { set age_string "yesterday" }
+    default { set age_string "$days_since_posted days ago" }
+} 
+
+# for GeoCentric classifieds, we'll want to say where this is from
+if {$geocentric_p == "t"} {
+    set geocentric_info "<p>\n"    
+    if { ![empty_string_p $country] } {
+	append geocentric_info "Country:   [ad_country_name_from_country_code $db $country]<br>\n"
+    }
+    if { ![empty_string_p $state] } {
+	append geocentric_info "State:   [ad_state_name_from_usps_abbrev $db $state]<br>\n"
+    }
+} else {
+    set geocentric_info ""
+}
+
+set action_items [list]
+
+if { $ad_auction_p == "t" && $auction_p != "f" } {
+    lappend action_items "<a href=\"place-bid.tcl?classified_ad_id=$classified_ad_id\">Place a bid</a> <font size=-1>(an email notice will be sent to the advertiser)</font> "
+    lappend action_items "<a href=\"mailto:$poster_email\">Reply privately to $poster_email</a>"
+    set selection [ns_db select $db "select bid, bid_time, currency, location, 
+email as bidder_email, first_names || ' ' || last_name as bidder_name, users.user_id as bidder_user_id
+from classified_auction_bids, users
+where users.user_id = classified_auction_bids.user_id
+and classified_ad_id = $classified_ad_id 
+order by bid_time desc"]
+
+    set bid_items ""
+    while {[ns_db getrow $db $selection]} {
+	set_variables_after_query
+	append bid_items "<li>[string trim $bid] $currency bid by
+<a href=\"/shared/community-member.tcl?user_id=$bidder_user_id\">$bidder_name</a>
+on [util_AnsiDatetoPrettyDate $bid_time] in $location
+"
+    }
+    if ![empty_string_p $bid_items] {
+	set bid_history "<h3>Bids</h3>\n<ul>\n$bid_items\n</ul>\n"
+    } else {
+	set bid_history ""
+    }
+} else {
+    # not an auction
+    lappend action_items "<a href=\"mailto:$poster_email\">email $poster_email</a>"
+    set bid_history ""
+}
+
+lappend action_items  "<a href=\"/shared/community-member.tcl?user_id=$poster_id\">view $poster_name's history as a community member</a>"
+
+
+set n_audit_rows [database_to_tcl_string $db "select count(*) as n_audit_rows from classified_ads_audit where classified_ad_id = $classified_ad_id"]
+
+if { $n_audit_rows > 0 } {
+    lappend action_items "<a href=\"view-ad-history.tcl?classified_ad_id=$classified_ad_id\">view previous versions of this ad</a>
+<font size=-1 color=red>(this ad has been edited)</font>
+"
+}
+
+set comment_html [ad_general_comments_list $db  $classified_ad_id classified_ads $one_line gc]
+
+ns_db releasehandle $db
+
+if [ad_parameter IncludeBannerIdeasP gc 0] {
+    set banneridea_html "<br>
+<br>
+
+<center>
+<hr width=95% size=1 noshade>
+[bannerideas_random]
+</center>
+"
+} else {
+    set banneridea_html ""
+
+}
+
+ns_return 200 text/html "[gc_header $one_line]
+
+<h2>$one_line</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" [gc_system_name]] [list "domain-top.tcl?[export_url_vars domain_id]" $full_noun] "One Ad"]
+
+<hr>
+advertised $age_string 
+by
+<a href=\"/shared/community-member.tcl?user_id=$poster_id\">$poster_name</a>
+
+
+<blockquote>
+
+[util_maybe_convert_to_html $full_ad $html_p]
+
+$geocentric_info
+
+</blockquote>
+
+<h3>Take Action</h3>
+
+<ul>
+<li>
+[join $action_items "\n<li>"]
+</ul>
+
+$comment_html
+
+$bid_history
+
+$banneridea_html
+</body>
+</html>
+"
+
Index: web/openacs/www/gc/admin/ads-from-one-category.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/admin/ads-from-one-category.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/admin/ads-from-one-category.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,70 @@
+# ads-from-one-category.tcl,v 3.1 2000/03/10 23:58:47 curtisg Exp
+set_the_usual_form_variables
+
+# domain_id, primary_category
+
+validate_integer domain_id $domain_id
+
+set db [gc_db_gethandle]
+set selection [ns_db 1row $db "select full_noun from ad_domains where domain_id = $domain_id"]
+set_variables_after_query
+
+append html "[ad_admin_header "$primary_category Classified Ads"]
+
+<h2>$primary_category Ads</h2>
+
+[ad_context_bar_ws_or_index [list "/gc/" "Classifieds"] [list "index.tcl" "Classifieds Admin"] [list "domain-top.tcl?domain_id=[ns_urlencode $domain_id]" $full_noun] [list "manage-categories-for-domain.tcl?[export_url_vars domain_id]" "Categories"] "One Category"]
+
+
+<hr>
+
+<h3>$primary_category Ads</h3>
+
+<ul>
+"
+
+set selection [ns_db select $db "select classified_ad_id, one_line, primary_category, classified_ads.user_id, email as poster_email, posted, last_modified as edited_date, expired_p(expires) as expired_p, originating_ip, decode(last_modified, posted, 'f', 't') as ever_edited_p
+from classified_ads, users
+where users.user_id = classified_ads.user_id
+and domain_id = $domain_id
+and primary_category = '$QQprimary_category'
+order by classified_ad_id desc"]
+
+set items ""
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    if { $originating_ip == "" } {
+	set ip_stuff ""
+    } else {
+	set ip_stuff "(at 
+<a href=\"ads-from-one-ip.tcl?domain_id=[ns_urlencode $domain_id]&originating_ip=[ns_urlencode $originating_ip]\">$originating_ip</a>)"
+    }
+    if { $expired_p == "t" } {
+	set expired_flag "<font color=red>expired</font>; "
+    } else {
+	set expired_flag ""
+    }
+    append items "<li>$classified_ad_id $primary_category:
+$one_line<br>
+(${expired_flag}submitted by
+<a href=\"ads-from-one-user.tcl?[export_url_vars domain_id user_id]\">$poster_email</a> $ip_stuff $posted"
+    if { $ever_edited_p == "t" } { 
+	 append items "; edited $edited_date"
+    }
+    append items ")
+\[<a target=another_window href=\"edit-ad.tcl?classified_ad_id=$classified_ad_id\">Edit</a> |
+<a target=another_window href=\"delete-ad.tcl?classified_ad_id=$classified_ad_id\">Delete</a> \]
+"
+
+}
+
+append html $items
+
+append html "
+</ul>
+
+[ad_admin_footer]"
+
+ns_db releasehandle $db
+ns_return 200 text/html $html
Index: web/openacs/www/gc/admin/ads-from-one-ip.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/admin/ads-from-one-ip.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/admin/ads-from-one-ip.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,76 @@
+# ads-from-one-ip.tcl,v 3.1 2000/03/10 23:58:47 curtisg Exp
+set_form_variables
+set_form_variables_string_trim_DoubleAposQQ
+
+# domain_id, originating_ip
+
+validate_integer domain_id $domain_id
+
+set db [gc_db_gethandle]
+set selection [ns_db 1row $db "select * from ad_domains where domain_id = $domain_id"]
+set_variables_after_query
+
+append html "[ad_header "$domain Classified Ads"]
+
+<h2>Classified Ads</h2>
+
+from $originating_ip in <a href=\"domain-top.tcl?domain_id=$domain_id\">$domain</a>
+
+<hr>
+
+<h3>The Ads</h3>
+
+<ul>
+"
+
+set selection [ns_db select $db "select classified_ad_id, one_line, primary_category, classified_ads.user_id, email as poster_email, posted, last_modified as edited_date, expired_p(expires) as expired_p, decode(last_modified, posted, 'f', 't') as ever_edited_p
+from classified_ads, users
+where users.user_id = classified_ads.user_id
+and domain_id = $domain_id
+and originating_ip = '$QQoriginating_ip'
+order by classified_ad_id desc"]
+
+while {[ns_db getrow $db $selection]} {
+
+    set_variables_after_query
+    if { $expired_p == "t" } {
+	set expired_flag "<font color=red>expired</font>; "
+    } else {
+	set expired_flag ""
+    }
+    append html "<li>$classified_ad_id $primary_category:
+$one_line<br>
+(${expired_flag}submitted by
+<a href=\"ads-from-one-user.tcl?[export_url_vars domain_id user_id]\">$poster_email</a> $posted"
+     if { $ever_edited_p == "t" } { 
+	 append html "; edited $edited_date"
+     }
+     append html ")
+\[<a target=another_window href=\"edit-ad.tcl?classified_ad_id=$classified_ad_id\">Edit</a> |
+<a target=another_window href=\"delete-ad.tcl?classified_ad_id=$classified_ad_id\">Delete</a> \]
+
+"
+
+}
+
+
+
+append html "
+</ul>
+
+
+Doing a reverse DNS now:  $originating_ip maps to ...  
+
+"
+
+append html "[ns_hostbyaddr $originating_ip]
+
+<P>
+
+(note: if you just get the number again, that means the hostname could
+not be found.)
+
+[ad_admin_footer]"
+
+ns_db releasehandle $db
+ns_return 200 text/html $html
Index: web/openacs/www/gc/admin/ads-from-one-user.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/admin/ads-from-one-user.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/admin/ads-from-one-user.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,90 @@
+# ads-from-one-user.tcl,v 3.1 2000/03/10 23:58:47 curtisg Exp
+set_the_usual_form_variables
+
+# domain_id, user_id
+
+validate_integer domain_id $domain_id
+validate_integer user_id $user_id
+
+set db [gc_db_gethandle]
+set selection [ns_db 1row $db "select full_noun from ad_domains where domain_id = $domain_id"]
+set_variables_after_query
+
+set selection [ns_db 1row $db "select first_names, last_name, email 
+from users
+where user_id = $user_id"]
+set_variables_after_query
+
+append html "[ad_header "Ads from $email"]
+
+<h2>Ads from $email</h2>
+
+[ad_context_bar_ws_or_index [list "/gc/" "Classifieds"] [list "index.tcl" "Classifieds Admin"] [list "domain-top.tcl?domain_id=$domain_id" $full_noun] "One User"]
+
+<hr>
+
+<ul>
+<li>user admin page: 
+<a href=\"/admin/users/one.tcl?user_id=$user_id\">$first_names $last_name</a>
+
+<li>email:  <a href=\"mailto:$email\">$email</a>
+
+
+</ul>
+
+<h3>The Ads</h3>
+
+<ul>
+"
+
+set selection [ns_db select $db "select classified_ad_id, one_line, primary_category, posted, last_modified as edited_date, expired_p(expires) as expired_p, originating_ip, decode(last_modified, posted, 'f', 't') as ever_edited_p
+from classified_ads, users
+where users.user_id = classified_ads.user_id
+and domain_id = $domain_id
+and classified_ads.user_id = $user_id
+order by classified_ad_id desc"]
+
+set counter 0
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+    if { [empty_string_p $originating_ip] } {
+	set ip_stuff ""
+    } else {
+	set ip_stuff "at 
+<a href=\"ads-from-one-ip.tcl?domain=[ns_urlencode $domain_id]&originating_ip=[ns_urlencode $originating_ip]\">$originating_ip</a>"
+    }
+
+    if { $expired_p == "t" } {
+	set expired_flag "<font color=red>expired</font>; "
+    } else {
+	set expired_flag ""
+    }
+    append html "<li>$classified_ad_id $primary_category:
+$one_line<br>
+($ip_stuff; $posted"
+     if { $ever_edited_p == "t" } { 
+	 append html "; edited $edited_date"
+     }
+     append html ")
+\[<a target=another_window href=\"edit-ad.tcl?classified_ad_id=$classified_ad_id\">Edit</a> |
+<a target=another_window href=\"delete-ad.tcl?classified_ad_id=$classified_ad_id\">Delete</a> \]
+"
+
+}
+
+append html "
+</ul>
+
+"
+
+if { $counter != 0 } {
+    append html "<p>
+You can <a href=\"delete-ads-from-one-user.tcl?[export_url_vars domain_id user_id]\">delete all of the above ads</a>.
+"
+}
+
+append html [ad_admin_footer]
+
+ns_db releasehandle $db
+ns_return 200 text/html $html
Index: web/openacs/www/gc/admin/ads.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/admin/ads.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/admin/ads.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,85 @@
+# ads.tcl,v 3.1 2000/03/10 23:58:47 curtisg Exp
+# will display all ads or some number of days worth 
+
+set_the_usual_form_variables
+
+# domain_id, optional num_days 
+
+validate_integer domain_id $domain_id
+
+set db [gc_db_gethandle]
+set selection [ns_db 1row $db "select * from ad_domains where domain_id = $domain_id"]
+set_variables_after_query
+
+if { ![info exists num_days] || [empty_string_p $num_days] || $num_days == "all" } {
+    # all the ads 
+    set description "All Ads"
+    set day_limit_clause ""
+} else {
+    validate_integer num_days $num_days
+
+    set day_limit_clause "\nand posted > ([db_sysdate] - $num_days)"
+    if { $num_days == 1 } {
+	set description "Ads from last 24 hours"
+    } else {
+	set description "Ads from last $num_days days"
+    }
+}
+
+
+append html "[ad_admin_header "$domain Classified Ads"]
+
+<h2>Classified Ads</h2>
+
+[ad_context_bar_ws_or_index [list "/gc/" "Classifieds"] [list "index.tcl" "Classifieds Admin"] [list "domain-top.tcl?domain_id=$domain_id" $full_noun] $description]
+
+
+<hr>
+
+<h3>The Ads</h3>
+
+<ul>
+
+"
+
+set selection [ns_db select $db "select classified_ad_id, one_line, primary_category,posted, last_modified as edited_date, originating_ip, users.user_id, email as poster_email, decode(last_modified, posted, 'f', 't') as ever_edited_p
+from classified_ads, users 
+where domain_id = $domain_id
+and users.user_id = classified_ads.user_id
+and (sysdate <= expires or expires is null) $day_limit_clause
+order by classified_ad_id desc"]
+
+set items ""
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    if { $originating_ip == "" } {
+	set ip_stuff ""
+    } else {
+	set ip_stuff "(at 
+<a href=\"ads-from-one-ip.tcl?domain_id=$domain_id&originating_ip=[ns_urlencode $originating_ip]\">$originating_ip</a>)"
+    }
+    append items "<li>$classified_ad_id $primary_category:
+$one_line<br>
+(from 
+<a href=\"ads-from-one-user.tcl?[export_url_vars domain_id user_id]\">$poster_email</a> $ip_stuff on $posted"
+     if { $ever_edited_p == "t" } { 
+	 append items "; edited $edited_date"
+     }
+     append items ")
+\[<a target=another_window href=\"edit-ad.tcl?classified_ad_id=$classified_ad_id\">Edit</a> |
+<a target=another_window href=\"delete-ad.tcl?classified_ad_id=$classified_ad_id\">Delete</a> \]
+
+"
+
+}
+
+append html $items
+
+append html "
+</ul>
+
+[ad_admin_footer]
+"
+
+ns_db releasehandle $db
+ns_return 200 text/html $html
Index: web/openacs/www/gc/admin/alert-toggle.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/admin/alert-toggle.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/admin/alert-toggle.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,21 @@
+# alert-toggle.tcl,v 3.1 2000/03/10 23:58:47 curtisg Exp
+set_form_variables
+
+# alert_id, domain_id
+
+validate_integer alert_id $alert_id
+validate_integer domain_id $domain_id
+
+set db [ns_db gethandle]
+
+if [catch {ns_db dml $db "update classified_email_alerts set valid_p = logical_negation(valid_p) where alert_id = $alert_id"} errmsg] {
+    ad_return_error "Error Editing Alert" "Here's what the database produced:
+
+<blockquote><code>
+$errmsg
+</blockquote></code>
+"
+return
+}
+
+ns_returnredirect "view-alerts.tcl?[export_url_vars domain_id]"
Index: web/openacs/www/gc/admin/community-view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/admin/community-view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/admin/community-view.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,75 @@
+# community-view.tcl,v 3.1 2000/03/10 23:58:47 curtisg Exp
+set_the_usual_form_variables
+
+# domain_id, n_postings, hairy AOLserver widgets for start_date, end_date
+
+validate_integer domain_id $domain_id
+validate_integer n_postings $n_postings
+
+# pull out start_date, end_date (ANSI format that will make Oracle hurl)
+
+ns_dbformvalue [ns_conn form] start_date date start_date
+ns_dbformvalue [ns_conn form] end_date date end_date
+
+
+set db [ns_db gethandle]
+set selection [ns_db 1row $db "select * from ad_domains where domain_id = $domain_id"]
+set_variables_after_query
+
+append html "[ad_admin_header "Users who've made $n_postings postings between $start_date and $end_date"]
+
+<h2>Users</h2>
+
+[ad_context_bar_ws_or_index [list "/gc/" "Classifieds"] [list "index.tcl" "Classifieds Admin"] [list "domain-top.tcl?domain=$domain_id" $full_noun] "Users with $n_postings postings"]
+
+
+
+<hr>
+
+Here are the participants who've made at least $n_postings postings
+between $start_date and $end_date...
+
+<ul>
+
+"
+
+if { $n_postings < 2 } {
+    set sql "select users.user_id, email, count(*) as how_many_posts
+from classified_ads , users
+where classified_ads.user_id = users.user_id
+and domain_id = $domain_id
+and posted >= to_date('$start_date','YYYY-MM-DD')
+and posted <= to_date('$end_date','YYYY-MM-DD')
+group by users.user_id, email
+order by how_many_posts desc"
+} else {
+    set sql "select users.user_id, email, count(*) as how_many_posts
+from classified_ads, users 
+where classified_ads.user_id = users.user_id 
+and domain_id = $domain_id
+and posted >= to_date('$start_date','YYYY-MM-DD')
+and posted <= to_date('$end_date','YYYY-MM-DD')
+group by users.user_id, email
+having count(*) >= $n_postings
+order by how_many_posts desc"
+}
+
+set selection [ns_db select $db $sql]
+set count 0
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append html "<li><a href=\"ads-from-one-user.tcl?[export_url_vars user_id domain_id]\">$email</a> ($how_many_posts)\n"
+    incr count
+}
+
+if { $count == 0 } {
+    append html "<li>None"
+}
+append html "</ul>
+
+[ad_admin_footer]
+"
+
+ns_db releasehandle $db
+ns_return 200 text/html $html
Index: web/openacs/www/gc/admin/delete-ad-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/admin/delete-ad-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/admin/delete-ad-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,89 @@
+# delete-ad-2.tcl,v 3.1 2000/03/10 23:58:47 curtisg Exp
+set admin_id [ad_verify_and_get_user_id]
+if { $admin_id == 0 } {
+    ns_returnredirect "/register/"
+    return
+}
+
+set_the_usual_form_variables
+
+# classified_ad_id
+# maybe user_charge (and if so, then perhaps charge_comment)
+
+validate_integer classified_ad_id $classified_ad_id
+
+set db [ns_db gethandle]
+
+if [catch { set selection [ns_db 1row $db "select ca.one_line, ca.full_ad, ca.domain_id, u.user_id, u.email, u.first_names, u.last_name, ad.domain
+from classified_ads ca, ad_domains ad, users u
+where ca.user_id = u.user_id
+and ad.domain_id = ca.domain_id
+and classified_ad_id = $classified_ad_id"] } errmsg ] {
+    ad_return_error "Could not find Ad $classified_ad_id" "Either you are fooling around with the Location field in your browser
+or my code has a serious bug.  The error message from the database was
+
+<blockquote><code>
+$errmsg
+</blockquote></code>"
+       return 
+}
+set_variables_after_query
+
+if [catch { ns_db dml $db "begin transaction"
+            ns_db dml $db [gc_audit_insert $classified_ad_id 1]
+            ns_db dml $db "delete from classified_auction_bids where classified_ad_id = $classified_ad_id"
+            ns_db dml $db "delete from classified_ads where classified_ad_id = $classified_ad_id"
+            ns_db dml $db "end transaction" } errmsg] {
+	# we shouldn't be able to get here except because of 
+	# violating integrity constraints
+	ad_return_error "Could not delete Ad $classified_ad_id" "I think my code must have a serious bug.
+The error message from the database was
+
+<blockquote><code>
+$errmsg
+</blockquote></code>"
+        return
+}
+
+append html "[gc_header "Ad $classified_ad_id Deleted"]
+
+<h2>Ad $classified_ad_id Deleted</h2>
+
+[ad_context_bar_ws_or_index [list "/gc/" "Classifieds"] [list "index.tcl" "Classifieds Admin"] [list "domain-top.tcl?domain_id=$domain_id" $domain] "Ad Deleted"]
+
+<hr>
+
+Deletion of ad $classified_ad_id confirmed.\n\n
+
+"
+
+if { [info exists user_charge] && ![empty_string_p $user_charge] } {
+    if { [info exists charge_comment] && ![empty_string_p $charge_comment] } {
+	# insert separately typed comment
+	set user_charge [mv_user_charge_replace_comment $user_charge $charge_comment]
+    }
+    append html "<p> ... adding a user charge:
+<blockquote>
+[mv_describe_user_charge $user_charge]
+</blockquote>
+... "
+    mv_charge_user $db $user_charge "Deleting your ad from [ad_system_name]" "We had to delete your ad from [ad_system_name].
+
+For clarity, here is what we had in the database..
+
+Subject:  $one_line
+
+Full Ad:
+
+$full_ad
+"
+    append html "Done."
+}
+
+append html "
+
+[ad_admin_footer]
+"
+
+ns_db releasehandle $db
+ns_return 200 text/html $html
Index: web/openacs/www/gc/admin/delete-ad.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/admin/delete-ad.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/admin/delete-ad.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,92 @@
+# delete-ad.tcl,v 3.1 2000/03/10 23:58:48 curtisg Exp
+ad_maybe_redirect_for_registration
+
+set admin_id [ad_get_user_id]
+
+set_the_usual_form_variables
+
+# classified_ad_id
+
+validate_integer classified_ad_id $classified_ad_id
+
+set db [ns_db gethandle]
+
+if [catch { set selection [ns_db 1row $db "select ca.one_line, ca.full_ad, ca.domain_id, u.user_id, u.email, u.first_names, u.last_name, ad.domain
+from classified_ads ca, ad_domains ad, users u
+where ca.user_id = u.user_id
+and ad.domain_id = ca.domain_id
+and classified_ad_id = $classified_ad_id"] } errmsg ] {
+    ad_return_error "Could not find Ad $classified_ad_id" "Either you are fooling around with the Location field in your browser
+or my code has a serious bug.  The error message from the database was
+
+<blockquote><code>
+$errmsg
+</blockquote></code>"
+       return 
+}
+
+# OK, we found the ad in the database if we are here...
+# the variable SELECTION holds the values from the db
+set_variables_after_query
+
+# now we know to what domain this ad belongs
+
+if ![ad_administration_group_member $db "gc" $domain $admin_id] {
+    ad_return_error "Unauthorized" "Unauthorized" 
+    return
+}
+
+if [ad_parameter EnabledP "member-value"] {
+    set mistake_wad [mv_create_user_charge $user_id  $admin_id "classified_ad_mistake" $classified_ad_id [mv_rate ClassifiedAdMistakeRate]]
+    set spam_wad [mv_create_user_charge $user_id $admin_id "classified_ad_spam" $classified_ad_id [mv_rate ClassifiedAdSpamRate]]
+    set options [list [list "" "Don't charge user"] [list $mistake_wad "Mistake of some kind, e.g., duplicate posting"] [list $spam_wad "Spam or other serious policy violation"]]
+    set member_value_section "<h3>Charge this user for his sins?</h3>
+<select name=user_charge>\n"
+    foreach sublist $options {
+	set value [lindex $sublist 0]
+	set visible_value [lindex $sublist 1]
+	append member_value_section "<option value=\"[philg_quote_double_quotes $value]\">$visible_value\n"
+    }
+    append member_value_section "</select>
+<br>
+<br>
+Charge Comment:  <input type=text name=charge_comment size=50>
+<br>
+<br>
+<br>"
+} else {
+    set member_value_section ""
+}
+
+
+ns_return 200 text/html "[gc_header "Confirm Deletion"]
+
+<h2>Confirm Deletion</h2>
+
+[ad_context_bar_ws_or_index [list "/gc/" "Classifieds"] [list "index.tcl" "Classifieds Admin"] [list "domain-top.tcl?domain_id=$domain_id" $domain] "Delete Ad #$classified_ad_id"]
+
+
+<hr>
+
+<form method=POST action=delete-ad-2.tcl>
+[export_form_vars classified_ad_id]
+$member_value_section
+<P>
+<center>
+<input type=submit value=\"Yes, delete this ad.\">
+</center>
+</form>
+
+<h3>$one_line</h3>
+
+<blockquote>
+$full_ad
+<br>
+<br>
+-- <a href=\"/admin/users/one.tcl?user_id=$user_id\">$first_names $last_name</a> 
+(<a href=\"mailto:$email\">$email</a>)
+</blockquote>
+
+
+[ad_admin_footer]"
+
Index: web/openacs/www/gc/admin/delete-ads-from-one-user-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/admin/delete-ads-from-one-user-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/admin/delete-ads-from-one-user-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,137 @@
+# delete-ads-from-one-user-2.tcl,v 3.1.2.1 2000/03/14 22:40:55 curtisg Exp
+set admin_id [ad_verify_and_get_user_id]
+if { $admin_id == 0 } {
+    ns_returnredirect "/register/"
+    return
+}
+
+set_the_usual_form_variables
+
+# classified_ad_id, user_id, domain_id
+# maybe user_charge (and if so, then perhaps charge_comment)
+
+validate_integer classified_ad_id $classified_ad_id
+validate_integer user_id $user_id
+validate_integer domain_id $domain_id
+
+set db [ns_db gethandle]
+
+set audit_sql "insert into classified_ads_audit 
+ (classified_ad_id,
+  user_id,
+  domain_id,
+  originating_ip,
+  posted,
+  expires,
+  wanted_p,
+  private_p,
+  primary_category,
+  subcategory_1,
+  subcategory_2,
+  manufacturer,
+  model,
+  one_line,
+  full_ad,
+  html_p,
+  last_modified,
+  audit_ip,
+  deleted_by_admin_p)
+select 
+  classified_ad_id,
+  user_id,
+  domain_id,
+  originating_ip,
+  posted,
+  expires,
+  wanted_p,
+  private_p,
+  primary_category,
+  subcategory_1,
+  subcategory_2,
+  manufacturer,
+  model,
+  one_line,
+  full_ad,
+  html_p,
+  last_modified,
+  '[DoubleApos [ns_conn peeraddr]]',
+  't'
+from classified_ads 
+where user_id = $user_id
+and domain_id = $domain_id"
+
+set delete_bids_sql "delete from classified_auction_bids
+where classified_ad_id in
+   (select classified_ad_id 
+    from classified_ads
+    where user_id = $user_id
+    and domain_id = $domain_id)"
+
+set delete_ads_sql "delete from classified_ads 
+where user_id = $user_id
+and domain_id = $domain_id"
+
+if [catch { ns_db dml $db "begin transaction"
+            ns_db dml $db $audit_sql
+            ns_db dml $db $delete_bids_sql
+            ns_db dml $db $delete_ads_sql 
+            ns_db dml $db "end transaction" } errmsg] {
+	# we shouldn't be able to get here except because of 
+	# violating integrity constraints
+	ad_return_error "Could not delete Ads from user $user_id" "I think my code must have a serious bug.
+The error message from the database was
+
+<blockquote><code>
+$errmsg
+</blockquote></code>"
+        return
+}
+
+set domain [database_to_tcl_string $db "select domain from ad_domains
+where domain_id = $domain_id"]
+
+append html "[gc_header "Ads from User $user_id Deleted"]
+
+<h2>Ads from User $user_id Deleted</h2>
+
+in the <a href=\"domain-top.tcl?domain_id=$domain_id\"> $domain domain of [gc_system_name]</a>
+
+<hr>
+
+Deletion of ads confirmed.\n\n
+
+"
+
+if { [info exists user_charge] && ![empty_string_p $user_charge] } {
+    if { [info exists charge_comment] && ![empty_string_p $charge_comment] } {
+	# insert separately typed comment
+	set user_charge [mv_user_charge_replace_comment $user_charge $charge_comment]
+    }
+    append html "<p> ... adding a user charge:
+<blockquote>
+[mv_describe_user_charge $user_charge]
+</blockquote>
+... "
+    mv_charge_user $db $user_charge "Deleted your ads from [ad_system_name]" "We had to delete your ads from [ad_system_name].
+
+Comment:  $charge_comment
+
+(most likely you've violated the stated policy against screaming with
+all-uppercase words or using other attention-getting characters in the
+subject line).
+
+Sorry for deleting all of your ads but that is really the only
+possible way for a free site like this to stay afloat.  We can't
+afford to pick through every ad so the easiest thing to do is just
+click once and delete all the ads.
+"
+    append html "Done."
+}
+
+append html "
+
+[ad_admin_footer]
+"
+
+ns_db releasehandle $db
+ns_return 200 text/html $html
Index: web/openacs/www/gc/admin/delete-ads-from-one-user.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/admin/delete-ads-from-one-user.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/admin/delete-ads-from-one-user.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,68 @@
+# delete-ads-from-one-user.tcl,v 3.1.2.1 2000/03/15 05:04:53 curtisg Exp
+set admin_id [ad_verify_and_get_user_id]
+if { $admin_id == 0 } {
+    ns_returnredirect "/register/"
+    return
+}
+
+set_the_usual_form_variables
+
+# domain_id, user_id
+
+validate_integer domain_id $domain_id
+validate_integer user_id $user_id
+
+set db [ns_db gethandle]
+
+set classified_ad_id [database_to_tcl_string $db "select max(classified_ad_id) from classified_ads where user_id = $user_id"]
+
+if [ad_parameter EnabledP "member-value"] {
+    set mistake_wad [mv_create_user_charge $user_id  $admin_id "classified_ad_mistake" $classified_ad_id [mv_rate ClassifiedAdMistakeRate]]
+    set spam_wad [mv_create_user_charge $user_id $admin_id "classified_ad_spam" $classified_ad_id [mv_rate ClassifiedAdSpamRate]]
+    set options [list [list "" "Don't charge user"] [list $mistake_wad "Mistake of some kind, e.g., duplicate posting"] [list $spam_wad "Spam or other serious policy violation"]]
+    set member_value_section "<h3>Charge this user for his sins?</h3>
+<select name=user_charge>\n"
+    foreach sublist $options {
+	set value [lindex $sublist 0]
+	set visible_value [lindex $sublist 1]
+	append member_value_section "<option value=\"[philg_quote_double_quotes $value]\">$visible_value\n"
+    }
+    append member_value_section "</select>
+<br>
+<br>
+Charge Comment:  <input type=text name=charge_comment size=50>
+<br>
+<br>
+<br>"
+} else {
+    set member_value_section ""
+}
+
+set domain [database_to_tcl_string $db "select domain from ad_domains
+where domain_id = $domain_id"]
+
+set user_name [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id = $user_id"]
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "[gc_header "Confirm Deletion"]
+
+<h2>Confirm Deletion</h2>
+
+of ads from 
+<a href=\"/admin/users/one.tcl?user_id=$user_id\">$user_name</a>
+in the
+ <a href=\"domain-top.tcl?domain_id=$domain_id\"> $domain domain of [gc_system_name]</a>
+
+<hr>
+
+<form method=POST action=delete-ads-from-one-user-2.tcl>
+[export_form_vars domain_id user_id]
+$member_value_section
+<P>
+<center>
+<input type=submit value=\"Yes, delete these ads.\">
+</center>
+</form>
+
+[ad_admin_footer]"
Index: web/openacs/www/gc/admin/delete-email-alerts.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/admin/delete-email-alerts.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/admin/delete-email-alerts.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,41 @@
+# delete-email-alerts.tcl,v 3.1 2000/03/10 23:58:48 curtisg Exp
+set_form_variables
+set_form_variables_string_trim_DoubleAposQQ
+
+# bad_addresses (separated by spaces, thus a Tcl list)
+
+set db [ns_db gethandle]
+
+set sql "delete from classified_email_alerts where user_id in (select user_id from users where upper(email) in ('[join [string toupper $QQbad_addresses] "','"]'))"
+
+ns_db dml $db $sql
+
+set n_alerts_killed [ns_pg ntuples $db]
+
+set domain [database_to_tcl_string $db "select domain
+from ad_domains where domain_id = $domain_id"]
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "<html>
+<head>
+<title>Alerts Deleted</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Alerts Deleted</h2>
+
+in <a href=\"domain-top.tcl?[export_url_vars domain_id]\">$domain classifieds</a>
+<hr>
+
+
+Deleted a total of $n_alerts_killed alerts for the following email addresses:
+
+<blockquote>
+$bad_addresses
+</blockquote>
+
+<hr>
+<address>philg@mit.edu</address>
+</body>
+</html>"
Index: web/openacs/www/gc/admin/domain-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/admin/domain-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/admin/domain-add-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,134 @@
+# domain-add-2.tcl,v 3.1 2000/03/10 23:58:49 curtisg Exp
+set_the_usual_form_variables
+
+# domain_id, full_noun, domain, user_id_from_search, 
+# first_names_from_search, last_name_from_search, email_from_search
+
+validate_integer domain_id $domain_id
+validate_integer user_id_from_search $user_id_from_search
+
+# user error checking
+
+set exception_text ""
+set exception_count 0
+
+if { ![info exists full_noun] || [empty_string_p $full_noun] } {
+    incr exception_count
+    append exception_text "<li>Please enter a name for this domain."
+}
+
+if { ![info exists domain] || [empty_string_p $domain] } {
+    incr exception_count
+    append exception_text "<li>Please enter a short key."
+}
+
+if { ![info exists domain_id] || [valid_number_p $domain_id] } {
+    incr exception_count
+    append exception_text "<li>Please have a valid domain ID."
+}
+
+if { $exception_count > 0 } { 
+  ad_return_complaint $exception_count $exception_text
+  return
+}
+
+set db [ns_db gethandle]
+
+if { [database_to_tcl_string $db "select count(domain) from ad_domains where domain = '$QQdomain'"] > 0 } {
+    ad_return_error "$domain already exists" "A domain with a short key \"$domain\" already exists in [ad_system_name].  The short key must be unique. Perhaps there is a conflict with an existing domain or you double clicked and submitted the form twice."
+    return
+}  
+
+ns_db dml $db "begin transaction"
+
+ns_db dml $db "insert into ad_domains 
+(domain_id, primary_maintainer_id, domain, full_noun) 
+values
+($domain_id, $user_id_from_search, '$QQdomain', '$QQfull_noun')"
+
+# create an administration group for users authorized to
+# delete and edit ads
+ns_db dml $db "declare begin administration_group_add('Admin group for the $QQdomain classifieds', 'gc', '$QQdomain', 'f'); end;"
+
+ns_db dml $db "end transaction"
+
+append html "[ad_admin_header "Add a domain, Step 2"]
+
+<h2>Add domain</h2>
+
+[ad_context_bar_ws_or_index [list "/gc/" "Classifieds"] [list "index.tcl" "Classifieds Admin"] "Add domain, Step 2"]
+
+
+<hr>
+
+<form method=post action=domain-add-3.tcl>
+<H3>User Interface</H3>
+Annotation for the top of the domain page:<br>
+<textarea cols=60 rows=6 wrap=soft type=text name=blurb></textarea>
+<p>
+Annotation for the bottom of the domain page: <br>
+<textarea cols=60 rows=6 wrap=soft type=text name=blurb_bottom></textarea><br>
+<H3>Ad Parameters</H3>
+By default, a full ad and a short description will be collected for all ads.  To include more fields, write the form fragment to collect the ad data you desire.  This fragment will be place inside a 2 column table.
+<br>
+Valid fields:
+<table>
+<tr><th align=left>Name</th><th align=left>Properties</th></tr>
+<tr><td>manufacturer</td><td>Maxlength 50</td></tr>
+<tr><td>model</td><td>Maxlength 50</td></tr>
+<tr><td>item_size</td><td>Maxlength 100</td></tr>
+<tr><td>color</td><td>Maxlength 50</td></tr>
+<tr><td>us_citizen_p</td><td>\"t\" or \"f\"</td></tr>
+</table>
+<br>
+The default below is a sample of a form fragment
+that incorporates all the above fields.  Modify this
+to use the fields and annotation you desire.<br>
+
+<textarea cols=60 rows=6 wrap=soft type=text name=insert_form_fragments>
+<tr><th align=left>Manufacturer</th><td><input type=text name=manufacturer maxlength=50></td></tr>
+<tr><th align=left>Model</th><td><input type=text name=model maxlength=50></td></tr>
+<tr><th align=left>Item Size</th><td><input type=text name=item_size maxlength=100></td></tr> 
+<tr><th align=left>Color</th><td><input type=text name=color maxlength=50></td></tr>
+<tr><th align=left>US  Citizenship required</th><td>Yes<input type=radio name=us_citizen_p value=\"t\">
+No<input type=radio name=us_citizen_p value=\"f\"></td></tr>
+</textarea>
+
+<table>
+<tr>
+<td>
+Default expiration days:
+</td><td> 
+<input type=text name=default_expiration_days size=3 value=30>
+</td></tr>
+<tr><td>
+Do you want to allow \"Wanted to by\" adds?  
+</td><td>
+<input type=radio name=wtb_common_p value=\"t\">Yes
+<input type=radio name=wtb_common_p value=\"f\">No
+</td></tr>
+<tr><td>
+Do you wish to have auctions on this site?  
+</td><td>
+<input type=radio name=auction_p value=\"t\">Yes
+<input type=radio name=auction_p value=\"f\">No
+</td></tr>
+<tr><td>
+Are your ads based on geography?
+</td><td>
+<input type=radio name=geocentric_p value=\"t\">Yes
+<input type=radio name=geocentric_p value=\"f\">No
+</td></tr>
+</table>
+<p>
+
+<center>
+<input type=submit name=submit value=\"Proceed\">
+</center>
+[export_form_vars domain_id domain]
+</form>
+[ad_admin_footer]
+"
+
+ns_db releasehandle $db
+ns_return 200 text/html $html
Index: web/openacs/www/gc/admin/domain-add-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/admin/domain-add-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/admin/domain-add-3.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,44 @@
+# domain-add-3.tcl,v 3.1 2000/03/10 23:58:49 curtisg Exp
+set_the_usual_form_variables
+
+# domain_id, domain, insert_form_fragments, default_expiration_days,
+# wtb_common_p, auction_p, geocentric_p
+# submit
+
+validate_integer domain_id $domain_id
+
+# user error checking
+
+set exception_text ""
+set exception_count 0
+
+if { [info exists insert_for_fragments] && [string length $insert_form_fragments] > 4000 } {
+    incr exception_count
+    append exception_text "<li>Please limit you form fragment for ad parameters to 4000 characters."
+}
+
+if { $exception_count > 0 } { 
+  ad_return_complaint $exception_count $exception_text
+  return
+}
+
+set db [ns_db gethandle]
+
+ns_set delkey [ns_conn form] submit
+
+
+set sql_statement  [util_prepare_update $db ad_domains domain_id $domain_id [ns_conn form]]
+
+
+if [catch { ns_db dml $db $sql_statement } errmsg] {
+	    ad_return_error "Failure to update domain information" "The database rejected the attempt:
+	    <blockquote>
+<pre>
+$errmsg
+</pre>
+</blockquote>
+"
+    return
+}
+
+ns_returnredirect "index.tcl"
Index: web/openacs/www/gc/admin/domain-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/admin/domain-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/admin/domain-add.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,41 @@
+# domain-add.tcl,v 3.1 2000/03/10 23:58:49 curtisg Exp
+
+set db [ns_db gethandle]
+set domain_id [database_to_tcl_string $db "select ad_domain_id_seq.nextval from dual"]
+ns_db releasehandle $db
+
+return 200 text/html "[ad_admin_header "Add a domain"]
+
+<h2>Add domain</h2>
+
+[ad_context_bar_ws_or_index [list "/gc/" "Classifieds"] [list "index.tcl" "Classifieds Admin"] "Add domain"]
+
+<hr>
+
+<form method=post action=/user-search.tcl>
+<input type=hidden name=target value=\"/admin/gc/domain-add-2.tcl\">
+<input type=hidden name=passthrough value=\"full_noun domain\">
+<input type=hidden name=custom_title value=\"Choose a Member to Add as an Administrator\">
+
+<H3>Identity</H3>
+<table>
+<tr><td>Full domain name:<td><input type=text name=full_noun></tr>
+<tr><td>Pick a short key:<td><input type=text name=domain></tr>
+</table>
+<h3>Administration</h3>
+Search for a user to be primary administrator of this domain by<br>
+<table border=0>
+<tr><td>Email address:<td><input type=text name=email  size=40 [export_form_value email]></tr>
+<tr><td colspan=2>or by</tr>
+<tr><td>Last name:<td><input type=text name=last_name size=40></tr>
+</table>
+
+<p>
+
+<center>
+<input type=submit name=submit value=\"Proceed\">
+</center>
+
+</form>
+[ad_admin_footer]
+"
Index: web/openacs/www/gc/admin/domain-administrator-update-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/admin/domain-administrator-update-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/admin/domain-administrator-update-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,14 @@
+# domain-administrator-update-2.tcl,v 3.1 2000/03/10 23:58:49 curtisg Exp
+set_the_usual_form_variables
+
+# domain_id, user_id_from_search
+# first_names_from_search, last_name_from_search, email_from_search
+
+validate_integer domain_id $domain_id
+validate_integer user_id_from_search $user_id_from_search
+
+set db [ns_db gethandle]
+
+ns_db dml $db "update ad_domains set primary_maintainer_id = $user_id_from_search where domain_id = $domain_id"
+
+ns_returnredirect "domain-top.tcl?[export_url_vars domain_id]"
\ No newline at end of file
Index: web/openacs/www/gc/admin/domain-administrator-update.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/admin/domain-administrator-update.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/admin/domain-administrator-update.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,49 @@
+# domain-administrator-update.tcl,v 3.1 2000/03/10 23:58:49 curtisg Exp
+set_the_usual_form_variables
+
+# domain_id
+
+validate_integer domain_id $domain_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select ad_domains.*,
+users.email from ad_domains, users
+where domain_id = $domain_id
+and users.user_id(+) = ad_domains.primary_maintainer_id"] 
+set_variables_after_query
+
+set action "Edit administrator for $domain"
+
+append html "[ad_header "$action"]
+
+<h2>$action</h2>
+
+in <a href=\"index.tcl\">[neighbor_system_name] administration</a>
+<hr>
+
+<form action=\"/user-search.tcl\" method=post>
+[export_form_vars domain_id]
+<input type=hidden name=target value=\"/admin/gc/domain-administrator-update-2.tcl\">
+<input type=hidden name=passthrough value=\"domain_id\">
+<input type=hidden name=custom_title value=\"Choose a Member for the Administrator of $domain classifieds\">
+
+<h3></h3>
+<p>
+Search for a user to be primary administrator of this domain by<br>
+<table border=0>
+<tr><td>Email address:<td><input type=text name=email  size=40 [export_form_value email]></tr>
+<tr><td colspan=2>or by</tr>
+<tr><td>Last name:<td><input type=text name=last_name size=40></tr>
+</table>
+
+<center>
+<input type=submit name=submit value=\"Proceed\">
+</center>
+[export_form_vars category_id]
+</form>
+[neighbor_footer]
+"
+
+ns_db releasehandle $db
+ns_return 200 text/html $html
Index: web/openacs/www/gc/admin/domain-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/admin/domain-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/admin/domain-edit-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,55 @@
+# domain-edit-2.tcl,v 3.1 2000/03/10 23:58:50 curtisg Exp
+set_the_usual_form_variables
+
+# domain_id, domain, insert_form_fragments, default_expiration_days,
+# wtb_common_p, auction_p, geocentric_p
+# submit
+
+validate_integer domain_id $domain_id
+
+# user error checking
+
+set exception_text ""
+set exception_count 0
+
+if { ![info exists full_noun] || [empty_string_p $full_noun] } {
+    incr exception_count
+    append exception_text "<li>Please enter a name for this domain."
+}
+
+if { ![info exists domain] || [empty_string_p $domain] } {
+    incr exception_count
+    append exception_text "<li>Please enter a short key."
+}
+
+
+if { [info exists insert_for_fragments] && [string length $insert_form_fragments] > 4000 } {
+    incr exception_count
+    append exception_text "<li>Please limit you form fragment for ad parameters to 4000 characters."
+}
+
+if { $exception_count > 0 } { 
+  ad_return_complaint $exception_count $exception_text
+  return
+}
+
+set db [ns_db gethandle]
+
+ns_set delkey [ns_conn form] submit
+
+
+set sql_statement  [util_prepare_update $db ad_domains domain_id $domain_id [ns_conn form]]
+
+
+if [catch { ns_db dml $db $sql_statement } errmsg] {
+	    ad_return_error "Failure to update domain information" "The database rejected the attempt:
+	    <blockquote>
+<pre>
+$errmsg
+</pre>
+</blockquote>
+"
+    return
+}
+
+ns_returnredirect "domain-top.tcl?[export_url_vars domain]"
Index: web/openacs/www/gc/admin/domain-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/admin/domain-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/admin/domain-edit.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,87 @@
+# domain-edit.tcl,v 3.1 2000/03/10 23:58:50 curtisg Exp
+set_the_usual_form_variables
+
+# domain_id
+
+validate_integer domain_id $domain_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select * from ad_domains
+where domain_id=$domain_id"]
+set_variables_after_query
+
+append html "[ad_admin_header "Edit $domain parameters"]
+
+<h2>Edit $domain parameters</h2>
+
+in the <a href=\"index.tcl\"> classifieds</a>
+
+<hr>
+
+<form method=post action=domain-edit-2.tcl>
+<H3>Identity</H3>
+Full domain name: <input type=text name=full_noun value=\"$full_noun\"><br>
+Pick a short key : <input type=text name=domain value=\"$domain\"><br>
+<H3>User Interface</H3>
+Annotation for the top of the domain page:<br>
+<textarea cols=60 rows=6 wrap=soft type=text name=blurb>[ns_quotehtml $blurb]</textarea>
+<p>
+Annotation for the bottom of the domain page: <br>
+<textarea cols=60 rows=6 wrap=soft type=text name=blurb_bottom>[ns_quotehtml $blurb_bottom]</textarea><br>
+<H3>Ad Parameters</H3>
+By default, a full ad and a short description will be collected for all ads.  To include more fields, write the form fragment to collect the ad data you desire.  This fragment will be place inside a 2 column table.
+<br>
+Valid fields:
+<table>
+<tr><th align=left>Name</th><th align=left>Properties</th></tr>
+<tr><td>manufacturer</td><td>Maxlength 50</td></tr>
+<tr><td>model</td><td>Maxlength 50</td></tr>
+<tr><td>item_size</td><td>Maxlength 100</td></tr>
+<tr><td>color</td><td>Maxlength 50</td></tr>
+<tr><td>us_citizen_p</td><td>\"t\" or \"f\"</td></tr>
+</table>
+<br>
+<textarea cols=60 rows=6 wrap=soft type=text name=insert_form_fragments>[ns_quotehtml $insert_form_fragments]</textarea>
+<table>
+<tr>
+<td>
+Default expiration days:
+</td><td> 
+<input type=text name=default_expiration_days size=3 value=\"$default_expiration_days\">
+</td></tr>
+<tr><td>
+Do you want to allow \"Wanted to by\" adds?  
+</td><td>"
+
+set html_form "<input type=radio name=wtb_common_p value=\"t\">Yes
+<input type=radio name=wtb_common_p value=\"f\">No
+</td></tr>
+<tr><td>
+Do you wish to have auctions on this site?  
+</td><td>
+<input type=radio name=auction_p value=\"t\">Yes
+<input type=radio name=auction_p value=\"f\">No
+</td></tr>
+<tr><td>
+Are your ads based on geography?
+</td><td>
+<input type=radio name=geocentric_p value=\"t\">Yes
+<input type=radio name=geocentric_p value=\"f\">No"
+
+
+append html "[bt_mergepiece $html_form $selection]
+</td></tr>
+</table>
+<p>
+
+<center>
+<input type=submit name=submit value=\"Proceed\">
+</center>
+[export_form_vars domain_id]
+</form>
+[ad_admin_footer]
+"
+
+ns_db releasehandle $db
+ns_return 200 text/html $html
Index: web/openacs/www/gc/admin/domain-top.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/admin/domain-top.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/admin/domain-top.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,73 @@
+# domain-top.tcl,v 3.1 2000/03/10 23:58:50 curtisg Exp
+ad_maybe_redirect_for_registration
+
+set_the_usual_form_variables
+
+set user_id [ad_get_user_id]
+
+# domain_id
+
+validate_integer domain_id $domain_id
+
+set db [gc_db_gethandle]
+
+set selection [ns_db 1row $db [gc_query_for_domain_info $domain_id ad_domains.rowid,]]
+set_variables_after_query
+
+if ![ad_administration_group_member $db "gc" $domain $user_id] {
+    ad_return_error "Unauthorized" "Unauthorized" 
+    return
+}
+
+append html "[ad_admin_header "Administer the $domain Classifieds"]
+
+<h2>Administration</h2>
+
+[ad_context_bar_ws_or_index [list "/gc/" "Classifieds"] [list "index.tcl" "Classifieds Admin"] $full_noun]
+
+<hr>
+
+<ul>
+<p>
+
+<H3> The ads</h3>
+<li><a href=\"/gc/domain-top.tcl?domain_id=$domain_id\">user's view for $domain classifieds</a>
+<p>
+<li> <form action=ads.tcl method=post>
+Ads from the last <select name=num_days>[ad_integer_optionlist 1 30]</select>
+[export_form_vars domain_id] day(s)
+<input type=submit name=submit value=\"Go\">
+</form>
+
+<li><a href=\"ads.tcl?domain_id=$domain_id&num_days=all\">all ads</a>
+
+<H3>Users</h3>
+<li>
+Pick out the users who've posted at least
+
+<form method=post action=community-view.tcl>
+[export_form_vars domain_id]
+<input type=text name=n_postings value=1 size=4> time(s)
+
+between
+
+[_ns_dateentrywidget start_date]
+
+and
+
+[_ns_dateentrywidget end_date]
+
+
+<input type=submit value=\"Go\">
+
+</form>
+
+<li> <a href=\"view-alerts.tcl?[export_url_vars domain_id]\">View alerts</a>
+
+</ul>
+
+
+[ad_admin_footer]"
+
+ns_db releasehandle $db
+ns_return 200 text/html $html
Index: web/openacs/www/gc/admin/edit-ad-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/admin/edit-ad-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/admin/edit-ad-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,106 @@
+# edit-ad-2.tcl,v 3.1 2000/03/10 23:58:50 curtisg Exp
+ad_maybe_redirect_for_registration
+
+set_the_usual_form_variables
+
+set admin_id [ad_get_user_id]
+
+# bunch of stuff including classified_ad_id; maybe user_charge
+# actually most of these will have gotten overwritten by 
+# set_variables_after_query after the next query
+
+validate_integer classified_ad_id $classified_ad_id
+
+set db [ns_db gethandle]
+
+if [catch { set selection [ns_db 1row $db "select ca.*, ad.domain
+from classified_ads ca, ad_domains ad
+where ad.domain_id = ca.domain_id and
+classified_ad_id = $classified_ad_id"] } errmsg ] {
+    ad_return_error "Could not find Ad $classified_ad_id" "Either you are fooling around with the Location field in your browser
+or my code has a serious bug.  The error message from the database was
+
+<blockquote><code>
+$errmsg
+</blockquote></code>"
+       return 
+}
+
+# OK, we found the ad in the database if we are here...
+# the variable SELECTION holds the values from the db
+set_variables_after_query
+
+# now we know to what domain this ad belongs
+
+if ![ad_administration_group_member $db "gc" $domain $admin_id] {
+    ad_return_error "Unauthorized" "Unauthorized" 
+    return
+}
+
+set update_sql [util_prepare_update $db classified_ads classified_ad_id $classified_ad_id [ns_conn form]]
+
+if [catch { ns_db dml $db $update_sql } errmsg] {
+    # something went a bit wrong
+    set_variables_after_query
+    ad_return_error "Error Updating Ad $classified_ad_id" "Tried the following SQL:
+
+<pre>
+$update_sql
+</pre>
+
+and got back the following:
+
+<blockquote><code>
+$errmsg
+</blockquote></code>"
+    return
+
+} else {
+
+    # everything went nicely 
+    append html "[gc_header "Success"]
+
+<h2>Success!</h2>
+
+[ad_context_bar_ws_or_index [list "/gc/" "Classifieds"] [list "index.tcl" "Classifieds Admin"] [list "domain-top.tcl?domain_id=$domain_id" $domain] "Edit Ad #$classified_ad_id"]
+
+<hr>
+
+"
+
+if { [info exists user_charge] && ![empty_string_p $user_charge] } {
+    if { [info exists charge_comment] && ![empty_string_p $charge_comment] } {
+	# insert separately typed comment
+	set user_charge [mv_user_charge_replace_comment $user_charge $charge_comment]
+    }
+    append html "<p> ... adding a user charge:
+<blockquote>
+[mv_describe_user_charge $user_charge]
+</blockquote>
+... "
+    mv_charge_user $db $user_charge "Editing your ad in [ad_system_name]" "We had to edit your ad in [ad_system_name].
+
+For clarity, here is what we had in the database..
+
+Subject:  $one_line
+
+Full Ad:
+
+$full_ad
+"
+    append html "Done."
+}
+
+
+append html "
+
+<p>
+
+If you'd like to check the ad, then take a look 
+at <a href=\"/gc/view-one.tcl?classified_ad_id=$classified_ad_id\">the public page</a>.
+
+[ad_admin_footer]"
+}
+
+ns_db releasehandle $b
+ns_return 200 text/html $html
Index: web/openacs/www/gc/admin/edit-ad.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/admin/edit-ad.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/admin/edit-ad.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,149 @@
+# edit-ad.tcl,v 3.1 2000/03/10 23:58:50 curtisg Exp
+# /gc/admin/edit-ad.tcl 
+# a script for letting a domain administrator edit a user's classified
+
+ad_maybe_redirect_for_registration
+
+set_the_usual_form_variables
+
+set admin_id [ad_get_user_id]
+
+# classified_ad_id
+
+validate_integer classified_ad_id $classified_ad_id
+
+set db [gc_db_gethandle]
+if [catch { set selection [ns_db 1row $db "select ca.*, ad.domain,
+to_char(expires,'YYYY-MM-DD') as ansi_expires
+from classified_ads ca, ad_domains ad
+where ad.domain_id = ca.domain_id and
+classified_ad_id = $classified_ad_id"] } errmsg] {
+    ad_return_error "Could not find Ad $classified_ad_id" "Either you are fooling around with the Location field in your browser
+or my code has a serious bug.  The error message from the database was
+
+<blockquote><code>
+$errmsg
+</blockquote></code>"
+       return
+}
+
+# OK, we found the ad in the database if we are here...
+# the variable SELECTION holds the values from the db
+set_variables_after_query
+
+# now we know to what domain this ad belongs
+
+if ![ad_administration_group_member $db "gc" $domain $admin_id] {
+    ad_return_error "Unauthorized" "Unauthorized" 
+    return
+}
+
+# user wants to edit the ad
+set selection_domain [ns_db 1row $db "select full_noun, insert_form_fragments, wtb_common_p, geocentric_p, auction_p from ad_domains where domain_id = $domain_id"]
+set_variables_after_query_not_selection $selection_domain
+
+if { [string first "full_ad" $insert_form_fragments] == -1 } {
+    set insert_form_fragments  [concat "<tr><th align=left>Full Ad<br>
+<td><textarea name=full_ad wrap=hard rows=6 cols=50></textarea>
+</tr>
+<td><select name=html_p><option value=f>Plain Text<option value=t>HTML</select></td></tr>" $insert_form_fragments]
+
+} elseif  { [string first "html_p" $insert_form_fragments] == -1 } {
+    # there was full-ad in the form fragments, but there is no corresponding html_p
+    append insert_form_fragments "<tr><th align=left>The full ad above is</td><td> <select name=html_p><option value=f>Plain Text<option value=t>HTML</select></td></tr>"
+}
+
+if { [string first "one_line" $insert_form_fragments] == -1 } {
+    set insert_form_fragments [concat "<tr><th align=left>One Line Summary<br>
+    <td><input type=text name=one_line  size=50>
+    </tr>" $insert_form_fragments]
+}
+set raw_form "<form method=post action=edit-ad-2.tcl>
+<input type=hidden name=classified_ad_id value=$classified_ad_id>
+
+<table>
+$insert_form_fragments
+"
+
+
+if {$geocentric_p == "t"} {
+    append raw_form "<tr><th align=left  valign=top>State</th>
+    <td align=left>[state_widget $db "" "state"]</td></tr>
+    <tr><th align=left>Country</th>
+    <td align=left>[country_widget $db "" "country"]</td></tr>"
+}
+
+if {$wtb_common_p == "t" && [string first "wanted_p" $insert_form_fragments] == -1 } {
+    append raw_form "<tr><th align=left>Do you want to buy or sell?</th>
+    <td align=left>
+    <input name=wanted_p type=radio value=f> Sell
+    <input name=wanted_p type=radio value=t> Buy
+    </td></tr>"
+}
+
+if {$auction_p == "t"} {
+    append raw_form "<tr><th align=left>Auction?</th>
+    <td align=left>
+    <input name=auction_p type=radio value=t> Yes
+    <input name=auction_p type=radio value=f> No
+    (this allows members to place bids) </td></tr>"
+}
+
+set selection_without_nulls [remove_nulls_from_ns_set $selection]
+set final_form [bt_mergepiece $raw_form $selection_without_nulls]
+
+if [ad_parameter EnabledP "member-value"] {
+    set mistake_wad [mv_create_user_charge $user_id  $admin_id "classified_ad_mistake" $classified_ad_id [mv_rate ClassifiedAdMistakeRate]]
+    set spam_wad [mv_create_user_charge $user_id $admin_id "classified_ad_spam" $classified_ad_id [mv_rate ClassifiedAdSpamRate]]
+    set options [list [list "" "Don't charge user"] [list $mistake_wad "Mistake of some kind, e.g., duplicate posting"] [list $spam_wad "Spam or other serious policy violation"]]
+    set member_value_section "<h3>Charge this user for his sins?</h3>
+<select name=user_charge>\n"
+    foreach sublist $options {
+	set value [lindex $sublist 0]
+	set visible_value [lindex $sublist 1]
+	append member_value_section "<option value=\"[philg_quote_double_quotes $value]\">$visible_value\n"
+    }
+    append member_value_section "</select>
+<br>
+<br>
+Charge Comment:  <input type=text name=charge_comment size=50>
+<br>
+<br>
+<br>"
+} else {
+    set member_value_section ""
+}
+
+
+append html "[gc_header "Edit \"$one_line\""]
+
+<h2>Edit \"$one_line\"</h2>
+
+[ad_context_bar_ws_or_index [list "/gc/" "Classifieds"] [list "index.tcl" "Classifieds Admin"] [list "domain-top.tcl?domain_id=$domain_id" $full_noun] "Edit Ad #$classified_ad_id"]
+
+<hr>
+
+$final_form
+<tr><th>Expires<td>
+<input name=expires type=text size=11 value=\"$ansi_expires\"> YYYY-MM-DD \[format must be exact\]
+<tr><th>Category<td>
+<select name=primary_category>
+[db_html_select_options $db "select primary_category
+from ad_categories
+where domain_id = $domain_id
+order by primary_category" $primary_category]
+</select>
+</table>
+<P>
+
+$member_value_section
+
+<center>
+<input type=submit value=\"Update Ad\">
+</center>
+</form>
+[ad_admin_footer]
+"
+
+ns_db releasehandle $db
+ns_return 200 text/html $html
Index: web/openacs/www/gc/admin/edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/admin/edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/admin/edit.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,30 @@
+# edit.tcl,v 3.1 2000/03/10 23:58:50 curtisg Exp
+set db [ns_db gethandle]
+
+set selection [ns_db select $db "select * from ad_domains"]
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append bullet_list "<li><a href=\"domain-top.tcl?domain_id=$domain_id\">$backlink_title</a>\n"
+}
+
+ns_return 200 text/html "<html>
+<head>
+<title>Pick a Domain</title>
+</head>
+<body bgcolor=#ffffff text=#000000>
+<h2>Pick a Domain</h2>
+
+<hr>
+
+<ul>
+
+$bullet_list
+
+</ul>
+
+
+<hr>
+<a href=\"http://www-swiss.ai.mit.edu/philg/\"><address>philg@mit.edu</address></a>
+
+</body>
+</html>"
Index: web/openacs/www/gc/admin/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/admin/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/admin/index.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,58 @@
+# index.tcl,v 3.1 2000/03/10 23:58:50 curtisg Exp
+ad_maybe_redirect_for_registration
+
+set user_id [ad_get_user_id]
+
+append html "[ad_admin_header "Classified Administration"]
+
+<h2>Classified Administration</h2>
+
+[ad_context_bar_ws_or_index [list "/gc/" "Classifieds"] "Classifieds Admin"]
+
+<hr>
+<ul>
+
+<h4>Active domains</h4>"
+
+set db [gc_db_gethandle]
+
+set selection [ns_db select $db "select * 
+from ad_domains
+where ad_admin_group_member_p('gc',domain,$user_id) = 't'
+order by active_p desc, upper(domain)"]
+
+set count 0
+set inactive_title_shown_p 0
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { $active_p == "f" } {
+	if { $inactive_title_shown_p == 0 } {
+	    # we have not shown the inactive title yet
+	    if { $count == 0 } {
+		append html "<li>No active domains"
+	    }
+	    set inactive_title_shown_p 1
+	    append html "<h4>Inactive domains</h4>"
+	}
+    } else {
+    }
+
+    set_variables_after_query
+
+    append html "<li><a href=\"domain-top.tcl?domain_id=$domain_id\">$domain</a>\n"
+    incr count
+}
+
+if { $count == 0 } {
+    append html "you're not an administrator of any domains"
+}
+
+append html "
+
+</ul>
+
+[ad_admin_footer]"
+
+ns_db releasehandle $db
+ns_return 200 text/html $html
Index: web/openacs/www/gc/admin/test.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/admin/test.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/admin/test.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,91 @@
+# test.tcl,v 3.1 2000/03/10 23:58:50 curtisg Exp
+# let's test out our spamming system to remind people who've placed ads
+
+set db [gc_db_gethandle]
+set db_sub [ns_db gethandle orasubquery]
+
+append html "<ul>"
+
+set generic_preamble "
+
+In the interests of having a well-groomed classified ad system for
+everyone, we're sending you this robotically generated message to
+remind you to
+
+1) delete ads for items that have sold
+2) consider updating the price on items that haven't sold
+3) delete duplicate ads
+
+It is effort like this on the part of the users that makes it possible
+to offer this service for free.
+
+Here are the ads you've placed to date:
+
+"
+
+set generic_postamble "
+
+Thank you for using [gc_system_name]
+(at [gc_system_url]).
+"
+
+set selection [ns_db select $db "select max(poster_email) as email, max(domain_id) as domain_id, max(last_modified) as most_recent_visit, min(last_modified) as least_recent_visit, count(*) as n_ads
+from classified_ads
+where (sysdate <= expires or expires is null)
+and (wanted_p <> 't' or sysdate > (last_modified + 30))
+and sysdate > last_modified + 6
+group by poster_email"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append html "<li>$email has $n_ads, most recent edit was $most_recent_visit; oldest ad hasn't been touched since $least_recent_visit.  URL:  <a href=\"[gc_system_url]edit-ad-2.tcl?poster_email=[ns_urlencode $email]&domain_id=$domain_id\">edit them</a>\n"
+    set sub_selection [ns_db select $db_sub "select classified_ad_id, posted, last_modified, one_line, expired_p(expires) as expired_p
+from classified_ads
+where poster_email = '[DoubleApos $email]'
+order by expired_p, classified_ad_id desc"]
+    if { $n_ads == 1 } {
+	set subject_line "your ad in [gc_system_name]"
+    } else {
+	set subject_line "your $n_ads ads in [gc_system_name]"
+    }
+    set body $generic_preamble
+    set expired_section_started_yet_p 0
+    while { [ns_db getrow $db_sub $sub_selection] } {
+	set_variables_after_subquery
+	if { $last_modified == $posted || $last_modified == "" } {
+	    set modified_phrase ""
+	} else {
+	    set modified_phrase "(modified $last_modified)"
+	}
+	if { $expired_p == "t" } {
+	    if { !$expired_section_started_yet_p } {
+		append body "\n    -- expired ads --  \n\n"
+		set expired_section_started_yet_p 1
+	    }
+	    set expired_phrase "(EXPIRED)"
+	} else {
+	    set expired_phrase ""
+	}
+        append body "${posted}${expired_phrase} : $one_line $modified_phrase
+[gc_system_url]edit-ad-3.tcl?classified_ad_id=$classified_ad_id
+"
+    }
+    if { $expired_p == "t" } {
+	# there was at least one expired ad
+	append body "\n\nNote:  you can revive an expired ad by going to the edit URL (above)
+and changing the expiration date."
+    }
+    append body $generic_postamble
+    append html "<pre>
+Subject: $subject_line
+Body:
+$body
+</pre>
+"
+}
+
+append html "</ul>"
+
+ns_db releasehandle $db
+ns_db releasehandle $db_sub
+ns_return 200 text/html $html
Index: web/openacs/www/gc/admin/view-alerts.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gc/admin/view-alerts.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gc/admin/view-alerts.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,101 @@
+# view-alerts.tcl,v 3.1 2000/03/10 23:58:51 curtisg Exp
+set_the_usual_form_variables
+
+# domain_id
+
+validate_integer domain_id $domain_id
+
+set db [ns_db gethandle]
+
+ad_maybe_redirect_for_registration
+
+set admin_id [ad_get_user_id]
+
+set domain [database_to_tcl_string $db "select domain
+from ad_domains where domain_id = $domain_id"]
+
+if ![ad_administration_group_member $db "gc" $domain $admin_id] {
+    ad_return_error "Unauthorized" "Unauthorized" 
+    return
+}
+
+set keyword_header ""
+if { [bboard_pls_blade_installed_p] == 1 } {
+    set keyword_header "<th>Keywords</th>"
+}
+
+append html "[ad_header "Alerts for $domain"]
+
+<h2>Alerts for $domain</h2>
+
+[ad_context_bar_ws_or_index [list "/gc/" "Classifieds"] [list "index.tcl" "Classifieds Admin"] [list "domain-top.tcl?domain_id=$domain_id" $domain] "Alerts"]
+
+<hr>
+
+<table>
+<tr><th>Email<th>Action</th><th>Frequency</th>$keyword_header</tr>
+
+"
+
+
+set selection [ns_db select $db "select cea.*, cea.alert_id,
+decode(valid_p,'f','t','f') as not_valid_p,
+upper(email) as upper_email, email
+from classified_email_alerts cea, users
+where cea.user_id = users.user_id
+and domain_id = $domain_id
+order by not_valid_p, upper_email"]
+
+set seen_any_enabled_p 0
+set seen_disabled_p 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    if { $valid_p == "f" } {
+	# we're into the disabled section
+	if { $seen_any_enabled_p && !$seen_disabled_p } {
+	    if { [bboard_pls_blade_installed_p] == 1 } {	    
+		append html "<tr><td colspan=4 align=center>-- <b>Disabled Alerts</b> --</tr>\n"
+	    } else {
+		append html "<tr><td colspan=3 align=center>-- <b>Disabled Alerts</b> --</tr>\n"
+	    }
+	    set seen_disabled_p 1
+	}
+	set action "<a href=\"alert-toggle.tcl?[export_url_vars alert_id domain_id]\">Re-enable</a>"
+    } else {
+	# alert is enabled
+	set seen_any_enabled_p 1
+	set action "<a href=\"alert-toggle.tcl?[export_url_vars alert_id domain_id]\">Disable</a>"
+    }
+    if { [bboard_pls_blade_installed_p] == 1 } {
+	append html "<tr><td>$email<td>$action<td>$frequency<td>\"$keywords\"</tr>\n"
+    } else {
+	append html "<tr><td>$email<td>$action<td>$frequency</tr>\n"
+    }
+}
+
+append html "
+
+</table>
+<p>
+If you are seeing consistent bounces from the email notification
+system then just type these addresses into the form below and the
+alerts will be flushed from the database.  Place spaces between the
+email addresses (but no actual carriage returns).
+
+<form method=POST action=delete-email-alerts.tcl>
+[export_form_vars domain_id]
+
+<textarea name=bad_addresses wrap=virtual rows=10 cols=60></textarea>
+
+<P>
+
+<input type=submit value=\"Delete Alerts\">
+
+</form>
+
+[ad_admin_footer]
+"
+
+ns_db releasehandle $db
+ns_return 200 text/html $html
Index: web/openacs/www/general-comments/comment-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/general-comments/comment-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/general-comments/comment-add-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,96 @@
+# comment-add-2.tcl,v 3.0 2000/02/06 03:43:52 ron Exp
+# File:     /general-comments/comment-add-2.tcl
+# Date:     01/21/2000
+# Contact:  philg@mit.edu, tarik@mit.edu
+# Purpose:  
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+# on_which_table, on_what_id, content, comment_id, html_p, return_url, item, module
+# maybe one_line
+
+validate_integer on_what_id $on_what_id
+validate_integer comment_id $comment_id
+
+# check for bad input
+if { ![info exists content] || [empty_string_p $content] } {
+    ad_return_complaint 1 "<li>please type something"
+    return
+}
+
+if { $html_p == "t" && ![empty_string_p [ad_check_for_naughty_html $content]] } {
+    ad_return_complaint 1 "<li>[ad_check_for_naughty_html $content]\n"
+    return
+}
+
+if {![info exists one_line]} {
+    set one_line ""
+}
+
+if { [info exists html_p] && $html_p == "t" } {
+    set approval_text "<blockquote>
+<h4>$one_line</h4>
+
+$content
+</blockquote>
+[ad_style_bodynote "Note: if the text above has lost all of its paragraph breaks then you
+probably should have selected \"Plain Text\" rather than HTML.  Use
+your browser's Back button to return to the submission form."]
+"
+} else {
+    set approval_text "<blockquote>
+<h4>$one_line</h4>
+
+[util_convert_plaintext_to_html $content]
+</blockquote>
+
+[ad_style_bodynote "Note: if the text above has a bunch of visible HTML tags then you probably
+should have selected \"HTML\" rather than \"Plain Text\".  Use your
+browser's Back button to return to the submission form."]"
+}
+
+# Get the default approval policy for the site
+set approval_policy [ad_parameter DefaultCommentApprovalPolicy]
+
+# If there is a different approval policy for the module, override
+# the site approval policy
+set approval_policy [ad_parameter CommentApprovalPolicy $module $approval_policy]
+
+
+# If the comment will require approval tell the user that it will not appear immediately.
+if { ![ad_parameter AcceptAttachmentsP "general-comments" 0] && [string compare $approval_policy "open"] != 0 } {
+    append approval_text "<p>Your comment will be visible after it is approved by the administrator.\n"
+}
+
+ns_return 200 text/html "[ad_header "Confirm comment on $item"]
+
+<h2>Confirm comment on $item</h2>
+
+[ad_context_bar_ws [list $return_url $item] "Confirm comment"]
+
+<hr>
+
+Here is how your comment would appear:
+
+
+$approval_text
+
+<center>
+<form action=comment-add-3.tcl method=post>
+[export_entire_form]
+<input type=submit name=submit value=\"Confirm\">
+</form>
+</center>
+
+[ad_footer]
+"
Index: web/openacs/www/general-comments/comment-add-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/general-comments/comment-add-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/general-comments/comment-add-3.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,151 @@
+# comment-add-3.tcl,v 3.1 2000/02/20 10:57:05 ron Exp
+# File:     /general-comments/comment-add-3.tcl
+# Date:     01/21/2000
+# Contact:  philg@mit.edu, tarik@mit.edu
+# Purpose:  
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+# item, on_which_table, on_what_id, content, comment_id, content, html_p, module
+# maybe one_line
+
+validate_integer on_what_id $on_what_id
+validate_integer comment_id $comment_id
+
+# check for bad input
+if { ![info exists content] || [empty_string_p $content] } {
+    ad_return_complaint 1 "<li>the comment field was empty"
+    return
+}
+
+if { ![info exists scope] } {
+    set scope "public"
+}
+
+if { $html_p == "t" && ![empty_string_p [ad_check_for_naughty_html $content]] } {
+    ad_return_complaint 1 "<li>[ad_check_for_naughty_html $content]\n"
+    return
+}
+
+if {![info exists one_line]} {
+    set one_line ""
+}
+
+# user has input something, so continue on
+
+# assign necessary data for insert
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set originating_ip [ns_conn peeraddr]
+
+set db [ns_db gethandle]
+
+# Get the default approval policy for the site
+set approval_policy [ad_parameter DefaultCommentApprovalPolicy]
+
+# If there is a different approval policy for the module, override
+# the site approval policy
+set approval_policy [ad_parameter CommentApprovalPolicy $module $approval_policy]
+
+
+if {$approval_policy == "open"} {
+    set approved_p "t"
+
+    set result_text "
+Your comment is now in the database.  You <a
+href=\"$return_url\">return to the original page</a> to see it in
+context.
+"
+
+} else {
+    set approved_p "f"
+
+    set result_text "
+Your comment is now in the database.  After it is approved by the administrator, you will see it on <a
+href=\"$return_url\">the original page</a>.
+"
+
+}
+
+if [catch {
+ad_general_comment_add $db $comment_id $on_which_table $on_what_id $item $content $user_id  $originating_ip $approved_p $html_p $one_line
+} errmsg] {
+    # Oracle choked on the insert
+     if { [database_to_tcl_string $db "select count(*) from general_comments where comment_id = $comment_id"] == 0  } { 
+	# there was an error with comment insert other than a duplication
+	ad_return_error "Error in inserting comment" "We were unable to insert your comment in the database.  Here is the error that was returned:
+<p>
+<blockquote>
+<pre>
+$errmsg
+</pre>
+</blockquote>"
+        return
+     }
+}
+
+
+# either we were successful in doing the insert or the user hit submit
+# twice and we don't really care
+
+if ![ad_parameter AcceptAttachmentsP "general-comments" 0] {
+    # we don't accept attachments, so return immediatel
+    ns_returnredirect $return_url
+    return
+} 
+
+ns_return 200 text/html "[ad_header "Comment inserted"]
+
+<h2>Comment Inserted</h2>
+
+[ad_context_bar_ws [list $return_url $item] "Comment Inserted"]
+
+<hr>
+
+$result_text
+
+<P>
+
+Alternatively, you can attach a
+file to your comment.  This file can be a document, a photograph, or
+anything else on your desktop computer.
+
+<form enctype=multipart/form-data method=POST action=\"upload-attachment.tcl\">
+[export_form_vars comment_id return_url]
+<blockquote>
+<table>
+<tr>
+<td valign=top align=right>Filename: </td>
+<td>
+<input type=file name=upload_file size=20><br>
+<font size=-1>Use the \"Browse...\" button to locate your file, then click \"Open\".</font>
+</td>
+</tr>
+<tr>
+<td valign=top align=right>Caption</td>
+<td><input size=30 name=caption>
+<br>
+<font size=-1>(leave blank if this isn't a photo)</font>
+</td>
+</tr>
+</table>
+<p>
+<center>
+<input type=submit value=\"Upload\">
+</center>
+</blockquote>
+</form>
+
+[ad_footer]
+"
Index: web/openacs/www/general-comments/comment-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/general-comments/comment-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/general-comments/comment-add.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,68 @@
+# comment-add.tcl,v 3.1 2000/02/20 10:57:05 ron Exp
+# File:     /general-comments/comment-add.tcl
+# Date:     01/21/2000
+# Contact:  philg@mit.edu, tarik@mit.edu
+# Purpose:  
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_form_variables
+# on_which_table, on_what_id, item, module, return_url
+
+validate_integer on_what_id $on_what_id
+
+# check for the user cookie
+set user_id [ad_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+set comment_id [database_to_tcl_string $db "select general_comment_id_sequence.nextval from dual"]
+
+ns_db releasehandle $db
+
+if {[ad_parameter UseTitlesP "general-comments" 0]} {
+    set title_text "Title:<br>
+<input type=text name=one_line maxlenth=200>
+<p>
+Comment:<br>
+"     
+} else {
+    set title_text ""
+}
+
+
+ns_return 200 text/html "[ad_header "Add a comment to $item"]
+
+<h2>Add a comment to $item</h2>
+
+[ad_context_bar_ws [list $return_url $item] "Add a comment"]
+
+<hr>
+
+Comment on $item:
+
+<blockquote>
+<form action=comment-add-2.tcl method=post>
+[export_form_vars on_which_table on_what_id comment_id item return_url module scope group_id]
+$title_text
+<textarea name=content cols=50 rows=5 wrap=soft></textarea><br>
+Text above is
+<select name=html_p>
+[html_select_value_options [list [list "f" "Plain Text" ] [list  "t" "HTML" ]]]
+</select>
+</blockquote>
+<br>
+<center>
+<input type=submit name=submit value=\"Proceed\">
+</center>
+</form>
+[ad_footer]
+"
Index: web/openacs/www/general-comments/comment-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/general-comments/comment-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/general-comments/comment-edit-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,96 @@
+# comment-edit-2.tcl,v 3.0 2000/02/06 03:43:57 ron Exp
+# File:     /general-comments/comment-edit-2.tcl
+# Date:     01/21/2000
+# Contact:  philg@mit.edu, tarik@mit.edu
+# Purpose:  
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_form_variables
+# comment_id, on_what_id, on_which_table, item, module, return_url
+# check for bad input
+
+validate_integer comment_id $comment_id
+validate_integer on_what_id $on_what_id
+
+if  {![info exists content] || [empty_string_p $content] } { 
+    ad_return_complaint 1 "<li>the comment field was empty"
+    return
+}
+
+if { $html_p == "t" && ![empty_string_p [ad_check_for_naughty_html $content]] } {
+    ad_return_complaint 1 "<li>[ad_check_for_naughty_html $content]\n"
+    return
+}
+
+if {![info exists one_line]} {
+    set one_line ""
+}
+
+
+set db [ns_db gethandle]
+set user_id [ad_get_user_id]
+
+set selection [ns_db 1row $db "select  general_comments.user_id as comment_user_id
+from  general_comments
+where comment_id = $comment_id"]
+
+set_variables_after_query
+
+# check to see if ther user was the orginal poster
+if {$user_id != $comment_user_id &&  ![ad_permission_p $db $module $submodule]} {
+    ad_return_complaint 1 "<li>You can not edit this entry because you did not post it"
+    return
+}
+
+
+if { [info exists html_p] && $html_p == "t" } {
+    set approval_text "<blockquote>
+<h4>$one_line</h4>
+$content
+</blockquote>
+[ad_style_bodynote "Note: if the text above has lost all of its paragraph breaks then you
+probably should have selected \"Plain Text\" rather than HTML.  Use
+your browser's Back button to return to the submission form."]
+"
+} else {
+    set approval_text "<blockquote>
+<h4>$one_line</h4>
+[util_convert_plaintext_to_html $content]
+</blockquote>
+
+[ad_style_bodynote "Note: if the text above has a bunch of visible HTML tags then you probably
+should have selected \"HTML\" rather than \"Plain Text\".  Use your
+browser's Back button to return to the submission form."]"
+}
+
+ns_return 200 text/html "[ad_header "Confirm comment on $item" ]
+
+<h2>Confirm comment on $item</h2>
+
+[ad_context_bar_ws [list "$return_url" "$item"]  "Confirm comment"]
+
+<hr>
+
+Here is how your comment would appear:
+
+
+$approval_text
+
+<center>
+<form action=comment-edit-3.tcl method=post>
+[export_entire_form]
+<input type=submit name=submit value=\"Confirm\">
+</form>
+</center>
+[ad_footer]
+"
+
Index: web/openacs/www/general-comments/comment-edit-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/general-comments/comment-edit-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/general-comments/comment-edit-3.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,72 @@
+# comment-edit-3.tcl,v 3.0 2000/02/06 03:43:59 ron Exp
+# File:     /general-comments/comment-edit-3.tcl
+# Date:     01/21/2000
+# Contact:  philg@mit.edu, tarik@mit.edu
+# Purpose:  
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+# comment_id, content, html_p, on_which_table, on_what_id, return_url, item
+# maybe one_line
+
+validate_integer comment_id $comment_id
+validate_integer on_what_id $on_what_id
+
+# check for bad input
+if  {![info exists content] || [empty_string_p $content] } { 
+    ad_return_complaint 1 "<li>the comment field was empty"
+    return
+}
+
+if { $html_p == "t" && ![empty_string_p [ad_check_for_naughty_html $content]] } {
+    ad_return_complaint 1 "<li>[ad_check_for_naughty_html $content]\n"
+    return
+}
+
+if {![info exists one_line]} {
+    set one_line ""
+}
+
+# user has input something, so continue on
+
+set db [ns_db gethandle]
+set user_id [ad_get_user_id]
+
+set selection [ns_db 1row $db "select  general_comments.user_id 
+as comment_user_id
+from general_comments
+where comment_id = $comment_id"]
+set_variables_after_query
+
+# check to see if ther user was the orginal poster
+if {$user_id != $comment_user_id && ![ad_permission_p $db $module $submodule]} {
+    ad_return_complaint 1 "<li>You can not edit this entry because you did not post it"
+    return
+}
+
+if [catch { 
+ad_general_comment_update $db $comment_id  $content [ns_conn peeraddr] $html_p $one_line } errmsg] {
+
+	# there was some other error with the comment update
+	ad_return_error "Error updating comment" "We couldn't update your comment. Here is what the database returned:
+<p>
+<blockquote>
+<pre>
+$errmsg
+</pre>
+</blockquote>
+"
+return
+}
+
+ns_returnredirect $return_url
Index: web/openacs/www/general-comments/comment-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/general-comments/comment-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/general-comments/comment-edit.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,81 @@
+# comment-edit.tcl,v 3.0 2000/02/06 03:44:01 ron Exp
+# File:     /general-comments/comment-edit.tcl
+# Date:     01/21/2000
+# Contact:  philg@mit.edu, tarik@mit.edu
+# Purpose:  
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_form_variables
+# comment_id, item, module, return_url
+
+validate_integer comment_id $comment_id
+
+# check for the user cookie
+set user_id [ad_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select comment_id, content, general_comments.html_p as comment_html_p, general_comments.user_id as comment_user_id, one_line
+from general_comments
+where comment_id = $comment_id"]
+set_variables_after_query
+
+# check to see if ther user was the orginal poster
+if {$user_id != $comment_user_id && ![ad_permission_p $db $module $submodule]} {
+    ad_return_complaint 1 "<li>You can not edit this entry because you did not post it"
+    return
+}
+
+
+if {[ad_parameter UseTitlesP "general-comments" 0]} {
+    set title_text "Title:<br>
+<input type=text name=one_line maxlenth=200 [export_form_value one_line]>
+<p>
+Comment:<br>
+"     
+} else {
+    set title_text ""
+}
+
+
+ns_return 200 text/html "[ad_header "Edit comment on $item" ]
+
+<h2>Edit comment on $item</h2>
+
+[ad_context_bar_ws  [list "$return_url" $item]  "Edit comment"]
+
+<hr>
+
+<P>
+Edit your comment.<br>
+
+<form action=comment-edit-2.tcl method=post>
+[export_form_vars comment_id module submodule return_url item]
+
+<blockquote>
+
+$title_text
+
+<textarea name=content cols=50 rows=5 wrap=soft>[ns_quotehtml $content]</textarea><br>
+Text above is
+<select name=html_p>[html_select_value_options [list [list "f" "Plain Text" ] [list  "t" "HTML" ]] $comment_html_p]</select>
+</blockquote>
+<br>
+<center>
+<input type=submit name=submit value=\"Proceed\">
+</center>
+</form>
+[ad_footer]"
+
+
+
Index: web/openacs/www/general-comments/image-attachment.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/general-comments/image-attachment.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/general-comments/image-attachment.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,50 @@
+# image-attachment.tcl,v 3.0 2000/02/06 03:44:02 ron Exp
+# File:     /general-comments/image-attachment.tcl
+# Date:     01/21/2000
+# Contact:  philg@mit.edu, tarik@mit.edu
+# Purpose:  Present a pretty page with caption and image info with an IMG tag.
+#           This page should only get called for image attachments; any other
+#           attachments should be sent directly to 
+#           /general-comments/attachment/[comment_id]/[filename]
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+# comment_id return_url
+
+validate_integer comment_id $comment_id
+
+set db [ns_db gethandle]
+set selection [ns_db 1row $db "select one_line_item_desc, file_type, caption, original_width, original_height, client_file_name, users.user_id, users.first_names, users.last_name, users.email, on_what_id
+from general_comments, users
+where comment_id = $comment_id
+and users.user_id = general_comments.user_id"]
+
+
+set_variables_after_query
+
+ns_return 200 text/html "[ad_header "Image Attachment"]
+
+<h2>Image Attachment</h2>
+
+[ad_context_bar_ws [list $return_url "$one_line_item_desc"] "Image Attachment"]
+
+<hr>
+
+<center>
+<i>$caption</i>
+<p>
+<img src=\"attachment/$comment_id/$client_file_name\" width=$original_width height=$original_height>
+</center>
+
+<hr>
+<a href=\"/shared/community-member.tcl?user_id=$user_id\">$first_names $last_name</a>
+</body>
+</html>
+"
+
+
Index: web/openacs/www/general-comments/upload-attachment.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/general-comments/upload-attachment.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/general-comments/upload-attachment.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,107 @@
+# upload-attachment.tcl,v 3.0 2000/02/06 03:44:03 ron Exp
+# File:     /general-comments/upload-attachment.tcl
+# Date:     September 7, 1999
+# Contact:  philg@mit.edu, tarik@mit.edu
+# Purpose:  adds (or replaces) an attachment to a comment
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+ad_page_variables {
+    comment_id
+}
+
+set_the_usual_form_variables
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+# comment_id, return_url, caption plus upload_file as a multipart file upload
+
+validate_integer comment_id $comment_id
+
+set db [ns_db gethandle]
+
+# let's first check to see if this user is authorized to attach
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set comment_owner_id [database_to_tcl_string $db "select user_id from general_comments where comment_id = $comment_id"]
+
+if { $user_id != $comment_owner_id } {
+    ad_return_error "Unauthorized" "Ouch.  We think that you're not authorized to attach a file to this comment.  Unless you've been playing around with the HTML, this is probably our programming bug."
+    return
+}
+
+# user is authorized
+
+set exception_text ""
+set exception_count 0
+
+if { ![info exists upload_file] || [empty_string_p $upload_file] } {
+    append exception_text "<li>Please specify a file to upload\n"
+    incr exception_count
+} else {
+    # this stuff only makes sense to do if we know the file exists
+    set tmp_filename [ns_queryget upload_file.tmpfile]
+
+    set file_extension [string tolower [file extension $upload_file]]
+
+    # remove the first . from the file extension
+    regsub {\.} $file_extension "" file_extension
+
+    set guessed_file_type [ns_guesstype $upload_file]
+
+    set n_bytes [file size $tmp_filename]
+
+    # strip off the C:\directories... crud and just get the file name
+    if ![regexp {([^/\\]+)$} $upload_file match client_filename] {
+	# couldn't find a match
+	set client_filename $upload_file
+    }
+
+    if { ![empty_string_p [ad_parameter MaxAttachmentSize "general-comments"]] && $n_bytes > [ad_parameter MaxAttachmentSize "general-comments"] } {
+	append exception_text "<li>Your file is too large.  The publisher of [ad_system_name] has chosen to limit attachments to [util_commify_number [ad_parameter MaxAttachmentSize "general-comments"]] bytes.\n"
+	incr exception_count
+    }
+
+    if { $n_bytes == 0 } {
+	append exception_text "<li>Your file is zero-length. Either you attempted to upload a zero length file, a file which does not exist, or something went wrong during the transfer.\n"
+	incr exception_count
+    }
+}
+
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+set what_aolserver_told_us ""
+if { $file_extension == "jpeg" || $file_extension == "jpg" } {
+    catch { set what_aolserver_told_us [ns_jpegsize $tmp_filename] }
+} elseif { $file_extension == "gif" } {
+    catch { set what_aolserver_told_us [ns_gifsize $tmp_filename] }
+}
+
+# the AOLserver jpegsize command has some bugs where the height comes 
+# through as 1 or 2 
+if { ![empty_string_p $what_aolserver_told_us] && [lindex $what_aolserver_told_us 0] > 10 && [lindex $what_aolserver_told_us 1] > 10 } {
+    set original_width [lindex $what_aolserver_told_us 0]
+    set original_height [lindex $what_aolserver_told_us 1]
+} else {
+    set original_width ""
+    set original_height ""
+}
+
+ns_ora blob_dml_file $db "update general_comments 
+set attachment = empty_blob(),
+    client_file_name = '[DoubleApos $client_filename]',
+    file_type = '[DoubleApos $guessed_file_type]',
+    file_extension = '[DoubleApos $file_extension]',
+    caption = '$QQcaption',
+    original_width = [ns_dbquotevalue $original_width number],
+    original_height = [ns_dbquotevalue $original_height number]
+where comment_id = $comment_id
+returning attachment into :1" $tmp_filename
+
+ns_returnredirect $return_url
Index: web/openacs/www/general-comments/view-one.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/general-comments/view-one.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/general-comments/view-one.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,62 @@
+# view-one.tcl,v 3.0 2000/02/06 03:44:04 ron Exp
+# File:     /general-comments/view-one.tcl
+# Date:     01/21/2000
+# Contact:  philg@mit.edu, tarik@mit.edu
+# Purpose:  
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_form_variables
+# comment_id, return_url
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+validate_integer comment_id $comment_id
+
+# check for the user cookie
+set user_id [ad_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select comment_id, content, general_comments.html_p as comment_html_p, general_comments.user_id as comment_user_id, client_file_name, file_type, original_width, original_height, caption, one_line,
+first_names || ' ' || last_name as commenter_name
+from general_comments, users
+where comment_id = $comment_id
+and users.user_id = general_comments.user_id"]
+set_variables_after_query
+
+ns_db releasehandle $db 
+
+append return_string "[ad_header "Edit comment on $item" ]
+
+<h2>Comment on $item</h2>
+
+[ad_context_bar_ws  [list "$return_url" $item]  "Comment"]
+
+<hr>
+
+<blockquote>\n[format_general_comment $comment_id $client_file_name $file_type $original_width $original_height $caption $content $comment_html_p $one_line]"
+
+# if the user posted the comment, they are allowed to edit it
+if {$user_id == $comment_user_id} {
+    append return_string "<br><br>-- you <A HREF=\"/general-comments/comment-edit.tcl?[export_url_vars comment_id on_which_table on_what_id item module return_url submodule]\">(edit your comment)</a>"
+} else {
+    append return_string "<br><br>-- <a href=\"/shared/community-member.tcl?user_id=$comment_user_id\">$commenter_name</a>"
+}
+
+append return_string "</blockquote>"
+
+ns_return 200 text/html "
+
+$return_string
+
+[ad_footer]"
+
Index: web/openacs/www/general-comments/admin/delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/general-comments/admin/delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/general-comments/admin/delete-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,64 @@
+# delete-2.tcl,v 3.0 2000/02/06 03:44:06 ron Exp
+# File:     /general-comments/admin/delete-2.tcl
+# Date:     01/06/99
+# author :  philg@mit.edu
+# Contact:  philg@mit.edu, tarik@arsdigita.com
+# Purpose:  delete the comment
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+# comment_id, content, html_p, submit, maybe return_url
+
+validate_integer comment_id $comment_id
+
+ad_scope_error_check
+set db [ns_db gethandle]
+set user_id [general_comments_admin_authorize $db $comment_id]
+
+if { ![info exists return_url] } {
+    set return_url "index.tcl"
+}
+
+if {[regexp -nocase "cancel" $submit]} {
+    ns_returnredirect $return_url
+    return
+}
+
+if [catch { 
+    ns_db dml $db "begin transaction" 
+    # insert into the audit table
+    ns_db dml $db "insert into general_comments_audit
+    (comment_id, user_id, ip_address, audit_entry_time, modified_date, content)
+    select comment_id, user_id, '[ns_conn peeraddr]', sysdate, modified_date, content from general_comments where comment_id = $comment_id"
+    
+    ns_db dml $db "
+    delete from general_comments where
+    comment_id=$comment_id"
+
+    ns_db dml $db "end transaction" 
+
+} errmsg] {
+    # there was some other error with the comment update
+    ad_scope_return_error "Error updating comment" "We couldn't update your comment. Here is what the database returned:
+    <p>
+    <blockquote>
+    <pre>
+    $errmsg
+    </pre>
+    </blockquote>
+    " $db
+    return
+}
+
+ns_returnredirect $return_url
+
Index: web/openacs/www/general-comments/admin/delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/general-comments/admin/delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/general-comments/admin/delete.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,59 @@
+# delete.tcl,v 3.0 2000/02/06 03:44:07 ron Exp
+# File:     /general-comments/admin/delete.tcl
+# Date:     01/06/99
+# author :  philg@mit.edu
+# Contact:  philg@mit.edu, tarik@arsdigita.com
+# Purpose:  delete the comment
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_form_variables
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+# comment_id, maybe return_url
+
+validate_integer comment_id $comment_id
+
+ad_scope_error_check
+set db [ns_db gethandle]
+general_comments_admin_authorize $db $comment_id
+
+set selection [ns_db 0or1row $db "
+select comment_id, content, general_comments.html_p as comment_html_p
+from general_comments
+where comment_id = $comment_id"]
+
+if { $selection == "" } {
+   ad_scope_return_error "Can't find comment" "Can't find comment $comment_id"
+   return
+}
+
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "
+[ad_scope_admin_header "Really delete comment" $db]
+[ad_scope_admin_page_title "Really delete comment" $db]
+<hr>
+
+<form action=delete-2.tcl method=post>
+Do you really wish to delete the following comment?
+<blockquote>
+[util_maybe_convert_to_html $content $comment_html_p]
+</blockquote>
+<center>
+<input type=submit name=submit value=\"Proceed\">
+<input type=submit name=submit value=\"Cancel\">
+</center>
+[export_form_scope_vars comment_id return_url]
+</form>
+[ad_scope_admin_footer]
+"
Index: web/openacs/www/general-comments/admin/edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/general-comments/admin/edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/general-comments/admin/edit-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,82 @@
+# edit-2.tcl,v 3.0 2000/02/06 03:44:08 ron Exp
+# File:     /general-comments/admin/edit-2.tcl
+# Date:     01/06/99
+# author :  philg@mit.edu
+# Contact:  philg@mit.edu, tarik@arsdigita.com
+# Purpose:  edit comment page
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+# comment_id, content, html_p, approved_p
+# maybe return_url
+
+validate_integer comment_id $comment_id
+
+ad_scope_error_check 
+set db [ns_db gethandle]
+set admin_id [general_comments_admin_authorize $db $comment_id]
+
+if { $admin_id == 0 } {
+    # we don't know who this is administering, 
+    # so we won't be able to audit properly
+    ns_returnredirect "/register/"
+    return
+}
+
+# check for bad input
+if  {![info exists content] || [empty_string_p $content] } { 
+    ad_scope_return_complaint 1 "<li>the comment field was empty"
+    return
+}
+
+# user has input something, so continue on
+
+if [catch { 
+    ns_db dml $db "begin transaction" 
+    # insert into the audit table
+    
+    ns_db dml $db "
+    insert into general_comments_audit
+    (comment_id, user_id, ip_address, audit_entry_time, modified_date, content)
+    select comment_id, $admin_id, '[ns_conn peeraddr]', sysdate, modified_date, content from general_comments where comment_id = $comment_id"
+    
+    ns_ora clob_dml $db "update general_comments
+    set content = empty_clob(), html_p = '$html_p', approved_p = '$approved_p'
+    where comment_id = $comment_id returning content into :1" "$content"
+    ns_db dml $db "end transaction" 
+} errmsg] {
+    
+    # there was some other error with the comment update
+    ad_scope_return_error "Error updating comment" "We couldn't update your comment. Here is what the database returned:
+    <p>
+    <blockquote>
+    <pre>
+    $errmsg
+    </pre>
+    </blockquote>
+    "
+    return
+}
+
+if { [info exists return_url] } {
+    ns_returnredirect $return_url
+} else {
+    ns_return 200 text/html "
+    [ad_scope_admin_header "Done" $db]
+    [ad_scope_admin_page_title "Done" $db]
+    [ad_scope_admin_context_bar [list "index.tcl" "General Comments"] "Edit"]
+    <hr>
+    [ad_scope_admin_footer]
+    "
+}
+
Index: web/openacs/www/general-comments/admin/edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/general-comments/admin/edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/general-comments/admin/edit.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,70 @@
+# edit.tcl,v 3.0 2000/02/06 03:44:10 ron Exp
+# File:     /general-comments/admin/edit.tcl
+# Date:     01/06/99
+# author :  philg@mit.edu
+# Contact:  philg@mit.edu, tarik@arsdigita.com
+# Purpose:  edit comment page
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_form_variables
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+# comment_id
+# maybe return_url
+
+validate_integer comment_id $comment_id
+
+ad_scope_error_check 
+set db [ns_db gethandle]
+set admin_id [general_comments_admin_authorize $db $comment_id]
+
+if { $admin_id == 0 } {
+    # we don't know who this is administering, 
+    # so we won't be able to audit properly
+    ns_returnredirect "/register/"
+    return
+}
+
+set selection [ns_db 1row $db "
+select comment_id, content, general_comments.html_p as comment_html_p, approved_p
+from general_comments
+where comment_id = $comment_id"]
+
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "
+[ad_scope_admin_header "Edit comment" $db]
+[ad_scope_admin_page_title "Edit comment" $db]
+[ad_scope_admin_context_bar [list "index.tcl" "General Comments"] "Edit"]
+<hr>
+
+<blockquote>
+<form action=edit-2.tcl method=post>
+<textarea name=content cols=70 rows=10 wrap=soft>[philg_quote_double_quotes $content]</textarea><br>
+Text above is
+<select name=html_p>
+ [ad_generic_optionlist {"Plain Text" "HTML"} {"f" "t"} $comment_html_p]
+</select>
+<br>
+Approval status
+<select name=approved_p>
+ [ad_generic_optionlist {"Approved" "Unapproved"} {"t" "f"} $approved_p]
+</select>
+<center>
+<input type=submit name=submit value=\"Proceed\">
+</center>
+[export_form_scope_vars comment_id return_url]
+</form>
+</blockquote>
+[ad_scope_admin_footer]
+"
Index: web/openacs/www/general-comments/admin/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/general-comments/admin/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/general-comments/admin/index.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,192 @@
+# index.tcl,v 3.0 2000/02/06 03:44:11 ron Exp
+# File:     /general-comments/admin/index.tcl
+# Date:     01/06/99
+# author :  philg@mit.edu
+# Contact:  philg@mit.edu, tarik@arsdigita.com
+# Purpose:  general comments administration main page
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+# the idea here is to present the newer comments, separated by 
+# section, with dimensional controls up top to control
+# how much is displayed
+
+# within each section, we sort by date descending
+
+# the dimensions:
+#  time (limit to 1 7 30 days or "all")
+#  section ("all" or limit to one section), presented as a select box
+#  approval ("all" or "unapproved only") 
+
+set_form_variables 0
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+# time_dimension_value, section_dimension_value, approval_dimension_value
+
+if { ![info exists time_dimension_value] || [empty_string_p $time_dimension_value] } {
+    set time_dimension_value "30"
+}
+
+if { ![info exists section_dimension_value] || [empty_string_p $section_dimension_value] } {
+    set section_dimension_value "all"
+}
+
+if { ![info exists approval_dimension_value] || [empty_string_p $approval_dimension_value] } {
+    set approval_dimension_value "all"
+}
+
+# return_url to be passed to various helper pages so that we return to
+# this page with the proper parameters
+
+set return_url "[ns_urlencode "index.tcl?[export_ns_set_vars "url"]"]"
+
+ad_scope_error_check 
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope admin group_admin none
+
+set n_days_possible [list 1 7 30 all]
+
+foreach n_days $n_days_possible {
+    if { $n_days == $time_dimension_value } {
+	# current choice, just the item
+	lappend time_widget_items $n_days
+    } else {
+	lappend time_widget_items "<a href=\"index.tcl?time_dimension_value=$n_days&[export_ns_set_vars "url" [list time_dimension_value]]\">$n_days</a>"
+    }
+}
+
+set time_widget [join $time_widget_items]
+
+set individual_section_options [ad_db_optionlist $db "
+select section_name, table_name 
+from table_acs_properties
+order by upper(section_name)" $section_dimension_value]
+
+if { $section_dimension_value == "all" } {
+    set all_sections_option "<option value=\"all\" SELECTED>All Sections</option>\n"
+} else {
+    set all_sections_option "<option value=\"all\">All Sections</option>\n"
+}
+
+set section_widget "
+<form action=\"index.tcl\" method=POST>
+[export_ns_set_vars "form" [list section_dimension_value]]
+<select name=section_dimension_value>
+$all_sections_option
+$individual_section_options
+</select>
+<input type=submit value=\"Go\">
+</form>
+"
+
+if { $approval_dimension_value == "all" } {
+    set approval_widget "all | <a href=\"index.tcl?approval_dimension_value=unapproved_only&[export_ns_set_vars "url" [list approval_dimension_value]]\">unapproved only</a>"
+} else {
+    # we're currently looking at unapproved
+    set approval_widget "<a href=\"index.tcl?approval_dimension_value=all&[export_ns_set_vars "url" [list approval_dimension_value]]\">all</a> | unapproved only"
+}
+
+ReturnHeaders
+
+ns_write "
+[ad_scope_admin_header "General Comments Administration" $db]
+[ad_scope_admin_page_title "General Comments Administration" $db]
+[ad_scope_admin_context_bar "General Comments"]
+<hr>
+<p>
+
+<table width=100%><tr><td align=left valign=top>$section_widget
+<td align=center valign=top>$approval_widget
+<td align=right valign=top>$time_widget
+</table>
+"
+
+if { $section_dimension_value == "all" } {
+    set where_clause_for_section ""
+} else {
+    set where_clause_for_section "and gc.on_which_table = '$section_dimension_value'"
+}
+
+if { $approval_dimension_value == "all" } {
+    set where_clause_for_approval ""
+} else {
+    set where_clause_for_approval "and gc.approved_p = 'f'"
+}
+
+if { $time_dimension_value == "all" } {
+    set where_clause_for_time ""
+} else {
+    set where_clause_for_time "and gc.comment_date > sysdate() - timespan_days($time_dimension_value)"
+}
+
+set selection [ns_db select $db "
+(select gc.*, first_names || ' ' || last_name as commenter_name,
+       tm.admin_url_stub, tm.section_name
+from general_comments gc, users, table_acs_properties tm
+where users.user_id = gc.user_id 
+and gc.on_which_table = tm.table_name
+and [ad_scope_sql gc]
+$where_clause_for_section
+$where_clause_for_approval
+$where_clause_for_time)
+union
+(select gc.*, first_names || ' ' || last_name as commenter_name,
+       null as admin_url_stub, null as section_name
+from general_comments gc, users
+where users.user_id = gc.user_id 
+and not exists (select table_name from table_acs_properties where table_name=on_which_table)
+and [ad_scope_sql gc]
+$where_clause_for_section
+$where_clause_for_approval
+$where_clause_for_time)
+order by gc.on_which_table, gc.comment_date desc"]
+
+set the_comments ""
+
+set last_section_name ""
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { $section_name != $last_section_name } {
+	if ![empty_string_p $section_name] {
+	    append the_comments "<h3>Comments within $section_name</h3>\n"
+	} else {
+	    append the_comments "<h3>Comments on $on_which_table</h3>\n"
+	}
+	set last_section_name $section_name
+    }
+    if { [empty_string_p $one_line_item_desc] } {
+	set best_item_description "$section_name ID#$on_what_id"
+    } else {
+	set best_item_description $one_line_item_desc
+    }
+    append the_comments "<table width=90%>
+<tr><td><blockquote>
+[format_general_comment $comment_id $client_file_name $file_type $original_width $original_height $caption $content $html_p]
+<br><br>-- <a href=\"/admin/users/one.tcl?user_id=$user_id\">$commenter_name</a> ([util_AnsiDatetoPrettyDate $comment_date])
+on <a href=\"${admin_url_stub}$on_what_id\">$best_item_description</a>
+</blockquote>
+</td>
+<td align=right>
+"
+    if { $approved_p == "f" } {
+	append the_comments "<a href=\"toggle-approved-p.tcl?comment_id=$comment_id&return_url=$return_url\">Approve</a>\n<br>\n"
+    }
+    append the_comments "<a href=\"edit.tcl?comment_id=$comment_id&return_url=$return_url\" target=working>edit</a>
+<br>
+<a href=\"delete.tcl?comment_id=$comment_id&return_url=$return_url\" target=working>delete</a>
+</td>
+</table>\n"
+}
+
+if [empty_string_p $the_comments] {
+    ns_write "there aren't any comments in this ACS installation that fit your criteria"
+} else {
+    ns_write $the_comments
+}
+
+
+ns_write [ad_scope_admin_footer]
+
+
Index: web/openacs/www/general-comments/admin/toggle-approved-p.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/general-comments/admin/toggle-approved-p.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/general-comments/admin/toggle-approved-p.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,28 @@
+# toggle-approved-p.tcl,v 3.0 2000/02/06 03:44:13 ron Exp
+# File:     /general-comments/admin/toggle-approved_p.tcl
+# Date:     01/06/99
+# author :  philg@mit.edu
+# Contact:  philg@mit.edu, tarik@arsdigita.com
+# Purpose:  general comments administration main page
+#
+# Note: if page is accessed through /groups pages then group_id and group_vars_set are already set up in 
+#       the environment by the ug_serve_section. group_vars_set contains group related variables (group_id, 
+#       group_name, group_short_name, group_admin_email, group_public_url, group_admin_url, group_public_root_url,
+#       group_admin_root_url, group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_form_variables
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+# comment_id  maybe return_url
+
+validate_integer comment_id $comment_id
+
+if {![info exists return_url]} {
+    set return_url "index.tcl"
+}
+
+set db [ns_db gethandle]
+
+ns_db dml $db "update general_comments set approved_p = logical_negation(approved_p) where comment_id = $comment_id"
+
+ns_returnredirect $return_url
+
Index: web/openacs/www/general-links/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/general-links/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/general-links/index.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,219 @@
+# File: /general-links/index.tcl
+# Date: 2/01/2000
+# Author: tzumainn@arsdigita.com 
+#
+# Purpose: 
+#  Displays a hierarchy of the links
+#  the variable  "category_select" determines if all the
+#  the links are displayed or just a subset
+#
+# index.tcl,v 3.2 2000/03/09 00:23:08 tzumainn Exp
+#--------------------------------------------------------
+
+ad_page_variables {{category_select "all"} {search_query ""}}
+
+set db [ns_db gethandle]
+
+if { $category_select == "all" } {
+
+    set start_with_clause "start with parent_category_id is null"
+    # pg hack (BMA)
+    set start_with_proc "0"
+
+    ad_return_top_of_page "
+    [ad_header "General Links"]
+    
+    <h2>General Links</h2>
+    
+    [ad_context_bar_ws "General Links"]
+    
+    <hr>
+    "
+} else {
+    set category_select_name [database_to_tcl_string_or_null $db "select 
+    category as category_select_name 
+    from  categories c 
+    where c.category_id = '$category_select'"]
+    set start_with_clause "start with child_category_id = $category_select"
+    # PG hack (BMA)
+    set start_with_proc "$category_select"
+
+    ad_return_top_of_page "
+    [ad_header "$category_select_name"]
+    
+    <h2>$category_select_name</h2>
+    
+    [ad_context_bar_ws [list "" "General Links"] $category_select_name]
+    
+    <hr>
+    "
+
+}
+
+if { $category_select == "all" } {
+    set where_clause_for_section ""
+} else {
+    set category_select_name [database_to_tcl_string_or_null $db "
+    select category 
+    from categories 
+    where category_id = '$category_select'"]
+   
+    set where_clause_for_section "and c.category_id = $category_select"
+}
+
+if { [empty_string_p $search_query] } {
+    set where_clause_for_search_query ""
+} else {
+    set QQsearch_query [DoubleApos $search_query]
+    set where_clause_for_search_query " 
+    and (
+           upper(meta_keywords) like '%[string toupper $QQsearch_query]%' 
+         or upper(meta_description) like '%[string toupper $QQsearch_query]%' 
+         or upper(link_description) like '%[string toupper $QQsearch_query]%' 
+         or upper(link_title) like '%[string toupper $QQsearch_query]%'
+        )"
+}
+
+set individual_section_options [ad_db_optionlist $db "
+select category, category_id 
+from categories
+order by upper(category)" $category_select]
+
+if { $category_select == "all" } {
+    set all_sections_option "<option value=\"all\" SELECTED>All Categories</option>\n"
+} else {
+    set all_sections_option "<option value=\"all\">All Categories</option>\n"
+}
+
+set n_links 0
+set link_list "<ul>"
+
+### category hierarchy
+
+set selection [ns_db select $db "select c.category_id, category_hierarchy_level(c.category_id, $start_with_proc, 0) - 1 as indent, 
+c.category, c.category_type, link_id, url, link_title, n_ratings, round(avg_rating,2) as avg_rating
+from categories c, general_links gl
+where gl.approved_p = 't'
+and exists (select 1 from site_wide_category_map swm
+            where gl.link_id = swm.on_what_id
+            and swm.on_which_table = 'general_links'
+            and swm.category_id = c.category_id)
+and category_hierarchy_level(c.category_id, $start_with_proc, 0) is not null
+$where_clause_for_search_query
+order by category_hierarchy_reverse_sortkey(c.category_id, $start_with_proc, ''), link_title"]
+
+set current_category_name ""
+set current_indent 0
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr n_links
+    set category_name $category
+    if {![empty_string_p $category_type]} {
+	append category_name " ($category_type)"
+    }
+
+    if { $current_category_name != $category_name } {
+	# new category
+	
+	if {![empty_string_p $current_category_name]} {
+	    # close the ul for the old category
+	    append link_list "</ul>"
+
+	    for {set i 1} {$i <= $current_indent} {incr i} {
+		append link_list "\n</ul>"
+	    }
+	}
+
+	set current_category_name $category_name
+	set current_indent $indent
+
+	for {set i 1} {$i <= $current_indent} {incr i} {
+	    append link_list "\n<ul>"
+	}
+
+	append link_list "<li><a href=\"index.tcl?category_select=$category_id&search_query=[ns_urlencode $search_query]\"><b>$current_category_name</b></a>\n<ul>"
+    }
+
+    if {[ad_parameter ClickthroughP general-links] == 1} {
+	# use the clickthroughs
+	set exact_link "/ct/ad_link_${link_id}?send_to=$url"
+    } else {
+	# don't use clickthoughs
+	set exact_link "$url"
+    }
+
+    append link_list "\n<li><a href=\"$exact_link\">$link_title</a> - Average Rating: $avg_rating; Number of Ratings: $n_ratings - <a href=\"one-link.tcl?[export_url_vars link_id]\">more</a>"
+}
+
+### wrap up last ul/blockquote
+if { $n_links > 0 } {
+    append link_list "</ul>"
+}
+
+for {set i 1} {$i <= $current_indent} {incr i} {
+    append link_list "\n</ul>"
+}
+
+### deal with uncategorized links - maybe
+set uncategorized_link_list ""
+if { $category_select == "all" } {
+    
+    set n_uncategorized 0
+    set selection [ns_db select $db "select link_id, url, link_title, n_ratings, avg_rating from general_links gl
+    where not exists (select 1 from site_wide_category_map swm
+                     where gl.link_id = swm.on_what_id
+                     and swm.on_which_table = 'general_links')
+          and gl.approved_p = 't'
+    "]
+    
+    while {[ns_db getrow $db $selection]} {
+	set_variables_after_query
+
+	incr n_links
+	incr n_uncategorized
+
+	if {[ad_parameter ClickthroughP general-links] == 1} {
+	    # use clickthroughs
+	    set exact_link "/ct/ad_link_${link_id}?send_to=$url"
+	} else {
+	    # don't use clickthroughs
+	    set exact_link "$url"
+	}
+
+	append uncategorized_link_list "<li> <a href=\"$exact_link\">$link_title</a> - Average Rating: $avg_rating; Number of Ratings: $n_ratings - <a href=\"one-link.tcl?[export_url_vars link_id]\">more</a>"
+    }
+    
+    if { $n_uncategorized != 0 } {
+	set uncategorized_link_list "<li><b>Uncategorized Links</b><ul>$uncategorized_link_list</ul>"
+    }
+}
+
+if { $n_links == 0 } {
+    # no links
+    append link_list "<li>No links available."
+}
+
+ns_db releasehandle $db
+
+append link_list $uncategorized_link_list
+
+append link_list "</ul>"
+
+set suggest_link ""
+
+if {[ad_parameter AllowSuggestionsP general-links] == 1} {
+    # users can suggest links to the hotlist
+    set suggest_link "<ul><li><p><a href=\"link-add-without-assoc.tcl\">suggest a link</a></ul>"
+}
+
+ns_write "
+<form method=post action=\"index.tcl\">
+<input type=text size=40 name=search_query value=\"$search_query\">
+<input type=submit value=\"Search\">
+</form>
+$link_list
+$suggest_link
+
+[ad_footer]
+"
+
Index: web/openacs/www/general-links/link-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/general-links/link-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/general-links/link-add-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,109 @@
+# link-add-2.tcl,v 3.0 2000/02/06 03:44:17 ron Exp
+# File: /general-links/link-add-2.tcl
+# Date: 2/01/2000
+# Author: tzumainn@arsdigita.com 
+#
+# Purpose: 
+#  Step 2 of 4 in adding link and its association
+#
+# link-add-2.tcl,v 3.0 2000/02/06 03:44:17 ron Exp
+#--------------------------------------------------------
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+ad_page_variables {on_which_table on_what_id item {module ""} return_url {link_title ""} url}
+
+page_validation {
+    if {[empty_string_p $url] || $url == "http://"} {
+	error "You did not enter a URL.  Examples of valid URLs include:
+	<ul>
+	<li> http://arsdigita.com
+	<li> http://photo.net/photo
+	</ul>
+	"
+    }
+
+    validate_integer on_what_id $on_what_id
+}
+
+#check for the user cookie
+set user_id [ad_maybe_redirect_for_registration]
+
+# if link_title is empty, look for title on page
+if {[empty_string_p $link_title]} {
+    set link_title [ad_general_link_get_title $url]
+    if {[empty_string_p $link_title]} {
+	set link_title "-- title not found --"
+    }
+}
+
+set db [ns_db gethandle]
+
+set link_id [database_to_tcl_string $db "select general_link_id_sequence.nextval from dual"]
+set association_id [database_to_tcl_string $db "select general_link_map_id.nextval from dual"]
+
+set category_select [ad_categorization_widget -db $db -which_table "general_links" -what_id $link_id]
+
+ns_db releasehandle $db
+
+set whole_page "
+[ad_header "Add \"$link_title\" to $item (Step 2 of 3)"]
+
+<h2>Add \"$link_title\" to $item (Step 2 of 3)</h2>
+
+[ad_context_bar_ws [list $return_url $item] "Add \"$link_title\" to $item (Step 2 of 3)"]
+
+<hr>
+
+<blockquote>
+<form action=link-add-3.tcl method=post>
+[export_form_vars on_which_table on_what_id item return_url module link_id association_id url]
+
+<table>
+
+<tr>
+<th align=left>URL:</th>
+<td>$url</td>
+</tr>
+
+<tr>
+<th align=left>Link Title:</th>
+<td><input type=text name=link_title size=50 maxlength=100 value=\"$link_title\"></td>
+</tr>
+
+<tr>
+<th align=left valign=top>Link Description:</th>
+<td valign=top><textarea name=link_description cols=40 rows=5 wrap=soft></textarea></td>
+</tr>
+"
+
+if {[regexp {option} $category_select match] == 0} {
+    append whole_page "<input type=hidden name=category_id_list value=\"\">"
+} else {
+    append whole_page "
+    <tr>
+    <th align=left valign=top>Associated Categories:</th>
+    <td valign=top>$category_select</td>
+    </tr>
+"
+}
+
+append whole_page "
+</table>
+
+</blockquote>
+<br>
+<center>
+<input type=submit name=submit value=\"Proceed to Step 3\">
+</center>
+</form>
+[ad_footer]
+"
+
+ns_return 200 text/html $whole_page
+
+
+
Index: web/openacs/www/general-links/link-add-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/general-links/link-add-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/general-links/link-add-3.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,97 @@
+# File: /general-links/link-add-3.tcl
+# Date: 2/01/2000
+# Author: tzumainn@arsdigita.com 
+#
+# Purpose: 
+#  Step 3 of 4 in adding link and its association
+#
+# link-add-3.tcl,v 3.0.4.1 2000/03/15 02:12:12 tzumainn Exp
+#--------------------------------------------------------
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+ad_page_variables {on_which_table on_what_id item {module ""} return_url link_id association_id link_title url {link_description ""} {category_id_list -multiple-list}}
+
+validate_integer on_what_id $on_what_id
+validate_integer link_id $link_id
+validate_integer association_id $association_id
+foreach loop_category_id $category_id_list {
+    validate_integer category_id $loop_category_id
+}
+
+ad_return_top_of_page "
+[ad_header "Confirm Link to $item (Step 3 of 3)"]
+
+<h2>Confirm Link to $item (Step 3 of 3)</h2>
+
+[ad_context_bar_ws [list $return_url $item] "Confirm Link to $item (Step 3 of 3)"]
+
+<hr>
+"
+
+set db [ns_db gethandle]
+
+set category_list "<ul>"
+set n_categories 0
+
+if ![empty_string_p [lindex $category_id_list 0]] {
+    set category_name_list [database_to_tcl_list $db "select category from categories where category_id in ([join $category_id_list ", "]) order by category"]
+
+    foreach category_name $category_name_list {
+	incr n_categories
+	if ![empty_string_p $category_name] {
+	    append category_list "<li> $category_name"
+	}
+    }
+}
+
+ns_db releasehandle $db
+
+if { $n_categories == 0 } {
+    append category_list "<li><i>None</i>"
+}
+append category_list "</ul>"
+
+set approval_policy [ad_parameter DefaultLinkApprovalPolicy]
+if { $approval_policy != "open" } {
+    set approval_text "<p><i>Your link must be approved by an administrator before it becomes visible to users.</i>"
+} else {
+    set approval_text ""
+}
+
+set rating_html "<select name=rating>"
+set current_rating 0
+while { $current_rating <= 10 } {
+    append rating_html "<option type=radio name=rating value=\"$current_rating\">$current_rating "
+    
+    incr current_rating
+}
+append rating_html "</select>"
+
+ns_write "
+Here is how your link will appear:
+
+<blockquote>
+<a href=\"$url\"><b>$link_title</b></a> - <b>No ratings</b> - more (<i>This will link to additional features about the link</i>)
+
+<p>It will be associated with the following categories:
+$category_list
+$approval_text
+<form action=\"link-add-4.tcl\" method=post>
+[export_form_vars on_which_table on_what_id module return_url link_id association_id link_title url link_description category_id_list item]
+Please rate this link:
+$rating_html
+</blockquote>
+<p>
+<center>
+<input type=submit name=submit value=\"Confirm Link Addition\">
+</center>
+</form>
+
+[ad_footer]
+"
+
+
Index: web/openacs/www/general-links/link-add-4.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/general-links/link-add-4.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/general-links/link-add-4.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,88 @@
+# File: /general-links/link-add-4.tcl
+# Date: 2/01/2000
+# Author: tzumainn@arsdigita.com 
+#
+# Purpose: 
+#  Step 4 of 4 in adding link and its association
+#
+# link-add-4.tcl,v 3.1.2.1 2000/03/18 02:27:56 tzumainn Exp
+#--------------------------------------------------------
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+ad_page_variables {on_which_table on_what_id item {module ""} return_url link_id association_id link_title url rating {category_id_list -multiple-list} {link_description ""}}
+
+validate_integer on_what_id $on_what_id
+validate_integer link_id $link_id
+validate_integer association_id $association_id
+foreach loop_category_id $category_id_list {
+    validate_integer category_id $loop_category_id
+}
+
+set category_id_list_hack [lindex $category_id_list 0]
+
+# user has input something, so continue on
+
+# assign necessary data for insert
+set user_id [ad_maybe_redirect_for_registration]
+
+set originating_ip [ns_conn peeraddr]
+
+set db [ns_db gethandle]
+
+# Get the default approval policy for the site
+set approval_policy [ad_parameter DefaultLinkApprovalPolicy]
+
+if {$approval_policy == "open"} {
+    set approved_p "t"
+} else {
+     set approved_p ""
+}
+
+if [catch {
+    ns_db dml $db "begin transaction"
+    ad_general_link_add $db $link_id $url $link_title $link_description $user_id $originating_ip $approved_p
+    ad_general_link_map_add $db $association_id $link_id $on_which_table $on_what_id $item $user_id $originating_ip $approved_p
+    if {$category_id_list_hack != "{}"} {
+	ad_categorize_row -db $db -which_table "general_links" -what_id $link_id -category_id_list $category_id_list_hack -one_line_item_desc "[DoubleApos $link_title]"
+    }
+    ad_general_link_check $db $link_id
+    ns_db dml $db "insert into general_link_user_ratings (user_id, link_id, rating)
+    values
+    ($user_id, $link_id, $rating)
+    "
+    ns_db dml $db "end transaction"
+} errmsg] {
+    # Oracle choked on the insert
+    ns_db dml $db "abort transaction"
+    if { [database_to_tcl_string $db "select count(*) from general_links where link_id = $link_id"] == 0 } {
+	# there was an error with link insert other than a duplication
+
+	ad_return_error "Error in inserting link" "We were unable to insert your link in the database.  Here is the error that was returned:
+	<p>
+	<blockquote>
+	<pre>
+	$errmsg
+	</pre>
+	</blockquote>"
+        return
+     } elseif { [database_to_tcl_string $db "select count(*) from site_wide_link_map where map_id = $association_id"] == 0 } { 
+	 # there was an error with link association insert other than a duplication
+
+	ad_return_error "Error in inserting link association" "We were unable to insert your link association in the database.  Here is the error that was returned:
+	<p>
+	<blockquote>
+	<pre>
+	$errmsg
+	</pre>
+	</blockquote>"
+        return
+     } else {
+	 ns_returnredirect $return_url
+     }
+}
+
+ns_returnredirect $return_url
Index: web/openacs/www/general-links/link-add-without-assoc-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/general-links/link-add-without-assoc-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/general-links/link-add-without-assoc-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,104 @@
+# File: /general-links/link-add-without-assoc-2.tcl
+# Date: 2/01/2000
+# Author: tzumainn@arsdigita.com 
+#
+# Purpose: 
+#  Step 2 of 4 in adding link WITHOUT association
+#
+# link-add-without-assoc-2.tcl,v 3.0 2000/02/06 03:44:21 ron Exp
+#--------------------------------------------------------
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+ad_page_variables {return_url {link_title ""} url}
+
+page_validation {
+    if {[empty_string_p $url] || $url == "http://"} {
+	error "You did not enter a URL.  Examples of valid URLs include:
+	<ul>
+	<li> http://arsdigita.com
+	<li> http://photo.net/photo
+	</ul>
+	"
+    }
+}
+
+#check for the user cookie
+set user_id [ad_maybe_redirect_for_registration]
+
+# if link_title is empty, look for title on page
+if {[empty_string_p $link_title]} {
+    set link_title [ad_general_link_get_title $url]
+    if {[empty_string_p $link_title]} {
+	set link_title "-- title not found --"
+    }
+}
+
+set db [ns_db gethandle]
+
+set link_id [database_to_tcl_string $db "select general_link_id_sequence.nextval from dual"]
+
+set category_select [ad_categorization_widget -db $db -which_table "general_links" -what_id $link_id]
+
+ns_db releasehandle $db
+
+set whole_page "
+[ad_header "Add \"$link_title\" (Step 2 of 3)"]
+
+<h2>Add \"$link_title\" (Step 2 of 3)</h2>
+
+[ad_context_bar_ws [list $return_url "General Links"] "Add \"$link_title\" (Step 2 of 3)"]
+
+<hr>
+
+<blockquote>
+<form action=link-add-without-assoc-3.tcl method=post>
+[export_form_vars return_url link_id url]
+
+<table>
+
+<tr>
+<th align=right>URL:</th>
+<td>$url</td>
+</tr>
+
+<tr>
+<th align=right>Link Title:</th>
+<td><input type=text name=link_title size=50 maxlength=100 value=\"$link_title\"></td>
+</tr>
+
+<tr>
+<th align=right valign=top>Link Description:</th>
+<td valign=top><textarea name=link_description cols=40 rows=5 wrap=soft></textarea></td>
+</tr>
+"
+
+if {[regexp {option} $category_select match] == 0} {
+    append whole_page "<input type=hidden name=category_id_list value=\"\">"
+} else {
+    append whole_page "
+    <tr>
+    <th align=right valign=top>Associated Categories:</th>
+    <td valign=top>$category_select</td>
+    </tr>
+"
+}
+
+append whole_page "
+</table>
+
+</blockquote>
+<br>
+<center>
+<input type=submit name=submit value=\"Proceed to Step 3\">
+</center>
+</form>
+[ad_footer]
+"
+
+ns_return 200 text/html $whole_page
+
+
Index: web/openacs/www/general-links/link-add-without-assoc-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/general-links/link-add-without-assoc-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/general-links/link-add-without-assoc-3.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,94 @@
+# File: /general-links/link-add-without-assoc-3.tcl
+# Date: 2/01/2000
+# Author: tzumainn@arsdigita.com 
+#
+# Purpose: 
+#  Step 3 of 4 in adding link WITHOUT association
+#
+# link-add-without-assoc-3.tcl,v 3.0.4.2 2000/03/15 02:12:23 tzumainn Exp
+#--------------------------------------------------------
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+ad_page_variables {return_url link_id link_title url {link_description ""} {category_id_list -multiple-list}}
+
+validate_integer link_id $link_id
+foreach loop_category_id $category_id_list {
+    validate_integer category_id_list $loop_category_id
+}
+
+ad_return_top_of_page "
+[ad_header "Confirm Link (Step 3 of 3)"]
+
+<h2>Confirm Link (Step 3 of 7)</h2>
+
+[ad_context_bar_ws [list $return_url "General Links"] "Confirm Link (Step 3 of 3)"]
+
+<hr>
+"
+
+set db [ns_db gethandle]
+
+set category_list "<ul>"
+set n_categories 0
+
+if ![empty_string_p [lindex $category_id_list 0]] {
+    ns_write "Hi<br>"
+    set category_name_list [database_to_tcl_list $db "select category from categories where category_id in ([join $category_id_list ", "]) order by category"]
+
+    foreach category_name $category_name_list {
+	incr n_categories
+	if ![empty_string_p $category_name] {
+	    append category_list "<li> $category_name"
+	}
+    }
+}
+
+ns_db releasehandle $db
+
+if { $n_categories == 0 } {
+    append category_list "<li><i>None</i>"
+}
+append category_list "</ul>"
+
+set approval_policy [ad_parameter DefaultLinkApprovalPolicy]
+if { $approval_policy != "open" } {
+    set approval_text "<p><i>Your link must be approved by an administrator before it becomes visible to users.</i>"
+} else {
+    set approval_text ""
+}
+
+set rating_html "<select name=rating>"
+set current_rating 0
+while { $current_rating <= 10 } {
+    append rating_html "<option type=radio name=rating value=\"$current_rating\">$current_rating "
+    
+    incr current_rating
+}
+append rating_html "</select>"
+
+ns_write "
+Here is how your link will appear:
+
+<blockquote>
+<a href=\"$url\"><b>$link_title</b></a> - <b>No ratings</b> - more (<i>This will link to additional features about the link</i>)
+
+<p>It will be associated with the following categories:
+$category_list
+$approval_text
+<form action=\"link-add-without-assoc-4.tcl\" method=post>
+[export_form_vars return_url link_id link_title url link_description category_id_list]
+Please rate this link:
+$rating_html
+</blockquote>
+<p>
+<center>
+<input type=submit name=submit value=\"Confirm Link Addition\">
+</center>
+</form>
+
+[ad_footer]
+"
Index: web/openacs/www/general-links/link-add-without-assoc-4.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/general-links/link-add-without-assoc-4.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/general-links/link-add-without-assoc-4.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,76 @@
+# File: /general-links/link-add-without-assoc-4.tcl
+# Date: 2/01/2000
+# Author: tzumainn@arsdigita.com 
+#
+# Purpose: 
+#  Step 4 of 4 in adding link WITHOUT association
+#
+# link-add-without-assoc-4.tcl,v 3.1.2.1 2000/03/18 02:28:54 tzumainn Exp
+#--------------------------------------------------------
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+ad_page_variables {return_url link_id link_title url rating {category_id_list -multiple-list} {link_description ""}}
+
+validate_integer link_id $link_id
+foreach loop_category_id $category_id_list {
+    validate_integer category_id_list $loop_category_id
+}
+
+# user has input something, so continue on
+
+set category_id_list_hack [lindex $category_id_list 0]
+
+# assign necessary data for insert
+set user_id [ad_maybe_redirect_for_registration]
+
+set originating_ip [ns_conn peeraddr]
+
+set db [ns_db gethandle]
+
+# Get the default approval policy for the site
+set approval_policy [ad_parameter DefaultLinkApprovalPolicy]
+
+if {$approval_policy == "open"} {
+    set approved_p "t"
+} else {
+     set approved_p ""
+}
+
+if [catch {
+    ns_db dml $db "begin transaction"
+    ad_general_link_add $db $link_id $url $link_title $link_description $user_id $originating_ip $approved_p
+
+    if {$category_id_list_hack != "{}"} {
+	ad_categorize_row -db $db -which_table "general_links" -what_id $link_id -category_id_list $category_id_list_hack -one_line_item_desc "[DoubleApos $link_title]"
+    }
+
+    ad_general_link_check $db $link_id
+    ns_db dml $db "insert into general_link_user_ratings (user_id, link_id, rating)
+    values
+    ($user_id, $link_id, $rating)
+    "
+    ns_db dml $db "end transaction"
+} errmsg] {
+    # Oracle choked on the insert
+    ns_db dml $db "abort transaction"
+    if { [database_to_tcl_string $db "select count(*) from general_links where link_id = $link_id"] == 0 } {
+	# there was an error with link insert other than a duplication
+
+	ad_return_error "Error in inserting link" "We were unable to insert your link in the database.  Here is the error that was returned:
+	<p>
+	<blockquote>
+	<pre>
+	$errmsg
+	</pre>
+	</blockquote>"
+        return
+     } else { 
+	 ns_returnredirect $return_url
+     }
+ }
+
+ns_returnredirect $return_url
Index: web/openacs/www/general-links/link-add-without-assoc.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/general-links/link-add-without-assoc.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/general-links/link-add-without-assoc.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,59 @@
+# File: /general-links/link-add-without-assoc.tcl
+# Date: 2/01/2000
+# Author: tzumainn@arsdigita.com 
+#
+# Purpose: 
+#  Step 1 of 4 in adding link WITHOUT association
+#
+# link-add-without-assoc.tcl,v 3.0 2000/02/06 03:44:25 ron Exp
+#--------------------------------------------------------
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+ad_page_variables {{return_url "index.tcl"}}
+
+#check for the user cookie
+set user_id [ad_maybe_redirect_for_registration]
+
+ns_return 200 text/html "
+[ad_header "Add a Link (Step 1 of 3)"]
+
+<h2>Add a Link (Step 1 of 3)</h2>
+
+[ad_context_bar_ws [list $return_url "General Links"] "Add a Link (Step 1 of 3)"]
+
+<hr>
+
+<blockquote>
+<form action=link-add-without-assoc-2.tcl method=post>
+[export_form_vars return_url]
+
+<table>
+
+<tr>
+<th align=right>URL:</th>
+<td><input type=text name=url value=\"http://\" size=50 maxlength=300></td>
+</tr>
+
+<tr>
+<th valign=top align=right>Link Title:</th>
+<td valign=top><input type=text name=link_title size=50 maxlength=100><br><i>Optional - if left blank, our server will look this up</i></td>
+</tr>
+
+</table>
+
+</blockquote>
+<br>
+<center>
+<input type=submit name=submit value=\"Proceed to Step 2\">
+</center>
+</form>
+[ad_footer]
+"
+
+
+
+
Index: web/openacs/www/general-links/link-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/general-links/link-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/general-links/link-add.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,61 @@
+# File: /general-links/link-add.tcl
+# Date: 2/01/2000
+# Author: tzumainn@arsdigita.com 
+#
+# Purpose: 
+#  Step 1 of 4 in adding link and its association
+#
+# link-add.tcl,v 3.0 2000/02/06 03:44:26 ron Exp
+#--------------------------------------------------------
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+ad_page_variables {on_which_table on_what_id item {module ""} return_url}
+
+validate_integer on_what_id $on_what_id
+
+#check for the user cookie
+set user_id [ad_maybe_redirect_for_registration]
+
+ns_return 200 text/html "
+[ad_header "Add a Link to $item (Step 1 of 3)"]
+
+<h2>Add a Link to $item (Step 1 of 3)</h2>
+
+[ad_context_bar_ws [list $return_url $item] "Add a Link to $item (Step 1 of 3)"]
+
+<hr>
+
+<blockquote>
+<form action=link-add-2.tcl method=post>
+[export_form_vars on_which_table on_what_id item return_url module]
+
+<table>
+
+<tr>
+<th align=left>URL:</th>
+<td><input type=text name=url value=\"http://\" size=50 maxlength=300></td>
+</tr>
+
+<tr>
+<th valign=top align=left>Link Title:</th>
+<td valign=top><input type=text name=link_title size=50 maxlength=100><br><i>Optional - if left blank, our server will look this up</i></td>
+</tr>
+
+</table>
+
+</blockquote>
+<br>
+<center>
+<input type=submit name=submit value=\"Proceed to Step 2\">
+</center>
+</form>
+[ad_footer]
+"
+
+
+
+
Index: web/openacs/www/general-links/link-rate.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/general-links/link-rate.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/general-links/link-rate.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,38 @@
+# File: /general-links/link-rate.tcl
+# Date: 2/01/2000
+# Author: tzumainn@arsdigita.com 
+#
+# Purpose: 
+#  Updates a link's rating
+#
+# link-rate.tcl,v 3.0 2000/02/06 03:44:28 ron Exp
+#--------------------------------------------------------
+
+ad_page_variables {link_id rating}
+
+validate_integer link_id $link_id
+
+#check for the user cookie
+set user_id [ad_maybe_redirect_for_registration]
+
+set db [ns_db gethandle]
+
+ns_db dml $db "begin transaction"
+
+ns_db dml $db "update general_link_user_ratings set rating = $rating where user_id = $user_id and link_id = $link_id"
+if { [ns_pg ntuples $db] == 0 } {
+    ns_db dml $db "insert into general_link_user_ratings (user_id, link_id, rating)
+    select $user_id, $link_id, $rating
+    from dual
+    where 0 = (select count(*) from general_link_user_ratings
+               where user_id = $user_id
+               and link_id = $link_id)
+    "
+}
+
+ns_db dml $db "end transaction"
+
+ns_db releasehandle $db
+
+ns_returnredirect "one-link.tcl?[export_url_vars link_id]"
+
Index: web/openacs/www/general-links/one-link.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/general-links/one-link.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/general-links/one-link.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,62 @@
+# File: /general-links/one-link.tcl
+# Date: 2/01/2000
+# Author: tzumainn@arsdigita.com 
+#
+# Purpose: 
+#  Displays more link information
+#
+# one-link.tcl,v 3.0 2000/02/06 03:44:29 ron Exp
+#--------------------------------------------------------
+
+ad_page_variables {link_id {return_title "General Links"} {return_url "index.tcl"}}
+
+validate_integer link_id $link_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select link_id, creation_time, url, link_title, link_description
+from general_links gl
+where link_id=$link_id
+"]
+
+page_validation {
+    if {[empty_string_p $selection]} {
+	error "Link $link_id does not exist."
+    }
+}
+
+set_variables_after_query
+
+if {[ad_parameter ClickthroughP general-links] == 1} {
+    set exact_link "/ct/ad_link_${link_id}?send_to=$url"
+} else {
+    set exact_link "$url"
+}
+
+set link_html "<ul>
+<li><a href=\"$exact_link\"><b>$link_title</b></a> - [ad_general_link_format_rating_result $db $link_id]
+<p>$link_description
+<p>Posted on [util_AnsiDatetoPrettyDate $creation_time]
+<p>
+[ad_general_link_format_rating $db $link_id "link-rate.tcl"]
+<p>
+</ul>"
+
+set comments [ad_general_comments_list $db $link_id general_links "$link_title"]
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "
+[ad_header "One Link"]
+
+<h2>One Link</h2>
+
+[ad_context_bar_ws [list "$return_url" "$return_title"] "One Link"]
+
+<hr>
+
+$link_html
+$comments
+
+[ad_footer]
+"
Index: web/openacs/www/glassroom/cert-add-2.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/cert-add-2.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/cert-add-2.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,69 @@
+<%
+# cert-add-2.adp -- add a new certificate to the the glassroom_certificates
+#                   table.
+#                   (this is an ADP as opposed to a .tcl file so that 
+#                   it's consistent naming with cert-add.adp)
+
+
+set_the_usual_form_variables
+
+# Expects hostname, issuer, encoded_email, expires, ns_db magic vars that
+#         can be stitched together to form expires
+
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+
+
+# check for bad input
+
+# set happy_p [glassroom_check_cert_args $certname $ip_address $further_docs_url]
+
+set happy_p 1
+
+
+if [catch { ns_dbformvalue [ns_conn form] expires date expires } errmsg] {
+    ad_return_complaint 1 "<li> The expiration date wasn't well-formed"
+    ns_adp_abort
+}
+
+
+
+if $happy_p {
+    
+    # Assuming we don't need to confirm entry.  Just add it to the
+    # glassroom_certs table
+    
+    set insert_sql "
+    insert into glassroom_certificates
+      (cert_id, hostname, issuer, encoded_email, expires)
+    values
+      (glassroom_cert_id_sequence.nextval, '$QQhostname',
+       '$QQissuer', '$QQencoded_email',
+       to_date('$expires', 'yyyy-mm-dd'))
+    "
+    
+    set db [ns_db gethandle]
+    ns_db dml $db "$insert_sql"
+    ns_db releasehandle $db
+    
+    
+    # and redirect back to index.tcl so folks can see the new cert  list
+    
+    ns_returnredirect "index.tcl"
+}
+%>
+
Index: web/openacs/www/glassroom/cert-add.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/cert-add.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/cert-add.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,41 @@
+<%
+# cert-add.tcl -- add a new certificatex to the list of certs that the
+#                 glass room handles This file is an ADP so that we can 
+#                 ns_adp_include the cert entry/editing form
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+	ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+	return
+}
+
+
+# emit the page contents
+
+ns_puts "
+[ad_header "Add a new Certificate"]
+<h2>Add a new Certificate</h2>
+in [ad_context_bar [list index.tcl Glassroom] "Add Certificate"]
+<hr>
+"
+
+
+# include the shared HTML form
+
+ns_adp_include "cert-form.adp" "Add Certificate" "cert-add-2.adp"
+
+
+
+ns_puts "[glassroom_footer]"
+
+%>
+
Index: web/openacs/www/glassroom/cert-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/cert-delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/cert-delete-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,67 @@
+# cert-delete-2.tcl,v 3.0 2000/02/06 03:44:30 ron Exp
+# cert-delete-2.tcl -- remove a certificate from glassroom_certificates
+#
+
+set_form_variables
+
+# Expects cert_id
+
+validate_integer cert_id $cert_id
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+	ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+	return
+}
+
+
+
+# snarf the host name
+
+set db [ns_db gethandle]
+
+set select_sql "
+select hostname
+  from glassroom_certificates
+ where cert_id=$cert_id"
+
+set hostname [database_to_tcl_string_or_null $db $select_sql]
+
+
+# emit the page contents
+
+ReturnHeaders
+
+ns_write "[ad_header "Certificate for \"$hostname\" Deleted"]
+
+<h2>Certificate \"$hostname\" Deleted</h2>
+<hr>
+"
+
+
+#!!! what to do if delete fails...
+
+ns_db dml $db "delete from glassroom_certificates where cert_id=$cert_id"
+
+ns_db releasehandle $db
+
+
+ns_write "
+Deletion of certificate for hostname $hostname confirmed.
+
+<p>
+
+
+<a href=index.tcl>Return to the Glass Room</a>
+
+[glassroom_footer]
+"
\ No newline at end of file
Index: web/openacs/www/glassroom/cert-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/cert-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/cert-delete.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,64 @@
+# cert-delete.tcl,v 3.0 2000/02/06 03:44:32 ron Exp
+# cert-delete.tcl -- confirm the removal of a certificate from 
+#                    glassroom_certificates
+#
+
+set_form_variables
+
+# Expects cert_id
+
+validate_integer cert_id $cert_id
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+	ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+	return
+}
+
+
+
+# snarf the hostname for the certificate name
+
+set db [ns_db gethandle]
+
+set select_sql "
+select hostname
+  from glassroom_certificates
+ where cert_id=$cert_id"
+
+set hostname [database_to_tcl_string_or_null $db $select_sql]
+
+ns_db releasehandle $db
+
+
+# emit the page contents
+
+ReturnHeaders
+
+ns_write "[ad_header "Delete Certificate for \"$hostname\""]
+
+<h2>Delete Certificate for \"$hostname\"</h2>
+in [ad_context_bar [list index.tcl Glassroom] [list cert-view.tcl?[export_url_vars cert_id] "View Certificate"] "Delete Certificate"]
+<hr>
+
+Are you sure you want to delete this certificate?
+
+<ul>
+   <li> <a href=\"cert-delete-2.tcl?[export_url_vars cert_id]\">yes, I'm sure</a>
+        <br><br>
+
+   <li> <a href=\"cert-view.tcl?[export_url_vars cert_id]\">no, let me look at the cert info again</a>
+</ul>
+
+[glassroom_footer]
+"
+
Index: web/openacs/www/glassroom/cert-edit-2.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/cert-edit-2.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/cert-edit-2.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,64 @@
+<%
+# cert-edit-2.adp -- commit changes made to a certificates in the 
+#                    glassroom_certificates table
+#                    (this is an ADP instead of a Tcl file to be consistent
+#                    with cert-edi.adp)
+
+set_the_usual_form_variables
+
+# Expects hostname, issuer, encoded_email, expires, ns_db magic vars that
+#         can be stitched together to form expires
+
+
+validate_integer cert_id $cert_id
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+	ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+	return
+}
+
+
+
+
+# check for bad input
+
+# set happy_p [glassroom_check_cert_args $certname $ip_address $further_docs_url]
+
+set happy_p 1
+
+#!!! need to error check this
+
+if [catch { ns_dbformvalue [ns_conn form] expires date expires } errmsg] {
+    jwernjwenrjwenrjwenrjn
+}
+
+if $happy_p {
+
+    set update_sql "
+    update glassroom_certificates
+    set 
+        hostname='$QQhostname',
+        issuer='$QQissuer',
+        encoded_email='$QQencoded_email',
+        expires=to_date('$expires', 'YYYY-MM-DD')
+    where cert_id=$cert_id"
+
+    set db [ns_db gethandle]
+    ns_db dml $db $update_sql
+    ns_db releasehandle $db
+
+    # and redirect back to index.tcl so folks can see the new certificate
+    
+    ns_returnredirect "cert-view.tcl?[export_url_vars cert_id]"
+}
+%>
Index: web/openacs/www/glassroom/cert-edit.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/cert-edit.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/cert-edit.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,64 @@
+<%
+# cert-edit.adp -- edit a certificate in the glassroom_certificates table.  
+#                  This file is an ADP so that we can ns_adp_include the 
+#                  cert entry/editing form
+
+set_form_variables
+
+# Expects cert_id
+
+validate_integer cert_id $cert_id
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+	ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+	return
+}
+
+
+# snarf the cert information
+
+set db [ns_db gethandle]
+
+set select_sql "
+select hostname, issuer, encoded_email, expires
+  from glassroom_certificates
+ where cert_id=$cert_id"
+
+set selection [ns_db 1row $db $select_sql]
+set_variables_after_query
+
+ns_db releasehandle $db
+
+
+
+
+# emit the page contents
+
+ns_puts "[ad_header "Edit Certificate for \"$hostname\""]"
+
+ns_puts "<h2>Edit Certificate for \"$hostname\"</h2>
+in [ad_context_bar [list index.tcl Glassroom] [list cert-view.tcl?[export_url_vars cert_id] "View Certificate"] "Edit Certificate"]
+<hr>
+"
+
+
+# include the shared HTML form
+
+ns_adp_include "cert-form.adp" "Update Certificate" "cert-edit-2.adp"
+
+
+
+ns_puts "[glassroom_footer]"
+
+%>
+
Index: web/openacs/www/glassroom/cert-form.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/cert-form.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/cert-form.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,74 @@
+<%
+# cert-form.adp -- an incldued file for cert-edit.adp and cert-add.adp which
+#                  share the form between those two pages.
+#
+# required arguments - the text for the "submit" button and the form action
+
+# make sure these variables exist so we don't generate lots of errors
+# accessing unknown variables below
+
+if { [ns_adp_argc] != 3 } {
+    ns_log error "wrong number of arguments passed to cert-form.adp.  The text for the submit button should be included, as well as the form action to send the data to."
+    ns_adp_abort
+}
+
+ns_adp_bind_args submit_button_text form_action
+
+
+if { ![info exists hostname] } {
+    set hostname ""
+}
+
+if { ![info exists issuer] } {
+    set issuer ""
+}
+
+if { ![info exists encoded_email] } {
+    set encoded_email ""
+}
+
+if { ![info exists expires] } {
+    set expires [ns_fmttime [ns_time] "%Y-%m-%d"]
+}
+
+
+%>
+
+<%=[glassroom_form_action "$form_action" ]%>
+
+<%
+if { [info exists cert_id] } {
+    ns_puts "[export_form_vars cert_id]\n"
+}
+%>
+
+<table>
+
+<tr>
+  <td align=right> Hostname: 
+  <td>             <input type=text size=30 name=hostname <%= [export_form_value hostname] %>>
+</tr>
+
+<tr>
+  <td align=right> Issuer:
+  <td>             <input type=text size=30 name=issuer <%= [export_form_value issuer] %>>
+</tr>
+
+<tr>
+  <td align=right> The Certificate Request:
+  <td>             <input type=text size=30 maxlength=100 name=encoded_email <%= [export_form_value encoded_email] %>>
+</tr>
+
+<tr>
+  <td align=right> Exipiration Date:
+  <td>             <%= [philg_dateentrywidget expires] %>
+</tr>
+
+</table>
+
+<p>
+  
+<%=[glassroom_submit_button "$submit_button_text" ]%>
+
+</form>
+
Index: web/openacs/www/glassroom/cert-view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/cert-view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/cert-view.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,106 @@
+# cert-view.tcl,v 3.0 2000/02/06 03:44:34 ron Exp
+# cert-view.tcl -- view a certificate's information, and also give them the
+#                  option to edit or delete the information
+
+#!!! need large, friendly letters if this cert is expired or near
+#!!! expiration
+
+
+set_form_variables
+
+# Expects cert_id
+
+validate_integer cert_id $cert_id
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+
+
+# snarf the cert information
+
+set db [ns_db gethandle]
+
+set select_sql "
+select hostname, issuer, encoded_email, expires,
+       trunc(months_between(expires, sysdate), 2) as expire_months
+  from glassroom_certificates
+ where cert_id=$cert_id"
+
+set selection [ns_db 0or1row $db $select_sql]
+
+if { [empty_string_p $selection] } {
+    # if it's not there, just redirect them to the index page
+    # (if they hacked the URL, they get what they deserve, if the
+    # the cert has been deleted, they can see the list of valid certs)
+    ns_returnredirect index.tcl
+    return
+}
+
+set_variables_after_query
+
+ns_db releasehandle $db
+
+
+# emit the page contents
+
+ReturnHeaders
+
+ns_write "[ad_header "Certificate for $hostname"]
+
+<h2>Certificate for $hostname</h2>
+in [ad_context_bar [list index.tcl Glassroom] "View Certificate"]
+<hr>
+
+<h3>The Certificate</h3>
+
+<ul>
+    <li> <b>Hostname:</b> $hostname
+         <p>
+
+    <li> <b>Issuer:</b> $issuer
+         <p>
+
+    <li> <b>Certificate Request:</b> $encoded_email
+         <p>
+
+    <li> <b>Expires:</b> [util_AnsiDatetoPrettyDate $expires]
+"
+
+if { $expire_months < 0} {
+    ns_write "    <font color=red>Certificate has <blink>expired</blink></font>"
+} elseif { $expire_months < [ad_parameter CertExpireMonthWarning glassroom 2] } {
+    ns_write "    <font color=red>Certificate will soon expire</font>"
+}
+
+
+ns_write "
+         <p>
+
+</ul>
+"
+
+
+ns_write "
+
+<h3>Actions</h3>
+
+<ul>
+   <li> <a href=\"cert-edit.adp?[export_url_vars cert_id]\">Edit</a>
+        <p>
+
+   <li> <a href=\"cert-delete.tcl?[export_url_vars cert_id]\">Delete</a>
+
+</ul>
+
+[glassroom_footer]
+"
+
+
Index: web/openacs/www/glassroom/domain-add-2.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/domain-add-2.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/domain-add-2.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,74 @@
+<%
+# domain-add-2.adp -- add a new domain to the the glassroom_domains
+#                   table.
+#                   (this is an ADP as opposed to a .tcl file so that 
+#                   it's consistent naming with domain-add.adp)
+
+
+set_the_usual_form_variables
+
+# Expects domain_name, by_whom_paid, last_paid, expires, ns_db magic vars that
+#         can be stitched together to form expires
+
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+
+
+# check for bad input
+
+# set happy_p [glassroom_check_domain_args $domainname $ip_address $further_docs_url]
+
+set happy_p 1
+
+
+if [catch { ns_dbformvalue [ns_conn form] expires date expires } errmsg] {
+    ad_return_complaint 1 "<li> The expiration date wasn't well-formed"
+    ns_adp_abort
+}
+
+if [catch { ns_dbformvalue [ns_conn form] last_paid date last_paid } errmsg] {
+    ad_return_complaint 1 "<li> The Last-paid date wasn't well-formed"
+    ns_adp_abort
+}
+
+
+
+if $happy_p {
+    
+    # Assuming we don't need to confirm entry.  Just add it to the
+    # glassroom_domains table
+    
+    set insert_sql "
+    insert into glassroom_domains
+      (domain_name, by_whom_paid, last_paid, expires)
+    values
+      ('$QQdomain_name', '$QQby_whom_paid',
+       to_date('$last_paid', 'yyyy-mm-dd'),
+       to_date('$expires', 'yyyy-mm-dd'))
+    "
+    
+    set db [ns_db gethandle]
+    ns_db dml $db "$insert_sql"
+    ns_db releasehandle $db
+    
+    
+    # and redirect back to index.tcl so folks can see the new domain  list
+    
+    ns_returnredirect "index.tcl"
+}
+%>
+
Index: web/openacs/www/glassroom/domain-add.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/domain-add.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/domain-add.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,41 @@
+<%
+# domain-add.adp -- add a new domain to the list of domains that the
+#                   glass room handles This file is an ADP so that we can 
+#                   ns_adp_include the domain entry/editing form
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+	ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+	return
+}
+
+
+# emit the page contents
+
+ns_puts "
+[ad_header "Add a new Domain"]
+<h2>Add a new Domain</h2>
+in [ad_context_bar [list index.tcl Glassroom] "Add Domain"]
+<hr>
+"
+
+
+# include the shared HTML form
+
+ns_adp_include "domain-form.adp" "Add Domain" "domain-add-2.adp"
+
+
+
+ns_puts "[glassroom_footer]"
+
+%>
+
Index: web/openacs/www/glassroom/domain-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/domain-delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/domain-delete-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,54 @@
+# domain-delete-2.tcl,v 3.0 2000/02/06 03:44:35 ron Exp
+# domain-delete-2.tcl -- remove a domain from glassroom_domains
+#
+
+set_form_variables
+
+# Expects domain_name
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+	ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+	return
+}
+
+
+# emit the page contents
+
+ReturnHeaders
+
+ns_write "[ad_header "\"$domain_name\" Deleted"]
+
+<h2>\"$domain_name\" Deleted</h2>
+<hr>
+"
+
+
+#!!! what to do if delete fails...
+
+set db [ns_db gethandle]
+
+ns_db dml $db "delete from glassroom_domains where domain_name='$domain_name'"
+
+ns_db releasehandle $db
+
+
+ns_write "
+Deletion of domain for domain_name $domain_name confirmed.
+
+<p>
+
+
+<a href=index.tcl>Return to the Glass Room</a>
+
+[glassroom_footer]
+"
\ No newline at end of file
Index: web/openacs/www/glassroom/domain-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/domain-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/domain-delete.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,48 @@
+# domain-delete.tcl,v 3.0 2000/02/06 03:44:36 ron Exp
+# domain-delete.tcl -- confirm the removal of a domain from 
+#                     glassroom_domains
+#
+
+set_form_variables
+
+# Expects domain_name
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+	ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+	return
+}
+
+
+
+# emit the page contents
+
+ReturnHeaders
+
+ns_write "[ad_header "Delete \"$domain_name\""]
+
+<h2>Delete \"$domain_name\"</h2>
+in [ad_context_bar [list index.tcl Glassroom] [list domain-view.tcl?[export_url_vars domain_name] "View Domain"] "Delete Domain"]
+<hr>
+
+Are you sure you want to delete this domain?
+
+<ul>
+   <li> <a href=\"domain-delete-2.tcl?[export_url_vars domain_name]\">yes, I'm sure</a>
+        <br><br>
+
+   <li> <a href=\"domain-view.tcl?[export_url_vars domain_name]\">no, let me look at the domain info again</a>
+</ul>
+
+[glassroom_footer]
+"
+
Index: web/openacs/www/glassroom/domain-edit-2.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/domain-edit-2.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/domain-edit-2.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,68 @@
+<%
+# domain-edit-2.adp -- commit changes made to a domains in the 
+#                    glassroom_domains table
+#                    (this is an ADP instead of a Tcl file to be consistent
+#                    with domain-edi.adp)
+
+set_the_usual_form_variables
+
+# Expects old_domain_name, domain_name, by_whom_paid; 
+#         last_paid, epires, ns_db magic vars that
+#         can be stitched together to form expires
+
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+	ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+	return
+}
+
+
+
+# check for bad input
+
+# set happy_p [glassroom_check_domain_args $domainname $ip_address $further_docs_url]
+
+if [catch { ns_dbformvalue [ns_conn form] expires date expires } errmsg] {
+    ad_return_complaint 1 "<li> The expiration date wasn't well-formed"
+    ns_adp_abort
+}
+
+if [catch { ns_dbformvalue [ns_conn form] last_paid date last_paid } errmsg] {
+    ad_return_complaint 1 "<li> The Last-paid date wasn't well-formed"
+    ns_adp_abort
+}
+
+
+set happy_p 1
+
+
+if $happy_p {
+
+    set update_sql "
+    update glassroom_domains
+    set 
+        domain_name='$QQdomain_name',
+        by_whom_paid='$QQby_whom_paid',
+        last_paid = to_date('$last_paid', 'YYYY-MM-DD'),
+        expires = to_date('$expires', 'YYYY-MM-DD')
+    where domain_name='$old_domain_name'"
+
+    set db [ns_db gethandle]
+    ns_db dml $db $update_sql
+    ns_db releasehandle $db
+
+    # and redirect back to index.tcl so folks can see the new domain
+    
+    ns_returnredirect "domain-view.tcl?[export_url_vars domain_name]"
+}
+%>
Index: web/openacs/www/glassroom/domain-edit.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/domain-edit.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/domain-edit.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,62 @@
+<%
+# domain-edit.adp -- edit a domain in the glassroom_domains table.  
+#                    This file is an ADP so that we can ns_adp_include the 
+#                    domain entry/editing form
+
+set_form_variables
+
+# Expects domain_name
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+	ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+	return
+}
+
+
+# snarf the domain information
+
+set db [ns_db gethandle]
+
+set select_sql "
+select by_whom_paid, last_paid, expires
+  from glassroom_domains
+ where domain_name='$domain_name'"
+
+set selection [ns_db 1row $db $select_sql]
+set_variables_after_query
+
+ns_db releasehandle $db
+
+
+
+
+# emit the page contents
+
+ns_puts "[ad_header "Edit \"$domain_name\""]"
+
+ns_puts "<h2>Edit \"$domain_name\"</h2>
+in [ad_context_bar [list index.tcl Glassroom] [list domain-view.tcl?[export_url_vars domain_name] "View Domain"] "Edit Domain"]
+<hr>
+"
+
+
+# include the shared HTML form
+
+ns_adp_include "domain-form.adp" "Update Domain" "domain-edit-2.adp"
+
+
+
+ns_puts "[glassroom_footer]"
+
+%>
+
Index: web/openacs/www/glassroom/domain-form.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/domain-form.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/domain-form.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,74 @@
+<%
+# domain-form.adp -- an incldued file for domain-edit.adp and domain-add.adp
+#                    which share the form between those two pages.
+#
+# required arguments - the text for the "submit" button, and the form-action
+
+# make sure these variables exist so we don't generate lots of errors
+# accessing unknown variables below
+
+if { [ns_adp_argc] != 3 } {
+    ns_log error "wrong number of arguments passed to domain-form.adp.  The text for the submit button should be included, as well as the form action to send the data to."
+    ns_adp_abort
+}
+
+ns_adp_bind_args submit_button_text form_action
+
+
+if { ![info exists domain_name] } {
+    set domain_name ""
+}
+
+if { ![info exists last_paid] } {
+    set last_paid [ns_fmttime [ns_time] "%Y-%m-%d"]
+}
+
+if { ![info exists by_whom_paid] } {
+    set by_whom_paid ""
+}
+
+if { ![info exists expires] } {
+    set expires [ns_fmttime [ns_time] "%Y-%m-%d"]
+}
+
+%>
+
+<%=[glassroom_form_action "$form_action" ]%>
+
+<% 
+if { [info exists domain_name] } {
+    set old_domain_name $domain_name
+    ns_puts "[export_form_vars old_domain_name]\n"
+}
+%>
+
+<table>
+
+<tr>
+  <td align=right> Domain Name: 
+  <td>             <input type=text size=50 name=domain_name maxlength=50 <%= [export_form_value domain_name] %>>
+</tr>
+
+<tr>
+  <td align=right> Date Last Paid:
+  <td>             <%= [philg_dateentrywidget last_paid $last_paid] %>
+</tr>
+
+<tr>
+  <td align=right> Paid by Whom:
+  <td>             <input type=text size=50 name=by_whom_paid maxlength=100 <%= [export_form_value by_whom_paid] %>>
+</tr>
+
+<tr>
+  <td align=right> Exipiration Date:
+  <td>             <%= [philg_dateentrywidget expires $expires] %>
+</tr>
+
+</table>
+
+<p>
+  
+<%=[glassroom_submit_button "$submit_button_text" ]%>
+
+</form>
+
Index: web/openacs/www/glassroom/domain-view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/domain-view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/domain-view.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,104 @@
+# domain-view.tcl,v 3.0 2000/02/06 03:44:37 ron Exp
+# domain-view.tcl -- view a domain's information, and also give them the
+#                  option to edit or delete the information
+
+#!!! need large, friendly letters if this domain is expired or near
+#!!! expiration
+
+set_form_variables
+
+# Expects domain_name
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+
+
+# snarf the domain information
+
+set db [ns_db gethandle]
+
+set select_sql "
+select by_whom_paid, last_paid, expires,
+       trunc(months_between(expires, sysdate), 2) as expire_months
+  from glassroom_domains
+ where domain_name='$domain_name'"
+
+set selection [ns_db 0or1row $db $select_sql]
+
+if { [empty_string_p $selection] } {
+    # if it's not there, just redirect them to the index page
+    # (if they hacked the URL, they get what they deserve, if the
+    # the domain has been deleted, they can see the list of valid domains)
+    ns_returnredirect index.tcl
+    return
+}
+
+set_variables_after_query
+
+ns_db releasehandle $db
+
+
+# emit the page contents
+
+ReturnHeaders
+
+ns_write "[ad_header "$domain_name"]
+
+<h2>$domain_name</h2>
+in [ad_context_bar [list index.tcl Glassroom] "View Domain"]
+<hr>
+
+<h3>The Domain</h3>
+
+<ul>
+    <li> <b>Domain_Name:</b> $domain_name
+         <p>
+
+    <li> <b>Last Paid:</b> [util_AnsiDatetoPrettyDate $last_paid]
+         <p>
+
+    <li> <b>Last Paid By:</b> $by_whom_paid
+         <p>
+
+    <li> <b>Expires:</b> [util_AnsiDatetoPrettyDate $expires]
+"
+
+if { $expire_months < 0} {
+    ns_write "    <font color=red>Domain has <blink>expired</blink></font>"
+} elseif { $expire_months < [ad_parameter DomainExpireMonthWarning glassroom 2] } {
+    ns_write "    <font color=red>Domain will soon expire</font>"
+}
+
+
+ns_write "
+         <p>
+
+</ul>
+"
+
+
+ns_write "
+
+<h3>Actions</h3>
+
+<ul>
+   <li> <a href=\"domain-edit.adp?[export_url_vars domain_name]\">Edit</a>
+        <p>
+
+   <li> <a href=\"domain-delete.tcl?[export_url_vars domain_name]\">Delete</a>
+
+</ul>
+
+[glassroom_footer]
+"
+
+
Index: web/openacs/www/glassroom/entry-comment-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/entry-comment-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/entry-comment-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,64 @@
+# entry-comment-2.tcl,v 3.0 2000/02/06 03:44:38 ron Exp
+# entry-comment-2.tcl -- preview comment on logbook entry
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+
+# Expects content, html_p, procedure_name, entry_id
+
+validate_integer entry_id $entry_id
+
+# check for bad input
+
+if { ![info exists content] || [empty_string_p $content] } {
+    ad_return_complaint 1 "<li>the comment field was empty"
+    return
+}
+
+ReturnHeaders
+
+ns_write "[ad_header "Confirm comment on $procedure_name entry"]
+
+<h2>Confirm comment</h2>
+on $procedure_name Entry
+
+<hr>
+
+The following is your comment as it would appear on the page <i>Comments for Logbook Entry</i>.
+If it looks incorrect, please use the back button on your browser to return and
+correct it.  Otherwise, press \"Continue\".
+<p>
+<blockquote>"
+
+if { [info exists html_p] && $html_p == "t" } {
+    ns_write "$content
+</blockquote>
+Note: if the story has lost all of its paragraph breaks then you
+probably should have selected \"Plain Text\" rather than HTML.  Use
+your browser's Back button to return to the submission form.
+"
+} else {
+    ns_write "[util_convert_plaintext_to_html $content]
+</blockquote>
+
+Note: if the story has a bunch of visible HTML tags then you probably
+should have selected \"HTML\" rather than \"Plain Text\".  Use your
+browser's Back button to return to the submission form.  " 
+}
+
+set db [ns_db gethandle]
+
+ns_write "<form action=entry-comment-3.tcl method=post>
+<center>
+<input type=submit name=submit value=\"Confirm\">
+<input type=hidden name=comment_id value=\"[database_to_tcl_string $db "select general_comment_id_sequence.nextval from dual"]\">
+</center>
+[export_form_vars content html_p procedure_name entry_id]
+</form>
+[glassroom_footer]
+"
+
Index: web/openacs/www/glassroom/entry-comment-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/entry-comment-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/entry-comment-3.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,63 @@
+# entry-comment-3.tcl,v 3.0.4.1 2000/03/16 13:26:30 james Exp
+# entry-comment-3.tcl -- add a comment to the general_comments table
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+set_the_usual_form_variables
+
+# expects comment_id, content, htmp_p, procedure_name, entry_id
+
+validate_integer comment_id $comment_id
+validate_integer entry_id $entry_id
+
+# check for bad input
+if { ![info exists content] || [empty_string_p $content] } {
+    ad_return_complaint 1 "<li>the comment field was empty"
+    return
+}
+
+
+
+# user has input something, so continue on
+
+# assign necessary data for insert
+set user_id [ad_verify_and_get_user_id]
+set originating_ip [ns_conn peeraddr]
+
+#if { [ad_parameter CommentApprovalPolicy calendar] == "open"} {
+     set approved_p "t"
+#} else {
+#    set approved_p "f"
+#}
+
+
+set db [ns_db gethandle]
+
+set one_line_item_desc " "
+
+if [catch { ns_ora clob_dml $db "insert into general_comments
+(comment_id,on_what_id, user_id, on_which_table ,content, ip_address,comment_date, approved_p, html_p, one_line_item_desc)
+values ($comment_id, $entry_id, $user_id, 'glassroom_logbook', empty_clob(), '$originating_ip', sysdate, '$approved_p', '$html_p', '$one_line_item_desc') 
+returning content into :1" "$content"} errmsg] {
+    # Oracle choked on the insert
+     if { [database_to_tcl_string $db "select count(*) from general_comments where comment_id = $comment_id"] == 0 } {
+	# there was an error with comment insert other than a duplication
+	ad_return_error "Error in inserting comment" "We were unable to insert your comment in the database.  Here is the error that was returned:
+<p>
+<blockquote>
+<pre>
+$errmsg
+</pre>
+</blockquote>"
+        return
+     }
+}
+
+# either we were successful in doing the insert or the user hit submit
+# twice and we don't really care
+
+ns_returnredirect "logbook-view.tcl?procedure_name=[ns_urlencode $procedure_name]"
Index: web/openacs/www/glassroom/entry-comment.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/entry-comment.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/entry-comment.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,116 @@
+# entry-comment.tcl,v 3.0 2000/02/06 03:44:41 ron Exp
+# entry-comment.tcl -- show existing comments for a logbook entry,
+#                      and allow entry of new comments
+
+set_form_variables
+
+# expects entry_id, procedure_name
+
+validate_integer entry_id $entry_id
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+set select_sql "
+select entry_time, entry_author, procedure_name, entry_time, 
+       first_names || ' ' || last_name as pretty_entry_author, notes
+  from glassroom_logbook, users
+ where entry_id = $entry_id
+       and glassroom_logbook.entry_author = users.user_id
+       and users.user_id = entry_author"
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db $select_sql]
+
+if { [empty_string_p $selection] } {
+    # if it's not there, just redirect them to the index page
+    # (if they hacked the URL, they get what they deserve, if the
+    # the entry has been deleted, they can see the list of entries for that logbook procedure)
+    ns_returnredirect "index.tcl?procedure_name=[ns_urlencode $procedure_name]"
+    return
+}
+
+set_variables_after_query
+
+
+# emit page contents
+
+
+ReturnHeaders
+
+ns_write "[ad_header "Comments on Logbook Entry"]
+
+<h2>Comments on Logbook Entry for $procedure_name</h2>
+in [ad_context_bar [list index.tcl Glassroom] [list "logbook-view.tcl?procedure_name=[ns_urlencode $procedure_name]" "View Logbook Entries"] "View Logbook Entry Comments"]
+<hr>
+
+<h3>The Logbook Entry for $procedure_name</h3>
+
+<ul>
+    <li> <b>Entry Time</b>: [util_AnsiDatetoPrettyDate $entry_time]
+         <p>
+
+    <li> <b>Entry Author</b>: $pretty_entry_author
+         <p>
+
+    <li> <b>Notes</b>: $notes
+         <p>
+</ul>
+"
+
+set count [database_to_tcl_string $db "select count(*) from general_comments where on_what_id = $entry_id and on_which_table = 'glassroom_logbook'"]
+
+if { $count == 0 } {
+    ns_write "There are no comments at this time"
+} elseif { $count == 1 } {
+    ns_write "There is one comment:"
+} else {
+    ns_write "There are $count comments:"
+}
+
+set select_sql "
+select gc.comment_id, gc.user_id, gc.content, gc.html_p, users.first_names || ' ' || users.last_name as commenter_name,
+       gc.comment_date
+  from general_comments gc, users
+ where gc.on_what_id = $entry_id
+       and gc.on_which_table = 'glassroom_logbook'
+       and gc.user_id = users.user_id
+ order by gc.comment_date"
+
+
+set selection [ns_db select $db $select_sql]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    ns_write "<blockquote>\n[util_maybe_convert_to_html $content $html_p]\n"
+    ns_write "<br><br>-- <a href=\"/shared/community-member.tcl?user_id=$user_id\">$commenter_name</a>, [util_AnsiDatetoPrettyDate $comment_date]"
+    ns_write "</blockquote>"
+}
+
+
+if { ![ad_read_only_p] } {
+    # show 'add new comment'
+    ns_write "<hr><blockquote><form action=entry-comment-2.tcl method=POST>
+Would you like to add a comment?<p>
+[export_form_vars procedure_name entry_id]
+<textarea name=content cols=50 rows=5 wrap=soft></textarea><br>
+Text above is
+<select name=html_p><option value=f>Plain Text<option value=t>HTML</select>
+<br>
+<input type=submit name=submit value=\"Proceed\"></blockquote>"
+} else {
+    ns_write "Comments cannot be added at this time"
+}
+
+
+ns_write "
+[glassroom_footer]
+"
Index: web/openacs/www/glassroom/host-add-2.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/host-add-2.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/host-add-2.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,69 @@
+<%
+# host-add-2.adp -- add a new host to the the glassroom_hosts table
+#                   (this is an ADP as opposed to a .tcl file so that 
+#                   it's consistent naming with host-add.adp)
+
+set_the_usual_form_variables
+
+# Expects hostname, ip_address, os_version, description,
+#         model_and_serial, street_address, remote_console_instructions
+#         service_phone_number, service_contract, facility_phone,
+#         facility_contact, backup_strategy, rdbms_backup_strategy,
+#         further_docs_url
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+	ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+	return
+}
+
+
+
+
+# check for bad input
+
+set happy_p [glassroom_check_host_args $hostname $ip_address $further_docs_url]
+
+
+
+if $happy_p {
+    
+    # Assuming we don't need to confirm entry.  Just add it to the
+    # glassroom_hosts table
+    
+    set insert_sql "
+    insert into glassroom_hosts
+      (host_id, hostname, ip_address,
+       os_version, description, model_and_serial,
+       street_address, remote_console_instructions,
+       service_phone_number, service_contract, facility_phone,
+       facility_contact, backup_strategy, rdbms_backup_strategy,
+       further_docs_url)
+    values
+      (glassroom_host_id_sequence.nextval, '$QQhostname', '$ip_address',
+       '$QQos_version', '$QQdescription', '$QQmodel_and_serial',
+       '$QQstreet_address', '$QQremote_console_instructions',
+       '$QQservice_phone_number', '$QQservice_contract', '$QQfacility_phone',
+       '$QQfacility_contact', '$QQbackup_strategy', '$QQrdbms_backup_strategy',
+       '$QQfurther_docs_url')
+    "
+    
+    set db [ns_db gethandle]
+    ns_db dml $db "$insert_sql"
+    ns_db releasehandle $db
+    
+    
+    # and redirect back to index.tcl so folks can see the new host list
+    
+    ns_returnredirect "index.tcl"
+}
+%>
+
Index: web/openacs/www/glassroom/host-add.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/host-add.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/host-add.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,41 @@
+<%
+# host-add.adp -- add a new host to the list of hosts that the glass room handles
+#                 This file is an ADP so that we can ns_adp_include the 
+#                 host entry/editing form
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+# emit the page contents
+
+ns_puts "[ad_header "Add a new Host"]"
+
+ns_puts "<h2>Add a new Host</h2>
+in [ad_context_bar [list index.tcl Glassroom] "Add Host"]
+<hr>
+"
+
+
+# include the shared HTML form
+
+ns_adp_include "host-form.adp" "Add Host" "host-add-2.adp"
+
+
+
+ns_puts "[glassroom_footer]"
+
+%>
+
Index: web/openacs/www/glassroom/host-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/host-delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/host-delete-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,68 @@
+# host-delete-2.tcl,v 3.0 2000/02/06 03:44:42 ron Exp
+# host-delete-2.tcl -- remove a host from glassroom_hosts
+#
+
+set_form_variables
+
+# Expects host_id
+
+validate_integer host_id $host_id
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+	ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+	return
+}
+
+
+
+# snarf the host name
+
+set db [ns_db gethandle]
+
+set select_sql "
+select hostname
+  from glassroom_hosts
+ where host_id=$host_id"
+
+set hostname [database_to_tcl_string_or_null $db $select_sql]
+
+
+# emit the page contents
+
+ReturnHeaders
+
+ns_write "[ad_header "Host \"$hostname\" Deleted"]
+
+<h2>Host \"$hostname\" Deleted</h2>
+<hr>
+"
+
+set delete_sql "delete from glassroom_hosts where host_id=$host_id"
+
+#!!! what to do if delete fails...
+
+ns_db dml $db $delete_sql
+
+ns_db releasehandle $db
+
+
+ns_write "
+Deletion of $hostname confirmed.
+
+<p>
+
+
+<a href=index.tcl>Return to the Glass Room</a>
+
+[glassroom_footer]
+"
\ No newline at end of file
Index: web/openacs/www/glassroom/host-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/host-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/host-delete.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,67 @@
+# host-delete.tcl,v 3.0 2000/02/06 03:44:43 ron Exp
+# host-delete.tcl -- confirm the removal of a host from glassroom_hosts
+#
+
+
+set_form_variables
+
+# Expects host_id
+
+validate_integer host_id $host_id
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+# snarf the host name
+
+set db [ns_db gethandle]
+
+set select_sql "
+select hostname
+  from glassroom_hosts
+ where host_id=$host_id"
+
+set hostname [database_to_tcl_string_or_null $db $select_sql]
+
+ns_db releasehandle $db
+
+
+# emit the page contents
+
+ReturnHeaders
+
+ns_write "[ad_header "Delete \"$hostname\""]
+
+<h2>Delete \"$hostname\"</h2>
+in [ad_context_bar [list index.tcl Glassroom] [list host-view.tcl?[export_url_vars host_id] "View Host"] "Delete Host"]
+<hr>
+
+Are you sure you want to delete this host?
+
+<ul>
+   <li> <a href=\"host-delete-2.tcl?[export_url_vars host_id]\">yes, I'm sure</a>
+        <br><br>
+
+   <li> <a href=\"host-view.tcl?[export_url_vars host_id]\">no, let me look at the host info again</a>
+</ul>
+
+[glassroom_footer]
+"
+
+
+
+
+
Index: web/openacs/www/glassroom/host-edit-2.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/host-edit-2.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/host-edit-2.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,68 @@
+<%
+# host-edit-2.adp -- commit changes made to a host in the glassroom_hosts table
+#                    (this is an ADP instead of a Tcl file to be consistent
+#                    with host-edi.adp)
+
+set_the_usual_form_variables
+
+# Expects host_id, hostname, ip_address, os_version, description,
+#         model_and_serial, street_address, remote_console_instructions
+#         service_phone_number, service_contract, facility_phone,
+#         facility_contact, backup_strategy, rdbms_backup_strategy,
+#         further_docs_url
+
+validate_integer host_id $host_id
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+	ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+	return
+}
+
+
+
+
+# check for bad input
+
+set happy_p [glassroom_check_host_args $hostname $ip_address $further_docs_url]
+
+
+if $happy_p {
+
+    set update_sql "
+    update glassroom_hosts
+    set 
+        hostname='$QQhostname',
+        ip_address='$QQip_address',
+        os_version='$QQos_version',
+        description='$QQdescription',
+        model_and_serial='$QQmodel_and_serial',
+        street_address='$QQstreet_address',
+        remote_console_instructions='$QQremote_console_instructions',
+        service_phone_number='$QQservice_phone_number',
+        service_contract='$QQservice_contract',
+        facility_phone='$QQfacility_phone',
+        facility_contact='$QQfacility_contact',
+        backup_strategy='$QQbackup_strategy',
+        rdbms_backup_strategy='$QQrdbms_backup_strategy',
+        further_docs_url='$QQfurther_docs_url'
+    where host_id=$host_id"
+
+    set db [ns_db gethandle]
+    ns_db dml $db $update_sql
+    ns_db releasehandle $db
+
+    # and redirect back to index.tcl so folks can see the new host list
+    
+    ns_returnredirect "host-view.tcl?[export_url_vars host_id]"
+}
+%>
Index: web/openacs/www/glassroom/host-edit.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/host-edit.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/host-edit.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,67 @@
+<%
+# host-edit.adp -- edit a host in the glassroom_hosts table.  This file is an
+#                  ADP so that we can ns_adp_include the host entry/editing
+#                  form
+
+set_form_variables
+
+# Expects host_id
+
+validate_integer host_id $host_id
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+	ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+	return
+}
+
+
+# snarf the host information
+
+set db [ns_db gethandle]
+
+set select_sql "
+select hostname, ip_address, os_version, description, model_and_serial,
+       street_address, remote_console_instructions, service_phone_number,
+       service_contract, facility_phone, facility_contact, backup_strategy,
+       rdbms_backup_strategy, further_docs_url
+  from glassroom_hosts
+ where host_id=$host_id"
+
+set selection [ns_db 1row $db $select_sql]
+set_variables_after_query
+
+ns_db releasehandle $db
+
+
+
+
+# emit the page contents
+
+ns_puts "[ad_header "Edit Host \"$hostname\""]"
+
+ns_puts "<h2>Edit Host \"$hostname\"</h2>
+in [ad_context_bar [list index.tcl Glassroom] [list host-view.tcl?[export_url_vars host_id] "View Host"] "Edit Host"]
+<hr>
+"
+
+
+# include the shared HTML form
+
+ns_adp_include "host-form.adp" "Update Host" "host-edit-2.adp"
+
+
+
+ns_puts "[glassroom_footer]"
+
+%>
+
Index: web/openacs/www/glassroom/host-form.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/host-form.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/host-form.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,190 @@
+<%
+# host-form.adp -- an incldued file for host-edit.adp and host-add.adp which
+#                  shares the form between those two pages.
+#
+# required arguments - the text for the "submit button" and the action
+#                      for the form
+
+
+if { [ns_adp_argc] != 3 } {
+    ns_log error "wrong number of arguments passed to host-form.adp.  The text for the submit button should be included, as well as the form action to send the data to."
+    ns_adp_abort
+}
+
+ns_adp_bind_args submit_button_text form_action
+
+# make sure these variables exist so we don't generate lots of errors
+# accessing unknown variables below
+
+if { ![info exists hostname] } {
+    set hostname ""
+}
+
+if { ![info exists ip_address] } {
+    set ip_address ""
+}
+
+if { ![info exists os_version] } {
+    set os_version ""
+}
+
+if { ![info exists description] } {
+    set description ""
+}
+
+if { ![info exists model_and_serial] } {
+    set model_and_serial ""
+}
+
+if { ![info exists street_address] } {
+    set street_address ""
+}
+
+if { ![info exists remote_console_instructions] } {
+    set remote_console_instructions ""
+}
+
+if { ![info exists service_phone_number] } {
+    set service_phone_number ""
+}
+
+if { ![info exists service_contract] } {
+    set service_contract ""
+}
+
+if { ![info exists facility_phone] } {
+    set facility_phone ""
+}
+
+if { ![info exists facility_contact] } {
+    set facility_contact ""
+}
+
+if { ![info exists backup_strategy] } {
+    set backup_strategy ""
+}
+
+if { ![info exists rdbms_backup_strategy] } {
+    set rdbms_backup_strategy ""
+}
+
+if { ![info exists further_docs_url] } {
+    set further_docs_url ""
+}
+
+
+%>
+
+<%=[glassroom_form_action "$form_action" ]%>
+
+<%
+if { [info exists host_id] } {
+    ns_puts "[export_form_vars host_id]\n"
+}
+%>
+
+<table>
+
+<tr>
+  <td align=right> Main Hostname: 
+  <td>             <input type=text size=30 name=hostname <%= [export_form_value hostname] %>>
+</tr>
+
+
+<tr>
+  <td align=right> IP Address: 
+  <td>             <input type=text size=15 name=ip_address <%= [export_form_value ip_address] %>>
+</tr>
+
+
+
+<tr>
+  <td align=right> Operating System and Version: 
+  <td>             <input type=text size=50 name=os_version <%= [export_form_value os_version] %>>
+</tr>
+
+
+
+<tr>
+  <td align=right valign=top> Description of physical configuration: 
+  <td>             <textarea wrap=physcal cols=60 rows=6 name=description><%= [ns_quotehtml $description] %></textarea>
+</tr>
+
+
+
+<tr>
+  <td align=right> Model# and Serial #: 
+  <td>             <input type=text size=30 name=model_and_serial <%= [export_form_value model_and_serial] %>>
+</tr>
+
+
+
+<tr>
+  <td align=right valign=top> Street Address:
+  <td>             <textarea wrap=soft cols=60 rows=6 name=street_address><%= [ns_quotehtml $street_address] %></textarea>
+</tr>
+
+
+  
+<tr>
+  <td align=right valign=top> How to get to the console port:
+  <td>             <textarea wrap=soft cols=60 rows=6 name=remote_console_instructions><%= [ns_quotehtml $remote_console_instructions] %></textarea>
+</tr>
+
+
+
+<tr>
+  <td align=right> Service contract phone number: 
+  <td>             <input type=text size=30 name=service_phone_number <%= [export_form_value service_phone_number] %>>
+</tr>
+
+
+
+<tr>
+  <td align=right valign=top> Service contract number and other details:
+  <td>             <textarea wrap=soft cols=60 rows=6 name=service_contract><%= [ns_quotehtml $service_contract] %></textarea>
+</tr>
+
+
+  
+<tr>
+  <td align=right> Hosting facility phone number: 
+  <td>             <input type=text size=30 name=facility_phone <%= [export_form_value facility_phone] %>>
+</tr>
+
+
+
+<tr>
+  <td align=right> Hosting facility contact information:
+  <td>             <input type=text size=60 name=facility_contact <%= [export_form_value facility_contact] %>>
+</tr>
+
+
+
+<tr>
+  <td align=right valign=top> File system backup strategy:
+  <td>             <textarea wrap=soft cols=60 rows=6 name=backup_strategy><%= [ns_quotehtml $backup_strategy] %></textarea>
+</tr>
+
+
+        
+<tr>
+  <td align=right valign=top> RDBMS backup strategy:
+  <td>             <textarea wrap=soft cols=60 rows=6 name=rdbms_backup_strategy><%= [ns_quotehtml $rdbms_backup_strategy] %></textarea>
+</tr>
+
+
+<tr>
+  <td align=right> Complete URL for other documentation:
+  <td>             <input type=text size=60 name=further_docs_url <%= [export_form_value further_docs_url] %>>
+</tr>
+
+</table>
+
+<p>
+  
+<%=[glassroom_submit_button "$submit_button_text" ]%>
+
+
+</form>
+
Index: web/openacs/www/glassroom/host-view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/host-view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/host-view.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,123 @@
+# host-view.tcl,v 3.0 2000/02/06 03:44:44 ron Exp
+# host-view.tcl -- view a host's information, and also give them the option
+#                  to edit or delete the information
+
+
+set_form_variables
+
+# Expects host_id
+
+validate_integer host_id $host_id
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+
+
+# snarf the host information
+
+set db [ns_db gethandle]
+
+set select_sql "
+select hostname, ip_address, os_version, description, model_and_serial,
+       street_address, remote_console_instructions, service_phone_number,
+       service_contract, facility_phone, facility_contact, backup_strategy,
+       rdbms_backup_strategy, further_docs_url
+  from glassroom_hosts
+ where host_id=$host_id"
+
+set selection [ns_db 0or1row $db $select_sql]
+
+if { [empty_string_p $selection] } {
+    # if it's not there, just redirect them to the index page
+    # (if they hacked the URL, they get what they deserve, if the
+    # the host has been deleted, they can see the list of valid hosts)
+    ns_returnredirect index.tcl
+    return
+}
+
+set_variables_after_query
+
+ns_db releasehandle $db
+
+
+# emit the page contents
+
+ReturnHeaders
+
+ns_write "[ad_header $hostname]
+
+<h2>$hostname</h2>
+in [ad_context_bar [list index.tcl Glassroom] "View Host"]
+<hr>
+
+<h3>The Host</h3>
+
+<ul>
+    <li> <b>Hostname:</b> $hostname
+         <p>
+
+    <li> <b>IP Address:</b> $ip_address
+         <p>
+
+    <li> <b>OS and Version:</b> $os_version
+         <p>
+
+    <li> <b>Physical Configuration:</b> $description
+         <p>
+
+    <li> <b>Model and Serial#</b> $model_and_serial
+         <p>
+
+    <li> <b>Address</b> $street_address
+         <p>
+
+    <li> <b>How to get to console port</b> $remote_console_instructions
+         <p>
+
+    <li> <b>Service number</b> $service_phone_number
+         <p>
+
+    <li> <b>Service contract:</b> $service_contract
+         <p>
+
+    <li> <b>Hosting phone:</b> $facility_phone
+         <p>
+
+    <li> <b>Hosting contact:</b> $facility_contact
+         <p>
+
+    <li> <b>Backup strategy:</b> $backup_strategy
+         <p>
+
+    <li> <b>RDBMS backup strategy:</b> $rdbms_backup_strategy
+         <p>
+
+    <li> <b>Further Documentation:</b> <a href=\"$further_docs_url\">$further_docs_url</a>
+</ul>
+"
+
+
+ns_write "
+
+<h3>Actions</h3>
+
+<ul>
+   <li> <a href=\"host-edit.adp?[export_url_vars host_id]\">Edit</a>
+        <p>
+
+   <li> <a href=\"host-delete.tcl?[export_url_vars host_id]\">Delete</a>
+
+</ul>
+
+[glassroom_footer]
+"
+
+
Index: web/openacs/www/glassroom/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/index.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,378 @@
+# index.tcl,v 3.0 2000/02/06 03:44:45 ron Exp
+# index.tcl for /glassroom -- primary page for accessing the GlassRoom
+#               module.  displays current alerts, as well as look at
+#               existing information, and add logbook entries
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+	ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+	return
+}
+
+
+# emit the page contents
+
+set page_title [ad_parameter SystemName glassroom "Glass Room"]
+
+ReturnHeaders
+
+ns_write "[ad_header $page_title]
+
+<h2>$page_title</h2>
+
+from [ad_site_home_link]
+
+<hr>
+
+"
+
+
+set db [ns_db gethandle]
+
+
+# important alerts go here
+
+
+ns_write "<h3>Alerts</h3>
+<ul>"
+
+set alerts_p 0
+
+
+
+# see if any certs (with retsin!)  have expired
+
+set cert_expire_threshold [ad_parameter CertExpireMonthWarning glassroom 2]
+
+set count [database_to_tcl_string $db "select count(*) from glassroom_certificates where trunc(months_between(expires,[db_sysdate]),2) < $cert_expire_threshold"]
+
+if { $count > 0 } {
+    
+    set alerts_p 1
+
+    set select_sql "
+    select hostname,  expires, cert_id,
+           trunc(months_between(expires,[db_sysdate]), 2) as expire_months
+      from glassroom_certificates
+     where trunc(months_between(expires,[db_sysdate]), 2) < $cert_expire_threshold
+     order by hostname
+    "
+    set selection [ns_db select $db $select_sql]
+    
+    while { [ns_db getrow $db $selection] } {
+	set_variables_after_query
+	ns_write "    <li> <a href=\"cert-view.tcl?[export_url_vars cert_id]\">$hostname</a>"
+	if { $expire_months < 0} {
+	    ns_write "    <font color=red>Certificate has <blink>expired</blink></font>"
+	} elseif { $expire_months < $cert_expire_threshold } {
+	    ns_write "    <font color=red>Certificate will soon expire</font>"
+	}
+    }
+}
+
+
+# see if any domains  have expired
+
+set domain_expire_threshold [ad_parameter DomainExpireMonthWarning glassroom 2]
+
+set count [database_to_tcl_string $db "select count(*) from glassroom_domains where trunc(months_between(expires,[db_sysdate]),2) < $domain_expire_threshold"]
+
+if { $count > 0 } {
+    
+    set alerts_p 1
+
+    set select_sql "
+    select domain_name,
+           trunc(months_between(expires,sysdate()), 2) as expire_months
+      from glassroom_domains
+     where trunc(months_between(expires,sysdate()), 2) < $domain_expire_threshold
+     order by domain_name
+    "
+    set selection [ns_db select $db $select_sql]
+    
+    while { [ns_db getrow $db $selection] } {
+	set_variables_after_query
+	ns_write "    <li> <a href=\"domain-view.tcl?[export_url_vars domain_name]\">$domain_name</a>"
+	if { $expire_months < 0} {
+	    ns_write "    <font color=red>Domain has <blink>expired</blink></font>"
+	} elseif { $expire_months < $domain_expire_threshold } {
+	    ns_write "    <font color=red>Domain will soon expire</font>"
+	}
+    }
+}
+
+
+if { !$alerts_p } {
+    ns_write "<li> no alerts at this time"
+}
+
+ns_write "</ul>"
+
+
+
+
+# logbook stuff
+
+ns_write "<br><br><br> <h3>Logbook</h3>
+<ul>"
+
+set select_sql "
+select procedure_name, count(*) as count
+  from glassroom_logbook
+ group by procedure_name
+ order by procedure_name"
+
+set selection [ns_db select $db $select_sql]
+
+set logbook_count 0
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    if { $count == 1 } {
+	ns_write "    <li> <a href=\"logbook-view.tcl?[export_url_vars procedure_name]\">$procedure_name</a> (1 entry)"
+    } else {
+	ns_write "    <li> <a href=\"logbook-view.tcl?[export_url_vars procedure_name]\">$procedure_name</a> ($count entries)"
+    }
+
+    incr logbook_count
+}
+
+if { $logbook_count == 0 } {
+    ns_write "    <li> No logbook entries found.  Would you like to <a href=\"logbook-add.adp\">add one</a>?\n</ul>"
+} else {
+    ns_write "</ul>\nOr <a href=\"logbook-add.adp\">add a new logbook entry</a>?\n"
+}
+
+
+# Software module and release stuff
+
+# glassroom_modules.  module_id, module_name, current_version
+
+ns_write "<br><br><br> <h3>Software Modules</h3>
+<ul>"
+
+set select_sql "
+select module_id, module_name, current_version
+  from glassroom_modules
+ order by module_name
+"
+
+set selection [ns_db select $db $select_sql]
+
+set module_count 0
+
+set db2 [ns_db gethandle subquery]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    ns_write "    <li> <a href=\"module-view.tcl?[export_url_vars module_id]\">$module_name</a> $current_version"
+    
+    set count [database_to_tcl_string $db2 "select count(*) from glassroom_releases where module_id = $module_id"]
+    if { $count > 0 } {
+	ns_write "      <ul>"
+
+	set sub_select_sql "select release_id, release_name, release_date, anticipated_release_date from glassroom_releases where module_id = $module_id order by release_name"
+
+	set sub_selection [ns_db select $db2 $sub_select_sql]
+
+	while { [ns_db getrow $db2 $sub_selection] } {
+	    set_variables_after_subquery
+	    #!!! do something with release_date and anticipated_release_date, such as print 'released on xxxxx', or 'antcipated to be released on xxxx'
+	    ns_write "      <li> <a href=\"release-view.tcl?[export_url_vars release_id]\">$release_name</a>"
+	}
+
+	ns_write "      </ul>"
+    }
+    incr module_count
+}
+
+ns_db releasehandle $db2
+
+if { $module_count == 0 } {
+    ns_write "    <li> No software modules found.  Would you like to <a href=\"module-add.adp\">add one</a>?\n</ul>"
+} else {
+    ns_write "    </ul>\nOr <a href=\"module-add.adp\">add a new software module</a> or <a href=\"release-add.adp\">add a new release to a module</a>?\n"
+}
+
+
+
+# procedure stuff
+
+ns_write "<br><br><br> <h3>Procedures</h3>
+<ul>"
+
+set select_sql "
+select procedure_name
+  from glassroom_procedures
+ order by procedure_name"
+
+set selection [ns_db select $db $select_sql]
+
+set procedure_count 0
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    ns_write "    <li> <a href=\"procedure-view.tcl?[export_url_vars procedure_name]\">$procedure_name</a>"
+
+    incr procedure_count
+}
+
+if { $procedure_count == 0 } {
+    ns_write "    <li> No procedures found.  Would you like to <a href=\"procedure-add.adp\">add one</a>?\n</ul>"
+} else {
+    ns_write "</ul>\nOr <a href=\"procedure-add.adp\">add a new procedure</a>?\n"
+}
+
+
+
+# Service stuff
+
+
+ns_write "
+<br><br><br><h3>Services</h3>
+<ul>"
+
+set select_sql "
+select service_name
+  from glassroom_services
+ order by service_name
+"
+
+set selection [ns_db select $db $select_sql]
+
+set service_count 0
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    ns_write "    <li> <a href=\"service-view.tcl?[export_url_vars service_name]\">$service_name</a>"
+    incr service_count
+}
+
+if { $service_count == 0 } {
+    ns_write "    <li> No services found.  Would you like to <a href=\"service-add.adp\">add one</a>?\n</ul>"
+} else {
+    ns_write "</ul>\nOr <a href=\"service-add.adp\">add a new service</a>?\n"
+}
+
+
+
+# Host stuff
+
+
+ns_write "
+<br><br><br><h3>Hosts</h3>
+<ul>"
+
+set select_sql "
+select hostname, host_id 
+  from glassroom_hosts
+ order by hostname
+"
+
+set selection [ns_db select $db $select_sql]
+
+set host_count 0
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    ns_write "    <li> <a href=\"host-view.tcl?[export_url_vars host_id]\">$hostname</a>"
+    incr host_count
+}
+
+if { $host_count == 0 } {
+    ns_write "    <li> No hosts found.  Would you like to <a href=\"host-add.adp\">add one</a>?\n</ul>"
+} else {
+    ns_write "</ul>\nOr <a href=\"host-add.adp\">add a new host</a>?\n"
+}
+
+
+
+# Certificate stuff
+
+ns_write "<br><br><br> <h3>Certificates</h3>
+<ul>"
+
+set select_sql "
+select hostname, expires, cert_id,
+       trunc(months_between(expires, sysdate()), 2) as expire_months
+  from glassroom_certificates
+ order by hostname
+"
+
+set selection [ns_db select $db $select_sql]
+
+set cert_count 0
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    ns_write "    <li> <a href=\"cert-view.tcl?[export_url_vars cert_id]\">$hostname</a>"
+
+    if { $expire_months < 0} {
+	ns_write "    <font color=red>Certificate has <blink>expired</blink></font>"
+    } elseif { $expire_months < $cert_expire_threshold } {
+	ns_write "    <font color=red>Certificate will soon expire</font>"
+    }
+    incr cert_count
+}
+
+if { $cert_count == 0 } {
+    ns_write "    <li> No certificates found.  Would you like to <a href=\"cert-add.adp\">add one</a>?\n</ul>"
+} else {
+    ns_write "</ul>\nOr <a href=\"cert-add.adp\">add a new certificate</a>?\n"
+}
+
+
+
+# Domain stuff
+
+ns_write "<br><br><br> <h3>Domains</h3>
+<ul>"
+
+set select_sql "
+select domain_name, expires,
+       trunc(months_between(expires, sysdate()), 2) as expire_months
+  from glassroom_domains
+ order by domain_name
+"
+
+set selection [ns_db select $db $select_sql]
+
+set domain_count 0
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    ns_write "    <li> <a href=\"domain-view.tcl?[export_url_vars domain_name]\">$domain_name</a>"
+
+    if { $expire_months < 0} {
+	ns_write "    <font color=red>Domain has <blink>expired</blink></font>"
+    } elseif { $expire_months < $domain_expire_threshold } {
+	ns_write "    <font color=red>Domain will soon expire</font>"
+    }
+    incr domain_count
+}
+
+if { $domain_count == 0 } {
+    ns_write "    <li> No domains found.  Would you like to <a href=\"domain-add.adp\">add one</a>?\n</ul>"
+} else {
+    ns_write "</ul>\nOr <a href=\"domain-add.adp\">add a new domain</a>?\n"
+}
+
+
+
+
+
+# that's all, folks
+
+ns_db releasehandle $db
+
+ns_write "
+
+[glassroom_footer]
+"
+
Index: web/openacs/www/glassroom/logbook-add-2.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/logbook-add-2.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/logbook-add-2.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,67 @@
+<%
+# logbook-add-2.adp -- add a new entry to the the glassroom_logbook table
+#                      (this is an ADP as opposed to a .tcl file so that 
+#                      it's consistent naming with logbook-add.adp)
+
+
+set_the_usual_form_variables
+
+# Expects procedure_name_select, procedure_name_text, notes
+
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+
+
+# no real argument checking to be done.
+# procedure_name_text takes precedence over procedure_name_select
+
+set procedure_name ""
+
+if { [info exists procedure_name_select] && ![empty_string_p $procedure_name_select] } {
+    set procedure_name $procedure_name_select
+}
+
+if { [info exists procedure_name_text] && ![empty_string_p $procedure_name_text] } {
+    set procedure_name $procedure_name_text
+}
+
+
+
+
+
+# Assuming we don't need to confirm entry.  Just add it to the
+# glassroom_certs table
+
+set insert_sql "
+    insert into glassroom_logbook
+      (entry_id, entry_time, entry_author, procedure_name, notes)
+    values
+      (glassroom_logbook_entry_id_seq.nextval, sysdate, $user_id,
+       '[DoubleApos $procedure_name]', '$QQnotes')
+    "
+    
+set db [ns_db gethandle]
+ns_db dml $db "$insert_sql"
+ns_db releasehandle $db
+
+
+# and redirect back to index.tcl so folks can see the new entry list
+
+ns_returnredirect "index.tcl"
+
+%>
+
Index: web/openacs/www/glassroom/logbook-add.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/logbook-add.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/logbook-add.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,54 @@
+<%
+# logbook-add.tcl -- add a new logbook entry
+#                    This file is an ADP so that we can ns_adp_include the 
+#                    logbook entry entry/editing form
+
+set_form_variables 0
+
+# expects nothing, or perhaps the procedure name
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+
+
+# emit the page contents
+
+ns_puts "[ad_header "Add a New Logbook Entry"]"
+
+ns_puts "<h2>Add a New Logbook Entry</h2>
+in [ad_context_bar [list index.tcl Glassroom] "Add Logbook Entry"]
+<hr>
+"
+
+
+# include the shared HTML form
+
+set db [ns_db gethandle]
+
+if {![info exists notes]} {
+	set notes ""
+}
+
+ns_adp_include "logbook-form.adp" "Add Logbook Entry" "logbook-add-2.adp"
+
+ns_db releasehandle $db
+
+
+ns_puts "[glassroom_footer]"
+
+%>
+
Index: web/openacs/www/glassroom/logbook-form.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/logbook-form.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/logbook-form.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,68 @@
+<%
+# logbook-form.adp -- an included file for logbook-edit.adp and logbook-add.adp
+#                     which shares the form between those two pages
+#
+# required arguments - the text for the "submit button" and the action
+#                      for the form
+
+if { [ns_adp_argc] != 3 } {
+    ns_log error "wrong number of arguments passed to release-form.adp. I count [ns_adp_argc].  The text for the submit button should be included, as well as the form action to send the data to."
+    ns_adp_abort
+}
+
+ns_adp_bind_args submit_button_text form_action
+
+if ![info exists procedure_name] {
+    set procedure_name ""
+}
+
+%>
+
+
+<%=[glassroom_form_action "$form_action" ]%>
+
+
+<table>
+
+<tr>
+  <td align=right> Procedure:
+  <td>             <select name=procedure_name_select>
+                      <option value=""> No Procedure
+<%
+set name_in_popup_p 0
+
+set select_sql "select procedure_name as procedure_name_db from glassroom_procedures order by procedure_name"
+set selection [ns_db select $db $select_sql]
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { [string compare $procedure_name_db $procedure_name] == 0 } {
+	ns_puts "                      <option selected> $procedure_name_db</option>"
+	set name_in_popup_p 1
+    } else {
+	ns_puts "                      <option> $procedure_name_db</option>"
+    }
+}
+%>
+                   </select>
+   or
+<%
+if { !$name_in_popup_p } {
+    ns_puts "                      <input type=text maxlength=50 name=procedure_name_text [export_form_value procedure_name] >"
+} else {
+    ns_puts "                      <input type=text maxlength=50 name=procedure_name_text>"
+}
+%>
+</tr>
+
+<tr>
+  <td align=right> Notes:
+  <td>             <textarea wrap=soft cols=60 rows=6 name=notes><%= [ns_quotehtml $notes] %></textarea>
+</tr>
+
+</table>
+
+<p>
+  
+<%=[glassroom_submit_button "$submit_button_text" ]%>
+
+</form>
Index: web/openacs/www/glassroom/logbook-view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/logbook-view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/logbook-view.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,95 @@
+# logbook-view.tcl,v 3.0 2000/02/06 03:44:47 ron Exp
+# logbook-view.tcl -- view a particular procedure's logbook entries
+
+set_the_usual_form_variables
+
+# Expects procedure_name
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+set db_handles [ns_db gethandle main 2]
+set db [lindex $db_handles 0]
+set db2 [lindex $db_handles 1]
+
+
+set select_sql "
+select entry_id, entry_time, 
+       first_names || ' ' || last_name as pretty_entry_author, notes
+  from glassroom_logbook, users
+ where procedure_name='$QQprocedure_name'
+       and glassroom_logbook.entry_author=users.user_id
+       and users.user_id = entry_author
+ order by entry_time"
+
+set selection [ns_db select $db $select_sql]
+
+if { [empty_string_p $selection] } {
+    # if it's not there, just redirect them to the index page
+    # (if they hacked the URL, they get what they deserve, if all the
+    # entries for the procedure have been deleted, they can see the list of valid procedures)
+    ns_returnredirect index.tcl
+    return
+}
+
+
+
+
+# emit the page contents
+
+ReturnHeaders
+
+ns_write "[ad_header "Logbook Entries for $procedure_name"]
+
+<h2>Logbook Entries for $procedure_name</h2>
+in [ad_context_bar [list index.tcl Glassroom] "View Logbook"]
+<hr>
+
+<h3>The Logbook</h3>
+
+<center>
+<table border=1 width=90%>"
+
+ns_write "<tr><th>Time</th><th>Author</th><th>Notes</th><th colspan=2>Comments</th></tr>"
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    ns_write "<tr><td>[util_AnsiDatetoPrettyDate $entry_time]</td><td>$pretty_entry_author</td><td>$notes</td><td>"
+
+    # see if there are any comments on this item
+    set count [database_to_tcl_string $db2 "select count(*) from general_comments where on_what_id = $entry_id and on_which_table = 'glassroom_logbook'"]
+
+    if { $count > 0 } {
+	if { $count == 1 } {
+	    set entry_text "comment"
+	} else {
+	    set entry_text "comments"
+	}
+	ns_write "$count $entry_text. </td><td><form method=POST action=\"entry-comment.tcl\"><input type=submit name=submit value=\"View $entry_text\">[export_form_vars entry_id procedure_name]</form></td>"
+    } else { 
+	ns_write "<form method=POST action=\"entry-comment.tcl\"><input type=submit name=submit value=\"Add Comment\">[export_form_vars entry_id procedure_name]</form>"
+    }
+
+    ns_write "</td></tr>"
+}
+
+
+ns_write "</table></center><p>
+
+Would you like to <a href=\"logbook-add.adp?procedure_name=[ns_urlencode $procedure_name]\">add a new logbook entry</a>?
+
+
+[glassroom_footer]
+"
+
+
+
+
Index: web/openacs/www/glassroom/module-add-2.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/module-add-2.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/module-add-2.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,82 @@
+<%
+# module-add-2.adp -- add a new software module to the glassroom_modules
+#                     table.
+
+
+
+set_the_usual_form_variables
+
+# Expects module_id, module_name, who_installed_it, who_owns_it, source
+#         current_version
+#
+# This also handles two 'search' buttons for looking up folks:
+#     find_who_owns_it and find_who_installed_it
+# if either of these are set, then that's the action that triggered
+# us
+
+validate_integer module_id $module_id
+validate_integer who_owns_it $who_owns_it
+validate_integer who_installed_it $who_installed_it
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+# redirect to a search page if appropriate
+
+if [info exists find_who_owns_it] {
+    ns_adp_include user-search.adp "Who Owns It" "who_owns" "/glassroom/module-add.adp" [list module-add.adp "Add Software Module"] "module_name who_installed_it who_owns_it source current_version search_token"
+    ns_adp_break
+}
+
+if [info exists find_who_installed_it] {
+    ns_adp_include user-search.adp "Who Installed It" "who_installed" "/glassroom/module-add.adp" [list module-add.adp "Add Software Module"] "module_name who_installed_it who_owns_it source current_version search_token"
+
+    ns_adp_break
+}
+
+
+# if we get here, we add it to the database
+
+# check for bad input
+
+if ![info exists who_installed_it] {
+    set who_installed_it "NULL"
+}
+
+if ![info exists who_owns_it] {
+    set who_owns_it "NULL"
+}
+
+set happy_p [glassroom_check_module_args $module_name $who_installed_it $who_owns_it $source $current_version]
+
+
+if $happy_p {
+    set insert_sql "
+    insert into glassroom_modules
+      (module_id, module_name, source, current_version, who_installed_it, who_owns_it)
+    values
+      (glassroom_module_id_sequence.nextval, '$QQmodule_name', '$QQsource', '$QQcurrent_version', $who_installed_it, $who_owns_it)"
+
+    set db [ns_db gethandle]
+    ns_db dml $db "$insert_sql"
+    ns_db releasehandle $db
+
+    # and redirect back to index.tcl so folks can see the new module list
+
+    ns_returnredirect "index.tcl"
+}
+
+%>
+
Index: web/openacs/www/glassroom/module-add.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/module-add.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/module-add.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,66 @@
+<%
+# module-add.adp -- add a new software module.
+#
+
+
+set_form_variables 0
+
+# expects either nothing, or all of the requisite form data
+#
+# if search_token is set, that means that we've gotten to this page
+# from a user search. expected tokens are "who_installed" and "who_owns"
+
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+if [info exists search_token] {
+    if { $search_token == "who_installed" } {
+	set who_installed_it $user_id_from_search
+    } elseif { $search_token == "who_owns" } {
+	set who_owns_it $user_id_from_search
+    }
+}
+
+
+# emit the page contents
+
+ns_puts "
+[ad_header "Add a new Software Module"]
+<h2>Add a new Software Module</h2>
+in [ad_context_bar [list index.tcl Glassroom] "Add Software Module"]
+<hr>
+"
+
+# generate the module_id
+
+set db [ns_db gethandle]
+
+if ![info exists module_id] {
+    set module_id [database_to_tcl_string $db "select glassroom_module_id_sequence.nextval from dual"]
+}
+
+# include the shared HTML form
+
+ns_adp_include "module-form.adp" "Add Module" "module-add-2.adp"
+
+ns_db releasehandle $db
+
+
+ns_puts "[glassroom_footer]"
+
+%>
+
Index: web/openacs/www/glassroom/module-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/module-delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/module-delete-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,87 @@
+# module-delete-2.tcl,v 3.0 2000/02/06 03:44:49 ron Exp
+# module-delete-2.tcl -- remove a module from glassroom_modules
+#
+
+
+set_form_variables
+
+# Expects module_id
+
+validate_integer module_id $module_id
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+
+# snarf the module name
+
+set db [ns_db gethandle]
+
+set select_sql "
+select module_name || ' ' || current_version
+  from glassroom_modules
+ where module_id=$module_id"
+
+set module_name [database_to_tcl_string_or_null $db $select_sql]
+
+
+# emit the page contents
+
+ReturnHeaders
+
+ns_write "[ad_header "Module \"$module_name\" Deleted"]
+
+<h2>Module \"$module_name\" Deleted</h2>
+<hr>
+"
+
+set count [database_to_tcl_string $db "select count(*) from glassroom_modules where module_id=$module_id"]
+
+if { $count > 0 } {
+    set db2 [ns_db gethandle subquery]
+
+    set select_sql "select release_id from glassroom_releases where module_id = $module_id"
+    set selection [ns_db select $db $select_sql]
+
+    while { [ns_db getrow $db $selection] } {
+	set_variables_after_query
+
+	ns_db dml $db2 "delete from glassroom_releases where release_id = $release_id"
+    }
+
+    ns_db releasehandle $db2
+
+}
+
+set delete_sql "delete from glassroom_modules where module_id=$module_id"
+
+#!!! what to do if delete fails...
+
+ns_db dml $db $delete_sql
+
+ns_db releasehandle $db
+
+
+ns_write "
+Deletion of $module_name confirmed.
+
+<p>
+
+
+<a href=index.tcl>Return to the Glass Room</a>
+
+[glassroom_footer]
+"
Index: web/openacs/www/glassroom/module-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/module-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/module-delete.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,97 @@
+# module-delete.tcl,v 3.0 2000/02/06 03:44:50 ron Exp
+# module-delete.tcl -- confirm the removal of a software module from glassroom_modules
+#
+
+
+set_form_variables
+
+# Expects module_id
+
+validate_integer module_id $module_id
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+
+#snarf the module name
+
+set db [ns_db gethandle]
+
+set select_sql "
+select module_name || ' ' || current_version
+  from glassroom_modules
+ where module_id=$module_id"
+
+set module_name [database_to_tcl_string_or_null $db $select_sql]
+
+
+# if there's nothing there, it might have been deleted already
+if { [empty_string_p $module_name] } {
+    ns_returnredirect index.tcl
+}
+
+
+#emit the page contents
+
+ReturnHeaders
+
+ns_write "[ad_header "Delete \"$module_name\""]
+
+<h2>Delete \"$module_name\"</h2>
+in [ad_context_bar [list index.tcl Glassroom] [list module-view.tcl?[export_url_vars module_id] "View Module"] "Delete Module"]
+<hr>
+
+"
+
+set count [database_to_tcl_string $db "select count(*) from glassroom_releases where module_id = $module_id"]
+
+if { $count > 0 } {
+    ns_write "Are you sure you want to delete this module and its associated releases?
+<blockquote><ul>"
+    set select_sql "select release_name, release_id from glassroom_releases where module_id = $module_id order by release_name"
+    set selection [ns_db select $db $select_sql]
+    while { [ns_db getrow $db $selection ] } {
+	set_variables_after_query
+	ns_write "      <li> <a href=\"release-view.tcl?[export_url_vars release_id]\">$release_name</a>"
+    }
+    ns_write "</ul></blockquote> <p>&nbsp;<p> "
+} else {
+    ns_write "Are you sure you want to delete this module?"
+}
+
+
+
+
+
+ns_db releasehandle $db
+
+
+ns_write "
+
+<ul>
+   <li> <a href=\"module-delete-2.tcl?[export_url_vars module_id]\">yes, I'm sure</a>
+        <br><br>
+
+   <li> <a href=\"module-view.tcl?[export_url_vars module_id]\">no, let me look at the module info again</a>
+</ul>
+
+[glassroom_footer]
+"
+
+
+
+
+
Index: web/openacs/www/glassroom/module-edit-2.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/module-edit-2.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/module-edit-2.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,82 @@
+<%
+# module-edit-2.adp -- modify a software module to the glassroom_modules
+#                      table.
+
+
+set_the_usual_form_variables
+
+# Expects module_id, module_name, who_installed_it, who_owns_it, source
+#         current_version
+#
+# This also handles two 'search' buttons for looking up folks:
+#     find_who_owns_it and find_who_installed_it
+# if either of these are set, then that's the action that triggered
+# us
+
+validate_integer module_id $module_id
+validate_integer who_owns_it $who_owns_it
+validate_integer who_installed_it $who_installed_it
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+if [info exists find_who_owns_it] {
+    ns_adp_include user-search.adp "Who Owns It" "who_owns" "/glassroom/module-edit.adp" [list module-edit.adp "Edit Module"] "module_id module_name who_installed_it who_owns_it source current_version search_token"
+    ns_adp_break
+}
+
+if [info exists find_who_installed_it] {
+    ns_adp_include user-search.adp "Who Installed It" "who_installed" "/glassroom/module-edit.adp" [list module-edit.adp "Edit Module"] "module_id module_name who_installed_it who_owns_it source current_version search_token"
+    ns_adp_break
+}
+
+
+# if we get here, we update it in the database
+
+# check for bad input
+
+if ![info exists who_installed_it] {
+    set who_installed_it "NULL"
+}
+
+if ![info exists who_owns_it] {
+    set who_owns_it "NULL"
+}
+
+set happy_p [glassroom_check_module_args $module_name $who_installed_it $who_owns_it $source $current_version]
+
+
+if $happy_p {
+    set update_sql "
+    update glassroom_modules
+    set
+        module_name = '$QQmodule_name',
+        source = '$QQsource',
+        current_version = '$QQcurrent_version',
+        who_installed_it = $who_installed_it,
+        who_owns_it = $who_owns_it
+    where module_id = $module_id"
+
+    set db [ns_db gethandle]
+    ns_db dml $db "$update_sql"
+    ns_db releasehandle $db
+
+    # and redirect back to index.tcl so folks can see the new host list
+
+    ns_returnredirect "index.tcl"
+}
+
+%>
+
Index: web/openacs/www/glassroom/module-edit.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/module-edit.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/module-edit.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,77 @@
+<%
+# module-edit.adp -- edit a software module in the glassroom_modules table.
+#                    This file is an ADP so that we can ns_adp_include the 
+#                    entry/editing form
+
+
+set_form_variables
+
+# Expects module_id, or all of the requisite form data
+#
+# if search_token is set, that means that we've gotten to this page
+# from a user search. expected tokens are "who_installed" and "who_owns"
+
+validate_integer module_id $module_id
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+set db [ns_db gethandle]
+
+    
+if [info exists search_token] {
+    # means we're on a return-trip from user searching
+    if { $search_token == "who_installed" } {
+	set who_installed_it $user_id_from_search
+    } elseif { $search_token == "who_owns" } {
+	set who_owns_it $user_id_from_search
+    }
+} else {
+    
+    # snarf the module information
+    
+    set select_sql "
+    select module_name, source, current_version, who_installed_it, who_owns_it
+      from glassroom_modules
+     where module_id=$module_id"
+    
+    set selection [ns_db 1row $db $select_sql]
+
+    set_variables_after_query
+}
+
+
+
+# emit the page contents
+
+ns_puts "[ad_header "Edit Module \"$module_name $current_version\""]"
+
+ns_puts "<h2>Edit Module \"$module_name $current_version\"</h2>
+in [ad_context_bar [list index.tcl Glassroom] [list module-view.tcl?[export_url_vars module_id] "View Module"] "Edit Module"]
+<hr>
+"
+
+
+# include the shared HTML form
+
+ns_adp_include "module-form.adp" "Update Module" "module-edit-2.adp"
+
+
+
+ns_puts "[glassroom_footer]"
+
+%>
+
Index: web/openacs/www/glassroom/module-form.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/module-form.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/module-form.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,88 @@
+<%
+# module-form.adp -- an included file for module-edit.adp and module-add.adp
+#                    which shares the form between those two pages
+#
+# required arguments - the text for the "submit button" and the action
+#                      for the form
+
+if { [ns_adp_argc] != 3 } {
+    ns_log error "wrong number of arguments passed to module-form.adp.  The text for the submit button should be included, as well as the form action to send the data to."
+    ns_adp_abort
+}
+
+ns_adp_bind_args submit_button_text form_action
+
+if { ![info exists source] } {
+    set source ""
+}
+
+
+%>
+
+<%=[glassroom_form_action "$form_action"]%>
+
+<%= [export_form_vars module_id] %>
+
+<table>
+
+<tr>
+  <td align=right> Module Name: 
+  <td>             <input type=text maxlength=100 name=module_name <%= [export_form_value module_name] %>>
+</tr>
+
+
+<tr>
+  <td align=right> Who Installed It:
+  <td>
+<%
+if { ![info exists who_installed_it] } {
+    set whom "nobody"
+} else {
+    set whom [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id=$who_installed_it"]
+    ns_puts [export_form_vars who_installed_it]
+}
+ns_puts "<i>$whom</i>"
+%>
+<input type=submit name=find_who_installed_it value="Search for User">
+</tr>
+
+
+
+<tr>
+  <td align=right> Who Owns It:
+  <td>
+<%
+if { ![info exists who_owns_it] } {
+    set whom "nobody"
+} else {
+    set whom [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id=$who_owns_it"]
+    ns_puts [export_form_vars who_owns_it]
+}
+ns_puts "<i>$whom</i>"
+%>
+<input type=submit name=find_who_owns_it value="Search for User">
+</tr>
+
+
+<tr>
+<!-- URL, vendor phone number, whatever is necessary to get a new copy -->
+  <td align=right> Module Source: 
+  <td> <textarea wrap=virtual cols=60 rows=6 name=source><%= [ns_quotehtml $source] %></textarea>
+</tr>
+
+
+<tr>
+  <td align=right> Current Version: 
+  <td>             <input type=text maxlength=50 name=current_version <%= [export_form_value current_version] %>>
+</tr>
+
+
+
+</table>
+
+<p>
+
+<%=[glassroom_submit_button $submit_button_text]%>
+
+</form>
+
Index: web/openacs/www/glassroom/module-view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/module-view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/module-view.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,103 @@
+# module-view.tcl,v 3.0 2000/02/06 03:44:51 ron Exp
+# module-view.tcl -- view a software module's information, and also give users
+#                    the option to edit or delete the information
+
+set_form_variables
+
+# Expects module_id
+
+validate_integer module_id $module_id
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+set db [ns_db gethandle]
+
+set select_sql "
+select module_name, source, current_version, who_installed_it, who_owns_it
+  from glassroom_modules
+ where module_id = $module_id"
+
+set selection [ns_db 0or1row $db $select_sql]
+
+if { [empty_string_p $selection] } {
+    # if it's not there, just redirect them to the index page
+    # (if they hacked the URL, they get what they deserve, if the
+    # the module has been deleted, they can see the list of valid modules)
+    ns_returnredirect index.tcl
+    return
+}
+
+set_variables_after_query
+
+if { [info exists who_installed_it] && ![empty_string_p $who_installed_it] } {
+    set who_installed_it [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id=$who_installed_it"]
+} else {
+    set who_installed_it "Nobody"
+}
+
+if { [info exists who_owns_it] && ![empty_string_p $who_owns_it] } {
+    set who_owns_it [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id=$who_owns_it"]
+} else {
+    set who_owns_it "Nobody"
+}
+
+
+
+# emit the page contents
+
+ReturnHeaders
+
+ns_write "[ad_header "$module_name $current_version"]
+
+<h2>$module_name $current_version</h2>
+in [ad_context_bar [list index.tcl Glassroom] "View Module"]
+<hr>
+
+<h3>The Module</h3>
+
+<ul>
+    <li> <b>Module Name:</b> $module_name
+         <p>
+
+    <li> <b>Who Installed It:</b> $who_installed_it
+         <p>
+
+    <li> <b>Who Owns It:</b> $who_owns_it
+         <p>
+
+    <li> <b>Source:</b> $source
+         <p>
+
+    <li> <b>Current Version:</b> $current_version
+         <p>
+
+
+</ul>"
+
+
+ns_write "
+
+<h3>Actions</h3>
+
+<ul>
+   <li> <a href=\"module-edit.adp?[export_url_vars module_id]\">Edit</a>
+        <p>
+
+   <li> <a href=\"module-delete.tcl?[export_url_vars module_id]\">Delete</a>
+
+</ul>
+
+[glassroom_footer]
+"
+
+
+
+
Index: web/openacs/www/glassroom/procedure-add-2.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/procedure-add-2.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/procedure-add-2.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,84 @@
+<%
+# procedure-add-2.adp -- add a new procedure to the glassroom_procedures table
+#                      (this is an ADP as opposed to a .tcl file so that 
+#                      it's consistent naming with domain-add.adp)
+
+set_the_usual_form_variables
+
+# Expects procedure_name, procedure_description, responsible_user, responsible_user_group, max_time_interval, importance
+#
+# This also handles a 'search' button for looking up a user.
+#      find_responsible_user or find_responsible_group
+# If this is set, then that's the action that triggered us
+
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+# redirect to a search page if appropriate
+
+if [info exists find_responsible_user] {
+    ns_adp_include user-search.adp "Responsible User" "responsible_user" "/glassroom/procedure-add.adp" [list procedure-add.adp "Add Procedure"] "procedure_name procedure_description old_procedure_name responsible_user responsible_user_group max_time_interval importance search_token"
+    ns_adp_break
+}
+
+if { ![info exists responsible_user] || [empty_string_p $responsible_user] } {
+    set responsible_user ""
+}
+
+if { ![info exists responsible_user_group] || [empty_string_p $responsible_user_group] } {
+    set responsible_user_group ""
+}
+
+if { ![info exists max_time_interval] || [empty_string_p $max_time_interval] } {
+    set max_time_interval ""
+}
+
+
+
+set happy_p [glassroom_check_procedure_args $procedure_name $procedure_description $responsible_user $responsible_user_group $max_time_interval $importance]
+
+if $happy_p {
+
+    if [empty_string_p $max_time_interval] {
+	set max_time_interval "NULL"
+    }
+
+    if [empty_string_p $responsible_user] {
+	set responsible_user "NULL"
+    }
+
+    if [empty_string_p $responsible_user_group] {
+	set responsible_user_group "NULL"
+    }
+
+    set insert_sql "
+    insert into glassroom_procedures
+        (procedure_name, procedure_description, responsible_user, responsible_user_group, max_time_interval, importance)
+    values
+        ('$QQprocedure_name', '$QQprocedure_description', $responsible_user, $responsible_user_group, $max_time_interval, $importance)"
+
+    set db [ns_db gethandle]
+    ns_db dml $db "$insert_sql"
+    ns_db releasehandle $db
+
+    # and redirect back to index.tcl so folks can see the new release
+
+    ns_returnredirect "index.tcl"
+}
+
+%>
+
Index: web/openacs/www/glassroom/procedure-add.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/procedure-add.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/procedure-add.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,63 @@
+<%
+# procedure-add.adp -- add a new procedure
+
+set_form_variables 0
+
+# Expects either nothing, or all the requisite form data when doing
+#         a user search
+#
+# if search_token is set, that means that we've gotten to this page
+# from a user search. expected token is "responsible_user"
+
+
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+if [info exists search_token] {
+    if { $search_token == "responsible_user" } {
+	set responsible_user $user_id_from_search
+    }
+}
+
+
+
+
+
+# emit the page contents
+
+ns_puts "
+[ad_header "Add a new Procedure"]
+<h2>Add a new Procedure</h2>
+in [ad_context_bar [list index.tcl Glassroom] "Add Procedure"]
+<hr>
+"
+
+
+set db [ns_db gethandle]
+
+# include the shared HTML form
+
+ns_adp_include "procedure-form.adp" "Add Procedure" "procedure-add-2.adp"
+
+ns_db releasehandle $db
+
+
+ns_puts "[glassroom_footer]"
+
+%>
+
+
Index: web/openacs/www/glassroom/procedure-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/procedure-delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/procedure-delete-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,58 @@
+# procedure-delete-2.tcl,v 3.0 2000/02/06 03:44:52 ron Exp
+# procedure-delete-2.tcl -- remove a procedure from glassroom_procedures
+#
+
+set_the_usual_form_variables
+
+# Expects procedure_name
+
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+
+
+# emit the page contents
+
+ReturnHeaders
+
+ns_write "[ad_header "Procedure \"$procedure_name\" Deleted"]
+
+<h2>Procedure \"$procedure_name\" Deleted</h2>
+<hr>
+"
+
+set delete_sql "delete from glassroom_procedures where procedure_name='$QQprocedure_name'"
+
+#!!! what to do if delete fails...
+
+set db [ns_db gethandle]
+
+ns_db dml $db $delete_sql
+
+ns_db releasehandle $db
+
+
+ns_write "
+Deletion of $procedure_name confirmed.
+
+<p>
+
+
+<a href=index.tcl>Return to the Glass Room</a>
+
+[glassroom_footer]
+"
Index: web/openacs/www/glassroom/procedure-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/procedure-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/procedure-delete.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,75 @@
+# procedure-delete.tcl,v 3.0 2000/02/06 03:44:53 ron Exp
+# procedure-delete.tcl -- confirm the removal of a software procedure from glassroom_procedures
+
+
+
+
+set_the_usual_form_variables
+
+# Expects procedure_id
+
+validate_integer procedure_id $procedure_id
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+
+
+#make sure the procedure is still there
+
+set db [ns_db gethandle]
+
+set select_sql "
+select procedure_name
+  from glassroom_procedures
+ where procedure_name='$QQprocedure_name'"
+
+set procedure_name [database_to_tcl_string_or_null $db $select_sql]
+
+ns_db releasehandle $db
+
+# if there's nothing there, it might have been deleted already
+if { [empty_string_p $procedure_name] } {
+    ns_returnredirect index.tcl
+}
+
+
+#emit the page contents
+
+ReturnHeaders
+
+ns_write "[ad_header "Delete \"$procedure_name\""]
+
+<h2>Delete \"$procedure_name\"</h2>
+in [ad_context_bar [list index.tcl Glassroom] [list procedure-view.tcl?[export_url_vars procedure_name] "View Procedure"] "Delete Procedure"]
+<hr>
+
+Are you sure you want to delete this procedure?
+
+<ul>
+   <li> <a href=\"procedure-delete-2.tcl?[export_url_vars procedure_name]\">yes, I'm sure</a>
+        <br><br>
+
+   <li> <a href=\"procedure-view.tcl?[export_url_vars procedure_name]\">no, let me look at the procedure info again</a>
+</ul>
+
+[glassroom_footer]
+"
+
+
+
+
+
Index: web/openacs/www/glassroom/procedure-edit-2.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/procedure-edit-2.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/procedure-edit-2.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,91 @@
+<%
+# release-edit-2.adp -- modify a procedure in the glassroom_procedures table.
+#
+
+set_the_usual_form_variables
+
+# Expects procedure_name, procedure_description, old_procedure_name, responsible_user, responsible_user_group, max_time_interval, importance
+#
+# This also handles a 'search' button for looking up a user.
+#      find_responsible_user or find_responsible_group
+# If this is set, then that's the action that triggered us
+
+
+
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+
+# redirect to a search page if appropriate
+
+if [info exists find_responsible_user] {
+    ns_adp_include user-search.adp "Responsible User" "responsible_user" "/glassroom/procedure-edit.adp" [list procedure-edit.adp "Edit Procedure"] "procedure_name procedure_description old_procedure_name responsible_user responsible_user_group max_time_interval importance search_token"
+    ns_adp_break
+}
+
+
+
+# if we get here, we update it in the database
+
+# check for bad input
+
+if ![info exists responsible_user] {
+    set responsible_user ""
+}
+
+if ![info exists responsible_user_group] {
+    set responsible_user_group ""
+}
+
+
+
+set happy_p [glassroom_check_procedure_args $procedure_name $procedure_description $responsible_user $responsible_user_group $max_time_interval $importance]
+
+if $happy_p {
+
+    if [empty_string_p $responsible_user] {
+	set responsible_user "NULL"
+    }
+
+    if [empty_string_p $responsible_user_group] {
+	set responsible_user_group "NULL"
+    }
+
+    if [empty_string_p $max_time_interval] {
+	set max_time_interval "NULL"
+    }
+
+    set update_sql "
+    update glassroom_procedures
+    set
+        procedure_name='$QQprocedure_name',
+        procedure_description='$QQprocedure_description',
+        responsible_user=$responsible_user,
+        responsible_user_group=$responsible_user_group,
+        max_time_interval=$max_time_interval,
+        importance=$importance
+    where procedure_name='$QQold_procedure_name'"
+
+    set db [ns_db gethandle]
+    ns_db dml $db "$update_sql"
+    ns_db releasehandle $db
+
+    # and redirect back to index.tcl so folks can see the new release list
+
+    ns_returnredirect "index.tcl"
+}
+
+%>
Index: web/openacs/www/glassroom/procedure-edit.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/procedure-edit.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/procedure-edit.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,85 @@
+<%
+# procedure-edit.adp -- edit a software procedure in the glassroom_procedures table.
+#                    This file is an ADP so that we can ns_adp_include the 
+#                    entry/editing form
+
+
+set_the_usual_form_variables
+
+# Expects procedure_id, or all of the requisite form data
+#
+# if search_token is set, that means that we've gotten to this page
+# from a user search. expected token is "responsible_user"
+
+
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+set db [ns_db gethandle]
+
+    
+if [info exists search_token] {
+    # means we're on a return-trip from user searching
+    if { $search_token == "responsible_user" } {
+	set responsible_user $user_id_from_search
+    }
+
+} else {
+    
+    # snarf the module information
+    
+    set select_sql "
+    select procedure_description, responsible_user, responsible_user_group, max_time_interval, importance
+      from glassroom_procedures
+     where procedure_name = '$QQprocedure_name'"
+    
+    set selection [ns_db 1row $db $select_sql]
+
+    if { [empty_string_p $selection] } {
+	
+	# if it's not there, just redirect them to the index page
+	# (if they hacked the URL, they get what they deserve, if the
+	# the procedure has been deleted, they can see the list of valid procedures)
+	ns_returnredirect index.tcl
+	return
+    }
+
+    set_variables_after_query
+}
+
+
+
+
+# emit the page contents
+
+ns_puts "[ad_header "Edit Procedure \"$procedure_name\""]"
+
+ns_puts "<h2>Edit Procedure \"$procedure_name\"</h2>
+in [ad_context_bar [list index.tcl Glassroom] [list procedure-view.tcl?[export_url_vars procedure_id] "View Procedure"] "Edit Procedure"]
+<hr>
+"
+
+
+# include the shared HTML form
+
+ns_adp_include "procedure-form.adp" "Update Procedure" "procedure-edit-2.adp"
+
+
+
+ns_puts "[glassroom_footer]"
+
+%>
+
Index: web/openacs/www/glassroom/procedure-form.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/procedure-form.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/procedure-form.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,151 @@
+<%
+# procedure-form.adp -- an included file for procedure-edit.adp and procedure-add.adp
+#                    which shares the form between those two pages
+#
+# required arguments - the text for the "submit button" and the action
+#                      for the form
+
+if { [ns_adp_argc] != 3 } {
+    ns_log error "wrong number of arguments passed to procedure-form.adp.  The text for the submit button should be included, as well as the form action to send the data to."
+    ns_adp_abort
+}
+
+ns_adp_bind_args submit_button_text form_action
+
+if { ![info exists source] } {
+    set source ""
+}
+
+if ![info exists importance] {
+    set importance "1"
+}
+
+if ![info exists responsible_user_group] {
+    set responsible_user_group ""
+}
+
+if ![info exists procedure_description] {
+    set procedure_description ""
+}
+
+%>
+
+
+<%= [glassroom_form_action "$form_action"] %>
+
+<%
+# keep around the old procedure name if they're going to be editing it
+if ![info exists old_procedure_name] {
+    ns_puts "[philg_hidden_input old_procedure_name $procedure_name]"
+} else {
+    ns_puts "[philg_hidden_input old_procedure_name $old_procedure_name]"
+}
+
+%>
+
+<table>
+
+<tr>
+  <td align=right> Procedure Name: 
+  <td>             <input type=text maxlength=50 name=procedure_name size=30 <%= [export_form_value procedure_name] %>>
+</tr>
+
+<tr>
+  <td align=right valign=top> Procedure Description:
+  <td>             <textarea wrap-soft cols=60 rows=6 name=procedure_description><%= [ns_quotehtml $procedure_description] %></textarea>
+</tr>
+
+<tr>
+  <td align=right> Responsible User:
+  <td>             
+<%
+if { ![info exists responsible_user] || [empty_string_p $responsible_user] } {
+    set whom "nobody"
+} else {
+    set whom [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id=$responsible_user"]
+    ns_puts [export_form_vars responsible_user]
+}
+ns_puts "<i>$whom</i>"
+%>
+<input type=submit name=find_responsible_user value="Search for User">
+
+</tr>
+
+
+
+<tr>
+  <td align=right> Responsible User Group:
+  <td>             <select name=responsible_user_group>
+<%
+
+if { [empty_string_p $responsible_user_group] } {
+    ns_puts "                     <option value=\"\" selected> No Group"
+} else {
+    ns_puts "                     <option value=\"\">No Group"
+}
+
+set selection [ns_db select $db "select group_name, group_id from user_groups order by group_name"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { $responsible_user_group == $group_id } {
+	ns_puts "                     <option value=$group_id selected> $group_name"
+    } else {
+	ns_puts "                     <option value=$group_id> $group_name"
+    }
+}
+
+%>
+                   </select>
+
+</tr>
+
+
+<tr>
+  <td align=right> Maximum Time Interval:
+  <td>             <input type=text maxlength=8 name=max_time_interval size=10 <%= [export_form_value max_time_interval] %>>
+
+ (days or fractions of days)
+</tr>
+
+
+
+<tr>
+  <td align=right> Importance:
+  <td>             <select name=importance>
+                     
+<%
+
+for { set i 1 } { $i <= 10 } { incr i } {
+
+    if { $i == 1 } {
+	set label "$i - Least Important"
+    } elseif { $i == 10 } {
+	set label "$i - Most Important"
+    } else {
+	set label $i
+    }
+
+    if { [string compare $i $importance] == 0 } {
+	ns_puts "                     <option selected value=$i> $label"
+    } else {
+	ns_puts "                     <option value=$i> $label"
+    }
+
+}
+ns_puts "<option value=0> 0 -- nuke me"
+ns_puts "<option value=11> 11 -- nuke me"
+%>
+                   </select>
+</tr>
+
+
+</table>
+
+<p>
+
+<%= [glassroom_submit_button "Add Procedure"] %>
+
+</form>
+
+
Index: web/openacs/www/glassroom/procedure-view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/procedure-view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/procedure-view.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,111 @@
+# procedure-view.tcl,v 3.0 2000/02/06 03:44:54 ron Exp
+# procedure-view.tcl -- view a procedure's information
+
+set_the_usual_form_variables
+
+# epects procedure name
+
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+
+set db [ns_db gethandle]
+
+set select_sql "
+select procedure_description, responsible_user, responsible_user_group, max_time_interval, importance
+  from glassroom_procedures
+ where procedure_name='$QQprocedure_name'
+ order by procedure_name"
+
+set selection [ns_db 0or1row $db $select_sql]
+
+if { [empty_string_p $selection] } {
+
+    # if it's not there, just redirect them to the index page
+    # (if they hacked the URL, they get what they deserve, if the
+    # the module has been deleted, they can see the list of valid modules)
+    ns_returnredirect index.tcl
+    return
+}
+
+set_variables_after_query
+
+if { [info exists responsible_user] && ![empty_string_p $responsible_user] } {
+    set responsible_user [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id=$responsible_user"]
+} else {
+    set responsible_user "Nobody"
+}
+
+if { [info exists responsible_user_group] && ![empty_string_p $responsible_user_group] } {
+    set responsible_user_group [database_to_tcl_string $db "select group_name from user_groups where group_id=$responsible_user_group"]
+} else {
+    set responsible_user_group "Nobody"
+}
+
+if { [info exists max_time_interval] && ![empty_string_p $max_time_interval] } {
+    append max_time_interval " days"
+} else {
+    set max_time_interval "none"
+}
+
+
+
+
+# emit the page contents
+
+ReturnHeaders
+
+ns_write "[ad_header "$procedure_name"]
+
+<h2>$procedure_name</h2>
+in [ad_context_bar [list index.tcl Glassroom] "View Procedure"]
+<hr>
+
+
+<h3>The Procedure</h3>
+
+<ul>
+
+  <li> <b>Procedure Name</b>: $procedure_name
+       <p>
+
+  <li> <b>Procedure Description</b>: $procedure_description
+       <p>
+
+  <li> <b>Responsible User</b>: $responsible_user
+       <p>
+
+  <li> <b>Responsible Group</b>: $responsible_user_group
+       <p>
+
+  <li> <b>Max Time Interval</b>: $max_time_interval
+       <p>
+
+  <li> <b>Importance</b>: $importance (1 is least important, 10 is most important)
+       <p>
+
+</ul>
+"
+
+
+
+ns_write "
+
+<h3>Actions</h3>
+
+<ul>
+   <li> <a href=\"procedure-edit.adp?[export_url_vars procedure_name]\">Edit</a>
+        <p>
+
+   <li> <a href=\"procedure-delete.tcl?[export_url_vars procedure_name]\">Delete</a>
+
+</ul>
+
+[glassroom_footer]
+"
Index: web/openacs/www/glassroom/punch-list.txt
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/punch-list.txt,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/punch-list.txt	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,30 @@
+GlassRoom punch-list
+--------------------------------------------------
+* Add 'Clear User' button for forms with user-searching
+
+* make sure all the nav bar things are accurate and speld corectly
+  = particularly logbook entry comments.
+
+* Make the usual cleanup/editing/sanitizing pass through code
+  = space around '=' in sql statements
+  = ns_db releasehandle's as soon as possible
+
+* test all text entry fields for
+  = empty values
+  = '
+  = "
+
+* use util_AnsiDatetoPrettyDate for all displayed dates
+
+* try pages with ad_read_only_p turned on
+
+* need to make things less open and move some editing functions to admin pages
+  = any of the 'edit', 'add', or 'delete' files
+
+* error handling checking on inserts, updates
+  = particularly things that violate referential integrety
+
+* look for procedures that are haven't been done in min_interval_time yet
+
+* add approval policy for comments
+
Index: web/openacs/www/glassroom/readme.txt
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/readme.txt,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/readme.txt	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,4 @@
+Regrettably, philg only had time to write the data model and
+documentation for this module.  So you'll have to hassle him to crank
+out the .tcl scripts!
+
Index: web/openacs/www/glassroom/release-add-2.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/release-add-2.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/release-add-2.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,101 @@
+<%
+# release-add-2.adp -- add a new release to the glassroom_releases table
+#                      (this is an ADP as opposed to a .tcl file so that 
+#                      it's consistent naming with domain-add.adp)
+
+set_the_usual_form_variables
+
+# Expects release_id, module_id, release_date, anticipated_release_date,
+#         release_name, and manager
+#
+# This also handles a 'search' button for looking up a user.
+#      find_manager
+# If this is set, then that's the action that triggered us
+
+validate_integer release_id $release_id
+validate_integer module_id $module_id
+validate_integer manager $manager
+
+# release_date and anticipated_release_date are the magical AOLserver date/time format
+
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+# unpack the dates
+
+if [catch { ns_dbformvalue [ns_conn form] release_date date release_date } errmsg] {
+    ad_return_complaint 1 "<li> The release date wasn't well-formed"
+    ns_adp_abort
+}
+
+if [catch { ns_dbformvalue [ns_conn form] anticipated_release_date date anticipated_release_date } errmsg] {
+    ad_return_complaint 1 "<li> The anticipated release date wasn't well-formed"
+    ns_adp_abort
+}
+
+
+# redirect to a search page if appropriate
+
+
+if [info exists find_manager] {
+    ns_set put [ns_conn form] release_date $release_date
+    ns_set put [ns_conn form] anticipated_release_date $anticipated_release_date
+    ns_adp_include user-search.adp "Who Owns It" "manager" "/glassroom/release-add.adp" [list release-add.adp "Add Software Release"] "release_id module_id release_date anticipated_release_date release_name manager search_token actually_released"
+    ns_adp_break
+}
+
+
+
+
+# if we get here, we add it to the database
+
+# check for bad input
+
+if ![info exists manager] {
+    set manager "NULL"
+}
+
+set happy_p [glassroom_check_release_args $release_date $anticipated_release_date $release_name $manager]
+
+if $happy_p {
+
+    if ![info exists actually_released] {
+	set release_date "NULL"
+    } else {
+	set release_date "'$release_date'"
+    }
+
+    set insert_sql "
+    insert into glassroom_releases
+      (release_id, module_id, release_date, anticipated_release_date, release_name, manager)
+    values
+      ($release_id, $module_id, 
+       to_date($release_date, 'yyyy-mm-dd'),
+       to_date('$anticipated_release_date', 'yyyy-mm-dd'),
+       '$QQrelease_name', $manager)"
+
+    set db [ns_db gethandle]
+    ns_db dml $db "$insert_sql"
+    ns_db releasehandle $db
+
+
+    # and redirect back to index.tcl so folks can see the new release
+
+    ns_returnredirect "index.tcl"
+}
+
+%>
+
Index: web/openacs/www/glassroom/release-add.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/release-add.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/release-add.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,64 @@
+<%
+# release-add.adp -- add a new release to a software module
+
+set_form_variables 0
+
+# Expects either nothing, or all the requisite form data when doing
+#         a user search
+#
+# if search_token is set, that means that we've gotten to this page
+# from a user search. expected token is "manager"
+
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+if [info exists search_token] {
+    if { $search_token == "manager" } {
+	set manager $user_id_from_search
+    }
+}
+
+
+# emit the page contents
+
+ns_puts "
+[ad_header "Add a new Software Release"]
+<h2>Add a new Software Release</h2>
+in [ad_context_bar [list index.tcl Glassroom] "Add Software Release"]
+<hr>
+"
+
+# generate the release_id
+
+set db [ns_db gethandle]
+
+if ![info exists release_id] {
+    set release_id [database_to_tcl_string $db "select glassroom_release_id_sequence.nextval from dual"]
+}
+
+# include the shared HTML form
+
+ns_adp_include "release-form.adp" "Add Release" "release-add-2.adp"
+
+ns_db releasehandle $db
+
+
+ns_puts "[glassroom_footer]"
+
+%>
+
+
Index: web/openacs/www/glassroom/release-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/release-delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/release-delete-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,69 @@
+# release-delete-2.tcl,v 3.0 2000/02/06 03:44:55 ron Exp
+# release-delete-2.tcl -- remove a release from glassroom_releases
+#
+
+
+set_form_variables
+
+# Expects release_id
+
+validate_integer release_id $release_id
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+
+# snarf the release name
+
+set db [ns_db gethandle]
+
+set select_sql "
+select release_name
+  from glassroom_releases
+ where release_id=$release_id"
+
+set release_name [database_to_tcl_string_or_null $db $select_sql]
+
+
+# emit the page contents
+
+ReturnHeaders
+
+ns_write "[ad_header "Release \"$release_name\" Deleted"]
+
+<h2>Release \"$release_name\" Deleted</h2>
+<hr>
+"
+
+set delete_sql "delete from glassroom_releases where release_id=$release_id"
+
+#!!! what to do if delete fails...
+
+ns_db dml $db $delete_sql
+
+ns_db releasehandle $db
+
+
+ns_write "
+Deletion of $release_name confirmed.
+
+<p>
+
+
+<a href=index.tcl>Return to the Glass Room</a>
+
+[glassroom_footer]
+"
Index: web/openacs/www/glassroom/release-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/release-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/release-delete.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,75 @@
+# release-delete.tcl,v 3.0 2000/02/06 03:44:56 ron Exp
+# release-delete.tcl -- confirm the removal of a software release from glassroom_releases
+
+
+
+
+set_form_variables
+
+# Expects release_id
+
+validate_integer release_id $release_id
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+
+
+#snarf the release name
+
+set db [ns_db gethandle]
+
+set select_sql "
+select release_name
+  from glassroom_releases
+ where release_id=$release_id"
+
+set release_name [database_to_tcl_string_or_null $db $select_sql]
+
+ns_db releasehandle $db
+
+# if there's nothing there, it might have been deleted already
+if { [empty_string_p $release_name] } {
+    ns_returnredirect index.tcl
+}
+
+
+#emit the page contents
+
+ReturnHeaders
+
+ns_write "[ad_header "Delete \"$release_name\""]
+
+<h2>Delete \"$release_name\"</h2>
+in [ad_context_bar [list index.tcl Glassroom] [list release-view.tcl?[export_url_vars release_id] "View Release"] "Delete Release"]
+<hr>
+
+Are you sure you want to delete this release?
+
+<ul>
+   <li> <a href=\"release-delete-2.tcl?[export_url_vars release_id]\">yes, I'm sure</a>
+        <br><br>
+
+   <li> <a href=\"release-view.tcl?[export_url_vars release_id]\">no, let me look at the release info again</a>
+</ul>
+
+[glassroom_footer]
+"
+
+
+
+
+
Index: web/openacs/www/glassroom/release-edit-2.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/release-edit-2.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/release-edit-2.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,97 @@
+<%
+# release-edit-2.adp -- modify a software release in the glassroom_releases
+#                      table.
+
+
+set_the_usual_form_variables
+
+# Expects either nothing, or all the requisite form data when doing
+#         a user search
+#
+# if search_token is set, that means that we've gotten to this page
+# from a user search. expected token is "manager"
+
+
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+# unpack the dates
+
+if [catch { ns_dbformvalue [ns_conn form] release_date date release_date } errmsg] {
+    ad_return_complaint 1 "<li> The release date wasn't well-formed"
+    ns_adp_abort
+}
+
+if [catch { ns_dbformvalue [ns_conn form] anticipated_release_date date anticipated_release_date } errmsg] {
+    ad_return_complaint 1 "<li> The anticipated release date wasn't well-formed"
+    ns_adp_abort
+}
+
+
+# redirect to a search page if appropriate
+
+if [info exists find_manager] {
+    ns_set put [ns_conn form] release_date $release_date
+    ns_set put [ns_conn form] anticipated_release_date $anticipated_release_date
+    ns_adp_include user-search.adp "Who Owns It" "manager" "/glassroom/release-edit.adp" [list release-edit.adp "Edit Software Release"] "release_id module_id release_date anticipated_release_date release_name manager search_token actually_released"
+    ns_adp_break
+}
+
+
+# if we get here, we update it in the database
+
+# check for bad input
+
+if ![info exists manager] {
+    set manager ""
+}
+
+
+set happy_p [glassroom_check_release_args $release_date $anticipated_release_date $release_name $manager]
+
+if $happy_p {
+
+    if ![info exists actually_released] {
+	set release_date "NULL"
+    } else {
+	set release_date "'$release_date'"
+    }
+
+    if [empty_string_p $manager] {
+	set manager "NULL"
+    }
+
+    set update_sql "
+    update glassroom_releases
+    set
+        module_id = $module_id,
+        release_date = to_date($release_date, 'yyyy-mm-dd'),
+        anticipated_release_date = to_date('$anticipated_release_date', 'yyyy-mm-dd'),
+        release_name = '$QQrelease_name',
+        manager = $manager
+    where release_id = $release_id"
+
+    set db [ns_db gethandle]
+    ns_db dml $db "$update_sql"
+    ns_db releasehandle $db
+
+    # and redirect back to index.tcl so folks can see the new release list
+
+    ns_returnredirect "index.tcl"
+}
+
+%>
+
Index: web/openacs/www/glassroom/release-edit.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/release-edit.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/release-edit.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,89 @@
+<%
+# release-edit.adp -- edit a software release in the glassroom_releases table.
+#                    This file is an ADP so that we can ns_adp_include the 
+#                    entry/editing form
+
+
+set_form_variables
+
+# Expects release_id, or all of the requisite form data
+#
+# if search_token is set, that means that we've gotten to this page
+# from a user search. expected token is "manager"
+
+validate_integer release_id $release_id
+
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+set db [ns_db gethandle]
+    
+if [info exists search_token] {
+    # means we're on a return-trip from user searching
+    if { $search_token == "manager" } {
+	set manager $user_id_from_search
+    }
+
+} else {
+    
+    # snarf the module information
+    
+    set select_sql "
+    select release_name, manager, release_date, anticipated_release_date, module_id
+      from glassroom_releases
+     where release_id=$release_id"
+    
+    set selection [ns_db 1row $db $select_sql]
+
+    if { [empty_string_p $selection] } {
+	
+	# if it's not there, just redirect them to the index page
+	# (if they hacked the URL, they get what they deserve, if the
+	# the module has been deleted, they can see the list of valid modules)
+	ns_returnredirect index.tcl
+	return
+    }
+
+    set_variables_after_query
+
+    if ![empty_string_p $release_date] {
+	set actually_released checked
+    }
+}
+
+
+
+
+# emit the page contents
+
+ns_puts "[ad_header "Edit Release \"$release_name\""]"
+
+ns_puts "<h2>Edit Release \"$release_name\"</h2>
+in [ad_context_bar [list index.tcl Glassroom] [list release-view.tcl?[export_url_vars release_id] "View Release"] "Edit Release"]
+<hr>
+"
+
+
+# include the shared HTML form
+
+ns_adp_include "release-form.adp" "Update Release" "release-edit-2.adp"
+
+
+
+ns_puts "[glassroom_footer]"
+
+%>
+
Index: web/openacs/www/glassroom/release-form.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/release-form.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/release-form.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,111 @@
+<%
+# release-form.adp -- an included file for release-edit.adp and release-add.adp
+#                    which shares the form between those two pages
+#
+# required arguments - the text for the "submit button" and the action
+#                      for the form
+
+if { [ns_adp_argc] != 3 } {
+    ns_log error "wrong number of arguments passed to release-form.adp.  The text for the submit button should be included, as well as the form action to send the data to."
+    ns_adp_abort
+}
+
+ns_adp_bind_args submit_button_text form_action
+
+if { ![info exists source] } {
+    set source ""
+}
+
+
+
+if { ![info exists release_date] || [empty_string_p $release_date] } {
+    set release_date [ns_fmttime [ns_time] "%Y-%m-%d"]
+}
+
+if { ![info exists anticipated_release_date] || [empty_string_p $release_date] } {
+    set anticipated_release_date [ns_fmttime [ns_time] "%Y-%m-%d"]
+}
+
+if { ![info exists module_id] } {
+    set module_id ""
+}
+
+%>
+
+<%[glassroom_form_action "$form_action" ]%>
+
+<%= [export_form_vars release_id] %>
+
+
+<table>
+
+<tr>
+  <td align=right> Release Name: 
+  <td>             <input type=text maxlength=50 name=release_name <%= [export_form_value release_name] %>>
+</tr>
+
+<tr>
+  <td align=right> Software Module:
+  <td>             <select name=module_id>
+
+<%
+set select_sql "select module_name, module_id as module_id_from_db from glassroom_modules order by module_name"
+set selection [ns_db select $db $select_sql]
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { $module_id_from_db == $module_id } {
+	ns_puts "                     <option value=$module_id selected>$module_name</option>"
+    } else {
+	ns_puts "                     <option value=$module_id_from_db>$module_name</option>"
+    }
+}
+%>
+                   </select>
+</tr>
+
+
+<tr>
+  <td align=right> Manager:
+  <td>             
+<%
+if { ![info exists manager] || [empty_string_p $manager] } {
+    set whom "nobody"
+} else {
+    set whom [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id=$manager"]
+    ns_puts [export_form_vars manager]
+}
+ns_puts "<i>$whom</i>"
+%>
+<input type=submit name=find_manager value="Search for User">
+
+</tr>
+
+
+<tr>
+  <td align=right> Anticiapted Release Date:
+  <td>             <%= [philg_dateentrywidget anticipated_release_date $anticipated_release_date] %>
+</tr>
+
+
+<tr>
+  <td align=right> Release Date:
+  <td>             <%= [philg_dateentrywidget release_date $release_date] %>
+
+<%
+if [info exists actually_released] {
+    ns_puts "<input type=checkbox name=actually_released value=checked checked>Actually Released?"
+} else {
+    ns_puts "<input type=checkbox name=actually_released value=checked>Actually Released?"
+}
+%>
+</tr>
+
+</table>
+
+<p>
+
+
+<%= [glass_room_submit_button "$submit_button_text"] %>
+
+</form>
+
Index: web/openacs/www/glassroom/release-view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/release-view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/release-view.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,101 @@
+# release-view.tcl,v 3.0 2000/02/06 03:44:58 ron Exp
+# release-view.tcl -- view a software release's information
+
+set_form_variables
+
+# Expects release_id
+
+validate_integer release_id $release_id
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+
+set db [ns_db gethandle]
+
+set select_sql "
+select glassroom_releases.module_id, release_name, manager, module_name, release_date, anticipated_release_date
+  from glassroom_releases, glassroom_modules
+ where glassroom_releases.module_id = glassroom_modules.module_id and release_id = $release_id"
+
+set selection [ns_db 0or1row $db $select_sql]
+
+if { [empty_string_p $selection] } {
+
+    # if it's not there, just redirect them to the index page
+    # (if they hacked the URL, they get what they deserve, if the
+    # the module has been deleted, they can see the list of valid modules)
+    ns_returnredirect index.tcl
+    return
+}
+
+set_variables_after_query
+
+if { [info exists manager] && ![empty_string_p $manager] } {
+    set manager [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id=$manager"]
+} else {
+    set manager "Nobody"
+}
+
+if [empty_string_p $release_date] {
+    set release_date "not released"
+}
+
+
+# emit the page contents
+
+ReturnHeaders
+
+ns_write "[ad_header "$release_name"]
+
+<h2>$release_name</h2>
+in [ad_context_bar [list index.tcl Glassroom] "View Release"]
+<hr>
+
+
+<h3>The Release</h3>
+
+<ul>
+
+  <li> <b>Release Name</b>: $release_name
+       <p>
+
+  <li> <b>Software Module</b>: $module_name
+       <p>
+
+  <li> <b>Manager</b>: $manager
+       <p>
+
+  <li> <b>Anticipated Release Date</b>: [util_AnsiDatetoPrettyDate $anticipated_release_date]
+       <p>
+
+  <li> <b>Release Date</b>: [util_AnsiDatetoPrettyDate $release_date]
+       <p>
+
+</ul>
+
+"
+
+
+
+ns_write "
+
+<h3>Actions</h3>
+
+<ul>
+   <li> <a href=\"release-edit.adp?[export_url_vars release_id]\">Edit</a>
+        <p>
+
+   <li> <a href=\"release-delete.tcl?[export_url_vars release_id]\">Delete</a>
+
+</ul>
+
+[glassroom_footer]
+"
Index: web/openacs/www/glassroom/service-add-2.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/service-add-2.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/service-add-2.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,71 @@
+<%
+# host-add-2.adp -- add a new host to the the glassroom_hosts table
+#                   (this is an ADP as opposed to a .tcl file so that 
+#                   it's consistent naming with host-add.adp)
+
+set_the_usual_form_variables
+
+# Expects service_name, web_service_host, rdbms_host, dns_primary_host, dns_secondary_host, disaster_host
+
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+	ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+	return
+}
+
+
+
+
+# check for bad input
+
+set happy_p [glassroom_check_service_args $service_name $web_service_host $rdbms_host $dns_primary_host $dns_secondary_host $disaster_host]
+
+
+
+if $happy_p {
+    
+    # Assuming we don't need to confirm entry.  Just add it to the
+    # glassroom_services table
+
+    if { [empty_string_p $web_service_host] } {
+	set web_service_host "NULL"
+    }
+    if { [empty_string_p $rdbms_host] } {
+	set rdbms_host "NULL"
+    }
+    if { [empty_string_p $dns_primary_host] } {
+	set dns_primary_host "NULL"
+    }
+    if { [empty_string_p $dns_secondary_host] } {
+	set dns_secondary_host "NULL"
+    }
+    if { [empty_string_p $disaster_host] } {
+	set disaster_host "NULL"
+    }
+    
+    set insert_sql "
+    insert into glassroom_services
+      (service_name, web_service_host, rdbms_host, dns_primary_host, dns_secondary_host, disaster_host)
+    values
+      ('$QQservice_name', $web_service_host, $rdbms_host, $dns_primary_host, $dns_secondary_host, $disaster_host)
+    "
+    
+    set db [ns_db gethandle]
+    ns_db dml $db "$insert_sql"
+    ns_db releasehandle $db
+
+    # and redirect back to index.tcl so folks can see the new host list
+    
+    ns_returnredirect "index.tcl"
+}
+%>
+
Index: web/openacs/www/glassroom/service-add.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/service-add.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/service-add.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,42 @@
+<%
+# service-add.adp -- add a new service to the glassroom_services table
+#                 This file is an ADP so that we can ns_adp_include the 
+#                 service entry/editing form
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+# emit the page contents
+
+ns_puts "[ad_header "Add a new Service"]"
+
+ns_puts "<h2>Add a new Service</h2>
+in [ad_context_bar [list index.tcl Glassroom] "Add Service"]
+<hr>
+"
+
+
+# include the shared HTML form
+
+set db [ns_db gethandle]
+ns_adp_include "service-form.adp" "Add Service" "service-add-2.adp"
+ns_db releasehandle $db
+
+
+ns_puts "[glassroom_footer]"
+
+%>
+
Index: web/openacs/www/glassroom/service-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/service-delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/service-delete-2.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,55 @@
+# service-delete-2.tcl,v 3.0 2000/02/06 03:44:59 ron Exp
+# service-delete-2.tcl -- remove a service from glassroom_services
+#
+
+set_the_usual_form_variables
+
+# Expects service_name
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+	ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+	return
+}
+
+
+
+# emit the page contents
+
+ReturnHeaders
+
+ns_write "[ad_header "Service \"$service_name\" Deleted"]
+
+<h2>Service \"$service_name\" Deleted</h2>
+<hr>
+"
+
+set delete_sql "delete from glassroom_services where service_name='$QQservice_name'"
+
+#!!! what to do if delete fails...
+
+set db [ns_db gethandle]
+ns_db dml $db $delete_sql
+
+ns_db releasehandle $db
+
+
+ns_write "
+Deletion of $service_name confirmed.
+
+<p>
+
+
+<a href=index.tcl>Return to the Glass Room</a>
+
+[glassroom_footer]
+"
\ No newline at end of file
Index: web/openacs/www/glassroom/service-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/service-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/service-delete.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,66 @@
+# service-delete.tcl,v 3.0 2000/02/06 03:45:00 ron Exp
+# service-delete.tcl -- confirm the removal of a service from glassroom_services
+#
+
+
+set_the_usual_form_variables
+
+# Expects service_name
+
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+# snarf the service name
+
+set db [ns_db gethandle]
+
+set select_sql "
+select service_name
+  from glassroom_services
+ where service_name='$QQservice_name'"
+
+set service_name [database_to_tcl_string_or_null $db $select_sql]
+
+ns_db releasehandle $db
+
+
+# emit the page contents
+
+ReturnHeaders
+
+ns_write "[ad_header "Delete \"$service_name\""]
+
+<h2>Delete \"$service_name\"</h2>
+in [ad_context_bar [list index.tcl Glassroom] [list service-view.tcl?[export_url_vars service_name] "View Service"] "Delete Service"]
+<hr>
+
+Are you sure you want to delete this service?
+
+<ul>
+   <li> <a href=\"service-delete-2.tcl?[export_url_vars service_name]\">yes, I'm sure</a>
+        <br><br>
+
+   <li> <a href=\"service-view.tcl?[export_url_vars service_name]\">no, let me look at the service info again</a>
+</ul>
+
+[glassroom_footer]
+"
+
+
+
+
+
Index: web/openacs/www/glassroom/service-edit-2.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/service-edit-2.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/service-edit-2.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,72 @@
+<%
+# service-edit-2.adp -- commit changes made to a service in the glassroom_services table
+#                    (this is an ADP instead of a Tcl file to be consistent
+#                    with service-edi.adp)
+
+set_the_usual_form_variables
+
+# Expects service_name, old_service_name, web_service_host, rdbms_host, dns_primary_host, dns_secondary_host, disaster_host
+
+
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+	ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+	return
+}
+
+
+
+
+# check for bad input
+
+set happy_p [glassroom_check_service_args $service_name $web_service_host $rdbms_host $dns_primary_host $dns_secondary_host $disaster_host]
+
+
+if $happy_p {
+
+    if { [empty_string_p $web_service_host] } {
+	set web_service_host "NULL"
+    }
+    if { [empty_string_p $rdbms_host] } {
+	set rdbms_host "NULL"
+    }
+    if { [empty_string_p $dns_primary_host] } {
+	set dns_primary_host "NULL"
+    }
+    if { [empty_string_p $dns_secondary_host] } {
+	set dns_secondary_host "NULL"
+    }
+    if { [empty_string_p $disaster_host] } {
+	set disaster_host "NULL"
+    }
+
+    set update_sql "
+    update glassroom_services
+    set 
+        service_name='$QQservice_name',
+        web_service_host=$web_service_host,
+        rdbms_host=$rdbms_host,
+        dns_primary_host=$dns_primary_host,
+        dns_secondary_host=$dns_secondary_host,
+        disaster_host=$disaster_host
+    where service_name = '$QQold_service_name'"
+
+    set db [ns_db gethandle]
+    ns_db dml $db $update_sql
+    ns_db releasehandle $db
+
+    # and redirect back to index.tcl so folks can see the new service list
+    
+    ns_returnredirect "service-view.tcl?[export_url_vars service_name]"
+}
+%>
Index: web/openacs/www/glassroom/service-edit.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/service-edit.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/service-edit.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,62 @@
+<%
+# service-edit.adp -- edit a service in the glassroom_services table.  This file is an
+#                  ADP so that we can ns_adp_include the service entry/editing
+#                  form
+
+set_the_usual_form_variables
+
+# Expects service_name
+
+if { [ad_read_only_p] } {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+	ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+	return
+}
+
+
+# snarf the service information
+
+set db [ns_db gethandle]
+
+ns_log notice "Fnord: $QQservice_name"
+
+set select_sql "
+select web_service_host, rdbms_host, dns_primary_host, dns_secondary_host, disaster_host
+  from glassroom_services
+ where service_name = '$QQservice_name'"
+
+set selection [ns_db 1row $db $select_sql]
+set_variables_after_query
+
+
+
+# emit the page contents
+
+ns_puts "[ad_header "Edit Service \"$service_name\""]"
+
+ns_puts "<h2>Edit Service \"$service_name\"</h2>
+in [ad_context_bar [list index.tcl Glassroom] [list service-view.tcl?[export_url_vars service_name] "View Service"] "Edit Service"]
+<hr>
+"
+
+
+# include the shared HTML form
+
+ns_adp_include "service-form.adp" "Update Service" "service-edit-2.adp"
+
+ns_db releasehandle $db
+
+
+ns_puts "[glassroom_footer]"
+
+%>
+
Index: web/openacs/www/glassroom/service-form.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/service-form.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/service-form.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,174 @@
+<%
+# host-form.adp -- an included file for service-edit.adp and service-add.adp which
+#                  shares this form between those two pages
+#
+# required arguments - the text for the "submit button" and the action
+#                      for the form
+
+
+if { [ns_adp_argc] != 3 } {
+    ns_log error "wrong number of arguments passed to host-form.adp.  The text for the submit button should be included, as well as the form action to send the data to."
+    ns_adp_abort
+}
+
+ns_adp_bind_args submit_button_text form_action
+
+# create a set of hosts
+
+set select_sql "select host_id, hostname from glassroom_hosts order by hostname"
+
+set selection [ns_db select $db $select_sql]
+
+set hosts ""
+
+lappend hosts [list "" "None"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    lappend hosts [list $host_id $hostname]
+}
+
+ns_log notice "FNORD $hosts"
+
+
+# make sure these variables exist so we don't generate lots of errors
+# accessing unknown variables below
+
+if { ![info exists web_service_host] } {
+    set web_service_host ""
+}
+
+if { ![info exists rdbms_host] } {
+    set rdbms_host ""
+}
+
+if { ![info exists dns_primary_host] } {
+    set dns_primary_host ""
+}
+
+if { ![info exists dns_secondary_host] } {
+    set dns_secondary_host ""
+}
+
+if { ![info exists disaster_host] } {
+    set disaster_host ""
+}
+
+
+%>
+
+<%=[glassroom_form_action "$form_action" ]%>
+
+<%
+if { [info exists service_name] } {
+    set old_service_name $service_name
+    ns_puts "[export_form_vars service_name old_service_name]\n"
+}
+%>
+
+
+<table>
+
+<tr>
+  <td align=right> Service Name:
+  <td>             <input type=text size=30 name=service_name <%= [export_form_value service_name] %>>
+</tr>
+
+<tr>
+  <td align=right> WebService Host:
+  <td>             <select name=web_service_host>
+<%
+foreach host $hosts {
+    set host_id [lindex $host 0]
+    set host_name [lindex $host 1]
+    if { [string compare $host_id $web_service_host] == 0 } {
+	ns_puts "                     <option value=\"$host_id\" selected> $host_name"
+    } else {
+	ns_puts "                     <option value=\"$host_id\"> $host_name"
+    }
+}
+%>
+                   </select>
+</tr>
+
+
+<tr>
+  <td align=right> RDBMS Host:
+  <td>             <select name=rdbms_host>
+<%
+foreach host $hosts {
+    set host_id [lindex $host 0]
+    set host_name [lindex $host 1]
+    if { [string compare $host_id $rdbms_host] == 0 } {
+	ns_puts "                     <option value=\"$host_id\" selected> $host_name"
+    } else {
+	ns_puts "                     <option value=\"$host_id\"> $host_name"
+    }
+}
+%>
+                   </select>
+</tr>
+
+
+<tr>
+  <td align=right> DNS Primary Host:
+  <td>             <select name=dns_primary_host>
+<%
+foreach host $hosts {
+    set host_id [lindex $host 0]
+    set host_name [lindex $host 1]
+    if { [string compare $host_id $dns_primary_host] == 0 } {
+	ns_puts "                     <option value=\"$host_id\" selected> $host_name"
+    } else {
+	ns_puts "                     <option value=\"$host_id\"> $host_name"
+    }
+}
+%>
+                   </select>
+</tr>
+
+
+<tr>
+  <td align=right> DNS Secondary Host:
+  <td>             <select name=dns_secondary_host>
+<%
+foreach host $hosts {
+    set host_id [lindex $host 0]
+    set host_name [lindex $host 1]
+    if { [string compare $host_id $dns_secondary_host] == 0 } {
+	ns_puts "                     <option value=\"$host_id\" selected> $host_name"
+    } else {
+	ns_puts "                     <option value=\"$host_id\"> $host_name"
+    }
+}
+%>
+                   </select>
+</tr>
+
+<tr>
+  <td align=right> Disaster Host:
+  <td>             <select name=disaster_host>
+<%
+foreach host $hosts {
+    set host_id [lindex $host 0]
+    set host_name [lindex $host 1]
+    if { [string compare $host_id $disaster_host] == 0 } {
+	ns_puts "                     <option value=\"$host_id\" selected> $host_name"
+    } else {
+	ns_puts "                     <option value=\"$host_id\"> $host_name"
+    }
+}
+%>
+                   </select>
+</tr>
+
+</table>
+
+
+<p>
+  
+<%=[glassroom_submit_button "$submit_button_text" ]%>
+
+
+</form>
+
Index: web/openacs/www/glassroom/service-view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/service-view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/service-view.tcl	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,123 @@
+# service-view.tcl,v 3.0 2000/02/06 03:45:02 ron Exp
+# service-view.tcl -- view a service's information, and also give them the option
+#                     to edit or delete the information
+
+
+set_the_usual_form_variables
+
+# Expects service_name
+
+
+# check for user
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+
+# get the service data
+
+
+set db [ns_db gethandle]
+
+set select_sql "
+select web_service_host, rdbms_host, dns_primary_host, dns_secondary_host, disaster_host
+  from glassroom_services
+ where service_name = '$QQservice_name'"
+
+set selection [ns_db 0or1row $db $select_sql]
+
+if { [empty_string_p $selection] } {
+    # if it's not there, just redirect them to the index page
+    # (if they hacked the URL, they get what they deserve, if the
+    # the host has been deleted, they can see the list of valid hosts)
+    ns_returnredirect index.tcl
+    return
+}
+
+set_variables_after_query
+
+
+if { ![empty_string_p $web_service_host] } {
+    set web_service_host [database_to_tcl_string_or_null $db "select hostname from glassroom_hosts where host_id = $web_service_host"]
+} else {
+    set web_service_host "None"
+}
+if { ![empty_string_p $rdbms_host] } {
+    set rdbms_host [database_to_tcl_string_or_null $db "select hostname from glassroom_hosts where host_id = $rdbms_host"]
+} else {
+    set rdbms_host "None"
+}
+if { ![empty_string_p $dns_primary_host] } {
+    set dns_primary_host [database_to_tcl_string_or_null $db "select hostname from glassroom_hosts where host_id = $dns_primary_host"]
+} else {
+    set dns_primary_host "None"
+}
+if { ![empty_string_p $dns_secondary_host] } {
+    set dns_secondary_host [database_to_tcl_string_or_null $db "select hostname from glassroom_hosts where host_id = $dns_secondary_host"]
+} else {
+    set dns_secondary_host "None"
+}
+if { ![empty_string_p $disaster_host] } {
+    set disaster_host [database_to_tcl_string_or_null $db "select hostname from glassroom_hosts where host_id = $disaster_host"]
+} else {
+    set disaster_host "None"
+}
+
+
+# emit the page contents
+
+
+ReturnHeaders
+
+ns_write "[ad_header $service_name]
+
+<h2>$service_name</h2>
+in [ad_context_bar [list index.tcl Glassroom] "View Service"]
+<hr>
+
+<h3>The Service</h3>
+
+<ul>
+    <li> <b>Service Name:</b> $service_name
+         <p>
+
+    <li> <b> Web Service Host:</b> $web_service_host
+         <p>
+
+    <li> <b> RDBMS Host:</b> $rdbms_host
+         <p>
+
+    <li> <b> DNS Primary Host:</b> $dns_primary_host
+         <p>
+
+    <li> <b> DNS Secondary Host:</b> $dns_secondary_host
+         <p>
+
+    <li> <b> Disaster Host:</b> $disaster_host
+         <p>
+
+</ul>
+"
+
+
+
+ns_write "
+
+<h3>Actions</h3>
+
+<ul>
+   <li> <a href=\"service-edit.adp?[export_url_vars service_name]\">Edit</a>
+        <p>
+
+   <li> <a href=\"service-delete.tcl?[export_url_vars service_name]\">Delete</a>
+
+</ul>
+
+[glassroom_footer]
+"
+
+
Index: web/openacs/www/glassroom/user-search-2.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/user-search-2.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/user-search-2.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,3 @@
+<%
+# user-search-2.adp -- given input from the form from user-search.adp, do the search
+
Index: web/openacs/www/glassroom/user-search.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glassroom/user-search.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glassroom/user-search.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,48 @@
+<%
+# user-search.adp -- allow searching for an individual user
+#
+# required arguments - the text of what user to look for,
+#                      the ultimate page to redirect back to
+
+# assumes that it's being invoked as ns_adp_includ -sameframe ...
+# also assumes that it's the first HTML to be written and that
+# ns_adp_break will be called afterwards
+
+if { [ns_adp_argc] != 6 } {
+    ns_log error "wrong number of arguments passed to user-search.adp.  Expected Looking_for text, search token, target page for search results, list for navigation bar, and passthrough values"
+    ns_adp_aabort
+}
+
+ns_adp_bind_args looking_for search_token target nav_list passthrough
+
+# emit the page contents
+
+
+ns_puts "
+[ad_header "Search for $looking_for"]
+<h2>Search for $looking_for</h2>
+in [ad_context_bar [list index.tcl Glassroom] $nav_list "Search for $looking_for"]
+<hr>
+Locate $looking_for by
+
+<form method=get action=\"/user-search.tcl\">
+[export_entire_form]
+<input type=hidden name=passthrough value=\"$passthrough\">
+<input type=hidden name=target value=\"$target\">
+<input type=hidden name=search_token value=\"$search_token\">
+"
+%>
+
+<table border=0>
+<tr><td>Email address:<td><input type=text name=email size=40></tr>
+<tr><td colspan=2>or by</tr>
+<tr><td>Last name:<td><input type=text name=last_name size=40></tr>
+</table>
+<p>
+
+<center>
+<input type=submit value="Search">
+</center>
+</form>
+
+<%= [glassroom_footer] %>
Index: web/openacs/www/global/copyright.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/global/copyright.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/global/copyright.adp	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1,108 @@
+<%= [ad_header "Copyright Policy"] %>
+
+<h2>Copyright Policy</h2>
+
+at <a href=/><%=[ad_system_name]%></a>,
+adapted from
+<a href="http://photo.net/philg/nasty-copyright-notice.html">Philip Greenspun's</a>
+
+<hr>
+
+All the text and pictures on this Web server are copyright 19**-1999
+by the authors, photographers, and/or <%=[ad_publisher_name]%>.
+
+<p>
+
+Here are the terms of our blanket license...
+
+<h3>Printing of photos for personal use</h3>
+
+If you want a copy of one of our pictures to stick on your fridge or
+use in a school project or cover a crack in your wall, then please
+feel free to print anything you like from this site.
+
+<h3>Non-commercial Web use of photos/writing</h3>
+
+If you have a personal home page or non-commercial Web service, please
+feel free to use our writing or photographs with hyperlinked credit.
+Acceptable HTML is
+
+<blockquote><code>
+courtesy &lt;a href="<%=[ad_url]%>"&gt;<%=[ad_publisher_name]%>&lt/a&gt
+</code></blockquote>
+
+That way people know where the contribution originated and also can
+find this on-line copyright statement.  You do not need to pay for
+usage.  Just build the best Web site you can and give it back to the
+community.
+
+<h3>Commercial Web use of photos</h3>
+
+If you would like to use our writing or pictures on a commercial page,
+then please do the following:
+
+<ol>
+<li>register the URL with us (sending email is fine)
+<li>add the hyperlinked credit as above
+</ol>
+
+You do not need to pay for usage, either, though we reserve the right
+to deny usage on sites that we find to be truly poisonous.
+
+<p>
+
+Note: remember that most of the pictures of people on these pages are
+not model-released.  Advertising usage of photos (e.g., brochures,
+catalogs, print ads) is very different from editorial usage of photos
+(e.g., newspaper and magazine articles, books).  You cannot use
+pictures in advertising (e.g., an on-line product brochure or anything
+else that is selling) without getting a model release from any person
+whose image is recognizable in the photo.  You might also have
+problems if an image contains a recognizable physical property, e.g.,
+Disneyland.  One of the reasons advertisers pay $1000+ for images from
+stock agencies is that those agencies have generally already gotten
+the relevant releases.
+
+<h3>Text and Stories</h3>
+
+Please feel free to redistribute via hardcopy or email for
+noncommercial purposes any of our writings, but please don't break up
+documents (except by chapter) and please attribute the source in such
+a way that someone can find the most up-to-date version on the Web.
+
+<p>
+
+Please do not ever copy any of our (text) content to a public Web
+server.  Link to our pages instead.  We will endeavor not to break any
+of your links.  The problem with you putting a page on your server is
+that the search engines will find it and send our readers to your
+server instead.  Thus readers will be deprived of our latest content
+and service innovations.
+
+<h3>Use of photos and Web pages in print</h3>
+
+If you are doing a story, book, or CD-ROM about the World Wide Web,
+please feel free to include a page or two of our under the following
+conditions:
+
+<ol>
+
+<li>screen captures must be made from a computer with a 24-bit color
+video board.  (Machines with 8-bit cards produce distorted images and
+colors.)
+
+<li>the URL must be legible in the capture or separately printed in a
+caption
+
+</ol>
+
+<h3>More</h3>
+
+If you like reading stuff like this, you can also check out our
+
+<ul>
+<li><a href="legal.adp">Legal Page</a>
+<li><a href="privacy.adp">Privacy Policy</a>
+</ul>
+
+<%=[ad_footer]%>
Index: web/openacs/www/global/error.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/global/error.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/global/error.html	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1 @@
+error
Index: web/openacs/www/global/file-not-found.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/global/file-not-found.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/global/file-not-found.html	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1 @@
+file not found
Index: web/openacs/www/global/forbidden.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/global/forbidden.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/global/forbidden.html	17 Apr 2001 14:05:15 -0000	1.1
@@ -0,0 +1 @@
+forbidden
Index: web/openacs/www/global/legal.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/global/legal.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/global/legal.adp	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,51 @@
+<%= [ad_header "Legal Notes"] %>
+
+<h2>Legal Notes</h2>
+
+at <a href=/><%=[ad_system_name]%></a>
+
+<hr>
+
+We endeavor to keep this site available 24 hours per day, 7 days per
+week.  However, we are subject to the same gremlins of hardware and
+systems failure as anyone else using computers.  You can expect that
+this service will be down at least 40 hours per year and perhaps more.
+If there is information that you absolutely need from this server, we
+recommend that you make a personal copy on your own desktop computer's
+hard drive.
+
+<p>
+
+Similarly for email alerts.  We do our best, but our email system
+isn't perfect, the Internet isn't perfect, and your email system
+probably isn't perfect.  Don't rely on us when it is a matter of life
+and death.  Has your desktop machine ever crashed?  Well, so has our
+server.  That's why we wouldn't bet the farm that this site would be
+up and running at any particular instant in time.
+
+<p>
+
+Decisions of content moderators are final.  If you post something and
+thought it was witty and interesting but the moderator kills it,
+that's painful but it is better than everyone suffering with the
+miseries of an unmoderated forum.
+
+<p>
+
+We reserve the right to exclude users from this online community.  The
+usual reason for exclusion would be that a person repeatedly posts
+off-topic or otherwise undesirable content and thereby imposes too
+great a burden on site content moderators.
+
+
+
+<h3>More</h3>
+
+If you like reading stuff like this, you can also check out our
+
+<ul>
+<li><a href="copyright.adp">Copyright Notice</a>
+<li><a href="privacy.adp">Privacy Policy</a>
+</ul>
+
+<%=[ad_footer]%>
Index: web/openacs/www/global/privacy.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/global/privacy.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/global/privacy.adp	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,47 @@
+<%= [ad_header "Privacy Policy"] %>
+
+<h2>Privacy Policy</h2>
+
+at <a href=/><%=[ad_system_name]%></a>
+
+<hr>
+
+We collect personal information from you only when we can use it to
+provide you with some service.  For example, we ask for your email
+address so that we can notify you when someone responds to a question
+that you've posted in a discussion forum.
+
+<p>
+
+You have some control over the extent to which your personal
+information is kept private.  However, here are some examples of the
+default system behavior:
+
+<ul>
+
+<li>your email address is kept hidden from non-registered users; this
+is mostly to keep spam robots from harvesting your address
+
+<li>your email address is provided to other registered users on
+request; this is to faciliate dialog among community members
+
+<li>the complete history of everything you've posted on the site is
+available to anyone; this is so that people may assess the credibility
+of your contributions
+
+<li>the history of things that you've looked at or purchased aren't
+available to anyone except the site administrators
+
+</ul>
+
+
+<h3>More</h3>
+
+If you like reading stuff like this, you can also check out our
+
+<ul>
+<li><a href="copyright.adp">Copyright Notice</a>
+<li><a href="legal.adp">Legal Page</a>
+</ul>
+
+<%=[ad_footer]%>
Index: web/openacs/www/global/readme.txt
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/global/readme.txt,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/global/readme.txt	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,15 @@
+The /global directory is here so that you can have custom error
+messages.  These must be static .html files and must be referenced in
+the AOLserver .ini file as follows:
+
+[ns/server/foobar]
+PageRoot=/web/foobar/www
+DirectoryFile=index.tcl, index.adp, index.html, index.htm
+Webmaster=bigloser@yourdomain.com
+NoticeBgColor=#ffffff
+EnableTclPages=On
+ForbiddenResponse=/global/forbidden.html
+NotFoundResponse=/global/file-not-found.html
+ServerBusyResponse=/global/server-busy.html
+ServerInternalErrorResponse=/global/error.html
+UnauthorizedResponse=/global/unauthorized.html
Index: web/openacs/www/global/server-busy.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/global/server-busy.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/global/server-busy.html	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1 @@
+server busy
Index: web/openacs/www/global/unauthorized.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/global/unauthorized.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/global/unauthorized.html	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1 @@
+unauthorized
Index: web/openacs/www/glossary/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glossary/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glossary/index.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,66 @@
+#
+# later refined by aure@caltech.edu
+#
+# index.tcl,v 3.0 2000/02/06 03:45:03 ron Exp
+
+set user_id [ad_verify_and_get_user_id]
+
+ReturnHeaders
+ns_write "[ad_header "Glossary"]
+
+<h2>Terms Defined</h2>
+
+[ad_context_bar_ws_or_index Glossary]
+
+<hr>
+<blockquote>
+"
+
+set db [ns_db gethandle]
+
+set selection [ns_db select $db "select term, author
+from glossary
+where approved_p = 't'
+order by upper(term)"]
+
+set old_first_char ""
+set count 0
+
+set big_string "<table border=0 cellpadding=0 cellspacing=0>"
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    
+    set first_char [string toupper [string index $term 0]]
+    if { [string compare $first_char $old_first_char] != 0 } {
+	if { $count > 0 } {
+	    append big_string "</ul></td></tr>\n"
+	}
+	append big_string "<tr><td valign=top><h3>$first_char</h3>\n</td><td><ul>\n"
+    }
+    
+    append big_string "<li><a href=\"one.tcl?term=[ns_urlencode $term]\">$term</a>\n"
+    if { $author == $user_id && [ad_parameter ApprovalPolicy glossary] == "open" } {
+	append big_string "\[ <a href=\"term-edit.tcl?term=[ns_urlencode $term]\">Edit</a> \]\n"
+    }
+
+    set old_first_char $first_char
+    incr count
+}
+
+append big_string "</ul></td></tr></table>\n"
+
+if { [ad_parameter ApprovalPolicy glossary] == "open" } {
+    append big_string "<a href=\"term-new.tcl\">Add a Term</a>\n"
+} elseif { [ad_parameter ApprovalPolicy glossary] == "wait" } {
+    append big_string "<a href=\"term-new.tcl\">Suggest a Term</a>\n"
+}
+
+append big_string "
+</blockquote>
+
+[ad_footer]
+"
+
+ns_db releasehandle $db
+ns_write $big_string
Index: web/openacs/www/glossary/one.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glossary/one.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glossary/one.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,40 @@
+# one.tcl,v 3.0 2000/02/06 03:45:05 ron Exp
+# get the user id in case the person is logged in and we want to offer
+# an edit option
+set user_id [ad_get_user_id]
+
+set_the_usual_form_variables
+# term
+
+if { ![info exists term] || [empty_string_p $term] } {
+    ad_return_complaint 1 "No term given"
+    return
+}
+
+ReturnHeaders
+
+ns_write "[ad_header $term]
+
+<h2>$term</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" Glossary] "One Term"]
+
+<hr>
+
+<i>$term</i>:
+"
+
+set db [ns_db gethandle]
+
+set definition [database_to_tcl_string_or_null $db "select definition from glossary where term = '$QQterm'"]
+
+if { $definition == "" } {
+    set definition "Not defined in glossary."
+}
+
+ns_db releasehandle $db
+
+ns_write "
+<blockquote>$definition</blockquote>
+[ad_footer]
+"
Index: web/openacs/www/glossary/term-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glossary/term-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glossary/term-edit-2.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,54 @@
+# term-edit-2.tcl,v 3.0 2000/02/06 03:45:07 ron Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    ns_returnredirect /register/index.tcl?return_url=[ns_urlencode [ns_conn url]]?term=$term
+}
+
+set exception_count 0
+set exception_text ""
+
+if { [ad_parameter ApprovalPolicy glossary] != "open" } {
+    incr exception_count
+    append exception_text "<li>Only the administrator may edit terms."
+}
+
+set_the_usual_form_variables
+# term, definition
+
+set db [ns_db gethandle]
+
+
+if { ![info exists term] || [empty_string_p $QQterm] } {
+    incr exception_count
+    append exception_text "<li>No term to edit\n"
+} else {
+    set author [database_to_tcl_string_or_null $db "select author
+    from glossary
+    where term = '$QQterm'"]
+
+    # check to see if ther user was the original author
+    if {$user_id != $author } {
+	incr exception_count
+	append exception_text "<li>You can not edit this term because you did not author it.\n"
+    }
+}
+
+if { ![info exists definition] || [empty_string_p $QQdefinition] } {
+    incr exception_count
+    append exception_text "<li>No definition provided\n"
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+ns_db dml $db "update glossary set definition = '$QQdefinition' where term = '$QQterm'"
+
+ns_returnredirect "one.tcl?term=[ns_urlencode $term]"
\ No newline at end of file
Index: web/openacs/www/glossary/term-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glossary/term-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glossary/term-edit.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,71 @@
+# term-edit.tcl,v 3.0 2000/02/06 03:45:09 ron Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    ns_returnredirect /register/index.tcl?return_url=[ns_urlencode [ns_conn url]]?term=$term
+}
+
+set exception_count 0
+set exception_text ""
+
+set_the_usual_form_variables
+# term
+
+set db [ns_db gethandle]
+
+
+if { ![info exists term] || [empty_string_p $QQterm] } {
+    incr exception_count
+    append exception_text "<li>No term to edit\n"
+} else {
+    set selection [ns_db 0or1row $db "select definition, author
+    from glossary
+    where term = '$QQterm'"]
+    # In case of someone clicking on an old window
+    if [empty_string_p $selection] {
+	ns_db releasehandle $db
+	ns_returnredirect index.tcl
+	return
+    }
+    set_variables_after_query
+    
+    # check to see if ther user was the original author
+    if {$user_id != $author } {
+	incr exception_count
+	append exception_text "<li>You can not edit this term because you did not author it.\n"
+    }
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+ReturnHeaders
+
+ns_write "[ad_header "Edit Definition" ]
+
+<h2>Edit Definition</h2>
+[ad_context_bar_ws_or_index [list "index.tcl" "Glossary"] Edit]
+<hr>
+
+<form action=term-edit-2.tcl method=post>
+Edit your definition for
+<p>
+<b>$term</b>:<br>
+<textarea name=definition cols=50 rows=5 wrap=soft>[philg_quote_double_quotes $definition]</textarea><br>
+
+<p>
+<center>
+<input type=submit name=submit value=\"Proceed\">
+</center>
+[export_form_vars term]
+</form>
+
+[ad_footer]
+"
Index: web/openacs/www/glossary/term-new-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glossary/term-new-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glossary/term-new-2.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,66 @@
+# term-new-2.tcl,v 3.0 2000/02/06 03:45:10 ron Exp
+# display a confirmation page for new news postings
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set user_id [ad_verify_and_get_user_id]
+if { $user_id == 0 } {
+    ns_returnredirect "/register/index.tcl"
+    return
+}
+
+set_the_usual_form_variables
+# term, definition
+
+set exception_count 0
+set exception_text ""
+
+if { [ad_parameter ApprovalPolicy glossary] == "closed" } {
+    incr exception_count
+    append exception_text "<li>Only the administrator may add a term."
+} else {
+    if { ![info exists term] || $QQterm == ""} {
+	incr exception_count
+	append exception_text "<li>Please enter a term to define."
+    }
+    if { ![info exists definition] || $QQdefinition == "" } {
+	incr exception_count
+	append exception_text "<li>Please enter a definition for the term."
+    }
+}
+
+if {$exception_count > 0} { 
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+ReturnHeaders
+
+ns_write "[ad_header "Confirm"]
+
+<h2>Confirm</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" Glossary]  [list "term-new.tcl" "Add Term"] Confirm]
+<hr>
+
+<h3>What viewers of your definition will see</h3>
+
+<b>$term</b>:
+<blockquote>$definition</blockquote>
+<p>
+
+<form method=post action=\"term-new-3.tcl\">
+[export_entire_form]
+<center>
+<input type=submit value=\"Confirm\">
+</center>
+</form>
+
+
+[ad_footer]"
+
+
Index: web/openacs/www/glossary/term-new-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glossary/term-new-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glossary/term-new-3.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,81 @@
+# term-new-3.tcl,v 3.0 2000/02/06 03:45:11 ron Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set user_id [ad_verify_and_get_user_id]
+if { $user_id == 0 } {
+    ns_returnredirect "/register/index.tcl"
+    return
+}
+
+set_the_usual_form_variables
+
+# term, definition
+
+set exception_count 0
+set exception_text ""
+
+set db [ns_db gethandle]
+
+if { [ad_parameter ApprovalPolicy glossary] == "closed" } {
+    incr exception_count
+    append exception_text "<li>Only the administrator may add a term."
+} else {
+    if { ![info exists term] || [empty_string_p $QQterm]} {
+	incr exception_count
+	append exception_text "<li>You somehow got here without entering a term to define."
+    }
+    if { ![info exists definition] || [empty_string_p $QQdefinition] } {
+	incr exception_count
+	append exception_text "<li>You somehow got here without entering a definition."
+    }
+}
+if {$exception_count > 0} { 
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+if { [ad_parameter ApprovalPolicy glossary] == "open"} {
+    set approved_p "t"
+} else {
+    set approved_p "f"
+}
+
+
+if [catch { ns_db dml $db "insert into glossary
+(term, definition, author, approved_p, creation_date)
+values
+('$QQterm', '$QQdefinition', $user_id, '$approved_p', sysdate())" } errmsg] {
+    # insert failed; let's see if it was because of duplicate submission
+    if { [database_to_tcl_string $db "select count(*) from glossary where term = '$QQterm'"] == 0 } {
+	ns_log Error "/glossary/term-new-3.tcl choked:  $errmsg"
+	ad_return_error "Insert Failed" "The Database did not like what you typed.  This is probably a bug in our code.  Here's what the database said:
+<blockquote>
+<pre>
+$errmsg
+</pre>
+</blockquote>
+"
+        return
+    }
+    # we don't bother to handle the cases where there is a dupe submission
+    # because the user should be thanked or redirected anyway
+}
+
+if { [ad_parameter ApprovalPolicy glossary] == "open"} {
+    ns_returnredirect "index.tcl"
+} else {
+    ns_return 200 text/html "[ad_header "Thank you"]
+
+<h2>Thank You For Your Submission</h2>
+[ad_context_bar_ws_or_index [list "index.tcl" Glossary]  [list "term-new.tcl" "Add Term"] Submitted]
+<hr>
+
+Your submission will be reviewed by 
+[ad_parameter SystemOwner glossary [ad_system_owner]].
+
+[ad_footer]"
+}
+
Index: web/openacs/www/glossary/term-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/glossary/term-new.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/glossary/term-new.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,46 @@
+# term-new.tcl,v 3.0 2000/02/06 03:45:12 ron Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set user_id [ad_verify_and_get_user_id]
+if { $user_id == 0 } {
+    ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+if { [ad_parameter ApprovalPolicy glossary] == "open"} {
+    set verb "Add"
+} elseif { [ad_parameter ApprovalPolicy glossary] == "wait"} {
+    set verb "Suggest"
+} else {
+    ns_returnredirect "index.tcl"
+    return
+}
+
+ReturnHeaders
+ns_write "[ad_header "$verb a Term"]
+<h2>$verb a Term</h2>
+[ad_context_bar_ws_or_index [list "index.tcl" Glossary] "$verb Term"]
+<hr>
+"
+
+set db [ns_db gethandle]
+
+ns_write "
+<form method=post action=\"term-new-2.tcl\">
+<table>
+<tr><th>Term <td><input type=text size=40 name=term>
+<tr><th>Definition <td><textarea cols=60 rows=6 wrap=soft name=definition></textarea>
+</tr>
+</table>
+<br>
+<center>
+<input type=\"submit\" value=\"Submit\">
+</center>
+</form>
+[ad_footer]
+"
+ 
+
Index: web/openacs/www/gp/administer-permissions.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gp/administer-permissions.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gp/administer-permissions.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,326 @@
+#
+# /www/gp/administer-permissions.tcl
+#
+# UI for editing the permissions for a specific database row
+#
+# created by michael@arsdigita.com, 2000-02-25
+#
+# administer-permissions.tcl,v 1.1.2.4 2000/03/24 01:57:47 michael Exp
+#
+
+# Given that a row in the database typically represents an
+# object (e.g., a web page, a person), this page accepts
+# an object_name parameter which we use to build a meaningful
+# page title.
+#
+ad_page_variables {
+    on_what_id
+    on_which_table
+    {object_name "Row $on_what_id of Table $on_which_table"}
+    return_url
+}
+
+validate_integer on_what_id $on_what_id
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+ad_require_permission $db $user_id "administer" \
+	$on_what_id $on_which_table $return_url
+
+# Fetch the permission grid for this database row and format it into
+# a pretty HTML table. Should be easy to turn it into XML later.
+#
+set permission_grid "<table cellpadding=3>
+<tr><th>Scope</th><th>Read?</th><th>Comment?</th><th>Write?</th><th>Administer?</th></tr>
+"
+
+# We need to export the current page as return_url for links that
+# we create below, so we save the return_url value obtained from
+# the form input in a separate variabel and then restore it later.
+#
+set return_url_save $return_url
+set return_url "[ns_conn url]?[ns_conn query]"
+
+# Initialize the CSS class for table rows.
+#
+set row_class "odd"
+
+set registered_users_scope_pretty_name "Registered Users Only"
+set all_users_scope_pretty_name "All Users"
+
+# This query fetches all of the standard permission grants (i.e.,
+# read, comment, write, and administer) for the specified database
+# row. Also, it appends rows for the 'registered_users' and
+# 'all_users' scopes if no permissions have been granted to those
+# scopes (this is what the two queries UNIONed onto the end do).
+#
+
+# set sql "select
+#  (case when pg.scope = 'user' then 
+#    '<a href=\"/shared/community-member.tcl?user_id=' || u.user_id ||
+#    '\">' || u.first_names || ' ' || u.last_name || '</a>' 
+#   else 
+#   case when pg.scope = 'group_role' then g.group_name || ' ' || pg.role 
+#   else
+#   case when pg.scope = 'group' then g.group_name 
+#   else 
+#   case when pg.scope = 'registered_users' then '$registered_users_scope_pretty_name'
+#   else 
+#   case when pg.scope = 'all_users' then '$all_users_scope_pretty_name'
+#   end end end end end) as permission_owner,
+#  pg.scope as scope, pg.user_id, pg.group_id, pg.role,
+#  pg.read_permission_p,
+#  pg.comment_permission_p,
+#  pg.write_permission_p,
+#  pg.administer_permission_p,
+#  (case when scope = 'user' then 1 else
+#   case when scope = 'group_role' then 2 else 
+#   case when scope = 'group' then 3 else 
+#   case when scope = 'registered_users' then 4 else
+#   case when scope = 'all_users' then 5
+#   end end end end end) as display_order
+# from general_permissions_grid pg, users u, user_groups g
+# where pg.on_what_id = $on_what_id
+# and pg.on_which_table = lower('$on_which_table')
+# and pg.user_id = u.user_id (+)
+# and pg.group_id = g.group_id (+)
+# union
+# select
+#  '$registered_users_scope_pretty_name' as permission_owner,
+#  'registered_users' as scope,
+#  to_number(null) as user_id,
+#  to_number(null) as group_id,
+#  to_char(null) as role,
+#  'f' as read_permission_p,
+#  'f' as comment_permission_p,
+#  'f' as write_permission_p,
+#  'f' as administer_permission_p,
+#  4 as display_order
+# from dual
+# where not exists (select 1
+#                   from general_permissions_grid
+#                   where on_what_id = $on_what_id
+#                   and on_which_table = lower('$on_which_table')
+#                   and scope = 'registered_users')
+# union
+# select
+#  '$all_users_scope_pretty_name' as permission_owner,
+#  'all_users' as scope,
+#  to_number(null) as user_id,
+#  to_number(null) as group_id,
+#  to_char(null) as role,
+#  'f' as read_permission_p,
+#  'f' as comment_permission_p,
+#  'f' as write_permission_p,
+#  'f' as administer_permission_p,
+#  5 as display_order
+# from dual
+# where not exists (select 1
+#                   from general_permissions_grid
+#                   where on_what_id = $on_what_id
+#                   and on_which_table = lower('$on_which_table')
+#                   and scope = 'all_users')
+# order by display_order asc"
+
+set sql "
+select
+ (case when pg.scope = 'user' then 
+   '<a href=\"/shared/community-member.tcl?user_id=' || u.user_id ||
+   '\">' || u.first_names || ' ' || u.last_name || '</a>' 
+  else 
+  case when pg.scope = 'group_role' then g.group_name || ' ' || pg.role 
+  else
+  case when pg.scope = 'group' then g.group_name 
+  else 
+  case when pg.scope = 'registered_users' then '$registered_users_scope_pretty_name'
+  else 
+  case when pg.scope = 'all_users' then '$all_users_scope_pretty_name'
+  end end end end end) as permission_owner,
+ pg.scope as scope, pg.user_id, pg.group_id, pg.role,
+ pg.read_permission_p,
+ pg.comment_permission_p,
+ pg.write_permission_p,
+ pg.administer_permission_p,
+ (case when scope = 'user' then 1 else
+  case when scope = 'group_role' then 2 else 
+  case when scope = 'group' then 3 else 
+  case when scope = 'registered_users' then 4 else
+  case when scope = 'all_users' then 5
+  end end end end end) as display_order
+from general_permissions_grid pg, users_view u, user_groups_view g
+where pg.on_what_id = $on_what_id
+and pg.on_which_table = lower('$on_which_table')
+and pg.user_id = u.user_id
+and pg.group_id = g.group_id
+union
+select
+ (case when pg.scope = 'user' then 
+   '<a href=\"/shared/community-member.tcl?user_id=' || u.user_id ||
+   '\">' || u.first_names || ' ' || u.last_name || '</a>' 
+  else 
+  case when pg.scope = 'group_role' then g.group_name || ' ' || pg.role 
+  else
+  case when pg.scope = 'group' then g.group_name 
+  else 
+  case when pg.scope = 'registered_users' then '$registered_users_scope_pretty_name'
+  else 
+  case when pg.scope = 'all_users' then '$all_users_scope_pretty_name'
+  end end end end end) as permission_owner,
+ pg.scope as scope, pg.user_id, pg.group_id, pg.role,
+ pg.read_permission_p,
+ pg.comment_permission_p,
+ pg.write_permission_p,
+ pg.administer_permission_p,
+ (case when scope = 'user' then 1 else
+  case when scope = 'group_role' then 2 else 
+  case when scope = 'group' then 3 else 
+  case when scope = 'registered_users' then 4 else
+  case when scope = 'all_users' then 5
+  end end end end end) as display_order
+from general_permissions_grid pg, users_view u, user_groups_null g
+where pg.on_what_id = $on_what_id
+and pg.on_which_table = lower('$on_which_table')
+and pg.user_id = u.user_id
+and not exists (select 1 from user_groups 
+                where group_id = pg.group_id)
+union
+select
+ (case when pg.scope = 'user' then 
+   '<a href=\"/shared/community-member.tcl?user_id=' || u.user_id ||
+   '\">' || u.first_names || ' ' || u.last_name || '</a>' 
+  else 
+  case when pg.scope = 'group_role' then g.group_name || ' ' || pg.role 
+  else
+  case when pg.scope = 'group' then g.group_name 
+  else 
+  case when pg.scope = 'registered_users' then '$registered_users_scope_pretty_name'
+  else 
+  case when pg.scope = 'all_users' then '$all_users_scope_pretty_name'
+  end end end end end) as permission_owner,
+ pg.scope as scope, pg.user_id, pg.group_id, pg.role,
+ pg.read_permission_p,
+ pg.comment_permission_p,
+ pg.write_permission_p,
+ pg.administer_permission_p,
+ (case when scope = 'user' then 1 else
+  case when scope = 'group_role' then 2 else 
+  case when scope = 'group' then 3 else 
+  case when scope = 'registered_users' then 4 else
+  case when scope = 'all_users' then 5
+  end end end end end) as display_order
+from general_permissions_grid pg, users_null u, user_groups_view g
+where pg.on_what_id = $on_what_id
+and pg.on_which_table = lower('$on_which_table')
+and not exists (select 1 from users 
+                where user_id = pg.user_id)
+and pg.group_id = g.group_id
+union
+select
+ (case when pg.scope = 'user' then 
+   '<a href=\"/shared/community-member.tcl?user_id=' || u.user_id ||
+   '\">' || u.first_names || ' ' || u.last_name || '</a>' 
+  else 
+  case when pg.scope = 'group_role' then g.group_name || ' ' || pg.role 
+  else
+  case when pg.scope = 'group' then g.group_name 
+  else 
+  case when pg.scope = 'registered_users' then '$registered_users_scope_pretty_name'
+  else 
+  case when pg.scope = 'all_users' then '$all_users_scope_pretty_name'
+  end end end end end) as permission_owner,
+ pg.scope as scope, pg.user_id, pg.group_id, pg.role,
+ pg.read_permission_p,
+ pg.comment_permission_p,
+ pg.write_permission_p,
+ pg.administer_permission_p,
+ (case when scope = 'user' then 1 else
+  case when scope = 'group_role' then 2 else 
+  case when scope = 'group' then 3 else 
+  case when scope = 'registered_users' then 4 else
+  case when scope = 'all_users' then 5
+  end end end end end) as display_order
+from general_permissions_grid pg, users_null u, user_groups_null g
+where pg.on_what_id = $on_what_id
+and pg.on_which_table = lower('$on_which_table')
+and not exists (select 1 from users 
+                where user_id = pg.user_id)
+and not exists (select 1 from user_groups 
+                where group_id = pg.group_id)
+union
+select
+ '$registered_users_scope_pretty_name' as permission_owner,
+ 'registered_users' as scope,
+ '' as user_id,
+ '' as group_id,
+ ''::varchar as role,
+ 'f' as read_permission_p,
+ 'f' as comment_permission_p,
+ 'f' as write_permission_p,
+ 'f' as administer_permission_p,
+ 4 as display_order
+from dual
+where not exists (select 1
+                  from general_permissions_grid
+                  where on_what_id = $on_what_id
+                  and on_which_table = lower('$on_which_table')
+                  and scope = 'registered_users')
+union
+select
+ '$all_users_scope_pretty_name' as permission_owner,
+ 'all_users' as scope,
+ '' as user_id,
+ '' as group_id,
+ ''::varchar as role,
+ 'f'::char as read_permission_p,
+ 'f'::char as comment_permission_p,
+ 'f'::char as write_permission_p,
+ 'f' as administer_permission_p,
+ 5 as display_order
+from dual
+where not exists (select 1
+                  from general_permissions_grid
+                  where on_what_id = $on_what_id
+                  and on_which_table = lower('$on_which_table')
+                  and scope = 'all_users')
+order by display_order asc"
+
+set selection [ns_db select $db $sql]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    append permission_grid "<tr class=$row_class><td>$permission_owner</td>"
+
+    foreach permission_type {read comment write administer} {
+	# Read the value of "<permission_type>_permission_p" into a
+	# generically-named variable.
+	#
+	set permission_p [set "${permission_type}_permission_p"]
+
+	set toggle_url "permission-toggle?[export_url_vars on_what_id on_which_table object_name permission_type scope user_id group_id role return_url]"
+
+	append permission_grid "<td align=center>[util_PrettyBoolean $permission_p] (<a href=\"$toggle_url\">[ad_decode $permission_p "t" "revoke" "grant"]</a>)</td>"
+
+    }
+
+    append permission_grid "</tr>\n"
+
+    set row_class [ad_decode $row_class "odd" "even" "odd"]
+}
+
+append permission_grid "</table>"
+
+set grant_permission_to_user_link "<a href=\"permission-grant-to-user?[export_url_vars on_what_id on_which_table object_name return_url]\">Grant permission to a user</a>"
+
+set grant_permission_to_group_link "<a href=\"permission-grant-to-group?[export_url_vars on_what_id on_which_table object_name return_url]\">Grant permission to a user group</a>"
+
+# Restore the value of return_url to that obtained from the form
+# input.
+#
+set return_url $return_url_save
+
+ns_db releasehandle $db
+
+ad_return_template
Index: web/openacs/www/gp/comment-toggle.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gp/comment-toggle.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gp/comment-toggle.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,61 @@
+# comment-toggle.tcl,v 1.1.4.1 2000/02/03 09:53:35 ron Exp
+# requires: permissions_id, user_id OR group_id
+# optional: page_url, page_name, return_url (these are merely kept to save state)
+
+ad_page_variables {
+    permissions_id
+    {user_id {}}
+    {group_id {}}
+    {role {}}
+    {page_url {}}
+    {page_name {}}
+    {return_url {}}
+    {return_name {}}
+}
+
+validate_integer permissions_id $permissions_id
+validate_integer_or_null user_id $user_id
+validate_integer_or_null group_id $group_id
+
+set local_user_id [ad_verify_and_get_user_id]
+set local_group_id [ad_get_group_id]
+set db [ns_db gethandle]
+
+# check permissions
+if { ![ad_g_owner_p $db $permissions_id $local_user_id $local_group_id] } {
+    ad_return_error "Unauthorized" "You are not authorized to edit the permissions for this page.<p>"
+    return
+}
+
+if { [info exists user_id] && ![empty_string_p $user_id] } {
+    if { [empty_string_p $group_id] } {
+	ns_db dml $db "update permissions_ug_map
+                       set comment_p = logical_negation(comment_p)
+                       where user_id = $user_id
+                       and permissions_id = $permissions_id"
+    } else {
+	ns_db dml $db "update permissions_ug_map
+                       set comment_p = logical_negation(comment_p)
+                       where user_id = $user_id
+	               and group_id = $group_id
+                       and permissions_id = $permissions_id"
+    }
+} else {
+	if { [empty_string_p $role] } {
+	    ns_db dml $db "update permissions_ug_map
+                           set comment_p = logical_negation(comment_p)
+                           where group_id = $group_id
+                           and permissions_id = $permissions_id
+                           and role is null"
+	} else {
+	    ns_db dml $db "update permissions_ug_map
+                           set comment_p = logical_negation(comment_p)
+                           where group_id = $group_id
+                           and permissions_id = $permissions_id
+                           and role = '[DoubleApos $role]'"
+	}
+}
+
+ns_returnredirect "edit-page-permissions.tcl?[export_url_vars permissions_id page_url page_name return_url return_name]"
+
+
Index: web/openacs/www/gp/edit-page-permissions.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gp/edit-page-permissions.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gp/edit-page-permissions.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,357 @@
+# edit-page-permissions.tcl,v 1.4.2.1 2000/02/03 09:53:36 ron Exp
+# requires: on_what_id, on_which_table OR permissions_id
+# optional: page_url, page_name, return_url, return_name
+
+# page_url is the URL of the page whose permissions we are editing
+# page_name is the name of the page whose permissions we are
+#    editing (used for prettier UI)
+# return_url is the URL of the page calling the edit permissions page
+# return_name is the name of the page calling the edit permissions page
+
+# if return_url/return_name are empty, we assume page_url/page_name
+
+ad_page_variables {
+    {on_what_id {}}
+    {on_which_table {}}
+    {permissions_id {}}
+    {page_url {}}
+    {page_name {}}
+    {return_url {}}
+    {return_name {}}
+    {orderby {}}
+}
+
+validate_integer on_what_id $on_what_id
+validate_integer permissions_id $permissions_id
+
+set user_id [ad_verify_and_get_user_id]
+set group_id [ad_get_group_id]
+
+set db [ns_db gethandle]
+
+set error_count 0
+set error_msg ""
+
+if { [info exists permissions_id] && ![empty_string_p $permissions_id] } {
+    set not_know_id_p 0
+} else {
+    set not_know_id_p 1
+}
+
+if { $not_know_id_p } {
+    if { ![info exists on_what_id] || [empty_string_p $on_what_id] } {
+	incr error_count
+	append error_msg "<li>We need to know which particular row of the table you want to access."
+    }
+    
+    if { ![info exists on_which_table] || [empty_string_p $on_which_table] } {
+	incr error_count
+	append error_msg "<li>We need to know which table the page accesses."
+    }
+
+    if { $error_count == 0 } {
+	set permissions_id [ad_g_permissions_id $db $on_what_id $on_which_table]
+    }
+    if { ![info exists permissions_id] || $permissions_id == "" } {
+	incr error_count
+	append error_msg "<li>The permissions record was not found."
+    }
+}
+
+if { $error_count > 0 } {
+    ad_return_complaint $error_count $error_msg
+    return
+}
+
+if { ![ad_g_owner_p $db $permissions_id $user_id $group_id] } {
+    ad_return_error "Unauthorized" "You are not authorized to edit the permissions for this page."
+    return
+}
+
+# create the page URL/document name information
+if { ![info exists page_url] || [empty_string_p $page_url] } {
+    set page_name "this page"
+    set page_url_info "this page"
+} elseif { [info exists page_name] && ![empty_string_p $page_name] } {
+    set page_name $page_name
+    set page_url_info "<a href=\"$page_url\">$page_name</a>"
+} else {
+    set page_url_info "<a href=\"$page_url\">$page_url</a>"
+}
+
+# if we don't have all the info we need for return_name
+if { [info exists return_name] && ![empty_string_p $return_name] && [info exists return_url] && ![empty_string_p $return_url] } {
+    set navbar "[ad_context_bar_ws_or_index [list "$return_url" "$return_name"] "Edit Permissions"]"
+} else {
+    set navbar "[ad_context_bar_ws_or_index [list "$page_url" "$page_name"] "Edit Permissions"]"
+}
+
+# set up data for dimensional slider
+set dimensional_list {
+    { dim "" all {
+	{users "Users" {where "pum.group_id is null"}}
+	{groups "Groups" {where "pum.user_id is null"}}
+	{owners "Owners" {where "owner_p = 't'"}}
+	{all "All" {}}
+}   }
+}
+
+# set up the table definition
+set export_url_vars [export_url_vars permissions_id page_url page_name return_url return_name]
+
+# some helper procedures that will be called by ad_table
+proc get_short_name g {
+    if { ![empty_string_p $g] } {
+	set db [ns_db gethandle subquery] 
+	set return_value [database_to_tcl_string $db "select short_name from user_groups where group_id = $g"]
+	ns_db releasehandle $db
+    } else {
+	set return_value ""
+    }
+    return $return_value
+}
+
+proc give_UG_name_url_admin {user_id group_id first_names last_name group_name} {
+    if { [empty_string_p $group_name] } {
+	return "<td><a href=\"/admin/users/one.tcl?user_id=$user_id\">$first_names $last_name</a></td>"
+    } else {
+	return "<td><a href=\"/admin/ug/group.tcl?group_id=$group_id\">$group_name</a></td>"
+    }
+}
+
+proc give_UG_name_url {user_id group_id first_names last_name group_name} {
+    if { [empty_string_p $group_name] } {
+	return "<td><a href=\"/shared/community-member.tcl?user_id=$user_id\">$first_names $last_name</a></td>"
+    } else {
+	return "<td><a href=\"/[ad_parameter GroupsDirectory ug]/[ad_urlencode [get_short_name $group_id]]/\">$group_name</a></td>"
+    }
+}
+
+if { [ad_permission_p $db "" "" administrator $user_id $group_id] } {
+    set table_def {
+	{fullname "User/Group Name" {upper(last_name) $order, upper(first_names) $order, upper(group_name)} "[give_UG_name_url_admin $user_id $group_id $first_names $last_name $group_name]"}
+    }
+} else {
+    set table_def {
+	{fullname "User/Group Name" {upper(last_name) $order, upper(first_names) $order, upper(group_name)} "[give_UG_name_url $user_id $group_id $first_names $last_name $group_name]"}
+    }
+}
+
+    
+if { [ad_parameter GroupPermissionsP gp] } {
+    lappend table_def {role "Role" {} {}}
+}
+
+lappend table_def {read_p "Read" {} "<td><a href=\"read-toggle.tcl?[export_url_vars user_id group_id role]&\[uplevel {set export_url_vars}\]\">[ad_html_pretty_boolean $read_p]</td>"}
+lappend table_def {write_p "Write" {} "<td><a href=\"write-toggle.tcl?[export_url_vars user_id group_id role]&\[uplevel {set export_url_vars}\]\">[ad_html_pretty_boolean $write_p]</td>"}
+
+if { [ad_parameter CommentPermissionsP gp] } {
+    lappend table_def {comment_p "Comment" {} "<td><a href=\"comment-toggle.tcl?[export_url_vars user_id group_id role]&\[uplevel {set export_url_vars}\]\">[ad_html_pretty_boolean $comment_p]</td>"}
+}
+
+lappend table_def {owner_p "Owner" {} "<td><a href=\"owner-toggle.tcl?[export_url_vars user_id group_id role]&\[uplevel {set export_url_vars}\]\">[ad_html_pretty_boolean $owner_p]</td>"}
+
+lappend table_def {actions "" {} "<td align=center><a href=\"remove-ug.tcl?[export_url_vars user_id group_id role]&\[uplevel {set export_url_vars}\]\">remove</a>"}
+
+# public permissions
+set extra_row_html "
+<td>Public</td>\n
+<td></td>\n"
+
+set selection [ns_db 1row $db "select public_read_p, public_write_p, public_comment_p 
+                               from general_permissions
+                               where permissions_id = $permissions_id"]
+set_variables_after_query
+
+append extra_row_html "<td><a href=\"public-read-toggle.tcl?[export_url_vars permissions_id page_url page_name return_url return_name]\">[ad_html_pretty_boolean $public_read_p]</a></td>"
+
+append extra_row_html "<td><a href=\"public-write-toggle.tcl?[export_url_vars permissions_id page_url page_name return_url return_name]\">[ad_html_pretty_boolean $public_write_p]</a></td>"
+
+if { [ad_parameter CommentPermissionsP gp] } {
+    append extra_row_html "<td><a href=\"public-comment-toggle.tcl?[export_url_vars permissions_id page_url page_name return_url return_name]\">[ad_html_pretty_boolean $public_comment_p]</a></td>"
+}
+
+ReturnHeaders
+
+ns_write "[ad_header "View/Edit Permissions"]
+<h2>View/Edit Permissions</h2>
+
+$navbar 
+<hr>
+Permissions for $page_url_info
+<p>
+"
+
+# spit out the dimensional bar
+ns_write "[ad_dimensional $dimensional_list]<p>\n"
+
+if { [ad_parameter GroupPermissionsP gp] } {
+#     set sql "select gp.*, pum.*, users.*, user_groups.*
+#              from general_permissions gp, permissions_ug_map pum, users, user_groups
+#              where pum.group_id = user_groups.group_id(+)
+#              and pum.user_id = users.user_id(+)
+#              and gp.permissions_id = pum.permissions_id
+#              and gp.permissions_id = $permissions_id
+#              [ad_dimensional_sql $dimensional_list where]
+#              [ad_order_by_from_sort_spec $orderby $table_def]"
+
+    set sql "select gp.*, pum.*, users.*, user_groups.*
+             from general_permissions gp, permissions_ug_map pum, users_view, user_groups_view
+             where pum.group_id = user_groups.group_id
+             and pum.user_id = users.user_id
+             and gp.permissions_id = pum.permissions_id
+             and gp.permissions_id = $permissions_id
+             [ad_dimensional_sql $dimensional_list where]
+             [ad_order_by_from_sort_spec $orderby $table_def]
+             union
+             select gp.*, pum.*, users.*, user_groups.*
+             from general_permissions gp, permissions_ug_map pum, users_null users, user_groups_view
+             where pum.group_id = user_groups.group_id
+             and not exists (select 1 from users 
+                             where user_id = pum.user_id)
+             and gp.permissions_id = pum.permissions_id
+             and gp.permissions_id = $permissions_id
+             [ad_dimensional_sql $dimensional_list where]
+             [ad_order_by_from_sort_spec $orderby $table_def]
+             union
+             select gp.*, pum.*, users.*, user_groups.*
+             from general_permissions gp, permissions_ug_map pum, users, user_groups_null user_groups_view
+             where not exists (select 1 from user_groups 
+                               where group_id = pum.group_id)
+             and pum.user_id = users.user_id
+             and gp.permissions_id = pum.permissions_id
+             and gp.permissions_id = $permissions_id
+             [ad_dimensional_sql $dimensional_list where]
+             [ad_order_by_from_sort_spec $orderby $table_def]
+             union
+             select gp.*, pum.*, users.*, user_groups.*
+             from general_permissions gp, permissions_ug_map pum, users_null, user_groups_null
+             where not exists (select 1 from user_groups
+                               where group_id = pum.group_id)
+             and not exists (select 1 from users 
+                             where user_id = pum.user_id)
+             and gp.permissions_id = pum.permissions_id
+             and gp.permissions_id = $permissions_id
+             [ad_dimensional_sql $dimensional_list where]
+             [ad_order_by_from_sort_spec $orderby $table_def]"
+
+} else {
+
+#     set sql "select gp.*, pum.*, users.*, user_groups.*
+#              from general_permissions gp, permissions_ug_map pum, users, user_groups
+#              where pum.group_id = user_groups.group_id(+)
+#              and pum.user_id = users.user_id(+)
+#              and gp.permissions_id = pum.permissions_id
+#              and gp.permissions_id = $permissions_id
+#              and pum.group_id is null
+#              [ad_dimensional_sql $dimensional_list where]
+#              [ad_order_by_from_sort_spec $orderby $table_def]"
+
+    set sql "select gp.*, pum.*, users.*, user_groups.*
+             from general_permissions gp, permissions_ug_map pum, users_view, user_groups_view
+             where pum.group_id = user_groups.group_id
+             and pum.user_id = users.user_id
+             and gp.permissions_id = pum.permissions_id
+             and gp.permissions_id = $permissions_id
+             and pum.group_id is null
+             [ad_dimensional_sql $dimensional_list where]
+             [ad_order_by_from_sort_spec $orderby $table_def]
+             union
+             select gp.*, pum.*, users.*, user_groups.*
+             from general_permissions gp, permissions_ug_map pum, users_null users, user_groups_view
+             where pum.group_id = user_groups.group_id
+             and not exists (select 1 from users 
+                             where user_id = pum.user_id)
+             and gp.permissions_id = pum.permissions_id
+             and gp.permissions_id = $permissions_id
+             and pum.group_id is null
+             [ad_dimensional_sql $dimensional_list where]
+             [ad_order_by_from_sort_spec $orderby $table_def]
+             union
+             select gp.*, pum.*, users.*, user_groups.*
+             from general_permissions gp, permissions_ug_map pum, users, user_groups_null user_groups_view
+             where not exists (select 1 from user_groups 
+                               where group_id = pum.group_id)
+             and pum.user_id = users.user_id
+             and gp.permissions_id = pum.permissions_id
+             and gp.permissions_id = $permissions_id
+             and pum.group_id is null
+             [ad_dimensional_sql $dimensional_list where]
+             [ad_order_by_from_sort_spec $orderby $table_def]
+             union
+             select gp.*, pum.*, users.*, user_groups.*
+             from general_permissions gp, permissions_ug_map pum, users_null users, user_groups_null user_groups_view
+             where not exists (select 1 from user_groups 
+                               where group_id = pum.group_id)
+             and not exists (select 1 from users 
+                             where user_id = pum.user_id)
+             and gp.permissions_id = pum.permissions_id
+             and gp.permissions_id = $permissions_id
+             and pum.group_id is null
+             [ad_dimensional_sql $dimensional_list where]
+             [ad_order_by_from_sort_spec $orderby $table_def]
+
+"
+}
+
+set selection [ns_db select $db $sql] 
+
+ns_write "
+<blockquote>
+[ad_table -Torderby $orderby -Textra_row_html $extra_row_html $db $selection $table_def]
+
+<p>
+
+</blockquote>
+"
+
+set selection [ns_db 1row $db "select count(*) as users_to_add
+                               from users
+                               where not exists (select 1 from permissions_ug_map pum
+                                                 where permissions_id = $permissions_id
+                                                 and users.user_id = pum.user_id)"]
+
+set_variables_after_query
+
+if { $users_to_add > 0 } {
+    ns_write "
+    <ul>
+    <li><a href=\"user-add.tcl?[export_url_vars permissions_id page_url page_name return_url]\">Add a user</a></li>
+    "
+}
+
+if { [ad_parameter GroupPermissionsP gp] } {
+
+    set selection [ns_db 1row $db "select count(*) as groups_to_add
+    from user_groups ug, user_group_types ugt
+    where ug.group_type = ugt.group_type
+    and existence_public_p = 't'
+    and approved_p = 't'
+    and exists 
+    ((select role from user_group_roles ugr where ugr.group_id = ug.group_id union select null from dual)
+    EXCEPT
+    (select role from permissions_ug_map pum where pum.group_id = ug.group_id and permissions_id = $permissions_id))"]
+    
+    set_variables_after_query
+
+    if { $groups_to_add > 0 } {
+	ns_write "<li><a href=\"group-add.tcl?[export_url_vars permissions_id page_url page_name return_url]\">Add a group</a></li>"
+    }
+}
+
+ns_write "</ul>"
+
+if { [ad_parameter ShowFinishButtonP gp] } {
+    ns_write "<form action=redirect-to-caller.tcl method=post>
+    [export_form_vars page_url return_url]
+    <center><input type=submit value=\"Finished editing permissions\"></center>
+    </form>
+"
+}
+
+ns_write "
+
+[ad_footer]
+"
+
+
Index: web/openacs/www/gp/group-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gp/group-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gp/group-add-2.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,104 @@
+# group-add-2.tcl,v 1.3.4.1 2000/02/03 09:53:37 ron Exp
+# UI for selecting a particular role once a group has been selected
+
+ad_page_variables {
+    permissions_id
+    group_id
+    {page_url {}}
+    {page_name {}}
+    {return_url {}}
+    {return_name {}}
+}
+
+validate_integer permissions_id $permissions_id
+validate_integer group_id $group_id
+
+set local_user_id [ad_verify_and_get_user_id]
+set local_group_id [ad_get_group_id]
+set db [ns_db gethandle]
+
+# check permissions
+if { ![ad_g_owner_p $db $permissions_id $local_user_id $local_group_id] } {
+    ad_return_error "Unauthorized" "You are not authorized to edit the permissions for this page.<p>"
+    return
+}
+
+# first check to see if we need to do roles
+set multi_role_p [database_to_tcl_string $db "select multi_role_p from user_groups
+                                              where group_id = $group_id"]
+
+if { $multi_role_p == "f" } {
+    ns_returnredirect "group-add-3.tcl?[export_url_vars permissions_id page_url page_name return_url return_name group_id]"
+}
+
+# first, check to see if the "all" role  has been added
+set null_role_p [database_to_tcl_string_or_null $db "select 1 from permissions_ug_map
+                                                     where permissions_id = $permissions_id
+                                                     and group_id = $group_id
+                                                     and role is null"]
+
+# get all roles for a particular group that aren't in pum
+set selection [ns_db select $db "select * from user_group_roles ugr
+                                 where group_id = $group_id
+                                 and not exists (select 1 from permissions_ug_map pum
+                                                 where permissions_id = $permissions_id
+                                                 and ugr.role = pum.role
+                                                 and pum.group_id = $group_id)"]
+
+if { $selection == "" && $null_role_p == 1 } {
+    ns_returnredirect "group-add-3.tcl?[export_url_vars permissions_id page_url page_name return_url return_name group_id]"
+}
+
+# show the UI. we have roles we want the user to choose.
+
+set edit_perm_url edit-page-permissions.tcl?[export_url_vars permissions_id page_url page_name return_url return_name]
+set group_edit_url group-add.tcl?[export_url_vars permissions_id page_url page_name return_url return_name]
+
+if { [info exists return_name] && ![empty_string_p $return_name] && [info exists return_url] && ![empty_string_p $return_url] } {
+    set navbar "[ad_context_bar_ws_or_index [list "$return_url" "$return_name"] [list "$edit_perm_url" "Edit Permissions"] [list "$group_edit_url" "Add a Group"] "Choose a Role"]"
+} else { 
+    set navbar "[ad_context_bar_ws_or_index [list "$page_url" "$page_name"] [list "$edit_perm_url" "Edit Permissions"] [list "$group_edit_url" "Add a Group"] "Choose a Role"]"
+}
+
+ReturnHeaders
+ns_write "
+[ad_header "Choose a Role"]
+
+<h2>Choose a Role</h2>
+$navbar
+<hr>
+Choose a role:
+<p>
+
+<table><tr><td>
+<ul>
+"
+
+set count 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    ns_write "<li><a href=\"group-add-3.tcl?[export_url_vars permissions_id group_id role page_url page_name return_url return_name]\">$role</a>\n"
+    incr count
+}
+
+if { $count > 0 } {
+    ns_write "
+    </ul>
+    </td>"
+}
+
+# if we want to give permissions to all roles, we don't pass role
+if { $null_role_p == "" } {
+    if { $count > 0 } {
+	ns_write "<td><ul><li><a href=\"group-add-3.tcl?[export_url_vars permissions_id group_id page_url page_name return_url return_name]\">all</a></ul></td>\n"
+    } else {
+	ns_write "<li><a href=\"group-add-3.tcl?[export_url_vars permissions_id group_id page_url page_name return_url return_name]\">all</a>\n"
+    }
+}
+
+
+ns_write "
+</tr>
+</table>
+<p>
+[ad_footer]"
Index: web/openacs/www/gp/group-add-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gp/group-add-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gp/group-add-3.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,36 @@
+# group-add-3.tcl,v 1.1.4.1 2000/02/03 09:53:39 ron Exp
+ad_page_variables {
+    permissions_id
+    group_id
+    {role {}}
+    {page_url {}}
+    {page_name {}}
+    {return_url {}}
+    {return_name {}}
+}
+
+validate_integer permissions_id group_id
+
+set local_user_id [ad_verify_and_get_user_id]
+set local_group_id [ad_get_group_id]
+set db [ns_db gethandle]
+
+# check permissions
+if { ![ad_g_owner_p $db $permissions_id $local_user_id $local_group_id] } {
+    ad_return_error "Unauthorized" "You are not authorized to edit the permissions for this page.<p>"
+    return
+}
+
+if { ![info exists role] || [empty_string_p $role] } {
+    ns_db dml $db "insert into permissions_ug_map
+    (permissions_id, group_id)
+    values
+    ($permissions_id, $group_id)"
+} else {
+    ns_db dml $db "insert into permissions_ug_map
+    (permissions_id, group_id, role)
+    values
+    ($permissions_id, $group_id, '[DoubleApos $role]')"
+}    
+
+ns_returnredirect "edit-page-permissions.tcl?[export_url_vars permissions_id page_url page_name return_url return_name]"
Index: web/openacs/www/gp/group-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gp/group-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gp/group-add.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,82 @@
+# group-add.tcl,v 1.2.4.1 2000/02/03 09:53:40 ron Exp
+ad_page_variables {
+    permissions_id
+    {page_url {}}
+    {page_name {}}
+    {return_url {}}
+    {return_name {}}
+}
+
+validate_integer permissions_id
+
+set local_user_id [ad_verify_and_get_user_id]
+set local_group_id [ad_get_group_id]
+set db [ns_db gethandle]
+
+# check permissions
+if { ![ad_g_owner_p $db $permissions_id $local_user_id $local_group_id] } {
+    ad_return_error "Unauthorized" "You are not authorized to edit the permissions for this page.<p>"
+    return
+}
+
+set edit_perm_url edit-page-permissions.tcl?[export_url_vars permissions_id page_url page_name return_url return_name]
+
+# if we don't have all the info we need for return_name
+if { [info exists return_name] && ![empty_string_p $return_name] && [info exists return_url] && ![empty_string_p $return_url] } {
+    set navbar "[ad_context_bar_ws_or_index [list "$return_url" "$return_name"] [list "$edit_perm_url" "Edit Permissions"] "Add a Group"]"
+} else { 
+    set navbar "[ad_context_bar_ws_or_index [list "$page_url" "$page_name"] [list "$edit_perm_url" "Edit Permissions"] "Add a Group"]"
+}
+
+ReturnHeaders
+
+ns_write "
+[ad_header "Add a Group"]
+
+<h2>Add a Group</h2>
+$navbar
+<hr>
+"
+
+# we show all user groups that do not have user-group-role mappings
+set selection [ns_db select $db "select ug.group_id, ug.group_name, ugt.pretty_plural
+from user_groups ug, user_group_types ugt
+where ug.group_type = ugt.group_type
+and existence_public_p = 't'
+and approved_p = 't'
+and exists 
+    ((select role from user_group_roles ugr where ugr.group_id = ug.group_id union select null from dual)
+    EXCEPT
+    (select role from permissions_ug_map pum where pum.group_id = ug.group_id and permissions_id = $permissions_id))
+order by upper(ug.group_type)"]
+
+set count 0
+set last_pretty_plural ""
+
+set groups_list "Please choose a group to add:\n<ul>"
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    
+    if { $last_pretty_plural != $pretty_plural } {
+	append groups_list "<h4>$pretty_plural</h4>\n"
+	set last_pretty_plural $pretty_plural
+    }
+
+    append groups_list "<li><a href=\"group-add-2.tcl?[export_url_vars group_id permissions_id page_url page_name return_url]\">$group_name</a>\n"
+    incr count
+}
+
+
+
+if { $count == 0 } {
+    set groups_list "<blockquote>Sorry, no groups are available to be added.</blockquote>"
+} else {
+    append groups_list "</ul>"
+}
+
+ns_write "
+$groups_list
+
+[ad_footer]
+"
Index: web/openacs/www/gp/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gp/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gp/index.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,4 @@
+# index.tcl,v 3.1 2000/03/07 23:28:08 michael Exp
+# user try to play with the URL and get the directory structure instead of a file
+ns_returnnotfound
+
Index: web/openacs/www/gp/owner-toggle.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gp/owner-toggle.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gp/owner-toggle.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,62 @@
+# owner-toggle.tcl,v 1.1.4.1 2000/02/03 09:53:42 ron Exp
+# requires: permissions_id, user_id OR group_id
+# optional: page_url, page_name, return_url (these are merely kept to save state)
+
+ad_page_variables {
+    permissions_id
+    {user_id {}}
+    {group_id {}}
+    {role {}}
+    {page_url {}}
+    {page_name {}}
+    {return_url {}}
+    {return_name {}}
+}
+
+validate_integer permissions_id $permissions_id
+validate_integer_or_null user_id $user_id
+validate_integer_or_null group_id $group_id
+
+set local_user_id [ad_verify_and_get_user_id]
+set local_group_id [ad_get_group_id]
+set db [ns_db gethandle]
+
+# check permissions
+if { ![ad_g_owner_p $db $permissions_id $local_user_id $local_group_id] } {
+    ad_return_error "Unauthorized" "You are not authorized to edit the permissions for this page.<p>"
+    return
+}
+
+if { [info exists user_id] && ![empty_string_p $user_id] } {
+    if { [empty_string_p $group_id] } {
+	ns_db dml $db "update permissions_ug_map
+                       set owner_p = logical_negation(owner_p)
+                       where user_id = $user_id
+                       and permissions_id = $permissions_id"
+    } else {
+	ns_db dml $db "update permissions_ug_map
+                       set owner_p = logical_negation(owner_p)
+                       where user_id = $user_id
+	               and group_id = $group_id
+                       and permissions_id = $permissions_id"
+
+    }
+} else {
+	if { [empty_string_p $role] } {
+	    ns_db dml $db "update permissions_ug_map
+                           set owner_p = logical_negation(owner_p)
+	                   where group_id = $group_id
+                           and permissions_id = $permissions_id
+                           and role is null"
+	} else {
+	    ns_db dml $db "update permissions_ug_map
+                           set owner_p = logical_negation(owner_p)
+	                   where group_id = $group_id
+                           and permissions_id = $permissions_id
+                           and role = '[DoubleApos $role]'"
+	}
+}
+
+ns_returnredirect "edit-page-permissions.tcl?[export_url_vars permissions_id page_url page_name return_url return_name]"
+
+
Index: web/openacs/www/gp/permission-grant-to-group.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gp/permission-grant-to-group.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gp/permission-grant-to-group.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,49 @@
+#
+# /gp/permission-grant-to-group.tcl
+#
+# created by michael@arsdigita.com, 2000-02-27
+#
+# 3.2
+# 2000/03/02 08:20:24
+# michael
+#
+
+ad_page_variables {
+    on_what_id
+    on_which_table
+    object_name
+    return_url
+}
+
+validate_integer on_what_id $on_what_id
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+ad_require_permission $db $user_id "administer" $on_what_id $on_which_table
+
+set scope "group"
+
+# Fetch all public and approved groups that do not have permission
+# on this database row.
+#
+set query "select g.group_id, g.group_name || ' (' || gt.pretty_name || ')'
+from user_groups g, user_group_types gt
+where not exists (select 1
+                  from general_permissions p
+                  where p.scope = 'group'
+                  and p.group_id = g.group_id)
+and g.active_p = 't'
+and g.existence_public_p = 't'
+and g.approved_p = 't'
+and g.group_type = gt.group_type
+order by g.group_type, g.group_name"
+
+set user_group_widget "<select name=group_id>
+[db_html_select_value_options $db $query]
+</select>"
+
+ns_db releasehandle $db
+
+ad_return_template
Index: web/openacs/www/gp/permission-grant-to-user-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gp/permission-grant-to-user-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gp/permission-grant-to-user-2.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,36 @@
+#
+# /gp/permission-grant-to-user-2.tcl
+#
+# created by michael@arsdigita.com, 2000-02-27
+#
+# 3.2
+# 2000/03/02 08:20:24
+# michael
+#
+
+ad_page_variables {
+    user_id_from_search
+    first_names_from_search
+    last_name_from_search
+    email_from_search
+    on_what_id
+    on_which_table
+    object_name
+    return_url
+}
+
+validate_integer user_id_from_search $user_id_from_search
+validate_integer on_what_id $on_what_id
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+ad_require_permission $db $user_id "administer" $on_what_id $on_which_table
+
+ns_db releasehandle $db
+
+set full_name "$first_names_from_search $last_name_from_search"
+set scope "user"
+
+ad_return_template
Index: web/openacs/www/gp/permission-grant-to-user.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gp/permission-grant-to-user.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gp/permission-grant-to-user.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,30 @@
+#
+# /gp/permission-grant-to-user.tcl
+#
+# created by michael@arsdigita.com, 2000-02-27
+#
+# 3.2
+# 2000/03/02 08:20:24
+# michael
+#
+
+ad_page_variables {
+    on_what_id
+    on_which_table
+    object_name
+    return_url
+}
+
+validate_integer on_what_id $on_what_id
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+ad_require_permission $db $user_id "administer" $on_what_id $on_which_table
+
+ns_db releasehandle $db
+
+set passthrough {on_what_id on_which_table object_name return_url}
+
+ad_return_template
Index: web/openacs/www/gp/permission-grant.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gp/permission-grant.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gp/permission-grant.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,143 @@
+#
+# /gp/permission-grant.tcl
+#
+# This script performs the actual insertion of rows into the
+# general_permissions table. It is used to add user permissions,
+# role permissions, group permissions, and public permissions
+# (both for only registered users and all users).
+#
+# created by michael@arsdigita.com, 2000-02-27
+#
+# 3.8
+# 2000/03/06 06:14:28
+# michael
+#
+
+ad_page_variables {
+    on_what_id
+    on_which_table
+    scope
+    {user_id_from_search ""}
+    {group_id ""}
+    {role ""}
+    {permission_types -multiple-list}
+    return_url
+}
+
+page_validation {
+    if { [llength $permission_types] == 0 } {
+	error "You selected no permission types."
+    }
+
+    switch $scope {
+	user {
+	    if { [empty_string_p $user_id_from_search] } {
+		error "missing user_id"
+	    }
+	}
+
+	group_role {
+	    if { [empty_string_p $group_id] } {
+		error "missing group_id"
+	    }
+
+	    if { [empty_string_p $role] } {
+		error "missing role"
+	    }
+	}
+
+	group {
+	    if { [empty_string_p $group_id] } {
+		error "missing group_id"
+	    }
+	}
+
+	registered_users -
+	all_users {
+	}
+
+	default {
+	    error "unknown scope: $scope"
+	}
+    }
+    
+    validate_integer on_what_id $on_what_id
+    validate_integer_or_null user_id $user_id
+    validate_integer_or_null group_id $group_id
+}
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+ad_require_permission $db $user_id "administer" $on_what_id $on_which_table
+
+switch $scope {
+    user {
+	set user_id_criterion "user_id = $user_id_from_search"
+
+	set group_id "null"
+	set group_id_criterion "group_id is null"
+	set role "null"
+	set role_criterion "role is null"
+    }
+
+    group_role {
+	set group_id_criterion "group_id = $group_id"
+	set role "'$role'"
+	set role_criterion "role = $role"
+
+	set user_id_from_search "null"
+	set user_id_criterion "user_id is null"
+    }
+
+    group {
+	set group_id_criterion "group_id = $group_id"
+
+	set user_id_from_search "null"
+	set user_id_criterion "user_id is null"
+	set role "null"
+	set role_criterion "role is null"
+    }
+
+    registered_users -
+    all_users {
+	set user_id_from_search "null"
+	set user_id_criterion "user_id is null"
+	set group_id "null"
+	set group_id_criterion "group_id is null"
+	set role "null"
+	set role_criterion "role is null"
+    }
+}
+
+ns_db dml $db "begin transaction"
+
+# Insert a row for each type of permission being granted, making sure
+# not to duplicate existing permissions.
+#
+foreach permission_type $permission_types {
+
+    ns_db dml $db "insert into general_permissions
+ (permission_id, on_what_id, on_which_table,
+  scope, user_id, group_id, role,
+  permission_type)
+select
+ nextval('gp_id_sequence'), '$on_what_id', '$on_which_table',
+ '$scope', $user_id_from_search, $group_id, $role,
+ '$permission_type'
+from dual
+where not exists (select 1
+                  from general_permissions
+                  where on_what_id = '$on_what_id'
+                  and on_which_table = lower('$on_which_table')
+                  and scope = '$scope'
+                  and $user_id_criterion
+                  and $group_id_criterion
+                  and $role_criterion
+                  and permission_type = lower('$permission_type'))"
+}
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect $return_url
Index: web/openacs/www/gp/permission-revoke.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gp/permission-revoke.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gp/permission-revoke.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,31 @@
+#
+# /www/gp/permission-revoke.tcl
+#
+# created by michael@arsdigita.com, 2000-03-23
+#
+# Revokes the specified permission and redirects to the
+# specified return_url
+#
+# permission-revoke.tcl,v 1.1.2.1 2000/03/23 18:44:32 michael Exp
+#
+
+ad_page_variables {
+    on_what_id
+    on_which_table
+    permission_id
+    return_url
+}
+
+validate_integer on_what_id $on_what_id
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+ad_require_permission $db $user_id "administer" $on_what_id $on_which_table
+
+ns_db select $db "select revoke_permission($permission_id)"
+
+ns_db releasehandle $db
+
+ns_returnredirect $return_url
Index: web/openacs/www/gp/permission-toggle.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gp/permission-toggle.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gp/permission-toggle.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,149 @@
+#
+# /www/gp/permission-toggle.tcl
+#
+# created by michael@arsdigita.com, 2000-02-25
+#
+# Given form input that identifies a specific permission,
+# deletes the permission if it already exists or inserts
+# it if it does not.
+#
+# permission-toggle.tcl,v 3.5.2.1 2000/03/23 18:44:32 michael Exp
+#
+
+ad_page_variables {
+    on_what_id
+    on_which_table
+    object_name
+    scope
+    {user_id ""}
+    {group_id ""}
+    {role ""}
+    permission_type 
+    return_url
+}
+
+page_validation {
+    switch $scope {
+	user {
+	    if { [empty_string_p $user_id] } {
+		error "\"user_id\" required but not supplied"
+	    }
+	}
+
+	group_role {
+	    if { [empty_string_p $group_id] } {
+		error "\"group_id\" required but not supplied"
+	    }
+
+	    if { [empty_string_p $role] } {
+		error "\"role\" required but not supplied"
+	    }
+	}
+
+	group {
+	    if { [empty_string_p $group_id] } {
+		error "\"group_id\" required but not supplied"
+	    }
+	}
+
+	registered_users -
+	all_users {
+	}
+
+	default {
+	    error "unknown scope: $scope"
+	}
+    }
+
+    validate_integer on_what_id $on_what_id
+    validate_integer_or_null user_id $user_id
+    validate_integer_or_null group_id $group_id
+}
+
+set local_user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+ad_require_permission $db $local_user_id "administer" $on_what_id $on_which_table
+
+# Does the specified permission exist?
+#
+switch $scope {
+    user {
+	set permission_id [database_to_tcl_string $db "select
+ user_permission_id($user_id, '$permission_type', '$on_what_id', '$on_which_table')
+from dual"]
+    }
+
+    group_role {
+	set permission_id [database_to_tcl_string $db "select
+ group_role_permission_id($group_id, '$role', '$permission_type', '$on_what_id', '$on_which_table')
+from dual"]
+    }
+
+    group {
+	set permission_id [database_to_tcl_string $db "select
+ group_permission_id($group_id, '$permission_type', '$on_what_id', '$on_which_table')
+from dual"]
+    }
+
+    registered_users {
+	set permission_id [database_to_tcl_string $db "select
+ reg_users_permission_id('$permission_type', '$on_what_id', '$on_which_table')
+from dual"]
+    }
+
+    all_users {
+	set permission_id [database_to_tcl_string $db "select
+ all_users_permission_id('$permission_type',
+  '$on_what_id', '$on_which_table')
+from dual"]
+    }
+}
+
+if { $permission_id != 0 } {
+    # If the permission exists, then check to see if it's the last
+    # 'administer' permission. If it is, then present a confirmation
+    # page. Otherwise, revoke it.
+    #
+    if {
+	$permission_type == "administer"
+	&& [ad_permission_count $db $on_what_id $on_which_table \
+		$permission_type] == 1
+    } {
+	ns_db releasehandle $db
+
+	ns_returnredirect "revoke-only-administer-permission?[export_url_vars on_what_id on_which_table object_name permission_id return_url]"
+	return
+
+    } else {
+	ns_db select $db "select revoke_permission($permission_id)"
+    }
+
+} else {
+    # Otherwise, grant the permission.
+    #
+    switch $scope {
+	user {
+	    ns_db select $db "select grant_permission_to_user($user_id, '$permission_type', '$on_what_id', '$on_which_table')"
+	}
+
+	group_role {
+	    ns_db select $db "select grant_permission_to_role($group_id, '$role', '$permission_type', '$on_what_id', '$on_which_table')"
+	}
+
+	group {
+	    ns_db select $db "select grant_permission_to_group($group_id, '$permission_type', '$on_what_id', '$on_which_table')"
+	}
+
+	registered_users {
+	    ns_db select $db "select grant_permission_to_reg_users('$permission_type', '$on_what_id', '$on_which_table')"
+	}
+
+	all_users {
+	    ns_db select $db "select grant_permission_to_all_users('$permission_type', '$on_what_id', '$on_which_table')"
+	}
+    }
+}
+
+ns_returnredirect $return_url
Index: web/openacs/www/gp/public-comment-toggle.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gp/public-comment-toggle.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gp/public-comment-toggle.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,36 @@
+# public-comment-toggle.tcl,v 1.1.4.1 2000/02/03 09:53:44 ron Exp
+# requires: permissions_id
+# optional: page_url, page_name, return_url, return_name
+
+ad_page_variables {
+    permissions_id
+    {user_id {}}
+    {group_id {}}
+    {role {}}
+    {page_url {}}
+    {page_name {}}
+    {return_url {}}
+    {return_name {}}
+}
+
+validate_integer permissions_id $permissions_id
+validate_integer_or_null user_id $user_id
+validate_integer_or_null group_id $group_id
+
+set local_user_id [ad_verify_and_get_user_id]
+set local_group_id [ad_get_group_id]
+set db [ns_db gethandle]
+
+# check permissions
+if { ![ad_g_owner_p $db $permissions_id $local_user_id $local_group_id] } {
+    ad_return_error "Unauthorized" "You are not authorized to edit the permissions for this page.<p>"
+    return
+}
+
+ns_db dml $db "update general_permissions
+               set public_comment_p = logical_negation(public_comment_p)
+               where permissions_id = $permissions_id"
+
+ns_returnredirect "edit-page-permissions.tcl?[export_url_vars permissions_id page_url page_name return_url return_name]"
+
+
Index: web/openacs/www/gp/public-read-toggle.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gp/public-read-toggle.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gp/public-read-toggle.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,36 @@
+# public-read-toggle.tcl,v 1.1.4.1 2000/02/03 09:53:45 ron Exp
+# requires: permissions_id
+# optional: page_url, page_name, return_url, return_name
+
+ad_page_variables {
+    permissions_id
+    {user_id {}}
+    {group_id {}}
+    {role {}}
+    {page_url {}}
+    {page_name {}}
+    {return_url {}}
+    {return_name {}}
+}
+
+validate_integer permissions_id $permissions_id
+validate_integer_or_null user_id $user_id
+validate_integer_or_null group_id $group_id
+
+set local_user_id [ad_verify_and_get_user_id]
+set local_group_id [ad_get_group_id]
+set db [ns_db gethandle]
+
+# check permissions
+if { ![ad_g_owner_p $db $permissions_id $local_user_id $local_group_id] } {
+    ad_return_error "Unauthorized" "You are not authorized to edit the permissions for this page.<p>"
+    return
+}
+
+ns_db dml $db "update general_permissions
+               set public_read_p = logical_negation(public_read_p)
+               where permissions_id = $permissions_id"
+
+ns_returnredirect "edit-page-permissions.tcl?[export_url_vars permissions_id page_url page_name return_url return_name]"
+
+
Index: web/openacs/www/gp/public-write-toggle.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gp/public-write-toggle.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gp/public-write-toggle.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,36 @@
+# public-write-toggle.tcl,v 1.1.4.1 2000/02/03 09:53:46 ron Exp
+# requires: permissions_id
+# optional: page_url, page_name, return_url, return_name
+
+ad_page_variables {
+    permissions_id
+    {user_id {}}
+    {group_id {}}
+    {role {}}
+    {page_url {}}
+    {page_name {}}
+    {return_url {}}
+    {return_name {}}
+}
+
+validate_integer permissions_id $permissions_id
+validate_integer_or_null user_id $user_id
+validate_integer_or_null group_id $group_id
+
+set local_user_id [ad_verify_and_get_user_id]
+set local_group_id [ad_get_group_id]
+set db [ns_db gethandle]
+
+# check permissions
+if { ![ad_g_owner_p $db $permissions_id $local_user_id $local_group_id] } {
+    ad_return_error "Unauthorized" "You are not authorized to edit the permissions for this page.<p>"
+    return
+}
+
+ns_db dml $db "update general_permissions
+               set public_write_p = logical_negation(public_write_p)
+               where permissions_id = $permissions_id"
+
+ns_returnredirect "edit-page-permissions.tcl?[export_url_vars permissions_id page_url page_name return_url return_name]"
+
+
Index: web/openacs/www/gp/read-toggle.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gp/read-toggle.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gp/read-toggle.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,61 @@
+# read-toggle.tcl,v 1.1.4.1 2000/02/03 09:53:47 ron Exp
+# requires: permissions_id, user_id OR group_id
+# optional: page_url, page_name, return_url (these are merely kept to save state)
+
+ad_page_variables {
+    permissions_id
+    {user_id {}}
+    {group_id {}}
+    {role {}}
+    {page_url {}}
+    {page_name {}}
+    {return_url {}}
+    {return_name {}}
+}
+
+validate_integer permissions_id $permissions_id
+validate_integer_or_null user_id $user_id
+validate_integer_or_null group_id $group_id
+
+set local_user_id [ad_verify_and_get_user_id]
+set local_group_id [ad_get_group_id]
+set db [ns_db gethandle]
+
+# check permissions
+if { ![ad_g_owner_p $db $permissions_id $local_user_id $local_group_id] } {
+    ad_return_error "Unauthorized" "You are not authorized to edit the permissions for this page.<p>"
+    return
+}
+
+if { [info exists user_id] && ![empty_string_p $user_id] } {
+    if { [empty_string_p $group_id] } {
+	ns_db dml $db "update permissions_ug_map
+                       set read_p = logical_negation(read_p)
+                       where user_id = $user_id
+                       and permissions_id = $permissions_id"
+    } else {
+	ns_db dml $db "update permissions_ug_map
+                       set read_p = logical_negation(read_p)
+                       where user_id = $user_id
+	               and group_id = $group_id
+                       and permissions_id = $permissions_id"
+    }
+} else {
+    if { [empty_string_p $role] } {
+	ns_db dml $db "update permissions_ug_map
+                       set read_p = logical_negation(read_p)
+                       where group_id = $group_id
+                       and permissions_id = $permissions_id
+                       and role is null"
+    } else {
+	ns_db dml $db "update permissions_ug_map
+                       set read_p = logical_negation(read_p)
+                       where group_id = $group_id
+                       and permissions_id = $permissions_id
+                       and role = '[DoubleApos $role]'"
+    }	
+}
+
+ns_returnredirect "edit-page-permissions.tcl?[export_url_vars permissions_id page_url page_name return_url return_name]"
+
+
Index: web/openacs/www/gp/redirect-to-caller.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gp/redirect-to-caller.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gp/redirect-to-caller.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,11 @@
+# redirect-to-caller.tcl,v 1.1.4.1 2000/02/03 09:53:48 ron Exp
+ad_page_variables {
+    {page_url {}}
+    {return_url {}}
+}
+
+if { ![empty_string_p $return_url] } {
+    ns_returnredirect $return_url
+} else {
+    ns_returnredirect $page_url
+}
\ No newline at end of file
Index: web/openacs/www/gp/remove-ug.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gp/remove-ug.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gp/remove-ug.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,54 @@
+# remove-ug.tcl,v 1.1.4.1 2000/02/03 09:53:49 ron Exp
+# requires: permissions_id
+# optional: page_url, page_name, return_url
+
+ad_page_variables {
+    permissions_id
+    {user_id {}}
+    {group_id {}}
+    {role {}}
+    {page_url {}}
+    {page_name {}}
+    {return_url {}}
+    {return_name {}}
+}
+
+validate_integer permissions_id $permissions_id
+validate_integer_or_null user_id $user_id
+validate_integer_or_null group_id $group_id
+
+set local_user_id [ad_verify_and_get_user_id]
+set local_group_id [ad_get_group_id]
+set db [ns_db gethandle]
+
+# check permissions
+if { ![ad_g_owner_p $db $permissions_id $local_user_id $local_group_id] } {
+    ad_return_error "Unauthorized" "You are not authorized to edit the permissions for this page.<p>"
+    return
+}
+
+if { $user_id != 0 && ![empty_string_p $user_id] } {
+    ns_db dml $db "delete from permissions_ug_map
+    where user_id = $user_id
+    and permissions_id = $permissions_id"
+}
+
+if { $group_id != 0 && ![empty_string_p $group_id] } {
+    if { ![empty_string_p $role] } {
+	ns_db dml $db "delete from permissions_ug_map
+	where group_id = $group_id
+	and user_id is null
+	and role = '[DoubleApos $role]'
+	and permissions_id = $permissions_id"
+    } else {
+	ns_db dml $db "delete from permissions_ug_map
+	where group_id = $group_id
+	and user_id is null
+	and role is null
+	and permissions_id = $permissions_id"
+    }
+}
+
+ns_returnredirect "edit-page-permissions.tcl?[export_url_vars permissions_id page_url page_name return_url return_name]"
+
+
Index: web/openacs/www/gp/revoke-only-administer-permission.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gp/revoke-only-administer-permission.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gp/revoke-only-administer-permission.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,30 @@
+#
+# /www/gp/confirm-revoke.tcl
+#
+# created by michael@arsdigita.com, 2000-03-23
+#
+# Confirmation page to present before revoking a permission
+# for a given row in the database.
+#
+# revoke-only-administer-permission.tcl,v 1.1.2.1 2000/03/23 18:44:31 michael Exp
+#
+
+ad_page_variables {
+    on_what_id
+    on_which_table
+    object_name
+    permission_id
+    return_url
+}
+
+validate_integer on_what_id $on_what_id
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+ad_require_permission $db $user_id "administer" $on_what_id $on_which_table
+
+ns_db releasehandle $db
+
+ad_return_template
Index: web/openacs/www/gp/search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gp/search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gp/search.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,116 @@
+# search.tcl,v 1.2.4.1 2000/02/03 09:53:51 ron Exp
+# (stolen from admin/users/search.tcl)
+
+# Reusable page for searching for a user by email or last_name.
+# Returns to "target" with user_id_from_search, first_names_from_search,
+# last_name_from_search, and email_from_search, and passing along all
+# form variables listed in "passthrough".
+
+set_the_usual_form_variables
+
+# email or last_name (search strings)
+# also accept "keyword" (for looking through both)
+# target (URL to return to)
+# passthrough (form variables to pass along from caller)
+
+
+# Check input.
+set exception_count 0
+set exception_text ""
+
+# from one of the user pages
+if { (![info exists email] || $email == "") && (![info exists last_name] || $last_name == "") } {
+    incr exception_count
+    append exception_text "<li>You must specify either an email address or last name to search for.\n"
+}
+
+if { [info exists email] && [info exists last_name] && $email != "" && $last_name != "" } {
+    incr exception_count
+    append exception_text "<li>You can only specify either email or last name, not both.\n"
+}
+
+if { ![info exists target] || $target == "" } {
+    incr exception_count
+    append exception_text "<li>Target was not specified. This shouldn't have happened,
+    please contact the <a href=\"mailto:[ad_host_administrator]\">administrator</a>
+    and let them know what happened.\n"
+}
+
+if { $exception_count != 00 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+if { [info exists keyword] } {
+    set search_clause "lower(email) like '%[string tolower $keyword]%' or lower(first_names || ' ' || last_name) like '%[string tolower $keyword]%'"
+    set search_text "name or email matching \"$keyword\""
+} elseif { [info exists email] && $email != "" } {
+    set search_text "email \"$email\""
+    set search_clause "lower(email) like '%[string tolower $email]%'"
+} else {
+    set search_text "last name \"$last_name\""
+    set search_clause "lower(last_name) like '%[string tolower $last_name]%'"
+}
+
+set edit_perm_url "edit-page-permissions.tcl?[export_url_vars permissions_id page_url page_name return_url return_name]"
+set user_add_url "user-add.tcl?[export_url_vars permissions_id page_url page_name return_url return_name]"
+
+if { [info exists return_name] && ![empty_string_p $return_name] && [info exists return_url] && ![empty_string_p $return_url] } {
+    set navbar "[ad_context_bar_ws_or_index [list "$return_url" "$return_name"] [list "$edit_perm_url" "Edit Permissions"] [list "$user_add_url" "Add a User"] "User Search for $search_text"]"
+} else { 
+    set navbar "[ad_context_bar_ws_or_index [list "$page_url" "$page_name"] [list "$edit_perm_url" "Edit Permissions"] [list "$user_add_url" "Add a User"] "User Search for $search_text"]"
+}
+
+if { ![info exists passthrough] } {
+    set passthrough_parameters ""
+} else {
+    set passthrough_parameters "&[export_entire_form_as_url_vars $passthrough]"
+}
+
+# append some sql to remove users already in this permission record
+append search_clause " and not exists (select 1 from permissions_ug_map
+                                       where permissions_id = $permissions_id
+                                       and users.user_id = permissions_ug_map.user_id)"
+
+
+set db [ns_db gethandle]
+set selection [ns_db select $db "select user_id as user_id_from_search, 
+  first_names as first_names_from_search, last_name as last_name_from_search,
+  email as email_from_search, user_state
+from users
+where $search_clause"]
+
+ReturnHeaders
+
+ns_write "[ad_admin_header "User Search"]
+<h2>User Search</h2>
+$navbar
+<hr>
+<ul>
+"
+
+set i 0
+
+set user_items ""
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    append user_items "<li><a href=\"$target?[export_url_vars user_id_from_search first_names_from_search last_name_from_search email_from_search]$passthrough_parameters\">$first_names_from_search $last_name_from_search ($email_from_search)</a>\n"
+    incr i
+    if { $user_state != "authorized" } {
+	set user_finite_state_links  [ad_registration_finite_state_machine_admin_links $user_state $user_id_from_search]
+	append user_items "<font color=red>$user_state</font> [join $user_finite_state_links " | "] \n"
+    }
+}
+
+if { $i == 0 } {
+    ns_write "<li>No users found that can be added to this permissions record.\n"
+} else {
+    ns_write $user_items
+}
+
+ns_write "</ul>
+[ad_admin_footer]
+"
+
Index: web/openacs/www/gp/user-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gp/user-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gp/user-add-2.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,53 @@
+# user-add-2.tcl,v 1.1.4.1 2000/02/03 09:53:52 ron Exp
+# requires: users_to_be_added, permissions_id
+# optional: return_url, page_url, page_name
+
+ad_page_variables {
+    permissions_id
+    {page_url {}}
+    {page_name {}}
+    {return_url {}}
+    {return_name {}}
+    {user_id_from_search {}}
+    {first_names_from_search {}}
+    {last_name_from_search {}}
+    {email_from_search {}}
+}
+
+validate_integer permissions_id $permissions_id
+validate_integer_or_null user_id_from_search $user_id_from_search
+
+set local_user_id [ad_verify_and_get_user_id]
+set local_group_id [ad_get_group_id]
+set db [ns_db gethandle]
+
+# check permissions
+if { ![ad_g_owner_p $db $permissions_id $local_user_id $local_group_id] } {
+    ad_return_error "Unauthorized" "You are not authorized to edit the permissions for this page.<p>"
+    return
+}
+
+if { [info exists user_id_from_search] && ![empty_string_p $user_id_from_search] } {
+    ns_db dml $db "insert into permissions_ug_map
+    (permissions_id, user_id)
+    values
+    ($permissions_id, $user_id_from_search)"
+} else {
+    set add_users_list [util_GetCheckboxValues [ns_conn form] users_to_be_added]
+    
+    if {[llength $add_users_list] > 0 && $add_users_list != 0} {
+	ns_db dml $db "begin transaction"
+	
+	foreach user_id $add_users_list {
+	    ns_db dml $db "insert into permissions_ug_map
+	    (permissions_id, user_id)
+	    values
+	    ($permissions_id, $user_id)"
+	}
+	
+	ns_db dml $db "end transaction"
+    }
+}
+
+ns_returnredirect "edit-page-permissions.tcl?[export_url_vars permissions_id page_url page_name return_url return_name]"
+
Index: web/openacs/www/gp/user-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gp/user-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gp/user-add.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,122 @@
+# user-add.tcl,v 1.2.4.1 2000/02/03 09:53:53 ron Exp
+# requires: permissions_id
+# optional: page_url, page_name, return_url
+
+ad_page_variables {
+    permissions_id
+    {page_url {}}
+    {page_name {}}
+    {return_url {}}
+    {return_name {}}
+}
+
+validate_integer permissions_id $permissions_id
+
+set user_id [ad_verify_and_get_user_id]
+set group_id [ad_get_group_id]
+set db [ns_db gethandle]
+
+if { ![ad_g_owner_p $db $permissions_id $user_id $group_id] } {
+    ad_return_error "Unauthorized" "You are not authorized to edit the permissions for this page.<p>"
+    return
+}
+
+set count 0
+
+if { [ad_parameter ShowUsersP gp] } {
+    set user_list_info "<table>
+    <tr>
+    <td> </td>
+    <th align=left>User</th>
+    <th align=left>Email</th>
+    </tr>
+    "
+
+    set selection [ns_db select $db "select users.user_id, first_names, last_name, email
+                                     from users
+                                     where not exists
+                                     (select 1 from permissions_ug_map
+                                     where permissions_id = $permissions_id
+                                     and users.user_id = permissions_ug_map.user_id)
+                                     order by last_name, first_names"]
+
+    while { [ns_db getrow $db $selection] } {
+	set_variables_after_query
+	append user_list_info "
+	<tr>
+	<td><input type=checkbox name=users_to_be_added value=$user_id></td>
+	<td>$last_name, $first_names</td>
+	<td>$email</td>
+	</tr>"
+	
+	incr count
+    }
+}
+
+set edit_perm_url "edit-page-permissions.tcl?[export_url_vars permissions_id page_url page_name return_url return_name]"
+
+if { [info exists return_name] && ![empty_string_p $return_name] && [info exists return_url] && ![empty_string_p $return_url] } {
+    set navbar "[ad_context_bar_ws_or_index [list "$return_url" "$return_name"] [list "$edit_perm_url" "Edit Permissions"] "Add a User"]"
+} else { 
+    set navbar "[ad_context_bar_ws_or_index [list "$page_url" "$page_name"] [list "$edit_perm_url" "Edit Permissions"] "Add a User"]"
+}
+
+ReturnHeaders 
+
+ns_write "
+[ad_header "Add a User"]
+
+<h2>Add a User</h2>
+$navbar
+<hr>
+
+"
+
+
+
+if { [ad_parameter ShowUsersP gp] } {
+    if { $count == 0 }  {
+	
+	ns_write "
+	No users are available to be added.
+	"
+	
+    } else {
+	append user_list_info "</table>"
+	
+	ns_write "
+	<form method=get action=\"user-add-2.tcl\">
+	
+	[export_entire_form]
+	<input type=hidden name=target value=\"/gp/user-add-2.tcl\">
+	
+	$user_list_info
+
+	<p>
+	
+	<input type=submit value=\"Add Selected User(s)\">
+	</form>
+	"
+    }
+}
+
+ns_write "
+<form action=search.tcl method=post>
+[export_entire_form]
+<input type=hidden name=target value=\"/gp/user-add-2.tcl\">
+<input type=hidden name=passthrough value=\"permissions_id page_url page_name return_url return_name\">
+<table border=0>
+<tr><td>Email address:<td><input type=text name=email size=40></tr>
+<tr><td colspan=2>or by</tr>
+<tr><td>Last name:<td><input type=text name=last_name size=40></tr>
+</table>
+
+<p>
+
+<center>
+<input type=submit value=\"Search\">
+</center>
+</form>
+
+[ad_footer]
+"
Index: web/openacs/www/gp/write-toggle.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/gp/write-toggle.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/gp/write-toggle.tcl	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,61 @@
+# write-toggle.tcl,v 1.1.4.1 2000/02/03 09:53:54 ron Exp
+# requires: permissions_id, user_id OR group_id
+# optional: page_url, page_name, return_url (these are merely kept to save state)
+
+ad_page_variables {
+    permissions_id
+    {user_id {}}
+    {group_id {}}
+    {role {}}
+    {page_url {}}
+    {page_name {}}
+    {return_url {}}
+    {return_name {}}
+}
+
+validate_integer permissions_id $permissions_id
+validate_integer_or_null user_id $user_id
+validate_integer_or_null group_id $group_id
+
+set local_user_id [ad_verify_and_get_user_id]
+set local_group_id [ad_get_group_id]
+set db [ns_db gethandle]
+
+# check permissions
+if { ![ad_g_owner_p $db $permissions_id $local_user_id $local_group_id] } {
+    ad_return_error "Unauthorized" "You are not authorized to edit the permissions for this page.<p>"
+    return
+}
+
+if { [info exists user_id] && ![empty_string_p $user_id] } {
+    if { [empty_string_p $group_id] } {
+	ns_db dml $db "update permissions_ug_map
+                       set write_p = logical_negation(write_p)
+                       where user_id = $user_id
+                       and permissions_id = $permissions_id"
+    } else {
+	ns_db dml $db "update permissions_ug_map
+                       set write_p = logical_negation(write_p)
+                       where user_id = $user_id
+	               and group_id = $group_id
+                       and permissions_id = $permissions_id"
+    }
+} else {
+    if { [empty_string_p $role] } {
+	ns_db dml $db "update permissions_ug_map
+                       set write_p = logical_negation(write_p)
+                       where group_id = $group_id
+                       and permissions_id = $permissions_id
+                       and role is null"
+    } else {
+	ns_db dml $db "update permissions_ug_map
+                       set write_p = logical_negation(write_p)
+                       where group_id = $group_id
+                       and permissions_id = $permissions_id
+                       and role = '[DoubleApos $role]'"
+    }
+}
+
+ns_returnredirect "edit-page-permissions.tcl?[export_url_vars permissions_id page_url page_name return_url return_name]"
+
+
Index: web/openacs/www/graphics/1pixel.footer
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/1pixel.footer,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/1pixel.header
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/1pixel.header,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/checked.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/checked.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/checkmark.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/checkmark.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/down-arrow.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/down-arrow.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/down.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/down.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/folder.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/folder.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/readme.txt
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/readme.txt,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/graphics/readme.txt	17 Apr 2001 14:05:16 -0000	1.1
@@ -0,0 +1,8 @@
+this directory is for graphics used site-wide, e.g., backgrounds and logos
+(sadly the heaviest users of this directory will be those who haven't
+read the HTML chapter of http://photo.net/wtr/thebook/ )
+
+Some standard files:
+
+bg.gif (background)
+logo.gif 
Index: web/openacs/www/graphics/redball.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/redball.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/unchecked.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/unchecked.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/up-arrow.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/up-arrow.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/up.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/up.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/file-storage/docqmark.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/file-storage/docqmark.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/file-storage/folderqmark.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/file-storage/folderqmark.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/file-storage/ftv2blank.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/file-storage/ftv2blank.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/file-storage/ftv2doc.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/file-storage/ftv2doc.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/file-storage/ftv2folderclosed.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/file-storage/ftv2folderclosed.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/file-storage/ftv2folderopen.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/file-storage/ftv2folderopen.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/file-storage/ftv2lastnode.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/file-storage/ftv2lastnode.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/file-storage/ftv2link.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/file-storage/ftv2link.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/file-storage/ftv2mlastnode.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/file-storage/ftv2mlastnode.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/file-storage/ftv2mnode.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/file-storage/ftv2mnode.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/file-storage/ftv2node.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/file-storage/ftv2node.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/file-storage/ftv2plastnode.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/file-storage/ftv2plastnode.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/file-storage/ftv2pnode.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/file-storage/ftv2pnode.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/file-storage/ftv2vertline.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/file-storage/ftv2vertline.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/file-storage/spacer.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/file-storage/spacer.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/aquamarine-dot.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/aquamarine-dot.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/black-dot.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/black-dot.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/blue-dot.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/blue-dot.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/dark-green-dot.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/dark-green-dot.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/dark-grey-dot.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/dark-grey-dot.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/magenta-dot.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/magenta-dot.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/medium-blue-dot.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/medium-blue-dot.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/muted-aquamarine-dot.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/muted-aquamarine-dot.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/muted-blue-dot.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/muted-blue-dot.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/muted-green-dot.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/muted-green-dot.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/muted-magenta-dot.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/muted-magenta-dot.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/muted-red-dot.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/muted-red-dot.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/muted-yellow-dot.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/muted-yellow-dot.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/orange-dot.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/orange-dot.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/purple-dot.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/purple-dot.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/red-circle-10.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/red-circle-10.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/red-circle-12.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/red-circle-12.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/red-circle-14.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/red-circle-14.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/red-circle-16.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/red-circle-16.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/red-circle-4.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/red-circle-4.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/red-circle-6.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/red-circle-6.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/red-circle-8.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/red-circle-8.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/red-dot.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/red-dot.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/scale-left.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/scale-left.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/scale-main.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/scale-main.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/scale-middle-2.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/scale-middle-2.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/scale-middle.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/scale-middle.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/scale-right.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/scale-right.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/transparent-dot.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/transparent-dot.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/wbbwc.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/wbbwc.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/wbbwh.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/wbbwh.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/wbbwv.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/wbbwv.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/white-dot.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/white-dot.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/graphing-package/yellow-dot.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/graphing-package/yellow-dot.gif,v
diff -u
Binary files differ
Index: web/openacs/www/graphics/photodb/error.jpg
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/graphics/photodb/error.jpg,v
diff -u
Binary files differ
Index: web/openacs/www/groups/group-new-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/group-new-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/group-new-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,134 @@
+# group-new-2.tcl,v 3.0 2000/02/06 03:45:37 ron Exp
+# File: /groups/group-new-2.tcl
+# Date: mid-1998
+# Contact: teadams@mit.edu, tarik@mit.edu
+# Purpose: creation of a new user group
+# 
+# Note: groups_public_dir, group_type_url_p, group_type, group_type_pretty_name, 
+#       group_type_pretty_plural, group_public_root_url and group_admin_root_url
+#       are set in this environment by ug_serve_group_pages. if group_type_url_p
+#       is 0, then group_type, group_type_pretty_name and group_type_pretty_plural
+#       are empty strings)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+# group_type, maybe return_url, parent_group_id
+
+if {[info exists parent_group_id]} {
+    validate_integer parent_group_id $parent_group_id
+}
+
+set user_id [ad_get_user_id]
+
+if {$user_id == 0} {
+   ns_returnredirect "/register/index.tcl?return_url=[ad_urlencode "[ug_url]/group-new-2.tcl?group_type=$group_type"]"
+    return
+}
+
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select * from user_group_types where group_type = '$QQgroup_type'"]
+
+set_variables_after_query
+
+ReturnHeaders 
+
+ns_write "[ad_header "Define a $pretty_name"]
+
+<h2>New $pretty_name</h2>
+
+in <a href=/>[ad_system_name]</a>
+
+<hr>
+
+"
+
+# so we don't get hit by duplicates if the user double-submits,
+# let's generate the group_id here
+
+set group_id [database_to_tcl_string $db "select user_group_sequence.nextval from dual"]
+
+ns_write "
+<form method=post action=\"group-new-3.tcl\">
+[export_form_vars group_id group_type return_url parent_group_id]
+<table>
+<tr>
+<th>Group Name
+<td><input type=text name=group_name>
+</tr>
+
+<tr>
+<th>Short Name
+<td><input type=text name=short_name>
+</tr>
+
+<tr>
+<th>Group Admin Email
+<td><input type=text name=admin_email>
+</tr>
+"
+
+set approval_widget_raw "
+<tr>
+<th>New Member Policy
+<td><select name=new_member_policy>
+<option value=\"open\" selected>Open: Users will be able to join this group
+<option value=\"wait\">Wait: Users can apply to join
+<option value=\"closed\">Closed: Only administrators can put users in this group 
+</select>
+</tr>"
+
+set simple_ns_set [ns_set new "Just for approval policy"]
+ns_set put $simple_ns_set new_member_policy $default_new_member_policy
+
+set approval_widget_stuffed [bt_mergepiece $approval_widget_raw $simple_ns_set]
+
+ns_write "\n$approval_widget_stuffed\n"
+
+
+
+append spam_policy_widget_html "
+<tr>
+<th>Group Spam Policy
+<td><select name=spam_policy>
+    [ad_generic_optionlist { "Open : Any group member can spam the group" 
+                             "Wait : Spam by members require administrator's approval"
+                             "Closed : Only administrators can spam the group" } \
+                           { open wait closed } open]
+    </select>
+</tr>
+"
+
+ns_write "\n$spam_policy_widget_html\n"
+
+# now let's query for any additional fields
+
+set selection [ns_db select $db "select * 
+from user_group_type_fields
+where group_type = '$QQgroup_type'
+order by sort_key"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    ns_write "<tr><th>$pretty_name
+<td>[ad_user_group_type_field_form_element $column_name $column_type]
+</tr>
+"
+}
+
+ns_write "
+
+</table>
+<br>
+<center>
+<input type=submit value=\"Create\">
+</center>
+</form>
+
+[ad_footer]
+"
Index: web/openacs/www/groups/group-new-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/group-new-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/group-new-3.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,175 @@
+# group-new-3.tcl,v 3.0.4.1 2000/03/18 02:32:53 ron Exp
+# File: /groups/group-new-3.tcl
+# Date: mid-1998
+# Contact: teadams@mit.edu, tarik@mit.edu
+# Purpose: creation of a new user group
+# 
+# Note: groups_public_dir, group_type_url_p, group_type, group_type_pretty_name, 
+#       group_type_pretty_plural, group_public_root_url and group_admin_root_url
+#       are set in this environment by ug_serve_group_pages. if group_type_url_p
+#       is 0, then group_type, group_type_pretty_name and group_type_pretty_plural
+#       are empty strings)
+
+set user_id [ad_verify_and_get_user_id]
+
+set_the_usual_form_variables
+# everything for a new group, including extra fields and the group_id
+# maybe return_url
+
+if {$user_id == 0} {
+   ns_returnredirect "/register/index.tcl?return_url=[ad_urlencode "[ug_url]/group-new-2.tcl?group_type=$group_type"]"
+    return
+}
+if { ![exists_and_not_null parent_group_id] } {
+    set parent_group_id ""
+    set QQparent_group_id ""
+} else {
+    validate_integer parent_group_id $parent_group_id
+}
+
+# Structure of this script:
+#   check inputs 
+#   prepare transaction
+#   if transaction fails, try to figure out if it 
+#     failed because the group_id was already in there
+#     (i.e., user hit submit twice)
+#   if transaction succeeds, redirect user to group home page 
+
+set db [ns_db gethandle]
+
+set exception_text ""
+set exception_count 0
+
+if { ![exists_and_not_null group_name] } {
+    append exception_text "<li>Please give us a name for the group.\n"
+    incr exception_count
+}
+
+if { ![exists_and_not_null short_name] } {
+    append exception_text "<li>Please give us a short name for the group.\n"
+    incr exception_count
+}
+
+# let's check constraints imposed on the extra columns
+
+set non_null_columns [database_to_tcl_list_list $db "select column_name, pretty_name
+from user_group_type_fields
+where group_type = '$QQgroup_type'
+and lower(column_extra) like '%not null%'"]
+
+foreach column_spec $non_null_columns {
+    set column_name [lindex $column_spec 0]
+    set column_pretty_name [lindex $column_spec 1]
+    if { ![info exists $column_name] || [empty_string_p [set $column_name]] } {
+	append exception_text "<li>Please enter a value for $column_name.\n"
+	incr exception_count
+    }
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# everything checks out 
+
+if { [ad_administrator_p $db $user_id] || ([database_to_tcl_string $db "select approval_policy from user_group_types where group_type = '$QQgroup_type'"] == "open") } {
+    set approved_p "t"
+} else {
+    set approved_p "f"
+}
+
+#DRB: Postgres doesn't consider '' to be NULL (nor should it) so the
+#insertion of a blank parent group id causes a referential integrity
+#constraint error.
+
+if {$QQparent_group_id != ""} {
+    set insert_for_user_groups "insert into user_groups
+    (group_id, group_type, group_name, short_name, admin_email, creation_user, creation_ip_address, approved_p, new_member_policy, spam_policy, parent_group_id, registration_date)
+values
+    ($group_id,'$QQgroup_type','$QQgroup_name', '$QQshort_name', '$QQadmin_email', $user_id,'[ns_conn peeraddr]', '$approved_p', '$QQnew_member_policy', '$QQspam_policy', '$QQparent_group_id', sysdate())"
+} else {
+    set insert_for_user_groups "insert into user_groups
+(group_id, group_type, group_name, short_name, admin_email, creation_user, creation_ip_address, approved_p, new_member_policy, spam_policy)
+values
+($group_id,'$QQgroup_type','$QQgroup_name', '$QQshort_name', '$QQadmin_email', $user_id,'[ns_conn peeraddr]', '$approved_p', '$QQnew_member_policy', '$QQspam_policy')"
+}
+
+set n_custom_fields [database_to_tcl_string $db "select count(*) from user_group_type_fields where group_type = '$QQgroup_type'"]
+
+if { $n_custom_fields > 0 } {
+    set helper_table_name [ad_user_group_helper_table_name $group_type]
+    # let's use the utilities.tcl procedure util_prepare_insert
+    # for this we need to produce an ns_conn form-style structure
+    set helper_fields [ns_set new]
+    foreach helper_column [database_to_tcl_list $db "select column_name from user_group_type_fields where group_type = '$QQgroup_type'"] {
+	if [info exists $helper_column] {
+	    ns_set put $helper_fields $helper_column [set $helper_column]
+	}
+    }
+    if { [ns_set size $helper_fields] > 0 } {
+	set insert_for_helper_table [util_prepare_insert $db $helper_table_name group_id $group_id $helper_fields]
+    }
+}
+
+if { ![info exists return_url] } {
+    set return_url "[ug_url]/[ad_urlencode $short_name]/"
+}
+
+if [catch { 
+    ns_db dml $db "begin transaction"
+
+    ns_db dml $db $insert_for_user_groups
+    if [info exists insert_for_helper_table] {
+	ns_db dml $db $insert_for_helper_table
+    }
+
+    # let's add all the modules to this groups, which are associated with this group type
+    
+    ns_db dml $db "
+    insert into content_sections
+    (section_id, scope, section_type, requires_registration_p, visibility, group_id, 
+    section_key, module_key, section_pretty_name, enabled_p)
+    select nextval('content_section_id_sequence'), 'group', section_type_from_module_key(module_key), 'f', 'public', $group_id,
+           module_key, module_key, pretty_name_from_module_key(module_key), 't'
+    from user_group_type_modules_map
+    where group_type='$QQgroup_type'
+    "
+
+    ns_db dml $db "end transaction" 
+} errmsg] {
+    # something went wrong
+    ns_db dml $db "abort transaction" 
+
+    set selection [ns_db 0or1row $db "select 1 from user_groups where group_id=$group_id"]
+    if { ![empty_string_p $selection] } {
+	# group was already in database, so we can assume that this was a double click
+	ns_returnredirect $return_url
+	return
+    }
+
+    set selection [ns_db 0or1row $db "select group_name as other_group_name from user_groups where short_name='$QQshort_name'"]
+    if { ![empty_string_p $selection] } {
+	set_variables_after_query
+
+	incr exception_count
+	set exception_text "
+	<li>Short Name $short_name is already used by the group $other_group_name. Please choose different short name.
+	"
+	ad_return_complaint $exception_count $exception_text
+	return
+    }
+    
+    ad_return_error "database choked" "The database choked on your insert:
+    <blockquote>
+    <pre>
+    $errmsg
+    </pre>
+    </blockquote>
+    You can back up, edit your data, and try again"
+    return
+}
+
+# insert went OK
+
+ns_returnredirect $return_url
Index: web/openacs/www/groups/group-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/group-new.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/group-new.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,70 @@
+# group-new.tcl,v 3.0 2000/02/06 03:45:39 ron Exp
+# File: /groups/group-new.tcl
+# Date: mid-1998
+# Contact: teadams@mit.edu, tarik@mit.edu
+# Purpose: creation of a new user group
+# 
+# Note: groups_public_dir, group_type_url_p, group_type, group_type_pretty_name, 
+#       group_type_pretty_plural, group_public_root_url and group_admin_root_url
+#       are set in this environment by ug_serve_group_pages. if group_type_url_p
+#       is 0, then group_type, group_type_pretty_name and group_type_pretty_plural
+#       are empty strings)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set user_id [ad_get_user_id]
+
+if {$user_id == 0} {
+   ns_returnredirect "/register.tcl?return_url=[ad_urlencode "[ug_url]/group-new.tcl"]"
+    return
+}
+
+ReturnHeaders
+
+ns_write "[ad_header "Define a New User Group"]
+
+<h2>Define a New User Group</h2>
+
+in <a href=/>[ad_system_name]</a>
+
+<hr>
+
+Which of these categories best characterizes your group?
+
+<ul>
+
+"
+
+set db [ns_db gethandle]
+
+set selection [ns_db select $db "select * 
+from user_group_types
+where approval_policy <> 'closed'"]
+
+set count 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    incr count
+    ns_write "<li><a href=\"group-new-2.tcl?[export_url_vars group_type]\">$pretty_name</a>\n"
+}
+
+if { $count == 0 } {
+    ns_write "currently there are no types of groups that users may define"
+}
+
+ns_write "
+
+<p>
+
+<li>if none of the preceding categories fit the group you want to
+create <a href=\"mailto:[ad_system_owner]\">send mail to
+[ad_system_owner]</a> and ask for a new type of group to be created.
+
+</ul>
+
+[ad_footer]
+"
+
Index: web/openacs/www/groups/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/index.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,64 @@
+# index.tcl,v 3.1 2000/02/10 03:19:04 ron Exp
+# File: /groups/index.tcl
+# Date: mid-1998
+# Contact: teadams@arsdigita.com, tarik@arsdigita.com
+# Purpose: display list of user groups
+# 
+# Note: groups_public_dir, group_type_url_p, group_type, group_type_pretty_name, 
+#       group_type_pretty_plural, group_public_root_url and group_admin_root_url
+#       are set in this environment by ug_serve_group_pages. if group_type_url_p
+#       is 0, then group_type, group_type_pretty_name and group_type_pretty_plural
+#       are empty strings)
+
+
+ReturnHeaders 
+
+set page_title [ad_decode $group_type_url_p 1 $group_type_pretty_plural "User Groups"]
+
+ns_write "
+[ad_header $page_title]
+<h2>$page_title</h2>
+[ad_context_bar_ws_or_index [ad_decode $group_type_url_p 1 $group_type_pretty_plural "Groups"]]
+<hr>
+"
+
+set db [ns_db gethandle]
+
+set group_type_sql [ad_decode $group_type_url_p 1 "and ugt.group_type='[DoubleApos $group_type]'" ""]
+
+set selection [ns_db select $db "
+select ug.short_name, ug.group_name, ugt.group_type as user_group_type, ugt.pretty_plural
+from user_groups ug, user_group_types ugt
+where ug.group_type = ugt.group_type
+and existence_public_p = 't'
+and approved_p = 't'
+$group_type_sql
+order by upper(ug.group_type)"]
+
+set html ""
+set last_group_type ""
+set group_counter 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { $last_group_type != $user_group_type && !$group_type_url_p } {
+	append group_html "<h4>$pretty_plural</h4>\n"
+	set last_group_type $user_group_type
+    }
+    append group_html "<li><a href=\"$group_public_root_url/[ad_urlencode $short_name]/\">$group_name</a>\n"
+    incr group_counter
+}
+
+if { $group_counter > 0 } {
+    append html $group_html
+} else {
+    append html "There are no publicly accessible groups in the database right now. "
+}
+
+
+ns_write "
+<ul>
+$html
+</ul>
+
+[ad_footer]
+"
Index: web/openacs/www/groups/member-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/member-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/member-add-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,125 @@
+# member-add-2.tcl,v 3.0 2000/02/06 03:45:42 ron Exp
+set_the_usual_form_variables
+
+# group_id, user_id_from_search, maybe role,return_url
+
+validate_integer group_id $group_id
+validate_integer user_id_from_search $user_id_from_search
+
+set db [ns_db gethandle]
+
+set old_role_list [database_to_tcl_list $db "select role
+from user_group_map
+where user_id = $user_id_from_search
+and group_id = $group_id"]
+
+set name [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id = $user_id_from_search"]
+set selection [ns_db 1row $db "select group_name, multi_role_p from user_groups where group_id = $group_id"]
+set_variables_after_query
+
+
+if {[info exists role] && ![empty_string_p $role]} {
+    set title "Add $name as $role"
+} else {
+    set title "Specify Role and Any Extra Fields for $name"
+}
+
+ReturnHeaders 
+
+ns_write "[ad_header "$title"]
+
+<h2>$title</h2>
+
+in <a href=\"group.tcl?group_id=$group_id\">$group_name</a>
+
+<hr>
+
+<form method=get action=\"member-add-3.tcl\">
+[export_form_vars group_id user_id_from_search return_url]
+<table>
+"
+
+if { [llength $old_role_list] > 0 } {
+
+    ns_write "
+Warning: $name currently has the role: [join $old_role_list ", "], which will be replaced by this operation.<p>
+"
+}
+
+if { [info exists role] && ![empty_string_p $role] } {
+    ns_write "[export_form_vars role]"
+} else {
+    
+    if { [string compare $multi_role_p "t"] == 0 } {
+	set existing_roles [database_to_tcl_list $db "select role from user_group_roles where group_id = $group_id"]
+	if {[lsearch $existing_roles "administrator"] == -1 } {
+	    lappend existing_roles "administrator"
+	}
+	if { [llength $existing_roles] > 0 } {
+	    ns_write "<tr><th>Role<td><select name=existing_role>
+	    [ad_generic_optionlist $existing_roles $existing_roles ""]
+	    </select>
+	    "
+	}
+	ns_write "</tr>"
+    } else {
+	set existing_roles [database_to_tcl_list $db "select distinct role from user_group_map where group_id = $group_id"]
+	if {[lsearch $existing_roles "administrator"] == -1 } {
+	    lappend existing_roles "administrator"
+	}
+	if {[lsearch $existing_roles "all"] == -1 } {
+	    lappend existing_roles "all"
+	}
+	
+	ns_write "<tr><th>Existing role</th><td>
+	<select name=existing_role>
+	<option value=\"\">choose an existing role
+	"
+	if { [lsearch $existing_roles member] == -1 } {
+	    ns_write "<option value=\"member\">ordinary member; no special attributes\n"
+	}
+	if { [llength $existing_roles] > 0 } {
+	    ns_write "
+	    <option>[join $existing_roles "\n<option>"]"
+	}
+	ns_write "</select>
+	</tr>
+	<tr><td colspan=2 align=center>or</tr>
+	<tr>
+	<td>
+	Define a new role for this group:
+	<td>
+	<input type=text name=new_role size=30>
+	</tr>
+	"
+    }
+}
+
+
+# Additional fields
+
+set selection [ns_db select $db "select group_id, field_name, field_type
+from all_member_fields_for_group
+where group_id = $group_id
+order by sort_key"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    ns_write "<tr><th>$field_name
+<td>[ad_user_group_type_field_form_element $field_name $field_type]
+</tr>
+"
+}
+
+
+ns_write "
+</table>
+<p>
+
+<center>
+<input type=submit value=\"Confirm\">
+</center>
+</form>
+
+[ad_footer]
+"
Index: web/openacs/www/groups/member-add-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/member-add-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/member-add-3.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,103 @@
+# member-add-3.tcl,v 3.2.2.2 2000/03/17 21:12:41 lars Exp
+set_the_usual_form_variables
+
+# group_id, user_id_from_search, one or more of role, existing_role, new_role
+# all the info for extra member fields
+# Maybe return_url
+
+validate_integer group_id $group_id
+validate_integer user_id_from_search $user_id_from_search
+
+set dbs [ns_db gethandle main 2]
+set db [lindex $dbs 0]
+set sub_db [lindex $dbs 1]
+
+# ACK! Let's get some sanity checking in here. HUGE security hole. -jsc
+validate_integer "user_id_from_search" $user_id_from_search
+validate_integer "group_id" $group_id
+
+#
+# lars@pinds.com, March 17, 2000:
+# Put in a hack so intranet modules will work as expected but without the security hole.
+# We shouldn't have module-specific code here, though, so we should definitely find
+# a better solution for next release.
+
+set user_id [ad_verify_and_get_user_id]
+
+set selection [ns_db 0or1row $db "select group_type, new_member_policy from user_groups where group_id=$group_id"]
+if { [empty_string_p $selection] } {
+    ad_return_error "Couldn't find group" "We couldn't find the group $group_id. Must be a programming error."
+    return
+}
+set_variables_after_query
+
+if { ![ad_administrator_p $db $user_id] } {
+
+    if { ![ad_user_group_authorized_admin $user_id $group_id $db] } {
+
+	set intranet_administrator_p [ad_administration_group_member $db [ad_parameter IntranetGroupType intranet] "" $user_id]
+
+	if { $group_type != "intranet" || !$intranet_administrator_p } {
+
+	    if { $new_member_policy != "open" } {
+		
+		ad_return_complaint 1 "<li>The group you are attempting to add a member to 
+		does not have an open new member policy."
+		return
+	    }
+	}
+    }
+}
+
+set mapping_user [ad_get_user_id]
+
+set mapping_ip_address [ns_conn peeraddr]
+
+if ![info exists role] {
+    # we weren't just given a role so let's look at the user's choice
+    if { [info exists existing_role] && ![empty_string_p $existing_role] } {
+	set role $existing_role
+    } elseif { [info exists new_role] && ![empty_string_p $new_role] } {
+	set role $new_role
+    } else {
+	ad_return_error "No role specified" "We couldn't figure out what role this new member is supposed to have; either you didn't choose one or there is a bug in our software."
+	return
+    }
+}
+
+with_transaction $db {
+
+    ns_db dml $db "delete from user_group_map where group_id = $group_id and user_id = $user_id_from_search"
+
+    ns_db dml $db "insert into user_group_map (group_id, user_id, role, mapping_user, mapping_ip_address) select $group_id, $user_id_from_search, '[DoubleApos $role]', $mapping_user, '$mapping_ip_address' from dual where ad_user_has_role_p ( $user_id_from_search, $group_id, '$role' ) <> 't'"
+    
+    # Extra fields
+    set sub_selection [ns_db select $sub_db "select field_name from all_member_fields_for_group where group_id = $group_id"]
+    while { [ns_db getrow $sub_db $sub_selection] } {
+	set_variables_after_subquery
+	if { [exists_and_not_null $field_name] } {
+	    ns_db dml $db "insert into user_group_member_field_map
+(group_id, user_id, field_name, field_value)
+values ($group_id, $user_id_from_search, '[DoubleApos $field_name]', [ns_dbquotevalue [set $field_name]])"
+        }
+    }
+    
+} {
+    ad_return_error "Database Error" "Error while trying to insert user into a user group.
+
+Database error message was:	
+<blockquote>
+<pre>
+$errmsg
+</pre>
+</blockquote>	
+	
+[ad_footer]"
+    return
+}
+
+if { [exists_and_not_null return_url] } {
+    ns_returnredirect $return_url
+} else {
+    ns_returnredirect "group.tcl?group_id=$group_id"
+}
Index: web/openacs/www/groups/member-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/member-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/member-add.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,54 @@
+# member-add.tcl,v 3.0 2000/02/06 03:45:45 ron Exp
+set_the_usual_form_variables
+
+# group_id, maybe role,return_url
+
+validate_integer group_id $group_id
+
+set user_id [ad_get_user_id]
+
+# we will want to record who was logged in when this person was added
+# so let's force admin to register
+
+if {$user_id == 0} {
+   ns_returnredirect "/register.tcl?return_url=[ns_urlencode "/admin/ug/member-add.tcl?[export_url_vars group_id role return_url]"]"
+    return
+}
+
+set db [ns_db gethandle]
+
+ReturnHeaders 
+
+ns_write "[ad_header "Add Member"]
+
+<h2>Add Member</h2>
+
+"
+
+set group_name [database_to_tcl_string $db "select group_name from user_groups where group_id = $group_id"]
+
+ns_write "to <a href=\"group.tcl?group_id=$group_id\">$group_name</a>
+
+<hr>
+
+Locate your new member by 
+
+<form method=get action=\"/user-search.tcl\">
+[export_entire_form]
+<input type=hidden name=target value=\"/groups/member-add-2.tcl\">
+<input type=hidden name=passthrough value=\"group_id role return_url\">
+<table border=0>
+<tr><td>Email address:<td><input type=text name=email size=40></tr>
+<tr><td colspan=2>or by</tr>
+<tr><td>Last name:<td><input type=text name=last_name size=40></tr>
+</table>
+
+<p>
+
+<center>
+<input type=submit value=\"Search\">
+</center>
+</form>
+
+[ad_footer]
+"
Index: web/openacs/www/groups/member-remove-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/member-remove-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/member-remove-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,19 @@
+# member-remove-2.tcl,v 3.1 2000/02/20 10:49:08 ron Exp
+set_the_usual_form_variables
+
+# group_id, user_id
+# return_url (optional)
+
+validate_integer group_id $group_id
+validate_integer user_id $user_id
+
+set db [ns_db gethandle]
+
+ns_db dml $db "delete from user_group_map where
+user_id = $user_id and group_id = $group_id"
+
+if { [exists_and_not_null return_url] } {
+    ns_returnredirect $return_url
+} else {
+    ns_returnredirect "index.tcl"
+}
\ No newline at end of file
Index: web/openacs/www/groups/test.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/test.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/test.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,13 @@
+ReturnHeaders
+
+set db [ns_db gethandle]
+
+ns_write "
+[ad_header success]
+[database_to_tcl_string $db "select news_id_sequence.nextval from dual"]
+[ad_footer]
+"
+
+
+
+
Index: web/openacs/www/groups/admin/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/admin/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/admin/index.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,74 @@
+# index.tcl,v 3.1 2000/03/01 08:42:33 yon Exp
+# File:    /groups/admin/index.tcl
+# Date:    12/21/99
+# Author:  tarik@arsdigita.com
+# Purpose: display list of user groups for which user has group administration privileges
+# 
+# Note: groups_public_dir, group_type_url_p, group_type, group_type_pretty_name, 
+#       group_type_pretty_plural, group_public_root_url and group_admin_root_url
+#       are set in this environment by ug_serve_group_pages. if group_type_url_p
+#       is 0, then group_type, group_type_pretty_name and group_type_pretty_plural
+#       are empty strings)
+
+set user_id [ad_get_user_id]
+
+if {$user_id == 0} {
+    ns_returnredirect "/register.tcl?return_url=[ad_urlencode "[ug_admin_url]/"]"
+    return
+}
+
+ReturnHeaders 
+
+set page_title [ad_decode $group_type_url_p 1 "$group_type_pretty_name Administration" "Group Administration"]
+
+ns_write "
+[ad_header $page_title]
+<h2>$page_title</h2>
+[ad_admin_context_bar $page_title]
+<hr>
+"
+
+set db [ns_db gethandle]
+
+set group_type_sql [ad_decode $group_type_url_p 1 "and ugt.group_type='[DoubleApos $group_type]'" ""]
+
+set selection [ns_db select $db "
+select ug.short_name, ug.group_name, ugt.group_type, ugt.pretty_plural
+from user_groups ug, user_group_types ugt, users u
+where u.user_id=$user_id
+and ad_user_has_role_p ( $user_id, ug.group_id, 'administrator' ) = 't'
+and ug.approved_p = 't'
+$group_type_sql
+and ugt.group_type= ug.group_type
+order by upper(ug.group_type)"]
+
+set last_group_type ""
+set group_counter 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { $last_group_type != $group_type && !$group_type_url_p } {
+	append group_html "<h4>$pretty_plural</h4>\n"
+	set last_group_type $group_type
+    }
+    append group_html "<li><a href=\"$group_admin_root_url/[ad_urlencode $short_name]/\">$group_name</a>\n"
+    incr group_counter
+}
+
+if { $group_counter > 0 } {
+    append html $group_html
+} else {
+    append html "
+    You do not have administrator privileges for any of the
+    groups at <a href=/>[ad_system_name]</a>
+    <br>
+    You can browse through existing groups at <a href=[ug_url]/>[ad_parameter SystemURL][ug_url]</a>
+    <br>"
+}
+
+ns_write "
+<ul>
+$html
+</ul>
+
+[ad_footer]
+"
Index: web/openacs/www/groups/admin/group/action-role-map.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/admin/group/action-role-map.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/admin/group/action-role-map.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,29 @@
+# action-role-map.tcl,v 3.0 2000/02/06 03:45:49 ron Exp
+# File:     /groups/admin/group/action-role-map.tcl
+# Date:     mid-1998
+# Contact:  teadams@mit.edu, tarik@arsdigita.com
+# Purpose:  allow users with the role $role to do action $action
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+# role, action
+
+set db [ns_db gethandle]
+
+if { [ad_user_group_authorized_admin [ad_verify_and_get_user_id] $group_id $db] != 1 || [database_to_tcl_string $db "select group_admin_permissions_p from user_groups where group_id=$group_id"] == "f" } {
+    ad_return_error "Not Authorized" "You are not authorized to see this page"
+    return
+}
+
+ns_db dml $db "
+insert into user_group_action_role_map (group_id, role, action, creation_user, creation_ip_address)
+select $group_id, '$QQrole', '$QQaction', [ad_get_user_id], '[DoubleApos [ns_conn peeraddr]]' 
+from dual 
+where not exists (select role from user_group_action_role_map where group_id = $group_id and role = '$QQrole' and action = '$QQaction')"
+
+ns_returnredirect members.tcl
+
Index: web/openacs/www/groups/admin/group/action-role-unmap.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/admin/group/action-role-unmap.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/admin/group/action-role-unmap.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,28 @@
+# action-role-unmap.tcl,v 3.0 2000/02/06 03:45:50 ron Exp
+# File:     /groups/admin/group/action-role-unmap.tcl
+# Date:     mid-1998
+# Contact:  teadams@mit.edu, tarik@arsdigita.com
+# Purpose:  forbid users with the role $role to do action $action
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+# role, action
+
+set db [ns_db gethandle]
+
+if { [ad_user_group_authorized_admin [ad_verify_and_get_user_id] $group_id $db] != 1 || [database_to_tcl_string $db "select group_admin_permissions_p from user_groups where group_id=$group_id"] == "f" } {
+    ad_return_error "Not Authorized" "You are not authorized to see this page"
+    return
+}
+
+ns_db dml $db "delete from 
+user_group_action_role_map
+where group_id = $group_id 
+and role = '$QQrole' and action = '$QQaction'"
+
+ns_returnredirect members.tcl
+
Index: web/openacs/www/groups/admin/group/email-alert-policy-update.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/admin/group/email-alert-policy-update.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/admin/group/email-alert-policy-update.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,27 @@
+# email-alert-policy-update.tcl,v 3.0 2000/02/06 03:45:51 ron Exp
+# File:    /groups/admin/group/member-add.tcl
+# Date:    mid-1998
+# Contact: tarik@arsdigita.com, teadams@arsdigita.com
+# Purpose: toggle the flag which sends email to admin when a user applies for
+#           group membership.
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set db [ns_db gethandle]
+
+if { [ad_user_group_authorized_admin [ad_verify_and_get_user_id] $group_id $db] != 1 } {
+    ad_return_error "Not Authorized" "You are not authorized to see this page"
+    return
+}
+
+
+
+ns_db dml $db "
+update user_groups set email_alert_p = logical_negation(email_alert_p) where group_id = $group_id"
+
+ns_returnredirect members.tcl
+
+
Index: web/openacs/www/groups/admin/group/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/admin/group/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/admin/group/index.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,152 @@
+# index.tcl,v 3.0 2000/02/06 03:45:52 ron Exp
+# File:     /groups/admin/group/index.tcl
+# Date:     mid-1998
+# Contact:  teadams@mit.edu, tarik@arsdigita.com
+# Purpose:  group administration main page
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set group_admin_url [ns_set get $group_vars_set group_admin_url]
+set group_public_url [ns_set get $group_vars_set group_public_url]
+
+set db [ns_db gethandle]
+
+if { [ad_user_group_authorized_admin  [ad_verify_and_get_user_id]  $group_id $db] != 1 } {
+    ad_return_error "Not Authorized" "You are not authorized to see this page"
+    return
+}
+
+
+set selection [ns_db 1row $db "
+select ug.approved_p, ug.creation_user, ug.registration_date, 
+       ug.new_member_policy, ug.email_alert_p, ug.group_type, 
+       ug.multi_role_p, ug.group_admin_permissions_p, ug.group_name,
+       first_names, last_name
+from user_groups ug, users u
+where ug.group_id = $group_id
+and ug.creation_user = u.user_id"]
+set_variables_after_query
+
+ReturnHeaders 
+
+ns_write "
+[ad_scope_admin_header $group_name $db]
+[ad_scope_admin_page_title Administration $db]
+[ad_scope_admin_context_bar $group_name]
+<hr>
+[help_upper_right_menu [list "$group_public_url/" "Public Page"]]
+"
+
+if { $approved_p == "f" } {
+    ns_write "
+    <blockquote>
+    <font color=red>this group is awaiting approval</font>
+    </blockquote>
+    [ad_scope_admin_footer]
+    "
+    return
+}
+
+set info_table_name [ad_user_group_helper_table_name $group_type] 
+
+# Check that the helper table exists (BMA)
+if {[ns_table exists $db $info_table_name]} {
+    set selection [ns_db 0or1row $db "select * from $info_table_name where group_id = $group_id"]
+    
+    if { ![empty_string_p $selection] } {
+	set set_variables_after_query_i 0
+	set set_variables_after_query_limit [ns_set size $selection]
+	while {$set_variables_after_query_i<$set_variables_after_query_limit} {
+	    append html "<li>[ns_set key $selection $set_variables_after_query_i]: [ns_set value $selection $set_variables_after_query_i]\n"
+	    incr set_variables_after_query_i
+	}
+    }
+}
+
+append html "
+<h4>Group Administration</h4>
+<a href=members.tcl>Membership</a><br>
+<a href=spam-index.tcl>Group Spam</a><br>
+"
+
+set selection [ns_db select $db "
+select section_id,section_key, section_pretty_name, section_type, module_key
+from content_sections 
+where scope='group' 
+and group_id=$group_id
+and (section_type!='static')
+order by sort_key
+"]
+
+set return_url "$group_admin_url/"
+
+set admin_section_counter 0
+set system_section_counter 0
+set custom_section_counter 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    if { [string compare $section_type admin]==0 } {
+    
+	append admin_sections_html "
+	<a href=[ad_urlencode $section_key]/index.tcl?[export_url_vars return_url]>$section_pretty_name</a><br>
+	"    
+    	incr admin_section_counter
+    }
+    
+    if { [string compare $section_type system]==0 } {
+    
+	# custom sections module doesn't have any administration of it's own (handled inside content-sections module),
+	# so we don't want to display link
+	if { [string compare $module_key custom-sections]!=0 } {
+	    append system_sections_html "
+	    <a href=[ad_urlencode $section_key]/>$section_pretty_name</a><br>
+	    "    
+	    incr system_section_counter
+	}
+    }
+    
+    if { [string compare $section_type custom]==0 } {
+    
+	append custom_sections_html "
+	<a href=custom-sections/index.tcl?[export_url_vars section_id]>$section_pretty_name</a><br>
+	"  
+	incr custom_section_counter
+    }
+}
+
+if { $admin_section_counter>0 } {
+    append html "
+    $admin_sections_html
+    <p>
+    "
+}
+
+if { $system_section_counter>0 } {
+    append html "
+    <h4>Module Administration</h4>
+    $system_sections_html
+    <p>
+    "
+}
+
+if { $custom_section_counter>0 } {
+    append html "
+    <h4>Custom Sections Administration</h4>
+    $custom_sections_html
+    <p>
+    "
+}
+
+ns_write "
+<blockquote>
+$html
+</blockquote>
+
+
+[ad_scope_admin_footer]
+"
+
Index: web/openacs/www/groups/admin/group/member-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/admin/group/member-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/admin/group/member-add-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,103 @@
+# member-add-2.tcl,v 3.0 2000/02/06 03:45:53 ron Exp
+# File:     /groups/admin/group/member-add-2.tcl
+# Date:     mid-1998
+# Contact:  teadams@mit.edu, tarik@arsdigita.com
+# Purpose:  add a member to the user group
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+# user_id_from_search, maybe role 
+
+validate_integer user_id_from_search $user_id_from_search
+
+set db [ns_db gethandle]
+
+if ![info exists role] {
+    set role ""
+}
+    
+if { [ad_user_group_authorized_admin  [ad_verify_and_get_user_id]  $group_id $db] != 1 } {
+    ad_return_error "Not Authorized" "You are not authorized to see this page"
+    return
+}
+
+set name [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id = $user_id_from_search"]
+set selection [ns_db 1row $db "select group_name, group_type, multi_role_p from user_groups where group_id = $group_id"]
+set_variables_after_query
+
+ReturnHeaders 
+
+set group_admin_url [ns_set get $group_vars_set group_admin_url]
+
+ns_write "
+[ad_scope_admin_header "Add $name" $db]
+[ad_scope_admin_page_title "Add $name" $db]
+[ad_scope_admin_context_bar "Add $name"]
+<hr>
+"
+
+append html "
+<form method=get action=\"member-add-3.tcl\">
+[export_form_vars group_id user_id_from_search]
+"
+
+if { ![empty_string_p $role] } {
+    append html "[export_form_vars role]"
+} else {
+
+    if { [string compare $multi_role_p "t"] == 0 } {
+	# all groups must have an adminstrator role
+	set existing_roles [database_to_tcl_list $db "select role from user_group_roles where group_id = $group_id"]
+	if {[lsearch $existing_roles "administrator"] == -1 } {
+	    lappend existing_roles "administrator"
+	}
+	if { [llength $existing_roles] > 0 } {
+	    append html "
+	    <select name=existing_role>
+	    [ad_generic_optionlist $existing_roles $existing_roles $role]
+	    </select>
+	    "
+	}
+	append html "</tr>"
+    } else {
+	set existing_roles [database_to_tcl_list $db "select distinct role from user_group_map where group_id = $group_id"]
+	if {[lsearch $existing_roles "administrator"] == -1 } {
+	    lappend existing_roles "administrator"
+	}
+	if {[lsearch $existing_roles "all"] == -1 } {
+	    lappend existing_roles "all"
+	}
+	if { [llength $existing_roles] > 0 } {
+	    append html "
+	    <select name=existing_role>
+	    <option value=\"\">choose an existing role
+	    <option>[join $existing_roles "\n<option>"]
+	    </select>
+	    "
+	}
+	append html "
+	<p>
+	Define a new role for this group:
+	<input type=text name=new_role size=30>
+	"
+    }
+}
+
+append html "
+<p>
+
+<center>
+<input type=submit value=\"Confirm\">
+</center>
+</form>
+"
+
+ns_write "
+$html
+[ad_scope_admin_footer]
+"
+
Index: web/openacs/www/groups/admin/group/member-add-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/admin/group/member-add-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/admin/group/member-add-3.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,62 @@
+# member-add-3.tcl,v 3.1 2000/03/01 08:42:25 yon Exp
+# File:     /groups/admin/group/member-add-3.tcl
+# Date:     mid-1998
+# Contact:  teadams@mit.edu, tarik@arsdigita.com
+# Purpose:  add a member to the user group
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+# user_id_from_search, one or more of role, existing_role, new_role
+
+validate_integer user_id_from_search $user_id_from_search
+
+set db [ns_db gethandle]
+
+if { [ad_user_group_authorized_admin  [ad_verify_and_get_user_id]  $group_id $db] != 1 } {
+    ad_return_error "Not Authorized" "You are not authorized to see this page"
+    return
+
+}
+
+set mapping_user [ad_get_user_id]
+
+set mapping_ip_address [ns_conn peeraddr]
+
+if ![info exists role] {
+    # we weren't just given a role so let's look at the user's choice
+    if { [info exists existing_role] && ![empty_string_p $existing_role] } {
+	set role $existing_role
+    } elseif { [info exists new_role] && ![empty_string_p $new_role] } {
+	set role $new_role
+    } else {
+	ad_return_error "No role specified" "We couldn't figure out what role this new member is supposed to have; either you didn't choose one or there is a bug in our software."
+	return
+    }
+}
+
+# now the unique constraint is on user_id, group_id, role,
+# not just on user_id, group_id; this means we can insert
+# multiple instances of this user into this group, but with
+# different roles
+ns_db dml $db "
+insert into user_group_map
+(group_id, user_id, role, mapping_user, mapping_ip_address)
+     select $group_id,
+            $user_id_from_search,
+            '[DoubleApos $role]',
+            $mapping_user,
+            '$mapping_ip_address'
+       from dual
+      where not exists (select user_id
+                          from user_group_map
+                         where group_id = $group_id
+                           and user_id = $user_id_from_search
+                           and role = '[DoubleApos $role]')"
+
+ns_returnredirect members.tcl
+
+
Index: web/openacs/www/groups/admin/group/member-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/admin/group/member-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/admin/group/member-add.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,78 @@
+# member-add.tcl,v 3.0 2000/02/06 03:45:56 ron Exp
+# File:    /groups/admin/group/member-add.tcl
+# Date:    mid-1998
+# Contact: tarik@arsdigita.com, teadams@arsdigita.com
+# Purpose: display list of user groups for which user has group administration privileges
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_form_variables 0
+
+# maybe role 
+
+set user_id [ad_get_user_id]
+
+set group_name [ns_set get $group_vars_set group_name]
+set group_admin_url [ns_set get $group_vars_set group_admin_url]
+
+# we will want to record who was logged in when this person was added
+# so let's force admin to register
+
+if {$user_id == 0} {
+    ns_returnredirect "/register.tcl?return_url=[ad_urlencode "$group_admin_url/member-add.tcl?[export_url_vars role]"]"
+    return
+}
+
+if { ![info exists role] } {
+    set role ""
+}
+
+set db [ns_db gethandle]
+
+
+if { [ad_user_group_authorized_admin [ad_verify_and_get_user_id] $group_id $db] != 1 } {
+    ad_return_error "Not Authorized" "You are not authorized to see this page"
+    return
+}
+
+
+append html "
+[ad_scope_admin_header "Add Member" $db]
+[ad_scope_admin_page_title "Add Member" $db]
+[ad_scope_admin_context_bar "Add Member"]
+<hr>
+
+Locate your new member by 
+
+<form method=get action=\"/user-search.tcl\">
+[export_form_vars role]
+<input type=hidden name=target value=\"$group_admin_url/member-add-2.tcl\">
+"
+
+if { ![empty_string_p $role] } {
+    append html "
+    <input type=hidden name=passthrough value=\"role\">
+    "
+}
+
+append html "
+<table border=0>
+<tr><td>Email address:<td><input type=text name=email size=40></tr>
+<tr><td colspan=2>or by</tr>
+<tr><td>Last name:<td><input type=text name=last_name size=40></tr>
+</table>
+
+<p>
+
+<center>
+<input type=submit value=\"Search\">
+</center>
+</form>
+
+[ad_scope_admin_footer]
+"
+
+ns_return 200 text/html $html
\ No newline at end of file
Index: web/openacs/www/groups/admin/group/member-remove-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/admin/group/member-remove-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/admin/group/member-remove-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,28 @@
+# member-remove-2.tcl,v 3.0 2000/02/06 03:45:57 ron Exp
+# File:     /groups/admin/group/member-remove-2.tcl
+# Date:     mid-1998
+# Contact:  teadams@mit.edu, tarik@arsdigita.com
+# Purpose:  remove member from the user group
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+# user_id
+
+validate_integer user_id $user_id
+
+set db [ns_db gethandle]
+
+if { [ad_user_group_authorized_admin [ad_verify_and_get_user_id] $group_id $db] != 1 } {
+    ad_return_error "Not Authorized" "You are not authorized to see this page"
+    return
+}
+
+ns_db dml $db "
+delete from user_group_map where
+user_id = $user_id and group_id = $group_id"
+
+ns_returnredirect members.tcl
Index: web/openacs/www/groups/admin/group/member-remove.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/admin/group/member-remove.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/admin/group/member-remove.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,62 @@
+# member-remove.tcl,v 3.1.2.1 2000/04/11 11:57:40 carsten Exp
+# File:     /groups/admin/group/member-remove.tcl
+# Date:     mid-1998
+# Contact:  teadams@mit.edu, tarik@arsdigita.com
+# Purpose:  remove member from the user group
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+# user_id
+
+validate_integer user_id $user_id
+
+set group_name [ns_set get $group_vars_set group_name]
+set group_admin_url [ns_set get $group_vars_set group_admin_url]
+
+set db [ns_db gethandle]
+
+if { [ad_user_group_authorized_admin [ad_verify_and_get_user_id] $group_id $db] != 1 } {
+    ad_return_error "Not Authorized" "You are not authorized to see this page"
+    return
+}
+
+if { ![ad_user_group_member $db $group_id $user_id] } {
+    ad_return_error "Not a Member" "The user you are trying to remove is not a member of this group."
+    return
+}
+
+set name [database_to_tcl_string_or_null $db "
+select first_names || ' ' || last_name
+from users, user_groups 
+where users.user_id = $user_id
+and user_groups.group_id = $group_id
+and ad_group_member_p ( $user_id, $group_id ) = 't'"]
+
+ReturnHeaders 
+
+ns_write "
+[ad_scope_admin_header "Really remove $name?" $db]
+[ad_scope_admin_page_title "Really remove $name?" $db]
+[ad_scope_admin_context_bar "Remove $name"]
+<hr>
+
+<center>
+<table>
+<tr><td>
+<form method=get action=members.tcl>
+<input type=submit name=submit value=\"No, Cancel\">
+</form>
+</td><td>
+<form method=get action=\"member-remove-2.tcl\">
+[export_form_vars user_id]
+<input type=submit name=submit value=\"Yes, Proceed\">
+</form>
+</td></tr>
+</table>
+</center>
+[ad_scope_admin_footer]
+"
Index: web/openacs/www/groups/admin/group/members.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/admin/group/members.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/admin/group/members.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,208 @@
+# members.tcl,v 3.1.2.1 2000/04/11 11:57:08 carsten Exp
+# File:     /groups/admin/group/members.tcl
+# Date:     mid-1998
+# Contact:  teadams@mit.edu, tarik@arsdigita.com
+# Purpose:  groups members and privileges administration page
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set db [ns_db gethandle]
+
+if { [ad_user_group_authorized_admin  [ad_verify_and_get_user_id]  $group_id $db] != 1 } {
+    ad_return_error "Not Authorized" "You are not authorized to see this page"
+    return
+}
+
+
+set selection [ns_db 1row $db "
+select ug.approved_p, ug.creation_user, ug.registration_date, ug.group_name,
+       ug.new_member_policy,ug.spam_policy, ug.email_alert_p, ug.group_type, 
+       ug.multi_role_p, ug.group_admin_permissions_p,
+       first_names, last_name
+from user_groups ug, users u
+where ug.group_id = $group_id
+and ug.creation_user = u.user_id"]
+set_variables_after_query
+
+ReturnHeaders 
+
+ns_write "
+[ad_scope_admin_header "Membership Administration" $db]
+[ad_scope_admin_page_title "Membership Administration" $db]
+[ad_scope_admin_context_bar "Membership Admin"]
+<hr>
+"
+
+append html "
+<h3>Membership</h3>
+<form action=new-member-policy-update.tcl method=post>
+<ul>
+<li>New Member Policy: 
+<select name=new_member_policy>
+[ad_generic_optionlist { open wait closed }  { open wait closed } $new_member_policy]
+</select>
+<input type=submit name=submit value=\"Edit\">
+</form>
+
+<li>Send email to admins on new membership request:  [util_PrettyBoolean $email_alert_p] (<a href=\"email-alert-policy-update.tcl\">Toggle</a>)
+<p>
+</ul>
+"
+
+set selection [ns_db select $db "
+select queue.user_id, first_names || ' ' || last_name as name, to_char(queue_date, 'Mon-dd-yyyy') as queue_date
+from user_group_map_queue queue, users 
+where queue.user_id = users.user_id
+and group_id = $group_id
+order by queue_date asc
+"]
+
+
+set counter 0
+while { [ns_db getrow $db $selection] } {
+    if { $counter== 0 } {
+	append html "
+	<h3>Users who have asked for membership</h3>
+	<ul>"
+    }
+    set_variables_after_query
+    incr counter
+    append html "<li><a href=\"/shared/community-member.tcl?user_id=$user_id\">$name</a> - $queue_date\n  &nbsp <a href=\"membership-grant.tcl?[export_url_vars user_id]\"> <font color=red>(grant membership)</font></a> &nbsp; | &nbsp;  <a href=\"membership-refuse.tcl?[export_url_vars user_id]\"><font color=red>(refuse membership)</font></a>"
+}
+
+if { $counter!= 0 } {
+    append html "</ul>"
+}
+
+append html "
+<h3>Administrator Members</h3>
+
+<ul>
+"
+
+# let's look for administrators
+
+set selection [ns_db select $db "
+select user_id, first_names || ' ' || last_name as name
+from users
+where ad_user_has_role_p ( user_id, $group_id, 'administrator' ) = 't'"]
+
+set counter 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    incr counter
+    append html "<li><a href=\"/shared/community-member.tcl?user_id=$user_id\">$name</a>  &nbsp; &nbsp <a href=\"role-edit.tcl?[export_url_vars user_id]\">edit role</a> | <a href=\"member-remove.tcl?[export_url_vars user_id]\">remove</a> \n"
+}
+
+if { $counter== 0 } {
+    append html "no administrators are currently defined for this group"
+}
+
+append html "
+<p>
+<li><a href=\"member-add.tcl?role=administrator\">add an administrator</a>
+</ul>
+
+<h3>Other Members</h3>
+
+<ul>
+"
+
+# let's look for members
+
+set selection [ns_db select $db "
+select map.user_id, map.role, first_names || ' ' || last_name as name
+from user_group_map map, users 
+where map.user_id = users.user_id
+and group_id = $group_id
+and role <> 'administrator'
+order by role, name"]
+
+set counter 0
+set last_role ""
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    incr counter
+    if { $role != $last_role } {
+	set last_role $role
+	append html "<h4>$role</h4>"
+    }
+    append html "<li><a href=\"/shared/community-member.tcl?user_id=$user_id\">$name</a> &nbsp; &nbsp <a href=\"role-edit.tcl?[export_url_vars user_id]\">edit role</a> | <a href=\"member-remove.tcl?[export_url_vars user_id]\">remove</a>\n"
+}
+
+if { $counter== 0 } {
+    append html "no members found"
+}
+
+append html "
+<p>
+<li><a href=\"member-add.tcl?role=member\">add a member</a>
+</ul>"
+
+
+if { [string compare $multi_role_p "t"] == 0} {
+    append html "
+    <h3>Permissions</h3>
+    Note: users with the role administrator have full authorization.
+    <p>
+    "
+
+
+    append role_table_title "
+    <table border=1 cellpadding=2><tr><th>Role \\\\ Action</th>"
+    set actions_list [database_to_tcl_list $db "select action from user_group_actions where group_id = $group_id"]
+    set roles_list [database_to_tcl_list $db "select role from user_group_roles where group_id = $group_id"]
+  
+    
+    append role_table "<tr>"
+
+    set actions_with_mapping ""
+
+    foreach role $roles_list {
+	set allowed_actions_for_role [database_to_tcl_list $db "select action from user_group_action_role_map where group_id = $group_id and role='[DoubleApos $role]'"]
+	append role_table "<tr><th align=left>$role</th>"
+	foreach action $actions_list {
+	    if {[lsearch $allowed_actions_for_role $action] == -1} {
+		set state "Denied"
+	    } else {
+		set state "Allowed"
+	   }
+	   
+	   if {[lsearch $state "Denied"] == 0  && [string compare $group_admin_permissions_p "f"] != 0 } {
+	       append role_table "<td><a href=\"action-role-map.tcl?[export_url_vars action role]\">$state</a></td>"
+	   } elseif { [string compare $group_admin_permissions_p "f"] != 0 } {
+	       lappend actions_with_mapping $action
+	       append role_table "<td><a href=\"action-role-unmap.tcl?[export_url_vars action role]\">$state</a></td>"
+	   } else {
+	       lappend actions_with_mapping $action
+	       append role_table "<td>$state</td>"
+	   }
+       }
+       append role_table "</tr>"
+    }
+
+    append role_table "
+    </table>"
+
+    foreach action $actions_list {
+	append role_table_title "<th>$action</th>"
+    }
+    
+    append role_table_title "</tr>"
+    
+    append html "
+    $role_table_title
+    $role_table
+    <p>
+    "
+}
+
+ns_write "
+<blockquote>
+$html
+</blockquote>
+[ad_scope_admin_footer] 
+"
Index: web/openacs/www/groups/admin/group/membership-grant.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/admin/group/membership-grant.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/admin/group/membership-grant.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,57 @@
+# membership-grant.tcl,v 3.1 2000/03/01 08:42:29 yon Exp
+# File:     /groups/admin/group/membership-grant.tcl
+# Date:     mid-1998
+# Contact:  teadams@mit.edu, tarik@arsdigita.com
+# Purpose:  grant membership to user who applied for it (used only for groups,
+#           which heave new members policy set to wait)
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_form_variables
+# user_id
+
+validate_integer user_id $user_id
+
+set db [ns_db gethandle]
+
+
+if { [ad_user_group_authorized_admin [ad_verify_and_get_user_id] $group_id $db] != 1 } {
+    ad_return_error "Not Authorized" "You are not authorized to see this page"
+    return
+}
+
+ns_db dml $db "begin transaction"
+
+ns_db dml $db "
+insert into user_group_map 
+(user_id, group_id, mapping_ip_address,  role, mapping_user) 
+     select user_id,
+            group_id,
+            ip_address,
+            'member',
+            [ad_get_user_id] 
+       from user_group_map_queue 
+      where user_id = $user_id
+        and group_id = $group_id 
+        and not exists (select user_id 
+                          from user_group_map 
+                         where user_id = $user_id
+                           and group_id = $group_id
+                           and role = 'member')"
+
+ns_db dml $db "
+delete from user_group_map_queue 
+where user_id = $user_id and group_id = $group_id
+"
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect members.tcl
+
+
+
+
+
Index: web/openacs/www/groups/admin/group/membership-refuse-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/admin/group/membership-refuse-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/admin/group/membership-refuse-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,25 @@
+# membership-refuse-2.tcl,v 3.0 2000/02/06 03:46:03 ron Exp
+# File:     /groups/admin/group/membership-refuse-2.tcl
+# Date:     mid-1998
+# Contact:  teadams@mit.edu, tarik@arsdigita.com
+# Purpose:  deny membership to user who applied for it (used only for groups,
+#           which heave new members policy set to wait)
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+# user_id
+
+validate_integer user_id $user_id
+
+set db [ns_db gethandle]
+
+ns_db dml $db "
+delete from user_group_map_queue where
+user_id = $user_id and group_id = $group_id
+"
+
+ns_returnredirect members.tcl
Index: web/openacs/www/groups/admin/group/membership-refuse.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/admin/group/membership-refuse.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/admin/group/membership-refuse.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,45 @@
+# membership-refuse.tcl,v 3.0 2000/02/06 03:46:04 ron Exp
+# File:     /groups/admin/group/membership-refuse.tcl
+# Date:     mid-1998
+# Contact:  teadams@mit.edu, tarik@arsdigita.com
+# Purpose:  deny membership to user who applied for it (used only for groups,
+#           which heave new members policy set to wait)
+#
+# Note: group_id and group_vars_set are already set up in the environment y the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+# user_id
+
+validate_integer user_id $user_id
+
+set group_name [ns_set get $group_vars_set group_name]
+set group_admin_url [ns_set get $group_vars_set group_admin_url]
+set db [ns_db gethandle]
+
+set name [database_to_tcl_string  $db "
+select first_names || ' ' || last_name from users where user_id = $user_id"]
+ 
+ns_return 200 text/html "
+[ad_scope_admin_header "Really refuse $name?" $db]
+[ad_scope_admin_page_title "Really refuse $name?" $db]
+[ad_scope_admin_context_bar "Refuse $name"]
+<hr>
+
+<center>
+<table>
+<tr><td>
+<form method=get action=members.tcl>
+<input type=submit name=submit value=\"No, Cancel\">
+</form>
+</td><td>
+<form method=get action=\"membership-refuse-2.tcl\">
+[export_form_vars user_id]
+<input type=submit name=submit value=\"Yes, Proceed\">
+</form>
+</td></tr>
+</table>
+[ad_scope_admin_footer]
+"
Index: web/openacs/www/groups/admin/group/new-member-policy-update.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/admin/group/new-member-policy-update.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/admin/group/new-member-policy-update.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,61 @@
+# new-member-policy-update.tcl,v 3.1 2000/03/01 08:42:30 yon Exp
+# File:    /groups/admin/group/new-member-policy-update.tcl
+# Date:    mid-1998
+# Contact: teadams@arsdigita.com, tarik@arsdigita.com
+# Purpose: sets the new member policy for the group
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_form_variables
+# new_member_policy
+
+set db [ns_db gethandle]
+
+
+if { [ad_user_group_authorized_admin [ad_verify_and_get_user_id] $group_id $db] != 1 } {
+    ad_return_error "Not Authorized" "You are not authorized to see this page"
+    return
+}
+
+ns_db dml $db "
+update user_groups 
+set new_member_policy = '$new_member_policy' 
+where group_id = $group_id"
+
+if { $new_member_policy == "open" } {
+    # grant everyone in the queue membership
+    
+    ns_db dml $db "begin transaction"
+    
+    ns_db dml $db "
+    insert into user_group_map 
+    (user_id, group_id, mapping_ip_address,  role, mapping_user) 
+    select user_id,
+           group_id,
+           ip_address,
+           'member',
+           [ad_get_user_id] 
+      from user_group_map_queue 
+     where group_id = $group_id 
+       and not exists (select user_id 
+                         from user_group_map 
+                        where user_group_map.user_id = user_group_map_queue.user_id 
+                          and group_id = $group_id
+                          and role = 'member')"
+
+    ns_db dml $db "
+    delete from user_group_map_queue where group_id = $group_id"
+
+    ns_db dml $db "end transaction"
+
+}
+
+ns_returnredirect members.tcl
+
+
+
+
+
Index: web/openacs/www/groups/admin/group/role-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/admin/group/role-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/admin/group/role-edit-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,45 @@
+# role-edit-2.tcl,v 3.1 2000/03/01 08:42:31 yon Exp
+# File:    /groups/admin/group/role-edit-2.tcl
+# Date:    mid-1998
+# Contact: tarik@arsdigita.com
+# Purpose: edit the role for the user
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_form_variables
+
+# user_id, exisiting_role and/or new_role
+
+validate_integer user_id $user_id
+
+set db [ns_db gethandle]
+
+if { [ad_user_group_authorized_admin [ad_verify_and_get_user_id] $group_id $db] != 1 } {
+    ad_return_error "Not Authorized" "You are not authorized to see this page"
+    return
+}
+
+
+if { [info exists new_role] && ![empty_string_p $new_role] } {
+    set role $new_role
+} else {
+    set role $existing_role
+}
+
+if { ![info exists role] || [empty_string_p $role] } {
+    ad_return_complaint 1 "<li>Please pick a role." 
+    return
+}
+
+
+ns_db dml $db "
+     update user_group_map
+        set role = '[DoubleApos $role]'
+      where user_id = $user_id
+        and group_id = $group_id
+        and role = '[DoubleApos $old_role]'"
+
+ns_returnredirect members.tcl
Index: web/openacs/www/groups/admin/group/role-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/admin/group/role-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/admin/group/role-edit.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,119 @@
+# role-edit.tcl,v 3.0 2000/02/06 03:46:07 ron Exp
+# File:    /groups/admin/group/role-edit.tcl
+# Date:    mid-1998
+# Contact: tarik@arsdigita.com
+# Purpose: edit the role for the user
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+# user_id
+
+validate_integer user_id $user_id
+
+set group_name [ns_set get $group_vars_set group_name]
+set group_admin_url [ns_set get $group_vars_set group_admin_url]
+
+set db [ns_db gethandle]
+
+if { [ad_user_group_authorized_admin [ad_verify_and_get_user_id] $group_id $db] != 1 } {
+    ad_return_error "Not Authorized" "You are not authorized to see this page"
+    return
+}
+
+set selection [ns_db 1row  $db "
+select first_names || ' ' || last_name as name, role, 
+       multi_role_p, group_type
+from users, user_group_map, user_groups 
+where users.user_id = $user_id
+and user_group_map.user_id = users.user_id
+and user_groups.group_id = user_group_map.group_id
+and user_groups.group_id = $group_id"]
+set_variables_after_query
+
+ReturnHeaders 
+
+ns_write "
+[ad_scope_admin_header "Edit role for $name" $db]
+[ad_scope_admin_page_title "Edit role for $name" $db]
+[ad_scope_admin_context_bar "Edit Role"]
+<hr>
+"
+
+append html "
+<form method=get action=\"role-edit-2.tcl\">
+[export_form_vars user_id]
+<input type=hidden name=old_role value=\"$role\">
+
+<table>
+<tr>
+<td>Set Role
+</td><td>
+"
+
+# TODO!!!! Have to switch over from STS
+# The following is a special case for sts; hospitals have predefined roles
+
+if { [string compare $multi_role_p "t"] == 0 } {
+    # all groups must have an administrator role
+    set existing_roles [database_to_tcl_list $db "select role from user_group_roles where group_id = $group_id"]
+    if {[lsearch $existing_roles "administrator"] == -1 } {
+	lappend existing_roles "administrator"
+    }
+    if { [llength $existing_roles] > 0 } {
+	append html "
+	<select name=existing_role>
+	[ad_generic_optionlist $existing_roles $existing_roles $role]
+	</select>
+	"
+    }
+    append html "</tr>"
+} else {
+    set existing_roles [database_to_tcl_list $db "select distinct role from user_group_map where group_id = $group_id"]
+    if {[lsearch $existing_roles "administrator"] == -1 } {
+	lappend existing_roles "administrator"
+    }
+    if {[lsearch $existing_roles "all"] == -1 } {
+	lappend existing_roles "all"
+    }
+
+    if { [llength $existing_roles] > 0 } {
+	append html "
+	<select name=existing_role>
+	<option value=\"\">choose an existing role
+	[ad_generic_optionlist $existing_roles $existing_roles $role]
+	</select>
+	<tr><td colspan=2 align=center>or</tr>
+	<tr>
+	<td>
+	Define a new role for this group:
+	<td>
+	<input type=text name=new_role size=30>
+	</tr>
+	"
+    }
+}
+
+
+append html "
+</table>
+<center>
+<input type=submit value=\"Proceed\">
+</center>
+</form>
+"
+
+ns_write "
+$html
+[ad_scope_admin_footer]
+"
+
+
+
+
+
+
+
Index: web/openacs/www/groups/admin/group/spam-approve.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/admin/group/spam-approve.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/admin/group/spam-approve.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,51 @@
+# spam-approve.tcl,v 3.0 2000/02/06 03:46:08 ron Exp
+# File:     /groups/admin/group/spam-approve.tcl
+# Date:     Mon Jan 17 13:39:51 EST 2000
+# Contact:  ahmeds@mit.edu
+# Purpose:  sends one spam provided it is approved by the administrator
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+# spam_id approved_p
+
+validate_integer spam_id $spam_id
+
+set db [ns_db gethandle]
+
+if { [ad_user_group_authorized_admin  [ad_verify_and_get_user_id]  $group_id $db] != 1 } {
+    ad_return_error "Not Authorized" "You are not authorized to see this page"
+    return
+}
+
+set counter [database_to_tcl_string  $db "select count(*)
+from group_spam_history 
+where spam_id = $spam_id"]
+
+if { $counter == 0} {
+    ad_return_complaint 1 "<li>No spam with spam id $spam_id was found in the database."
+    return
+} 
+
+ns_db dml $db "update group_spam_history
+               set approved_p ='$approved_p'
+               where spam_id = $spam_id"
+
+ns_db releasehandle $db
+ns_returnredirect spam-index.tcl
+
+if { $approved_p == "t" } {
+    # although send_one_group_spam_message will not send disapproved messages , 
+    # still no need to go through the unnecessary checking, so the proc here is
+    # only called for approved messages
+ 
+    ns_conn close
+    
+    ns_log Notice "groups/admin/group/spam-approve.tcl:  sending group spam $spam_id"
+    send_one_group_spam_message $spam_id
+    ns_log Notice "groups/admin/group/spam-approve.tcl: group spam $spam_id sent"
+}
+
Index: web/openacs/www/groups/admin/group/spam-confirm.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/admin/group/spam-confirm.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/admin/group/spam-confirm.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,104 @@
+# spam-confirm.tcl,v 3.2 2000/03/09 10:46:32 hqm Exp
+# File:     /groups/admin/group/spam-confirm.tcl
+# Date:     Mon Jan 17 13:39:51 EST 2000
+# Contact:  ahmeds@mit.edu
+# Purpose:  this is the group spam confirm page
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+# sendto subject message
+
+set group_name [ns_set get $group_vars_set group_name]
+
+set sendto_string [ad_decode $sendto "members" "Members" "Administrators"]
+
+set db [ns_db gethandle]
+
+if { [ad_user_group_authorized_admin  [ad_verify_and_get_user_id]  $group_id $db] != 1 } {
+    ad_return_error "Not Authorized" "You are not authorized to see this page"
+    return
+}
+
+ReturnHeaders 
+
+ns_write "
+[ad_scope_admin_header "Confirm Spamming Group $sendto_string" $db]
+[ad_scope_admin_page_title "Confirm Spamming Group $sendto_string" $db]
+[ad_scope_admin_context_bar [list "spam-index.tcl" "Spam Admin"] \
+	[list "spam.tcl?[export_url_vars sendto]"  "Spam $sendto_string"] Confirm] 
+<hr>
+"
+set creation_date [database_to_tcl_string $db "select to_char(sysdate, 'ddth Month,YYYY  HH:MI:SS am') from dual"]
+
+set sender_id [ad_verify_and_get_user_id $db]
+
+set role_clause [ad_decode $sendto "members" "" "and ug.role='administrator'"]
+
+set counter [database_to_tcl_string $db "
+    select count(*)
+    from user_group_map ug, users_spammable u
+	where ug.group_id = $group_id
+	$role_clause
+	and ug.user_id = u.user_id
+	and not exists ( select 1 
+	                 from group_member_email_preferences
+                         where group_id = $group_id
+	                 and user_id =  u.user_id 
+                         and dont_spam_me_p = 't')
+        and not exists ( select 1 
+	                 from user_user_bozo_filter
+                         where origin_user_id = u.user_id 
+	                 and target_user_id =  $sender_id)"]
+ 
+# generate unique key here so we can handle the "user hit submit twice" case
+set spam_id [database_to_tcl_string $db "select group_spam_id_sequence.nextval from dual"]
+
+
+set message [spam_wrap_text $message 80]
+
+
+append html "
+
+<form method=POST action=\"spam-send.tcl\">
+[export_form_vars sendto spam_id from_address subject message]
+
+<blockquote>
+
+<table border=0 cellpadding=5>
+
+<tr><th align=left>Date</th><td>$creation_date </td></tr>
+
+
+<tr><th align=left>From </th><td>$from_address</td></tr>
+
+<tr><th align=left>To </th><td>$sendto_string of $group_name group</td></tr>
+
+<tr><th align=left>Number of Recipients </th><td>$counter</td></tr>
+
+<tr><th align=left>Subject </th><td>$subject</td></tr>
+
+<tr><th align=left valign=top>Message </th><td>
+<pre>[ns_quotehtml $message]</pre>
+</td></tr>
+
+</table>
+
+</blockquote>
+
+<center>
+<input type=submit value=\"Send Email\">
+</center>
+"
+
+ns_write "
+
+<blockquote>
+$html
+</blockquote>
+
+[ad_scope_admin_footer]
+"
Index: web/openacs/www/groups/admin/group/spam-history.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/admin/group/spam-history.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/admin/group/spam-history.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,98 @@
+# spam-history.tcl,v 3.0 2000/02/06 03:46:11 ron Exp
+# File:     /groups/admin/group/spam-history.tcl
+# Date:     Mon Jan 17 13:39:51 EST 2000
+# Contact:  ahmeds@mit.edu
+# Purpose:  shows group spam history
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set group_name [ns_set get $group_vars_set group_name]
+
+set db [ns_db gethandle]
+
+if { [ad_user_group_authorized_admin  [ad_verify_and_get_user_id]  $group_id $db] != 1 } {
+    ad_return_error "Not Authorized" "You are not authorized to see this page"
+    return
+}
+
+set exception_count 0
+set exception_text ""
+
+ReturnHeaders 
+
+ns_write "
+[ad_scope_admin_header "Spam History" $db]
+[ad_scope_admin_page_title "Spam History" $db]
+[ad_scope_admin_context_bar [list "spam-index.tcl" "Spam Admin"] "History"]
+<hr>
+"
+set selection [ns_db select $db "select gsh.*, first_names, last_name , email
+from group_spam_history gsh, users u
+where gsh.group_id = $group_id
+and gsh.sender_id = u.user_id
+order by gsh.creation_date desc "]
+
+set counter 0 
+
+append html "
+<table border=1 align=center cellpadding=3>
+
+<tr>
+<th>Sender</th>
+<th>IP Address</th>
+<th>From Address</th>
+<th>Send To</th>
+<th>Subject</th>
+<th>Send Date</th>
+<th>Approval Date</th>
+<th><br>No. of Intended <br> Recipients</th>
+<th><br>No. of Actual <br> Recipients</th>
+</tr>
+"    
+
+while { [ns_db getrow $db $selection ]} {
+    set_variables_after_query
+
+    incr counter
+    
+    set approved_string [ad_decode $send_date "" "N/A" $send_date]
+    set approval_state_string [ad_decode $approved_p "f" "Disapproved"\
+	    "t" "$approved_string" "Waiting"]
+
+    set subject [ad_decode $subject "" None $subject]
+
+    append html "
+    <tr>
+    <td><a href=\"mailto:$email\">$first_names $last_name</a>
+    <td>$sender_ip_address
+    <td>$from_address
+    <td>$send_to
+    <td><a href=\"spam-item.tcl?[export_url_vars spam_id]\">$subject</a>
+    <td>$creation_date
+    <td>$approval_state_string
+    <td align=center>$n_receivers_intended
+    <td align=center>$n_receivers_actual
+    </tr>
+    "
+}
+
+
+if { $counter > 0 } {
+    append html "</table>" 
+} else {
+    set html "No Email history of $group_name group available in the database."
+}
+
+
+ns_write "
+<blockquote>
+$html
+</blockquote>
+<p><br>
+[ad_scope_admin_footer] 
+"
+
+
Index: web/openacs/www/groups/admin/group/spam-index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/admin/group/spam-index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/admin/group/spam-index.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,113 @@
+# spam-index.tcl,v 3.0 2000/02/06 03:46:12 ron Exp
+# File:     /groups/admin/group/spam-index.tcl
+# Date:     Mon Jan 17 13:39:51 EST 2000
+# Contact:  ahmeds@mit.edu
+# Purpose:  group spam administration page
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set group_name [ns_set get $group_vars_set group_name]
+
+set db [ns_db gethandle]
+
+if { [ad_user_group_authorized_admin  [ad_verify_and_get_user_id]  $group_id $db] != 1 } {
+    ad_return_error "Not Authorized" "You are not authorized to see this page"
+    return
+}
+
+
+set selection [ns_db 1row $db "
+select spam_policy
+from user_groups 
+where group_id = $group_id"]
+
+set_variables_after_query
+
+set helper_args [list "spam-policy-update-form.tcl" "Group Spam Policy"]
+
+ReturnHeaders 
+
+ns_write "
+[ad_scope_admin_header "Spam Administration" $db]
+[ad_scope_admin_page_title "Spam Administration" $db]
+[ad_scope_admin_context_bar "Spam Admin"]
+<hr>
+[help_upper_right_menu $helper_args]
+"
+
+set group_public_url [ns_set get $group_vars_set group_public_url]
+append html "
+<li><a href=/doc/group-spam.html>Documentation</a></br>
+<li><a href=$group_public_url/spam-index.tcl>User pages</a>
+"
+
+append html "
+
+<p>
+
+<b>Send Spam to </b>
+<ul>  
+    <li><a href=\"spam.tcl?sendto=members\">Group Members</a>
+    <li><a href=\"spam.tcl?sendto=administrators\">Group Administrators</a>
+</ul>
+"
+set selection [ns_db select $db "select gsh.*, first_names, last_name 
+from group_spam_history gsh, users u
+where gsh.group_id = $group_id
+and gsh.sender_id = u.user_id
+and gsh.approved_p is null
+order by gsh.creation_date "]
+
+set counter 0 
+
+set approval_html "
+<b> Spams Awaiting Approval </b>
+<ul>
+"
+
+while { [ns_db getrow $db $selection ]} {
+    set_variables_after_query
+
+    incr counter
+
+    append approval_html "
+    <li><a href=spam-item.tcl?[export_url_vars spam_id]>[util_AnsiDatetoPrettyDate $creation_date]</a> by  $first_names $last_name
+    "
+}
+
+if {$counter > 0} {
+    append approval_html "</ul>"
+    append html $approval_html
+}
+
+
+set history_count  [database_to_tcl_string $db "select count(*)
+from group_spam_history 
+where group_id = $group_id"]
+
+if { $history_count > 0 } {
+    set selection [ns_db 1row $db "select 
+    max(creation_date) as max_creation_date , 
+    min(creation_date) as min_creation_date 
+    from group_spam_history 
+    where group_id = $group_id"]
+    
+    set_variables_after_query
+    
+    append html "
+    <b> Spam History </b> [ad_space 1]
+    <a href=\"spam-history.tcl?[export_url_vars group_id]\">$history_count emails between [util_AnsiDatetoPrettyDate $min_creation_date] and [util_AnsiDatetoPrettyDate $max_creation_date]</a>
+    <p>
+    "
+}
+
+ns_write "
+<blockquote>
+$html
+</blockquote>
+
+[ad_scope_admin_footer] 
+"
Index: web/openacs/www/groups/admin/group/spam-item.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/admin/group/spam-item.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/admin/group/spam-item.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,109 @@
+# spam-item.tcl,v 3.0 2000/02/06 03:46:13 ron Exp
+# File:     /groups/admin/group/spam-item.tcl
+# Date:     Mon Jan 17 13:39:51 EST 2000
+# Contact:  ahmeds@mit.edu
+# Purpose:  shows one spam details to be approved/disapproved by the administrator
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set group_name [ns_set get $group_vars_set group_name]
+
+set_the_usual_form_variables
+# spam_id
+
+validate_integer spam_id $spam_id
+
+set db [ns_db gethandle]
+
+if { [ad_user_group_authorized_admin  [ad_verify_and_get_user_id]  $group_id $db] != 1 } {
+    ad_return_error "Not Authorized" "You are not authorized to see this page"
+    return
+}
+
+ReturnHeaders 
+
+ns_write "
+[ad_scope_admin_header "One Spam" $db]
+[ad_scope_admin_page_title "One Spam" $db]
+[ad_scope_admin_context_bar [list "spam-index.tcl" "Spam Admin"] [list "spam-history.tcl" "History"] "One Spam"]
+<hr>
+"
+
+set selection [ns_db 0or1row  $db "select gsh.*, first_names, last_name, email 
+from group_spam_history gsh, users u
+where gsh.spam_id = $spam_id
+and gsh.sender_id = u.user_id"]
+
+
+
+if { [empty_string_p $selection ]} {
+    ad_return_complaint 1 "<li>No spam with spam id $spam_id was found in the database."
+    return
+} 
+
+set_variables_after_query
+
+if { $send_to == "members" } {
+    set sendto_string "Members"
+} else {
+    set sendto_string "Administrators"
+}
+
+
+if { $approved_p == "t" } {
+    set status_string "Approved on [util_AnsiDatetoPrettyDate $send_date]"
+} elseif { $approved_p == "f" } {
+    set status_string "Disapproved [ad_space 1] 
+        \[<a href=\"spam-approve.tcl?[export_url_vars spam_id]&approved_p=t\">approve</a>\]"
+} else {
+    set status_string "Waiting for Approval [ad_space 1] 
+        \[<a href=\"spam-approve.tcl?[export_url_vars spam_id]&approved_p=t\">approve</a> | 
+          <a href=\"spam-approve.tcl?[export_url_vars spam_id]&approved_p=f\">disapprove</a>\]"
+}
+
+
+append html "
+
+<table border=0 cellpadding=3>
+
+<tr><th align=left>Submitted By </th>
+    <td><a href=\"mailto: $email\">$first_names $last_name</a></td>
+</tr>
+
+<tr><th align=left>Status</th> 
+    <td>$status_string
+</tr>
+
+<tr><td></tr><tr><td></tr>
+
+<tr><th align=left>Date</th><td>[util_AnsiDatetoPrettyDate $creation_date]</td></tr>
+
+<tr><th align=left>From </th><td>$from_address</td></tr>
+
+<tr><th align=left>To </th><td>$sendto_string of $group_name</td></tr>
+
+<tr><th align=left>No. of Intended Recipients </th><td>$n_receivers_intended</td></tr>
+
+<tr><th align=left>No. of Actual Recipients </th><td>$n_receivers_actual</td></tr>
+
+<tr><th align=left>Subject </th><td>$subject</td></tr>
+
+<tr><th align=left valign=top>Message </th><td>
+<pre>[ns_quotehtml $body]</pre>
+</td></tr>
+
+</table>
+<p>
+"
+
+ns_write "
+<blockquote>
+$html
+</blockquote>
+[ad_scope_admin_footer] 
+"
+
+
Index: web/openacs/www/groups/admin/group/spam-policy-update-form.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/admin/group/spam-policy-update-form.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/admin/group/spam-policy-update-form.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,57 @@
+# spam-policy-update-form.tcl,v 3.0 2000/02/06 03:46:15 ron Exp
+# File:     /groups/admin/group/spam-policy-update-form.tcl
+# Date:     Mon Jan 17 13:39:51 EST 2000
+# Contact:  ahmeds@mit.edu
+# Purpose:  group spam policy update form
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set group_name [ns_set get $group_vars_set group_name]
+
+set db [ns_db gethandle]
+
+if { [ad_user_group_authorized_admin  [ad_verify_and_get_user_id]  $group_id $db] != 1 } {
+    ad_return_error "Not Authorized" "You are not authorized to see this page"
+    return
+}
+
+
+set selection [ns_db 1row $db "
+select spam_policy
+from user_groups 
+where group_id = $group_id"]
+
+set_variables_after_query
+
+ReturnHeaders 
+
+ns_write "
+[ad_scope_admin_header "Group Spam Policy" $db]
+[ad_scope_admin_page_title "Group Spam Policy" $db]
+[ad_scope_admin_context_bar [list "spam-index.tcl" "Spam Admin"] "Spam Policy"]
+<hr>
+
+"
+
+append html "
+<form action=spam-policy-update.tcl method=post>
+
+<b>Group Spam Policy </b> [ad_space 1]
+<select name=spam_policy>
+[ad_generic_optionlist { open wait closed }  { open wait closed } $spam_policy]
+</select>
+<input type=submit name=submit value=\"Update\">
+</form>
+<p>
+"
+
+ns_write "
+<blockquote>
+$html
+</blockquote>
+
+[ad_scope_admin_footer] 
+"
Index: web/openacs/www/groups/admin/group/spam-policy-update.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/admin/group/spam-policy-update.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/admin/group/spam-policy-update.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,52 @@
+# spam-policy-update.tcl,v 3.0 2000/02/06 03:46:17 ron Exp
+# File:    /groups/admin/group/spam-policy-update.tcl
+# Date:    mid-1998
+# Contact: ahmeds@mit.edu
+# Purpose: sets the spam policy for the group
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_form_variables
+# spam_policy
+
+set db [ns_db gethandle]
+
+
+if { [ad_user_group_authorized_admin [ad_verify_and_get_user_id] $group_id $db] != 1 } {
+    ad_return_error "Not Authorized" "You are not authorized to see this page"
+    return
+}
+
+ns_db dml $db "
+update user_groups 
+set spam_policy = '$spam_policy' 
+where group_id = $group_id"
+
+if { $spam_policy == "open" } {
+    # grant every spam of this group waiting in the queue 
+   
+    ns_db dml $db "update group_spam_history
+                   set approved_p ='t'
+                   where group_id = $group_id
+                   and approved_p is null"
+
+    
+    ns_db releasehandle $db
+    ns_returnredirect spam-index.tcl
+    
+    ns_conn close
+    
+    ns_log Notice "/groups/admin/group/spam-policy-update.tcl:  sending all waiting spam for group $group_id"
+    send_all_group_spam_messages $group_id
+    ns_log Notice "/groups/admin/group/spam-policy-update.tcl:  sent all waiting spam for group $group_id"
+    
+} else {
+    #spam_policy = wait / closed
+    
+    ns_returnredirect spam-index.tcl
+}
+
+
Index: web/openacs/www/groups/admin/group/spam-send.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/admin/group/spam-send.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/admin/group/spam-send.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,83 @@
+# spam-send.tcl,v 3.1 2000/02/14 23:42:36 ahmeds Exp
+# File:     /groups/admin/group/spam-send.tcl
+# Date:     Mon Jan 17 13:39:51 EST 2000
+# Contact:  ahmeds@mit.edu
+# Purpose:  sends one spam 
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+# spam_id sendto subject message 
+
+validate_integer spam_id $spam_id
+
+set db [ns_db gethandle]
+
+if { [ad_user_group_authorized_admin  [ad_verify_and_get_user_id]  $group_id $db] != 1 } {
+    ad_return_error "Not Authorized" "You are not authorized to see this page"
+    return
+}
+
+set user_id [ad_verify_and_get_user_id $db]
+
+set role_clause [ad_decode $sendto "members" "" "and ug.role='administrator'"]
+
+set n_receivers_intended [database_to_tcl_string $db "
+    select count(*)
+    from user_group_map ug, users_spammable u
+	where ug.group_id = $group_id
+	$role_clause
+	and ug.user_id = u.user_id
+	and not exists ( select 1 
+	                 from group_member_email_preferences
+                         where group_id = $group_id
+	                 and user_id =  u.user_id 
+                         and dont_spam_me_p = 't')
+        and not exists ( select 1 
+	                 from user_user_bozo_filter
+                         where origin_user_id = u.user_id 
+	                 and target_user_id =  $user_id)"]
+
+
+if [catch { ns_db dml $db "insert into group_spam_history
+            ( spam_id, group_id, from_address, approved_p, subject, 
+              body, send_date,  creation_date, sender_id,
+              sender_ip_address, send_to,
+              n_receivers_intended, n_receivers_actual)
+            values
+              ($spam_id, $group_id, '$QQfrom_address', 't', '$QQsubject', 
+               '[DoubleApos $message]', null, [db_sysdate], $user_id, 
+               '[DoubleApos [ns_conn peeraddr]]', '$QQsendto', 
+               $n_receivers_intended ,0)"} errmsg] {
+    
+    # choked; let's see if it is because 
+    if { [database_to_tcl_string $db "select count(*)
+    from group_spam_history 
+    where spam_id = $spam_id"] > 0 } {
+	# double click
+	ns_returnredirect spam-index.tcl
+    } else {
+	ad_return_error "Ouch!"\
+		"The database choked on your insert:
+	<blockquote>
+	$errmsg
+	</blockquote>
+		      "
+    } 
+    return
+}
+
+ns_db releasehandle $db
+ns_returnredirect spam-index.tcl
+
+ns_conn close
+
+ns_log Notice "/groups/admin/group/spam-send.tcl:  sending group spam $spam_id"
+send_one_group_spam_message $spam_id
+ns_log Notice "/groups/admin/group/spam-send.tcl: group spam $spam_id sent"
+
+	  
+	
Index: web/openacs/www/groups/admin/group/spam.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/admin/group/spam.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/admin/group/spam.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,89 @@
+# spam.tcl,v 3.3 2000/03/09 10:47:29 hqm Exp
+# File:     /groups/admin/group/spam.tcl
+# Date:     Mon Jan 17 13:39:51 EST 2000
+# Contact:  ahmeds@mit.edu
+# Purpose:  this is the group spam page
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables
+# sendto
+
+set group_name [ns_set get $group_vars_set group_name]
+
+set sendto_string [ad_decode $sendto "members" "Group Members" "Group Administrators"]
+
+set db [ns_db gethandle]
+
+if { [ad_user_group_authorized_admin  [ad_verify_and_get_user_id]  $group_id $db] != 1 } {
+    ad_return_error "Not Authorized" "You are not authorized to see this page"
+    return
+}
+
+ReturnHeaders 
+
+ns_write "
+[ad_scope_admin_header "Send Email to $sendto_string" $db]
+[ad_scope_admin_page_title "Email to $sendto_string " $db]
+[ad_scope_admin_context_bar [list "spam-index.tcl" "Spam Admin"] "Spam $sendto_string"]
+<hr>
+"
+
+
+set default_msg "
+Dear <first_names>,
+"
+
+append html "
+<form method=POST action=\"spam-confirm.tcl\">
+[export_form_vars sendto]
+<table>
+
+<tr><th align=left>From:</th>
+<td><input name=from_address type=text size=20 
+value=\"[database_to_tcl_string $db "select email from users where user_id =[ad_get_user_id]"]\"></td></tr>
+
+<tr><th align=left>Subject:</th><td><input name=subject type=text size=40></td></tr>
+
+<tr><th align=left valign=top>Message:</th><td>
+<textarea name=message rows=10 cols=60 wrap=soft>$default_msg</textarea>
+</td></tr>
+
+</table>
+
+<center>
+
+<input type=submit value=\"Proceed\">
+
+</center>
+
+</form>
+<p>
+
+
+<table >
+<tr>
+<th colspan=3 >The following variables can be used to be replaced with user/group specific data :
+</tr>
+<tr><td>
+<tr><td>&#60first_names&#62 <td> = <td>User's First Name</tr>
+<tr><td>&#60last_name&#62   <td> = <td>User's Last Name</tr>
+<tr><td>&#60email&#62  <td> = <td> User's Email</tr>
+<tr><td>&#60group_name&#62<td> = <td>Group Name</tr>
+<tr><td>&#60admin_email&#62<td> = <td>Group's Administrative Email</tr>
+</table>
+
+<br>
+"
+
+ns_write "
+
+<blockquote>
+$html
+</blockquote>
+
+[ad_scope_admin_footer]
+"
Index: web/openacs/www/groups/group/edit-preference.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/group/edit-preference.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/group/edit-preference.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,33 @@
+# edit-preference.tcl,v 3.0 2000/02/06 03:46:21 ron Exp
+set_the_usual_form_variables 0
+# dont_spam_me_p
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set db [ns_db gethandle]
+set user_id [ad_verify_and_get_user_id $db]
+
+ad_scope_authorize $db $scope all group_member none
+
+set counter [database_to_tcl_string  $db "
+select count(*) 
+from group_member_email_preferences
+where group_id = $group_id
+and user_id = $user_id "]
+
+if { $counter == 0 } {
+    ns_db dml $db "insert into group_member_email_preferences
+    (group_id, user_id, dont_spam_me_p)
+    values 
+    ($group_id, $user_id, '$dont_spam_me_p')"
+} else {
+    ns_db dml $db "update group_member_email_preferences
+    set dont_spam_me_p = '$dont_spam_me_p'
+    where group_id=$group_id
+    and user_id=$user_id"
+}
+
+ns_returnredirect "spam-index.tcl"
\ No newline at end of file
Index: web/openacs/www/groups/group/help.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/group/help.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/group/help.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,15 @@
+# help.tcl,v 3.0 2000/02/06 03:46:23 ron Exp
+# File: /groups/group/help.tcl
+# Date: 01/24/2000
+# Contact: tarik@arsdigita.com
+# Purpose: displays help files
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+# this page has same functionality as /help/for-one-page.tcl, so we can 
+# simply use source command
+source [ns_info pageroot]/help/for-one-page.tcl
+
Index: web/openacs/www/groups/group/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/group/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/group/index.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,178 @@
+# index.tcl,v 3.1.2.1 2000/03/14 05:10:01 tarik Exp
+# File: /groups/group/index.tcl
+# Date: mid-1998
+# Contact: teadams@arsdigita.com, tarik@arsdigita.com
+# Purpose: this is the group public page
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set user_id [ad_get_user_id]
+
+set group_name [ns_set get $group_vars_set group_name]
+set group_public_url [ns_set get $group_vars_set group_public_url]
+set group_admin_url [ns_set get $group_vars_set group_admin_url]
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "
+select ug.approved_p, ug.creation_user, ug.registration_date,  ug.group_type, 
+       ug.new_member_policy, u.first_names, u.last_name
+from user_groups ug, users u
+where group_id = $group_id
+and ug.creation_user = u.user_id"]
+set_variables_after_query
+
+ReturnHeaders 
+
+if { $approved_p == "f" } {
+    ns_write "
+    [ad_scope_header "Main Page" $db]
+    [ad_scope_page_title "Main Page" $db]
+    [ad_scope_context_bar_ws_or_index $group_name] 
+    <hr>
+    <blockquote>
+    <font color=red>this group is awaiting approval by [ad_system_owner]</font>
+    </blockquote>
+    [ad_scope_footer]
+    "
+    return
+}
+
+append page_top "
+[ad_scope_header "Main Page" $db]
+[ad_scope_page_title "Main Page" $db]
+[ad_scope_context_bar_ws_or_index $group_name] 
+<hr>
+"
+
+if { [ad_user_group_authorized_admin $user_id $group_id $db] && ![empty_string_p $group_admin_url] } {
+    append page_top [help_upper_right_menu [list "$group_admin_url/" "Administration Page"]]
+}
+
+ns_write $page_top
+
+# get group sections 
+set selection [ns_db select $db "
+select section_key, section_pretty_name, section_type
+from content_sections 
+where scope='group' 
+and group_id=$group_id
+and (section_type='static' or
+     section_type='custom' or
+     (section_type='system' and module_key!='custom-sections'))
+and enabled_p='t'
+order by sort_key
+"]
+
+set system_section_counter 0
+set non_system_section_counter 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    if { [string compare $section_type system]==0 } {
+    
+	append system_sections_html "
+	<a href=[ad_urlencode $section_key]/>$section_pretty_name</a><br>
+	"    
+	incr system_section_counter
+    } else {
+	append non_system_sections_html "
+	<a href=[ad_urlencode $section_key]/>$section_pretty_name</a><br>
+	"    
+	incr non_system_section_counter
+    }
+
+}
+
+append system_sections_html "
+<a href=\"spam-index.tcl\">Email</a><br>
+"
+incr system_section_counter
+
+
+if { [expr $system_section_counter + $non_system_section_counter]>0 } {
+    append html "
+    <h4>Sections</h4>
+    "
+    
+    if { $system_section_counter>0 } {
+	append html "
+	$system_sections_html
+	"
+    }
+
+    if { $non_system_section_counter>0 } {
+	append html "
+	<br>
+	$non_system_sections_html
+	"
+    }
+
+}
+
+# let's look for administrators
+
+set selection [ns_db select $db "select user_id as admin_user_id, first_names || ' ' || last_name as name
+from users 
+where ad_user_has_role_p ( user_id, $group_id, 'administrator' ) = 't'"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append administrator_items "<a href=\"/shared/community-member.tcl?user_id=$admin_user_id\">$name</a><br>\n"
+}
+
+if [info exists administrator_items] {
+    append html "<h4>Group Administrators</h4>\n\n$administrator_items\n"
+}
+
+if { $user_id == 0 } {
+    if { $new_member_policy != "closed" } {
+	# there is at least some possibility of a member joining
+	append html "If you want to join this group, you'll need to <a href=\"/register.tcl?return_url=[ad_urlencode "$group_public_url/member-add.tcl"]\">log in </a>."
+    }
+} else {
+    # the user is logged in
+    if { [string compare [database_to_tcl_string $db "select ad_group_member_p ( $user_id, $group_id ) from dual"] "t"] == 0 } {
+	# user is already a member
+	append html "<br>You are a member of this group.  You can <a href=\"member-remove.tcl\">remove yourself</a>."
+    } else {
+	switch $new_member_policy {
+	    "open"  { 
+		append html "<h4>Join</h4>
+		This group has an open enrollment policy.  You can simply
+		<a href=\"member-add.tcl\">sign up</a>."
+	    }
+	    "wait"  {
+		append html "<h4>Join</h4>
+		The administrator approves users who wish to end this group.
+		<a href=\"member-add.tcl\">Submit your name for approval</a>."
+	    }
+	    "closed" {
+		append html "
+		This group has closed membership policy. You cannot become a member of this group."
+	    }
+	} 
+    }
+}
+
+ns_write "
+<blockquote>
+$html
+</blockquote>
+[ad_style_bodynote "Created by <a href=\"/shared/community-member.tcl?user_id=$creation_user\">$first_names $last_name</a> on [util_AnsiDatetoPrettyDate $registration_date]"]
+[ad_scope_footer]
+"
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/groups/group/index.tcl,v
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/group/index.tcl,v,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/group/index.tcl,v	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,217 @@
+head	1.2;
+access;
+symbols;
+locks; strict;
+comment	@# @;
+
+
+1.2
+date	2000.01.08.02.08.37;	author tarik;	state Exp;
+branches;
+next	1.1;
+
+1.1
+date	2000.01.08.00.22.42;	author tarik;	state Exp;
+branches;
+next	;
+
+
+desc
+@@
+
+
+1.2
+log
+@*** empty log message ***
+@
+text
+@# File: /groups/group/index.tcl
+# Date: mid-1998
+# Contact: teadams@@arsdigita.com, tarik@@arsdigita.com
+# Purpose: this is the group public page
+#
+# Note: group_id, group_name, short_name, admin_email, scope, ug_navbar_list and ug_context_bar_list
+#       are already set up in the environment by the ug_serve_section
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "
+select ug.approved_p, ug.creation_user, ug.registration_date,  ug.group_type, 
+       ug.new_member_policy, u.first_names, u.last_name
+from user_groups ug, users u
+where group_id = $group_id
+and ug.creation_user = u.user_id"]
+set_variables_after_query
+
+
+
+ReturnHeaders 
+
+ns_write "
+[ug_header "Main Page" $db $group_id]
+[ug_page_title "Main Page" $db $group_id $group_name]
+[ad_scope_context_bar_ws_or_index $group_name] 
+<hr>
+
+"
+
+if { $approved_p == "f" } {
+    append html "
+    <blockquote>
+    <font color=red>this group is awaiting approval by [ad_system_owner]</font>
+    </blockquote>
+    [ug_footer $admin_email]
+    "
+}
+
+
+# get group sections 
+
+set selection [ns_db select $db "
+select section_key, section_pretty_name, section_type
+from content_sections
+where scope='group' 
+and group_id=$group_id
+and section_type!='admin'
+and module_key!='custom-sections'
+and enabled_p='t'
+order by sort_key
+"]
+
+set system_section_counter 0
+set non_system_section_counter 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    if { [string compare $section_type system]==0 } {
+    
+	append system_sections_html "
+	<a href=[ad_urlencode $section_key]/>$section_pretty_name</a><br>
+	"    
+	incr system_section_counter
+    } else {
+	append non_system_sections_html "
+	<a href=[ad_urlencode $section_key]/>$section_pretty_name</a><br>
+	"    
+	incr non_system_section_counter
+    }
+
+}
+
+if { [expr $system_section_counter + $non_system_section_counter]>0 } {
+    append html "
+    <h4>Sections</h4>
+    "
+    
+    if { $system_section_counter>0 } {
+	append html "
+	$system_sections_html
+	"
+    }
+
+    if { $non_system_section_counter>0 } {
+	append html "
+	<br>
+	$non_system_sections_html
+	"
+    }
+
+    append html "
+    <p>
+    "
+}
+
+# let's look for administrators
+
+set selection [ns_db select $db "select map.user_id, first_names || ' ' || last_name as name
+from user_group_map map, users 
+where map.user_id = users.user_id
+and role = 'administrator'
+and group_id=$group_id"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append administrator_items "<a href=\"/shared/community-member.tcl?user_id=$user_id\">$name</a><br>\n"
+}
+
+if [info exists administrator_items] {
+    append html "<h4>Group Administrators</h4>\n\n$administrator_items\n"
+}
+
+set user_id [ad_get_user_id]
+
+if { $user_id == 0 } {
+    if { $new_member_policy != "closed" } {
+	# there is at least some possibility of a member joining
+	append html "If you want to join this group, you'll need to <a href=\"/register.tcl?return_url=[ad_urlencode "[ug_url]/[ad_urlencode $short_name]/member-add.tcl"]\">log in </a>."
+    }
+} else {
+    # the user is logged in
+    if { [database_to_tcl_string $db "select count(*) from user_group_map where group_id = $group_id and user_id = $user_id"] > 0 } {
+	# user is already a member
+	append html "<br>You are a member of this group.  You can <a href=\"member-remove.tcl\">remove yourself</a>."
+    } else {
+	switch $new_member_policy {
+	    "open"  { 
+		append html "<h4>Join</h4>
+		This group has an open enrollment policy.  You can simply
+		<a href=\"member-add.tcl\">sign up</a>."
+	    }
+	    "wait"  {
+		append html "<h4>Join</h4>
+		The administrator approves users who wish to end this group.
+		<a href=\"member-add.tcl\">Submit your name for approval</a>."
+	    }
+	    "closed" {
+		append html "
+		This group has closed membership policy. You cannot become a member of this group."
+	    }
+	} 
+    }
+}
+
+set user_id [ad_verify_and_get_user_id] 
+
+set helper_args ""
+
+if { [ad_user_group_authorized_admin $user_id $group_id $db] == 1 } {
+   append helper_args [list "[ug_admin_url]/[ad_urlencode $short_name]/" "Administration page"]
+    
+}
+
+
+
+ns_write "
+[help_upper_right_menu $helper_args]
+<blockquote>
+$html
+</blockquote>
+
+[ad_style_bodynote "Created by <a href=\"/shared/community-member.tcl?user_id=$creation_user\">$first_names $last_name</a> on [util_AnsiDatetoPrettyDate $registration_date]"]
+
+[ug_footer $admin_email]
+"
+
+
+
+
+
+
+
+
+
+
+
+@
+
+
+1.1
+log
+@Initial revision
+@
+text
+@d45 1
+a45 1
+from content_sections_temp 
+d51 1
+@
Index: web/openacs/www/groups/group/member-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/group/member-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/group/member-add.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,117 @@
+# member-add.tcl,v 3.1.2.1 2000/03/30 10:21:15 carsten Exp
+# File: /groups/group/member-add.tcl
+# Date: mid-1998
+# Contact: teadams@arsdigita.com, tarik@arsdigita.com
+# Purpose: adds the mebmer to the group
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set group_name [ns_set get $group_vars_set group_name]
+set group_public_url [ns_set get $group_vars_set group_public_url]
+
+set local_user_id [ad_get_user_id]
+
+if {$local_user_id == 0} {
+   ns_returnredirect "/register.tcl?return_url=[ad_urlencode $group_public_url/member-add.tcl]"
+    return
+}
+
+# send email to all admins of this group
+proc notify_group_admins {db group_id subject message {from "system@arsdigita.com"}} {
+
+    set selection [ns_db select $db "
+    SELECT email FROM users WHERE ad_user_has_role_p ( user_id, $group_id, 'administrator' ) = 't'"]
+
+    while { [ns_db getrow $db $selection] } { 
+	set_variables_after_query
+	if [catch { ns_sendmail $email $from $subject $message "" [ad_system_owner] } errmsg] {
+	    # failed
+	    ns_log Notice "Failed to send group $group_id membership request alert to admin $email:  $errmsg"
+	} else {
+	    # succeeded
+	    ns_log Notice "Send new group $group_id membership request alert to $email."
+	}
+    }
+}
+
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "
+select new_member_policy, email_alert_p from user_groups where group_id = $group_id"]
+set_variables_after_query
+
+set selection [ns_db 1row $db "
+select email, first_names, last_name from users where user_id = [ad_get_user_id]"]
+set_variables_after_query
+
+if { $new_member_policy == "closed" } {
+    ad_return_error "Group Closed" "You can't sign yourself up to this group.  Only [ad_system_owner] can add you."
+} elseif { $new_member_policy == "wait" } {
+    ns_db dml $db "
+insert into user_group_map_queue (group_id, user_id, ip_address, queue_date)
+select $group_id, $local_user_id, '[ns_conn peeraddr]', [db_sysdate]
+where not exists (select user_id from user_group_map_queue where user_id = $local_user_id and group_id = $group_id)"
+
+if {[string match "t" $email_alert_p]} {
+    notify_group_admins $db $group_id "User [ad_get_user_id] has requested membership in group $group_name" "A user has requested membership in group $group_name.
+
+user_id: [ad_get_user_id]
+  email: $email
+   name: $first_names $last_name" 
+}
+
+
+ns_return 200 text/html "
+[ad_scope_header "Queued" $db]
+
+<h2>Queued</h2>
+
+<hr>
+
+Your request to join 
+<a href=\"$group_public_url/\">$group_name</a> has been queued
+for approval by the group administrators.
+You can return now 
+to [ad_pvt_home_link].
+
+[ad_scope_footer]
+"
+
+
+} elseif { $new_member_policy == "open" } {
+    ns_db dml $db "
+insert into user_group_map 
+(group_id, user_id, role, mapping_user, mapping_ip_address)
+select $group_id, $local_user_id, 'selfenrolled', $local_user_id, '[ns_conn peeraddr]' from dual where ad_user_has_role_p ( $local_user_id, $group_id, 'selfenrolled' ) <> 't'"
+
+ns_return 200 text/html "
+[ad_scope_header "Success" $db]
+
+<h2>Success</h2>
+
+add you to <a
+href=\"$group_public_url/\">$group_name</a>.
+
+<hr>
+
+There isn't much more to say.  You can return now 
+to [ad_pvt_home_link].
+
+[ad_footer]
+"
+} else {
+    ad_return_error "Don't understand policy" "We don't understand $group_name's approval policy:  $new_member_policy.  This is presumably a programming bug."
+}
+
+
+
+
Index: web/openacs/www/groups/group/member-remove.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/group/member-remove.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/group/member-remove.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,46 @@
+# member-remove.tcl,v 3.0 2000/02/06 03:46:27 ron Exp
+# File: /groups/group/member-remove.tcl
+# Date: mid-1998
+# Contact: teadams@arsdigita.com, tarik@arsdigita.com
+# Purpose: removes the mebmer from the group
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set group_name [ns_set get $group_vars_set group_name]
+set group_public_url [ns_set get $group_vars_set group_public_url]
+
+set user_id [ad_get_user_id]
+
+if {$user_id == 0} {
+   ns_returnredirect "/register.tcl?return_url=[ad_urlencode $group_public_url/member-remove.tcl]"
+    return
+}
+
+set db [ns_db gethandle]
+
+ns_db dml $db "
+delete from user_group_map where group_id = $group_id and user_id = $user_id
+"
+
+ns_return 200 text/html "
+[ad_scope_header "Success" $db]
+
+<h2>Success</h2>
+
+removing you from <a href=\"$group_public_url/\">$group_name</a>
+
+<hr>
+
+There isn't much more to say.  You can return now 
+to [ad_pvt_home_link]
+
+[ad_scope_footer]
+"
Index: web/openacs/www/groups/group/spam-confirm.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/group/spam-confirm.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/group/spam-confirm.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,123 @@
+# File: /groups/group/spam-confirm.tcl
+# Date: Fri Jan 14 19:27:42 EST 2000
+# Contact: ahmeds@mit.edu
+# Purpose: this is the group spam confirm page
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+#
+# spam-confirm.tcl,v 3.3 2000/03/12 09:48:47 hqm Exp
+
+set_the_usual_form_variables 0
+# sendto subject message
+
+set group_name [ns_set get $group_vars_set group_name]
+
+set db [ns_db gethandle]
+
+ad_scope_authorize $db $scope all group_member none
+
+set exception_count 0
+set exception_text ""
+
+if {[empty_string_p $subject] && [empty_string_p $message]} {
+    incr exception_count
+    append exception_text "<li>The contents of your message and subject line is the empty string. <br> You must send something in the message body or subject line."
+}
+
+
+if {$exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+set sendto_string [ad_decode $sendto "members" "Members" "Administrators"]
+
+
+ReturnHeaders 
+
+ns_write "
+[ad_scope_header "Confirm Sending Email" $db]
+[ad_scope_page_title "Confirm Email to Group $sendto_string" $db]
+[ad_scope_context_bar_ws_or_index [list index.tcl $group_name] [list spam-index.tcl "Email"] [list "spam.tcl?[export_url_vars sendto]"  "Group $sendto_string"] Confirm]
+<hr>
+"
+
+set creation_date [database_to_tcl_string $db "select to_char(sysdate(), 'DDth Month,YYYY  HH:MI:SS am') from dual"]
+
+set sender_id [ad_verify_and_get_user_id $db]
+
+set role_clause [ad_decode $sendto "members" "" "and ug.role='administrator'"]
+
+set counter [database_to_tcl_string $db "
+    select count(*)
+    from user_group_map ug, users_spammable u
+	where ug.group_id = $group_id
+	$role_clause
+	and ug.user_id = u.user_id
+	and not exists ( select 1 
+	                 from group_member_email_preferences
+                         where group_id = $group_id
+	                 and user_id =  u.user_id 
+                         and dont_spam_me_p = 't')
+        and not exists ( select 1 
+	                 from user_user_bozo_filter
+                         where origin_user_id = u.user_id 
+	                 and target_user_id =  $sender_id)"]
+ 
+# generate unique key here so we can handle the "user hit submit twice" case
+set spam_id [database_to_tcl_string $db "select group_spam_id_sequence.nextval from dual"]
+
+# strips ctrl-m's, makes linebreaks at >= 80 cols when possible, without
+# destroying urls or other long strings
+set message [spam_wrap_text $message 80]
+
+append html "
+
+<form method=POST action=\"spam-send.tcl\">
+[export_form_vars sendto spam_id from_address subject message]
+
+<blockquote>
+
+<table border=0 cellpadding=5 >
+
+<tr><th align=left>Date</th><td>$creation_date </td></tr>
+
+<tr><th align=left>To </th><td>$sendto_string of $group_name group</td></tr>
+<tr><th align=left>From </th><td>$from_address</td></tr>
+
+
+<tr><th align=left>Subject </th><td>$subject</td></tr>
+
+<tr><th align=left valign=top>Message </th><td>
+<pre>[ns_quotehtml $message]</pre>
+</td></tr>
+
+<tr><th align=left>Number of recipients </th><td>$counter</td></tr>
+
+</table>
+
+</blockquote>
+<center>
+<input type=submit value=\"Send Email\">
+
+</center>
+"
+
+
+ns_write "
+
+<blockquote>
+$html
+</blockquote>
+
+[ad_scope_footer]
+"
+
+
+
+
+
+
Index: web/openacs/www/groups/group/spam-history.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/group/spam-history.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/group/spam-history.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,121 @@
+# spam-history.tcl,v 3.0 2000/02/06 03:46:29 ron Exp
+# File: /groups/group/spam-history.tcl
+# Date: Fri Jan 14 19:27:42 EST 2000
+# Contact: ahmeds@mit.edu
+# Purpose: this page generates the spam history of this user
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+# user_id 
+
+validate_integer user_id $user_id
+
+set group_name [ns_set get $group_vars_set group_name]
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope all group_member none
+
+set exception_count 0
+set exception_text ""
+
+if {[empty_string_p $user_id] && [empty_string_p $user_id]} {
+    incr exception_count
+    append exception_text "
+    <li>No user id was passed"
+}
+
+
+if {$exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+set first_names [database_to_tcl_string $db "
+select first_names 
+from users
+where user_id=$user_id "]
+
+set last_name [database_to_tcl_string $db "
+select last_name
+from users
+where user_id=$user_id "]
+
+ReturnHeaders 
+
+ns_write "
+[ad_scope_header "Email History" $db]
+[ad_scope_page_title "Email History of $first_names $last_name" $db]
+[ad_scope_context_bar_ws_or_index [list index.tcl $group_name] [list spam-index.tcl "Email"] "History"]
+<hr>
+"
+set selection [ns_db select $db "select *
+from group_spam_history
+where sender_id = $user_id
+and group_id = $group_id 
+order by creation_date desc"]
+
+set counter 0
+
+append html "
+<table border=1 align=center cellpadding=3>
+
+<tr>
+<th>IP Address</th>
+<th>From Address</th>
+<th>Send To</th>
+<th>title</th>
+<th>Send Date</th>
+<th>Approval Date</th>
+<th><br>No. of Intended <br> Recipients</th>
+<th><br>No. of Actual <br> Recipients</th>
+</tr>
+"    
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    
+    incr counter
+    
+    set approved_string [ad_decode $send_date "" "N/A" $send_date]
+    set approval_state_string [ad_decode $approved_p "f" "Disapproved"\
+	    "t" "$approved_string" "Waiting"]
+
+    set subject [ad_decode $subject "" None $subject]
+
+    append html "
+    <tr>
+    <td>$sender_ip_address
+    <td>$from_address
+    <td>$send_to
+    <td><a href=\"spam-item.tcl?[export_url_vars spam_id]\">$subject</a>
+    <td>$creation_date
+    <td>$approval_state_string
+    <td align=center>$n_receivers_intended
+    <td align=center>$n_receivers_actual
+    </tr>
+    "
+}
+
+if { $counter > 0 } {
+    append html "</table>" 
+} else {
+    set html "No Email history of $first_names $last_name for $group_name group available in the database."
+}
+
+ns_write "
+
+<blockquote>
+$html
+</blockquote>
+<p><br>
+[ad_scope_footer]
+"
+
+
+
+
+
+
Index: web/openacs/www/groups/group/spam-index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/group/spam-index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/group/spam-index.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,102 @@
+# spam-index.tcl,v 3.0 2000/02/06 03:46:30 ron Exp
+# File: /groups/group/spam-index.tcl
+# Date: Fri Jan 14 19:27:42 EST 2000
+# Contact: ahmeds@mit.edu
+# Purpose: this is the group spam main page
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set group_name [ns_set get $group_vars_set group_name]
+
+set db [ns_db gethandle]
+set user_id [ad_verify_and_get_user_id $db]
+
+ad_scope_authorize $db $scope all group_member none
+
+set counter [database_to_tcl_string $db "
+select count(*)
+from group_member_email_preferences
+where group_id = $group_id
+and user_id = $user_id "]
+
+if { $counter == 0 } {
+    set dont_spam_me_p f
+} else {
+    set dont_spam_me_p [database_to_tcl_string $db "
+    select dont_spam_me_p 
+    from group_member_email_preferences
+    where group_id = $group_id
+    and user_id = $user_id "] 
+}
+
+ReturnHeaders 
+
+ns_write "
+[ad_scope_header "Email" $db]
+[ad_scope_page_title "Email" $db]
+[ad_scope_context_bar_ws_or_index [list index.tcl $group_name] Email]
+<hr>
+"
+
+append html "
+
+<b>Send Email To</b>
+<ul>
+    <li><a href=\"spam.tcl?sendto=members\">Group Members</a>
+    <li><a href=\"spam.tcl?sendto=administrators\">Group Administrators</a>
+</ul>
+
+<p>
+<li>Email Preference[ad_space 1]
+<font size=-1>
+[generic_navbar [list "Receive Group Emails" "Don't Spam Me" ]\
+	        [list "edit-preference.tcl?dont_spam_me_p=f" "edit-preference.tcl?dont_spam_me_p=t"]\
+		[list "f" "t"]  $dont_spam_me_p]
+</font>
+"
+set history_count  [database_to_tcl_string $db "select count(*)
+from group_spam_history 
+where group_id = $group_id
+and sender_id = $user_id"]
+
+if { $history_count > 0 } {
+
+    set selection [ns_db 1row $db "select 
+    max(creation_date) as max_creation_date , 
+    min(creation_date) as min_creation_date 
+    from group_spam_history 
+    where group_id = $group_id
+    and sender_id = $user_id"]
+    
+    set_variables_after_query
+    
+    append html "
+    <p>
+    <li>Email History </b> [ad_space 1]
+    <a href=\"spam-history.tcl?[export_url_vars user_id]\">$history_count emails between [util_AnsiDatetoPrettyDate $min_creation_date] and [util_AnsiDatetoPrettyDate $max_creation_date]</a>
+    <p>
+    "
+}
+
+ns_write "
+
+<blockquote>
+$html
+</blockquote>
+
+[ad_scope_footer]
+"
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/groups/group/spam-item.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/group/spam-item.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/group/spam-item.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,108 @@
+# spam-item.tcl,v 3.0 2000/02/06 03:46:31 ron Exp
+# File: /groups/group/spam-item.tcl
+# Date: Fri Jan 14 19:27:42 EST 2000
+# Contact: ahmeds@mit.edu
+# Purpose: shows one spam details 
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+# spam_id 
+
+validate_integer spam_id $spam_id
+
+set group_name [ns_set get $group_vars_set group_name]
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope all group_member none
+
+set exception_count 0
+set exception_text ""
+
+if {[empty_string_p $spam_id] && [empty_string_p $spam_id]} {
+    incr exception_count
+    append exception_text "
+    <li>No spam id was passed"
+}
+
+
+if {$exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+set user_id [ad_verify_and_get_user_id]
+
+ReturnHeaders 
+
+ns_write "
+[ad_scope_header "One Email" $db]
+[ad_scope_page_title "One Email " $db]
+[ad_scope_context_bar_ws_or_index [list index.tcl $group_name]\
+    [list spam-index.tcl "Email"] [list spam-history.tcl?[export_url_vars user_id] "History"] "One Email"] 
+<hr>
+"
+
+set selection [ns_db 0or1row  $db "select *
+from group_spam_history 
+where spam_id = $spam_id"]
+
+if { [empty_string_p $selection ]} {
+    ad_return_complaint 1 "<li>No spam with spam id $spam_id was found in the database."
+    return
+} 
+
+set_variables_after_query
+
+if { $send_to == "members" } {
+    set sendto_string "Members"
+} else {
+    set sendto_string "Administrators"
+}
+
+set status_string [ad_decode $approved_p "t" "Approved on [util_AnsiDatetoPrettyDate $send_date]"\
+	"f" "Disapproved" "Waiting for Approval"]
+
+append html "
+
+<table border=0 cellpadding=3>
+
+<tr><th align=left>Status</th> 
+    <td>$status_string
+</tr>
+
+<tr><th align=left>Date</th><td>[util_AnsiDatetoPrettyDate $creation_date]</td></tr>
+
+<tr><th align=left>From </th><td>$from_address</td></tr>
+
+<tr><th align=left>To </th><td>$sendto_string of $group_name</td></tr>
+
+<tr><th align=left>No. of Intended Recipients </th><td>$n_receivers_intended</td></tr>
+
+<tr><th align=left>No. of Actual Recipients </th><td>$n_receivers_actual</td></tr>
+
+<tr><th align=left>Subject </th><td>$subject</td></tr>
+
+<tr><th align=left valign=top>Message </th><td>
+<pre>[ns_quotehtml $body]</pre>
+</td></tr>
+
+</table>
+"
+ns_write "
+
+<blockquote>
+$html
+</blockquote>
+
+[ad_scope_footer]
+"
+
+
+
+
+
+
Index: web/openacs/www/groups/group/spam-send.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/group/spam-send.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/group/spam-send.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,98 @@
+# File: /groups/group/spam-send.tcl
+# Date: Fri Jan 14 19:27:42 EST 2000
+# Contact: ahmeds@mit.edu
+# Purpose: sends the spam
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+#
+# spam-send.tcl,v 3.2 2000/02/20 10:49:16 ron Exp
+
+set_the_usual_form_variables 0
+# spam_id sendto subject message 
+
+validate_integer spam_id $spam_id
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope all group_member none
+
+set user_id [ad_verify_and_get_user_id $db]
+
+set role_clause [ad_decode $sendto "members" "" "and ug.role='administrator'"]
+
+set n_receivers_intended [database_to_tcl_string $db "
+    select count(*)
+    from user_group_map ug, users_spammable u
+	where ug.group_id = $group_id
+	$role_clause
+	and ug.user_id = u.user_id
+	and not exists ( select 1 
+	                 from group_member_email_preferences
+                         where group_id = $group_id
+	                 and user_id =  u.user_id 
+                         and dont_spam_me_p = 't')
+        and not exists ( select 1 
+	                 from user_user_bozo_filter
+                         where origin_user_id = u.user_id 
+	                 and target_user_id =  $user_id)"]
+
+set spam_policy [database_to_tcl_string $db "select spam_policy
+                                            from user_groups
+                                            where group_id = $group_id"]
+  
+set approved_p [ad_decode $spam_policy "open" "'t'" "closed" "'f'" null]
+set approved_p [ad_decode $role_clause "and ug.role='administrator'" "'t'" $approved_p]
+
+if [catch { ns_db dml $db "insert into group_spam_history
+            ( spam_id, group_id, from_address, approved_p, subject, 
+              body, send_date,  creation_date, sender_id,
+              sender_ip_address, send_to,
+              n_receivers_intended, n_receivers_actual)
+            values
+              ($spam_id, $group_id, '$QQfrom_address', $approved_p, '$QQsubject', 
+               '[DoubleApos $message]', null, sysdate(), $user_id, 
+               '[DoubleApos [ns_conn peeraddr]]', '$QQsendto', 
+               $n_receivers_intended ,0)"} errmsg] {
+    
+    # choked; let's see if it is because 
+    if { [database_to_tcl_string $db "select count(*)
+    from group_spam_history 
+    where spam_id = $spam_id"] > 0 } {
+	ns_return 200 text/html "
+	[ad_scope_header "Double Click?" $db]
+	[ad_scope_page_title "Double Click?" $db]
+	<hr>
+	
+	This spam has already been sent.  
+	Perhaps you double clicked?  
+	In any case, you can check the progress of this spam on
+	<a href=\"spam-item.tcl?[export_url_vars spam_id]\">the history page</a>.
+	
+	[ad_scope_footer]"
+    } else {
+	ad_return_error "Ouch!"\
+		"The database choked on your insert:
+	<blockquote>
+	$errmsg
+	</blockquote>
+		      "
+    } 
+    return
+}
+
+ns_db releasehandle $db
+ns_returnredirect spam-index.tcl
+
+ns_conn close
+
+ns_log Notice "/groups/group/spam-send.tcl:  sending group spam $spam_id"
+send_one_group_spam_message $spam_id
+ns_log Notice "/groups/group/spam-send.tcl: group spam $spam_id sent"
+
+	  
+	  
+
+
+
Index: web/openacs/www/groups/group/spam.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/groups/group/spam.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/groups/group/spam.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,131 @@
+# File: /groups/group/spam.tcl
+# Date: Fri Jan 14 19:27:42 EST 2000
+# Contact: ahmeds@mit.edu
+# Purpose: this is the group spam page
+#
+# Note: group_id and group_vars_set are already set up in the environment by the ug_serve_section.
+#       group_vars_set contains group related variables (group_id, group_name, group_short_name,
+#       group_admin_email, group_public_url, group_admin_url, group_public_root_url, group_admin_root_url, 
+#       group_type_url_p, group_context_bar_list and group_navbar_list)
+#
+# spam.tcl,v 3.2 2000/02/23 19:20:31 ron Exp
+# -----------------------------------------------------------------------------
+
+set_the_usual_form_variables 0
+# sendto
+
+set group_name [ns_set get $group_vars_set group_name]
+
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope all group_member none
+
+set user_id [ad_verify_and_get_user_id]
+set first_names [database_to_tcl_string $db "select first_names
+                                             from users
+                                             where user_id = $user_id"]
+set last_name [database_to_tcl_string $db "select last_name
+                                           from users
+                                           where user_id = $user_id"]
+
+set sendto_string [ad_decode $sendto "members" "Group Members" "Group Administrators"]
+
+set default_msg "
+Dear <first_names>,
+
+
+
+
+
+
+
+Thanks
+$first_names $last_name
+"
+
+# -----------------------------------------------------------------------------
+
+ns_return 200 text/html "
+[ad_scope_header "Send Email to $sendto_string" $db]
+[ad_scope_page_title "Email $sendto_string" $db]
+[ad_scope_context_bar_ws_or_index [list index.tcl $group_name] [list spam-index.tcl "Email"] "$sendto_string"]
+
+<hr>
+
+<blockquote>
+<form method=POST action=\"spam-confirm.tcl\">
+[export_form_vars sendto]
+
+<table>
+<tr>
+<th align=left>From:</th>
+<td><input name=from_address type=text size=20 
+value=\"[database_to_tcl_string $db "select email from users where user_id =[ad_get_user_id]"]\">
+</td>
+</tr>
+
+<tr>
+<th align=left>Subject:</th>
+<td><input name=subject type=text size=40></td>
+</tr>
+
+<tr>
+<th align=left valign=top>Message:</th>
+<td>
+<textarea name=message rows=10 cols=60 wrap=soft>$default_msg</textarea>
+</td>
+</tr>
+</table>
+
+<center>
+<p>
+<input type=submit value=\"Proceed\">
+</center>
+</form>
+
+<p>
+
+<table>
+<tr>
+<th colspan=3>The following variables can be used to insert user/group specific data:</th> 
+</tr>
+
+<tr>
+<td>&#60first_names&#62</td>
+<td> = </td>
+<td>User's First Name</td>
+</tr>
+
+<tr>
+<td>&#60last_name&#62</td>
+<td> = </td>
+<td>User's Last Name</td>
+</tr>
+
+<tr>
+<td>&#60email&#62</td>
+<td> = </td>
+<td>User's Email</td>
+</tr>
+
+<tr>
+<td>&#60group_name&#62</td>
+<td> = </td>
+<td>Group Name</td>
+</tr>
+</table>
+<br>
+</blockquote>
+
+[ad_scope_footer]
+"
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/help/for-one-page.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/help/for-one-page.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/help/for-one-page.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,39 @@
+# for-one-page.tcl,v 3.0 2000/02/06 03:46:35 ron Exp
+# /help/for-one-page.tcl 
+#
+# by philg@mit.edu on July 2, 1999
+#
+# displays the help file associated with a particular URL
+# typically called by help_link (defined in /tcl/help-defs.tcl)
+
+# tries to find the best help file according to the user's language
+# preference
+
+set_the_usual_form_variables
+
+# url 
+
+set pageroot [ns_info pageroot]
+set helproot [ad_parameter HelpPageRoot help ""]
+set helproot_fullpath "$pageroot$helproot"
+
+set full_url $url
+set just_the_dir [file dirname $full_url]
+set just_the_filename [file rootname [file tail $full_url]]
+set help_file_directory "$helproot_fullpath$just_the_dir"
+set glob_pattern "${help_file_directory}/${just_the_filename}*.help"
+set available_help_files [glob -nocomplain $glob_pattern]
+
+if { [llength $available_help_files] == 0 } {
+    ns_log Notice "$helproot/for-one-page.tcl reports that User requested help for \"$url\" but no .help file found"
+    ad_return_error "No help available" "No help is available for this page (\"$url\"), contrary to what you presumably were told.  This is either our programming bug or (maybe) a bug in your browser."
+    return
+}
+
+set list_of_lists [ad_style_score_templates $available_help_files]
+set sorted_list [lsort -decreasing -command ad_style_sort_by_score $list_of_lists]
+
+set top_scoring_help_file_filename [lindex [lindex $sorted_list 0] 1]
+set fully_qualified_help_file_filename $top_scoring_help_file_filename
+
+ns_return 200 text/html [ns_adp_parse -file $fully_qualified_help_file_filename]
Index: web/openacs/www/homepage/add-section.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/add-section.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/add-section.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,59 @@
+# add-section.tcl,v 3.0 2000/02/06 03:46:37 ron Exp
+# File:     /homepage/add-section.tcl
+# Date:     Tue Jan 25 02:26:37 EST 2000
+# Location: 42���21'N 71���04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Page to create an empty subsection
+
+set_form_variables
+# filesystem_node, section_type, master_type
+
+# ------------------------------ initialization codeBlock ----
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+set first_letter [string toupper [string range $section_type 0 0]]
+set others [string range $section_type 1 [expr [string length $section_type] - 1]]
+set section_type_2 "$first_letter$others"
+
+# ------------------------------ htmlGeneration codeBlock ----
+
+set dialog_body " \
+<form method=post action=mksection-1.tcl> \
+  <input type=hidden name=filesystem_node value=$filesystem_node> \
+  <input type=hidden name=section_type value=$section_type> \
+  <table cellpadding=0 border=0> \
+    <tr> \
+      <td align=left> \
+      Add a $section_type to this $master_type</td> \
+      </tr> \
+    <tr> \
+      <td align=left>name: </td>\
+      <td><input type=text size=16 name=section_title value=\"$section_type_2 1\">(used as a sort key)</tr> \
+    <tr> \
+      <td align=left>$section_type title: </td>\
+      <td><input type=text size=40 name=section_desc></tr> \
+  </table> \
+  <table border=0 cellpadding=0> \
+  <tr><td><input type=submit value=Okay></form></td> \
+      <td><form method=get action=index.tcl> \
+          <input type=hidden name=filesystem_node value=$filesystem_node> \
+          <input type=submit value=Cancel></form></td> \
+  </tr></table>"
+
+
+ns_returnredirect "dialog-class.tcl?title=Content Management&text=$dialog_body"
+return
+
+
+
+
Index: web/openacs/www/homepage/all.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/all.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/all.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,129 @@
+# all.tcl,v 3.0 2000/02/06 03:46:38 ron Exp
+# File:     /homepage/all.tcl
+# Date:     Thu Jan 27 06:47:54 EST 2000
+# Location: 42��21'N 71��04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Page to show all members
+
+
+# http headers
+ReturnHeaders
+
+set title "Homepages at [ad_parameter SystemName]"
+
+# packet of html
+ns_write "
+[ad_header $title]
+<h2>$title</h2>
+[ad_context_bar_ws_or_index $title] 
+<hr>
+<table width=100%>
+<tr>
+<td align=right>\[ <a href=neighborhoods.tcl>browse neighborhoods</a> \]
+</td></tr></table>
+<blockquote>
+
+<center>
+\[ <A HREF=\"#A\">A</A> | <A HREF=\"#B\">B</A> | 
+<A HREF=\"#C\">C</A> | <A HREF=\"#D\">D</A> | <A HREF=\"#E\">E</A> | 
+<A HREF=\"#F\">F</A> | <A HREF=\"#G\">G</A> | <A HREF=\"#H\">H</A> | 
+<A HREF=\"#I\">I</A> | <A HREF=\"#J\">J</A> | <A HREF=\"#K\">K</A> | 
+<A HREF=\"#L\">L</A> | <A HREF=\"#M\">M</A> | <A HREF=\"#N\">N</A> | 
+<A HREF=\"#O\">O</A> | <A HREF=\"#P\">P</A> | <A HREF=\"#Q\">Q</A> | 
+<A HREF=\"#R\">R</A> | <A HREF=\"#S\">S</A> | <A HREF=\"#T\">T</A> | 
+<A HREF=\"#U\">U</A> | <A HREF=\"#V\">V</A> | <A HREF=\"#W\">W</A> | 
+<A HREF=\"#X\">X</A> | <A HREF=\"#Y\">Y</A> | <A HREF=\"#Z\">Z</A> \] 
+</center>
+
+<br>
+
+    <table bgcolor=DDEEFF border=0 cellspacing=0 cellpadding=8 width=90%>
+    <tr><td>
+    <b>These are the members with homepages at [ad_parameter SystemName]</b>
+    <ul>
+"
+
+set db [ns_db gethandle]
+
+set counter 0
+
+for {set cx 1} {$cx <= 26} {incr cx} {
+
+    set letter [mobin_number_to_letter $cx]
+
+    set selection [ns_db select $db "
+    select uh.user_id as user_id,
+    u.screen_name as screen_name,
+    u.first_names as first_names,
+    u.last_name as last_name
+    from users_homepages uh, users u
+    where uh.user_id=u.user_id
+    and upper(u.last_name) like '$letter%'
+    order by last_name desc, first_names desc"]
+    
+    append html "
+    <h3><a name=\"$letter\">$letter</a></h3>
+    <table>
+    "
+        
+    set sub_counter 0
+
+    while {[ns_db getrow $db $selection]} {
+	incr counter
+	incr sub_counter
+	set_variables_after_query
+	append html "
+	<tr>
+	<td><a href=\"/users/$screen_name\">$last_name, $first_names</a>
+	</td>
+	</tr>
+	"
+    }
+
+    if {$sub_counter == 0} {
+	append html "
+	<tr>
+	<td>
+	Nobody here
+	</td>
+	</tr>
+	"
+    }
+
+    append html "
+    </table>
+    <hr>"
+
+    ns_write "$html"
+    set html ""
+}
+
+# And finally, we're done with the database (duh)
+ns_db releasehandle $db
+
+
+ns_write "
+</ul>
+$counter member(s)
+</table>
+<p>
+<center>
+
+\[ <A HREF=\"#A\">A</A> | <A HREF=\"#B\">B</A> | 
+<A HREF=\"#C\">C</A> | <A HREF=\"#D\">D</A> | <A HREF=\"#E\">E</A> | 
+<A HREF=\"#F\">F</A> | <A HREF=\"#G\">G</A> | <A HREF=\"#H\">H</A> | 
+<A HREF=\"#I\">I</A> | <A HREF=\"#J\">J</A> | <A HREF=\"#K\">K</A> | 
+<A HREF=\"#L\">L</A> | <A HREF=\"#M\">M</A> | <A HREF=\"#N\">N</A> | 
+<A HREF=\"#O\">O</A> | <A HREF=\"#P\">P</A> | <A HREF=\"#Q\">Q</A> | 
+<A HREF=\"#R\">R</A> | <A HREF=\"#S\">S</A> | <A HREF=\"#T\">T</A> | 
+<A HREF=\"#U\">U</A> | <A HREF=\"#V\">V</A> | <A HREF=\"#W\">W</A> | 
+<A HREF=\"#X\">X</A> | <A HREF=\"#Y\">Y</A> | <A HREF=\"#Z\">Z</A> \] 
+</center>
+
+<br>
+</blockquote>
+[ad_footer]
+"
+
+
Index: web/openacs/www/homepage/back.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/back.gif,v
diff -u
Binary files differ
Index: web/openacs/www/homepage/dialog-class.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/dialog-class.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/dialog-class.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,166 @@
+# dialog-class.tcl,v 3.0 2000/02/06 03:46:39 ron Exp
+# File:     /homepage/dialog-class.tcl
+# Date:     Tue Jan 18 19:36:14 EST 2000
+# Location: 42��21'N 71��04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Object Oriented Generic Dialog Class File.
+
+set_the_usual_form_variables 0
+# title, text, btn1, btn2, btn1target, btn2target, btn1keyvalpairs, btn2keyvalpairs
+
+if {![info exists title] || [empty_string_p $title]} {
+    set title "Generic Dialog Box"
+}
+
+if {![info exists text] || [empty_string_p $text]} {
+    set text "Part of the Arsdigita Community System<br>by Usman Y. Mobin."
+}
+
+if {![info exists btn1] || [empty_string_p $btn1]} {
+    set btn1 ""
+}
+
+if {![info exists btn2] || [empty_string_p $btn2]} {
+    set btn2 ""
+}
+
+if {![info exists btn1target] || [empty_string_p $btn1target]} {
+    set btn1target ""
+}
+
+if {![info exists btn2target] || [empty_string_p $btn2target]} {
+    set btn2target ""
+}
+
+if {![info exists btn1keyvalpairs] || [empty_string_p $btn1keyvalpairs]} {
+    set btn1keyvalpairs ""
+}
+
+if {![info exists btn2keyvalpairs] || [empty_string_p $btn2keyvalpairs]} {
+    set btn2keyvalpairs ""
+}
+
+
+set btn1html ""
+set btn2html ""
+
+if {$btn1 != ""} {
+    set btn1pass ""
+    for {set cx 0} {$cx < [llength $btn1keyvalpairs]} {set cx [expr $cx+2]} {
+	append btn1pass "
+	<input type=hidden name=[lindex $btn1keyvalpairs $cx]
+                           value=[lindex $btn1keyvalpairs [expr $cx+1]]>
+	"
+    }
+    set btn1html "
+    <td>
+    <form method=get action=$btn1target>
+    $btn1pass
+    <input type=submit value=\"$btn1\">
+    </form>
+    </td>
+    "
+}
+
+if {$btn2 != ""} {
+    set btn2pass ""
+    for {set cx 0} {$cx < [llength $btn2keyvalpairs]} {set cx [expr $cx+2]} {
+	append btn2pass "
+	<input type=hidden name=[lindex $btn2keyvalpairs $cx]
+                           value=[lindex $btn2keyvalpairs [expr $cx+1]]>
+	"
+    }
+    set btn2html "
+    <td>
+    <form method=get action=$btn2target>
+    $btn2pass
+    <input type=submit value=\"$btn2\">
+    </form>
+    </td>
+    "
+}
+
+set btnhtml ""
+
+if {"$btn1$btn2" != ""} {
+    set btnhtml "
+                                <table border=0
+                                       cellspacing=0
+                                       cellpadding=0>
+                                         <tr align=center>
+                                         $btn1html
+                                         $btn2html
+                                         </tr>
+                                </table>
+    "
+}
+
+ReturnHeaders
+
+ns_write "
+<html>
+
+<head>
+<title>$title</title>
+<meta name=\"description\" content=\"Usman Y. Mobin's generic dialog class.\">
+</head>
+
+<body bgcolor=FFFFFF text=000000 link=FFCE00 vlink=842C2C alink=B0B0B0>
+<div align=center><center>
+
+<table border=0 
+        cellspacing=0 
+        cellpadding=0 
+        width=100%
+        height=100%>
+                <tr>
+                <td align=center valign=middle>
+
+                <table border=0
+                       cellspacing=0
+                       cellpadding=0>
+                        <tr bgcolor=000080>
+                        <td>
+                                <table border=0
+                                       cellspacing=0
+                                       cellpadding=6>
+                                        <tr bgcolor=000080>
+                                        <td>
+                                               <font color=FFFFFF>
+                                               $title
+                                               </font>
+                                        </td>
+                                        </tr>
+                                </table> 
+                        </td>
+                        </tr>
+                        <tr bgcolor=C0C0C0>
+                        <td align=center>
+                                <table border=0
+                                       cellspacing=0
+                                       cellpadding=25>
+                                         <tr align=center>
+                                         <td>
+                                                  $text
+                                         </td>
+                                         </tr>
+                                </table>
+                                         $btnhtml
+                        </td>
+                        </tr>
+                </table>
+
+                </td>
+                </tr>
+</table>
+
+</center></div>
+</body>
+</html>
+"
+
+
+
+
+
Index: web/openacs/www/homepage/dir.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/dir.gif,v
diff -u
Binary files differ
Index: web/openacs/www/homepage/doc.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/doc.gif,v
diff -u
Binary files differ
Index: web/openacs/www/homepage/edit-1.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/edit-1.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/edit-1.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,140 @@
+# edit-1.tcl,v 3.0 2000/02/06 03:46:40 ron Exp
+# File:     /homepage/rmfile-1.tcl
+# Date:     Wed Jan 19 00:04:18 EST 2000
+# Location: 42��21'N 71��04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Page to delete a file
+
+set_the_usual_form_variables
+# filesystem_node, file_node
+
+# --------------------------- initialErrorCheck codeBlock ----
+
+set exception_count 0
+set exception_text ""
+
+if { ![info exists file_node] || [empty_string_p $file_node] } {
+    ad_return_error "FileSystem Target Node for editing Missing."
+    return
+}
+
+if { ![info exists filesystem_node] || [empty_string_p $filesystem_node] } {
+    ad_return_error "FileSystem Node Information Missing"
+    return
+}
+
+if {$exception_count > 0} { 
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# ------------------------------ initialization codeBlock ----
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+# ------------------------ initialDatabaseQuery codeBlock ----
+
+# The database handle (a thoroughly useless comment)
+set db [ns_db gethandle]
+
+# Checking for site-wide administration status
+set admin_p [ad_administrator_p $db $user_id]
+
+# This query will return the quota of the user
+set sql "
+select hp_true_filename($file_node) as full_filename,
+uf.file_size as old_filesize,
+uf.filename as filename
+from dual, users_files uf
+where file_id=$file_node
+"
+
+# Extract results from the query
+set selection [ns_db 1row $db $sql]
+
+# This will  assign the  variables their appropriate values 
+# based on the query.
+set_variables_after_query
+
+set access_denied_p [database_to_tcl_string $db "
+select hp_access_denied_p($file_node,$user_id) from dual"]
+
+# And off with the handle!
+ns_db releasehandle $db
+
+# Check to see whether the user is the owner of the filesystem node
+# for which access is requested.
+if {$access_denied_p} {
+    # Aha! url surgery attempted!
+    ns_returnredirect "dialog-class.tcl?title=Error!&text=File cannot be deleted<br>The filesystem has gone out of sync<br>Please contact your administrator.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+    #ad_return_error "Unable to Edit File" "Unauthorized Access to the FileSystem"
+    #return
+}
+
+ReturnHeaders
+
+set title "Edit File - $filename"
+
+ns_write "
+[ad_header $title]
+<h2>$title</h2>
+[ad_context_bar_ws_or_index \
+        [list "index.tcl?filesystem_node=$filesystem_node" "Homepage Maintenance"] $title]
+<hr>
+<blockquote>
+"
+
+set file_full_name "[ad_parameter ContentRoot users]$full_filename"
+
+set streamhandle1 [open "$file_full_name" r]
+set file_contents [read -nonewline $streamhandle1]
+
+append html "
+<form method=post action=edit-2.tcl>
+  [export_form_vars filesystem_node file_node]
+  <p>
+  <table cellpadding=4>
+    <tr>
+      <td align=left>File Contents:</td>
+    <tr>
+      <td><textarea name=file_contents cols=70 rows=24 wrap=soft>[ns_quotehtml $file_contents]</textarea></td>
+  </table>
+  <input type=submit value=\"Save It!\">
+</form>
+"
+
+
+
+
+
+#if [catch {file delete "$file_full_name"} errmsg] {
+#    append exception_text "
+#    <li>File $file_full_name could not be deleted.<br>
+#    $errmsg"
+#    ad_return_complaint 1 $exception_text
+#    return
+#} else {
+#    set dml_sql "
+#    delete from users_files
+#    where file_id=$file_node
+#    "
+#    ns_db dml $db $dml_sql
+#}
+
+ns_write "
+$html
+</blockquote>
+[ad_footer]
+"
+
+
Index: web/openacs/www/homepage/edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/edit-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,113 @@
+# edit-2.tcl,v 3.0 2000/02/06 03:46:41 ron Exp
+# File:     /homepage/mkfile-2.tcl
+# Date:     Wed Jan 19 21:36:48 EST 2000
+# Location: 42���21'N 71���04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Page to create a new file
+
+set_the_usual_form_variables
+# filesystem_node, file_node, file_contents
+
+# --------------------------- initialErrorCheck codeBlock ----
+
+set exception_count 0
+set exception_text ""
+
+# Deactivated code. Due to the new dialog-class
+#if { ![info exists new_name] || [empty_string_p $new_name] } {
+#    incr exception_count
+#    append exception_text "
+#    <li>You did not specify a filename"
+#}
+
+if { ![info exists filesystem_node] || [empty_string_p $filesystem_node] } {
+    ad_return_error "FileSystem Node Information Missing"
+}
+
+if { ![info exists file_node] || [empty_string_p $file_node] } {
+    ad_return_error "FileSystem Target Node Information Missing"
+}
+
+if {$exception_count > 0} { 
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+# ------------------------------ initialization codeBlock ----
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+# ------------------------ initialDatabaseQuery codeBlock ----
+
+# The database handle (a thoroughly useless comment)
+set db [ns_db gethandle]
+
+# Checking for site-wide administration status
+set admin_p [ad_administrator_p $db $user_id]
+
+# This query will return the quota of the user
+set sql "
+select hp_true_filename($file_node) as full_filename,
+uf.file_size as old_filesize,
+uf.filename as filename
+from dual, users_files uf
+where file_id=$file_node
+"
+
+# Extract results from the query
+set selection [ns_db 1row $db $sql]
+
+# This will  assign the  variables their appropriate values 
+# based on the query.
+set_variables_after_query
+
+set access_denied_p [database_to_tcl_string $db "
+select hp_access_denied_p($file_node,$user_id) from dual"]
+
+# Check to see whether the user is the owner of the filesystem node
+# for which access is requested.
+if {$access_denied_p} {
+    # Aha! url surgery attempted!
+    ns_returnredirect "dialog-class.tcl?title=Error!&text=File cannot be deleted<br>The filesystem has gone out of sync<br>Please contact your administrator.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+    #ad_return_error "Unable to Edit File" "Unauthorized Access to the FileSystem"
+    #return
+}
+
+set file_full_name "[ad_parameter ContentRoot users]$full_filename"
+
+set streamhandle1 [open "$file_full_name" w]
+
+if [catch {puts $streamhandle1 $file_contents} errmsg] {
+    # directory already exists    
+    append exception_text "
+    <li>file $new_fullname could not be created."
+    ad_return_complaint 1 $exception_text
+    return
+} else {
+    flush $streamhandle1
+    close $streamhandle1
+    set new_size [file size $file_full_name]
+    set dml_sql "
+    update users_files
+    set file_size=$new_size
+    where file_id=$file_node
+    "
+    ns_db dml $db $dml_sql
+}
+
+# And off with the handle!
+ns_db releasehandle $db
+
+# And let's go back to the main maintenance page
+ns_returnredirect index.tcl?filesystem_node=$filesystem_node
Index: web/openacs/www/homepage/get-display.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/get-display.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/get-display.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,107 @@
+# get-display.tcl,v 3.0 2000/02/06 03:46:42 ron Exp
+set_form_variables
+# maint_p, user_id
+
+#if {![info exists user_id] || [empty_string_p $user_id]} {
+    # First, we need to get the user_id
+#    set user_id [ad_verify_and_get_user_id]
+#}
+
+if {![info exists maint_p] || [empty_string_p $maint_p]} {
+    set maint_p 1
+}
+
+set db [ns_db gethandle]
+
+if {$maint_p == 0} {
+    set selection [ns_db 0or1row $db "
+    select bgcolor, 
+    textcolor, 
+    unvisited_link, 
+    visited_link, 
+    link_text_decoration, 
+    link_font_weight,
+    font_type
+    from users_homepages
+    where user_id=$user_id
+    "]
+} else {
+    set selection [ns_db 0or1row $db "
+    select maint_bgcolor as bgcolor, 
+    maint_textcolor as textcolor, 
+    maint_unvisited_link as unvisited_link, 
+    maint_visited_link as visited_link, 
+    maint_link_text_decoration as link_text_decoration,
+    maint_link_font_weight as link_font_weight,
+    maint_font_type as font_type
+    from users_homepages
+    where user_id=$user_id
+    "]
+}
+if { [empty_string_p $selection] } {
+    # initialize background color to white
+    ns_return 200 text/css "BODY { background-color: white }
+    "
+    return
+}    
+
+set_variables_after_query
+
+if { ![empty_string_p $bgcolor] } {
+    set style_bgcolor "background-color: $bgcolor"
+}
+
+if { ![empty_string_p $textcolor] } {
+    set style_textcolor "color: $textcolor"
+}
+
+if { ![empty_string_p $unvisited_link] } {
+    set style_unvisited_link "color: $unvisited_link"
+}
+
+if { ![empty_string_p $visited_link] } {
+    set style_visited_link "color: $visited_link"
+}
+
+if { ![empty_string_p $link_text_decoration] } {
+    set style_link_text_decoration "text-decoration: $link_text_decoration"
+}
+
+if { ![empty_string_p $link_font_weight] } {
+    set style_link_font_weight "font-weight: $link_font_weight"
+}
+
+if { ![empty_string_p $font_type] } {
+    set style_font_type "font-family: $font_type"
+}
+
+set a_string [join [css_list_existing style_link_text_decoration style_unvisited_link style_link_font_weight] "; "]
+append css [ad_decode $a_string "" "" "A { $a_string }\n"]
+
+set a_hover_string  [join [css_list_existing style_link_text_decoration] "; "]
+append css [ad_decode $a_hover_string "" "" "A:hover { $a_hover_string }\n"]
+
+set a_visited_string [join [css_list_existing style_visited_link style_link_text_decoration] "; "]
+append css [ad_decode $a_visited_string "" "" "A:visited { $a_visited_string }\n"]
+
+set font_string [join [css_list_existing style_font_type style_textcolor] "; "]
+if { ![empty_string_p $font_string] } {
+    append css "P  { $font_string }
+UL { $font_string }
+H1 { $font_string }
+H2 { $font_string }
+H3 { $font_string }
+H4 { $font_string }
+TH { $font_string }
+TD { $font_string }
+BLOCKQUOTE{ $font_string }
+"
+}
+
+set body_string [join [css_list_existing style_bgcolor style_textcolor style_font_type] "; "]
+append css [ad_decode $body_string "" "" "BODY { $body_string }"]
+
+ns_db releasehandle $db 
+ns_return 200 text/css $css
+
+
Index: web/openacs/www/homepage/index-tree.help
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/index-tree.help,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/index-tree.help	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,15 @@
+<%= [ad_header "Help for Homepage Maintenance"] %>
+
+<h2>Help</h2>
+
+for Homepage Maintenance Page
+
+<hr>
+
+<ul>
+
+<li>No help available at this time.
+</ul>
+
+
+<%= [ad_footer] %>
Index: web/openacs/www/homepage/index.help
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/index.help,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/index.help	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,159 @@
+<%= [ad_header "Help for Homepage Maintenance"] %>
+
+<h2>Help</h2>
+
+for Homepage Maintenance Page
+
+<hr>
+
+The homepage maintenance page is at /homepage/. You use it to maintain
+your web content once your webspace has been initialized and you have
+set up a screen name for yourself.
+<p>
+
+1&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Customizing your Maintenance and Public Pages
+<p>
+You can change the display settings of your maintenance page by
+clicking on the [display-settings] link in the lower right of the
+page. There are two types of settings: settings for public pages, and
+settings for maintenance pages. The settings will affect your public
+and maintenance pages respectively. Your public pages are the pages
+shown to the entire world and are available at
+http://yourdomain.com/users/your_screen_name. Your maintenance page is
+/homepage/, the page through which you maintain your webspace. You can
+also customize the way you view your files. The directory listing can
+be normal or hierarchical. This can be set using the [ normal view |
+tree view ] buttons at the upper right of the screen. By clicking on a
+directory, you browse its content (in the normal view), or you browse
+content rooted at it (in the tree view).
+<p>
+
+2&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Creating Files
+<p>
+You can create files by clicking on the "create file" link. You will
+be prompted for the name, and an empty file with that name will be
+created. Mind however that to be able to invoke the editor on a file,
+it should have a .text, .html, .htm, .txt or anyother extension that
+represents a mime type of text/*. If you're unsure of what this means,
+just end the filename in .html if it's an html file or .text if it's a
+text file. If you do not know html then, for your own good, I advise
+you to learn it. It is a very good advice. Take it. Html is very very
+easy to learn. Meanwhile, you can just name your files ending with
+.text or just use the "publish content" option. It requires no
+knowledge of html. The created file is placed in the directory you are
+currently browsing. Html files have the following format:<br>
+<code>
+&lt;html&gt;<br>
+&lt;head&gt;<br>
+&lt;title&gt;<i>title-goes-here</i>&lt;/title&gt;<br>
+&lt;/head&gt;<br>
+&lt;body&gt;<br>
+<br>
+<i>body-text-goes-here</i><br>
+<br>
+&lt;/body&gt;<br> &lt;/html&gt;<br> </code><br> To learn about the
+things you can do in the body text, read the lower half of section
+5.1 of this document
+
+<p>
+
+2.1&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Index files and generated indices
+<p>
+If a web user requests a file from your webspace which is actually a
+directory, then the system generates a default index page for it. The
+format of the index page is such: your portrait (if you uploaded one
+following the links in your workspace) in the top right, your name as
+heading, and "webspace at your-system-name" as subheading. Then it
+displays a listing of files in the directory. If you do not wish to
+have a generated index, you can create an index file in that
+directory. By default filenames index.html, index.htm, and Default.htm
+will be treated by the system as index files and will be served when a
+directory is requested by the web browser. The presence of an index
+file makes it impossible for the web browser to lit the contents of
+that directory.
+<p>
+
+3&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Uploading Files
+<p>
+You can upload files from your local computer to your homepage
+webspace by clicking on the "upload file" link. You can either type
+the full filename on the local filesystem or press the browse button
+to browse your local filesystem to select the file you want to
+upload. Please mind your limited quota space before deciding on which
+files to upload.
+<p>
+
+4&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Creating Folders
+<p>
+Create folders using the "create folder" link. You are prompted for a
+folder name and a description. Choose a nice description for your
+folders as these descriptions are displayed alongside the folder name
+in the generated index pages which the world sees. You can remove,
+rename, or move folders by using the remove, rename, and move links
+respectively. A folder which is not empty cannot be deleted.
+<p>
+
+5&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Invoking the Content Manager
+<p>
+Click the "publish content" link to publish managed content on your
+site. You have to provide four parameters to the content manager: the
+content type, short name, full name, and subsections. Content type
+determines the type of your content. It can be anything from "book",
+"magazine", "newsletter", "encyclopedia", to anything you can come up
+with. The short name is a short name which describes the content. A
+specially marked folder with that name is created to store the
+content. The full name is the full name of your content. For example,
+if you're publishing your book then this ought to be the complete
+title of the book etcetra. In subsections, provide what one subsection
+of the content is called. For a book, this could be "chapter". If the
+content type is chapter, this could be "section". Please mind that you
+must provide a singular in this field.
+<p>
+
+5.1&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Managing Content
+<p>
+I will illustrate this with an example. Suppose I click on "publish
+content" and create content of type "magazine", short name "mobmag",
+full name "Mobin's Foolish Magazine", and subsections "article". This
+tells the content manager that I wish to publish a magazine which is
+composed of articles (multiple level hierarcies in content is possible
+but not discussed here). The content manager creates a folder "mobmag"
+(which is marked as a a magazine). When I click on "mobmag" to browse
+its contents, I see one file in it already, "Introductory Text". You
+can only edit or remove this file. The web viewer sees the contents of
+this file on the main magazine page (in this case
+http://mydomain.com/users/mobin/mobmag/) above the table of
+contents. To add an article, click on the "add article" link. This
+adds an empty article which you can then edit. While creating
+articles, choose meaningful descriptions for them. You can use html in
+these files if you want. This gives you the ability to show uploaded
+photos i your web content. The contents of these files are pasted
+within larger html files when these are served so you should not use
+the &lt;html&gt;, &lt;title&gt;, &lt;body&gt; etcetra tags. Also,
+since these files are really html, you will need to escape &lt, &gt,
+and & with &amp;lt, &amp;gt and &amp;amp if any of these are used as
+text. So you can enclose text within the &lt;h2&gt; and &lt;/h2&gt; to
+make it a second level heading, &lt;b&gt; and &lt;/b&gt; to make it
+bold, &lt;i&gt; and &lt;/i&gt; to make it italicised and more
+importantly, you can use something like &lt;a href=http://<i>whatever
+address</i>&gt;<i>whatever link name</i>&lt;/a&gt; to provide a link
+to any addess on the web. Also, you can have something like &lt;img
+src=<i>picture-filename</i>&gt; to display the picture which has the
+name <i>picture-filename</i>. This way you can upload picture files
+and then show them in your documents.
+<p>
+
+5.2&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Deleting Managed Directories
+<p>
+Delete all files in a managed directory by using the remove links next
+to them and then go to the parent directory and then remove the
+managed directory.
+<p>
+
+
+<%= [ad_footer] %>
+
+
+
+
+
Index: web/openacs/www/homepage/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/index.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,534 @@
+# index.tcl,v 3.2 2000/03/08 01:19:32 mobin Exp
+# File:     /homepage/index.tcl
+# Date:     Mon Jan 10 21:06:26 EST 2000
+# Location: 42��21'N 71��04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  User Content Main Page
+
+# Homepages should be enabled!
+set enabled_p [ad_parameter HomepageEnabledP users]
+# And if they're not... let's do nothing
+if {$enabled_p == 0} {
+    ns_return 200 text/plain "homepage module is disabled"
+    return
+}
+
+set_form_variables 0
+# filesystem_node
+
+# ------------------------------ initialization codeBlock ----
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+# Check whether user's directory exists or not
+set dir_p [file exists [ad_parameter ContentRoot users]$user_id]
+
+# ------------------------ initialDatabaseQuery codeBlock ----
+
+# The database handle (a thoroughly useless comment)
+set db [ns_db gethandle]
+
+# This query will extract information about the user from the
+# database
+set selection [ns_db 1row $db "
+select first_names, last_name
+from users
+where user_id=$user_id"]
+
+# This will assign the appropriate values to the appropriate
+# variables based on the query results.
+set_variables_after_query
+
+# Checking for site-wide administration status
+set admin_p [ad_administrator_p $db $user_id]
+
+# This query will return the quota of the user
+# set sql "
+#  select (hp_get_filesystem_root_node($user_id)) as fsid,
+#         (select count(*) * [ad_parameter DirectorySpaceRequirement users]
+#          from users_files
+#          where directory_p='t'
+#          and owner_id=$user_id) +
+#         (select nvl(sum(file_size),0)
+#          from users_files
+#          where directory_p='f'
+#          and owner_id=$user_id) as quota_used,
+#         (decode((select count(*) from
+#                  users_special_quotas
+#                  where user_id=$user_id),
+#                  0, [ad_parameter [ad_decode $admin_p \
+#  			 0 NormalUserMaxQuota \
+#  			 1 PrivelegedUserMaxQuota \
+#  			 PrivelegedUserMaxQuota] users],
+#                  (select max_quota from
+#                   users_special_quotas
+#                   where user_id=$user_id))) * pow(2.0,20.0) as quota_max,
+#         (select count(*)
+#          from users_files
+#          where filename='$user_id'
+#          and parent_id is null
+#          and owner_id=$user_id) as dir_p,
+#         (select screen_name
+#          from users
+#          where user_id=$user_id) as screen_name
+#  from dual
+#  "
+
+
+set sql "
+select hp_get_filesystem_root_node($user_id) as fsid, 
+       hp_quota_used($user_id,[ad_parameter DirectorySpaceRequirement users]) as quota_used,
+       trunc(hp_quota_max($user_id,[ad_parameter [ad_decode $admin_p 0 NormalUserMaxQuota 1 PrivelegedUserMaxQuota PrivelegedUserMaxQuota] users]) * pow(2.0,20.0)) as quota_max,
+       hp_users_files($user_id) as dir_p,
+       hp_screen_name($user_id) as screen_name"
+
+
+# Extract results from the query
+set selection [ns_db 1row $db $sql]
+
+# This will  assign the  variables their appropriate values 
+# based on the query.
+set_variables_after_query
+
+# If filesystem node is not specified, go to user's root directory
+if {![info exists filesystem_node] || [empty_string_p $filesystem_node]} {
+    set filesystem_node $fsid
+}
+
+set cookies [ns_set get [ns_conn headers] Cookie]
+if {[regexp {.*homepage_view=([^ ;]*).*} $cookies match cookie_view]} {
+    # we have a match
+    set view $cookie_view
+} else {
+    set view [ad_parameter DefaultView users]
+}
+
+if {![info exists view] || [empty_string_p $view]} {
+    set view "normal"
+}
+
+if {$dir_p != 0} {
+    set access_denied_p [database_to_tcl_string $db "
+    select hp_access_denied_p($filesystem_node,$user_id) from dual"]
+
+    # Check to see whether the user is the owner of the filesystem node
+    # for which access is requested.
+    if {$access_denied_p} {
+	# Aha! url surgery attempted!
+	#    append exception_text "
+	#    <li>Unauthorized Access to the FileSystem"
+	#    ad_return_complaint 1 $exception_text
+	#    return
+	ns_returnredirect "dialog-class.tcl?title=Access Denied&text=Unauthorized access to the filesystem!&btn1=Okay&btn1target=index.tcl"
+	return
+    }
+}
+
+# And off with the handle!
+ns_db releasehandle $db
+
+# ----------------------- initialHtmlGeneration codeBlock ----
+
+# Set the page title
+set title "$first_names $last_name - Homepage Maintenance"
+
+# Return the http headers. (an awefully useless comment)
+ReturnHeaders
+
+# Send the first packet of html. The reason for sending the
+# first packet (with the page heading) as early as possible
+# is that otherwise the user might find the system somewhat
+# unresponsive if it takes too long to query the database.
+ns_write "
+[hp_header $title $user_id 1]	
+<h2>$title</h2>
+[ad_context_bar_ws_or_index $title]
+<hr>
+[help_upper_right_menu_b]
+Your Max Quota: [util_commify_number $quota_max] bytes<br>
+Quota Space Used: [util_commify_number $quota_used] bytes<br>
+<br>
+<blockquote>
+"
+
+if {$dir_p==0} {
+    ns_write "Your webspace has not been activated yet.
+    Click <a href=webspace-init.tcl>here</a> to set it up for the first time.
+    </blockquote>
+    [ad_footer]"
+    return
+}
+
+if {[empty_string_p $screen_name]} {
+    ns_write "
+    You have not set up a screen name as yet. 
+    Click <a href=/pvt/basic-info-update.tcl>here</a> to set one up.
+    </blockquote>
+    [ad_footer]"
+    return
+}
+
+set home_url "[ad_parameter SystemURL]/users/$screen_name"
+append html "
+</blockquote>
+Your homepage is at <a href=\"$home_url\">$home_url</a>
+<blockquote>"
+
+# The database handle (a thoroughly useless comment)
+set db [ns_db gethandle]
+
+set sql "
+select parent_id as parent_node
+from users_files
+where file_id=$filesystem_node
+"
+
+# Extract results from the query
+set selection [ns_db 1row $db $sql]
+
+# This will  assign the  variables their appropriate values 
+# based on the query.
+set_variables_after_query
+
+set this_managed_p [database_to_tcl_string $db "
+select managed_p from users_files where file_id=$filesystem_node"]
+
+if {![info exists parent_node] || [empty_string_p $parent_node]} {
+    set parent_html ""
+} else {
+
+	set parent_html "
+	<tr><td><img src=back.gif>
+	<a href=index.tcl?filesystem_node=$parent_node>Parent Folder</a>
+	<font size=-1>\[level up\]</font>
+	</td></tr>
+	"
+
+}
+
+set curr_dir [database_to_tcl_string $db "
+select hp_user_relative_filename($filesystem_node) from dual"]
+
+set file_count [database_to_tcl_string $db "
+select hp_get_filesystem_child_count($filesystem_node) from dual"]
+
+if {$this_managed_p} {
+    set selection [ns_db 1row $db "
+    select type_name, sub_type_name
+    from users_content_types
+    where type_id = (select content_type 
+                     from users_files
+                     where file_id=$filesystem_node)"]
+    set_variables_after_query
+    set content_name [database_to_tcl_string $db "
+    select file_pretty_name from users_files
+    where file_id=$filesystem_node"]
+}
+# This menu displays a list of options which the user has
+# available for the current filesystem_node (directory).
+if {$this_managed_p} {
+    set options_menu "
+    \[ <a href=\"add-section.tcl?filesystem_node=$filesystem_node&section_type=$sub_type_name&master_type=$type_name\">add $sub_type_name</a> | <a href=publish-1.tcl?filesystem_node=$filesystem_node>publish sub-content</a> | <a href=upload-1.tcl?filesystem_node=$filesystem_node>upload picture</a> \]
+
+    "
+    append html "<i><font size=+2>$content_name</font></i> <font size=-1>($type_name)</font><p>"
+} else {
+    set options_menu "
+    \[ <a href=mkdir-1.tcl?filesystem_node=$filesystem_node>create folder</a> | <a href=publish-1.tcl?filesystem_node=$filesystem_node>publish content</a> | <a href=upload-1.tcl?filesystem_node=$filesystem_node>upload file</a> | <a href=mkfile-1.tcl?filesystem_node=$filesystem_node>create file</a> \]
+    "
+}
+
+# View Selection
+
+if {$view == "tree"} {
+
+    append html "
+    <br>
+    <table border=0 cellspacing=0 cellpadding=0 width=90%>
+    <tr><td>$options_menu</td>
+    <td align=right>\[ <a href=set-view.tcl?view=normal&filesystem_node=$filesystem_node>normal view</a> | tree view \]
+    </td></tr>
+    </table>
+    <br>
+    <table bgcolor=DDEEFF border=0 cellspacing=0 cellpadding=8 width=90%>
+    <tr><td>
+    <b>Contents rooted at /users/$screen_name$curr_dir :</b>
+    <ul>
+    <table border=0>
+    $parent_html
+    "
+
+    set counter 0
+    
+# select type_name 
+# from users_content_types, users_files uf
+# where type_id = uf.content_type"]
+# 	set selection [ns_db select $db "
+# 	select file_id as fid, filename, directory_p, file_size, level, file_pretty_name,
+#                parent_id, managed_p, content_type, modifyable_p, managed_p,
+# 	       ((case when f.managed_p = 'f' then 'folder' else '$type_name' end)) as type,
+# 	hp_filesystem_node_sortkey_gen(f.file_id) as generated_sort_key,
+# 	hp_user_relative_filename(f.file_id) as rel_filename
+# 	from users_files f
+# 	where owner_id=$user_id
+# 	and level > 1
+# 	connect by prior file_id = parent_id
+# 	start with file_id=$filesystem_node
+# 	order by generated_sort_key asc
+
+    if {$file_count==0} {
+	#append html "
+	#<tr><td>There are no files in this directory</td></tr>"
+	append html ""
+    } else {
+	set selection [ns_db select $db "
+	select file_id as fid, filename, 
+               directory_p, 
+               file_size, 
+               hp_filesystem_node_level_gen(f.file_id,1,0) as level, 
+               file_pretty_name,
+               parent_id, managed_p, content_type, modifyable_p, managed_p,
+	       (case when f.managed_p = 'f' then 'folder' else hp_content_name_from_type(f.content_type) end) as type,
+	hp_filesystem_node_sortkey_gen(f.file_id,$filesystem_node) as generated_sort_key,
+	hp_user_relative_filename(f.file_id) as rel_filename
+	from users_files f
+	where owner_id = $user_id
+	and  hp_filesystem_node_level_gen(f.file_id,1,0) > hp_filesystem_node_level_gen($filesystem_node,1,0)
+        and hp_id_is_subnode(f.file_id,$filesystem_node) = 't'
+	order by generated_sort_key asc"]
+	while {[ns_db getrow $db $selection]} {
+	    incr counter
+	    set_variables_after_query
+	    set level [expr $level - 2]
+	    if {$directory_p} {
+		
+		# Code deactivated but not removed because it is respectable code, man!
+		# set dir_menu "
+		# <font size=-1>\[ <a href=rmdir-1.tcl?filesystem_node=$filesystem_node&dir_node=$fid>remove</a> | rename \]</font>
+		# "
+		
+		# This dir_menu uses the generic dialog box for confirmation
+		set dir_menu "
+		<font size=-1>\[ <a href=\"dialog-class.tcl?title=Filesystem Management&text=This will delete the folder `$filename' permanently.<br>Are you sure you would like to do that?&btn1=Yes&btn2=No&btn2target=index.tcl&btn2keyvalpairs=filesystem_node $filesystem_node&btn1target=rmdir-1.tcl&btn1keyvalpairs=filesystem_node $filesystem_node dir_node $fid\">remove</a> | <a href=\"rename-1.tcl?filesystem_node=$filesystem_node&rename_node=$fid\">rename</a> | <a href=move-1.tcl?filesystem_node=$filesystem_node&move_node=$fid>move</a> \]</font>
+		"
+		
+		
+		append html "<tr><td>[ad_space [expr $level * 8]]<img src=dir.gif>
+		<a href=index.tcl?filesystem_node=$fid>$filename</a>
+		<font size=-1>($type)</font>
+		</td>
+		<!--<td valign=bottom align=center>&nbsp</td>-->
+		<td valign=bottom>&nbsp$dir_menu</td></tr>"
+	    } else {
+		# Deactivated by mobin Wed Jan 19 00:24:23 EST 2000
+		# set file_menu_1 "
+		# <font size=-1>\[ <a href=rmfile-1.tcl?filesystem_node=$filesystem_node&file_node=$fid>remove</a> | rename "
+		
+		set file_menu_2 "<a href=\"dialog-class.tcl?title=Filesystem Management&text=This will delete the file `$filename' permanently.<br>Are you sure you would like to do that?&btn1=Yes&btn2=No&btn2target=index.tcl&btn2keyvalpairs=filesystem_node $filesystem_node&btn1target=rmfile-1.tcl&btn1keyvalpairs=filesystem_node $filesystem_node file_node $fid\">remove</a> | <a href=\"rename-1.tcl?filesystem_node=$filesystem_node&rename_node=$fid\">rename</a> | <a href=move-1.tcl?filesystem_node=$filesystem_node&move_node=$fid>move</a> \]</font>"
+		
+		
+		if {[regexp {text.*} [ns_guesstype $filename] match]} {
+		    # The file is editable by a text editor.
+		    set file_menu_1 "<font size=-1>\[ <a href=edit-1.tcl?filesystem_node=$filesystem_node&file_node=$fid>edit</a> | "
+		} else {
+		    if {$managed_p} {
+			if {[file extension $filename] == ""} {
+			    set file_menu_1 "<font size=-1>\[ <a href=edit-1.tcl?filesystem_node=$filesystem_node&file_node=$fid>edit</a> | "
+			} else {
+			    set file_menu_1 "<font size=-1>\[ "
+			}
+		    } else {
+			set file_menu_1 "<font size=-1>\[ "
+		    }
+		}
+
+		if {$modifyable_p == "f"} {
+		    set file_menu_2 "<a href=\"dialog-class.tcl?title=Filesystem Management&text=This will delete the file `$filename' permanently.<br>Are you sure you would like to do that?&btn1=Yes&btn2=No&btn2target=index.tcl&btn2keyvalpairs=filesystem_node $filesystem_node&btn1target=rmfile-1.tcl&btn1keyvalpairs=filesystem_node $filesystem_node file_node $fid\">remove</a> \]</font>"
+		}
+		
+		set file_menu "$file_menu_1$file_menu_2"
+		
+		set filesize_display "
+		<font size=-1>[util_commify_number $file_size] bytes</font>
+		"
+		
+		if {$managed_p} {
+		    append html "<tr><td>[ad_space [expr $level * 8]]<img src=doc.gif>
+		    <a href=\"/users/$screen_name$rel_filename\">$filename</a>
+		    </td>
+		    <td valign=bottom align=left>&nbsp<font size=-1>$file_pretty_name</font></td>
+		    <td valign=bottom align=right>&nbsp$file_menu</td>
+		    </tr>
+		    "		    
+		} else {
+		    append html "<tr><td>[ad_space [expr $level * 8]]<img src=doc.gif>
+		    <a href=\"/users/$screen_name$rel_filename\">$filename</a>
+		    </td>
+		    <td valign=bottom align=right>&nbsp<font size=-1>$filesize_display</font></td>
+		    <td valign=bottom align=right>&nbsp$file_menu</td>
+		    </tr>
+		    "
+		}
+	    }
+	}
+    }
+       
+} else {
+
+    # This is when the view is normal
+    append html "
+    <br>
+    <table border=0 cellspacing=0 cellpadding=0 width=90%>
+    <tr><td>$options_menu</td>
+    <td align=right>\[ normal view | <a href=set-view.tcl?view=tree&filesystem_node=$filesystem_node>tree view</a> \]
+    </td></tr>
+    </table>
+    <br>
+    <table bgcolor=DDEEFF cellpadding=8 width=90%>
+    <tr><td>
+    <b>Contents of /users/$screen_name$curr_dir :</b>
+    <ul>
+    <table border=0>
+    $parent_html
+    "
+    
+    if {$file_count==0} {
+	#append html "
+	#<tr><td>There are no files in this directory</td></tr>"
+	append html ""
+    } else {
+	set selection [ns_db select $db "
+	select file_id as fid, filename, directory_p, file_size, content_type, 
+	       managed_p, file_pretty_name, modifyable_p,
+	       ((case when uf.managed_p = 'f' then 'folder' else hp_content_name_from_type(uf.content_type) end)) as type
+	from users_files uf
+	where parent_id=$filesystem_node
+	and owner_id=$user_id
+	order by directory_p desc, filename asc"]
+	while {[ns_db getrow $db $selection]} {
+	    set_variables_after_query
+	    if {$directory_p} {
+		
+		# Code deactivated but not removed because it is respectable code, man!
+		# set dir_menu "
+		# <font size=-1>\[ <a href=rmdir-1.tcl?filesystem_node=$filesystem_node&dir_node=$fid>remove</a> | rename \]</font>
+		# "
+		
+		# This dir_menu uses the generic dialog box for confirmation
+		set dir_menu "
+		<font size=-1>\[ <a href=\"dialog-class.tcl?title=Filesystem Management&text=This will delete the folder `$filename' permanently.<br>Are you sure you would like to do that?&btn1=Yes&btn2=No&btn2target=index.tcl&btn2keyvalpairs=filesystem_node $filesystem_node&btn1target=rmdir-1.tcl&btn1keyvalpairs=filesystem_node $filesystem_node dir_node $fid\">remove</a> | <a href=\"rename-1.tcl?filesystem_node=$filesystem_node&rename_node=$fid\">rename</a> | <a href=move-1.tcl?filesystem_node=$filesystem_node&move_node=$fid>move</a> \]</font>
+		"
+		
+		
+		append html "<tr><td><img src=dir.gif>
+		<a href=index.tcl?filesystem_node=$fid>$filename</a>
+		<font size=-1>($type)</font>
+		</td>
+		<!--<td valign=bottom align=center>&nbsp</td>-->
+		<td valign=bottom>&nbsp$dir_menu</td></tr>"
+	    } else {
+		# Deactivated by mobin Wed Jan 19 00:24:23 EST 2000
+		# set file_menu_1 "
+		# <font size=-1>\[ <a href=rmfile-1.tcl?filesystem_node=$filesystem_node&file_node=$fid>remove</a> | rename "
+		
+		set file_menu_2 "<a href=\"dialog-class.tcl?title=Filesystem Management&text=This will delete the file `$filename' permanently.<br>Are you sure you would like to do that?&btn1=Yes&btn2=No&btn2target=index.tcl&btn2keyvalpairs=filesystem_node $filesystem_node&btn1target=rmfile-1.tcl&btn1keyvalpairs=filesystem_node $filesystem_node file_node $fid\">remove</a> | <a href=\"rename-1.tcl?filesystem_node=$filesystem_node&rename_node=$fid\">rename</a> | <a href=move-1.tcl?filesystem_node=$filesystem_node&move_node=$fid>move</a> \]</font>"
+		
+		
+		if {[regexp {text.*} [ns_guesstype $filename] match]} {
+		    # The file is editable by a text editor.
+		    set file_menu_1 "<font size=-1>\[ <a href=edit-1.tcl?filesystem_node=$filesystem_node&file_node=$fid>edit</a> | "
+		} else {
+		    if {$this_managed_p} {
+			if {[file extension $filename] == ""} {
+			    set file_menu_1 "<font size=-1>\[ <a href=edit-1.tcl?filesystem_node=$filesystem_node&file_node=$fid>edit</a> | "
+			} else {
+			    set file_menu_1 "<font size=-1>\[ "
+			}
+		    } else {
+			set file_menu_1 "<font size=-1>\[ "
+		    }
+		}
+		
+		if {$modifyable_p == "f"} {
+		    set file_menu_2 "<a href=\"dialog-class.tcl?title=Filesystem Management&text=This will delete the file `$filename' permanently.<br>Are you sure you would like to do that?&btn1=Yes&btn2=No&btn2target=index.tcl&btn2keyvalpairs=filesystem_node $filesystem_node&btn1target=rmfile-1.tcl&btn1keyvalpairs=filesystem_node $filesystem_node file_node $fid\">remove</a> \]</font>"
+		}
+		
+		set file_menu "$file_menu_1$file_menu_2"
+		
+		set filesize_display "
+		<font size=-1>[util_commify_number $file_size] bytes</font>
+		"
+		if {$this_managed_p} {
+		    append html "<tr><td><img src=doc.gif>
+		    <a href=\"/users/$screen_name$curr_dir/$filename\">$filename</a>
+		    </td>
+		    <td valign=bottom align=left>&nbsp<font size=-1>$file_pretty_name</font></td>
+		    <td valign=bottom align=right>&nbsp$file_menu</td>
+		    </tr>
+		    "
+		} else {
+		    append html "<tr><td><img src=doc.gif>
+		    <a href=\"/users/$screen_name$curr_dir/$filename\">$filename</a>
+		    </td>
+		    <td valign=bottom align=right>&nbsp$filesize_display</td>
+		    <td valign=bottom align=right>&nbsp$file_menu</td>
+		    </tr>
+		    "
+		}
+	    }
+	}
+    }
+}
+
+append html "</table></ul>"
+
+# And off with the handle!
+ns_db releasehandle $db
+
+if {$view == "tree"} {
+    set file_count $counter
+}
+
+append html "
+$file_count file(s)
+</td></tr></table>
+<p>
+<table border=0 cellspacing=0 cellpadding=0 width=90%>
+<tr><td>$options_menu</td>
+<td align=right>\[ <a href=update-display.tcl?filesystem_node=$filesystem_node>display settings</a> \]
+</td></tr>
+</table>
+<br>
+"
+
+# To escape out of the blockquote mode
+append html "
+</blockquote>"
+
+# ------------------------ htmlFooterGeneration codeBlock ----
+
+# And here is our footer. Were you expecting someone else?
+ns_write "
+$html
+[ad_footer]
+"
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/homepage/joinnh.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/joinnh.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/joinnh.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,35 @@
+# joinnh.tcl,v 3.0 2000/02/06 03:46:44 ron Exp
+# File:     /homepage/joinnh.tcl
+# Date:     Thu Jan 27 09:09:43 EST 2000
+# Location: 42��21'N 71��04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Lets you join a neighbourhood
+
+set_form_variables
+# neighborhood_node, nid
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+set db [ns_db gethandle]
+
+if {![info exists nid] || [empty_string_p $nid]} {
+    set nid null
+}
+
+ns_db dml $db "
+update users_homepages
+set neighborhood_id = $nid
+where user_id = $user_id
+"
+
+# And let's go back to the main maintenance page
+ns_returnredirect neighborhoods.tcl?neighborhood_node=$neighborhood_node
Index: web/openacs/www/homepage/members.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/members.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/members.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,90 @@
+# members.tcl,v 3.0 2000/02/06 03:46:45 ron Exp
+# File:     /homepage/members.tcl
+# Date:     Thu Jan 27 05:45:19 EST 2000
+# Location: 42��21'N 71��04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Page to show members of a particular neighborhood
+
+	
+set_form_variables
+# neighborhood_node, nid
+
+set db [ns_db gethandle]
+
+set nh_name [database_to_tcl_string $db "
+select hp_relative_neighborhood_name($nid) 
+from dual"]
+
+ReturnHeaders
+
+set title "Members of $nh_name"
+
+# packet of html
+ns_write "
+[ad_header $title]
+<h2>$title</h2>
+[ad_context_bar_ws_or_index [list "neighborhoods.tcl?neighborhood_node=$neighborhood_node" "Neighborhoods"] $title] 
+<hr>
+<blockquote>
+
+    <table bgcolor=DDEEFF border=0 cellspacing=0 cellpadding=8 width=90%>
+    <tr><td>
+    <b>These are the members of $nh_name</b>
+    <ul>
+
+"
+
+set selection [ns_db select $db "
+select uh.user_id as user_id,
+u.screen_name as screen_name,
+u.first_names as first_names,
+u.last_name as last_name
+from users_homepages uh, users u
+where uh.user_id=u.user_id
+and uh.neighborhood_id=$nid
+order by last_name desc, first_names desc"]
+
+append html "
+<table border=0>
+"
+
+set counter 0
+
+while {[ns_db getrow $db $selection]} {
+    incr counter
+    set_variables_after_query
+    append html "
+    <tr>
+    <td><a href=\"/users/$screen_name\">$last_name, $first_names</a>
+    </td>
+    </tr>
+    "
+}
+
+# And finally, we're done with the database (duh)
+ns_db releasehandle $db
+
+if {$counter == 0} {
+    append html "
+    <tr>
+    <td>This neighborhood has no members
+    </td>
+    </tr>
+    "
+}
+
+append html "
+</table>
+</ul>
+$counter member(s)
+</table>
+</blockquote>
+"
+
+ns_write "
+$html
+[ad_footer]
+"
+
+
Index: web/openacs/www/homepage/mkdir-1.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/mkdir-1.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/mkdir-1.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,75 @@
+# mkdir-1.tcl,v 3.0 2000/02/06 03:46:46 ron Exp
+# File:     /homepage/mkdir-1.tcl
+# Date:     Fri Jan 14 18:48:26 EST 2000
+# Location: 42���21'N 71���04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Page to create a folder
+
+set_form_variables
+# filesystem_node
+
+# ------------------------------ initialization codeBlock ----
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+# ------------------------------ htmlGeneration codeBlock ----
+
+set dialog_body "Please choose a name for the folder. Also Choose a description for this folder.<br><form method=post action=mkdir-2.tcl> \
+  <input type=hidden name=filesystem_node value=$filesystem_node> \
+  <table border=0 cellpadding=15> \
+    <tr> \
+      <th align=left>Folder name: \
+      <td><input type=text size=16 name=dir_name></tr> \
+    <tr> \
+      <th align=left>Description: \
+      <td><input type=text size=40 name=dir_desc></tr> \
+  </table> \
+  <table border=0 cellpadding=0> \
+  <tr> \
+  <td><input type=submit value=Okay></form></td> \
+  <td><form method=get action=index.tcl> \
+  <input type=hidden name=filesystem_node value=$filesystem_node> \
+  <input type=submit value=Cancel></form></td> \
+  </tr> \
+  </table>"
+
+ns_returnredirect "dialog-class.tcl?title=Filesystem Management&text=$dialog_body"
+return
+
+ReturnHeaders
+
+set title "Create Folder"
+
+ns_write "
+[ad_header $title]
+<h2>$title</h2>
+[ad_context_bar_ws_or_index \
+        [list "index.tcl?filesystem_node=$filesystem_node" "Homepage Maintenance"] $title]
+<hr>
+<blockquote>
+
+<form method=post action=mkdir-2.tcl>
+  [export_form_vars filesystem_node]
+  <p><br>
+  <ul>
+  <table cellpadding=4>
+    <tr>
+      <th align=left>Folder Name:
+      <td><input type=text size=16 name=dir_name></tr>
+  </table>
+  <input type=submit value=\"Make It!\">
+  </ul>
+</form>
+
+</blockquote>
+[ad_footer]
+"
\ No newline at end of file
Index: web/openacs/www/homepage/mkdir-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/mkdir-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/mkdir-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,183 @@
+# mkdir-2.tcl,v 3.0 2000/02/06 03:46:47 ron Exp
+# File:     /homepage/mkdir-2.tcl
+# Date:     Fri Jan 14 18:48:26 EST 2000
+# Location: 42���21'N 71���04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Page to create a folder
+
+set_the_usual_form_variables
+# filesystem_node, dir_name, dir_desc
+
+# --------------------------- initialErrorCheck codeBlock ----
+
+set exception_count 0
+set exception_text ""
+
+# Recover if having the urge to elbow out dialog-class
+#if { ![info exists dir_name] || [empty_string_p $dir_name] } {
+#    incr exception_count
+#    append exception_text "
+#    <li>You did not specify a name for the folder."
+#}
+
+if { ![info exists filesystem_node] || [empty_string_p $filesystem_node] } {
+    ad_return_error "FileSystem Node Information Missing"
+}
+
+if {$exception_count > 0} { 
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+if { ![info exists dir_name] || [empty_string_p $dir_name] } {
+    ns_returnredirect "dialog-class.tcl?title=Filesystem Management&text=Unable to create the new folder you requested.<br>You did not provide a name for it.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+}
+
+if { ![info exists dir_desc] || [empty_string_p $dir_desc] } {
+    ns_returnredirect "dialog-class.tcl?title=Filesystem Management&text=Unable to create the new folder you requested.<br>You did not provide a description for it.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+}
+
+if {[regexp {.*/.*} $dir_name match]} {
+    ns_returnredirect "dialog-class.tcl?title=Access Management&text=Unable to create the requested folder.<br>Attempted to access some other directory.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+}
+
+if {[regexp {.*\.\..*} $dir_name match]} {
+    ns_returnredirect "dialog-class.tcl?title=Access Management&text=Unable to create the requested folder.<br>Tried to access parent directory.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+}
+
+
+
+# ------------------------------ initialization codeBlock ----
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+# ------------------------ initialDatabaseQuery codeBlock ----
+
+# The database handle (a thoroughly useless comment)
+set db [ns_db gethandle]
+
+# Checking for site-wide administration status
+set admin_p [ad_administrator_p $db $user_id]
+
+# This query will return the quota of the user
+# set sql "
+# select ((decode((select count(*) from
+#                 users_special_quotas
+#                 where user_id=$user_id),
+#                 0, [ad_parameter [ad_decode $admin_p \
+#                          0 NormalUserMaxQuota \
+#                          1 PrivelegedUserMaxQuota \
+#                          NormalUserMaxQuota] users],
+#                 (select max_quota from
+#                  users_special_quotas
+#                  where user_id=$user_id))) * pow(2,20)) -
+#       ((select count(*) * [ad_parameter DirectorySpaceRequirement users]
+#         from users_files
+#         where directory_p='t'
+#         and owner_id=$user_id) +
+#        (select nvl(sum(file_size),0)
+#         from users_files
+#         where directory_p='f'
+#         and owner_id=$user_id)) as quota_left,
+#        (select count(*) from users_files
+#         where filename='$QQdir_name'
+#         and parent_id=$filesystem_node) as dir_exists_p,
+#        hp_true_filename($filesystem_node) as dir_dir
+# from dual
+# "
+
+set sql "
+select trunc(hp_quota_max($user_id,[ad_parameter [ad_decode $admin_p \
+                                                  0 NormalUserMaxQuota \
+                                                  1 PrivelegedUserMaxQuota \
+                          NormalUserMaxQuota] users]) * power(2,20) - hp_quota_used($user_id,[ad_parameter DirectorySpaceRequirement users])) as quota_left,
+       hp_dir_exists('$QQdir_name',$filesystem_node) as dir_exists_p,
+       hp_true_filename($filesystem_node) as dir_dir
+"
+
+# Extract results from the query
+set selection [ns_db 1row $db $sql]
+
+# This will  assign the  variables their appropriate values 
+# based on the query.
+set_variables_after_query
+
+if {$quota_left < [ad_parameter DirectorySpaceRequirement users]} {
+    ns_returnredirect "dialog-class.tcl?title=User Quota Management&text=Unable to create the new folder you requested.<br>You have run out of quota space.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+
+    #ad_return_error "Unable to Create Folder" "Sorry, you do not have enough quota spa
+#ce available to create a new folder. A folder requires [util_commify_number [ad_parame
+#ter DirectorySpaceRequirement users]] bytes."
+    #return
+}
+
+if {$dir_exists_p != 0} {
+    ns_returnredirect "dialog-class.tcl?title=Filesystem Management&text=Unable to create the new folder you requested.<br>A folder with that name already exists.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+
+#    ad_return_error "Unable to Create Folder" "Sorry, the folder name you requested already exists."
+#    return
+}
+
+set access_denied_p [database_to_tcl_string $db "
+select hp_access_denied_p($filesystem_node,$user_id) from dual"]
+
+# Check to see whether the user is the owner of the filesystem node
+# for which access is requested.
+if {$access_denied_p} {
+    # Aha! url surgery attempted!
+    ad_return_error "Unable to Create Folder" "Unauthorized Access to the FileSystem"
+    return
+}
+
+set dir_full_name "[ad_parameter ContentRoot users]$dir_dir/$dir_name"
+
+if [catch {ns_mkdir "$dir_full_name"} errmsg] {
+    # directory already exists    
+    append exception_text "
+    <li>directory $dir_full_name could not be created."
+    ad_return_complaint 1 $exception_text
+    return
+} else {
+    ns_chmod "$dir_full_name" 0777
+    
+    set dml_sql "
+    insert into users_files
+    (file_id, 
+    filename, 
+    directory_p, 
+    file_pretty_name, 
+    file_size, 
+    owner_id, 
+    parent_id)
+    values
+    (users_file_id_seq.nextval, 
+    '$QQdir_name', 
+    't', 
+    '$QQdir_desc',
+    0, 
+    $user_id, 
+    $filesystem_node)"
+    
+    ns_db dml $db $dml_sql
+}
+
+# And off with the handle!
+ns_db releasehandle $db
+
+# And let's go back to the main maintenance page
+ns_returnredirect index.tcl?filesystem_node=$filesystem_node
Index: web/openacs/www/homepage/mkfile-1.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/mkfile-1.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/mkfile-1.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,83 @@
+# mkfile-1.tcl,v 3.0 2000/02/06 03:46:49 ron Exp
+# File:     /homepage/mkfile-1.tcl
+# Date:     Wed Jan 19 02:07:35 EST 2000
+# Location: 42���21'N 71���04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Page to create an empty file
+
+set_form_variables
+# filesystem_node
+
+# ------------------------------ initialization codeBlock ----
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+# ------------------------------ htmlGeneration codeBlock ----
+
+set dialog_body " \
+<form method=post action=mkfile-2.tcl> \
+  <input type=hidden name=filesystem_node value=$filesystem_node> \
+  <table cellpadding=0 border=0> \
+    <tr> \
+      <td align=left> \
+      Please choose a filename for the new file you wish to create. The filename you choose must end in .html (or .htm) if it's a HTML (webpage) file or it must end in .text (or .txt) if it's a plain text file. If your file does not have a .html, .htm, .text, or .txt extension then it will not be editable! \
+      </tr> \
+    <tr> \
+      <td align=left>filename to create: \
+      <td><input type=text size=16 name=new_name></tr> \
+    <tr> \
+      <td align=left>file description: \
+      <td><input type=text size=40 name=new_desc></tr> \
+  </table> \
+  <table border=0 cellpadding=0> \
+  <tr><td><input type=submit value=Okay></form></td> \
+      <td><form method=get action=index.tcl> \
+          <input type=hidden name=filesystem_node value=$filesystem_node> \
+          <input type=submit value=Cancel></form></td> \
+  </tr></table>"
+
+
+ns_returnredirect "dialog-class.tcl?title=Filesystem Management&text=$dialog_body"
+return
+
+ReturnHeaders
+
+set title "Create File"
+
+ns_write "
+[ad_header $title]
+<h2>$title</h2>
+[ad_context_bar_ws_or_index \
+        [list "index.tcl?filesystem_node=$filesystem_node" "Homepage Maintenance"] $title]
+<hr>
+<blockquote>
+
+<form method=post action=mkfile-2.tcl>
+  <input type=hidden name=filesystem_node value=$filesystem_node>
+  <p><br>
+  <ul>
+Please choose a filename for the new file you wish to create. The filename you choose must end in .html (or .htm) if it's a HTML (webpage) file, or it must end in .text (or .txt) if it's a plain text file. If your file does not have a .html, .htm, .text, or .txt extension then it will not be editable!<br>
+  <table cellpadding=4>
+    <tr>
+      <th align=left>filename to create:
+      <td><input type=text size=16 name=new_name></tr>
+  </table>
+  <input type=submit value=\"Create It!\">
+  </ul>
+</form>
+
+</blockquote>
+[ad_footer]
+"
+
+
+
Index: web/openacs/www/homepage/mkfile-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/mkfile-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/mkfile-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,126 @@
+# mkfile-2.tcl,v 3.0 2000/02/06 03:46:50 ron Exp
+# File:     /homepage/mkfile-2.tcl
+# Date:     Wed Jan 19 21:36:48 EST 2000
+# Location: 42���21'N 71���04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Page to create a new file
+
+set_the_usual_form_variables
+# filesystem_node, new_name, new_desc
+
+# --------------------------- initialErrorCheck codeBlock ----
+
+set exception_count 0
+set exception_text ""
+
+# Deactivated code. Due to the new dialog-class
+#if { ![info exists new_name] || [empty_string_p $new_name] } {
+#    incr exception_count
+#    append exception_text "
+#    <li>You did not specify a filename"
+#}
+
+if { ![info exists filesystem_node] || [empty_string_p $filesystem_node] } {
+    ad_return_error "FileSystem Node Information Missing"
+}
+
+if {$exception_count > 0} { 
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+if { ![info exists new_name] || [empty_string_p $new_name] } {
+    ns_returnredirect "dialog-class.tcl?title=Filesystem Management&text=Unable to create the new file you requested.<br>You did not provide a name for it.&btn1=Okay&btntarget=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+}
+
+if { ![info exists new_desc] || [empty_string_p $new_desc] } {
+    ns_returnredirect "dialog-class.tcl?title=Filesystem Management&text=Unable to create the new file you requested.<br>You did not provide a description for it.&btn1=Okay&btntarget=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+}
+
+if {[regexp {.*\.\..*} $new_name match]} {
+    ns_returnredirect "dialog-class.tcl?title=Access Management&text=Unable to create the requested file.<br>Attempted to access parent filesystem node.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+}
+
+if {[regexp {.*/.*} $new_name match]} {
+    ns_returnredirect "dialog-class.tcl?title=Access Management&text=Unable to create the requested file.<br>Attempted to access some other folder.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+}
+
+
+# ------------------------------ initialization codeBlock ----
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+# ------------------------ initialDatabaseQuery codeBlock ----
+
+# The database handle (a thoroughly useless comment)
+set db [ns_db gethandle]
+
+set dir_dir [database_to_tcl_string $db "
+select hp_true_filename($filesystem_node)
+from dual"]
+
+set new_fullname "[ad_parameter ContentRoot users]$dir_dir/$new_name"
+
+if {[file exists $new_fullname]} {
+    ns_returnredirect "dialog-class.tcl?title=Filesystem Management&text=Sorry, a file with that name already exists.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+}
+
+set access_denied_p [database_to_tcl_string $db "
+select hp_access_denied_p($filesystem_node,$user_id) from dual"]
+
+# Check to see whether the user is the owner of the filesystem node
+# for which access is requested.
+if {$access_denied_p} {
+    # Aha! url surgery attempted!
+    ad_return_error "Unable to Create File" "Unauthorized Access to the FileSystem"
+    return
+}
+
+if [catch {set filehandle1 [open "$new_fullname" w]} errmsg] {
+    # directory already exists    
+    append exception_text "
+    <li>file $new_fullname could not be created."
+    ad_return_complaint 1 $exception_text
+    return
+} else {
+    close $filehandle1
+    set dml_sql "
+    insert into users_files
+    (file_id, 
+    filename, 
+    directory_p, 
+    file_pretty_name, 
+    file_size, 
+    owner_id, 
+    parent_id)
+    values
+    (users_file_id_seq.nextval, 
+    '$QQnew_name', 
+    'f', 
+    '$QQnew_desc',
+    0, 
+    $user_id, 
+    $filesystem_node)"
+    
+    ns_db dml $db $dml_sql
+}
+
+# And off with the handle!
+ns_db releasehandle $db
+
+# And let's go back to the main maintenance page
+ns_returnredirect index.tcl?filesystem_node=$filesystem_node
Index: web/openacs/www/homepage/mknh-1.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/mknh-1.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/mknh-1.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,76 @@
+# mknh-1.tcl,v 3.0 2000/02/06 03:46:53 ron Exp
+# File:     /homepage/mknh-1.tcl
+# Date:     Thu Jan 27 01:06:47 EST 2000
+# Location: 42���21'N 71���04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Page to create a neighborhood
+
+set_form_variables
+# neighborhood_node
+
+# ------------------------------ initialization codeBlock ----
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+
+# ------------------------------ htmlGeneration codeBlock ----
+
+set dialog_body "Please choose a name for the neighborhood. Also Choose a description for this neighborhood.<br><form method=post action=mknh-2.tcl> \
+  <input type=hidden name=neighborhood_node value=$neighborhood_node> \
+  <table border=0 cellpadding=15> \
+    <tr> \
+      <th align=left>Neighborhood name: \
+      <td><input type=text size=16 name=nh_name></tr> \
+    <tr> \
+      <th align=left>Description: \
+      <td><input type=text size=66 name=nh_desc></tr> \
+  </table> \
+  <table border=0 cellpadding=0> \
+  <tr> \
+  <td><input type=submit value=Okay></form></td> \
+  <td><form method=get action=neighborhoods.tcl> \
+  <input type=hidden name=neighborhood_node value=$neighborhood_node> \
+  <input type=submit value=Cancel></form></td> \
+  </tr> \
+  </table>"
+
+ns_returnredirect "dialog-class.tcl?title=Neighborhood Management&text=$dialog_body"
+return
+
+ReturnHeaders
+
+set title "Create Neighborhood"
+
+ns_write "
+[ad_header $title]
+<h2>$title</h2>
+[ad_context_bar_ws_or_index \
+        [list "neighborhoods.tcl?neighborhood_node=$neighborhood_node" "Homepage Maintenance"] $title]
+<hr>
+<blockquote>
+
+<form method=post action=mknh-2.tcl>
+  [export_form_vars neighborhood_node]
+  <p><br>
+  <ul>
+  <table cellpadding=4>
+    <tr>
+      <th align=left>Neighborhood Name:
+      <td><input type=text size=16 name=nh_name></tr>
+  </table>
+  <input type=submit value=\"Make It!\">
+  </ul>
+</form>
+
+</blockquote>
+[ad_footer]
+"
\ No newline at end of file
Index: web/openacs/www/homepage/mknh-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/mknh-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/mknh-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,114 @@
+# mknh-2.tcl,v 3.1 2000/02/14 09:32:51 ron Exp
+# File:     /homepage/mkdir-2.tcl
+# Date:     Fri Jan 14 18:48:26 EST 2000
+# Location: 42���21'N 71���04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Page to create a Neighborhood
+
+set_the_usual_form_variables
+# neighborhood_node, nh_name, nh_desc
+
+# --------------------------- initialErrorCheck codeBlock ----
+
+set exception_count 0
+set exception_text ""
+
+# Recover if having the urge to elbow out dialog-class
+#if { ![info exists nh_name] || [empty_string_p $nh_name] } {
+#    incr exception_count
+#    append exception_text "
+#    <li>You did not specify a name for the Neighborhood."
+#}
+
+if { ![info exists neighborhood_node] || [empty_string_p $neighborhood_node] } {
+    ad_return_error "Neighborhood Node Information Missing"
+}
+
+if {$exception_count > 0} { 
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+if { ![info exists nh_name] || [empty_string_p $nh_name] } {
+    ns_returnredirect "dialog-class.tcl?title=Neighborhood Management&text=Unable to create the new neighborhood you requested.<br>You did not provide a name for it.&btn1=Okay&btn1target=neighborhoods.tcl&btn1keyvalpairs=neighborhood_node $neighborhood_node"
+    return
+}
+
+if { ![info exists nh_desc] || [empty_string_p $nh_desc] } {
+    ns_returnredirect "dialog-class.tcl?title=Neighborhood Management&text=Unable to create the new neighborhood you requested.<br>You did not provide a description for it.&btn1=Okay&btn1target=neighborhoods.tcl&btn1keyvalpairs=neighborhood_node $neighborhood_node"
+    return
+}
+
+if {[regexp {.*/.*} $nh_name match]} {
+    ns_returnredirect "dialog-class.tcl?title=Access Management&text=Unable to create the requested Neighborhood.<br>Attempted to access some other directory.&btn1=Okay&btn1target=neighborhoods.tcl&btn1keyvalpairs=neighborhood_node $neighborhood_node"
+    return
+}
+
+if {[regexp {.*\.\..*} $nh_name match]} {
+    ns_returnredirect "dialog-class.tcl?title=Access Management&text=Unable to create the requested Neighborhood.<br>Tried to access parent directory.&btn1=Okay&btn1target=neighborhoods.tcl&btn1keyvalpairs=neighborhood_node $neighborhood_node"
+    return
+}
+
+
+
+# ------------------------------ initialization codeBlock ----
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+# ------------------------ initialDatabaseQuery codeBlock ----
+
+# The database handle (a thoroughly useless comment)
+set db [ns_db gethandle]
+
+# Checking for site-wide administration status
+set admin_p [ad_administrator_p $db $user_id]
+
+set nh_exists_p [database_to_tcl_string $db "
+select count(*)
+from users_neighborhoods
+where neighborhood_name='$QQnh_name'
+and parent_id=$neighborhood_node"]
+
+if {$nh_exists_p != 0} {
+    ns_returnredirect "dialog-class.tcl?title=Neighborhood Management&text=Unable to create the new neighborhood you requested.<br>A Neighborhood with that name already exists.&btn1=Okay&btn1target=neighborhoods.tcl&btn1keyvalpairs=neighborhood_node $neighborhood_node"
+    return
+
+#    ad_return_error "Unable to Create Neighborhood" "Sorry, the Neighborhood name you requested already exists."
+#    return
+}
+
+if {$admin_p == 0} {
+    ns_returnredirect "dialog-class.tcl?title=Access Management&text=Unable to create the new neighborhood you requested.<br>Insufficient permission to perform requested database access in AddNeighborhood.&btn1=Okay&btn1target=neighborhoods.tcl&btn1keyvalpairs=neighborhood_node $neighborhood_node"
+    return
+    
+}
+
+set dml_sql "
+insert into users_neighborhoods
+(neighborhood_id, 
+ neighborhood_name,
+ description,  
+ parent_id)
+values
+(users_neighborhood_id_seq.nextval, 
+'$QQnh_name', 
+'$QQnh_desc',
+$neighborhood_node)"
+
+ns_db dml $db $dml_sql
+
+
+# And off with the handle!
+ns_db releasehandle $db
+
+# And let's go back to the main maintenance page
+ns_returnredirect neighborhoods.tcl?neighborhood_node=$neighborhood_node
Index: web/openacs/www/homepage/mksection-1.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/mksection-1.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/mksection-1.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,135 @@
+# mksection-1.tcl,v 3.1 2000/02/14 09:32:51 ron Exp
+# File:     /homepage/mkfile-2.tcl
+# Date:     Wed Jan 19 21:36:48 EST 2000
+# Location: 42���21'N 71���04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Page to create a new file
+
+set_the_usual_form_variables
+# filesystem_node, section_title, section_desc, section_type
+
+# --------------------------- initialErrorCheck codeBlock ----
+
+set exception_count 0
+set exception_text ""
+
+# Deactivated code. Due to the new dialog-class
+#if { ![info exists section_title] || [empty_string_p $section_title] } {
+#    incr exception_count
+#    append exception_text "
+#    <li>You did not specify a filename"
+#}
+
+if { ![info exists filesystem_node] || [empty_string_p $filesystem_node] } {
+    ad_return_error "FileSystem Node Information Missing"
+}
+
+if {$exception_count > 0} { 
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+if { ![info exists section_title] || [empty_string_p $section_title] } {
+    ns_returnredirect "dialog-class.tcl?title=Content Management&text=Unable to create the new section you requested.<br>You did not provide a name for it.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+}
+
+if { ![info exists section_desc] || [empty_string_p $section_desc] } {
+    ns_returnredirect "dialog-class.tcl?title=Content Management&text=Unable to create the new section you requested.<br>You did not provide a title for it.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+}
+
+if {[regexp {.*\.\..*} $section_title match]} {
+    ns_returnredirect "dialog-class.tcl?title=Access Management&text=Unable to create the requested file.<br>Attempted to access parent filesystem node.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+}
+
+if {[regexp {.*/.*} $section_title match]} {
+    ns_returnredirect "dialog-class.tcl?title=Access Management&text=Unable to create the requested file.<br>Attempted to access some other folder.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+}
+
+
+# ------------------------------ initialization codeBlock ----
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+# ------------------------ initialDatabaseQuery codeBlock ----
+
+# The database handle (a thoroughly useless comment)
+set db [ns_db gethandle]
+
+set dir_dir [database_to_tcl_string $db "
+select hp_true_filename($filesystem_node)
+from dual"]
+
+set new_fullname "[ad_parameter ContentRoot users]$dir_dir/$section_title"
+
+if {[file exists $new_fullname]} {
+    ns_returnredirect "dialog-class.tcl?title=Content Management&text=Sorry, a $section_type with that name already exists.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+}
+
+set access_denied_p [database_to_tcl_string $db "
+select hp_access_denied_p($filesystem_node,$user_id) from dual"]
+
+# Check to see whether the user is the owner of the filesystem node
+# for which access is requested.
+if {$access_denied_p} {
+    # Aha! url surgery attempted!
+    ad_return_error "Unable to Create File" "Unauthorized Access to the FileSystem"
+    return
+}
+
+if [catch {set filehandle1 [open "$new_fullname" w]} errmsg] {
+    # directory already exists    
+    append exception_text "
+    <li>file $new_fullname could not be created."
+    ad_return_complaint 1 $exception_text
+    return
+} else {
+    close $filehandle1
+    set dml_sql "
+    insert into users_files
+    (file_id, 
+    filename, 
+    directory_p, 
+    file_pretty_name, 
+    file_size, 
+    owner_id, 
+    parent_id,
+    managed_p)
+    values
+    (users_file_id_seq.nextval, 
+    '$QQsection_title', 
+    'f', 
+    '$QQsection_desc',
+    0, 
+    $user_id, 
+    $filesystem_node,
+    't')"
+    
+    ns_db dml $db $dml_sql
+}
+
+# And off with the handle!
+ns_db releasehandle $db
+
+# And let's go back to the main maintenance page
+ns_returnredirect index.tcl?filesystem_node=$filesystem_node
+
+
+
+
+
+
+
Index: web/openacs/www/homepage/move-1.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/move-1.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/move-1.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,187 @@
+# move-1.tcl,v 3.0 2000/02/06 03:46:56 ron Exp
+# File:     /homepage/move-1.tcl
+# Date:     Mon Jan 24 20:54:29 EST 2000
+# Location: 42���21'N 71���04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Page to move a file or folder
+
+set_form_variables
+# filesystem_node, move_node
+
+# ------------------------------ initialization codeBlock ----
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+# ------------------------------ htmlGeneration codeBlock ----
+
+set db [ns_db gethandle]
+set filename [database_to_tcl_string $db "
+select filename from users_files
+where file_id=$move_node"]
+
+set html "
+Please click on the directory to which<br>you would like to move `$filename':
+<br><p>
+<table border=0 cellpadding=0 cellspacing=0>"
+
+set user_root [database_to_tcl_string $db "
+select hp_get_filesystem_root_node($user_id) from dual"]
+
+# set selection [ns_db select $db "
+# select file_id as fid, filename, level, parent_id,
+# hp_filesystem_node_sortkey_gen(f.file_id) as generated_sort_key
+# from users_files f
+# where owner_id=$user_id
+# and directory_p='t'
+# and managed_p='f'
+# connect by prior file_id = parent_id
+# start with file_id=$user_root
+# order by generated_sort_key asc"]
+
+set selection [ns_db select $db "
+select file_id as fid, filename, hp_filesystem_node_level_gen(f.file_id,1,0) as level, parent_id,
+hp_filesystem_node_sortkey_gen(f.file_id,$user_root) as generated_sort_key
+from users_files f
+where owner_id=$user_id
+and directory_p='t'
+and managed_p='f'
+order by hp_filesystem_node_sortkey_gen(f.file_id,$user_root) asc"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    set level [expr $level - 1]
+    if {$level == 0} {
+	append html "<tr><td>[ad_space [expr $level * 8]]<img src=dir.gif>
+	<a href=move-2.tcl?filesystem_node=$filesystem_node&move_node=$move_node&move_target=$fid>Your root directory</a>"
+    } else {
+	append html "<tr><td>[ad_space [expr $level * 8]]<img src=dir.gif>
+	<a href=move-2.tcl?filesystem_node=$filesystem_node&move_node=$move_node&move_target=$fid>$filename</a>"
+    }
+}
+
+ns_db releasehandle $db
+
+append html "</table>"
+
+#set dialog_body "Please choose the directory to which you would like to move `$filename'<br> \
+#<table> \
+#$html \
+#</table>"
+
+#  <table border=0 cellpadding=0> \
+#  <tr> \
+#      <td><form method=get action=index.tcl> \
+#          <input type=hidden name=filesystem_node value=$filesystem_node> \
+#          <input type=submit value=Cancel></form></td> \
+#  </tr></table>"
+
+
+#ns_returnredirect "dialog-class.tcl?title=Filesystem Management&text=$dialog_body"
+#return
+
+ReturnHeaders
+
+set title "Filesystem Management"
+
+# Code deactivated Mon Jan 24 21:40:52 EST 2000
+#ns_write "
+#[ad_header $title]
+#<h2>$title</h2>
+#[ad_context_bar_ws_or_index \
+#        [list "index.tcl?filesystem_node=$filesystem_node" "Homepage Maintenance"] $title]
+#<hr>
+#<blockquote>
+#
+#$html
+#
+#<form method=post action=rename-2.tcl>
+#  <input type=hidden name=filesystem_node value=$filesystem_node>
+#  <input type=hidden name=move_node value=$move_node>
+#  <p><br>
+#  <ul> 
+#  <table cellpadding=4>
+#    <tr>
+#      <th align=left>new name for `$filename':
+#      <td><input type=text size=16 name=new_name></tr>
+#  </table>
+#  <input type=submit value=Rename>
+#  </ul>
+#</form>
+#
+#</blockquote>
+#[ad_footer]
+#"
+
+ns_write "
+<html>
+
+<head>
+<title>$title</title>
+<meta name=\"description\" content=\"Usman Y. Mobin's generic dialog class.\">
+<style>
+A:link {text-decoration:none; font-style:plain; font-weight:bold}
+A:vlink {text-decoration:none; font-style:plain; font-weight:bold}
+</style>
+</head>
+
+<body bgcolor=FFFFFF text=000000 link=000000 vlink=000000 alink=000000>
+<div align=center><center>
+
+<table border=0 
+        cellspacing=0 
+        cellpadding=0 
+        width=100%
+        height=100%>
+                <tr>
+                <td align=center valign=middle>
+
+                <table border=0
+                       cellspacing=0
+                       cellpadding=0>
+                        <tr bgcolor=000080>
+                        <td>
+                                <table border=0
+                                       cellspacing=0
+                                       cellpadding=6>
+                                        <tr bgcolor=000080>
+                                        <td>
+                                               <font color=FFFFFF>
+                                               $title
+                                               </font>
+                                        </td>
+                                        </tr>
+                                </table> 
+                        </td>
+                        </tr>
+                        <tr bgcolor=C0C0C0>
+                        <td align=center>
+                                <table border=0
+                                       cellspacing=0
+                                       cellpadding=25>
+                                         <tr align=center>
+                                         <td><p>
+                                                  $html
+                                         </td>
+                                         </tr>
+                                </table>
+                        </td>
+                        </tr>
+                </table>
+
+                </td>
+                </tr>
+</table>
+
+</center></div>
+</body>
+</html>
+"
Index: web/openacs/www/homepage/move-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/move-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/move-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,123 @@
+# move-2.tcl,v 3.0 2000/02/06 03:46:58 ron Exp
+# File:     /homepage/move-2.tcl
+# Date:     Mon Jan 24 22:03:59 EST 2000
+# Location: 42��21'N 71��04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Page to rename a file
+
+set_the_usual_form_variables
+# filesystem_node, move_node, move_target
+
+# --------------------------- initialErrorCheck codeBlock ----
+
+set exception_count 0
+set exception_text ""
+
+if { ![info exists move_node] || [empty_string_p $move_node] } {
+    ad_return_error "FileSystem Node for move Missing."
+    return
+}
+
+if { ![info exists move_target] || [empty_string_p $move_target] } {
+    ad_return_error "FileSystem Node for move target Missing."
+    return
+}
+
+if { ![info exists filesystem_node] || [empty_string_p $filesystem_node] } {
+    ad_return_error "FileSystem Node Information Missing"
+    return
+}
+
+if {$exception_count > 0} { 
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# ------------------------------ initialization codeBlock ----
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+# ------------------------ initialDatabaseQuery codeBlock ----
+
+# The database handle (a thoroughly useless comment)
+set db [ns_db gethandle]
+
+# Checking for site-wide administration status
+set admin_p [ad_administrator_p $db $user_id]
+
+# This query will return the quota of the user
+set sql "
+select filename as old_name,
+hp_true_filename($filesystem_node) as old_dir_name,
+hp_true_filename($move_target) as new_dir_name,
+hp_true_filename($move_node) as move_filename
+from users_files, dual
+where file_id=$move_node
+"
+
+# Extract results from the query
+set selection [ns_db 1row $db $sql]
+
+# This will  assign the  variables their appropriate values 
+# based on the query.
+set_variables_after_query
+
+set access_denied_p [database_to_tcl_string $db "
+select hp_access_denied_p($move_node,$user_id) from dual"]
+
+# Check to see whether the user is the owner of the filesystem node
+# for which access is requested.
+if {$access_denied_p == 1} {
+    # Aha! url surgery attempted!
+    ad_return_error "Unable to Rename Filesystem Node" "Unauthorized Access to the FileSystem"
+    return
+}
+
+
+set old_full_name "[ad_parameter ContentRoot users]$move_filename"
+set new_full_name "[ad_parameter ContentRoot users]$new_dir_name/$old_name"
+ns_log Debug "old = $old_full_name, new = $new_full_name"
+
+if {[file exists $new_full_name]} {
+    ns_returnredirect "dialog-class.tcl?title=Filesystem Management&text=A file with the name `$old_name'<br>already exists in the target directory.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return    
+}
+
+
+if [catch {ns_rename "$old_full_name" "$new_full_name"} errmsg] {
+    # unable to rename
+    append exception_text "
+    <li>File $old_full_name could not be moved."
+    ad_return_complaint 1 $exception_text
+    return
+} else {
+    set dml_sql "
+    update users_files
+    set parent_id=$move_target
+    where file_id=$move_node
+    "
+    ns_db dml $db $dml_sql
+}
+
+# And off with the handle!
+ns_db releasehandle $db
+
+# And let's go back to the main maintenance page
+ns_returnredirect index.tcl?filesystem_node=$filesystem_node
+
+
+
+
+
+
+
+
Index: web/openacs/www/homepage/movenh-1.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/movenh-1.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/movenh-1.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,183 @@
+# movenh-1.tcl,v 3.0 2000/02/06 03:46:59 ron Exp
+# File:     /homepage/movenh-1.tcl
+# Date:     Thu Jan 27 02:44:02 EST 2000
+# Location: 42���21'N 71���04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Page to move a neighbourhood
+
+set_form_variables
+# neighborhood_node, move_node
+
+# ------------------------------ initialization codeBlock ----
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+# ------------------------------ htmlGeneration codeBlock ----
+
+set db [ns_db gethandle]
+set neighborhood_name [database_to_tcl_string $db "
+select neighborhood_name from users_neighborhoods
+where neighborhood_id=$move_node"]
+
+set html "
+Please click on the neighborhood to which<br>you would like to move `$neighborhood_name':
+<br><p>
+<table border=0 cellpadding=0 cellspacing=0>"
+
+set user_root [database_to_tcl_string $db "
+select hp_get_neighborhood_root_node() from dual"]
+
+# select neighborhood_id as nid, neighborhood_name, level, parent_id,
+# hp_neighborhood_sortkey_gen(neighborhood_id) as generated_sort_key,
+# hp_neighborhood_in_subtree_p($move_node, neighborhood_id) as is_child_p
+# from users_neighborhoods
+# connect by prior neighborhood_id = parent_id
+# start with neighborhood_id=$user_root
+# order by generated_sort_key asc
+
+set selection [ns_db select $db "
+select neighborhood_id as nid, neighborhood_name, 
+hp_neighborhood_level_gen(neighborhood_id,1,0) as level, parent_id,
+hp_neighborhood_sortkey_gen(neighborhood_id,$user_root) as generated_sort_key,
+hp_neighborhood_in_subtree_p($move_node, neighborhood_id) as is_child_p
+from users_neighborhoods
+order by generated_sort_key asc"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    set level [expr $level - 1]
+    
+    if {$is_child_p} {
+    } else {
+    append html "<tr><td>[ad_space [expr $level * 8]]
+	<a href=movenh-2.tcl?neighborhood_node=$neighborhood_node&move_node=$move_node&move_target=$nid>$neighborhood_name</a>"
+    }
+
+}
+
+ns_db releasehandle $db
+
+append html "</table>"
+
+#set dialog_body "Please choose the directory to which you would like to move `$neighborhood_name'<br> \
+#<table> \
+#$html \
+#</table>"
+
+#  <table border=0 cellpadding=0> \
+#  <tr> \
+#      <td><form method=get action=index.tcl> \
+#          <input type=hidden name=neighborhood_node value=$neighborhood_node> \
+#          <input type=submit value=Cancel></form></td> \
+#  </tr></table>"
+
+
+#ns_returnredirect "dialog-class.tcl?title=Neighborhood Management&text=$dialog_body"
+#return
+
+ReturnHeaders
+
+set title "Neighborhood Management"
+
+# Code deactivated Mon Jan 24 21:40:52 EST 2000
+#ns_write "
+#[ad_header $title]
+#<h2>$title</h2>
+#[ad_context_bar_ws_or_index \
+#        [list "index.tcl?neighborhood_node=$neighborhood_node" "Homepage Maintenance"] $title]
+#<hr>
+#<blockquote>
+#
+#$html
+#
+#<form method=post action=rename-2.tcl>
+#  <input type=hidden name=neighborhood_node value=$neighborhood_node>
+#  <input type=hidden name=move_node value=$move_node>
+#  <p><br>
+#  <ul> 
+#  <table cellpadding=4>
+#    <tr>
+#      <th align=left>new name for `$neighborhood_name':
+#      <td><input type=text size=16 name=new_name></tr>
+#  </table>
+#  <input type=submit value=Rename>
+#  </ul>
+#</form>
+#
+#</blockquote>
+#[ad_footer]
+#"
+
+ns_write "
+<html>
+
+<head>
+<title>$title</title>
+<meta name=\"description\" content=\"Usman Y. Mobin's generic dialog class.\">
+<style>
+A:link {text-decoration:none; font-style:plain; font-weight:bold}
+A:vlink {text-decoration:none; font-style:plain; font-weight:bold}
+</style>
+</head>
+
+<body bgcolor=FFFFFF text=000000 link=000000 vlink=000000 alink=000000>
+<div align=center><center>
+
+<table border=0 
+        cellspacing=0 
+        cellpadding=0 
+        width=100%
+        height=100%>
+                <tr>
+                <td align=center valign=middle>
+
+                <table border=0
+                       cellspacing=0
+                       cellpadding=0>
+                        <tr bgcolor=000080>
+                        <td>
+                                <table border=0
+                                       cellspacing=0
+                                       cellpadding=6>
+                                        <tr bgcolor=000080>
+                                        <td>
+                                               <font color=FFFFFF>
+                                               $title
+                                               </font>
+                                        </td>
+                                        </tr>
+                                </table> 
+                        </td>
+                        </tr>
+                        <tr bgcolor=C0C0C0>
+                        <td align=center>
+                                <table border=0
+                                       cellspacing=0
+                                       cellpadding=25>
+                                         <tr align=center>
+                                         <td><p>
+                                                  $html
+                                         </td>
+                                         </tr>
+                                </table>
+                        </td>
+                        </tr>
+                </table>
+
+                </td>
+                </tr>
+</table>
+
+</center></div>
+</body>
+</html>
+"
Index: web/openacs/www/homepage/movenh-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/movenh-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/movenh-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,94 @@
+# movenh-2.tcl,v 3.0 2000/02/06 03:47:00 ron Exp
+# File:     /homepage/movenh-2.tcl
+# Date:     Thu Jan 27 02:54:54 EST 2000
+# Location: 42��21'N 71��04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Page to move a neighborhood
+
+set_the_usual_form_variables
+# neighborhood_node, move_node, move_target
+
+# --------------------------- initialErrorCheck codeBlock ----
+
+set exception_count 0
+set exception_text ""
+
+if { ![info exists move_node] || [empty_string_p $move_node] } {
+    ad_return_error "Neighborhood Node for move Missing."
+    return
+}
+
+if { ![info exists move_target] || [empty_string_p $move_target] } {
+    ad_return_error "Neighborhood Node for move target Missing."
+    return
+}
+
+if { ![info exists neighborhood_node] || [empty_string_p $neighborhood_node] } {
+    ad_return_error "Neighborhood Node Information Missing"
+    return
+}
+
+if {$exception_count > 0} { 
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# ------------------------------ initialization codeBlock ----
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+# ------------------------ initialDatabaseQuery codeBlock ----
+
+# The database handle (a thoroughly useless comment)
+set db [ns_db gethandle]
+
+# Checking for site-wide administration status
+set admin_p [ad_administrator_p $db $user_id]
+
+if {$admin_p == 0} {
+    ns_returnredirect "dialog-class.tcl?title=Access Management&text=Unable to move the neighborhood you requested.<br>Insufficient permission to perform requested database access in MoveNeighborhood.&btn1=Okay&btn1target=neighborhoods.tcl&btn1keyvalpairs=neighborhood_node $neighborhood_node"
+    return
+    
+}
+
+set dml_sql "
+update users_neighborhoods
+set parent_id=$move_target
+where neighborhood_id=$move_node
+"
+
+ns_db dml $db $dml_sql
+
+
+# And off with the handle!
+ns_db releasehandle $db
+
+# And let's go back to the main maintenance page
+ns_returnredirect neighborhoods.tcl?neighborhood_node=$neighborhood_node
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/homepage/neighborhoods.help
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/neighborhoods.help,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/neighborhoods.help	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,42 @@
+<%= [ad_header "Help for Homepage Maintenance"] %>
+
+<h2>Help</h2>
+
+for Neighbourhoods Page
+<hr>
+
+1&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Neighbourhoods Page for users
+<p>
+The neighbourhoods page lets you browse through neighbourhoods. You
+can join a neighbourhood by clicking on the [join] button besides a
+neighbourhood's entry in the list. Similarly, the [members] button
+lets you view all the members of a neighbourhood. As a normal user,
+you cannot create, modify, delete, move, or rename neighbourhoods. An
+attempt at doing so will result only in a meaningless error message
+such as "Insufficient permission to perform requested database access
+in AddNeighborhood". The neighbourhoods page is located at
+/homepage/neighbourhoods.tcl. Alternatively, there is a link to it
+from your workspace.
+<p>
+
+2&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Neighbourhoods Page for adminitrators
+<p>
+
+Administration of neighbourhoods is done at
+/homepage/neighbourhoods.tcl. This page will hereby be referred to as
+the "neighbourhoods page". If the homepage module is enabled in your
+system, a link should appear to the neighbourhoods page at your
+workspace. The neighbourhoods page is essentially for browsing through
+neighbourhoods, viewing their members or even joining a
+neighbourhood. Additionally, site wide administrators can create
+neighbourhoods by pressing the [create-neighborhood] button above the
+neighbourhoods listing; remove neighbourhoods by pressing the [remove]
+button besides a neighbourhoods name; change neighbourhood hierarchy
+by pressing the [move] button and moving neighbourhoods around; or
+change the name or description of a neighbourhood by pressing the
+[rename] button besides a neighbourhood name. Administrators should
+mind the five hundred letter maximum limit on neighbourhood names and
+a four thousand letter limit on neighbourhood descriptions.
+<p>
+
+<%= [ad_footer] %>
Index: web/openacs/www/homepage/neighborhoods.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/neighborhoods.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/neighborhoods.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,326 @@
+# neighborhoods.tcl,v 3.0 2000/02/06 03:47:01 ron Exp
+# File:     /homepage/neighborhoods.tcl
+# Date:     Thu Jan 27 00:30:05 EST 2000
+# Location: 42��21'N 71��04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  User Content Main Page
+
+set_form_variables 0
+# neighborhood_node
+
+# ------------------------------ initialization codeBlock ----
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# ------------------------ initialDatabaseQuery codeBlock ----
+
+# The database handle (a thoroughly useless comment)
+set db [ns_db gethandle]
+
+# This will tell us whether the user has a page or not.
+set haspage_p [database_to_tcl_string $db "
+select count(*)
+from users_homepages
+where user_id=$user_id"]
+
+# This query will extract information about the user from the
+# database
+set selection [ns_db 0or1row $db "
+select screen_name
+from users
+where user_id=$user_id"]
+
+if {[empty_string_p $selection]} {
+    set screen_name ""
+} else {
+    # This will assign the appropriate values to the appropriate
+    # variables based on the query results.
+    set_variables_after_query
+}    
+
+# Checking for site-wide administration status
+set admin_p [ad_administrator_p $db $user_id]
+
+set adminhtml "You are not an administrator and cannot add/delete neighborhoods"
+
+if {$admin_p} {
+    set adminhtml "You are an administrator and can add/delete neighborhoods"
+}
+
+# If neighborhood node is not specified, go to user's root directory
+if {![info exists neighborhood_node] || [empty_string_p $neighborhood_node]} {
+    set neighborhood_node [database_to_tcl_string $db "
+    select hp_get_neighborhood_root_node() from dual"]
+}
+
+set cookies [ns_set get [ns_conn headers] Cookie]
+if {[regexp {.*neighborhood_view=([^ ;]*).*} $cookies match cookie_view]} {
+    # we have a match
+    set view $cookie_view
+} else {
+    set view [ad_parameter DefaultView users]
+}
+
+if {![info exists view] || [empty_string_p $view]} {
+    set view "tree"
+}
+
+set userhtml ""
+if {$haspage_p} {
+
+    set selection [ns_db 0or1row $db "
+    select neighborhood_id 
+    from users_homepages
+    where user_id=$user_id
+    "]
+
+    set_variables_after_query
+
+    if {![info exists neighborhood_id] || [empty_string_p $neighborhood_id]} {
+	set your_nh "&lt you haven't joined one &gt"
+    } else {
+	set your_nh [database_to_tcl_string $db "
+	select hp_relative_neighborhood_name($neighborhood_id)
+	from dual"]
+	append your_nh "[ad_space 3]<a href=joinnh.tcl?neighborhood_node=$neighborhood_node>leave it!</a>"
+    }
+    
+    set userhtml "Your neighborhood - $your_nh"
+    
+}
+
+# And off with the handle!
+ns_db releasehandle $db
+
+
+# ----------------------- initialHtmlGeneration codeBlock ----
+
+# Set the page title
+set title "Neighborhoods"
+
+# Return the http headers. (an awefully useless comment)
+ReturnHeaders
+
+if {[empty_string_p $screen_name]} {
+    set screenhtml "Your screen name: &lt none set up &gt -  Click <a href=/pvt/basic-info-update.tcl>here</a> to set one up."
+} else {
+    set screenhtml "Your screen name: $screen_name"
+}
+
+
+# Send the first packet of html. The reason for sending the
+# first packet (with the page heading) as early as possible
+# is that otherwise the user might find the system somewhat
+# unresponsive if it takes too long to query the database.
+ns_write "
+[ad_header $title]
+<h2>$title</h2>
+[ad_context_bar_ws_or_index $title]
+<hr>
+[help_upper_right_menu_b]
+$screenhtml<br>
+$adminhtml<br>
+<p>
+$userhtml<br>
+<blockquote>
+"
+
+# The database handle (a thoroughly useless comment)
+set db [ns_db gethandle]
+
+set sql "
+select parent_id as parent_node
+from users_neighborhoods
+where neighborhood_id = $neighborhood_node
+"
+
+# Extract results from the query
+set selection [ns_db 1row $db $sql]
+
+# This will  assign the  variables their appropriate values 
+# based on the query.
+set_variables_after_query
+
+if {![info exists parent_node] || [empty_string_p $parent_node]} {
+    set parent_html ""
+} else {
+    
+    set parent_html "
+    <tr><td><img src=back.gif>
+    <a href=neighborhoods.tcl?neighborhood_node=$parent_node>Parent Neighborhood</a>
+    </td></tr>
+    <tr><td>&nbsp;</td></tr>
+    "
+}
+
+set curr_neighborhood [database_to_tcl_string $db "
+select hp_true_neighborhood_name($neighborhood_node) from dual"]
+
+set child_count [database_to_tcl_string $db "
+select hp_get_nh_child_count($neighborhood_node) from dual"]
+
+# This menu displays a list of options which the user has
+# available for the current neighborhood_node (directory).
+set options_menu "\[ <a href=mknh-1.tcl?neighborhood_node=$neighborhood_node>create neighborhood</a> \]"
+
+# View Selection
+
+
+
+if {$view == "tree"} {
+
+    append html "
+    <br>
+    <table border=0 cellspacing=0 cellpadding=0 width=90%>
+    <tr><td>$options_menu
+    <td align=right>\[ <a href=set-view-nh.tcl?view=normal&neighborhood_node=$neighborhood_node>normal view</a> | tree view \]
+    </tr>
+    </table>
+    <br>
+    <table bgcolor=DDEEFF border=0 cellspacing=0 cellpadding=8 width=90%>
+    <tr><td>
+    <b>You are browsing $curr_neighborhood</b>
+    <ul>
+    <table border=0>
+    $parent_html
+    "
+
+    set counter 0
+
+# select neighborhood_id as nid, neighborhood_name, 
+#                level, 
+#                description,
+#                parent_id,
+# 	hp_neighborhood_sortkey_gen(neighborhood_id) as generated_sort_key
+# 	from users_neighborhoods
+# 	where level > 1
+# 	connect by prior neighborhood_id = parent_id
+# 	start with neighborhood_id=$neighborhood_node
+# 	order by generated_sort_key asc"
+
+    
+    if {$child_count==0} {
+	#append html "
+	#<tr><td>There are no sub-neighborhoods in this neighborhood</td></tr>"
+	append html ""
+    } else {
+	set selection [ns_db select $db "
+	select neighborhood_id as nid, neighborhood_name, 
+               hp_neighborhood_level_gen(neighborhood_id,1,0) as level, 
+               description,
+               parent_id,
+	hp_neighborhood_sortkey_gen(neighborhood_id,hp_get_neighborhood_root_node()) as generated_sort_key
+	from users_neighborhoods
+	where hp_neighborhood_level_gen(neighborhood_id,1,0) > 1
+        and  hp_neighborid_is_subnode(neighborhood_id,$neighborhood_node) = 't'
+	order by generated_sort_key asc"]
+	while {[ns_db getrow $db $selection]} {
+	    incr counter
+	    set_variables_after_query
+	    set level [expr $level - 2]
+
+	    set neighborhood_menu "<font size=-1><a href=\"dialog-class.tcl?title=Neighborhood Management&text=This will delete the Neighborhood `$neighborhood_name' and all its sub-neighborhoods permanently.<br>Are you certain you would like to do that?&btn1=Yes&btn2=No&btn2target=neighborhoods.tcl&btn2keyvalpairs=neighborhood_node $neighborhood_node&btn1target=rmnh-1.tcl&btn1keyvalpairs=neighborhood_node $neighborhood_node dir_node $nid\">remove</a> | <a href=\"renamenh-1.tcl?neighborhood_node=$neighborhood_node&rename_node=$nid\">rename</a> | <a href=movenh-1.tcl?neighborhood_node=$neighborhood_node&move_node=$nid>move</a> | <a href=members.tcl?neighborhood_node=$neighborhood_node&nid=$nid>members</a> | <a href=joinnh.tcl?neighborhood_node=$neighborhood_node&nid=$nid>join</a></font>
+	    "
+				
+	    append html "<tr><td valign=top>[ad_space [expr $level * 8]]
+	    <a href=neighborhoods.tcl?neighborhood_node=$nid>$neighborhood_name</a>
+	    </td>
+	    <td valign=top align=left>&nbsp<font size=-1>$description</font></td>
+	    <td valign=top>&nbsp$neighborhood_menu</td></tr>"
+	    
+	}
+    }
+    
+
+} else {
+    
+    # This is when the view is normal
+    append html "
+    <br>
+    <table border=0 cellspacing=0 cellpadding=0 width=90%>
+    <tr><td>$options_menu
+    <td align=right>\[ normal view | <a href=set-view-nh.tcl?view=tree&neighborhood_node=$neighborhood_node>tree view</a> \]
+    </tr>
+    </table>
+    <br>
+    <table bgcolor=DDEEFF cellpadding=8 width=90%>
+    <tr><td>
+    <b>You are browsing $curr_neighborhood</b>
+    <ul>
+    <table border=0>
+    $parent_html
+    "
+    
+    if {$child_count==0} {
+	#append html "
+	#<tr><td>There are no files in this directory</td></tr>"
+	append html ""
+    } else {
+	set selection [ns_db select $db "
+	select neighborhood_id as nid, neighborhood_name,
+	       description
+	from users_neighborhoods
+	where parent_id=$neighborhood_node
+	order by neighborhood_name asc"]
+	while {[ns_db getrow $db $selection]} {
+	    set_variables_after_query
+
+	    set neighborhood_menu "<font size=-1><a href=\"dialog-class.tcl?title=Neighborhood Management&text=This will delete the Neighborhood `$neighborhood_name' and all its sub-neighborhoods permanently.<br>Are you certain you would like to do that?&btn1=Yes&btn2=No&btn2target=neighborhoods.tcl&btn2keyvalpairs=neighborhood_node $neighborhood_node&btn1target=rmnh-1.tcl&btn1keyvalpairs=neighborhood_node $neighborhood_node dir_node $nid\">remove</a> | <a href=\"renamenh-1.tcl?neighborhood_node=$neighborhood_node&rename_node=$nid\">rename</a> | <a href=movenh-1.tcl?neighborhood_node=$neighborhood_node&move_node=$nid>move</a> | <a href=members.tcl?neighborhood_node=$neighborhood_node&nid=$nid>members</a> | <a href=joinnh.tcl?neighborhood_node=$neighborhood_node&nid=$nid>join</a></font>
+	    "
+				
+	    append html "<tr><td valign=top>
+	    <a href=neighborhoods.tcl?neighborhood_node=$nid>$neighborhood_name</a>
+	    </td>
+	    <td valign=top align=left>&nbsp<font size=-1>$description</font></td>
+	    <td valign=top>&nbsp$neighborhood_menu</td></tr>"
+	    
+	}   
+    }
+}
+
+
+append html "</table></ul>"
+
+# And off with the handle!
+ns_db releasehandle $db
+
+if {$view == "tree"} {
+    set child_count $counter
+}
+
+append html "
+$child_count neighborhood(s)
+</td></tr></table>
+<p>
+<table border=0 cellspacing=0 cellpadding=0 width=90%>
+<tr><td>$options_menu</td>
+<td align=right>\[ <a href=all.tcl>list all homepages</a> \]
+</td></tr>
+</table>
+<br>
+"
+
+# To escape out of the blockquote mode
+append html "
+</blockquote>"
+
+# ------------------------ htmlFooterGeneration codeBlock ----
+
+# And here is our footer. Were you expecting someone else?
+ns_write "
+$html
+[ad_footer]
+"
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/homepage/publish-1.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/publish-1.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/publish-1.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,60 @@
+# publish-1.tcl,v 3.0 2000/02/06 03:47:02 ron Exp
+# File:     /homepage/mkdir-1.tcl
+# Date:     Fri Jan 14 18:48:26 EST 2000
+# Location: 42���21'N 71���04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Page to create a folder
+
+set_form_variables
+# filesystem_node
+
+# ------------------------------ initialization codeBlock ----
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+set db [ns_db gethandle]
+set new_type_id [database_to_tcl_string $db "
+select users_type_id_seq.nextval from dual" 1]
+
+# ------------------------------ htmlGeneration codeBlock ----
+
+set dialog_body "Provide characteristics of the new content:<br><form method=post action=publish-2.tcl> \
+  <input type=hidden name=filesystem_node value=$filesystem_node> \
+  <input type=hidden name=new_type_id value=$new_type_id> \
+  <table border=0 cellpadding=15> \
+    <tr> \
+      <th align=left>Content type: </td> \
+      <td><input type=text size=16 name=content_type><br>(e.g. book)</td></tr> \
+    <tr> \
+      <th align=left>Very short name: </td> \
+      <td><input type=text size=16 name=very_short_name><br>(e.g. nerdguide)</td></tr> \
+    <tr> \
+      <th align=left>Full name: </td> \
+      <td><input type=text size=30 name=full_name><br>(e.g. Mobin's Guide to Becoming a Better Nerd)</td></tr> \
+    <tr> \
+      <th align=left>Subsections: </td> \
+      <td><input type=text size=30 name=sub_section><br>(e.g. for a book, this should be `chapter')</td></tr> \
+  </table> \
+  <table border=0 cellpadding=0> \
+  <tr> \
+  <td><input type=submit value=Okay></form></td> \
+  <td><form method=get action=index.tcl> \
+  <input type=hidden name=filesystem_node value=$filesystem_node> \
+  <input type=submit value=Cancel></form></td> \
+  </tr> \
+  </table>"
+
+ns_returnredirect "dialog-class.tcl?title=Content Management&text=$dialog_body"
+return
+
+
+
Index: web/openacs/www/homepage/publish-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/publish-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/publish-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,286 @@
+# publish-2.tcl,v 3.0 2000/02/06 03:47:03 ron Exp
+# File:     /homepage/mkdir-2.tcl
+# Date:     Fri Jan 14 18:48:26 EST 2000
+# Location: 42���21'N 71���04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Page to create a folder
+
+set_the_usual_form_variables
+# filesystem_node, content_type, very_short_name, full_name, new_type_id, sub_section
+
+# --------------------------- initialErrorCheck codeBlock ----
+
+set exception_count 0
+set exception_text ""
+
+# Recover if having the urge to elbow out dialog-class
+#if { ![info exists very_short_name] || [empty_string_p $very_short_name] } {
+#    incr exception_count
+#    append exception_text "
+#    <li>You did not specify a name for the folder."
+#}
+
+if { ![info exists filesystem_node] || [empty_string_p $filesystem_node] } {
+    ad_return_error "FileSystem Node Information Missing"
+}
+
+if { ![info exists new_type_id] || [empty_string_p $new_type_id] } {
+    ad_return_error "new_type_id information missing"
+}
+
+if {$exception_count > 0} { 
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+if { ![info exists very_short_name] || [empty_string_p $very_short_name] } {
+    ns_returnredirect "dialog-class.tcl?title=Filesystem Management&text=Unable to create the new folder requested by the content management system.<br>It did not provide a name for it beause you did not provide 'very short name' for the content.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+}
+
+if { ![info exists content_type] || [empty_string_p $content_type] } {
+    ns_returnredirect "dialog-class.tcl?title=Content Management&text=Unable to create the new cotent type you requested.<br>You did not provide a name for it.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+}
+
+if { ![info exists sub_section] || [empty_string_p $sub_section] } {
+    ns_returnredirect "dialog-class.tcl?title=Content Management&text=Unable to create the new cotent type you requested.<br>You did not provide a logical sub-class for it.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+}
+
+if { ![info exists full_name] || [empty_string_p $full_name] } {
+    ns_returnredirect "dialog-class.tcl?title=Content Management&text=Unable to create the new cotent you requested.<br>You did not provide a full name for it.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+}
+
+if {[regexp {.*/.*} $very_short_name match]} {
+    ns_returnredirect "dialog-class.tcl?title=Access Management&text=Unable to create the requested folder.<br>Attempted to access some other directory.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+}
+
+if {[regexp {.*\.\..*} $very_short_name match]} {
+    ns_returnredirect "dialog-class.tcl?title=Access Management&text=Unable to create the requested folder.<br>Tried to access parent directory.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+}
+
+
+
+# ------------------------------ initialization codeBlock ----
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+# ------------------------ initialDatabaseQuery codeBlock ----
+
+# The database handle (a thoroughly useless comment)
+set db [ns_db gethandle]
+
+# Checking for site-wide administration status
+set admin_p [ad_administrator_p $db $user_id]
+
+
+
+# set sql "
+# select ((decode((select count(*) from
+#                 users_special_quotas
+#                 where user_id=$user_id),
+#                 0, [ad_parameter [ad_decode $admin_p \
+#                          0 NormalUserMaxQuota \
+#                          1 PrivelegedUserMaxQuota \
+#                          NormalUserMaxQuota] users],
+#                 (select max_quota from
+#                  users_special_quotas
+#                  where user_id=$user_id))) * power(2,20)) -
+#       ((select count(*) * [ad_parameter DirectorySpaceRequirement users]
+#         from users_files
+#         where directory_p='t'
+#         and owner_id=$user_id) +
+#        (select nvl(sum(file_size),0)
+#         from users_files
+#         where directory_p='f'
+#         and owner_id=$user_id)) as quota_left,
+#        (select count(*) from users_files
+#         where filename='$very_short_name'
+#         and parent_id=$filesystem_node) as dir_exists_p,
+#        hp_true_filename($filesystem_node) as dir_dir
+# from dual
+# "
+
+# This query will return the quota of the user
+# set sql "
+# select ((decode((select count(*) from
+#                 users_special_quotas
+#                 where user_id=$user_id),
+#                 0, [ad_parameter [ad_decode $admin_p \
+#                          0 NormalUserMaxQuota \
+#                          1 PrivelegedUserMaxQuota \
+#                          NormalUserMaxQuota] users],
+#                 (select max_quota from
+#                  users_special_quotas
+#                  where user_id=$user_id))) * power(2,20)) -
+#       ((select count(*) * [ad_parameter DirectorySpaceRequirement users]
+#         from users_files
+#         where directory_p='t'
+#         and owner_id=$user_id) +
+#        (select nvl(sum(file_size),0)
+#         from users_files
+#         where directory_p='f'
+#         and owner_id=$user_id)) as quota_left,
+#        (select count(*) from users_files
+#         where filename='$very_short_name'
+#         and parent_id=$filesystem_node) as dir_exists_p,
+#        hp_true_filename($filesystem_node) as dir_dir
+# from dual
+# "
+
+set sql "
+select (trunc(hp_quota_max($user_id,[ad_parameter [ad_decode $admin_p 0 NormalUserMaxQuota 1 PrivelegedUserMaxQuota PrivelegedUserMaxQuota] users]) * power(2,20))) - hp_quota_used($user_id,[ad_parameter DirectorySpaceRequirement users]) as quota_left,
+hp_directory_exists('$very_short_name'::varchar,$filesystem_node) as dir_exists_p,
+hp_true_filename($filesystem_node) as dir_dir
+from dual"
+
+# Extract results from the query
+set selection [ns_db 1row $db $sql]
+
+# This will  assign the  variables their appropriate values 
+# based on the query.
+set_variables_after_query
+
+if {$quota_left < [ad_parameter DirectorySpaceRequirement users]} {
+    ns_returnredirect "dialog-class.tcl?title=User Quota Management&text=Unable to create the new folder requested by the content management system.<br>You have run out of quota space.&btn1=Okay&btntarget=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+
+    #ad_return_error "Unable to Create Folder" "Sorry, you do not have enough quota spa
+#ce available to create a new folder. A folder requires [util_commify_number [ad_parame
+#ter DirectorySpaceRequirement users]] bytes."
+    #return
+}
+
+if {$dir_exists_p != 0} {
+    ns_returnredirect "dialog-class.tcl?title=Filesystem Management&text=Unable to create the new folder requested by the content management system.<br>A folder with that name already exists.&btn1=Okay&btntarget=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+
+#    ad_return_error "Unable to Create Folder" "Sorry, the folder name you requested already exists."
+#    return
+}
+
+set access_denied_p [database_to_tcl_string $db "
+select hp_access_denied_p($filesystem_node,$user_id) from dual"]
+
+set next_file_id [database_to_tcl_string $db "
+select users_file_id_seq.nextval from dual" 1]
+
+
+# Check to see whether the user is the owner of the filesystem node
+# for which access is requested.
+if {$access_denied_p} {
+    # Aha! url surgery attempted!
+    ad_return_error "Unable to Create Folder" "Unauthorized Access to the FileSystem"
+    return
+}
+
+set dir_full_name "[ad_parameter ContentRoot users]$dir_dir/$very_short_name"
+
+if [catch {ns_mkdir "$dir_full_name"} errmsg] {
+    # directory already exists    
+    append exception_text "
+    <li>directory $dir_full_name could not be created."
+    ad_return_complaint 1 $exception_text
+    return
+} else {
+    ns_chmod "$dir_full_name" 0777
+
+    ns_db dml $db "begin transaction"
+
+    ns_db dml $db "
+    insert into users_content_types
+    (type_id,
+    type_name,
+    sub_type_name,
+    owner_id)
+    values
+    ($new_type_id,
+    '$QQcontent_type',
+    '$QQsub_section',
+    $user_id)
+    "
+    
+    set dml_sql "
+    insert into users_files
+    (file_id, 
+    filename, 
+    directory_p, 
+    file_pretty_name, 
+    file_size, 
+    owner_id, 
+    parent_id,
+    managed_p,
+    content_type)
+    values
+    ($next_file_id, 
+    '$QQvery_short_name', 
+    't', 
+    '$QQfull_name',
+    0, 
+    $user_id, 
+    $filesystem_node,
+    't',
+    $new_type_id)"
+    
+    ns_db dml $db $dml_sql
+
+    ns_db dml $db "end transaction"
+
+}
+
+
+# Create a file for introductory text
+
+if [catch {set filehandle1 [open "$dir_full_name/Introductory Text" w]} errmsg] {
+    # directory already exists    
+    append exception_text "
+    <li>file Introductory Text could not be created."
+    ad_return_complaint 1 $exception_text
+    return
+} else {
+    close $filehandle1
+    set dml_sql "
+    insert into users_files
+    (file_id, 
+    filename, 
+    directory_p, 
+    file_pretty_name, 
+    file_size, 
+    owner_id, 
+    parent_id,
+    managed_p,
+    modifyable_p)
+    values
+    (users_file_id_seq.nextval, 
+    'Introductory Text', 
+    'f', 
+    'Introductory Text',
+    0, 
+    $user_id, 
+    $next_file_id,
+    't',
+    'f')"
+    
+    ns_db dml $db $dml_sql
+}
+
+
+
+# And off with the handle!
+ns_db releasehandle $db
+
+# And let's go back to the main maintenance page
+ns_returnredirect index.tcl?filesystem_node=$filesystem_node
Index: web/openacs/www/homepage/rename-1.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/rename-1.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/rename-1.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,86 @@
+# rename-1.tcl,v 3.0 2000/02/06 03:47:04 ron Exp
+# File:     /homepage/rename-1.tcl
+# Date:     Wed Jan 19 02:07:35 EST 2000
+# Location: 42���21'N 71���04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Page to rename a file or folder
+
+set_form_variables
+# filesystem_node, rename_node
+
+# ------------------------------ initialization codeBlock ----
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+# ------------------------------ htmlGeneration codeBlock ----
+
+set db [ns_db gethandle]
+set filename [database_to_tcl_string $db "
+select filename from users_files
+where file_id=$rename_node"]
+
+set pretty_name [database_to_tcl_string $db "
+select file_pretty_name from users_files
+where file_id=$rename_node"]
+
+set dialog_body "Please choose a new name for `$filename' \
+<form method=post action=rename-2.tcl> \
+  <input type=hidden name=filesystem_node value=$filesystem_node> \
+  <input type=hidden name=rename_node value=$rename_node> \
+  <table cellpadding=0 border=0> \
+    <tr> \
+      <td align=left>new name: \
+      <td><input type=text size=16 name=new_name value=\"$filename\"></tr> \
+    <tr> \
+      <td align=left>description: \
+      <td><input type=text size=40 name=new_desc value=\"$pretty_name\"></tr> \
+  </table> \
+  <table border=0 cellpadding=0> \
+  <tr><td><input type=submit value=Okay></form></td> \
+      <td><form method=get action=index.tcl> \
+          <input type=hidden name=filesystem_node value=$filesystem_node> \
+          <input type=submit value=Cancel></form></td> \
+  </tr></table>"
+
+
+ns_returnredirect "dialog-class.tcl?title=Filesystem Management&text=$dialog_body"
+return
+
+ReturnHeaders
+
+set title "Rename File/Folder"
+
+ns_write "
+[ad_header $title]
+<h2>$title</h2>
+[ad_context_bar_ws_or_index \
+        [list "index.tcl?filesystem_node=$filesystem_node" "Homepage Maintenance"] $title]
+<hr>
+<blockquote>
+
+<form method=post action=rename-2.tcl>
+  <input type=hidden name=filesystem_node value=$filesystem_node>
+  <input type=hidden name=rename_node value=$rename_node>
+  <p><br>
+  <ul> 
+  <table cellpadding=4>
+    <tr>
+      <th align=left>new name for `$filename':
+      <td><input type=text size=16 name=new_name></tr>
+  </table>
+  <input type=submit value=Rename>
+  </ul>
+</form>
+
+</blockquote>
+[ad_footer]
+"
Index: web/openacs/www/homepage/rename-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/rename-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/rename-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,141 @@
+# rename-2.tcl,v 3.0 2000/02/06 03:47:05 ron Exp
+# File:     /homepage/rename-2.tcl
+# Date:     Wed Jan 19 02:21:25 EST 2000
+# Location: 42��21'N 71��04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Page to rename a file
+
+set_the_usual_form_variables
+# filesystem_node, rename_node, new_name, new_desc
+
+# --------------------------- initialErrorCheck codeBlock ----
+
+set exception_count 0
+set exception_text ""
+
+if { ![info exists rename_node] || [empty_string_p $rename_node] } {
+    ad_return_error "FileSystem Target Node for rename Missing."
+    return
+}
+
+if { ![info exists filesystem_node] || [empty_string_p $filesystem_node] } {
+    ad_return_error "FileSystem Node Information Missing"
+    return
+}
+
+if { ![info exists new_name] || [empty_string_p $new_name] } {
+    ns_returnredirect "dialog-class.tcl?title=Filesystem Management&text=Unable to rename the requested file.<br>New name not provided.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+}
+
+if {[regexp {.*/.*} $new_name match]} {
+    ns_returnredirect "dialog-class.tcl?title=Filesystem Management&text=Unable to rename the requested file.<br>This operation is not for moving files.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+}
+
+if {[regexp {.*\.\..*} $new_name match]} {
+    ns_returnredirect "dialog-class.tcl?title=Filesystem Management&text=Unable to rename the requested file.<br>This operation is not for moving files.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+}
+
+if {$exception_count > 0} { 
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# ------------------------------ initialization codeBlock ----
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+# ------------------------ initialDatabaseQuery codeBlock ----
+
+# The database handle (a thoroughly useless comment)
+set db [ns_db gethandle]
+
+# Checking for site-wide administration status
+set admin_p [ad_administrator_p $db $user_id]
+
+# This query will return the quota of the user
+set sql "
+select filename as old_name,
+directory_p as dirp,
+hp_true_dirname($rename_node) as dir_name
+from users_files, dual
+where file_id=$rename_node
+"
+# Extract results from the query
+set selection [ns_db 1row $db $sql]
+
+# This will  assign the  variables their appropriate values 
+# based on the query.
+set_variables_after_query
+ns_log Debug "dir name = $dir_name, dirp = $dirp"
+
+# chop off the lowest directory name - the part being changed.
+if { $dirp == "t" } {
+
+    regsub {(.+)/[^/]+} $dir_name {\1} dir_name
+    ns_log Debug "dir name = $dir_name"
+}   
+
+
+
+
+set access_denied_p [database_to_tcl_string $db "
+select hp_access_denied_p($rename_node,$user_id) from dual"]
+
+# Check to see whether the user is the owner of the filesystem node
+# for which access is requested.
+if {$access_denied_p} {
+    # Aha! url surgery attempted!
+    ad_return_error "Unable to Rename Filesystem Node" "Unauthorized Access to the FileSystem"
+    return
+}
+
+
+set old_full_name "[ad_parameter ContentRoot users]$dir_name/$old_name"
+set new_full_name "[ad_parameter ContentRoot users]$dir_name/$new_name"
+
+if {[file exists $new_full_name] && $old_name != $new_name} {
+    ns_returnredirect "dialog-class.tcl?title=Filesystem Management&text=A file with the name `$new_name'<br>already exists in the current directory.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return    
+}
+
+if [catch {ns_rename "$old_full_name" "$new_full_name"} errmsg] {
+    # unable to rename
+    append exception_text "
+    <li>Folder $old_full_name could not be renamed."
+    ad_return_complaint 1 $exception_text
+    return
+} else {
+    set dml_sql "
+    update users_files
+    set filename='$QQnew_name',
+    file_pretty_name='$QQnew_desc'
+    where file_id=$rename_node
+    "
+    ns_db dml $db $dml_sql
+}
+
+# And off with the handle!
+ns_db releasehandle $db
+
+# And let's go back to the main maintenance page
+ns_returnredirect index.tcl?filesystem_node=$filesystem_node
+
+
+
+
+
+
+
+
Index: web/openacs/www/homepage/renamenh-1.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/renamenh-1.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/renamenh-1.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,86 @@
+# renamenh-1.tcl,v 3.0 2000/02/06 03:47:06 ron Exp
+# File:     /homepage/renamenh-1.tcl
+# Date:     Thu Jan 27 01:52:07 EST 2000
+# Location: 42���21'N 71���04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Page to rename a neighborhood
+
+set_form_variables
+# neighborhood_node, rename_node
+
+# ------------------------------ initialization codeBlock ----
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+# ------------------------------ htmlGeneration codeBlock ----
+
+set db [ns_db gethandle]
+set neighborhood_name [database_to_tcl_string $db "
+select neighborhood_name from users_neighborhoods
+where neighborhood_id=$rename_node"]
+
+set pretty_name [database_to_tcl_string $db "
+select description from users_neighborhoods
+where neighborhood_id=$rename_node"]
+
+set dialog_body "Please choose a new name for `$neighborhood_name' \
+<form method=post action=renamenh-2.tcl> \
+  <input type=hidden name=neighborhood_node value=$neighborhood_node> \
+  <input type=hidden name=rename_node value=$rename_node> \
+  <table cellpadding=0 border=0> \
+    <tr> \
+      <td align=left>new name: \
+      <td><input type=text size=16 name=new_name value=\"$neighborhood_name\"></tr> \
+    <tr> \
+      <td align=left>description: \
+      <td><input type=text size=40 name=new_desc value=\"$pretty_name\"></tr> \
+  </table> \
+  <table border=0 cellpadding=0> \
+  <tr><td><input type=submit value=Okay></form></td> \
+      <td><form method=get action=neighborhoods.tcl> \
+          <input type=hidden name=neighborhood_node value=$neighborhood_node> \
+          <input type=submit value=Cancel></form></td> \
+  </tr></table>"
+
+
+ns_returnredirect "dialog-class.tcl?title=Neighborhood Management&text=$dialog_body"
+return
+
+ReturnHeaders
+
+set title "Rename File/Folder"
+
+ns_write "
+[ad_header $title]
+<h2>$title</h2>
+[ad_context_bar_ws_or_index \
+        [list "neighborhoods.tcl?neighborhood_node=$neighborhood_node" "Homepage Maintenance"] $title]
+<hr>
+<blockquote>
+
+<form method=post action=renamenh-2.tcl>
+  <input type=hidden name=neighborhood_node value=$neighborhood_node>
+  <input type=hidden name=rename_node value=$rename_node>
+  <p><br>
+  <ul> 
+  <table cellpadding=4>
+    <tr>
+      <th align=left>new name for `$neighborhood_name':
+      <td><input type=text size=16 name=new_name></tr>
+  </table>
+  <input type=submit value=Rename>
+  </ul>
+</form>
+
+</blockquote>
+[ad_footer]
+"
Index: web/openacs/www/homepage/renamenh-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/renamenh-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/renamenh-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,100 @@
+# renamenh-2.tcl,v 3.0 2000/02/06 03:47:08 ron Exp
+# File:     /homepage/rename-2.tcl
+# Date:     Wed Jan 19 02:21:25 EST 2000
+# Location: 42��21'N 71��04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Page to rename a file
+
+set_the_usual_form_variables
+# neighborhood_node, rename_node, new_name, new_desc
+
+# --------------------------- initialErrorCheck codeBlock ----
+
+set exception_count 0
+set exception_text ""
+
+if { ![info exists rename_node] || [empty_string_p $rename_node] } {
+    ad_return_error "Neighborhood Target Node for rename Missing."
+    return
+}
+
+if { ![info exists neighborhood_node] || [empty_string_p $neighborhood_node] } {
+    ad_return_error "Neighborhood Node Information Missing"
+    return
+}
+
+if { ![info exists new_name] || [empty_string_p $new_name] } {
+    ns_returnredirect "dialog-class.tcl?title=Neighborhood Management&text=Unable to rename the requested neighborhood.<br>New name not provided.&btn1=Okay&btn1target=neighborhoods.tcl&btn1keyvalpairs=neighborhood_node $neighborhood_node"
+    return
+}
+
+if {[regexp {.*/.*} $new_name match]} {
+    ns_returnredirect "dialog-class.tcl?title=Neighborhood Management&text=Unable to rename the requested neighborhoods.<br>This operation is not for moving neighborhoods.&btn1=Okay&btn1target=neighborhoods.tcl&btn1keyvalpairs=neighborhood_node $neighborhood_node"
+    return
+}
+
+if {[regexp {.*\.\..*} $new_name match]} {
+    ns_returnredirect "dialog-class.tcl?title=Neighborhood Management&text=Unable to rename the requested neighborhood.<br>This operation is not for moving neighborhoods.&btn1=Okay&btn1target=neighborhoods.tcl&btn1keyvalpairs=neighborhood_node $neighborhood_node"
+    return
+}
+
+if {$exception_count > 0} { 
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# ------------------------------ initialization codeBlock ----
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+# ------------------------ initialDatabaseQuery codeBlock ----
+
+# The database handle (a thoroughly useless comment)
+set db [ns_db gethandle]
+
+# Checking for site-wide administration status
+set admin_p [ad_administrator_p $db $user_id]
+
+set nh_exists_p [database_to_tcl_string $db "
+select count(*)
+from users_neighborhoods
+where neighborhood_name='$QQnew_name'
+and parent_id=$neighborhood_node
+and neighborhood_id != $rename_node"]
+
+if {$nh_exists_p != 0} {
+    ns_returnredirect "dialog-class.tcl?title=Neighborhood Management&text=Unable to rename neighborhood you requested.<br>A Neighborhood with that name already exists.&btn1=Okay&btn1target=neighborhoods.tcl&btn1keyvalpairs=neighborhood_node $neighborhood_node"
+    return
+
+}
+
+if {$admin_p == 0} {
+    ns_returnredirect "dialog-class.tcl?title=Access Management&text=Unable to rename the neighborhood you requested.<br>Insufficient permission to perform requested database access in RenameNeighborhood.&btn1=Okay&btn1target=neighborhoods.tcl&btn1keyvalpairs=neighborhood_node $neighborhood_node"
+    return
+    
+}
+
+
+set dml_sql "
+update users_neighborhoods
+set neighborhood_name='$QQnew_name',
+description='$QQnew_desc'
+where neighborhood_id=$rename_node
+"
+ns_db dml $db $dml_sql
+
+
+# And off with the handle!
+ns_db releasehandle $db
+
+# And let's go back to the main maintenance page
+ns_returnredirect neighborhoods.tcl?neighborhood_node=$neighborhood_node
Index: web/openacs/www/homepage/rmdir-1.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/rmdir-1.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/rmdir-1.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,111 @@
+# rmdir-1.tcl,v 3.0 2000/02/06 03:47:09 ron Exp
+# File:     /homepage/rmdir-1.tcl
+# Date:     Fri Jan 14 18:48:26 EST 2000
+# Location: 42��21'N 71��04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Page to delete a folder
+
+set_the_usual_form_variables
+# filesystem_node, dir_node
+
+# --------------------------- initialErrorCheck codeBlock ----
+
+set exception_count 0
+set exception_text ""
+
+if { ![info exists dir_node] || [empty_string_p $dir_node] } {
+    ad_return_error "FileSystem Target Node for deletion Missing."
+    return
+}
+
+if { ![info exists filesystem_node] || [empty_string_p $filesystem_node] } {
+    ad_return_error "FileSystem Node Information Missing"
+    return
+}
+
+if {$exception_count > 0} { 
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# ------------------------------ initialization codeBlock ----
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+# ------------------------ initialDatabaseQuery codeBlock ----
+
+# The database handle (a thoroughly useless comment)
+set db [ns_db gethandle]
+
+# Checking for site-wide administration status
+set admin_p [ad_administrator_p $db $user_id]
+
+# This query will return the quota of the user
+set sql "
+select hp_get_filesystem_child_count($dir_node) as child_count,
+       hp_true_filename($dir_node) as dir_name 
+from dual
+"
+
+# Extract results from the query
+set selection [ns_db 1row $db $sql]
+
+# This will  assign the  variables their appropriate values 
+# based on the query.
+set_variables_after_query
+
+set access_denied_p [database_to_tcl_string $db "
+select hp_access_denied_p($dir_node,$user_id) from dual"]
+
+# Check to see whether the user is the owner of the filesystem node
+# for which access is requested.
+if {$access_denied_p} {
+    # Aha! url surgery attempted!
+    ad_return_error "Unable to Delete Folder" "Unauthorized Access to the FileSystem"
+    return
+}
+
+if {$child_count != 0} {
+    
+    ns_returnredirect "dialog-class.tcl?title=Error!&text=Folder cannot be deleted<br>It is not empty&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+    
+    # Old code before th generic dialog box days. deactivated by mobin
+    # ad_return_complaint 1 "<li>Folder cannot be deleted. It is not empty."
+    # return
+}
+
+set dir_full_name "[ad_parameter ContentRoot users]$dir_name"
+
+if [catch {ns_rmdir "$dir_full_name"} errmsg] {
+    # directory already exists    
+    append exception_text "
+    <li>Folder $dir_full_name could not be deleted. Make sure it is empty."
+    ad_return_complaint 1 $exception_text
+    return
+} else {
+    set dml_sql "
+    delete from users_files
+    where file_id=$dir_node
+    "
+    ns_db dml $db $dml_sql
+}
+
+# And off with the handle!
+ns_db releasehandle $db
+
+# And let's go back to the main maintenance page
+ns_returnredirect index.tcl?filesystem_node=$filesystem_node
+
+
+
+
Index: web/openacs/www/homepage/rmfile-1.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/rmfile-1.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/rmfile-1.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,124 @@
+# rmfile-1.tcl,v 3.1 2000/02/14 09:32:51 ron Exp
+# File:     /homepage/rmfile-1.tcl
+# Date:     Wed Jan 19 00:04:18 EST 2000
+# Location: 42��21'N 71��04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Page to delete a file
+
+set_the_usual_form_variables
+# filesystem_node, file_node
+
+# --------------------------- initialErrorCheck codeBlock ----
+
+set exception_count 0
+set exception_text ""
+
+if { ![info exists file_node] || [empty_string_p $file_node] } {
+    ad_return_error "FileSystem Target Node for deletion Missing."
+    return
+}
+
+if { ![info exists filesystem_node] || [empty_string_p $filesystem_node] } {
+    ad_return_error "FileSystem Node Information Missing"
+    return
+}
+
+if {$exception_count > 0} { 
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# ------------------------------ initialization codeBlock ----
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+# ------------------------ initialDatabaseQuery codeBlock ----
+
+# The database handle (a thoroughly useless comment)
+set db [ns_db gethandle]
+
+# Checking for site-wide administration status
+set admin_p [ad_administrator_p $db $user_id]
+
+# This query will return the quota of the user
+set sql "
+select hp_get_filesystem_child_count($file_node) as child_count,
+       hp_true_filename($file_node) as full_filename 
+from dual
+"
+
+# Extract results from the query
+set selection [ns_db 1row $db $sql]
+
+# This will  assign the  variables their appropriate values 
+# based on the query.
+set_variables_after_query
+
+set access_denied_p [database_to_tcl_string $db "
+select hp_access_denied_p($file_node,$user_id) from dual"]
+
+# Check to see whether the user is the owner of the filesystem node
+# for which access is requested.
+if {$access_denied_p} {
+    # Aha! url surgery attempted!
+    ad_return_error "Unable to Delete File" "Unauthorized Access to the FileSystem"
+    return
+}
+
+if {$child_count != 0} {
+    # Files contained within this file! There has to be something awfully wrong
+    # with this file.
+    ns_returnredirect "dialog-class.tcl?title=Error!&text=File cannot be deleted<br>The filesystem has gone out of sync<br>Please contact your administrator.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+    
+    # Old code before th generic dialog box days. deactivated by mobin
+    # ad_return_complaint 1 "<li>File cannot be deleted. It is crazy."
+    # return
+}
+
+set file_full_name "[ad_parameter ContentRoot users]$full_filename"
+
+set dml_sql "
+delete from users_files
+where file_id=$file_node
+"
+
+if [catch {file delete "$file_full_name"} errmsg] {
+    if [catch {exec rm $file_full_name} errmsg2] {
+	append exception_text "
+	<li>File $file_full_name could not be deleted.<br>
+	$errmsg2"
+	ad_return_complaint 1 $exception_text
+	return    
+    } else {
+	ns_db dml $db $dml_sql
+	ns_returnredirect index.tcl?filesystem_node=$filesystem_node
+	return
+    }
+    append exception_text "
+    <li>File $file_full_name could not be deleted.<br>
+    $errmsg"
+    ad_return_complaint 1 $exception_text
+    return
+} else {
+    ns_db dml $db $dml_sql
+}
+
+# And off with the handle!
+ns_db releasehandle $db
+
+# And let's go back to the main maintenance page
+ns_returnredirect index.tcl?filesystem_node=$filesystem_node
+
+
+
+
Index: web/openacs/www/homepage/rmnh-1.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/rmnh-1.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/rmnh-1.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,76 @@
+# rmnh-1.tcl,v 3.0 2000/02/06 03:47:11 ron Exp
+# File:     /homepage/rmnh-1.tcl
+# Date:     Thu Jan 27 02:21:55 EST 2000
+# Location: 42��21'N 71��04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Page to delete a neighborhood
+
+set_the_usual_form_variables
+# neighborhood_node, dir_node
+
+# --------------------------- initialErrorCheck codeBlock ----
+
+set exception_count 0
+set exception_text ""
+
+if { ![info exists dir_node] || [empty_string_p $dir_node] } {
+    ad_return_error "Neighborhood Target Node for deletion Missing."
+    return
+}
+
+if { ![info exists neighborhood_node] || [empty_string_p $neighborhood_node] } {
+    ad_return_error "Neighborhood Node Information Missing"
+    return
+}
+
+if {$exception_count > 0} { 
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# ------------------------------ initialization codeBlock ----
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+# ------------------------ initialDatabaseQuery codeBlock ----
+
+# The database handle (a thoroughly useless comment)
+set db [ns_db gethandle]
+
+# Checking for site-wide administration status
+set admin_p [ad_administrator_p $db $user_id]
+
+# Checking for site-wide administration status
+set admin_p [ad_administrator_p $db $user_id]
+
+if {$admin_p == 0} {
+    ns_returnredirect "dialog-class.tcl?title=Access Management&text=Unable to delete the neighborhood you requested.<br>Insufficient permission to perform requested database access in DeleteNeighborhood.&btn1=Okay&btn1target=neighborhoods.tcl&btn1keyvalpairs=neighborhood_node $neighborhood_node"
+    return
+    
+}
+
+set dml_sql "
+delete from users_neighborhoods
+where neighborhood_id=$dir_node
+"
+
+ns_db dml $db $dml_sql
+
+# And off with the handle!
+ns_db releasehandle $db
+
+# And let's go back to the main maintenance page
+ns_returnredirect neighborhoods.tcl?neighborhood_node=$neighborhood_node
+
+
+
+
Index: web/openacs/www/homepage/set-view-nh.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/set-view-nh.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/set-view-nh.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,17 @@
+# set-view-nh.tcl,v 3.0 2000/02/06 03:47:13 ron Exp
+# File:     /homepage/set-view-nh.tcl
+# Date:     Sat Jan 22 23:03:44 EST 2000
+# Location: 42��21'N 71��04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Sets a cookie to determine user's preferred view
+
+set_form_variables
+# view, neighborhood_node
+
+ns_write "HTTP/1.0 302 FOUND
+MIME-Version: 1.0
+Content-Type: text/html
+Set-Cookie: neighborhood_view=$view; path=/; expires=05-Mar-2079 05:45:00 GMT
+Location: neighborhoods.tcl?neighborhood_node=$neighborhood_node
+"
Index: web/openacs/www/homepage/set-view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/set-view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/set-view.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,17 @@
+# set-view.tcl,v 3.0 2000/02/06 03:47:14 ron Exp
+# File:     /homepage/set-view.tcl
+# Date:     Sat Jan 22 23:03:44 EST 2000
+# Location: 42��21'N 71��04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Sets a cookie to determine user's preferred view
+
+set_form_variables
+# view, filesystem_node
+
+ns_write "HTTP/1.0 302 FOUND
+MIME-Version: 1.0
+Content-Type: text/html
+Set-Cookie: homepage_view=$view; path=/; expires=05-Mar-2079 05:45:00 GMT
+Location: index.tcl?filesystem_node=$filesystem_node
+"
Index: web/openacs/www/homepage/update-display-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/update-display-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/update-display-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,105 @@
+# update-display-2.tcl,v 3.0 2000/02/06 03:47:15 ron Exp
+set_the_usual_form_variables
+# bgcolor, textcolor, unvisited_link, visited_link, link_text_decoration, font_type
+# bgcolor_val, textcolor_val, unvisited_link_val, visited_link_val
+# filesystem_node
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+set db [ns_db gethandle]
+
+append update_sql "
+update users_homepages
+set "
+
+
+if { ([info exists bgcolor] && ![empty_string_p $bgcolor]) || \
+	([info exists bgcolor_val] && ![empty_string_p $bgcolor_val]) } {
+    append update_sql "bgcolor = [ad_decode $bgcolor_val "" '$bgcolor' '$bgcolor_val'],
+    "
+}
+
+if { ([info exists textcolor] && ![empty_string_p $textcolor]) || \
+	([info exists textcolor_val] && ![empty_string_p $textcolor_val]) } {
+    append update_sql "textcolor = [ad_decode $textcolor_val "" '$textcolor' '$textcolor_val'],
+    "
+}
+
+if { ([info exists unvisited_link] && ![empty_string_p $unvisited_link]) || \
+	([info exists unvisited_link_val] && ![empty_string_p $unvisited_link_val]) } {
+    append update_sql "unvisited_link = [ad_decode $unvisited_link_val "" '$unvisited_link' '$unvisited_link_val'],
+    "
+}
+
+if { ([info exists visited_link] && ![empty_string_p $visited_link]) || \
+	([info exists visited_link_val] && ![empty_string_p $visited_link_val]) } {
+    append update_sql "visited_link = [ad_decode $visited_link_val "" '$visited_link' '$visited_link_val'],
+    "
+}
+
+if { [info exists font_type] && ![empty_string_p $font_type] } {
+    append update_sql "font_type = '$font_type',
+    "
+}
+
+
+
+
+
+if { ([info exists maint_bgcolor] && ![empty_string_p $maint_bgcolor]) || \
+	([info exists maint_bgcolor_val] && ![empty_string_p $maint_bgcolor_val]) } {
+    append update_sql "maint_bgcolor = [ad_decode $maint_bgcolor_val "" '$maint_bgcolor' '$maint_bgcolor_val'],
+    "
+}
+
+if { ([info exists maint_textcolor] && ![empty_string_p $maint_textcolor]) || \
+	([info exists maint_textcolor_val] && ![empty_string_p $maint_textcolor_val]) } {
+    append update_sql "maint_textcolor = [ad_decode $maint_textcolor_val "" '$maint_textcolor' '$maint_textcolor_val'],
+    "
+}
+
+if { ([info exists maint_unvisited_link] && ![empty_string_p $maint_unvisited_link]) || \
+	([info exists maint_unvisited_link_val] && ![empty_string_p $maint_unvisited_link_val]) } {
+    append update_sql "maint_unvisited_link = [ad_decode $maint_unvisited_link_val "" '$maint_unvisited_link' '$maint_unvisited_link_val'],
+    "
+}
+
+if { ([info exists maint_visited_link] && ![empty_string_p $maint_visited_link]) || \
+	([info exists maint_visited_link_val] && ![empty_string_p $maint_visited_link_val]) } {
+    append update_sql "maint_visited_link = [ad_decode $maint_visited_link_val "" '$maint_visited_link' '$maint_visited_link_val'],
+    "
+}
+
+if { [info exists maint_font_type] && ![empty_string_p $maint_font_type] } {
+    append update_sql "maint_font_type = '$maint_font_type',
+    "
+}
+
+append update_sql "link_text_decoration = '$link_text_decoration',
+maint_link_text_decoration = '$maint_link_text_decoration',
+link_font_weight = '$link_font_weight',
+maint_link_font_weight = '$maint_link_font_weight'
+where user_id=$user_id
+"
+
+ns_db dml $db $update_sql
+
+ns_db releasehandle $db
+
+ns_returnredirect "index.tcl?filesystem_node=$filesystem_node"
+
+
+
+
+
+
+
+
Index: web/openacs/www/homepage/update-display-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/update-display-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/update-display-3.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,48 @@
+# update-display-3.tcl,v 3.0 2000/02/06 03:47:17 ron Exp
+set_the_usual_form_variables
+# filesystem_node
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+set db [ns_db gethandle]
+
+append update_sql "
+update users_homepages
+set 	bgcolor			        = null,
+	textcolor			= null,
+	unvisited_link	  		= null,
+	visited_link	  		= null,
+	link_text_decoration  		= null,
+	link_font_weight		= null,
+	font_type		  	= null,
+	maint_bgcolor	 		= null,
+	maint_textcolor			= null,
+	maint_unvisited_link		= null,
+	maint_visited_link	  	= null,
+	maint_link_text_decoration  	= null,
+	maint_link_font_weight		= null,
+	maint_font_type			= null
+where user_id=$user_id
+"
+
+ns_db dml $db $update_sql
+
+ns_db releasehandle $db
+
+ns_returnredirect "index.tcl?filesystem_node=$filesystem_node"
+
+
+
+
+
+
+
+
Index: web/openacs/www/homepage/update-display.help
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/update-display.help,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/update-display.help	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,21 @@
+<%= [ad_header "Help for Edit Display Settings"] %>
+
+<h2>Help</h2>
+
+for the Edit CSS display settings page
+
+<hr>
+
+Instead of choosing a color, you may elect to type in a hex RGB value
+for a color, e.g.,
+
+<ul>
+<li>#000000 is black
+<li>#FFFFFF is white
+<li>#FF0000 is red
+
+</ul>
+
+Make sure to include the # sign.
+
+<%= [ad_footer] %>
Index: web/openacs/www/homepage/update-display.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/update-display.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/update-display.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,273 @@
+# update-display.tcl,v 3.0 2000/02/06 03:47:18 ron Exp
+set_form_variables
+# filesystem_node
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+set db [ns_db gethandle]
+
+ReturnHeaders
+
+set title "Display Settings "
+
+ns_write "
+[ad_header $title]
+<h2>$title</h2>
+[ad_context_bar_ws [list "index.tcl?filesystem_node=$filesystem_node" "Homepage Maintenance"] $title]
+<hr>
+
+[help_upper_right_menu]
+"
+
+set selection [ns_db 0or1row $db "
+select user_id,
+       bgcolor, 
+       textcolor, 
+       unvisited_link, 
+       visited_link, 
+       link_text_decoration, 
+       link_font_weight, 
+       font_type,
+       maint_bgcolor,
+       maint_textcolor, 
+       maint_unvisited_link, 
+       maint_visited_link, 
+       maint_link_text_decoration, 
+       maint_link_font_weight, 
+       maint_font_type
+from users_homepages
+where user_id=$user_id"]
+
+#if { [empty_string_p $selection] }  {
+    # there is no entry for this scope, let's go and create the default one
+#    ns_db dml $db "
+#    insert into simple
+#    (id, [ad_scope_cols_sql], bgcolor, textcolor, unvisited_link, visited_link, 
+#     link_text_decoration, font_type)
+#    values
+#    (simple_id_sequence.nextval, [ad_scope_vals_sql], 'white', 'black', 'blue', 'purple', 'none', 'arial')
+#    "
+
+#    set selection [ns_db 1row $db "
+#    select bgcolor, textcolor, unvisited_link, visited_link, link_text_decoration, font_type
+#    from simple
+#    where [ad_scope_sql]
+#    "]
+#}
+ 
+set_variables_after_query
+
+set color_names_list { "choose new color" Black Blue Cyan Gray Green Lime Magenta Maroon Navy Olive Purple Red Silver Teal White Yellow }
+set color_values_list { "" black blue cyan gray green lime magenta maroon navy olive purple red silver teal white yellow }
+
+#present the user with graphical options:
+append html "
+<form method=post action=update-display-2.tcl>
+[export_form_vars filesystem_node]
+<font size=+1>Public Pages:</font>
+<table>
+<tr>
+<td colspan=3>&nbsp;
+<th>hex value (alternative)
+<tr>
+<td>Body Background Color:
+<td><font color=red>$bgcolor</font>
+<td>[ns_htmlselect -labels $color_names_list bgcolor $color_values_list $bgcolor]
+<td><input type=text name=bgcolor_val size=8>
+</tr>
+
+<tr>
+<td>Body Text Color:
+<td>[ad_space 2]<font color=red>$textcolor</font>
+<td>[ns_htmlselect -labels $color_names_list textcolor $color_values_list $textcolor]
+<td><input type=text name=textcolor_val size=8>
+</tr>
+
+<tr>
+<td>Links Color:
+<td>[ad_space 2]<font color=red>$unvisited_link</font>
+<td>[ns_htmlselect -labels $color_names_list unvisited_link $color_values_list $unvisited_link]
+<td><input type=text name=unvisited_link_val size=8>
+</tr>
+
+<tr>
+<td>Visited Links Color:
+<td>[ad_space 2]<font color=red> $visited_link</font>
+<td>[ns_htmlselect -labels $color_names_list visited_link $color_values_list $visited_link]
+<td><input type=text name=visited_link_val size=8>
+</tr>
+
+<tr>
+<td>Choose Font:
+<td>[ad_space 2]<font color=red>$font_type</font>
+<td>[ns_htmlselect -labels {"choose new font" Arial Courier Geneva Helvetica Palatino Sans-Serif Times} \
+	font_type \
+	{"" arial courier geneva helvetica palatino sans-serif times} \
+	$font_type]
+</tr>
+"
+
+if { $link_text_decoration == "none" } {
+    append html "
+    <tr>
+    <td>Links:
+    <td><input type=radio name=link_text_decoration value=underline>Underlined
+    <td><input type=radio name=link_text_decoration value=none checked>Not Underlined
+    </tr>
+    "
+} else {
+    append html "
+    <tr>
+    <td>Links:
+    <td><input type=radio name=link_text_decoration value=underline checked>Underlined
+    <td><input type=radio name=link_text_decoration value=none>Not Underlined
+    </tr>
+    " 
+}
+
+
+if { $link_font_weight == "none" || [empty_string_p $link_font_weight] } {
+    append html "
+    <tr>
+    <td>Links weight:
+    <td><input type=radio name=link_font_weight value=bold>Bold
+    <td><input type=radio name=link_font_weight value=none checked>Normal
+    </tr>
+    "
+} else {
+    append html "
+    <tr>
+    <td>Links weight:
+    <td><input type=radio name=link_font_weight value=bold checked>Bold
+    <td><input type=radio name=link_font_weight value=none>Normal
+    </tr>
+    " 
+}
+
+
+append html "</table><br><p>"
+
+# For Maintenance Pages
+append html "
+<p>
+<font size=+1>Maintenance Pages:</font>
+<table border=0 cellpadding=0 cellspacing=0>
+<tr>
+<td colspan=3>&nbsp;
+<th>hex value (alternative)
+<tr>
+<td>Body Background Color:
+<td><font color=red>$maint_bgcolor</font>
+<td>[ns_htmlselect -labels $color_names_list maint_bgcolor $color_values_list $maint_bgcolor]
+<td><input type=text name=maint_bgcolor_val size=8>
+</tr>
+
+<tr>
+<td>Body Text Color:
+<td>[ad_space 2]<font color=red>$maint_textcolor</font>
+<td>[ns_htmlselect -labels $color_names_list maint_textcolor $color_values_list $maint_textcolor]
+<td><input type=text name=maint_textcolor_val size=8>
+</tr>
+
+<tr>
+<td>Links Color:
+<td>[ad_space 2]<font color=red>$maint_unvisited_link</font>
+<td>[ns_htmlselect -labels $color_names_list maint_unvisited_link $color_values_list $maint_unvisited_link]
+<td><input type=text name=maint_unvisited_link_val size=8>
+</tr>
+
+<tr>
+<td>Visited Links Color:
+<td>[ad_space 2]<font color=red>$maint_visited_link</font>
+<td>[ns_htmlselect -labels $color_names_list maint_visited_link $color_values_list $maint_visited_link]
+<td><input type=text name=maint_visited_link_val size=8>
+</tr>
+
+<tr>
+<td>Choose Font:
+<td>[ad_space 2]<font color=red>$maint_font_type</font>
+<td>[ns_htmlselect -labels {"choose new font" Arial Courier Geneva Helvetica Palatino Sans-Serif Times} \
+	maint_font_type \
+	{"" arial courier geneva helvetica palatino sans-serif times} \
+	$maint_font_type]
+</tr>
+"
+
+if { $maint_link_text_decoration == "none" } {
+    append html "
+    <tr>
+    <td>Links:
+    <td><input type=radio name=maint_link_text_decoration value=underline>Underlined
+    <td><input type=radio name=maint_link_text_decoration value=none checked>Not Underlined
+    </tr>
+    "
+} else {
+    append html "
+    <tr>
+    <td>Links:
+    <td><input type=radio name=maint_link_text_decoration value=underline checked>Underlined
+    <td><input type=radio name=maint_link_text_decoration value=none>Not Underlined
+    </tr>
+    " 
+}
+
+
+if { $maint_link_font_weight == "none" || [empty_string_p $maint_link_font_weight] } {
+    append html "
+    <tr>
+    <td>Links weight:
+    <td><input type=radio name=maint_link_font_weight value=bold>Bold
+    <td><input type=radio name=maint_link_font_weight value=none checked>Normal
+    </tr>
+    "
+} else {
+    append html "
+    <tr>
+    <td>Links weight:
+    <td><input type=radio name=maint_link_font_weight value=bold checked>Bold
+    <td><input type=radio name=maint_link_font_weight value=none>Normal
+    </tr>
+    " 
+}
+
+
+append html "
+</table>
+<p>
+<table><tr><td><input type=submit value=\"Update\"></form></td><td>
+<form method=post action=update-display-3.tcl>
+[export_form_vars filesystem_node]
+<input type=submit value=\"Delete Customizations\"></form>
+</td></tr></table>
+"
+
+ns_write "
+<blockquote>
+$html
+</blockquote>
+[ad_footer]
+"
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/homepage/upload-1.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/upload-1.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/upload-1.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,79 @@
+# upload-1.tcl,v 3.0 2000/02/06 03:47:20 ron Exp
+# File:     /homepage/upload-1.tcl
+# Date:     Tue Jan 18 22:58:22 EST 2000
+# Location: 42��21'N 71��04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Upload File form
+
+set_form_variables
+# filesystem_node
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+set db [ns_db gethandle]
+
+set next_node [database_to_tcl_string $db "
+select users_file_id_seq.nextval" 1]
+
+ns_db releasehandle $db
+
+set dialog_body "Please select a local file to upload: <form enctype=multipart/form-data method=post action=upload-2.tcl> <input type=hidden name=filesystem_node value=$filesystem_node> <input type=file name=upload_file size=20> <input type=hidden name=new_node value=$next_node><table border=0 cellpadding=0 cellspacing=0><tr><td> <input type=submit value=Okay></form></td>  <td><form method=get action=index.tcl><input type=hidden name=filesystem_node value=$filesystem_node><input type=submit value=Cancel></form></td></tr></table>"
+
+set dialog_file "dialog-class.tcl?title=Filesystem Management&text=$dialog_body"
+
+ns_returnredirect "$dialog_file"
+return
+
+ReturnHeaders 
+
+set title "Upload File"
+
+ns_write "
+[ad_header $title]
+<h2>$title</h2>
+[ad_context_bar_ws [list "index.tcl?filesystem_node=$filesystem_node" "Homepage Maintenance"] $title]
+<hr>
+"
+
+append html "
+<form enctype=multipart/form-data method=post action=upload-2.tcl>
+[export_form_vars filesystem_node]
+
+<table cellpadding=3>
+
+<tr><th align=left>Upload File 
+<td>
+<input type=file name=upload_file size=20>
+</tr>
+
+
+</table>
+
+<input type=hidden name=new_node value=$next_node>
+<p>
+<input type=submit value=\"Upload\">
+</form>
+<p>
+"
+
+ns_write "
+<blockquote>
+$html
+</blockquote>
+[ad_footer]
+"
+
+
+
+
+
+
Index: web/openacs/www/homepage/upload-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/upload-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/upload-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,126 @@
+# upload-2.tcl,v 3.1 2000/02/08 03:47:38 mobin Exp
+# File:     /homepage/upload-2.tcl
+# Date:     Tue Jan 18 23:08:52 EST 2000
+# Location: 42��21'N 71��04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  Upload File form target
+
+set_form_variables
+
+ad_page_variables {
+    filesystem_node
+    upload_file
+    new_node
+}
+# filesystem_node, upload_file, new_node
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+#Now check to see if the input is good as directed by the page designer
+set exception_count 0
+set exception_text ""
+
+if { ![info exists upload_file] || [empty_string_p $upload_file] } {
+    append exception_text "<li>Please specify a file to upload\n"
+    incr exception_count
+    
+    ns_returnredirect "dialog-class.tcl?title=Error!&text=Cannot process your upload request.<br>You did not specify a filename to upload!&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+set db [ns_db gethandle]
+
+# Checking for site-wide administration status
+set admin_p [ad_administrator_p $db $user_id]
+
+
+set access_denied_p [database_to_tcl_string $db "
+select hp_access_denied_p($filesystem_node,$user_id) from dual"]
+
+# Check to see whether the user is the owner of the filesystem node
+# for which access is requested.
+if {$access_denied_p} {
+    # Aha! url surgery attempted!
+    ad_return_error "Unable to Upload File" "Unauthorized Access to the FileSystem"
+    return
+}
+
+set new_filename $upload_file
+set tmp_filename [ns_queryget upload_file.tmpfile]
+
+if {[regexp {.*\\([^\\]*)} $new_filename match windows_filename]} {
+    set new_filename $windows_filename
+}
+
+set new_filesize [file size $tmp_filename]
+
+set quota_left [database_to_tcl_string $db "
+select hp_user_quota_left($user_id, [ad_parameter NormalUserMaxQuota users], [ad_parameter PrivelegedUserMaxQuota users], $admin_p, [ad_parameter DirectorySpaceRequirement users]) from dual"]
+
+if {$new_filesize > $quota_left} {
+    ns_returnredirect "dialog-class.tcl?title=Quota Management System&text=You do not have enough quota space left to upload this file!&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+}
+
+set dir_name [database_to_tcl_string $db "
+select hp_true_filename($filesystem_node) from dual"]
+
+set new_full_filename "[ad_parameter ContentRoot users]$dir_name/$new_filename"
+
+
+if {[file exists $new_full_filename]} {
+    ns_returnredirect "dialog-class.tcl?title=Error!&text=A file with the name $new_filename<br>already exists in the current directory.&btn1=Okay&btn1target=index.tcl&btn1keyvalpairs=filesystem_node $filesystem_node"
+    return
+}
+
+set double_click_p [database_to_tcl_string $db "
+select count(*)
+from users_files
+where file_id = $new_node"]
+
+if {$double_click_p == "0"} {
+    # not a double click
+    
+    if [catch {ns_cp -preserve $tmp_filename $new_full_filename} errmsg ] {
+	# file could not be copied	
+	incr exception_count
+	append exception_text "<li>File could not be copied into $new_full_filename <br>
+	This is the error message it returned : $errmsg
+	"
+    } else {
+	ns_db dml $db "
+	insert into users_files
+	 (file_id, filename,
+	 directory_p, file_pretty_name,
+	 file_size, owner_id,
+	 parent_id)
+	values
+	 ($new_node, '$new_filename',
+	 'f', 'FileSystem uploadedFile',
+	 $new_filesize, $user_id,
+	 $filesystem_node)"
+    }
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+ns_returnredirect index.tcl?filesystem_node=$filesystem_node
+
Index: web/openacs/www/homepage/webspace-init.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/homepage/webspace-init.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/homepage/webspace-init.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,66 @@
+# webspace-init.tcl,v 3.1 2000/03/08 01:15:54 mobin Exp
+# File:     /users/webspace-init.tcl
+# Date:     Thu Jan 13 00:09:31 EST 2000
+# Location: 42���21'N 71���04'W
+# Location: 80 PROSPECT ST CAMBRIDGE MA 02139 USA
+# Author:   mobin@mit.edu (Usman Y. Mobin)
+# Purpose:  User Content Main Page
+
+# ------------------------------ initialization codeBlock ----
+
+# First, we need to get the user_id
+set user_id [ad_verify_and_get_user_id]
+
+# If the user is not registered, we need to redirect him for
+# registration
+if { $user_id == 0 } {
+    ad_redirect_for_registration
+    return
+}
+
+# ------------------------ initialDatabaseQuery codeBlock ----
+
+# The database handle (a thoroughly useless comment)
+set db [ns_db gethandle]
+
+# This will check whether the user's top level directory exists
+# or not.
+set dir_p [database_to_tcl_string $db "
+select count(*)
+from users_files
+where filename='$user_id'
+and parent_id is null
+and owner_id=$user_id"]
+
+if {$dir_p==0} {
+    if [catch {ns_mkdir "[ad_parameter ContentRoot users]$user_id"} errmsg] {
+        # directory already exists    
+        append exception_text "
+        <li>directory [ad_parameter ContentRoot users]$user_id could not be created.<pre>$errmsg</pre>"
+        ad_return_complaint 1 $exception_text
+        return
+   } else {
+       ns_chmod "[ad_parameter ContentRoot users]$user_id" 0777
+
+       ns_db dml $db "
+       insert into users_files
+       (file_id, filename, directory_p, file_pretty_name, file_size, owner_id)
+       values
+       (users_file_id_seq.nextval, '$user_id', 't', 'UserContent personalRoot', 0, $user_id)"
+       ns_db dml $db "
+       insert into users_homepages
+       (user_id, bgcolor, maint_bgcolor, maint_unvisited_link, maint_visited_link, 
+       maint_link_text_decoration, maint_link_font_weight)
+       values
+       ($user_id, 'white', 'white', '006699', '006699', 'none', 'bold')"
+   }
+}
+# And off with the handle!
+ns_db releasehandle $db
+
+ns_returnredirect index.tcl
+
+
+
+
+
Index: web/openacs/www/install/acs_geo_parents.sql
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/install/acs_geo_parents.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/install/acs_geo_parents.sql	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,54 @@
+-- acs_geo_parents.sql
+-- Modified for ACS by DRB 1/30/2000
+
+-- counties
+-- used to be in acs/www/install/counties.dmp (with EDF tablespace)
+-- data now in counties.ctl
+CREATE TABLE COUNTIES (
+       FIPS_COUNTY_CODE     VARCHAR(5) NOT NULL,
+       FIPS_COUNTY_NAME     VARCHAR(35) NOT NULL,
+       FIPS_STATE_CODE      VARCHAR(2) NOT NULL,
+       USPS_ABBREV          VARCHAR(2) NOT NULL,
+       STATE_NAME           VARCHAR(50) NOT NULL,
+       PRIMARY KEY (FIPS_COUNTY_CODE)
+);
+
+
+-- countries
+-- used to be in acs/www/install/country-codes.dmp (with EDF tablespace)
+-- data now in country_codes.ctl
+CREATE TABLE COUNTRY_CODES (
+       ISO                  CHAR(2) NOT NULL,
+       COUNTRY_NAME         VARCHAR(150),
+       PRIMARY KEY (ISO)
+);
+
+-- states
+-- used to be in acs/www/install/states.dmp (with EDF tablespace)
+-- data now in states.ctl
+CREATE TABLE STATES (
+       USPS_ABBREV          CHAR(2) NOT NULL,
+       STATE_NAME           VARCHAR(25),
+       FIPS_STATE_CODE      CHAR(2),
+       PRIMARY KEY (USPS_ABBREV)
+);
+
+-- US EPA regions
+-- used to be in acs/www/install/epa-regions.dmp (with EDF tablespace)
+-- data now in bboard_epa_regions.ctl
+CREATE TABLE BBOARD_EPA_REGIONS (
+       STATE_NAME           VARCHAR(30),
+       FIPS_NUMERIC_CODE    CHAR(2),
+       EPA_REGION           NUMERIC,
+       USPS_ABBREV          CHAR(2),
+       DESCRIPTION          VARCHAR(50)
+);
+
+-- currency codes
+-- only the currencies with supported_p equal to t will be shown in the currency widget
+CREATE TABLE CURRENCY_CODES (
+	ISO		CHAR(3) PRIMARY KEY,
+	CURRENCY_NAME	VARCHAR(200),
+	SUPPORTED_P	CHAR(1) DEFAULT 'f' CHECK(SUPPORTED_P in ('t','f'))
+);
+
Index: web/openacs/www/install/bboard_epa_regions.ctl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/install/bboard_epa_regions.ctl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/install/bboard_epa_regions.ctl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,58 @@
+COPY BBOARD_EPA_REGIONS FROM stdin USING DELIMITERS '|';
+Alabama|01|4|AL|Southeast Region
+Alaska|02|10|AK|Northwestern Region
+American Samoa|60|9|AS|Western Region
+Arizona|04|9|AZ|Western Region
+Arkansas|05|6|AR|Southern Region
+California|06|9|CA|Western Region
+Colorado|08|8|CO|North Central Region
+Connecticut|09|1|CT|New England Region
+Delaware|10|3|DE|Mid Atlantic Region
+District of Columbia|11|3|DC|Mid Atlantic Region
+Florida|12|4|FL|Southeast Region
+Georgia|13|4|GA|Southeast Region
+Guam|66|9|GU|Western Region
+Hawaii|15|9|HI|Western Region
+Idaho|16|10|ID|Northwestern Region
+Illinois|17|5|IL|Great Lakes Region
+Indiana|18|5|IN|Great Lakes Region
+Iowa|19|7|IA|Central Region
+Kansas|20|7|KS|Central Region
+Kentucky|21|4|KY|Southeast Region
+Louisiana|22|6|LA|Southern Region
+Maine|23|1|ME|New England Region
+Maryland|24|3|MD|Mid Atlantic Region
+Massachusetts|25|1|MA|New England Region
+Michigan|26|5|MI|Great Lakes Region
+Minnesota|27|5|MN|Great Lakes Region
+Mississippi|28|4|MS|Southeast Region
+Missouri|29|7|MO|Central Region
+Montana|30|8|MT|North Central Region
+Nebraska|31|7|NE|Central Region
+Nevada|32|9|NV|Western Region
+New Hampshire|33|1|NH|New England Region
+New Jersey|34|2|NJ|NY and NJ Region
+New Mexico|35|6|NM|Southern Region
+New York|36|2|NY|NY and NJ Region
+North Carolina|37|4|NC|Southeast Region
+North Dakota|38|8|ND|North Central Region
+Ohio|39|5|OH|Great Lakes Region
+Oklahoma|40|6|OK|Southern Region
+Oregon|41|10|OR|Northwestern Region
+Pennsylvania|42|3|PA|Mid Atlantic Region
+Puerto Rico|72|2|PR|NY and NJ Region
+Rhode Island|44|1|RI|New England Region
+South Carolina|45|4|SC|Southeast Region
+South Dakota|46|8|SD|North Central Region
+Tennessee|47|4|TN|Southeast Region
+Texas|48|6|TX|Southern Region
+Utah|49|8|UT|North Central Region
+Vermont|50|1|VT|New England Region
+Virgin Islands of the U.S.|78|2|VI|NY and NJ Region
+Virginia|51|3|VA|Mid Atlantic Region
+Washington|53|10|WA|Northwestern Region
+West Virginia|54|3|WV|Mid Atlantic Region
+Wisconsin|55|5|WI|Great Lakes Region
+Wyoming|56|8|WY|North Central Region
+\.
+
Index: web/openacs/www/install/counties.ctl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/install/counties.ctl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/install/counties.ctl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,3296 @@
+COPY COUNTIES FROM stdin USING DELIMITERS '|';
+01001|AUTAUGA|01|AL|ALABAMA
+01003|BALDWIN|01|AL|ALABAMA
+01005|BARBOUR|01|AL|ALABAMA
+01007|BIBB|01|AL|ALABAMA
+01009|BLOUNT|01|AL|ALABAMA
+01011|BULLOCK|01|AL|ALABAMA
+01013|BUTLER|01|AL|ALABAMA
+01015|CALHOUN|01|AL|ALABAMA
+01017|CHAMBERS|01|AL|ALABAMA
+01019|CHEROKEE|01|AL|ALABAMA
+01021|CHILTON|01|AL|ALABAMA
+01023|CHOCTAW|01|AL|ALABAMA
+01025|CLARKE|01|AL|ALABAMA
+01027|CLAY|01|AL|ALABAMA
+01029|CLEBURNE|01|AL|ALABAMA
+01031|COFFEE|01|AL|ALABAMA
+01033|COLBERT|01|AL|ALABAMA
+01035|CONECUH|01|AL|ALABAMA
+01037|COOSA|01|AL|ALABAMA
+01039|COVINGTON|01|AL|ALABAMA
+01041|CRENSHAW|01|AL|ALABAMA
+01043|CULLMAN|01|AL|ALABAMA
+01045|DALE|01|AL|ALABAMA
+01047|DALLAS|01|AL|ALABAMA
+01049|DEKALB|01|AL|ALABAMA
+01051|ELMORE|01|AL|ALABAMA
+01053|ESCAMBIA|01|AL|ALABAMA
+01055|ETOWAH|01|AL|ALABAMA
+01057|FAYETTE|01|AL|ALABAMA
+01059|FRANKLIN|01|AL|ALABAMA
+01061|GENEVA|01|AL|ALABAMA
+01063|GREENE|01|AL|ALABAMA
+01065|HALE|01|AL|ALABAMA
+01067|HENRY|01|AL|ALABAMA
+01069|HOUSTON|01|AL|ALABAMA
+01071|JACKSON|01|AL|ALABAMA
+01073|JEFFERSON|01|AL|ALABAMA
+01075|LAMAR|01|AL|ALABAMA
+01077|LAUDERDALE|01|AL|ALABAMA
+01079|LAWRENCE|01|AL|ALABAMA
+01081|LEE|01|AL|ALABAMA
+01083|LIMESTONE|01|AL|ALABAMA
+01085|LOWNDES|01|AL|ALABAMA
+01087|MACON|01|AL|ALABAMA
+01089|MADISON|01|AL|ALABAMA
+01091|MARENGO|01|AL|ALABAMA
+01093|MARION|01|AL|ALABAMA
+01095|MARSHALL|01|AL|ALABAMA
+01097|MOBILE|01|AL|ALABAMA
+01099|MONROE|01|AL|ALABAMA
+01101|MONTGOMERY|01|AL|ALABAMA
+01103|MORGAN|01|AL|ALABAMA
+01105|PERRY|01|AL|ALABAMA
+01107|PICKENS|01|AL|ALABAMA
+01109|PIKE|01|AL|ALABAMA
+01111|RANDOLPH|01|AL|ALABAMA
+01113|RUSSELL|01|AL|ALABAMA
+01115|ST. CLAIR|01|AL|ALABAMA
+01117|SHELBY|01|AL|ALABAMA
+01119|SUMTER|01|AL|ALABAMA
+01121|TALLADEGA|01|AL|ALABAMA
+01123|TALLAPOOSA|01|AL|ALABAMA
+01125|TUSCALOOSA|01|AL|ALABAMA
+01127|WALKER|01|AL|ALABAMA
+01129|WASHINGTON|01|AL|ALABAMA
+01131|WILCOX|01|AL|ALABAMA
+01133|WINSTON|01|AL|ALABAMA
+02013|ALEUTIANS EAST|02|AK|ALASKA
+02016|ALEUTIANS WEST|02|AK|ALASKA
+02020|ANCHORAGE|02|AK|ALASKA
+02050|BETHEL|02|AK|ALASKA
+02060|BRISTOL BAY|02|AK|ALASKA
+02070|DILLINGHAM|02|AK|ALASKA
+02090|FAIRBANKS NORTH STAR|02|AK|ALASKA
+02100|HAINES|02|AK|ALASKA
+02110|JUNEAU|02|AK|ALASKA
+02122|KENAI PENINSULA|02|AK|ALASKA
+02130|KETCHIKAN GATEWAY|02|AK|ALASKA
+02150|KODIAK ISLAND|02|AK|ALASKA
+02164|LAKE AND PENINSULA|02|AK|ALASKA
+02170|MATANUSKA-SUSITNA|02|AK|ALASKA
+02180|NOME|02|AK|ALASKA
+02185|NORTH SLOPE|02|AK|ALASKA
+02188|NORTHWEST ARCTIC|02|AK|ALASKA
+02201|PRINCE OF WALES-OUTER KETCHIKAN|02|AK|ALASKA
+02220|SITKA|02|AK|ALASKA
+02231|SKAGWAY|02|AK|ALASKA
+02240|SOUTHEAST FAIRBANKS|02|AK|ALASKA
+02261|VALDEZ-CORDOVA|02|AK|ALASKA
+02270|WADE HAMPTON|02|AK|ALASKA
+02280|WRANGELL-PETERSBURG|02|AK|ALASKA
+02290|YUKON-KOYUKUK|02|AK|ALASKA
+04001|APACHE|04|AZ|ARIZONA
+04003|COCHISE|04|AZ|ARIZONA
+04005|COCONINO|04|AZ|ARIZONA
+04007|GILA|04|AZ|ARIZONA
+04009|GRAHAM|04|AZ|ARIZONA
+04011|GREENLEE|04|AZ|ARIZONA
+04012|LA PAZ|04|AZ|ARIZONA
+04013|MARICOPA|04|AZ|ARIZONA
+04015|MOHAVE|04|AZ|ARIZONA
+04017|NAVAJO|04|AZ|ARIZONA
+04019|PIMA|04|AZ|ARIZONA
+04021|PINAL|04|AZ|ARIZONA
+04023|SANTA CRUZ|04|AZ|ARIZONA
+04025|YAVAPAI|04|AZ|ARIZONA
+04027|YUMA|04|AZ|ARIZONA
+05001|ARKANSAS|05|AR|ARKANSAS
+05003|ASHLEY|05|AR|ARKANSAS
+05005|BAXTER|05|AR|ARKANSAS
+05007|BENTON|05|AR|ARKANSAS
+05009|BOONE|05|AR|ARKANSAS
+05011|BRADLEY|05|AR|ARKANSAS
+05013|CALHOUN|05|AR|ARKANSAS
+05015|CARROLL|05|AR|ARKANSAS
+05017|CHICOT|05|AR|ARKANSAS
+05019|CLARK|05|AR|ARKANSAS
+05021|CLAY|05|AR|ARKANSAS
+05023|CLEBURNE|05|AR|ARKANSAS
+05025|CLEVELAND|05|AR|ARKANSAS
+05027|COLUMBIA|05|AR|ARKANSAS
+05029|CONWAY|05|AR|ARKANSAS
+05031|CRAIGHEAD|05|AR|ARKANSAS
+05033|CRAWFORD|05|AR|ARKANSAS
+05035|CRITTENDEN|05|AR|ARKANSAS
+05037|CROSS|05|AR|ARKANSAS
+05039|DALLAS|05|AR|ARKANSAS
+05041|DESHA|05|AR|ARKANSAS
+05043|DREW|05|AR|ARKANSAS
+05045|FAULKNER|05|AR|ARKANSAS
+05047|FRANKLIN|05|AR|ARKANSAS
+05049|FULTON|05|AR|ARKANSAS
+05051|GARLAND|05|AR|ARKANSAS
+05053|GRANT|05|AR|ARKANSAS
+05055|GREENE|05|AR|ARKANSAS
+05057|HEMPSTEAD|05|AR|ARKANSAS
+05059|HOT SPRING|05|AR|ARKANSAS
+05061|HOWARD|05|AR|ARKANSAS
+05063|INDEPENDENCE|05|AR|ARKANSAS
+05065|IZARD|05|AR|ARKANSAS
+05067|JACKSON|05|AR|ARKANSAS
+05069|JEFFERSON|05|AR|ARKANSAS
+05071|JOHNSON|05|AR|ARKANSAS
+05073|LAFAYETTE|05|AR|ARKANSAS
+05075|LAWRENCE|05|AR|ARKANSAS
+05077|LEE|05|AR|ARKANSAS
+05079|LINCOLN|05|AR|ARKANSAS
+05081|LITTLE RIVER|05|AR|ARKANSAS
+05083|LOGAN|05|AR|ARKANSAS
+05085|LONOKE|05|AR|ARKANSAS
+05087|MADISON|05|AR|ARKANSAS
+05089|MARION|05|AR|ARKANSAS
+05091|MILLER|05|AR|ARKANSAS
+05093|MISSISSIPPI|05|AR|ARKANSAS
+05095|MONROE|05|AR|ARKANSAS
+05097|MONTGOMERY|05|AR|ARKANSAS
+05099|NEVADA|05|AR|ARKANSAS
+05101|NEWTON|05|AR|ARKANSAS
+05103|OUACHITA|05|AR|ARKANSAS
+05105|PERRY|05|AR|ARKANSAS
+05107|PHILLIPS|05|AR|ARKANSAS
+05109|PIKE|05|AR|ARKANSAS
+05111|POINSETT|05|AR|ARKANSAS
+05113|POLK|05|AR|ARKANSAS
+05115|POPE|05|AR|ARKANSAS
+05117|PRAIRIE|05|AR|ARKANSAS
+05119|PULASKI|05|AR|ARKANSAS
+05121|RANDOLPH|05|AR|ARKANSAS
+05123|ST. FRANCIS|05|AR|ARKANSAS
+05125|SALINE|05|AR|ARKANSAS
+05127|SCOTT|05|AR|ARKANSAS
+05129|SEARCY|05|AR|ARKANSAS
+05131|SEBASTIAN|05|AR|ARKANSAS
+05133|SEVIER|05|AR|ARKANSAS
+05135|SHARP|05|AR|ARKANSAS
+05137|STONE|05|AR|ARKANSAS
+05139|UNION|05|AR|ARKANSAS
+05141|VAN BUREN|05|AR|ARKANSAS
+05143|WASHINGTON|05|AR|ARKANSAS
+05145|WHITE|05|AR|ARKANSAS
+05147|WOODRUFF|05|AR|ARKANSAS
+05149|YELL|05|AR|ARKANSAS
+06001|ALAMEDA|06|CA|CALIFORNIA
+06003|ALPINE|06|CA|CALIFORNIA
+06005|AMADOR|06|CA|CALIFORNIA
+06007|BUTTE|06|CA|CALIFORNIA
+06009|CALAVERAS|06|CA|CALIFORNIA
+06011|COLUSA|06|CA|CALIFORNIA
+06013|CONTRA COSTA|06|CA|CALIFORNIA
+06015|DEL NORTE|06|CA|CALIFORNIA
+06017|EL DORADO|06|CA|CALIFORNIA
+06019|FRESNO|06|CA|CALIFORNIA
+06021|GLENN|06|CA|CALIFORNIA
+06023|HUMBOLDT|06|CA|CALIFORNIA
+06025|IMPERIAL|06|CA|CALIFORNIA
+06027|INYO|06|CA|CALIFORNIA
+06029|KERN|06|CA|CALIFORNIA
+06031|KINGS|06|CA|CALIFORNIA
+06033|LAKE|06|CA|CALIFORNIA
+06035|LASSEN|06|CA|CALIFORNIA
+06037|LOS ANGELES|06|CA|CALIFORNIA
+06039|MADERA|06|CA|CALIFORNIA
+06041|MARIN|06|CA|CALIFORNIA
+06043|MARIPOSA|06|CA|CALIFORNIA
+06045|MENDOCINO|06|CA|CALIFORNIA
+06047|MERCED|06|CA|CALIFORNIA
+06049|MODOC|06|CA|CALIFORNIA
+06051|MONO|06|CA|CALIFORNIA
+06053|MONTEREY|06|CA|CALIFORNIA
+06055|NAPA|06|CA|CALIFORNIA
+06057|NEVADA|06|CA|CALIFORNIA
+06059|ORANGE|06|CA|CALIFORNIA
+06061|PLACER|06|CA|CALIFORNIA
+06063|PLUMAS|06|CA|CALIFORNIA
+06065|RIVERSIDE|06|CA|CALIFORNIA
+06067|SACRAMENTO|06|CA|CALIFORNIA
+06069|SAN BENITO|06|CA|CALIFORNIA
+06071|SAN BERNARDINO|06|CA|CALIFORNIA
+06073|SAN DIEGO|06|CA|CALIFORNIA
+06075|SAN FRANCISCO|06|CA|CALIFORNIA
+06077|SAN JOAQUIN|06|CA|CALIFORNIA
+06079|SAN LUIS OBISPO|06|CA|CALIFORNIA
+06081|SAN MATEO|06|CA|CALIFORNIA
+06083|SANTA BARBARA|06|CA|CALIFORNIA
+06085|SANTA CLARA|06|CA|CALIFORNIA
+06087|SANTA CRUZ|06|CA|CALIFORNIA
+06089|SHASTA|06|CA|CALIFORNIA
+06091|SIERRA|06|CA|CALIFORNIA
+06093|SISKIYOU|06|CA|CALIFORNIA
+06095|SOLANO|06|CA|CALIFORNIA
+06097|SONOMA|06|CA|CALIFORNIA
+06099|STANISLAUS|06|CA|CALIFORNIA
+06101|SUTTER|06|CA|CALIFORNIA
+06103|TEHAMA|06|CA|CALIFORNIA
+06105|TRINITY|06|CA|CALIFORNIA
+06107|TULARE|06|CA|CALIFORNIA
+06109|TUOLUMNE|06|CA|CALIFORNIA
+06111|VENTURA|06|CA|CALIFORNIA
+06113|YOLO|06|CA|CALIFORNIA
+06115|YUBA|06|CA|CALIFORNIA
+08001|ADAMS|08|CO|COLORADO
+08003|ALAMOSA|08|CO|COLORADO
+08005|ARAPAHOE|08|CO|COLORADO
+08007|ARCHULETA|08|CO|COLORADO
+08009|BACA|08|CO|COLORADO
+08011|BENT|08|CO|COLORADO
+08013|BOULDER|08|CO|COLORADO
+08015|CHAFFEE|08|CO|COLORADO
+08017|CHEYENNE|08|CO|COLORADO
+08019|CLEAR CREEK|08|CO|COLORADO
+08021|CONEJOS|08|CO|COLORADO
+08023|COSTILLA|08|CO|COLORADO
+08025|CROWLEY|08|CO|COLORADO
+08027|CUSTER|08|CO|COLORADO
+08029|DELTA|08|CO|COLORADO
+08031|DENVER|08|CO|COLORADO
+08033|DOLORES|08|CO|COLORADO
+08035|DOUGLAS|08|CO|COLORADO
+08037|EAGLE|08|CO|COLORADO
+08039|ELBERT|08|CO|COLORADO
+08041|EL PASO|08|CO|COLORADO
+08043|FREMONT|08|CO|COLORADO
+08045|GARFIELD|08|CO|COLORADO
+08047|GILPIN|08|CO|COLORADO
+08049|GRAND|08|CO|COLORADO
+08051|GUNNISON|08|CO|COLORADO
+08053|HINSDALE|08|CO|COLORADO
+08055|HUERFANO|08|CO|COLORADO
+08057|JACKSON|08|CO|COLORADO
+08059|JEFFERSON|08|CO|COLORADO
+08061|KIOWA|08|CO|COLORADO
+08063|KIT CARSON|08|CO|COLORADO
+08065|LAKE|08|CO|COLORADO
+08067|LA PLATA|08|CO|COLORADO
+08069|LARIMER|08|CO|COLORADO
+08071|LAS ANIMAS|08|CO|COLORADO
+08073|LINCOLN|08|CO|COLORADO
+08075|LOGAN|08|CO|COLORADO
+08077|MESA|08|CO|COLORADO
+08079|MINERAL|08|CO|COLORADO
+08081|MOFFAT|08|CO|COLORADO
+08083|MONTEZUMA|08|CO|COLORADO
+08085|MONTROSE|08|CO|COLORADO
+08087|MORGAN|08|CO|COLORADO
+08089|OTERO|08|CO|COLORADO
+08091|OURAY|08|CO|COLORADO
+08093|PARK|08|CO|COLORADO
+08095|PHILLIPS|08|CO|COLORADO
+08097|PITKIN|08|CO|COLORADO
+08099|PROWERS|08|CO|COLORADO
+08101|PUEBLO|08|CO|COLORADO
+08103|RIO BLANCO|08|CO|COLORADO
+08105|RIO GRANDE|08|CO|COLORADO
+08107|ROUTT|08|CO|COLORADO
+08109|SAGUACHE|08|CO|COLORADO
+08111|SAN JUAN|08|CO|COLORADO
+08113|SAN MIGUEL|08|CO|COLORADO
+08115|SEDGWICK|08|CO|COLORADO
+08117|SUMMIT|08|CO|COLORADO
+08119|TELLER|08|CO|COLORADO
+08121|WASHINGTON|08|CO|COLORADO
+08123|WELD|08|CO|COLORADO
+08125|YUMA|08|CO|COLORADO
+09001|FAIRFIELD|09|CT|CONNECTICUT
+09003|HARTFORD|09|CT|CONNECTICUT
+09005|LITCHFIELD|09|CT|CONNECTICUT
+09007|MIDDLESEX|09|CT|CONNECTICUT
+09009|NEW HAVEN|09|CT|CONNECTICUT
+09011|NEW LONDON|09|CT|CONNECTICUT
+09013|TOLLAND|09|CT|CONNECTICUT
+09015|WINDHAM|09|CT|CONNECTICUT
+10001|KENT|10|DE|DELAWARE
+10003|NEW CASTLE|10|DE|DELAWARE
+10005|SUSSEX|10|DE|DELAWARE
+11001|DISTRICT OF COLUMBIA|11|DC|DISTRICT OF COLUMBIA
+12001|ALACHUA|12|FL|FLORIDA
+12003|BAKER|12|FL|FLORIDA
+12005|BAY|12|FL|FLORIDA
+12007|BRADFORD|12|FL|FLORIDA
+12009|BREVARD|12|FL|FLORIDA
+12011|BROWARD|12|FL|FLORIDA
+12013|CALHOUN|12|FL|FLORIDA
+12015|CHARLOTTE|12|FL|FLORIDA
+12017|CITRUS|12|FL|FLORIDA
+12019|CLAY|12|FL|FLORIDA
+12021|COLLIER|12|FL|FLORIDA
+12023|COLUMBIA|12|FL|FLORIDA
+12025|DADE|12|FL|FLORIDA
+12027|DESOTO|12|FL|FLORIDA
+12029|DIXIE|12|FL|FLORIDA
+12031|DUVAL|12|FL|FLORIDA
+12033|ESCAMBIA|12|FL|FLORIDA
+12035|FLAGLER|12|FL|FLORIDA
+12037|FRANKLIN|12|FL|FLORIDA
+12039|GADSDEN|12|FL|FLORIDA
+12041|GILCHRIST|12|FL|FLORIDA
+12043|GLADES|12|FL|FLORIDA
+12045|GULF|12|FL|FLORIDA
+12047|HAMILTON|12|FL|FLORIDA
+12049|HARDEE|12|FL|FLORIDA
+12051|HENDRY|12|FL|FLORIDA
+12053|HERNANDO|12|FL|FLORIDA
+12055|HIGHLANDS|12|FL|FLORIDA
+12057|HILLSBOROUGH|12|FL|FLORIDA
+12059|HOLMES|12|FL|FLORIDA
+12061|INDIAN RIVER|12|FL|FLORIDA
+12063|JACKSON|12|FL|FLORIDA
+12065|JEFFERSON|12|FL|FLORIDA
+12067|LAFAYETTE|12|FL|FLORIDA
+12069|LAKE|12|FL|FLORIDA
+12071|LEE|12|FL|FLORIDA
+12073|LEON|12|FL|FLORIDA
+12075|LEVY|12|FL|FLORIDA
+12077|LIBERTY|12|FL|FLORIDA
+12079|MADISON|12|FL|FLORIDA
+12081|MANATEE|12|FL|FLORIDA
+12083|MARION|12|FL|FLORIDA
+12085|MARTIN|12|FL|FLORIDA
+12087|MONROE|12|FL|FLORIDA
+12089|NASSAU|12|FL|FLORIDA
+12091|OKALOOSA|12|FL|FLORIDA
+12093|OKEECHOBEE|12|FL|FLORIDA
+12095|ORANGE|12|FL|FLORIDA
+12097|OSCEOLA|12|FL|FLORIDA
+12099|PALM BEACH|12|FL|FLORIDA
+12101|PASCO|12|FL|FLORIDA
+12103|PINELLAS|12|FL|FLORIDA
+12105|POLK|12|FL|FLORIDA
+12107|PUTNAM|12|FL|FLORIDA
+12109|ST. JOHNS|12|FL|FLORIDA
+12111|ST. LUCIE|12|FL|FLORIDA
+12113|SANTA ROSA|12|FL|FLORIDA
+12115|SARASOTA|12|FL|FLORIDA
+12117|SEMINOLE|12|FL|FLORIDA
+12119|SUMTER|12|FL|FLORIDA
+12121|SUWANNEE|12|FL|FLORIDA
+12123|TAYLOR|12|FL|FLORIDA
+12125|UNION|12|FL|FLORIDA
+12127|VOLUSIA|12|FL|FLORIDA
+12129|WAKULLA|12|FL|FLORIDA
+12131|WALTON|12|FL|FLORIDA
+12133|WASHINGTON|12|FL|FLORIDA
+13001|APPLING|13|GA|GEORGIA
+13003|ATKINSON|13|GA|GEORGIA
+13005|BACON|13|GA|GEORGIA
+13007|BAKER|13|GA|GEORGIA
+13009|BALDWIN|13|GA|GEORGIA
+13011|BANKS|13|GA|GEORGIA
+13013|BARROW|13|GA|GEORGIA
+13015|BARTOW|13|GA|GEORGIA
+13017|BEN HILL|13|GA|GEORGIA
+13019|BERRIEN|13|GA|GEORGIA
+13021|BIBB|13|GA|GEORGIA
+13023|BLECKLEY|13|GA|GEORGIA
+13025|BRANTLEY|13|GA|GEORGIA
+13027|BROOKS|13|GA|GEORGIA
+13029|BRYAN|13|GA|GEORGIA
+13031|BULLOCH|13|GA|GEORGIA
+13033|BURKE|13|GA|GEORGIA
+13035|BUTTS|13|GA|GEORGIA
+13037|CALHOUN|13|GA|GEORGIA
+13039|CAMDEN|13|GA|GEORGIA
+13043|CANDLER|13|GA|GEORGIA
+13045|CARROLL|13|GA|GEORGIA
+13047|CATOOSA|13|GA|GEORGIA
+13049|CHARLTON|13|GA|GEORGIA
+13051|CHATHAM|13|GA|GEORGIA
+13053|CHATTAHOOCHEE|13|GA|GEORGIA
+13055|CHATTOOGA|13|GA|GEORGIA
+13057|CHEROKEE|13|GA|GEORGIA
+13059|CLARKE|13|GA|GEORGIA
+13061|CLAY|13|GA|GEORGIA
+13063|CLAYTON|13|GA|GEORGIA
+13065|CLINCH|13|GA|GEORGIA
+13067|COBB|13|GA|GEORGIA
+13069|COFFEE|13|GA|GEORGIA
+13071|COLQUITT|13|GA|GEORGIA
+13073|COLUMBIA|13|GA|GEORGIA
+13075|COOK|13|GA|GEORGIA
+13077|COWETA|13|GA|GEORGIA
+13079|CRAWFORD|13|GA|GEORGIA
+13081|CRISP|13|GA|GEORGIA
+13083|DADE|13|GA|GEORGIA
+13085|DAWSON|13|GA|GEORGIA
+13087|DECATUR|13|GA|GEORGIA
+13089|DEKALB|13|GA|GEORGIA
+13091|DODGE|13|GA|GEORGIA
+13093|DOOLY|13|GA|GEORGIA
+13095|DOUGHERTY|13|GA|GEORGIA
+13097|DOUGLAS|13|GA|GEORGIA
+13099|EARLY|13|GA|GEORGIA
+13101|ECHOLS|13|GA|GEORGIA
+13103|EFFINGHAM|13|GA|GEORGIA
+13105|ELBERT|13|GA|GEORGIA
+13107|EMANUEL|13|GA|GEORGIA
+13109|EVANS|13|GA|GEORGIA
+13111|FANNIN|13|GA|GEORGIA
+13113|FAYETTE|13|GA|GEORGIA
+13115|FLOYD|13|GA|GEORGIA
+13117|FORSYTH|13|GA|GEORGIA
+13119|FRANKLIN|13|GA|GEORGIA
+13121|FULTON|13|GA|GEORGIA
+13123|GILMER|13|GA|GEORGIA
+13125|GLASCOCK|13|GA|GEORGIA
+13127|GLYNN|13|GA|GEORGIA
+13129|GORDON|13|GA|GEORGIA
+13131|GRADY|13|GA|GEORGIA
+13133|GREENE|13|GA|GEORGIA
+13135|GWINNETT|13|GA|GEORGIA
+13137|HABERSHAM|13|GA|GEORGIA
+13139|HALL|13|GA|GEORGIA
+13141|HANCOCK|13|GA|GEORGIA
+13143|HARALSON|13|GA|GEORGIA
+13145|HARRIS|13|GA|GEORGIA
+13147|HART|13|GA|GEORGIA
+13149|HEARD|13|GA|GEORGIA
+13151|HENRY|13|GA|GEORGIA
+13153|HOUSTON|13|GA|GEORGIA
+13155|IRWIN|13|GA|GEORGIA
+13157|JACKSON|13|GA|GEORGIA
+13159|JASPER|13|GA|GEORGIA
+13161|JEFF DAVIS|13|GA|GEORGIA
+13163|JEFFERSON|13|GA|GEORGIA
+13165|JENKINS|13|GA|GEORGIA
+13167|JOHNSON|13|GA|GEORGIA
+13169|JONES|13|GA|GEORGIA
+13171|LAMAR|13|GA|GEORGIA
+13173|LANIER|13|GA|GEORGIA
+13175|LAURENS|13|GA|GEORGIA
+13177|LEE|13|GA|GEORGIA
+13179|LIBERTY|13|GA|GEORGIA
+13181|LINCOLN|13|GA|GEORGIA
+13183|LONG|13|GA|GEORGIA
+13185|LOWNDES|13|GA|GEORGIA
+13187|LUMPKIN|13|GA|GEORGIA
+13189|MCDUFFIE|13|GA|GEORGIA
+13191|MCINTOSH|13|GA|GEORGIA
+13193|MACON|13|GA|GEORGIA
+13195|MADISON|13|GA|GEORGIA
+13197|MARION|13|GA|GEORGIA
+13199|MERIWETHER|13|GA|GEORGIA
+13201|MILLER|13|GA|GEORGIA
+13205|MITCHELL|13|GA|GEORGIA
+13207|MONROE|13|GA|GEORGIA
+13209|MONTGOMERY|13|GA|GEORGIA
+13211|MORGAN|13|GA|GEORGIA
+13213|MURRAY|13|GA|GEORGIA
+13215|MUSCOGEE|13|GA|GEORGIA
+13217|NEWTON|13|GA|GEORGIA
+13219|OCONEE|13|GA|GEORGIA
+13221|OGLETHORPE|13|GA|GEORGIA
+13223|PAULDING|13|GA|GEORGIA
+13225|PEACH|13|GA|GEORGIA
+13227|PICKENS|13|GA|GEORGIA
+13229|PIERCE|13|GA|GEORGIA
+13231|PIKE|13|GA|GEORGIA
+13233|POLK|13|GA|GEORGIA
+13235|PULASKI|13|GA|GEORGIA
+13237|PUTNAM|13|GA|GEORGIA
+13239|QUITMAN|13|GA|GEORGIA
+13241|RABUN|13|GA|GEORGIA
+13243|RANDOLPH|13|GA|GEORGIA
+13245|RICHMOND|13|GA|GEORGIA
+13247|ROCKDALE|13|GA|GEORGIA
+13249|SCHLEY|13|GA|GEORGIA
+13251|SCREVEN|13|GA|GEORGIA
+13253|SEMINOLE|13|GA|GEORGIA
+13255|SPALDING|13|GA|GEORGIA
+13257|STEPHENS|13|GA|GEORGIA
+13259|STEWART|13|GA|GEORGIA
+13261|SUMTER|13|GA|GEORGIA
+13263|TALBOT|13|GA|GEORGIA
+13265|TALIAFERRO|13|GA|GEORGIA
+13267|TATTNALL|13|GA|GEORGIA
+13269|TAYLOR|13|GA|GEORGIA
+13271|TELFAIR|13|GA|GEORGIA
+13273|TERRELL|13|GA|GEORGIA
+13275|THOMAS|13|GA|GEORGIA
+13277|TIFT|13|GA|GEORGIA
+13279|TOOMBS|13|GA|GEORGIA
+13281|TOWNS|13|GA|GEORGIA
+13283|TREUTLEN|13|GA|GEORGIA
+13285|TROUP|13|GA|GEORGIA
+13287|TURNER|13|GA|GEORGIA
+13289|TWIGGS|13|GA|GEORGIA
+13291|UNION|13|GA|GEORGIA
+13293|UPSON|13|GA|GEORGIA
+13295|WALKER|13|GA|GEORGIA
+13297|WALTON|13|GA|GEORGIA
+13299|WARE|13|GA|GEORGIA
+13301|WARREN|13|GA|GEORGIA
+13303|WASHINGTON|13|GA|GEORGIA
+13305|WAYNE|13|GA|GEORGIA
+13307|WEBSTER|13|GA|GEORGIA
+13309|WHEELER|13|GA|GEORGIA
+13311|WHITE|13|GA|GEORGIA
+13313|WHITFIELD|13|GA|GEORGIA
+13315|WILCOX|13|GA|GEORGIA
+13317|WILKES|13|GA|GEORGIA
+13319|WILKINSON|13|GA|GEORGIA
+13321|WORTH|13|GA|GEORGIA
+15001|HAWAII|15|HI|HAWAII
+15003|HONOLULU|15|HI|HAWAII
+15005|KALAWAO|15|HI|HAWAII
+15007|KAUAI|15|HI|HAWAII
+15009|MAUI|15|HI|HAWAII
+16001|ADA|16|ID|IDAHO
+16003|ADAMS|16|ID|IDAHO
+16005|BANNOCK|16|ID|IDAHO
+16007|BEAR LAKE|16|ID|IDAHO
+16009|BENEWAH|16|ID|IDAHO
+16011|BINGHAM|16|ID|IDAHO
+16013|BLAINE|16|ID|IDAHO
+16015|BOISE|16|ID|IDAHO
+16017|BONNER|16|ID|IDAHO
+16019|BONNEVILLE|16|ID|IDAHO
+16021|BOUNDARY|16|ID|IDAHO
+16023|BUTTE|16|ID|IDAHO
+16025|CAMAS|16|ID|IDAHO
+16027|CANYON|16|ID|IDAHO
+16029|CARIBOU|16|ID|IDAHO
+16031|CASSIA|16|ID|IDAHO
+16033|CLARK|16|ID|IDAHO
+16035|CLEARWATER|16|ID|IDAHO
+16037|CUSTER|16|ID|IDAHO
+16039|ELMORE|16|ID|IDAHO
+16041|FRANKLIN|16|ID|IDAHO
+16043|FREMONT|16|ID|IDAHO
+16045|GEM|16|ID|IDAHO
+16047|GOODING|16|ID|IDAHO
+16049|IDAHO|16|ID|IDAHO
+16051|JEFFERSON|16|ID|IDAHO
+16053|JEROME|16|ID|IDAHO
+16055|KOOTENAI|16|ID|IDAHO
+16057|LATAH|16|ID|IDAHO
+16059|LEMHI|16|ID|IDAHO
+16061|LEWIS|16|ID|IDAHO
+16063|LINCOLN|16|ID|IDAHO
+16065|MADISON|16|ID|IDAHO
+16067|MINIDOKA|16|ID|IDAHO
+16069|NEZ PERCE|16|ID|IDAHO
+16071|ONEIDA|16|ID|IDAHO
+16073|OWYHEE|16|ID|IDAHO
+16075|PAYETTE|16|ID|IDAHO
+16077|POWER|16|ID|IDAHO
+16079|SHOSHONE|16|ID|IDAHO
+16081|TETON|16|ID|IDAHO
+16083|TWIN FALLS|16|ID|IDAHO
+16085|VALLEY|16|ID|IDAHO
+16087|WASHINGTON|16|ID|IDAHO
+17001|ADAMS|17|IL|ILLINOIS
+17003|ALEXANDER|17|IL|ILLINOIS
+17005|BOND|17|IL|ILLINOIS
+17007|BOONE|17|IL|ILLINOIS
+17009|BROWN|17|IL|ILLINOIS
+17011|BUREAU|17|IL|ILLINOIS
+17013|CALHOUN|17|IL|ILLINOIS
+17015|CARROLL|17|IL|ILLINOIS
+17017|CASS|17|IL|ILLINOIS
+17019|CHAMPAIGN|17|IL|ILLINOIS
+17021|CHRISTIAN|17|IL|ILLINOIS
+17023|CLARK|17|IL|ILLINOIS
+17025|CLAY|17|IL|ILLINOIS
+17027|CLINTON|17|IL|ILLINOIS
+17029|COLES|17|IL|ILLINOIS
+17031|COOK|17|IL|ILLINOIS
+17033|CRAWFORD|17|IL|ILLINOIS
+17035|CUMBERLAND|17|IL|ILLINOIS
+17037|DEKALB|17|IL|ILLINOIS
+17039|DE WITT|17|IL|ILLINOIS
+17041|DOUGLAS|17|IL|ILLINOIS
+17043|DUPAGE|17|IL|ILLINOIS
+17045|EDGAR|17|IL|ILLINOIS
+17047|EDWARDS|17|IL|ILLINOIS
+17049|EFFINGHAM|17|IL|ILLINOIS
+17051|FAYETTE|17|IL|ILLINOIS
+17053|FORD|17|IL|ILLINOIS
+17055|FRANKLIN|17|IL|ILLINOIS
+17057|FULTON|17|IL|ILLINOIS
+17059|GALLATIN|17|IL|ILLINOIS
+17061|GREENE|17|IL|ILLINOIS
+17063|GRUNDY|17|IL|ILLINOIS
+17065|HAMILTON|17|IL|ILLINOIS
+17067|HANCOCK|17|IL|ILLINOIS
+17069|HARDIN|17|IL|ILLINOIS
+17071|HENDERSON|17|IL|ILLINOIS
+17073|HENRY|17|IL|ILLINOIS
+17075|IROQUOIS|17|IL|ILLINOIS
+17077|JACKSON|17|IL|ILLINOIS
+17079|JASPER|17|IL|ILLINOIS
+17081|JEFFERSON|17|IL|ILLINOIS
+17083|JERSEY|17|IL|ILLINOIS
+17085|JO DAVIESS|17|IL|ILLINOIS
+17087|JOHNSON|17|IL|ILLINOIS
+17089|KANE|17|IL|ILLINOIS
+17091|KANKAKEE|17|IL|ILLINOIS
+17093|KENDALL|17|IL|ILLINOIS
+17095|KNOX|17|IL|ILLINOIS
+17097|LAKE|17|IL|ILLINOIS
+17099|LA SALLE|17|IL|ILLINOIS
+17101|LAWRENCE|17|IL|ILLINOIS
+17103|LEE|17|IL|ILLINOIS
+17105|LIVINGSTON|17|IL|ILLINOIS
+17107|LOGAN|17|IL|ILLINOIS
+17109|MCDONOUGH|17|IL|ILLINOIS
+17111|MCHENRY|17|IL|ILLINOIS
+17113|MCLEAN|17|IL|ILLINOIS
+17115|MACON|17|IL|ILLINOIS
+17117|MACOUPIN|17|IL|ILLINOIS
+17119|MADISON|17|IL|ILLINOIS
+17121|MARION|17|IL|ILLINOIS
+17123|MARSHALL|17|IL|ILLINOIS
+17125|MASON|17|IL|ILLINOIS
+17127|MASSAC|17|IL|ILLINOIS
+17129|MENARD|17|IL|ILLINOIS
+17131|MERCER|17|IL|ILLINOIS
+17133|MONROE|17|IL|ILLINOIS
+17135|MONTGOMERY|17|IL|ILLINOIS
+17137|MORGAN|17|IL|ILLINOIS
+17139|MOULTRIE|17|IL|ILLINOIS
+17141|OGLE|17|IL|ILLINOIS
+17143|PEORIA|17|IL|ILLINOIS
+17145|PERRY|17|IL|ILLINOIS
+17147|PIATT|17|IL|ILLINOIS
+17149|PIKE|17|IL|ILLINOIS
+17151|POPE|17|IL|ILLINOIS
+17153|PULASKI|17|IL|ILLINOIS
+17155|PUTNAM|17|IL|ILLINOIS
+17157|RANDOLPH|17|IL|ILLINOIS
+17159|RICHLAND|17|IL|ILLINOIS
+17161|ROCK ISLAND|17|IL|ILLINOIS
+17163|ST. CLAIR|17|IL|ILLINOIS
+17165|SALINE|17|IL|ILLINOIS
+17167|SANGAMON|17|IL|ILLINOIS
+17169|SCHUYLER|17|IL|ILLINOIS
+17171|SCOTT|17|IL|ILLINOIS
+17173|SHELBY|17|IL|ILLINOIS
+17175|STARK|17|IL|ILLINOIS
+17177|STEPHENSON|17|IL|ILLINOIS
+17179|TAZEWELL|17|IL|ILLINOIS
+17181|UNION|17|IL|ILLINOIS
+17183|VERMILION|17|IL|ILLINOIS
+17185|WABASH|17|IL|ILLINOIS
+17187|WARREN|17|IL|ILLINOIS
+17189|WASHINGTON|17|IL|ILLINOIS
+17191|WAYNE|17|IL|ILLINOIS
+17193|WHITE|17|IL|ILLINOIS
+17195|WHITESIDE|17|IL|ILLINOIS
+17197|WILL|17|IL|ILLINOIS
+17199|WILLIAMSON|17|IL|ILLINOIS
+17201|WINNEBAGO|17|IL|ILLINOIS
+17203|WOODFORD|17|IL|ILLINOIS
+18001|ADAMS|18|IN|INDIANA
+18003|ALLEN|18|IN|INDIANA
+18005|BARTHOLOMEW|18|IN|INDIANA
+18007|BENTON|18|IN|INDIANA
+18009|BLACKFORD|18|IN|INDIANA
+18011|BOONE|18|IN|INDIANA
+18013|BROWN|18|IN|INDIANA
+18015|CARROLL|18|IN|INDIANA
+18017|CASS|18|IN|INDIANA
+18019|CLARK|18|IN|INDIANA
+18021|CLAY|18|IN|INDIANA
+18023|CLINTON|18|IN|INDIANA
+18025|CRAWFORD|18|IN|INDIANA
+18027|DAVIESS|18|IN|INDIANA
+18029|DEARBORN|18|IN|INDIANA
+18031|DECATUR|18|IN|INDIANA
+18033|DE KALB|18|IN|INDIANA
+18035|DELAWARE|18|IN|INDIANA
+18037|DUBOIS|18|IN|INDIANA
+18039|ELKHART|18|IN|INDIANA
+18041|FAYETTE|18|IN|INDIANA
+18043|FLOYD|18|IN|INDIANA
+18045|FOUNTAIN|18|IN|INDIANA
+18047|FRANKLIN|18|IN|INDIANA
+18049|FULTON|18|IN|INDIANA
+18051|GIBSON|18|IN|INDIANA
+18053|GRANT|18|IN|INDIANA
+18055|GREENE|18|IN|INDIANA
+18057|HAMILTON|18|IN|INDIANA
+18059|HANCOCK|18|IN|INDIANA
+18061|HARRISON|18|IN|INDIANA
+18063|HENDRICKS|18|IN|INDIANA
+18065|HENRY|18|IN|INDIANA
+18067|HOWARD|18|IN|INDIANA
+18069|HUNTINGTON|18|IN|INDIANA
+18071|JACKSON|18|IN|INDIANA
+18073|JASPER|18|IN|INDIANA
+18075|JAY|18|IN|INDIANA
+18077|JEFFERSON|18|IN|INDIANA
+18079|JENNINGS|18|IN|INDIANA
+18081|JOHNSON|18|IN|INDIANA
+18083|KNOX|18|IN|INDIANA
+18085|KOSCIUSKO|18|IN|INDIANA
+18087|LAGRANGE|18|IN|INDIANA
+18089|LAKE|18|IN|INDIANA
+18091|LA PORTE|18|IN|INDIANA
+18093|LAWRENCE|18|IN|INDIANA
+18095|MADISON|18|IN|INDIANA
+18097|MARION|18|IN|INDIANA
+18099|MARSHALL|18|IN|INDIANA
+18101|MARTIN|18|IN|INDIANA
+18103|MIAMI|18|IN|INDIANA
+18105|MONROE|18|IN|INDIANA
+18107|MONTGOMERY|18|IN|INDIANA
+18109|MORGAN|18|IN|INDIANA
+18111|NEWTON|18|IN|INDIANA
+18113|NOBLE|18|IN|INDIANA
+18115|OHIO|18|IN|INDIANA
+18117|ORANGE|18|IN|INDIANA
+18119|OWEN|18|IN|INDIANA
+18121|PARKE|18|IN|INDIANA
+18123|PERRY|18|IN|INDIANA
+18125|PIKE|18|IN|INDIANA
+18127|PORTER|18|IN|INDIANA
+18129|POSEY|18|IN|INDIANA
+18131|PULASKI|18|IN|INDIANA
+18133|PUTNAM|18|IN|INDIANA
+18135|RANDOLPH|18|IN|INDIANA
+18137|RIPLEY|18|IN|INDIANA
+18139|RUSH|18|IN|INDIANA
+18141|ST. JOSEPH|18|IN|INDIANA
+18143|SCOTT|18|IN|INDIANA
+18145|SHELBY|18|IN|INDIANA
+18147|SPENCER|18|IN|INDIANA
+18149|STARKE|18|IN|INDIANA
+18151|STEUBEN|18|IN|INDIANA
+18153|SULLIVAN|18|IN|INDIANA
+18155|SWITZERLAND|18|IN|INDIANA
+18157|TIPPECANOE|18|IN|INDIANA
+18159|TIPTON|18|IN|INDIANA
+18161|UNION|18|IN|INDIANA
+18163|VANDERBURGH|18|IN|INDIANA
+18165|VERMILLION|18|IN|INDIANA
+18167|VIGO|18|IN|INDIANA
+18169|WABASH|18|IN|INDIANA
+18171|WARREN|18|IN|INDIANA
+18173|WARRICK|18|IN|INDIANA
+18175|WASHINGTON|18|IN|INDIANA
+18177|WAYNE|18|IN|INDIANA
+18179|WELLS|18|IN|INDIANA
+18181|WHITE|18|IN|INDIANA
+18183|WHITLEY|18|IN|INDIANA
+19001|ADAIR|19|IA|IOWA
+19003|ADAMS|19|IA|IOWA
+19005|ALLAMAKEE|19|IA|IOWA
+19007|APPANOOSE|19|IA|IOWA
+19009|AUDUBON|19|IA|IOWA
+19011|BENTON|19|IA|IOWA
+19013|BLACK HAWK|19|IA|IOWA
+19015|BOONE|19|IA|IOWA
+19017|BREMER|19|IA|IOWA
+19019|BUCHANAN|19|IA|IOWA
+19021|BUENA VISTA|19|IA|IOWA
+19023|BUTLER|19|IA|IOWA
+19025|CALHOUN|19|IA|IOWA
+19027|CARROLL|19|IA|IOWA
+19029|CASS|19|IA|IOWA
+19031|CEDAR|19|IA|IOWA
+19033|CERRO GORDO|19|IA|IOWA
+19035|CHEROKEE|19|IA|IOWA
+19037|CHICKASAW|19|IA|IOWA
+19039|CLARKE|19|IA|IOWA
+19041|CLAY|19|IA|IOWA
+19043|CLAYTON|19|IA|IOWA
+19045|CLINTON|19|IA|IOWA
+19047|CRAWFORD|19|IA|IOWA
+19049|DALLAS|19|IA|IOWA
+19051|DAVIS|19|IA|IOWA
+19053|DECATUR|19|IA|IOWA
+19055|DELAWARE|19|IA|IOWA
+19057|DES MOINES|19|IA|IOWA
+19059|DICKINSON|19|IA|IOWA
+19061|DUBUQUE|19|IA|IOWA
+19063|EMMET|19|IA|IOWA
+19065|FAYETTE|19|IA|IOWA
+19067|FLOYD|19|IA|IOWA
+19069|FRANKLIN|19|IA|IOWA
+19071|FREMONT|19|IA|IOWA
+19073|GREENE|19|IA|IOWA
+19075|GRUNDY|19|IA|IOWA
+19077|GUTHRIE|19|IA|IOWA
+19079|HAMILTON|19|IA|IOWA
+19081|HANCOCK|19|IA|IOWA
+19083|HARDIN|19|IA|IOWA
+19085|HARRISON|19|IA|IOWA
+19087|HENRY|19|IA|IOWA
+19089|HOWARD|19|IA|IOWA
+19091|HUMBOLDT|19|IA|IOWA
+19093|IDA|19|IA|IOWA
+19095|IOWA|19|IA|IOWA
+19097|JACKSON|19|IA|IOWA
+19099|JASPER|19|IA|IOWA
+19101|JEFFERSON|19|IA|IOWA
+19103|JOHNSON|19|IA|IOWA
+19105|JONES|19|IA|IOWA
+19107|KEOKUK|19|IA|IOWA
+19109|KOSSUTH|19|IA|IOWA
+19111|LEE|19|IA|IOWA
+19113|LINN|19|IA|IOWA
+19115|LOUISA|19|IA|IOWA
+19117|LUCAS|19|IA|IOWA
+19119|LYON|19|IA|IOWA
+19121|MADISON|19|IA|IOWA
+19123|MAHASKA|19|IA|IOWA
+19125|MARION|19|IA|IOWA
+19127|MARSHALL|19|IA|IOWA
+19129|MILLS|19|IA|IOWA
+19131|MITCHELL|19|IA|IOWA
+19133|MONONA|19|IA|IOWA
+19135|MONROE|19|IA|IOWA
+19137|MONTGOMERY|19|IA|IOWA
+19139|MUSCATINE|19|IA|IOWA
+19141|O'BRIEN|19|IA|IOWA
+19143|OSCEOLA|19|IA|IOWA
+19145|PAGE|19|IA|IOWA
+19147|PALO ALTO|19|IA|IOWA
+19149|PLYMOUTH|19|IA|IOWA
+19151|POCAHONTAS|19|IA|IOWA
+19153|POLK|19|IA|IOWA
+19155|POTTAWATTAMIE|19|IA|IOWA
+19157|POWESHIEK|19|IA|IOWA
+19159|RINGGOLD|19|IA|IOWA
+19161|SAC|19|IA|IOWA
+19163|SCOTT|19|IA|IOWA
+19165|SHELBY|19|IA|IOWA
+19167|SIOUX|19|IA|IOWA
+19169|STORY|19|IA|IOWA
+19171|TAMA|19|IA|IOWA
+19173|TAYLOR|19|IA|IOWA
+19175|UNION|19|IA|IOWA
+19177|VAN BUREN|19|IA|IOWA
+19179|WAPELLO|19|IA|IOWA
+19181|WARREN|19|IA|IOWA
+19183|WASHINGTON|19|IA|IOWA
+19185|WAYNE|19|IA|IOWA
+19187|WEBSTER|19|IA|IOWA
+19189|WINNEBAGO|19|IA|IOWA
+19191|WINNESHIEK|19|IA|IOWA
+19193|WOODBURY|19|IA|IOWA
+19195|WORTH|19|IA|IOWA
+19197|WRIGHT|19|IA|IOWA
+20001|ALLEN|20|KS|KANSAS
+20003|ANDERSON|20|KS|KANSAS
+20005|ATCHISON|20|KS|KANSAS
+20007|BARBER|20|KS|KANSAS
+20009|BARTON|20|KS|KANSAS
+20011|BOURBON|20|KS|KANSAS
+20013|BROWN|20|KS|KANSAS
+20015|BUTLER|20|KS|KANSAS
+20017|CHASE|20|KS|KANSAS
+20019|CHAUTAUQUA|20|KS|KANSAS
+20021|CHEROKEE|20|KS|KANSAS
+20023|CHEYENNE|20|KS|KANSAS
+20025|CLARK|20|KS|KANSAS
+20027|CLAY|20|KS|KANSAS
+20029|CLOUD|20|KS|KANSAS
+20031|COFFEY|20|KS|KANSAS
+20033|COMANCHE|20|KS|KANSAS
+20035|COWLEY|20|KS|KANSAS
+20037|CRAWFORD|20|KS|KANSAS
+20039|DECATUR|20|KS|KANSAS
+20041|DICKINSON|20|KS|KANSAS
+20043|DONIPHAN|20|KS|KANSAS
+20045|DOUGLAS|20|KS|KANSAS
+20047|EDWARDS|20|KS|KANSAS
+20049|ELK|20|KS|KANSAS
+20051|ELLIS|20|KS|KANSAS
+20053|ELLSWORTH|20|KS|KANSAS
+20055|FINNEY|20|KS|KANSAS
+20057|FORD|20|KS|KANSAS
+20059|FRANKLIN|20|KS|KANSAS
+20061|GEARY|20|KS|KANSAS
+20063|GOVE|20|KS|KANSAS
+20065|GRAHAM|20|KS|KANSAS
+20067|GRANT|20|KS|KANSAS
+20069|GRAY|20|KS|KANSAS
+20071|GREELEY|20|KS|KANSAS
+20073|GREENWOOD|20|KS|KANSAS
+20075|HAMILTON|20|KS|KANSAS
+20077|HARPER|20|KS|KANSAS
+20079|HARVEY|20|KS|KANSAS
+20081|HASKELL|20|KS|KANSAS
+20083|HODGEMAN|20|KS|KANSAS
+20085|JACKSON|20|KS|KANSAS
+20087|JEFFERSON|20|KS|KANSAS
+20089|JEWELL|20|KS|KANSAS
+20091|JOHNSON|20|KS|KANSAS
+20093|KEARNY|20|KS|KANSAS
+20095|KINGMAN|20|KS|KANSAS
+20097|KIOWA|20|KS|KANSAS
+20099|LABETTE|20|KS|KANSAS
+20101|LANE|20|KS|KANSAS
+20103|LEAVENWORTH|20|KS|KANSAS
+20105|LINCOLN|20|KS|KANSAS
+20107|LINN|20|KS|KANSAS
+20109|LOGAN|20|KS|KANSAS
+20111|LYON|20|KS|KANSAS
+20113|MCPHERSON|20|KS|KANSAS
+20115|MARION|20|KS|KANSAS
+20117|MARSHALL|20|KS|KANSAS
+20119|MEADE|20|KS|KANSAS
+20121|MIAMI|20|KS|KANSAS
+20123|MITCHELL|20|KS|KANSAS
+20125|MONTGOMERY|20|KS|KANSAS
+20127|MORRIS|20|KS|KANSAS
+20129|MORTON|20|KS|KANSAS
+20131|NEMAHA|20|KS|KANSAS
+20133|NEOSHO|20|KS|KANSAS
+20135|NESS|20|KS|KANSAS
+20137|NORTON|20|KS|KANSAS
+20139|OSAGE|20|KS|KANSAS
+20141|OSBORNE|20|KS|KANSAS
+20143|OTTAWA|20|KS|KANSAS
+20145|PAWNEE|20|KS|KANSAS
+20147|PHILLIPS|20|KS|KANSAS
+20149|POTTAWATOMIE|20|KS|KANSAS
+20151|PRATT|20|KS|KANSAS
+20153|RAWLINS|20|KS|KANSAS
+20155|RENO|20|KS|KANSAS
+20157|REPUBLIC|20|KS|KANSAS
+20159|RICE|20|KS|KANSAS
+20161|RILEY|20|KS|KANSAS
+20163|ROOKS|20|KS|KANSAS
+20165|RUSH|20|KS|KANSAS
+20167|RUSSELL|20|KS|KANSAS
+20169|SALINE|20|KS|KANSAS
+20171|SCOTT|20|KS|KANSAS
+20173|SEDGWICK|20|KS|KANSAS
+20175|SEWARD|20|KS|KANSAS
+20177|SHAWNEE|20|KS|KANSAS
+20179|SHERIDAN|20|KS|KANSAS
+20181|SHERMAN|20|KS|KANSAS
+20183|SMITH|20|KS|KANSAS
+20185|STAFFORD|20|KS|KANSAS
+20187|STANTON|20|KS|KANSAS
+20189|STEVENS|20|KS|KANSAS
+20191|SUMNER|20|KS|KANSAS
+20193|THOMAS|20|KS|KANSAS
+20195|TREGO|20|KS|KANSAS
+20197|WABAUNSEE|20|KS|KANSAS
+20199|WALLACE|20|KS|KANSAS
+20201|WASHINGTON|20|KS|KANSAS
+20203|WICHITA|20|KS|KANSAS
+20205|WILSON|20|KS|KANSAS
+20207|WOODSON|20|KS|KANSAS
+20209|WYANDOTTE|20|KS|KANSAS
+21001|ADAIR|21|KY|KENTUCKY
+21003|ALLEN|21|KY|KENTUCKY
+21005|ANDERSON|21|KY|KENTUCKY
+21007|BALLARD|21|KY|KENTUCKY
+21009|BARREN|21|KY|KENTUCKY
+21011|BATH|21|KY|KENTUCKY
+21013|BELL|21|KY|KENTUCKY
+21015|BOONE|21|KY|KENTUCKY
+21017|BOURBON|21|KY|KENTUCKY
+21019|BOYD|21|KY|KENTUCKY
+21021|BOYLE|21|KY|KENTUCKY
+21023|BRACKEN|21|KY|KENTUCKY
+21025|BREATHITT|21|KY|KENTUCKY
+21027|BRECKINRIDGE|21|KY|KENTUCKY
+21029|BULLITT|21|KY|KENTUCKY
+21031|BUTLER|21|KY|KENTUCKY
+21033|CALDWELL|21|KY|KENTUCKY
+21035|CALLOWAY|21|KY|KENTUCKY
+21037|CAMPBELL|21|KY|KENTUCKY
+21039|CARLISLE|21|KY|KENTUCKY
+21041|CARROLL|21|KY|KENTUCKY
+21043|CARTER|21|KY|KENTUCKY
+21045|CASEY|21|KY|KENTUCKY
+21047|CHRISTIAN|21|KY|KENTUCKY
+21049|CLARK|21|KY|KENTUCKY
+21051|CLAY|21|KY|KENTUCKY
+21053|CLINTON|21|KY|KENTUCKY
+21055|CRITTENDEN|21|KY|KENTUCKY
+21057|CUMBERLAND|21|KY|KENTUCKY
+21059|DAVIESS|21|KY|KENTUCKY
+21061|EDMONSON|21|KY|KENTUCKY
+21063|ELLIOTT|21|KY|KENTUCKY
+21065|ESTILL|21|KY|KENTUCKY
+21067|FAYETTE|21|KY|KENTUCKY
+21069|FLEMING|21|KY|KENTUCKY
+21071|FLOYD|21|KY|KENTUCKY
+21073|FRANKLIN|21|KY|KENTUCKY
+21075|FULTON|21|KY|KENTUCKY
+21077|GALLATIN|21|KY|KENTUCKY
+21079|GARRARD|21|KY|KENTUCKY
+21081|GRANT|21|KY|KENTUCKY
+21083|GRAVES|21|KY|KENTUCKY
+21085|GRAYSON|21|KY|KENTUCKY
+21087|GREEN|21|KY|KENTUCKY
+21089|GREENUP|21|KY|KENTUCKY
+21091|HANCOCK|21|KY|KENTUCKY
+21093|HARDIN|21|KY|KENTUCKY
+21095|HARLAN|21|KY|KENTUCKY
+21097|HARRISON|21|KY|KENTUCKY
+21099|HART|21|KY|KENTUCKY
+21101|HENDERSON|21|KY|KENTUCKY
+21103|HENRY|21|KY|KENTUCKY
+21105|HICKMAN|21|KY|KENTUCKY
+21107|HOPKINS|21|KY|KENTUCKY
+21109|JACKSON|21|KY|KENTUCKY
+21111|JEFFERSON|21|KY|KENTUCKY
+21113|JESSAMINE|21|KY|KENTUCKY
+21115|JOHNSON|21|KY|KENTUCKY
+21117|KENTON|21|KY|KENTUCKY
+21119|KNOTT|21|KY|KENTUCKY
+21121|KNOX|21|KY|KENTUCKY
+21123|LARUE|21|KY|KENTUCKY
+21125|LAUREL|21|KY|KENTUCKY
+21127|LAWRENCE|21|KY|KENTUCKY
+21129|LEE|21|KY|KENTUCKY
+21131|LESLIE|21|KY|KENTUCKY
+21133|LETCHER|21|KY|KENTUCKY
+21135|LEWIS|21|KY|KENTUCKY
+21137|LINCOLN|21|KY|KENTUCKY
+21139|LIVINGSTON|21|KY|KENTUCKY
+21141|LOGAN|21|KY|KENTUCKY
+21143|LYON|21|KY|KENTUCKY
+21145|MCCRACKEN|21|KY|KENTUCKY
+21147|MCCREARY|21|KY|KENTUCKY
+21149|MCLEAN|21|KY|KENTUCKY
+21151|MADISON|21|KY|KENTUCKY
+21153|MAGOFFIN|21|KY|KENTUCKY
+21155|MARION|21|KY|KENTUCKY
+21157|MARSHALL|21|KY|KENTUCKY
+21159|MARTIN|21|KY|KENTUCKY
+21161|MASON|21|KY|KENTUCKY
+21163|MEADE|21|KY|KENTUCKY
+21165|MENIFEE|21|KY|KENTUCKY
+21167|MERCER|21|KY|KENTUCKY
+21169|METCALFE|21|KY|KENTUCKY
+21171|MONROE|21|KY|KENTUCKY
+21173|MONTGOMERY|21|KY|KENTUCKY
+21175|MORGAN|21|KY|KENTUCKY
+21177|MUHLENBERG|21|KY|KENTUCKY
+21179|NELSON|21|KY|KENTUCKY
+21181|NICHOLAS|21|KY|KENTUCKY
+21183|OHIO|21|KY|KENTUCKY
+21185|OLDHAM|21|KY|KENTUCKY
+21187|OWEN|21|KY|KENTUCKY
+21189|OWSLEY|21|KY|KENTUCKY
+21191|PENDLETON|21|KY|KENTUCKY
+21193|PERRY|21|KY|KENTUCKY
+21195|PIKE|21|KY|KENTUCKY
+21197|POWELL|21|KY|KENTUCKY
+21199|PULASKI|21|KY|KENTUCKY
+21201|ROBERTSON|21|KY|KENTUCKY
+21203|ROCKCASTLE|21|KY|KENTUCKY
+21205|ROWAN|21|KY|KENTUCKY
+21207|RUSSELL|21|KY|KENTUCKY
+21209|SCOTT|21|KY|KENTUCKY
+21211|SHELBY|21|KY|KENTUCKY
+21213|SIMPSON|21|KY|KENTUCKY
+21215|SPENCER|21|KY|KENTUCKY
+21217|TAYLOR|21|KY|KENTUCKY
+21219|TODD|21|KY|KENTUCKY
+21221|TRIGG|21|KY|KENTUCKY
+21223|TRIMBLE|21|KY|KENTUCKY
+21225|UNION|21|KY|KENTUCKY
+21227|WARREN|21|KY|KENTUCKY
+21229|WASHINGTON|21|KY|KENTUCKY
+21231|WAYNE|21|KY|KENTUCKY
+21233|WEBSTER|21|KY|KENTUCKY
+21235|WHITLEY|21|KY|KENTUCKY
+21237|WOLFE|21|KY|KENTUCKY
+21239|WOODFORD|21|KY|KENTUCKY
+22001|ACADIA|22|LA|LOUISIANA
+22003|ALLEN|22|LA|LOUISIANA
+22005|ASCENSION|22|LA|LOUISIANA
+22007|ASSUMPTION|22|LA|LOUISIANA
+22009|AVOYELLES|22|LA|LOUISIANA
+22011|BEAUREGARD|22|LA|LOUISIANA
+22013|BIENVILLE|22|LA|LOUISIANA
+22015|BOSSIER|22|LA|LOUISIANA
+22017|CADDO|22|LA|LOUISIANA
+22019|CALCASIEU|22|LA|LOUISIANA
+22021|CALDWELL|22|LA|LOUISIANA
+22023|CAMERON|22|LA|LOUISIANA
+22025|CATAHOULA|22|LA|LOUISIANA
+22027|CLAIBORNE|22|LA|LOUISIANA
+22029|CONCORDIA|22|LA|LOUISIANA
+22031|DE SOTO|22|LA|LOUISIANA
+22033|EAST BATON ROUGE|22|LA|LOUISIANA
+22035|EAST CARROLL|22|LA|LOUISIANA
+22037|EAST FELICIANA|22|LA|LOUISIANA
+22039|EVANGELINE|22|LA|LOUISIANA
+22041|FRANKLIN|22|LA|LOUISIANA
+22043|GRANT|22|LA|LOUISIANA
+22045|IBERIA|22|LA|LOUISIANA
+22047|IBERVILLE|22|LA|LOUISIANA
+22049|JACKSON|22|LA|LOUISIANA
+22051|JEFFERSON|22|LA|LOUISIANA
+22053|JEFFERSON DAVIS|22|LA|LOUISIANA
+22055|LAFAYETTE|22|LA|LOUISIANA
+22057|LAFOURCHE|22|LA|LOUISIANA
+22059|LA SALLE|22|LA|LOUISIANA
+22061|LINCOLN|22|LA|LOUISIANA
+22063|LIVINGSTON|22|LA|LOUISIANA
+22065|MADISON|22|LA|LOUISIANA
+22067|MOREHOUSE|22|LA|LOUISIANA
+22069|NATCHITOCHES|22|LA|LOUISIANA
+22071|ORLEANS|22|LA|LOUISIANA
+22073|OUACHITA|22|LA|LOUISIANA
+22075|PLAQUEMINES|22|LA|LOUISIANA
+22077|POINTE COUPEE|22|LA|LOUISIANA
+22079|RAPIDES|22|LA|LOUISIANA
+22081|RED RIVER|22|LA|LOUISIANA
+22083|RICHLAND|22|LA|LOUISIANA
+22085|SABINE|22|LA|LOUISIANA
+22087|ST. BERNARD|22|LA|LOUISIANA
+22089|ST. CHARLES|22|LA|LOUISIANA
+22091|ST. HELENA|22|LA|LOUISIANA
+22093|ST. JAMES|22|LA|LOUISIANA
+22095|ST. JOHN THE BAPTIST|22|LA|LOUISIANA
+22097|ST. LANDRY|22|LA|LOUISIANA
+22099|ST. MARTIN|22|LA|LOUISIANA
+22101|ST. MARY|22|LA|LOUISIANA
+22103|ST. TAMMANY|22|LA|LOUISIANA
+22105|TANGIPAHOA|22|LA|LOUISIANA
+22107|TENSAS|22|LA|LOUISIANA
+22109|TERREBONNE|22|LA|LOUISIANA
+22111|UNION|22|LA|LOUISIANA
+22113|VERMILION|22|LA|LOUISIANA
+22115|VERNON|22|LA|LOUISIANA
+22117|WASHINGTON|22|LA|LOUISIANA
+22119|WEBSTER|22|LA|LOUISIANA
+22121|WEST BATON ROUGE|22|LA|LOUISIANA
+22123|WEST CARROLL|22|LA|LOUISIANA
+22125|WEST FELICIANA|22|LA|LOUISIANA
+22127|WINN|22|LA|LOUISIANA
+23001|ANDROSCOGGIN|23|ME|MAINE
+23003|AROOSTOOK|23|ME|MAINE
+23005|CUMBERLAND|23|ME|MAINE
+23007|FRANKLIN|23|ME|MAINE
+23009|HANCOCK|23|ME|MAINE
+23011|KENNEBEC|23|ME|MAINE
+23013|KNOX|23|ME|MAINE
+23015|LINCOLN|23|ME|MAINE
+23017|OXFORD|23|ME|MAINE
+23019|PENOBSCOT|23|ME|MAINE
+23021|PISCATAQUIS|23|ME|MAINE
+23023|SAGADAHOC|23|ME|MAINE
+23025|SOMERSET|23|ME|MAINE
+23027|WALDO|23|ME|MAINE
+23029|WASHINGTON|23|ME|MAINE
+23031|YORK|23|ME|MAINE
+24001|ALLEGANY|24|MD|MARYLAND
+24003|ANNE ARUNDEL|24|MD|MARYLAND
+24005|BALTIMORE|24|MD|MARYLAND
+24009|CALVERT|24|MD|MARYLAND
+24011|CAROLINE|24|MD|MARYLAND
+24013|CARROLL|24|MD|MARYLAND
+24015|CECIL|24|MD|MARYLAND
+24017|CHARLES|24|MD|MARYLAND
+24019|DORCHESTER|24|MD|MARYLAND
+24021|FREDERICK|24|MD|MARYLAND
+24023|GARRETT|24|MD|MARYLAND
+24025|HARFORD|24|MD|MARYLAND
+24027|HOWARD|24|MD|MARYLAND
+24029|KENT|24|MD|MARYLAND
+24031|MONTGOMERY|24|MD|MARYLAND
+24033|PRINCE GEORGE'S|24|MD|MARYLAND
+24035|QUEEN ANNE'S|24|MD|MARYLAND
+24037|ST. MARY'S|24|MD|MARYLAND
+24039|SOMERSET|24|MD|MARYLAND
+24041|TALBOT|24|MD|MARYLAND
+24043|WASHINGTON|24|MD|MARYLAND
+24045|WICOMICO|24|MD|MARYLAND
+24047|WORCESTER|24|MD|MARYLAND
+24510|BALTIMORE (CITY)|24|MD|MARYLAND
+25001|BARNSTABLE|25|MA|MASSACHUSETTS
+25003|BERKSHIRE|25|MA|MASSACHUSETTS
+25005|BRISTOL|25|MA|MASSACHUSETTS
+25007|DUKES|25|MA|MASSACHUSETTS
+25009|ESSEX|25|MA|MASSACHUSETTS
+25011|FRANKLIN|25|MA|MASSACHUSETTS
+25013|HAMPDEN|25|MA|MASSACHUSETTS
+25015|HAMPSHIRE|25|MA|MASSACHUSETTS
+25017|MIDDLESEX|25|MA|MASSACHUSETTS
+25019|NANTUCKET|25|MA|MASSACHUSETTS
+25021|NORFOLK|25|MA|MASSACHUSETTS
+25023|PLYMOUTH|25|MA|MASSACHUSETTS
+25025|SUFFOLK|25|MA|MASSACHUSETTS
+25027|WORCESTER|25|MA|MASSACHUSETTS
+26001|ALCONA|26|MI|MICHIGAN
+26003|ALGER|26|MI|MICHIGAN
+26005|ALLEGAN|26|MI|MICHIGAN
+26007|ALPENA|26|MI|MICHIGAN
+26009|ANTRIM|26|MI|MICHIGAN
+26011|ARENAC|26|MI|MICHIGAN
+26013|BARAGA|26|MI|MICHIGAN
+26015|BARRY|26|MI|MICHIGAN
+26017|BAY|26|MI|MICHIGAN
+26019|BENZIE|26|MI|MICHIGAN
+26021|BERRIEN|26|MI|MICHIGAN
+26023|BRANCH|26|MI|MICHIGAN
+26025|CALHOUN|26|MI|MICHIGAN
+26027|CASS|26|MI|MICHIGAN
+26029|CHARLEVOIX|26|MI|MICHIGAN
+26031|CHEBOYGAN|26|MI|MICHIGAN
+26033|CHIPPEWA|26|MI|MICHIGAN
+26035|CLARE|26|MI|MICHIGAN
+26037|CLINTON|26|MI|MICHIGAN
+26039|CRAWFORD|26|MI|MICHIGAN
+26041|DELTA|26|MI|MICHIGAN
+26043|DICKINSON|26|MI|MICHIGAN
+26045|EATON|26|MI|MICHIGAN
+26047|EMMET|26|MI|MICHIGAN
+26049|GENESEE|26|MI|MICHIGAN
+26051|GLADWIN|26|MI|MICHIGAN
+26053|GOGEBIC|26|MI|MICHIGAN
+26055|GRAND TRAVERSE|26|MI|MICHIGAN
+26057|GRATIOT|26|MI|MICHIGAN
+26059|HILLSDALE|26|MI|MICHIGAN
+26061|HOUGHTON|26|MI|MICHIGAN
+26063|HURON|26|MI|MICHIGAN
+26065|INGHAM|26|MI|MICHIGAN
+26067|IONIA|26|MI|MICHIGAN
+26069|IOSCO|26|MI|MICHIGAN
+26071|IRON|26|MI|MICHIGAN
+26073|ISABELLA|26|MI|MICHIGAN
+26075|JACKSON|26|MI|MICHIGAN
+26077|KALAMAZOO|26|MI|MICHIGAN
+26079|KALKASKA|26|MI|MICHIGAN
+26081|KENT|26|MI|MICHIGAN
+26083|KEWEENAW|26|MI|MICHIGAN
+26085|LAKE|26|MI|MICHIGAN
+26087|LAPEER|26|MI|MICHIGAN
+26089|LEELANAU|26|MI|MICHIGAN
+26091|LENAWEE|26|MI|MICHIGAN
+26093|LIVINGSTON|26|MI|MICHIGAN
+26095|LUCE|26|MI|MICHIGAN
+26097|MACKINAC|26|MI|MICHIGAN
+26099|MACOMB|26|MI|MICHIGAN
+26101|MANISTEE|26|MI|MICHIGAN
+26103|MARQUETTE|26|MI|MICHIGAN
+26105|MASON|26|MI|MICHIGAN
+26107|MECOSTA|26|MI|MICHIGAN
+26109|MENOMINEE|26|MI|MICHIGAN
+26111|MIDLAND|26|MI|MICHIGAN
+26113|MISSAUKEE|26|MI|MICHIGAN
+26115|MONROE|26|MI|MICHIGAN
+26117|MONTCALM|26|MI|MICHIGAN
+26119|MONTMORENCY|26|MI|MICHIGAN
+26121|MUSKEGON|26|MI|MICHIGAN
+26123|NEWAYGO|26|MI|MICHIGAN
+26125|OAKLAND|26|MI|MICHIGAN
+26127|OCEANA|26|MI|MICHIGAN
+26129|OGEMAW|26|MI|MICHIGAN
+26131|ONTONAGON|26|MI|MICHIGAN
+26133|OSCEOLA|26|MI|MICHIGAN
+26135|OSCODA|26|MI|MICHIGAN
+26137|OTSEGO|26|MI|MICHIGAN
+26139|OTTAWA|26|MI|MICHIGAN
+26141|PRESQUE ISLE|26|MI|MICHIGAN
+26143|ROSCOMMON|26|MI|MICHIGAN
+26145|SAGINAW|26|MI|MICHIGAN
+26147|ST. CLAIR|26|MI|MICHIGAN
+26149|ST. JOSEPH|26|MI|MICHIGAN
+26151|SANILAC|26|MI|MICHIGAN
+26153|SCHOOLCRAFT|26|MI|MICHIGAN
+26155|SHIAWASSEE|26|MI|MICHIGAN
+26157|TUSCOLA|26|MI|MICHIGAN
+26159|VAN BUREN|26|MI|MICHIGAN
+26161|WASHTENAW|26|MI|MICHIGAN
+26163|WAYNE|26|MI|MICHIGAN
+26165|WEXFORD|26|MI|MICHIGAN
+27001|AITKIN|27|MN|MINNESOTA
+27003|ANOKA|27|MN|MINNESOTA
+27005|BECKER|27|MN|MINNESOTA
+27007|BELTRAMI|27|MN|MINNESOTA
+27009|BENTON|27|MN|MINNESOTA
+27011|BIG STONE|27|MN|MINNESOTA
+27013|BLUE EARTH|27|MN|MINNESOTA
+27015|BROWN|27|MN|MINNESOTA
+27017|CARLTON|27|MN|MINNESOTA
+27019|CARVER|27|MN|MINNESOTA
+27021|CASS|27|MN|MINNESOTA
+27023|CHIPPEWA|27|MN|MINNESOTA
+27025|CHISAGO|27|MN|MINNESOTA
+27027|CLAY|27|MN|MINNESOTA
+27029|CLEARWATER|27|MN|MINNESOTA
+27031|COOK|27|MN|MINNESOTA
+27033|COTTONWOOD|27|MN|MINNESOTA
+27035|CROW WING|27|MN|MINNESOTA
+27037|DAKOTA|27|MN|MINNESOTA
+27039|DODGE|27|MN|MINNESOTA
+27041|DOUGLAS|27|MN|MINNESOTA
+27043|FARIBAULT|27|MN|MINNESOTA
+27045|FILLMORE|27|MN|MINNESOTA
+27047|FREEBORN|27|MN|MINNESOTA
+27049|GOODHUE|27|MN|MINNESOTA
+27051|GRANT|27|MN|MINNESOTA
+27053|HENNEPIN|27|MN|MINNESOTA
+27055|HOUSTON|27|MN|MINNESOTA
+27057|HUBBARD|27|MN|MINNESOTA
+27059|ISANTI|27|MN|MINNESOTA
+27061|ITASCA|27|MN|MINNESOTA
+27063|JACKSON|27|MN|MINNESOTA
+27065|KANABEC|27|MN|MINNESOTA
+27067|KANDIYOHI|27|MN|MINNESOTA
+27069|KITTSON|27|MN|MINNESOTA
+27071|KOOCHICHING|27|MN|MINNESOTA
+27073|LAC QUI PARLE|27|MN|MINNESOTA
+27075|LAKE|27|MN|MINNESOTA
+27077|LAKE OF THE WOODS|27|MN|MINNESOTA
+27079|LE SUEUR|27|MN|MINNESOTA
+27081|LINCOLN|27|MN|MINNESOTA
+27083|LYON|27|MN|MINNESOTA
+27085|MCLEOD|27|MN|MINNESOTA
+27087|MAHNOMEN|27|MN|MINNESOTA
+27089|MARSHALL|27|MN|MINNESOTA
+27091|MARTIN|27|MN|MINNESOTA
+27093|MEEKER|27|MN|MINNESOTA
+27095|MILLE LACS|27|MN|MINNESOTA
+27097|MORRISON|27|MN|MINNESOTA
+27099|MOWER|27|MN|MINNESOTA
+27101|MURRAY|27|MN|MINNESOTA
+27103|NICOLLET|27|MN|MINNESOTA
+27105|NOBLES|27|MN|MINNESOTA
+27107|NORMAN|27|MN|MINNESOTA
+27109|OLMSTED|27|MN|MINNESOTA
+27111|OTTER TAIL|27|MN|MINNESOTA
+27113|PENNINGTON|27|MN|MINNESOTA
+27115|PINE|27|MN|MINNESOTA
+27117|PIPESTONE|27|MN|MINNESOTA
+27119|POLK|27|MN|MINNESOTA
+27121|POPE|27|MN|MINNESOTA
+27123|RAMSEY|27|MN|MINNESOTA
+27125|RED LAKE|27|MN|MINNESOTA
+27127|REDWOOD|27|MN|MINNESOTA
+27129|RENVILLE|27|MN|MINNESOTA
+27131|RICE|27|MN|MINNESOTA
+27133|ROCK|27|MN|MINNESOTA
+27135|ROSEAU|27|MN|MINNESOTA
+27137|ST. LOUIS|27|MN|MINNESOTA
+27139|SCOTT|27|MN|MINNESOTA
+27141|SHERBURNE|27|MN|MINNESOTA
+27143|SIBLEY|27|MN|MINNESOTA
+27145|STEARNS|27|MN|MINNESOTA
+27147|STEELE|27|MN|MINNESOTA
+27149|STEVENS|27|MN|MINNESOTA
+27151|SWIFT|27|MN|MINNESOTA
+27153|TODD|27|MN|MINNESOTA
+27155|TRAVERSE|27|MN|MINNESOTA
+27157|WABASHA|27|MN|MINNESOTA
+27159|WADENA|27|MN|MINNESOTA
+27161|WASECA|27|MN|MINNESOTA
+27163|WASHINGTON|27|MN|MINNESOTA
+27165|WATONWAN|27|MN|MINNESOTA
+27167|WILKIN|27|MN|MINNESOTA
+27169|WINONA|27|MN|MINNESOTA
+27171|WRIGHT|27|MN|MINNESOTA
+27173|YELLOW MEDICINE|27|MN|MINNESOTA
+28001|ADAMS|28|MS|MISSISSIPPI
+28003|ALCORN|28|MS|MISSISSIPPI
+28005|AMITE|28|MS|MISSISSIPPI
+28007|ATTALA|28|MS|MISSISSIPPI
+28009|BENTON|28|MS|MISSISSIPPI
+28011|BOLIVAR|28|MS|MISSISSIPPI
+28013|CALHOUN|28|MS|MISSISSIPPI
+28015|CARROLL|28|MS|MISSISSIPPI
+28017|CHICKASAW|28|MS|MISSISSIPPI
+28019|CHOCTAW|28|MS|MISSISSIPPI
+28021|CLAIBORNE|28|MS|MISSISSIPPI
+28023|CLARKE|28|MS|MISSISSIPPI
+28025|CLAY|28|MS|MISSISSIPPI
+28027|COAHOMA|28|MS|MISSISSIPPI
+28029|COPIAH|28|MS|MISSISSIPPI
+28031|COVINGTON|28|MS|MISSISSIPPI
+28033|DESOTO|28|MS|MISSISSIPPI
+28035|FORREST|28|MS|MISSISSIPPI
+28037|FRANKLIN|28|MS|MISSISSIPPI
+28039|GEORGE|28|MS|MISSISSIPPI
+28041|GREENE|28|MS|MISSISSIPPI
+28043|GRENADA|28|MS|MISSISSIPPI
+28045|HANCOCK|28|MS|MISSISSIPPI
+28047|HARRISON|28|MS|MISSISSIPPI
+28049|HINDS|28|MS|MISSISSIPPI
+28051|HOLMES|28|MS|MISSISSIPPI
+28053|HUMPHREYS|28|MS|MISSISSIPPI
+28055|ISSAQUENA|28|MS|MISSISSIPPI
+28057|ITAWAMBA|28|MS|MISSISSIPPI
+28059|JACKSON|28|MS|MISSISSIPPI
+28061|JASPER|28|MS|MISSISSIPPI
+28063|JEFFERSON|28|MS|MISSISSIPPI
+28065|JEFFERSON DAVIS|28|MS|MISSISSIPPI
+28067|JONES|28|MS|MISSISSIPPI
+28069|KEMPER|28|MS|MISSISSIPPI
+28071|LAFAYETTE|28|MS|MISSISSIPPI
+28073|LAMAR|28|MS|MISSISSIPPI
+28075|LAUDERDALE|28|MS|MISSISSIPPI
+28077|LAWRENCE|28|MS|MISSISSIPPI
+28079|LEAKE|28|MS|MISSISSIPPI
+28081|LEE|28|MS|MISSISSIPPI
+28083|LEFLORE|28|MS|MISSISSIPPI
+28085|LINCOLN|28|MS|MISSISSIPPI
+28087|LOWNDES|28|MS|MISSISSIPPI
+28089|MADISON|28|MS|MISSISSIPPI
+28091|MARION|28|MS|MISSISSIPPI
+28093|MARSHALL|28|MS|MISSISSIPPI
+28095|MONROE|28|MS|MISSISSIPPI
+28097|MONTGOMERY|28|MS|MISSISSIPPI
+28099|NESHOBA|28|MS|MISSISSIPPI
+28101|NEWTON|28|MS|MISSISSIPPI
+28103|NOXUBEE|28|MS|MISSISSIPPI
+28105|OKTIBBEHA|28|MS|MISSISSIPPI
+28107|PANOLA|28|MS|MISSISSIPPI
+28109|PEARL RIVER|28|MS|MISSISSIPPI
+28111|PERRY|28|MS|MISSISSIPPI
+28113|PIKE|28|MS|MISSISSIPPI
+28115|PONTOTOC|28|MS|MISSISSIPPI
+28117|PRENTISS|28|MS|MISSISSIPPI
+28119|QUITMAN|28|MS|MISSISSIPPI
+28121|RANKIN|28|MS|MISSISSIPPI
+28123|SCOTT|28|MS|MISSISSIPPI
+28125|SHARKEY|28|MS|MISSISSIPPI
+28127|SIMPSON|28|MS|MISSISSIPPI
+28129|SMITH|28|MS|MISSISSIPPI
+28131|STONE|28|MS|MISSISSIPPI
+28133|SUNFLOWER|28|MS|MISSISSIPPI
+28135|TALLAHATCHIE|28|MS|MISSISSIPPI
+28137|TATE|28|MS|MISSISSIPPI
+28139|TIPPAH|28|MS|MISSISSIPPI
+28141|TISHOMINGO|28|MS|MISSISSIPPI
+28143|TUNICA|28|MS|MISSISSIPPI
+28145|UNION|28|MS|MISSISSIPPI
+28147|WALTHALL|28|MS|MISSISSIPPI
+28149|WARREN|28|MS|MISSISSIPPI
+28151|WASHINGTON|28|MS|MISSISSIPPI
+28153|WAYNE|28|MS|MISSISSIPPI
+28155|WEBSTER|28|MS|MISSISSIPPI
+28157|WILKINSON|28|MS|MISSISSIPPI
+28159|WINSTON|28|MS|MISSISSIPPI
+28161|YALOBUSHA|28|MS|MISSISSIPPI
+28163|YAZOO|28|MS|MISSISSIPPI
+29001|ADAIR|29|MO|MISSOURI
+29003|ANDREW|29|MO|MISSOURI
+29005|ATCHISON|29|MO|MISSOURI
+29007|AUDRAIN|29|MO|MISSOURI
+29009|BARRY|29|MO|MISSOURI
+29011|BARTON|29|MO|MISSOURI
+29013|BATES|29|MO|MISSOURI
+29015|BENTON|29|MO|MISSOURI
+29017|BOLLINGER|29|MO|MISSOURI
+29019|BOONE|29|MO|MISSOURI
+29021|BUCHANAN|29|MO|MISSOURI
+29023|BUTLER|29|MO|MISSOURI
+29025|CALDWELL|29|MO|MISSOURI
+29027|CALLAWAY|29|MO|MISSOURI
+29029|CAMDEN|29|MO|MISSOURI
+29031|CAPE GIRARDEAU|29|MO|MISSOURI
+29033|CARROLL|29|MO|MISSOURI
+29035|CARTER|29|MO|MISSOURI
+29037|CASS|29|MO|MISSOURI
+29039|CEDAR|29|MO|MISSOURI
+29041|CHARITON|29|MO|MISSOURI
+29043|CHRISTIAN|29|MO|MISSOURI
+29045|CLARK|29|MO|MISSOURI
+29047|CLAY|29|MO|MISSOURI
+29049|CLINTON|29|MO|MISSOURI
+29051|COLE|29|MO|MISSOURI
+29053|COOPER|29|MO|MISSOURI
+29055|CRAWFORD|29|MO|MISSOURI
+29057|DADE|29|MO|MISSOURI
+29059|DALLAS|29|MO|MISSOURI
+29061|DAVIESS|29|MO|MISSOURI
+29063|DEKALB|29|MO|MISSOURI
+29065|DENT|29|MO|MISSOURI
+29067|DOUGLAS|29|MO|MISSOURI
+29069|DUNKLIN|29|MO|MISSOURI
+29071|FRANKLIN|29|MO|MISSOURI
+29073|GASCONADE|29|MO|MISSOURI
+29075|GENTRY|29|MO|MISSOURI
+29077|GREENE|29|MO|MISSOURI
+29079|GRUNDY|29|MO|MISSOURI
+29081|HARRISON|29|MO|MISSOURI
+29083|HENRY|29|MO|MISSOURI
+29085|HICKORY|29|MO|MISSOURI
+29087|HOLT|29|MO|MISSOURI
+29089|HOWARD|29|MO|MISSOURI
+29091|HOWELL|29|MO|MISSOURI
+29093|IRON|29|MO|MISSOURI
+29095|JACKSON|29|MO|MISSOURI
+29097|JASPER|29|MO|MISSOURI
+29099|JEFFERSON|29|MO|MISSOURI
+29101|JOHNSON|29|MO|MISSOURI
+29103|KNOX|29|MO|MISSOURI
+29105|LACLEDE|29|MO|MISSOURI
+29107|LAFAYETTE|29|MO|MISSOURI
+29109|LAWRENCE|29|MO|MISSOURI
+29111|LEWIS|29|MO|MISSOURI
+29113|LINCOLN|29|MO|MISSOURI
+29115|LINN|29|MO|MISSOURI
+29117|LIVINGSTON|29|MO|MISSOURI
+29119|MCDONALD|29|MO|MISSOURI
+29121|MACON|29|MO|MISSOURI
+29123|MADISON|29|MO|MISSOURI
+29125|MARIES|29|MO|MISSOURI
+29127|MARION|29|MO|MISSOURI
+29129|MERCER|29|MO|MISSOURI
+29131|MILLER|29|MO|MISSOURI
+29133|MISSISSIPPI|29|MO|MISSOURI
+29135|MONITEAU|29|MO|MISSOURI
+29137|MONROE|29|MO|MISSOURI
+29139|MONTGOMERY|29|MO|MISSOURI
+29141|MORGAN|29|MO|MISSOURI
+29143|NEW MADRID|29|MO|MISSOURI
+29145|NEWTON|29|MO|MISSOURI
+29147|NODAWAY|29|MO|MISSOURI
+29149|OREGON|29|MO|MISSOURI
+29151|OSAGE|29|MO|MISSOURI
+29153|OZARK|29|MO|MISSOURI
+29155|PEMISCOT|29|MO|MISSOURI
+29157|PERRY|29|MO|MISSOURI
+29159|PETTIS|29|MO|MISSOURI
+29161|PHELPS|29|MO|MISSOURI
+29163|PIKE|29|MO|MISSOURI
+29165|PLATTE|29|MO|MISSOURI
+29167|POLK|29|MO|MISSOURI
+29169|PULASKI|29|MO|MISSOURI
+29171|PUTNAM|29|MO|MISSOURI
+29173|RALLS|29|MO|MISSOURI
+29175|RANDOLPH|29|MO|MISSOURI
+29177|RAY|29|MO|MISSOURI
+29179|REYNOLDS|29|MO|MISSOURI
+29181|RIPLEY|29|MO|MISSOURI
+29183|ST. CHARLES|29|MO|MISSOURI
+29185|ST. CLAIR|29|MO|MISSOURI
+29186|STE. GENEVIEVE|29|MO|MISSOURI
+29187|ST. FRANCOIS|29|MO|MISSOURI
+29189|ST. LOUIS|29|MO|MISSOURI
+29195|SALINE|29|MO|MISSOURI
+29197|SCHUYLER|29|MO|MISSOURI
+29199|SCOTLAND|29|MO|MISSOURI
+29201|SCOTT|29|MO|MISSOURI
+29203|SHANNON|29|MO|MISSOURI
+29205|SHELBY|29|MO|MISSOURI
+29207|STODDARD|29|MO|MISSOURI
+29209|STONE|29|MO|MISSOURI
+29211|SULLIVAN|29|MO|MISSOURI
+29213|TANEY|29|MO|MISSOURI
+29215|TEXAS|29|MO|MISSOURI
+29217|VERNON|29|MO|MISSOURI
+29219|WARREN|29|MO|MISSOURI
+29221|WASHINGTON|29|MO|MISSOURI
+29223|WAYNE|29|MO|MISSOURI
+29225|WEBSTER|29|MO|MISSOURI
+29227|WORTH|29|MO|MISSOURI
+29229|WRIGHT|29|MO|MISSOURI
+29510|ST. LOUIS (CITY)|29|MO|MISSOURI
+30001|BEAVERHEAD|30|MT|MONTANA
+30003|BIG HORN|30|MT|MONTANA
+30005|BLAINE|30|MT|MONTANA
+30007|BROADWATER|30|MT|MONTANA
+30009|CARBON|30|MT|MONTANA
+30011|CARTER|30|MT|MONTANA
+30013|CASCADE|30|MT|MONTANA
+30015|CHOUTEAU|30|MT|MONTANA
+30017|CUSTER|30|MT|MONTANA
+30019|DANIELS|30|MT|MONTANA
+30021|DAWSON|30|MT|MONTANA
+30023|DEER LODGE|30|MT|MONTANA
+30025|FALLON|30|MT|MONTANA
+30027|FERGUS|30|MT|MONTANA
+30029|FLATHEAD|30|MT|MONTANA
+30031|GALLATIN|30|MT|MONTANA
+30033|GARFIELD|30|MT|MONTANA
+30035|GLACIER|30|MT|MONTANA
+30037|GOLDEN VALLEY|30|MT|MONTANA
+30039|GRANITE|30|MT|MONTANA
+30041|HILL|30|MT|MONTANA
+30043|JEFFERSON|30|MT|MONTANA
+30045|JUDITH BASIN|30|MT|MONTANA
+30047|LAKE|30|MT|MONTANA
+30049|LEWIS AND CLARK|30|MT|MONTANA
+30051|LIBERTY|30|MT|MONTANA
+30053|LINCOLN|30|MT|MONTANA
+30055|MCCONE|30|MT|MONTANA
+30057|MADISON|30|MT|MONTANA
+30059|MEAGHER|30|MT|MONTANA
+30061|MINERAL|30|MT|MONTANA
+30063|MISSOULA|30|MT|MONTANA
+30065|MUSSELSHELL|30|MT|MONTANA
+30067|PARK|30|MT|MONTANA
+30069|PETROLEUM|30|MT|MONTANA
+30071|PHILLIPS|30|MT|MONTANA
+30073|PONDERA|30|MT|MONTANA
+30075|POWDER RIVER|30|MT|MONTANA
+30077|POWELL|30|MT|MONTANA
+30079|PRAIRIE|30|MT|MONTANA
+30081|RAVALLI|30|MT|MONTANA
+30083|RICHLAND|30|MT|MONTANA
+30085|ROOSEVELT|30|MT|MONTANA
+30087|ROSEBUD|30|MT|MONTANA
+30089|SANDERS|30|MT|MONTANA
+30091|SHERIDAN|30|MT|MONTANA
+30093|SILVER BOW|30|MT|MONTANA
+30095|STILLWATER|30|MT|MONTANA
+30097|SWEET GRASS|30|MT|MONTANA
+30099|TETON|30|MT|MONTANA
+30101|TOOLE|30|MT|MONTANA
+30103|TREASURE|30|MT|MONTANA
+30105|VALLEY|30|MT|MONTANA
+30107|WHEATLAND|30|MT|MONTANA
+30109|WIBAUX|30|MT|MONTANA
+30111|YELLOWSTONE|30|MT|MONTANA
+30113|YELLOWSTONE NATIONAL PARK|30|MT|MONTANA
+31001|ADAMS|31|NE|NEBRASKA
+31003|ANTELOPE|31|NE|NEBRASKA
+31005|ARTHUR|31|NE|NEBRASKA
+31007|BANNER|31|NE|NEBRASKA
+31009|BLAINE|31|NE|NEBRASKA
+31011|BOONE|31|NE|NEBRASKA
+31013|BOX BUTTE|31|NE|NEBRASKA
+31015|BOYD|31|NE|NEBRASKA
+31017|BROWN|31|NE|NEBRASKA
+31019|BUFFALO|31|NE|NEBRASKA
+31021|BURT|31|NE|NEBRASKA
+31023|BUTLER|31|NE|NEBRASKA
+31025|CASS|31|NE|NEBRASKA
+31027|CEDAR|31|NE|NEBRASKA
+31029|CHASE|31|NE|NEBRASKA
+31031|CHERRY|31|NE|NEBRASKA
+31033|CHEYENNE|31|NE|NEBRASKA
+31035|CLAY|31|NE|NEBRASKA
+31037|COLFAX|31|NE|NEBRASKA
+31039|CUMING|31|NE|NEBRASKA
+31041|CUSTER|31|NE|NEBRASKA
+31043|DAKOTA|31|NE|NEBRASKA
+31045|DAWES|31|NE|NEBRASKA
+31047|DAWSON|31|NE|NEBRASKA
+31049|DEUEL|31|NE|NEBRASKA
+31051|DIXON|31|NE|NEBRASKA
+31053|DODGE|31|NE|NEBRASKA
+31055|DOUGLAS|31|NE|NEBRASKA
+31057|DUNDY|31|NE|NEBRASKA
+31059|FILLMORE|31|NE|NEBRASKA
+31061|FRANKLIN|31|NE|NEBRASKA
+31063|FRONTIER|31|NE|NEBRASKA
+31065|FURNAS|31|NE|NEBRASKA
+31067|GAGE|31|NE|NEBRASKA
+31069|GARDEN|31|NE|NEBRASKA
+31071|GARFIELD|31|NE|NEBRASKA
+31073|GOSPER|31|NE|NEBRASKA
+31075|GRANT|31|NE|NEBRASKA
+31077|GREELEY|31|NE|NEBRASKA
+31079|HALL|31|NE|NEBRASKA
+31081|HAMILTON|31|NE|NEBRASKA
+31083|HARLAN|31|NE|NEBRASKA
+31085|HAYES|31|NE|NEBRASKA
+31087|HITCHCOCK|31|NE|NEBRASKA
+31089|HOLT|31|NE|NEBRASKA
+31091|HOOKER|31|NE|NEBRASKA
+31093|HOWARD|31|NE|NEBRASKA
+31095|JEFFERSON|31|NE|NEBRASKA
+31097|JOHNSON|31|NE|NEBRASKA
+31099|KEARNEY|31|NE|NEBRASKA
+31101|KEITH|31|NE|NEBRASKA
+31103|KEYA PAHA|31|NE|NEBRASKA
+31105|KIMBALL|31|NE|NEBRASKA
+31107|KNOX|31|NE|NEBRASKA
+31109|LANCASTER|31|NE|NEBRASKA
+31111|LINCOLN|31|NE|NEBRASKA
+31113|LOGAN|31|NE|NEBRASKA
+31115|LOUP|31|NE|NEBRASKA
+31117|MCPHERSON|31|NE|NEBRASKA
+31119|MADISON|31|NE|NEBRASKA
+31121|MERRICK|31|NE|NEBRASKA
+31123|MORRILL|31|NE|NEBRASKA
+31125|NANCE|31|NE|NEBRASKA
+31127|NEMAHA|31|NE|NEBRASKA
+31129|NUCKOLLS|31|NE|NEBRASKA
+31131|OTOE|31|NE|NEBRASKA
+31133|PAWNEE|31|NE|NEBRASKA
+31135|PERKINS|31|NE|NEBRASKA
+31137|PHELPS|31|NE|NEBRASKA
+31139|PIERCE|31|NE|NEBRASKA
+31141|PLATTE|31|NE|NEBRASKA
+31143|POLK|31|NE|NEBRASKA
+31145|RED WILLOW|31|NE|NEBRASKA
+31147|RICHARDSON|31|NE|NEBRASKA
+31149|ROCK|31|NE|NEBRASKA
+31151|SALINE|31|NE|NEBRASKA
+31153|SARPY|31|NE|NEBRASKA
+31155|SAUNDERS|31|NE|NEBRASKA
+31157|SCOTTS BLUFF|31|NE|NEBRASKA
+31159|SEWARD|31|NE|NEBRASKA
+31161|SHERIDAN|31|NE|NEBRASKA
+31163|SHERMAN|31|NE|NEBRASKA
+31165|SIOUX|31|NE|NEBRASKA
+31167|STANTON|31|NE|NEBRASKA
+31169|THAYER|31|NE|NEBRASKA
+31171|THOMAS|31|NE|NEBRASKA
+31173|THURSTON|31|NE|NEBRASKA
+31175|VALLEY|31|NE|NEBRASKA
+31177|WASHINGTON|31|NE|NEBRASKA
+31179|WAYNE|31|NE|NEBRASKA
+31181|WEBSTER|31|NE|NEBRASKA
+31183|WHEELER|31|NE|NEBRASKA
+31185|YORK|31|NE|NEBRASKA
+32001|CHURCHILL|32|NV|NEVADA
+32003|CLARK|32|NV|NEVADA
+32005|DOUGLAS|32|NV|NEVADA
+32007|ELKO|32|NV|NEVADA
+32009|ESMERALDA|32|NV|NEVADA
+32011|EUREKA|32|NV|NEVADA
+32013|HUMBOLDT|32|NV|NEVADA
+32015|LANDER|32|NV|NEVADA
+32017|LINCOLN|32|NV|NEVADA
+32019|LYON|32|NV|NEVADA
+32021|MINERAL|32|NV|NEVADA
+32023|NYE|32|NV|NEVADA
+32027|PERSHING|32|NV|NEVADA
+32029|STOREY|32|NV|NEVADA
+32031|WASHOE|32|NV|NEVADA
+32033|WHITE PINE|32|NV|NEVADA
+32510|CARSON CITY|32|NV|NEVADA
+33001|BELKNAP|33|NH|NEW HAMPSHIRE
+33003|CARROLL|33|NH|NEW HAMPSHIRE
+33005|CHESHIRE|33|NH|NEW HAMPSHIRE
+33007|COOS|33|NH|NEW HAMPSHIRE
+33009|GRAFTON|33|NH|NEW HAMPSHIRE
+33011|HILLSBOROUGH|33|NH|NEW HAMPSHIRE
+33013|MERRIMACK|33|NH|NEW HAMPSHIRE
+33015|ROCKINGHAM|33|NH|NEW HAMPSHIRE
+33017|STRAFFORD|33|NH|NEW HAMPSHIRE
+33019|SULLIVAN|33|NH|NEW HAMPSHIRE
+34001|ATLANTIC|34|NJ|NEW JERSEY
+34003|BERGEN|34|NJ|NEW JERSEY
+34005|BURLINGTON|34|NJ|NEW JERSEY
+34007|CAMDEN|34|NJ|NEW JERSEY
+34009|CAPE MAY|34|NJ|NEW JERSEY
+34011|CUMBERLAND|34|NJ|NEW JERSEY
+34013|ESSEX|34|NJ|NEW JERSEY
+34015|GLOUCESTER|34|NJ|NEW JERSEY
+34017|HUDSON|34|NJ|NEW JERSEY
+34019|HUNTERDON|34|NJ|NEW JERSEY
+34021|MERCER|34|NJ|NEW JERSEY
+34023|MIDDLESEX|34|NJ|NEW JERSEY
+34025|MONMOUTH|34|NJ|NEW JERSEY
+34027|MORRIS|34|NJ|NEW JERSEY
+34029|OCEAN|34|NJ|NEW JERSEY
+34031|PASSAIC|34|NJ|NEW JERSEY
+34033|SALEM|34|NJ|NEW JERSEY
+34035|SOMERSET|34|NJ|NEW JERSEY
+34037|SUSSEX|34|NJ|NEW JERSEY
+34039|UNION|34|NJ|NEW JERSEY
+34041|WARREN|34|NJ|NEW JERSEY
+35001|BERNALILLO|35|NM|NEW MEXICO
+35003|CATRON|35|NM|NEW MEXICO
+35005|CHAVES|35|NM|NEW MEXICO
+35006|CIBOLA|35|NM|NEW MEXICO
+35007|COLFAX|35|NM|NEW MEXICO
+35009|CURRY|35|NM|NEW MEXICO
+35011|DEBACA|35|NM|NEW MEXICO
+35013|DONA ANA|35|NM|NEW MEXICO
+35015|EDDY|35|NM|NEW MEXICO
+35017|GRANT|35|NM|NEW MEXICO
+35019|GUADALUPE|35|NM|NEW MEXICO
+35021|HARDING|35|NM|NEW MEXICO
+35023|HIDALGO|35|NM|NEW MEXICO
+35025|LEA|35|NM|NEW MEXICO
+35027|LINCOLN|35|NM|NEW MEXICO
+35028|LOS ALAMOS|35|NM|NEW MEXICO
+35029|LUNA|35|NM|NEW MEXICO
+35031|MCKINLEY|35|NM|NEW MEXICO
+35033|MORA|35|NM|NEW MEXICO
+35035|OTERO|35|NM|NEW MEXICO
+35037|QUAY|35|NM|NEW MEXICO
+35039|RIO ARRIBA|35|NM|NEW MEXICO
+35041|ROOSEVELT|35|NM|NEW MEXICO
+35043|SANDOVAL|35|NM|NEW MEXICO
+35045|SAN JUAN|35|NM|NEW MEXICO
+35047|SAN MIGUEL|35|NM|NEW MEXICO
+35049|SANTA FE|35|NM|NEW MEXICO
+35051|SIERRA|35|NM|NEW MEXICO
+35053|SOCORRO|35|NM|NEW MEXICO
+35055|TAOS|35|NM|NEW MEXICO
+35057|TORRANCE|35|NM|NEW MEXICO
+35059|UNION|35|NM|NEW MEXICO
+35061|VALENCIA|35|NM|NEW MEXICO
+36001|ALBANY|36|NY|NEW YORK
+36003|ALLEGANY|36|NY|NEW YORK
+36005|BRONX|36|NY|NEW YORK
+36007|BROOME|36|NY|NEW YORK
+36009|CATTARAUGUS|36|NY|NEW YORK
+36011|CAYUGA|36|NY|NEW YORK
+36013|CHAUTAUQUA|36|NY|NEW YORK
+36015|CHEMUNG|36|NY|NEW YORK
+36017|CHENANGO|36|NY|NEW YORK
+36019|CLINTON|36|NY|NEW YORK
+36021|COLUMBIA|36|NY|NEW YORK
+36023|CORTLAND|36|NY|NEW YORK
+36025|DELAWARE|36|NY|NEW YORK
+36027|DUTCHESS|36|NY|NEW YORK
+36029|ERIE|36|NY|NEW YORK
+36031|ESSEX|36|NY|NEW YORK
+36033|FRANKLIN|36|NY|NEW YORK
+36035|FULTON|36|NY|NEW YORK
+36037|GENESEE|36|NY|NEW YORK
+36039|GREENE|36|NY|NEW YORK
+36041|HAMILTON|36|NY|NEW YORK
+36043|HERKIMER|36|NY|NEW YORK
+36045|JEFFERSON|36|NY|NEW YORK
+36047|KINGS|36|NY|NEW YORK
+36049|LEWIS|36|NY|NEW YORK
+36051|LIVINGSTON|36|NY|NEW YORK
+36053|MADISON|36|NY|NEW YORK
+36055|MONROE|36|NY|NEW YORK
+36057|MONTGOMERY|36|NY|NEW YORK
+36059|NASSAU|36|NY|NEW YORK
+36061|NEW YORK|36|NY|NEW YORK
+36063|NIAGARA|36|NY|NEW YORK
+36065|ONEIDA|36|NY|NEW YORK
+36067|ONONDAGA|36|NY|NEW YORK
+36069|ONTARIO|36|NY|NEW YORK
+36071|ORANGE|36|NY|NEW YORK
+36073|ORLEANS|36|NY|NEW YORK
+36075|OSWEGO|36|NY|NEW YORK
+36077|OTSEGO|36|NY|NEW YORK
+36079|PUTNAM|36|NY|NEW YORK
+36081|QUEENS|36|NY|NEW YORK
+36083|RENSSELAER|36|NY|NEW YORK
+36085|RICHMOND|36|NY|NEW YORK
+36087|ROCKLAND|36|NY|NEW YORK
+36089|ST. LAWRENCE|36|NY|NEW YORK
+36091|SARATOGA|36|NY|NEW YORK
+36093|SCHENECTADY|36|NY|NEW YORK
+36095|SCHOHARIE|36|NY|NEW YORK
+36097|SCHUYLER|36|NY|NEW YORK
+36099|SENECA|36|NY|NEW YORK
+36101|STEUBEN|36|NY|NEW YORK
+36103|SUFFOLK|36|NY|NEW YORK
+36105|SULLIVAN|36|NY|NEW YORK
+36107|TIOGA|36|NY|NEW YORK
+36109|TOMPKINS|36|NY|NEW YORK
+36111|ULSTER|36|NY|NEW YORK
+36113|WARREN|36|NY|NEW YORK
+36115|WASHINGTON|36|NY|NEW YORK
+36117|WAYNE|36|NY|NEW YORK
+36119|WESTCHESTER|36|NY|NEW YORK
+36121|WYOMING|36|NY|NEW YORK
+36123|YATES|36|NY|NEW YORK
+37001|ALAMANCE|37|NC|NORTH CAROLINA
+37003|ALEXANDER|37|NC|NORTH CAROLINA
+37005|ALLEGHANY|37|NC|NORTH CAROLINA
+37007|ANSON|37|NC|NORTH CAROLINA
+37009|ASHE|37|NC|NORTH CAROLINA
+37011|AVERY|37|NC|NORTH CAROLINA
+37013|BEAUFORT|37|NC|NORTH CAROLINA
+37015|BERTIE|37|NC|NORTH CAROLINA
+37017|BLADEN|37|NC|NORTH CAROLINA
+37019|BRUNSWICK|37|NC|NORTH CAROLINA
+37021|BUNCOMBE|37|NC|NORTH CAROLINA
+37023|BURKE|37|NC|NORTH CAROLINA
+37025|CABARRUS|37|NC|NORTH CAROLINA
+37027|CALDWELL|37|NC|NORTH CAROLINA
+37029|CAMDEN|37|NC|NORTH CAROLINA
+37031|CARTERET|37|NC|NORTH CAROLINA
+37033|CASWELL|37|NC|NORTH CAROLINA
+37035|CATAWBA|37|NC|NORTH CAROLINA
+37037|CHATHAM|37|NC|NORTH CAROLINA
+37039|CHEROKEE|37|NC|NORTH CAROLINA
+37041|CHOWAN|37|NC|NORTH CAROLINA
+37043|CLAY|37|NC|NORTH CAROLINA
+37045|CLEVELAND|37|NC|NORTH CAROLINA
+37047|COLUMBUS|37|NC|NORTH CAROLINA
+37049|CRAVEN|37|NC|NORTH CAROLINA
+37051|CUMBERLAND|37|NC|NORTH CAROLINA
+37053|CURRITUCK|37|NC|NORTH CAROLINA
+37055|DARE|37|NC|NORTH CAROLINA
+37057|DAVIDSON|37|NC|NORTH CAROLINA
+37059|DAVIE|37|NC|NORTH CAROLINA
+37061|DUPLIN|37|NC|NORTH CAROLINA
+37063|DURHAM|37|NC|NORTH CAROLINA
+37065|EDGECOMBE|37|NC|NORTH CAROLINA
+37067|FORSYTH|37|NC|NORTH CAROLINA
+37069|FRANKLIN|37|NC|NORTH CAROLINA
+37071|GASTON|37|NC|NORTH CAROLINA
+37073|GATES|37|NC|NORTH CAROLINA
+37075|GRAHAM|37|NC|NORTH CAROLINA
+37077|GRANVILLE|37|NC|NORTH CAROLINA
+37079|GREENE|37|NC|NORTH CAROLINA
+37081|GUILFORD|37|NC|NORTH CAROLINA
+37083|HALIFAX|37|NC|NORTH CAROLINA
+37085|HARNETT|37|NC|NORTH CAROLINA
+37087|HAYWOOD|37|NC|NORTH CAROLINA
+37089|HENDERSON|37|NC|NORTH CAROLINA
+37091|HERTFORD|37|NC|NORTH CAROLINA
+37093|HOKE|37|NC|NORTH CAROLINA
+37095|HYDE|37|NC|NORTH CAROLINA
+37097|IREDELL|37|NC|NORTH CAROLINA
+37099|JACKSON|37|NC|NORTH CAROLINA
+37101|JOHNSTON|37|NC|NORTH CAROLINA
+37103|JONES|37|NC|NORTH CAROLINA
+37105|LEE|37|NC|NORTH CAROLINA
+37107|LENOIR|37|NC|NORTH CAROLINA
+37109|LINCOLN|37|NC|NORTH CAROLINA
+37111|MCDOWELL|37|NC|NORTH CAROLINA
+37113|MACON|37|NC|NORTH CAROLINA
+37115|MADISON|37|NC|NORTH CAROLINA
+37117|MARTIN|37|NC|NORTH CAROLINA
+37119|MECKLENBURG|37|NC|NORTH CAROLINA
+37121|MITCHELL|37|NC|NORTH CAROLINA
+37123|MONTGOMERY|37|NC|NORTH CAROLINA
+37125|MOORE|37|NC|NORTH CAROLINA
+37127|NASH|37|NC|NORTH CAROLINA
+37129|NEW HANOVER|37|NC|NORTH CAROLINA
+37131|NORTHAMPTON|37|NC|NORTH CAROLINA
+37133|ONSLOW|37|NC|NORTH CAROLINA
+37135|ORANGE|37|NC|NORTH CAROLINA
+37137|PAMLICO|37|NC|NORTH CAROLINA
+37139|PASQUOTANK|37|NC|NORTH CAROLINA
+37141|PENDER|37|NC|NORTH CAROLINA
+37143|PERQUIMANS|37|NC|NORTH CAROLINA
+37145|PERSON|37|NC|NORTH CAROLINA
+37147|PITT|37|NC|NORTH CAROLINA
+37149|POLK|37|NC|NORTH CAROLINA
+37151|RANDOLPH|37|NC|NORTH CAROLINA
+37153|RICHMOND|37|NC|NORTH CAROLINA
+37155|ROBESON|37|NC|NORTH CAROLINA
+37157|ROCKINGHAM|37|NC|NORTH CAROLINA
+37159|ROWAN|37|NC|NORTH CAROLINA
+37161|RUTHERFORD|37|NC|NORTH CAROLINA
+37163|SAMPSON|37|NC|NORTH CAROLINA
+37165|SCOTLAND|37|NC|NORTH CAROLINA
+37167|STANLY|37|NC|NORTH CAROLINA
+37169|STOKES|37|NC|NORTH CAROLINA
+37171|SURRY|37|NC|NORTH CAROLINA
+37173|SWAIN|37|NC|NORTH CAROLINA
+37175|TRANSYLVANIA|37|NC|NORTH CAROLINA
+37177|TYRRELL|37|NC|NORTH CAROLINA
+37179|UNION|37|NC|NORTH CAROLINA
+37181|VANCE|37|NC|NORTH CAROLINA
+37183|WAKE|37|NC|NORTH CAROLINA
+37185|WARREN|37|NC|NORTH CAROLINA
+37187|WASHINGTON|37|NC|NORTH CAROLINA
+37189|WATAUGA|37|NC|NORTH CAROLINA
+37191|WAYNE|37|NC|NORTH CAROLINA
+37193|WILKES|37|NC|NORTH CAROLINA
+37195|WILSON|37|NC|NORTH CAROLINA
+37197|YADKIN|37|NC|NORTH CAROLINA
+37199|YANCEY|37|NC|NORTH CAROLINA
+38001|ADAMS|38|ND|NORTH DAKOTA
+38003|BARNES|38|ND|NORTH DAKOTA
+38005|BENSON|38|ND|NORTH DAKOTA
+38007|BILLINGS|38|ND|NORTH DAKOTA
+38009|BOTTINEAU|38|ND|NORTH DAKOTA
+38011|BOWMAN|38|ND|NORTH DAKOTA
+38013|BURKE|38|ND|NORTH DAKOTA
+38015|BURLEIGH|38|ND|NORTH DAKOTA
+38017|CASS|38|ND|NORTH DAKOTA
+38019|CAVALIER|38|ND|NORTH DAKOTA
+38021|DICKEY|38|ND|NORTH DAKOTA
+38023|DIVIDE|38|ND|NORTH DAKOTA
+38025|DUNN|38|ND|NORTH DAKOTA
+38027|EDDY|38|ND|NORTH DAKOTA
+38029|EMMONS|38|ND|NORTH DAKOTA
+38031|FOSTER|38|ND|NORTH DAKOTA
+38033|GOLDEN VALLEY|38|ND|NORTH DAKOTA
+38035|GRAND FORKS|38|ND|NORTH DAKOTA
+38037|GRANT|38|ND|NORTH DAKOTA
+38039|GRIGGS|38|ND|NORTH DAKOTA
+38041|HETTINGER|38|ND|NORTH DAKOTA
+38043|KIDDER|38|ND|NORTH DAKOTA
+38045|LAMOURE|38|ND|NORTH DAKOTA
+38047|LOGAN|38|ND|NORTH DAKOTA
+38049|MCHENRY|38|ND|NORTH DAKOTA
+38051|MCINTOSH|38|ND|NORTH DAKOTA
+38053|MCKENZIE|38|ND|NORTH DAKOTA
+38055|MCLEAN|38|ND|NORTH DAKOTA
+38057|MERCER|38|ND|NORTH DAKOTA
+38059|MORTON|38|ND|NORTH DAKOTA
+38061|MOUNTRAIL|38|ND|NORTH DAKOTA
+38063|NELSON|38|ND|NORTH DAKOTA
+38065|OLIVER|38|ND|NORTH DAKOTA
+38067|PEMBINA|38|ND|NORTH DAKOTA
+38069|PIERCE|38|ND|NORTH DAKOTA
+38071|RAMSEY|38|ND|NORTH DAKOTA
+38073|RANSOM|38|ND|NORTH DAKOTA
+38075|RENVILLE|38|ND|NORTH DAKOTA
+38077|RICHLAND|38|ND|NORTH DAKOTA
+38079|ROLETTE|38|ND|NORTH DAKOTA
+38081|SARGENT|38|ND|NORTH DAKOTA
+38083|SHERIDAN|38|ND|NORTH DAKOTA
+38085|SIOUX|38|ND|NORTH DAKOTA
+38087|SLOPE|38|ND|NORTH DAKOTA
+38089|STARK|38|ND|NORTH DAKOTA
+38091|STEELE|38|ND|NORTH DAKOTA
+38093|STUTSMAN|38|ND|NORTH DAKOTA
+38095|TOWNER|38|ND|NORTH DAKOTA
+38097|TRAILL|38|ND|NORTH DAKOTA
+38099|WALSH|38|ND|NORTH DAKOTA
+38101|WARD|38|ND|NORTH DAKOTA
+38103|WELLS|38|ND|NORTH DAKOTA
+38105|WILLIAMS|38|ND|NORTH DAKOTA
+39001|ADAMS|39|OH|OHIO
+39003|ALLEN|39|OH|OHIO
+39005|ASHLAND|39|OH|OHIO
+39007|ASHTABULA|39|OH|OHIO
+39009|ATHENS|39|OH|OHIO
+39011|AUGLAIZE|39|OH|OHIO
+39013|BELMONT|39|OH|OHIO
+39015|BROWN|39|OH|OHIO
+39017|BUTLER|39|OH|OHIO
+39019|CARROLL|39|OH|OHIO
+39021|CHAMPAIGN|39|OH|OHIO
+39023|CLARK|39|OH|OHIO
+39025|CLERMONT|39|OH|OHIO
+39027|CLINTON|39|OH|OHIO
+39029|COLUMBIANA|39|OH|OHIO
+39031|COSHOCTON|39|OH|OHIO
+39033|CRAWFORD|39|OH|OHIO
+39035|CUYAHOGA|39|OH|OHIO
+39037|DARKE|39|OH|OHIO
+39039|DEFIANCE|39|OH|OHIO
+39041|DELAWARE|39|OH|OHIO
+39043|ERIE|39|OH|OHIO
+39045|FAIRFIELD|39|OH|OHIO
+39047|FAYETTE|39|OH|OHIO
+39049|FRANKLIN|39|OH|OHIO
+39051|FULTON|39|OH|OHIO
+39053|GALLIA|39|OH|OHIO
+39055|GEAUGA|39|OH|OHIO
+39057|GREENE|39|OH|OHIO
+39059|GUERNSEY|39|OH|OHIO
+39061|HAMILTON|39|OH|OHIO
+39063|HANCOCK|39|OH|OHIO
+39065|HARDIN|39|OH|OHIO
+39067|HARRISON|39|OH|OHIO
+39069|HENRY|39|OH|OHIO
+39071|HIGHLAND|39|OH|OHIO
+39073|HOCKING|39|OH|OHIO
+39075|HOLMES|39|OH|OHIO
+39077|HURON|39|OH|OHIO
+39079|JACKSON|39|OH|OHIO
+39081|JEFFERSON|39|OH|OHIO
+39083|KNOX|39|OH|OHIO
+39085|LAKE|39|OH|OHIO
+39087|LAWRENCE|39|OH|OHIO
+39089|LICKING|39|OH|OHIO
+39091|LOGAN|39|OH|OHIO
+39093|LORAIN|39|OH|OHIO
+39095|LUCAS|39|OH|OHIO
+39097|MADISON|39|OH|OHIO
+39099|MAHONING|39|OH|OHIO
+39101|MARION|39|OH|OHIO
+39103|MEDINA|39|OH|OHIO
+39105|MEIGS|39|OH|OHIO
+39107|MERCER|39|OH|OHIO
+39109|MIAMI|39|OH|OHIO
+39111|MONROE|39|OH|OHIO
+39113|MONTGOMERY|39|OH|OHIO
+39115|MORGAN|39|OH|OHIO
+39117|MORROW|39|OH|OHIO
+39119|MUSKINGUM|39|OH|OHIO
+39121|NOBLE|39|OH|OHIO
+39123|OTTAWA|39|OH|OHIO
+39125|PAULDING|39|OH|OHIO
+39127|PERRY|39|OH|OHIO
+39129|PICKAWAY|39|OH|OHIO
+39131|PIKE|39|OH|OHIO
+39133|PORTAGE|39|OH|OHIO
+39135|PREBLE|39|OH|OHIO
+39137|PUTNAM|39|OH|OHIO
+39139|RICHLAND|39|OH|OHIO
+39141|ROSS|39|OH|OHIO
+39143|SANDUSKY|39|OH|OHIO
+39145|SCIOTO|39|OH|OHIO
+39147|SENECA|39|OH|OHIO
+39149|SHELBY|39|OH|OHIO
+39151|STARK|39|OH|OHIO
+39153|SUMMIT|39|OH|OHIO
+39155|TRUMBULL|39|OH|OHIO
+39157|TUSCARAWAS|39|OH|OHIO
+39159|UNION|39|OH|OHIO
+39161|VAN WERT|39|OH|OHIO
+39163|VINTON|39|OH|OHIO
+39165|WARREN|39|OH|OHIO
+39167|WASHINGTON|39|OH|OHIO
+39169|WAYNE|39|OH|OHIO
+39171|WILLIAMS|39|OH|OHIO
+39173|WOOD|39|OH|OHIO
+39175|WYANDOT|39|OH|OHIO
+40001|ADAIR|40|OK|OKLAHOMA
+40003|ALFALFA|40|OK|OKLAHOMA
+40005|ATOKA|40|OK|OKLAHOMA
+40007|BEAVER|40|OK|OKLAHOMA
+40009|BECKHAM|40|OK|OKLAHOMA
+40011|BLAINE|40|OK|OKLAHOMA
+40013|BRYAN|40|OK|OKLAHOMA
+40015|CADDO|40|OK|OKLAHOMA
+40017|CANADIAN|40|OK|OKLAHOMA
+40019|CARTER|40|OK|OKLAHOMA
+40021|CHEROKEE|40|OK|OKLAHOMA
+40023|CHOCTAW|40|OK|OKLAHOMA
+40025|CIMARRON|40|OK|OKLAHOMA
+40027|CLEVELAND|40|OK|OKLAHOMA
+40029|COAL|40|OK|OKLAHOMA
+40031|COMANCHE|40|OK|OKLAHOMA
+40033|COTTON|40|OK|OKLAHOMA
+40035|CRAIG|40|OK|OKLAHOMA
+40037|CREEK|40|OK|OKLAHOMA
+40039|CUSTER|40|OK|OKLAHOMA
+40041|DELAWARE|40|OK|OKLAHOMA
+40043|DEWEY|40|OK|OKLAHOMA
+40045|ELLIS|40|OK|OKLAHOMA
+40047|GARFIELD|40|OK|OKLAHOMA
+40049|GARVIN|40|OK|OKLAHOMA
+40051|GRADY|40|OK|OKLAHOMA
+40053|GRANT|40|OK|OKLAHOMA
+40055|GREER|40|OK|OKLAHOMA
+40057|HARMON|40|OK|OKLAHOMA
+40059|HARPER|40|OK|OKLAHOMA
+40061|HASKELL|40|OK|OKLAHOMA
+40063|HUGHES|40|OK|OKLAHOMA
+40065|JACKSON|40|OK|OKLAHOMA
+40067|JEFFERSON|40|OK|OKLAHOMA
+40069|JOHNSTON|40|OK|OKLAHOMA
+40071|KAY|40|OK|OKLAHOMA
+40073|KINGFISHER|40|OK|OKLAHOMA
+40075|KIOWA|40|OK|OKLAHOMA
+40077|LATIMER|40|OK|OKLAHOMA
+40079|LE FLORE|40|OK|OKLAHOMA
+40081|LINCOLN|40|OK|OKLAHOMA
+40083|LOGAN|40|OK|OKLAHOMA
+40085|LOVE|40|OK|OKLAHOMA
+40087|MCCLAIN|40|OK|OKLAHOMA
+40089|MCCURTAIN|40|OK|OKLAHOMA
+40091|MCINTOSH|40|OK|OKLAHOMA
+40093|MAJOR|40|OK|OKLAHOMA
+40095|MARSHALL|40|OK|OKLAHOMA
+40097|MAYES|40|OK|OKLAHOMA
+40099|MURRAY|40|OK|OKLAHOMA
+40101|MUSKOGEE|40|OK|OKLAHOMA
+40103|NOBLE|40|OK|OKLAHOMA
+40105|NOWATA|40|OK|OKLAHOMA
+40107|OKFUSKEE|40|OK|OKLAHOMA
+40109|OKLAHOMA|40|OK|OKLAHOMA
+40111|OKMULGEE|40|OK|OKLAHOMA
+40113|OSAGE|40|OK|OKLAHOMA
+40115|OTTAWA|40|OK|OKLAHOMA
+40117|PAWNEE|40|OK|OKLAHOMA
+40119|PAYNE|40|OK|OKLAHOMA
+40121|PITTSBURG|40|OK|OKLAHOMA
+40123|PONTOTOC|40|OK|OKLAHOMA
+40125|POTTAWATOMIE|40|OK|OKLAHOMA
+40127|PUSHMATAHA|40|OK|OKLAHOMA
+40129|ROGER MILLS|40|OK|OKLAHOMA
+40131|ROGERS|40|OK|OKLAHOMA
+40133|SEMINOLE|40|OK|OKLAHOMA
+40135|SEQUOYAH|40|OK|OKLAHOMA
+40137|STEPHENS|40|OK|OKLAHOMA
+40139|TEXAS|40|OK|OKLAHOMA
+40141|TILLMAN|40|OK|OKLAHOMA
+40143|TULSA|40|OK|OKLAHOMA
+40145|WAGONER|40|OK|OKLAHOMA
+40147|WASHINGTON|40|OK|OKLAHOMA
+40149|WASHITA|40|OK|OKLAHOMA
+40151|WOODS|40|OK|OKLAHOMA
+40153|WOODWARD|40|OK|OKLAHOMA
+41001|BAKER|41|OR|OREGON
+41003|BENTON|41|OR|OREGON
+41005|CLACKAMAS|41|OR|OREGON
+41007|CLATSOP|41|OR|OREGON
+41009|COLUMBIA|41|OR|OREGON
+41011|COOS|41|OR|OREGON
+41013|CROOK|41|OR|OREGON
+41015|CURRY|41|OR|OREGON
+41017|DESCHUTES|41|OR|OREGON
+41019|DOUGLAS|41|OR|OREGON
+41021|GILLIAM|41|OR|OREGON
+41023|GRANT|41|OR|OREGON
+41025|HARNEY|41|OR|OREGON
+41027|HOOD RIVER|41|OR|OREGON
+41029|JACKSON|41|OR|OREGON
+41031|JEFFERSON|41|OR|OREGON
+41033|JOSEPHINE|41|OR|OREGON
+41035|KLAMATH|41|OR|OREGON
+41037|LAKE|41|OR|OREGON
+41039|LANE|41|OR|OREGON
+41041|LINCOLN|41|OR|OREGON
+41043|LINN|41|OR|OREGON
+41045|MALHEUR|41|OR|OREGON
+41047|MARION|41|OR|OREGON
+41049|MORROW|41|OR|OREGON
+41051|MULTNOMAH|41|OR|OREGON
+41053|POLK|41|OR|OREGON
+41055|SHERMAN|41|OR|OREGON
+41057|TILLAMOOK|41|OR|OREGON
+41059|UMATILLA|41|OR|OREGON
+41061|UNION|41|OR|OREGON
+41063|WALLOWA|41|OR|OREGON
+41065|WASCO|41|OR|OREGON
+41067|WASHINGTON|41|OR|OREGON
+41069|WHEELER|41|OR|OREGON
+41071|YAMHILL|41|OR|OREGON
+42001|ADAMS|42|PA|PENNSYLVANIA
+42003|ALLEGHENY|42|PA|PENNSYLVANIA
+42005|ARMSTRONG|42|PA|PENNSYLVANIA
+42007|BEAVER|42|PA|PENNSYLVANIA
+42009|BEDFORD|42|PA|PENNSYLVANIA
+42011|BERKS|42|PA|PENNSYLVANIA
+42013|BLAIR|42|PA|PENNSYLVANIA
+42015|BRADFORD|42|PA|PENNSYLVANIA
+42017|BUCKS|42|PA|PENNSYLVANIA
+42019|BUTLER|42|PA|PENNSYLVANIA
+42021|CAMBRIA|42|PA|PENNSYLVANIA
+42023|CAMERON|42|PA|PENNSYLVANIA
+42025|CARBON|42|PA|PENNSYLVANIA
+42027|CENTRE|42|PA|PENNSYLVANIA
+42029|CHESTER|42|PA|PENNSYLVANIA
+42031|CLARION|42|PA|PENNSYLVANIA
+42033|CLEARFIELD|42|PA|PENNSYLVANIA
+42035|CLINTON|42|PA|PENNSYLVANIA
+42037|COLUMBIA|42|PA|PENNSYLVANIA
+42039|CRAWFORD|42|PA|PENNSYLVANIA
+42041|CUMBERLAND|42|PA|PENNSYLVANIA
+42043|DAUPHIN|42|PA|PENNSYLVANIA
+42045|DELAWARE|42|PA|PENNSYLVANIA
+42047|ELK|42|PA|PENNSYLVANIA
+42049|ERIE|42|PA|PENNSYLVANIA
+42051|FAYETTE|42|PA|PENNSYLVANIA
+42053|FOREST|42|PA|PENNSYLVANIA
+42055|FRANKLIN|42|PA|PENNSYLVANIA
+42057|FULTON|42|PA|PENNSYLVANIA
+42059|GREENE|42|PA|PENNSYLVANIA
+42061|HUNTINGDON|42|PA|PENNSYLVANIA
+42063|INDIANA|42|PA|PENNSYLVANIA
+42065|JEFFERSON|42|PA|PENNSYLVANIA
+42067|JUNIATA|42|PA|PENNSYLVANIA
+42069|LACKAWANNA|42|PA|PENNSYLVANIA
+42071|LANCASTER|42|PA|PENNSYLVANIA
+42073|LAWRENCE|42|PA|PENNSYLVANIA
+42075|LEBANON|42|PA|PENNSYLVANIA
+42077|LEHIGH|42|PA|PENNSYLVANIA
+42079|LUZERNE|42|PA|PENNSYLVANIA
+42081|LYCOMING|42|PA|PENNSYLVANIA
+42083|MCKEAN|42|PA|PENNSYLVANIA
+42085|MERCER|42|PA|PENNSYLVANIA
+42087|MIFFLIN|42|PA|PENNSYLVANIA
+42089|MONROE|42|PA|PENNSYLVANIA
+42091|MONTGOMERY|42|PA|PENNSYLVANIA
+42093|MONTOUR|42|PA|PENNSYLVANIA
+42095|NORTHAMPTON|42|PA|PENNSYLVANIA
+42097|NORTHUMBERLAND|42|PA|PENNSYLVANIA
+42099|PERRY|42|PA|PENNSYLVANIA
+42101|PHILADELPHIA|42|PA|PENNSYLVANIA
+42103|PIKE|42|PA|PENNSYLVANIA
+42105|POTTER|42|PA|PENNSYLVANIA
+42107|SCHUYLKILL|42|PA|PENNSYLVANIA
+42109|SNYDER|42|PA|PENNSYLVANIA
+42111|SOMERSET|42|PA|PENNSYLVANIA
+42113|SULLIVAN|42|PA|PENNSYLVANIA
+42115|SUSQUEHANNA|42|PA|PENNSYLVANIA
+42117|TIOGA|42|PA|PENNSYLVANIA
+42119|UNION|42|PA|PENNSYLVANIA
+42121|VENANGO|42|PA|PENNSYLVANIA
+42123|WARREN|42|PA|PENNSYLVANIA
+42125|WASHINGTON|42|PA|PENNSYLVANIA
+42127|WAYNE|42|PA|PENNSYLVANIA
+42129|WESTMORELAND|42|PA|PENNSYLVANIA
+42131|WYOMING|42|PA|PENNSYLVANIA
+42133|YORK|42|PA|PENNSYLVANIA
+44001|BRISTOL|44|RI|RHODE ISLAND
+44003|KENT|44|RI|RHODE ISLAND
+44005|NEWPORT|44|RI|RHODE ISLAND
+44007|PROVIDENCE|44|RI|RHODE ISLAND
+44009|WASHINGTON|44|RI|RHODE ISLAND
+45001|ABBEVILLE|45|SC|SOUTH CAROLINA
+45003|AIKEN|45|SC|SOUTH CAROLINA
+45005|ALLENDALE|45|SC|SOUTH CAROLINA
+45007|ANDERSON|45|SC|SOUTH CAROLINA
+45009|BAMBERG|45|SC|SOUTH CAROLINA
+45011|BARNWELL|45|SC|SOUTH CAROLINA
+45013|BEAUFORT|45|SC|SOUTH CAROLINA
+45015|BERKELEY|45|SC|SOUTH CAROLINA
+45017|CALHOUN|45|SC|SOUTH CAROLINA
+45019|CHARLESTON|45|SC|SOUTH CAROLINA
+45021|CHEROKEE|45|SC|SOUTH CAROLINA
+45023|CHESTER|45|SC|SOUTH CAROLINA
+45025|CHESTERFIELD|45|SC|SOUTH CAROLINA
+45027|CLARENDON|45|SC|SOUTH CAROLINA
+45029|COLLETON|45|SC|SOUTH CAROLINA
+45031|DARLINGTON|45|SC|SOUTH CAROLINA
+45033|DILLON|45|SC|SOUTH CAROLINA
+45035|DORCHESTER|45|SC|SOUTH CAROLINA
+45037|EDGEFIELD|45|SC|SOUTH CAROLINA
+45039|FAIRFIELD|45|SC|SOUTH CAROLINA
+45041|FLORENCE|45|SC|SOUTH CAROLINA
+45043|GEORGETOWN|45|SC|SOUTH CAROLINA
+45045|GREENVILLE|45|SC|SOUTH CAROLINA
+45047|GREENWOOD|45|SC|SOUTH CAROLINA
+45049|HAMPTON|45|SC|SOUTH CAROLINA
+45051|HORRY|45|SC|SOUTH CAROLINA
+45053|JASPER|45|SC|SOUTH CAROLINA
+45055|KERSHAW|45|SC|SOUTH CAROLINA
+45057|LANCASTER|45|SC|SOUTH CAROLINA
+45059|LAURENS|45|SC|SOUTH CAROLINA
+45061|LEE|45|SC|SOUTH CAROLINA
+45063|LEXINGTON|45|SC|SOUTH CAROLINA
+45065|MCCORMICK|45|SC|SOUTH CAROLINA
+45067|MARION|45|SC|SOUTH CAROLINA
+45069|MARLBORO|45|SC|SOUTH CAROLINA
+45071|NEWBERRY|45|SC|SOUTH CAROLINA
+45073|OCONEE|45|SC|SOUTH CAROLINA
+45075|ORANGEBURG|45|SC|SOUTH CAROLINA
+45077|PICKENS|45|SC|SOUTH CAROLINA
+45079|RICHLAND|45|SC|SOUTH CAROLINA
+45081|SALUDA|45|SC|SOUTH CAROLINA
+45083|SPARTANBURG|45|SC|SOUTH CAROLINA
+45085|SUMTER|45|SC|SOUTH CAROLINA
+45087|UNION|45|SC|SOUTH CAROLINA
+45089|WILLIAMSBURG|45|SC|SOUTH CAROLINA
+45091|YORK|45|SC|SOUTH CAROLINA
+46003|AURORA|46|SD|SOUTH DAKOTA
+46005|BEADLE|46|SD|SOUTH DAKOTA
+46007|BENNETT|46|SD|SOUTH DAKOTA
+46009|BON HOMME|46|SD|SOUTH DAKOTA
+46011|BROOKINGS|46|SD|SOUTH DAKOTA
+46013|BROWN|46|SD|SOUTH DAKOTA
+46015|BRULE|46|SD|SOUTH DAKOTA
+46017|BUFFALO|46|SD|SOUTH DAKOTA
+46019|BUTTE|46|SD|SOUTH DAKOTA
+46021|CAMPBELL|46|SD|SOUTH DAKOTA
+46023|CHARLES MIX|46|SD|SOUTH DAKOTA
+46025|CLARK|46|SD|SOUTH DAKOTA
+46027|CLAY|46|SD|SOUTH DAKOTA
+46029|CODINGTON|46|SD|SOUTH DAKOTA
+46031|CORSON|46|SD|SOUTH DAKOTA
+46033|CUSTER|46|SD|SOUTH DAKOTA
+46035|DAVISON|46|SD|SOUTH DAKOTA
+46037|DAY|46|SD|SOUTH DAKOTA
+46039|DEUEL|46|SD|SOUTH DAKOTA
+46041|DEWEY|46|SD|SOUTH DAKOTA
+46043|DOUGLAS|46|SD|SOUTH DAKOTA
+46045|EDMUNDS|46|SD|SOUTH DAKOTA
+46047|FALL RIVER|46|SD|SOUTH DAKOTA
+46049|FAULK|46|SD|SOUTH DAKOTA
+46051|GRANT|46|SD|SOUTH DAKOTA
+46053|GREGORY|46|SD|SOUTH DAKOTA
+46055|HAAKON|46|SD|SOUTH DAKOTA
+46057|HAMLIN|46|SD|SOUTH DAKOTA
+46059|HAND|46|SD|SOUTH DAKOTA
+46061|HANSON|46|SD|SOUTH DAKOTA
+46063|HARDING|46|SD|SOUTH DAKOTA
+46065|HUGHES|46|SD|SOUTH DAKOTA
+46067|HUTCHINSON|46|SD|SOUTH DAKOTA
+46069|HYDE|46|SD|SOUTH DAKOTA
+46071|JACKSON|46|SD|SOUTH DAKOTA
+46073|JERAULD|46|SD|SOUTH DAKOTA
+46075|JONES|46|SD|SOUTH DAKOTA
+46077|KINGSBURY|46|SD|SOUTH DAKOTA
+46079|LAKE|46|SD|SOUTH DAKOTA
+46081|LAWRENCE|46|SD|SOUTH DAKOTA
+46083|LINCOLN|46|SD|SOUTH DAKOTA
+46085|LYMAN|46|SD|SOUTH DAKOTA
+46087|MCCOOK|46|SD|SOUTH DAKOTA
+46089|MCPHERSON|46|SD|SOUTH DAKOTA
+46091|MARSHALL|46|SD|SOUTH DAKOTA
+46093|MEADE|46|SD|SOUTH DAKOTA
+46095|MELLETTE|46|SD|SOUTH DAKOTA
+46097|MINER|46|SD|SOUTH DAKOTA
+46099|MINNEHAHA|46|SD|SOUTH DAKOTA
+46101|MOODY|46|SD|SOUTH DAKOTA
+46103|PENNINGTON|46|SD|SOUTH DAKOTA
+46105|PERKINS|46|SD|SOUTH DAKOTA
+46107|POTTER|46|SD|SOUTH DAKOTA
+46109|ROBERTS|46|SD|SOUTH DAKOTA
+46111|SANBORN|46|SD|SOUTH DAKOTA
+46113|SHANNON|46|SD|SOUTH DAKOTA
+46115|SPINK|46|SD|SOUTH DAKOTA
+46117|STANLEY|46|SD|SOUTH DAKOTA
+46119|SULLY|46|SD|SOUTH DAKOTA
+46121|TODD|46|SD|SOUTH DAKOTA
+46123|TRIPP|46|SD|SOUTH DAKOTA
+46125|TURNER|46|SD|SOUTH DAKOTA
+46127|UNION|46|SD|SOUTH DAKOTA
+46129|WALWORTH|46|SD|SOUTH DAKOTA
+46135|YANKTON|46|SD|SOUTH DAKOTA
+46137|ZIEBACH|46|SD|SOUTH DAKOTA
+47001|ANDERSON|47|TN|TENNESSEE
+47003|BEDFORD|47|TN|TENNESSEE
+47005|BENTON|47|TN|TENNESSEE
+47007|BLEDSOE|47|TN|TENNESSEE
+47009|BLOUNT|47|TN|TENNESSEE
+47011|BRADLEY|47|TN|TENNESSEE
+47013|CAMPBELL|47|TN|TENNESSEE
+47015|CANNON|47|TN|TENNESSEE
+47017|CARROLL|47|TN|TENNESSEE
+47019|CARTER|47|TN|TENNESSEE
+47021|CHEATHAM|47|TN|TENNESSEE
+47023|CHESTER|47|TN|TENNESSEE
+47025|CLAIBORNE|47|TN|TENNESSEE
+47027|CLAY|47|TN|TENNESSEE
+47029|COCKE|47|TN|TENNESSEE
+47031|COFFEE|47|TN|TENNESSEE
+47033|CROCKETT|47|TN|TENNESSEE
+47035|CUMBERLAND|47|TN|TENNESSEE
+47037|DAVIDSON|47|TN|TENNESSEE
+47039|DECATUR|47|TN|TENNESSEE
+47041|DEKALB|47|TN|TENNESSEE
+47043|DICKSON|47|TN|TENNESSEE
+47045|DYER|47|TN|TENNESSEE
+47047|FAYETTE|47|TN|TENNESSEE
+47049|FENTRESS|47|TN|TENNESSEE
+47051|FRANKLIN|47|TN|TENNESSEE
+47053|GIBSON|47|TN|TENNESSEE
+47055|GILES|47|TN|TENNESSEE
+47057|GRAINGER|47|TN|TENNESSEE
+47059|GREENE|47|TN|TENNESSEE
+47061|GRUNDY|47|TN|TENNESSEE
+47063|HAMBLEN|47|TN|TENNESSEE
+47065|HAMILTON|47|TN|TENNESSEE
+47067|HANCOCK|47|TN|TENNESSEE
+47069|HARDEMAN|47|TN|TENNESSEE
+47071|HARDIN|47|TN|TENNESSEE
+47073|HAWKINS|47|TN|TENNESSEE
+47075|HAYWOOD|47|TN|TENNESSEE
+47077|HENDERSON|47|TN|TENNESSEE
+47079|HENRY|47|TN|TENNESSEE
+47081|HICKMAN|47|TN|TENNESSEE
+47083|HOUSTON|47|TN|TENNESSEE
+47085|HUMPHREYS|47|TN|TENNESSEE
+47087|JACKSON|47|TN|TENNESSEE
+47089|JEFFERSON|47|TN|TENNESSEE
+47091|JOHNSON|47|TN|TENNESSEE
+47093|KNOX|47|TN|TENNESSEE
+47095|LAKE|47|TN|TENNESSEE
+47097|LAUDERDALE|47|TN|TENNESSEE
+47099|LAWRENCE|47|TN|TENNESSEE
+47101|LEWIS|47|TN|TENNESSEE
+47103|LINCOLN|47|TN|TENNESSEE
+47105|LOUDON|47|TN|TENNESSEE
+47107|MCMINN|47|TN|TENNESSEE
+47109|MCNAIRY|47|TN|TENNESSEE
+47111|MACON|47|TN|TENNESSEE
+47113|MADISON|47|TN|TENNESSEE
+47115|MARION|47|TN|TENNESSEE
+47117|MARSHALL|47|TN|TENNESSEE
+47119|MAURY|47|TN|TENNESSEE
+47121|MEIGS|47|TN|TENNESSEE
+47123|MONROE|47|TN|TENNESSEE
+47125|MONTGOMERY|47|TN|TENNESSEE
+47127|MOORE|47|TN|TENNESSEE
+47129|MORGAN|47|TN|TENNESSEE
+47131|OBION|47|TN|TENNESSEE
+47133|OVERTON|47|TN|TENNESSEE
+47135|PERRY|47|TN|TENNESSEE
+47137|PICKETT|47|TN|TENNESSEE
+47139|POLK|47|TN|TENNESSEE
+47141|PUTNAM|47|TN|TENNESSEE
+47143|RHEA|47|TN|TENNESSEE
+47145|ROANE|47|TN|TENNESSEE
+47147|ROBERTSON|47|TN|TENNESSEE
+47149|RUTHERFORD|47|TN|TENNESSEE
+47151|SCOTT|47|TN|TENNESSEE
+47153|SEQUATCHIE|47|TN|TENNESSEE
+47155|SEVIER|47|TN|TENNESSEE
+47157|SHELBY|47|TN|TENNESSEE
+47159|SMITH|47|TN|TENNESSEE
+47161|STEWART|47|TN|TENNESSEE
+47163|SULLIVAN|47|TN|TENNESSEE
+47165|SUMNER|47|TN|TENNESSEE
+47167|TIPTON|47|TN|TENNESSEE
+47169|TROUSDALE|47|TN|TENNESSEE
+47171|UNICOI|47|TN|TENNESSEE
+47173|UNION|47|TN|TENNESSEE
+47175|VAN BUREN|47|TN|TENNESSEE
+47177|WARREN|47|TN|TENNESSEE
+47179|WASHINGTON|47|TN|TENNESSEE
+47181|WAYNE|47|TN|TENNESSEE
+47183|WEAKLEY|47|TN|TENNESSEE
+47185|WHITE|47|TN|TENNESSEE
+47187|WILLIAMSON|47|TN|TENNESSEE
+47189|WILSON|47|TN|TENNESSEE
+48001|ANDERSON|48|TX|TEXAS
+48003|ANDREWS|48|TX|TEXAS
+48005|ANGELINA|48|TX|TEXAS
+48007|ARANSAS|48|TX|TEXAS
+48009|ARCHER|48|TX|TEXAS
+48011|ARMSTRONG|48|TX|TEXAS
+48013|ATASCOSA|48|TX|TEXAS
+48015|AUSTIN|48|TX|TEXAS
+48017|BAILEY|48|TX|TEXAS
+48019|BANDERA|48|TX|TEXAS
+48021|BASTROP|48|TX|TEXAS
+48023|BAYLOR|48|TX|TEXAS
+48025|BEE|48|TX|TEXAS
+48027|BELL|48|TX|TEXAS
+48029|BEXAR|48|TX|TEXAS
+48031|BLANCO|48|TX|TEXAS
+48033|BORDEN|48|TX|TEXAS
+48035|BOSQUE|48|TX|TEXAS
+48037|BOWIE|48|TX|TEXAS
+48039|BRAZORIA|48|TX|TEXAS
+48041|BRAZOS|48|TX|TEXAS
+48043|BREWSTER|48|TX|TEXAS
+48045|BRISCOE|48|TX|TEXAS
+48047|BROOKS|48|TX|TEXAS
+48049|BROWN|48|TX|TEXAS
+48051|BURLESON|48|TX|TEXAS
+48053|BURNET|48|TX|TEXAS
+48055|CALDWELL|48|TX|TEXAS
+48057|CALHOUN|48|TX|TEXAS
+48059|CALLAHAN|48|TX|TEXAS
+48061|CAMERON|48|TX|TEXAS
+48063|CAMP|48|TX|TEXAS
+48065|CARSON|48|TX|TEXAS
+48067|CASS|48|TX|TEXAS
+48069|CASTRO|48|TX|TEXAS
+48071|CHAMBERS|48|TX|TEXAS
+48073|CHEROKEE|48|TX|TEXAS
+48075|CHILDRESS|48|TX|TEXAS
+48077|CLAY|48|TX|TEXAS
+48079|COCHRAN|48|TX|TEXAS
+48081|COKE|48|TX|TEXAS
+48083|COLEMAN|48|TX|TEXAS
+48085|COLLIN|48|TX|TEXAS
+48087|COLLINGSWORTH|48|TX|TEXAS
+48089|COLORADO|48|TX|TEXAS
+48091|COMAL|48|TX|TEXAS
+48093|COMANCHE|48|TX|TEXAS
+48095|CONCHO|48|TX|TEXAS
+48097|COOKE|48|TX|TEXAS
+48099|CORYELL|48|TX|TEXAS
+48101|COTTLE|48|TX|TEXAS
+48103|CRANE|48|TX|TEXAS
+48105|CROCKETT|48|TX|TEXAS
+48107|CROSBY|48|TX|TEXAS
+48109|CULBERSON|48|TX|TEXAS
+48111|DALLAM|48|TX|TEXAS
+48113|DALLAS|48|TX|TEXAS
+48115|DAWSON|48|TX|TEXAS
+48117|DEAF SMITH|48|TX|TEXAS
+48119|DELTA|48|TX|TEXAS
+48121|DENTON|48|TX|TEXAS
+48123|DEWITT|48|TX|TEXAS
+48125|DICKENS|48|TX|TEXAS
+48127|DIMMIT|48|TX|TEXAS
+48129|DONLEY|48|TX|TEXAS
+48131|DUVAL|48|TX|TEXAS
+48133|EASTLAND|48|TX|TEXAS
+48135|ECTOR|48|TX|TEXAS
+48137|EDWARDS|48|TX|TEXAS
+48139|ELLIS|48|TX|TEXAS
+48141|EL PASO|48|TX|TEXAS
+48143|ERATH|48|TX|TEXAS
+48145|FALLS|48|TX|TEXAS
+48147|FANNIN|48|TX|TEXAS
+48149|FAYETTE|48|TX|TEXAS
+48151|FISHER|48|TX|TEXAS
+48153|FLOYD|48|TX|TEXAS
+48155|FOARD|48|TX|TEXAS
+48157|FORT BEND|48|TX|TEXAS
+48159|FRANKLIN|48|TX|TEXAS
+48161|FREESTONE|48|TX|TEXAS
+48163|FRIO|48|TX|TEXAS
+48165|GAINES|48|TX|TEXAS
+48167|GALVESTON|48|TX|TEXAS
+48169|GARZA|48|TX|TEXAS
+48171|GILLESPIE|48|TX|TEXAS
+48173|GLASSCOCK|48|TX|TEXAS
+48175|GOLIAD|48|TX|TEXAS
+48177|GONZALES|48|TX|TEXAS
+48179|GRAY|48|TX|TEXAS
+48181|GRAYSON|48|TX|TEXAS
+48183|GREGG|48|TX|TEXAS
+48185|GRIMES|48|TX|TEXAS
+48187|GUADALUPE|48|TX|TEXAS
+48189|HALE|48|TX|TEXAS
+48191|HALL|48|TX|TEXAS
+48193|HAMILTON|48|TX|TEXAS
+48195|HANSFORD|48|TX|TEXAS
+48197|HARDEMAN|48|TX|TEXAS
+48199|HARDIN|48|TX|TEXAS
+48201|HARRIS|48|TX|TEXAS
+48203|HARRISON|48|TX|TEXAS
+48205|HARTLEY|48|TX|TEXAS
+48207|HASKELL|48|TX|TEXAS
+48209|HAYS|48|TX|TEXAS
+48211|HEMPHILL|48|TX|TEXAS
+48213|HENDERSON|48|TX|TEXAS
+48215|HIDALGO|48|TX|TEXAS
+48217|HILL|48|TX|TEXAS
+48219|HOCKLEY|48|TX|TEXAS
+48221|HOOD|48|TX|TEXAS
+48223|HOPKINS|48|TX|TEXAS
+48225|HOUSTON|48|TX|TEXAS
+48227|HOWARD|48|TX|TEXAS
+48229|HUDSPETH|48|TX|TEXAS
+48231|HUNT|48|TX|TEXAS
+48233|HUTCHINSON|48|TX|TEXAS
+48235|IRION|48|TX|TEXAS
+48237|JACK|48|TX|TEXAS
+48239|JACKSON|48|TX|TEXAS
+48241|JASPER|48|TX|TEXAS
+48243|JEFF DAVIS|48|TX|TEXAS
+48245|JEFFERSON|48|TX|TEXAS
+48247|JIM HOGG|48|TX|TEXAS
+48249|JIM WELLS|48|TX|TEXAS
+48251|JOHNSON|48|TX|TEXAS
+48253|JONES|48|TX|TEXAS
+48255|KARNES|48|TX|TEXAS
+48257|KAUFMAN|48|TX|TEXAS
+48259|KENDALL|48|TX|TEXAS
+48261|KENEDY|48|TX|TEXAS
+48263|KENT|48|TX|TEXAS
+48265|KERR|48|TX|TEXAS
+48267|KIMBLE|48|TX|TEXAS
+48269|KING|48|TX|TEXAS
+48271|KINNEY|48|TX|TEXAS
+48273|KLEBERG|48|TX|TEXAS
+48275|KNOX|48|TX|TEXAS
+48277|LAMAR|48|TX|TEXAS
+48279|LAMB|48|TX|TEXAS
+48281|LAMPASAS|48|TX|TEXAS
+48283|LA SALLE|48|TX|TEXAS
+48285|LAVACA|48|TX|TEXAS
+48287|LEE|48|TX|TEXAS
+48289|LEON|48|TX|TEXAS
+48291|LIBERTY|48|TX|TEXAS
+48293|LIMESTONE|48|TX|TEXAS
+48295|LIPSCOMB|48|TX|TEXAS
+48297|LIVE OAK|48|TX|TEXAS
+48299|LLANO|48|TX|TEXAS
+48301|LOVING|48|TX|TEXAS
+48303|LUBBOCK|48|TX|TEXAS
+48305|LYNN|48|TX|TEXAS
+48307|MCCULLOCH|48|TX|TEXAS
+48309|MCLENNAN|48|TX|TEXAS
+48311|MCMULLEN|48|TX|TEXAS
+48313|MADISON|48|TX|TEXAS
+48315|MARION|48|TX|TEXAS
+48317|MARTIN|48|TX|TEXAS
+48319|MASON|48|TX|TEXAS
+48321|MATAGORDA|48|TX|TEXAS
+48323|MAVERICK|48|TX|TEXAS
+48325|MEDINA|48|TX|TEXAS
+48327|MENARD|48|TX|TEXAS
+48329|MIDLAND|48|TX|TEXAS
+48331|MILAM|48|TX|TEXAS
+48333|MILLS|48|TX|TEXAS
+48335|MITCHELL|48|TX|TEXAS
+48337|MONTAGUE|48|TX|TEXAS
+48339|MONTGOMERY|48|TX|TEXAS
+48341|MOORE|48|TX|TEXAS
+48343|MORRIS|48|TX|TEXAS
+48345|MOTLEY|48|TX|TEXAS
+48347|NACOGDOCHES|48|TX|TEXAS
+48349|NAVARRO|48|TX|TEXAS
+48351|NEWTON|48|TX|TEXAS
+48353|NOLAN|48|TX|TEXAS
+48355|NUECES|48|TX|TEXAS
+48357|OCHILTREE|48|TX|TEXAS
+48359|OLDHAM|48|TX|TEXAS
+48361|ORANGE|48|TX|TEXAS
+48363|PALO PINTO|48|TX|TEXAS
+48365|PANOLA|48|TX|TEXAS
+48367|PARKER|48|TX|TEXAS
+48369|PARMER|48|TX|TEXAS
+48371|PECOS|48|TX|TEXAS
+48373|POLK|48|TX|TEXAS
+48375|POTTER|48|TX|TEXAS
+48377|PRESIDIO|48|TX|TEXAS
+48379|RAINS|48|TX|TEXAS
+48381|RANDALL|48|TX|TEXAS
+48383|REAGAN|48|TX|TEXAS
+48385|REAL|48|TX|TEXAS
+48387|RED RIVER|48|TX|TEXAS
+48389|REEVES|48|TX|TEXAS
+48391|REFUGIO|48|TX|TEXAS
+48393|ROBERTS|48|TX|TEXAS
+48395|ROBERTSON|48|TX|TEXAS
+48397|ROCKWALL|48|TX|TEXAS
+48399|RUNNELS|48|TX|TEXAS
+48401|RUSK|48|TX|TEXAS
+48403|SABINE|48|TX|TEXAS
+48405|SAN AUGUSTINE|48|TX|TEXAS
+48407|SAN JACINTO|48|TX|TEXAS
+48409|SAN PATRICIO|48|TX|TEXAS
+48411|SAN SABA|48|TX|TEXAS
+48413|SCHLEICHER|48|TX|TEXAS
+48415|SCURRY|48|TX|TEXAS
+48417|SHACKELFORD|48|TX|TEXAS
+48419|SHELBY|48|TX|TEXAS
+48421|SHERMAN|48|TX|TEXAS
+48423|SMITH|48|TX|TEXAS
+48425|SOMERVELL|48|TX|TEXAS
+48427|STARR|48|TX|TEXAS
+48429|STEPHENS|48|TX|TEXAS
+48431|STERLING|48|TX|TEXAS
+48433|STONEWALL|48|TX|TEXAS
+48435|SUTTON|48|TX|TEXAS
+48437|SWISHER|48|TX|TEXAS
+48439|TARRANT|48|TX|TEXAS
+48441|TAYLOR|48|TX|TEXAS
+48443|TERRELL|48|TX|TEXAS
+48445|TERRY|48|TX|TEXAS
+48447|THROCKMORTON|48|TX|TEXAS
+48449|TITUS|48|TX|TEXAS
+48451|TOM GREEN|48|TX|TEXAS
+48453|TRAVIS|48|TX|TEXAS
+48455|TRINITY|48|TX|TEXAS
+48457|TYLER|48|TX|TEXAS
+48459|UPSHUR|48|TX|TEXAS
+48461|UPTON|48|TX|TEXAS
+48463|UVALDE|48|TX|TEXAS
+48465|VAL VERDE|48|TX|TEXAS
+48467|VAN ZANDT|48|TX|TEXAS
+48469|VICTORIA|48|TX|TEXAS
+48471|WALKER|48|TX|TEXAS
+48473|WALLER|48|TX|TEXAS
+48475|WARD|48|TX|TEXAS
+48477|WASHINGTON|48|TX|TEXAS
+48479|WEBB|48|TX|TEXAS
+48481|WHARTON|48|TX|TEXAS
+48483|WHEELER|48|TX|TEXAS
+48485|WICHITA|48|TX|TEXAS
+48487|WILBARGER|48|TX|TEXAS
+48489|WILLACY|48|TX|TEXAS
+48491|WILLIAMSON|48|TX|TEXAS
+48493|WILSON|48|TX|TEXAS
+48495|WINKLER|48|TX|TEXAS
+48497|WISE|48|TX|TEXAS
+48499|WOOD|48|TX|TEXAS
+48501|YOAKUM|48|TX|TEXAS
+48503|YOUNG|48|TX|TEXAS
+48505|ZAPATA|48|TX|TEXAS
+48507|ZAVALA|48|TX|TEXAS
+49001|BEAVER|49|UT|UTAH
+49003|BOX ELDER|49|UT|UTAH
+49005|CACHE|49|UT|UTAH
+49007|CARBON|49|UT|UTAH
+49009|DAGGETT|49|UT|UTAH
+49011|DAVIS|49|UT|UTAH
+49013|DUCHESNE|49|UT|UTAH
+49015|EMERY|49|UT|UTAH
+49017|GARFIELD|49|UT|UTAH
+49019|GRAND|49|UT|UTAH
+49021|IRON|49|UT|UTAH
+49023|JUAB|49|UT|UTAH
+49025|KANE|49|UT|UTAH
+49027|MILLARD|49|UT|UTAH
+49029|MORGAN|49|UT|UTAH
+49031|PIUTE|49|UT|UTAH
+49033|RICH|49|UT|UTAH
+49035|SALT LAKE|49|UT|UTAH
+49037|SAN JUAN|49|UT|UTAH
+49039|SANPETE|49|UT|UTAH
+49041|SEVIER|49|UT|UTAH
+49043|SUMMIT|49|UT|UTAH
+49045|TOOELE|49|UT|UTAH
+49047|UINTAH|49|UT|UTAH
+49049|UTAH|49|UT|UTAH
+49051|WASATCH|49|UT|UTAH
+49053|WASHINGTON|49|UT|UTAH
+49055|WAYNE|49|UT|UTAH
+49057|WEBER|49|UT|UTAH
+50001|ADDISON|50|VT|VERMONT
+50003|BENNINGTON|50|VT|VERMONT
+50005|CALEDONIA|50|VT|VERMONT
+50007|CHITTENDEN|50|VT|VERMONT
+50009|ESSEX|50|VT|VERMONT
+50011|FRANKLIN|50|VT|VERMONT
+50013|GRAND ISLE|50|VT|VERMONT
+50015|LAMOILLE|50|VT|VERMONT
+50017|ORANGE|50|VT|VERMONT
+50019|ORLEANS|50|VT|VERMONT
+50021|RUTLAND|50|VT|VERMONT
+50023|WASHINGTON|50|VT|VERMONT
+50025|WINDHAM|50|VT|VERMONT
+50027|WINDSOR|50|VT|VERMONT
+51001|ACCOMACK|51|VA|VIRGINIA
+51003|ALBEMARLE|51|VA|VIRGINIA
+51005|ALLEGHANY|51|VA|VIRGINIA
+51007|AMELIA|51|VA|VIRGINIA
+51009|AMHERST|51|VA|VIRGINIA
+51011|APPOMATTOX|51|VA|VIRGINIA
+51013|ARLINGTON|51|VA|VIRGINIA
+51015|AUGUSTA|51|VA|VIRGINIA
+51017|BATH|51|VA|VIRGINIA
+51019|BEDFORD|51|VA|VIRGINIA
+51021|BLAND|51|VA|VIRGINIA
+51023|BOTETOURT|51|VA|VIRGINIA
+51025|BRUNSWICK|51|VA|VIRGINIA
+51027|BUCHANAN|51|VA|VIRGINIA
+51029|BUCKINGHAM|51|VA|VIRGINIA
+51031|CAMPBELL|51|VA|VIRGINIA
+51033|CAROLINE|51|VA|VIRGINIA
+51035|CARROLL|51|VA|VIRGINIA
+51036|CHARLES CITY|51|VA|VIRGINIA
+51037|CHARLOTTE|51|VA|VIRGINIA
+51041|CHESTERFIELD|51|VA|VIRGINIA
+51043|CLARKE|51|VA|VIRGINIA
+51045|CRAIG|51|VA|VIRGINIA
+51047|CULPEPER|51|VA|VIRGINIA
+51049|CUMBERLAND|51|VA|VIRGINIA
+51051|DICKENSON|51|VA|VIRGINIA
+51053|DINWIDDIE|51|VA|VIRGINIA
+51057|ESSEX|51|VA|VIRGINIA
+51059|FAIRFAX|51|VA|VIRGINIA
+51061|FAUQUIER|51|VA|VIRGINIA
+51063|FLOYD|51|VA|VIRGINIA
+51065|FLUVANNA|51|VA|VIRGINIA
+51067|FRANKLIN|51|VA|VIRGINIA
+51069|FREDERICK|51|VA|VIRGINIA
+51071|GILES|51|VA|VIRGINIA
+51073|GLOUCESTER|51|VA|VIRGINIA
+51075|GOOCHLAND|51|VA|VIRGINIA
+51077|GRAYSON|51|VA|VIRGINIA
+51079|GREENE|51|VA|VIRGINIA
+51081|GREENSVILLE|51|VA|VIRGINIA
+51083|HALIFAX|51|VA|VIRGINIA
+51085|HANOVER|51|VA|VIRGINIA
+51087|HENRICO|51|VA|VIRGINIA
+51089|HENRY|51|VA|VIRGINIA
+51091|HIGHLAND|51|VA|VIRGINIA
+51093|ISLE OF WIGHT|51|VA|VIRGINIA
+51095|JAMES CITY|51|VA|VIRGINIA
+51097|KING AND QUEEN|51|VA|VIRGINIA
+51099|KING GEORGE|51|VA|VIRGINIA
+51101|KING WILLIAM|51|VA|VIRGINIA
+51103|LANCASTER|51|VA|VIRGINIA
+51105|LEE|51|VA|VIRGINIA
+51107|LOUDOUN|51|VA|VIRGINIA
+51109|LOUISA|51|VA|VIRGINIA
+51111|LUNENBURG|51|VA|VIRGINIA
+51113|MADISON|51|VA|VIRGINIA
+51115|MATHEWS|51|VA|VIRGINIA
+51117|MECKLENBURG|51|VA|VIRGINIA
+51119|MIDDLESEX|51|VA|VIRGINIA
+51121|MONTGOMERY|51|VA|VIRGINIA
+51125|NELSON|51|VA|VIRGINIA
+51127|NEW KENT|51|VA|VIRGINIA
+51131|NORTHAMPTON|51|VA|VIRGINIA
+51133|NORTHUMBERLAND|51|VA|VIRGINIA
+51135|NOTTOWAY|51|VA|VIRGINIA
+51137|ORANGE|51|VA|VIRGINIA
+51139|PAGE|51|VA|VIRGINIA
+51141|PATRICK|51|VA|VIRGINIA
+51143|PITTSYLVANIA|51|VA|VIRGINIA
+51145|POWHATAN|51|VA|VIRGINIA
+51147|PRINCE EDWARD|51|VA|VIRGINIA
+51149|PRINCE GEORGE|51|VA|VIRGINIA
+51153|PRINCE WILLIAM|51|VA|VIRGINIA
+51155|PULASKI|51|VA|VIRGINIA
+51157|RAPPAHANNOCK|51|VA|VIRGINIA
+51159|RICHMOND|51|VA|VIRGINIA
+51161|ROANOKE|51|VA|VIRGINIA
+51163|ROCKBRIDGE|51|VA|VIRGINIA
+51165|ROCKINGHAM|51|VA|VIRGINIA
+51167|RUSSELL|51|VA|VIRGINIA
+51169|SCOTT|51|VA|VIRGINIA
+51171|SHENANDOAH|51|VA|VIRGINIA
+51173|SMYTH|51|VA|VIRGINIA
+51175|SOUTHAMPTON|51|VA|VIRGINIA
+51177|SPOTSYLVANIA|51|VA|VIRGINIA
+51179|STAFFORD|51|VA|VIRGINIA
+51181|SURRY|51|VA|VIRGINIA
+51183|SUSSEX|51|VA|VIRGINIA
+51185|TAZEWELL|51|VA|VIRGINIA
+51187|WARREN|51|VA|VIRGINIA
+51191|WASHINGTON|51|VA|VIRGINIA
+51193|WESTMORELAND|51|VA|VIRGINIA
+51195|WISE|51|VA|VIRGINIA
+51197|WYTHE|51|VA|VIRGINIA
+51199|YORK|51|VA|VIRGINIA
+51510|ALEXANDRIA (CITY)|51|VA|VIRGINIA
+51515|BEDFORD (CITY)|51|VA|VIRGINIA
+51520|BRISTOL (CITY)|51|VA|VIRGINIA
+51530|BUENA VISTA (CITY)|51|VA|VIRGINIA
+51540|CHARLOTTESVILLE (CITY)|51|VA|VIRGINIA
+51550|CHESAPEAKE (CITY)|51|VA|VIRGINIA
+51560|CLIFTON FORGE (CITY)|51|VA|VIRGINIA
+51570|COLONIAL HEIGHTS (CITY)|51|VA|VIRGINIA
+51580|COVINGTON (CITY)|51|VA|VIRGINIA
+51590|DANVILLE (CITY)|51|VA|VIRGINIA
+51595|EMPORIA (CITY)|51|VA|VIRGINIA
+51600|FAIRFAX (CITY)|51|VA|VIRGINIA
+51610|FALLS CHURCH (CITY)|51|VA|VIRGINIA
+51620|FRANKLIN (CITY)|51|VA|VIRGINIA
+51630|FREDERICKSBURG (CITY)|51|VA|VIRGINIA
+51640|GALAX (CITY)|51|VA|VIRGINIA
+51650|HAMPTON (CITY)|51|VA|VIRGINIA
+51660|HARRISONBURG (CITY)|51|VA|VIRGINIA
+51670|HOPEWELL (CITY)|51|VA|VIRGINIA
+51678|LEXINGTON (CITY)|51|VA|VIRGINIA
+51680|LYNCHBURG (CITY)|51|VA|VIRGINIA
+51683|MANASSAS (CITY)|51|VA|VIRGINIA
+51685|MANASSAS PARK (CITY)|51|VA|VIRGINIA
+51690|MARTINSVILLE (CITY)|51|VA|VIRGINIA
+51700|NEWPORT NEWS (CITY)|51|VA|VIRGINIA
+51710|NORFOLK (CITY)|51|VA|VIRGINIA
+51720|NORTON (CITY)|51|VA|VIRGINIA
+51730|PETERSBURG (CITY)|51|VA|VIRGINIA
+51735|POQUOSON (CITY)|51|VA|VIRGINIA
+51740|PORTSMOUTH (CITY)|51|VA|VIRGINIA
+51750|RADFORD (CITY)|51|VA|VIRGINIA
+51760|RICHMOND (CITY)|51|VA|VIRGINIA
+51770|ROANOKE (CITY)|51|VA|VIRGINIA
+51775|SALEM (CITY)|51|VA|VIRGINIA
+51780|SOUTH BOSTON (CITY)|51|VA|VIRGINIA
+51790|STAUNTON (CITY)|51|VA|VIRGINIA
+51800|SUFFOLK (CITY)|51|VA|VIRGINIA
+51810|VIRGINIA BEACH (CITY)|51|VA|VIRGINIA
+51820|WAYNESBORO (CITY)|51|VA|VIRGINIA
+51830|WILLIAMSBURG (CITY)|51|VA|VIRGINIA
+51840|WINCHESTER (CITY)|51|VA|VIRGINIA
+53001|ADAMS|53|WA|WASHINGTON
+53003|ASOTIN|53|WA|WASHINGTON
+53005|BENTON|53|WA|WASHINGTON
+53007|CHELAN|53|WA|WASHINGTON
+53009|CLALLAM|53|WA|WASHINGTON
+53011|CLARK|53|WA|WASHINGTON
+53013|COLUMBIA|53|WA|WASHINGTON
+53015|COWLITZ|53|WA|WASHINGTON
+53017|DOUGLAS|53|WA|WASHINGTON
+53019|FERRY|53|WA|WASHINGTON
+53021|FRANKLIN|53|WA|WASHINGTON
+53023|GARFIELD|53|WA|WASHINGTON
+53025|GRANT|53|WA|WASHINGTON
+53027|GRAYS HARBOR|53|WA|WASHINGTON
+53029|ISLAND|53|WA|WASHINGTON
+53031|JEFFERSON|53|WA|WASHINGTON
+53033|KING|53|WA|WASHINGTON
+53035|KITSAP|53|WA|WASHINGTON
+53037|KITTITAS|53|WA|WASHINGTON
+53039|KLICKITAT|53|WA|WASHINGTON
+53041|LEWIS|53|WA|WASHINGTON
+53043|LINCOLN|53|WA|WASHINGTON
+53045|MASON|53|WA|WASHINGTON
+53047|OKANOGAN|53|WA|WASHINGTON
+53049|PACIFIC|53|WA|WASHINGTON
+53051|PEND OREILLE|53|WA|WASHINGTON
+53053|PIERCE|53|WA|WASHINGTON
+53055|SAN JUAN|53|WA|WASHINGTON
+53057|SKAGIT|53|WA|WASHINGTON
+53059|SKAMANIA|53|WA|WASHINGTON
+53061|SNOHOMISH|53|WA|WASHINGTON
+53063|SPOKANE|53|WA|WASHINGTON
+53065|STEVENS|53|WA|WASHINGTON
+53067|THURSTON|53|WA|WASHINGTON
+53069|WAHKIAKUM|53|WA|WASHINGTON
+53071|WALLA WALLA|53|WA|WASHINGTON
+53073|WHATCOM|53|WA|WASHINGTON
+53075|WHITMAN|53|WA|WASHINGTON
+53077|YAKIMA|53|WA|WASHINGTON
+54001|BARBOUR|54|WV|WEST VIRGINIA
+54003|BERKELEY|54|WV|WEST VIRGINIA
+54005|BOONE|54|WV|WEST VIRGINIA
+54007|BRAXTON|54|WV|WEST VIRGINIA
+54009|BROOKE|54|WV|WEST VIRGINIA
+54011|CABELL|54|WV|WEST VIRGINIA
+54013|CALHOUN|54|WV|WEST VIRGINIA
+54015|CLAY|54|WV|WEST VIRGINIA
+54017|DODDRIDGE|54|WV|WEST VIRGINIA
+54019|FAYETTE|54|WV|WEST VIRGINIA
+54021|GILMER|54|WV|WEST VIRGINIA
+54023|GRANT|54|WV|WEST VIRGINIA
+54025|GREENBRIER|54|WV|WEST VIRGINIA
+54027|HAMPSHIRE|54|WV|WEST VIRGINIA
+54029|HANCOCK|54|WV|WEST VIRGINIA
+54031|HARDY|54|WV|WEST VIRGINIA
+54033|HARRISON|54|WV|WEST VIRGINIA
+54035|JACKSON|54|WV|WEST VIRGINIA
+54037|JEFFERSON|54|WV|WEST VIRGINIA
+54039|KANAWHA|54|WV|WEST VIRGINIA
+54041|LEWIS|54|WV|WEST VIRGINIA
+54043|LINCOLN|54|WV|WEST VIRGINIA
+54045|LOGAN|54|WV|WEST VIRGINIA
+54047|MCDOWELL|54|WV|WEST VIRGINIA
+54049|MARION|54|WV|WEST VIRGINIA
+54051|MARSHALL|54|WV|WEST VIRGINIA
+54053|MASON|54|WV|WEST VIRGINIA
+54055|MERCER|54|WV|WEST VIRGINIA
+54057|MINERAL|54|WV|WEST VIRGINIA
+54059|MINGO|54|WV|WEST VIRGINIA
+54061|MONONGALIA|54|WV|WEST VIRGINIA
+54063|MONROE|54|WV|WEST VIRGINIA
+54065|MORGAN|54|WV|WEST VIRGINIA
+54067|NICHOLAS|54|WV|WEST VIRGINIA
+54069|OHIO|54|WV|WEST VIRGINIA
+54071|PENDLETON|54|WV|WEST VIRGINIA
+54073|PLEASANTS|54|WV|WEST VIRGINIA
+54075|POCAHONTAS|54|WV|WEST VIRGINIA
+54077|PRESTON|54|WV|WEST VIRGINIA
+54079|PUTNAM|54|WV|WEST VIRGINIA
+54081|RALEIGH|54|WV|WEST VIRGINIA
+54083|RANDOLPH|54|WV|WEST VIRGINIA
+54085|RITCHIE|54|WV|WEST VIRGINIA
+54087|ROANE|54|WV|WEST VIRGINIA
+54089|SUMMERS|54|WV|WEST VIRGINIA
+54091|TAYLOR|54|WV|WEST VIRGINIA
+54093|TUCKER|54|WV|WEST VIRGINIA
+54095|TYLER|54|WV|WEST VIRGINIA
+54097|UPSHUR|54|WV|WEST VIRGINIA
+54099|WAYNE|54|WV|WEST VIRGINIA
+54101|WEBSTER|54|WV|WEST VIRGINIA
+54103|WETZEL|54|WV|WEST VIRGINIA
+54105|WIRT|54|WV|WEST VIRGINIA
+54107|WOOD|54|WV|WEST VIRGINIA
+54109|WYOMING|54|WV|WEST VIRGINIA
+55001|ADAMS|55|WI|WISCONSIN
+55003|ASHLAND|55|WI|WISCONSIN
+55005|BARRON|55|WI|WISCONSIN
+55007|BAYFIELD|55|WI|WISCONSIN
+55009|BROWN|55|WI|WISCONSIN
+55011|BUFFALO|55|WI|WISCONSIN
+55013|BURNETT|55|WI|WISCONSIN
+55015|CALUMET|55|WI|WISCONSIN
+55017|CHIPPEWA|55|WI|WISCONSIN
+55019|CLARK|55|WI|WISCONSIN
+55021|COLUMBIA|55|WI|WISCONSIN
+55023|CRAWFORD|55|WI|WISCONSIN
+55025|DANE|55|WI|WISCONSIN
+55027|DODGE|55|WI|WISCONSIN
+55029|DOOR|55|WI|WISCONSIN
+55031|DOUGLAS|55|WI|WISCONSIN
+55033|DUNN|55|WI|WISCONSIN
+55035|EAU CLAIRE|55|WI|WISCONSIN
+55037|FLORENCE|55|WI|WISCONSIN
+55039|FOND DU LAC|55|WI|WISCONSIN
+55041|FOREST|55|WI|WISCONSIN
+55043|GRANT|55|WI|WISCONSIN
+55045|GREEN|55|WI|WISCONSIN
+55047|GREEN LAKE|55|WI|WISCONSIN
+55049|IOWA|55|WI|WISCONSIN
+55051|IRON|55|WI|WISCONSIN
+55053|JACKSON|55|WI|WISCONSIN
+55055|JEFFERSON|55|WI|WISCONSIN
+55057|JUNEAU|55|WI|WISCONSIN
+55059|KENOSHA|55|WI|WISCONSIN
+55061|KEWAUNEE|55|WI|WISCONSIN
+55063|LA CROSSE|55|WI|WISCONSIN
+55065|LAFAYETTE|55|WI|WISCONSIN
+55067|LANGLADE|55|WI|WISCONSIN
+55069|LINCOLN|55|WI|WISCONSIN
+55071|MANITOWOC|55|WI|WISCONSIN
+55073|MARATHON|55|WI|WISCONSIN
+55075|MARINETTE|55|WI|WISCONSIN
+55077|MARQUETTE|55|WI|WISCONSIN
+55078|MENOMINEE|55|WI|WISCONSIN
+55079|MILWAUKEE|55|WI|WISCONSIN
+55081|MONROE|55|WI|WISCONSIN
+55083|OCONTO|55|WI|WISCONSIN
+55085|ONEIDA|55|WI|WISCONSIN
+55087|OUTAGAMIE|55|WI|WISCONSIN
+55089|OZAUKEE|55|WI|WISCONSIN
+55091|PEPIN|55|WI|WISCONSIN
+55093|PIERCE|55|WI|WISCONSIN
+55095|POLK|55|WI|WISCONSIN
+55097|PORTAGE|55|WI|WISCONSIN
+55099|PRICE|55|WI|WISCONSIN
+55101|RACINE|55|WI|WISCONSIN
+55103|RICHLAND|55|WI|WISCONSIN
+55105|ROCK|55|WI|WISCONSIN
+55107|RUSK|55|WI|WISCONSIN
+55109|ST. CROIX|55|WI|WISCONSIN
+55111|SAUK|55|WI|WISCONSIN
+55113|SAWYER|55|WI|WISCONSIN
+55115|SHAWANO|55|WI|WISCONSIN
+55117|SHEBOYGAN|55|WI|WISCONSIN
+55119|TAYLOR|55|WI|WISCONSIN
+55121|TREMPEALEAU|55|WI|WISCONSIN
+55123|VERNON|55|WI|WISCONSIN
+55125|VILAS|55|WI|WISCONSIN
+55127|WALWORTH|55|WI|WISCONSIN
+55129|WASHBURN|55|WI|WISCONSIN
+55131|WASHINGTON|55|WI|WISCONSIN
+55133|WAUKESHA|55|WI|WISCONSIN
+55135|WAUPACA|55|WI|WISCONSIN
+55137|WAUSHARA|55|WI|WISCONSIN
+55139|WINNEBAGO|55|WI|WISCONSIN
+55141|WOOD|55|WI|WISCONSIN
+56001|ALBANY|56|WY|WYOMING
+56003|BIG HORN|56|WY|WYOMING
+56005|CAMPBELL|56|WY|WYOMING
+56007|CARBON|56|WY|WYOMING
+56009|CONVERSE|56|WY|WYOMING
+56011|CROOK|56|WY|WYOMING
+56013|FREMONT|56|WY|WYOMING
+56015|GOSHEN|56|WY|WYOMING
+56017|HOT SPRINGS|56|WY|WYOMING
+56019|JOHNSON|56|WY|WYOMING
+56021|LARAMIE|56|WY|WYOMING
+56023|LINCOLN|56|WY|WYOMING
+56025|NATRONA|56|WY|WYOMING
+56027|NIOBRARA|56|WY|WYOMING
+56029|PARK|56|WY|WYOMING
+56031|PLATTE|56|WY|WYOMING
+56033|SHERIDAN|56|WY|WYOMING
+56035|SUBLETTE|56|WY|WYOMING
+56037|SWEETWATER|56|WY|WYOMING
+56039|TETON|56|WY|WYOMING
+56041|UINTA|56|WY|WYOMING
+56043|WASHAKIE|56|WY|WYOMING
+56045|WESTON|56|WY|WYOMING
+60010|EASTERN (DISTRICT)|60|AS|AMERICAN SAMOA
+60020|MANU'A (DISTRICT)|60|AS|AMERICAN SAMOA
+60030|ROSE ISLAND|60|AS|AMERICAN SAMOA
+60040|SWAINS ISLAND|60|AS|AMERICAN SAMOA
+60050|WESTERN (DISTRICT)|60|AS|AMERICAN SAMOA
+64002|CHUUK|64|FM|FEDERATED STATES OF MICRONESIA
+64005|KOSRAE|64|FM|FEDERATED STATES OF MICRONESIA
+64040|POHNPEIT|64|FM|FEDERATED STATES OF MICRONESIA
+64060|YAP|64|FM|FEDERATED STATES OF MICRONESIA
+66010|GUAM|66|GU|GUAM
+68007|AILINGINAE|68|MH|MARSHALL ISLANDS
+68010|AILINGLAPLAP|68|MH|MARSHALL ISLANDS
+68030|AILUK|68|MH|MARSHALL ISLANDS
+68040|ARNO|68|MH|MARSHALL ISLANDS
+68050|AUR|68|MH|MARSHALL ISLANDS
+68060|BIKAR|68|MH|MARSHALL ISLANDS
+68070|BIKINI|68|MH|MARSHALL ISLANDS
+68073|BOKAK|68|MH|MARSHALL ISLANDS
+68080|EBON|68|MH|MARSHALL ISLANDS
+68090|ENEWETAK|68|MH|MARSHALL ISLANDS
+68100|ERIKUB|68|MH|MARSHALL ISLANDS
+68110|JABAT|68|MH|MARSHALL ISLANDS
+68120|JALUIT|68|MH|MARSHALL ISLANDS
+68130|JEMO|68|MH|MARSHALL ISLANDS
+68140|KILI|68|MH|MARSHALL ISLANDS
+68150|KWAJALEIN|68|MH|MARSHALL ISLANDS
+68160|LAE|68|MH|MARSHALL ISLANDS
+68170|LIB|68|MH|MARSHALL ISLANDS
+68180|LIKIEP|68|MH|MARSHALL ISLANDS
+68190|MAJURO|68|MH|MARSHALL ISLANDS
+68300|MALOELAP|68|MH|MARSHALL ISLANDS
+68310|MEJIT|68|MH|MARSHALL ISLANDS
+68320|MILI|68|MH|MARSHALL ISLANDS
+68330|NAMORIK|68|MH|MARSHALL ISLANDS
+68340|NAMU|68|MH|MARSHALL ISLANDS
+68350|RONGELAP|68|MH|MARSHALL ISLANDS
+68360|RONGRIK|68|MH|MARSHALL ISLANDS
+68385|TOKE|68|MH|MARSHALL ISLANDS
+68390|UJAE|68|MH|MARSHALL ISLANDS
+68400|UJELANG|68|MH|MARSHALL ISLANDS
+68410|UTRIK|68|MH|MARSHALL ISLANDS
+68420|WOTHO|68|MH|MARSHALL ISLANDS
+68430|WOTLE|68|MH|MARSHALL ISLANDS
+69085|NORTHERN ISLANDS|69|MP|NORTHERN MARIANA ISLANDS
+69100|ROTA|69|MP|NORTHERN MARIANA ISLANDS
+69110|SAIPAN|69|MP|NORTHERN MARIANA ISLANDS
+69120|TINIAN|69|MP|NORTHERN MARIANA ISLANDS
+70002|AIMELIIK|70|PW|PALAU
+70004|AIRAI|70|PW|PALAU
+70010|ANGAUR|70|PW|PALAU
+70050|HATOBOHEIT|70|PW|PALAU
+70100|KAYANGEL|70|PW|PALAU
+70150|KOROR|70|PW|PALAU
+70212|MELEKEOK|70|PW|PALAU
+70214|NGARAARD|70|PW|PALAU
+70218|NGARCHELONG|70|PW|PALAU
+70222|NGARDMAU|70|PW|PALAU
+70224|NGATPANG|70|PW|PALAU
+70226|NGCHESAR|70|PW|PALAU
+70227|NGERNMLENGUI|70|PW|PALAU
+70228|NGIWAL|70|PW|PALAU
+70350|PELELIU|70|PW|PALAU
+70370|SONSOROL|70|PW|PALAU
+72001|ADJUNTAS|72|PR|PUERTO RICO
+72003|AGUADA|72|PR|PUERTO RICO
+72005|AGUADILLA|72|PR|PUERTO RICO
+72007|AGUAS BUENAS|72|PR|PUERTO RICO
+72009|AIBONITO|72|PR|PUERTO RICO
+72011|ANASCO|72|PR|PUERTO RICO
+72013|ARECIBO|72|PR|PUERTO RICO
+72015|ARROYO|72|PR|PUERTO RICO
+72017|BARCELONETA|72|PR|PUERTO RICO
+72019|BARRANQUITAS|72|PR|PUERTO RICO
+72021|BAYAMO'N|72|PR|PUERTO RICO
+72023|CABO ROJO|72|PR|PUERTO RICO
+72025|CAGUAS|72|PR|PUERTO RICO
+72027|CAMUY|72|PR|PUERTO RICO
+72029|CANOVANAS|72|PR|PUERTO RICO
+72031|CAROLINA|72|PR|PUERTO RICO
+72033|CATANO|72|PR|PUERTO RICO
+72035|CAYEY|72|PR|PUERTO RICO
+72037|CEIBA|72|PR|PUERTO RICO
+72039|CIALES|72|PR|PUERTO RICO
+72041|CIDRA|72|PR|PUERTO RICO
+72043|COAMO|72|PR|PUERTO RICO
+72045|COMERIO|72|PR|PUERTO RICO
+72047|COROZAL|72|PR|PUERTO RICO
+72049|CULEBRA|72|PR|PUERTO RICO
+72051|DORADO|72|PR|PUERTO RICO
+72053|FAJARDO|72|PR|PUERTO RICO
+72054|FLORIDA|72|PR|PUERTO RICO
+72055|GUANICA|72|PR|PUERTO RICO
+72057|GUAYAMA|72|PR|PUERTO RICO
+72059|GUAYANILLA|72|PR|PUERTO RICO
+72061|GUAYNABO|72|PR|PUERTO RICO
+72063|GURABO|72|PR|PUERTO RICO
+72065|HATILLO|72|PR|PUERTO RICO
+72067|HORMIGUEROS|72|PR|PUERTO RICO
+72069|HUMACAO|72|PR|PUERTO RICO
+72071|ISABELA|72|PR|PUERTO RICO
+72073|JAYUYA|72|PR|PUERTO RICO
+72075|JUANA DIAZ|72|PR|PUERTO RICO
+72077|JUNCOS|72|PR|PUERTO RICO
+72079|LAJAS|72|PR|PUERTO RICO
+72081|LARES|72|PR|PUERTO RICO
+72083|LAS MARIAS|72|PR|PUERTO RICO
+72085|LAS PIEDRAS|72|PR|PUERTO RICO
+72087|LOIZA|72|PR|PUERTO RICO
+72089|LUQUILLO|72|PR|PUERTO RICO
+72091|MANATI|72|PR|PUERTO RICO
+72093|MARICAO|72|PR|PUERTO RICO
+72095|MAUNABO|72|PR|PUERTO RICO
+72097|MAYAGUEZ|72|PR|PUERTO RICO
+72099|MOCA|72|PR|PUERTO RICO
+72101|MOROVIS|72|PR|PUERTO RICO
+72103|NAGUABO|72|PR|PUERTO RICO
+72105|NARANJITO|72|PR|PUERTO RICO
+72107|OROCOVIS|72|PR|PUERTO RICO
+72109|PATILLAS|72|PR|PUERTO RICO
+72111|PENUELAS|72|PR|PUERTO RICO
+72113|PONCE|72|PR|PUERTO RICO
+72115|QUEBRADILLAS|72|PR|PUERTO RICO
+72117|RINCON|72|PR|PUERTO RICO
+72119|RIO GRANDE|72|PR|PUERTO RICO
+72121|SABANA GRANDE|72|PR|PUERTO RICO
+72123|SALINAS|72|PR|PUERTO RICO
+72125|SAN GERMAN|72|PR|PUERTO RICO
+72127|SAN JUAN|72|PR|PUERTO RICO
+72129|SAN LORENZO|72|PR|PUERTO RICO
+72131|SAN SEBASTIAN|72|PR|PUERTO RICO
+72133|SANTA ISABEL|72|PR|PUERTO RICO
+72135|TOA ALTA|72|PR|PUERTO RICO
+72137|TOA BAJA|72|PR|PUERTO RICO
+72139|TRUJILLO ALTO|72|PR|PUERTO RICO
+72141|UTUADO|72|PR|PUERTO RICO
+72143|VEGA ALTA|72|PR|PUERTO RICO
+72145|VEGA BAJA|72|PR|PUERTO RICO
+72147|VIEQUES|72|PR|PUERTO RICO
+72149|VILLALBA|72|PR|PUERTO RICO
+72151|YABUCOA|72|PR|PUERTO RICO
+72153|YAUCO|72|PR|PUERTO RICO
+74050|BAKER ISLAND|74|UM|U.S. MINOR OUTLYING ISLANDS
+74100|HOWLAND ISLAND|74|UM|U.S. MINOR OUTLYING ISLANDS
+74150|JARVIS ISLAND|74|UM|U.S. MINOR OUTLYING ISLANDS
+74200|JOHNSTON ISLAND|74|UM|U.S. MINOR OUTLYING ISLANDS
+74250|KINGMAN REEF|74|UM|U.S. MINOR OUTLYING ISLANDS
+74300|MIDWAY ISLANDS|74|UM|U.S. MINOR OUTLYING ISLANDS
+74350|NAVASSA ISLAND|74|UM|U.S. MINOR OUTLYING ISLANDS
+74400|PALMYRA ATOLL|74|UM|U.S. MINOR OUTLYING ISLANDS
+74450|WAKE ISLAND|74|UM|U.S. MINOR OUTLYING ISLANDS
+78010|ST. CROIX|78|VI|VIRGIN ISLANDS
+78020|ST. JOHN|78|VI|VIRGIN ISLANDS
+78030|ST. THOMAS|78|VI|VIRGIN ISLANDS
+\.
Index: web/openacs/www/install/country_codes.ctl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/install/country_codes.ctl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/install/country_codes.ctl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,245 @@
+COPY COUNTRY_CODES FROM stdin USING DELIMITERS '|';
+ad|Andorra
+ae|United Arab Emirates
+af|Afghanistan
+ag|Antigua and Barbuda
+ai|Anguilla
+al|Albania
+am|Armenia
+an|Netherlands Antilles
+ao|Angola
+aq|Antarctica
+ar|Argentina
+as|American Samoa
+at|Austria
+au|Australia
+aw|Aruba
+az|Azerbaijan
+ba|Bosnia and Herzegovina
+bb|Barbados
+bd|Bangladesh
+be|Belgium
+bf|Burkina Faso
+bg|Bulgaria
+bh|Bahrain
+bi|Burundi
+bj|Benin
+bm|Bermuda
+bn|Brunei Darussalam
+bo|Bolivia
+br|Brazil
+bs|Bahamas
+bt|Bhutan
+bv|Bouvet Island
+bw|Botswana
+by|Belarus
+bz|Belize
+ca|Canada
+cc|Cocos (Keeling) Islands
+cf|Central African Republic
+cg|Congo
+ch|Switzerland
+ck|Cook Islands
+cl|Chile
+cm|Cameroon
+cn|China
+co|Colombia
+cr|Costa Rica
+cs|Czechoslovakia (former)
+cu|Cuba
+cv|Cape Verde
+cx|Christmas Island
+cy|Cyprus
+cz|Czech Republic
+de|Germany
+dj|Djibouti
+dk|Denmark
+dm|Dominica
+do|Dominican Republic
+dz|Algeria
+ec|Ecuador
+ee|Estonia
+eg|Egypt
+eh|Western Sahara
+er|Eritrea
+es|Spain
+et|Ethiopia
+fi|Finland
+fj|Fiji
+fk|Falkland Islands (Malvinas)
+fm|Micronesia
+fo|Faroe Islands
+fr|France
+fx|France, Metropolitan
+ga|Gabon
+gb|Great Britain (UK)
+gd|Grenada
+ge|Georgia
+gf|French Guiana
+gh|Ghana
+gi|Gibraltar
+gl|Greenland
+gm|Gambia
+gn|Guinea
+gp|Guadeloupe
+gq|Equatorial Guinea
+gr|Greece
+gs|S. Georgia and S. Sandwich Isls.
+gt|Guatemala
+gu|Guam
+gw|Guinea-Bissau
+gy|Guyana
+hk|Hong Kong
+hm|Heard and McDonald Islands
+hn|Honduras
+hr|Croatia (Hrvatska)
+ht|Haiti
+hu|Hungary
+id|Indonesia
+ie|Ireland
+il|Israel
+in|India
+io|British Indian Ocean Territory
+iq|Iraq
+ir|Iran
+is|Iceland
+it|Italy
+jm|Jamaica
+jo|Jordan
+jp|Japan
+ke|Kenya
+kg|Kyrgyzstan
+kh|Cambodia
+ki|Kiribati
+km|Comoros
+kn|Saint Kitts and Nevis
+kp|Korea (North)
+kr|Korea (South)
+kw|Kuwait
+ky|Cayman Islands
+kz|Kazakhstan
+la|Laos
+lb|Lebanon
+lc|Saint Lucia
+li|Liechtenstein
+lk|Sri Lanka
+lr|Liberia
+ls|Lesotho
+lt|Lithuania
+lu|Luxembourg
+lv|Latvia
+ly|Libya
+ma|Morocco
+mc|Monaco
+md|Moldova
+mg|Madagascar
+mh|Marshall Islands
+mk|Macedonia
+ml|Mali
+mm|Myanmar
+mn|Mongolia
+mo|Macau
+mp|Northern Mariana Islands
+mq|Martinique
+mr|Mauritania
+ms|Montserrat
+mt|Malta
+mu|Mauritius
+mv|Maldives
+mw|Malawi
+mx|Mexico
+my|Malaysia
+mz|Mozambique
+na|Namibia
+nc|New Caledonia
+ne|Niger
+nf|Norfolk Island
+ng|Nigeria
+ni|Nicaragua
+nl|Netherlands
+no|Norway
+np|Nepal
+nr|Nauru
+nt|Neutral Zone
+nu|Niue
+nz|New Zealand (Aotearoa)
+om|Oman
+pa|Panama
+pe|Peru
+pf|French Polynesia
+pg|Papua New Guinea
+ph|Philippines
+pk|Pakistan
+pl|Poland
+pm|St. Pierre and Miquelon
+pn|Pitcairn
+pr|Puerto Rico
+pt|Portugal
+pw|Palau
+py|Paraguay
+qa|Qatar
+re|Reunion
+ro|Romania
+ru|Russian Federation
+rw|Rwanda
+sa|Saudi Arabia
+sb|Solomon Islands
+sc|Seychelles
+sd|Sudan
+se|Sweden
+sg|Singapore
+sh|St. Helena
+si|Slovenia
+sj|Svalbard and Jan Mayen Islands
+sk|Slovak Republic
+sl|Sierra Leone
+sm|San Marino
+sn|Senegal
+so|Somalia
+sr|Suriname
+st|Sao Tome and Principe
+su|USSR (former)
+sv|El Salvador
+sy|Syria
+sz|Swaziland
+tc|Turks and Caicos Islands
+td|Chad
+tf|French Southern Territories
+tg|Togo
+th|Thailand
+tj|Tajikistan
+tk|Tokelau
+tm|Turkmenistan
+tn|Tunisia
+to|Tonga
+tp|East Timor
+tr|Turkey
+tt|Trinidad and Tobago
+tv|Tuvalu
+tw|Taiwan
+tz|Tanzania
+ua|Ukraine
+ug|Uganda
+uk|United Kingdom
+um|US Minor Outlying Islands
+us|United States
+uy|Uruguay
+uz|Uzbekistan
+va|Vatican City State (Holy See)
+vc|Saint Vincent and the Grenadines
+ve|Venezuela
+vg|Virgin Islands (British)
+vi|Virgin Islands (U.S.)
+vn|Viet Nam
+vu|Vanuatu
+wf|Wallis and Futuna Islands
+ws|Samoa
+ye|Yemen
+yt|Mayotte
+yu|Yugoslavia
+za|South Africa
+zm|Zambia
+zr|Zaire
+zw|Zimbabwe
+\.
+
Index: web/openacs/www/install/currency_codes.ctl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/install/currency_codes.ctl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/install/currency_codes.ctl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,164 @@
+COPY CURRENCY_CODES FROM stdin USING DELIMITERS '|';
+ADP|Andorran Peseta|f
+AED|United Arab Emirates Dirham|f
+AFA|Afghanistan Afghani|f
+ALL|Albanian Lek|f
+AMD|Armenian Dram|f
+ANG|Netherlands Antillian Guilder|f
+AON|Angolan New Kwanza|f
+ARP|Argentinian Peso|f
+ATS|Austrian Schilling|f
+AUD|Australian Dollar|t
+AWF|Aruban Florin|f
+AZM|Azerbaijan Manat|f
+BAK|Bosnia and Herzegovina Convertible Mark|f
+BBD|Barbados Dollar|f
+BDT|Bangladeshi Taka|f
+BEF|Belgian Franc|f
+BGL|Bulgarian Lev|f
+BHD|Bahraini Dinar|f
+BIF|Burundi Franc|f
+BMD|Bermudian Dollar|f
+BND|Brunei Dollar|f
+BOB|Bolivian Boliviano|f
+BRR|Brazilian Real|f
+BSD|Bahamian Dollar|f
+BTN|Bhutan Ngultrum|f
+BUK|Burma Kyat|f
+BWP|Botswanian Pula|f
+BYP|Belarus Ruble|f
+BZD|Belize Dollar|f
+CAD|Canadian Dollar|t
+CHF|Swiss Franc|f
+CLF|Chilean Unidades de Fomento|f
+CLP|Chilean Peso|f
+CNY|Yuan (Chinese) Renminbi|f
+COP|Colombian Peso|f
+CRC|Costa Rican Colon|f
+CSK|Czech Koruna|f
+CUP|Cuban Peso|f
+CVE|Cape Verde Escudo|f
+CYP|Cyprus Pound|f
+DDM|East German Mark (DDR)|f
+DEM|Deutsche Mark|f
+DJF|Djibouti Franc|f
+DKK|Danish Krone|f
+DOP|Dominican Peso|f
+DZD|Algerian Dinar|f
+ECS|Ecuador Sucre|f
+EGP|Egyptian Pound|f
+ESP|Spanish Peseta|f
+ETB|Ethiopian Birr|f
+EUR|Euro|t
+FIM|Finnish Markka|f
+FJD|Fiji Dollar|f
+FKP|Falkland Islands Pound|f
+FRF|French Franc|f
+GBP|British Pound|f
+GHC|Ghanaian Cedi|f
+GIP|Gibraltar Pound|f
+GMD|Gambian Dalasi|f
+GNF|Guinea Franc|f
+GRD|Greek Drachma|f
+GTQ|Guatemalan Quetzal|f
+GWP|Guinea-Bissau Peso|f
+GYD|Guyanan Dollar|f
+HKD|Hong Kong Dollar|f
+HNL|Honduran Lempira|f
+HRK|Croatian Kuna|f
+HTG|Haitian Gourde|f
+HUF|Hungarian Forint|f
+IDR|Indonesian Rupiah|f
+IEP|Irish Punt|f
+ILS|Israeli Shekel|f
+INR|Indian Rupee|f
+IQD|Iraqi Dinar|f
+IRR|Iranian Rial|f
+ISK|Iceland Krona|f
+ITL|Italian Lira|f
+JMD|Jamaican Dollar|f
+JOD|Jordanian Dinar|f
+JPY|Japanese Yen|t
+KES|Kenyan Schilling|f
+KHR|Kampuchean (Cambodian) Riel|f
+KMF|Comoros Franc|f
+KPW|North Korean Won|f
+KRW|South Korean Won|f
+KWD|Kuwaiti Dinar|f
+KYD|Cayman Islands Dollar|f
+LAK|Lao Kip|f
+LBP|Lebanese Pound|f
+LKR|Sri Lanka Rupee|f
+LRD|Liberian Dollar|f
+LSL|Lesotho Loti|f
+LUF|Luxembourg Franc|f
+LYD|Libyan Dinar|f
+MAD|Moroccan Dirham|f
+MGF|Malagasy Franc|f
+MNT|Mongolian Tugrik|f
+MOP|Macau Pataca|f
+MRO|Mauritanian Ouguiya|f
+MTL|Maltese Lira|f
+MUR|Mauritius Rupee|f
+MVR|Maldive Rufiyaa|f
+MWK|Malawi Kwacha|f
+MXP|Mexican Peso|f
+MYR|Malaysian Ringgit|f
+MZM|Mozambique Metical|f
+NGN|Nigerian Naira|f
+NIC|Nicaraguan Cordoba|f
+NLG|Dutch Guilder|f
+NOK|Norwegian Kroner|f
+NPR|Nepalese Rupee|f
+NZD|New Zealand Dollar|f
+OMR|Omani Rial|f
+PAB|Panamanian Balboa|f
+PEI|Peruvian Inti|f
+PGK|Papua New Guinea Kina|f
+PHP|Philippine Peso|f
+PKR|Pakistan Rupee|f
+PLZ|Polish Zloty|f
+PTE|Portuguese Escudo|f
+PYG|Paraguay Guarani|f
+QAR|Qatari Rial|f
+ROL|Romanian Leu|f
+RUR|Russian Ruble|f
+RWF|Rwanda Franc|f
+SAR|Saudi Arabian Riyal|f
+SBD|Solomon Islands Dollar|f
+SCR|Seychelles Rupee|f
+SDP|Sudanese Pound|f
+SEK|Swedish Krona|f
+SGD|Singapore Dollar|f
+SHP|St. Helena Pound|f
+SLL|Sierra Leone Leone|f
+SOS|Somali Schilling|f
+SRG|Suriname Guilder|f
+STD|Sao Tome and Principe Dobra|f
+SVC|El Salvador Colon|f
+SYP|Syrian Potmd|f
+SZL|Swaziland Lilangeni|f
+THB|Thai Bhat|f
+TND|Tunisian Dinar|f
+TOP|Tongan Pa'anga|f
+TPE|East Timor Escudo|f
+TRL|Turkish Lira|f
+TTD|Trinidad and Tobago Dollar|f
+TWD|Taiwan Dollar|f
+TZS|Tanzanian Schilling|f
+UAH|Ukrainan Hryvnia|f
+UGS|Uganda Shilling|f
+USD|United States Dollar|t
+UYP|Uruguayan Peso|f
+VEB|Venezualan Bolivar|f
+VND|Vietnamese Dong|f
+VUV|Vanuatu Vatu|f
+WST|Samoan Tala|f
+YDD|Democratic Yemeni Dinar|f
+YER|Yemeni Rial|f
+YUD|New Yugoslavia Dinar|f
+ZAR|South African Rand|f
+ZMK|Zambian Kwacha|f
+ZRZ|Zaire Zaire|f
+ZWD|Zimbabwe Dollar|f
+\.
Index: web/openacs/www/install/keepalive.ini
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/install/keepalive.ini,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/install/keepalive.ini	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,51 @@
+[ns/parameters]
+User=nsadmin
+ServerLog=/home/nsadmin/log/keepalive-error.log
+Home=/home/nsadmin
+StackSize=500000
+
+[ns/server/keepalive]
+EnableTclPages=On
+PageRoot=/web/keepalive
+DirectoryFile=index.html, index.htm, index.shtml
+
+[ns/server/keepalive/module/nslog]
+enablehostnamelookup=Off
+file=/home/nsadmin/log/keepalive.log
+logcombined=On
+logrefer=Off
+loguseragent=Off
+maxbackup=5
+rollday=*
+rollfmt=%y-%m-%d-%H:%M
+rollhour=0
+rollonsignal=On
+
+[ns/server/keepalive/module/nsperm]
+Model=Small
+EnableHostnameLookup=Off
+
+[ns/server/keepalive/module/nssock]
+timeout=120
+Port=1997
+Address=server_ip
+Hostname=server_domain
+
+[ns/server/keepalive/modules]
+nslog=nslog.so
+nssock=nssock.so
+nsperm=nsperm.so
+nsssl=nsssle.so
+
+[ns/server/keepalive/tcl]
+SharedGlobals=On
+Library=/web/keepalive/tcl
+
+[ns/servers]
+keepalive=keepalive
+
+
+[ns/setup]
+ContinueOnError=On
+Enabled=Off
+Port=9879
\ No newline at end of file
Index: web/openacs/www/install/load-geo-tables
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/install/load-geo-tables,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/install/load-geo-tables	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,9 @@
+#! /bin/sh
+
+psql -f acs_geo_parents.sql $*
+
+for f in *.ctl; do
+    echo loading $f...
+    psql -f $f $*
+done
+
Index: web/openacs/www/install/readme.txt
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/install/readme.txt,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/install/readme.txt	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,4 @@
+these are files that you need purely for installation,
+e.g., Oracle dumps of country_codes, states, counties
+and currency_codes tables.
+
Index: web/openacs/www/install/service-name.ini
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/install/service-name.ini,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/install/service-name.ini	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,120 @@
+[ns/db/drivers]
+ora8=ora8.so
+
+[ns/db/pool/main]
+Driver=ora8
+Connections=4
+DataSource=
+User=service_name
+Password=service_database_password
+Verbose=On
+ExtendedTableInfo=On
+
+[ns/db/pool/subquery]
+Driver=ora8
+Connections=4
+DataSource=
+User=service_name
+Password=service_database_password
+Verbose=On
+ExtendedTableInfo=On
+
+[ns/db/pool/log]
+Driver=ora8
+Connections=3
+DataSource=
+User=service_name
+Password=service_database_password
+Verbose=On
+ExtendedTableInfo=On
+
+[ns/db/pools]
+main=main
+subquery=subquery
+log=log
+
+[ns/parameters]
+User=nsadmin
+ServerLog=/home/nsadmin/log/service_name-error.log
+Home=/home/nsadmin
+StackSize=500000
+auxconfigdir=/web/service_name/parameters
+
+[ns/threads]
+; use more than 1 processor (Solaris)
+SystemScope=on
+
+[ns/server/service_name/module/nscache]
+CacheADP=on
+
+[ns/server/service_name]
+PageRoot=/web/service_name/www
+DirectoryFile=index.tcl, index.adp, index.html, index.htm 
+Webmaster=service_email
+NoticeBgColor=#ffffff
+EnableTclPages=On
+NotFoundResponse=/global/file-not-found.html
+ServerBusyResponse=/global/busy.html
+ServerInternalErrorResponse=/global/error.html
+MaxThreads=50
+MaxBusyThreads=20
+MaxWait=2
+
+[ns/server/service_name/db]
+Pools=*
+DefaultPool=main
+
+[ns/server/service_name/adp]
+Map=/*.adp
+
+[ns/server/service_name/module/nslog]
+EnableHostnameLookup=Off
+File=/home/nsadmin/log/service_name.log
+LogCombined=On
+LogRefer=Off
+LogUserAgent=Off
+MaxBackup=5
+RollDay=*
+RollFmt=%Y-%m-%d-%H:%M
+RollHour=0
+RollOnSignal=On
+RollLog=On
+
+[ns/server/service_name/module/nsperm]
+model=Small
+enablehostnamelookup=Off
+
+[ns/server/service_name/module/nssock]
+timeout=120
+Address=service_ip_address
+Hostname=service_domain
+
+[ns/server/service_name/module/nsssl]
+Address=service_ip_address
+Hostname=service_domain
+CertFile=/home/nsadmin/servers/service_name/cert.pem
+KeyFile=/home/nsadmin/servers/service_name/key.pem
+
+[ns/server/service_name/modules]
+nsperm=nsperm.so
+nssock=nssock.so
+nslog=nslog.so
+nsssl=nsssle.so
+
+[ns/server/service_name/MimeTypes]
+Default=text/plain
+NoExtension=text/plain
+.pcd=image/x-photo-cd
+.prc=application/x-pilot
+
+[ns/server/service_name/tcl]
+Library=/web/service_name/tcl
+
+[ns/servers]
+service_name=service_domain community system
+
+
+[ns/setup]
+ContinueOnError=On
+Enabled=Off
+Port=9879
\ No newline at end of file
Index: web/openacs/www/install/states.ctl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/install/states.ctl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/install/states.ctl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,72 @@
+COPY states FROM STDIN USING DELIMITERS '|';
+AL|ALABAMA|01
+AK|ALASKA|02
+AZ|ARIZONA|04
+AR|ARKANSAS|05
+CA|CALIFORNIA|06
+CO|COLORADO|08
+CT|CONNECTICUT|09
+DE|DELAWARE|10
+DC|DISTRICT OF COLUMBIA|11
+FL|FLORIDA|12
+GA|GEORGIA|13
+HI|HAWAII|15
+ID|IDAHO|16
+IL|ILLINOIS|17
+IN|INDIANA|18
+IA|IOWA|19
+KS|KANSAS|20
+KY|KENTUCKY|21
+LA|LOUISIANA|22
+ME|MAINE|23
+MD|MARYLAND|24
+MA|MASSACHUSETTS|25
+MI|MICHIGAN|26
+MN|MINNESOTA|27
+MS|MISSISSIPPI|28
+MO|MISSOURI|29
+MT|MONTANA|30
+NE|NEBRASKA|31
+NV|NEVADA|32
+NH|NEW HAMPSHIRE|33
+NJ|NEW JERSEY|34
+NM|NEW MEXICO|35
+NY|NEW YORK|36
+NC|NORTH CAROLINA|37
+ND|NORTH DAKOTA|38
+OH|OHIO|39
+OK|OKLAHOMA|40
+OR|OREGON|41
+PA|PENNSYLVANIA|42
+RI|RHODE ISLAND|44
+SC|SOUTH CAROLINA|45
+SD|SOUTH DAKOTA|46
+TN|TENNESSEE|47
+TX|TEXAS|48
+UT|UTAH|49
+VT|VERMONT|50
+VA|VIRGINIA|51
+WA|WASHINGTON|53
+WV|WEST VIRGINIA|54
+WI|WISCONSIN|55
+WY|WYOMING|56
+AS|AMERICAN SAMOA|60
+GU|GUAM|66
+MP|NORTHERN MARIANA ISLANDS|69
+PR|PUERTO RICO|72
+VI|VIRGIN ISLANDS|78
+FM|FED. STATES OF MICRONESIA|64
+UM|US MINOR OUTLYING ISLANDS|74
+67|JOHNSTON ATOLL|67
+MH|MARSHALL ISLANDS|68
+PW|PALAU|70
+71|MIDWAY ISLANDS|71
+76|NAVASSA ISLAND|76
+79|WAKE ISLAND|79
+81|BAKER ISLAND|81
+84|HOWLAND ISLAND|84
+86|JARVIS ISLAND|86
+89|KINGMAN REEF|89
+95|PALMYRA ATOLL|95
+\.
+
Index: web/openacs/www/install/watchdog.ini
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/install/watchdog.ini,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/install/watchdog.ini	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,51 @@
+[ns/parameters]
+User=nsadmin
+ServerLog=/home/nsadmin/log/watchdog-error.log
+Home=/home/nsadmin
+StackSize=500000
+
+[ns/server/watchdog]
+EnableTclPages=On
+PageRoot=/web/watchdog
+DirectoryFile=index.tcl, index.html, index.htm, index.shtml
+
+[ns/server/watchdog/module/nslog]
+enablehostnamelookup=Off
+file=/home/nsadmin/log/watchdog.log
+logcombined=On
+logrefer=Off
+loguseragent=Off
+maxbackup=5
+rollday=*
+rollfmt=%y-%m-%d-%H:%M
+rollhour=0
+rollonsignal=On
+
+[ns/server/watchdog/module/nsperm]
+Model=Small
+EnableHostnameLookup=Off
+
+[ns/server/watchdog/module/nssock]
+timeout=120
+Port=1998
+Address=server_ip
+Hostname=server_domain
+
+[ns/server/watchdog/modules]
+nslog=nslog.so
+nssock=nssock.so
+nsperm=nsperm.so
+nsssl=nsssle.so
+
+[ns/server/watchdog/tcl]
+SharedGlobals=On
+Library=/web/watchdog/tcl
+
+[ns/servers]
+watchdog=watchdog
+
+
+[ns/setup]
+ContinueOnError=On
+Enabled=Off
+Port=9879
\ No newline at end of file
Index: web/openacs/www/intranet/customers.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/customers.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/customers.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,141 @@
+# customers.tcl,v 3.1.4.1 2000/03/17 08:22:39 mbryzek Exp
+#
+# File: /www/intranet/customers.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: top-level page for our customers to gain information 
+#  about their projects and the ArsDigitans working for them
+#  This page intended to provide a complete snapshot of everything
+#  on the intranet in which this customer would be interested
+
+set_form_variables 0
+# show_all_comments
+
+set return_url [ad_partner_url_with_query]
+
+set current_user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select 
+  first_names, 
+  last_name, 
+  email, 
+  url, 
+  portrait_upload_date,
+  portrait_client_file_name,
+  coalesce(screen_name,'&lt none set up &gt') as screen_name
+from users 
+where user_id=$current_user_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Account Unavailable" "We can't find you (user #$current_user_id) in the users table.  Probably your account was deleted for some reason.  You can visit <a href=\"/register/logout.tcl\">the log out page</a> and then start over."
+    return
+}
+
+set_variables_after_query
+
+if { ![empty_string_p $first_names] || ![empty_string_p $last_name] } {
+    set full_name "$first_names $last_name"
+} else {
+    set full_name "name unknown"
+}
+
+if [ad_parameter SolicitPortraitP "user-info" 0] {
+    # we have portraits for some users 
+    set portrait_chunk "<h4>Your Portrait</h4>\n"
+    if { ![empty_string_p $portrait_upload_date] } {
+	append portrait_chunk "On [util_AnsiDatetoPrettyDate $portrait_upload_date], you uploaded <a href=\"/pvt/portrait/\">$portrait_client_file_name</a>."
+    } else {
+	append portrait_chunk "Show everyone else at [ad_system_name] how great looking you are:  <a href=\"/pvt/portrait/upload.tcl?[export_url_vars return_url]\">upload a portrait</a>"
+    }
+} else {
+    set portrait_chunk ""
+}
+
+set page_title "Projects with [ad_parameter SystemName]"
+set context_bar [ad_context_bar [list "/" Home] "Your workspace"]
+
+# Let's get a list of each project, and the employees who work on that project
+
+# set all_projects [database_to_tcl_list_list $db \
+# 	"select ug.group_name, ug.group_id
+#            from user_groups ug, user_group_map ugm
+#           where ug.parent_group_id=[im_project_group_id]
+#             and ug.group_id=ugm.group_id(+)
+#             and ugm.user_id=$current_user_id"]
+
+
+set all_projects [database_to_tcl_list_list $db "\
+select ug.group_name, ug.group_id
+           from user_groups ug, user_group_map ugm
+          where ug.parent_group_id=[im_project_group_id]
+            and ug.group_id=ugm.group_id
+            and ugm.user_id=$current_user_id
+union
+select ug.group_name, ug.group_id
+           from user_groups ug, user_group_map ugm
+          where ug.parent_group_id=[im_project_group_id]
+            and not exists (select 1 from user_group_map 
+                            where group_id = ug.group_id)
+            and ugm.user_id=$current_user_id"]
+
+
+
+set projects "<ul>\n"
+if { [llength $all_projects] == 0 } {
+    append projects "<li><em>none</em>\n"    
+} else {
+    foreach pair $all_projects {
+	set group_name [lindex $pair 0]
+	set group_id [lindex $pair 1]
+	append projects "
+  <li> <b>$group_name</b>
+  <ul>
+    <li>Employees working on this project:
+     <ul>[im_users_in_group $db $group_id $current_user_id Employees 0 $return_url [im_employee_group_id] [im_customer_group_id]]</ul>
+  </ul>
+  <ul>
+    <li>Progress reports:
+"
+    if { [exists_and_not_null show_all_comments] } {
+	set progress_reports [ad_general_comments_summary_sorted $db $group_id im_projects $group_name]
+    } else {
+	set url_for_more "[im_url_stub]/customers.tcl?show_all_comments=1&[export_ns_set_vars url [list show_all_comments]]"
+	set progress_reports [ad_general_comments_summary_sorted $db $group_id im_projects $group_name 5 $url_for_more]
+    }
+    append projects "
+$progress_reports
+   </ul>
+"
+    }
+}
+append projects "</ul>\n"
+
+
+set left_column "
+$projects
+
+<h3>Information about you</h3>
+
+<ul>
+<li>Name:  $full_name
+<li>email address:  $email 
+<li>personal URL:  <a target=new_window href=\"$url\">$url</a>
+<li>screen name:  $screen_name
+<p>
+(<a href=\"/pvt/basic-info-update.tcl?[export_url_vars return_url]\">update</a>)
+  <p><li><a href=/pvt/password-update.tcl?[export_url_vars return_url]>Change my password</a>
+  <p><li><a href=/register/logout.tcl>Log Out</a>
+</ul>
+
+$portrait_chunk
+"
+
+
+set page_body $left_column
+
+ns_db releasehandle $db
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/index.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,223 @@
+# /www/intranet/index.tcl
+#
+# Purpose: top level, portal-like page, for employees, for the intranet
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# index.tcl,v 3.12.2.4 2000/03/18 02:36:19 ron Exp
+
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+# Redirect customers away
+set user_admin_p [im_is_user_site_wide_or_intranet_admin $db $user_id]
+if { $user_admin_p } {
+    set user_customer_p 0
+} else {
+    set user_customer_p [database_to_tcl_string $db \
+            "select (case when ad_group_member_p( $user_id, [im_customer_group_id] ) = 'f' then 0 else 1 end) from dual"]
+}
+
+# If this is a customer, go to the customer front page
+if { $user_customer_p } {
+    ad_return_error "Access Denied" "Sorry, but you need to be an employee of [ad_parameter SystemURL] to access the intranet"
+    return
+    # the customer portal is not yet build
+    ns_returnredirect customers.tcl
+    return
+}
+
+set selection [ns_db 0or1row $db \
+	"select first_names || ' ' || last_name as full_name, 
+                (case when portrait_upload_date is NULL then 0 else 1 end) as portrait_exists_p
+           from users 
+          where user_id=$user_id"]
+if { [empty_string_p $selection] } {
+    ad_return_error "User doesn't exist" "We're sorry, but we can't find you in our database. You can <a href=/register/logout.tcl>logout</a> and try logging in again."
+    return
+}
+set_variables_after_query
+
+set page_title "${full_name}'s workspace at [ad_parameter SystemName]"
+set context_bar [ad_context_bar "Intranet"]
+
+
+
+set projects ""
+set selection [ns_db select $db \
+	"select ug.group_name, ug.group_id
+           from user_groups ug, im_projects p
+          where ad_group_member_p ( $user_id, ug.group_id ) = 't'
+            and ug.group_id=p.group_id
+            and p.project_status_id in (select project_status_id
+                                          from im_project_status 
+                                         where project_status='Open' 
+                                            or project_status='Future' )
+          order by lower(group_name)"]
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append projects "  <li> <a href=projects/view.tcl?[export_url_vars group_id]>$group_name</a>\n"
+}
+if { ![empty_string_p $projects] } {
+    append projects "<p>"
+}
+
+append projects "  <li> <a href=projects/index.tcl?mine_p=f>All projects</a>\n"
+
+
+
+set customers ""
+set selection [ns_db select $db \
+	"select ug.group_name, ug.group_id
+           from user_groups ug, im_customers c
+          where ad_group_member_p ( $user_id, ug.group_id ) = 't'
+            and ug.group_id=c.group_id
+            and c.customer_status_id in (select customer_status_id 
+                                          from im_customer_status 
+                                         where customer_status in ('Current','Inquiries','Creating Bid','Bid out'))
+          order by lower(group_name)"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append customers "  <li> <a href=customers/view.tcl?[export_url_vars group_id]>$group_name</a>\n"
+}
+if { ![empty_string_p $customers] } {
+    append customers "<p>"
+}
+append customers "  <li> <a href=customers/index.tcl?mine_p=f>All customers</a>\n"
+
+
+if { [ad_parameter TrackHours intranet 0] } {
+    set on_which_table "im_projects"
+    set num_hours [hours_sum_for_user $db $user_id $on_which_table "" 7]
+    if { $num_hours == 0 } {
+	append hours "<b>You haven't logged your hours in the last week. Please <a href=hours/index.tcl?[export_url_vars on_which_table]>log them now</a></b>\n"
+    } else {
+	append hours "You logged $num_hours [util_decode $num_hours 1 hour hours] in the last 7 days."
+    }
+    append hours "
+<ul>
+  <li><a href=hours/projects.tcl?[export_url_vars on_which_table user_id]>View your hours on all projects</a>
+  <li><a href=hours/total.tcl?[export_url_vars on_which_table]>View time spent on all projects by everyone</a>
+  <li><a href=hours/projects.tcl?[export_url_vars on_which_table]>View the hours logged by someone else</a>
+  <li><a href=hours/index.tcl?[export_url_vars on_which_table]>Log hours</a>
+</ul>
+" 
+} else {
+    set hours ""
+}
+
+set return_url [ad_partner_url_with_query]
+set since_when [database_to_tcl_string $db "select sysdate() - 30 from dual"]
+set news [news_new_stuff $db $since_when 0 "web_display" 1 0 [im_employee_group_id]]
+set news_dir [im_groups_url -short_name [ad_parameter EmployeeGroupShortName intranet employee] -section news]
+
+if { [ad_parameter ApprovalPolicy news] == "open"} {
+    append news "\n<li><a href=\"$news_dir/post-new.tcl?scope=group&[export_url_vars return_url]\">post an item</a>\n"
+} elseif { [ad_parameter ApprovalPolicy news] == "wait"} {
+    append news "\n<li><a href=\"$news_dir/post-new.tcl?scope=group&[export_url_vars return_url]\">suggest an item</a>\n"
+}
+append news " | <a href=$news_dir/index.tcl?scope=group&archive_p=1>archives</a>\n"
+
+set left_column "
+
+[im_late_project_reports $db $user_id]
+<P><em><a href=\"/news/\">[ad_parameter SystemName] News</a></em>
+<ul>
+  $news
+</ul>
+
+<form method=post action=employees/search.tcl>
+<table width=100%>
+<tr><td valign=top>
+<ul>
+  <li><a href=employees/index.tcl>Employees</A> (<a href=employees/org-chart.tcl>org chart</a>)
+  <br><font size=-1>
+      Search: <input type=text name=keywords size=20>
+  <br><input name=search_type type=submit value=\"Search\"> 
+      <input name=search_type type=submit value=\"Feeling Lucky\"></font></form>
+ 
+  <p>
+  <li><a href=offices/index.tcl>Offices</a>
+  <li><a href=partners/index.tcl>Partners</a>
+  <li><a href=procedures/index.tcl>Procedures</A>
+  <p>
+  <!-- <li><a href=/address-book/index.tcl?scope=public>Address book: [ad_parameter IntranetName intranet]</a> -->
+  <li><a href=/address-book/index.tcl>Address Book: Private</a>
+  <li><a href=/calendar/monthly.tcl>Calendar (monthly view with vacations!)</a>
+  <li><a href=/directory>Directory</a>
+  <p>
+  <li><a href=/bboard>Discussion Groups</a>
+  <li><a href=/file-storage/index.tcl>Shared Files</a> 
+  <li><a href=status-report.tcl>Status Report</a>
+  <p><li><a href=/register/logout.tcl>Log Out</a>
+
+</ul>
+
+</td><td valign=top>[im_random_employee_blurb $db]</td>
+</tr></table>
+"
+
+set info_about_you "
+<ul>
+  <li><a href=users/view.tcl>Your public information</a>
+  <li><a href=employees/payroll.tcl>Your HR information</a>
+  <li><a href=vacations/one-user.tcl>Work absences</a>
+  <li><a href=/pvt/alerts.tcl>Your alerts</a> (<a href=/pvt/unsubscribe.tcl>Unsubscribe</a>)
+  <li><a href=/pvt/password-update.tcl>Change your password</a>
+" 
+
+if { $portrait_exists_p } {
+    append info_about_you "  <li><a href=/pvt/portrait/index.tcl>Your portrait</a>\n"
+} else {
+    append info_about_you "  <li><a href=/pvt/portrait/upload.tcl>Upload your portrait</a>\n"
+}
+
+append info_about_you "</ul>\n"
+
+set page_body "
+<table width=100% cellpadding=0 cellspacing=2 border=0>
+<tr>
+  <td valign=top>
+$left_column
+  </td>
+  <td valign=top>
+[im_table_with_title "Tasks and Tickets" "
+<ul>
+<li><a href=/new-ticket/index.tcl>Ticket Tracker</a>
+<li><a href=/new-ticket/project-summary.tcl?return_url=%2fnew%2dticket%2findex%2etcl%3fsubmitby%3dany%26assign%3dany%26status%3dactive%26created%3dany%26orderby%3dmsg%255fid%252a%26expert%3d0&public=yes>Project summary</a>
+</ul>"
+]
+
+[im_table_with_title "Projects" "<ul>$projects</ul>"]
+[im_table_with_title "Customers" "<ul>$customers</ul>"]
+"
+if { ![empty_string_p $hours] } {
+    append page_body [im_table_with_title "Work Logs" $hours]
+} 
+
+if { $user_admin_p } {
+    append page_body [im_table_with_title "Administration" "
+<ul>
+  <li> <a href=employees/admin>Employee administration</a>
+  <li> <a href=vacations/>Work absences</a>
+</ul>
+"]
+}
+
+
+append page_body "
+[im_table_with_title "Information about you" $info_about_you]
+  </td>
+</tr>
+</table>
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html [ad_partner_return_template]
+
Index: web/openacs/www/intranet/status-report.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/status-report.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/status-report.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,67 @@
+# status-report.tcl,v 3.3.4.2 2000/03/17 08:56:31 mbryzek Exp
+#
+# File: /www/intranet/status-report.tcl
+#
+# by teadams@mit.edu on Dec 10, 1999
+# last modified: sunday december 26 by ahmedaa@mit.edu
+
+# gives the random user a comprehensive view of 
+# the company's status 
+
+set_the_usual_form_variables 0
+
+set db [ns_db gethandle]
+ad_maybe_redirect_for_registration
+
+if { ![im_user_is_employee_p $db [ad_verify_and_get_user_id]] } {
+    ad_return_error "Access denied" "You must be an employee to see this page"
+    return
+}
+
+# coverage_days 
+
+if ![info exists coverage_days] {
+    set coverage_days 1
+}
+
+set page_title "Intranet Status Report"
+set context_bar [ad_context_bar [list index.tcl "Intranet"] "Status report"]
+
+set report_date [database_to_tcl_string $db "select to_char(sysdate(),'YYYY-MM-DD') from dual"] 
+
+set n_days_possible [list 1 2 3 4 5 6 7 14 30]
+
+set right_widget [list]
+
+foreach n_days $n_days_possible {
+    if { $n_days == $coverage_days } {
+	# current choice, just the item
+	lappend right_widget_items $n_days
+    } else {
+	lappend right_widget_items "<a href=\"status-report.tcl?coverage_days=$n_days\">$n_days</a>"
+    }
+}
+
+
+
+set right_widget [join $right_widget_items]
+
+set page_body "
+<table width=100%>
+<tr>
+  <td align=left>Report date: [util_IllustraDatetoPrettyDate $report_date]</td>
+  <td align=right>Coverage: $right_widget days</a>
+</tr>
+</table>
+
+<p>
+
+"
+
+append page_body [im_status_report $db $coverage_days $report_date "web_display" "im_status_report_section_list"]
+
+ns_db releasehandle $db
+
+ns_return 200 text/html [ad_partner_return_template]
+
+ 
Index: web/openacs/www/intranet/user-search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/user-search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/user-search.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,45 @@
+# user-search.tcl,v 3.1.2.1 2000/03/17 08:22:41 mbryzek Exp
+# 
+# File: /www/intranet/user-search.tcl
+#
+# Author: mbryzek@arsdigita.com, Mar 2000
+#
+# Purpose: Standard form to search for a user (through /user-search.tcl)
+#
+
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_form_variables
+# target
+# passthrough
+
+
+
+set page_title "Search for a user"
+set context_bar [ad_context_bar [list "/" Home] [list "../" "Intranet"] [list index.tcl "Offices"] [list view.tcl?[export_url_vars group_id] "One office"] "Select contact"]
+
+set page_body "
+
+Locate user by:
+
+<form method=get action=/user-search.tcl>
+[export_ns_set_vars form]
+
+<table border=0>
+<tr><td>Email address:<td><input type=text name=email size=40></tr>
+<tr><td colspan=2>or by</tr>
+<tr><td>Last name:<td><input type=text name=last_name size=40></tr>
+</table>
+
+<p>
+
+<center>
+<input type=submit value=Search>
+</center>
+</form>
+
+"
+
+ns_return 200 text/html [ad_partner_return_template]
\ No newline at end of file
Index: web/openacs/www/intranet/allocations/add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/allocations/add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/allocations/add-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,123 @@
+# add-2.tcl,v 1.1.2.1 2000/02/03 09:55:50 ron Exp
+set_the_usual_form_variables
+
+# group_id, allocated_user_id, start_block, end_block, percentage_time, note, allocation_id, maybe return_url
+
+validate_integer group_id $group_id
+validate_integer_or_null allocated_user_id $allocated_user_id
+validate_integer allocation_id $allocation_id
+
+ad_maybe_redirect_for_registration
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+# Now check to see if the input is good as directed by the page designer
+
+set exception_count 0
+set exception_text ""
+
+if {[string length $note] > 1000} {
+    incr exception_count
+    append exception_text "<LI>\"note\" is too long\n"
+}
+
+
+#check the start and end blocks
+set selection [ns_db 0or1row $db "select 1 from dual 
+where to_date('$start_block'::varchar, 'YYYY-MM-DD'::varchar) <= 
+to_date('$end_block'::varchar, 'YYYY-MM-DD'::varchar)
+"]
+
+if {[empty_string_p $selection]} {
+    incr exception_count
+    append exception_text "<li>Please make sure your start block is not 
+    after your end block.\n"
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+set_variables_after_query
+
+
+if [empty_string_p $end_block] {
+    set end_block $start_block
+}
+# So the input is good --
+# Now we'll update the allocation.
+
+set dml_type "insert"
+
+ns_db dml $db "begin transaction"
+
+# We want to be smart about adjusting the current allocations
+
+# if the allocation_id and the start_block are the same as an
+# existing row,  this means we are changing a particular allocation
+# decision from before. We want to do an update of that row instead of
+# creating a new row.
+
+    ns_db dml $db "update 
+im_allocations 
+set last_modified = sysdate(),
+last_modifying_user = $user_id, modified_ip_address = '[ns_conn peeraddr]',
+percentage_time = $percentage_time,
+note = '$QQnote', user_id =  [ns_dbquotevalue $allocated_user_id],
+group_id = $group_id
+where start_block >= '$start_block' and start_block <=\
+ '$end_block'
+and allocation_id = $allocation_id"
+
+# if the user_id, start_date and group_id is that same
+# as an exisiting row and the allocation_id is not the same (above case), 
+# we are giving a user two different allocations
+# on the same project. we want to do an update of that row
+# instead of creating a new row
+
+ns_db dml $db "update im_allocations 
+set last_modified=sysdate(),
+last_modifying_user = $user_id, modified_ip_address = '[ns_conn peeraddr]',
+percentage_time = $percentage_time,
+note = '$QQnote',
+allocation_id = $allocation_id
+where start_block >= '$start_block' and start_block <=\
+ '$end_block'
+and user_id =  [ns_dbquotevalue $allocated_user_id]
+and group_id = $group_id
+and allocation_id <> $allocation_id"
+
+# If the conditions above don't apply, let's add a new row
+
+ns_db dml $db "insert into im_allocations
+(allocation_id, last_modified, last_modifying_user, 
+modified_ip_address, group_id, user_id, start_block, percentage_time, note)
+select $allocation_id, sysdate(), $user_id, 
+'[ns_conn peeraddr]', $group_id,  
+[ns_dbquotevalue $allocated_user_id], start_block, 
+$QQpercentage_time, '$QQnote' 
+from im_start_blocks 
+where (start_block >= '$start_block'::datetime) 
+ and (start_block <= '$end_block'::datetime)
+and not exists (select 1 from im_allocations im2
+where im2.allocation_id = $allocation_id 
+and im_start_blocks.start_block = im2.start_block)
+and not exists (select 1 from im_allocations im3
+where im3.user_id =  [ns_dbquotevalue $allocated_user_id]
+and im3.group_id = $group_id 
+and im3.allocation_id <> $allocation_id
+and im_start_blocks.start_block = im3.start_block)"
+
+# clean out allocations with 0 percentage
+ns_db dml $db "delete from im_allocations where percentage_time=0"
+
+ns_db dml $db "end transaction"
+
+if [info exist return_url] {
+    ns_returnredirect $return_url
+} else {
+    ns_returnredirect index.tcl?[export_url_vars start_block]
+}
+ 
Index: web/openacs/www/intranet/allocations/add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/allocations/add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/allocations/add.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,87 @@
+# add.tcl,v 1.2.2.1 2000/02/03 09:55:51 ron Exp
+set_the_usual_form_variables 0
+
+# maybe group_id, start_block, allocation_id, user_id, note 
+# maybe return_url
+
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+set percentages [list 100 95 90 85 80 75 70 65 60 55 50 45 40 35 30 25 20 15 10 5 0]
+
+if ![info exists allocation_id] {
+    set allocation_id [database_to_tcl_string $db "select im_allocations_id_seq.nextval from dual"]
+} else {
+    validate_integer allocation_id $allocation_id
+
+    set selection [ns_db 1row $db "select user_id as allocation_user_id, note
+from im_allocations
+where allocation_id = $allocation_id
+and start_block = '$start_block'"]
+    set_variables_after_query
+}
+
+set page_title "Enter an allocation"
+set context_bar "[ad_context_bar [list "/" Home] [list "../index.tcl" "Intranet"] [list "index.tcl" "Allocations"] "Enter allocation"]"
+
+ns_return 200 text/html "
+[ad_partner_header]
+
+<form method=POST action=\"add-2.tcl\"> 
+[export_form_vars allocation_id return_url]
+<table>
+<tr><th valign=top align=right>Project</th>
+<td><select name=group_id>
+[db_html_select_value_options  $db "select 
+p.group_id, ug.group_name 
+from im_projects p, user_groups ug, im_project_status ps
+where ps.project_status <> 'deleted'
+and ps.project_status_id = p.project_status_id
+and ug.group_id = p.group_id
+order by lower(group_name)" [value_if_exists group_id]]
+</select>
+</td></tr>
+
+<tr><th valign=top align=right>Employee</th>
+<td>
+<select name=allocated_user_id>
+<option value=\"\">Not decided</option>
+[im_employee_select_optionlist $db [value_if_exists allocation_user_id]]
+</select>
+</td></tr>
+
+<tr><th valign=top align=right>Start week beginning (Sunday):</th>
+<td>
+<select name=start_block>
+[im_allocation_date_optionlist $db [value_if_exists start_block]]
+</select>
+</td></tr>
+
+<tr><th valign=top align=right>End week beginning (Sunday):</th>
+<td>
+<select name=end_block>
+<option></option>
+[im_allocation_date_optionlist $db [value_if_exists start_block]]
+</select>
+</td></tr>
+
+<tr><th valign=top align=right>Percentage time</th>
+<td><select name=percentage_time>
+[html_select_options $percentages [value_if_exists percentage_time]]
+</select>
+</td></tr>
+</select>
+
+<tr><th valign=top align=right>Note</th>
+<td><textarea name=note cols=40 rows=8 wrap=soft>[value_if_exists note]</textarea></td></tr>
+
+</table>
+
+<p>
+<center>
+<input type=submit value=\"Submit\">
+</center>
+</form>
+<p>
+[ad_partner_footer]"
Index: web/openacs/www/intranet/allocations/index-bu.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/allocations/index-bu.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/allocations/index-bu.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,379 @@
+# index-bu.tcl,v 3.1.4.1 2000/03/17 08:22:47 mbryzek Exp
+
+set_the_usual_form_variables 0
+
+# maybe start_block, end_block, order_by_var, allocation_user_id
+
+# warning
+# start_block can be reassigned on this page 
+#  be careful to recast start_block in your queries
+
+set db [ns_db gethandle]
+
+# if not other wise provided, the report will be for the
+# last 4 weeks
+
+if ![info exist end_block] {
+    set end_block [database_to_tcl_string $db "select to_char(max(start_block),'YYYY-MM-DD')
+from im_start_blocks where start_block < sysdate()"]
+}
+
+if ![info exist start_block] {
+    set start_block [database_to_tcl_string $db "select to_date('$end_block'::varchar,'YYYY-MM-DD'::varchar) - 28 from dual"]
+}
+
+
+#lappend where_clauses "users.user_id(+) = im_allocations.user_id"
+#lappend where_clauses "im_projects.group_id = im_allocations.group_id"
+#lappend where_clauses "im_allocations.start_block >= '$start_block'"
+#lappend where_clauses "im_allocations.start_block < '$end_block'"
+#lappend where_clauses "im_allocations.percentage_time > 0"
+
+
+if {![info exists order_by_var] || [empty_string_p $order_by_var]}  {
+    set order_by_var "last_name"
+}
+
+set order_by_clause "order by $order_by_var"
+
+set order_by_last ""
+
+if {$order_by_var == "last_name"} {
+    set interface_separation "allocated_name"    
+} elseif {$order_by_var == "group_id"} { 
+   set interface_separation "project_name"
+} else {
+   set interface_separation "percentage_time"
+}
+
+set selection [ns_db select $db "select 
+note, start_block as allocation_note_start_block from im_start_blocks
+where start_block >= '$start_block'
+and start_block < '$end_block' "]
+
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    set allocation_note($allocation_note_start_block) "$note <a href=note-edit.tcl?[export_url_vars allocation_note_start_block start_block end_block]>edit</a>"
+}
+
+# set selection [ns_db select $db "select 
+# valid_start_blocks.start_block as temp_start_block,  
+# sum(im_employee_percentage_time.percentage_time)/100 as percentage_time
+# from im_employee_percentage_time, 
+#  (select start_block
+#  from im_start_blocks 
+#  where start_block >= '$start_block'
+#  and start_block < '$end_block') valid_start_blocks 
+# where valid_start_blocks.start_block = im_employee_percentage_time.start_block
+# group by valid_start_blocks.start_block"]
+
+set selection [ns_db select $db "select 
+valid_start_blocks.start_block as temp_start_block,  
+sum(im_employee_percentage_time.percentage_time)/100 as percentage_time
+from im_employee_percentage_time, im_start_blocks valid_start_blocks
+where valid_start_blocks.start_block = im_employee_percentage_time.start_block
+and valid_start_blocks.start_block >= '$start_block'
+ and valid_start_blocks.start_block < '$end_block'
+group by valid_start_blocks.start_block"]
+
+
+#set selection [ns_db select $db "select 
+#im_employee_percentage_time.start_block as temp_start_block,  sum(percentage_time)/100 as percentage_time
+#from im_employee_percentage_time, im_employee_info (select start_block
+#from im_start_blocks where start_block >= '$start_block'
+#and start_block < '$end_block') valid_start_blocks 
+#where im_employee_info.user_id = im_employee_percentage_time.user_id group by im_employee_percentage_time.start_block"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+#    if {![exists_and_not_null percentage_time]} {
+#	set percentage_time 0
+#    }
+    set number_developer_units_available($temp_start_block) "$percentage_time<br>"
+}
+
+# set selection [ns_db select $db "select 
+# sum(percentage_time)/100 as percentage_time, start_block as temp_start_block
+# from im_allocations, im_projects, users
+# where [join $where_clauses " and "]
+# group by start_block"]
+
+set sql "select 
+sum((case when percentage_time is null then 0 else percentage_time end))/100 as percentage_time, start_block as temp_start_block
+from im_allocations, im_projects, users
+where im_projects.group_id = im_allocations.group_id
+and im_allocations.start_block >= '$start_block'
+and im_allocations.start_block < '$end_block'
+and im_allocations.percentage_time > 0
+group by start_block"
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    set number_developer_units_scheduled($temp_start_block)  "$percentage_time"
+}
+
+set selection [ns_db select $db \
+	"select start_block as temp_start_block, to_char(start_block, 'Mon DD, YYYY') as temp_pretty_start_block
+           from im_start_blocks 
+          where start_block >= '$start_block'
+            and start_block < '$end_block'"]
+
+set summary_text ""
+set ctr 0
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    if { $ctr % 2 == 0 } {
+	set background_tag " bgcolor=\"[ad_parameter TableColorOdd intranet white]\""
+    } else {
+	set background_tag " bgcolor=\"[ad_parameter TableColorEven intranet white]\""
+    }
+    incr ctr
+    append summary_text "
+<tr$background_tag>
+  <td>$temp_pretty_start_block</td>
+  <td>$allocation_note($temp_start_block)</td>
+  <td>$number_developer_units_available($temp_start_block)</td>
+"
+    if { [info exists number_developer_units_scheduled($temp_start_block)] } {
+	append summary_text "  <td>$number_developer_units_scheduled($temp_start_block)</td>"
+    } else {
+	append summary_text "  <td>&nbsp;</td>"
+    }
+    append summary_text "\n</tr>\n"
+}
+
+# set sql_query  "select im_projects.group_id, users.user_id, allocation_id, 
+# group_name as project_name, percentage_time, start_block as temp_start_block,
+# to_char(start_block, 'Mon DD, YYYY') as week_start, im_allocations.note,
+# first_names || ' ' || last_name as allocated_name
+# from im_allocations, im_projects, users, user_groups
+# where [join $where_clauses " and "]
+# and user_groups.group_id = im_projects.group_id
+# $order_by_clause"
+
+
+set sql_query  "select im_projects.group_id, users.user_id, allocation_id, 
+group_name as project_name, percentage_time, start_block as temp_start_block,
+to_char(start_block, 'Mon DD, YYYY') as week_start, im_allocations.note,
+first_names || ' ' || last_name as allocated_name
+from im_allocations, im_projects, users, user_groups
+where users.user_id = im_allocations.user_id
+and im_projects.group_id = im_allocations.group_id
+and im_allocations.start_block >= '$start_block'
+and im_allocations.start_block < '$end_block'
+and im_allocations.percentage_time > 0
+and user_groups.group_id = im_projects.group_id
+union
+select im_projects.group_id, '' as user_id, allocation_id, 
+group_name as project_name, percentage_time, start_block as temp_start_block,
+to_char(start_block, 'Mon DD, YYYY') as week_start, im_allocations.note,
+'' as allocated_name
+from im_allocations, im_projects, user_groups
+where not exists (select 1 from users 
+                  where user_id = im_allocations.user_id)
+and im_projects.group_id = im_allocations.group_id
+and im_allocations.start_block >= '$start_block'
+and im_allocations.start_block < '$end_block'
+and im_allocations.percentage_time > 0
+and user_groups.group_id = im_projects.group_id
+$order_by_clause"
+
+
+set selection [ns_db select $db $sql_query] 
+
+set counter 0
+
+set allocation_list ""
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    incr counter
+   
+    if { $order_by_last != [set $interface_separation] } {
+	append allocation_list "<tr><td>&nbsp;</td></tr>"
+    }
+    append allocation_list "<tr><td>$week_start</td><td><a href=\"project.tcl?[export_url_vars group_id]\">$project_name</a></td><td><a href=user.tcl?allocation_user_id=$user_id>$allocated_name</a></td><td>$percentage_time % <td><a href=add.tcl?[export_url_vars group_id user_id  percentage_time allocation_id]&start_block=$temp_start_block>edit</a></td><td><font size=-1>$note</font></td></tr>"
+
+    set order_by_last [set $interface_separation]
+
+}
+
+set num_weeks [database_to_tcl_string $db "select count(start_block) from
+im_start_blocks where start_block >= '$start_block'
+and start_block < '$end_block'"]
+
+# set selection  [ns_db select $db "select 
+# first_names || ' ' || last_name as name, 
+# available_view.percentage_time as percentage,
+# scheduled_view.percentage_time as scheduled_percentage
+# from im_employee_info, users,
+# (select sum(percentage_time) as percentage_time, user_id 
+# from im_employee_percentage_time
+# where start_block >= '$start_block'
+# and start_block < '$end_block'
+# group by user_id) available_view,
+# (select sum(percentage_time) as percentage_time, user_id 
+# from im_allocations
+# where start_block >= '$start_block'
+# and start_block < '$end_block'
+# group by user_id) scheduled_view
+# where im_employee_info.user_id = users.user_id
+# and im_employee_info.user_id = available_view.user_id
+# and im_employee_info.user_id = scheduled_view.user_id"]
+
+set aview " 
+select sum(percentage_time) as percentage_time, user_id into table available_view
+            from im_employee_percentage_time
+           where start_block >= '$start_block'
+             and start_block < '$end_block'
+           group by user_id"
+
+set sview "
+select sum(percentage_time) as percentage_time, user_id into table scheduled_view
+            from im_allocations
+           where start_block >= '$start_block'
+             and start_block < '$end_block'
+           group by user_id"
+
+
+set sql "
+select first_names || ' ' || last_name as name, 
+       coalesce(available_view.percentage_time,0) as percentage,
+       coalesce(scheduled_view.percentage_time,0) as scheduled_percentage
+  from im_employee_info, users, available_view, scheduled_view
+ where im_employee_info.user_id = users.user_id
+   and im_employee_info.user_id = available_view.user_id
+   and im_employee_info.user_id = scheduled_view.user_id
+union
+select first_names || ' ' || last_name as name, 
+       0 as percentage,
+       coalesce(scheduled_view.percentage_time,0) as scheduled_percentage
+  from im_employee_info, users, scheduled_view
+ where im_employee_info.user_id = users.user_id
+   and not exists (select 1 from available_view 
+                    where user_id = im_employee_info.user_id)
+   and im_employee_info.user_id = scheduled_view.user_id
+union
+select first_names || ' ' || last_name as name, 
+       coalesce(available_view.percentage_time,0) as percentage,
+       0 as scheduled_percentage
+  from im_employee_info, users, available_view
+ where im_employee_info.user_id = users.user_id
+   and im_employee_info.user_id = available_view.user_id
+   and not exists (select 1 from scheduled_view 
+                    where user_id = im_employee_info.user_id)
+union
+select first_names || ' ' || last_name as name, 
+       0 as percentage,
+       0 as scheduled_percentage
+  from im_employee_info, users
+ where im_employee_info.user_id = users.user_id
+   and not exists (select 1 from available_view 
+                    where user_id = im_employee_info.user_id)
+   and not exists (select 1 from scheduled_view 
+                    where user_id = im_employee_info.user_id)"
+
+
+set over_allocated ""
+set under_allocated ""
+
+ns_db dml $db "begin transaction"
+
+ns_db dml $db $aview
+ns_db dml $db $sview
+
+set selection  [ns_db select $db $sql]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    if {$scheduled_percentage < "$percentage"} {
+	append under_allocated "<li>$name (Scheduled $scheduled_percentage% of $percentage%  available)<br>"
+    }
+    if {$scheduled_percentage > $percentage} {
+	append over_allocated "<li>$name (Scheduled $scheduled_percentage% of $percentage% available)<br>"
+    }
+}
+
+ns_db dml $db "drop table available_view"
+ns_db dml $db "drop table scheduled_view"
+ns_db dml $db "end transaction"
+
+if { [empty_string_p $over_allocated] } {
+    set over_allocated "  <li><i>none</i>"
+} 
+if { [empty_string_p $under_allocated] } {
+    set under_allocated "  <li><i>none</i>"
+} 
+
+
+set page_title "Allocations (Time stamp)"
+set context_bar "[ad_context_bar [list "/" Home] [list "/intranet" "Intranet"] "Project allocations"]"
+
+set page_body "
+<table width=100% cellpadding=5><tr><td>
+<form action=index.tcl method=post>
+Week starting:
+<select name=start_block>
+[im_allocation_date_optionlist $db $start_block]
+</select>
+through week ending:
+<select name=end_block>
+[im_allocation_date_optionlist $db $end_block]
+</select>
+
+<input type=submit name=submit value=Go>
+</form>
+</td><td align=right valign=top>[ad_partner_default_font "size=-1"]
+<a href=../projects/index.tcl?[export_ns_set_vars]>Summary view</a> |
+<a href=../projects/money.tcl?[export_ns_set_vars]>Financial view</a> 
+</font></table>
+<p>
+
+<h3>Summary</h3>
+<table cellpadding=2 cellspacing=2 border=1>
+<tr bgcolor=\"[ad_parameter TableColorHeader intranet white]\">
+  <th>Week of</th>
+  <th>Note</th>
+  <th>Available staff</th>
+  <th>Scheduled staff</th>
+</tr>
+$summary_text
+</table>
+
+<p>
+"
+
+if { [empty_string_p $allocation_list] } {
+    append page_body "<b>There are no allocations in the database right now.</b><p>\n"
+} else {
+    append page_body "
+
+<table cellpadding=5>
+<tr><th>Week Starting</th>
+<th><a href=index.tcl?[export_ns_set_vars url order_by]&order_by_var=group_id>Project</a></th>
+<th><a href=index.tcl?[export_ns_set_vars url order_by]&order_by_var=last_name>Employee</a></th>
+<th><a href=index.tcl?[export_ns_set_vars url oder_by]&order_by_var=percentage_time>% of full</a></th><th>Edit</td><th>Note</td></tr>
+$allocation_list
+</table>
+"
+}
+
+append page_body "
+<h3>Allocation problems</h3>
+[ad_partner_default_font]<b>Under allocated</b></font><br>
+<ul>
+$under_allocated
+</ul>
+[ad_partner_default_font]<b>Over allocated</b></font><br>
+<ul>
+$over_allocated
+</ul>
+
+<p>
+<a href=\"add.tcl?[export_url_vars start_block]\">Add an allocation</a></ul><p>
+
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/allocations/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/allocations/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/allocations/index.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,397 @@
+# index.tcl,v 1.2.2.1 2000/02/03 09:55:53 ron Exp
+set_the_usual_form_variables 0
+
+# maybe start_block, end_block, order_by_var
+
+# warning
+# start_block can be reassigned on this page 
+#  be careful to recast start_block in your queries
+
+set db [ns_db gethandle]
+
+# if not other wise provided, the report will be for the
+# last 4 weeks
+
+if ![info exist end_block] {
+    set end_block [database_to_tcl_string $db "select to_char(max(start_block),'YYYY-MM-DD')
+from im_start_blocks where start_block < sysdate()"]
+} else {
+    set end_block [database_to_tcl_string $db "select to_date('$end_block','YYYY-MM-DD')"]
+}
+
+if ![info exist start_block] {
+    set start_block [database_to_tcl_string $db "select to_date('$end_block'::varchar,'YYYY-MM-DD'::varchar) - 28 from dual"]
+} else {
+    set start_block [database_to_tcl_string $db "select to_date('$start_block','YYYY-MM-DD')"]
+}
+
+
+#lappend where_clauses "users.user_id(+) = im_allocations.user_id"
+#lappend where_clauses "im_projects.group_id = im_allocations.group_id"
+#lappend where_clauses "im_allocations.start_block >= '$start_block'"
+#lappend where_clauses "im_allocations.start_block < '$end_block'"
+#lappend where_clauses "im_allocations.percentage_time > 0"
+
+
+if {![info exists order_by_var] || [empty_string_p $order_by_var]}  {
+    set order_by_var "last_name"
+}
+
+set order_by_clause "order by $order_by_var"
+set order_by_last ""
+
+if {$order_by_var == "last_name"} {
+    set interface_separation "allocated_name"    
+} elseif {$order_by_var == "group_id"} { 
+   set interface_separation "project_name"
+} else {
+   set interface_separation "percentage_time"
+}
+
+set selection [ns_db select $db "select 
+note, to_char(start_block,'YYYY-MM-DD') as allocation_note_start_block from im_start_blocks
+where start_block >= '$start_block'
+and start_block < '$end_block' "]
+
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    set allocation_note($allocation_note_start_block) "$note <a href=note-edit.tcl?[export_url_vars allocation_note_start_block start_block end_block]>edit</a>"
+}
+
+# set selection [ns_db select $db "select 
+# valid_start_blocks.start_block as temp_start_block,  
+# sum(im_employee_percentage_time.percentage_time)/100 as percentage_time
+# from im_employee_percentage_time, 
+#  (select start_block
+#  from im_start_blocks 
+#  where start_block >= '$start_block'
+#  and start_block < '$end_block') valid_start_blocks 
+# where valid_start_blocks.start_block = im_employee_percentage_time.start_block
+# group by valid_start_blocks.start_block"]
+
+set selection [ns_db select $db "select 
+to_char(valid_start_blocks.start_block,'YYYY-MM-DD') as temp_start_block,  
+sum(im_employee_percentage_time.percentage_time)/100 as percentage_time
+from im_employee_percentage_time, im_start_blocks valid_start_blocks
+where valid_start_blocks.start_block = im_employee_percentage_time.start_block
+and valid_start_blocks.start_block >= '$start_block'
+ and valid_start_blocks.start_block < '$end_block'
+group by valid_start_blocks.start_block"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+#    if {![exists_and_not_null percentage_time]} {
+#	set percentage_time 0
+#    }
+    set number_developer_units_available($temp_start_block) "$percentage_time<br>"
+}
+
+# set sql "select 
+# sum((case when percentage_time is null then 0 else percentage_time end))/100 as percentage_time, start_block as temp_start_block
+# from im_allocations, im_projects, users
+# where users.user_id(+) = im_allocations.user_id
+# im_projects.group_id = im_allocations.group_id
+# and im_allocations.start_block >= '$start_block'
+# and im_allocations.start_block < '$end_block'
+# and im_allocations.percentage_time > 0
+# group by start_block"
+
+set sql "select 
+sum((case when percentage_time is null then 0 else percentage_time end))/100 as percentage_time, to_char(start_block,'YYYY-MM-DD') as temp_start_block
+from im_allocations, im_projects, users
+where im_projects.group_id = im_allocations.group_id
+and im_allocations.start_block >= '$start_block'
+and im_allocations.start_block < '$end_block'
+and im_allocations.percentage_time > 0
+and im_allocations.user_id= users.user_id
+group by start_block"
+
+set selection [ns_db select $db $sql]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    if { $temp_start_block != "" } {
+    set number_developer_units_scheduled($temp_start_block)  "$percentage_time"
+    }
+}
+
+set selection [ns_db select $db \
+	"select to_char(start_block,'YYYY-MM-DD') as temp_start_block, to_char(start_block, 'Mon DD, YYYY') as temp_pretty_start_block
+           from im_start_blocks 
+          where start_block >= '$start_block'
+            and start_block < '$end_block'"]
+
+set summary_text ""
+set ctr 0
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    if { $ctr % 2 == 0 } {
+	set background_tag " bgcolor=\"[ad_parameter TableColorOdd intranet white]\""
+    } else {
+	set background_tag " bgcolor=\"[ad_parameter TableColorEven intranet white]\""
+    }
+    incr ctr
+    append summary_text "
+<tr$background_tag>
+  <td>$temp_pretty_start_block</td>
+  <td>$allocation_note($temp_start_block)</td>
+"
+
+if {[info exists number_developer_units_available($temp_start_block)]} {
+    append summary_text "
+  <td>$number_developer_units_available($temp_start_block)</td>
+"
+} else {
+    append summary_text "
+    <td>0</td>
+"
+}
+    if { [info exists number_developer_units_scheduled($temp_start_block)] } {
+	append summary_text "  <td>$number_developer_units_scheduled($temp_start_block)</td>"
+    } else {
+	append summary_text "  <td>&nbsp;</td>"
+    }
+    append summary_text "\n</tr>\n"
+}
+
+
+# set sql_query  "select im_projects.group_id, users.user_id, allocation_id, 
+# group_name as project_name, percentage_time, start_block as temp_start_block,
+# to_char(start_block, 'Mon DD, YYYY') as week_start, im_allocations.note,
+# first_names || ' ' || last_name as allocated_name
+# from im_allocations, im_projects, users, user_groups
+# where users.user_id(+) = im_allocations.user_id
+# and im_projects.group_id = im_allocations.group_id
+# and im_allocations.start_block >= '$start_block'
+# and im_allocations.start_block < '$end_block'
+# and im_allocations.percentage_time > 0
+# and user_groups.group_id = im_projects.group_id
+# $order_by_clause"
+
+
+set sql_query  "select im_projects.group_id, users.user_id, allocation_id, 
+group_name as project_name, percentage_time, start_block as temp_start_block,
+to_char(start_block, 'Mon DD, YYYY') as week_start, im_allocations.note,
+first_names || ' ' || last_name as allocated_name
+from im_allocations, im_projects, users, user_groups
+where users.user_id = im_allocations.user_id
+and im_projects.group_id = im_allocations.group_id
+and im_allocations.start_block >= '$start_block'
+and im_allocations.start_block < '$end_block'
+and im_allocations.percentage_time > 0
+and user_groups.group_id = im_projects.group_id
+union
+select im_projects.group_id, '' as user_id, allocation_id, 
+group_name as project_name, percentage_time, start_block as temp_start_block,
+to_char(start_block, 'Mon DD, YYYY') as week_start, im_allocations.note,
+'' as allocated_name
+from im_allocations, im_projects, user_groups
+where not exists (select 1 from users 
+                  where user_id = im_allocations.user_id)
+and im_projects.group_id = im_allocations.group_id
+and im_allocations.start_block >= '$start_block'
+and im_allocations.start_block < '$end_block'
+and im_allocations.percentage_time > 0
+and user_groups.group_id = im_projects.group_id
+$order_by_clause"
+
+set selection [ns_db select $db $sql_query] 
+
+set counter 0
+
+set allocation_list ""
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    incr counter
+   
+    if { $order_by_last != [set $interface_separation] } {
+	append allocation_list "<tr><td>&nbsp;</td></tr>"
+    }
+    append allocation_list "<tr><td>$week_start</td><td><a href=\"project.tcl?[export_url_vars group_id]\">$project_name</a></td><td><a href=user.tcl?allocation_user_id=$user_id>$allocated_name</a></td><td>$percentage_time % <td><a href=add.tcl?[export_url_vars group_id user_id  percentage_time allocation_id]&start_block=$temp_start_block>edit</a></td><td><font size=-1>$note</font></td></tr>"
+
+    set order_by_last [set $interface_separation]
+
+}
+
+set num_weeks [database_to_tcl_string $db "select count(start_block) from
+im_start_blocks where start_block >= '$start_block'
+and start_block < '$end_block'"]
+
+
+# set sql "
+# select first_names || ' ' || last_name as name, 
+#        coalesce(available_view.percentage_time,0) as percentage,
+#        coalesce(scheduled_view.percentage_time,0) as scheduled_percentage
+#   from im_employee_info, users,
+#          (select sum(percentage_time) as percentage_time, user_id 
+#             from im_employee_percentage_time
+#            where start_block >= '$start_block'
+#              and start_block < '$end_block'
+#            group by user_id) available_view,
+#          (select sum(percentage_time) as percentage_time, user_id 
+#             from im_allocations
+#            where start_block >= '$start_block'
+#              and start_block < '$end_block'
+#            group by user_id) scheduled_view
+#  where im_employee_info.user_id = users.user_id
+#    and im_employee_info.user_id = available_view.user_id (+)
+#    and im_employee_info.user_id = scheduled_view.user_id (+)"
+
+set aview " 
+select sum(percentage_time) as percentage_time, user_id into table available_view
+            from im_employee_percentage_time
+           where start_block >= '$start_block'
+             and start_block < '$end_block'
+           group by user_id"
+
+set sview "
+select sum(percentage_time) as percentage_time, user_id into table scheduled_view
+            from im_allocations
+           where start_block >= '$start_block'
+             and start_block < '$end_block'
+           group by user_id"
+
+
+set sql "
+select first_names || ' ' || last_name as name, 
+       coalesce(available_view.percentage_time,0) as percentage,
+       coalesce(scheduled_view.percentage_time,0) as scheduled_percentage
+  from im_employee_info, users, available_view, scheduled_view
+ where im_employee_info.user_id = users.user_id
+   and im_employee_info.user_id = available_view.user_id
+   and im_employee_info.user_id = scheduled_view.user_id
+union
+select first_names || ' ' || last_name as name, 
+       0 as percentage,
+       coalesce(scheduled_view.percentage_time,0) as scheduled_percentage
+  from im_employee_info, users, scheduled_view
+ where im_employee_info.user_id = users.user_id
+   and not exists (select 1 from available_view 
+                    where user_id = im_employee_info.user_id)
+   and im_employee_info.user_id = scheduled_view.user_id
+union
+select first_names || ' ' || last_name as name, 
+       coalesce(available_view.percentage_time,0) as percentage,
+       0 as scheduled_percentage
+  from im_employee_info, users, available_view
+ where im_employee_info.user_id = users.user_id
+   and im_employee_info.user_id = available_view.user_id
+   and not exists (select 1 from scheduled_view 
+                    where user_id = im_employee_info.user_id)
+union
+select first_names || ' ' || last_name as name, 
+       0 as percentage,
+       0 as scheduled_percentage
+  from im_employee_info, users
+ where im_employee_info.user_id = users.user_id
+   and not exists (select 1 from available_view 
+                    where user_id = im_employee_info.user_id)
+   and not exists (select 1 from scheduled_view 
+                    where user_id = im_employee_info.user_id)"
+
+set over_allocated ""
+set under_allocated ""
+
+ns_db dml $db "begin transaction"
+
+ns_db dml $db $aview
+ns_db dml $db $sview
+
+set selection  [ns_db select $db $sql]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    if {$scheduled_percentage < "$percentage"} {
+	append under_allocated "<li>$name (Scheduled $scheduled_percentage% of $percentage%  available)<br>"
+    }
+    if {$scheduled_percentage > $percentage} {
+	append over_allocated "<li>$name (Scheduled $scheduled_percentage% of $percentage% available)<br>"
+    }
+}
+
+ns_db dml $db "drop table available_view"
+ns_db dml $db "drop table scheduled_view"
+ns_db dml $db "end transaction"
+
+
+if { [empty_string_p $over_allocated] } {
+    set over_allocated "  <li><i>none</i>"
+} 
+if { [empty_string_p $under_allocated] } {
+    set under_allocated "  <li><i>none</i>"
+} 
+
+
+set page_title "Allocations for [util_IllustraDatetoPrettyDate $start_block] to [util_IllustraDatetoPrettyDate  $end_block]"
+set context_bar "[ad_context_bar [list "/" Home] [list "/intranet" "Intranet"] "Project allocations"]"
+
+set page_body "
+<table width=100% cellpadding=5><tr><td>
+<form action=index.tcl method=post>
+Week starting:
+<select name=start_block>
+[im_allocation_date_optionlist $db $start_block]
+</select>
+through week ending:
+<select name=end_block>
+[im_allocation_date_optionlist $db $end_block]
+</select>
+
+<input type=submit name=submit value=Go>
+</form>
+</td><td align=right valign=top>[ad_partner_default_font "size=-1"]
+<a href=../projects/index.tcl?[export_ns_set_vars]>Summary view</a> |
+<a href=../projects/money.tcl?[export_ns_set_vars]>Financial view</a> 
+</font></table>
+<p>
+
+<h3>Summary</h3>
+<table cellpadding=2 cellspacing=2 border=1>
+<tr bgcolor=\"[ad_parameter TableColorHeader intranet white]\">
+  <th>Week of</th>
+  <th>Note</th>
+  <th>Available staff</th>
+  <th>Scheduled staff</th>
+</tr>
+$summary_text
+</table>
+
+<p>
+"
+
+
+if { [empty_string_p $allocation_list] } {
+    append page_body "<b>There are no allocations in the database right now.</b><p>\n"
+} else {
+    append page_body "
+
+<table cellpadding=5>
+<tr><th>Week Starting</th>
+<th><a href=index.tcl?[export_ns_set_vars url order_by]&order_by_var=group_id>Project</a></th>
+<th><a href=index.tcl?[export_ns_set_vars url order_by]&order_by_var=last_name>Employee</a></th>
+<th><a href=index.tcl?[export_ns_set_vars url oder_by]&order_by_var=percentage_time>% of full</a></th><th>Edit</td><th>Note</td></tr>
+$allocation_list
+</table>
+"
+}
+
+append page_body "
+<h3>Allocation problems</h3>
+[ad_partner_default_font]<b>Under allocated</b></font><br>
+<ul>
+$under_allocated
+</ul>
+[ad_partner_default_font]<b>Over allocated</b></font><br>
+<ul>
+$over_allocated
+</ul>
+
+<p>
+<a href=\"add.tcl?[export_url_vars start_block]\">Add an allocation</a></ul><p>
+
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/allocations/note-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/allocations/note-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/allocations/note-edit-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,10 @@
+# note-edit-2.tcl,v 1.1.2.1 2000/02/03 09:55:54 ron Exp
+set_the_usual_form_variables 
+
+#  allocation_note_start_block, start_block, end_block, note
+
+set db [ns_db gethandle]
+ns_db dml $db "update im_start_blocks set note='$QQnote'
+where start_block= '$allocation_note_start_block'"
+
+ns_returnredirect "index.tcl?[export_url_vars start_block end_block]"
Index: web/openacs/www/intranet/allocations/note-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/allocations/note-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/allocations/note-edit.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,28 @@
+# note-edit.tcl,v 1.2.2.1 2000/02/03 09:55:55 ron Exp
+set_the_usual_form_variables 
+
+# allocation_note_start_block
+# maybe start_block, end_note
+
+set db [ns_db gethandle]
+set note [database_to_tcl_string $db "select note from im_start_blocks
+where start_block = '$allocation_note_start_block'"]
+
+set page_title  "Edit note for $allocation_note_start_block"
+set context_bar "[ad_context_bar [list "/" Home] [list "../index.tcl" "Intranet"] [list "index.tcl" "Project allocations"] "Edit note"]"
+  
+ns_return 200 text/html " 
+[ad_partner_header]
+<form action=note-edit-2.tcl method=post>
+[export_form_vars start_block end_block allocation_note_start_block]
+<table>
+<th valign=top>Note:</th> 
+<td><textarea name=note cols=50 rows=5>[ns_quotehtml $note]</textarea></td>
+</tr>
+</table>
+<center>
+<input type=submit name=submit value=Submit>
+</center>
+</form>
+<p>
+[ad_partner_footer]"
Index: web/openacs/www/intranet/allocations/project.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/allocations/project.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/allocations/project.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,145 @@
+# project.tcl,v 1.2.2.1 2000/02/03 09:55:57 ron Exp
+set_the_usual_form_variables 
+
+# group_id, maybe order_by_var
+
+validate_integer group_id $group_id
+
+set db [ns_db gethandle]
+
+#lappend where_clauses "users.user_id(+) = im_allocations.user_id"
+#lappend where_clauses "im_projects.group_id = im_allocations.group_id"
+#lappend where_clauses "im_allocations.group_id = '$group_id'"
+#lappend where_clauses "im_allocations.percentage_time > 0"
+
+
+if {![info exists order_by_var] || [empty_string_p $order_by_var]}  {
+    set order_by_var "start_block"
+}
+
+set order_by_clause "order by $order_by_var"
+set order_by_last ""
+
+
+if {$order_by_var == "group_id"} { 
+   set interface_separation "project_name"
+} else {
+   set interface_separation "start_block"
+}
+
+
+# take the most recent allocation for this user for this start_block
+              
+# set sql_query  "select im_projects.group_id, users.user_id, allocation_id, 
+# group_name as project_name, percentage_time, start_block,
+# to_char(start_block, 'Mon DD, YYYY') as week_start, im_allocations.note,
+# first_names || ' ' || last_name as allocated_name
+# from im_allocations, im_projects, users, user_groups
+# where users.user_id(+) = im_allocations.user_id
+# and im_projects.group_id = im_allocations.group_id
+# and im_allocations.group_id = '$group_id'
+# and im_allocations.percentage_time > 0
+# and user_groups.group_id = im_projects.group_id
+# $order_by_clause"
+
+set sql_query  "select im_projects.group_id, users.user_id, allocation_id, 
+group_name as project_name, percentage_time, to_char(start_block,'YYYY-MM-DD') as start_block,
+to_char(start_block, 'Mon DD, YYYY') as week_start, im_allocations.note,
+first_names || ' ' || last_name as allocated_name
+from im_allocations, im_projects, users, user_groups
+where users.user_id = im_allocations.user_id
+and im_projects.group_id = im_allocations.group_id
+and im_allocations.group_id = '$group_id'
+and im_allocations.percentage_time > 0
+and user_groups.group_id = im_projects.group_id
+union
+select im_projects.group_id, '' as user_id, allocation_id, 
+group_name as project_name, percentage_time, to_char(start_block,'YYYY-MM-DD') as start_block,
+to_char(start_block, 'Mon DD, YYYY') as week_start, im_allocations.note,
+'' as allocated_name
+from im_allocations, im_projects, user_groups
+where not exists (select 1 from users where user_id = im_allocations.user_id)
+and im_projects.group_id = im_allocations.group_id
+and im_allocations.group_id = '$group_id'
+and im_allocations.percentage_time > 0
+and user_groups.group_id = im_projects.group_id
+$order_by_clause"
+
+set selection [ns_db select $db $sql_query] 
+
+set counter 0
+
+set return_url [ad_partner_url_with_query]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    incr counter
+   
+#    if { $order_by_last != [set $interface_separation] } {
+#	append allocation_list "<tr><td>&nbsp;</td></tr>"
+#    }
+    append allocation_list "
+<tr>
+  <td>$week_start</td>
+  <td><a href=\"user.tcl?allocation_user_id=$user_id\">$allocated_name</a></td>
+  <td>$percentage_time % <td><a href=add.tcl?[export_url_vars group_id user_id start_block percentage_time allocation_id return_url]>edit</a></td>
+  <td><font size=-1>$note</font></td>
+</tr>
+"
+
+    set order_by_last [set $interface_separation]
+
+}
+
+if { $counter == 0 } {
+    append allocation_list "<br>
+    There are no allocations in the database right now.<p>"
+
+    set project_name [database_to_tcl_string $db "select
+    group_name from user_groups where group_id=$group_id"]
+    
+    #get the start block too!
+    set start_block [database_to_tcl_string $db "select 
+    to_char(get_start_week(im_projects.start_date),'YYYY-MM-DD') as start_block
+    from im_projects where group_id = $group_id"]
+}
+
+# set sql "select 
+# first_names || ' ' || last_name as name, im_employee_info.percentage, sum(im_allocations.percentage_time) as scheduled_percentage
+# from im_employee_info, users, im_allocations, im_projects
+# where im_employee_info.user_id = users.user_id
+# and im_allocations.user_id = users.user_id
+# and users.user_id(+) = im_allocations.user_id
+# and im_projects.group_id = im_allocations.group_id
+# and im_allocations.group_id = '$group_id'
+# and im_allocations.percentage_time > 0
+# group by im_employee_info.user_id, first_names, last_name, im_employee_info.percentage"
+
+set sql "select 
+first_names || ' ' || last_name as name, im_employee_info.percentage, sum(im_allocations.percentage_time) as scheduled_percentage
+from im_employee_info, users, im_allocations, im_projects
+where im_employee_info.user_id = users.user_id
+and im_allocations.user_id = users.user_id
+and im_projects.group_id = im_allocations.group_id
+and im_allocations.group_id = '$group_id'
+and im_allocations.percentage_time > 0
+group by im_employee_info.user_id, first_names, last_name, im_employee_info.percentage"
+
+set selection  [ns_db select $db $sql]
+
+
+set page_title "Allocations for $project_name"
+set context_bar "[ad_context_bar [list "/" Home] [list "/intranet" "Intranet"] [list "index.tcl" "Project allocations"] "One project"]"
+
+ns_return 200 text/html "
+[ad_partner_header]
+
+<table cellpadding=5>
+<tr><th>Week Starting</th>
+<th><a href=project.tcl?[export_ns_set_vars url order_by]&order_by_var=group_id>Employee</a></th>
+<th><a href=project.tcl?[export_ns_set_vars url oder_by]&order_by_var=percentage_time>% of full</a></th><th>Edit</td><th>Note</td></tr>
+$allocation_list
+</table>
+<p>
+<a href=\"add.tcl?[export_url_vars start_block group_id]\">Add an allocation</a></ul><p>
+[ad_partner_footer]"
Index: web/openacs/www/intranet/allocations/user.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/allocations/user.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/allocations/user.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,81 @@
+# user.tcl,v 1.2.2.1 2000/02/03 09:55:58 ron Exp
+set_the_usual_form_variables 
+
+# allocation_user_id, maybe order_by_var
+
+validate_integer allocation_user_id $allocation_user_id
+
+set db [ns_db gethandle]
+
+set allocated_name [database_to_tcl_string $db "select first_names || ' ' || last_name as allocated_name from users where user_id = $allocation_user_id"]
+
+
+set where_clauses [list]
+
+lappend where_clauses "im_projects.group_id = im_allocations.group_id"
+lappend where_clauses "im_allocations.user_id = '$allocation_user_id'"
+lappend where_clauses "im_allocations.percentage_time > 0"
+
+
+if {![info exists order_by_var] || [empty_string_p $order_by_var]}  {
+    set order_by_var "start_block"
+}
+
+set order_by_clause "order by $order_by_var"
+set order_by_last ""
+
+
+if {$order_by_var == "group_id"} { 
+   set interface_separation "project_name"
+} else {
+   set interface_separation "start_block"
+}
+
+
+
+set sql_query  "select im_projects.group_id, im_allocations.user_id, allocation_id, 
+group_name as project_name, percentage_time, start_block,
+to_char(start_block, 'Mon DD, YYYY') as week_start, im_allocations.note
+from im_allocations, im_projects, user_groups
+where [join $where_clauses " and "]
+and user_groups.group_id = im_projects.group_id
+$order_by_clause"
+
+set selection [ns_db select $db $sql_query] 
+
+set counter 0
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    incr counter
+   
+    if { $order_by_last != [set $interface_separation] } {
+	append allocation_list "<tr><td>&nbsp;</td></tr>"
+    }
+
+    append allocation_list "<tr><td>$week_start</td><td><a href=\"project.tcl?[export_url_vars group_id]\">$project_name</a></td><td>$percentage_time % <td><a href=add.tcl?[export_url_vars group_id user_id start_block percentage_time allocation_id note]&return_url=[ns_urlencode [ns_conn url]?[ns_conn query]]>edit</a></td><td><font size=-1>$note</font></td></tr>"
+
+    set order_by_last [set $interface_separation]
+
+}
+
+if { $counter == 0 } {
+    append allocation_list "<br>
+There are no allocations in the database right now.<p>"
+}
+
+set page_title "Allocations for $allocated_name"
+set context_bar "[ad_context_bar [list "/" Home] [list "/intranet" "Intranet"] [list "index.tcl" "Project allocations"] "One employee"]"
+
+ns_return 200 text/html " 
+[ad_partner_header]
+
+<table>
+<tr><th>Week Starting</th>
+<th><a href=user.tcl?[export_ns_set_vars url order_by]&order_by_var=group_id>Project</a></th>
+<th><a href=user.tcl?[export_ns_set_vars url oder_by]&order_by_var=percentage_time>% of full</a></th><th>Edit</td><th>Note</td></tr>
+$allocation_list
+</table>
+<p>
+<a href=\"add.tcl?[export_url_vars allocation_user_id start_block]&return_url=[ns_urlencode [ns_conn url]?[ns_conn query]]\">Add an allocation</a></ul><p>
+[ad_partner_footer]"
Index: web/openacs/www/intranet/customers/ae-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/customers/ae-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/customers/ae-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,91 @@
+# ae-2.tcl,v 3.2.2.1 2000/03/17 08:22:51 mbryzek Exp
+# File: /www/intranet/customers/ae-2.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Writes all the customer information to the db. 
+# 
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_form_variables
+# Bunch of stuff for dp
+
+validate_integer group_id $group_id
+
+set required_vars [list \
+	[list "dp_ug.user_groups.group_name" "You must specify the customer's name"]]
+
+set errors [im_verify_form_variables $required_vars]
+
+set exception_count 0
+if { ![empty_string_p $errors] } {
+    incr exception_count
+}
+
+set db [ns_db gethandle]
+
+# Make sure customer name is unique
+set exists_p [database_to_tcl_string $db \
+	"select (case when count(1) = 0 then 0 else 1 end) 
+           from user_groups 
+          where lower(trim(short_name))=lower(trim('[DoubleApos ${dp_ug.user_groups.short_name}]'))
+            and group_id != $group_id"]
+
+if { $exists_p } {
+    incr exception_count
+    append errors "  <li> The specified customer short name already exists. Either choose a new name or go back to the customer's page to edit the existing record\n"
+}
+
+if { ![empty_string_p $errors] } {
+    ad_return_complaint $exception_count "<ul>$errors</ul>"
+    return
+}
+
+set form_setid [ns_getform]
+
+# Create/update the user group frst since projects reference it
+# Note: group_name, creation_user, creation_date are all set in ae.tcl
+ns_set put $form_setid "dp_ug.user_groups.group_id" $group_id
+ns_set put $form_setid "dp_ug.user_groups.group_type" [ad_parameter IntranetGroupType intranet]
+ns_set put $form_setid "dp_ug.user_groups.approved_p" "t"
+ns_set put $form_setid "dp_ug.user_groups.new_member_policy" "closed"
+ns_set put $form_setid "dp_ug.user_groups.parent_group_id" [im_customer_group_id]
+
+# Log the modification date
+ns_set put $form_setid "dp_ug.user_groups.modification_date.expr" "sysdate()"
+ns_set put $form_setid "dp_ug.user_groups.modifying_user" $user_id
+
+# Put the group_id into projects
+ns_set put $form_setid "dp.im_customers.group_id" $group_id
+
+# Log the change in state if necessary
+set old_status_id [database_to_tcl_string_or_null $db \
+	"select customer_status_id from im_customers where group_id=$group_id"]
+if { ![empty_string_p $old_status_id] && $old_status_id != ${dp.im_customers.customer_status_id} } {
+    ns_set put $form_setid "dp.im_customers.old_customer_status_id" $old_status_id
+    ns_set put $form_setid "dp.im_customers.status_modification_date.expr" "sysdate()"
+}
+
+
+with_transaction $db {
+
+    # Update user_groups
+    dp_process -db $db -form_index "_ug" -where_clause "group_id=$group_id" 
+
+    # Now update im_projects
+    dp_process -db $db -where_clause "group_id=$group_id"
+} { ns_log Error "transaction failed" }
+
+
+if { ![exists_and_not_null return_url] } {
+    set return_url [im_url_stub]/customers/view.tcl?[export_url_vars group_id]
+}
+
+if { [exists_and_not_null dp_ug.user_groups.creation_user] } {
+    # add the creating current user to the group
+    ns_returnredirect "/groups/member-add-3.tcl?[export_url_vars group_id return_url]&user_id_from_search=$user_id&role=administrator"
+} else {
+    ns_returnredirect $return_url
+}
Index: web/openacs/www/intranet/customers/ae.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/customers/ae.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/customers/ae.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,63 @@
+# ae.tcl,v 3.1.4.1 2000/03/17 08:22:51 mbryzek Exp
+# File: /www/intranet/customers/ae.tcl
+# 
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Lets users add/modify information about our customers
+# 
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_form_variables 0
+# group_id (if we're editing)
+# return_url (optional)
+
+set db [ns_db gethandle]
+if { [exists_and_not_null group_id] } {
+    validate_integer group_id $group_id
+
+    set selection [ns_db 1row $db \
+	    "select g.group_name, c.customer_status_id, c.note, g.short_name
+               from im_customers c, user_groups g
+              where c.group_id=$group_id
+                and c.group_id=g.group_id"]
+    set_variables_after_query
+    set page_title "Edit customer"
+    set context_bar [ad_context_bar [list "/" Home] [list "../" "Intranet"] [list index.tcl "Customers"] [list "view.tcl?[export_url_vars group_id]" "One customer"] $page_title]
+
+} else {
+    set page_title "Add customer"
+    set context_bar [ad_context_bar [list "/" Home] [list "../" "Intranet"] [list index.tcl "Customers"] $page_title]
+    
+    set note ""
+    set customer_status_id ""
+    set "dp_ug.user_groups.creation_ip_address" [ns_conn peeraddr]
+    set "dp_ug.user_groups.creation_user" $user_id
+
+    set group_id [database_to_tcl_string $db "select user_group_sequence.nextval from dual"]
+}
+
+set page_body "
+<form method=post action=ae-2.tcl>
+[export_form_vars return_url group_id dp_ug.user_groups.creation_ip_address dp_ug.user_groups.creation_user]
+
+[im_format_number 1] Customer name: 
+<br><dd><input type=text size=45 name=dp_ug.user_groups.group_name [export_form_value group_name]>
+
+<p>[im_format_number 2] Customer short name:
+<br><dd><input type=text size=45 name=dp_ug.user_groups.short_name [export_form_value short_name]>
+
+<p>[im_format_number 3] Status:
+[im_customer_status_select $db "dp.im_customers.customer_status_id" $customer_status_id]
+
+<p>[im_format_number 4] Notes:
+<br><dd><textarea name=dp.im_customers.note rows=6 cols=45 wrap=soft>[philg_quote_double_quotes $note]</textarea>
+ 
+<p><center><input type=submit value=\"$page_title\"></center>
+</form>
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html [ad_partner_return_template]
\ No newline at end of file
Index: web/openacs/www/intranet/customers/bboard-ae-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/customers/bboard-ae-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/customers/bboard-ae-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,11 @@
+# bboard-ae-2.tcl,v 3.1.4.1 2000/03/17 08:22:51 mbryzek Exp
+#
+# File: /www/intranet/customers/bboard-ae-2.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Once bboard is scoped, this page will allow us to easily link 
+# customers with their own bboards
+# 
+
+source "[ns_info pageroot]/admin/bboard/add-new-topic-2.tcl"
Index: web/openacs/www/intranet/customers/bboard-ae.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/customers/bboard-ae.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/customers/bboard-ae.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,132 @@
+# bboard-ae.tcl,v 3.1.4.2 2000/03/17 08:56:32 mbryzek Exp
+#
+# File: /www/intranet/customers/bboard-ae.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Once bboard is scoped, this page will allow us to easily link 
+# customers with their own bboards
+
+
+set_form_variables 0
+
+# group_id
+# topic_id if we're editing
+
+validate_integer group_id $group_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if { [exists_and_not_null topic_id] } {
+    set selection [ns_db 1row $db \
+	    "select * from bboard_topics where topic_id=$topic_id"]
+    set_variables_after_query
+    set page_title "Edit BBoard Topic"
+} else {
+    set selection [ns_db 1row $db \
+	    "select * from user_groups where group_id=$group_id"]
+    set_variables_after_query
+    set topic $group_name
+    set page_title "Add BBoard Topic"
+}
+
+set context_bar [ad_context_bar [list "/" Home] [list ../index.tcl "Intranet"] [list index.tcl "Customers"] [list "view.tcl?[export_url_vars group_id]" "One customer"] [list "staff-server.tcl?[export_url_vars group_id]" "Staff server"] $page_title]
+
+set page_body "
+[ad_partner_header]
+<form action=\"/user-search.tcl\" method=get>
+[export_form_vars group_id]
+<input type=hidden name=target value=\"[im_url_stub]/customers/bboard-ae-2.tcl\">
+<input type=hidden name=passthrough value=\"topic group_id presentation_type moderation_policy iehelper_notify_of_new_postings_p\">
+<input type=hidden name=custom_title value=\"Choose a Member to Add as an Administrator\">
+
+<h3>The Most Important Things</h3>
+
+What do you want to call your forum?  The topic name that you choose
+will appear in the alphabetical listing on the [bboard_system_name]
+home page.  It will appear on pages visible to users.  It will appear
+in URLs.  If you want to let other people link directly to your forum,
+they'll need to include this.  So it is probably best to pick some
+short and descriptive, e.g., \"darkroom technique\".  The software
+adds words like \"Q&A\" and \"forum\" so don't include those in your
+topic name.
+
+<P>
+
+New Topic Name:  <input type=text name=topic [export_form_value topic] size=30>
+
+<P>
+<h3>Maintainer</h3>
+<p>
+Search for a user to be primary administrator of this domain by<br>
+<table border=0>
+<tr><td>Email address:<td><input type=text name=email size=40></tr>
+<tr><td colspan=2>or by</tr>
+<tr><td>Last name:<td><input type=text name=last_name size=40></tr>
+</table>
+<p>
+
+<h3>How this BBoard is presented to users</h3>
+
+You have to choose whether or not this is primarily a Q&A
+forum or a threads-based discussion group.  The user interfaces
+interoperate, i.e., a posting made a user in the Q&A interface will be
+seen in the threads interface and vice versa.  But my software still
+needs to know whether this is primarily threads or Q&A.  For example,
+if a user signs up for email alerts, this program will send out email
+saying \"come back to the forum at http://...\".  The \"come back
+URL\" is different for Q&A and threads.
+
+<ul>
+<li><input type=radio name=presentation_type value=threads> threads - classical USENET style 
+<li><input type=radio name=presentation_type value=q_and_a CHECKED> Q&A - questions and all answers appear on one page, use for discussion groups that tend to have short messages/responses
+<li><input type=radio name=presentation_type value=ed_com> Editorial - question and answers appear on separate pages,  answers are collasped by subject line as a default, use for discussion groups that tend to have longer messages/responses 
+</ul>
+
+<p>
+
+<br>
+
+(note: I personally greatly prefer the Q&A interface; if people liked
+threads, they'd have stuck with USENET.)
+
+<h3>Moderation Type</h3>
+
+What moderation category does this fall under?
+<select name=moderation_policy>"
+
+set optionlist [bboard_moderation_policy_order]
+
+append page_body "
+[ad_generic_optionlist $optionlist $optionlist]
+</select>
+
+<h3>Notification</h3>
+
+If your forum is inactive, you'll probably want this system to send
+the primary maintainer email every time someone adds a posting of any kind (new top-level
+question or reply).  If you're getting 50 new postings/day then you'll
+probably want to disable this feature
+
+<p>
+
+Notify me of all new postings?
+<input type=radio name=iehelper_notify_of_new_postings_p value=t CHECKED> Yes <input type=radio name=iehelper_notify_of_new_postings_p value=f> No
+
+<p>
+<center>
+
+<input type=submit value=\"Enter This New Topic in the Database\">
+
+</form>
+
+</center>
+
+[ad_admin_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $page_body
\ No newline at end of file
Index: web/openacs/www/intranet/customers/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/customers/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/customers/index.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,232 @@
+# index.tcl,v 3.2.2.1 2000/03/17 08:22:52 mbryzek Exp
+# File: /www/intranet/customers/index.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Shows all customers. Lots of dimensional sliders
+# 
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_form_variables 0
+# optional: status_id
+
+if { ![exists_and_not_null status_id] } {
+    # Default status is Current - select the id once and memoize it
+    set status_id [ad_partner_memoize_one \
+	    "select customer_status_id 
+               from im_customer_status
+              where upper(customer_status) = 'CURRENT'" customer_status_id]
+} else {
+    validate_integer status_id $status_id
+}
+
+if { ![exists_and_not_null order_by] } {
+    set order_by "Customer"
+}
+
+if { ![exists_and_not_null mine_p] } {
+    set mine_p "t"
+}
+set view_types [list "t" "Mine" "f" "All"]
+
+
+# status_types will be a list of pairs of (project_status_id, project_status)
+set status_types [ad_partner_memoize_list_from_db \
+	"select customer_status_id, customer_status
+           from im_customer_status
+          order by display_order, lower(customer_status)" [list customer_status_id customer_status]]
+lappend status_types 0 All
+
+# Now let's generate the sql query
+set criteria [list]
+
+if { ![empty_string_p $status_id] && $status_id != 0 } {
+    lappend criteria "c.customer_status_id=$status_id"
+}
+
+set extra_tables [list]
+if { [string compare $mine_p "t"] == 0 } {
+    lappend criteria "ad_group_member_p ( $user_id, g.group_id ) = 't'"
+}
+
+set order_by_clause ""
+switch $order_by {
+    "Phone" { set order_by_clause "order by upper(work_phone), upper(group_name)" }
+    "Email" { set order_by_clause "order by upper(email), upper(group_name)" }
+    "Status" { set order_by_clause "order by upper(customer_status), upper(group_name)" }
+    "Contact Person" { set order_by_clause "order by upper(last_name), upper(first_names), upper(group_name)" }
+    "Customer" { set order_by_clause "order by upper(group_name)" }
+}
+
+set extra_table ""
+if { [llength $extra_tables] > 0 } {
+    set extra_table ", [join $extra_tables ","]"
+}
+
+set where_clause [join $criteria " and\n            "]
+if { ![empty_string_p $where_clause] } {
+    set where_clause " and $where_clause"
+}
+
+set page_title "Customers"
+set context_bar [ad_context_bar [list "/" Home] [list ../index.tcl "Intranet"] $page_title]
+
+
+# set sql "\
+# select c.group_id as customer_id, g.group_name, c.primary_contact_id, status.customer_status,
+#                 u.last_name||', '||u.first_names as name, u.email, uc.work_phone
+#            from user_groups g, im_customers c, im_customer_status status, users u, users_contact uc$extra_table
+#           where c.group_id = g.group_id
+#             and c.primary_contact_id=u.user_id(+)
+#             and c.primary_contact_id=uc.user_id(+)
+#             and c.customer_status_id=status.customer_status_id $where_clause $order_by_clause"
+
+
+set sql "\
+select c.group_id as customer_id, 
+       g.group_name, 
+       c.primary_contact_id, 
+       status.customer_status,
+       a.last_name || ', ' || a.first_names as name, 
+       a.email, 
+       uc.work_phone
+from user_groups g, 
+     im_customers c, 
+     im_customer_status status, 
+     address_book a, 
+     users_contact uc$extra_table
+where c.group_id = g.group_id
+  and c.primary_contact_id=a.address_book_id
+  and c.primary_contact_id=uc.user_id
+  and c.customer_status_id=status.customer_status_id 
+$where_clause
+union
+select c.group_id as customer_id, 
+       g.group_name, 
+       c.primary_contact_id, 
+       status.customer_status,
+       '' as name, 
+       '' as email, 
+       uc.work_phone
+from user_groups g, 
+     im_customers c, 
+     im_customer_status status,
+     users_contact uc$extra_table
+where c.group_id = g.group_id
+  and not exists (select user_id from users 
+                   where c.primary_contact_id = user_id)
+  and c.primary_contact_id = uc.user_id
+  and c.customer_status_id=status.customer_status_id 
+$where_clause
+union
+select c.group_id as customer_id, 
+       g.group_name, 
+       c.primary_contact_id, 
+       status.customer_status,
+       a.last_name || ', ' || a.first_names as name, 
+       a.email, 
+       '' as work_phone
+from user_groups g, 
+     im_customers c, 
+     im_customer_status status, 
+     address_book a$extra_table
+where c.group_id = g.group_id
+  and c.primary_contact_id = a.address_book_id
+  and not exists (select user_id from users_contact where 
+                  c.primary_contact_id = user_id)
+  and c.customer_status_id=status.customer_status_id 
+$where_clause
+union
+select c.group_id as customer_id, 
+       g.group_name, 
+       c.primary_contact_id, 
+       status.customer_status,
+       '' as name, 
+       '' as email, 
+       '' as work_phone
+from user_groups g, 
+     im_customers c, 
+     im_customer_status status$extra_table
+where c.group_id = g.group_id
+  and not exists (select user_id from users 
+                   where c.primary_contact_id = user_id)
+  and not exists (select user_id from users_contact where 
+                  c.primary_contact_id = user_id)
+  and c.customer_status_id=status.customer_status_id 
+$where_clause
+$order_by_clause"
+
+set db [ns_db gethandle]
+set selection [ns_db select $db $sql]
+            
+
+set results ""
+set bgcolor(0) " bgcolor=\"[ad_parameter TableColorOdd Intranet white]\""
+set bgcolor(1) " bgcolor=\"[ad_parameter TableColorEven Intranet white]\""
+set ctr 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append results "
+<tr$bgcolor([expr $ctr % 2])>
+  <td valign=top>[ad_partner_default_font]<a href=view.tcl?group_id=$customer_id>$group_name</a></font></td>
+  <td valign=top>[ad_partner_default_font]$customer_status</font></td>
+  <td valign=top>[ad_partner_default_font][util_decode $name ", " "&nbsp;" $name]</font></td>
+  <td valign=top>[ad_partner_default_font][util_decode $email "" "&nbsp;" "<a href=mailto:$email>$email</a>"]</font></td>
+  <td valign=top>[ad_partner_default_font][util_decode $work_phone "" "&nbsp;" $work_phone]</font></td>
+</tr>
+"
+    incr ctr
+}
+
+
+if { [empty_string_p $results] } {
+    set results "<ul><li><b> There are currently no customers</b></ul>\n"
+} else {
+    set column_headers [list Customer Status "Contact Person" Email Phone]
+    set url "index.tcl"
+    set query_string [export_ns_set_vars url [list order_by]]
+    if { [empty_string_p $query_string] } {
+	append url "?"
+    } else {
+	append url "?$query_string&"
+    }
+    set table "
+<table width=100% cellpadding=1 cellspacing=2 border=0>
+<tr bgcolor=\"[ad_parameter TableColorHeader intranet white]\">
+"
+    foreach col $column_headers {
+	if { [string compare $order_by $col] == 0 } {
+	    append table "  <th>$col</th>\n"
+	} else {
+	    append table "  <th><a href=\"${url}order_by=[ns_urlencode $col]\">$col</a></th>\n"
+	}
+    }
+    set results "
+<br>
+$table
+</tr>
+$results
+</table>
+"
+}
+
+
+
+
+set page_body "
+[ad_partner_default_font "size=-1"]
+Customer status: [im_slider status_id $status_types]
+<br>View: [im_slider mine_p $view_types]
+</font>
+<p>
+$results
+
+<p><a href=ae.tcl>Add a customer</a>
+"
+
+ns_db releasehandle $db
+
+ 
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/customers/primary-contact-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/customers/primary-contact-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/customers/primary-contact-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,28 @@
+# primary-contact-2.tcl,v 3.1.4.1 2000/03/17 08:22:52 mbryzek Exp
+# File: /www/intranet/customers/primary-contact-2.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Writes customer's primary contact to the db
+# 
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_form_variables
+# group_id, address_book_id
+
+validate_integer group_id $group_id
+validate_integer address_book_id $address_book_id
+
+set db [ns_db gethandle]
+
+ns_db dml $db \
+	"update im_customers 
+            set primary_contact_id=$address_book_id
+          where group_id=$group_id"
+
+ns_db releasehandle $db
+
+
+ns_returnredirect view.tcl?[export_url_vars group_id]
\ No newline at end of file
Index: web/openacs/www/intranet/customers/primary-contact-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/customers/primary-contact-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/customers/primary-contact-delete.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,27 @@
+# primary-contact-delete.tcl,v 3.0.4.1 2000/03/17 08:22:53 mbryzek Exp
+# File: /www/intranet/customers/primary-contact-delete.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Removes customer's primary contact
+# 
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_form_variables
+# group_id, return_url
+
+validate_integer group_id $group_id
+
+set db [ns_db gethandle]
+
+ns_db dml $db \
+	"update im_customers
+            set primary_contact_id=null
+          where group_id=$group_id"
+
+ns_db releasehandle $db
+
+
+ns_returnredirect $return_url
\ No newline at end of file
Index: web/openacs/www/intranet/customers/primary-contact-users-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/customers/primary-contact-users-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/customers/primary-contact-users-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,32 @@
+# primary-contact-users-2.tcl,v 3.1.4.1 2000/03/17 08:22:53 mbryzek Exp
+#
+# File: /www/intranet/customers/primary-contact-users-2.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Allows you to have a primary contact that references the
+# users table. We don't use this yet, but it will indeed
+# be good once all customers are in the users table
+
+
+set user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+set_form_variables
+# group_id, user_id_from_search
+
+validate_integer group_id $group_id
+validate_integer user_id_from_search $user_id_from_search
+
+set db [ns_db gethandle]
+
+ns_db dml $db \
+	"update im_customers 
+            set primary_contact_id=$user_id_from_search
+          where group_id=$group_id"
+
+ns_db releasehandle $db
+
+
+ns_returnredirect view.tcl?[export_url_vars group_id]
\ No newline at end of file
Index: web/openacs/www/intranet/customers/primary-contact-users.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/customers/primary-contact-users.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/customers/primary-contact-users.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,61 @@
+# primary-contact-users.tcl,v 3.1.4.1 2000/03/17 08:22:53 mbryzek Exp
+#
+# File: /www/intranet/customers/primary-contact-users.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Allows you to have a primary contact that references the
+# users table. We don't use this yet, but it will indeed
+# be good once all customers are in the users table
+
+
+set user_id [ad_verify_and_get_user_id]
+
+ad_maybe_redirect_for_registration
+
+set_form_variables
+# group_id
+
+validate_integer group_id $group_id
+
+# Avoid hardcoding the url stub
+set target [ns_conn url]
+regsub {primary-contact.tcl} $target {primary-contact-2.tcl} target
+
+set db [ns_db gethandle]
+
+set customer_name [database_to_tcl_string $db \
+	"select g.group_name
+           from im_customers c, user_groups g
+          where c.group_id = $group_id
+            and c.group_id=g.group_id"]
+
+ns_db releasehandle $db
+
+set page_title "Select primary contact for $customer_name"
+set context_bar [ad_context_bar [list "/" Home] [list "../" "Intranet"] [list index.tcl "Customers"] [list view.tcl?[export_url_vars group_id] "One customer"] "Select contact"]
+
+set page_body "
+
+Locate your new primary contact by
+
+<form method=get action=/user-search.tcl>
+[export_form_vars group_id target limit_to_users_in_group_id]
+<input type=hidden name=passthrough value=group_id>
+
+<table border=0>
+<tr><td>Email address:<td><input type=text name=email size=40></tr>
+<tr><td colspan=2>or by</tr>
+<tr><td>Last name:<td><input type=text name=last_name size=40></tr>
+</table>
+
+<p>
+
+<center>
+<input type=submit value=Search>
+</center>
+</form>
+
+"
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/customers/primary-contact.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/customers/primary-contact.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/customers/primary-contact.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,57 @@
+# primary-contact.tcl,v 3.1.4.1 2000/03/17 08:22:54 mbryzek Exp
+# File: /www/intranet/customers/primary-contact.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Lets you select a primary contact from the group's address book
+#
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_form_variables
+# group_id
+
+validate_integer group_id $group_id
+
+set db [ns_db gethandle]
+
+set customer_name [database_to_tcl_string $db \
+	"select g.group_name
+           from im_customers c, user_groups g
+          where c.group_id = $group_id
+            and c.group_id=g.group_id"]
+
+set contact_info ""
+set selection [ns_db select $db \
+	"select * 
+           from address_book 
+          where group_id=$group_id
+       order by lower(last_name)"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append contact_info "<p><li>[address_book_record_display $selection "f"]</a><br>(<a href=primary-contact-2.tcl?[export_url_vars group_id address_book_id]>make primary contact</a>) \n"
+    
+} 
+
+ns_db releasehandle $db
+
+set return_url "[im_url_stub]/customers.tcl?[export_url_vars group_id]"
+
+if { [empty_string_p $contact_info] } {
+    ad_return_error "No contacts listed" "Before you can select a primary contact, you must <a href=/address-book/record-add.tcl?scope=group&[export_url_vars group_id return_url]>add at least 1 person to the address book</a>"
+    return
+}
+
+set page_title "Select primary contact for $customer_name"
+set context_bar [ad_context_bar [list "/" Home] [list "../" "Intranet"] [list index.tcl "Customers"] [list view.tcl?[export_url_vars group_id] "One customer"] "Select contact"]
+
+set page_body "
+<ul>
+$contact_info
+</ul>
+"
+
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/customers/view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/customers/view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/customers/view.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,278 @@
+# view.tcl,v 3.2.2.2 2000/03/17 08:22:54 mbryzek Exp
+# File: /www/intranet/customers/view.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# View all info regarding one customer
+#
+
+set current_user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_form_variables
+# group_id
+
+validate_integer group_id $group_id
+
+set return_url [ad_partner_url_with_query]
+
+set db [ns_db gethandle]
+
+# Admins and Employees can administer customers
+set user_admin_p [im_is_user_site_wide_or_intranet_admin $db $current_user_id]
+if { $user_admin_p == 0 } {
+    set user_admin_p [im_user_is_employee_p $db $current_user_id]
+}
+
+# set user_admin_p [im_can_user_administer_group $db $group_id $current_user_id]
+
+if { ! $user_admin_p } {
+    # We let employees have full administrative control
+    set user_admin_p [im_user_is_employee_p $db $current_user_id]
+}
+
+if { $user_admin_p > 0 } {
+    # Set up all the admin stuff here in an array
+    set admin(projects) "  <p><li><a href=../projects/ae.tcl?customer_id=$group_id>Add a project</a>"
+    set admin(basic_info) "  <p><li> <a href=ae.tcl?[export_url_vars group_id return_url]>Edit this information</a>"
+    set admin(contact_info) "<p><li><a href=/address-book/record-add.tcl?scope=group&[export_url_vars group_id return_url]>Add a contact</a>"
+} else {
+    set admin(projects) ""
+    set admin(basic_info) ""
+    set admin(contact_info) ""
+}
+
+# set sql "\
+# select g.group_name, g.registration_date, c.note, g.short_name,
+#                 ab.first_names||' '||ab.last_name as primary_contact_name, primary_contact_id,
+#                 nvl(im_cust_status_from_id(customer_status_id),'&lt;-- not specified --&gt;') as customer_status
+# 	   from user_groups g, im_customers c, address_book ab
+# 	  where g.group_id=$group_id
+# 	    and g.group_id=c.group_id
+#             and c.primary_contact_id=ab.address_book_id(+)"
+
+set sql "\
+select g.group_name, 
+       g.registration_date, 
+       c.note, 
+       g.short_name,
+       a.first_names||' '||a.last_name as primary_contact_name, 
+       primary_contact_id,
+       coalesce(im_cust_status_from_id(customer_status_id),'&lt;-- not specified --&gt;') as customer_status
+from user_groups g, im_customers c, address_book a
+where g.group_id=$group_id
+  and g.group_id=c.group_id
+  and c.primary_contact_id=a.address_book_id
+union
+select g.group_name, 
+       g.registration_date, 
+       c.note, 
+       g.short_name,
+       '' as primary_contact_name,
+       primary_contact_id,
+       coalesce(im_cust_status_from_id(customer_status_id),'&lt;-- not specified --&gt;') as customer_status
+from user_groups g, im_customers c
+where g.group_id=$group_id
+  and g.group_id=c.group_id
+  and not exists (select user_id from users 
+                  where c.primary_contact_id = user_id)"	
+
+set selection [ns_db 1row $db $sql]
+
+set_variables_after_query
+
+set page_title $group_name
+set context_bar [ad_context_bar [list "/" Home] [list ../index.tcl "Intranet"] [list index.tcl "Customers"] "One customer"]
+
+set left_column "
+<ul> 
+  <li> Status: $customer_status
+  <li> Added on [util_AnsiDatetoPrettyDate $registration_date]
+"
+
+set primary_contact_text ""
+set limit_to_users_in_group_id [im_employee_group_id]
+if { [empty_string_p $primary_contact_id] } {
+    if { $user_admin_p } {
+	set primary_contact_text "<a href=primary-contact.tcl?[export_url_vars group_id limit_to_users_in_group_id]>Add primary contact</a>\n"
+    } else {
+	set primary_contact_text "<i>none</i>"
+    }
+} else {
+    append primary_contact_text "<a href=/address-book/record.tcl?address_book_id=$primary_contact_id&[export_url_vars group_id]&scope=group>$primary_contact_name</a>"
+    if { $user_admin_p } {
+	append primary_contact_text "    (<a href=primary-contact.tcl?[export_url_vars group_id limit_to_users_in_group_id]>change</a> |
+	<a href=primary-contact-delete.tcl?[export_url_vars group_id return_url]>remove</a>)\n"
+    }
+}
+
+append left_column "
+  <li> Primary contact: $primary_contact_text
+  <li> Group short name: $short_name
+"
+
+
+if { ![empty_string_p $note] } {
+    append left_column "  <li> Notes: <font size=-1>$note</font>\n"
+}
+
+
+append left_column "
+$admin(basic_info)
+</ul>
+"
+
+# Let's create the list of active projects
+
+# set selection [ns_db select $db \
+# 	"select user_group_name_from_id(group_id) as project_name,
+#                 group_id as project_id, level, im_project_ticket_project_id(group_id) as ticket_project_id
+#            from im_projects p
+#           where customer_id=$group_id
+#      connect by prior group_id=parent_id
+#      start with parent_id is null"]
+
+set selection [ns_db select $db \
+	"select user_group_name_from_id(group_id) as project_name,
+                group_id as project_id, level, im_project_ticket_project_id(group_id) as ticket_project_id
+           from im_projects_view p
+          where customer_id=$group_id
+          order by connect_by_key"]
+
+
+set projects_html ""
+set current_level 1
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { $level > $current_level } {
+	append projects_html "  <ul>\n"
+	incr current_level
+    } elseif { $level < $current_level } {
+	append projects_html "  </ul>\n"
+	set current_level [expr $current_level - 1]
+    }	
+    if { $ticket_project_id == 0 } {
+	set ticket_link "(<a href=../projects/ticket-edit.tcl?group_id=$project_id&[export_url_vars return_url]>create ticket tracker</a>)"
+    } else {
+	set ticket_link "(<a href=/new-ticket/index.tcl?project_id=$ticket_project_id>ticket tracker</a>)"
+    }
+    append projects_html "  <li><a href=../projects/view.tcl?group_id=$project_id>$project_name</a> - $ticket_link\n"
+}
+if { [exists_and_not_null level] && $level < $current_level } {
+    append projects_html "  </ul>\n"
+}	
+if { [empty_string_p $projects_html] } {
+    set projects_html "  <li><i>None</i>\n"
+}
+
+
+append left_column "<b>Contact correspondence and strategy reviews:</b>\n"
+
+if { [exists_and_not_null show_all_correspondance_comments] } {
+    append left_column [ad_general_comments_summary_sorted $db $group_id im_customers $group_name]
+} else {
+    set url_for_more "[im_url_stub]/projects/view.tcl?show_all_correspondance_comments=1&[export_ns_set_vars url [list show_all_correspondance_comments]]"
+    append left_column [ad_general_comments_summary_sorted $db $group_id im_customers $group_name 5 $url_for_more]
+}
+
+append left_column "
+<ul>
+<p><a href=\"/general-comments/comment-add.tcl?group_id=$group_id&scope=group&on_which_table=im_customers&on_what_id=$group_id&item=[ns_urlencode $group_name]&module=intranet&[export_url_vars return_url]\">Add a correspondance</a>
+</ul>
+"
+
+
+# Print out the address book
+set contact_info ""
+set selection [ns_db select $db \
+	"select * 
+           from address_book 
+          where group_id=$group_id
+       order by lower(last_name)"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append contact_info "<p><li>[address_book_record_display $selection "f"]\n"
+    if { $user_admin_p > 0 } {
+	append contact_info "
+<br>
+\[<a href=/address-book/record-edit.tcl?scope=group&[export_url_vars group_id address_book_id return_url]>edit</a> | 
+<a href=/address-book/record-delete.tcl?scope=group&[export_url_vars group_id address_book_id return_url]>delete</a>\]
+"
+    }
+} 
+
+if { [empty_string_p $contact_info] } {
+    set contact_info "  <li> <i>None</i>\n"
+}
+
+append left_column "
+<b>Contact Information</b>
+<ul>
+$contact_info
+$admin(contact_info)
+</ul>
+"
+
+## News specific to this customer
+set since_when [database_to_tcl_string $db "select sysdate() - 30 from dual"]
+set news [news_new_stuff $db $since_when 0 "web_display" 1 0 $group_id]
+if { [empty_string_p $news] } {
+    set news "  <li> <em>none</em>\n"
+}
+set news_dir [im_groups_url -db $db -group_id $group_id -section news]
+
+if { [ad_parameter ApprovalPolicy news] == "open"} {
+    append news "\n<li><a href=\"$news_dir/post-new.tcl?scope=group&[export_url_vars return_url]\">post an item</a>\n"
+} elseif { [ad_parameter ApprovalPolicy news] == "wait"} {
+    append news "\n<li><a href=\"$news_dir/post-new.tcl?scope=group&[export_url_vars return_url]\">suggest an item</a>\n"
+}
+append news " | <a href=$news_dir/index.tcl?scope=group&archive_p=1>archives</a>\n"
+
+
+## BBoards are not currently supported
+if { [ad_parameter BBoardEnabledP intranet 0] } {
+    ## Links to associated bboards
+    set bboard_string ""
+    set selection [ns_db select $db \
+	    "select topic, topic_id, presentation_type
+               from bboard_topics
+              where group_id=$group_id"]
+    while { [ns_db getrow $db $selection] } {
+	set_variables_after_query
+	set link [bboard_complete_backlink $topic_id $topic $presentation_type]
+	regsub {href="} $link {href="/bboard/} link
+	append bboard_string "  <li> $link\n"
+    }
+    if { [empty_string_p $bboard_string] } {
+	set bboard_string "  <li> <em>none</em>\n"
+    }
+    append bboard_string " <li> <a href=bboard-ae.tcl?[export_url_vars group_id]>Create a new discussion group</a>\n"
+} else {
+    set bboard_string ""
+}
+
+## Links to associated sections (things we don't know where else to put!)
+set sections "  <li><a href=/file-storage/group.tcl?[export_url_vars group_id]>File Storage</a>\n"
+
+set page_body "
+<table width=100% cellpadding=0 cellspacing=2 border=0>
+<tr>
+  <td valign=top>
+$left_column
+  </td>
+  <td valign=top>
+[im_table_with_title "Customer News" "<ul>$news</ul>"]
+[util_decode $bboard_string "" "" [im_table_with_title "Discussion Groups" "<ul>$bboard_string</ul>"]]
+[im_table_with_title "Sections" "<ul>$sections</ul>"]
+[im_table_with_title "Projects" "<ul>$projects_html\n$admin(projects)</ul>"]
+[im_table_with_title "[ad_parameter SystemName] Employees" "<ul>[im_users_in_group $db $group_id $current_user_id "Spam employees working with $group_name" $user_admin_p $return_url [im_employee_group_id]]</ul>"]
+[im_table_with_title "Customer Employees" "<ul>[im_users_in_group $db $group_id $current_user_id "Spam users who work for $group_name" $user_admin_p $return_url [im_customer_group_id] [im_employee_group_id]]</ul>"]
+  </td>
+</tr>
+</table>
+
+"
+
+ns_db releasehandle $db
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/employees/aim-blt-by-office.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/employees/aim-blt-by-office.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/employees/aim-blt-by-office.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,51 @@
+# aim-blt-by-office.tcl,v 3.1.2.1 2000/03/17 07:25:47 mbryzek Exp
+#
+# File: /www/intranet/employees/aim-blt-by-office.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Generates an AIM blt file subdivided by office
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+set html "
+Config {
+ version 1 
+}
+Buddy {
+ list {
+"
+
+set selection [ns_db select $db \
+	"select distinct ug.group_name, uc.aim_screen_name
+           from user_groups ug, users_active users, users_contact uc
+          where ug.parent_group_id = [im_office_group_id]
+            and ad_group_member_p ( users.user_id, ug.group_id ) = 't'
+            and users.user_id = uc.user_id
+            and users.user_id <> $user_id
+            and aim_screen_name is not null
+       order by upper(ug.group_name), upper(aim_screen_name)"]
+
+set last_off_name ""
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { $last_off_name != $group_name } {
+	if { ![empty_string_p $last_off_name] } {
+	    append html "    \}\n"
+	}
+	append html "    \"$group_name\" \{\n"
+	set last_off_name $group_name
+    }
+    append html "        \"$aim_screen_name\"\n"
+}
+
+append html "    }
+ }
+}
+"
+
+ns_return 200 text/plain $html
Index: web/openacs/www/intranet/employees/aim-blt.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/employees/aim-blt.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/employees/aim-blt.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,42 @@
+# aim-blt.tcl,v 3.1.2.1 2000/03/17 07:25:48 mbryzek Exp
+#
+# File: /www/intranet/employees/aim-blt.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Generates an AIM Blt file of all the employees
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+set html "
+Config {
+ version 1 
+}
+Buddy {
+ list {
+   [ad_parameter SystemName] {
+"
+
+set selection [ns_db select $db "
+select aim_screen_name
+from users_active users, users_contact
+where users.user_id = users_contact.user_id
+and aim_screen_name is not null
+and ad_group_member_p ( users.user_id, [im_employee_group_id] ) = 't'
+and users.user_id <> $user_id
+order by upper(aim_screen_name)"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append html "   \"$aim_screen_name\"\n"
+}
+
+append html "  }
+ }
+}
+"
+
+ns_return 200 text/plain $html
Index: web/openacs/www/intranet/employees/aim-tik-by-office.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/employees/aim-tik-by-office.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/employees/aim-tik-by-office.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,41 @@
+# aim-tik-by-office.tcl,v 1.1.2.1 2000/03/17 07:25:49 mbryzek Exp
+#
+# File: /www/intranet/employees/aim-tik-by-office.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Generates an AIM Tik file of all the employees subdivided by office
+# 
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+set html "m 1\n"
+
+set selection [ns_db select $db \
+	"select distinct ug.group_name, uc.aim_screen_name
+           from user_groups ug, user_group_map ugm, users_active users, users_contact uc
+          where ug.parent_group_id=[im_office_group_id]
+            and ug.group_id=ugm.group_id
+            and ugm.user_id=users.user_id
+            and users.user_id=uc.user_id
+            and users.user_id<>$user_id
+            and aim_screen_name is not null
+       order by upper(ug.group_name), upper(aim_screen_name)"]
+
+
+
+set last_off_name ""
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { $last_off_name != $group_name } {
+	append html "\ng $group_name\n"
+	set last_off_name $group_name
+    }
+    append html "b $aim_screen_name\n"
+}
+
+ns_return 200 text/plain $html
Index: web/openacs/www/intranet/employees/aim-tik.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/employees/aim-tik.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/employees/aim-tik.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,35 @@
+# aim-tik.tcl,v 1.1.2.1 2000/03/17 07:25:49 mbryzek Exp
+#
+# File: /www/intranet/employees/aim-tik.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Generates an AIM Tik file of all the employees
+# 
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+set html "
+m 1
+g Buddy
+"
+
+set selection [ns_db select $db "
+select aim_screen_name
+from users_active users, user_group_map ugm, users_contact
+where users.user_id = users_contact.user_id
+and aim_screen_name is not null
+and ugm.group_id=[im_employee_group_id]
+and ugm.user_id=users.user_id
+and users.user_id <> $user_id
+order by upper(aim_screen_name)"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append html "b $aim_screen_name\n"
+}
+
+ns_return 200 text/plain $html
Index: web/openacs/www/intranet/employees/aim.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/employees/aim.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/employees/aim.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,28 @@
+# aim.tcl,v 1.2.2.1 2000/03/17 07:25:50 mbryzek Exp
+#
+# File: /www/intranet/employees/aim.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Top level page to select an AIM format
+# 
+
+
+set page_title "Employee AIM Buddy Lists"
+set context_bar [ad_context_bar [list "/" Home] [list ../index.tcl "Intranet"] [list index.tcl "Employees"] "AIM Lists"]
+
+set page_body "
+All Employees:
+<ul>
+  <li> <a href=aim-blt.tcl>blt</a> - standard, windows format
+  <li> <a href=aim-tik.tcl>Tik</a> (for linux)
+</ul>
+
+By Office:
+<ul>
+  <li> <a href=aim-blt-by-office.tcl>blt</a> - standard, windows format
+  <li> <a href=aim-tik-by-office.tcl>Tik</a> (for linux)
+</ul>
+
+"
+ns_return 200 text/html [ad_partner_return_template]
\ No newline at end of file
Index: web/openacs/www/intranet/employees/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/employees/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/employees/index.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,150 @@
+# index.tcl,v 3.3.2.2 2000/03/17 08:56:34 mbryzek Exp
+#
+# File: /www/intranet/employees/index.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Top level admin view of all employees
+# 
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_form_variables 0
+# optional: status_id
+
+set db [ns_db gethandle]
+
+# can the user make administrative changes to this page
+set user_admin_p [im_is_user_site_wide_or_intranet_admin $db $user_id]
+
+set return_url [ad_partner_url_with_query]
+
+if { ![exists_and_not_null order_by] } {
+    set order_by "Name"
+}
+
+# Offer admins a link to a different view
+if { $user_admin_p } {
+    set view_types "<a href=admin/index.tcl>Admin View</a> | " 
+}
+
+append view_types "<a href=org-chart.tcl>Org Chart</a> | <b>Standard View</b>"
+
+set order_by_clause ""
+switch $order_by {
+    "Name" { set order_by_clause "order by upper(last_name), upper(first_names)" }
+    "Email" { set order_by_clause "order by upper(email), upper(last_name), upper(first_names)" }
+    "AIM" { set order_by_clause "order by upper(aim_screen_name), upper(last_name), upper(first_names)" }
+    "Cell Phone" { set order_by_clause "order by upper(cell_phone), upper(last_name), upper(first_names)" }
+    "Home Phone" { set order_by_clause "order by upper(home_phone), upper(last_name), upper(first_names)" }
+    "Work Phone" { set order_by_clause "order by upper(work_phone), upper(last_name), upper(first_names)" }
+}
+
+set page_title "Employees"
+set context_bar [ad_context_bar [list "/" Home] [list ../index.tcl "Intranet"] $page_title]
+
+set page_body "
+<table width=100% cellpadding=0 cellspacing=0 border=0>
+  <tr><td align=right>$view_types</td></tr>
+</table>
+"
+
+# set selection [ns_db select $db \
+#  	"select u.last_name||', '||u.first_names as name, u.user_id,
+#                 u.email, c.aim_screen_name, c.home_phone, c.work_phone, c.cell_phone
+#            from users_active u, users_contact c
+#           where u.user_id=c.user_id(+) 
+#             and ad_group_member_p ( u.user_id, [im_employee_group_id] ) = 't'
+#             $order_by_clause"]
+ 
+
+set selection [ns_db select $db \
+"select u.last_name||', '||u.first_names as name, u.user_id,
+                u.email, c.aim_screen_name, c.home_phone, c.work_phone, c.cell_phone
+           from users_active u, users_contact c
+          where u.user_id=c.user_id
+            and ad_group_member_p ( u.user_id, [im_employee_group_id] ) = 't'
+union
+select u.last_name||', '||u.first_names as name, u.user_id,
+                u.email, '' as aim_screen_name, '' as home_phone, '' as work_phone, '' as cell_phone
+           from users_active u
+          where not exists (select 1 from users_contact 
+                            where user_id = u.user_id) 
+            and ad_group_member_p ( u.user_id, [im_employee_group_id] ) = 't'
+            $order_by_clause"]
+            
+
+set results ""
+set bgcolor(0) " bgcolor=\"[ad_parameter TableColorOdd Intranet white]\""
+set bgcolor(1) " bgcolor=\"[ad_parameter TableColorEven Intranet white]\""
+set ctr 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append results "
+<tr$bgcolor([expr $ctr % 2])>
+  <td valign=top>[ad_partner_default_font] <a href=../users/view.tcl?[export_url_vars user_id]>$name</a> </font></td>
+  <td valign=top>[ad_partner_default_font] <a href=mailto:$email>$email</a> </font></td>
+  <td valign=top>[ad_partner_default_font] [util_decode $aim_screen_name "" "&nbsp;" $aim_screen_name] </font></td>
+  <td valign=top>[ad_partner_default_font] [util_decode $cell_phone "" "&nbsp;" $cell_phone] </font></td>
+  <td valign=top>[ad_partner_default_font] [util_decode $home_phone "" "&nbsp;" $home_phone] </font></td>
+  <td valign=top>[ad_partner_default_font] [util_decode $work_phone "" "&nbsp;" $work_phone] </font></td>
+</tr>
+"
+    incr ctr
+}
+
+
+if { [empty_string_p $results] } {
+    set results "<ul><li><b> There are currently no employees</b></ul>\n"
+} else {
+    set column_headers [list Name "Email" AIM "Cell Phone" "Home Phone" "Work Phone"]
+
+    set url "index.tcl"
+    set query_string [export_ns_set_vars url [list order_by]]
+    if { [empty_string_p $query_string] } {
+	append url "?"
+    } else {
+	append url "?$query_string&"
+    }
+    set table "
+<table width=100% cellpadding=1 cellspacing=2 border=0>
+<tr bgcolor=\"[ad_parameter TableColorHeader intranet white]\">
+"
+    foreach col $column_headers {
+	if { [string compare $order_by $col] == 0 } {
+	    append table "  <th>$col</th>\n"
+	} else {
+	    append table "  <th><a href=\"${url}order_by=[ns_urlencode $col]\">$col</a></th>\n"
+	}
+    }
+    set results "
+<br>
+$table
+</tr>
+$results
+</table>
+"
+}
+
+
+append page_body "
+$results
+<ul>
+"
+if { $user_admin_p } {
+    append page_body "  <li> <a href=/groups/member-add.tcl?role=member&[export_url_vars return_url]&group_id=[im_employee_group_id]>Add an employee</a>\n"
+}
+
+set spam_link "/groups/[ad_parameter EmployeeGroupShortName intranet employee]/spam.tcl?sendto=members"
+
+append page_body "
+  <li> Look at all <a href=with-portrait.tcl>employees with portraits</a>
+  <li> <a href=$spam_link>Spam all employees</a>
+  <li> <a href=aim.tcl>Download</a> an AIM's [ad_parameter SystemName] \"buddy\" list
+</ul>
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/employees/org-chart.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/employees/org-chart.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/employees/org-chart.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,130 @@
+# org-chart.tcl,v 3.3.2.1 2000/03/17 07:25:51 mbryzek Exp
+#
+# File: /www/intranet/employees/org-chart.tcl
+#
+# by philg@mit.edu on July 6, 1999
+#
+# uses CONNECT BY on the supervisor column in im_employee_info to query 
+# out the org chart for a company
+
+# modified 8/6/99 by dvr@arsdigita.com to handle the case of more 
+# than one person without a supervisor. We figure the Big Kahuna
+# is the person with no supervisor AND no subordinates
+
+# fixed a bug on 9/12/99 that caused the org chart
+
+# modified 1/28/2000 by mbryzek@arsdigita.com to support user groups
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+# can the user make administrative changes to this page
+set user_admin_p [im_is_user_site_wide_or_intranet_admin $db $user_id]
+
+set return_url [ad_partner_url_with_query]
+
+# Offer admins a link to a different view
+if { $user_admin_p } {
+    set view_types "<a href=admin/index.tcl>Admin View</a> | " 
+}
+append view_types "<b>Org Chart</b> | <a href=index.tcl>Standard View</a>"
+
+set page_title "Org Chart"
+set context_bar [ad_context_bar [list "/" Home] [list ../index.tcl "Intranet"] [list index.tcl "Employees"] "Org Chart"]
+
+# Note that the following query requires! that employees also exist in the
+# im_employee_info - basically, until you say This user is supervised by nobody
+# or by her, that user won't show up in the query
+
+set big_kahuna_list [database_to_tcl_list $db \
+	"select info.user_id 
+           from im_employee_info info
+          where supervisor_id is null
+            and exists (select 1
+                          from im_employee_info
+                         where supervisor_id = info.user_id)"]
+
+if { [llength $big_kahuna_list] == 0 || [llength $big_kahuna_list] > 1 } {
+    ad_return_error "No Big Kahuna" "<blockquote>For the org chart page to work, you need to have set up the \"who supervises whom\" relationships so that there is only one person (the CEO) who has no supervisor and no subordinates.</blockquote>"
+    return
+}
+
+set page_body "
+<table width=100% cellpadding=0 cellspacing=0 border=0>
+  <tr><td align=right>$view_types</td></tr>
+</table>
+<blockquote>\n"
+
+# this is kind of inefficient in that we do a subquery to make
+# sure the employee hasn't left the company, but you can't do a 
+# JOIN with a CONNECT BY
+
+#
+# there's a weird case when a manager has left the company.  we can't just leave him blank because
+# it screws the chart up, therefore put in a placeholder "vacant"
+#
+
+set last_level 0   ;#level of last employee
+set vacant_position ""
+
+
+proc gen_spacing { level } {
+
+    set str ""
+    set level [expr $level - 1]
+    for {set i 0} {$i < $level} {incr i} {
+
+        append str "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;"
+    }
+
+    return $str
+}
+
+# set sql "select 
+#     supervisor_id, 
+#     user_id, 
+#     replace(lpad(' ', (level - 1) * 6),' ','&nbsp;') as spacing,
+#     im_name_from_user_id(user_id) as employee_name,
+#     level,
+#     ad_group_member_p(user_id, [im_employee_group_id]) as currently_employed_p
+# from 
+#     im_employee_info
+# start with 
+#     user_id = [lindex $big_kahuna_list 0]
+# connect by  
+#     supervisor_id = PRIOR user_id"
+
+set sql "select supervisor_id, user_id, 
+                im_org_chart_level(user_id,1,0) as level,
+                im_name_from_user_id(user_id) as employee_name,
+                ad_group_member_p(user_id, [im_employee_group_id]) as currently_employed_p
+           from im_employee_info
+          where user_id in (select user_id from users_active)
+       order by im_org_chart_connect_by(user_id,0)"
+
+        
+set selection [ns_db select $db $sql]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    set spacing [gen_spacing $level]
+    if { $currently_employed_p == "t" } {
+        if { $vacant_position != "" && $last_level < $level } {
+            append page_body $vacant_position
+	}
+        append page_body "$spacing<a href=../users/view.tcl?[export_url_vars user_id]>$employee_name</a><br>\n"
+        set vacant_position ""
+    } else {
+        set vacant_position $spacing
+        append vacant_position "Position Vacant</i><br>\n"
+    }
+    set last_level $level
+}
+
+append page_body "</blockquote>\n"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/employees/payroll-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/employees/payroll-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/employees/payroll-edit-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,68 @@
+# payroll-edit-2.tcl,v 3.0.4.1 2000/03/17 07:25:51 mbryzek Exp
+#
+# File: /www/intranet/employees/payroll-edit-2.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Saves payroll information
+# 
+
+ad_maybe_redirect_for_registration
+
+set_form_variables
+# dp stuff
+# return_url (optional)
+
+set user_id ${dp.im_employee_info.user_id}
+validate_integer user_id $user_id
+
+set form_setid [ns_getform]
+
+set db [ns_db gethandle]
+
+# can the user make administrative changes to the user's salary information?
+set user_admin_p [im_is_user_site_wide_or_intranet_admin $db $user_id]
+if { !$user_admin_p } {
+    ns_set delkey $form_setid dp.im_employee_info.salary
+    ns_set delkey $form_setid dp.im_employee_info.salary_period
+} else {
+    ns_set put $form_setid dp.im_employee_info.salary_period [im_salary_period_input]
+}
+
+# This page is restricted to only site/intranet admins
+if { $user_id != [ad_verify_and_get_user_id] && ![im_is_user_site_wide_or_intranet_admin $db] } {
+    ns_returnredirect ../
+    return
+}
+
+set exception_count 0
+if { [catch {set birthdate [validate_ad_dateentrywidget birthdate birthdate [ns_conn form]]} err_msg] } {
+    incr exception_count
+    append exception_text "  <li> $err_msg\n"
+} else {
+    ns_set put $form_setid {dp.im_employee_info.birthdate} $birthdate
+}
+
+if { [catch {set first_experience [validate_ad_dateentrywidget first_experience first_experience [ns_conn form]]} err_msg] } {
+    incr exception_count
+    append exception_text "  <li> $err_msg\n"
+} else {
+    ns_set put $form_setid {dp.im_employee_info.first_experience} $first_experience
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+with_transaction $db {
+
+    dp_process -db $db -where_clause "user_id=$user_id"
+} { ns_log Error "transaction failed" }
+
+
+if { [exists_and_not_null return_url] } {
+    ns_returnredirect $return_url
+} else {
+    ns_returnredirect payroll.tcl?[export_url_vars user_id]
+}
Index: web/openacs/www/intranet/employees/payroll-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/employees/payroll-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/employees/payroll-edit.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,169 @@
+# payroll-edit.tcl,v 3.2.2.2 2000/03/17 08:56:34 mbryzek Exp
+#
+# File: /www/intranet/employees/payroll-edit.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Allows users to enter payroll info
+#
+
+ad_maybe_redirect_for_registration
+
+set_form_variables 0
+# user_id 
+# return_url (optional)
+
+validate_integer user_id $user_id
+
+set caller_user_id $user_id 
+
+if { ![exists_and_not_null user_id] } {
+    ad_return_error "Missing user id" "We weren't able to determine  forwhat user you want information."
+    return
+}
+
+set db [ns_db gethandle]
+
+# This page is restricted to only site/intranet admins or the person
+# whose record this is
+if { $caller_user_id != [ad_verify_and_get_user_id] && ![im_is_user_site_wide_or_intranet_admin $db] } {
+    ns_returnredirect ../
+    return
+}
+
+# set selection [ns_db 0or1row $db "
+# select 
+#   u.first_names, 
+#   u.last_name, 
+#   u.email, 
+#   (sysdate() - info.first_experience)/365 as years_experience,
+#   info.*
+# from users u, im_employee_info info
+# where u.user_id = $user_id
+# and u.user_id = info.user_id(+)
+# and ad_group_member_p ( u.user_id, [im_employee_group_id] ) = 't'"]
+
+
+set selection [ns_db 0or1row $db "
+select 
+  u.first_names, 
+  u.last_name, 
+  u.email, 
+  (sysdate() - info.first_experience::timestamp)/365 as years_experience,
+  info.*
+from users u, im_employee_info_view info
+where u.user_id = $user_id
+and u.user_id = info.user_id
+and ad_group_member_p ( u.user_id, [im_employee_group_id] ) = 't'
+union
+select 
+  u.first_names, 
+  u.last_name, 
+  u.email, 
+  0::interval as years_experience,
+  info.*
+from users u, im_employee_info_null info
+where u.user_id = $user_id
+and not exists (select 1 from im_employee_info i 
+                where u.user_id = i.user_id)
+and ad_group_member_p ( u.user_id, [im_employee_group_id] ) = 't'"]
+
+
+if [empty_string_p $selection] {
+    ad_return_error "Error" "That user doesn't exist"
+    return
+}
+set_variables_after_query
+
+set page_title "$first_names $last_name"
+set context_bar [ad_context_bar [list "/" Home] [list ../index.tcl "Intranet"] [list index.tcl "Employees"] [list ../users/view.tcl?user_id=$caller_user_id "One employee"] [list payroll.tcl?user_id=$caller_user_id "Payroll information"] "Edit information"]
+
+set user_admin_p [im_is_user_site_wide_or_intranet_admin $db $user_id]
+if { $user_admin_p } {
+    set salary_info "
+<tr>
+ <td>Salary (per year)</td>
+ <td><input NAME=dp.im_employee_info.salary.money MAXLENGTH=20 [export_form_value salary]></td>
+</tr>
+"
+} else {
+    set salary_info ""
+}
+
+ns_db releasehandle $db
+
+
+set page_body "
+<form method=post action=payroll-edit-2.tcl>
+<input type=hidden name=dp.im_employee_info.user_id value=$caller_user_id>
+[export_form_vars return_url]
+<table>
+$salary_info
+<tr>
+ <td>Social Security Number</td>
+ <td><input NAME=dp.im_employee_info.ss_number MAXLENGTH=20 [export_form_value ss_number]></td>
+</tr>
+
+<tr>
+ <td>Birthdate:</td>
+ <td>[ad_dateentrywidget birthdate [value_if_exists birthdate]]</td>
+</tr>
+
+<tr>
+ <td>Are you married?</td>
+ <td><SELECT NAME=dp.im_employee_info.married_p>
+ [ad_generic_optionlist [list No Yes] [list f t] [value_if_exists married_p]]
+ </SELECT>
+ </td>
+</tr>
+
+<tr>
+ <td>Are you a dependent?<br>(Does someone else claim you on your
+ tax return?)</td>
+ <td>
+ <SELECT NAME=dp.im_employee_info.dependant_p>
+ [ad_generic_optionlist [list No Yes] [list f t] [value_if_exists dependant_p]]
+ </SELECT>
+ </td>
+</tr>
+
+<tr>
+ <td>Is this your only job?</td>
+ <td><SELECT NAME=dp.im_employee_info.only_job_p>
+ [ad_generic_optionlist [list Yes No] [list t f] [value_if_exists only_job_p]]
+ </SELECT>
+ </td>
+</tr>
+
+<tr>
+ <td>Are you the head of the household?</td>
+ <td><SELECT NAME=dp.im_employee_info.head_of_household_p>
+ [ad_generic_optionlist [list Yes No] [list t f] [value_if_exists head_of_household_p]]
+ </SELECT>
+ </td>
+</tr>
+
+<tr>
+ <td>Number of dependents:</td>
+ <td><input NAME=dp.im_employee_info.dependants [export_form_value dependants] SIZE=2 MAXLENGTH=2></td>
+</tr>
+
+<tr>
+ <td colspan=2>&nbsp;</td>
+</tr>
+
+<tr>
+ <td><B>Experience.</B> When did you start work in this field?</td>
+ <td>[ad_dateentrywidget first_experience [value_if_exists first_experience]]</td>
+</tr>
+
+</table>
+
+<p><CENTER>
+<input TYPE=Submit VALUE=\" Update \">
+</center>
+
+</form>
+"
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/employees/payroll.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/employees/payroll.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/employees/payroll.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,163 @@
+# payroll.tcl,v 3.2.2.2 2000/03/17 08:56:34 mbryzek Exp
+#
+# File: /www/intranet/employees/payroll.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Shows payroll information about one employee
+#
+# Mar 15 2000 mbryzek: Removed ns_writes
+
+ad_maybe_redirect_for_registration
+
+set_form_variables 0
+# user_id 
+# return_url (optional)
+
+
+if { ![exists_and_not_null user_id] } {
+    set user_id [ad_verify_and_get_user_id]
+}
+
+validate_integer user_id $user_id
+
+set caller_user_id $user_id 
+
+set db [ns_db gethandle]
+
+# This page is restricted to only site/intranet admins
+if { $caller_user_id != [ad_verify_and_get_user_id] && ![im_is_user_site_wide_or_intranet_admin $db] } {
+    ns_returnredirect ../
+    return
+}
+
+set default_value "<em>(No information)</em>"
+
+# set selection [ns_db 0or1row $db "
+# select 
+#   u.first_names, 
+#   u.last_name, 
+#   u.email, 
+#   (sysdate - info.first_experience)/365 as total_years_experience,
+#   info.*
+# from users u, im_employee_info info
+# where u.user_id = $user_id
+# and u.user_id = info.user_id(+)
+# and ad_group_member_p ( u.user_id, [im_employee_group_id] ) = 't'"]
+
+set sql "\
+select 
+  u.first_names, 
+  u.last_name, 
+  u.email, 
+  trunc((sysdate() - info.first_experience::timestamp)/365) as total_years_experience,
+  info.*
+from users u, im_employee_info_view info
+where u.user_id = $user_id
+and u.user_id = info.user_id
+and ad_group_member_p ( u.user_id, [im_employee_group_id] ) = 't'
+union
+select 
+  u.first_names, 
+  u.last_name, 
+  u.email, 
+  0::integer as total_years_experience,
+  info.*
+from users u, im_employee_info_null info
+where u.user_id = $user_id
+and not exists (select 1 from im_employee_info 
+                where user_id = u.user_id)
+and ad_group_member_p ( u.user_id, [im_employee_group_id] ) = 't'"
+
+set selection [ns_db 0or1row $db $sql]
+
+
+
+if [empty_string_p $selection] {
+    ad_return_error "Error" "That user doesn't exist"
+    return
+}
+set_variables_after_query
+
+set page_title "$first_names $last_name"
+set context_bar [ad_context_bar [list "/" Home] [list ../index.tcl "Intranet"] [list index.tcl "Employees"] [list ../users/view.tcl?user_id=$caller_user_id "One employee"] "Payroll information"]
+
+ns_db releasehandle $db
+
+if [empty_string_p $salary] {
+    set salary "<em>(No information)</em>"
+} else {
+    set salary [im_display_salary $salary $salary_period]
+}
+if [empty_string_p $total_years_experience] {
+    set total_years_experience "<em>(No information)</em>"
+} else {
+    set total_years_experience "[format %4.1f $total_years_experience] [util_decode $total_years_experience 1 year years]"
+}
+if [empty_string_p $ss_number] {
+    set ss_number "(No information)"
+}
+if [empty_string_p $dependants] {
+    set dependants "(No information)"
+}
+if [empty_string_p $birthdate] {
+    set birthdate "<EM>(No information)</EM>"
+} else {
+    set birthdate "[util_AnsiDatetoPrettyDate $birthdate]"
+}
+
+
+set page_body "
+<b>Salary:</b> $salary
+<br><b>Years of relevant work experience:</b> $total_years_experience
+<p><b>W-2 information:</b>
+<ul>
+
+<BLOCKQUOTE>
+
+<TABLE CELLPADDING=3>
+
+<TR>
+<TD>Social Security number:</TD>
+<TD><EM>$ss_number</EM></TD>
+</TR>
+
+<TR>
+<TD>Birthdate:</TD>
+<TD><EM>$birthdate</EM></TD>
+</TR>
+
+<TR>
+<TD>Are you married?</TD>
+<TD><EM>[util_PrettyBoolean $married_p $default_value]</EM></TD>
+</TR>
+
+<TR>
+<TD>Are you a dependant? <br><font size=-1>(Does someone else claim you on their tax return?)</font></TD>
+<TD><EM>[util_PrettyBoolean $dependant_p $default_value]</EM></TD>
+</TR>
+
+<TR>
+<TD>Is this your only job?</TD>
+<TD><EM>[util_PrettyBoolean $only_job_p $default_value]</EM></TD>
+</TR>
+
+<TR>
+<TD>Are you the head of the household?</TD>
+<TD><EM>[util_PrettyBoolean $head_of_household_p $default_value]</EM></TD>
+</TR>
+
+<TR>
+<TD>Number of dependants:</TD>
+<TD><EM>$dependants</EM></TD>
+</TR>
+
+</TABLE>
+</blockquote>
+
+</ul>
+
+(<a href=payroll-edit.tcl?user_id=$caller_user_id&[export_url_vars return_url]>edit</a>)
+"
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/employees/search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/employees/search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/employees/search.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,93 @@
+# search.tcl,v 3.2.2.1 2000/03/17 07:25:53 mbryzek Exp
+#
+# File: /www/intranet/employees/search.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Allows you to search through all employees
+# 
+
+set_the_usual_form_variables 0
+
+# keywords
+
+if { ![exists_and_not_null keywords] } {
+    ns_returnredirect index.tcl
+    return
+}
+
+set upper_keywords [string toupper $keywords]
+# Convert * to oracle wild card
+regsub -all {\*} $upper_keywords {%} upper_keywords
+
+set db [ns_db gethandle]
+
+# set selection [ns_db select $db \
+#         "select u.last_name || ', ' || u.first_names as full_name, email, u.user_id
+#            from users_active u, user_group_map ugm, users_contact uc
+#           where upper(u.last_name||' '||u.first_names||' '||u.email||' '||uc.aim_screen_name||' '||u.screen_name) like '%[DoubleApos $upper_keywords]%'
+#             and u.user_id=ugm.user_id
+#             and ugm.group_id=[im_employee_group_id]
+#             and u.user_id=uc.user_id(+)
+#           order by lower(trim(full_name))"]
+
+set selection [ns_db select $db \
+"select u.last_name || ', ' || u.first_names as full_name, email, u.user_id
+           from users_active u, user_group_map ugm, users_contact uc
+          where upper(u.last_name||' '||u.first_names||' '||u.email||' '||uc.aim_screen_name||' '||u.screen_name) like '%[DoubleApos $upper_keywords]%'
+            and u.user_id=ugm.user_id
+            and ugm.group_id=[im_employee_group_id]
+            and u.user_id=uc.user_id
+union
+select u.last_name || ', ' || u.first_names as full_name, email, u.user_id
+           from users_active u, user_group_map ugm
+          where upper(u.last_name||' '||u.first_names||' '||u.email||' '||''||' '||u.screen_name) like '%[DoubleApos $upper_keywords]%'
+            and u.user_id=ugm.user_id
+            and ugm.group_id=[im_employee_group_id]
+            and not exists (select 1 from users_contact 
+                            where user_id = u.user_id)
+          order by lower(trim(full_name))"]
+
+
+set number 0
+set page_body ""
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    incr number
+    if { $number == 1 && [exists_and_not_null search_type] && [string compare $search_type "Feeling Lucky"] == 0 } {
+	ns_db flush $db
+	ns_returnredirect ../users/view.tcl?[export_url_vars user_id]
+	return
+    }
+    append page_body "  <li> <a href=../users/view.tcl?[export_url_vars user_id]>$full_name</a>"
+    if { ![empty_string_p $email] } {
+        append page_body " - <a href=\"mailto:$email\">$email</a>"
+    }
+    append page_body "\n"
+}
+
+ns_db releasehandle $db
+
+
+if { [empty_string_p $page_body] } {
+    set page_body "
+<blockquote>
+<b>No matches found.</b>
+Look at all <a href=index.tcl>employees</a>
+</blockquote>
+"
+} else {
+    set page_body "
+<b>$number [util_decode $number 1 "employee was" "employees were"] found</b>
+<ul>
+$page_body
+</ul>
+
+"
+}
+
+
+set page_title "Employee Search"
+set context_bar [ad_context_bar [list "/" Home] [list ../index.tcl "Intranet"] [list index.tcl "Employees"] Search]
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/employees/with-portrait.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/employees/with-portrait.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/employees/with-portrait.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,122 @@
+# with-portrait.tcl,v 3.4.2.1 2000/03/17 07:25:54 mbryzek Exp
+#
+# File: /www/intranet/employees/with-portrait.tcl
+#
+# by philg@mit.edu on September 27, 1999
+# 
+# a registration-required page that shows the portraits 
+# of all the users in the system who have uploaded them
+#
+# we have dimension controls on top to toggle "recent"|"all"
+# and some kind of order-by control 
+# and some kind of text list (with links), thumbnails, full-size
+# control
+
+ad_maybe_redirect_for_registration
+
+set_the_usual_form_variables 0 
+
+# optional text_picture_dim, recent_all_dim, order_by 
+
+if { ![info exists text_picture_dim] || [empty_string_p $text_picture_dim] } {
+    set text_picture_dim "links"
+}
+
+if { ![info exists recent_all_dim] || [empty_string_p $recent_all_dim] } {
+    set recent_all_dim "recent"
+}
+
+switch $text_picture_dim {
+    links  { set text_picture_bar "links | 
+<a href=\"with-portrait.tcl?text_picture_dim=thumbnails&[export_ns_set_vars url text_picture_dim]\">thumbnails</a> |
+<a href=\"with-portrait.tcl?text_picture_dim=full_size&[export_ns_set_vars url text_picture_dim]\">full-size</a>" }
+    thumbnails  { set text_picture_bar "<a href=\"with-portrait.tcl?text_picture_dim=links&[export_ns_set_vars url text_picture_dim]\">links</a> |
+thumbnails |
+<a href=\"with-portrait.tcl?text_picture_dim=full_size&[export_ns_set_vars url text_picture_dim]\">full-size</a>" }
+    full_size  { set text_picture_bar "<a href=\"with-portrait.tcl?text_picture_dim=links&[export_ns_set_vars url text_picture_dim]\">links</a> |
+<a href=\"with-portrait.tcl?text_picture_dim=thumbnails&[export_ns_set_vars url text_picture_dim]\">thumbnails</a> |
+full-size" }
+}
+
+
+set order_by_clause "order by upper(last_name), upper(first_names), upper(email)"
+switch $recent_all_dim {
+    recent { set recent_all_bar "recent |
+<a href=\"with-portrait.tcl?recent_all_dim=all&[export_ns_set_vars url recent_all_dim]\">all</a>"
+             set order_by_clause "order by portrait_upload_date desc" }
+    all { set recent_all_bar "<a href=\"with-portrait.tcl?recent_all_dim=recent&[export_ns_set_vars url recent_all_dim]\">recent</a> | all" }
+	     
+}
+
+set page_title "Employees with portraits"
+set context_bar [ad_context_bar [list "/" Home] [list "../index.tcl" "Intranet"] [list index.tcl Employees] "Employees with portraits"]
+
+ReturnHeaders
+ns_write "
+[ad_partner_header]
+
+<table width=100%>
+<tr>
+<td align=left>
+$text_picture_bar
+<td align=right>
+$recent_all_bar
+</table>
+
+<ul>
+"
+
+set db [ns_db gethandle]
+
+set selection [ns_db select $db "
+    select 
+        user_id, first_names, last_name, email, priv_email,
+        portrait_upload_date, portrait_original_width, portrait_original_height, portrait_client_file_name,
+        portrait_thumbnail_width, portrait_thumbnail_height
+    from 
+        users
+    where 
+        portrait_upload_date is not null and
+        ad_group_member_p ( user_id, [im_employee_group_id] ) = 't'
+    $order_by_clause"]
+
+
+set rows ""
+set count 0 
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    incr count
+    if { $count > 50 && $recent_all_dim == "recent" } {
+	# they only wanted to see the recent ones 
+	ns_db flush $db
+	break
+    }
+    append rows "\n<p><li> <a href=\"/shared/community-member.tcl?user_id=$user_id\">$first_names $last_name</a>"
+    if { $priv_email <= [ad_privacy_threshold] } {
+	append rows ", <a href=\"mailto:$email\">$email</a>"
+    }
+    # try to put the portrait in there
+    if { $text_picture_dim == "links" } {
+	append rows ", <a href=\"/shared/portrait.tcl?[export_url_vars user_id]\">$portrait_client_file_name</a>"
+    } elseif { $text_picture_dim == "thumbnails" } {
+	# **** this should really be smart and look for the actual thumbnail
+	# but it isn't and just has the browser smash it down to a fixed width
+	append rows "<br><dd><a href=\"/shared/portrait.tcl?[export_url_vars user_id]\"><img width=200 src=\"/shared/portrait-bits.tcl?[export_url_vars user_id]\"></a>\n"
+    } else { 
+	# must be the full thing
+	if { ![empty_string_p $portrait_original_width] && ![empty_string_p $portrait_original_height] } {
+	    set widthheight "width=$portrait_original_width height=$portrait_original_height"
+	} else {
+	    set widthheight ""
+	}
+	append rows "<br><dd><a href=\"/shared/portrait.tcl?[export_url_vars user_id]\"><img $widthheight src=\"/shared/portrait-bits.tcl?[export_url_vars user_id]\"></a>"
+    }
+}
+
+ns_db releasehandle $db 
+
+ns_write "$rows
+</ul>
+
+[ad_partner_footer]
+"
Index: web/openacs/www/intranet/employees/admin/history-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/employees/admin/history-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/employees/admin/history-edit-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,75 @@
+# history-edit-2.tcl,v 3.0.4.2 2000/03/17 07:13:34 mbryzek Exp
+# /www/intranet/employees/admin/history-edit-2.tcl
+# created: january 1st 2000
+# ahmedaa@mit.edu
+# Modified by mbryzek@arsdigita.com in January 2000 to 
+# support new group-based intranet
+
+# allows and administrator to edit the work percentage
+# history of an employee
+set db [ns_db gethandle]
+
+# percentage, user_id, start_block, stop_block, note
+set_the_usual_form_variables
+
+validate_integer user_id $user_id
+
+if { [string compare $stop_block "forever"] == 0 } {
+    set stop_block [database_to_tcl_string $db \
+	    "select distinct max(start_block) as max_start_block from im_start_blocks"]
+}
+
+ns_db dml $db "begin transaction"
+
+# change rows that do exist and overlap with my range
+ns_db dml $db "update im_employee_percentage_time 
+                  set percentage_time = $percentage 
+                where user_id = $user_id
+                  and start_block in (select start_block 
+                                        from im_start_blocks 
+                                       where start_block >= '$start_block'
+                                         and start_block <= '$stop_block')"
+
+# insert rows that do not exist
+ns_db dml $db "insert into im_employee_percentage_time 
+                      select start_block, $user_id, $percentage, '$QQnote' 
+                        from im_start_blocks 
+                       where start_block >= '$start_block' 
+                         and start_block <= '$stop_block' 
+                         and not exists (select start_block 
+                                           from im_employee_percentage_time imap2 
+                                          where im_start_blocks.start_block = imap2.start_block 
+                                            and user_id = $user_id)"
+
+set selection [ns_db select $db \
+	"select start_block 
+           from im_start_blocks 
+          where start_block > (select max(start_block) 
+                                 from im_employee_percentage_time 
+                                where start_block < '$start_block') 
+                                  and start_block < '$start_block'"]
+
+set number_empty_spaces [ns_set size $selection]
+
+if { $number_empty_spaces > 0 } {
+
+    # now lets fill in the gaps that come before this range
+    ns_db dml $db "insert into im_employee_percentage_time 
+                   (start_block, user_id, percentage_time, note) 
+                   select start_block, $user_id, 0, '$QQnote'  
+                     from im_start_blocks 
+                    where start_block < '$start_block'
+                      and start_block > (select max(start_block) 
+                                           from im_employee_percentage_time 
+                                          where start_block < '$start_block')"
+
+}
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect history.tcl?[export_url_vars user_id]
+
+
+
+
+
Index: web/openacs/www/intranet/employees/admin/history-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/employees/admin/history-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/employees/admin/history-edit.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,150 @@
+# history-edit.tcl,v 3.1.4.2 2000/03/17 07:13:34 mbryzek Exp
+# /www/intranet/employees/admin/history-edit.tcl
+# created: january 1st 2000
+# ahmedaa@mit.edu
+# Modified by mbryzek@arsdigita.com in January 2000 to support new group-based intranet
+
+# allows and administrator to edit the work percentage
+# history of an employee
+
+ad_maybe_redirect_for_registration
+
+set_form_variables 0
+# user_id 
+
+validate_integer user_id $user_id
+
+if { ![exists_and_not_null user_id] } {
+    ad_return_error "Missing user id" "We weren't able to determine what user you want information for."
+    return
+}
+
+set db [ns_db gethandle]
+
+# when did this user start
+set start_date [database_to_tcl_string_or_null $db \
+	"select start_date from im_employee_info where user_id = $user_id"]
+
+if { [empty_string_p $start_date] } {
+    set return_url history-edit.tcl?[export_url_vars user_id]
+    ad_return_error "Missing Start Date" "You must <a href=info-update.tcl?[export_url_vars user_id return_url]>set this employee's start date</a> before editing the history"
+    return
+}
+
+# Get the user's name and employment start date
+set selection [ns_db 1row $db \
+	"select initcap(u.first_names) || ' ' || initcap(u.last_name) as user_name, info.start_date
+          from users u, im_employee_info info
+         where u.user_id = $user_id
+           and u.user_id = info.user_id"]
+set_variables_after_query
+
+# Get the list of all the start blocks and percentages for this employee
+set selection [ns_db select $db \
+	"select percentage_time, start_block,
+                to_char(start_block, 'Month DDth, YYYY') as pretty_start_block
+           from im_employee_percentage_time 
+          where user_id = $user_id 
+            and percentage_time is not null 
+          order by start_block asc"]
+
+set list_of_changes_html ""
+
+set percentages [list 100 95 90 85 80 75 70 65 60 55 50 45 40 35 30 25 20 15 10 5 0]
+set old_percentage ""
+set counter 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { $counter == 0 } {
+	append list_of_changes_html "
+<tr>
+  <td valign=top>History starts on week beginning $pretty_start_block at $percentage_time %</td>
+</tr>
+"
+	incr counter
+    } else {
+	if { [string compare  $old_percentage $percentage_time] != 0 } {
+	    append list_of_changes_html "
+<tr>
+  <td>On week starting $pretty_start_block, changed to $percentage_time %</td>
+</tr>
+"
+        }
+        set old_percentage $percentage_time
+    } 
+}
+
+
+# Let's setup an html select box to get the next start_block 
+#   (that is, the next sunday including today if today is sunday)
+set selection [ns_db select $db \
+	"select to_char(start_block, 'DDth Month, YYYY') as start_block_pretty, start_block 
+           from im_start_blocks 
+          where start_block >= (select next_day(to_date('$start_date'::varchar,'YYYY-MM-DD'::varchar)- 60, 'SUNDAY') from dual)"]
+
+set block_start_html "<select name=start_block>\n"
+set block_end_html "<select name=stop_block>\n  <option value=\"forever\">Indefinite</option>"
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append block_end_html "  <option value=\"$start_block\"> $start_block_pretty</option>\n"
+    append block_start_html "  <option value=\"$start_block\"> $start_block_pretty</option>\n"
+}
+
+append block_end_html "</select>"
+append block_start_html "</select>"
+
+set page_title "Edit employee history"
+set context_bar [ad_context_bar [list "/" Home] [list "../index.tcl" "Intranet"] [list "index.tcl" "Employees" ] [list view.tcl?[export_url_vars user_id] "One employee"] [list "history.tcl?[export_url_vars user_id]" "History"] "Edit"]
+
+ReturnHeaders
+ns_write "
+[ad_partner_header]
+
+<h3>Current History:</h3>
+<table>
+[util_decode $list_of_changes_html "" "<tr><td><i>No history</i></td></tr>" $list_of_changes_html]
+</table>
+<br>
+<h3>Edit:</h3>
+<form method=post action=history-edit-2.tcl>
+[export_form_vars user_id]
+<table>
+<tr>
+<th align=right>Percentage working time:</th>
+<td><select name=percentage>
+[html_select_options $percentages [value_if_exists percentage]]
+</select>
+</td>
+</tr>
+
+<tr>
+ <th align=right>Starts at this percentage on:</th>
+<td>
+$block_start_html
+</td>
+</tr>
+
+<tr>
+ <th align=right>Will work at this percentage until:</th>
+<td>
+$block_end_html
+</td>
+</tr>
+
+<tr>
+<th valign=top align=right>Note:</th>
+<td>
+<textarea name=note cols=50 rows=5 wrap=soft></textarea
+</td>
+</tr>
+
+</table>
+<br>
+<center>
+<input type=submit value=\"Update history\">
+</center>
+</form>
+
+[ad_partner_footer]
+"
Index: web/openacs/www/intranet/employees/admin/history.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/employees/admin/history.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/employees/admin/history.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,137 @@
+# history.tcl,v 3.2.2.1 2000/03/17 07:25:58 mbryzek Exp
+#
+# File: /www/intranet/employees/admin/history.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+
+ad_maybe_redirect_for_registration
+
+set_form_variables 0
+# user_id 
+# return_url optional
+
+validate_integer user_id $user_id
+
+set db_list [ns_db gethandle main 2]
+set db [lindex $db_list 0]
+set db2 [lindex $db_list 1]
+
+# This page is restricted to only site/intranet admins or the user 
+if { ![im_is_user_site_wide_or_intranet_admin $db] } {
+    ns_returnredirect ../
+    return
+}
+
+set user_name [database_to_tcl_string_or_null $db \
+	"select first_names || ' ' || last_name from users where user_id=$user_id"]
+if { [empty_string_p $user_name] } {
+    ad_return_error "User #$user_id doesn't exist" "We couldn't find the user with user id of $user_id."
+    return
+}
+
+
+#make selection
+set selection [ns_db select $db \
+	"select percentage_time, to_char(start_block,'YYYY-MM-DD') as start_block
+           from im_employee_percentage_time 
+          where user_id = $user_id 
+            and start_block < to_date(sysdate(), 'YYYY-MM-DD'::varchar) 
+          order by start_block desc"]
+
+set result [list]
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    lappend result [list $start_block " " $percentage_time]
+}
+
+
+set user_name [database_to_tcl_string $db \
+	"select initcap(first_names) || ' ' || initcap(last_name) from users where user_id = $user_id"]
+
+set selection [ns_db select $db \
+	"select percentage_time, start_block ,
+                to_char(start_block, 'Month DDth, YYYY') as pretty_start_block
+           from im_employee_percentage_time 
+          where user_id = $user_id 
+            and percentage_time is not null 
+          order by start_block asc"]
+
+set list_of_changes_html ""
+set graph_return_html ""
+
+set percentages [list 100 95 90 85 80 75 70 65 60 55 50 45 40 35 30 25 20 15 10 5 0]
+
+set old_percentage ""
+set counter 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { $counter == 0 } {
+	set list_of_changes_html "<h4>Summary</h4><table>"
+	append list_of_changes_html "
+<tr>
+  <td valign=top>History starts on week beginning $pretty_start_block at ${percentage_time}%</td>
+</tr>
+"
+	incr counter
+    } else {
+	if { [string compare  $old_percentage $percentage_time] != 0 } {
+	    if { ![catch {set correct_grammar [database_to_tcl_string $db2 "select 'will change to' from dual where sysdate() < to_date('$start_block'::varchar, 'YYYY-MM-DD'::varchar)"] } errmsg] } {
+		
+	    } else {
+		set correct_grammar "changed to"
+	    }
+	    append list_of_changes_html "
+<tr>
+  <td>On week starting $pretty_start_block, $correct_grammar $percentage_time %</td>
+</tr>
+"
+        }
+    }
+    set old_percentage $percentage_time
+}
+ns_db releasehandle $db2
+
+append list_of_changes_html "</table>"
+
+set no_history_message_html ""
+
+if { $counter == 0 } {
+    set no_history_message_html "<br><br><blockquote>There is no percentage employment history for $user_name."
+    set start_date [database_to_tcl_string_or_null $db \
+	    "select (case when start_date is NULL then '' else to_char(start_date, 'Month DDth, YYYY') end) || 
+                    (case when percentage is NULL then '' else case when percentage = 0 then '' else ' at '||percentage||'%.' end end) as start_date 
+               from im_employee_info
+              where user_id =  $user_id"]
+
+    if { ![empty_string_p $start_date] } {
+	append no_history_message_html " It is known that he/she started on $start_date"
+    } else {
+	append no_history_message_html " This person's starting percentage is also not listed."
+    }
+    append no_history_message_html "</blockquote>\n"
+
+} else {
+    set graph_return_html "
+    <br><h4>Graph:up until [database_to_tcl_string $db "select to_char(sysdate(), 'Month DDth, YYYY') from dual"]</h4>
+    <br>
+    
+    [gr_sideways_bar_chart -bar_color_list "muted-green"  -display_values_p "t" -bar_height "10" -left_heading "<b><u>Week starting</u><b>"  -right_heading "<b><u>Percentage</u></b>" $result]
+"
+}
+
+ns_db releasehandle $db
+
+set page_title "Employee History for $user_name"
+set context_bar [ad_context_bar [list "/" Home] [list "../index.tcl" "Intranet"] [list "index.tcl" "Employees" ] [list view.tcl?[export_url_vars user_id] "One employee"] "History"]
+
+set page_body "
+(<a href=history-edit.tcl?[export_url_vars user_id]>Edit</a>)
+
+$no_history_message_html
+$list_of_changes_html
+$graph_return_html
+"
+
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/employees/admin/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/employees/admin/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/employees/admin/index.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,172 @@
+# index.tcl,v 3.3.2.4 2000/03/17 07:26:01 mbryzek Exp
+#
+# File: /www/intranet/employees/admin/index.tcl
+# Author: mbryzek@arsdigita.com, Jan 2000
+# Adminstrative view of all employees
+
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_form_variables 0
+# optional: status_id
+
+set db_list [ns_db gethandle main 2]
+set db [lindex $db_list 0]
+set db2 [lindex $db_list 1]
+
+set view_types "<b>Admin View</b> | <a href=../org-chart.tcl>Org Chart</a> | <a href=../index.tcl>Standard View</a>"
+
+set page_title "Employees"
+set context_bar [ad_context_bar [list "/" Home] [list ../../index.tcl "Intranet"] $page_title]
+
+ReturnHeaders
+ns_write "
+[ad_partner_header]
+
+<table width=100% cellpadding=0 cellspacing=0 border=0>
+  <tr><td align=right>$view_types</td></tr>
+</table>
+
+
+"
+
+set missing_html "<em>missing</em>"
+
+
+# set selection [ns_db select $db \
+# 	"select users.user_id , coalesce(info.salary, 0) as salary, users.last_name || ', ' || users.first_names as name,
+#                 info.supervisor_id, info.years_experience as n_years_experience, info.salary_period, info.referred_by, 
+#                 to_char(info.start_date,'Mon DD, YYYY') as start_date_pretty,
+#                 decode(info.project_lead_p, 't', 'Yes', 'No') as project_lead,
+#                 decode(info.team_leader_p, 't', 'Yes', 'No') as team_lead,
+#                 decode(supervisor_id, NULL, '$missing_html', s.first_names || ' ' || s.last_name) as supervisor_name,
+#                 decode(info.referred_by, NULL, '<em>nobody</em>', r.first_names || ' ' || r.last_name) as referral_name
+#            from users_active users, im_employee_info info, user_group_map ugm, users s, users r
+#           where users.user_id = ugm.user_id
+#             and ugm.group_id = [im_employee_group_id]
+#             and users.user_id = info.user_id(+) 
+#             and info.referred_by = r.user_id(+)
+#             and info.supervisor_id = s.user_id(+) 
+#        order by upper(name)"]
+
+# DRB: The original port of this query to Postgres was complex and worse had a
+# cartesian product buried somewhere within its multiple UNION clauses.
+
+# After looking looking at the datamodel I realized that the query really only
+# needed a single outer join, since the fields in im_employee_info reference
+# users (thus must be null or must references a real row in the users table).
+
+# This allows considerable simplification ... when outer joins become available,
+# though, we should make use of them as the subselects are slower.
+
+set selection [ns_db select $db \
+"select users.user_id , coalesce(info.salary, 0) as salary, users.last_name || ', ' || users.first_names as name,
+                info.supervisor_id, info.years_experience as n_years_experience, info.salary_period, info.referred_by, 
+                to_char(info.start_date,'Mon DD, YYYY') as start_date_pretty,
+                (case when info.project_lead_p = 't' then 'Yes'::varchar else 'No'::varchar end) as project_lead,
+                (case when info.team_leader_p = 't' then 'Yes'::varchar else 'No'::varchar end) as team_lead,
+                (case when supervisor_id is NULL then '$missing_html'
+                 else (select s.first_names || ' ' || s.last_name from users s where s.user_id=supervisor_id) end) as supervisor_name,
+                (case when info.referred_by is NULL then '<em>nobody</em>'
+                 else (select r.first_names || ' ' || r.last_name from users r where r.user_id=referred_by) end) as referral_name
+           from users_active users, im_employee_info info, user_group_map ugm
+          where users.user_id = ugm.user_id
+            and ugm.group_id = [im_employee_group_id]
+            and users.user_id = info.user_id
+union
+select users.user_id , 0 as salary, users.last_name || ', ' || users.first_names as name,
+                '' as supervisor_id, '' as n_years_experience, '' as salary_period, '' as referred_by, 
+                '' as start_date_pretty,
+                'No'::varchar as project_lead,
+                'No'::varchar as team_lead,
+                '<em>missing</em>' as supervisor_name,
+                '<em>nobody</em>' as referral_name
+           from users_active users, user_group_map ugm
+          where users.user_id = ugm.user_id
+            and ugm.group_id = [im_employee_group_id]
+            and not exists (select 1 from im_employee_info 
+                            where user_id = users.user_id)
+       order by upper(users.last_name),upper(users.first_names)"]
+
+set ctr 0
+set results ""
+set bgcolor(0) " bgcolor=\"[ad_parameter TableColorOdd Intranet white]\""
+set bgcolor(1) " bgcolor=\"[ad_parameter TableColorEven Intranet white]\""
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append results "
+<tr$bgcolor([expr $ctr % 2])>
+  <td valign=top>[ad_partner_default_font "size=-1"] <a href=view.tcl?[export_url_vars user_id]>$name</a> </font></td>
+  <td valign=top>[ad_partner_default_font "size=-1"]  
+"
+    append results "
+Supervisor: <a href=update-supervisor.tcl?[export_url_vars user_id]>$supervisor_name</a>
+<br>Experience: "    
+    if { [empty_string_p $n_years_experience] } {
+        append results $missing_html
+    } else {
+        append results "$n_years_experience [util_decode $n_years_experience 1 year years]"
+    }
+    append results "<br>Referred by: $referral_name"
+    append results "\n</font></td>\n"
+
+    if { ![catch {set new_time [database_to_tcl_string $db2 \
+	    "select percentage_time 
+               from im_employee_percentage_time 
+              where user_id = $user_id 
+                and start_block = to_date(next_day(sysdate() - 8, 'SUNDAY'), 'YYYY-MM-DD'::varchar)"]} errmsg] } {
+	set percentage $new_time
+    } else {
+	set percentage "x"
+    }
+
+    append results "
+  <td valign=top>[ad_partner_default_font "size=-1"]<center> <a href=history.tcl?[export_url_vars user_id]>$percentage</a> </center></font></td>
+  <td valign=top>[ad_partner_default_font "size=-1"]<center> [util_decode $start_date_pretty "" "&nbsp;" $start_date_pretty] </center></font></td>
+  <td valign=top>[ad_partner_default_font "size=-1"]<center> $team_lead </center></font></td>
+  <td valign=top>[ad_partner_default_font "size=-1"]<center> $project_lead </center></font></td>
+</tr>
+"
+    incr ctr
+}
+
+set intranet_admin_group_id [database_to_tcl_string $db \
+	"select group_id from user_groups where group_type='administration' and short_name='[ad_parameter IntranetGroupType intranet intranet]'"]
+
+ns_db releasehandle $db
+ns_db releasehandle $db2
+
+
+if { [empty_string_p $results] } {
+    set results "<ul><li><b> There are currently no employees</b></ul>\n"
+} else {
+    set results "
+<br>
+<table width=100% cellpadding=1 cellspacing=2 border=0>
+<tr bgcolor=\"[ad_parameter TableColorHeader intranet white]\">
+  <th valign=top>[ad_partner_default_font "size=-1"]Name</font></th>
+  <th valign=top>[ad_partner_default_font "size=-1"]Details</font></th>
+  <th valign=top>[ad_partner_default_font "size=-1"]Current<br>Percentage</font></th>
+  <th valign=top>[ad_partner_default_font "size=-1"]Start Date</font></th>
+  <th valign=top>[ad_partner_default_font "size=-1"]Team Leader?</font></th>
+  <th valign=top>[ad_partner_default_font "size=-1"]Project Leader?</font></th>
+</tr>
+$results
+</table>
+"
+}
+
+
+ns_write "
+$results
+<p> 
+<ul>
+  <li> <a href=referral.tcl>Referral Summary Page</a>
+  <li> <a href=/groups/member-add.tcl?role=member&return_url=[ad_partner_url_with_query]&group_id=[im_employee_group_id]>Add an employee</a>
+  <li> <a href=/groups/member-add.tcl?role=administrator&return_url=[ad_partner_url_with_query]&group_id=$intranet_admin_group_id>Add an Intranet administrator</a>
+</ul>
+
+[ad_partner_footer]
+"
Index: web/openacs/www/intranet/employees/admin/info-update-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/employees/admin/info-update-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/employees/admin/info-update-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,85 @@
+# info-update-2.tcl,v 3.1.2.2 2000/03/17 07:26:02 mbryzek Exp
+#
+# File: /www/intranet/employess/admin/info-update-2.tcl
+# Author: mbryzek@arsdigita.com, Jan 2000
+# Write employee information to db
+
+set_form_variables 0
+# dp variables
+# select_referred_by
+
+set exception_count 0
+
+if { ![exists_and_not_null dp.im_employee_info.user_id] } {
+    ad_return_error "Missing user id" "We weren't able to determine for what user you want information."
+    return
+}
+
+set user_id ${dp.im_employee_info.user_id}
+
+validate_integer user_id $user_id
+
+set form_setid [ns_getform]
+
+if [catch {ns_dbformvalue [ns_conn form] start_date date start_date}] {
+    incr exception_count
+    append exception_text "<li>The start date is invalid"
+} else {
+    ns_set put $form_setid dp.im_employee_info.start_date $start_date
+}
+
+#ns_log Debug "start date = $start_date"
+
+
+if [catch {ns_dbformvalue [ns_conn form] most_recent_review date most_recent_review}] {
+    incr exception_count
+    append exception_text "<li>The recent review review date is invalid"
+} else {
+    ns_set put $form_setid dp.im_employee_info.most_recent_review $most_recent_review
+}
+
+set db [ns_db gethandle]
+
+# This page is restricted to only site/intranet admins
+if { ![im_is_user_site_wide_or_intranet_admin $db] } {
+    ns_returnredirect ../
+    return
+}
+
+if {[string length ${dp.users.bio}] > 4000} {
+    incr exception_count
+    append exception_text "<li>Please limit the bio to 4000 characters"
+}
+
+if {[string length ${dp.im_employee_info.job_description}] > 4000} {
+    incr exception_count
+    append exception_text "<li>Please limit the job description to 4000 characters"
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+# get the old salary period
+ns_set put $form_setid dp.im_employee_info.salary_period [im_salary_period_input]
+
+with_transaction $db {
+
+    dp_process -db $db -where_clause "user_id=$user_id"
+} { ns_log Error "transaction failed" }
+
+if { ![exists_and_not_null return_url] } {
+    set return_url "[im_url_stub]/employees/admin/view.tcl?[export_url_vars user_id]"
+}
+
+if { [exists_and_not_null select_referred_by] && $select_referred_by == "t" } {
+    # Need to redirect to the user search page
+    set target "[im_url_stub]/employees/admin/info-update-referral.tcl"
+    set passthrough "return_url employee_id"
+    set employee_id $user_id
+    ns_returnredirect "../../user-search.tcl?[export_url_vars passthrough target return_url employee_id]"
+} else {
+    ns_returnredirect $return_url
+}
Index: web/openacs/www/intranet/employees/admin/info-update-referral.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/employees/admin/info-update-referral.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/employees/admin/info-update-referral.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,32 @@
+# info-update-referral.tcl,v 3.2.2.2 2000/03/17 07:26:04 mbryzek Exp
+#
+# File: /www/intranet/employess/admin/info-referral.tcl
+# Author: mbryzek@arsdigita.com, Jan 2000
+# Write employee information regarding referrals to db
+
+set_form_variables 0
+# employee_id
+# user_id_from_search
+# return_url (optional)
+
+validate_integer employee_id $employee_id
+validate_integer user_id_from_search $user_id_from_search
+
+set user_id [value_if_exists employee_id]
+
+if { ![exists_and_not_null return_url] } {
+    set return_url "view.tcl?[export_url_vars user_id]"
+}
+
+# Blank user id means no referral
+if { [empty_string_p $user_id_from_search] } {
+    set user_id_from_search null
+}
+
+if { [exists_and_not_null employee_id] && [exists_and_not_null user_id_from_search] } {
+    set db [ns_db gethandle]
+    ns_db dml $db "update im_employee_info set referred_by=$user_id_from_search where user_id=$employee_id"
+    ns_db releasehandle $db
+}
+
+ns_returnredirect $return_url
Index: web/openacs/www/intranet/employees/admin/info-update.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/employees/admin/info-update.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/employees/admin/info-update.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,231 @@
+# info-update.tcl,v 3.5.2.2 2000/03/17 07:26:06 mbryzek Exp
+#
+# File: /www/intranet/employees/admin/info-update.tcl
+# Author: mbryzek@arsdigita.com, Jan 2000
+# Allows admin to update an employees info
+
+ad_maybe_redirect_for_registration
+
+set_form_variables 0
+# user_id 
+# return_url (optional)
+
+if { ![exists_and_not_null user_id] } {
+    ad_return_error "Missing user id" "We weren't able to determine what user you want information for."
+    return
+}
+
+validate_integer user_id $user_id
+
+set calling_user_id $user_id
+
+set db [ns_db gethandle]
+
+set percentages [list 100 95 90 85 80 75 70 65 60 55 50 45 40 35 30 25 20 15 10 5 0]
+
+
+# set selection [ns_db 0or1row $db \
+# 	"select users.*, info.*
+#            from users, im_employee_info info
+#           where users.user_id = info.user_id(+)
+#             and users.user_id = $calling_user_id"]
+
+set sql "\
+select users.*, info.*
+            from users, im_employee_info_view info
+           where users.user_id = info.user_id
+             and users.user_id = $calling_user_id
+union
+select users.*, info.*
+            from users, im_employee_info_null info
+           where not exists (select 1 from im_employee_info
+                             where user_id = users.user_id)
+             and users.user_id = $calling_user_id"
+
+set selection [ns_db 0or1row $db $sql]
+
+if [empty_string_p $selection] {
+    ad_return_error "Error" "That user doesn't exist"
+    return
+} 
+set_variables_after_query
+
+set office_id [database_to_tcl_string_or_null $db \
+	"select group_id
+           from im_offices
+          where ad_group_member_p ( $calling_user_id, group_id ) = 't'"]
+
+set office_sql \
+	"select g.group_name, g.group_id
+           from user_groups g, im_offices o
+          where o.group_id=g.group_id
+       order by lower(g.group_name)"
+
+set offices_html "
+<select name=office_id>
+<option value=\"\"> -- Please select --
+[ad_db_optionlist $db $office_sql [value_if_exists office_id]]
+</select>
+"
+
+
+set salary_period_input [im_salary_period_input]
+if { [empty_string_p $salary_period_input] } {
+    set salary_period_input month
+}
+
+if { ![exists_and_not_null start_date] } {
+    set start_date [database_to_tcl_string $db "select to_char(sysdate(),'YYYY-MM-DD') from dual"]
+}
+
+if { ![info exists most_recent_review] || [empty_string_p $most_recent_review] } {
+    set most_recent_review_html "
+    <tr>
+    <th align=right valign=top>Most recent review</th>
+    <td>
+    [ad_dateentrywidget most_recent_review [value_if_exists most_recent_review]]
+    </td>
+    </tr>"
+
+} else {
+    set most_recent_review_html "
+    <tr>
+    <th align=right valign=top>Most recent review</th>
+    <td>
+    [ad_dateentrywidget most_recent_review [value_if_exists most_recent_review]]
+    </td>
+    </tr>
+    "
+
+}
+
+set page_title "Edit \"$first_names $last_name\""
+set context_bar [ad_context_bar [list "/" Home] [list ../../index.tcl "Intranet"] [list index.tcl "Employees"] [list view.tcl?[export_url_vars user_id] "One employee"] "Edit employee"]
+
+ReturnHeadersNoCache 
+ns_write "
+[ad_partner_header]
+<form method=post action=info-update-2.tcl>
+[export_form_vars return_url]
+<input type=hidden name=dp.im_employee_info.user_id value=$calling_user_id>
+
+<table cellpadding=3>
+
+<tr>
+  <th align=right>Salary (per $salary_period_input):</th>
+  <td>\$<input name=dp.im_employee_info.salary.money size=10 [export_form_value salary]></TD>
+</tr>
+
+<tr>
+  <th align=right>Office:</th>
+  <td>$offices_html</td>
+</tr>
+
+<tr>
+  <th align=right>Job title:</th>
+  <td><input name=dp.im_employee_info.job_title size=30 [export_form_value job_title]></td>
+</tr>
+
+<tr>
+  <th align=right>Start date:</th>
+  <td>[ad_dateentrywidget start_date [value_if_exists start_date]]</td>
+</tr>
+
+<tr>
+ <th align=right>Manages group:</th><td><input name=dp.im_employee_info.group_manages size=30 [export_form_value group_manages]>
+</tr>
+
+<tr>
+ <th align=right>Team leader?</th>
+<td><input type=radio name=dp.im_employee_info.team_leader_p value=t[util_decode [value_if_exists team_leader_p] t " checked" ""]> Yes
+    <input type=radio name=dp.im_employee_info.team_leader_p value=f[util_decode [value_if_exists team_leader_p] t "" " checked"]>No
+</td>
+</tr>
+
+<tr>
+ <th align=right>Project lead?</th>
+<td><input type=radio name=dp.im_employee_info.project_lead_p value=t[util_decode [value_if_exists project_lead_p] t " checked" ""]> Yes
+<input type=radio name=dp.im_employee_info.project_lead_p value=f[util_decode [value_if_exists project_lead_p] t "" " checked"]>No
+</tr>
+
+<tr>
+ <th align=right>Select Referred By?</th>
+<td><input type=radio name=select_referred_by value=t> Yes
+    <input type=radio name=select_referred_by value=f checked> No
+</td>
+</tr>
+
+<tr>
+ <TH align=right valign=top>Job Description:</th>
+ <TD>
+ <TEXTAREA name=dp.im_employee_info.job_description COLS=40 ROWS=6 WRAP=SOFT>[philg_quote_double_quotes $job_description]</TEXTAREA>
+ </TD>
+</TR>
+
+<tr>
+<th align=right valign=top>Received offer letter?</th>
+<td>
+<input type=radio name=dp.im_employee_info.received_offer_letter_p value=t[util_decode [value_if_exists received_offer_letter_p] t " checked" ""]> Yes
+<input type=radio name=dp.im_employee_info.received_offer_letter_p value=f[util_decode [value_if_exists received_offer_letter_p] t "" " checked"]>No
+</td>
+</tr>
+
+<tr>
+<th align=right valign=top>Returned offer letter?</th>
+<td>
+<input type=radio name=dp.im_employee_info.returned_offer_letter_p value=t[util_decode [value_if_exists returned_offer_letter_p] t " checked" ""]> Yes
+<input type=radio name=dp.im_employee_info.returned_offer_letter_p value=f[util_decode [value_if_exists returned_offer_letter_p] t "" " checked"]>No
+</td>
+</tr>
+
+<tr>
+<th align=right valign=top>Signed cc agreement?</th>
+<td>
+<input type=radio name=dp.im_employee_info.signed_confidentiality_p value=t[util_decode [value_if_exists signed_confidentiality_p] t " checked" ""]> Yes
+<input type=radio name=dp.im_employee_info.signed_confidentiality_p value=f[util_decode [value_if_exists signed_confidentiality_p] t "" " checked"]>No
+</td>
+</tr>
+
+$most_recent_review_html
+
+<tr>
+<th align=right valign=top>Most recent review in folder?</th>
+<td>
+<input type=radio name=dp.im_employee_info.most_recent_review_in_folder_p value=t[util_decode [value_if_exists most_recent_review_in_folder_p] t " checked" ""]> Yes
+<input type=radio name=dp.im_employee_info.most_recent_review_in_folder_p value=f[util_decode [value_if_exists most_recent_review_in_folder_p] t "" " checked"]>No
+</td>
+</tr>
+
+<tr>
+ <TH align=right valign=top>Biography:</th>
+ <TD>
+ <textarea name=dp.users.bio cols=40 rows=6 wrap=soft>[philg_quote_double_quotes $bio]</TEXTAREA>
+ </TD>
+</TR>
+
+<tr>
+ <TH align=right valign=top>Featured Employee Blurb:</th>
+ <TD>
+ <textarea name=dp.im_employee_info.featured_employee_blurb cols=40 rows=6 wrap=soft>[philg_quote_double_quotes $featured_employee_blurb]</TEXTAREA>
+ </TD>
+</TR>
+
+
+<tr>
+<th align=right valign=top>Blurb Approved?</th>
+<td>
+<input type=radio name=dp.im_employee_info.featured_employee_approved_p value=t[util_decode [value_if_exists featured_employee_approved_p] t " checked" ""]> Yes
+<input type=radio name=dp.im_employee_info.featured_employee_approved_p value=f[util_decode [value_if_exists featured_employee_approved_p] t "" " checked"]>No
+</td>
+</tr>
+
+
+</table>
+
+<P><center>
+<input type=submit value=Update>
+</center>
+</form>
+
+[ad_footer]
+"
Index: web/openacs/www/intranet/employees/admin/referral-details.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/employees/admin/referral-details.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/employees/admin/referral-details.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,51 @@
+# referral-details.tcl,v 3.1.2.2 2000/03/17 07:26:09 mbryzek Exp
+# File: /www/intranet/employees/admin/referral-details.tcl
+# Author: mbryzek@arsdigita.com, Mar 2000
+# Summary view of all the people a particular employee has referred
+
+set_form_variables 0
+
+# referred_by
+
+if { ![exists_and_not_null referred_by] } {
+    ns_returnredirect referral.tcl
+    return
+}
+
+validate_integer referred_by $referred_by
+
+set db [ns_db gethandle]
+set user_name [database_to_tcl_string $db \
+	"select first_names || ' ' || last_name from users where user_id=$referred_by"]
+
+set page_title "Employee Referrals for $user_name"
+set context_bar [ad_context_bar [list "/" Home] [list ../../index.tcl "Intranet"] [list index.tcl Employees] [list referral.tcl "Referrals"] "Referral Details"]
+
+
+set selection [ns_db select $db \
+	"select u.first_names||' '||u.last_name as user_name, u.user_id
+           from users_active u, im_employee_info info
+          where u.user_id=info.user_id
+            and info.referred_by=$referred_by
+          order by lower(first_names),lower(last_name)"]
+
+
+set results ""
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append results "  <li> <a href=[im_url_stub]/users/view.tcl?[export_url_vars user_id]>$user_name</a>"
+}
+
+ns_db releasehandle $db
+
+if { [empty_string_p $results] } {
+    set results "  <li> There have been no referrals\n"
+}
+
+set page_body "
+<ul>
+$results
+</ul>
+"
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/employees/admin/referral.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/employees/admin/referral.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/employees/admin/referral.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,46 @@
+# referral.tcl,v 3.1.2.2 2000/03/17 07:26:09 mbryzek Exp
+#
+# File: /www/intranet/employess/admin/referral.tcl
+# Author: mbryzek@arsdigita.com, Mar 2000
+# Referral summary page - lists each employee and the number of people 
+# that person referred. 
+
+set db [ns_db gethandle]
+# set selection [ns_db select $db \
+# 	 "select u.user_id, u.first_names||' '||u.last_name as user_name, x.count 
+#             from (select info.referred_by, count(1) as count
+#                     from im_employee_info info
+#                    where referred_by is not null
+#                    group by info.referred_by) x, users_active u
+#            where x.referred_by=u.user_id
+#            order by lower(last_name), lower(first_names)"]
+
+
+set selection [ns_db select $db \
+	 "select u.user_id, u.first_names||' '||u.last_name as user_name, im_employee_referals(info.referred_by) as count 
+            from im_employee_info info, users_active u
+           where info.referred_by=u.user_id
+           order by lower(last_name), lower(first_names)"]
+
+set results ""
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append results "  <li> $user_name: <a href=referral-details.tcl?referred_by=$user_id>[util_commify_number $count]</a>\n"
+}
+
+ns_db releasehandle $db
+
+if { [empty_string_p $results] } {
+    set results "  <li> There have been no referrals\n"
+}
+
+set page_title "Employee Referrals"
+set context_bar [ad_context_bar [list "/" Home] [list ../../index.tcl "Intranet"] [list index.tcl Employees] "Referrals"]
+
+set page_body "
+<ul>
+$results
+</ul>
+"
+
+ns_return 200 text/html [ad_partner_return_template]
\ No newline at end of file
Index: web/openacs/www/intranet/employees/admin/update-supervisor-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/employees/admin/update-supervisor-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/employees/admin/update-supervisor-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,34 @@
+# update-supervisor-2.tcl,v 3.0.4.1 2000/03/17 07:26:10 mbryzek Exp
+#
+# File: /www/intranet/employees/admin/update-supervisor-2.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# writes employee's supervisor to db
+# 
+
+set db [ns_db gethandle]
+
+set_the_usual_form_variables
+# user_id, supervisor_id (dp variables)
+
+validate_integer user_id $dp.im_employee_info.user_id
+validate_integer supervisor_id $dp.im_employee_info.supervisor_id
+
+# We use data pipeline to not worry about updates vs inserts
+
+if { ![exists_and_not_null dp.im_employee_info.user_id] } {
+    ad_return_error "Browser broken" "Your browser is broken or our code is.  We didn't see a user_id for the user you're trying to update."
+    return
+}
+
+with_transaction $db {
+
+    dp_process -db $db -where_clause "user_id=${dp.im_employee_info.user_id}"
+} { ns_log Error "transaction failed" }
+
+if { [exists_and_not_null return_url] } {
+    ns_returnredirect $return_url
+} else {
+    ns_returnredirect index.tcl
+}
Index: web/openacs/www/intranet/employees/admin/update-supervisor.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/employees/admin/update-supervisor.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/employees/admin/update-supervisor.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,149 @@
+# update-supervisor.tcl,v 3.2.2.1 2000/03/17 07:26:11 mbryzek Exp
+#
+# File: /www/intranet/employees/admin/update-supervisor.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# present employee's current supervisor and options to update it
+# 
+
+set db [ns_db gethandle]
+
+set_the_usual_form_variables
+# user_id
+
+validate_integer user_id $user_id
+
+set caller_user_id $user_id
+
+# get information about employee and current supervisor
+
+# set sql "\
+# select 
+#   u.first_names, 
+#   u.last_name, 
+#   u.email, 
+#   info.*, 
+#   supervisors.user_id as supervisor_user_id, 
+#   supervisors.first_names || ' ' || supervisors.last_name as supervisor_name
+# from users u, im_employee_info info, users supervisors
+# where u.user_id = $caller_user_id
+# and u.user_id = info.user_id(+)
+# and info.supervisor_id = supervisors.user_id(+)"
+
+set sql "\
+select 
+  u.first_names, 
+  u.last_name, 
+  u.email, 
+  info.*, 
+  info.supervisor_id as supervisor_user_id,
+  (case when info.supervisor_id is null then null
+   else (select s.first_names || ' ' || s.last_name
+   from users s where s.user_id=info.supervisor_id) end) as supervisor_name
+from users u, im_employee_info_view info
+where u.user_id = $caller_user_id
+and u.user_id = info.user_id
+union
+select 
+  u.first_names, 
+  u.last_name, 
+  u.email, 
+  null as user_id,
+  null as job_title,
+  null as job_description,
+  null as team_leader_p,
+  null as project_lead_p,
+  null as percentage,
+  null as supervisor_id,
+  null as group_manages,
+  null as current_information,
+  null as last_modified,
+  null as ss_number,
+  null as salary,
+  null as salary_period,
+  null as dependant_p,
+  null as only_job_p,
+  null as married_p,
+  null as dependants,
+  null as head_of_household_p,
+  null as birthdate,
+  null as skills,
+  null as first_experience,
+  null as years_experience,
+  null as educational_history,
+  null as last_degree_completed,
+  null as resume,
+  null as resume_html_p,
+  null as start_date,
+  null as received_offer_letter_p,
+  null as returned_offer_letter_p,
+  null as signed_confidentiality_p,
+  null as most_recent_review,
+  null as most_recent_review_in_folder_p,
+  null as featured_employee_approved_p,
+  null as featured_employee_approved_by,
+  null as featured_employee_blurb,
+  null as featured_employee_blurb_html_p,
+  null as referred_by,
+  null as supervisor_user_id, 
+  null as supervisor_name
+from users u
+where u.user_id = $caller_user_id
+and not exists (select 1 from im_employee_info_view info 
+                where u.user_id = info.user_id)"
+
+set selection [ns_db 0or1row $db $sql ]
+
+if { [empty_string_p $selection] } {
+    ad_return_error "Error" "That user doesn't exist"
+    return
+}
+
+set_variables_after_query
+
+set page_title "Update supervisor for $first_names $last_name"
+set context_bar [ad_context_bar [list "/" Home] [list "../../" "Intranet"] [list "view.tcl?user_id=$caller_user_id" "Employee information"] "Update Supervisor"]
+
+ReturnHeaders
+ns_write "
+[ad_partner_header]
+Name:  $first_names $last_name (<a href=\"mailto:$email\">$email</a>)
+
+<blockquote>
+<p>
+
+"
+
+if [empty_string_p $supervisor_user_id] {
+    ns_write "<i>This employee currently has no supervisor!  I hope this is the CEO.</i>\n<P>\n\n"
+}
+
+set sql "select u.last_name || ', ' || u.first_names as name, u.user_id
+from users u, im_employee_info info
+where u.user_id <> $caller_user_id
+and u.user_id = info.user_id
+and ad_group_member_p ( u.user_id, [im_employee_group_id] ) = 't'
+union
+select u.last_name || ', ' || u.first_names as name, u.user_id
+from users u
+where u.user_id <> $caller_user_id
+and not exists (select 1 from im_employee_info 
+                where user_id = u.user_id )
+and ad_group_member_p ( u.user_id, [im_employee_group_id] ) = 't'
+order by upper(u.last_name)"
+
+
+ns_write "
+<form method=get action=update-supervisor-2.tcl>
+<input type=hidden name=dp.im_employee_info.user_id value=\"$caller_user_id\">
+<select name=dp.im_employee_info.supervisor_id>
+<option value=\"\"> None
+[ad_db_optionlist $db $sql $supervisor_user_id]
+</select>
+
+<input type=submit value=\"Update\">
+</form>
+</blockquote>
+[ad_partner_footer]
+"
Index: web/openacs/www/intranet/employees/admin/user-remove-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/employees/admin/user-remove-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/employees/admin/user-remove-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,26 @@
+# user-remove-2.tcl,v 1.1.2.3 2000/03/17 07:26:12 mbryzek Exp
+#
+# File: /www/intranet/employess/admin/user-remove-2.tcl
+# Author: mbryzek@arsdigita.com, 3/15/2000
+# removes specified user_id from all groups of type intranet
+
+set_form_variables 0
+# user_id
+
+validate_integer user_id $user_id
+
+if { [exists_and_not_null user_id] } {
+    set db [ns_db gethandle]
+    
+    ns_db dml $db "delete from user_group_map ugm 
+                    where ugm.user_id='$user_id' 
+                      and exists (select 1 
+                                    from user_groups ug 
+                                   where ug.group_id=ugm.group_id 
+                                     and ug.group_type='[ad_parameter IntranetGroupType intranet intranet]')"
+
+
+    ns_db releasehandle $db
+}
+
+ns_returnredirect index.tcl
\ No newline at end of file
Index: web/openacs/www/intranet/employees/admin/user-remove-cancel.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/employees/admin/user-remove-cancel.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/employees/admin/user-remove-cancel.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,17 @@
+# user-remove-cancel.tcl,v 1.1.2.3 2000/03/17 07:26:13 mbryzek Exp
+#
+# File: /www/intranet/employess/admin/user-remove-cancel.tcl
+# Author: mbryzek@arsdigita.com, 3/15/2000
+# Cancels user removal by redirecting to return_url or standard employee view
+
+set_form_variables 0
+# user_id
+# return_url (optional)
+
+validate_integer user_id $user_id
+
+if { ![exists_and_not_null return_url] } {
+    set return_url view.tcl?[export_url_vars user_id]
+}
+
+ns_returnredirect $return_url
\ No newline at end of file
Index: web/openacs/www/intranet/employees/admin/user-remove.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/employees/admin/user-remove.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/employees/admin/user-remove.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,39 @@
+# user-remove.tcl,v 1.1.2.3 2000/03/17 07:26:13 mbryzek Exp
+#
+# File: /www/intranet/employess/admin/user-remove.tcl
+# Author: mbryzek@arsdigita.com, 3/15/2000
+# Confirmation to remove specified user from all intranet groups
+
+set_form_variables 0
+# user_id
+# return_url (optional)
+
+if { ![exists_and_not_null user_id] } {
+    ad_return_error "Missing user id!" "We are missing the user_id of the person you want to remove. Please back up, hit reload, and try again."
+    return
+}
+
+validate_integer user_id $user_id
+
+set db [ns_db gethandle]
+
+set user_name [database_to_tcl_string_or_null $db \
+	"select first_names || ' ' || last_name from users where user_id='$user_id'"]
+
+if { [empty_string_p $user_name] } {
+    ad_return_error "User #$user_id Not Found" "We can't find a user with an id of $user_id. This user has probably been removed from the system"
+    return
+}
+
+ns_db releasehandle $db
+
+set page_title "Confirm removal"
+set context_bar [ad_context_bar [list "/" Home] [list ../../index.tcl "Intranet"] [list index.tcl "Employees"] [list view.tcl?[export_url_vars user_id] "One employee"] $page_title]
+
+set page_body "
+Do you really want to remove $user_name from all intranet groups?
+
+[im_yes_no_table user-remove-2.tcl user-remove-cancel.tcl [list user_id return_url]]
+"
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/employees/admin/view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/employees/admin/view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/employees/admin/view.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,239 @@
+# view.tcl,v 3.5.2.3 2000/03/17 07:26:14 mbryzek Exp
+#
+# File: /www/intranet/employess/admin/view.tcl
+# Author: mbryzek@arsdigita.com, Jan 2000
+# Adminstrative view of one employees
+# 
+
+ad_maybe_redirect_for_registration
+
+set_form_variables 0
+# user_id 
+# return_url optional
+
+if { ![exists_and_not_null user_id] } {
+    ad_return_error "Missing user id" "We weren't able to determine what user you want information for."
+    return
+}
+
+validate_integer user_id $user_id
+
+if { ![exists_and_not_null return_url] } {
+    set return_url [ad_partner_url_with_query]
+}
+
+set caller_user_id $user_id 
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "
+select 
+  u.first_names, 
+  u.last_name, 
+  u.email, 
+  u.bio,
+  (case when u.user_state = 'banned' then 'banned' else case when u.user_state = 'deleted' then 'deleted' else ''::varchar end end) as user_state,
+  info.*, 
+  info.referred_by as referral_id,
+  (case when info.referred_by is null then null
+   else (select r.first_names || ' ' || r.last_name
+         from users r where r.user_id = info.referred_by) end) as referral_name,
+  info.supervisor_id as supervisor_user_id, 
+  (case when info.supervisor_id is null then null
+   else (select s.first_names || ' ' || s.last_name
+         from users s where s.user_id = info.supervisor_id) end) as supervisor_name
+from users u, im_employee_info_view info
+where u.user_id = $user_id
+and u.user_id = info.user_id
+and ad_group_member_p ( u.user_id, [im_employee_group_id] ) = 't'
+union
+select 
+  u.first_names, 
+  u.last_name, 
+  u.email, 
+  u.bio,
+  (case when u.user_state = 'banned' then 'banned' else case when u.user_state = 'deleted' then 'deleted' else ''::varchar end end) as user_state,
+  null as user_id,
+  null as job_title,
+  null as job_description,
+  null as team_leader_p,
+  null as project_lead_p,
+  null as percentage,
+  null as supervisor_id,
+  null as group_manages,
+  null as current_information,
+  null as last_modified,
+  null as ss_number,
+  null as salary,
+  null as salary_period,
+  null as dependant_p,
+  null as only_job_p,
+  null as married_p,
+  null as dependants,
+  null as head_of_household_p,
+  null as birthdate,
+  null as skills,
+  null as first_experience,
+  null as years_experience,
+  null as educational_history,
+  null as last_degree_completed,
+  null as resume,
+  null as resume_html_p,
+  null as start_date,
+  null as received_offer_letter_p,
+  null as returned_offer_letter_p,
+  null as signed_confidentiality_p,
+  null as most_recent_review,
+  null as most_recent_review_in_folder_p,
+  null as featured_employee_approved_p,
+  null as featured_employee_approved_by,
+  null as featured_employee_blurb,
+  null as featured_employee_blurb_html_p,
+  null as referred_by,
+  null as referral_id,
+  null as referral_name,
+  null as supervisor_user_id, 
+  null as supervisor_name
+from users u
+where u.user_id = $user_id
+and not exists (select 1 from im_employee_info_view info 
+                where u.user_id = info.user_id)"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Error" "That user doesn't exist"
+    return
+}
+set_variables_after_query
+
+# We keep offices separate as their is a chance of having more than one right now (because
+# of our use of the user_group_map table
+set selection [ns_db select $db \
+	"select ug.group_name, ug.group_id
+           from user_groups ug
+          where ad_group_member_p ( $caller_user_id, ug.group_id ) = 't'
+            and ug.parent_group_id = [im_office_group_id]"]
+
+set office ""
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { ![empty_string_p $office] } {
+	append office ", "
+    }
+    append office "  <a href=../../offices/view.tcl?[export_url_vars group_id]>$group_name</A>\n"
+}
+
+
+
+
+proc display_salary {salary salary_period} {
+
+    set display_pref [im_salary_period_display]
+
+    switch $salary_period {
+        month {
+	    if {$display_pref == "month"} {
+                 return "[format %6.2f $salary] per month"
+            } elseif {$display_pref == "year"} {
+                 return "\$[format %6.2f [expr $salary * 12]] per year"
+            } else {
+                 return "\$[format %6.2f $salary] per $salary_period"
+            }
+        }
+        year {
+	    if {$display_pref == "month"} {
+                 return "[format %6.2f [expr $salary/12]] per month"
+            } elseif {$display_pref == "year"} {
+                 return "\$[format %6.2f $salary] per year"
+            } else {
+                 return "\$[format %6.2f $salary] per $salary_period"
+            }
+        }
+        default {
+            return "\$[format %6.2f $salary] per $salary_period"
+        }
+    }
+}
+
+set page_title "$first_names $last_name"
+set context_bar [ad_context_bar [list "/" Home] [list ../../index.tcl "Intranet"] [list index.tcl "Employees"] "One employee"]
+
+ns_db releasehandle $db
+
+ReturnHeaders
+ns_write [ad_partner_header]
+
+if { [empty_string_p $job_title] } {
+    set job_title "<em>(No information)</em>"
+}
+
+if [empty_string_p $salary] {
+    set salary "<em>(No information)</em>"
+} else {
+    set salary [display_salary $salary $salary_period]
+}
+
+if { ![empty_string_p $supervisor_user_id] } {
+    set supervisor_link "<a href=view.tcl?user_id=$supervisor_user_id>$supervisor_name</a>"
+} else {
+    set supervisor_link "<em>(No information)</em>"
+}
+
+ns_write "<UL>
+<LI>Job title: $job_title
+<li>Office: $office
+<LI>Supervisor:  $supervisor_link 
+(<a href=update-supervisor.tcl?user_id=$caller_user_id>update</a>)
+<LI>Salary: $salary
+ -- <A HREF=../payroll.tcl?user_id=$caller_user_id&[export_url_vars return_url]>payroll information</A>
+<li>Team leader? [util_decode t $team_leader_p "Yes" "No"]
+<li>Project lead? [util_decode t $project_lead_p "Yes" "No"]
+<li>Referred by: "
+
+if { ![empty_string_p $referred_by] } {
+    set target "[im_url_stub]/employees/admin/info-update-referral.tcl"
+    set passthrough "return_url employee_id"
+    set employee_id $caller_user_id
+    ns_write "<a href=[im_url_stub]/users/view.tcl?user_id=$referral_id>$referral_name</a> 
+(<a href=../../user-search.tcl?[export_url_vars passthrough target return_url employee_id]>update</a> | 
+ <a href=info-update-referral.tcl?user_id_from_search=&[export_url_vars employee_id return_url]>clear</a> )\n"
+}
+
+ns_write "
+
+<li>Percentage:  $percentage (<a href=history.tcl?user_id=$caller_user_id>history</a>)
+
+<li>Job description: $job_description
+<li>Start date: [util_AnsiDatetoPrettyDate $start_date]
+<li>Manages group: $group_manages
+<li>Received offer letter: [util_decode t $received_offer_letter_p "Yes" "No"]
+<li>Returned offer letter: [util_decode t $returned_offer_letter_p "Yes" "No"]
+<li>Signed confidentiality agreement: [util_decode t $signed_confidentiality_p "Yes" "No"]
+<li>Most recent review: [util_AnsiDatetoPrettyDate $most_recent_review]
+<li>Most recent review in folder? : [util_decode t $most_recent_review_in_folder_p "Yes" "No"]
+<li>Biography: 
+<blockquote>
+$bio
+</blockquote>
+<li> Years experience: $years_experience
+<li> Eductional history: $educational_history
+<li> Last degree completed: $last_degree_completed
+<li>Featured Employee Blurb:
+<blockquote>
+$featured_employee_blurb
+</blockquote>
+<li>Blurb approved? [util_decode t $featured_employee_approved_p "Yes" "No"]
+<p>
+(<a href=info-update.tcl?user_id=$caller_user_id>edit</a>)
+
+</ul>
+"
+
+if { ![empty_string_p $user_state] } {
+    ns_write "This user is currently <a href=/admin/users/one.tcl?user_id=$caller_user_id>$user_state</a>."
+} else {
+    ns_write "If this person has left the company, you can <a href=user-remove.tcl?user_id=$caller_user_id&[export_url_vars return_url]>remove</a> him/her from all intranet groups, or you can 
+<a href=/admin/users/delete.tcl?user_id=$caller_user_id&[export_url_vars return_url]>ban him/her from the system</a>.
+"
+
+}
+
+ns_write [ad_partner_footer]
Index: web/openacs/www/intranet/hours/ae-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/hours/ae-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/hours/ae-2.tcl	17 Apr 2001 14:05:17 -0000	1.1
@@ -0,0 +1,70 @@
+# ae-2.tcl,v 3.0.4.1 2000/03/17 08:22:55 mbryzek Exp
+# File: /www/intranet/hours/ae-2.tcl
+#
+# Author: dvr@arsdigita.com, Sep 1999
+# 
+# Writes hours to db. 
+#
+
+ad_maybe_redirect_for_registration
+set user_id [ad_get_user_id]
+
+set_the_usual_form_variables
+# on_which_table
+# at least one hours_<id>.<column> field
+
+set db [ns_db gethandle]
+
+foreach var [info vars "hours_*"] {
+
+    if { [regexp {^hours_([0-9]+).*$} $var match on_what_id] } {
+
+	validate_integer on_what_id $on_what_id
+
+	set hours [set hours_${on_what_id}.hours]
+	set billing_rate [set hours_${on_what_id}.billing_rate]
+
+	# we need to validate hours and billing_rate
+	validate_decimal hours $hours
+	validate_decimal_or_null billing_rate $billing_rate
+
+        if { [empty_string_p $hours] } {
+           set hours 0
+        }
+        if [empty_string_p $billing_rate] {
+           set billing_rate null
+        }
+        set QQnote [DoubleApos [set hours_${on_what_id}.note]]
+
+        if {($hours == 0) && [empty_string_p $QQnote]} {
+            ns_db dml $db "delete from im_hours
+                            where on_what_id = $on_what_id
+                              and on_which_table = '$QQon_which_table'
+                              and user_id = $user_id
+                              and day = date_from_julian($julian_date)"
+	} else {
+	    
+            ns_db dml $db "update im_hours
+                              set hours = $hours,
+                                  note = '$QQnote',
+                                  billing_rate = $billing_rate
+                            where on_what_id = $on_what_id
+                              and on_which_table = '$QQon_which_table'
+                              and user_id = $user_id
+                              and day = date_from_julian($julian_date)"
+
+            if {[ns_pg ntuples $db] == 0} {
+                ns_db dml $db "insert into im_hours 
+                               (user_id, on_which_table, on_what_id, day, hours, billing_rate, note) 
+                               values 
+                               ($user_id, '$QQon_which_table', $on_what_id, date_from_julian($julian_date), $hours, $billing_rate, '$QQnote')"
+            }
+        }
+    }
+}
+
+if { [exists_and_not_null return_url] } {
+    ns_returnredirect $return_url
+} else {
+    ns_returnredirect index.tcl?[export_url_vars on_which_table julian_date]
+}
Index: web/openacs/www/intranet/hours/ae.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/hours/ae.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/hours/ae.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,305 @@
+# ae.tcl,v 3.1.4.1 2000/03/17 08:22:56 mbryzek Exp
+# File: /www/intranet/hours/ae.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Displays form to let user enter hours
+#
+
+set_the_usual_form_variables
+# on_which_table
+# julian_date (defaults to today)
+# on_what_id (optional)
+
+set db [ns_db gethandle]
+
+if { ![exists_and_not_null on_which_table] } {
+    set on_which_table im_projects
+    set QQon_which_table im_projects
+}
+
+if { ![exists_and_not_null julian_date] } {
+    set julian_date [database_to_tcl_string $db \
+	    "select to_char(sysdate(),'J') from dual"]
+
+}
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set selection [ns_db 1row $db \
+	"select first_names || ' ' || last_name as user_name,
+                to_char(date_from_julian($julian_date), 'FMDay FMMonth FMDD, YYYY') as pretty_date
+           from users
+          where user_id = $user_id"]    
+
+set_variables_after_query
+
+## Ben's attempt
+if { [exists_and_not_null on_what_id] } {
+
+    validate_integer on_what_id $on_what_id
+
+    set one_project_only_p 1
+    set selection [ns_db select $db \
+	    "select g.group_name, g.group_id,
+    h.hours, h.note, h.billing_rate
+    from user_groups g, im_hours h
+    where g.group_id = $on_what_id
+    and g.group_id = h.on_what_id
+    and '$QQon_which_table' = h.on_which_table
+    and h.user_id = $user_id
+    and date_from_julian($julian_date) = h.day
+    union
+    select g.group_name, g.group_id,
+    h.hours, h.note, h.billing_rate
+    from user_groups g, im_hours_null h
+    where g.group_id = $on_what_id
+    and 0=(select count(*) from im_hours where 
+    g.group_id= im_hours.on_what_id and
+    '$QQon_which_table' = im_hours.on_which_table and
+    im_hours.user_id= $user_id and
+    date_from_julian($julian_date) = im_hours.day)
+    order by upper(group_name)"]
+} else {
+    set one_project_only_p 0
+
+   set selection [ns_db select $db \
+	   "select g.group_name, g.group_id,
+    h.hours, h.note, h.billing_rate
+    from user_groups g, im_hours h, im_projects p
+    where h.day = date_from_julian($julian_date)
+    and g.group_id=p.group_id
+    and h.user_id = $user_id
+    and g.group_id = h.on_what_id
+    and '$QQon_which_table' = h.on_which_table
+    and p.project_status_id in (select project_status_id
+    from im_project_status
+    where upper(project_status) in ('OPEN','FUTURE'))
+    and im_hours_group_id_valid_p(p.group_id, $user_id, '$QQon_which_table', $julian_date)='t'
+    union
+    select g.group_name, g.group_id,
+    h.hours, h.note, h.billing_rate
+    from user_groups g, im_hours_null h, im_projects p
+    where g.group_id = p.group_id
+    and 0=(select count(*) from im_hours where 
+    g.group_id= im_hours.on_what_id and
+    '$QQon_which_table' = im_hours.on_which_table and
+    im_hours.user_id= $user_id and
+    date_from_julian($julian_date) = im_hours.day)
+    and p.project_status_id in (select project_status_id
+    from im_project_status
+    where upper(project_status) in ('OPEN','FUTURE'))
+    and im_hours_group_id_valid_p(p.group_id, $user_id, '$QQon_which_table', $julian_date)='t'
+    order by upper(group_name)"]
+}
+
+
+# if { [exists_and_not_null on_what_id] } {
+
+#     set one_project_only_p 1
+#     set selection [ns_db select $db \
+# 	    "select g.group_name, g.group_id,
+# 	            h.hours, h.note, h.billing_rate
+#                from user_groups g, im_hours h
+#               where g.group_id = $on_what_id
+#                 and g.group_id = h.on_what_id(+)
+#                 and '$QQon_which_table' = h.on_which_table(+)
+#                 and h.user_id(+) = $user_id
+#                 and to_date($julian_date, 'J') = h.day(+)
+#               order by upper(group_name)"]
+
+# } else {
+#     set one_project_only_p 0
+
+#     set selection [ns_db select $db \
+# 	    "select g.group_name, g.group_id,
+# 	            h.hours, h.note, h.billing_rate
+#                from user_groups g, im_hours h, im_projects p
+#               where h.day(+) = to_date($julian_date, 'J')
+#                 and g.group_id=p.group_id
+#                 and h.user_id(+) = $user_id
+#                 and g.group_id = h.on_what_id(+)
+#                 and '$QQon_which_table' = h.on_which_table(+)
+#                 and p.project_status_id in (select project_status_id
+#                                               from im_project_status
+#                                              where upper(project_status) in ('OPEN','FUTURE'))
+#                 and p.group_id in (select map.group_id 
+#                                      from user_group_map map
+#                                     where map.user_id = $user_id
+#                                     UNION
+#                                    select h.on_what_id
+#                                      from im_hours h
+#                                     where h.user_id = $user_id
+#                                       and on_which_table = '$QQon_which_table'
+#                                       and (h.hours is not null
+#                                            OR h.note is not null)
+#                                       and h.day = to_date($julian_date, 'J'))
+#             order by upper(group_name)"]
+
+# }
+
+#  set where_clause1 [list "g.group_id = h.on_what_id" "not exists (select 1 from im_hours where on_what_id = g.group_id)"]
+#  set where_clause2 [list "'$QQon_which_table' = h.on_which_table" "not exists (select 1 from im_hours where on_which_table = '$QQon_which_table')"]
+#  set where_clause3 [list "h.user_id = $user_id" "not exists (select 1 from im_hours where user_id = $user_id)"]
+#  set where_clause4 [list "date(date_from_julian($julian_date)) = date(h.day)" "not exists (select 1 where date(date_from_julian($julian_date)) = date(day))"]
+
+#  if { [exists_and_not_null on_what_id] } {
+
+#      set one_project_only_p 1
+#      set sql_select_clause "select g.group_name, g.group_id,
+#  	            %s
+#                 from user_groups g %s
+#                where g.group_id = $on_what_id
+#                  and %s
+#                  and %s
+#                  and %s
+#                  and %s"
+
+#      set sub_clause ""
+#      set sub_sql    ""
+
+#  } else {
+#      set one_project_only_p 0     
+#      set sql_select_clause "select g.group_name, g.group_id,
+#  	            %s
+#                 from user_groups g, im_projects p %s
+#                where g.group_id=p.group_id
+#                  and %s
+#                  and %s
+#                  and %s
+#                  and %s
+#                  and p.project_status_id in (select project_status_id
+#                                                from im_project_status
+#                                               where upper(project_status) in ('OPEN','FUTURE'))"
+
+#      set sub_clause "and p.group_id in"
+#      set sub_sql    "select map.group_id 
+#                        from user_group_map map
+#                       where map.user_id = $user_id
+#                       UNION
+#                      select h.on_what_id
+#                        from im_hours h
+#                       where h.user_id = $user_id
+#                         and on_which_table = '$QQon_which_table'
+#                         and (h.hours is not null
+#                              OR h.note is not null)
+#                         and date(h.day) = date(date_from_julian($julian_date))"
+#  }
+
+
+set page_title "Hours for $pretty_date"
+set context_bar [ad_context_bar [list "/" Home] [list "../index.tcl" Intranet] [list index.tcl?[export_url_vars on_which_table] "Hours"] "Add hours"]
+
+set page_body "
+<form method=post action=ae-2.tcl>
+[export_form_vars julian_date return_url on_which_table]
+
+"
+
+set results ""
+
+# Warning - Major hack in progress.  Postgres 6.5 doesn't support unions in subqueries.  Perform subquery
+# and use result to from main query.  Wrap the whole thing in a transaction to maintain ACID.
+
+#  set sql_list [list]
+
+#  for {set i 0} {$i < 16} {incr i} {
+
+#      set bit0 [expr $i & 1]
+#      set bit1 [expr ($i >> 1) & 1]
+#      set bit2 [expr ($i >> 2) & 1]
+#      set bit3 [expr ($i >> 3) & 1]
+
+#      if {$bit0 && $bit1 && $bit2 && $bit3} {
+#          set im_hours_selects " 0.0 as hours, '' as note, 0.0 as billing_rate "
+#          set hours_table ", im_hours h"
+#      } else {
+#          set hours_table ", im_hours h"
+#          set im_hours_selects " h.hours, h.note, h.billing_rate "
+#      }
+
+#      lappend sql_list [format $sql_select_clause $im_hours_selects $hours_table [lindex $where_clause1 $bit0] [lindex $where_clause2 $bit1] [lindex $where_clause3 $bit2] [lindex $where_clause4 $bit3]]
+
+#  }
+
+#  ns_db dml $db "begin transaction"
+
+#  if { $sub_sql != "" } {
+#    set sub_list [database_to_tcl_list $db $sub_sql]
+#  } else {
+#      set sub_list [list]
+#  }
+
+#  if { [llength $sub_list] > 0 } {
+#      set sub_query_values "$sub_clause ([join $sub_list ","])"
+#  } else {
+#      set sub_query_values ""
+#  }
+
+#  set sql "[join $sql_list " $sub_query_values \nunion\n"] $sub_query_values\norder by upper(group_name)"
+
+# set selection [ns_db select $db $sql]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append results "
+
+<tr>
+<td bgcolor=#d0d0d0 COLSPAN=2><B>$group_name</B></TD></TR>
+<tr VALIGN=top bgcolor=#efefef>
+<td ALIGN=right bgcolor=#efefef>Hours:</TD>
+<td><INPUT NAME=hours_${group_id}.hours size=5 MAXLENGTH=5 [export_form_value hours]></TD>
+</TR>
+<tr VALIGN=top bgcolor=#efefef>
+<td>Work done:</TD>
+<td><TEXTAREA NAME=hours_${group_id}.note WRAP=SOFT COLS=50 ROWS=6>[ns_quotehtml [value_if_exists note]]</TEXTAREA>
+</TD>
+</TR>
+<tr bgcolor=#efefef>
+<td ALIGN=right bgcolor=#efefef>Billing Rate:</TD>
+<td>\$<INPUT NAME=hours_${group_id}.billing_rate size=6 MAXLENGTH=6 [export_form_value billing_rate]> 
+<FONT size=-1>(Leave blank if not billing hourly)</FONT></TD>
+</TR>
+
+
+"
+}
+
+# ns_db dml $db "end transaction"
+
+
+if { [empty_string_p $results] } {
+    append page_body "
+<b>You currently do not belong to any projects</b>
+
+<p><a href=other-projects.tcl?[export_url_vars on_which_table julian_date]>Add hours on other projects</A>
+"
+} else {
+    set page_body "
+$page_body
+<center>
+<table border=0 cellpadding=4 cellspacing=2>
+$results 
+"
+    if {! $one_project_only_p} {
+	append page_body "
+<tr>
+<td COLSPAN=2 bgcolor=#d0d0d0>
+<a href=other-projects.tcl?[export_url_vars on_which_table julian_date]>Add hours on other projects</A>
+</TD>
+</TR>
+"
+    }
+
+    append page_body "
+</table>
+
+<p><INPUT TYPE=Submit VALUE=\" Add hours \">
+</form>
+</center>
+"
+}
+
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/hours/full.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/hours/full.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/hours/full.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,91 @@
+# full.tcl,v 3.1.4.1 2000/03/17 08:22:56 mbryzek Exp
+# File: /www/intranet/hours/full.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Shows a detailed list of all the hours one user 
+# spent on a given item (e.g. a project)
+# 
+
+set_the_usual_form_variables
+# on_which_table on_what_id user_id show_notes_p
+# item (optional - used for UI)
+
+validate_integer on_what_id $on_what_id
+validate_integer user_id $user_id
+
+set caller_id [ad_verify_and_get_user_id]
+
+if {![info exists user_id] && ($caller_id != 0)} {
+    set looking_at_self_p 1
+    set user_id $caller_id
+} else {
+    if {$caller_id == $user_id} {
+        set looking_at_self_p 1
+    } else {
+        set looking_at_self_p 0
+    }
+}
+set db [ns_db gethandle]
+
+set user_name [database_to_tcl_string $db "\
+	select first_names || ' ' || last_name from users where user_id = $user_id"]
+
+if { [exists_and_not_null item] } {
+    set page_title "Hours on \"$item\" by $user_name"
+} else {
+    set page_title "Hours by $user_name"
+}
+
+set context_bar [ad_context_bar [list "/" Home] [list "../index.tcl" "Intranet"] [list projects.tcl?[export_url_vars on_which_table] "View employee's hours"] [list projects.tcl?[export_url_vars on_which_table user_id] "One employee"] "One project"]
+
+set page_body "<ul>\n"
+
+set selection [ns_db select $db "\
+select 
+    to_char(day,'FMDay, FMMonth FMDD') as pretty_day,
+    to_char(day, 'J') as j_day,
+    hours, 
+    billing_rate,
+    hours * billing_rate as amount_earned, 
+    note 
+from im_hours
+where on_what_id = $on_what_id 
+and on_which_table = '$QQon_which_table'
+and user_id = $user_id
+and hours is not null
+order by day"]
+
+set total_hours_on_project 0
+set total_hours_billed_hourly 0
+set hourly_bill 0
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append page_body "<p><li>$pretty_day <br><em>$hours [util_decode $hours 1 hour hours]</em>\n"
+
+    set total_hours_on_project [expr $total_hours_on_project + $hours]
+
+    if ![empty_string_p $amount_earned] {
+        append page_body " (@ \$[format %4.2f $billing_rate]/hour = \$[format %4.2f $amount_earned])"
+        set hourly_bill [expr $hourly_bill + $amount_earned]
+        set total_hours_billed_hourly [expr $total_hours_billed_hourly + $hours]
+    }
+
+    if ![empty_string_p $note] {
+        append page_body "<blockquote>$note</blockquote>"
+    }
+}
+
+append page_body "\n<p><b>Total:</b> [util_commify_number $total_hours_on_project] 
+[util_decode $total_hours_on_project 1 hour hours]"
+
+if {$hourly_bill > 0} {
+    append page_body "<BR><FONT SIZE=-1>[util_commify_number $total_hours_billed_hourly]
+of those hours were billed hourly, for a total amount of 
+\$[util_commify_number [format %4.2f $hourly_bill]]</FONT>"
+}
+
+append page_body "</ul>\n"
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/hours/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/hours/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/hours/index.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,141 @@
+# index.tcl,v 3.1.4.1 2000/03/17 08:22:57 mbryzek Exp
+# File: /www/intranet/hours/index.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Calendar format display of user's hours with links 
+# to log more hours, if the user is looking at him/
+# herself
+
+
+set_form_variables 0
+# on_which_table
+# maybe date, maybe user_id, maybe group_id
+
+if { ![exists_and_not_null on_which_table] } {
+    set on_which_table im_projects
+    set QQon_which_table im_projects
+}
+
+set caller_id [ad_get_user_id]
+
+if ![info exists user_id] {
+    if {$caller_id} { 
+        set user_id $caller_id
+    } else {
+        ad_maybe_redirect_for_registration
+    }
+} else {
+    validate_integer user_id $user_id
+}
+
+if {$user_id == $caller_id} {
+    set looking_at_self_p 1
+} else {
+    set looking_at_self_p 0
+}
+
+set db [ns_db gethandle]
+
+set user_name [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id = $user_id"]
+
+set page_title "Hours by $user_name"
+set context_bar [ad_context_bar [list "/" Home] [list "../" "Intranet"] "Hours"]
+
+if [info exists project_id] { 
+    validate_integer group_id $group_id
+    set project_name [database_to_tcl_string $db \
+	    "select group_name from user_groups where group_id = $group_id"]
+    append page_title " on $project_name"
+    set project_restriction "and group_id = $group_id"
+} else {
+    set project_restriction ""
+}
+
+
+# Default to today if there is no date specified
+if { ![exists_and_not_null date] } {
+    if { [exists_and_not_null julian_date] } {
+	set date [database_to_tcl_string $db \
+		"select to_char( date_from_julian($julian_date), 'YYYY-MM-DD') from dual"]
+    } else {
+	set date [database_to_tcl_string $db \
+		"select to_char( sysdate(), 'YYYY-MM-DD') from dual"]
+    }
+} 
+
+set calendar_details [ns_set create calendar_details]
+
+# figure out the first and last julian days in the month
+set selection [calendar_get_info_from_db $date]
+set_variables_after_query
+
+# Grab all the hours from im_hours
+set selection [ns_db select $db \
+	"select to_char(day, 'J') as julian_date, sum(hours) as hours
+           from im_hours 
+          where user_id = $user_id
+            and day between date_from_julian($first_julian_date) 
+                            and date_from_julian($last_julian_date) $project_restriction
+       group by to_char(day, 'J')"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    set users_hours($julian_date) $hours
+}
+
+set hours_for_this_week 0.0
+set first_day 1
+# And now fill in information for every day of the month
+for { set current_date $first_julian_date } { $current_date <= $last_julian_date } {incr current_date } {
+    if { [info exists users_hours($current_date)] && ![empty_string_p $users_hours($current_date)] } {
+ 	set html [util_decode $users_hours($current_date) 1 "1 hour" "$users_hours($current_date) hours"]
+	set hours_for_this_week [expr $hours_for_this_week + $users_hours($current_date)]
+    } else {
+	set html "<font color=#666666><em>none</em></font>"
+    }
+    if { $looking_at_self_p } {
+
+        set one_project_p [database_to_tcl_string_or_null $db "select distinct count(group_id) from im_projects"]
+        
+        if { $one_project_p != "" && $one_project_p > 1 } {
+            set html "<a href=other-projects.tcl?[export_url_vars on_which_table]&julian_date=[ns_urlencode $current_date]>$html</a>"
+        } else {
+            set html "<a href=ae.tcl?[export_url_vars on_which_table]&julian_date=[ns_urlencode $current_date]>$html</a>"
+        }
+    }
+
+    if { $first_day == 7 && $hours_for_this_week > 0} {
+	set html "
+<br>
+<table width=100% cellpadding=0 border=0 cellspacing=0>
+<tr>
+   <td align=right>[ad_partner_default_font "size=-1"]<a href=week.tcl?julian_date=[ns_urlencode $current_date]&[export_url_vars user_id on_which_table]>Week total: $hours_for_this_week</a></font></td>
+</tr>
+<tr>
+   <td align=left>$html</td>
+</tr>
+</table>
+"
+    } else {
+	set html "<p>&nbsp;<br>$html"
+    }
+    ns_set put $calendar_details $current_date $html
+    
+    # we keep track of the day of the week we are on
+    incr first_day
+    if { $first_day > 7 } {
+	set first_day 1
+	set hours_for_this_week 0.0
+    }
+}
+    
+set prev_month_template "<font color=white>&lt;</font> <a href=\"index.tcl?[export_url_vars user_id]&date=\$ansi_date\"><font color=white>\$prev_month_name</font></a>"
+set next_month_template "<a href=\"index.tcl?[export_url_vars user_id]&date=\$ansi_date\"><font color=white>\$next_month_name</font></a> <font color=white>&gt;</font>"
+
+set day_bgcolor "#efefef"
+set day_number_template "<!--\$julian_date-->[ad_partner_default_font "size=-1"]\$day_number</font>"
+
+set page_body [calendar_basic_month -calendar_details $calendar_details -next_month_template $next_month_template -prev_month_template $prev_month_template -day_number_template $day_number_template -day_bgcolor $day_bgcolor -date $date -prev_next_links_in_title 1 -fill_all_days 1 -empty_bgcolor "#cccccc"]
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/hours/one-project.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/hours/one-project.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/hours/one-project.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,54 @@
+# one-project.tcl,v 3.1.4.1 2000/03/17 08:22:57 mbryzek Exp
+# File: /www/intranet/hours/one-project.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Shows hours by all users for a specific item/project
+# 
+
+set_the_usual_form_variables 
+# on_what_id on_which_table
+# item (optional - for UI)
+
+validate_integer on_what_id $on_what_id
+
+set show_notes_p 1
+
+set db [ns_db gethandle]
+
+set page_title "Hours"
+if { [exists_and_not_null item] } {
+    append page_title " on $item"
+}
+set context_bar [ad_context_bar [list "/" Home] [list "../index.tcl" "Intranet"] [list total.tcl?[export_url_vars on_which_table] "Project hours"] "Hours on one project"]
+
+set page_body "
+Click on a person's name to see a detailed log of their hours.
+<ul>
+"
+
+set selection [ns_db select $db "\
+select 
+    u.user_id, 
+    u.first_names || ' ' || u.last_name as user_name,
+    to_char(sum(h.hours),'999G999G999') as total_hours,
+    min(day) as first_day,
+    max(day) as last_day
+from users u, im_hours h
+where u.user_id = h.user_id
+and h.on_what_id = $on_what_id
+and h.on_which_table = '$QQon_which_table'
+group by u.user_id, first_names, last_name
+order by upper(first_names),upper(last_name)"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    append page_body "<li><a href=full.tcl?[export_url_vars on_what_id on_which_table user_id]&date=$last_day>$user_name</A>, $total_hours hours between 
+[util_AnsiDatetoPrettyDate $first_day] and 
+[util_AnsiDatetoPrettyDate $last_day]\n"
+}
+
+append page_body "</ul>\n"
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/hours/other-projects.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/hours/other-projects.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/hours/other-projects.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,42 @@
+# other-projects.tcl,v 3.1.4.2 2000/03/17 08:56:38 mbryzek Exp
+# File: /www/intranet/hours/other-projects.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Lets a user choose a project on which to log hours
+# 
+
+set_form_variables
+# on_which_table julian_date
+
+ad_maybe_redirect_for_registration
+
+set page_title "Choose a project"
+set context_bar [ad_context_bar [list "/" Home] [list "../index.tcl" Intranet] [list index.tcl?[export_url_vars on_which_table] Hours] [list ae.tcl?[export_url_vars on_which_table julian_date] "Add hours"] "Choose project"]
+
+set db [ns_db gethandle]
+
+set page_body "<ul>\n"
+set counter 0
+set selection [ns_db select $db \
+	"select g.group_name, g.group_id 
+           from user_groups g, im_projects p
+          where g.group_id=p.group_id
+       order by upper(group_name)"]
+
+while {[ns_db getrow $db $selection]} {
+    incr counter
+    set_variables_after_query
+    append page_body "<li><a href=ae.tcl?on_what_id=$group_id&[export_url_vars on_which_table julian_date]>$group_name</a>\n"
+}
+
+if { $counter == 0 } {
+    append page_body "  <li> There are no projects.\n"
+}
+
+append page_body "</ul>\n"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/hours/projects.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/hours/projects.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/hours/projects.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,92 @@
+# projects.tcl,v 3.1.4.1 2000/03/17 08:22:58 mbryzek Exp
+# File: /www/intranet/hours/projects.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Shows all the hours an employee has worked, organized 
+# by project
+# 
+
+set_the_usual_form_variables
+# on_which_table
+# user_id (maybe)
+
+# If we get a user_id, give them information for that 
+# user. Otherwise, send a list of users.
+
+set db [ns_db gethandle]
+
+if { ![exists_and_not_null user_id] } {
+    
+    # send them a list of users
+    set page_title "View employee's hours"
+    set context_bar [ad_context_bar [list "/" Home] [list "../index.tcl" "Intranet"] "View employee's hours"]
+    set page_body "
+Choose an employee to see their hours.
+<ul>
+"
+    set rows_found_p 0
+
+    set selection [ns_db select $db "
+select user_id, first_names || ' ' || last_name as user_name 
+from users_active users
+where exists (select 1 from im_hours where user_id = users.user_id)
+order by lower(first_names),lower(last_name)"]
+
+    while {[ns_db getrow $db $selection]} {
+        set rows_found_p 1
+        set_variables_after_query
+        append page_body "<li><a href=projects.tcl?[export_url_vars on_which_table user_id]>$user_name</a>\n"
+    }
+    if {$rows_found_p == 0} {
+        append page_body "<em>No users found</em>"
+    }
+
+    append page_body "</ul>"
+
+} else {
+
+    validate_integer user_id $user_id
+
+    set user_name [database_to_tcl_string $db "\
+select first_names || ' ' || last_name 
+from users 
+where user_id = $user_id"]
+
+    set page_title "Hours by $user_name"
+    set context_bar [ad_context_bar [list "/" Home] [list "../index.tcl" "Intranet"] [list projects.tcl?[export_url_vars on_which_table] "View employee's hours"] "One employee"]
+
+    # Click on a project name to see the full log for that project 
+    set page_body "<ul>\n"
+
+    set selection [ns_db select $db "
+select 
+    g.group_name, 
+    g.group_id,
+    round(sum(h.hours)) as total_hours,
+    min(h.day) as first_day, 
+    max(h.day) as last_day
+from user_groups g, im_hours h
+where g.group_id = h.on_what_id
+and h.on_which_table='$QQon_which_table'
+and h.user_id = $user_id
+group by g.group_name, g.group_id"]
+
+    set none_found_p 1
+    while { [ns_db getrow $db $selection] } {
+        set none_found_p 0
+        set_variables_after_query
+
+        append page_body "<li><a href=full.tcl?on_what_id=$group_id&[export_url_vars on_which_table user_id]&date=$last_day&item=[ad_urlencode $group_name]>$group_name</a>, $total_hours hours 
+between [util_AnsiDatetoPrettyDate $first_day] and [util_AnsiDatetoPrettyDate $last_day]\n"
+    }
+
+    if {$none_found_p == 1} {
+        append page_body "<em>No time logged on any projects</em>"
+    }
+    append page_body "</ul>"
+}
+
+ns_db releasehandle $db 
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/hours/total.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/hours/total.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/hours/total.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,52 @@
+# total.tcl,v 3.1.4.1 2000/03/17 08:22:58 mbryzek Exp
+# File: /www/intranet/hours/total.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Shows total number of hours spent on all project
+# 
+
+set_the_usual_form_variables
+# on_which_table
+
+set page_title "Hours on all projects"
+set context_bar [ad_context_bar [list "/" Home] [list "../index.tcl" "Intranet"] "Hours on all projects"]
+
+
+set db [ns_db gethandle]
+
+
+set page_body "
+Click on a project name to breakdown of hours per person.
+<ul>
+"
+
+set selection [ns_db select $db "\
+select 
+    g.group_id, 
+    g.group_name, 
+    round(sum(h.hours)) as total_hours,
+    min(h.day) as first_day, 
+    max(h.day) as last_day
+from user_groups g, im_hours h, im_projects p
+where g.group_id = h.on_what_id
+and h.on_which_table='$QQon_which_table'
+and g.group_id = p.group_id
+group by g.group_id, g.group_name
+order by upper(g.group_name)"]
+
+set none_found_p 1
+while { [ns_db getrow $db $selection] } {
+    set none_found_p 0
+    set_variables_after_query
+    append page_body "<li><a href=one-project.tcl?on_what_id=$group_id&[export_url_vars on_which_table]&item=[ad_urlencode $group_name]>$group_name</A>, 
+$total_hours hours between [util_AnsiDatetoPrettyDate $first_day] and [util_AnsiDatetoPrettyDate $last_day]\n";
+}
+
+if {$none_found_p == 1} {
+    append page_body "<em>No time logged on any projects</em>"
+}
+
+append page_body "</UL>\n"
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/hours/week.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/hours/week.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/hours/week.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,132 @@
+# week.tcl,v 3.1.4.1 2000/03/17 08:22:58 mbryzek Exp
+# File: /www/intranet/hours/week.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Shows the hour a specified user spend working over the course of a week
+# 
+
+set_the_usual_form_variables
+# expect: julian_date
+# on_which_table
+# optional: user_id
+
+if { ![info exists user_id] } {
+    set user_id [ad_get_user_id]
+} else {
+    validate_integer user_id $user_id
+}
+
+set db [ns_db gethandle]
+
+set user_name [database_to_tcl_string $db \
+	"select first_names || ' ' || last_name from users where user_id = $user_id"]
+
+set selection [ns_db 1row $db \
+	"select to_char( next_day(
+    	    	   date_from_julian( $julian_date)-1, 'sat' ),
+    	    	  'MM/DD/YYYY' ) AS end_date,
+	        to_char( next_day(
+    	    	   date_from_julian( $julian_date)-1, 'sat' )-6,
+    	    	  'MM/DD/YYYY' ) AS start_date
+    	 from dual"]
+
+set_variables_after_query
+
+
+
+set selection [ns_db select $db \
+	"SELECT g.group_id, g.group_name, sum(h.hours) as total
+    	 FROM im_hours h, user_groups g
+    	 WHERE g.group_id = h.on_what_id
+    	   AND h.on_which_table = '$QQon_which_table'
+    	   AND h.day >= trunc( to_date( '$start_date'::varchar, 'MM/DD/YYYY'::varchar ) )
+    	   AND h.day < trunc( to_date( '$end_date'::varchar, 'MM/DD/YYYY'::varchar ) ) + 1
+    	   AND h.user_id=$user_id
+    	 GROUP BY g.group_id, g.group_name"]
+
+set items {}
+set grand_total 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    set grand_total [expr $grand_total+$total]
+    lappend items [ns_set copy $selection]
+}
+
+set selection [ns_db select $db \
+	"SELECT g.group_id, g.group_name, coalesce(h.note,'<i>none</i>') as note,
+		TO_CHAR( day, 'Dy, MM/DD/YYYY' ) as nice_day
+	 FROM im_hours h, user_groups g
+	 WHERE g.group_id = h.on_what_id
+     	   AND h.on_which_table = '$QQon_which_table'
+    	   AND h.day >= trunc( to_date( '$start_date'::varchar, 'MM/DD/YYYY'::varchar ) )
+    	   AND h.day < trunc( to_date( '$end_date'::varchar, 'MM/DD/YYYY'::varchar ) ) + 1
+    	   AND user_id=$user_id
+	 ORDER BY lower(g.group_name), day"]
+
+set last_id -1
+set pcount 0
+set notes "<hr>\n<h2>Daily project notes</h2>\n"
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    if { $last_id != $group_id } {
+	set last_id $group_id
+	if { $pcount > 0 } {
+	    append notes "</ul>\n"
+	}
+	append notes "<h3>$group_name</h3>\n<ul>\n"
+	incr pcount
+    }
+    append notes "<li><b>$nice_day:</b>&nbsp;$note\n"
+}
+
+if { $pcount > 0 } {
+    append notes "</ul>\n"
+} else {
+    set notes ""
+}
+
+ns_db releasehandle $db
+
+set hour_table "No hours for this week"
+
+if {[llength $items] > 0 } {
+    set hour_table "<table cellspacing=1 cellpadding=3>
+    <tr bgcolor=\"#666666\">
+    <th><font color=\"#ffffff\">Project</font></th>
+    <th><font color=\"#ffffff\">Hours</font></th>
+    <th><font color=\"#ffffff\">Percentage</font></th>
+    </tr>
+    "
+
+    foreach selection $items {
+	set_variables_after_query
+	append hour_table "<tr bgcolor=\"#efefef\">
+	<td><a href=\"../projects/view.tcl?[export_url_vars group_id on_which_table]\">
+	    $group_name</a></td>
+	<td align=right>[format "%0.02f" $total]</td>
+	<td align=right>[format "%0.02f%%" \
+	    [expr double($total)/$grand_total*100]]</td>
+	</tr>
+	"
+    }
+
+    append hour_table "<tr bgcolor=\"#aaaaaa\">
+    	<td><b>Grand Total</b></td>
+    	<td align=right><b>[format "%0.02f" $grand_total]</b></td>
+    	<td align=right><b>100.00%</b></td>
+    	</tr>
+    	</table>\n"
+}
+
+set page_title "Weekly total by $user_name"
+set context_bar [ad_context_bar [list "/" Home] [list "../index.tcl" Intranet] [list index.tcl?[export_url_vars on_which_table] "Your hours"] "Weekly hours"]
+
+set page_body "
+$hour_table
+$notes
+"
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/offices/ae-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/offices/ae-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/offices/ae-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,84 @@
+# ae-2.tcl,v 3.0.4.1 2000/03/17 08:23:00 mbryzek Exp
+# File: /www/intranet/offices/ae-2.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+# 
+# Saves office info to db
+#
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_form_variables
+# group_id, group_name, short_name, Bunch of stuff for dp
+
+validate_integer group_id $group_id
+
+if { ![exists_and_not_null group_id] }  {
+    ad_return_error "We've lost the office's group id" "Please back up, hit reload, and try again."
+    return
+}
+ 
+set required_vars [list \
+	[list group_name "You must specify the office's name"] \
+	[list short_name "You must specify the office's short name"]]
+
+set errors [im_verify_form_variables $required_vars]
+
+set exception_count 0
+if { ![empty_string_p $errors] } {
+    set exception_count 1
+}
+
+set db [ns_db gethandle]
+
+# Make sure short name is unique - this is enforced in user groups since short_name 
+# must be unique for different UI stuff
+if { ![empty_string_p $short_name] } {
+    set exists_p [database_to_tcl_string $db \
+	    "select (case when count(1) = 0 then 0 else 1 end) 
+               from user_groups 
+              where lower(trim(short_name))=lower(trim('[DoubleApos ${short_name}]'))
+                and group_id != $group_id"]
+
+    if { $exists_p } {
+	incr exception_count
+	append errors "  <li> The specified short name already exists for another user group. Please choose a new short name\n"
+    }
+}
+
+if { ![empty_string_p $errors] } {
+    ad_return_complaint $exception_count $errors
+    return
+}
+
+set form_setid [ns_getform]
+
+# Create/update the user group frst since projects reference it
+# Note: group_name, creation_user, creation_date are all set in ae.tcl
+ns_set put $form_setid "dp_ug.user_groups.group_id" $group_id
+ns_set put $form_setid "dp_ug.user_groups.group_type" [ad_parameter IntranetGroupType intranet]
+ns_set put $form_setid "dp_ug.user_groups.approved_p" "t"
+ns_set put $form_setid "dp_ug.user_groups.new_member_policy" "closed"
+ns_set put $form_setid "dp_ug.user_groups.parent_group_id" [util_memoize {im_group_id_from_parameter OfficeGroupShortName}]
+ns_set put $form_setid "dp_ug.user_groups.group_name" $group_name
+ns_set put $form_setid "dp_ug.user_groups.short_name" $short_name
+
+# Put the group_id into the office information
+ns_set put $form_setid "dp.im_offices.group_id" $group_id
+
+
+with_transaction $db {
+
+    # Update user_groups
+    dp_process -db $db -form_index "_ug" -where_clause "group_id=$group_id"
+
+    # Now update im_offices
+    dp_process -db $db -where_clause "group_id=$group_id"
+} { ns_log Error "transaction failed" }
+
+if { [exists_and_not_null return_url] } {
+    ns_returnredirect $return_url
+} else {
+    ns_returnredirect index.tcl
+}
Index: web/openacs/www/intranet/offices/ae.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/offices/ae.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/offices/ae.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,154 @@
+# ae.tcl,v 3.2.2.3 2000/03/17 08:23:00 mbryzek Exp
+# File: /www/intranet/offices/ae.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+# 
+# Adds/edits office information
+#
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_form_variables 0
+# group_id (if we're editing)
+# return_url (optional)
+
+
+set db [ns_db gethandle]
+if { [exists_and_not_null group_id] } {
+    validate_integer group_id $group_id
+
+    set caller_group_id $group_id
+#     set selection [ns_db 1row $db \
+# 	    "select g.group_name, g.short_name, o.*
+#                from im_offices o, user_groups g
+#               where g.group_id=$caller_group_id
+#                 and g.group_id=o.group_id(+)"]
+    set selection [ns_db 1row $db \
+	    "select g.group_name, g.short_name, o.*
+               from im_offices o, user_groups g
+              where g.group_id=$caller_group_id
+                and g.group_id=o.group_id
+              union
+             select g.group_name, g.short_name, 
+                    '' as group_id,
+                    '' as phone,
+                    '' as fax,
+                    '' as address_line1,
+                    '' as address_line2,
+                    '' as address_city,
+                    '' as address_state,
+                    '' as address_postal_code,
+                    '' as address_country_code,
+                    '' as contact_person_id,
+                    '' as landlord,
+                    '' as security,
+                    '' as note
+               from user_groups g
+              where g.group_id=$caller_group_id
+                and not exists (select 1 from im_offices 
+                                where group_id = g.group_id)"]
+    set_variables_after_query
+    set page_title "Edit office"
+    set context_bar [ad_context_bar [list "/" Home] [list "../" "Intranet"] [list index.tcl "Offices"] [list "view.tcl?group_id=$caller_group_id" "One office"] $page_title]
+
+} else {
+    set page_title "Add office"
+    set context_bar [ad_context_bar [list "/" Home] [list "../" "Intranet"] [list index.tcl "Offices"] $page_title]
+    set caller_group_id [database_to_tcl_string $db "select user_group_sequence.nextval from dual"]
+ 
+    # Information about the user creating this office
+    set "dp_ug.user_groups.creation_ip_address" [ns_conn peeraddr]
+    set "dp_ug.user_groups.creation_user" $user_id
+
+}
+
+
+set page_body "
+<form method=post action=ae-2.tcl>
+<input type=hidden name=group_id value=$caller_group_id>
+[export_form_vars return_url dp_ug.user_groups.creation_ip_address dp_ug.user_groups.creation_user]
+
+<table border=0 cellpadding=3 cellspacing=0 border=0>
+
+<TR>
+<TD ALIGN=RIGHT>Office name:</TD>
+<TD><INPUT NAME=group_name SIZE=30 [export_form_value group_name] MAXLENGTH=100></TD>
+</TR>
+
+<TR>
+<TD ALIGN=RIGHT>Office short name:</TD>
+<TD><INPUT NAME=short_name SIZE=30 [export_form_value short_name] MAXLENGTH=100>
+  <br><font size=-1>To be used for email aliases/nice urls</font></TD>
+</TR>
+
+<TR><TD COLSPAN=2><BR></TD></TR>
+
+<TR>
+<TD ALIGN=RIGHT>Phone:</TD>
+<TD><INPUT NAME=dp.im_offices.phone.phone [export_form_value phone] SIZE=14 MAXLENGTH=50></TD>
+</TR>
+
+<TR>
+<TD ALIGN=RIGHT>Fax:</TD>
+<TD><INPUT NAME=dp.im_offices.fax.phone [export_form_value fax] SIZE=14 MAXLENGTH=50></TD>
+</TR>
+
+<TR><TD COLSPAN=2><BR></TD></TR>
+
+<TR>
+<TD VALIGN=TOP ALIGN=RIGHT>Address:</TD>
+<TD><INPUT NAME=dp.im_offices.address_line1 [export_form_value address_line1]  SIZE=30 MAXLENGTH=80></TD>
+</TR>
+
+<TR>
+<TD VALIGN=TOP ALIGN=RIGHT></TD>
+<TD><INPUT NAME=dp.im_offices.address_line2 [export_form_value address_line2] SIZE=30 MAXLENGTH=80></TD>
+</TR>
+
+<TR>
+<TD VALIGN=TOP ALIGN=RIGHT>City:</TD>
+<TD><INPUT NAME=dp.im_offices.address_city [export_form_value address_city] SIZE=30 MAXLENGTH=80></TD>
+</TR>
+
+<TR>
+<TD VALIGN=TOP ALIGN=RIGHT>State:</TD>
+<TD>
+[state_widget $db [value_if_exists address_state] "dp.im_offices.address_state"]
+</TD>
+</TR>
+
+<TR>
+<TD VALIGN=TOP ALIGN=RIGHT>Zip:</TD>
+<TD><INPUT NAME=dp.im_offices.address_postal_code [export_form_value address_postal_code] SIZE=10 MAXLENGTH=80></TD>
+</TR>
+
+</TABLE>
+
+<H4>Landlord information</H4>
+
+<BLOCKQUOTE>
+<TEXTAREA NAME=dp.im_offices.landlord COLS=60 ROWS=4 WRAP=SOFT>[philg_quote_double_quotes [value_if_exists landlord]]</TEXTAREA>
+</BLOCKQUOTE>
+
+<H4>Security information</H4>
+
+<BLOCKQUOTE>
+<TEXTAREA NAME=dp.im_offices.security COLS=60 ROWS=4 WRAP=SOFT>[philg_quote_double_quotes [value_if_exists security]]</TEXTAREA>
+</BLOCKQUOTE>
+
+<H4>Other information</H4>
+
+<BLOCKQUOTE>
+<TEXTAREA NAME=dp.im_offices.note COLS=60 ROWS=4 WRAP=SOFT>[philg_quote_double_quotes [value_if_exists note]]</TEXTAREA>
+</BLOCKQUOTE>
+
+<P>
+
+<p><center><input type=submit value=\"$page_title\"></center>
+</form>
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/offices/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/offices/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/offices/index.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,48 @@
+# index.tcl,v 3.2.2.1 2000/03/17 08:23:01 mbryzek Exp
+# File: /www/intranet/offices/index.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Lists all offices
+#
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+# set selection [ns_db select $db \
+# 	"select g.group_id, g.group_name
+#            from user_groups g, im_offices o
+#           where o.group_id=g.group_id
+#        order by lower(g.group_name)"]
+
+set selection [ns_db select $db \
+	"select group_id, group_name 
+           from user_groups
+          where parent_group_id=[im_office_group_id]
+          order by lower(group_name)"] 
+
+set results ""
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append results "  <li> <a href=view.tcl?[export_url_vars group_id]>$group_name</a>\n"
+}
+
+if { [empty_string_p $results] } {
+    set results "  <li><b> There are no offices </b>\n" 
+}
+
+ns_db releasehandle $db
+
+set page_title "Offices"
+set context_bar [ad_context_bar [list "/" Home] [list ../index.tcl "Intranet"] $page_title]
+
+set page_body "
+<ul>
+$results
+<p><li><a href=ae.tcl>Add an office</a>
+</ul>
+"
+ 
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/offices/primary-contact-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/offices/primary-contact-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/offices/primary-contact-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,28 @@
+# primary-contact-2.tcl,v 3.0.4.1 2000/03/17 08:23:02 mbryzek Exp
+# File: /www/intranet/offices/primary-contact-2.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# stores primary contact id for the office
+#
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_form_variables
+# group_id, user_id_from_search
+
+validate_integer group_id $group_id
+validate_integer user_id_from_search $user_id_from_search
+
+set db [ns_db gethandle]
+
+ns_db dml $db \
+	"update im_offices 
+            set contact_person_id=$user_id_from_search
+          where group_id=$group_id"
+
+ns_db releasehandle $db
+
+
+ns_returnredirect view.tcl?[export_url_vars group_id]
\ No newline at end of file
Index: web/openacs/www/intranet/offices/primary-contact-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/offices/primary-contact-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/offices/primary-contact-delete.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,27 @@
+# primary-contact-delete.tcl,v 3.0.4.1 2000/03/17 08:23:02 mbryzek Exp
+# File: /www/intranet/offices/primary-contact-delete.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Removes primary contact from office
+# 
+ 
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_form_variables
+# group_id, return_url
+
+validate_integer group_id $group_id
+
+set db [ns_db gethandle]
+
+ns_db dml $db \
+	"update im_offices 
+            set contact_person_id=null
+          where group_id=$group_id"
+
+ns_db releasehandle $db
+
+
+ns_returnredirect $return_url
\ No newline at end of file
Index: web/openacs/www/intranet/offices/primary-contact.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/offices/primary-contact.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/offices/primary-contact.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,57 @@
+# primary-contact.tcl,v 3.1.4.1 2000/03/17 08:23:02 mbryzek Exp
+# File: /www/intranet/offices/primary-contact.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Allows user to choose primary contact for office
+# 
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_form_variables
+# group_id
+
+validate_integer group_id $group_id
+
+# Avoid hardcoding the url stub
+set target [ns_conn url]
+regsub {primary-contact.tcl} $target {primary-contact-2.tcl} target
+
+set db [ns_db gethandle]
+
+set office_name [database_to_tcl_string $db \
+	"select g.group_name
+           from im_offices o, user_groups g
+          where o.group_id = $group_id
+            and o.group_id=g.group_id"]
+
+ns_db releasehandle $db
+
+set page_title "Select primary contact for $office_name"
+set context_bar [ad_context_bar [list "/" Home] [list "../" "Intranet"] [list index.tcl "Offices"] [list view.tcl?[export_url_vars group_id] "One office"] "Select contact"]
+
+set page_body "
+
+Locate your new primary contact by
+
+<form method=get action=/user-search.tcl>
+[export_form_vars group_id target limit_to_group_id]
+<input type=hidden name=passthrough value=group_id>
+
+<table border=0>
+<tr><td>Email address:<td><input type=text name=email size=40></tr>
+<tr><td colspan=2>or by</tr>
+<tr><td>Last name:<td><input type=text name=last_name size=40></tr>
+</table>
+
+<p>
+
+<center>
+<input type=submit value=Search>
+</center>
+</form>
+
+"
+
+ns_return 200 text/html [ad_partner_return_template]
\ No newline at end of file
Index: web/openacs/www/intranet/offices/view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/offices/view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/offices/view.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,182 @@
+# view.tcl,v 3.3.2.1 2000/03/17 08:23:03 mbryzek Exp
+# File: /www/intranet/offices/view.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Shows all info about a specified office
+# 
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_form_variables
+# group_id
+
+validate_integer group_id $group_id
+
+set caller_group_id $group_id
+
+set return_url [ad_partner_url_with_query]
+
+set db [ns_db gethandle]
+
+# set selection [ns_db 0or1row $db \
+# 	"select g.group_name, g.short_name, o.*, u.first_names || ' ' || u.last_name as name
+#            from im_offices o, user_groups g, users u
+#           where g.group_id = $caller_group_id
+#             and g.group_id=o.group_id(+)
+#             and o.contact_person_id=u.user_id(+)"]
+
+
+set selection [ns_db 0or1row $db \
+"select g.group_name, g.short_name, o.*, u.first_names || ' ' || u.last_name as name
+           from im_offices o, user_groups g, users u
+          where g.group_id = $caller_group_id
+            and g.group_id=o.group_id
+            and o.contact_person_id=u.user_id
+union
+select g.group_name, g.short_name, o.*, '' as name
+           from im_offices o, user_groups g
+          where g.group_id = $caller_group_id
+            and g.group_id=o.group_id
+            and not exists (select 1 from users 
+                            where user_id = o.contact_person_id)
+union
+select g.group_name, g.short_name, o.*, u.first_names || ' ' || u.last_name as name
+           from im_offices o, user_groups g, users u
+          where g.group_id = $caller_group_id
+            and not exists (select 1 from im_offices 
+                            where group_id = g.group_id)
+            and o.contact_person_id=u.user_id
+union
+select g.group_name, g.short_name, o.*, '' as name
+           from im_offices o, user_groups g
+          where g.group_id = $caller_group_id
+            and not exists (select 1 from im_offices 
+                            where group_id = g.group_id)
+            and not exists (select 1 from users      
+                            where user_id = o.contact_person_id)"]
+    
+if { [empty_string_p $selection] } {
+    ad_return_error "Error" "Office doesn't exist"
+    return
+}
+set_variables_after_query
+
+set years_experience ""
+
+if { 0 } {
+    set years_experience [database_to_tcl_string_or_null $db \
+	"select round(sum((sysdate() - first_experience)/365)) 
+           from im_users 
+          where group_id = $caller_group_id"]
+}
+
+
+set page_title "$group_name"
+set context_bar [ad_context_bar [list "/" Home] [list "../" "Intranet"] [list index.tcl "Offices"] "One office"]
+set page_body ""
+
+if { ![empty_string_p $years_experience] } {
+    append page_body "<center><blockquote>
+<em>$years_experience [util_decode $years_experience 1 year years] of combined experience</em>
+</blockquote></center>
+"
+}
+
+append page_body "
+<table cellpadding=3>
+<tr>
+  <th valign=top align=right>Short Name:</th>
+  <td valign=top>$short_name</td>
+</tr>
+
+<tr>
+  <th valign=top align=right>Addess:</th>
+  <td valign=top>[im_format_address $address_line1 $address_line2 $address_city $address_state $address_postal_code]</td>
+</tr>
+
+<tr>
+  <th valign=top align=right>Phone:</TH>
+  <td valign=top>$phone</td>
+</tr>
+
+<tr>
+  <th valign=top align=right>Fax:</TH>
+  <td valign=top>$fax</td>
+</tr>
+
+<tr>
+  <th valign=top align=right>Contact:</TH>
+  <td valign=top>
+"
+if { [empty_string_p $contact_person_id] } {
+    append page_body "    <a href=primary-contact.tcl?group_id=$caller_group_id&limit_to_users_in_group_id=[im_employee_group_id]>Add primary contact</a>\n"
+} else {
+    append page_body "
+    <a href=../users/view.tcl?user_id=$contact_person_id>$name</a>
+    (<a href=primary-contact.tcl?group_id=$caller_group_id>change</a> |
+    <a href=primary-contact-delete.tcl?[export_url_vars group_id return_url]>remove</a>)
+"
+}
+
+append page_body "
+  </td>
+</tr>
+
+<tr>
+  <th align=right valign=top>Landlord:</TH>
+  <td valign=top>$landlord</td>
+</tr>
+
+<tr>
+  <th align=right valign=top>Security:</TH>
+  <td valign=top>$security</td>
+</tr>
+
+<tr>
+  <th align=right valign=top>Other<Br> information:</TH>
+  <td valign=top>$note</td>
+</tr>
+
+
+<tr>
+  <th></th>
+  <td align=center>(<a href=ae.tcl?group_id=$caller_group_id&[export_url_vars return_url]>edit</A>)</td>
+</tr>
+
+</table>
+
+"
+
+set selection [ns_db select $db \
+	"select u.user_id, u.first_names || ' ' || u.last_name as name
+           from users_active u
+          where ad_group_member_p ( u.user_id, $caller_group_id ) = 't'
+       order by upper(first_names),upper(last_name)"]
+
+set employees ""
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append employees "  <li><a href=../users/view.tcl?[export_url_vars user_id]>$name</a>\n"
+    append employees " (<a href=/groups/member-remove-2.tcl?[export_url_vars group_id user_id return_url]>remove</a>)\n"
+}
+
+if { [empty_string_p $employees] } {
+    set employees "<li><i>No employees listed</i>\n"
+}
+
+append page_body "
+<h4>Employees</h4>
+
+<ul>
+$employees
+
+   <p><li><a href=/groups/member-add.tcl?limit_to_users_in_group_id=[im_employee_group_id]&role=member&[export_url_vars group_id return_url]>Add an employee</a>
+   <li><a href=/groups/[ad_urlencode $short_name]/spam.tcl?sendto=members>Send email to this office</a>
+</ul>
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/partners/ae-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/partners/ae-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/partners/ae-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,86 @@
+# ae-2.tcl,v 3.2.2.1 2000/03/17 08:23:05 mbryzek Exp
+# File: /www/intranet/partners/ae-2.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+# 
+# Purpose: Stores partner info in db
+#
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_form_variables
+# Bunch of stuff for dp
+
+validate_integer group_id $group_id
+
+set required_vars [list \
+	[list "dp_ug.user_groups.group_name" "You must specify the partner's name"]]
+
+set errors [im_verify_form_variables $required_vars]
+
+set exception_count 0
+if { ![empty_string_p $errors] } {
+    incr exception_count
+}
+
+set db [ns_db gethandle]
+
+# Make sure partner name is unique
+set exists_p [database_to_tcl_string $db \
+	"select (case when count(1) = 0 then 0 else 1 end) 
+           from user_groups 
+          where short_name='[DoubleApos ${dp_ug.user_groups.short_name}]'
+            and group_id != $group_id"]
+
+if { $exists_p } {
+    incr exception_count
+    append errors "  <li> The specified short name already exists. Either choose a new name or go back to the partner's page to edit the existing record\n"
+}
+
+if { ![empty_string_p $errors] } {
+    ad_return_complaint $exception_count "<ul>$errors</ul>"
+    return
+}
+
+set form_setid [ns_getform]
+
+# Create/update the user group frst since projects reference it
+# Note: group_name, creation_user, creation_date are all set in ae.tcl
+ns_set put $form_setid "dp_ug.user_groups.group_id" $group_id
+ns_set put $form_setid "dp_ug.user_groups.group_type" [ad_parameter IntranetGroupType intranet]
+ns_set put $form_setid "dp_ug.user_groups.approved_p" "t"
+ns_set put $form_setid "dp_ug.user_groups.new_member_policy" "closed"
+ns_set put $form_setid "dp_ug.user_groups.parent_group_id" [im_partner_group_id]
+
+
+# Log the modification date
+ns_set put $form_setid "dp_ug.user_groups.modification_date.expr" "sysdate()"
+ns_set put $form_setid "dp_ug.user_groups.modifying_user" $user_id
+
+
+# Put the group_id into projects
+ns_set put $form_setid "dp.im_partners.group_id" $group_id
+
+with_transaction $db {
+
+    # Update user_groups
+    dp_process -db $db -form_index "_ug" -where_clause "group_id=$group_id"
+
+    # ns_log Notice "process user groups" 
+
+    # Now update im_projects
+    dp_process -db $db -where_clause "group_id=$group_id"
+
+    # ns_log Notice "oh yeah IM"
+} { ns_log Error "transaction failed" }
+
+if { ![exists_and_not_null return_url] } {
+    set return_url [im_url_stub]/partners/view.tcl?[export_url_vars group_id]
+}
+
+if { [exists_and_not_null dp_ug.user_groups.creation_user] } {
+    # add the creating current user to the group
+    ns_returnredirect "/groups/member-add-3.tcl?[export_url_vars group_id return_url]&user_id_from_search=$user_id&role=administrator"
+} else {
+    ns_returnredirect $return_url
+}
Index: web/openacs/www/intranet/partners/ae.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/partners/ae.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/partners/ae.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,65 @@
+# ae.tcl,v 3.2.2.1 2000/03/17 08:23:05 mbryzek Exp
+# File: /www/intranet/partners/ae.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+# 
+# Purpose: Add/edit partner information
+#
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_form_variables 0
+# group_id (if we're editing)
+# return_url (optional)
+
+set db [ns_db gethandle]
+if { [exists_and_not_null group_id] } {
+    
+    validate_integer group_id $group_id
+    
+    set selection [ns_db 1row $db \
+	    "select g.group_name, g.short_name, p.*
+               from im_partners p, user_groups g
+              where p.group_id=$group_id
+                and p.group_id=g.group_id"]
+    set_variables_after_query
+    set page_title "Edit partner"
+    set context_bar [ad_context_bar [list "/" Home] [list "../" "Intranet"] [list index.tcl "Partners"] [list "view.tcl?[export_url_vars group_id]" "One partner"] $page_title]
+
+} else {
+    set page_title "Add partner"
+    set context_bar [ad_context_bar [list "/" Home] [list "../" "Intranet"] [list index.tcl "Partners"] $page_title]
+    set "dp_ug.user_groups.creation_ip_address" [ns_conn peeraddr]
+    set "dp_ug.user_groups.creation_user" $user_id
+    set group_id [database_to_tcl_string $db "select user_group_sequence.nextval from dual"]
+}
+
+set page_body "
+<form method=post action=ae-2.tcl>
+[export_form_vars return_url group_id dp_ug.user_groups.creation_ip_address dp_ug.user_groups.creation_user]
+
+[im_format_number 1] Partner name: 
+<br><dd><input type=text size=45 name=dp_ug.user_groups.group_name [export_form_value group_name]>
+
+<p>[im_format_number 2] Partner short name:
+<br><dd><input type=text size=45 name=dp_ug.user_groups.short_name [export_form_value short_name]>
+
+<p>[im_format_number 3] Type:
+[im_partner_type_select $db "dp.im_partners.partner_type_id" [value_if_exists partner_type_id]]
+
+<p>[im_format_number 4] Status:
+[im_partner_status_select $db "dp.im_partners.partner_status_id" [value_if_exists partner_status_id]]
+
+<p>[im_format_number 5] URL:
+<br><dd><input type=text size=45 name=dp.im_partners.url [export_form_value url]>
+
+<p>[im_format_number 6] Notes:
+<br><dd><textarea name=dp.im_partners.note rows=6 cols=45 wrap=soft>[philg_quote_double_quotes [value_if_exists note]]</textarea>
+ 
+<p><center><input type=submit value=\"$page_title\"></center>
+</form>
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html [ad_partner_return_template]
\ No newline at end of file
Index: web/openacs/www/intranet/partners/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/partners/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/partners/index.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,206 @@
+# index.tcl,v 3.3.2.1 2000/03/17 08:23:05 mbryzek Exp
+# File: /www/intranet/partners/index.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: Lists all partners with dimensional sliders
+#
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_form_variables 0
+# optional: type_id
+
+if { ![exists_and_not_null order_by] } {
+    set order_by "Partner"
+}
+if { ![exists_and_not_null type_id] } {
+    set type_id 0
+} else {
+    validate_integer type_id $type_id
+}
+
+if { ![exists_and_not_null status_id] } {
+    set status_id 0
+} else {
+    validate_integer status_id $status_id
+}
+
+if { ![exists_and_not_null mine_p] } {
+    set mine_p "t"
+}
+set view_types [list "t" "Mine" "f" "All"]
+
+# status_types will be a list of pairs of (partner_type_id, partner_status)
+set partner_types [ad_partner_memoize_list_from_db \
+	"select partner_type_id, partner_type
+           from im_partner_types
+          order by display_order, lower(partner_type)" [list partner_type_id partner_type]]
+lappend partner_types 0 All
+
+
+# status_types will be a list of pairs of (partner_status_id, partner_status)
+set status_types [ad_partner_memoize_list_from_db \
+	"select partner_status_id, partner_status
+           from im_partner_status
+          order by display_order, lower(partner_status)" [list partner_status_id partner_status]]
+lappend status_types 0 All
+
+
+# Now let's generate the sql query
+set criteria [list]
+
+if { ![empty_string_p $type_id] && $type_id != 0 } {
+    lappend criteria "p.partner_type_id=$type_id"
+}
+
+if { ![empty_string_p $status_id] && $status_id != 0 } {
+    lappend criteria "p.partner_status_id=$status_id"
+}
+
+set extra_tables [list]
+if { [string compare $mine_p "t"] == 0 } {
+    lappend criteria "ad_group_member_p ( $user_id, g.group_id ) = 't'"
+}
+
+set order_by_clause ""
+switch $order_by {
+    "Partner" { set order_by_clause "order by upper(group_name)" }
+    "Type" { set order_by_clause "order by upper(partner_type), upper(group_name)" }
+    "Status" { set order_by_clause "order by upper(partner_status), upper(group_name)" }
+    "URL" { set order_by_clause "order by upper(url), upper(group_name)" }
+    "Note" { set order_by_clause "order by upper(note), upper(group_name)" }
+}
+
+set extra_table ""
+if { [llength $extra_tables] > 0 } {
+    set extra_table ", [join $extra_tables ","]"
+}
+
+set where_clause [join $criteria " and\n            "]
+if { ![empty_string_p $where_clause] } {
+    set where_clause " and $where_clause"
+}
+
+set page_title "Partners"
+set context_bar [ad_context_bar [list "/" Home] [list ../index.tcl "Intranet"] $page_title]
+
+set db [ns_db gethandle]
+# set selection [ns_db select $db \
+# 	"select p.*, g.group_name, t.partner_type, s.partner_status
+#            from user_groups g, im_partners p, im_partner_types t, im_partner_status s$extra_table
+#           where p.group_id = g.group_id
+#             and p.partner_type_id=t.partner_type_id(+) 
+#             and p.partner_status_id=s.partner_status_id(+) $where_clause $order_by_clause"]
+
+
+set selection [ns_db select $db "\
+select p.*, g.group_name, t.partner_type, s.partner_status
+           from user_groups g, im_partners p, im_partner_types t, im_partner_status s$extra_table
+          where p.group_id = g.group_id
+            and p.partner_type_id=t.partner_type_id
+            and p.partner_status_id=s.partner_status_id
+                $where_clause
+union
+select p.*, g.group_name, '' as partner_type, s.partner_status
+           from user_groups g, im_partners p, im_partner_status s$extra_table
+          where p.group_id = g.group_id
+            and not exists (select 1 from im_partner_types 
+                            where partner_type_id = p.partner_type_id) 
+            and p.partner_status_id=s.partner_status_id
+                $where_clause 
+union
+select p.*, g.group_name, t.partner_type, '' as partner_status
+           from user_groups g, im_partners p, im_partner_types t$extra_table
+          where p.group_id = g.group_id
+            and p.partner_type_id=t.partner_type_id 
+            and not exists (select 1 from im_partner_status 
+                            where partner_status_id = p.partner_status_id) 
+                $where_clause 
+union
+select p.*, g.group_name, '' as partner_type, '' as partner_status
+           from user_groups g, im_partners p$extra_table
+          where p.group_id = g.group_id
+            and not exists (select 1 from im_partner_types 
+                            where partner_type_id = p.partner_type_id) 
+            and not exists (select 1 from im_partner_status 
+                            where partner_status_id = p.partner_status_id) 
+                $where_clause 
+$order_by_clause"]
+            
+
+set results ""
+set bgcolor(0) " bgcolor=\"[ad_parameter TableColorOdd Intranet white]\""
+set bgcolor(1) " bgcolor=\"[ad_parameter TableColorEven Intranet white]\""
+set ctr 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { [empty_string_p $url] } {
+	set url "&nbsp;"
+    } else {
+	set url "<a href=\"[im_maybe_prepend_http $url]\">[im_maybe_prepend_http $url]</a>"
+    }
+    append results "
+<tr$bgcolor([expr $ctr % 2])>
+  <td valign=top>[ad_partner_default_font]<a href=view.tcl?[export_url_vars group_id]>$group_name</a></font></td>
+  <td valign=top>[ad_partner_default_font][util_decode $partner_type "" "&nbsp;" $partner_type]</font></td>
+  <td valign=top>[ad_partner_default_font][util_decode $partner_status "" "&nbsp;" $partner_status]</font></td>
+  <td valign=top>[ad_partner_default_font]$url</font></td>
+  <td valign=top>[ad_partner_default_font][util_decode $note "" "&nbsp;" $note]</font></td>
+</tr>
+"
+    incr ctr
+}
+
+
+if { [empty_string_p $results] } {
+    set results "<ul><li><b> There are currently no partners</b></ul>\n"
+} else {
+    set column_headers [list Partner Type Status URL Note]
+    set url "index.tcl"
+    set query_string [export_ns_set_vars url [list order_by]]
+    if { [empty_string_p $query_string] } {
+	append url "?"
+    } else {
+	append url "?$query_string&"
+    }
+    set table "
+<table width=100% cellpadding=1 cellspacing=2 border=0>
+<tr bgcolor=\"[ad_parameter TableColorHeader intranet white]\">
+"
+    foreach col $column_headers {
+	if { [string compare $order_by $col] == 0 } {
+	    append table "  <th>$col</th>\n"
+	} else {
+	    append table "  <th><a href=\"${url}order_by=[ns_urlencode $col]\">$col</a></th>\n"
+	}
+    }
+    set results "
+<br>
+$table
+</tr>
+$results
+</table>
+"
+}
+
+
+
+
+set page_body "
+[ad_partner_default_font "size=-1"]
+Partner status: [im_slider status_id $status_types]
+<br>Partner type: [im_slider type_id $partner_types]
+<br>View: [im_slider mine_p $view_types]
+</font>
+<p>
+$results
+
+<p><a href=ae.tcl>Add a partner</a>
+"
+
+ns_db releasehandle $db
+
+ 
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/partners/view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/partners/view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/partners/view.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,181 @@
+# view.tcl,v 3.3.2.1 2000/03/17 08:23:06 mbryzek Exp
+# File: /www/intranet/partners/view.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: Lists info about one partner
+#
+
+set current_user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_form_variables
+# group_id
+
+validate_integer group_id $group_id
+
+set return_url [ad_partner_url_with_query]
+
+set db [ns_db gethandle]
+
+# Admins and Employees can administer partners
+set user_admin_p [im_is_user_site_wide_or_intranet_admin $db $current_user_id]
+if { $user_admin_p == 0 } {
+    set user_admin_p [im_user_is_employee_p $db $current_user_id]
+}
+
+# set user_admin_p [im_can_user_administer_group $db $group_id $current_user_id]
+
+
+
+if { $user_admin_p > 0 } {
+    # Set up all the admin stuff here in an array
+    set admin(basic_info) "  <p><li> <a href=ae.tcl?[export_url_vars group_id return_url]>Edit this information</a>"
+    set admin(contact_info) "<p><li><a href=/address-book/record-add.tcl?scope=group&[export_url_vars group_id return_url]>Add a contact</a>"
+} else {
+    set admin(basic_info) ""
+    set admin(contact_info) ""
+}
+ 
+# set selection [ns_db 1row $db \
+# 	"select g.group_name, g.registration_date, g.modification_date, p.note, p.url, g.short_name, 
+#                 coalesce(t.partner_type,'&lt;-- not specified --&gt;') as partner_type,
+#                 coalesce(s.partner_status,'&lt;-- not specified --&gt;') as partner_status
+# 	   from user_groups g, im_partners p, im_partner_types t, im_partner_status s
+# 	  where g.group_id=$group_id
+# 	    and g.group_id=p.group_id
+# 	    and p.partner_type_id=t.partner_type_id(+)
+# 	    and p.partner_status_id=s.partner_status_id(+)"]
+
+
+
+set selection [ns_db 1row $db "\
+select g.group_name, g.registration_date, g.modification_date, p.note, p.url, g.short_name, 
+                coalesce(t.partner_type,'&lt;-- not specified --&gt;') as partner_type,
+                coalesce(s.partner_status,'&lt;-- not specified --&gt;') as partner_status
+	   from user_groups g, im_partners p, im_partner_types t, im_partner_status s
+	  where g.group_id=$group_id
+	    and g.group_id=p.group_id
+	    and p.partner_type_id=t.partner_type_id
+	    and p.partner_status_id=s.partner_status_id
+union
+select g.group_name, g.registration_date, g.modification_date, p.note, p.url, g.short_name, 
+                '&lt;-- not specified --&gt;' as partner_type,
+                coalesce(s.partner_status,'&lt;-- not specified --&gt;') as partner_status
+	   from user_groups g, im_partners p, im_partner_types t, im_partner_status s
+	  where g.group_id=$group_id
+	    and g.group_id=p.group_id
+	    and not exists (select 1 from im_partner_types 
+                            where partner_type_id = p.partner_type_id)
+	    and p.partner_status_id=s.partner_status_id
+union
+select g.group_name, g.registration_date, g.modification_date, p.note, p.url, g.short_name, 
+                coalesce(t.partner_type,'&lt;-- not specified --&gt;') as partner_type,
+                '&lt;-- not specified --&gt;' as partner_status
+	   from user_groups g, im_partners p, im_partner_types t, im_partner_status s
+	  where g.group_id=$group_id
+	    and g.group_id=p.group_id
+	    and p.partner_type_id=t.partner_type_id
+	    and not exists (select 1 from im_partner_status 
+                            where partner_status_id = p.partner_status_id)
+union
+select g.group_name, g.registration_date, g.modification_date, p.note, p.url, g.short_name, 
+                '&lt;-- not specified --&gt;' as partner_type,
+                '&lt;-- not specified --&gt;' as partner_status
+	   from user_groups g, im_partners p, im_partner_types t, im_partner_status s
+	  where g.group_id=$group_id
+	    and g.group_id=p.group_id
+	    and not exists (select 1 from im_partner_types 
+                            where partner_type_id = p.partner_type_id)
+	    and not exists (select 1 from im_partner_status 
+                            where partner_status_id = p.partner_status_id)"]
+
+set_variables_after_query
+
+set page_title $group_name
+set context_bar [ad_context_bar [list "/" Home] [list ../index.tcl "Intranet"] [list index.tcl "Partners"] "One partner"]
+
+set left_column "
+<ul> 
+  <li> Type: $partner_type
+  <li> Status: $partner_status
+  <li> Partner short name: $short_name
+  <li> Added on [util_AnsiDatetoPrettyDate $registration_date]
+" 
+
+if { ![empty_string_p $url] } {
+    set url [im_maybe_prepend_http $url]
+    append left_column "  <li> URL: <a href=\"$url\">$url</a>\n"
+}
+
+if { ![empty_string_p $modification_date] } {
+    append left_column "  <li> Last modified on [util_AnsiDatetoPrettyDate $modification_date]\n"
+}
+
+if { ![empty_string_p $note] } {
+    append left_column "  <li> Notes: <font size=-1>$note</font>\n"
+}
+
+
+append left_column "
+$admin(basic_info)
+</ul>
+"
+
+
+
+# Print out the address book
+set contact_info ""
+set selection [ns_db select $db \
+	"select * 
+           from address_book 
+          where group_id=$group_id
+       order by lower(last_name)"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append contact_info "  <p><li>[address_book_record_display $selection "f"]\n"
+    if { $user_admin_p > 0 } {
+	append contact_info "
+<br>
+\[<a href=/address-book/record-edit.tcl?scope=group&[export_url_vars group_id address_book_id return_url]>edit</a> | 
+<a href=/address-book/record-delete.tcl?scope=group&[export_url_vars group_id address_book_id return_url]>delete</a>\]
+"
+    }
+} 
+
+if { [empty_string_p $contact_info] } {
+    set contact_info "  <li> <i>None</i>\n"
+}
+
+append left_column "
+<b>Contact Information</b>
+<ul>
+$contact_info
+$admin(contact_info)
+</ul>
+
+<em>Contact correspondence and strategy reviews:</em>
+[ad_general_comments_summary $db $group_id im_partners $group_name]
+<ul>
+<p><a href=\"/general-comments/comment-add.tcl?group_id=$group_id&scope=group&on_which_table=im_partners&on_what_id=$group_id&item=[ns_urlencode $group_name]&module=intranet&[export_url_vars return_url]\">Add a correspondance</a>
+</ul>
+
+"
+
+set page_body "
+<table width=100% cellpadding=0 cellspacing=2 border=0>
+<tr>
+  <td valign=top>
+$left_column
+  </td>
+  <td valign=top>
+[im_table_with_title "[ad_parameter SystemName] Employees" "<ul>[im_users_in_group $db $group_id $current_user_id "are working with $group_name" $user_admin_p $return_url [im_employee_group_id]]</ul>"]
+  </td>
+</tr>
+</table>
+
+"
+
+ns_db releasehandle $db
+ns_return 200 text/html [ad_partner_return_template]
\ No newline at end of file
Index: web/openacs/www/intranet/payments/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/payments/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/payments/index.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,73 @@
+# index.tcl,v 1.2.2.1 2000/02/03 09:56:58 ron Exp
+set_form_variables 0
+
+# group_id
+
+validate_integer group_id $group_id
+
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+set project_name [database_to_tcl_string $db "select 
+group_name from user_groups ug
+where group_id = $group_id
+"]
+
+set selection [ns_db select $db "select 
+to_char(start_block,'YYYY-MM-DD') as start_block, fee, fee_type, note, 
+(case when paid_p = 't' then 'Yes' else 'No' end) as paid_p, 
+group_id, payment_id from im_project_payments 
+where
+group_id = $group_id order by start_block asc"]
+ 
+set payment_text ""
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append payment_text "<tr>
+    <td>[util_IllustraDatetoPrettyDate $start_block]
+    <td>$fee_type
+    <td>[util_commify_number $fee]
+    <td>$paid_p <a href=payment-negation.tcl?[export_url_vars payment_id]&return_url=[ns_urlencode [ns_conn url]?[ns_conn query]]>toggle</a>
+    <td>$note<td><a href=project-payment-ae.tcl?[export_url_vars group_id payment_id]>Edit</a></tr>
+<p>"
+
+}
+
+if {$payment_text == ""} {
+    set payment_text "There are no payments recorded."
+} else {
+    set payment_text "
+<table cellspacing=5>
+<tr>
+ <th align=left>Start of work period
+ <th align=left>Fee type
+ <th align=left>Fee
+ <th align=left>Paid?
+ <th align=left>Note
+ <th align=left>Edit
+$payment_text
+</table>
+"
+}
+
+set page_title "Payments for $project_name"
+set context_bar [ad_context_bar [list "../index.tcl" "Intranet"] [list "../projects/index.tcl" "Projects"] [list "../projects/view.tcl?[export_url_vars group_id]"  $project_name] "Payments"]
+
+ns_return 200 text/html "
+[ad_partner_header]
+
+Start of work period is the start of actual development.  Typically,
+a monthly fee for a given month is due the 15th of the following month.
+For example, if the \"start of work period\" is November 1st, the fee for
+this is due on December 15th.
+
+$payment_text
+<p>
+<table width=100%>
+<tr>
+ <td><a href=project-payment-ae.tcl?[export_url_vars group_id]>Add a payment</a>
+ <td align=right><a href=project-payments-audit.tcl?[export_url_vars group_id]>Audit Trail</a>
+</table>
+[ad_partner_footer]
+"
Index: web/openacs/www/intranet/payments/payment-negation.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/payments/payment-negation.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/payments/payment-negation.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,12 @@
+# payment-negation.tcl,v 1.1.2.1 2000/02/03 09:56:59 ron Exp
+set_the_usual_form_variables
+
+# return_url, payment_id
+
+validate_integer payment_id $payment_id
+
+set db [ns_db gethandle]
+
+ns_db dml $db "update im_project_payments set paid_p  = logical_negation(paid_p), received_date = sysdate() where payment_id= $payment_id"
+
+ns_returnredirect $return_url
Index: web/openacs/www/intranet/payments/project-payment-ae-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/payments/project-payment-ae-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/payments/project-payment-ae-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,73 @@
+# project-payment-ae-2.tcl,v 1.1.2.1 2000/02/03 09:57:02 ron Exp
+set_the_usual_form_variables
+
+# group_id, payment_id, start_block, fee, fee_types
+# due_date, received_date, note
+
+validate_integer group_id $group_id
+validate_integer payment_id $payment_id
+
+set db [ns_db gethandle]
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set required_vars [list [list start_block "Missing starting date"] [list fee_type "Missing fee type"]]
+
+
+regsub "," $fee "" fee
+
+
+ns_db dml $db "update im_project_payments set 
+    start_block = '$start_block',
+    fee = '$fee',
+    fee_type = '$QQfee_type',
+    last_modified = sysdate(),
+    last_modifying_user = $user_id,
+    modified_ip_address = '[ns_conn peeraddr]',
+    note = '$QQnote'
+    where payment_id = $payment_id"
+
+if {[ns_pg ntuples $db] == 0} {
+    ns_db dml $db "insert into im_project_payments 
+    (payment_id, group_id, start_block, fee, fee_type,  
+    note, last_modified, last_modifying_user, modified_ip_address)
+    values ($payment_id, $group_id, '$start_block', $fee, 
+    '$QQfee_type', '$QQnote', sysdate(),$user_id, '[ns_conn peeraddr]')"
+}
+
+ns_returnredirect "index.tcl?[export_url_vars group_id]"
+
+# email the people in the intranet billing group
+
+set project_name [database_to_tcl_string $db "select group_name
+from user_groups where group_id = $group_id"]
+
+set editing_user [database_to_tcl_string $db "select first_names
+|| ' ' || last_name from users where user_id = $user_id"]
+
+set selection [ns_db select $db "select email, first_names, last_name 
+from users, user_group_map, administration_info
+where administration_info.module = 'intranet'
+and administration_info.submodule = 'billing'
+and administration_info.group_id = user_group_map.group_id
+and user_group_map.user_id = users.user_id"]
+
+ReturnHeaders
+
+set message "
+
+A payment for $project_name has been changed by $editing_user.
+
+Work starting: $start_block
+Type:  $fee_type
+Note: $note
+
+To view online: [ns_conn location]/intranet/project-payments.tcl?project_id=$group_id
+
+"
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    ns_sendmail $email "[ad_parameter SpamRobotFromAddress spam]" "Change to $project_name payment plan." "$message"
+}
Index: web/openacs/www/intranet/payments/project-payment-ae.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/payments/project-payment-ae.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/payments/project-payment-ae.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,92 @@
+# project-payment-ae.tcl,v 1.2.2.1 2000/02/03 09:57:04 ron Exp
+set_the_usual_form_variables 0
+
+# group_id
+# maybe payment_id
+
+validate_integer group_id $group_id
+
+set caller_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set fee_type_list [ad_parameter FeeTypes intranet]
+
+set db [ns_db gethandle]
+
+set project_name [database_to_tcl_string $db "select 
+group_name from user_groups ug
+where group_id = $group_id"]
+
+
+if {![info exists payment_id] || [empty_string_p $payment_id]} {
+    set payment_id [database_to_tcl_string $db "select nextval('im_project_payment_id_seq') from dual"]
+    set page_title "Add payment  for $project_name" 
+    set button_name "Add payment"
+
+} else {
+
+    validate_integer payment_id $payment_id
+
+    set selection [ns_db 0or1row $db "select * from im_project_payments where
+payment_id = $payment_id"] 
+    if ![empty_string_p $selection] {
+        set_variables_after_query
+    }
+    set page_title "Edit payment for $project_name"
+    set button_name "Update"
+}
+
+set context_bar "[ad_context_bar [list "../index.tcl" "Intranet"] [list "../projects/index.tcl" "Projects"] [list "../projects/view.tcl?[export_url_vars group_id]"  "One project"] "Payment"]"
+
+set page_body "
+
+<form action=project-payment-ae-2.tcl method=post>
+[export_form_vars group_id payment_id]
+
+<TABLE CELLPADDING=5>
+
+<TR>
+<TD ALIGN=RIGHT>Start date of work:</TD>
+<TD> 
+<select name=start_block>
+[ad_db_optionlist $db "select to_char(start_block,'Month DD, YYYY'), start_block from im_start_blocks order by start_block asc" [value_if_exists start_block]]
+</select>
+</TD>
+</TR>
+
+<tr>
+<td align=right>Fee:</td>
+<td>
+<input type=text name=fee [export_form_value fee]>
+</td>
+</tr>
+
+
+<TR>
+<TD ALIGN=RIGHT>Fee type:</TD>
+<TD><select name=fee_type>
+[ad_generic_optionlist  $fee_type_list $fee_type_list [value_if_exists fee_type]]
+</select>
+</TD>
+</TR>
+
+
+
+
+</TABLE>
+
+<P>Note:<BR>
+<BLOCKQUOTE>
+<TEXTAREA NAME=note COLS=45 ROWS=5 wrap=soft>[ns_quotehtml [value_if_exists note]]</TEXTAREA>
+</BLOCKQUOTE>
+
+<P><CENTER>
+<INPUT TYPE=Submit Value=\" $button_name \">
+</CENTER>
+
+</FORM>
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/payments/project-payments-audit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/payments/project-payments-audit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/payments/project-payments-audit.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,26 @@
+# project-payments-audit.tcl,v 1.2.2.1 2000/02/03 09:57:05 ron Exp
+set_form_variables 0
+
+# group_id
+
+validate_integer group_id $group_id
+
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+set project_name [database_to_tcl_string $db "select 
+group_name from user_groups
+where group_id = $group_id"]
+
+set page_title "Payments audit for $project_name"
+set context_bar "[ad_context_bar [list "index.tcl" "Intranet"] [list "projects.tcl" "Projects"] [list "project-info.tcl?[export_url_vars group_id]"  $project_name] [list "project-payments.tcl?[export_url_vars group_id]" "Payments"] "Audit"]"
+
+ns_return 200 text/html "
+[ad_partner_header]
+
+[ad_audit_trail $db $group_id im_project_payments_audit im_project_payments group_id]
+
+
+[ad_partner_footer]
+"
Index: web/openacs/www/intranet/procedures/add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/procedures/add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/procedures/add-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,60 @@
+# add-2.tcl,v 3.0.4.1 2000/03/17 08:02:22 mbryzek Exp
+# File: /www/intranet/procedures/add-2.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: Stores a new procedure to the db
+#
+
+set_the_usual_form_variables
+# procedure_id, name, note, user_id
+
+validate_integer user_id $user_id
+validate_integer procedure_id $procedure_id
+
+set creation_user [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+set exception_count 0
+set exception_text ""
+
+if [empty_string_p ${name}] {
+    incr exception_count
+    append exception_text "<LI>The procedure needs a name\n"
+}
+
+if [empty_string_p ${user_id}] {
+    incr exception_count
+    append exception_text "<LI>Missing supervisor"
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+ns_db dml $db "begin transaction"
+
+set insert "insert into im_procedures 
+(procedure_id, name, note, creation_date, creation_user) values
+($procedure_id, '$QQname', '$QQnote', sysdate(), $creation_user)"
+
+if [catch {ns_db dml $db $insert} errmsg] {
+    if {[database_to_tcl_string $db "select count(*) from im_procedures where procedure_id = $procedure_id"] == 0} {
+        ad_return_error "Error" "Can't add procedure. Error: <PRE>$errmsg</PRE> "
+        return
+    } else {
+        ns_returnredirect procedures.tcl
+        return
+    }
+}
+
+ns_db dml $db "insert into im_procedure_users 
+(procedure_id, user_id, certifying_user, certifying_date) values
+($procedure_id, $user_id, $creation_user, sysdate())"
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect index.tcl
Index: web/openacs/www/intranet/procedures/add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/procedures/add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/procedures/add.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,54 @@
+# add.tcl,v 3.2.2.1 2000/03/17 08:02:22 mbryzek Exp
+# File: /www/intranet/procedures/add.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: Form to enter necessary info about a new procedure
+#
+
+ad_maybe_redirect_for_registration
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+set procedure_id [database_to_tcl_string $db \
+	"select im_procedures_procedure_id_seq.nextval from dual"]
+
+set page_title "Add a procedure"
+set context_bar [ad_context_bar [list "/" Home] [list "../index.tcl" "Intranet"] [list "index.tcl" "Procedures"] "Add procedure"]
+
+set page_body "
+<blockquote>
+
+<form method=post action=add-2.tcl>
+<input type=hidden name=procedure_id [export_form_value procedure_id]>
+
+[im_format_number 1] The procedure:
+<br><dd><input type=text size=50 maxlength=200 name=name [export_form_value name]>
+
+<p>[im_format_number 2] Notes on the procedure:
+<br><dd><textarea name=note cols=50 rows=8 wrap=soft>[philg_quote_double_quotes [value_if_exists note]]</textarea>
+
+<p>[im_format_number 3] The first person certified to do the procedure (and the
+person responsible for certifying others): 
+<br><dd>
+<select name=user_id>
+<option value=\"\"> -- Please select --
+[ad_db_optionlist $db "select 
+first_names || ' ' || last_name as name, user_id 
+from users
+where ad_group_member_p ( user_id, [im_employee_group_id] ) = 't'
+order by lower(first_names),lower(last_name)" [value_if_exists creation_user]]
+</select>
+
+<p><center>
+<input type=submit value=\" $page_title \">
+</center>
+</p>
+
+</form>
+
+</blockquote>
+
+"
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/procedures/event-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/procedures/event-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/procedures/event-add-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,54 @@
+# event-add-2.tcl,v 3.0.4.1 2000/03/17 08:02:23 mbryzek Exp
+# File: /www/intranet/procedures/event-add-2.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: Records a procedure event (Certification of another user for 
+#  the procedure)
+#
+
+set_the_usual_form_variables
+# procedure_id, user_id, note, event_date
+
+validate_integer user_id $user_id
+validate_integer procedure_id $procedure_id
+
+set supervising_user [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+if {[database_to_tcl_string $db "select count(*) from im_procedure_users where user_id = $supervising_user and procedure_id = $procedure_id"] == 0} {
+    ad_return_error "Error" "You're not allowed to certify new users"
+    return
+}
+
+set exception_count 0
+set exception_text ""
+
+if {![info exists user_id] || [empty_string_p $user_id]} {
+    incr exception_count
+    append exception_text "<LI>Missing name of user to certify\n"
+}
+if [catch {ns_dbformvalue [ns_conn form] event_date date event_date}] {
+    incr exception_count
+    append exception_text "<LI>The date you entered isn't valid"
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+ns_db dml $db "update im_procedure_events 
+set note = '$QQnote', user_id = $user_id, procedure_id = $procedure_id, 
+    event_date = '$event_date', supervising_user = $supervising_user
+where event_id = $event_id"
+
+if {[ns_pg ntuples $db] == 0} {
+    ns_db dml $db "insert into im_procedure_events
+(event_id, user_id, procedure_id, note, supervising_user, event_date) values
+($event_id, $user_id, $procedure_id,'$QQnote', $supervising_user, '$event_date')"
+}
+
+ns_returnredirect index.tcl?[export_url_vars procedure_id]
Index: web/openacs/www/intranet/procedures/event-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/procedures/event-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/procedures/event-add.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,94 @@
+# event-add.tcl,v 3.2.2.1 2000/03/17 08:02:23 mbryzek Exp
+# File: /www/intranet/procedures/event-add.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: Form to certify a user in a procedure
+#
+
+set_form_variables
+# procedure_id
+
+validate_integer procedure_id $procedure_id
+
+set caller_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "
+select * from im_procedures where procedure_id = $procedure_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Error" "That procedure doesn't exist"
+    return
+}
+set_variables_after_query
+
+if {[database_to_tcl_string $db "select count(*) from im_procedure_users where user_id = $caller_id and procedure_id = $procedure_id"] == 0} {
+    ad_return_error "Error" "You're not allowed to supervise users on this procedure"
+    return
+}
+
+set event_id [database_to_tcl_string $db "select im_proc_event_id_seq.nextval from dual"]
+
+set page_body "
+
+[ad_header "Record a procedure"]
+
+<H2>Record procedure</H2>
+
+[ad_context_bar [list "/" Home] [list "../index.tcl" "Intranet"] [list "index.tcl" "Procedures"] "Record procedure"]
+
+<HR>
+
+Use this form to record the times an uncertified user did this procedure.
+If you're confident enough in their ability, you can
+<A HREF=user-add.tcl?procedure_id=$procedure_id>certify them</A>
+instead.
+
+<UL>
+<LI>Procedure: $name
+<BLOCKQUOTE><EM>$note</EM></BLOCKQUOTE>
+</UL>
+
+<BLOCKQUOTE>
+
+<FORM METHOD=POST ACTION=event-add-2.tcl>
+[export_form_vars event_id procedure_id]
+
+<P>User supervised:
+<SELECT NAME=user_id>
+<option value=\"\"> -- Please select --
+[ad_db_optionlist $db "select 
+first_names || ' ' || last_name as name, u.user_id 
+from users_active u
+where ad_group_member_p ( u.user_id, [im_employee_group_id] ) = 't'
+and not exists (select 1 
+            from im_procedure_users ipu
+            where ipu.user_id = u.user_id
+            and procedure_id = $procedure_id)"]
+</SELECT>
+
+<P>Date supervised: [ad_dateentrywidget event_date]
+
+<P>Notes:<BR>
+<TEXTAREA NAME=note COLS=50 ROWS=8 WRAP=SOFT></TEXTAREA>
+
+</UL>
+
+<P><CENTER>
+<INPUT TYPE=Submit VALUE=\" Record procedure \">
+</CENTER>
+</P>
+
+</FORM>
+</BLOCKQUOTE>
+
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $page_body
+
Index: web/openacs/www/intranet/procedures/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/procedures/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/procedures/index.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,122 @@
+# index.tcl,v 3.1.4.1 2000/03/17 08:02:24 mbryzek Exp
+# File: /www/intranet/procedures/index.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: lists all procedures
+#
+
+set page_body "
+
+<blockquote>
+
+Use this section to record company procedures and 
+the people certified to do them. 
+<P>How to use:
+
+<UL>
+<LI>Anyone can add a procedure, and they're allowed to pick
+the first person certified for that procedure.
+<LI>Anyone certified in procedure <EM>X</EM> can certify anyone else
+to do that procedure. (That person can also add restrictions like
+<EM>only certified on HPUX</EM>)
+<LI>Certified users should record times they supervised 
+a non-certified user doing a procedure, so we can use rules
+like <EM>A user can be certified after completing the procedure
+5 times under the supervision of a certified user</EM>.
+</UL>
+
+<H4>The procedures</H4>
+
+<dl>
+"
+
+set db [ns_db gethandle]
+
+# set selection [ns_db select $db "
+# select 
+#     p.procedure_id,
+#     p.name as proc_name,
+#     u.user_id,
+#     u.first_names || ' ' || u.last_name as user_name
+# from im_procedures p, im_procedure_users pu, users_active u
+# where p.procedure_id = pu.procedure_id(+)
+# and pu.user_id = u.user_id(+)
+# order by proc_name, user_name"]
+
+
+set selection [ns_db select $db "
+select 
+    p.procedure_id,
+    p.name as proc_name,
+    u.user_id,
+    u.first_names || ' ' || u.last_name as user_name
+from im_procedures p, im_procedure_users pu, users_active u
+where p.procedure_id = pu.procedure_id
+and pu.user_id = u.user_id
+union
+select 
+    p.procedure_id,
+    p.name as proc_name,
+    u.user_id,
+    u.first_names || ' ' || u.last_name as user_name
+from im_procedures p, im_procedure_users pu, users_active u
+where not exists (select 1 from im_procedure_users 
+                  where procedure_id = p.procedure_id)
+and pu.user_id = u.user_id
+union
+select 
+    p.procedure_id,
+    p.name as proc_name,
+    '' as user_id,
+    '' as user_name
+from im_procedures p, im_procedure_users pu
+where p.procedure_id = pu.procedure_id
+and not exists (select 1 from users_active 
+                where user_id = pu.user_id)
+union
+select 
+    p.procedure_id,
+    p.name as proc_name,
+    '' as user_id,
+    '' as user_name
+from im_procedures p, im_procedure_users pu
+where not exists (select 1 from im_procedure_users 
+                  where procedure_id = p.procedure_id)
+and not exists (select 1 from users_active 
+                where user_id = pu.user_id)
+order by proc_name, user_name"]
+
+set list_of_procedures ""
+
+set last_procedure_id ""
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    if {$procedure_id != $last_procedure_id} {
+        append list_of_procedures "<p><dt><a href=info.tcl?[export_url_vars procedure_id]>$proc_name</A>\n"
+    }
+    append list_of_procedures "  <dd>$user_name\n"
+    set last_procedure_id $procedure_id
+}
+
+if [empty_string_p $list_of_procedures] {
+    set list_of_procedures "<EM>No procedures exist</EM>"
+}
+
+append page_body "
+
+$list_of_procedures
+
+</DL>
+
+<P><BR><A HREF=add.tcl>Add a procedure</A>
+</BLOCKQUOTE>
+"
+
+ns_db releasehandle $db
+
+set page_title "Procedures"
+set context_bar [ad_context_bar [list "/" Home] [list "../index.tcl" "Intranet"] "Procedures"]
+
+ns_return 200 text/html [ad_partner_return_template]
\ No newline at end of file
Index: web/openacs/www/intranet/procedures/info-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/procedures/info-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/procedures/info-edit-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,29 @@
+# info-edit-2.tcl,v 3.0.4.1 2000/03/17 08:02:24 mbryzek Exp
+# File: /www/intranet/procedures/info-edit-2.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: Stores changes to procedure
+#
+
+set_the_usual_form_variables
+# procedure_id, note
+
+validate_integer procedure_id $procedure_id
+
+set caller_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+set exception_count 0
+set exception_text ""
+
+if [empty_string_p $name] {
+    incr exception_count
+    append exception_text "<LI>The procedure needs a name\n"
+}
+
+ns_db dml $db "update im_procedures set note = '$QQnote', name='$QQname' where procedure_id = $procedure_id"
+
+ns_returnredirect info.tcl?procedure_id=$procedure_id
Index: web/openacs/www/intranet/procedures/info-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/procedures/info-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/procedures/info-edit.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,63 @@
+# info-edit.tcl,v 3.1.4.1 2000/03/17 08:02:24 mbryzek Exp
+# File: /www/intranet/procedures/info-edit.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: Form to edit procedure information
+#
+
+set_form_variables
+# procedure_id
+
+validate_integer procedure_id $procedure_id
+
+set caller_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+if {[database_to_tcl_string $db "select count(*) from im_procedure_users where user_id = $caller_id and procedure_id = $procedure_id"] == 0} {
+    ad_return_error "Error" "You're not allowed to edit this information"
+    return
+}
+
+set selection [ns_db 0or1row $db "
+select * from im_procedures where procedure_id = $procedure_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Error" "That procedure doesn't exist"
+    return
+}
+set_variables_after_query
+
+set page_body "
+
+[ad_header $name]
+
+<H2>$name</H2>
+
+[ad_context_bar [list "/" Home] [list "../index.tcl" "Intranet"] [list "index.tcl" "Procedures"] "Edit Procedure info"]
+
+<HR>
+
+<BLOCKQUOTE>
+<FORM METHOD=POST ACTION=info-edit-2.tcl>
+[export_form_vars procedure_id]
+
+<P>The procedure:<BR>
+<INPUT NAME=name SIZE=50 [export_form_value name]>
+
+<P>Notes on the procedure<BR>
+<TEXTAREA NAME=note COLS=50 ROWS=12 WRAP=SOFT>[ns_quotehtml $note]</TEXTAREA>
+
+<P><CENTER>
+<INPUT TYPE=Submit VALUE=\" Update \">
+</CENTER></P>
+
+</BLOCKQUOTE>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $page_body
\ No newline at end of file
Index: web/openacs/www/intranet/procedures/info.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/procedures/info.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/procedures/info.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,142 @@
+# info.tcl,v 3.1.4.1 2000/03/17 08:02:25 mbryzek Exp
+# File: /www/intranet/procedures/info.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: lists information about 1 procedure
+#
+
+set_form_variables
+# procedure_id
+
+validate_integer procedure_id $procedure_id
+
+set caller_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db \
+	"select * from im_procedures where procedure_id = $procedure_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Error" "That procedure doesn't exist"
+    return
+}
+set_variables_after_query
+
+set page_title $name
+set context_bar [ad_context_bar [list "/" Home] [list "../index.tcl" "Intranet"] [list "index.tcl" "Procedures"] "One procedure"]
+
+set page_body "
+<blockquote>
+[util_decode $note "" "<em>No description</em>" $note]
+"
+
+if {[database_to_tcl_string $db \
+	"select count(*) from im_procedure_users where procedure_id = $procedure_id and user_id = $caller_id"] > 0} {
+    append page_body "<p>(<a href=info-edit.tcl?[export_url_vars procedure_id]>edit</a>)\n"
+}
+
+append page_body "
+</BLOCKQUOTE>
+
+<H4>People certified to do this procedure</H4>
+
+"
+
+set selection [ns_db select $db "
+select 
+    u.user_id, 
+    u.first_names || ' ' || u.last_name as user_name,
+    pu.certifying_date,
+    u2.first_names || ' ' || u2.last_name as certifying_user_name,
+    pu.note as restrictions
+from users_active u, users_active u2, im_procedure_users pu, im_procedures p
+where p.procedure_id = $procedure_id
+and p.procedure_id = pu.procedure_id
+and u.user_id = pu.user_id
+and u2.user_id = pu.certifying_user
+order by certifying_date"]
+
+set certified_users ""
+set list_of_users {}
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    if ![empty_string_p $restrictions] {
+        set restrictions "Restrictions: $restrictions"
+    }
+    append certified_users "<LI><A HREF=user-info.tcl?[export_url_vars user_id procedure_id]>$user_name</A>,
+<FONT SIZE=-1> certified [util_AnsiDatetoPrettyDate $certifying_date] by $certifying_user_name<BR>
+&nbsp;&nbsp;$restrictions</FONT>\n"
+    lappend list_of_users $user_id
+}
+
+if [empty_string_p $certified_users] {
+    set certified_users "<EM>none</EM>"
+}
+
+if {[lsearch -exact $list_of_users $caller_id] != -1} {
+    set caller_certified_p 1
+    append certified_users "<P><A HREF=user-add.tcl?procedure_id=$procedure_id>Certify a user</A>"
+} else {
+    set caller_certified_p 0
+}
+
+append page_body "
+
+<UL>
+$certified_users
+</UL>
+
+<H4>Uncertified people who have done this procedure</H4>
+
+"
+
+set selection [ns_db select $db "
+select
+    u.user_id, 
+    u.first_names || ' ' || u.last_name as user_name,
+    pe.event_date,
+    u2.first_names || ' ' || u2.last_name as supervising_user_name,
+    pe.note as event_note
+from users_active u, users_active u2, im_procedure_events pe, im_procedures p
+where p.procedure_id = $procedure_id
+and p.procedure_id = pe.procedure_id
+and u.user_id = pe.user_id
+and u2.user_id = pe.supervising_user
+and not exists (select 1 from im_procedure_users ipu 
+                where ipu.user_id = u.user_id
+                and ipu.procedure_id = $procedure_id) 
+order by event_date"]
+
+set events ""
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append events "<LI><A HREF=../users/view.tcl?[export_url_vars user_id]>$user_name</A>, <FONT SIZE=-1>supervised by $supervising_user_name on [util_AnsiDatetoPrettyDate $event_date]"
+    if ![empty_string_p $note] {
+        append events "<BR>&nbsp; &nbsp; $event_note\n"
+    }
+    append events "</FONT>\n"
+}
+
+if [empty_string_p $events] {
+    set events "<EM>None</EM>"
+}
+
+if {$caller_certified_p} {
+    append events "<P><A HREF=event-add.tcl?procedure_id=$procedure_id>Add a record</A>"
+}
+
+append page_body "
+
+<UL>
+$events
+</UL>
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html [ad_partner_return_template]
\ No newline at end of file
Index: web/openacs/www/intranet/procedures/user-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/procedures/user-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/procedures/user-add.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,81 @@
+# user-add.tcl,v 3.2.2.1 2000/03/17 08:02:26 mbryzek Exp
+# File: /www/intranet/procedures/user-add.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: Certify a new user
+#
+
+set_form_variables
+# procedure_id
+
+validate_integer procedure_id $procedure_id
+
+set caller_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "
+select * from im_procedures where procedure_id = $procedure_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Error" "That procedure doesn't exist"
+    return
+}
+set_variables_after_query
+
+if {[database_to_tcl_string $db "select count(*) from im_procedure_users where user_id = $caller_id and procedure_id = $procedure_id"] == 0} {
+    ad_return_error "Error" "You're not allowed to certify new users"
+    return
+}
+
+set page_body "
+
+[ad_header "Certify a user"]
+
+<H2>Certify a user</H2>
+
+[ad_context_bar [list "/" Home] [list "../index.tcl" "Intranet"] [list "index.tcl" "Procedures"] "Certify a user"]
+
+<HR>
+
+<FORM METHOD=POST ACTION=user-edit-2.tcl>
+[export_form_vars procedure_id]
+
+<UL>
+<LI>Procedure: <B>$name</B>
+
+<P><BLOCKQUOTE><EM>$note</EM></BLOCKQUOTE>
+
+<P><LI>Certify user: 
+<SELECT NAME=user_id>
+<option value=\"\"> -- Please select --
+[ad_db_optionlist $db "select 
+first_names || ' ' || last_name as name, u.user_id 
+from users_active u
+where ad_group_member_p ( u.user_id, [im_employee_group_id] ) = 't'
+and not exists (select 1 from im_procedure_users ipu
+            where ipu.user_id = u.user_id
+            and procedure_id = $procedure_id)
+order by lower(first_names),lower(last_name)"]
+</SELECT>
+
+<P>Notes/restrictions (<EM>e.g., only certified on HPUX</EM>):<BR>
+<TEXTAREA NAME=note COLS=50 ROWS=8 WRAP=SOFT></TEXTAREA>
+
+</UL>
+
+<P><CENTER>
+<INPUT TYPE=Submit VALUE=\" Certify user \">
+</CENTER>
+</P>
+
+</FORM>
+
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $page_body
Index: web/openacs/www/intranet/procedures/user-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/procedures/user-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/procedures/user-edit-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,43 @@
+# user-edit-2.tcl,v 3.0.4.1 2000/03/17 08:02:26 mbryzek Exp
+# File: /www/intranet/procedures/user-edit-2.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: Edits/inserts note about a procedure
+#
+
+set_the_usual_form_variables
+# procedure_id, user_id, note
+
+validate_integer user_id $user_id
+validate_integer procedure_id $procedure_id
+
+set certifying_user [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+if {[database_to_tcl_string $db "select count(*) from im_procedure_users where user_id = $certifying_user and procedure_id = $procedure_id"] == 0} {
+    ad_return_error "Error" "You're not allowed to certify new users"
+    return
+}
+
+set exception_count 0
+set exception_text ""
+
+if [empty_string_p $user_id] {
+    incr exception_count
+    append exception_text "<LI>Missing name of user to certify\n"
+}
+
+ns_db dml $db "update im_procedure_users set note = '$QQnote'
+where procedure_id = $procedure_id
+and user_id = $user_id"
+
+if {[ns_pg ntuples $db] == 0} {
+    ns_db dml $db "insert into im_procedure_users
+(procedure_id, user_id, note, certifying_user, certifying_date) values
+($procedure_id, $user_id, '$QQnote', $certifying_user, sysdate())"
+}
+
+ns_returnredirect info.tcl?[export_url_vars procedure_id]
Index: web/openacs/www/intranet/procedures/user-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/procedures/user-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/procedures/user-edit.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,92 @@
+# user-edit.tcl,v 3.1.4.1 2000/03/17 08:02:28 mbryzek Exp
+# File: /www/intranet/procedures/user-edit.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: form to change restrictions on a procedure
+#
+
+set_form_variables
+# procedure_id user_id
+
+validate_integer user_id $user_id
+validate_integer procedure_id $procedure_id
+
+set caller_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "
+select * from im_procedures where procedure_id = $procedure_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Error" "That procedure doesn't exist"
+    return
+}
+set_variables_after_query
+
+if {[database_to_tcl_string $db "
+select count(*) 
+from im_procedure_users 
+where user_id = $user_id 
+and procedure_id = $procedure_id
+and user_id != $caller_id"] == 0} {
+    ad_return_error "Error" "You're not allowed to change this information"
+    return
+}
+
+set selection [ns_db 0or1row $db "
+select
+    u.first_names || ' ' || u.last_name as user_name,
+    ip.name as procedure_name,
+    ip.note as procedure_note,
+    ipu.note as restrictions
+from users u, im_procedures ip, im_procedure_users ipu
+where u.user_id = $user_id
+and ip.procedure_id = $procedure_id
+and ip.procedure_id = ipu.procedure_id
+and u.user_id = ipu.user_id"]
+
+set_variables_after_query
+
+set page_body "
+
+[ad_header "Change restrictions"]
+
+<H2>Change restrictions</H2>
+
+[ad_context_bar [list "/" Home] [list "index.tcl" "Intranet"] [list "procedures.tcl" "Procedures"] "Change restrictions"]
+
+<HR>
+
+<FORM METHOD=POST ACTION=procedure-user-edit-2.tcl>
+[export_form_vars user_id procedure_id]
+
+<UL>
+<LI>Procedure: <B>$procedure_name</B>
+
+<P><BLOCKQUOTE><EM>$procedure_note</EM></BLOCKQUOTE>
+
+<LI>User: $user_name
+
+<P>Restrictions:<BR>
+<TEXTAREA NAME=note COLS=50 ROWS=8 WRAP=SOFT>[ns_quotehtml $restrictions]</TEXTAREA>
+
+</UL>
+
+<P><CENTER>
+<INPUT TYPE=Submit VALUE=\" Update \">
+</CENTER>
+</P>
+
+</FORM>
+
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $page_body
+
Index: web/openacs/www/intranet/procedures/user-info.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/procedures/user-info.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/procedures/user-info.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,136 @@
+# user-info.tcl,v 3.1.4.1 2000/03/17 08:02:28 mbryzek Exp
+# File: /www/intranet/procedures/user-info.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: Displays info about a certified user
+#
+
+set_form_variables
+# procedure_id user_id
+
+validate_integer user_id $user_id
+validate_integer procedure_id $procedure_id
+
+set caller_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "
+select 
+    ip.name as procedure_name,
+    ip.note as procedure_note,
+    ipu.note as restrictions,
+    u1.first_names || ' ' || u1.last_name as user_name,  
+    u2.first_names || ' ' || u2.last_name as certifying_user_name,
+    ipu.certifying_date
+from users u1, users u2, im_procedures ip, im_procedure_users ipu
+where ip.procedure_id = $procedure_id
+and ip.procedure_id = ipu.procedure_id
+and u1.user_id = $user_id
+and u2.user_id = ipu.certifying_user
+and ipu.user_id = u1.user_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Error" "That user isn't certified to do that procedure"
+    return
+}
+set_variables_after_query
+
+if [empty_string_p $restrictions] {
+    set restrictions "None"
+}
+
+set page_body "
+
+[ad_header $user_name]
+
+<H2>$user_name</H2>
+
+[ad_context_bar [list "/" Home] [list "../index.tcl" "Intranet"] [list "index.tcl" "Procedures"] "User info"]
+
+<HR>
+
+<UL>
+<LI>Name: <A HREF=../users/view.tcl?user_id=$user_id>$user_name</A>
+<LI>Procedure: $procedure_name
+
+<BLOCKQUOTE>
+<EM>$procedure_note</EM>
+</BLOCKQUOTE>
+
+<P><LI>Certified [util_AnsiDatetoPrettyDate $certifying_date] by $certifying_user_name
+
+<P><EM>Restrictions:</EM> $restrictions 
+
+"
+
+if {($user_id != $caller_id) &&
+    ([database_to_tcl_string $db "select count(*) from im_procedure_users
+                                  where procedure_id = $procedure_id
+                                  and user_id = $user_id"] > 0)} {
+    append page_body "(<A HREF=procedure-user-edit.tcl?[export_url_vars user_id procedure_id]>edit</A>)"
+}
+
+set selection [ns_db select $db "
+select
+    u.user_id as certified_user,
+    u.first_names || ' ' || u.last_name as certified_user_name,
+    ipu.certifying_date
+from users u, im_procedure_users ipu
+where ipu.procedure_id = $procedure_id
+and ipu.user_id != $user_id
+and ipu.certifying_user = $user_id
+and ipu.user_id = u.user_id
+order by certifying_date"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append users_certified "<LI><A HREF=procedure-user-info.tcl?user_id=$certified_user&procedure_id=$procedure_id>$certified_user_name</A> on [util_AnsiDatetoPrettyDate $certifying_date]\n"
+}
+
+if [info exists users_certified] {
+    append page_body "<P><EM>Users certified by $user_name</EM>
+<UL>
+$users_certified
+</UL>
+"
+}
+
+set selection [ns_db select $db "
+select
+    u.user_id as supervised_user_id,
+    u.first_names || ' ' || u.last_name as supervised_user_name,
+    ipe.event_date
+from users u, im_procedure_events ipe
+where ipe.procedure_id = $procedure_id
+and ipe.user_id != $user_id
+and ipe.supervising_user = $user_id
+and ipe.user_id = u.user_id
+and not exists (select 1 from im_procedure_users ipu 
+                where ipu.user_id = u.user_id
+                and ipu.procedure_id = $procedure_id)
+order by event_date"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append users_supervised "<LI><A HREF=user-info.tcl?user_id=$supervised_user_id>$supervised_user_name</A> on [util_AnsiDatetoPrettyDate $event_date]\n"
+}
+
+if [info exists users_supervised] {
+    append page_body "<P><EM>Uncertified users supervised by $user_name</EM>
+<UL>
+$users_supervised
+</UL>
+"
+}
+
+append page_body "
+</UL>
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html [ad_partner_return_template]
\ No newline at end of file
Index: web/openacs/www/intranet/projects/ae-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/projects/ae-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/projects/ae-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,124 @@
+# ae-2.tcl,v 3.3.2.1 2000/03/17 08:23:10 mbryzek Exp
+# File: /www/intranet/projects/ae-2.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: verifies and stores project information to db
+#
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_the_usual_form_variables
+# Bunch of stuff for dp
+
+validate_integer group_id $group_id
+
+set form_setid [ns_getform]
+
+set start_date "${ColValue.start.year}-${ColValue.start.month}-${ColValue.start.day}"
+ns_set put $form_setid "dp.im_projects.start_date" $start_date
+
+set end_date "${ColValue.end.year}-${ColValue.end.month}-${ColValue.end.day}"
+ns_set put $form_setid "dp.im_projects.end_date" $end_date
+
+set db [ns_db gethandle]
+
+# Log who's making changes and when
+set todays_date [database_to_tcl_string $db "select sysdate() from dual"]
+
+set required_vars [list \
+	[list "dp_ug.user_groups.group_name" "You must specify the project name"] \
+	[list "dp.im_projects.customer_id" "You must specify the customer"] \
+	[list "dp.im_projects.project_type_id" "You must specify the project type"] \
+	[list "dp.im_projects.project_status_id" "You must specify the project status"]]
+
+set errors [im_verify_form_variables $required_vars]
+
+# make sure end date after start date
+if { ![empty_string_p $end_date] && ![empty_string_p $start_date] } {
+    set difference [database_to_tcl_string $db \
+	    "select to_date('$end_date'::varchar,'YYYY-MM-DD'::varchar) - to_date('$start_date'::varchar,'YYYY-MM-DD'::varchar) from dual"]
+    if { $difference < 0 } {
+	append errors "  <li> End date must be after start date\n"
+    }
+}
+
+# Let's make sure the specified short name is unique
+set short_name_exists_p [database_to_tcl_string $db \
+	"select (case when count(1) = 0 then 0 else 1 end) 
+           from user_groups 
+          where short_name='[DoubleApos ${dp_ug.user_groups.short_name}]'
+            and group_id <> $group_id"]
+
+
+if { $short_name_exists_p > 0 } {
+    append errors "  <li> The specified short name, \"${dp_ug.user_groups.short_name},\" already exists - please select another, unique short name\n"
+}
+
+if { ![empty_string_p $errors] } {
+    ad_return_complaint 2 "<ul>$errors</ul>"
+    return
+}
+
+# Create/update the user group frst since projects reference it
+# Note: group_name, creation_user, creation_date are all set in ae.tcl
+ns_set put $form_setid "dp_ug.user_groups.group_id" $group_id
+ns_set put $form_setid "dp_ug.user_groups.group_type" [ad_parameter IntranetGroupType intranet]
+ns_set put $form_setid "dp_ug.user_groups.approved_p" "t"
+ns_set put $form_setid "dp_ug.user_groups.new_member_policy" "closed"
+ns_set put $form_setid "dp_ug.user_groups.parent_group_id" [im_project_group_id]
+
+# Log the modification date
+ns_set put $form_setid "dp_ug.user_groups.modification_date.expr" "sysdate()"
+ns_set put $form_setid "dp_ug.user_groups.modifying_user" $user_id
+
+# Put the group_id into projects
+ns_set put $form_setid "dp.im_projects.group_id" $group_id
+
+with_transaction $db {
+
+    # Update user_groups
+    dp_process -db $db -form_index "_ug" -where_clause "group_id=$group_id"
+
+    # Now update im_projects
+    dp_process -db $db -where_clause "group_id=$group_id"
+
+    # Now we do the url's for this project
+
+    # Start by getting rid of the old URL's
+    ns_db dml $db "delete from im_project_url_map where group_id=$group_id"
+
+    foreach var [info vars "url_*"] {
+        # Get the double-quoted value from the textbox named var
+        set QQvar "QQ$var"
+        set current_url [set ${QQvar}]
+        # pull the url_type_id out of the name for the text box
+        regexp {url_(.*)} $var match url_type_id
+        # Insert the URL
+        ns_db dml $db \
+	    "insert into im_project_url_map
+             (group_id, url_type_id,  url)
+             values
+             ($group_id, $url_type_id,  '$current_url')"
+
+    }
+} { ns_log Error "transaction failed" }
+
+
+if { ![exists_and_not_null return_url] } {
+    set return_url [im_url_stub]/projects/view.tcl?[export_url_vars group_id]
+}
+
+
+if { [exists_and_not_null dp.im_projects.project_lead_id] } {
+    # Need to add the project leader as well
+    set return_url "/groups/member-add-3.tcl?[export_url_vars group_id return_url]&user_id_from_search=${dp.im_projects.project_lead_id}&role=administrator"
+}
+
+if { [exists_and_not_null dp_ug.user_groups.creation_user] } {
+    # add the creating current user to the group
+    ns_returnredirect "/groups/member-add-3.tcl?[export_url_vars group_id return_url]&user_id_from_search=$user_id&role=administrator"
+} else {
+    ns_returnredirect $return_url
+}
Index: web/openacs/www/intranet/projects/ae.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/projects/ae.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/projects/ae.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,172 @@
+# ae.tcl,v 3.2.2.1 2000/03/17 08:23:11 mbryzek Exp
+# File: /www/intranet/projects/ae.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: form to add a new project or edit an existing one
+#
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_form_variables 0
+# group_id (if we're editing)
+# return_url (optional)
+
+set todays_date [lindex [split [ns_localsqltimestamp] " "] 0]
+
+set db [ns_db gethandle]
+if { [exists_and_not_null group_id] } {
+
+    validate_integer group_id $group_id
+
+    set selection [ns_db 1row $db \
+	    "select p.parent_id, p.customer_id, g.group_name, p.project_type_id, p.project_status_id, p.description, 
+                    p.project_lead_id, p.supervisor_id, g.short_name, 
+                    to_char(p.start_date,'YYYY-MM-DD') as start_date,
+                    to_char(p.end_date,'YYYY-MM-DD') as end_date
+               from im_projects p, user_groups g
+              where p.group_id=$group_id
+                and p.group_id=g.group_id"]
+
+    set_variables_after_query
+    set page_title "Edit project"
+    set context_bar [ad_context_bar [list "/" Home] [list "../" "Intranet"] [list index.tcl "Projects"] [list "view.tcl?[export_url_vars group_id]" "One project"] $page_title]
+
+    if { [empty_string_p $start_date] } {
+	set start_date $todays_date
+    }
+    if { [empty_string_p $end_date] } {
+	set end_date $todays_date
+    }
+
+} else {
+
+    if { ![exists_and_not_null parent_id] } {
+	# A brand new project (not a subproject)
+	set parent_id ""
+	if { ![exists_and_not_null customer_id] } {
+	    set customer_id ""
+	}
+	set project_type_id ""
+	set project_status_id ""
+	set page_title "Add project"
+	set context_bar [ad_context_bar [list "/" Home] [list "../" "Intranet"] [list index.tcl "Projects"] $page_title]
+    } else {
+	# This means we are adding a subproject - let's select out some defaults for this page
+	set selection [ns_db 1row $db \
+		"select p.customer_id, p.project_type_id, p.project_status_id
+                   from im_projects p
+                  where p.group_id=$parent_id"]
+	set_variables_after_query
+
+	set page_title "Add subproject"
+	set context_bar [ad_context_bar [list "/" Home] [list "../" "Intranet"] [list index.tcl "Projects"] [list "view.tcl?group_id=$parent_id" "One project"] $page_title]
+    }
+    set start_date $todays_date
+    set end_date $todays_date
+    set project_lead_id ""
+    set supervisor_id ""
+    set description ""
+
+    set "dp_ug.user_groups.creation_ip_address" [ns_conn peeraddr]
+    set "dp_ug.user_groups.creation_user" $user_id
+
+    set group_id [database_to_tcl_string $db "select user_group_sequence.nextval from dual"]
+}
+
+set page_body "
+<form method=post action=ae-2.tcl>
+[export_form_vars return_url group_id dp_ug.user_groups.creation_ip_address dp_ug.user_groups.creation_user]
+
+[im_format_number 1] Project name: 
+<br><dd><input type=text size=45 name=dp_ug.user_groups.group_name [export_form_value group_name]>
+
+<p>[im_format_number 2] Project short name:
+<br><dd><input type=text size=45 name=dp_ug.user_groups.short_name [export_form_value short_name]>
+
+<p>[im_format_number 3] Customer: 
+[im_customer_select $db "dp.im_projects.customer_id" $customer_id Current]
+(<a href=../customers/ae.tcl?return_url=[ns_urlencode [ad_partner_url_with_query]]>Add a customer</a>)
+<br><dd><font size=-1>Note: Only current customers are listed</font>
+
+<p>[im_format_number 4] Project type:
+[im_project_type_select $db "dp.im_projects.project_type_id" $project_type_id]
+
+<p>[im_format_number 5] Project status:
+[im_project_status_select $db "dp.im_projects.project_status_id" $project_status_id]
+
+<p>[im_format_number 6] Project leader:
+[im_user_select $db "dp.im_projects.project_lead_id" $project_lead_id]
+
+<p>[im_format_number 7] Team leader or supervisor:
+[im_user_select $db "dp.im_projects.supervisor_id" $supervisor_id]
+
+<p>[im_format_number 8] Start date:
+[philg_dateentrywidget start $start_date]
+
+<p>[im_format_number 9] End date:
+[philg_dateentrywidget end $end_date]
+
+<p>[im_format_number 10] Parent project:
+[im_project_parent_select $db "dp.im_projects.parent_id" $parent_id $group_id Open]
+<br><dd><font size=-1>Note: Only open projects are listed</font>
+"
+
+set ctr 11
+
+# set selection [ns_db select $db \
+# 	"select t.url_type_id, t.to_ask, m.url
+#            from im_url_types t, im_project_url_map m
+#           where t.url_type_id=m.url_type_id(+)
+#             and $group_id=m.group_id(+)
+#           order by t.display_order, lower(t.url_type)"]
+
+set selection [ns_db select $db "\
+select t.url_type_id, t.to_ask, m.url
+           from im_url_types t, im_project_url_map m
+          where t.url_type_id=m.url_type_id
+            and $group_id=m.group_id
+union
+select t.url_type_id, t.to_ask, m.url
+           from im_url_types t, im_project_url_map m
+          where not exists (select 1 from im_project_url_map 
+                            where url_type_id = t.url_type_id)
+            and $group_id=m.group_id
+union
+select t.url_type_id, t.to_ask, m.url
+           from im_url_types t, im_project_url_map m
+          where t.url_type_id=m.url_type_id
+            and not exists (select 1 from im_project_url_map 
+                            where group_id = $group_id)
+union
+select t.url_type_id, t.to_ask, '' as url
+           from im_url_types t
+          where not exists (select 1 from im_project_url_map 
+                            where url_type_id = t.url_type_id)
+            and not exists (select 1 from im_project_url_map 
+                            where group_id = $group_id)
+          order by t.display_order, lower(t.url_type)"]
+
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append page_body "
+<p>[im_format_number $ctr] $to_ask:
+<br><dd><input type=text size=45 name=url_$url_type_id [export_form_value url]>
+"
+    incr ctr
+}
+
+
+append page_body "
+<p>[im_format_number $ctr] Short description of this project:
+<br><dd><textarea name=dp.im_projects.description rows=6 cols=45 wrap=soft>[philg_quote_double_quotes $description]</textarea>
+ 
+<p><center><input type=submit value=\"$page_title\"></center>
+</form>
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/projects/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/projects/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/projects/index.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,195 @@
+# index.tcl,v 3.2.2.2 2000/03/17 08:56:38 mbryzek Exp
+# File: /www/intranet/projects/index.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: lists all projects with dimensional sliders
+#
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_form_variables 0
+# optional: status_id, type_id
+
+if { ![exists_and_not_null status_id] } {
+    # Default status is OPEN - select the id once and memoize it
+    set status_id [ad_partner_memoize_one \
+	    "select project_status_id 
+               from im_project_status 
+              where upper(project_status) = 'OPEN'" project_status_id]
+} else {
+    validate_integer status_id $status_id
+}
+
+if { ![exists_and_not_null type_id] } {
+    set type_id 0
+} else {
+    validate_integer type_id $type_id
+}
+
+if { ![exists_and_not_null order_by] } {
+    set order_by "Name"
+}
+if { ![exists_and_not_null mine_p] } {
+    set mine_p "t"
+}
+set view_types [list "t" "Mine" "f" "All"]
+
+# status_types will be a list of pairs of (project_status_id, project_status)
+set status_types [ad_partner_memoize_list_from_db \
+	"select project_status_id, project_status
+           from im_project_status
+          order by display_order, lower(project_status)" [list project_status_id project_status]]
+lappend status_types 0 All
+
+# project_types will be a list of pairs of (project_type_id, project_type)
+set project_types [ad_partner_memoize_list_from_db \
+	"select project_type_id, project_type
+           from im_project_types
+          order by display_order, lower(project_type)" [list project_type_id project_type]]
+lappend project_types 0 All
+
+
+set page_title "Projects"
+set context_bar [ad_context_bar [list "/" Home] [list "../" "Intranet"] $page_title]
+
+set page_body "
+<table width=100% border=0>
+<tr>
+  <td valign=top>[ad_partner_default_font "size=-1"]
+    Project status: [im_slider status_id $status_types]
+    <br>Project type: [im_slider type_id $project_types]
+    <br>View: [im_slider mine_p $view_types]
+  </font></td>
+  <td align=right valign=top>[ad_partner_default_font "size=-1"]
+    <a href=\"../allocations/index.tcl\">Allocations</a> | 
+    <a href=\"money.tcl\">Financial View</a>
+  </font></td>
+</tr>
+</table>
+"
+
+# Now let's generate the sql query
+set criteria [list]
+
+if { ![empty_string_p $status_id] && $status_id != 0 } {
+    lappend criteria "p.project_status_id=$status_id"
+}
+if { ![empty_string_p $type_id] && $type_id != 0 } {
+    lappend criteria "p.project_type_id=$type_id"
+}
+set extra_table ""
+if { [string compare $mine_p "t"] == 0 } {
+    lappend criteria "ad_group_member_p ( $user_id, p.group_id ) = 't'"
+}
+
+set order_by_clause ""
+switch $order_by {
+    "Type" { set order_by_clause "order by project_type, upper(user_group_name_from_id(p.group_id))" }
+    "Status" { set order_by_clause "order by project_status, upper(user_group_name_from_id(p.group_id))" }
+    "Project Lead" { set order_by_clause "order by upper(last_name), upper(first_names), upper(user_group_name_from_id(p.group_id))" }
+    "URL" { set order_by_clause "order by upper(url), upper(user_group_name_from_id(p.group_id))" }
+    "Name" { set order_by_clause "order by upper(user_group_name_from_id(p.group_id))" }
+}
+
+set where_clause [join $criteria " and\n            "]
+if { ![empty_string_p $where_clause] } {
+    set where_clause " and $where_clause"
+}
+
+set db [ns_db gethandle]
+# set selection [ns_db select $db \
+# 	"select user_group_name_from_id(p.group_id) as group_name, p.group_id, p.group_id, 
+#                 u.first_names||' '||u.last_name as lead_name, u.user_id, 
+#                 im_proj_type_from_id(p.project_type_id)  as project_type, 
+#                 im_proj_status_from_id(p.project_status_id)  as project_status,
+#                 im_proj_url_from_type(p.group_id, 'website') as url
+#            from im_projects p, users u$extra_table
+#           where p.project_lead_id=u.user_id(+) $where_clause
+#             and p.parent_id is null $order_by_clause"]
+
+set selection [ns_db select $db "\
+select user_group_name_from_id(p.group_id) as group_name, p.group_id, p.group_id, 
+                u.first_names||' '||u.last_name as lead_name, u.user_id, 
+                im_proj_type_from_id(p.project_type_id)  as project_type, 
+                im_proj_status_from_id(p.project_status_id)  as project_status,
+                im_proj_url_from_type(p.group_id, 'website') as url
+           from im_projects p, users u$extra_table
+          where p.project_lead_id=u.user_id 
+                $where_clause
+            and p.parent_id is null 
+union
+select user_group_name_from_id(p.group_id) as group_name, p.group_id, p.group_id, 
+                '' as lead_name, '' as user_id, 
+                im_proj_type_from_id(p.project_type_id)  as project_type, 
+                im_proj_status_from_id(p.project_status_id)  as project_status,
+                im_proj_url_from_type(p.group_id, 'website') as url
+           from im_projects p$extra_table
+          where not exists (select 1 from users 
+                            where user_id = p.project_lead_id) 
+                $where_clause
+            and p.parent_id is null 
+                $order_by_clause"]
+
+
+set results ""
+set bgcolor(0) " bgcolor=\"[ad_parameter TableColorOdd Intranet white]\""
+set bgcolor(1) " bgcolor=\"[ad_parameter TableColorEven Intranet white]\""
+set ctr 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    set url [im_maybe_prepend_http $url]
+    if { [empty_string_p $url] } {
+	set url_string "&nbsp;"
+    } else {
+	set url_string "<a href=\"$url\">$url</a>"
+    }
+    append results "
+<tr$bgcolor([expr $ctr % 2])>
+  <td valign=top>[ad_partner_default_font]<a href=view.tcl?[export_url_vars group_id]>$group_name</a></font></td>
+  <td valign=top>[ad_partner_default_font]$project_type</font></td>
+  <td valign=top>[ad_partner_default_font]$project_status</font></td>
+  <td valign=top>[ad_partner_default_font]<a href=../users/view.tcl?[export_url_vars user_id]>$lead_name</a></font></td>
+  <td valign=top>[ad_partner_default_font]$url_string</font></td>
+</tr>
+"
+    incr ctr
+}
+
+ns_db releasehandle $db
+
+if { [empty_string_p $results] } {
+    append page_body "<ul><li><b> There are currently no projects</b></ul>\n"
+} else {
+    set column_headers [list Name Type Status "Project Lead" URL]
+    set url "index.tcl"
+    set query_string [export_ns_set_vars url [list order_by]]
+    if { [empty_string_p $query_string] } {
+	append url "?"
+    } else {
+	append url "?$query_string&"
+    }
+    set table "
+<table width=100% cellpadding=2 cellspacing=2 border=0>
+<tr bgcolor=\"[ad_parameter TableColorHeader intranet white]\">
+"
+    foreach col $column_headers {
+	if { [string compare $order_by $col] == 0 } {
+	    append table "  <th>$col</th>\n"
+	} else {
+	    append table "  <th><a href=\"${url}order_by=[ns_urlencode $col]\">$col</a></th>\n"
+	}
+    }
+    append page_body "
+<br>
+$table
+</tr>
+$results
+</table>
+"
+}
+
+append page_body "<p><a href=ae.tcl>Add a project</a>\n"
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/projects/money-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/projects/money-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/projects/money-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,159 @@
+# money-2.tcl,v 3.1.4.1 2000/03/17 08:23:11 mbryzek Exp
+# File: /www/intranet/projects/money-2.tcl
+#
+# Author: Feb 2000
+#
+# Purpose: 
+#
+
+set_the_usual_form_variables 0
+
+set html "
+[ad_header "Expense report"]
+
+<H2>Expense report (last 30 days)</H2>
+
+[ad_context_bar [list "/" Home] [list "index.tcl" "Intranet"]  [list "projects.tcl" "Projects"] "Expense report"]
+
+<HR>
+"
+if ![info exists status] {
+    set status "open"
+}
+
+if {$status != "all"} {
+    lappend where_clauses "status = '$status'"
+} 
+
+if ![info exists project_type] {
+    set project_type "client"
+}
+
+if {$project_type != "all"} {
+    lappend where_clauses "project_type = '$project_type'"
+}
+
+if ![info exists order_by] {
+    set order_by "name"
+}
+
+
+switch $order_by {
+    "name" { set order_by_clause "order by upper(name)" }
+    "project_type" { set order_by_clause "order by project_type, upper(name)" }
+    "status" { set order_by_clause "order by im_projects.status, upper(name)" }
+    "fee_setup" { set order_by_clause "order by fee_setup, upper(name)" }
+    "total_monthly" { set order_by_clause "order by total_monthly, upper(name)" }
+    "total_people" { set order_by_clause "order by total_people, upper(name)" }
+    "rev_person" { set order_by_clause "order by rev_person, upper(name)" }
+    "default" { set order_by_clause "order by upper(name)" }
+}
+
+set db [ns_db gethandle]
+
+lappend where_clauses "parent is null"
+
+# NOTE: This does not take hours for subprojects into account!!
+# This is just to get the demo done
+
+if ![info exist start_block] {
+    set start_block [database_to_tcl_string $db "select max(start_block)
+from im_start_blocks where start_block < sysdate()"]
+}
+
+set total_hours [database_to_tcl_string $db "select sum(hours)
+from im_hours where day > sysdate() - 30"]
+
+set total_people_logging [database_to_tcl_string $db "select count(distinct(user_id))
+from im_hours where day > sysdate() - 30"]
+
+
+# take the most recent allocation for this start_block
+lappend where_clauses "im_allocations.last_modified = (select max(last_modified) from 
+    im_allocations im2 
+    where (im2.user_id = im_allocations.user_id or
+           (im2.user_id is null 
+            and im_allocations.user_id is null))
+    and im2.project_id = im_allocations.project_id
+    and im2.start_block = im_allocations.start_block)"
+
+lappend where_clauses "im_projects.project_id = im_allocations.project_id"
+lappend where_clauses "im_allocations.start_block = '$start_block'"
+
+set selection [ns_db select $db "
+select im_projects.project_id, name, coalesce(fee_monthly,0) + coalesce(fee_hosting_monthly,0) as total_monthly, fee_setup, project_type, status,sum(percentage_time)/100 as total_people, trunc((coalesce(fee_monthly,0) + coalesce(fee_hosting_monthly,0))/(sum(percentage_time)/100),0) as rev_person
+from im_projects, im_allocations
+where [join $where_clauses " and " ]
+group by im_projects.project_id, im_allocations.project_id,  name, project_type, status, fee_setup, fee_monthly, fee_hosting_monthly
+$order_by_clause"]
+
+
+set status_params [list "open" "future" "inactive" "closed" "all"]
+set type_params [list "client" "internal" "toolkit" "all"]
+
+foreach param $status_params {
+    if { $status == $param } {
+	lappend status_links "<b> $param </b>"
+    } else {
+	lappend status_links "<a href=/intranet/projects-money.tcl?status=$param&[export_ns_set_vars "url" "status"]>$param</a>"
+    }
+}
+
+foreach param $type_params {
+    if { $project_type == $param } {
+	lappend type_links "<b> $param </b>"
+    } else {
+	lappend type_links "<a href=/intranet/projects-money.tcl?project_type=$param&[export_ns_set_vars "url" "project_type"]>$param</a>"
+    }
+}
+
+append html "
+<table width=100%>
+<tr><td>Project status: [join $status_links " | "]</td><td align=right><a href=allocation.tcl?[export_ns_set_vars]>Allocations</a> | <a href=projects.tcl?[export_ns_set_vars]>Summary view</a></td></tr>
+<tr><td>Project type: [join $type_links " | "]</td><td></td></tr>
+</table>
+<p>
+<center>
+<table>
+<tr bgcolor=[ad_parameter "Color2" "intranet"]>"
+
+set order_by_params [list {"name" "Name"} {"project_type" "Type"} {"status" "Status"} {"fee_setup" "Setup fee"}  {"total_monthly" "Monthly fee"} {"total_people" "# People"} {"rev_person" "(Rev/person)/month"} ]
+
+
+foreach parameter $order_by_params {
+    set pretty_order_by_current [lindex $parameter 1]
+    set order_by_current [lindex $parameter 0]
+    if {$order_by_current == $order_by} {
+	append html "<th>$pretty_order_by_current</th>"
+    } else {
+	append html "<th><a href=/intranet/projects-money.tcl?order_by=$order_by_current&[export_ns_set_vars "url" "order_by"]>$pretty_order_by_current</a></th>"
+    }
+}
+
+set projects ""
+set background_tag ""
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if [empty_string_p $background_tag] {
+	set background_tag " bgcolor = [ad_parameter "Color1" "intranet"] "
+    } else {
+	set background_tag ""
+    }
+
+    append projects "<tr>
+<td $background_tag><A HREF=project-info.tcl?project_id=$project_id>$name</A></td><td $background_tag>$project_type</td><td $background_tag>$status</td><td $background_tag>[dp_commify $fee_setup] &nbsp;</td><td $background_tag>[dp_commify $total_monthly] &nbsp;</td><td $background_tag>$total_people</td><td $background_tag>[dp_commify $rev_person]</td></tr>\n"
+}
+
+
+append html "$projects 
+</table>
+</center>
+<p>
+
+"
+
+append html [ad_footer]
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $html
Index: web/openacs/www/intranet/projects/money.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/projects/money.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/projects/money.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,291 @@
+# money.tcl,v 3.1.4.1 2000/03/17 08:23:12 mbryzek Exp
+# File: /www/intranet/projects/money.tcl
+#
+# Author: Feb 2000
+#
+# Purpose: Displays an expense report
+#
+
+set_the_usual_form_variables 0
+
+# maybe start_block, end_block, order_by, project_status_id, project_type_id, status_all, type_all
+
+set page_title "Expense report"
+set context_bar "[ad_context_bar [list "/" Home] [list "../index.tcl" "Intranet"]  [list "index.tcl" "Projects"] "Expense report"]"
+
+set db [ns_db gethandle]
+
+set html [ad_partner_header]
+
+if { ![exists_and_not_null partner_type_id] } {
+    set partner_type_id ""
+}
+
+if { ![exists_and_not_null status_id] } {
+    # Default status is OPEN - select the id once and memoize it
+    set status_id [ad_partner_memoize_one \
+	    "select project_status_id 
+               from im_project_status 
+              where upper(project_status) = 'OPEN'" project_status_id]
+}
+
+if {$status_id != 0} {
+    lappend where_clauses "im_projects.project_status_id = $status_id"
+}
+
+if { ![exists_and_not_null type_id] } {
+    set type_id 0
+} elseif {$type_id != 0} {
+    lappend where_clauses "im_projects.project_type_id = $type_id"
+}
+
+validate_integer project_status_id $status_id
+validate_integer project_type_id $type_id
+
+if { ![exists_and_not_null order_by] } {
+    set order_by name
+}
+
+# status_types will be a list of pairs of (project_status_id, project_status)
+set status_types [ad_partner_memoize_list_from_db \
+	"select project_status_id, project_status
+           from im_project_status
+          order by display_order, lower(project_status)" [list project_status_id project_status]]
+lappend status_types 0 All
+
+# project_types will be a list of pairs of (project_type_id, project_type)
+set project_types [ad_partner_memoize_list_from_db \
+	"select project_type_id, project_type
+           from im_project_types
+          order by display_order, lower(project_type)" [list project_type_id project_type]]
+lappend project_types 0 All
+
+switch $order_by {
+    "name" { set order_by_clause "order by upper(group_name)" }
+    "project_type" { set order_by_clause "order by upper(im_project_types.project_type), upper(group_name)" }
+    "status" { set order_by_clause "order by upper(im_project_status.project_status), upper(group_name)" }
+    "fee_setup" { set order_by_clause "order by fee_setup, upper(group_name)" }
+    "total_monthly" { set order_by_clause "order by total_monthly, upper(group_name)" }
+    "total_people" { set order_by_clause "order by total_people, upper(group_name)" }
+    #"rev_person" { set order_by_clause "order by rev_person, upper(name)" }
+    "default" { set order_by_clause "order by upper(group_name)" }
+}
+
+
+#lappend where_clauses "parent is null"
+#lappend where_clauses "project_type <> 'deleted'"
+
+# NOTE: This does not take hours for subprojects into account!!
+# This is just to get the demo done
+
+# if not other wise provided, the report will be for the
+# last 4 weeks
+
+if { ![info exist end_block] } {
+    set end_block [database_to_tcl_string $db "select max(start_block)
+from im_start_blocks where start_block < sysdate()"]
+}
+
+if { ![info exist start_block] } {
+    set start_block [database_to_tcl_string $db "select to_date('$end_block'::varchar,'yyyy-mm-dd'::varchar) - 28 from dual"]
+}
+
+set select_weeks_form "
+<form action=money.tcl method=post>
+Week starting:
+<select name=start_block>
+[im_allocation_date_optionlist $db $start_block]
+</select>
+through week ending:
+<select name=end_block>
+[im_allocation_date_optionlist $db $end_block]
+</select>
+<input type=submit name=submit value=Go>
+</form>"
+
+set sliders "
+<table width=100% border=0>
+<tr>
+  <td valign=top>[ad_partner_default_font "size=-1"]
+    Project status: [im_slider status_id $status_types]
+    <br>Project type: [im_slider type_id $project_types]
+  </font></td>
+  <td align=right valign=top>[ad_partner_default_font "size=-1"]
+    <a href=\"../allocations/index.tcl\">Allocations</a> | 
+    <a href=\"index.tcl\">Summary View</a>
+  </font></td>
+</tr>
+</table>
+"
+
+
+set num_weeks [database_to_tcl_string $db "select count(start_block) from
+im_start_blocks where start_block >= '$start_block'
+and start_block < '$end_block'"]
+
+#lappend where_clauses "im_projects.group_id = im_allocations.group_id(+)"
+
+
+# set selection [ns_db select $db "
+# select im_projects.group_id, group_name, 
+# coalesce(im_projects_monthly_fee(im_projects.group_id, '$start_block', '$end_block'),0)  as total_monthly, 
+# coalesce(im_projects_stock_fee(im_projects.group_id, '$start_block', '$end_block'),0)  as stock_fee,  
+# coalesce(im_projects_setup_fee(im_projects.group_id,'$start_block','$end_block'),0)  as fee_setup, 
+# im_projects.project_type_id, im_projects.project_status_id, 
+# coalesce(trunc(sum(percentage_time)/(100 * $num_weeks),2),0) as avg_people_week,
+# im_project_types.project_type, im_project_status.project_status
+# from im_projects, (select * from im_allocations
+# where (im_allocations.start_block >= '$start_block' or im_allocations.start_block is null)
+# and (im_allocations.start_block < '$end_block' or im_allocations.start_block is null)) im_allocations  , user_groups, im_project_status,
+# im_project_types
+# where [join $where_clauses " and " ]
+# and im_projects.group_id = im_allocations.group_id(+)
+# and user_groups.group_id = im_projects.group_id
+# and im_project_status.project_status_id = im_projects.project_status_id
+# and im_project_types.project_type_id = im_projects.project_type_id
+# group by im_projects.group_id, im_allocations.group_id,  
+# group_name, im_projects.project_type_id, im_projects.project_status_id, 
+# fee_setup, fee_monthly, fee_hosting_monthly, project_type, project_status
+# $order_by_clause"]
+
+
+set selection [ns_db select $db "\
+select im_projects.group_id, group_name, 
+coalesce(im_projects_monthly_fee(im_projects.group_id, '$start_block', '$end_block'),0)  as total_monthly, 
+coalesce(im_projects_stock_fee(im_projects.group_id, '$start_block', '$end_block'),0)  as stock_fee,  
+coalesce(im_projects_setup_fee(im_projects.group_id,'$start_block','$end_block'),0)  as fee_setup, 
+im_projects.project_type_id, im_projects.project_status_id, 
+coalesce(trunc(sum(percentage_time)/(100 * $num_weeks),2),0) as avg_people_week,
+im_project_types.project_type, im_project_status.project_status
+from im_projects, im_allocations, user_groups, im_project_status,
+im_project_types
+where [join $where_clauses " and " ]
+and ((im_allocations.start_block >= '$start_block' or im_allocations.start_block is null)
+and (im_allocations.start_block < '$end_block' or im_allocations.start_block is null))
+and im_projects.group_id = im_allocations.group_id
+and user_groups.group_id = im_projects.group_id
+and im_project_status.project_status_id = im_projects.project_status_id
+and im_project_types.project_type_id = im_projects.project_type_id
+group by im_projects.group_id, im_allocations.group_id,  
+group_name, im_projects.project_type_id, im_projects.project_status_id, 
+fee_setup, fee_monthly, fee_hosting_monthly, project_type, project_status
+union
+select im_projects.group_id, group_name, 
+coalesce(im_projects_monthly_fee(im_projects.group_id, '$start_block', '$end_block'),0)  as total_monthly, 
+coalesce(im_projects_stock_fee(im_projects.group_id, '$start_block', '$end_block'),0)  as stock_fee,  
+coalesce(im_projects_setup_fee(im_projects.group_id,'$start_block','$end_block'),0)  as fee_setup, 
+im_projects.project_type_id, im_projects.project_status_id, 
+coalesce(trunc(sum(percentage_time)/(100 * $num_weeks),2),0) as avg_people_week,
+im_project_types.project_type, im_project_status.project_status
+from im_projects, im_allocations, user_groups, im_project_status,
+im_project_types
+where [join $where_clauses " and " ]
+and ((im_allocations.start_block >= '$start_block' or im_allocations.start_block is null)
+and (im_allocations.start_block < '$end_block' or im_allocations.start_block is null))
+and not exists (select 1 from im_allocations where group_id = im_projects.group_id)
+and user_groups.group_id = im_projects.group_id
+and im_project_status.project_status_id = im_projects.project_status_id
+and im_project_types.project_type_id = im_projects.project_type_id
+group by im_projects.group_id, im_allocations.group_id,  
+group_name, im_projects.project_type_id, im_projects.project_status_id, 
+fee_setup, fee_monthly, fee_hosting_monthly, project_type, project_status
+$order_by_clause"]
+
+append html "
+$select_weeks_form
+
+$sliders
+<p>
+
+<center>
+<table width=100% cellpadding=2 cellspacing=2 border=0>
+<tr>
+ <td colspan=5><b>[util_AnsiDatetoPrettyDate $start_block] to [util_AnsiDatetoPrettyDate $end_block]</b></td></tr>
+<tr bgcolor=[ad_parameter "TableColorHeader" "intranet"]>"
+
+set order_by_params [list {"name" "Name"} {"project_type" "Type"} {"status" "Status"} {"fee_setup" "Total setup fees"}  {"total_monthly" "Total monthly fees"} {"stock" "Stock"} ]
+
+
+foreach parameter $order_by_params {
+    set pretty_order_by_current [lindex $parameter 1]
+    set order_by_current [lindex $parameter 0]
+    if {$order_by_current == $order_by} {
+	append html "<th>$pretty_order_by_current</th>"
+    } else {
+	append html "<th><a href=money.tcl?order_by=$order_by_current&[export_ns_set_vars "url" "order_by"]>$pretty_order_by_current</a></th>"
+    }
+}
+
+append html "<th> Average People/Week </th><th> (Rev/person)/$num_weeks weeks</th>"
+
+set projects ""
+set background_tag ""
+
+set fee_setup_sum 0
+set total_monthly_sum 0
+set avg_people_week_sum 0
+set rev_person_week_sum 0
+set stock_fee_sum 0
+
+set ctr 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { $ctr % 2 == 0 } {
+	set background_tag " bgcolor = [ad_parameter "TableColorOdd" "intranet"] "
+    } else {
+	set background_tag " bgcolor = [ad_parameter "TableColorEven" "intranet"] "
+    }
+    incr ctr
+
+    append projects "
+<tr $background_tag>
+ <td><A HREF=view.tcl?group_id=$group_id>$group_name</A>
+ <td>$project_type
+ <td>$project_status
+ <td>[util_commify_number $fee_setup] &nbsp;
+ <td>[util_commify_number $total_monthly] &nbsp;
+ <td>[util_commify_number $stock_fee] &nbsp;
+ <td>$avg_people_week &nbsp;
+ <td>"
+     
+    if {$avg_people_week > 0} {
+	set rev_person_week [expr (($fee_setup+$total_monthly + $stock_fee)/$avg_people_week)]
+	 append projects "[util_commify_number $rev_person_week] &nbsp;"
+     }  else {
+	 set rev_person_week 0
+	 append projects "NA"
+     }
+     append projects "</td></tr>\n"
+     set fee_setup_sum [expr $fee_setup_sum + $fee_setup]
+     set total_monthly_sum [expr $total_monthly_sum + $total_monthly]
+     set avg_people_week_sum [expr $avg_people_week_sum + $avg_people_week]
+#     set rev_person_week_sum [expr $rev_person_week_sum + $rev_person_week]
+     set stock_fee_sum [expr $stock_fee_sum + $stock_fee]
+}
+
+
+# We don't sum the avg_people_week column because we want
+# the average
+
+#set rev_person_week_total [expr (($fee_setup_sum + $total_monthly_sum + $stock_fee_sum))/$avg_people_week_sum]
+
+append html "$projects 
+<tr>
+ <td>Total
+ <td>
+ <td>
+ <td>[util_commify_number $fee_setup_sum]
+ <td>[util_commify_number $total_monthly_sum]
+ <td>[util_commify_number $stock_fee_sum]
+ <td>$avg_people_week_sum
+</table>
+</center>
+<p>
+
+"
+
+append html [ad_partner_footer]
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $html
Index: web/openacs/www/intranet/projects/report-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/projects/report-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/projects/report-add.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,24 @@
+# report-add.tcl,v 3.1.4.1 2000/03/17 08:23:12 mbryzek Exp
+# File: /www/intranet/projects/report-add.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: temporary file to redirect to general 
+#  comments until we get structured project reports
+
+set_the_usual_form_variables
+
+# group_id, maybe return_url
+
+validate_integer group_id $group_id
+
+set db [ns_db gethandle]
+
+set item [database_to_tcl_string $db "select group_name from user_groups
+where group_id = $group_id"]
+
+if {![info exist return_url]} {
+    set return_url "/intranet/projects/view.tcl?[export_url_vars group_id]"
+}
+
+ns_returnredirect "/general-comments/comment-add.tcl?on_which_table=im_projects&on_what_id=$group_id&item=Projects&module=intranet&[export_url_vars return_url item]&scope=group&group_id=$group_id"
Index: web/openacs/www/intranet/projects/ticket-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/projects/ticket-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/projects/ticket-edit-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,11 @@
+# ticket-edit-2.tcl,v 3.1.4.1 2000/03/17 08:23:12 mbryzek Exp
+#
+# File: /www/intranet/projects/ticket-edit-2.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: Redirect to edit a ticket without being a ticket admin
+#
+
+
+source "[ns_info pageroot]/new-ticket/admin/project-edit-2.tcl"
Index: web/openacs/www/intranet/projects/ticket-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/projects/ticket-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/projects/ticket-edit.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,31 @@
+# ticket-edit.tcl,v 3.1.4.1 2000/03/17 08:23:13 mbryzek Exp
+#
+# File: /www/intranet/projects/ticket-edit.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: sets up environment to edit a ticket tracker
+#  project without being in the ticket admin group
+#
+
+
+set_form_variables
+
+set form_setid [ns_getform]
+
+set db [ns_db gethandle]
+set selection [ns_db 1row $db \
+	"select * from user_groups where group_id=$group_id"]
+set_variables_after_query
+ns_db releasehandle $db
+
+ns_set put $form_setid target "[im_url_stub]/projects/ticket-edit-2.tcl"
+ns_set put $form_setid owning_group_id $group_id
+ns_set put $form_setid preset_title $group_name
+ns_set put $form_setid preset_title_long $group_name
+if { ![exists_and_not_null return_url] } {
+    set return_url "[im_url]/projects/view.tcl?[export_url_vars group_id]"
+}
+ns_set put $form_setid return_url $return_url
+
+source "[ns_info pageroot]/new-ticket/admin/project-edit.tcl"
Index: web/openacs/www/intranet/projects/view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/projects/view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/projects/view.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,433 @@
+# view.tcl,v 3.7.2.2 2000/03/17 08:23:13 mbryzek Exp
+# File: /www/intranet/projects/view.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: View all the info about a specific project
+#
+
+set current_user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_form_variables
+# group_id
+
+validate_integer group_id $group_id
+
+set return_url [ad_partner_url_with_query]
+
+set db [ns_db gethandle]
+
+
+# Admins and Employees can administer projects
+set user_admin_p [im_is_user_site_wide_or_intranet_admin $db $current_user_id]
+if { $user_admin_p == 0 } {
+    set user_admin_p [im_user_is_employee_p $db $current_user_id]
+}
+
+# set user_admin_p [im_can_user_administer_group $db $group_id $current_user_id]
+
+# set selection [ns_db 0or1row $db \
+# 	"select p.*, g.group_name as project_name, g.short_name, p.parent_id, p.customer_id,
+#                 g2.group_name as customer_name, im_project_ticket_project_id(g.group_id) as ticket_project_id,
+#                 user_group_name_from_id(p.parent_id) as parent_name,
+#                 l.first_names||' '||l.last_name as project_lead, project_lead_id, 
+#                 s.first_names||' '||s.last_name as supervisor,
+#                 im_proj_type_from_id(p.project_type_id) as project_type, 
+#                 im_proj_status_from_id(p.project_status_id) as project_status
+#            from im_projects p, users l, users s, user_groups g, user_groups g2
+#           where p.project_lead_id=l.user_id(+)
+#             and p.group_id=$group_id
+#             and p.supervisor_id=s.user_id(+)
+#             and p.group_id=g.group_id
+#             and p.customer_id=g2.group_id(+)"]
+
+
+set selection [ns_db 0or1row $db "\
+select p.*, g.group_name as project_name, g.short_name, p.parent_id, p.customer_id,
+                user_group_name_from_id(p.customer_id) as customer_name, im_project_ticket_project_id(g.group_id) as ticket_project_id,
+                user_group_name_from_id(p.parent_id) as parent_name,
+                user_full_name(p.project_lead_id) as project_lead, project_lead_id, 
+                user_full_name(p.supervisor_id) as supervisor,
+                im_proj_type_from_id(p.project_type_id) as project_type, 
+                im_proj_status_from_id(p.project_status_id) as project_status
+           from im_projects p, user_groups g
+          where p.group_id=$group_id
+            and p.group_id=g.group_id
+"]
+
+#  set selection [ns_db 0or1row $db "\
+#  select p.*, g.group_name as project_name, g.short_name, p.parent_id, p.customer_id,
+#                  g2.group_name as customer_name, im_project_ticket_project_id(g.group_id) as ticket_project_id,
+#                  user_group_name_from_id(p.parent_id) as parent_name,
+#                  l.first_names||' '||l.last_name as project_lead, project_lead_id, 
+#                  s.first_names||' '||s.last_name as supervisor,
+#                  im_proj_type_from_id(p.project_type_id) as project_type, 
+#                  im_proj_status_from_id(p.project_status_id) as project_status
+#             from im_projects p, users l, users s, user_groups g, user_groups g2
+#            where p.project_lead_id=l.user_id
+#              and p.group_id=$group_id
+#              and p.supervisor_id=s.user_id
+#              and p.group_id=g.group_id
+#              and p.customer_id=g2.group_id
+#  union
+#  select p.*, g.group_name as project_name, g.short_name, p.parent_id, p.customer_id,
+#                  '' as customer_name, im_project_ticket_project_id(g.group_id) as ticket_project_id,
+#                  user_group_name_from_id(p.parent_id) as parent_name,
+#                  l.first_names||' '||l.last_name as project_lead, project_lead_id, 
+#                  s.first_names||' '||s.last_name as supervisor,
+#                  im_proj_type_from_id(p.project_type_id) as project_type, 
+#                  im_proj_status_from_id(p.project_status_id) as project_status
+#             from im_projects p, users l, users s, user_groups g
+#            where p.project_lead_id=l.user_id
+#              and p.group_id=$group_id
+#              and p.supervisor_id=s.user_id
+#              and p.group_id=g.group_id
+#              and not exists (select 1 from user_groups
+#                              where group_id = p.customer_id)
+#  union
+#  select p.*, g.group_name as project_name, g.short_name, p.parent_id, p.customer_id,
+#                  g2.group_name as customer_name, im_project_ticket_project_id(g.group_id) as ticket_project_id,
+#                  user_group_name_from_id(p.parent_id) as parent_name,
+#                  l.first_names||' '||l.last_name as project_lead, project_lead_id, 
+#                  '' as supervisor,
+#                  im_proj_type_from_id(p.project_type_id) as project_type, 
+#                  im_proj_status_from_id(p.project_status_id) as project_status
+#             from im_projects p, users l, user_groups g, user_groups g2
+#            where p.project_lead_id=l.user_id
+#              and p.group_id=$group_id
+#              and not exists (select 1 from users
+#                              where user_id = p.supervisor_id)
+#              and p.group_id=g.group_id
+#              and p.customer_id=g2.group_id
+#  union
+#  select p.*, g.group_name as project_name, g.short_name, p.parent_id, p.customer_id,
+#                  '' as customer_name, im_project_ticket_project_id(g.group_id) as ticket_project_id,
+#                  user_group_name_from_id(p.parent_id) as parent_name,
+#                  l.first_names||' '||l.last_name as project_lead, project_lead_id, 
+#                  '' as supervisor,
+#                  im_proj_type_from_id(p.project_type_id) as project_type, 
+#                  im_proj_status_from_id(p.project_status_id) as project_status
+#             from im_projects p, users l, user_groups g
+#            where p.project_lead_id=l.user_id
+#              and p.group_id=$group_id
+#              and not exists (select 1 from users
+#                              where user_id = p.supervisor_id)
+#              and p.group_id=g.group_id
+#              and not exists (select 1 from user_groups
+#                              where group_id = p.customer_id)
+#  union
+#  select p.*, g.group_name as project_name, g.short_name, p.parent_id, p.customer_id,
+#                  g2.group_name as customer_name, im_project_ticket_project_id(g.group_id) as ticket_project_id,
+#                  user_group_name_from_id(p.parent_id) as parent_name,
+#                  '' as project_lead, project_lead_id, 
+#                  s.first_names||' '||s.last_name as supervisor,
+#                  im_proj_type_from_id(p.project_type_id) as project_type, 
+#                  im_proj_status_from_id(p.project_status_id) as project_status
+#             from im_projects p, users s, user_groups g, user_groups g2
+#            where not exists (select 1 from users 
+#                              where user_id = p.project_lead_id)
+#              and p.group_id=$group_id
+#              and p.supervisor_id=s.user_id
+#              and p.group_id=g.group_id
+#              and p.customer_id=g2.group_id
+#  union
+#  select p.*, g.group_name as project_name, g.short_name, p.parent_id, p.customer_id,
+#                  '' as customer_name, im_project_ticket_project_id(g.group_id) as ticket_project_id,
+#                  user_group_name_from_id(p.parent_id) as parent_name,
+#                  '' as project_lead, project_lead_id, 
+#                  s.first_names||' '||s.last_name as supervisor,
+#                  im_proj_type_from_id(p.project_type_id) as project_type, 
+#                  im_proj_status_from_id(p.project_status_id) as project_status
+#             from im_projects p, users s, user_groups g
+#            where not exists (select 1 from users 
+#                              where user_id = p.project_lead_id)
+#              and p.group_id=$group_id
+#              and p.supervisor_id=s.user_id
+#              and p.group_id=g.group_id
+#              and not exists (select 1 from user_groups
+#                              where group_id = p.customer_id)
+#  union
+#  select p.*, g.group_name as project_name, g.short_name, p.parent_id, p.customer_id,
+#                  g2.group_name as customer_name, im_project_ticket_project_id(g.group_id) as ticket_project_id,
+#                  user_group_name_from_id(p.parent_id) as parent_name,
+#                  '' as project_lead, project_lead_id, 
+#                  '' as supervisor,
+#                  im_proj_type_from_id(p.project_type_id) as project_type, 
+#                  im_proj_status_from_id(p.project_status_id) as project_status
+#             from im_projects p, user_groups g, user_groups g2
+#            where not exists (select 1 from users 
+#                              where user_id = p.project_lead_id)
+#              and p.group_id=$group_id
+#              and not exists (select 1 from users
+#                              where user_id = p.supervisor_id)
+#              and p.group_id=g.group_id
+#              and p.customer_id=g2.group_id
+#  union
+#  select p.*, g.group_name as project_name, g.short_name, p.parent_id, p.customer_id,
+#                  '' as customer_name, im_project_ticket_project_id(g.group_id) as ticket_project_id,
+#                  user_group_name_from_id(p.parent_id) as parent_name,
+#                  '' as project_lead, project_lead_id, 
+#                  '' as supervisor,
+#                  im_proj_type_from_id(p.project_type_id) as project_type, 
+#                  im_proj_status_from_id(p.project_status_id) as project_status
+#             from im_projects p, user_groups g
+#            where not exists (select 1 from users 
+#                              where user_id = p.project_lead_id)
+#              and p.group_id=$group_id
+#              and not exists (select 1 from users
+#                              where user_id = p.supervisor_id)
+#              and p.group_id=g.group_id
+#              and not exists (select 1 from user_groups
+#                              where group_id = p.customer_id)"]
+
+if { [empty_string_p $selection] } {
+    ad_return_complaint 1 "Can't find the project with group id of $group_id"
+    return
+}
+
+set_variables_after_query
+
+
+if { $user_admin_p > 0 || $current_user_id == $project_lead_id } {
+    # Set up all the admin stuff here in an array
+    set admin(edit_project) "  <p><li><a href=ae.tcl?[export_url_vars group_id return_url]>Edit this project</a>"
+} else {
+    set admin(edit_project) ""
+}
+
+if { $ticket_project_id == 0 } {
+    set ticket_string "<li><a href=ticket-edit.tcl?[export_url_vars group_id return_url]>Create a ticket tracker</a>\n"
+} else {
+    set num_new [database_to_tcl_string_or_null $db \
+	    "select count(1) 
+               from ticket_issues i
+              where sysdate() - POSTING_TIME < 3
+                and project_id=$ticket_project_id"]
+    set ticket_string "  <li> <a href=/new-ticket/index.tcl?project_id=$ticket_project_id>[util_decode $num_new 0 "No new tickets" 1 "1 new ticket" "$num_new new tickets"] in the last 24 hours</a>\n"
+}
+
+
+set left_column "
+[ad_partner_default_font "size=-1"]
+<ul>
+  <li> Customer: <a href=../customers/view.tcl?group_id=$customer_id>$customer_name</a>
+"
+
+if { [empty_string_p $parent_id] } {
+    set context_bar [ad_context_bar [list "/" Home] [list "../" "Intranet"] [list index.tcl "Projects"] "One project"]
+    set include_subproject_p 1
+} else {
+    set context_bar [ad_context_bar [list "/" Home] [list "../" "Intranet"] [list index.tcl "Projects"] [list "view.tcl?group_id=$parent_id" "One project"] "One subproject"]
+    append left_column "  <li> Parent Project: <a href=view.tcl?group_id=$parent_id>$parent_name</a>\n"
+    set include_subproject_p 0
+}
+
+append left_column "
+  <li> Project leader: <a href=../users/view.tcl?user_id=$project_lead_id>$project_lead</a>
+  <li> Team leader or supervisor: <a href=../users/view.tcl?user_id=$supervisor_id>$supervisor</a>
+  <li> Project short name: $short_name <font size=-1>(eventually for things like email...)</font>
+"
+
+if { $user_admin_p > 0 } {
+    append left_column "
+  <li> Project Status: $project_status
+  <li> Project Type: $project_type
+"
+
+    if { ![empty_string_p $start_date] } {
+	append left_column "  <li> Start Date: [util_AnsiDatetoPrettyDate $start_date]\n"
+    }
+    if { ![empty_string_p $end_date] } {
+	append left_column "  <li> End Date: [util_AnsiDatetoPrettyDate $end_date]\n"
+    }
+}
+
+
+# Get the urls
+set selection [ns_db select $db \
+	"select m.url, t.to_display
+           from im_url_types t, im_project_url_map m
+          where m.group_id=$group_id
+            and t.url_type_id=m.url_type_id
+          order by t.display_order, lower(t.url_type)"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { ![empty_string_p $url] } {
+	set url [im_maybe_prepend_http $url]
+	append left_column "  <li> $to_display: <a href=\"$url\">$url</a>\n"
+    }
+}
+
+
+if { ![empty_string_p $description] } {
+    append left_column "  <li> Description: $description\n"
+}
+
+
+if { $user_admin_p > 0 } {
+    append left_column "
+  <p><li><a href=ae.tcl?[export_url_vars group_id return_url]>Edit this project</a>
+
+<p><a href=../payments/index.tcl?[export_url_vars group_id]>Payments</a>
+<br><a href=../allocations/project.tcl?[export_url_vars group_id]>Allocations</a>
+"
+} 
+
+if { $include_subproject_p } {
+    append left_column "
+<p><b>Subprojects</b>
+<ul>
+"
+
+    set selection [ns_db select $db \
+	"select p.group_id as subgroup_id, g.group_name as subproject_name
+           from im_projects p, user_groups g
+          where p.parent_id=$group_id
+            and p.group_id=g.group_id"]
+    set ctr 0
+    while { [ns_db getrow $db $selection] } {
+	set_variables_after_query
+	append left_column "  <li><a href=view.tcl?group_id=$subgroup_id>$subproject_name</a>\n"
+	incr ctr
+    }
+ 
+    if { $ctr == 0 } {
+	append left_column "  <li> <i>None</i>\n"
+    }
+
+    if { $user_admin_p > 0 } {
+	append left_column "  <p><li> <a href=ae.tcl?[export_url_vars subproject]&parent_id=$group_id&customer_id=$customer_id>Add a subproject</a>\n"
+    }
+
+    append left_column "</ul>\n"
+}
+
+append left_column "
+</ul>
+</font>
+"
+
+if { $user_admin_p } {
+    ## HOURS LOGGED
+    set total_hours [hours_sum $db im_projects $group_id]
+
+    set hours_logged "
+<ul>
+  <li>$total_hours [util_decode $total_hours 1 "hour has" "hours have"] been spent on this project
+"
+    if { $total_hours > 0 } {
+	append hours_logged "  <li><a href=../hours/one-project.tcl?on_what_id=$group_id&on_which_table=[ad_urlencode im_projects]>See the breakdown by person</a>\n"
+    }
+    set user_in_project_group_p [database_to_tcl_string $db \
+				     "select (case when ad_group_member_p ( $current_user_id, $group_id ) = 'f' then 0 else 1 end) from dual"]
+    if { $user_in_project_group_p } {
+	append hours_logged "  <li><a href=../hours/ae.tcl?on_what_id=$group_id&on_which_table=[ad_urlencode im_projects]&[export_url_vars return_url]>Log your hours</a>\n"
+    }
+    append hours_logged "</ul>\n"
+}
+
+## PROJECT Notes
+set project_notes [ad_partner_default_font "size=-1"]
+
+if { [exists_and_not_null show_all_comments] } {
+    append project_notes [ad_general_comments_summary_sorted $db $group_id im_projects $project_name]
+} else {
+    set url_for_more "[im_url_stub]/projects/view.tcl?show_all_comments=1&[export_ns_set_vars url [list show_all_comments]]"
+    append project_notes [ad_general_comments_summary_sorted $db $group_id im_projects $project_name 5 $url_for_more]
+}
+
+append project_notes "
+<ul>
+<p><a href=\"/general-comments/comment-add.tcl?group_id=$group_id&scope=group&on_which_table=im_projects&on_what_id=$group_id&item=Projects&module=intranet&[export_url_vars return_url]\">Add a project comment</a>
+</ul>
+</font>
+"
+
+
+## Links to associated bboards
+set bboard_string ""
+set selection [ns_db select $db \
+	"select topic, topic_id, presentation_type
+           from bboard_topics
+         where group_id=$customer_id"]
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    set link [bboard_complete_backlink $topic_id $topic $presentation_type]
+    regsub {href="} $link {href="/bboard/} link
+    append bboard_string "  <li> $link\n"
+}
+if { [empty_string_p $bboard_string] } {
+    set bboard_string "  <li> <em>none</em>\n"
+}
+
+
+# project reports
+
+set project_report ""
+
+# Project reports are stored using the survsimp module
+# Get the survey_id of the survey.
+
+set survey_short_name [ad_parameter intranet "ProjectReportSurveyName" ""]
+
+if {![empty_string_p $survey_short_name]} {
+   
+    # figure out the survey_id from the short_name 
+    set survey_id  [survsimp_survey_short_name_to_id $survey_short_name]
+    
+    if {![empty_string_p $survey_id]} {
+	# figure out the latest response date for this group
+    set response_id [database_to_tcl_string_or_null $db "select response_id
+from survsimp_responses 
+where survey_id = $survey_id
+and group_id = $group_id
+and submission_date = (select max(submission_date) from
+survsimp_responses where survey_id = $survey_id 
+                 and group_id = $group_id)"]
+
+   
+        if {![empty_string_p $response_id]} {
+	    append project_report "[survsimp_answer_summary_display $db $response_id 1]"
+
+	} 
+
+	
+	set return_url "[ns_conn url]?[ns_conn query]"
+	
+	append project_report "<a href=/survsimp/one.tcl?[export_url_vars survey_id group_id return_url]>Add a report</a>"
+	
+	append left_column "[im_table_with_title "Latest project report" "$project_report"]"
+    }
+}
+
+
+
+set page_body  "
+<table width=100% cellpadding=0 cellspacing=2 border=0>
+<tr>
+  <td valign=top>
+$left_column
+  </td>
+  <td valign=top>
+[im_table_with_title "Ticket Tracker" "<ul>$ticket_string</ul>"]
+[im_table_with_title "Employees" "<ul>[im_users_in_group $db $group_id $current_user_id "Spam employees working on $project_name" $user_admin_p $return_url [im_employee_group_id]]</ul>"]
+[im_table_with_title "Customers" "<ul>[im_users_in_group $db $group_id $current_user_id "Spam customers working on $project_name" $user_admin_p $return_url [im_customer_group_id] [im_employee_group_id]]</ul>"]
+[im_table_with_title "Discussion Groups" "<ul>$bboard_string</ul>"]
+"
+if { $user_admin_p } {
+    append page_body [im_table_with_title "Hours logged" $hours_logged]
+} 
+
+append page_body "
+[im_table_with_title "Project Notes" $project_notes]
+  </td>
+</tr>
+</table>
+"
+
+ns_db releasehandle $db
+
+set page_title $project_name
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/users/add-to-office.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/users/add-to-office.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/users/add-to-office.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,53 @@
+# add-to-office.tcl,v 3.2.2.1 2000/03/17 08:23:20 mbryzek Exp
+# File: /www/intranet/users/add-to-office.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: Shows a list of offices to which to add a specified user
+#
+
+ad_maybe_redirect_for_registration
+
+set_form_variables
+# user_id
+# return_url (optional)
+
+validate_integer user_id $user_id
+
+set db [ns_db gethandle]
+
+set user_name [database_to_tcl_string_or_null $db \
+	"select first_names || ' ' || last_name from users_active where user_id=$user_id"]
+
+if { [empty_string_p $user_name] } {
+    ad_return_error "User doesn't exists!" "This user does not exist or is inactive"
+    return
+}
+
+set selection [ns_db select $db \
+	"select g.group_id, g.group_name
+           from user_groups g, im_offices o
+          where o.group_id=g.group_id
+       order by lower(g.group_name)"]
+
+set results ""
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append results "  <li> <a href=/groups/member-add-3.tcl?user_id_from_search=$user_id&role=member&[export_url_vars group_id return_url]>$group_name</a>\n"
+}
+
+if { [empty_string_p $results] } {
+    set page_body "<ul>  <li><b> There are no offices </b></ul>\n" 
+} else {
+    set page_body "
+<b>Choose office for this user:</b>
+<ul>$results</ul>
+"
+}
+
+ns_db releasehandle $db
+
+set page_title "Add user to office"
+set context_bar [ad_context_bar [list "/" Home] [list "../index.tcl" "Intranet"] [list "./" "Users"] [list view.tcl?[export_url_vars user_id] "One user"] $page_title]
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/users/edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/users/edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/users/edit.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,259 @@
+# edit.tcl,v 1.2.2.1 2000/02/03 09:57:30 ron Exp
+set_the_usual_form_variables 0
+# return_url (maybe)
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+#set sql "\
+#select 
+#  u.first_names, 
+#  u.last_name, 
+#  u.email, 
+#  u.url, 
+#  uc.aim_screen_name, 
+#  im_users.skills, 
+#  im_users.bio,
+# uc.icq_number, 
+#  uc.current_information,
+#  uc.note, 
+#  uc.home_phone, 
+#  uc.work_phone, 
+#  uc.cell_phone, 
+#  uc.ha_line1, 
+#  uc.ha_line2, 
+#  uc.ha_city, 
+#  uc.ha_state, 
+#  uc.ha_postal_code
+#from users u, users_contact uc, im_employee_info im_users
+#where u.user_id = uc.user_id(+)
+#and u.user_id = im_users.user_id(+)
+#and u.user_id = $user_id"
+
+set sql "\
+select 
+  u.first_names, 
+  u.last_name, 
+  u.email, 
+  u.url, 
+  uc.aim_screen_name, 
+  im_users.skills, 
+  im_users.bio,
+  uc.icq_number, 
+  uc.current_information,
+  uc.note, 
+  uc.home_phone, 
+  uc.work_phone, 
+  uc.cell_phone, 
+  uc.ha_line1, 
+  uc.ha_line2, 
+  uc.ha_city, 
+  uc.ha_state, 
+  uc.ha_postal_code
+from users u, users_contact uc, im_employee_info im_users
+where u.user_id = uc.user_id
+and u.user_id = im_users.user_id
+and u.user_id = $user_id
+union
+select 
+  u.first_names, 
+  u.last_name, 
+  u.email, 
+  u.url, 
+  '' as aim_screen_name, 
+  im_users.skills, 
+  im_users.bio,
+  '' as icq_number, 
+  '' as current_information,
+  '' as note, 
+  '' as home_phone, 
+  '' as work_phone, 
+  '' as cell_phone, 
+  '' as ha_line1, 
+  '' as ha_line2, 
+  '' as ha_city, 
+  '' as ha_state, 
+  '' as ha_postal_code
+from users u, users_contact uc, im_employee_info im_users
+where not exists (select 1 from users_contact where user_id = u.user_id)
+and u.user_id = im_users.user_id
+and u.user_id = $user_id
+union
+select 
+  u.first_names, 
+  u.last_name, 
+  u.email, 
+  u.url, 
+  uc.aim_screen_name, 
+  '' as skills, 
+  '' as bio,
+  uc.icq_number, 
+  uc.current_information,
+  uc.note, 
+  uc.home_phone, 
+  uc.work_phone, 
+  uc.cell_phone, 
+  uc.ha_line1, 
+  uc.ha_line2, 
+  uc.ha_city, 
+  uc.ha_state, 
+  uc.ha_postal_code
+from users u, users_contact uc, im_employee_info im_users
+where u.user_id = uc.user_id
+and not exists (select 1 from im_employee_info where user_id = u.user_id)
+and u.user_id = $user_id
+union
+select 
+  u.first_names, 
+  u.last_name, 
+  u.email, 
+  u.url, 
+  '' as aim_screen_name, 
+  '' as skills, 
+  '' as bio,
+  '' as icq_number, 
+  '' as current_information,
+  '' as note, 
+  '' as home_phone, 
+  '' as work_phone, 
+  '' as cell_phone, 
+  '' as ha_line1, 
+  '' as ha_line2, 
+  '' as ha_city, 
+  '' as ha_state, 
+  '' as ha_postal_code
+from users u, users_contact uc, im_employee_info im_users
+where not exists (select 1 from users_contact where user_id = u.user_id)
+and not exists (select 1 from im_employee_info where user_id = u.user_id)
+and u.user_id = $user_id"
+
+set selection [ns_db 1row $db $sql]
+
+set_variables_after_query
+
+
+
+ReturnHeaders 
+
+ns_write "
+[ad_header "Information about you"]
+
+<h2>$first_names $last_name</h2>
+
+[ad_context_bar [list index.tcl Intranet] "Information about you"]
+
+<hr>
+
+<form method=POST action=\"info-update-2.tcl\">
+
+[export_form_vars from]
+
+<table>
+
+<tr>
+ <th>Name:</th><td><input type=text name=first_names size=20 MAXLENGTH=100 value=\"[philg_quote_double_quotes $first_names]\"> <input type=text name=last_name size=25 MAXLENGTH=100 value=\"$last_name\">
+</tr>
+<tr>
+ <th>email address:</th><td><input type=text name=email size=30 MAXLENGTH=100 value=\"[philg_quote_double_quotes $email]\">
+</tr>
+<tr>
+ <th>Personal URL:</th><td><input type=text name=url size=50  MAXLENGTH=200 value=\"[philg_quote_double_quotes $url]\">
+</tr>
+<tr>
+ <th>AIM name:</th><td><input type=text name=aim_screen_name size=20  MAXLENGTH=50 value=\"[philg_quote_double_quotes $aim_screen_name]\">
+</tr>
+<tr>
+ <th>ICQ number:</th><td><input type=text name=icq_number size=20 MAXLENGTH=50 value=\"[philg_quote_double_quotes $icq_number]\">
+</tr>
+
+<tr>
+ <th>Home phone:</th><td><input type=text name=home_phone size=20 MAXLENGTH=100 value=\"[philg_quote_double_quotes $home_phone]\">
+</tr>
+
+<tr>
+ <th>Work phone:</th><td><input type=text name=work_phone size=20 MAXLENGTH=100 value=\"[philg_quote_double_quotes $work_phone]\">
+</tr>
+
+<tr>
+ <th>Cell phone:</th><td><input type=text name=cell_phone size=20 MAXLENGTH=100 value=\"[philg_quote_double_quotes $cell_phone]\">
+</tr>
+
+<tr>
+ <th>Office:</th><td>
+<SELECT NAME=office_id>
+[ad_db_optionlist $db "select name, office_id from im_offices order by name" $office_id]
+</SELECT>
+</tr>
+
+<tr><td COLSPAN=2><Br></TD></TR>
+
+
+<tr>
+ <th VALIN=top>Home address:</th>
+ <td>
+    <table>
+     <tr><TH ALIGN=right>Street:</TH><td><INPUT NAME=ha_line1 MAXLENGTH=80 VALUE=\"[philg_quote_double_quotes $ha_line1]\" size=30></TD></TR>
+     <tr><TH ALIGN=right><BR></TH><td><INPUT NAME=ha_line2 MAXLENGTH=80 VALUE=\"[philg_quote_double_quotes $ha_line2]\" size=30></TD></TR>
+     <tr><TH ALIGN=right>City:</TH><td><INPUT NAME=ha_city MAXLENGTH=80 VALUE=\"[philg_quote_double_quotes $ha_city]\" size=20></TD></TR>
+     <tr><TH ALIGN=right>State:</TH><td>[state_widget $db $ha_state ha_state]</TD></TR>
+     <tr><TH ALIGN=right>Zip:</TH><td><INPUT NAME=ha_postal_code MAXLENGTH=80 VALUE=\"[philg_quote_double_quotes $ha_postal_code]\" size=10></TD></TR>
+    </table>
+
+ </td>
+</tr>
+
+<tr><td COLSPAN=2><Br></TD></TR>
+
+<tr>
+ <th>Upcoming travel<BR>or vacation:</TH>
+<td><TEXTAREA NAME=current_information COLS=50 ROWS=6 WRAP=SOFT>[ns_quotehtml $current_information]</TEXTAREA></TD>
+</tr>
+
+
+<tr><td COLSPAN=2><Br></TD></TR>
+
+
+<tr>
+ <td ALIGN=CENTER width=200><B>Biography:</B><BR>
+<FONT size=-1>
+</FONT>
+</TD>
+ <td>
+<TEXTAREA NAME=bio COLS=50 ROWS=4 WRAP=SOFT>[ns_quotehtml $bio]</TEXTAREA></TD>
+</tr>
+
+<tr><td COLSPAN=2><Br></TD></TR>
+
+
+<tr><td COLSPAN=2><Br></TD></TR>
+
+
+<tr>
+ <td ALIGN=CENTER width=200><B>Special skills:</B><BR>
+<FONT size=-1>(when your coworkers need to find
+someone who can do <em>X</em>)
+</FONT>
+</TD>
+ <td>
+<TEXTAREA NAME=skills COLS=50 ROWS=4 WRAP=SOFT>[ns_quotehtml $skills]</TEXTAREA></TD>
+</tr>
+
+<tr><td COLSPAN=2><Br></TD></TR>
+
+<tr>
+ <th>Other notes:<td><TEXTAREA NAME=note COLS=50 ROWS=4 WRAP=SOFT>[ns_quotehtml $note]</TEXTAREA></TD>
+</tr>
+
+
+</table>
+
+<br>
+<br>
+<center>
+<input type=submit value=\"Update\">
+</center>
+
+[ad_footer]
+"
Index: web/openacs/www/intranet/users/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/users/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/users/index.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,9 @@
+# index.tcl,v 3.0.4.2 2000/03/17 08:23:21 mbryzek Exp
+# File: /www/intranet/users/index.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: don't know yet what to do with this page - show all employees
+#
+
+ns_returnredirect ../employees/index.tcl
\ No newline at end of file
Index: web/openacs/www/intranet/users/info-update-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/users/info-update-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/users/info-update-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,77 @@
+# info-update-2.tcl,v 3.0.4.1 2000/03/17 08:23:21 mbryzek Exp
+# File: /www/intranet/users/info-update-2.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: stores intranet info about a user to the db
+#
+
+set user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set_the_usual_form_variables 0
+# return_url, office_id, dp variables
+
+validate_integer office_id $office_id
+
+set required_vars [list \
+	[list dp.users.first_names "You must enter your first name"] \
+	[list dp.users.last_name "You must enter your last name"] \
+	[list dp.users.email.email "You must enter your email address"]]
+
+set exception_text [im_verify_form_variables $required_vars]
+# $required_vars]
+
+if { ![empty_string_p ${dp.users.email.email}] && ![philg_email_valid_p ${dp.users.email.email}] } {
+    append exception_text "<li>The email address that you typed doesn't look right to us.  Examples of valid email addresses are 
+<ul>
+<li>Alice1234@aol.com
+<li>joe_smith@hp.com
+<li>pierre@inria.fr
+</ul>
+"
+}
+
+if { ![empty_string_p $exception_text] } {
+    ad_return_complaint 2 "<ul>$exception_text</ul>"
+    return
+}
+
+# We have all the data - do the updates
+
+set form_setid [ns_getform]
+
+# In case we have to insert the row, we need to stick the user_id in the set
+ns_set put $form_setid "dp.users_contact.user_id" $user_id
+ns_set put $form_setid "dp.im_employee_info.user_id" $user_id
+
+set db [ns_db gethandle]
+
+# Create/update the mapping between between this users and the office
+# Note: group_name, creation_user, creation_date are all set in ae.tcl
+ns_set put $form_setid "dp_ug.user_group_map.role" "member"
+ns_set put $form_setid "dp_ug.user_group_map.group_id" $office_id
+ns_set put $form_setid "dp_ug.user_group_map.user_id" $user_id
+ns_set put $form_setid "dp_ug.user_group_map.registration_date.expr" "sysdate()"
+ns_set put $form_setid "dp_ug.user_group_map.mapping_user" $user_id
+ns_set put $form_setid "dp_ug.user_group_map.mapping_ip_address" [ns_conn peeraddr]
+
+with_transaction $db {
+
+    # First delete this users mappings in user_group_map (for offices)
+    ns_db dml $db "delete from user_group_map where user_id=$user_id and group_id in (select group_id from user_groups where parent_group_id=[im_office_group_id])"
+
+    if { ![empty_string_p $office_id] } {
+        # And replace with the new office
+        dp_process -db $db -form_index "_ug" -where_clause "user_id=$user_id and group_id=$office_id"
+    }
+
+    # Now add to the users, users_contact, and im_employee_info tables
+    dp_process -db $db -where_clause "user_id=$user_id"
+} { ns_log Error "transaction failed" }
+
+if { [exists_and_not_null return_url] } {
+    ns_returnredirect $return_url
+} else {
+    ns_returnredirect view.tcl
+}
Index: web/openacs/www/intranet/users/info-update.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/users/info-update.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/users/info-update.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,338 @@
+# info-update.tcl,v 3.3.2.1 2000/03/17 08:23:22 mbryzek Exp
+# File: /www/intranet/users/info-update.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: Updates a user's intranet information
+#
+
+set_the_usual_form_variables 0
+# from (maybe)
+
+set caller_user_id [ad_verify_and_get_user_id]
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "\
+select 
+  first_names, 
+  last_name, 
+  email, 
+  url, 
+  bio,
+  aim_screen_name,
+  info.*, 
+  icq_number, 
+  users_contact.current_information,
+  users_contact.note, 
+  home_phone, 
+  work_phone, 
+  cell_phone, 
+  ha_line1, 
+  ha_line2, 
+  ha_city, 
+  ha_state, 
+  ha_postal_code,
+  featured_employee_blurb
+from users, users_contact, im_employee_info_view info
+where users.user_id = users_contact.user_id
+and users.user_id = info.user_id
+and users.user_id = $caller_user_id
+union
+select 
+  first_names, 
+  last_name, 
+  email, 
+  url, 
+  bio,
+  '' as aim_screen_name, 
+  info.*,
+  '' as icq_number, 
+  '' as current_information,
+  '' as note, 
+  '' as home_phone, 
+  '' as work_phone, 
+  '' as cell_phone, 
+  '' as ha_line1, 
+  '' as ha_line2, 
+  '' as ha_city, 
+  '' as ha_state, 
+  '' as ha_postal_code,
+  featured_employee_blurb
+from users, im_employee_info_view info
+where not exists (select 1 from users_contact 
+                  where user_id = users.user_id)
+and users.user_id = info.user_id
+and users.user_id = $caller_user_id
+union
+select 
+  first_names, 
+  last_name, 
+  email, 
+  url, 
+  bio,
+  aim_screen_name,
+  info.*, 
+  icq_number, 
+  users_contact.current_information,
+  users_contact.note, 
+  home_phone, 
+  work_phone, 
+  cell_phone, 
+  ha_line1, 
+  ha_line2, 
+  ha_city, 
+  ha_state, 
+  ha_postal_code,
+  '' as featured_employee_blurb
+from users, users_contact, im_employee_info_null info
+where users.user_id = users_contact.user_id
+and not exists (select 1 from im_employee_info 
+                where user_id = users.user_id)
+and users.user_id = $caller_user_id
+union
+select 
+  first_names, 
+  last_name, 
+  email, 
+  url, 
+  bio,
+  '' as aim_screen_name, 
+  info.*,
+  '' as icq_number, 
+  '' as current_information,
+  '' as note, 
+  '' as home_phone, 
+  '' as work_phone, 
+  '' as cell_phone, 
+  '' as ha_line1, 
+  '' as ha_line2, 
+  '' as ha_city, 
+  '' as ha_state, 
+  '' as ha_postal_code,
+  '' as featured_employee_blurb
+from users, users_contact, im_employee_info_null info
+where not exists (select 1 from users_contact 
+                  where user_id = users.user_id)
+and not exists (select 1 from im_employee_info 
+                where user_id = users.user_id)
+and users.user_id = $caller_user_id"]
+
+set_variables_after_query
+
+set office_id [database_to_tcl_string_or_null $db \
+	"select o.group_id
+           from im_offices o
+          where ad_group_member_p ( $caller_user_id, o.group_id ) = 't'"]
+
+set user_id $caller_user_id
+
+set page_title "$first_names $last_name"
+set context_bar [ad_context_bar [list "/" Home] [list "../index.tcl" "Intranet"] [list "./" "Users"] [list view.tcl?[export_url_vars user_id] "One user"] "Update info"]
+
+set page_body "
+
+<form method=post action=info-update-2.tcl>
+[export_form_vars return_url]
+
+<table>
+
+<tr>
+ <th>name:</th>
+ <td><input type=text name=dp.users.first_names size=20 maxlength=100 [export_form_value first_names]> 
+     <input type=text name=dp.users.last_name size=25 maxlength=100 [export_form_value last_name]>
+ </td>
+</tr>
+<tr>
+ <th>email address:</th>
+ <td><input type=text name=dp.users.email.email size=30 maxlength=100 [export_form_value email]></td>
+</tr>
+<tr>
+ <th>Personal URL:</th>
+ <td><input type=text name=dp.users.url size=50  maxlength=200 [export_form_value url]></td>
+</tr>
+<tr>
+ <th>AIM name:</th>
+ <td><input type=text name=dp.users_contact.aim_screen_name size=20  maxlength=50 [export_form_value aim_screen_name]></td>
+</tr>
+<tr>
+ <th>ICQ number:</th>
+ <td><input type=text name=dp.users_contact.icq_number size=20 maxlength=50 [export_form_value icq_number]></td>
+</tr>
+
+<tr>
+ <th>Home phone:</th>
+ <td><input type=text name=dp.users_contact.home_phone size=20 maxlength=100 [export_form_value home_phone]></td>
+</tr>
+
+<tr>
+ <th>Work phone:</th>
+ <td><input type=text name=dp.users_contact.work_phone size=20 maxlength=100 [export_form_value work_phone]></td>
+</tr>
+
+<tr>
+ <th>Cell phone:</th>
+ <td><input type=text name=dp.users_contact.cell_phone size=20 maxlength=100 [export_form_value cell_phone]></td>
+</tr>
+
+<tr>
+ <th>Office:</th>
+ <td>
+<select name=office_id>
+<option value=\"\"> -- Please select --
+[ad_db_optionlist $db \
+	"select g.group_name, g.group_id
+           from im_offices o, user_groups g
+          where o.group_id=g.group_id
+       order by lower(group_name)" [value_if_exists office_id]]
+</select>
+ </td>
+</tr>
+
+<tr><td colspan=2></td></tr>
+
+
+<tr>
+ <th valign=top>Home address:</th>
+ <td>
+    <table>
+     <tr>
+        <th align=right>Street:</th>
+        <td><INPUT name=dp.users_contact.ha_line1 maxlength=80 [export_form_value ha_line1] size=30></td>
+     </tr>
+     <tr>
+        <th align=right>&nbsp;</th>
+        <td><INPUT name=dp.users_contact.ha_line2 maxlength=80 [export_form_value ha_line2] size=30></td>
+     </tr>
+     <tr>
+        <th align=right>City:</th>
+        <td><INPUT name=dp.users_contact.ha_city maxlength=80 [export_form_value ha_city] size=20></td>
+     </tr>
+     <tr>
+        <th align=right>State:</th>
+        <td>[state_widget $db [value_if_exists ha_state] dp.users_contact.ha_state]</td>
+     </tr>
+     <tr>
+        <th align=right>Zip:</th>
+        <td><INPUT name=dp.users_contact.ha_postal_code maxlength=80 [export_form_value ha_postal_code] size=10></td>
+     </tr>
+    </table>
+ </td>
+</tr>
+
+<tr><td colspan=2></td></tr>
+
+
+<tr>
+ <th>List your degrees with the school names:</TH>
+<td><textarea name=dp.im_employee_info.educational_history COLS=50 ROWS=6 WRAP=SOFT>[philg_quote_double_quotes [value_if_exists educational_history]]</textarea></td>
+</tr>
+
+<tr><td colspan=2></td></tr>
+
+<tr>
+ <th>Last degree you completed?</TH>
+<td>
+<select name=dp.im_employee_info.last_degree_completed>
+[html_select_options {"" "High School" "Bachelors" "Master" "PhD"} [value_if_exists last_degree_completed]]
+</select>
+</td>
+</tr>
+
+<tr><td colspan=2></td></tr>
+
+<tr>
+ <TD ALIGN=CENTER WIDTH=200><B>Biography:</B><BR>
+<FONT SIZE=-1>
+</FONT>
+</td>
+ <td>
+<textarea name=dp.users.bio cols=50 rows=4 wrap=soft>[philg_quote_double_quotes [value_if_exists bio]]</textarea></td>
+</tr>
+
+<tr><td colspan=2></td></tr>
+
+
+<tr><td colspan=2></td></tr>
+
+
+<tr>
+ <TD ALIGN=CENTER WIDTH=200><B>Special skills:</B><BR>
+<FONT SIZE=-1>(when your coworkers need to find
+someone who can do <EM>X</EM>)
+</FONT>
+</td>
+ <td>
+<textarea name=dp.im_employee_info.skills cols=50 rows=4 wrap=soft>[philg_quote_double_quotes [value_if_exists skills]]</textarea></td>
+</tr>
+
+<tr><td colspan=2></td></tr>
+
+<tr>
+ <th>Years experience in this field?</TH>
+<td>
+<select name=dp.im_employee_info.years_experience.integer>
+[html_select_options {0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30} $years_experience ]
+</select>
+</td>
+</tr>
+
+<tr><td colspan=2></td></tr>
+
+
+<tr>
+ <TD ALIGN=CENTER WIDTH=200><B>Resume:</B>
+</td>
+ <td>
+<textarea name=dp.im_employee_info.resume.clob cols=50 rows=4 wrap=soft>[philg_quote_double_quotes [value_if_exists resume]]</textarea>
+<p>
+
+
+The above resume is:
+<select name=dp.im_employee_info.resume_html_p>
+[html_select_value_options {{"t" "HTML"} {"f" "Text"}}  [value_if_exists resume_html_p]]
+</select>
+</td>
+</tr>
+
+
+<tr><td colspan=2></td></tr>
+
+<tr>
+ <th>Other notes:<td><textarea name=dp.users_contact.note cols=50 rows=4 wrap=soft>[philg_quote_double_quotes [value_if_exists note]]</textarea></td>
+</tr>
+
+
+<tr><td colspan=2></td></tr>
+
+
+<tr>
+ <TD ALIGN=CENTER WIDTH=200><B>Featured Employee Blurb:</B>
+</td>
+ <td>
+<textarea name=dp.im_employee_info.featured_employee_blurb.clob cols=50 rows=6 wrap=soft>[philg_quote_double_quotes [value_if_exists featured_employee_blurb]]</textarea>
+<p>
+
+
+The above blurb is:
+<select name=dp.im_employee_info.featured_employee_blurb_html_p>
+[html_select_value_options {{"t" "HTML"} {"f" "Text"}}  [value_if_exists featured_employee_blurb_html_p]]
+</select>
+</td>
+</tr>
+
+
+
+
+</table>
+
+<br>
+<br>
+<center>
+<input type=submit value=\"Update\">
+</center>
+</form>
+"
+
+ns_return 200 text/html [ad_partner_return_template]
Index: web/openacs/www/intranet/users/view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/users/view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/users/view.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,22 @@
+# view.tcl,v 3.4.2.1 2000/03/17 08:23:23 mbryzek Exp
+# File: /www/intranet/users/view.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: View everything about a user. We redirect right 
+#  now to community-member.tcl but leave this file here to:
+#    1. default to the current cookied user
+#    2. have a secure place later for more detailed employee
+#       info w/out breaking links
+
+
+set_form_variables 0 
+# user_id
+
+if { ![exists_and_not_null user_id] } {
+    set user_id [ad_get_user_id]
+} else {
+    validate_integer user_id $user_id
+}
+
+ns_returnredirect /shared/community-member.tcl?[export_url_vars user_id]
Index: web/openacs/www/intranet/vacations/add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/vacations/add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/vacations/add-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,84 @@
+# add-2.tcl,v 3.0.4.1 2000/03/17 08:23:25 mbryzek Exp
+# File: /www/intranet/vacations/add-2.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: Stores info about absences to the db
+#
+
+#This file should be called add-2.tcl
+set_the_usual_form_variables
+
+# vacation_id, start_date, end_date, description, contact_info, user_id, receive_email_p
+
+validate_integer vacation_id $vacation_id
+validate_integer user_id $user_id
+
+#Now check to see if the input is good as directed by the page designer
+
+set exception_count 0
+set exception_text ""
+
+# it doesn't matter what instructions we got,
+#  since start_date is of type date and thus must be checked.
+if [catch { ns_dbformvalue [ns_conn form] start_date date start_date } errmsg] {
+        incr exception_count
+        append exception_text "<li>Please enter a valid date for the entry date."
+}
+
+# it doesn't matter what instructions we got,
+#  since end_date is of type date and thus must be checked.
+if [catch { ns_dbformvalue [ns_conn form] end_date date end_date } errmsg] {
+        incr exception_count
+        append exception_text "<li>Please enter a valid date for the entry date."
+}
+
+# we were directed to return an error for contact_info
+if {![info exists contact_info] || [empty_string_p $contact_info]} {
+    incr exception_count
+    append exception_text "<li>You did not enter a value for contact_info.<br>"
+} 
+if {[string length $description] > 4000} {
+    incr exception_count
+    append exception_text "<LI>\"description\" is too long\n"
+}
+
+if {[string length $contact_info] > 4000} {
+    incr exception_count
+    append exception_text "<LI>\"contact_info\" is too long\n"
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# So the input is good --
+# Now we'll do the insertion in the user_vacations table.
+set db [ns_db gethandle]
+if [catch {ns_db dml $db "insert into user_vacations
+      (vacation_id, last_modified, user_id, start_date, end_date, description, contact_info, receive_email_p, vacation_type)
+      values
+      ($vacation_id, sysdate(), $user_id, to_date('$start_date'::varchar,'YYYY-MM-DD'::varchar), to_date('$end_date'::varchar,'YYYY-MM-DD'::varchar), '$QQdescription', '$QQcontact_info', '$receive_email_p', '$QQvacation_type')" } errmsg] {
+	  # Oracle choked on the insert    
+	  
+	  # see if this is a double click
+
+	  set number_vacations [database_to_tcl_string $db "select count(vacation_id) from 
+user_vacations where vacation_id = $vacation_id"]
+
+         if {$number_vacations == 0} {
+
+	     ad_return_error "Error in insert" "We were unable to do your insert in the database. 
+	     Here is the error that was returned:
+<p>
+<blockquote>
+<pre>
+$errmsg
+</pre>
+</blockquote>"
+	     return
+    }
+}
+
+ns_returnredirect "index.tcl"
Index: web/openacs/www/intranet/vacations/add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/vacations/add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/vacations/add.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,83 @@
+# add.tcl,v 3.0.4.1 2000/03/17 08:23:25 mbryzek Exp
+# File: /www/intranet/vacations/add.tcl
+#
+# last modified, ahmedaa@mit.edu, December 29 1999
+# added vacation_type select box
+#
+# Purpose: lets a user add info about their absences
+#
+
+ad_maybe_redirect_for_registration
+
+set db [ns_db gethandle]
+set vacation_id [database_to_tcl_string $db "select user_vacations_vacation_id_seq.nextval
+from dual"]
+
+
+set absence_types [ad_parameter AbsenceTypes pvt "travel sick vacation personal"]
+
+set absence_type_html "<tr><th valign=top align=right>Absence type</th><td><select name=vacation_type>"
+set counter 0
+foreach ab_type $absence_types {
+    append absence_type_html "<option value=$ab_type>$ab_type</option>"
+    incr counter
+}
+
+append absence_type_html "</select></td></tr>"
+
+
+if { $counter == 0 } {
+    set absence_type_html ""
+}
+
+set page_body "
+[ad_header "Add a vacation"]
+
+<h2>Add a vacation</h2>
+
+[ad_context_bar [list "../index.tcl" "Intranet"] [list index.tcl "Vacations"] "Add"]
+
+<hr>
+<form method=POST action=\"add-2.tcl\"> 
+[export_form_vars vacation_id]
+<table>
+$absence_type_html
+<tr><th valign=top align=right>Start date</th>
+<td>[philg_dateentrywidget_default_to_today start_date]</td></tr>
+
+<tr><th valign=top align=right>End date</th>
+<td>[philg_dateentrywidget_default_to_today end_date]</td></tr>
+
+<tr><th valign=top align=right>Employee</th>
+<td>
+<select name=user_id>
+[im_employee_select_optionlist $db]
+</select>
+</td>
+</tr>
+
+<tr><th valign=top align=right>Description</th>
+<td><textarea name=description cols=40 rows=8 wrap=soft></textarea></td></tr>
+
+<tr><th valign=top align=right>Emergency contact information</th>
+<td><textarea name=contact_info cols=40 rows=8 wrap=soft></textarea></td></tr>
+
+<tr><th valign=top align=right>Receive email?</th>
+<td>Yes <input type=radio name=receive_email_p value=\"t\" checked>
+No <input type=radio name=receive_email_p value=\"f\">
+
+</td></tr>
+
+</table>
+
+<p>
+<center>
+<input type=submit value=\"Add vacation\">
+</center>
+</form>
+<p>
+[ad_footer]"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $page_body 
Index: web/openacs/www/intranet/vacations/delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/vacations/delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/vacations/delete.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,30 @@
+# delete.tcl,v 3.1.2.1 2000/03/17 08:23:26 mbryzek Exp
+# File: /www/intranet/vacations/delete.tcl
+#
+# created, jsalz@mit.edu, 28 Feb 2000
+#
+# Purpose: Deletes a vacation for a specified user
+#
+
+set_the_usual_form_variables
+
+# vacation_id
+
+set vacation_id [validate_integer vacation_id $vacation_id]
+
+set my_user_id [ad_maybe_redirect_for_registration]
+
+set db [ns_db gethandle]
+
+set user_id [database_to_tcl_string $db "
+    select user_id
+    from user_vacations 
+    where vacation_id = $vacation_id
+"]
+
+if { $user_id == $my_user_id || [im_is_user_site_wide_or_intranet_admin $db $my_user_id] } {
+    ns_db dml $db "delete from user_vacations where vacation_id = $vacation_id"
+    ns_returnredirect "index.tcl"
+}
+
+ad_return_warning "Not authorized" "You are not authorized to perform this operation."
Index: web/openacs/www/intranet/vacations/edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/vacations/edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/vacations/edit-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,78 @@
+# edit-2.tcl,v 3.0.4.1 2000/03/17 08:23:26 mbryzek Exp
+# File: /www/intranet/vacations/edit-2.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: writes absence edits to db
+#
+
+#This file should be called edit-2.tcl
+set_the_usual_form_variables
+
+# vacation_id, start_date, end_date, description, contact_info, user_id, receive_email_p
+
+validate_integer vacation_id $vacation_id
+validate_integer user_id $user_id
+
+#Now check to see if the input is good as directed by the page designer
+
+set exception_count 0
+set exception_text ""
+
+
+# it doesn't matter what instructions we got,
+#  since start_date is of type date and thus must be checked.
+if [catch { ns_dbformvalue [ns_conn form] start_date date start_date } errmsg] {
+        incr exception_count
+        append exception_text "<li>Please enter a valid date for the entry date."
+}
+
+# it doesn't matter what instructions we got,
+#  since end_date is of type date and thus must be checked.
+if [catch { ns_dbformvalue [ns_conn form] end_date date end_date } errmsg] {
+        incr exception_count
+        append exception_text "<li>Please enter a valid date for the entry date."
+}
+
+# we were directed to return an error for contact_info
+if {![info exists contact_info] ||[empty_string_p $contact_info]} {
+    incr exception_count
+    append exception_text "<li>You did not enter a value for contact_info.<br>"
+} 
+if {[string length $description] > 4000} {
+    incr exception_count
+    append exception_text "<LI>\"description\" is too long\n"
+}
+
+if {[string length $contact_info] > 4000} {
+    incr exception_count
+    append exception_text "<LI>\"contact_info\" is too long\n"
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# So the input is good --
+# Now we'll do the update of the user_vacations table.
+
+set db [ns_db gethandle]
+
+if [catch {ns_db dml $db "update user_vacations 
+      set last_modified = sysdate(), start_date = to_date('$start_date'::varchar,'YYYY-MM-DD'::varchar), end_date = to_date('$end_date'::varchar,'YYYY-MM-DD'::varchar), description = '$QQdescription', contact_info = '$QQcontact_info', user_id = $user_id, receive_email_p = '$receive_email_p', vacation_type = '$QQvacation_type'
+      where vacation_id = $vacation_id" } errmsg] {
+
+# Oracle choked on the update
+    ad_return_error "Error in update" 
+"We were unable to do your update in the database. Here is the error that was returned:
+<p>
+<blockquote>
+<pre>
+$errmsg
+</pre>
+</blockquote>"
+    return
+}
+
+ns_returnredirect "index.tcl"
Index: web/openacs/www/intranet/vacations/edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/vacations/edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/vacations/edit.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,155 @@
+# edit.tcl,v 3.2.2.1 2000/03/17 08:23:27 mbryzek Exp
+# File: /www/intranet/vacations/edit.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: form to edit a user's absences information
+#
+
+# last modified, ahmedaa@mit.edu, December 29 1999
+# added vacation_type selection
+
+set_the_usual_form_variables
+
+# vacation_id
+
+validate_integer vacation_id $vacation_id
+
+set my_user_id [ad_maybe_redirect_for_registration]
+
+set db [ns_db gethandle]
+
+if {[catch {set selection [ns_db 1row $db "
+    select to_char(start_date,'YYYY-MM-DD') as start_date, to_char(end_date,'YYYY-MM-DD') as end_date, description, contact_info, user_id, coalesce(receive_email_p, 't') as receive_email_p, vacation_type
+    from user_vacations 
+    where vacation_id = $vacation_id"]} errmsg]} {
+    ad_return_error "Error in finding the data" "We encountered an error in querying the database for your object.
+Here is the error that was returned:
+<p>
+<blockquote>
+<pre>
+$errmsg
+</pre>
+</blockquote>"
+    return
+} 
+
+set_variables_after_query
+
+# Only the user whose vacation this is, or an administrator, can delete the vacation.
+if { $user_id == $my_user_id || [im_is_user_site_wide_or_intranet_admin $db $my_user_id] } {
+    set can_delete_p 1
+} else {
+    set can_delete_p 0
+}
+
+
+
+set absence_types [ad_parameter AbsenceTypes pvt "travel sick vacation personal"]
+
+set absence_type_html "<tr><th valign=top align=right>Absence type</th><td><select name=vacation_type>"
+set counter 0
+foreach ab_type $absence_types {
+    if { [string compare $ab_type $vacation_type] == 0 } {
+	set selected " SELECTED"
+    } else {
+	set selected ""
+    }
+    append absence_type_html "<option value=\"$ab_type\"$selected>$ab_type</option>"
+    incr counter
+}
+
+append absence_type_html "</select></td></tr>"
+
+if { $counter == 0 } {
+    set absence_type_html ""
+}
+
+
+
+#now we have the values from the database.
+
+set title "Edit the entry for $start_date"
+set page_body "[ad_header $title]
+<h2>Edit the entry for $start_date</h2>
+
+[ad_context_bar [list "../index.tcl" "Intranet"] [list index.tcl "Vacations"] "Add"]
+
+<hr>
+
+<form method=POST action=edit-2.tcl>
+[export_form_vars vacation_id]" 
+
+# Make the forms:
+
+append page_body "<table>
+$absence_type_html
+<tr><th valign=top align=right>Start date</th>
+
+"
+if [empty_string_p $start_date] {
+    append page_body "<td>No date in the database. Set a date: &nbsp;
+    [philg_dateentrywidget_default_to_today start_date]</td></tr>
+`
+"
+} else {
+    append page_body "<td>[philg_dateentrywidget start_date $start_date]</td></tr>
+
+"
+}
+
+append page_body "<tr><th valign=top align=right>End date</th>
+"
+if [empty_string_p $end_date] {
+    append page_body "<td>No date in the database. Set a date: &nbsp;
+    [philg_dateentrywidget_default_to_today end_date]</td></tr>
+
+"
+} else {
+    append page_body "<td>[philg_dateentrywidget end_date $end_date]</td></tr>
+
+"
+}
+
+append page_body "
+
+<tr><th valign=top align=right>Employee</th>
+<td>
+<select name=user_id>
+[im_employee_select_optionlist $db $user_id]
+</select>
+</td>
+</tr>
+
+
+<tr><th valign=top align=right>Description</th>
+<td><textarea name=description cols=40 rows=8 wrap=soft>[ns_quotehtml $description]</textarea></td></tr>
+
+<tr><th valign=top align=right>Emergency contact information</th>
+<td><textarea name=contact_info cols=40 rows=8 wrap=soft>[ns_quotehtml $contact_info]</textarea></td></tr>
+
+
+<tr><th valign=top align=right>Receive email?</th>
+<td>Yes [bt_mergepiece "<input type=radio name=receive_email_p value=\"t\">
+No <input type=radio name=receive_email_p value=\"f\">" $selection]
+
+</td></tr>
+
+</table>
+<p>
+<center>
+[ad_decode $can_delete_p 1 "
+    <input type=button value=\"Delete this vacation\" onClick=\"location.href='delete.tcl?vacation_id=$vacation_id'\">
+    <spacer type=horizontal size=50>
+" ""]
+<input type=submit value=\"Edit vacation\">
+
+
+</center>
+</form>
+<p>
+[ad_footer]"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $page_body
Index: web/openacs/www/intranet/vacations/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/vacations/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/vacations/index.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,95 @@
+# index.tcl,v 3.0.4.1 2000/03/17 08:23:27 mbryzek Exp
+# File: /www/intranet/vacations/index.tcl
+#
+# Mar 16 2000: mbryzek@arsdigita.com: removed ns_writes
+#
+# Dec 29 1999: ahmedaa@mit.edu, 
+#  made it viewable by normal people
+# 
+# Purpose: shows all office absences
+#
+
+#expected variables: vacation_type and/or period or none
+set_the_usual_form_variables 0
+
+if ![info exists period] {
+    set period ""
+}
+
+if { ![info exists vacation_type] || $vacation_type == "all" } {
+    set extra_sql ""
+    set vacation_type "all"
+    set slider "<table width=100%><tr><td align=left>\[all\]"
+} else {
+    set extra_sql "and vacation_type = '[string tolower $vacation_type]'"
+    set slider "<table width=100%><tr><td align=left>\[<a href=index.tcl?period=$period>all</a>\]"
+}
+
+set absence_types [ad_parameter AbsenceTypes pvt "travel sick vacation personal"]
+
+foreach ab_type $absence_types {
+    if { $ab_type == $vacation_type } {
+	append slider "\[$ab_type\]"
+    } else {
+	append slider "\[<a href=index.tcl?vacation_type=$ab_type&period=$period>$ab_type</a>\]"
+    }
+}
+
+if { [empty_string_p $period]} {
+    set extra_period_sql "and end_date > sysdate()"
+    set period ""
+    append slider "<td align=right>\[<a href=index.tcl?period=current&vacation_type=$vacation_type>current</a>\]\[<a href=index.tcl?period=future&vacation_type=$vacation_type>future</a>\]\[<a href=index.tcl?period=past&vacation_type=$vacation_type>past</a>\]</table>"
+}  elseif { $period == "current" } {
+    set extra_period_sql "and end_date >= sysdate() and start_date <= sysdate()"
+    append slider "<td align=right>\[current\]\[<a href=index.tcl?period=future&vacation_type=$vacation_type>future</a>\]\[<a href=index.tcl?period=past&vacation_type=$vacation_type>past</a>\]</table>"
+} elseif { $period == "past" } {
+    set extra_period_sql "and end_date < sysdate()"
+    append slider "<td align=right>\[<a href=index.tcl?period=current&vacation_type=$vacation_type>current</a>\]\[<a href=index.tcl?period=future&vacation_type=$vacation_type>future</a>\]\[past\]</table>"
+} else {
+    # future
+    set extra_period_sql "and start_date > sysdate()"
+    append slider "<td align=right>\[<a href=index.tcl?period=current&vacation_type=$vacation_type>current</a>\]\[future\]\[<a href=index.tcl?period=past&vacation_type=$vacation_type>past</a>\]</table>"
+}
+
+set page_body "
+[ad_header "Vacations" ]
+<h2>Work Absences: $vacation_type</h2>
+
+
+[ad_context_bar [list "../index.tcl" "Intranet"] "Work Absences ($vacation_type)"]
+<hr>
+$slider
+
+<blockquote>
+<table width=80%>"
+
+set db [ns_db gethandle]
+set sql_query  "select to_char(start_date,'YYYY-MM-DD') as start_date, to_char(end_date,'YYYY-MM-DD') as end_date, users.user_id, 
+users.first_names || ' ' || users.last_name as name, vacation_id, trunc(end_date-start_date) as duration
+from user_vacations, users
+where user_vacations.user_id =users.user_id
+$extra_sql
+$extra_period_sql
+order by to_char(start_date,'YYYY-MM-DD') asc"
+
+set selection [ns_db select $db $sql_query] 
+set counter 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    incr counter
+    append page_body "<tr><td align=left><a href=one-user.tcl?[export_url_vars user_id]>$name</a> <td align=left>[nmc_IllustraDatetoPrettyDate $start_date] - [nmc_IllustraDatetoPrettyDate $end_date] <td align=left> $duration days <td align=left><a href=edit.tcl?[export_url_vars vacation_id]>edit</a>"
+}
+
+append page_body "</table></blockquote>"
+
+if { $counter == 0 } {
+    append page_body "There are no office absences of type \" $period [string tolower $vacation_type]\" in the database right now.<p>"
+}
+
+append page_body "<p><a href=\"add.tcl\">Add an office absence</a><p>
+[ad_footer]"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $page_body
+
Index: web/openacs/www/intranet/vacations/one-user.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/intranet/vacations/one-user.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/intranet/vacations/one-user.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,75 @@
+# one-user.tcl,v 3.0.4.1 2000/03/17 08:23:28 mbryzek Exp
+# File: /www/intranet/vacations/one-user.tcl
+#
+# Author: mbryzek@arsdigita.com, Jan 2000
+#
+# Purpose: Shows absence info about one user
+#
+
+set_the_usual_form_variables 0
+# user_id
+
+set caller_id [ad_get_user_id]
+
+if { ![exists_and_not_null user_id] } {
+    set user_id $caller_id
+} else {
+    validate_integer user_id $user_id
+}
+
+set db [ns_db gethandle]
+
+if { $caller_id == $user_id } {
+    set page_title "Your vacations"
+} else {
+    set user_name [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id=$user_id"]
+    set page_title "Vacations for $user_name"
+}
+
+set page_body "
+[ad_header "$page_title"]
+<h2>$page_title</h2>
+
+[ad_context_bar [list "../index.tcl" "Intranet"] [list index.tcl "Vacations"] "One user"]
+
+<hr>
+<h3>Your vacations</h3>
+
+<ul>"
+
+set sql_query  "select vacation_id, to_char(start_date,'YYYY-MM-DD') as start_date, to_char(end_date,'YYYY-MM-DD') as end_date, description, contact_info,  (case when vacation_type = '' then 'unclassified' else vacation_type end) as vacation_type
+     from user_vacations where user_id = $user_id
+     order by to_char(start_date,'YYYY-MM-DD') desc"
+
+set selection [ns_db select $db $sql_query] 
+
+set counter 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    incr counter
+    append vacation_text "<li>[nmc_IllustraDatetoPrettyDate $start_date] - [nmc_IllustraDatetoPrettyDate $end_date], <b>$vacation_type</b>:
+    <br>
+    <blockquote>
+    Description:
+    $description 
+    <p>
+    Contact info
+    $contact_info
+    <p>
+    <a href=edit.tcl?[export_url_vars vacation_id]>edit</a>
+    </blockquote>"
+}
+
+if { $counter == 0 } {
+    append vacation_text "<li>You have no vacations in the database right now.<p>"
+}
+
+append page_body "
+$vacation_text
+<p><li><a href=\"add.tcl\">Add a vacation</a></ul><p>
+[ad_footer]"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $page_body
+
Index: web/openacs/www/links/add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/links/add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/links/add-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,92 @@
+# add-2.tcl,v 3.0 2000/02/06 03:49:23 ron Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+
+# page_id, link_description, link_title, url, maybe contact_p
+
+# security check (BMA, spec'ed by ad)
+validate_integer page_id $page_id
+
+# check for valid data
+set user_id [ad_verify_and_get_user_id]
+
+set exception_count 0
+set exception_text ""
+
+if { [info exists url] && [string match $url "http://"] ==  1 } {
+    # the user left the default hint for the url
+    set url ""
+    set QQurl ""
+}
+
+if { ![info exists url] || [empty_string_p $url]  } {
+    incr exception_count
+    append exception_text "<li> Please type in a URL."
+}
+
+if {[info exists url] && ![empty_string_p $url] && ![philg_url_valid_p $url] } {
+    # there is a URL but it doesn't match our REGEXP
+    incr exception_count
+    append exception_text "<li>You URL doesn't have the correct form.  A valid URL would be something like \"http://photo.net/philg/\"."
+}
+
+if { ![info exists link_description] || [empty_string_p $link_description] } {
+    incr exception_count
+    append exception_text "<li> Please type in a description of your link."
+}
+
+if { [info exists link_description] && [string length $link_description] > 4000 } {
+    incr exception_count
+    append exception_text "<li> Please limit your link description to 4000 characters."
+}
+
+if { ![info exists link_title] || [empty_string_p $link_title] } {
+    incr exception_count
+    append exception_text "<li> Please type in a title for your linked page."
+}
+
+set db [ns_db gethandle]
+
+if { [database_to_tcl_string $db "select count(url) from links where page_id = $page_id and lower(url)='[string tolower $QQurl]'"] > 0  } {
+    incr exception_count
+    append exception_text "<li> $url has already been submitted."
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# data is valid, move on
+
+set selection [ns_db 1row $db "select  coalesce(page_title,url_stub) as page_title, url_stub 
+from static_pages
+where page_id = $page_id"]
+set_variables_after_query
+
+ns_return 200 text/html "[ad_header "Confirm link on <i>$page_title</i>" ]
+
+<h2>Confirm link</h2>
+
+on <a href=\"$url_stub\">$page_title</a>
+<hr>
+
+The following is your link as it would appear on the page <i>$page_title</i>.
+If it looks incorrect, please use the back button on your browser to return and
+correct it.  Otherwise, press \"Proceed\".
+<p>
+<blockquote>
+<a href=\"$url\">$link_title</a>- $link_description
+</blockquote>
+<form action=add-3.tcl method=post>
+[export_form_vars page_id url_stub link_title link_description url contact_p]
+<center>
+<input type=submit name=submit value=\"Proceed\">
+</center>
+</form>
+[ad_footer]
+"
Index: web/openacs/www/links/add-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/links/add-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/links/add-3.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,127 @@
+# add-3.tcl,v 3.0 2000/02/06 03:49:24 ron Exp
+#
+# /links/add-3.tcl
+#
+# originally by Tracy Adams in mid-1998
+# fixed up by philg@mit.edu on November 15, 1999
+# to actually check link_kill_patterns before inserting
+#
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+
+# page_id, link_description, link_title, url, maybe contact_p
+
+# security check (BMA, spec'ed by ad)
+validate_integer page_id $page_id
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+set glob_patterns [database_to_tcl_list $db "select glob_pattern 
+from link_kill_patterns
+where page_id = $page_id
+or page_id is null"]
+
+foreach pattern $glob_patterns {
+    if { [string match $pattern $url] } {
+	ad_return_complaint 1 "<li>Your submission matched one of this community's exclusion patterns:
+
+<blockquote>
+<code>
+$pattern
+</code>
+</blockquote>
+
+These are installed by site administrators after noticing that someone is
+posting unrelated links.
+"
+	return
+    }
+}
+
+
+set originating_ip [ns_conn peeraddr]
+
+set already_submitted_p 0
+
+if [catch { ns_db dml $db "insert into links
+(page_id, user_id, url, link_title, link_description, contact_p, status,
+originating_ip, posting_time)
+values (
+$page_id, $user_id, '$QQurl', '$QQlink_title', '$QQlink_description', '$contact_p', 'live', '$originating_ip',sysdate())" } errmsg] {
+
+    if { [database_to_tcl_string $db "select count(url) from links where page_id = $page_id and url='$QQurl'"] > 0 } {
+	# the link was already there, either submitted by another user or this user pressed the button twice.
+    	set already_submitted_p 1
+    } else {
+
+	# there was a different error, print an error message
+	ReturnHeaders
+	ns_write "[ad_header "Error in inserting a link"]
+	
+<h3> Error in inserting a link</h3>
+<hr>
+There was an error in inserting your link into the database.
+Here is what the database returned:
+<p>
+<pre>
+$errmsg
+</pre>
+
+
+Don't quit your browser. The database may just be busy.
+You might be able to resubmit your posting five or ten minutes from now.
+
+[ad_footer]"
+
+    }
+}
+
+# get the page and author information
+
+set selection [ns_db 1row $db "select url_stub, coalesce(page_title,  url_stub) as page_title, coalesce(user_email(original_author),'[ad_system_owner]') as author_email
+from static_pages
+where static_pages.page_id = $page_id"]
+set_variables_after_query
+
+ns_return 200 text/html "[ad_header "Link submitted"]
+
+<h2>Link submitted</h2>
+
+to <a href=\"$url_stub\">$page_title</a>
+
+<hr> 
+
+The following link is listed as a related link on the page <a href=\"$url_stub\">$page_title</a> page. 
+<blockquote>
+<A href=\"$url\">$link_title</a> - $link_description
+</blockquote>
+[ad_footer]"
+
+if { [ad_parameter EmailNewLink links]   && !$already_submitted_p } {    
+    # send email if necessary
+    set selection [ns_db 1row $db "select first_names || ' ' || last_name as name, email from users where user_id = $user_id"]
+    set_variables_after_query
+    ns_db releasehandle $db
+    set subject "link added to $url_stub"
+    set body "
+$name ($email) added a link to
+[ad_url]$url_stub
+($page_title)
+		
+URL: $url
+Title:  $link_title
+Description:
+
+[wrap_string $link_description]
+"
+    if [catch { ns_sendmail $author_email $email $subject $body } errormsg ] {
+	ns_log Warning "Error in sending email to $author_email on [ns_conn url]"
+    }
+}   
Index: web/openacs/www/links/add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/links/add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/links/add.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,58 @@
+# add.tcl,v 3.0 2000/02/06 03:49:26 ron Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+set_the_usual_form_variables
+
+# page_id (a number)
+
+# security check (BMA, spec'ed by ad)
+validate_integer page_id $page_id
+
+set user_id [ad_get_user_id]
+if {$user_id == 0} {
+    ns_returnredirect /register.tcl?return_url=[ns_urlencode  /links/add.tcl?[export_url_vars page_id]]
+}
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select static_pages.page_id, static_pages.url_stub,  coalesce(page_title, url_stub) as page_title
+from static_pages
+where page_id = $page_id"]
+
+set_variables_after_query
+
+
+ns_return 200 text/html "[ad_header "Add a related link to $page_title" ]
+
+<h2>Add a related link</h2>\n
+to <a href=\"$url_stub\">$page_title</a>
+<hr>
+Add a link that other readers may enjoy.
+<p>
+<form action=add-2.tcl method=post>\n
+<table cellpadding=5>
+  <tr><th align=right>URL:</th><td><input type=text name=url size=50 maxlength=300 value=\"http://\"></td></tr>\n
+
+  <tr><th align=right>Title:</th><td><input type=text name=link_title size=50 maxlenghth=100></td></tr>\n
+  <tr><th align=right valign=top>Description:</th><td><textarea name=link_description cols=50 rows=5 wrap=soft></textarea></td></tr>\n
+  <tr><td></td><td>Would you like to be notified if this link
+becomes invalid?<br>
+Yes
+<input type=radio name=contact_p value=\"t\" checked>
+No
+<input type=radio name=contact_p value=\"f\"><br>
+</td>
+</table>
+<input type=hidden name=page_id value=\"$page_id\">
+<center>
+<input type=submit name=submit value=\"Proceed\">
+</center>
+</form>
+[ad_footer]
+"
+
+
Index: web/openacs/www/links/delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/links/delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/links/delete-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,36 @@
+# delete-2.tcl,v 3.0 2000/02/06 03:49:27 ron Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+
+# page_id, url
+
+validate_integer page_id $page_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select url_stub, coalesce(page_title, url_stub) as page_title
+from static_pages
+where static_pages.page_id = $page_id"]
+set_variables_after_query
+
+set user_id [ad_get_user_id]
+ns_db dml $db "delete from links where page_id=$page_id and url='$QQurl' and user_id = $user_id"
+
+ns_return 200 text/html "[ad_header "Link Deleted"]
+    
+<h2>Link Deleted</h2>
+
+from <a href=\"$url_stub\">$page_title</a>
+<hr>
+<p>
+Return to  <a href=\"$url_stub\">$page_title</a>
+<p>
+[ad_footer]"
+
+
+
+
Index: web/openacs/www/links/delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/links/delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/links/delete.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,49 @@
+# delete.tcl,v 3.0 2000/02/06 03:49:28 ron Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+
+# url, page_id
+
+validate_integer page_id $page_id
+
+set db [ns_db gethandle]
+set user_id [ad_verify_and_get_user_id]
+
+set selection [ns_db 1row $db "select  coalesce(page_title,url_stub) as page_title, url_stub 
+from static_pages
+where page_id = $page_id"]
+set_variables_after_query
+
+set selection [ns_db 1row $db "select url, link_title, link_description from links where page_id = $page_id and url='$QQurl' and user_id=$user_id"]
+set_variables_after_query
+
+ns_return 200 text/html "[ad_header "Verify deletion"]
+    
+<h2>Verify Deletion</h2>
+to <a href=\"$url_stub\">$page_title</a>
+
+<hr>
+Would you like to delete the following link?
+<p>
+<a href=\"$url\">$link_title</a> - $link_description
+<p>
+<table>
+<tr><td>
+<form action=delete-2.tcl method=post>
+[export_form_vars page_id url]
+<center>
+<input type=submit value=\"Delete Link\" name=submit>
+</form>
+</td><td>
+<form action=\"$url_stub\">
+<input type=submit value=\"Cancel\" name=submit>
+</form>
+</td></tr>
+</table>
+</center>
+</form>
+[ad_footer]"
Index: web/openacs/www/links/edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/links/edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/links/edit-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,94 @@
+# edit-2.tcl,v 3.0 2000/02/06 03:49:29 ron Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+
+# page_id, link_description, link_title, url, maybe contact_p, old_url, submit
+
+validate_integer page_id $page_id
+
+set db [ns_db gethandle]
+set user_id [ad_verify_and_get_user_id]
+
+set selection [ns_db 1row $db "select  coalesce(page_title,url_stub) as page_title, url_stub 
+from static_pages
+where page_id = $page_id"]
+set_variables_after_query
+
+# check for valid data
+
+set exception_count 0
+set exception_text ""
+
+if { [info exists url] && [string match $url "http://"] ==  1 } {
+    # the user left the default hint for the url
+    set url ""
+    set QQurl ""
+}
+
+if { ![info exists url] || [empty_string_p $url]  } {
+    incr exception_count
+    append exception_text "<li> Please type in a URL."
+}
+
+if {[info exists url] && ![empty_string_p $url] && ![philg_url_valid_p $url] } {
+    # there is a URL but it doesn't match our REGEXP
+    incr exception_count
+    append exception_text "<li>You URL doesn't have the correct form.  A valid URL would be something like \"http://photo.net/philg/\"."
+}
+
+if { ![info exists link_description] || [empty_string_p $link_description] } {
+    incr exception_count
+    append exception_text "<li> Please type in a description of your link."
+}
+
+if { [info exists link_description] && [string length $link_description] > 4000 } {
+    incr exception_count
+    append exception_text "<li> Please limit your link description to 4000 characters."
+}
+
+if { ![info exists link_title] || [empty_string_p $link_title] } {
+    incr exception_count
+    append exception_text "<li> Please type in a title for your linked page."
+}
+
+
+if { [database_to_tcl_string $db "select count(url) from links where page_id = $page_id and lower(url)='[string tolower $QQurl]' and user_id <> $user_id"] > 0  } {
+    # another user has submitted this link
+    incr exception_count
+    append exception_text "<li> $url was already submitted by another user."
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# data is valid, move on
+
+
+ns_return 200 text/html "[ad_header "Confirm link on <i>$page_title</i>" ]
+
+<h2>Confirm link</h2>
+
+on <a href=\"$url_stub\">$page_title</a>
+<hr>
+
+The following is your link as it would appear on the page <i>$page_title</i>.
+If it looks incorrect, please use the back button on your browser to return and
+correct it.  Otherwise, press \"Proceed\".
+<p>
+<blockquote>
+<a href=\"$url\">$link_title</a>- $link_description
+</blockquote>
+<form action=edit-3.tcl method=post>
+[export_form_vars page_id url_stub link_title link_description url contact_p old_url]
+<center>
+<input type=submit name=submit value=\"Proceed\">
+</center>
+</form>
+[ad_footer]
+"
Index: web/openacs/www/links/edit-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/links/edit-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/links/edit-3.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,113 @@
+# edit-3.tcl,v 3.0 2000/02/06 03:49:30 ron Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+
+# page_id, link_description, page_title, url, summit, old_url
+
+validate_integer page_id $page_id
+
+set db [ns_db gethandle]
+set user_id [ad_verify_and_get_user_id]
+
+# get the page and author information
+
+set selection [ns_db 1row $db "select url_stub, coalesce(page_title, url_stub) as page_title, coalesce(user_email(original_author),'[ad_system_owner]') as author_email
+from static_pages
+where static_pages.page_id = $page_id"]
+set_variables_after_query
+
+if { [regexp -nocase "delete" $submit] } {
+    # user would like to delete
+    set selection [ns_db 1row $db "select url, link_title, link_description from links where page_id = $page_id and url='$QQold_url' and user_id=$user_id"]
+    set_variables_after_query
+    
+    ReturnHeaders
+    ns_write "[ad_header "Verify deletion"]
+    
+<h2>Verify Deletion</h2>
+to <a href=\"$url_stub\">$page_title</a>
+
+<hr>
+Would you like to delete the following link?
+<p>
+<a href=\"$url\">$link_title</a> - $link_description
+<p>
+<form action=delete.tcl method=post>
+[export_form_vars page_id url]
+<center>
+<input type=submit value=\"Delete Link\" name=submit>
+<input type=submit value=\"Cancel\" name=submit>
+</center>
+</form>
+[ad_footer]"
+return
+}
+
+#user would like to edit
+
+
+if [catch {ns_db dml $db "update links
+set url='$QQurl', link_title='$QQlink_title', 
+link_description='$QQlink_description', contact_p='$contact_p'
+where page_id=$page_id 
+and url='$QQold_url'
+and user_id = $user_id"} errmsg] {
+    
+	ad_return_error "Error in updating link" "There 
+was an error in updating your link in the database.
+Here is what the database returned:
+<p>
+<pre>
+$errmsg
+</pre>
+
+
+Don't quit your browser. The database may just be busy.
+You might be able to resubmit your posting five or ten minutes from now.
+"
+return
+}
+
+
+ns_return 200 text/html  "[ad_header "Link edited"]
+
+<h2>Link edited</h2>
+
+on <a href=\"$url_stub\">$page_title</a>
+
+<hr> 
+
+The following link is listed as a related link on the page <a href=\"$url_stub\">$page_title</a> page. 
+<blockquote>
+<A href=\"$url\">$link_title</a> - $link_description
+</blockquote>
+
+[ad_footer]
+"
+
+
+if [ad_parameter EmailEditedLink links] {
+    # send email if necessary
+    set selection [ns_db 1row $db "select first_names || ' ' || last_name as name, email from users where user_id = $user_id"]
+    set_variables_after_query
+
+    ns_db releasehandle $db
+
+    set subject "edited link from $url_stub"
+    set body "$name ($email) edited a link from
+[ad_url]$url_stub
+($page_title)
+
+URL:  $url
+Description:
+
+[wrap_string $link_description]
+"
+    if [ catch { ns_sendmail $author_email $email $subject $body } errmsg] {
+	ns_log Warning "Error in email to $author_email from [ns_conn url]"
+    }
+}
Index: web/openacs/www/links/edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/links/edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/links/edit.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,69 @@
+# edit.tcl,v 3.0 2000/02/06 03:49:32 ron Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+
+# page_id, url
+
+validate_integer page_id $page_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select static_pages.page_id, static_pages.url_stub,  coalesce(page_title, url_stub) as page_title
+from static_pages
+where page_id = $page_id"]
+set_variables_after_query
+
+set selection [ns_db 1row $db "select 
+url, link_title, link_description, contact_p, page_id, user_id as link_user_id
+from links 
+where page_id = $page_id and url='$QQurl'"]
+set_variables_after_query
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $link_user_id != $user_id } {
+    ad_return_error "Unauthorized" "You are not allowed to edit a link you did not enter"
+    return
+}
+
+
+ns_return 200 text/html "[ad_header "Edit related link on $page_title" ]
+
+<h2>Edit related link</h2>
+on <a href=\"$url_stub\">$page_title</a>
+<hr>
+<form action=edit-2.tcl method=post>
+[export_form_vars page_id]
+<input type=hidden name=old_url value=\"$url\">
+<table cellpadding=5>
+  <tr><th align=right>URL:</th><td><input type=text name=url size=50 maxlength=300 [export_form_value url]></td></tr>\n
+  <tr><th align=right>Title:</th><td><input type=text name=link_title size=50 maxlenghth=100 [export_form_value link_title]></td></tr>\n
+  <tr><th align=right valign=top>Description:</th><td><textarea name=link_description cols=50 rows=5 wrap=soft>[philg_quote_double_quotes $link_description]</textarea></td></tr>
+  <tr><td></td><td>Would you like to be notified if this link
+becomes invalid?<br>
+Yes
+[bt_mergepiece "<input type=radio name=contact_p value=\"t\" checked>
+No
+<input type=radio name=contact_p value=\"f\">" $selection]<br>
+</td>
+</table>
+<center>
+<table>
+<tr><td>
+<input type=submit name=submit value=\"Edit Link\">
+</form>
+</td><td>
+<form action=delete.tcl method=post>
+[export_form_vars page_id url]
+<input type=submit name=submit value=\"Delete Link\">
+</form>
+</td></tr>
+</table>
+</center>
+[ad_footer]
+"
+
Index: web/openacs/www/links/expert_link.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/links/expert_link.gif,v
diff -u
Binary files differ
Index: web/openacs/www/links/for-one-page.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/links/for-one-page.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/links/for-one-page.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,92 @@
+# for-one-page.tcl,v 3.0 2000/02/06 03:49:33 ron Exp
+set_the_usual_form_variables
+
+# url_stub
+
+set user_id [ad_get_user_id]
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select page_id, coalesce(page_title, url_stub) as page_title, url_stub 
+from static_pages where url_stub = '$QQurl_stub'
+and accept_links_p = 't'"]
+
+if { $selection == "" } {
+    # this page isn't registered in the database 
+    # or comments are not allowed so we can't
+    # accept links on it or anything
+    
+    ns_log Notice "Someone grabbed $url_stub but we weren't able to offer for-one-page.tcl because this page isn't registered in the db"
+    
+    ReturnHeaders
+    ns_write "[ad_header "Can not accept links."]
+
+<h3> Can not accept links </h3>
+
+for this page.
+
+<hr>
+
+This <a href =\"/\">[ad_system_name]</a> page is not set up to accept links.
+
+[ad_footer]"
+
+return
+}
+
+# there was a link-addable page in the database
+
+set_variables_after_query
+
+ReturnHeaders
+ns_write "[ad_header "Related links for $page_title"]
+
+<h2>Related links</h2>
+
+for <a href=\"$url_stub\">$page_title</a>
+
+<hr>
+<ul>
+"
+
+set selection [ns_db select $db "select links.page_id, links.user_id as poster_user_id, users.first_names || ' ' || users.last_name as user_name, links.link_title, links.link_description, links.url
+from static_pages sp, links, users
+where sp.page_id = links.page_id
+and users.user_id = links.user_id
+and links.page_id = $page_id
+and status = 'live'
+order by posting_time"]
+
+set items ""
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append items "<li><a href=\"$url\">$link_title</a> - $link_description"
+    if { $user_id == $poster_user_id} {
+	# the user added, so let him/her edit it
+	append items "&nbsp;&nbsp;(<A HREF=\"/links/edit.tcl?page_id=$page_id&url=[ns_urlencode $url]\">edit/delete)</a>"
+    } else {
+	# the user did not add it, link to the community_member page
+	append items "&nbsp;&nbsp; <font size=-1>(contributed by <A HREF=\"/shared/community-member.tcl?user_id=$poster_user_id\">$user_name</a>)</font>"
+    }
+    append items "<p>\n"
+}
+
+ns_db releasehandle $db
+
+if [empty_string_p $items] {
+    ns_write "There have been no links so far on this page.\n"
+} else {
+    ns_write "$items"
+}
+
+ns_write "
+
+</ul>
+
+<p>
+<center>
+<a href=\"/links/add.tcl?page_id=$page_id\">Add a link</a>
+</center>
+
+[ad_footer]
+"
+
Index: web/openacs/www/mailing-list/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/mailing-list/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/mailing-list/index.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,83 @@
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+if { $user_id == 0 } {
+    # not a logged-in user 
+    set selection [ns_db select $db "select category_id, category
+from categories 
+where enabled_p = 't'
+order by upper(category)"]
+    set category_items ""
+    while { [ns_db getrow $db $selection] } {
+	set_variables_after_query
+	append category_items "<li><a href=\"one.tcl?[export_url_vars category_id]\">$category</a>\n"
+    }
+    if ![empty_string_p $category_items] {
+	set options $category_items
+    } else {
+	set options "The publisher of [ad_system_name] hasn't set up any interest or content categories."
+    }
+} else {
+    # this person is already logged in, let's just give them a subset of their workspace
+    set selection [ns_db select $db "select c.category, c.category_id, decode(ui.category_id,NULL,NULL,'t') as selected_p
+from categories c, (select * from users_interests where user_id = $user_id) ui
+where c.enabled_p = 't' 
+and c.category_id = ui.category_id(+)"]
+
+    set interest_items ""
+    while { [ns_db getrow $db $selection] } {
+	set_variables_after_query
+	set hyperlinked_category "<a href=\"one.tcl?[export_url_vars category_id]\">$category</a>"
+	if { $selected_p == "t" } {
+	    append interest_items "<input name=category_id type=checkbox value=\"$category_id\" CHECKED> $hyperlinked_category<br>\n"
+	} else {
+	    append interest_items "<input name=category_id type=checkbox value=\"$category_id\"> $hyperlinked_category<br>\n"
+	}
+    }
+    if ![empty_string_p $interest_items] {
+	set options "
+
+<form method=POST action=\"/pvt/interests-update.tcl\">
+<blockquote>
+$interest_items
+<br>
+<br>
+<input type=submit value=\"Update Interests\">
+</blockquote>
+</form>
+"
+    } else {
+	set options "The publisher of [ad_system_name] hasn't set up any interest or content categories."
+    }
+
+}
+
+
+ns_db releasehandle $db 
+
+ns_return 200 text/html "
+[ad_admin_header "Mailing List"]
+
+[ad_decorate_top "
+<h2>Mailing List</h2>
+
+[ad_context_bar_ws_or_index "Mailing List"]
+" [ad_parameter IndexPageDecoration mailing-list]]
+
+<hr>
+
+If you tell us what your interests are, we'll send you periodic
+updates of what's new at [ad_system_name].
+
+<ul>
+
+$options
+
+</ul>
+
+If you're going on vacation for awhile or changing your email address, 
+go to [ad_pvt_home_link] and update our database.
+
+[ad_admin_footer]
+"
Index: web/openacs/www/mailing-list/one.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/mailing-list/one.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/mailing-list/one.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,52 @@
+set_the_usual_form_variables
+
+# category_id
+
+validate_integer category_id $category_id
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select * from categories where category_id = $category_id"]
+
+if { $selection == "" } {
+    ad_return_error "Could not find category" "We couldn't find a category with id $category_id"
+    return
+}
+
+set_variables_after_query
+
+if { $user_id == 0 } {
+    set sign_up_instructions "If you'd like to sign up for this mailing list, please
+<a href=\"/register/index.tcl?return_url=[ns_urlencode "/mailing-list/one.tcl?category_id=$category_id"]\">register as a user of [ad_system_name]</a> (or log in if you're already registered) 
+and then you'll be bounced back to this page."
+} else {
+    # this is a user but we don't know if he or she is already signed up 
+    if { [database_to_tcl_string $db "select count(*) from users_interests where user_id = $user_id and category_id = $category_id"] > 0 } {
+	set sign_up_instructions "You're currently subscribed to this mailing list.  If you're 
+unhappy, you can <a href=\"unsubscribe.tcl?[export_url_vars category_id]\">unsubscribe</a>."
+    } else {
+	set sign_up_instructions "You're not currently subscribed to this mailing list.  You can <a href=\"subscribe.tcl?[export_url_vars category_id]\">subscribe if you wish</a>."
+    }
+}
+
+ns_return 200 text/html "[ad_header "$category"]
+
+<h2>$category</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Mailing List"] "One Category"]
+
+<hr>
+
+Here's what we say to expect if you sign up for the mailing list in
+this category:
+
+<blockquote>
+$mailing_list_info
+</blockquote>
+
+$sign_up_instructions
+
+[ad_footer]
+"
Index: web/openacs/www/mailing-list/set-dont-spam-me-p.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/mailing-list/set-dont-spam-me-p.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/mailing-list/set-dont-spam-me-p.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,24 @@
+set_the_usual_form_variables
+
+# user_id 
+
+validate_integer user_id $user_id
+
+set db [ns_db gethandle]
+
+ns_db dml $db "update users_preferences set dont_spam_me_p = 't' where user_id = $user_id"
+
+ns_return 200 text/html "[ad_header "Preference Recorded"]
+
+<h2>Preference Recorded</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Mailing List"] "Set dont_spam_me_p"]
+
+<hr>
+
+You should not be getting mailing list mail from us anymore.  We
+apologize if our email was intrusive.
+
+[ad_footer]
+"
+
Index: web/openacs/www/mailing-list/subscribe.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/mailing-list/subscribe.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/mailing-list/subscribe.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,19 @@
+ad_maybe_redirect_for_registration
+
+set user_id [ad_get_user_id]
+
+set_the_usual_form_variables
+
+# category_id
+
+validate_integer category_id $category_id
+
+set db [ns_db gethandle]
+
+ns_db dml $db "insert into users_interests
+(user_id, category_id, interest_date)
+values
+($user_id, $category_id, sysdate)"
+
+ns_returnredirect "index.tcl"
+
Index: web/openacs/www/mailing-list/unsubscribe.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/mailing-list/unsubscribe.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/mailing-list/unsubscribe.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,16 @@
+ad_maybe_redirect_for_registration
+
+set user_id [ad_get_user_id]
+
+set_the_usual_form_variables
+
+# category_id
+
+validate_integer category_id $category_id
+
+set db [ns_db gethandle]
+
+ns_db dml $db "delete from users_interests where user_id = $user_id and category_id = $category_id"
+
+ns_returnredirect "index.tcl"
+
Index: web/openacs/www/neighbor/by-about.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/by-about.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/by-about.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,94 @@
+# by-about.tcl,v 3.0 2000/02/06 03:49:34 ron Exp
+set_form_variables 0
+
+# category_id, everything_p 
+
+if ![info exists category_id] {
+    set category_id [ad_parameter DefaultPrimaryCategory neighbor]
+}
+
+validate_integer category_id $category_id
+
+set db [neighbor_db_gethandle]
+set selection [ns_db 0or1row $db "select primary_category, top_title, top_blurb, approval_policy, regional_p, region_type, noun_for_about, decorative_photo, primary_maintainer_id, u.email as maintainer_email
+from n_to_n_primary_categories n, users u 
+where n.primary_maintainer_id = u.user_id
+and n.category_id = $category_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Couldn't find Category $category_id" "There is no category
+#$category_id\" in [neighbor_system_name]"
+    return
+}
+
+set_variables_after_query
+   
+ReturnHeaders
+
+ns_write "[neighbor_header "All $primary_category postings by $noun_for_about]"]
+
+[ad_decorate_top "<h2>All postings by $noun_for_about</h2>
+
+in [neighbor_home_link $category_id $primary_category]
+
+<p>
+
+(actually these are ranked by the \"about\" column in the database, which typically
+contains a $noun_for_about)
+" $decorative_photo]
+
+<hr>
+"
+
+set selection [ns_db select $db "select neighbor_to_neighbor_id, users.email as poster_email, title, about, posted
+from neighbor_to_neighbor, users
+where category_id = $category_id
+and neighbor_to_neighbor.approved_p = 't'
+and neighbor_to_neighbor.poster_user_id = users.user_id 
+order by about, posted desc"]
+
+ns_write "<ul>\n"
+
+# we don't want a slow link loser tying up the database handle
+# so we build a list items variable 
+
+set list_items ""
+set n_reasonable [ad_parameter NReasonablePostings neighbor 100]
+set counter 0
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+    if [empty_string_p $title] {
+	set anchor $about
+    } else {
+	set anchor "$about : $title"
+    }
+    if { (![info exists everything_p] || $everything_p == 0) && ($counter > $n_reasonable) } {
+	append list_items "<p>
+...
+<p>
+(<a href=\"by-about.tcl?everything_p=1&[export_url_vars category_id]\">list entire database</a>)
+"
+	ns_db flush $db 
+	break
+    }
+    append list_items "<li><a href=\"view-one.tcl?neighbor_to_neighbor_id=$neighbor_to_neighbor_id\">$anchor</a> (by $poster_email on $posted)\n"
+
+}
+
+ns_db releasehandle $db 
+
+# we've kicked the database connection back into the pool; now let's
+# stream out all the stuff to the user
+
+ns_write $list_items
+
+ns_write "</ul>
+
+<p>
+
+<IMG  WIDTH=16 HEIGHT=16 SRC=next.xbm><a href=\"post-new.tcl?[export_url_vars category_id]\">Post your own story</a>
+
+[neighbor_footer $maintainer_email]
+"
+
Index: web/openacs/www/neighbor/by-date.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/by-date.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/by-date.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,89 @@
+# by-date.tcl,v 3.0 2000/02/06 03:49:36 ron Exp
+set_form_variables 0
+
+# category_id, everything_p 
+
+if ![info exists category_id] {
+    set category_id [ad_parameter DefaultPrimaryCategory neighbor]
+}
+
+validate_integer category_id $category_id
+
+set db [neighbor_db_gethandle]
+set selection [ns_db 0or1row $db "select primary_category, top_title, top_blurb, approval_policy, regional_p, region_type, noun_for_about, decorative_photo, primary_maintainer_id, u.email as maintainer_email
+from n_to_n_primary_categories n, users u 
+where n.primary_maintainer_id = u.user_id
+and n.category_id = $category_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Couldn't find Category $category_id" "There is no category
+#$category_id\" in [neighbor_system_name]"
+    return
+}
+
+set_variables_after_query
+   
+ReturnHeaders
+
+ns_write "[neighbor_header "All $primary_category postings by date]"]
+
+[ad_decorate_top "<h2>All postings by date</h2>
+
+in [neighbor_home_link $category_id $primary_category]
+" $decorative_photo]
+
+<hr>
+
+<ul>
+
+"
+
+set selection [ns_db select $db "select neighbor_to_neighbor_id, users.email as poster_email, title, about, posted
+from neighbor_to_neighbor, users
+where category_id = $category_id
+and neighbor_to_neighbor.approved_p = 't'
+and neighbor_to_neighbor.poster_user_id = users.user_id 
+order by posted desc"]
+
+# we don't want a slow link loser tying up the database handle
+# so we build a list items variable 
+
+set list_items ""
+set n_reasonable [ad_parameter NReasonablePostings neighbor 100]
+set counter 0
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+    if [empty_string_p $title] {
+	set anchor $about
+    } else {
+	set anchor "$about : $title"
+    }
+    if { (![info exists everything_p] || $everything_p == 0) && ($counter > $n_reasonable) } {
+	append list_items "<p>
+...
+<p>
+(<a href=\"by-date.tcl?everything_p=1&[export_url_vars category_id]\">list entire database</a>)
+"
+	ns_db flush $db 
+	break
+    }
+    append list_items "<li><a href=\"view-one.tcl?neighbor_to_neighbor_id=$neighbor_to_neighbor_id\">$anchor</a> (by $poster_email on $posted)\n"
+}
+
+ns_db releasehandle $db 
+
+# we've kicked the database connection back into the pool; now let's
+# stream out all the stuff to the user
+
+ns_write $list_items
+
+ns_write "</ul>
+
+<p>
+
+<IMG  WIDTH=16 HEIGHT=16 SRC=next.xbm><a href=\"post-new.tcl?[export_url_vars category_id]\">Post your own story</a>
+
+[neighbor_footer $maintainer_email]
+"
+
Index: web/openacs/www/neighbor/comment-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/comment-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/comment-add-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,74 @@
+# comment-add-2.tcl,v 3.0 2000/02/06 03:49:37 ron Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+#check for the user cookie
+
+set user_id [ad_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect /register/index.tcl    
+    return
+}
+
+set_the_usual_form_variables
+
+# neighbor_to_neighbor_id, content, comment_id, html_p
+
+validate_integer neighbor_to_neighbor_id $neighbor_to_neighbor_id
+validate_integer comment_id $comment_id
+
+# check for bad input
+if { ![info exists content] || [empty_string_p $content] } {
+    ad_return_complaint 1 "<li>the comment field was empty"
+    return
+}
+
+set db [ns_db gethandle]
+    
+set selection [ns_db 1row $db "select about, title from neighbor_to_neighbor where neighbor_to_neighbor_id = $neighbor_to_neighbor_id"]
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "[ad_header "Confirm comment on <i>$about : $title</i>" ]
+
+<h2>Confirm comment</h2>
+
+on <A HREF=\"view-one.tcl?[export_url_vars neighbor_to_neighbor_id]\">$about : $title</a>
+
+<hr>
+
+The following is your comment as it would appear on the page <i>$title</i>.
+If it looks incorrect, please use the back button on your browser to return and
+correct it.  Otherwise, press \"Continue\".
+<p>
+<blockquote>"
+
+if { [info exists html_p] && $html_p == "t" } {
+    ns_write "$content
+</blockquote>
+Note: if the story has lost all of its paragraph breaks then you
+probably should have selected \"Plain Text\" rather than HTML.  Use
+your browser's Back button to return to the submission form.
+"
+} else {
+    ns_write "[util_convert_plaintext_to_html $content]
+</blockquote>
+
+Note: if the story has a bunch of visible HTML tags then you probably
+should have selected \"HTML\" rather than \"Plain Text\".  Use your
+browser's Back button to return to the submission form.  " 
+}
+
+
+ns_write "<form action=comment-add-3.tcl method=post>
+<center>
+<input type=submit name=submit value=\"Confirm\">
+</center>
+[export_entire_form]
+</form>
+[ad_footer]
+"
Index: web/openacs/www/neighbor/comment-add-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/comment-add-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/comment-add-3.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,94 @@
+# comment-add-3.tcl,v 3.0 2000/02/06 03:49:38 ron Exp
+#
+# comment-add-3.tcl
+#
+# by philg@mit.edu many years ago 
+#
+# actually inserts a comment into the general_comments table
+#
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+
+set_the_usual_form_variables
+
+# neighbor_to_neighbor_id, content, comment_id, content, html_p
+
+validate_integer neighbor_to_neighbor_id $neighbor_to_neighbor_id
+validate_integer comment_id $comment_id
+
+# check for bad input
+if { ![info exists content] || [empty_string_p $content] } {
+    ad_return_complaint 1 "<li>the comment field was empty"
+    return
+}
+
+# user has input something, so continue on
+
+# assign necessary data for insert
+
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    ns_returnredirect /register/
+    return
+}
+
+set originating_ip [ns_conn peeraddr]
+
+if { [ad_parameter CommentApprovalPolicy neighbor] == "open"} {
+    set approved_p "t"
+} else {
+    set approved_p "f"
+}
+
+set db [ns_db gethandle]
+
+set one_line_item_desc [database_to_tcl_string $db "select about || ' : ' || title from neighbor_to_neighbor where neighbor_to_neighbor_id = $neighbor_to_neighbor_id"]
+
+if [catch { ad_general_comment_add $db $comment_id "neighbor_to_neighbor" $neighbor_to_neighbor_id $one_line_item_desc $content $user_id $originating_ip $approved_p $html_p } errmsg] {
+    # Oracle choked on the insert
+     if { [database_to_tcl_string $db "select count(*) from general_comments where comment_id = $comment_id"] == 0 } {
+	# there was an error with comment insert other than a duplication
+	ad_return_error "Error in inserting comment" "We were unable to insert your comment in the database.  Here is the error that was returned:
+<p>
+<blockquote>
+<pre>
+$errmsg
+</pre>
+</blockquote>"
+        return
+     }
+}
+
+# either we were successful in doing the insert or the user hit submit
+# twice and we don't really care
+
+if { $approved_p == "t" } {
+    # user will see it immediately
+    ns_returnredirect "view-one.tcl?[export_url_vars neighbor_to_neighbor_id]"
+} else {
+    set selection [ns_db 1row $db "select about,title,n.category_id,u.email as maintainer_email
+from neighbor_to_neighbor n, n_to_n_primary_categories pc, users u 
+where neighbor_to_neighbor_id = $neighbor_to_neighbor_id
+and n.category_id = pc.category_id
+and pc.primary_maintainer_id = u.user_id"]
+    set_variables_after_query
+
+    ns_return 200 text/html "[neighbor_header "Thank You"]
+
+<h2>Thank you</h2>
+
+for your comment on <A HREF=\"view-one.tcl?[export_url_vars neighbor_to_neighbor_id]\">$about : $title</a>
+
+<hr>
+
+You will find your comment on the site as soon as it has been approved
+by the moderator.
+
+[neighbor_footer $maintainer_email]
+"
+}
Index: web/openacs/www/neighbor/comment-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/comment-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/comment-add.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,65 @@
+# comment-add.tcl,v 3.0 2000/02/06 03:49:39 ron Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_form_variables
+
+# neighbor_to_neighbor_id
+
+validate_integer neighbor_to_neighbor_id $neighbor_to_neighbor_id
+
+#check for the user cookie
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    ns_returnredirect /register/index.tcl?return_url=[ns_urlencode [ns_conn url]]?[export_url_vars neighbor_to_neighbor_id]
+    return
+}
+
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select about, title, body, html_p
+from neighbor_to_neighbor
+where neighbor_to_neighbor_id = $neighbor_to_neighbor_id"]
+
+if { $selection == "" } {
+    ad_return_error "Can't find the neighbor-to-neighbor item" "Can't find neighbor-to-neighbor #$neighbor_to_neighbor_id"
+    return
+}
+
+set_variables_after_query
+
+# take care of cases with missing data
+
+ReturnHeaders
+
+ns_write "[ad_header "Add a comment to $about : $title" ]
+
+<h2>Add a comment</h2>
+
+to <A HREF=\"view-one.tcl?[export_url_vars neighbor_to_neighbor_id]\">$about : $title</a>
+<hr>
+
+<blockquote>
+[util_maybe_convert_to_html $body $html_p]
+</blockquote>
+<form action=comment-add-2.tcl method=post>
+What comment  would you like to add to this item?<br>
+<textarea name=content cols=50 rows=5 wrap=soft>
+</textarea><br>
+Text above is
+<select name=html_p><option value=f>Plain Text<option value=t>HTML</select>
+<br>
+<center>
+<input type=submit name=submit value=\"Proceed\">
+</center>
+[export_form_vars neighbor_to_neighbor_id]
+<input type=hidden name=comment_id value=\"[database_to_tcl_string $db "select general_comment_id_sequence.nextval from dual"]\">
+</form>
+
+
+[ad_footer]
+"
Index: web/openacs/www/neighbor/comment-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/comment-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/comment-edit-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,74 @@
+# comment-edit-2.tcl,v 3.0 2000/02/06 03:49:41 ron Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_form_variables
+
+# comment_id
+
+validate_integer comment_id $comment_id
+
+# check for bad input
+if  {![info exists content] || [empty_string_p $content] } { 
+    ad_return_complaint 1 "<li>the comment field was empty"
+    return
+}
+
+
+set db [ns_db gethandle]
+set user_id [ad_verify_and_get_user_id]
+
+set selection [ns_db 1row $db "select about || ' : ' || title as title, neighbor_to_neighbor_id, general_comments.user_id as comment_user_id
+from neighbor_to_neighbor n, general_comments
+where comment_id = $comment_id
+and n.neighbor_to_neighbor_id = general_comments.on_what_id"]
+set_variables_after_query
+
+# check to see if ther user was the orginal poster
+if {$user_id != $comment_user_id} {
+    ad_return_complaint 1 "<li>You can not edit this entry because you did not post it"
+    return
+}
+
+ReturnHeaders
+
+ns_write "[ad_header "Verify comment on <i>$title</i>" ]
+
+<h2>Verify comment</h2>
+on <A HREF=\"view-one.tcl?[export_url_vars neighbor_to_neighbor_id]\">$title</A>
+<hr>
+
+The following is your comment as it would appear on the story
+<i>$title</i>.  If it looks incorrect, please use the back button on
+your browser to return and correct it.  Otherwise, press \"Continue\".
+<p>
+
+<blockquote>"
+
+
+if { [info exists html_p] && $html_p == "t" } {
+    ns_write "$content
+</blockquote>
+Note: if the story has lost all of its paragraph breaks then you
+probably should have selected \"Plain Text\" rather than HTML.  Use
+your browser's Back button to return to the submission form.
+"
+} else {
+    ns_write "[util_convert_plaintext_to_html $content]
+</blockquote>
+
+Note: if the story has a bunch of visible HTML tags then you probably
+should have selected \"HTML\" rather than \"Plain Text\".  Use your
+browser's Back button to return to the submission form.  " 
+}
+
+ns_write "<center>
+<form action=comment-edit-3.tcl method=post>
+<input type=submit name=submit value=\"Continue\">
+[export_form_vars comment_id content html_p]
+</center>
+</form>
+[ad_footer]
+"
Index: web/openacs/www/neighbor/comment-edit-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/comment-edit-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/comment-edit-3.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,58 @@
+# comment-edit-3.tcl,v 3.0 2000/02/06 03:49:42 ron Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+
+# comment_id, content, html_p
+
+validate_integer comment_id $comment_id
+
+# check for bad input
+if  {![info exists content] || [empty_string_p $content] } { 
+    ad_return_complaint 1 "<li>the comment field was empty"
+    return
+}
+
+# user has input something, so continue on
+
+set db [ns_db gethandle]
+set user_id [ad_verify_and_get_user_id]
+
+set selection [ns_db 1row $db "select neighbor_to_neighbor_id, general_comments.user_id as comment_user_id
+from neighbor_to_neighbor, general_comments
+where comment_id = $comment_id
+and neighbor_to_neighbor_id = on_what_id"]
+set_variables_after_query
+
+# check to see if ther user was the orginal poster
+if {$user_id != $comment_user_id} {
+    ad_return_complaint 1 "<li>You can not edit this entry because you did not post it"
+    return
+}
+
+if [catch { ns_db dml $db "begin transaction" 
+            # insert into the audit table
+            ns_db dml $db "insert into general_comments_audit
+(comment_id, user_id, ip_address, audit_entry_time, modified_date, content)
+select comment_id, user_id, '[ns_conn peeraddr]', sysdate, modified_date, content from general_comments where comment_id = $comment_id"
+            ns_ora clob_dml $db "update general_comments
+set content = empty_clob(), html_p = '$html_p'
+where comment_id = $comment_id returning content into :1" "$content"
+            ns_db dml $db "end transaction" } errmsg] {
+
+	# there was some other error with the comment update
+	ad_return_error "Error updating comment" "We couldn't update your comment. Here is what the database returned:
+<p>
+<blockquote>
+<pre>
+$errmsg
+</pre>
+</blockquote>
+"
+return
+}
+
+ns_returnredirect "view-one.tcl?[export_url_vars neighbor_to_neighbor_id]"
Index: web/openacs/www/neighbor/comment-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/comment-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/comment-edit.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,58 @@
+# comment-edit.tcl,v 3.0 2000/02/06 03:49:43 ron Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_form_variables
+
+# comment_id
+
+validate_integer comment_id $comment_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select comment_id, content, general_comments.html_p as comment_html_p, user_id as comment_user_id, body, neighbor_to_neighbor_id, about || ' : ' || title as neighbor_title, n.html_p as neighbor_html_p
+from general_comments, neighbor_to_neighbor n
+where comment_id = $comment_id
+and n.neighbor_to_neighbor_id = general_comments.on_what_id"]
+
+set_variables_after_query
+
+#check for the user cookie
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+    ns_returnredirect /register/index.tcl?return_url=[ns_urlencode [ns_conn url]]?comment_id=$comment_id 
+}
+
+# check to see if ther user was the orginal poster
+if {$user_id != $comment_user_id} {
+    ad_return_complaint 1 "<li>You can not edit this entry because you did not post it"
+    return
+}
+ReturnHeaders
+
+ns_write "[ad_header "Edit comment on $neighbor_title" ]
+
+<h2>Edit comment </h2>
+on <A HREF=\"view-one.tcl?[export_url_vars neighbor_to_neighbor_id]\">$neighbor_title</a>
+<hr>
+
+<blockquote>
+[util_maybe_convert_to_html $body $neighbor_html_p]
+<form action=comment-edit-2.tcl method=post>
+Edit your comment on the above item.<br>
+<textarea name=content cols=50 rows=5 wrap=soft>[philg_quote_double_quotes $content]</textarea><br>
+Text above is
+<select name=html_p>
+ [ad_generic_optionlist {"Plain Text" "HTML"} {"f" "t"} $comment_html_p]
+</select>
+<center>
+<input type=submit name=submit value=\"Proceed\">
+</center>
+[export_form_vars comment_id]
+</form>
+</blockquote>
+[ad_footer]
+"
Index: web/openacs/www/neighbor/edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/edit-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,44 @@
+# edit-2.tcl,v 3.0 2000/02/06 03:49:45 ron Exp
+set_form_variables
+
+# neighbor_to_neighbor_id
+
+validate_integer neighbor_to_neighbor_id $neighbor_to_neighbor_id
+
+set db [neighbor_db_gethandle]
+
+set selection [ns_db 0or1row $db "select neighbor_to_neighbor.*, users.email as poster_email, users.first_names || ' ' || users.last_name as poster_name
+from neighbor_to_neighbor, users
+where neighbor_to_neighbor_id = $neighbor_to_neighbor_id
+and neighbor_to_neighbor.poster_user_id = users.user_id"]
+if { $selection == "" } {
+    ns_return 200 text/html [neighbor_error_page 1 "<li>Could not find a posting with an id of $neighbor_to_neighbor_id"]
+    return
+}
+
+# found the row
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "[neighbor_header "$about : $one_line"]
+
+<h2>$about : $one_line</h2>
+
+posted by $poster_email ($poster_name) on $posted
+
+<hr>
+
+<h3>Story</h3>
+
+$full_description_text
+<form action=edit-3.tcl method=post>
+<center>
+[export_form_vars neighbor_to_neighbor_id]
+<input type=submit name=edit_or_delete value=\"Edit\">
+<input type=submit name=edit_or_delete value=\"Delete\">
+</center>
+</form>
+
+[neighbor_footer]
+"
Index: web/openacs/www/neighbor/edit-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/edit-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/edit-3.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,99 @@
+# edit-3.tcl,v 3.1 2000/02/29 04:39:04 jsc Exp
+set_the_usual_form_variables
+
+# neighbor_to_neighbor_id,  edit_or_delete
+
+validate_integer neighbor_to_neighbor_id $neighbor_to_neighbor_id
+
+set db [neighbor_db_gethandle]
+
+set user_id [ad_get_user_id]
+
+set selection [ns_db 0or1row $db "select * from neighbor_to_neighbor where neighbor_to_neighbor_id = $neighbor_to_neighbor_id"]
+if { $selection == "" } {
+    ns_return 200 text/html [neighbor_error_page 1 "<li>Could not find a posting with an id of $neighbor_to_neighbor_id"]
+    return
+}
+
+# found the row
+set_variables_after_query
+
+
+if { $user_id != $poster_user_id } {
+    # not the author
+    ns_return 200 text/html "[neighbor_header "Permission denied"]
+
+<h2>Permission denied</h2>
+
+to change posting $neighbor_to_neighbor_id ($about : $one_line) 
+
+<P>
+
+in <a href=index.tcl>[neighbor_system_name]</a>
+
+<hr>
+
+You can not edit or delete this entry because you did not post it.
+
+[neighbor_footer]
+"
+   return 
+}
+
+if { [info exists edit_or_delete] && $edit_or_delete == "Delete" } {
+    # user explicitly requested a deletion
+    # let's put the row into an audit table and delete it from
+    # the live stuff
+    ns_db dml $db "begin transaction"
+    ns_db dml $db "insert into neighbor_to_neighbor_audit (neighbor_to_neighbor_id, audit_entry_time, domain, poster_user_id,  posted, primary_category, subcategory_1, about,	one_line, full_description_text)
+select neighbor_to_neighbor_id, sysdate, domain, poster_user_id, posted, primary_category, subcategory_1, about,	one_line, full_description_text
+from neighbor_to_neighbor
+where neighbor_to_neighbor_id = $neighbor_to_neighbor_id"
+    ns_db dml $db "delete from neighbor_to_neighbor where neighbor_to_neighbor_id = $neighbor_to_neighbor_id"
+    ns_db dml $db "end transaction"
+    ns_return 200 text/html "[neighbor_header "Posting Deleted"]
+
+<h2>Posting Deleted</h2>
+
+from <a href=index.tcl>[neighbor_system_name]</a>
+
+
+<hr>
+
+There is not much more to say.
+
+[neighbor_footer]
+"
+
+} else {
+    # we're doing an edit
+    ns_return 200 text/html "[neighbor_header "Edit Posting $neighbor_to_neighbor_id"]
+
+<h2>Edit Posting $neighbor_to_neighbor_id</h2>
+
+<hr>
+
+<form action=edit-4.tcl method=GET>
+<input type=hidden name=neighbor_to_neighbor_id value=\"$neighbor_to_neighbor_id\">
+
+<h3>Summary</h3>
+
+$about : <input type=text name=one_line_from_form size=60 value=\"[philg_quote_double_quotes $one_line]\">
+
+<h3>Full Story</h3>
+
+<textarea name=full_description_text_from_form rows=13 cols=75 wrap=soft>
+$full_description_text
+</textarea>
+
+
+
+<center>
+<input type=submit value=\"Edit\">
+</center>
+</form>
+
+[neighbor_footer]
+"
+}
+
Index: web/openacs/www/neighbor/edit-4.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/edit-4.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/edit-4.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,77 @@
+# edit-4.tcl,v 3.0 2000/02/06 03:49:47 ron Exp
+set_the_usual_form_variables
+
+# neighbor_to_neighbor_id, edit_or_delete
+# one_line_from_form, full_description_text_from_form
+
+validate_integer neighbor_to_neighbor_id $neighbor_to_neighbor_id
+
+set db [neighbor_db_gethandle]
+
+set selection [ns_db 0or1row $db "select * from neighbor_to_neighbor where neighbor_to_neighbor_id = $neighbor_to_neighbor_id"]
+if { $selection == "" } {
+    ns_return 200 text/html [neighbor_error_page 1 "<li>Could not find a posting with an id of $neighbor_to_neighbor_id"]
+    return
+}
+
+set user_id [ad_get_user_id]
+# found the row
+set_variables_after_query
+
+if { $user_id != $poster_user_id } {
+    # not the author
+    ns_return 200 text/html "[neighbor_header "Permission denied"]
+
+<h2>Permission denied</h2>
+
+to change posting $neighbor_to_neighbor_id ($about : $one_line) 
+
+<P>
+
+in <a href=index.tcl>[neighbor_system_name]</a>
+
+<hr>
+
+You can not edit or delete this entry because you did not post it.
+
+[neighbor_footer]
+"
+   return 
+}
+
+# OK, we're authorized, let's do the DML
+
+# first thing to do is decide whether or not to write to audit table
+
+if { [expr abs([string length full_description_text_from_form] - [string length full_description_text])] > 20 } {
+    ns_db dml $db "insert into neighbor_to_neighbor_audit (neighbor_to_neighbor_id, audit_entry_time, domain, poster_user_id,  posted, primary_category, subcategory_1, about,	one_line, full_description_text)
+select neighbor_to_neighbor_id, sysdate, domain, poster_user_id, posted, primary_category, subcategory_1, about, one_line, full_description_text
+from neighbor_to_neighbor
+where neighbor_to_neighbor_id = $neighbor_to_neighbor_id"
+}
+
+# do the actual update
+
+# let's make this work with strings > 4000 chars
+
+ns_ora clob_dml $db "update neighbor_to_neighbor
+set one_line = '$QQone_line_from_form',
+full_description_text = empty_clob(),
+poster_user_id = $user_id
+where neighbor_to_neighbor_id = $neighbor_to_neighbor_id
+returning full_description_text into :one" $full_description_text_from_form
+
+ns_return 200 text/html "[neighbor_header "Posting Updated"]
+
+<h2>Posting Updated</h2>
+
+in <a href=index.tcl>[neighbor_system_name]</a>
+
+<hr>
+
+There isn't much more to say.  
+<a href=\"view-one.tcl?neighbor_to_neighbor_id=$neighbor_to_neighbor_id\">Click here</a>
+if you want to see how the edited posting will look to the public.
+
+[neighbor_footer]
+"
Index: web/openacs/www/neighbor/edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/edit.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,38 @@
+# edit.tcl,v 3.0 2000/02/06 03:49:49 ron Exp
+set user_id [ad_get_user_id]
+
+if {$user_id == 0} {
+   ns_returnredirect /register.tcl?return_url=[ns_urlencode "[ns_conn url]"]
+   return
+}
+
+set db [neighbor_db_gethandle]
+
+ReturnHeaders
+
+ns_write "[neighbor_header "Your postings"]
+
+<h2>Your postings</h2>
+
+in <a href=index.tcl>[neighbor_system_name]</a>
+
+<hr>
+
+<ul>
+"
+
+set selection [ns_db select $db "select neighbor_to_neighbor_id, about, one_line, posted
+from neighbor_to_neighbor
+where poster_user_id = $user_id
+order by posted desc"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    ns_write "<li><a href=\"edit-2.tcl?neighbor_to_neighbor_id=$neighbor_to_neighbor_id\">$about : $one_line</a> (posted $posted)\n"
+}
+
+ns_write "</ul>
+
+
+[neighbor_footer]
+"
Index: web/openacs/www/neighbor/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/index.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,41 @@
+# index.tcl,v 3.0 2000/02/06 03:49:50 ron Exp
+if { [ad_parameter OnlyOnePrimaryCategoryP neighbor 0] && ![empty_string_p [ad_parameter DefaultPrimaryCategory neighbor]] } {
+    # this is only one category; send them straight there
+    ns_returnredirect "opc.tcl?category_id=[ad_parameter DefaultPrimaryCategory neighbor]"
+    return
+}
+
+set db [neighbor_db_gethandle]
+
+ReturnHeaders
+
+ns_write "[neighbor_header [neighbor_system_name]]
+
+<h2>Neighbor to Neighbor</h2>
+
+in [ad_site_home_link] 
+
+<hr>
+
+<ul>
+"
+
+set selection [ns_db select $db "select category_id, primary_category 
+from n_to_n_primary_categories
+where (active_p = 't' or active_p is null)
+order by upper(primary_category)"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    ns_write "<li><a href=\"opc.tcl?category_id=$category_id\">$primary_category</a>\n"
+}
+
+
+ns_write "
+</ul>
+
+[neighbor_footer]
+"
+
+
+
Index: web/openacs/www/neighbor/next.xbm
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/next.xbm,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/next.xbm	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,6 @@
+#define next.xbm_width 16
+#define next.xbm_height 16
+static char next.xbm_bits[] = {
+   0x00, 0x00, 0x00, 0x00, 0x02, 0x03, 0x06, 0x07, 0x0e, 0x0f, 0x1e, 0x1f,
+   0x3e, 0x3f, 0xfe, 0x7f, 0xfe, 0x7f, 0x3e, 0x3f, 0x1e, 0x1f, 0x0e, 0x0f,
+   0x06, 0x07, 0x02, 0x03, 0x00, 0x00, 0x00, 0x00};
Index: web/openacs/www/neighbor/one-category.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/one-category.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/one-category.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,29 @@
+# one-category.tcl,v 3.0 2000/02/06 03:49:51 ron Exp
+# this is a legacy file purely for photo.net; it redirects people 
+# over to the relevant page in /one-subcategory.tcl (in case there were
+# bookmarks)
+
+set_the_usual_form_variables
+
+# subcategory_1
+
+# we know that it is photographic
+set category_id 0
+
+# we now need to know which subcat
+case $subcategory_1  {
+    "Camera Shops" { set subcategory_id 2 } 
+    "Individuals selling cameras on the Internet" { set subcategory_id 3 } 
+    "Workshops" { set subcategory_id 8 } 
+    "Wedding Photographers" { set subcategory_id 7 } 
+    "Product and/or Manufacturer" { set subcategory_id 6 } 
+    "Processing Laboratories" { set subcategory_id 5 } 
+    "Camera Repair" { set subcategory_id 1 } 
+    "Miscellaneous" { set subcategory_id 7 } 
+}
+
+if [info exists subcategory_id] {
+    ns_returnredirect "one-subcategory.tcl?category_id=$category_id&id=$subcategory_id"
+} else {
+    ns_returnredirect /neighbor/opc.tcl?category_id=0
+}
Index: web/openacs/www/neighbor/one-subcategory.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/one-subcategory.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/one-subcategory.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,104 @@
+# one-subcategory.tcl,v 3.0 2000/02/06 03:49:52 ron Exp
+set_form_variables
+
+# id 
+
+validate_integer id $id
+
+set db [ns_db gethandle]
+set selection [ns_db 0or1row $db "select n.category_id, n.noun_for_about, n.primary_category, n.primary_maintainer_id, n.decorative_photo, 
+sc.subcategory_id, sc.subcategory_1, sc.decorative_photo as sub_photo, sc.publisher_hint,
+u.email as maintainer_email
+from n_to_n_subcategories sc, n_to_n_primary_categories n, users u 
+where sc.category_id = n.category_id
+and n.primary_maintainer_id = u.user_id
+and sc.subcategory_id = $id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Couldn't find Subcategory $id" "There is no subcategory
+\"$id\" in [neighbor_system_name]"
+    return
+}
+
+set_variables_after_query
+
+ReturnHeaders
+
+set the_title "$subcategory_1 Postings"
+set headline_and_uplink "\n<h2>$subcategory_1 Postings</h2>\n\nin [neighbor_home_link $category_id $primary_category]\n"
+
+ns_write "[neighbor_header $the_title]\n"
+
+if [empty_string_p $decorative_photo] {
+    ns_write $headline_and_uplink
+} else {
+    ns_write "<table><tr><td>$decorative_photo</td><td>$headline_and_uplink</td></tr></table>\n"
+}
+
+if { [info exists by_date_p] && $by_date_p == "t" } {
+    ns_write "<p>(also available <a href=\"one-subcategory.tcl?id=$id&by_date_p=f\">sorted by $noun_for_about</a>)"
+    set order_by "order by posted desc"
+} else {
+    ns_write "<p>(also available <a href=\"one-subcategory.tcl?id=$id&by_date_p=t\">sorted by date</a>)"
+    set order_by "order by sort_key, posted desc"
+}
+
+ns_write "
+<hr>
+
+$publisher_hint
+
+$sub_photo
+
+<ul>
+
+"
+
+set selection [ns_db select $db "select neighbor_to_neighbor_id, title, posted, about, upper(about) as sort_key, users.user_id, users.first_names || ' ' || users.last_name as poster_name
+from neighbor_to_neighbor, users
+where subcategory_id = $id
+and (expires is null or expires::date > sysdate()::date)
+and neighbor_to_neighbor.poster_user_id = users.user_id
+and neighbor_to_neighbor.approved_p = 't'
+$order_by"]
+
+# these can be extensive and we don't want someone on a slow link
+# tying up the database connection, so we build up a big string 
+
+set moby_string ""
+set last_about ""
+set first_pass 1
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { $sort_key != $last_about } {
+	if { $first_pass != 1 } {
+	    # not first time through, separate
+	    append moby_string "<p>\n"
+	}
+	set first_pass 0
+	set last_about $sort_key
+    }
+    if [empty_string_p $title] {
+	set anchor $about
+    } else {
+	set anchor "$about : $title"
+    }
+    append moby_string "<li><a href=\"view-one.tcl?neighbor_to_neighbor_id=$neighbor_to_neighbor_id\">$anchor</a>
+ -- $poster_name, [util_AnsiDatetoPrettyDate $posted]"
+}
+
+ns_db releasehandle $db
+
+# we've released the db handle; now a slow modem user can't hold up the server
+
+ns_write $moby_string
+
+ns_write "</ul>
+
+<p>
+
+Please contribute to making this a useful service by
+<a href=\"post-new.tcl?[export_url_vars category_id]\">posting your own story</a>.
+
+[neighbor_footer]
+"
Index: web/openacs/www/neighbor/opc.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/opc.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/opc.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,125 @@
+# opc.tcl,v 3.0.4.1 2000/03/16 18:19:32 bcameros Exp
+# opc.tcl stands for "one primary category"
+
+set_the_usual_form_variables
+
+# category_id
+
+validate_integer category_id $category_id
+
+set db [neighbor_db_gethandle]
+
+set selection [ns_db 0or1row $db "select primary_category, top_title, top_blurb, approval_policy, regional_p, region_type, noun_for_about, decorative_photo, primary_maintainer_id, u.first_names || ' ' || u.last_name as maintainer_name 
+from n_to_n_primary_categories n, users u 
+where n.primary_maintainer_id = u.user_id
+and n.category_id = $category_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Couldn't find Category $category_id" "There is no category
+#$category_id\" in [neighbor_system_name]"
+    return
+}
+
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "[neighbor_header "[neighbor_system_name]: $primary_category"]\n"
+
+if [empty_string_p $top_title] {
+    set top_title "$primary_category Postings"
+}
+
+
+if [empty_string_p $decorative_photo] {
+    # write a plain headline
+    ns_write "<h2>$top_title</h2>
+
+in [neighbor_uplink]
+"
+} else {
+    # write table including the picture
+    ns_write "
+<table>
+<tr>
+<td>
+$decorative_photo
+<td>
+<h2>$top_title</h2>
+
+in [neighbor_uplink]
+
+</tr>
+</table>
+"
+}
+
+ns_write "
+<hr>
+
+$top_blurb
+
+<ul>
+
+"
+
+set count 0
+
+# let's make sure that we aren't going to eval an unsafe express
+validate_integer "category_id" $category_id
+foreach sublist [util_memoize "neighbor_summary_items_approved $category_id" 900] {
+    set id [lindex $sublist 0]
+    set name [lindex $sublist 1]
+    set n_items [lindex $sublist 2]
+    incr count
+    ns_write "<li><a href=\"one-subcategory.tcl?id=$id\">$name</a> ($n_items)\n"
+}
+
+ns_write "
+
+</ul>
+
+You can also look at all the postings
+<a href=\"by-about.tcl?[export_url_vars category_id]\">by $noun_for_about</a>
+or 
+<a href=\"by-date.tcl?[export_url_vars category_id]\">by date</a>
+
+<p>
+
+"
+
+if [ad_parameter ProvideLocalSearchP neighbor 1] {
+    if [ad_parameter UseContext neighbor 0] {
+	set form_target "search-ctx.tcl"
+    } else {
+	# we'll just use our pseudo_contains sequential search thing
+	set form_target "search.tcl"
+    }
+    ns_write "
+<form action=\"$form_target\" method=GET>
+
+or search by keyword:  <input type=text name=query_string size=25>
+
+<input type=submit value=\"Submit\">
+
+<p>
+
+(this searches through the full text of all the postings, plus the
+names and email addresses of the posters)
+
+</form>
+
+"
+}
+
+if { $approval_policy != "closed" } {
+    ns_write "Help the community by <a href=\"post-new.tcl?category_id=$category_id\">posting a new story</a>.\n"
+}
+
+ns_write "
+
+[neighbor_footer]
+
+"
+
+
Index: web/openacs/www/neighbor/post-new-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/post-new-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/post-new-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,94 @@
+# post-new-2.tcl,v 3.0 2000/02/06 03:49:54 ron Exp
+set_the_usual_form_variables
+
+# subcategory_id
+
+validate_integer subcategory_id $subcategory_id
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+#check for the user cookie
+
+set user_id [ad_get_user_id]
+
+if {$user_id == 0} {
+   ns_returnredirect /register.tcl?return_url=[ns_urlencode "[ns_conn url]"]
+   return
+}
+
+# we know who this is
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select n.category_id, n.noun_for_about, primary_category, subcategory_1, pre_post_blurb, primary_maintainer_id, u.email as maintainer_email
+from n_to_n_subcategories sc, n_to_n_primary_categories n, users u 
+where sc.category_id = n.category_id
+and n.primary_maintainer_id = u.user_id
+and sc.subcategory_id = $subcategory_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Couldn't find Subcategory $subcategory_id" "There is no subcategory
+$subcategory_id\" in [neighbor_system_name]"
+    return
+}
+
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "[neighbor_header "Post Step 2"]
+
+<h2>Step 2</h2>
+
+of posting a new $subcategory_1  story in [neighbor_home_link $category_id $primary_category]
+
+<hr>
+
+In order to keep the site easily browsable, if you're telling a story
+about the same $noun_for_about as a previous poster,
+then it would be good if you click on the name here rather than typing
+it again (because you'd probably spell it differently).
+
+<ul>
+
+"
+
+set selection [ns_db select $db "select about
+from neighbor_to_neighbor
+where subcategory_id = $subcategory_id
+and about is not null
+group by about
+order by upper(about)"]
+
+set counter 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    incr counter
+    ns_write "<li><a href=\"post-new-3.tcl?subcategory_id=$subcategory_id&about=[ns_urlencode $about]\">$about</a>\n"
+}
+
+if { $counter == 0 } {
+    ns_write "no existing items found"
+}
+
+ns_write "
+</ul>
+
+<P>
+
+Just click on one of the above names if you recognize it.  If not,
+e.g., if you are telling a story about a new $noun_for_about, then 
+enter the name here:
+
+<form method=post action=post-new-3.tcl>
+[export_form_vars subcategory_id]
+<input type=text name=about size=20>
+<input type=submit value=\"Add a new About Value to the Database\">
+</form>
+"
+
+ns_write "[neighbor_footer $maintainer_email]"
+
+
Index: web/openacs/www/neighbor/post-new-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/post-new-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/post-new-3.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,100 @@
+# post-new-3.tcl,v 3.0 2000/02/06 03:49:55 ron Exp
+set_the_usual_form_variables
+
+# subcategory_id, about
+
+validate_integer subcategory_id $subcategory_id
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+#check for the user cookie
+
+set user_id [ad_get_user_id]
+
+if {$user_id == 0} {
+   ns_returnredirect /register.tcl?return_url=[ns_urlencode "[ns_conn url]"]
+   return
+}
+
+# we know who this is
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select n.category_id, n.noun_for_about, primary_category, subcategory_1, pre_post_blurb, primary_maintainer_id, u.email as maintainer_email
+from n_to_n_subcategories sc, n_to_n_primary_categories n, users u 
+where sc.category_id = n.category_id
+and n.primary_maintainer_id = u.user_id
+and sc.subcategory_id = $subcategory_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Couldn't find Subcategory $subcategory_id" "There is no subcategory
+$subcategory_id\" in [neighbor_system_name]"
+    return
+}
+
+set_variables_after_query
+
+set exception_text ""
+set exception_count 0
+
+if { ![info exists about] || $about == "" } {
+    append exception_text "<li>You didn't choose an about field for your posting. (or your browser dropped it)\n"
+    incr exception_count
+}
+
+if { $exception_count != 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+ReturnHeaders
+
+ns_write "[neighbor_header "Post Step 3"]
+
+<h2>Step 3</h2>
+
+of posting a new $subcategory_1 story in [neighbor_home_link $category_id $primary_category]
+
+<hr>
+
+<form method=post action=post-new-4.tcl>
+[export_form_vars subcategory_id about]
+
+<p>
+
+Give us a one-line summary of your posting, something that will let
+someone know whether or not they want to read the full story.  Note
+that this will appear with the about field (\"$about\") in front of
+it, so you don't have to repeat the name of the merchant, camera, etc.
+
+<p>
+
+$about : <input type=text name=title size=50>
+
+<p>
+
+Give us the full story, taking as much space as you need.
+
+<p>
+
+<textarea name=body rows=8 cols=70 wrap=soft>
+
+</textarea>
+
+<br>
+
+The above story is in <select name=html_p><option value=f>Plain Text<option value=t>HTML</select>
+
+
+<p>
+
+
+<center>
+<input type=submit value=\"Preview Story\">
+</center>
+
+
+[neighbor_footer]
+"
Index: web/openacs/www/neighbor/post-new-4.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/post-new-4.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/post-new-4.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,137 @@
+# post-new-4.tcl,v 3.0 2000/02/06 03:49:56 ron Exp
+set_the_usual_form_variables
+
+# subcategory_id, about, title, body, html_p
+
+validate_integer subcategory_id $subcategory_id
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+#check for the user cookie
+
+set user_id [ad_get_user_id]
+
+if {$user_id == 0} {
+   ns_returnredirect /register.tcl?return_url=[ns_urlencode "[ns_conn url]"]
+   return
+}
+
+# we know who this is
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select n.category_id, n.noun_for_about, primary_category, subcategory_1, pre_post_blurb, primary_maintainer_id, u.email as maintainer_email
+from n_to_n_subcategories sc, n_to_n_primary_categories n, users u 
+where sc.category_id = n.category_id
+and n.primary_maintainer_id = u.user_id
+and sc.subcategory_id = $subcategory_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Couldn't find Subcategory $subcategory_id" "There is no subcategory
+$subcategory_id\" in [neighbor_system_name]"
+    return
+}
+
+set_variables_after_query
+
+set exception_text ""
+set exception_count 0
+
+if { ![info exists about] || $about == "" } {
+    append exception_text "<li>You didn't choose an about field for your posting. (or your browser dropped it)\n"
+    incr exception_count
+}
+
+if { ![info exists title] || $title == "" } {
+    append exception_text "<li>You forgot to type a one-line summary of your story."
+    incr exception_count
+}
+
+if { ![info exists body] || ![regexp {[A-Za-z]} $body] } {
+    append exception_text "<li>You forgot to type your story!"
+    incr exception_count
+}
+
+if { [info exists title] && $title != "" && ![regexp {[a-z]} $title] } {
+    append exception_text "<li>Your one line summary appears to be all uppercase.  ON THE INTERNET THIS IS CONSIDERED SHOUTING.  IT IS ALSO MUCH HARDER TO READ THAN MIXED CASE TEXT.  So we don't allow it, out of decorum and consideration for people who may be visually impaired."
+    incr exception_count
+}
+
+if { [info exists body] && $body != "" && ![regexp {[a-z]} $body] } {
+    append exception_text "<li>Your story appears to be all uppercase.  ON THE INTERNET THIS IS CONSIDERED SHOUTING.  IT IS ALSO MUCH HARDER TO READ THAN MIXED CASE TEXT.  So we don't allow it, out of decorum and consideration for people who may be visually impaired."
+    incr exception_count
+}
+
+if { $exception_count != 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+
+if { $exception_count != 0 } {
+    ns_return 200 text/html [neighbor_error_page $exception_count $exception_text]
+    return
+}
+
+# no exceptions
+
+ReturnHeaders
+
+ns_write "[neighbor_header "Previewing Story"]
+
+<h2>Previewing Story</h2>
+
+before stuffing it into [neighbor_home_link $category_id $primary_category]
+
+
+<hr>
+
+<h3>What viewers of a summary list will see</h3>
+
+$about : $title
+
+<h3>The full story</h3>
+
+<blockquote>
+"
+
+if { [info exists html_p] && $html_p == "t" } {
+    ns_write "$body
+</blockquote>
+
+Note: if the story has lost all of its paragraph breaks then you
+probably should have selected \"Plain Text\" rather than HTML.  Use
+your browser's Back button to return to the submission form.
+"
+
+} else {
+    ns_write "[util_convert_plaintext_to_html $body]
+</blockquote>
+
+Note: if the story has a bunch of visible HTML tags then you probably
+should have selected \"HTML\" rather than \"Plain Text\".  Use your
+browser's Back button to return to the submission form.  " 
+}
+
+ns_write "
+</blockquote>
+
+"
+
+set neighbor_to_neighbor_id [database_to_tcl_string $db "select neighbor_sequence.nextval from dual"]
+
+ns_write "
+<form method=POST action=post-new-5.tcl>
+[export_form_vars neighbor_to_neighbor_id]
+[export_entire_form]
+<center>
+<input type=submit value=\"Confirm\">
+</center>
+</form>
+
+
+[neighbor_footer $maintainer_email]
+"
Index: web/openacs/www/neighbor/post-new-5.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/post-new-5.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/post-new-5.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,112 @@
+# post-new-5.tcl,v 3.0 2000/02/06 03:49:57 ron Exp
+set_the_usual_form_variables
+
+# everything for a neighbor_to_neighbor posting
+
+validate_integer subcategory_id $subcategory_id
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+# check for the user cookie; they shouldn't ever get here
+
+set user_id [ad_verify_and_get_user_id]
+
+if {$user_id == 0} {
+   ns_returnredirect /register.tcl
+   return
+}
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select n.category_id, n.noun_for_about, primary_category, subcategory_1, pre_post_blurb, approval_policy, primary_maintainer_id, u.email as maintainer_email
+from n_to_n_subcategories sc, n_to_n_primary_categories n, users u 
+where sc.category_id = n.category_id
+and n.primary_maintainer_id = u.user_id
+and sc.subcategory_id = $subcategory_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Couldn't find Subcategory $subcategory_id" "There is no subcategory
+$subcategory_id\" in [neighbor_system_name]"
+    return
+}
+set_variables_after_query
+
+set exception_text ""
+set exception_count 0
+
+if { ![info exists subcategory_id] || [empty_string_p $subcategory_id] } {
+    append exception_text "<li>Your browser (or maybe our software) dropped the category of posting.  Ouch!"
+    incr exception_count
+}
+
+if { ![info exists about] || [empty_string_p $about] } {
+    append exception_text "<li>Your browser dropped the about field for this posting."
+    incr exception_count
+}
+
+if { ![info exists title] || [empty_string_p $title] } {
+    append exception_text "<li>Your browser dropped the title for this posting."
+    incr exception_count
+}
+
+if { ![info exists body] || ![regexp {[A-Za-z]} $body] } {
+    append exception_text "<li>Your browser dropped your story!"
+    incr exception_count
+}
+
+if { $exception_count != 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# no exceptions
+
+ReturnHeaders
+
+ns_write "[neighbor_header "Inserting Story"]
+
+<h2>Inserting Story</h2>
+
+into [neighbor_home_link $category_id $primary_category]
+
+<hr>
+
+"
+
+set creation_ip_address [ns_conn peeraddr]
+
+if { $approval_policy == "open" } {
+    set approved_p "t"
+} else {
+    set approved_p "f"
+}
+
+## Postgres hack for now while we don't have blobs
+set QQbody [string range $QQbody 0 3900]
+
+if { [string length $QQbody] < 4000 } {
+    # pathetic Oracle can handle the string literal
+    ns_db dml $db "insert into neighbor_to_neighbor
+(neighbor_to_neighbor_id, poster_user_id, posted, creation_ip_address, category_id, subcategory_id, about, title, body, html_p, approved_p)
+values
+($neighbor_to_neighbor_id, $user_id, sysdate(), '$creation_ip_address', $category_id, $subcategory_id,'$QQabout','$QQtitle','$QQbody','$html_p','$approved_p')"
+} else {
+    # pathetic Oracle must be fed the full story via the bizzarro
+    # clob extensions 
+    ns_ora clob_dml $db "insert into neighbor_to_neighbor
+(neighbor_to_neighbor_id, poster_user_id, posted, creation_ip_address, category_id, subcategory_id, about, title, body, html_p, approved_p)
+values
+($neighbor_to_neighbor_id, $user_id, sysdate, '$creation_ip_address', $category_id, $subcategory_id,'$QQabout','$QQtitle',empty_clob(),'$html_p','$approved_p')
+returning body into :one" $body
+}
+
+ns_write "Success!
+
+<p>
+
+There isn't much more to say.
+
+[neighbor_footer $maintainer_email]
+"
Index: web/openacs/www/neighbor/post-new-old.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/post-new-old.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/post-new-old.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,55 @@
+# post-new-old.tcl,v 3.0 2000/02/06 03:49:58 ron Exp
+set_form_variables
+
+set exception_text ""
+set exception_count 0
+
+# bounce the ad if they didn't choose a category
+
+if { $subcategory_1 == "Choose a Category" } {
+
+    append exception_text "<li>You didn't choose a category for your posting.\n"
+    incr exception_count
+
+    }
+
+if { [string first "@" $poster_name] != -1 } {
+
+	append exception_text "<li>You typed an \"@\" in the name field.  Unless you are the 
+musician formerly known as Prince, I suspect that you mistakenly typed your email address
+in the name field.\n"
+	incr exception_count
+
+}
+
+if { ![regexp {.+@.+\..+} $poster_email] } {
+
+    append exception_text "<li>Your email address doesn't look like
+'foo@bar.com'.  We only accept postings from people with email
+addresses.  If you got here, it probably means either that (a) you are
+going to wait another 27 years to see if this Internet fad catches on,
+or (b) that you are an AOL subscriber who thinks that he doesn't have to 
+type the \"aol.com\".
+
+"
+	incr exception_count
+
+    }
+
+if { $exception_count != 0 } {
+    ns_return 200 text/html [neighbor_error_page $exception_count $exception_text]
+    return
+}
+
+ReturnHeaders
+
+ns_write "[neighbor_header "Post Step 
+
+append one_line "$about : "
+ns_set put $form one_line $one_line
+
+ns_set put $form neighbor_to_neighbor_id new
+
+ns_return 200 text/html [bt_mergepiece [classified_NtoN_form new] $form]
+
+
Index: web/openacs/www/neighbor/post-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/post-new.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/post-new.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,71 @@
+# post-new.tcl,v 3.0 2000/02/06 03:49:59 ron Exp
+set_the_usual_form_variables
+
+# category_id
+
+validate_integer category_id $category_id
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+#check for the user cookie
+
+set user_id [ad_get_user_id]
+
+if {$user_id == 0} {
+   ns_returnredirect /register.tcl?return_url=[ns_urlencode "[ns_conn url]?[export_url_vars category_id]"]
+   return
+}
+
+# we know who this is
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select primary_category, pre_post_blurb, primary_maintainer_id, u.email as maintainer_email
+from n_to_n_primary_categories n, users u 
+where n.primary_maintainer_id = u.user_id
+and n.category_id = $category_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Couldn't find Category $category_id" "There is no category
+$category_id\" in [neighbor_system_name]"
+    return
+}
+
+set_variables_after_query
+
+
+ReturnHeaders
+
+ns_write "[neighbor_header "Prepare New Post"]
+
+<h2>Prepare a New Posting</h2>
+
+in [neighbor_home_link $category_id $primary_category]
+
+<hr>
+<h3>Pick a Category</h3>
+
+<ul>
+
+"
+
+
+set selection [ns_db select $db "select subcategory_id, subcategory_1
+from n_to_n_subcategories
+where category_id = $category_id"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    ns_write "<li><a href=\"post-new-2.tcl?subcategory_id=$subcategory_id\">$subcategory_1</a>\n"
+}
+
+ns_write "
+
+</ul>
+
+$pre_post_blurb
+
+[neighbor_footer $maintainer_email]
+"
Index: web/openacs/www/neighbor/previous.xbm
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/previous.xbm,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/previous.xbm	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,6 @@
+#define previous.xbm_width 16
+#define previous.xbm_height 16
+static char previous.xbm_bits[] = {
+   0x00, 0x00, 0x00, 0x00, 0xc0, 0x40, 0xe0, 0x60, 0xf0, 0x70, 0xf8, 0x78,
+   0xfc, 0x7c, 0xfe, 0x7f, 0xfe, 0x7f, 0xfc, 0x7c, 0xf8, 0x78, 0xf0, 0x70,
+   0xe0, 0x60, 0xc0, 0x40, 0x00, 0x00, 0x00, 0x00};
Index: web/openacs/www/neighbor/search-ctx.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/search-ctx.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/search-ctx.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,125 @@
+# search-ctx.tcl,v 3.0 2000/02/06 03:50:00 ron Exp
+set_the_usual_form_variables
+
+# query_string, accumulate_p (optional), fuzzy_p (optional)
+   
+ReturnHeaders
+
+ns_write "[neighbor_header "Postings Matching \"$query_string\""]
+
+<h2>Postings Matching \"$query_string\"</h2>
+
+in <a href=\"index.tcl\">[neighbor_system_name]</a>
+
+<hr>
+
+<ul>
+
+"
+
+set db [neighbor_db_gethandle]
+
+regsub -all { +} [string trim $QQquery_string] "," query_string_for_ctx
+
+# we've separated the words with commas (sometimes more than one if the
+# user typed multiple spaces)
+
+if { [info exists accumulate_p] && $accumulate_p == "t" } {
+    # we bash down multiple commas to one comma (the 
+    # accumulate operator, score = sum of word appearance)
+    regsub -all {,+} $query_string_for_ctx "," query_string_for_ctx
+} else {
+    # this is the default, let's try the NEAR operator, tends
+    # to result in tighter more relevant results
+    regsub -all {,+} $query_string_for_ctx ";" query_string_for_ctx
+}
+
+set prefix {$}
+if { [info exists fuzzy_p] && $fuzzy_p == "t" } {
+    append prefix {?}
+}
+
+if [catch {set selection [ns_db select $db "select score(10) as the_score, nton.*
+from neighbor_to_neighbor nton
+where contains (indexed_stuff, '${prefix}($query_string_for_ctx)', 10) > 0
+order by score(10) desc"]} errmsg] {
+
+    ns_write "There aren't any results because something about
+your query string has made Oracle Context unhappy:
+<pre>
+$errmsg
+</pre>
+In general, ConText does not like special characters.  It does not like
+to see common words such as \"AND\" or \"a\" or \"the\".  
+I haven't completely figured this beast out.
+
+Back up and try again!
+
+</ul>
+<hr>
+</body>
+</html>"
+
+    return
+
+}
+
+
+set counter 0 
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+    if { ![info exists max_score] } {
+	# first iteration, this is the highest score
+	set max_score $the_score
+    }
+    if { ($counter > 25) && ($the_score < [expr 0.3 * $max_score] ) } {
+	# we've gotten more than 25 rows AND our relevance score
+	# is down to 30% of what the maximally relevant row was
+	ns_db flush $db
+	break
+    }
+    if { ($counter > 50) && ($the_score < [expr 0.5 * $max_score] ) } {
+	# take a tougher look
+	ns_db flush $db
+	break
+    }
+    if { ($counter > 100) && ($the_score < [expr 0.8 * $max_score] ) } {
+	# take a tougher look yet
+	ns_db flush $db
+	break
+    }
+    if { $one_line == "" } {
+	set anchor $about
+    } else {
+	set anchor "$about : $one_line"
+    }
+    ns_write "<li>$the_score: <a href=\"view-one.tcl?neighbor_to_neighbor_id=$neighbor_to_neighbor_id\">$anchor</a>\n"
+}
+
+if { $counter == 0 } {
+    if { ![info exists fuzzy_p] && ![info exists accumulate_p] } {
+	# nothin' special requested, offer special options
+	ns_write "<li>sorry, but no messages matched this query.
+Your query words were fed to Oracle ConText with instructions that
+they had to appear near each other.  This is a good way of achieving
+high relevance for common queries such as \"Nikon zoom lens\".
+<p>
+There are two basic ways in which we can expand your search:
+<ol>
+<li><a href=\"search.tcl?accumulate_p=t&query_string=[ns_urlencode $query_string]\">drop the proximity requirement</a>
+<li><a href=\"search.tcl?fuzzy_p=t&query_string=[ns_urlencode $query_string]\">expand the search words to related terms (fuzzy)</a>
+</ol>
+"
+
+} else {
+	# user is already doing something special but still losing unfortunately
+	ns_write "<li>sorry, but no messages matched this query\n"
+    }
+}
+
+
+ns_write "</ul>
+
+[neighbor_footer]"
Index: web/openacs/www/neighbor/search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/search.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,89 @@
+# search.tcl,v 3.0 2000/02/06 03:50:01 ron Exp
+set_the_usual_form_variables
+
+# query_string
+   
+ReturnHeaders
+
+ns_write "[neighbor_header "Postings Matching \"$query_string\""]
+
+<h2>Postings Matching \"$query_string\"</h2>
+
+in <a href=\"index.tcl\">[neighbor_system_name]</a>
+
+<hr>
+
+<ul>
+
+"
+
+set db [neighbor_db_gethandle]
+
+# if the user put in commas, replace with spaces
+
+regsub -all {,+} [string trim $QQquery_string] " " final_query_string
+
+if [catch {set selection [ns_db select $db "select pseudo_contains(substr(body,3000) || title || about, '$final_query_string') as the_score, nton.*
+from neighbor_to_neighbor nton
+where pseudo_contains (substr(body,3000) || title || about, '$final_query_string') > 0
+order by 1 desc"]} errmsg] {
+
+    ns_write "There aren't any results because something about
+your query string has made Oracle unhappy:
+<pre>
+$errmsg
+</pre>
+
+Back up and try again!
+
+</ul>
+<hr>
+</body>
+</html>"
+
+    return
+
+}
+
+
+set counter 0 
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+    if { ![info exists max_score] } {
+	# first iteration, this is the highest score
+	set max_score $the_score
+    }
+    if { ($counter > 25) && ($the_score < [expr 0.3 * $max_score] ) } {
+	# we've gotten more than 25 rows AND our relevance score
+	# is down to 30% of what the maximally relevant row was
+	ns_db flush $db
+	break
+    }
+    if { ($counter > 50) && ($the_score < [expr 0.5 * $max_score] ) } {
+	# take a tougher look
+	ns_db flush $db
+	break
+    }
+    if { ($counter > 100) && ($the_score < [expr 0.8 * $max_score] ) } {
+	# take a tougher look yet
+	ns_db flush $db
+	break
+    }
+    if { $title == "" } {
+	set anchor $about
+    } else {
+	set anchor "$about : $title"
+    }
+    ns_write "<li>$the_score: <a href=\"view-one.tcl?neighbor_to_neighbor_id=$neighbor_to_neighbor_id\">$anchor</a>\n"
+}
+
+if { $counter == 0 } {
+    ns_write "<li>sorry, but no postings matched this query\n"
+}
+
+
+ns_write "</ul>
+
+[neighbor_footer]"
Index: web/openacs/www/neighbor/up.xbm
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/up.xbm,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/up.xbm	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,6 @@
+#define up.xbm_width 16
+#define up.xbm_height 16
+static char up.xbm_bits[] = {
+   0x00, 0x00, 0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, 0xf0, 0x0f, 0xf8, 0x1f,
+   0xfc, 0x3f, 0xfc, 0x3f, 0x80, 0x01, 0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07,
+   0xf0, 0x0f, 0xf8, 0x1f, 0xfc, 0x3f, 0x00, 0x00};
Index: web/openacs/www/neighbor/view-one.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/neighbor/view-one.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/neighbor/view-one.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,107 @@
+# view-one.tcl,v 3.0 2000/02/06 03:50:02 ron Exp
+#
+# /neighbor/view-one.tcl
+#
+# by philg@mit.edu in the dark ages of 1998 (ported from 1995-era code)
+# 
+
+set viewing_user_id [ad_get_user_id]
+
+set_form_variables
+
+# neighbor_to_neighbor_id is set now
+
+validate_integer neighbor_to_neighbor_id $neighbor_to_neighbor_id
+
+set db [neighbor_db_gethandle]
+
+set selection [ns_db 0or1row $db "select about, title, body, html_p, posted, users.user_id, users.first_names || ' ' || users.last_name as poster_name, n.category_id, pc.primary_category
+from neighbor_to_neighbor n, users, n_to_n_primary_categories pc
+where neighbor_to_neighbor_id = $neighbor_to_neighbor_id
+and users.user_id = n.poster_user_id
+and n.category_id = pc.category_id"]
+
+if { $selection == "" } {
+    # user is looking at an old posting
+    ad_return_error "Bad story id" "Couldn't find posting number $neighbor_to_neighbor_id.
+
+<P>
+
+Probably you've bookmarked an old story
+that has been deleted by the moderator."
+    return
+}
+
+# found the row
+
+set_variables_after_query
+
+if [empty_string_p $title] {
+    set headline $about
+} else {
+    set headline "$about : $title"
+}
+
+
+ReturnHeaders
+
+ns_write "[neighbor_header $headline]
+
+<h2>$headline</h2>
+
+posted in [neighbor_home_link $category_id $primary_category]
+
+<hr>
+
+<blockquote>
+[util_maybe_convert_to_html $body $html_p]
+<br>
+<br>
+-- <a href=\"/shared/community-member.tcl?user_id=$user_id\">$poster_name</a>, [util_AnsiDatetoPrettyDate $posted]
+</blockquote>
+
+
+"
+
+if [ad_parameter SolicitCommentsP neighbor 1] {
+    # see if there are any comments on this story
+    set selection [ns_db select $db "select comment_id, content, comment_date, first_names || ' ' || last_name as commenter_name, users.user_id as comment_user_id, html_p as comment_html_p
+from general_comments, users
+where on_what_id= $neighbor_to_neighbor_id
+and on_which_table = 'neighbor_to_neighbor'
+and general_comments.approved_p = 't'
+and general_comments.user_id = users.user_id"]
+
+    set first_iteration_p 1
+    set comment_html ""
+    while {[ns_db getrow $db $selection]} {
+	set_variables_after_query
+	if $first_iteration_p {
+	    append comment_html "<h4>Comments</h4>\n"
+	    set first_iteration_p 0
+	}
+	append comment_html "<blockquote>\n[util_maybe_convert_to_html $content $comment_html_p]\n"
+	# if the user posted the comment, they are allowed to edit it
+	if {$viewing_user_id == $comment_user_id} {
+	    append comment_html "<br><br>-- you <A HREF=\"comment-edit.tcl?comment_id=$comment_id\">(edit your comment)</a>"
+	} else {
+	    append comment_html "<br><br>-- <a href=\"/shared/community-member.tcl?user_id=$comment_user_id\">$commenter_name</a>"
+	}
+	append comment_html ", [util_AnsiDatetoPrettyDate $comment_date]"
+	append comment_html "</blockquote>\n"
+    }
+    append comment_html "
+    <center>
+    <A HREF=\"comment-add.tcl?[export_url_vars neighbor_to_neighbor_id]\">Add a comment</a>
+    </center>
+    "
+    ns_write $comment_html 
+} else {
+    # we're not soliciting comments
+}
+
+
+ns_write "
+</body>
+</html>
+"
Index: web/openacs/www/new-ticket/add-xref-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/add-xref-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/add-xref-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,29 @@
+#
+# Add in a cross-reference to another ticket
+# 
+# pmsg_id  - the id of the parent issue
+# xmsg_id - the id of the xreferenced isue
+#
+# target - the url we return to
+
+set_form_variables
+
+validate_integer xmsg_id $xmsg_id
+validate_integer pmsg_id $pmsg_id
+
+set user_id [ad_get_user_id]
+set db [ticket_getdbhandle]
+
+if {![ticket_user_can_edit_issues_p $user_id [list $xmsg_id $pmsg_id] $db]} {
+    ticket_deny_access
+    return
+}
+
+set msg_id $pmsg_id
+
+ns_db dml $db "insert into ticket_xrefs (from_ticket, to_ticket) 
+values ($msg_id, $xmsg_id)"
+
+
+ns_returnredirect "$target?[export_url_vars msg_id]"
+
Index: web/openacs/www/new-ticket/add-xref-search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/add-xref-search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/add-xref-search.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,51 @@
+# Search the tickets for a given query string, and 
+# give user to add any results as cross-references to msg_id
+#
+# msg_id
+# target -- url to return control to when done
+
+set db [ticket_getdbhandle]
+
+ReturnHeaders
+set_form_variables
+
+validate_integer msg_id $msg_id
+
+set selection [ns_db 1row $db "select one_line, ticket_projects.project_id as project_id, title from ticket_issues,ticket_projects where msg_id=$msg_id and ticket_issues.project_id=ticket_projects.project_id"]
+set_variables_after_query
+
+ns_write "[ad_header "Search For Ticket To Add As Cross-Reference"]
+<h2>Cross-Reference Ticket Search</h2>
+[ad_context_bar_ws_or_index [list "[ticket_url_stub]/index.tcl" "Ticket Tracker"] [list "project-top.tcl?project_id=$project_id" $title] [list "issue-view.tcl?[export_url_vars msg_id]" "One Ticket"] "Cross-Reference"]
+<hr><p>
+You are adding a cross reference from ticket #$msg_id: [clean_up_html $one_line]
+<p>
+<form action=xref-search.tcl method=get>
+Enter a search string: <INPUT TYPE=text name=query_string_1>
+<input type=submit name=submit value=submit>
+[export_form_vars msg_id target]
+</form>
+
+"
+set query_string "%"
+ns_write "
+
+<a href=\"xref-search.tcl?[export_url_vars query_string msg_id target]\">List all tickets</a>
+
+
+</blockquote>
+[ad_footer]
+"
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/new-ticket/add-xref.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/add-xref.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/add-xref.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,188 @@
+#
+# Add in a cross-reference to another ticket
+# 
+# xmsg_id  - the id of the xreferenced issue
+# pmsg_id - the id of the parent isue
+#
+# target - the url we return to
+
+set_form_variables
+
+validate_integer xmsg_id $xmsg_id
+validate_integer pmsg_id $pmsg_id
+
+set user_id [ad_get_user_id]
+set db [ticket_getdbhandle]
+
+if {![ticket_user_can_edit_issues_p $user_id [list $xmsg_id $pmsg_id] $db]} {
+    ticket_deny_access
+    return
+}
+
+# show a confirmation
+
+set msg_id $xmsg_id
+
+# msg_id
+#
+# This page is shown to unprivileged users - it does not
+# allow any fields to be modified.
+
+set user_id [ad_get_user_id]
+
+set selection [ns_db 0or1row $db "select 
+to_char(posting_time, [ticket_date_format]) as posting_date,
+deadline, one_line, message, priority, ticket_type, first_names || ' ' || last_name as name, status
+from ticket_issues, users
+where msg_id = $msg_id
+and users.user_id = ticket_issues.user_id"]
+
+if { $selection == "" } {
+    # message was probably deleted
+    ns_return 200 text/html "Couldn't find message $msg_id.  Probably it was deleted by the forum maintainer."
+    return
+}
+
+set_variables_after_query
+set this_one_line $one_line
+
+
+set selection [ns_db 1row $db "select 
+ title, ticket_issues.project_id, notify_p,
+ ticket_issues.contact_name,  ticket_issues.contact_info1,
+ to_char(close_date, [ticket_date_format]) close_date,  ticket_priorities.name  as priority_name, ticket_priorities.priority
+from ticket_projects, ticket_issues, users, ticket_priorities
+where ticket_projects.project_id = ticket_issues.project_id
+and ticket_issues.msg_id = $msg_id
+and users.user_id(+) = closed_by
+and ticket_priorities.priority = ticket_issues.priority"]
+set_variables_after_query
+
+if { [empty_string_p $deadline] } {
+    set deadline [ns_localsqltimestamp]
+}
+
+ReturnHeaders
+
+ns_write "Confirm: link to this ticket as cross-reference from ticket \#$pmsg_id <a href=\"add-xref-2.tcl?[export_url_vars xmsg_id pmsg_id target]\">Yes</a> &nbsp;|&nbsp;<a href=\"$target?msg_id=$pmsg_id\">Cancel</a>
+<p>"
+
+
+ns_write "[ad_header $one_line]
+Project: $title
+<h2>$ticket_type \#$msg_id: [clean_up_html $one_line]</h2>"
+
+ns_write "
+<table border=0 cellspacing=3>
+<tr><td align=left><b>Ticket Type:</b><td>$ticket_type</td></tr>
+<tr><td align=left><b>Priority:</b><td>$priority</td></tr>
+<tr><td align=left><b>Deadline:</b><td>$deadline</td></tr>
+<tr><th align=left>Project:<td>$project_id</td></tr>
+<tr><td align=left><b>Submitted By:</b><td>$name on $posting_date</tr>
+<tr><td align=left><b>Status:</b><td>$status</td></tr>"
+
+
+ns_write "<tr><th valign=top align=left>Contact Name:</th><td>$contact_name</td></tr>"
+
+ns_write "<tr><th valign=top align=left>Contact Info:</th><td><pre>$contact_info1</pre></td></tr>"
+
+
+
+foreach entry [ticket_picklist_data] { 
+    # Get the name of the database column associated with each
+    # picklist field
+    set column_name [ticket_picklist_entry_column_name $entry]
+    set current_value [set $column_name]
+    set pretty_name  [ticket_picklist_entry_pretty_name $entry]
+    ns_write "<tr><th align=left>$pretty_name:</th><td>$current_value</td></tr>\n"
+}
+
+if { $close_date != "" } {
+    ns_write "<tr><td align=left><b>Closed On:</b><td>$close_date</tr>\n"
+}
+
+ns_write "
+
+<tr><td colspan=2><hr></tr>
+<tr><th valign=top align=left>Message:</th><td align=left>$message
+</td></tr>
+</table>"
+
+# List xrefs
+ns_write "<b>Related Issues</b>
+<br>
+"
+set selection [ns_db select $db "select to_ticket, one_line xone_line, msg_id xmsg_id
+ from ticket_xrefs, ticket_issues
+where  to_ticket = ticket_issues.msg_id and 
+from_ticket=$msg_id"]
+
+ns_write "<ul>"
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    ns_write "<li>\[$xmsg_id\] $xone_line"
+}
+
+
+
+
+ns_write "
+<h3>Assignment</h3>
+<table border=1 cellpadding=10>
+<tr>
+<th>Users assigned to this issue</th>
+</tr>
+
+"
+# list assignments
+ns_write "<tr valign=top><td><ul>
+"
+
+set selection [ns_db select $db "select first_names, last_name, users.user_id
+from users, ticket_issue_assignments where 
+users.user_id=ticket_issue_assignments.user_id 
+and msg_id=$msg_id"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    ns_write "<li>  $first_names $last_name\n"
+}
+
+ns_write  "</ul>
+</td></tr></table>
+</ul>\n"
+
+# List responses 
+set selection [ns_db select $db "select 
+ response_id, public_p,
+ users.first_names || ' ' || users.last_name as name,
+ to_char(posting_time, [ticket_date_format]) as posting_date,
+ message
+from ticket_issue_responses, users
+where ticket_issue_responses.user_id = users.user_id
+and ticket_issue_responses.response_to = $msg_id"] 
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if {$public_p == "t"} {
+	lappend responses "<blockquote>
+	$message
+	</blockquote>
+	Submitted by $name on $posting_date
+	"
+    }
+}
+
+
+if { [info exists responses] } {
+    ns_write "<h3>Comments</h3>
+[join $responses "<hr width=300>"]
+"
+}
+
+
+ns_write "[ad_footer]"
+
+
+
+
Index: web/openacs/www/new-ticket/by-creation-user.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/by-creation-user.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/by-creation-user.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,272 @@
+set_form_variables 0
+
+ad_page_variables {
+    {user_id ""}
+    {project_id ""}
+    {order_by "ticket_issues.msg_id"}
+    {view_assignment all}
+    {view_status open}
+    {view_created all}
+    {view_type all}
+}
+
+# form vars:
+# 
+# user_id - user_id this page is for (optional - defaults to logged in user)
+# project_id - project_id for this user (optional - defaults to all tickets 
+#              for the selected user)
+#
+# filter conditions
+#
+
+# logged_in_user_id corresponds to the user that is viewing this page
+# and user_id is the user_id for the person whom we want to see a summary of 
+# ticket issues.
+
+if { [info exists user_id] && ![empty_string_p $user_id]} {
+    # validate the user_id input and get the user_id of the person viewing this
+    # page.
+    validate_integer user_id $user_id
+    set logged_in_user_id [ad_get_user_id]
+} else {
+    # a user_id was not passed to this page so just default to showing the user
+    # his or her own tickets.
+    set user_id [ad_get_user_id]
+    set logged_in_user_id $user_id
+}
+
+if {![info exists project_id]} {
+    set project_id ""
+}
+
+if {![empty_string_p $project_id]} {
+    validate_integer project_id $project_id
+    set original_project_id $project_id
+} else {
+    set original_project_id ""
+}
+
+set db [ticket_getdbhandle]
+
+if {![empty_string_p $project_id]} {
+    set project_title [database_to_tcl_string $db "select title from ticket_projects where project_id=$project_id"]
+    set project_title_html "for project $project_title"
+} else {
+    set project_title_html "for all projects"
+}
+
+set list_of_projects [database_to_tcl_list_list $db "select project_id,title from ticket_projects where ticket_user_can_see_project_p($logged_in_user_id, project_id)='t'"]
+
+set list_of_projects [concat [list [list "" "(all)"]] $list_of_projects]
+
+set sql "select user_id, first_names || ' ' || last_name as name
+from users where user_id in (select user_id from user_group_map where group_id in 
+(select team_id from ticket_project_teams where ticket_user_can_see_project_p($logged_in_user_id, project_id)='t'))
+order by upper(last_name)"
+
+set list_of_users [database_to_tcl_list_list $db $sql]
+
+# Status
+# view_status  { open closed deferred created_by_you }
+#
+# Creation time
+# view_created { last_24 last_week last_month all}
+#
+# Ticket Type
+# view_type { all defects enhancements issues }
+#
+#
+# order_by       column name to sort table by 
+
+set ctrlvars {view_type view_assignment view_status view_created user_id project_id}
+
+set name [database_to_tcl_string $db "select first_names || ' ' || last_name 
+from users where user_id = $user_id"]
+
+ReturnHeaders
+
+ns_write "[ad_header "[ticket_system_name] Home"]
+
+<h2>Tickets created by $name $project_title_html</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Ticket Tracker"] "One User"]
+
+<hr>
+"
+
+# List of form vars used to select tickets to display
+
+# Assignment filter conditions
+#
+
+set filter_vars {view_assignment view_status view_created view_type order_by project_id user_id}
+set url "by-creation-user.tcl"
+    
+if {[string match "project*" $order_by]} {
+    set order_by "project_title"
+}
+
+switch $view_assignment {
+    "user" { 
+	set assignment_filter "and (exists (select msg_id from ticket_issue_assignments 
+	where ticket_issue_assignments.msg_id = ticket_issues.msg_id
+	and ticket_issue_assignments.user_id = $user_id)) " 
+    }
+    
+    "all" { set assignment_filter "" }
+    
+    "unassigned" {
+	set assignment_filter "and (not exists (select msg_id from ticket_issue_assignments
+	where ticket_issue_assignments.msg_id= ticket_issues.msg_id))"
+    }
+}
+
+switch $view_status {
+    "open" {
+	set status_filter "and ((status <> 'closed') and (status <> 'deferred') and (status <> 'fixed waiting approval')) " 
+    }
+    "deferred" {
+	set status_filter "and ((status <> 'closed') or (status = 'deferred')) " 
+    }
+    "closed" {
+	set status_filter "" 
+	set closed 1
+	set view_closed 1
+    }
+}
+
+switch $view_created {
+    "last_24"   { set date_filter "and (posting_time > (sysdate() - '1 day'::reltime))" } 
+    "last_week" { set date_filter "and (posting_time > (sysdate() - '7 days'::reltime)) " } 
+    "last_month" { set date_filter "and (posting_time > (sysdate() - '30 days'::reltime)) " }
+    "all" { set date_filter "" }
+}
+
+switch $view_type {
+    "all" { set issue_table "ticket_issues" }
+    "defects" { set issue_table "ticket_defects" }
+    "enhancements" { set issue_table "ticket_enhancements" }
+    "issues" { set issue_table "ticket_issues_issues" }
+}
+
+append page "<table border=0 cellspacing=0 cellpadding=0 width=100%>
+<tr>
+<th bgcolor=#ECECEC><font size=-1>Ticket Type</font></th>
+<th bgcolor=#ECECEC><font size=-1>Ticket Assignment</font></th>
+<th bgcolor=#ECECEC><font size=-1>Status</font></th>
+<th bgcolor=#ECECEC><font size=-1>Creation Time</font></th></tr>"
+
+
+#### Assignment flags
+# Show assigned to you 
+append page "<tr><td align=center><font size=-1><nobr>\["
+
+# Issue type filter
+append page [ticket_control_vars view_type all $filter_vars "ALL" "$url"]
+append page " | "
+append page [ticket_control_vars view_type defects $filter_vars "Defects" "$url"]
+append page " | "
+append page [ticket_control_vars view_type enhancements $filter_vars "Enhancements" "$url"]
+append page " | "
+append page [ticket_control_vars view_type issues $filter_vars "Issues" "$url"]
+
+append page "\]</nobr></font></td><td align=center><nobr><font size=-1>\["
+
+append page [ticket_control_vars view_assignment user $filter_vars "mine" "$url"]
+append page " | "
+# Show all tickets 
+append page [ticket_control_vars view_assignment all $filter_vars "everyone's" "$url"]
+
+# Depending on project_id
+if {![empty_string_p $project_id]} {
+    set unassigned_count [database_to_tcl_string $db "select count(*) from $issue_table where project_id=$project_id and ticket_n_assigned(msg_id)=0 $status_filter $date_filter"]
+} else {
+    set unassigned_count [database_to_tcl_string $db "select count(*) from $issue_table where ticket_user_can_see_project_p($user_id, project_id)='t' and ticket_n_assigned(msg_id)=0 $status_filter $date_filter"]
+}
+
+append page " | "
+
+append page [ticket_control_vars view_assignment unassigned $filter_vars "unassigned" "$url"]
+
+#### Status flags
+append page "\]</nobr></font></td>\n<td align=center><font size=-1><nobr>\["
+
+# Show open issues
+append page [ticket_control_vars view_status open $filter_vars "active" "$url"]
+append page " | "
+# Show deferred issues
+append page [ticket_control_vars view_status deferred $filter_vars "+deferred" "$url"]
+append page " | "
+# Show closed issues
+append page [ticket_control_vars view_status closed $filter_vars "+closed" "$url"]
+
+#### Creation time filter
+append page "\]</nobr></font></td>\n<td align=center><font size=-1><nobr>\["
+
+append page [ticket_control_vars view_created last_24 $filter_vars "last 24 hrs" "$url"]
+append page " | "
+append page [ticket_control_vars view_created last_week $filter_vars "last week" "$url"]
+append page " | "
+append page [ticket_control_vars view_created last_month $filter_vars "last month" "$url"]
+append page " | "
+append page [ticket_control_vars view_created all $filter_vars "all" "$url"]
+
+append page "\]</nobr></font></td></tr></table><p>"
+
+ns_write "$page"
+
+# Project Filter
+if {![empty_string_p $project_id]} {
+    set project_filter " and ticket_projects.project_id=$project_id"
+} else {
+    set project_filter ""
+}
+
+###################################################################
+#
+# Now display the tickets pertaining the selected user and project
+#
+###################################################################
+
+set query "select
+ ticket_issues.msg_id,
+ ticket_issues.ticket_type, 
+ ticket_issues.one_line,
+ ticket_issues.status,
+ ticket_issues.severity,
+ ticket_issues.posting_time,
+ ticket_projects.title as project_title,
+ ticket_projects.project_id,
+ ticket_issues.priority, 
+ to_char(ticket_issues.modification_time, 'MM/DD/YY') as modification_time_pretty,
+ to_char(ticket_issues.posting_time, 'MM/DD/YY') as creation_time_pretty,
+ to_char(ticket_issues.close_date, 'MM/DD/YY') as close_date_pretty,
+ to_char(ticket_issues.close_date, 'MM/DD/YY') as close_date,
+ to_char(ticket_issues.deadline, 'MM/DD/YY') as deadline_pretty,
+ to_char(ticket_issues.deadline, 'MM/DD/YY') as deadline,
+ sysdate() - deadline as pastdue,
+ ticket_assignees(ticket_issues.msg_id) as ticket_assignees
+from $issue_table ticket_issues, ticket_projects
+where ticket_user_can_see_project_p($logged_in_user_id, ticket_projects.project_id)='t'
+and ticket_issues.user_id= $user_id
+and ticket_projects.project_id = ticket_issues.project_id
+$project_filter
+$assignment_filter
+$status_filter
+$date_filter
+order by $order_by, ticket_issues.priority, ticket_issues.posting_time"
+
+set this_url "by-creation-user.tcl"
+append results [ticket_summary_display]
+
+ns_write  "$results
+
+<FORM method=GET action=by-creation-user.tcl>Project: 
+[make_html_select project_id $list_of_projects $original_project_id] 
+User: 
+[make_html_select user_id $list_of_users $user_id]
+<INPUT TYPE=submit value=go></FORM><p><p>
+
+[ad_footer]
+"
+
Index: web/openacs/www/new-ticket/custom-field-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/custom-field-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/custom-field-edit-2.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,25 @@
+set_the_usual_form_variables
+# field_id field_name field_pretty_name field_type field_vals
+
+validate_integer field_id $field_id
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+set project_id [database_to_tcl_string $db "select project_id from ticket_projects_fields where field_id=$field_id"]
+
+if {![ticket_user_can_admin_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+ns_db dml $db "update ticket_projects_fields set
+field_name= '$QQfield_name',
+field_pretty_name= '$QQfield_pretty_name',
+field_type= '$QQfield_type',
+field_vals= '$QQfield_vals',
+view_in_list= [db_null_sql $QQview_in_list]
+where field_id= $field_id"
+
+ns_returnredirect "project-fields.tcl?[export_url_vars project_id]"
Index: web/openacs/www/new-ticket/custom-field-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/custom-field-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/custom-field-edit.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,18 @@
+set_the_usual_form_variables
+# field_id
+
+validate_integer field_id $field_id
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select field_name, project_id, field_pretty_name, field_type, view_in_list, field_vals from ticket_projects_fields where field_id=$field_id"]
+set_variables_after_query
+
+if {![ticket_user_can_admin_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+ad_return_template
Index: web/openacs/www/new-ticket/custom-field-remove-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/custom-field-remove-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/custom-field-remove-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,23 @@
+set_the_usual_form_variables
+# project_id field_id
+
+validate_integer project_id $project_id
+validate_integer field_id $field_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![ticket_user_can_admin_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+ns_db dml $db "begin transaction"
+
+ns_db dml $db "delete from ticket_projects_field_vals where project_id=$project_id and field_id=$field_id"
+ns_db dml $db "delete from ticket_projects_fields where project_id=$project_id and field_id=$field_id"
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "project-fields.tcl?[export_url_vars project_id]"
Index: web/openacs/www/new-ticket/custom-field-remove.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/custom-field-remove.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/custom-field-remove.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,22 @@
+set_the_usual_form_variables
+# project_id field_id
+
+validate_integer project_id $project_id
+validate_integer field_id $field_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![ticket_user_can_admin_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+if {[database_to_tcl_string $db "select count(*) from ticket_projects_field_vals where project_id=$project_id and field_id=$field_id"] == 0} {
+    ns_db dml $db "delete from ticket_projects_fields where project_id=$project_id and field_id=$field_id"
+    ns_returnredirect "project-fields.tcl?[export_url_vars project_id]"
+    return
+}
+
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/new-ticket/index.help
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/index.help,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/index.help	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,19 @@
+<%= [ticket_help_header "Ticket Tracker Help"] %>
+
+<h3>Ticket Tracker: Big Picture</h3>
+
+The ticket tracker allows people to track project issues with full
+history management, assignment, and resolution tracking.
+<p>
+Each project is managed by a team of people, and anyone on the team
+can enter issues into the system. These issues (and the project as a
+whole) will only be visible to the members of the team. Once an issue
+is entered, a member with <b>internal</b> permissions will be allowed
+to edit the issue and assign it to another <b>internal</b> member of
+the team. The assignee can then declare the issue to be <b>fixed</b>,
+after which a team member with <b>administrator</b> privileges will be
+able to mark the issue as truly <b>closed</b>.
+
+<p>
+
+<%= [ad_footer] %>
\ No newline at end of file
Index: web/openacs/www/new-ticket/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/index.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,136 @@
+# Ticket tracker user home page
+#
+# index.tcl by hqm@arsdigita.com June 1999
+# 
+set_form_variables 0
+
+# form vars:
+# 
+# (these are all optional args which have defaults)
+#
+# filter conditions
+#
+# Assignments:
+# view_assignment    { user unassigned all }
+
+# Status
+# view_status  { open closed deferred created_by_you }
+#
+# Creation time
+# view_created { last_24 last_week last_month all}
+#
+#
+# order_by       column name to sort table by 
+
+set ctrlvars {view_assignment view_status view_created}
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+
+##
+## if there is only one project this person is assigned to, redirect to it.
+##
+set list_of_projects [database_to_tcl_list_list $db "select project_id,title from ticket_projects where ticket_user_can_see_project_p($user_id, project_id)='t'"]
+
+if {[llength $list_of_projects] == 0} {
+    ns_returnredirect "/team"
+    return
+}
+
+if {[llength $list_of_projects] == 1} {
+    ns_returnredirect "project-top.tcl?project_id=[lindex [lindex $list_of_projects 0] 0]"
+    return
+}
+
+ReturnHeaders
+
+ns_write "[ad_header "[ticket_system_name] Home"]
+
+<h2>[ticket_system_name]</h2>
+
+[ad_context_bar_ws_or_index "Ticket Tracker"]
+
+<hr>
+<p>
+<FORM method=GET action=project-top.tcl>Projects: 
+"
+
+#  foreach project $list_of_projects {
+#      ns_write "<a href=project-top.tcl?project_id=[lindex $project 0]>[lindex $project 1]</a> | "
+#  }
+
+ns_write " [make_html_select project_id $list_of_projects] <INPUT TYPE=submit value=go></FORM><p>"
+
+ns_write "<p>"
+# List of form vars used to select tickets to display
+
+# Assignment filter conditions
+#
+
+append results "[ticket_filter_bar $db $user_id "" index.tcl]"
+
+################################################################
+
+
+set query "select 
+ ticket_issues.msg_id,
+ ticket_issues.ticket_type, 
+ ticket_issues.one_line,
+ ticket_issues.status,
+ ticket_issues.severity,
+ ticket_issues.posting_time,
+ users.email,
+ ticket_assignees(msg_id) as ticket_assignees,
+ ticket_projects.title as project_title,
+ ticket_projects.project_id,
+ ticket_issues.priority, 
+ to_char(ticket_issues.modification_time, 'MM/DD/YY') as modification_time_pretty,
+ to_char(ticket_issues.posting_time, 'MM/DD/YY') as creation_time_pretty,
+ to_char(ticket_issues.close_date, 'MM/DD/YY') as close_date_pretty,
+ to_char(ticket_issues.deadline, 'MM/DD/YY') as deadline_pretty,
+ case when deadline < sysdate() then 1 else -1 end as pastdue,
+ ticket_issues.public_p
+from $issue_table ticket_issues, ticket_projects, users
+where
+ticket_user_can_see_project_p($user_id, ticket_projects.project_id)='t'
+and users.user_id = ticket_issues.user_id
+and ticket_projects.project_id = ticket_issues.project_id
+$assignment_filter
+$status_filter
+$date_filter
+order by $order_by, ticket_issues.priority, ticket_issues.posting_time"
+
+# set vars and generate the summary
+set this_url "index.tcl"
+set display_project_p 1
+append results [ticket_summary_display]
+
+ns_write  "
+$results
+<ul>
+<li>Summarize by 
+    <a href=\"project-summary.tcl\">project</a> |
+    <a href=\"user-summary.tcl\">user</a> |
+    <a href=\"by-creation-user.tcl\">creator</a>
+   
+
+<p>
+
+<li>Add new 
+   <a href=\"issue-new.tcl\">issue</a>
+
+<p>
+
+<FORM method=get action=issue-view.tcl>
+<li>Search by Ticket # <INPUT TYPE=text name=msg_id> <input type=submit value=search></form>
+
+</ul>
+
+
+
+</blockquote>
+
+[ad_footer]
+"
Index: web/openacs/www/new-ticket/issue-add-attachment-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-add-attachment-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-add-attachment-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,26 @@
+set_the_usual_form_variables
+# msg_id file filename
+
+validate_integer msg_id $msg_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![ticket_user_can_edit_issues_p $user_id [list $msg_id] $db]} {
+    ticket_deny_access
+    return
+}
+
+set original_filename [ns_queryget file]
+set tmp_filename [ns_queryget file.tmpfile]
+
+set ok_filename [ticket_filename_generate $msg_id $original_filename]
+
+# Copy the file
+ns_cp $tmp_filename [project_ticket_attachments_path]$ok_filename
+
+ns_db dml $db "insert into ticket_issues_attachments (msg_id, attachment_name, filename) values ($msg_id, '[DoubleApos $filename]', '$ok_filename')"
+
+ns_returnredirect "issue-view.tcl?[export_url_vars msg_id]"
+
Index: web/openacs/www/new-ticket/issue-add-attachment.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-add-attachment.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-add-attachment.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,18 @@
+set_the_usual_form_variables
+# msg_id
+
+validate_integer msg_id $msg_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![ticket_user_can_edit_issues_p $user_id [list $msg_id] $db]} {
+    ticket_deny_access
+    return
+}
+
+set selection [ns_db 1row $db "select title,project_id from ticket_projects where project_id=(select project_id from ticket_issues where msg_id=$msg_id)"]
+set_variables_after_query
+
+ad_return_template
Index: web/openacs/www/new-ticket/issue-assign-user.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-assign-user.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-assign-user.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,38 @@
+set_the_usual_form_variables
+
+# msg_id, assignee_id, project_id
+
+validate_integer msg_id $msg_id
+validate_integer assignee_id $assignee_id
+
+set user_id [ad_get_user_id]
+set db [ticket_getdbhandle]
+
+if {![info exists assignee_id] || [empty_string_p $assignee_id]} {
+    ad_return_complaint 1 "<li>You did not specify a user to assign to this ticket.\n"
+    return
+}
+
+if {![ticket_user_can_edit_issues_p $user_id $msg_id $db]} {
+    ticket_deny_access
+    return
+}
+
+
+if {[database_to_tcl_string $db  "select count(*) from ticket_issue_assignments where user_id=$assignee_id and msg_id=$msg_id"] > 0} {
+    # do nothing, ticket is already assigned (this should not happen unless
+    # someone resubmits a page by accident
+} else {
+    ns_db dml $db "insert into ticket_issue_assignments (msg_id, user_id, active_p) VALUES  ($msg_id, $assignee_id, 't')"
+
+
+    if {[catch {
+	# notify user of assignment to an issue
+	ticket_notify_user $db $assignee_id $msg_id 1
+    } errmsg]} {
+	ad_return_warning "Email Server Not Responding" "<b>Important</b>: your specified email server is not responding, thus the user you just assigned did not receive email notification that he/she was assigned this issue. The assignment <b>has been made</b> however, and will show up in that user's workspace. You can now <a href=issue-view.tcl?[export_url_vars msg_id]>continue editing the issue</a>."
+	return
+    }
+}
+
+ns_returnredirect "issue-view.tcl?msg_id=$msg_id"
Index: web/openacs/www/new-ticket/issue-change-log.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-change-log.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-change-log.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,82 @@
+# This page is for viewing issue change history as a privileged user - 
+# 
+# form vars: msg_id, one_line
+#
+#
+# Most data fields are modifiable
+
+set_form_variables
+
+validate_integer msg_id $msg_id
+
+set user_id [ad_get_user_id]
+set db [ticket_getdbhandle]
+
+# check perms
+set project_id [database_to_tcl_string $db "select project_id from ticket_issues where msg_id=$msg_id"]
+
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+ReturnHeaders
+
+set selection [ns_db 1row  $db "select ticket_type, one_line, ticket_issues.project_id, ticket_projects.title from ticket_issues, ticket_projects
+where msg_id = $msg_id
+and ticket_issues.project_id = ticket_projects.project_id"]
+set_variables_after_query
+
+ns_write "[ad_header [clean_up_html $one_line]]"
+
+ns_write "
+<h2>$ticket_type \#$msg_id: [clean_up_html $one_line]</h2>
+[ad_context_bar_ws_or_index [list "[ticket_url_stub]/index.tcl" "Ticket Tracker"] [list "project-top.tcl?project_id=$project_id" $title] [list "issue-view.tcl?msg_id=$msg_id" "Ticket \#$msg_id"] "View Change History"]
+
+<hr>
+"
+
+
+
+set selection [ns_db select $db "select 
+first_names as who_first_names, last_name as who_last_name, who, what, old_value, new_value , 
+modification_date
+from  ticket_changes , users
+where msg_id = $msg_id
+and ticket_changes.who=users.user_id::varchar"]
+
+ns_write "
+<table border=1>
+<tr>
+<th>Who</th>
+<th>What</th>
+<th>Old Value</th>
+<th>New Value</th>
+<th>When</th>
+</tr>
+"
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    ns_write "<tr>
+<td>$who_first_names $who_last_name</td>
+<td>$what</td>
+<td>$old_value</td>
+<td>$new_value</td>
+<td>$modification_date</td>
+</tr>"
+} 
+
+ns_write "</table>"
+
+ns_write "
+<p>
+<a href=issue-view.tcl?msg_id=$msg_id>View issue</a>
+<p>
+"
+
+ns_write "
+[ad_footer]"
+
+
+
Index: web/openacs/www/new-ticket/issue-change-priority-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-change-priority-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-change-priority-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,103 @@
+# User is modifying the priority of this ticket.
+# An explanatory comment is in message
+
+set_the_usual_form_variables
+# msg_id, message, priorty, public_p
+
+validate_integer msg_id $msg_id
+
+set user_id [ad_get_user_id]
+set db [ticket_getdbhandle]
+
+# check perms
+set project_id [database_to_tcl_string $db "select project_id from ticket_issues where msg_id=$msg_id"]
+
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+# responses from admins are defaultly private
+if {![info exists public_p]} { 
+    set public_p "f"
+}
+
+set exception_text ""
+set exception_count 0
+
+
+if {![info exists public_p]} {
+    set public_p "f"
+}
+
+if {![info exists notify_creator_p]} {
+    set notify_creator_p "f"
+}
+
+if [catch { set n_previous [database_to_tcl_string $db "select count(*)
+from ticket_issue_responses
+where response_to = $msg_id
+and user_id = $user_id
+and dbms_lob.instr(message,'[bboard_convert_plaintext_to_html $message]') > 0"]} errmsg] {
+    ns_log Notice "failed trying to look up previous posting: $errmsg"
+} else {
+    # lookup succeeded
+    if { $n_previous > 0 } {
+	incr exception_count
+	append exception_text "<li>There are already $n_previous responses from you with the same body.
+Perhaps you already posted this?
+If you are sure that you also want to add this issue, 
+back up and change at least one character in the subject 
+or message area, then resubmit."
+    }
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# gets around clob driver problem with and empty string
+if [empty_string_p $message] {
+    set message " "
+}
+
+set selection [ns_db 1row $db "select one_line, title, 
+ticket_issues.project_id, notify_p
+from ticket_issues, ticket_projects
+where ticket_issues.project_id = ticket_projects.project_id
+and msg_id = $msg_id"]
+set_variables_after_query
+
+set message_in_html [bboard_convert_plaintext_to_html $message]
+
+with_transaction $db {
+
+    update_last_modified_info $db $msg_id
+
+    ns_db dml $db "update ticket_issues 
+set priority = $priority where msg_id = $msg_id"
+    ns_ora clob_dml $db "insert into ticket_issue_responses (response_id,response_to,user_id,message,posting_time, public_p) values (ticket_response_id_sequence.nextval,$msg_id,$user_id,empty_clob(),sysdate, '$public_p') returning message into :1" $message_in_html
+
+    # send notifcation email
+    if { $notify_p == "t" } {
+	send_ticket_change_notification $db $msg_id $message $user_id $notify_creator_p
+    }
+
+} {
+    # something went a bit wrong during the insert
+    ns_return 200 text/html "[ad_header "Error Modifying Issue"]
+<h3>Ouch!!</h3>
+<hr>
+We encountered a problem modifying your issue.
+Here was the bad news from the database:
+<pre>
+$errmsg
+</pre>
+[ad_footer]
+"
+    return
+}
+
+
+ns_returnredirect "issue-view.tcl?msg_id=$msg_id"
\ No newline at end of file
Index: web/openacs/www/new-ticket/issue-change-priority.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-change-priority.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-change-priority.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,46 @@
+set_form_variables
+# msg_id, priority
+
+validate_integer msg_id $msg_id
+
+set user_id [ad_get_user_id]
+set db [ticket_getdbhandle]
+
+# check perms
+set project_id [database_to_tcl_string $db "select project_id from ticket_issues where msg_id=$msg_id"]
+
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set selection [ns_db 1row $db "select one_line, 
+ticket_issues.project_id, ticket_projects.title
+from ticket_issues, ticket_projects
+where msg_id = $msg_id
+and ticket_projects.project_id = ticket_issues.project_id"]
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "[ad_header "Change Priority"]
+<h2>Change Priority</h2>
+<a href=\"issue-view.tcl?msg_id=$msg_id\">[clean_up_html $one_line]</a>
+for project <a href=\"project-top.tcl?project_id=$project_id\">$title</a>
+in <a href=\"index.tcl\">[ticket_system_name]</a>
+<hr>
+Please say why you are changing the priority of this issue.
+<form action=\"issue-change-priority-2.tcl\" method=get>
+[export_form_vars msg_id priority]
+<textarea name=message rows=10 cols=70 wrap=physical></textarea>
+"
+# admins have the option of making a response public or private.
+ns_write "<p><input type=checkbox name=public_p value=t>Make this response publicly readable?
+    <p><input type=checkbox name=notify_creator_p value=t>Send email notification to this ticket's creator?<p>"
+
+ns_write "
+
+<center><input type=submit value=Submit></center>
+</form>
+[ad_footer]
+"
Index: web/openacs/www/new-ticket/issue-changed-status-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-changed-status-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-changed-status-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,106 @@
+# User is changing status this ticket.
+# An explanatory comment is in message
+
+set_the_usual_form_variables
+# msg_id, message, status
+# notify_creator_p
+
+validate_integer msg_id $msg_id
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+# check perms
+set project_id [database_to_tcl_string $db "select project_id from ticket_issues where msg_id=$msg_id"]
+
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set exception_text ""
+set exception_count 0
+
+
+if {![empty_string_p [string trim $message]]} {
+    if [catch { set n_previous [database_to_tcl_string $db "select count(*)
+from ticket_issue_responses
+where response_to = $msg_id
+and user_id = $user_id
+and dbms_lob.instr(message,'[bboard_convert_plaintext_to_html $message]') > 0"]} errmsg] {
+       ns_log Notice "failed trying to look up previous posting: $errmsg"
+    } else {
+    # lookup succeeded
+	if { $n_previous > 0 } {
+	    incr exception_count
+	    append exception_text "<li>There are already $n_previous responses from you with the same body.
+Perhaps you already posted this?
+If you are sure that you also want to add this issue, 
+back up and change at least one character in the subject 
+or message area, then resubmit."
+    }
+  }
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# gets around clob driver problem with and empty string
+if [empty_string_p $message] {
+    set message " "
+}
+
+set selection [ns_db 1row $db "select one_line, title, 
+ticket_issues.project_id, notify_p
+from ticket_issues, ticket_projects
+where ticket_issues.project_id = ticket_projects.project_id
+and msg_id = $msg_id"]
+set_variables_after_query
+
+set message_in_html [bboard_convert_plaintext_to_html $message]
+
+if {![info exists notify_creator_p]} {
+    set notify_creator_p "f"
+}
+
+with_transaction $db {
+    
+    update_last_modified_info $db $msg_id 
+
+    if {[string compare $status "closed"] == 0} {
+
+	ns_db dml $db "update ticket_issues 
+	set modification_time = sysdate(), close_date = sysdate(), closed_by = $user_id, status='closed'  where msg_id = $msg_id"
+    } else {
+	ns_db dml $db "update ticket_issues 
+	set status='$status', modification_time = sysdate() where msg_id = $msg_id"
+    }
+
+    if {![empty_string_p [string trim $message]]} {
+	ns_db dml $db "insert into ticket_issue_responses (response_id,response_to,user_id,message,posting_time) values (nextval('ticket_response_id_sequence'),$msg_id,$user_id,'[DoubleApos $message_in_html]',sysdate())"
+    }
+
+    # send notifcation email
+    if { $notify_p == "t" } {
+	    send_ticket_change_notification $db $msg_id $message $user_id $notify_creator_p
+    }
+} {
+    # something went a bit wrong during the insert
+    ns_return 200 text/html "[ad_header "Error Closing Issue"]
+<h3>Ouch!!</h3>
+<hr>
+We encountered a problem closing your issue.
+Here was the bad news from the database:
+<pre>
+$errmsg
+</pre>
+[ad_footer]
+"
+    return
+}
+
+
+ns_returnredirect "index.tcl"
\ No newline at end of file
Index: web/openacs/www/new-ticket/issue-changed-status.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-changed-status.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-changed-status.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,43 @@
+# Ask for a comment from user when status is being modified
+set_form_variables
+# msg_id, status
+
+validate_integer msg_id $msg_id
+
+set user_id [ad_get_user_id]
+set db [ticket_getdbhandle]
+
+# check perms
+set project_id [database_to_tcl_string $db "select project_id from ticket_issues where msg_id=$msg_id"]
+
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set selection [ns_db 1row $db "select one_line, 
+ticket_issues.project_id, ticket_projects.title
+from ticket_issues, ticket_projects
+where msg_id = $msg_id
+and ticket_projects.project_id = ticket_issues.project_id"]
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "[ad_header "Changing Issue Status To $status"]
+<h2>Change Issue Status To $status</h2>
+<a href=\"issue-view.tcl?msg_id=$msg_id\">[clean_up_html $one_line]</a>
+for project <a href=\"project-top.tcl?project_id=$project_id\">$title</a>
+in <a href=\"index.tcl\">[ticket_system_name]</a>
+<hr>
+Please say why you are changing the status of this issue to $status.
+<form action=\"issue-changed-status-2.tcl\" method=get>
+[export_form_vars msg_id status]
+<textarea name=message rows=10 cols=70 wrap=physical></textarea>
+<p><input type=checkbox name=public_p checked value=t>Make this response publicly readable?
+<p><input type=checkbox name=notify_creator_p value=t>Send email notification to this ticket's creator?
+<p><input type=checkbox name=preformat value=yes> Preserve fixed text formatting?
+<center><input type=submit value=Submit></center>
+</form>
+[ad_footer]
+"
Index: web/openacs/www/new-ticket/issue-close-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-close-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-close-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,97 @@
+# User is closing this ticket.
+# An explanatory comment is in message
+
+set_the_usual_form_variables
+# msg_id, message, fixed_release_id
+# notify_creator_p
+
+validate_integer msg_id $msg_id
+validate_integer_or_null fixed_release_id $fixed_release_id
+
+set user_id [ad_get_user_id]
+set db [ticket_getdbhandle]
+
+
+# check perms
+set project_id [database_to_tcl_string $db "select project_id from ticket_issues where msg_id=$msg_id"]
+
+if {![ticket_user_can_close_issue_p $user_id $msg_id $db] && 
+    ![ticket_user_can_admin_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set exception_text ""
+set exception_count 0
+
+if [catch { set n_previous [database_to_tcl_string $db "select count(*)
+from ticket_issue_responses
+where response_to = $msg_id
+and user_id = $user_id
+and dbms_lob.instr(message,'[bboard_convert_plaintext_to_html $message]') > 0"]} errmsg] {
+    ns_log Notice "failed trying to look up previous posting: $errmsg"
+} else {
+    # lookup succeeded
+    if { $n_previous > 0 } {
+	incr exception_count
+	append exception_text "<li>There are already $n_previous responses from you with the same body.
+Perhaps you already posted this?
+If you are sure that you also want to add this issue, 
+back up and change at least one character in the subject 
+or message area, then resubmit."
+    }
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# gets around clob driver problem with and empty string
+if [empty_string_p $message] {
+    set message " "
+}
+
+set selection [ns_db 1row $db "select one_line, title, 
+ticket_issues.project_id, notify_p
+from ticket_issues, ticket_projects
+where ticket_issues.project_id = ticket_projects.project_id
+and msg_id = $msg_id"]
+set_variables_after_query
+
+set message_in_html [bboard_convert_plaintext_to_html $message]
+set QQmessage_in_html [DoubleApos $message_in_html]
+
+if {![info exists notify_creator_p]} {
+    set notify_creator_p "f"
+}
+
+with_transaction $db {
+
+    update_last_modified_info $db $msg_id 
+
+    set response_id [db_sequence_nextval $db ticket_response_id_sequence]
+    
+    ns_db dml $db "insert into ticket_issue_responses (response_id,response_to,user_id,message,posting_time) values ($response_id,$msg_id,$user_id,'$QQmessage_in_html',sysdate())"
+
+    database_to_tcl_string $db "select ticket_update_for_response($response_id)"
+
+    ns_db dml $db "update ticket_issues 
+    set close_date = sysdate(), closed_by = $user_id, status='closed', fixed_release_id='$fixed_release_id'  where msg_id = $msg_id"
+} {
+    # something went a bit wrong during the insert
+    ns_return 200 text/html "[ad_header "Error Closing Issue"]
+<h3>Ouch!!</h3>
+<hr>
+We encountered a problem closing your issue.
+Here was the bad news from the database:
+<pre>
+$errmsg
+</pre>
+[ad_footer]
+"
+    return
+}
+
+
+ns_returnredirect "index.tcl"
Index: web/openacs/www/new-ticket/issue-close.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-close.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-close.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,45 @@
+set_form_variables
+# msg_id
+
+validate_integer msg_id $msg_id
+
+set user_id [ad_get_user_id]
+set db [ticket_getdbhandle]
+
+# check perms
+set project_id [database_to_tcl_string $db "select project_id from ticket_issues where msg_id=$msg_id"]
+
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set selection [ns_db 1row $db "select one_line, 
+ticket_issues.project_id, project_full_name(ticket_projects.project_id) as title, fixed_release_id
+from ticket_issues, ticket_projects
+where msg_id = $msg_id
+and ticket_projects.project_id = ticket_issues.project_id"]
+set_variables_after_query
+
+ReturnHeaders
+
+set return_url "issue-close.tcl?[export_url_vars msg_id]"
+set return_pretty_name "Closing Issue #$msg_id: $one_line"
+
+ns_write "[ad_header "Close Issue"]
+<h2>Close Issue</h2>
+<a href=\"issue-view.tcl?msg_id=$msg_id\">[clean_up_html $one_line]</a>
+for project <a href=\"project-top.tcl?project_id=$project_id\">$title</a>
+in <a href=\"index.tcl\">[ticket_system_name]</a>
+<hr>
+Please say why you are closing this issue.
+<form action=\"issue-close-2.tcl\" method=get>
+[export_form_vars msg_id]
+<textarea name=message rows=10 cols=70 wrap=physical></textarea>
+<p>
+If issue has been fixed, in which release? [ticket_release_select $project_id fixed_release_id $fixed_release_id $db] (<a href=releases.tcl?[export_url_vars project_id return_url return_pretty_name]>manage releases</a>)<p>
+<p><input type=checkbox CHECKED name=public_p value=t>Make this response publicly readable?
+<center><input type=submit value=Submit></center>
+</form>
+[ad_footer]
+"
Index: web/openacs/www/new-ticket/issue-deassign-user.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-deassign-user.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-deassign-user.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,27 @@
+set_the_usual_form_variables
+# msg_id, assignee_id
+
+validate_integer msg_id $msg_id
+validate_integer assignee_id $assignee_id
+
+set user_id [ad_get_user_id]
+set db [ticket_getdbhandle]
+
+# permissions
+if {![ticket_user_can_edit_issues_p $user_id $msg_id $db]} {
+    ticket_deny_access
+    return
+}
+
+ns_db dml $db "delete from ticket_issue_assignments 
+WHERE user_id=$assignee_id AND msg_id=$msg_id"
+
+if {[catch {
+    # notify user of assignment to an issue
+    ticket_notify_user $db $assignee_id $msg_id 0
+} errmsg]} {
+    ad_return_warning "Email Server Not Responding" "<b>Important</b>: your specified email server is not responding, thus the user you just deassigned did not receive email notification that he/she was deassigned from this issue. The deassignment <b>has been performed</b> however, and will no longer show up in that user's workspace. You can now <a href=issue-view.tcl?[export_url_vars msg_id]>continue editing the issue</a>."
+    return
+}
+
+ns_returnredirect "issue-view.tcl?msg_id=$msg_id"
Index: web/openacs/www/new-ticket/issue-download-attachment.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-download-attachment.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-download-attachment.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,20 @@
+set_the_usual_form_variables
+# msg_id attachment_name
+
+validate_integer msg_id $msg_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![ticket_user_can_see_issues_p $user_id [list $msg_id] $db]} {
+    ticket_deny_access
+    return
+}
+
+set path_stub [database_to_tcl_string $db "select filename from ticket_issues_attachments where msg_id=$msg_id and attachment_name='[DoubleApos $attachment_name]'"]
+
+set full_path [project_ticket_attachments_path]$path_stub
+
+ns_returnfile 200 [ns_guesstype $full_path] $full_path
+
Index: web/openacs/www/new-ticket/issue-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-edit.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,90 @@
+set_the_usual_form_variables
+
+# msg_id, deadline, status, one_line, ticket_type
+# privacy
+#
+# prev_priority prev_status 
+
+validate_integer msg_id $msg_id
+
+set user_id [ad_get_user_id]
+set db [ticket_getdbhandle]
+
+# check perms
+set project_id [database_to_tcl_string $db "select project_id from ticket_issues where msg_id=$msg_id"]
+
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set formdata [ns_set copy [ns_conn form]]
+
+if {[empty_string_p [set ColValue.deadline.month]] && [empty_string_p [set ColValue.deadline.day]]} {
+    ns_set update $formdata ColValue.deadline.year ""
+}
+
+if [catch {ns_dbformvalue $formdata deadline date deadline} error] {
+    ad_return_complaint 1 "<li>Error parsing the deadline date: $error
+<br>Please specify a month, day, and four digit year for the deadline.\n"
+    return
+}
+
+ns_db dml $db "begin transaction"
+
+update_last_modified_info $db $msg_id 
+
+if {$deadline == ""} {
+    set deadline_sql "NULL"
+} else {
+    set deadline_sql "'$deadline'"
+}
+
+ns_db dml $db "update ticket_issues set deadline = $deadline_sql, 
+one_line = '$QQone_line',
+severity = '$severity',
+status='$QQstatus',
+ticket_type='$QQticket_type', 
+privacy = [db_null_sql $privacy],
+project_id= '$project_id',
+release_id= '$release_id'
+where
+msg_id = $msg_id"
+
+foreach custom_field [ticket_custom_field_get_project_fields $project_id] {
+    if {[info exists [ticket_custom_field_varname [lindex $custom_field 1]]]} {
+	ns_db dml $db "update ticket_projects_field_vals 
+	set field_val= '[DoubleApos [set [ticket_custom_field_varname [lindex $custom_field 1]]]]'
+	where
+	project_id= $project_id and 
+	field_id= [lindex $custom_field 0] and 
+	issue_id= $msg_id"
+
+	set n_rows [db_resultrows $db]
+    } else {
+	set n_rows 0
+    }
+
+    if {$n_rows == 0} {
+	ns_db dml $db "insert into ticket_projects_field_vals (project_id, field_id, issue_id, field_val) values ($project_id, [lindex $custom_field 0], $msg_id, '')"
+    }
+}
+
+ns_db dml $db "end transaction"
+
+
+#  foreach field [ticket_picklist_field_names] {
+#      if {[info exists $field]} {
+#  	set entry [ticket_picklist_field_info $field]
+#  	set column_name [ticket_picklist_entry_column_name $entry]
+#  	ns_db dml $db "update ticket_issues set $column_name = '[DoubleApos [set $field]]' 
+#  	where
+#  	msg_id = $msg_id"
+#      }
+#  }
+
+if { [string compare $prev_status $status] != 0} {
+    ns_returnredirect "issue-changed-status.tcl?[export_url_vars msg_id status]"
+} else {
+    ns_returnredirect "issue-view.tcl?[export_url_vars msg_id]"
+}
Index: web/openacs/www/new-ticket/issue-fix-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-fix-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-fix-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,102 @@
+# User is moving  this ticket to "fixed waiting approval" status.
+# An explanatory comment is in message
+
+set_the_usual_form_variables
+
+# msg_id, message
+# notify_creator_p
+
+validate_integer msg_id $msg_id
+
+set user_id [ad_get_user_id]
+set db [ticket_getdbhandle]
+
+# check perms
+set project_id [database_to_tcl_string $db "select project_id from ticket_issues where msg_id=$msg_id"]
+
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+#  if {![info exist fixed_release_id] || $fixed_release_id == ""} {
+#      ad_return_complaint "No Release Specified" "You didn't specify a release for your fix, and that's no longer cool."
+#      return
+#  }
+
+set exception_text ""
+set exception_count 0
+
+if [catch { set n_previous [database_to_tcl_string $db "select count(*)
+from ticket_issue_responses
+where response_to = $msg_id
+and user_id = $user_id
+and dbms_lob.instr(message,'[bboard_convert_plaintext_to_html $message]') > 0"]} errmsg] {
+    ns_log Notice "failed trying to look up previous posting: $errmsg"
+} else {
+    # lookup succeeded
+    if { $n_previous > 0 } {
+	incr exception_count
+	append exception_text "<li>There are already $n_previous responses from you with the same body.
+Perhaps you already posted this?
+If you are sure that you also want to add this issue, 
+back up and change at least one character in the subject 
+or message area, then resubmit."
+    }
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# gets around clob driver problem with and empty string
+if [empty_string_p $message] {
+    set message " "
+}
+
+set selection [ns_db 1row $db "select one_line, title, 
+ticket_issues.project_id, notify_p
+from ticket_issues, ticket_projects
+where ticket_issues.project_id = ticket_projects.project_id
+and msg_id = $msg_id"]
+set_variables_after_query
+
+set message_in_html [bboard_convert_plaintext_to_html $message]
+set QQmessage_in_html [DoubleApos $message_in_html]
+
+#  if {![info exists notify_creator_p]} {
+#      set notify_creator_p "f"
+#  }
+
+with_transaction $db {
+
+    update_last_modified_info $db $msg_id 
+
+    set response_id [db_sequence_nextval $db ticket_response_id_sequence]
+
+    ns_db dml $db "insert into ticket_issue_responses (response_id,response_to,user_id,message,posting_time) values ($response_id,$msg_id,$user_id,'$QQmessage_in_html',sysdate())"
+
+    database_to_tcl_string $db "select ticket_update_for_response($response_id)"
+
+    ns_db dml $db "update ticket_issues 
+    set status='fixed waiting approval',
+    fixed_release_id='$fixed_release_id'
+    where msg_id = $msg_id"
+} {
+    # something went a bit wrong during the insert
+    ns_return 200 text/html "[ad_header "Error Changing Issue Status"]
+<h3>Ouch!!</h3>
+<hr>
+We encountered a problem processing your entry.
+Here was the bad news from the database:
+<pre>
+$errmsg
+</pre>
+[ad_footer]
+"
+    return
+}
+
+
+ns_returnredirect "project-top.tcl?project_id=$project_id"
\ No newline at end of file
Index: web/openacs/www/new-ticket/issue-fix.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-fix.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-fix.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,46 @@
+set_form_variables
+# msg_id
+
+validate_integer msg_id $msg_id
+
+set user_id [ad_get_user_id]
+
+set db [ticket_getdbhandle]
+
+# check perms
+set project_id [database_to_tcl_string $db "select project_id from ticket_issues where msg_id=$msg_id"]
+
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set selection [ns_db 1row $db "select one_line, 
+ticket_issues.project_id, project_full_name(ticket_projects.project_id) as title, fixed_release_id
+from ticket_issues, ticket_projects
+where msg_id = $msg_id
+and ticket_projects.project_id = ticket_issues.project_id"]
+set_variables_after_query
+
+ReturnHeaders
+
+set return_url "issue-fix.tcl?[export_url_vars msg_id]"
+set return_pretty_name "Fix Issue #$msg_id: $one_line"
+
+ns_write "[ad_header "Fix Issue"]
+<h2>Fix Issue</h2>
+<a href=\"issue-view.tcl?msg_id=$msg_id\">[clean_up_html $one_line]</a>
+for project <a href=\"project-top.tcl?project_id=$project_id\">$title</a>
+in <a href=\"index.tcl\">[ticket_system_name]</a>
+<hr>
+Please say why are changing the status of this issue.
+<form action=\"issue-fix-2.tcl\" method=get>
+[export_form_vars msg_id]
+<textarea name=message rows=10 cols=70 wrap=physical></textarea>
+<p>
+Release of Fix:  [ticket_release_select $project_id fixed_release_id $fixed_release_id $db] (<a href=releases.tcl?[export_url_vars project_id return_url return_pretty_name]>manage releases</a>)<p>
+<p><input type=checkbox CHECKED name=public_p value=t>Make this response publicly readable?
+<center><input type=submit value=Submit></center>
+</form>
+[ad_footer]
+"
Index: web/openacs/www/new-ticket/issue-new-1.5.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-new-1.5.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-new-1.5.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,119 @@
+set_form_variables 0
+# project_id
+
+validate_integer project_id $project_id
+
+set user_id [ad_get_user_id]
+
+set db [ticket_getdbhandle]
+
+set default_assignee ""
+
+# Permission Check
+if {![ticket_user_can_add_issues $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set raw_project_title [database_to_tcl_string $db "select project_full_name(project_id) as title 
+from ticket_projects
+where project_id = $project_id"]
+set project_title "for $raw_project_title, "
+
+# Get list of default user info
+set selection [ns_db 1row $db "select email, users.first_names || ' ' || users.last_name as pretty_name
+ from users
+ where  users.user_id = $user_id"]
+
+set_variables_after_query
+
+# Admin users get to choose project. 
+# Normal users are assigned automatially to "Tech Support" project
+
+ReturnHeaders
+
+append page "[ad_header "Create New Issue"]
+
+<h2>Create new issue</h2>
+
+[ad_context_bar_ws_or_index [list "[ticket_admin_url_stub]/index.tcl" "Ticket Tracker"]  "Create Ticket"]
+
+<hr>
+
+<blockquote>
+<form action=\"issue-new-2.tcl\" method=get>
+[export_form_vars project_id]
+
+<table border=0>"
+
+
+append page "<tr><th align=left>Subject:<td><input type=text name=one_line size=50</tr>"
+
+append page "<tr>
+<th valign=top align=left>Ticket Type:</th><td><select name=ticket_type>[ticket_html_select_ticket_type]</select>
+"
+
+if {[ticket_privacy_enabled_p]} {
+    append page "&nbsp;&nbsp;&nbsp; Privacy Level: [make_html_select privacy {{"" "(not set)"} 1 2 3 4 5}]"
+} else {
+    append page "[philg_hidden_input privacy ""]"
+}
+
+append page "</td></tr>"
+
+append page "
+<tr><th align=left>Project:
+    <td>$raw_project_title
+    </td></tr>
+"
+
+append page "
+<tr><td align=left><b>Severity:</b><td>
+<select name=severity>
+[ad_generic_optionlist [ticket_severity_types] [ticket_severity_types] normal]
+</select></td></tr>
+"
+
+
+append page "<tr><th align=left>Deadline:</th><td>[ticket_dateentrywidget_with_nulls deadline [export_var deadline [database_to_tcl_string $db "select date_part('year',sysdate()) from dual"]]]</td></tr>
+
+"
+
+
+## System-wide custom fields are stupid (ben@mit.edu)
+## We now have project-specific things
+#  foreach field [ticket_picklist_field_names] { 
+#      append page "<tr>[ticket_picklist_html_fragment $field]</tr>\n"
+#  }
+set selection [ns_db select $db "select field_name, field_pretty_name, field_type, field_vals from ticket_projects_fields where project_id=$project_id"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    append page "<tr><th align=left>$field_pretty_name</th><td>[ticket_custom_field_entry_form $field_type $field_name $field_vals]</td></tr>"
+}
+
+append page "<tr><th align=left>Release:</th>
+<td>[ticket_release_select $project_id release_id "" $db]</td></tr>\n"
+
+append page "
+<tr><th valign=top  align=left>Notify Project Members<br>(via email)</th>
+    <td valign=top><input type=radio name=notify_p value=t> Yes
+        <input type=radio name=notify_p value=f CHECKED> No</tr>
+"
+
+
+
+append page "<tr><th align=left>Message<td></tr>
+</table>
+<textarea name=message rows=10 cols=64 wrap=hard></textarea>
+<br>
+<b>Preserve fixed formatting of message?</b> <input type=checkbox checked name=preformat value=yes>
+<br>
+<center><input type=submit value=Submit></center>
+</form>
+</blockquote>
+[ad_footer]
+"
+
+ns_write $page
Index: web/openacs/www/new-ticket/issue-new-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-new-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-new-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,254 @@
+set_the_usual_form_variables
+
+# project_id, one_line, notify_p, message, priority
+#
+# ticket_type
+# 
+# and any defined picklist field names
+# 
+
+validate_integer project_id $project_id
+
+set url "[ns_conn location][ticket_admin_url_stub]"
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+# check perms
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+
+set formdata [ns_set copy [ns_conn form]]
+
+if {[empty_string_p [set ColValue.deadline.month]] && [empty_string_p [set ColValue.deadline.day]]} {
+    ns_set update $formdata ColValue.deadline.year ""
+}
+
+if [catch {ns_dbformvalue $formdata deadline date deadline} error] {
+    ad_return_complaint 1 "<li>Error parsing the deadline date: $error
+<br>Please specify a month, day, and four digit year for the deadline.\n"
+    return
+}
+
+# check input
+set exception_text ""
+set exception_count 0
+
+set selection [ns_db 1row $db "select email, first_names, last_name from users where user_id = $user_id"]
+
+set_variables_after_query
+
+
+set name "$first_names $last_name"
+set QQemail [DoubleApos $email]
+set QQname [DoubleApos $name]
+
+if { ![info exists project_id] || $project_id == "" } {
+    incr exception_count
+    append exception_text "<li>You somehow got here without a project specified.\n"
+}
+
+if { ![info exists one_line] || $one_line == "" } {
+    incr exception_count
+    append exception_text "<li>You must enter a subject line.\n"
+}
+
+if { ![info exists notify_p] || $notify_p == "" } {
+    incr exception_count
+    append exception_text "<li>You somehow got here without specifying notification.\n"
+}
+
+if { ![info exists message] || $message == "" } {
+    incr exception_count
+    append exception_text "<li>You have to say something about the issue.\n"
+}
+
+
+if {[info exists preformat] && $preformat == "yes"} {
+    set message_in_html "<pre>
+[clean_up_html $message]
+</pre>
+" } else {
+    set message_in_html [bboard_convert_plaintext_to_html $message]
+}
+
+set QQmessage_in_html [DoubleApos $message_in_html]
+
+if [catch { set n_previous [database_to_tcl_string $db "select count(*) from ticket_issues
+where one_line = '$QQone_line'
+and project_id = $project_id
+and dbms_lob.instr(message,'[bboard_convert_plaintext_to_html $QQmessage]') > 0"]} errmsg] {
+    ns_log Notice "failed trying to look up previous posting: $errmsg"
+} else {
+    # lookup succeeded
+    if { $n_previous > 0 } {
+	incr exception_count
+	append exception_text "<li>There are already $n_previous messages in the database with the same subject line and body.  Perhaps you already posted this?  Here are the messages:
+<ul>
+"
+        set selection [ns_db select $db "select first_names || ' ' || last_name as name, email, posting_time
+from ticket_issues, users
+where one_line = '$QQone_line'
+and project_id = $project_id
+and dbms_lob.instr(message,'[DoubleApos $message]') > 0
+and ticket_issues.user_id = users.user_id"]
+
+        while {[ns_db getrow $db $selection]} {
+	    set_variables_after_query
+	    append exception_text "<li>$posting_time by $name ($email)\n"
+	}
+	append exception_text "</ul>
+If you are sure that you also want to add this issue, 
+back up and change at least one character in the subject 
+or message area, then resubmit."
+    }
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# ReturnHeaders
+
+set project_title [database_to_tcl_string $db "select title from ticket_projects where project_id = $project_id"]
+
+#  ns_write "[ad_header "Inserting a New Issue"]
+
+#  <h2>Inserting a New Issue</h2>
+
+#  [ad_context_bar_ws_or_index [list "[ticket_admin_url_stub]/index.tcl" "Ticket Tracker"]  "Ticket Created"]
+#  "
+
+#  ns_write "<hr>\n"
+
+# Collect up the picklist field values
+set picklist_columns {}
+set picklist_values {}
+foreach entry [ticket_picklist_data] {
+    set field_name [ticket_picklist_entry_field_name $entry]
+    set column_name [ticket_picklist_entry_column_name $entry]
+    lappend picklist_columns $column_name
+    lappend picklist_values "'[DoubleApos [set $field_name]]'"
+}
+
+# Tickets default to "open" status when created.
+set status "open"
+
+# Find if there is a default assignee
+set default_assignee [database_to_tcl_string_or_null $db "select default_assignee from
+ticket_projects 
+where project_id=$project_id"]
+
+#  if {[llength $picklist_columns] > 0} {
+#      set custom_values ", [join $picklist_values {,}]"
+#      set custom_field_names ",  [join $picklist_columns {,}]"
+#  } else {
+#      set custom_values ""
+#      set custom_field_names ""
+#  }
+
+with_transaction $db {
+    set new_id [database_to_tcl_string $db "select ticket_issue_id_sequence.nextval from dual"]
+    set indexed_stuff "$one_line $message $email $name $new_id"
+    set QQindexed_stuff [DoubleApos $indexed_stuff]
+
+    set deadline_sql [db_postgres_null_sql $deadline]
+
+    ns_db dml $db "insert into ticket_issues
+    (msg_id,project_id,user_id,one_line,message,indexed_stuff,posting_time, severity, notify_p, deadline, status, ticket_type, privacy, last_modified_by, release_id)
+    values ($new_id,$project_id,$user_id,'$QQone_line','$QQmessage_in_html','$QQindexed_stuff',sysdate(),'$severity','$notify_p', $deadline_sql, '$status', '$ticket_type', [db_null_sql $privacy], $user_id, '$release_id')"
+
+    # Insert the custom fields (new way of doing it per project - ben@mit.edu)
+    foreach custom_field [ticket_custom_field_get_project_fields $project_id] {
+	ns_db dml $db "insert into ticket_projects_field_vals (project_id, field_id, issue_id, field_val) values ($project_id, [lindex $custom_field 0], $new_id, '[DoubleApos [set [ticket_custom_field_varname [lindex $custom_field 1]]]]')"
+    }
+
+    if {[info exists default_assignee] && \
+	    ![empty_string_p $default_assignee]} {
+	ns_db dml $db "insert into ticket_issue_assignments (msg_id, user_id, active_p) VALUES  ($new_id, $default_assignee, 't')"
+    }
+
+    # Add the fact that this user is obviously interested in the issue
+    if {[ticket_issue_author_is_interested_p]} {
+	notification_set_user_interest $user_id [ticket_notification_class $db] $new_id $db
+    }
+    
+} {
+    # something went a bit wrong during the insert
+    ns_return 200 text/html "<h3>Ouch!!</h3>
+Here was the bad news from the database:
+<pre>
+$errmsg
+</pre>
+[ad_footer]
+"
+    return
+}
+
+set msg_id $new_id
+
+ns_returnredirect issue-view.tcl?[export_url_vars msg_id]
+
+#  ns_write "<h3>Success!!</h3>
+#  A new issue for project 
+#  <a href=\"project-top.tcl?project_id=$project_id\">$project_title</a>
+#  has been entered in the database:
+
+#  <br>
+
+#  #$new_id: [clean_up_html $one_line]
+
+#  <p>
+
+#  <FORM METHOD=POST ENCTYPE=multipart/form-data ACTION=issue-add-attachment-2.tcl>
+#  [export_form_vars msg_id]
+#  Upload an attachment: <INPUT TYPE=file name=file><br>
+#  Name of Attachment: <INPUT TYPE=text name=filename><br>
+#  <INPUT TYPE=submit value=add>
+#  </FORM>
+
+#  <p>
+
+#  You can:<br>
+#  <ul>
+#  <li><a href=\"issue-view.tcl?msg_id=$new_id\">View issue details and make assignments</a>
+#  <li><a href=\"issue-new.tcl\">Add another issue</a>
+#  <li><a href=\"project-top.tcl?[export_url_vars project_id]\">Go to project page $project_title</a>
+#  <li><a href=\"index.tcl?[export_url_vars project_id]\">Return to main page</a>
+#  </ul>
+#  "
+
+#send out the email
+
+set ticket_email [ticket_reply_email_addr]
+set extra_headers [ns_set create] 
+ns_set update $extra_headers "Reply-to" $ticket_email
+
+if { $notify_p == "t" } {
+
+    set selection [ns_db select $db "select
+email as notify_email
+from users, ticket_assignments
+where project_id = $project_id 
+and users.user_id = ticket_assignments.user_id
+"]
+
+    while { [ns_db getrow $db $selection] } { 
+	set_variables_after_query
+	ns_sendmail $notify_email $email "New issue $one_line in project $project_title (TR#$new_id)" "Priority: $priority 
+Submitted By: $name 
+Description: $message
+
+Please use $url/issue-view.tcl?msg_id=$new_id to manage this issue." $extra_headers
+        # ns_write "<br> Emailed $notify_email"
+   }
+}
+
+#  ns_write "
+#  [ad_footer]
+#  "
Index: web/openacs/www/new-ticket/issue-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-new.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-new.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,42 @@
+set_form_variables 0
+# maybe project_id
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+set check_num_projects [database_to_tcl_string $db "select count(*) from ticket_projects where ticket_user_can_see_project_p($user_id, project_id)='t'"]
+
+if {$check_num_projects == 0} {
+    ad_return_error "No Projects Available" "There are no projects to which you can add an issue!"
+    return
+}
+
+set default_assignee ""
+
+
+if {[info exists project_id]} {
+    ns_returnredirect "issue-new-1.5.tcl?[export_url_vars project_id]"
+    return
+}
+
+
+ReturnHeaders
+
+ns_write "[ad_header "Create New Issue"]
+
+<h2>Create new issue</h2>
+
+[ad_context_bar_ws_or_index [list "[ticket_url_stub]/index.tcl" "Ticket Tracker"]  "Create Ticket"]
+
+<hr>
+
+<form action=\"issue-new-1.5.tcl\" method=get>
+
+Project: [ticket_project_select project_id "" $db]
+<p>
+<input type=submit value=continue>
+</form>
+<p>
+
+[ad_footer]"
Index: web/openacs/www/new-ticket/issue-remove-user-interest.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-remove-user-interest.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-remove-user-interest.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,12 @@
+set_the_usual_form_variables
+# msg_id
+
+validate_integer msg_id $msg_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+notification_remove_user_interest $user_id [ticket_notification_class $db] $msg_id
+
+ns_returnredirect "issue-view.tcl?[export_url_vars msg_id]"
Index: web/openacs/www/new-ticket/issue-reopen-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-reopen-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-reopen-2.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,80 @@
+set_the_usual_form_variables
+# msg_id, message
+
+validate_integer msg_id $msg_id
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+# check perms
+set project_id [database_to_tcl_string $db "select project_id from ticket_issues where msg_id=$msg_id"]
+
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set exception_text ""
+set exception_count 0
+
+if [catch { set n_previous [database_to_tcl_string $db "select count(*)
+from ticket_issue_responses
+where response_to = $msg_id
+and user_id = $user_id
+and dbms_lob.instr(message,'[bboard_convert_plaintext_to_html $message]') > 0"]} errmsg] {
+    ns_log Notice "failed trying to look up previous posting: $errmsg"
+} else {
+    # lookup succeeded
+    if { $n_previous > 0 } {
+	incr exception_count
+	append exception_text "<li>There are already $n_previous responses from you with the same body.
+Perhaps you already posted this?
+If you are sure that you also want to add this issue, 
+back up and change at least one character in the subject 
+or message area, then resubmit."
+    }
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# gets around clob driver problem with and empty string
+if [empty_string_p $message] {
+    set message " "
+}
+
+set selection [ns_db 1row $db "select one_line, title, ticket_issues.project_id
+from ticket_issues, ticket_projects
+where ticket_issues.project_id = ticket_projects.project_id
+and msg_id = $msg_id"]
+set_variables_after_query
+
+set message_in_html [bboard_convert_plaintext_to_html $message]
+
+with_transaction $db {
+
+    update_last_modified_info $db $msg_id 
+
+    ns_db dml $db "update ticket_issues 
+set close_date = null, closed_by = null, status='open' where msg_id = $msg_id"
+    ns_db dml $db "insert into ticket_issue_responses (response_id,response_to,user_id,message,posting_time) values (nextval('ticket_response_id_sequence'),$msg_id,$user_id,'[DoubleApos $message_in_html]',sysdate())"
+} {
+    # something went a bit wrong during the insert
+    ns_return 200 text/html "[ad_header "Error Reopening Issue"]
+<h3>Ouch!!</h3>
+<hr>
+We encountered a problem reopening your issue.
+Here was the bad news from the database:
+<pre>
+$errmsg
+</pre>
+[ad_footer]
+"
+    return
+}
+
+
+ns_returnredirect "issue-view.tcl?msg_id=$msg_id"
\ No newline at end of file
Index: web/openacs/www/new-ticket/issue-reopen.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-reopen.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-reopen.tcl	17 Apr 2001 14:05:18 -0000	1.1
@@ -0,0 +1,40 @@
+set_form_variables
+# msg_id
+
+validate_integer msg_id $msg_id
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+# check perms
+set project_id [database_to_tcl_string $db "select project_id from ticket_issues where msg_id=$msg_id"]
+
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set selection [ns_db 1row $db "select one_line, 
+ticket_issues.project_id, ticket_projects.title
+from ticket_issues, ticket_projects
+where msg_id = $msg_id
+and ticket_projects.project_id = ticket_issues.project_id"]
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "[ad_header "Reopen Issue"]
+<h2>Reopen Issue</h2>
+<a href=\"issue-view.tcl?msg_id=$msg_id\">[clean_up_html $one_line]</a>
+for project <a href=\"project-top.tcl?project_id=$project_id\">$title</a>
+in <a href=\"index.tcl\">[ticket_system_name]</a>
+<hr>
+Please say why you are reopening this closed issue.
+<form action=\"issue-reopen-2.tcl\" method=get>
+[export_form_vars msg_id]
+<textarea name=message rows=10 cols=70 wrap=physical></textarea>
+<center><input type=submit value=Submit></center>
+</form>
+[ad_footer]
+"
Index: web/openacs/www/new-ticket/issue-response-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-response-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-response-2.tcl	17 Apr 2001 14:05:19 -0000	1.1
@@ -0,0 +1,55 @@
+set_the_usual_form_variables
+# msg_id, message, public_p
+
+validate_integer msg_id $msg_id
+
+set user_id [ad_get_user_id]
+set db [ticket_getdbhandle]
+
+# check perms
+set project_id [database_to_tcl_string $db "select project_id from ticket_issues where msg_id=$msg_id"]
+
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set exception_text ""
+set exception_count 0
+
+if {[info exists preformat] && $preformat == "yes"} {
+    set message_in_html "<pre>
+[clean_up_html $message]
+</pre>
+" } else {
+    set message_in_html [bboard_convert_plaintext_to_html $message]
+    set preformat no
+}
+
+ReturnHeaders
+
+append page "[ad_header "Preview Add Response To Ticket"]
+
+<h2>Preview New Response For Ticket #$msg_id</h2>
+
+
+<hr>
+
+Below is how your response will appear in the list of ticket responses.
+If you approve, press the Submit button below, otherwise hit back in your
+browser and try again.
+<p>
+<blockquote>
+$message_in_html
+</blockquote>
+<form action=issue-response-3.tcl method=post>
+[export_form_vars msg_id message preformat public_p]
+<center><input type=submit value=Submit>
+</center>
+</form>
+<p>
+[ad_footer]
+"
+
+
+ns_write $page
Index: web/openacs/www/new-ticket/issue-response-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-response-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-response-3.tcl	17 Apr 2001 14:05:19 -0000	1.1
@@ -0,0 +1,103 @@
+set_the_usual_form_variables
+# msg_id, message, public_p
+
+validate_integer msg_id $msg_id
+
+set user_id [ad_get_user_id]
+set db [ticket_getdbhandle]
+
+set exception_text ""
+set exception_count 0
+
+# check perms
+set project_id [database_to_tcl_string $db "select project_id from ticket_issues where msg_id=$msg_id"]
+
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+if {[info exists preformat] && $preformat == "yes"} {
+    set message_in_html "<pre>
+[clean_up_html $message]
+</pre>
+" } else {
+    set message_in_html [bboard_convert_plaintext_to_html $message]
+}
+
+set QQmessage_in_html [DoubleApos $message_in_html]
+
+if [catch { set n_previous [database_to_tcl_string $db "select count(*) 
+from ticket_issue_responses
+where response_to = $msg_id
+and user_id = $user_id
+and message like '%[DoubleApos $message_in_html]%'"]} errmsg] {
+    ns_log Notice "failed trying to look up previous posting: $errmsg"
+} else {
+    # lookup succeeded
+    if { $n_previous > 0 } {
+	incr exception_count
+	append exception_text "<li>There are already $n_previous responses from you with the same body.
+Perhaps you already posted this?
+If you are sure that you also want to add this issue, 
+back up and change at least one character in the subject 
+or message area, then resubmit."
+    }
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# Default is for customer responses to be public, but staff responses
+# to be private
+
+if {![info exists public_p]} {
+    set public_p "f"
+}
+
+if {![info exists notify_creator_p]} {
+    set notify_creator_p "f"
+}
+
+
+
+set selection [ns_db 1row $db "select one_line, title, ticket_issues.project_id, notify_p
+from ticket_issues, ticket_projects
+where ticket_issues.project_id = ticket_projects.project_id
+and msg_id = $msg_id"]
+set_variables_after_query
+
+with_transaction $db {
+    set new_response_id [database_to_tcl_string $db "select ticket_response_id_sequence.nextval from dual"]
+    ns_db dml $db "insert into ticket_issue_responses (response_id,response_to,user_id, public_p, message,posting_time) values ($new_response_id,$msg_id,$user_id, '$public_p', '$QQmessage_in_html',sysdate())"
+
+    ns_db 1row $db "select ticket_update_for_response($new_response_id)"
+} {
+    # something went a bit wrong during the insert
+    ns_return 200 text/html "[ad_header "Error Adding a Response"]
+<h3>Ouch!!</h3>
+<hr>
+We encountered a problem inserting your response.
+Here was the bad news from the database:
+<pre>
+$errmsg
+</pre>
+[ad_footer]
+"
+    return
+}
+
+
+
+#send out the email
+#  if { $notify_p == "t" } {
+#      send_ticket_change_notification $db $msg_id $message $user_id $notify_creator_p
+#  }
+
+
+ns_returnredirect "issue-view.tcl?msg_id=$msg_id"
+
+
+
Index: web/openacs/www/new-ticket/issue-response.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-response.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-response.tcl	17 Apr 2001 14:05:19 -0000	1.1
@@ -0,0 +1,44 @@
+set_form_variables
+# msg_id
+
+validate_integer msg_id $msg_id
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+# check perms
+set project_id [database_to_tcl_string $db "select project_id from ticket_issues where msg_id=$msg_id"]
+
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set selection [ns_db 1row $db "select one_line, ticket_issues.project_id, ticket_projects.title
+from ticket_issues, ticket_projects
+where msg_id = $msg_id
+and ticket_projects.project_id = ticket_issues.project_id"]
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "[ad_header "Write a Response"]
+<h2>Write a Response</h2>
+to <a href=\"issue-view.tcl?msg_id=$msg_id\">[clean_up_html $one_line]</a>
+for project <a href=\"project-top.tcl?project_id=$project_id\">$title</a>
+in <a href=\"index.tcl\">[ticket_system_name]</a>
+<hr>
+<form action=\"issue-response-2.tcl\" method=post>
+[export_form_vars msg_id]
+Enter message in textarea below, then click submit.<br>
+<textarea name=message rows=10 cols=50 wrap=physical></textarea>
+"
+
+ns_write "<p><input type=checkbox name=public_p value=t>Make this response publicly readable?
+<p>
+ <input type=checkbox name=preformat value=yes> Preserve fixed text formatting?
+<P><center><input type=submit value=Submit></center>
+</form>
+[ad_footer]
+"
Index: web/openacs/www/new-ticket/issue-search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-search.tcl	17 Apr 2001 14:05:19 -0000	1.1
@@ -0,0 +1,87 @@
+set_the_usual_form_variables
+# query_string, project_id (optional)
+#
+#
+# target - 
+# passthrough -  msg_id
+
+set db [ticket_getdbhandle]
+
+if { ![info exists query_string] || $query_string == "" } {
+    # probably using MSIE
+    ns_return 200 text/html "[ad_header "Missing Query"]
+<h2>Missing Query</h2>
+<hr>
+Either you didn't type a query string or you're using a quality Web
+browser like Microsoft Internet Explorer 3.x (which neglects to 
+pass user input up the server).
+[ad_footer]
+"
+    return
+}
+
+# we ask for all the top level messages
+
+ReturnHeaders
+
+ns_write "[ad_header "Search Results"]
+<h2>Messages matching \"$query_string\"</h2>
+in the <a href=\"index.tcl\">[ticket_system_name]</a>
+<hr>
+<ul>
+"
+
+if {[info exists project_id] && ![empty_string_p $project_id]} {
+    validate_integer project_id $project_id
+
+    set restrict_by_project_id_clause "ticket_issues.project_id = $project_id and "
+} else {
+    set restrict_by_project_id_clause " "
+}
+
+set selection [ns_db select $db "select msg_id xmsg_id , one_line, ticket_issues.project_id, ticket_projects.title from 
+ticket_issues, ticket_projects 
+where ticket_projects.project_id = ticket_issues.project_id and
+$restrict_by_project_id_clause
+ticket_user_can_see_project_p($user_id, ticket_projects.project_id)='t' and
+upper(dbms_lob.substr(indexed_stuff,4000)) like upper('%$query_string%')
+order by title, xmsg_id"]
+
+set counter 0
+
+set last_title ""
+ns_write "<ul>"
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+    if {$title != $last_title} {
+	ns_write "</ul><b>$title</b><ul>"
+    }
+    set last_title $title
+	ns_write "<li><a href=\"$target?[eval "export_url_vars $passthrough"]\">\[$xmsg_id\] [clean_up_html $one_line]</a>\n"
+}
+
+ns_write "</ul>"
+
+if { $counter == 0 } {
+    set search_items "messages"
+    ns_write "No matching items found.<p>
+    <a href=\"$target?[eval "export_url_vars $passthrough"]\">"
+}
+ns_write "
+</ul>
+[ad_footer]
+"
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/new-ticket/issue-set-user-interest.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-set-user-interest.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-set-user-interest.tcl	17 Apr 2001 14:05:19 -0000	1.1
@@ -0,0 +1,12 @@
+set_the_usual_form_variables
+# msg_id
+
+validate_integer msg_id $msg_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+notification_set_user_interest $user_id [ticket_notification_class $db] $msg_id
+
+ns_returnredirect "issue-view.tcl?[export_url_vars msg_id]"
Index: web/openacs/www/new-ticket/issue-view-with-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-view-with-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-view-with-edit.tcl	17 Apr 2001 14:05:19 -0000	1.1
@@ -0,0 +1,396 @@
+# This page is for viewing an issue as a privileged user - 
+
+# Most data fields are modifiable
+
+set_the_usual_form_variables
+
+# msg_id
+
+validate_integer msg_id $msg_id
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+# permissions
+if {![ticket_user_can_edit_issues_p $user_id $msg_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set selection [ns_db 0or1row $db "select 
+posting_time as posting_date,
+case when deadline is null then null else deadline::date end as deadline, one_line, message, priority, ticket_type,  email, first_names, 
+last_name, status, release_id
+from ticket_issues, users
+where msg_id = $msg_id
+and users.user_id = ticket_issues.user_id"]
+
+if { $selection == "" } {
+    # message was probably deleted
+    ad_return_complaint 1 "<li>Couldn't find message $msg_id."
+    return
+}
+
+set_variables_after_query
+set this_one_line $one_line
+set name "$first_names $last_name"
+
+set selection [ns_db 1row $db "select 
+ title, ticket_issues.project_id, notify_p, public_p,
+ ticket_issues.last_modified_by, 
+fixed_release_id,
+ ticket_issues.severity, 
+ ticket_issues.privacy,
+ modification_time,
+ ticket_issues.contact_name,
+ ticket_issues.contact_email,  ticket_issues.contact_info1,
+ close_date, ticket_release_name(release_id) as release
+from ticket_projects, ticket_issues
+where ticket_projects.project_id = ticket_issues.project_id
+and ticket_issues.msg_id = $msg_id
+"]
+
+set_variables_after_query
+
+
+# get current user's email, to export as the "last modified by" value
+set email [database_to_tcl_string $db "select email from users where user_id=[ad_get_user_id]"]
+
+
+#if { [empty_string_p $deadline] } {
+#    set deadline [ns_localsqltimestamp]
+#}
+
+#  if { $public_p == "t" } {
+#      set PUBLIC_Y_CHECKED checked
+#      set PUBLIC_N_CHECKED ""
+#  } else {
+#      set PUBLIC_N_CHECKED checked
+#      set PUBLIC_Y_CHECKED ""
+#  }
+
+ReturnHeaders
+
+if {[info exists deadline] && [empty_string_p $deadline]} {
+    unset deadline
+}
+
+append page "[ad_header [clean_up_html $one_line]]
+
+<h2>$ticket_type \#$msg_id: [clean_up_html $one_line]</h2>
+
+[ad_context_bar_ws_or_index [list "[ticket_admin_url_stub]/index.tcl" "Ticket Tracker"] [list "project-top.tcl?project_id=$project_id" $title] "One Ticket"]
+
+<hr>
+
+<blockquote>
+<table border=0><tr><td bgcolor=#f0f0f0>$message</td></tr></table>
+<font size=-1>
+"
+
+set selection [ns_db select $db "select attachment_name from ticket_issues_attachments where msg_id=$msg_id"]
+
+append page "<p>Attachments: "
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    append page "<a href=issue-download-attachment.tcl?[export_url_vars msg_id attachment_name]>$attachment_name</a> | "
+}
+
+append page "<a href=issue-add-attachment.tcl?[export_url_vars msg_id]>(new)</a> <p>"
+
+if {[notification_user_is_interested_p $user_id [ticket_notification_class $db] $msg_id $db]} {
+    append page "Notification <b>Enabled</b> (<A href=issue-remove-user-interest.tcl?[export_url_vars msg_id]>Disable</a>)"
+} else {
+    append page "Notification <b>Disabled</b> (<A href=issue-set-user-interest.tcl?[export_url_vars msg_id]>Enable</a>)"
+}
+
+append page "</font><p></blockquote>
+
+<form action=issue-edit.tcl method=post>
+<input type=hidden name=prev_status [export_form_value status]>
+[export_form_vars email msg_id]
+
+<blockquote>
+<table border=0 cellspacing=3>
+<tr>
+  <th valign=top align=left>Subject:</th>
+  <td><input size=64 maxsize=200 type=text name=one_line [export_form_value one_line]></td>
+<tr>
+<th valign=top align=left>Ticket Type:</th><td><select name=ticket_type>[ticket_html_select_ticket_type $ticket_type]</select>
+"
+
+if {[ticket_privacy_enabled_p]} {
+    append page "&nbsp;&nbsp;&nbsp; Privacy Level: [make_html_select privacy {{"" "(not set)"} 1 2 3 4 5} $privacy]"
+} else {
+    append page "[philg_hidden_input privacy ""]"
+}
+
+append page "
+</tr>"
+
+# Status
+append page "
+<tr><td align=left><b>Status:</b><td>"
+
+if {[string compare $status "closed"] == 0} {
+    append page "Closed (<a href=\"issue-reopen.tcl?msg_id=$msg_id\">Reopen this issue</a>)\n [export_form_vars status]" 
+} else {
+    append page "<select name=status>"
+
+    if {[string compare $status "fixed waiting approval"] == 0} {
+	append page "<option selected> fixed waiting approval"
+    }
+
+append page "[ad_generic_optionlist [ticket_status_types] [ticket_status_types] $status]
+</select>"
+
+if {[string compare $status "fixed waiting approval"] != 0}  {
+append page "(<a href=issue-fix.tcl?[export_url_vars msg_id]>fix issue</a>)\n"
+}
+
+if {[ticket_user_can_admin_issues_p $user_id [list $msg_id] $db] ||
+    [ticket_user_can_close_issue_p $user_id $msg_id $db] } {
+    append page "(<a href=issue-close.tcl?[export_url_vars msg_id]>close issue</a>)
+    "
+}
+}
+
+# Project
+append page "</td></tr>
+<tr><th align=left>Project:<td>$title
+</td></tr>"
+
+# Severity
+append page "<tr><td align=left><b>Severity:</b><td>"
+append page "<select name=severity>
+[ad_generic_optionlist [ticket_severity_types] [ticket_severity_types] $severity]
+</select></td></tr>
+"
+
+# Deadline
+append page "
+<tr><td align=left><b>Deadline:</b><td>[ticket_dateentrywidget_with_nulls deadline [export_var deadline  [database_to_tcl_string $db "select date_part('year', sysdate()) from dual"]]]
+</tr>"
+
+append page "<input type=hidden name=prev_severity [export_form_value severity]>"
+
+set selection [ns_db select $db "select field_name, field_pretty_name, field_type, field_vals, field_val from ticket_projects_fields fields, ticket_projects_field_vals vals where fields.project_id=$project_id and vals.project_id=$project_id and vals.issue_id=$msg_id and fields.field_id=vals.field_id"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    append page "<tr><th align=left>$field_pretty_name</th><td>[ticket_custom_field_entry_form $field_type $field_name $field_vals $field_val]</td></tr>"
+}
+
+set return_url "issue-view.tcl?[export_url_vars msg_id]"
+set return_pretty_name "Issue #$msg_id: $one_line"
+
+set selection [ns_db 0or1row $db "select release as fixed_release from ticket_project_releases where release_id='$fixed_release_id'"]
+if {$selection != ""} {
+    set_variables_after_query
+} else {
+    set fixed_release ""
+}
+
+# Version
+append page "<tr>
+<th align=left>Project Release:</th>
+<td>[ticket_release_select $project_id release_id $release_id $db] (<a href=releases.tcl?[export_url_vars project_id return_url return_pretty_name]>Manage Releases</a>)</td>
+</tr>
+<th align=left>Release Where Fixed:</th>
+<td>$fixed_release</td>
+</tr>\n"
+
+# Show customizable picklist fields
+#  foreach field [ticket_picklist_field_names] { 
+#      set entry [ticket_picklist_field_info $field]
+#      append page "<tr>[ticket_picklist_html_fragment $field [set [ticket_picklist_entry_column_name $entry]]]</tr>\n"
+#  }
+
+append page "
+<tr><td align=left><b>Submitted By:</b><td>$name on $posting_date</tr>
+<tr><td align=left><b>Last Modified By:</b><td>[database_to_tcl_string_or_null $db "select first_names || ' ' || last_name from users where user_id='$last_modified_by'"] on $modification_time</tr></tr>
+"
+
+append page "<tr><td colspan=2 align=center>
+<input type=submit name=submit value=\"Update\">
+</td></tr>
+
+</form>
+"
+
+if { $close_date != "" } {
+    append page "<tr><td align=left><b>Closed On:</b><td>$close_date</tr>\n"
+}
+
+append page "
+
+</table>
+</blockquote>
+<p>
+"
+
+
+set selection [ns_db select $db "select 
+ response_id, public_p,
+ users.first_names || ' ' || users.last_name as name,
+ posting_time as posting_date,
+ message
+from ticket_issue_responses, users
+where ticket_issue_responses.user_id = users.user_id
+and ticket_issue_responses.response_to = $msg_id
+order by posting_time"] 
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    set text "<blockquote>
+    $message
+    </blockquote>
+    Submitted by $name on $posting_date, "
+
+    if {$public_p == "t"} {
+	 append text "<i>Public?</i> Yes (<a href=\"set-response-visibility.tcl?response_id=$response_id&public_p=f&msg_id=$msg_id\">toggle</a>)"
+    } else {
+	append text  "<i>Public?</i> No (<a href=\"set-response-visibility.tcl?response_id=$response_id&public_p=t&msg_id=$msg_id\">toggle</a>)"
+    }
+
+    lappend responses $text
+
+}
+
+if { [info exists responses] } {
+    append page "<b>Comments</b>
+    [join $responses "<hr width=300>"]
+    "
+}
+
+append page "<ul>"
+
+if { $close_date == "" } {
+    append page "<li><a href=\"issue-response.tcl?msg_id=$msg_id\">Add comment to \"[clean_up_html $one_line]\"</a>
+
+"
+} 
+
+
+append page "
+</ul>"
+
+# List xrefs
+append page "<b>Related Issues</b>
+<br>
+"
+set selection [ns_db select $db "select to_ticket, one_line as xone_line, msg_id as xmsg_id
+from ticket_xrefs, ticket_issues
+where  to_ticket = ticket_issues.msg_id and 
+from_ticket=$msg_id 
+union
+select to_ticket, one_line as xone_line, msg_id as xmsg_id
+from ticket_xrefs, ticket_issues
+where  from_ticket = ticket_issues.msg_id and 
+to_ticket=$msg_id 
+"]
+
+
+# target for subroutine pages to return to this page
+set target "issue-view.tcl"
+append page "<ul>"
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append page "<li><a href=\"issue-view.tcl?msg_id=$xmsg_id\">\[$xmsg_id\] $xone_line</a>&nbsp;&nbsp; <a href=\"unlink-xref.tcl?from_msg_id=$msg_id&to_msg_id=$xmsg_id&[export_url_vars target]\">(unlink)</a>"
+}
+
+append page "<p><li><a href=\"add-xref-search.tcl?[export_url_vars msg_id target]\">Add a cross-reference</a>"
+
+append page "</ul>"
+
+# View change log
+append page "<p>
+<ul>
+<li><a href=issue-change-log.tcl?msg_id=$msg_id>View Change History</a>
+<li><a href=\"issue-new.tcl?project_id=$project_id\">Add a new issue.</a>
+</ul>
+
+
+<p>
+<b><a name=assignment>Assignment</a></b>
+<table border=1 cellpadding=10>
+<tr>
+<th>Users assigned to this issue</th>
+<th>Candidates for assignment</th>
+</tr>
+<tr valign=top><td><ul>
+"
+
+# query for the users assigned to this issue already
+set selection [ns_db select $db "select case when first_names=email then '' else first_names end as first_names , case when last_name= email then '' else last_name end as last_name, users.user_id, email
+from users, ticket_issue_assignments 
+where users.user_id = ticket_issue_assignments.user_id 
+AND msg_id=$msg_id
+order by case when first_names=email then 'z' else lower(users.last_name) end, case when first_names=email then lower(email) else lower(users.first_names) end"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    if {$last_name == ""} {
+	set name "$email"
+    } else {
+	set name "$last_name, $first_names ($email)"
+    }
+    
+    append page "<li> \[<a href=\"issue-deassign-user.tcl?assignee_id=$user_id&msg_id=$msg_id\">deassign</a>\] $name \n"
+}
+
+append page  "</ul>
+<br>
+</td>
+
+<td>
+"
+
+# query for the users on the relevant project 
+# but not assigned to this issue already
+
+set ticket_group [ticket_admin_group $db]
+
+set selection [ns_db select $db "select users.user_id, case when first_names=email then '' else first_names end as first_names, case when last_name=email then '' else last_name end as last_name, email
+from users 
+where ticket_user_can_edit_project_p(user_id, $project_id)='t'
+and users.user_id NOT IN 
+    (SELECT ticket_issue_assignments.user_id 
+     from ticket_issue_assignments, ticket_issues
+     where ticket_issues.msg_id=$msg_id
+     and ticket_issue_assignments.msg_id = ticket_issues.msg_id)
+and users.email != 'system'
+order by case when first_names=email then 'z' else lower(users.last_name) end, case when first_names=email then lower(email) else lower(users.first_names) end"]
+
+while {[ns_db getrow $db $selection]}  {
+    set_variables_after_query
+    if {$last_name == ""} {
+	set name "$email"
+    } else {
+	set name "$last_name, $first_names ($email)"
+    }
+
+    append page "<li> \[<a href=\"issue-assign-user.tcl?assignee_id=$user_id&msg_id=$msg_id\">assign</a>\]  $name\n"
+}
+
+append page "</ul>
+</ul>
+<p>
+</form>
+</td>
+</tr>
+</table>
+"
+
+
+
+append page "[ad_footer]"
+
+ns_write $page
+
+
+
Index: web/openacs/www/new-ticket/issue-view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/issue-view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/issue-view.tcl	17 Apr 2001 14:05:19 -0000	1.1
@@ -0,0 +1,319 @@
+# This page is for viewing an issue as a privileged user - 
+
+# Most data fields are modifiable
+
+set_the_usual_form_variables
+
+# msg_id
+
+validate_integer msg_id $msg_id
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+if {![ticket_user_can_see_issues_p $user_id $msg_id $db]} {
+    ticket_deny_access
+    return
+}
+
+# If user can edit issue, source the proper page
+if {[ticket_user_can_edit_issues_p $user_id $msg_id $db]} {
+    ns_db releasehandle $db
+    util_source [ticket_url_stub]/issue-view-with-edit.tcl
+    return
+}
+
+set selection [ns_db 0or1row $db "select 
+posting_time as posting_date,
+deadline, one_line, message, priority, ticket_type,  email, first_names, 
+last_name, status
+from ticket_issues, users
+where msg_id = $msg_id
+and users.user_id = ticket_issues.user_id"]
+
+if { $selection == "" } {
+    # message was probably deleted
+    ad_return_complaint 1 "<li>Couldn't find message $msg_id."
+    return
+}
+
+set_variables_after_query
+set name "$first_names $last_name"
+set this_one_line $one_line
+
+
+set selection [ns_db 1row $db "select 
+title,ticket_issues.project_id, notify_p, public_p,
+fixed_release_id,
+ ticket_issues.group_id  as ticket_group_id,
+ ticket_issues.last_modified_by, 
+ ticket_issues.severity, 
+ modification_time,
+ ticket_issues.contact_name,
+ ticket_issues.contact_email,  ticket_issues.contact_info1,
+ close_date,
+ ticket_release_name(release_id) as release
+from ticket_projects, ticket_issues
+where ticket_projects.project_id = ticket_issues.project_id
+and ticket_issues.msg_id = $msg_id"]
+
+set_variables_after_query
+
+# access control
+if {![ticket_user_can_see_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+if {$public_p == "t"} {
+    set public_pretty "Yes"
+} else {
+    set public_pretty "No"
+}
+
+
+append group_select_menu "<select name=ticket_group>"
+
+
+# Get list of all user groups
+set selection [ns_db select $db "select distinct group_id as group_id_x, group_name 
+from user_groups"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    if {$group_id_x == $ticket_group_id} {
+	append group_select_menu "<option selected value=\"$group_id_x\">$group_name</option>"
+    } else {
+	append group_select_menu "<option value=\"$group_id_x\">$group_name</option>"	
+    }
+} 
+
+append group_select_menu "</select>"
+
+# get current user's email, to export as the "last modified by" value
+set email [database_to_tcl_string $db "select email from users where user_id=[ad_get_user_id]"]
+
+
+#if { [empty_string_p $deadline] } {
+#    set deadline [ns_localsqltimestamp]
+#}
+
+ReturnHeaders
+
+
+append page "[ad_header [clean_up_html $one_line]]
+
+<h2>$ticket_type \#$msg_id: [clean_up_html $one_line]</h2>
+
+[ad_context_bar_ws_or_index [list "[ticket_url_stub]/index.tcl" "Ticket Tracker"] [list "project-top.tcl?project_id=$project_id" $title] "One Ticket"]
+
+<hr>
+
+<blockquote>
+<table border=0><tr><td bgcolor=#f0f0f0>$message</td></tr></table>
+<font size=-1>
+"
+
+set selection [ns_db select $db "select attachment_name from ticket_issues_attachments where msg_id=$msg_id"]
+
+append page "<p>Attachments: "
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    append page "<a href=issue-download-attachment.tcl?[export_url_vars msg_id attachment_name]>$attachment_name</a> | "
+}
+
+append page "<p>"
+
+if {[notification_user_is_interested_p $user_id [ticket_notification_class $db] $msg_id $db]} {
+    append page "Notification <b>Enabled</b> (<A href=issue-remove-user-interest.tcl?[export_url_vars msg_id]>Disable</a>)"
+} else {
+    append page "Notification <b>Disabled</b> (<A href=issue-set-user-interest.tcl?[export_url_vars msg_id]>Enable</a>)"
+}
+
+append page "</font><p></blockquote>
+
+<blockquote>
+<table border=0 cellspacing=3>
+<tr>
+  <th valign=top align=left>Subject:</th>
+  <td>[clean_up_html $one_line]</td>
+<tr>
+<th valign=top align=left>Ticket Type:</th><td>$ticket_type</select>
+&nbsp;&nbsp;&nbsp;<b>Public?</b> $public_pretty
+
+</tr>"
+
+# Status
+append page "
+<tr><td align=left><b>Status:</b><td> $status
+</td></tr>
+"
+
+
+# Project
+append page "
+<tr><th align=left>Project:<td>
+$title
+</td></tr>"
+
+# Severity
+append page "<tr><td align=left><b>Severity:</b><td>"
+append page "
+ $severity</td></tr>
+"
+
+# Deadline
+append page "
+<tr><td align=left><b>Deadline:</b><td> [util_AnsiDatetoPrettyDate $deadline]
+</tr>"
+
+
+
+# Show customizable picklist fields
+#  foreach field [ticket_picklist_field_names] { 
+#      set entry [ticket_picklist_field_info $field]
+#      append page "<tr><th align=left>[ticket_picklist_entry_pretty_name $entry]</th><td>[set [ticket_picklist_entry_column_name $entry]]</td></tr>\n"
+#  }
+
+# Add real custom fields
+set selection [ns_db select $db "select field_name, field_pretty_name, field_type, field_val from ticket_projects_fields fields, ticket_projects_field_vals vals where fields.project_id=$project_id and vals.project_id=$project_id and vals.issue_id=$msg_id and fields.field_id=vals.field_id"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    append page "<tr><th align=left>$field_pretty_name</th><td>[ticket_custom_field_display_field $field_type $field_val]</td></tr>\n"
+}
+
+set selection [ns_db 0or1row $db "select release as fixed_release from ticket_project_releases where release_id='$fixed_release_id'"]
+if {$selection != ""} {
+    set_variables_after_query
+} else {
+    set fixed_release ""
+}
+
+append page "
+<tr><th align=left>Release</th><td>$release</td></tr>
+<tr><th align=left>Release where Fixed</th><td>$fixed_release</td></tr>
+<tr><td align=left><b>Submitted By:</b><td>$name on $posting_date</tr>
+<tr><td align=left><b>Last Modified By:</b><td>[database_to_tcl_string_or_null $db "select first_names || ' ' || last_name from users where user_id='$last_modified_by'"] on $modification_time</tr></tr>
+"
+
+if { $close_date != "" } {
+    append page "<tr><td align=left><b>Closed On:</b><td>$close_date</tr>\n"
+}
+
+append page "
+
+</table>
+</blockquote>
+<p>
+"
+
+
+set selection [ns_db select $db "select 
+ response_id, public_p,
+ users.first_names || ' ' || users.last_name as name,
+posting_time as posting_date,
+ message
+from ticket_issue_responses, users
+where ticket_issue_responses.user_id = users.user_id
+and ticket_issue_responses.response_to = $msg_id
+and public_p='t'
+order by posting_time"] 
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    set text "<blockquote>
+    $message
+    </blockquote>
+    Submitted by $name on $posting_date. "
+
+    lappend responses $text
+
+}
+
+if { [info exists responses] } {
+    append page "<b>Comments</b>
+    [join $responses "<hr width=300>"]
+    "
+}
+
+append page "<ul>"
+
+
+
+append page "
+</ul>"
+
+# List xrefs
+append page "<b>Related Issues</b>
+<br>
+"
+set selection [ns_db select $db "select to_ticket, one_line as xone_line, msg_id as xmsg_id
+from ticket_xrefs, ticket_issues
+where  to_ticket = ticket_issues.msg_id and 
+from_ticket=$msg_id 
+union
+select to_ticket, one_line as xone_line, msg_id as xmsg_id
+from ticket_xrefs, ticket_issues
+where  from_ticket = ticket_issues.msg_id and 
+to_ticket=$msg_id 
+"]
+
+
+# target for subroutine pages to return to this page
+set target "issue-view.tcl"
+append page "<ul>"
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append page "<li><a href=\"issue-view.tcl?msg_id=$xmsg_id\">\[$xmsg_id\] $xone_line</a>&nbsp;&nbsp; <a href=\"unlink-xref.tcl?from_msg_id=$msg_id&to_msg_id=$xmsg_id&[export_url_vars target]\">(unlink)</a>"
+}
+
+append page "</ul>"
+
+# View change log
+append page "<p>
+<ul>
+<li><a href=issue-change-log.tcl?msg_id=$msg_id>View Change History</a>
+<li><a href=\"issue-new.tcl?project_id=$project_id\">Add a new issue.</a>
+</ul>
+
+
+<p>
+<b>Assignment</b>
+<table border=1 cellpadding=10>
+<tr>
+<th>Users assigned to this issue</th>
+</tr>
+<tr valign=top><td><ul>
+"
+
+# query for the users assigned to this issue already
+set selection [ns_db select $db "select first_names, last_name, users.user_id
+from users, ticket_issue_assignments 
+where users.user_id = ticket_issue_assignments.user_id 
+AND msg_id=$msg_id
+order by users.last_name, users.first_names"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append page "<li> $first_names $last_name\n"
+}
+
+append page "
+</td>
+</tr>
+</table>
+"
+
+
+
+append page "[ad_footer]"
+
+ns_write $page
+
+
+
Index: web/openacs/www/new-ticket/list-issues.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/list-issues.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/list-issues.tcl	17 Apr 2001 14:05:19 -0000	1.1
@@ -0,0 +1,139 @@
+# List a set of tickets in a report 
+#
+# form vars:
+# report_type = "Ticket Summaries" "Complete Ticket Reports"
+# msg_ids  = semicolon separated list 
+# search_items 
+#
+
+set_form_variables
+
+foreach loop_msg_id $msg_ids {
+    validate_integer msg_id $loop_msg_id
+}
+
+set db_list [ns_db gethandle main 2]
+set db   [lindex $db_list 0]
+set db2   [lindex $db_list 1]
+
+set user_id [ad_get_user_id]
+
+# permissions
+if {![ticket_user_can_edit_issues_p $user_id $msg_ids $db]} {
+    ticket_deny_access
+    return
+}
+
+ReturnHeaders
+ns_write "[ad_header $report_type]
+<h2>$report_type</h2>
+
+[ad_context_bar_ws_or_index [list "[ticket_url_stub]/index.tcl" "Ticket Tracker"]  "Report"]
+
+<hr>
+<ul>
+"
+
+foreach item $search_items {
+    ns_write "<li>$item
+"
+}
+ns_write "
+</ul>
+
+<br>
+
+"
+
+# get multiple values of cgi var 'msg_id'
+
+set msg_id_list {}
+set form [ns_getform] 
+set form_size [ns_set size $form]
+set form_counter_i 0
+while {$form_counter_i<$form_size} {
+    set varname [ns_set key $form $form_counter_i]
+    if {$varname == "msg_ids"} {
+	lappend msg_id_list [ns_set value $form $form_counter_i]
+    }
+    incr form_counter_i
+}
+
+
+
+set selection [ns_db select $db "select ticket_issues.*, ticket_priorities.name, 
+ticket_projects.title as project_title, 
+users.first_names,
+users.last_name
+from ticket_issues, ticket_projects, ticket_priorities, users where
+users.user_id = ticket_issues.user_id 
+and ticket_user_can_see_project_p($user_id, ticket_projects.project_id)='t'
+and ticket_issues.priority = ticket_priorities.priority
+and ticket_projects.project_id = ticket_issues.project_id
+and msg_id in ([join $msg_id_list ","])"]
+
+
+set i 0
+set msgs_displayed_already [list]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { [lsearch $msgs_displayed_already msg_id] != -1 } {
+	continue
+    } else {
+	lappend msgs_displayed_already $msg_id
+    }
+    ns_log Notice [NsSettoTclString $selection]
+    set detail_list ""
+
+    set item_list_list { {"posting_time" "Creation Date:"} {"priority" "Priority:"} {"source" "Source:"} }
+
+    foreach item_list $item_list_list {
+	set variable [lindex $item_list 0]
+	set annotation [lindex $item_list 1]
+	if ![empty_string_p [set $variable]] {
+	    lappend detail_list "$annotation [set $variable]"
+	}
+    }
+    
+    ns_write "<br><b><a href=\"[ticket_url_stub]/issue-view.tcl?[export_url_vars msg_id]\">\#$msg_id [clean_up_html $one_line]</a></b><br>"
+   if {[string tolower $status] == "closed"} {
+       ns_write " <font color=green>Status: closed</font> "
+   } else {
+       ns_write " Status: $status "
+   }
+   ns_write [join $detail_list " ; "]
+   if {$report_type == "Complete Ticket Reports"} {
+       ns_write "<br><b>Content:</b><blockquote>$message</blockquote>"
+       set responses ""
+
+       # show responses
+       set sub_selection [ns_db select $db2 "select 
+       response_id, public_p,
+       users.first_names || ' ' || users.last_name as name,
+       to_char(posting_time, [ticket_date_format]) as posting_date,
+       ticket_issue_responses.message as followup_text
+       from ticket_issue_responses, users
+       where ticket_issue_responses.user_id = users.user_id
+       and ticket_issue_responses.response_to = $msg_id
+       order by posting_time"] 
+       
+       while { [ns_db getrow $db2 $sub_selection] } {
+	   set_variables_after_subquery
+	   set text "$followup_text <br>
+	   <i>Submitted by $name on $posting_date</i>"
+	   lappend responses $text
+       }
+       
+       if { [info exists responses] } {
+	   ns_write "<br><b>Comments</b>
+	   <blockquote>
+	   [join $responses "<p>"]
+	   </blockquote>
+	   "
+       }
+   }
+   incr i
+}
+
+
Index: web/openacs/www/new-ticket/new-child-project-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/new-child-project-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/new-child-project-2.tcl	17 Apr 2001 14:05:19 -0000	1.1
@@ -0,0 +1,19 @@
+set_the_usual_form_variables
+# parent_project_id, title
+
+validate_integer parent_project_id $parent_project_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![ticket_user_can_edit_project_p $user_id $parent_project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set project_id [database_to_tcl_string $db "select ticket_project_id_sequence.nextval from dual"]
+
+ns_db dml $db "insert into ticket_projects (project_id, title, parent_project_id, start_date, customer_id) select $project_id, '$QQtitle', $parent_project_id, sysdate, customer_id from ticket_projects where project_id=$parent_project_id"
+
+ns_returnredirect "project-top.tcl?[export_url_vars project_id]"
Index: web/openacs/www/new-ticket/new-child-project.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/new-child-project.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/new-child-project.tcl	17 Apr 2001 14:05:19 -0000	1.1
@@ -0,0 +1,34 @@
+set_the_usual_form_variables
+# parent_project_id
+
+validate_integer parent_project_id $parent_project_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![ticket_user_can_edit_project_p $user_id $parent_project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+ReturnHeaders
+
+set selection [ns_db 1row $db "select title from ticket_projects where project_id=$parent_project_id"]
+set_variables_after_query
+
+ns_write "[ad_header "New Child Project"]
+<h2>New Child Project</h2>
+[ad_context_bar_ws_or_index [list [ticket_admin_url_stub]/index.tcl [ticket_system_name]] [list "project-top.tcl?project_id=$parent_project_id" $title] "New Child Project"]
+<hr><p>
+
+<FORM METHOD=POST action=new-child-project-2.tcl>
+[export_form_vars parent_project_id]
+Child Project Name: <INPUT TYPE=text name=title>
+<p>
+<INPUT TYPE=submit value=\"add child project\">
+</FORM>
+<p>
+
+[ad_footer]
+"
\ No newline at end of file
Index: web/openacs/www/new-ticket/new-project-custom-field-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/new-project-custom-field-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/new-project-custom-field-2.tcl	17 Apr 2001 14:05:19 -0000	1.1
@@ -0,0 +1,32 @@
+set_the_usual_form_variables
+# project_id field_name field_pretty_name field_type
+
+validate_integer project_id $project_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![ticket_user_can_admin_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+ns_db dml $db "begin transaction"
+
+# Lock the row
+database_to_tcl_string $db "select title from ticket_projects where project_id=$project_id for update"
+
+set check [database_to_tcl_string $db "select count(*) from ticket_projects_fields where project_id=$project_id and field_name='$QQfield_name'"]
+
+if {$check > 0} {
+    ns_db dml $db "abort transaction"
+    ns_returnredirect "project-fields.tcl?[export_url_vars project_id]"
+    return
+}
+
+ns_db dml $db "insert into ticket_projects_fields (field_id, project_id, field_name, field_pretty_name, field_vals, view_in_list, field_type) values ([db_sequence_nextval_sql ticket_field_id_sequence], $project_id, '$QQfield_name', '$QQfield_pretty_name', [db_null_sql $field_vals], [db_null_sql $QQview_in_list], '$QQfield_type')"
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "project-fields.tcl?[export_url_vars project_id]"
\ No newline at end of file
Index: web/openacs/www/new-ticket/new-project-custom-field.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/new-project-custom-field.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/new-project-custom-field.tcl	17 Apr 2001 14:05:19 -0000	1.1
@@ -0,0 +1,15 @@
+set_the_usual_form_variables
+# project_id
+
+validate_integer project_id $project_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![ticket_user_can_admin_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+ad_return_template
Index: web/openacs/www/new-ticket/new-release.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/new-release.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/new-release.tcl	17 Apr 2001 14:05:19 -0000	1.1
@@ -0,0 +1,18 @@
+set_the_usual_form_variables
+# project_id release
+# return_url return_pretty_name
+
+validate_integer project_id $project_id
+
+set user_id [ad_get_user_id]
+set db [ns_db gethandle]
+
+# permissions
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+ns_db dml $db "insert into ticket_project_releases (project_id, release_id, release) VALUES ($project_id, nextval('release_id_sequence'), '$QQrelease')"
+
+ns_returnredirect "releases.tcl?[export_url_vars project_id return_url return_pretty_name]"
\ No newline at end of file
Index: web/openacs/www/new-ticket/notification-set.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/notification-set.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/notification-set.tcl	17 Apr 2001 14:05:19 -0000	1.1
@@ -0,0 +1,52 @@
+set_the_usual_form_variables
+# msg_id, notify
+# maybe return_url
+
+validate_integer msg_id $msg_id
+
+set user_id [ad_get_user_id]
+set db [ticket_getdbhandle]
+
+# check perms
+set project_id [database_to_tcl_string $db "select project_id from ticket_issues where msg_id=$msg_id"]
+
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+if { $notify == "f" } {
+    set sql "update ticket_issues set notify_p = 'f' where msg_id = $msg_id"
+} else {
+    set sql "update ticket_issues set notify_p = 't' where msg_id = $msg_id"
+}
+
+if { [catch {ns_db dml $db $sql} errmsg] } {
+    ns_return 200 text/html "[ad_header "Setting Notification Failed"]
+<h2>Setting Notification Failed</h2>
+Send email to [ad_system_owner].
+Here was the message:
+<pre>
+$errmsg
+</pre>
+Which resulted from the following SQL:
+<code>
+$sql
+</code>
+[ad_footer]
+"
+} elseif { [info exists return_url] } {
+    ns_returnredirect $return_url
+} elseif { $notify == "t" } {
+    ns_return 200 text/html "[ad_header "Setting Notification Succeeded"]
+<h2>Setting Notification Succeeded</h2>
+Project members will get notification messages for this issue.
+[ad_footer]
+"
+} else {
+    ns_return 200 text/html "[ad_header "Setting Notification Succeeded"]
+<h2>Setting Notification Succeeded</h2>
+Project members will no longer get notification messages for this issue.
+[ad_footer]
+"
+}
Index: web/openacs/www/new-ticket/one-release.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/one-release.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/one-release.tcl	17 Apr 2001 14:05:19 -0000	1.1
@@ -0,0 +1,51 @@
+set_the_usual_form_variables
+# project_id release_id return_url return_pretty_name
+
+validate_integer project_id $project_id
+validate_integer release_id $release_id
+
+set user_id [ad_get_user_id]
+set db [ns_db gethandle]
+
+# permissions
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set selection [ns_db 0or1row $db "select project_full_name(ticket_projects.project_id) as title, release, build_file from ticket_projects, ticket_project_releases where ticket_project_releases.project_id=project_root_project_id(ticket_projects.project_id) and ticket_projects.project_id=$project_id and release_id='$release_id'"]
+
+if {$selection == ""} {
+    ad_return_error "no such release!" "no such release!"
+    return
+}
+
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "[ad_header "One Release of $title"]
+<h2>$title: $release</h2>
+[ad_context_bar_ws_or_index [list "[ticket_admin_url_stub]/index.tcl" "Ticket Tracker"] [list "project-top.tcl?[export_url_vars project_id]" $title] [list "releases.tcl?[export_url_vars project_id return_url return_pretty_name]" "Releases"] "One Release"]
+<hr><p>
+
+<FORM METHOD=post action=release-edit.tcl>
+[export_form_vars project_id release_id return_url return_pretty_name]
+Release Name: <INPUT TYPE=text name=release value=\"$release\" size=50> <INPUT TYPE=submit value=edit></FORM>
+<p>
+<ul>
+<li> <a href=release-delete.tcl?[export_url_vars project_id release_id return_url return_pretty_name]>delete</a> release.
+"
+
+if {$build_file != ""} {
+    ns_write "<li> <a href=release-download.tcl?[export_url_vars project_id release_id]>download release build</a> (or <a href=release-upload-build.tcl?[export_url_vars project_id release_id return_url return_pretty_name]>upload</a> a new file for this build)\n"
+} else {
+    ns_write "<li> <a href=release-upload-build.tcl?[export_url_vars project_id release_id return_url return_pretty_name]>upload release build</a>\n"
+}
+
+
+ns_write "</ul>
+<p>
+
+[ad_footer]
+"
\ No newline at end of file
Index: web/openacs/www/new-ticket/one-user.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/one-user.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/one-user.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,228 @@
+set_form_variables 0
+
+
+# form vars:
+# 
+# user_id - user_id this page is for (optional - defaults to logged in user)
+# project_id - project_id for this user (optional - defaults to all tickets 
+#              for the selected user)
+#
+# filter conditions
+#
+
+# logged_in_user_id corresponds to the user that is viewing this page
+# and user_id is the user_id for the person whom we want to see a summary of 
+# ticket issues.
+
+if { [info exists user_id] } {
+    # validate the user_id input and get the user_id of the person viewing this
+    # page.
+    validate_integer user_id $user_id
+    set logged_in_user_id [ad_get_user_id]
+} else {
+    # a user_id was not passed to this page so just default to showing the user
+    # his or her own tickets.
+    set user_id [ad_get_user_id]
+    set logged_in_user_id $user_id
+}
+
+if { [info exists project_id] } {
+    validate_integer project_id $project_id
+}
+
+# Status
+# view_status  { open closed deferred created_by_you }
+#
+# Creation time
+# view_created { last_24 last_week last_month all}
+#
+# Ticket Type
+# view_type { all defects enhancements issues }
+#
+#
+# order_by       column name to sort table by 
+
+set ctrlvars {view_type view_assignment view_status view_created user_id project_id}
+
+set db [ticket_getdbhandle]
+
+set name [database_to_tcl_string $db "select first_names || ' ' || last_name 
+from users where user_id = $user_id"]
+
+ReturnHeaders
+
+ns_write "[ad_header "[ticket_system_name] Home"]
+
+<h2>Tickets for $name</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Ticket Tracker"] "One User"]
+
+<hr>
+"
+
+# List of form vars used to select tickets to display
+
+# Assignment filter conditions
+#
+
+# default to show issues assigned to $user_id
+if {![info exists view_type]} {
+    set view_type all
+}
+
+# default to show issues assigned to $user_id
+if {![info exists view_assignment]} {
+    set view_assignment user
+}
+
+# default to only your own assigned issues
+if {![info exists view_status]} {
+    set view_status open
+}
+
+# default to all time
+if {![info exists view_created]} {
+    set view_created all
+}
+
+set assignment_filter ""
+
+if { [info exists project_id] } {
+    set project_filter "and ticket_projects.project_id = $project_id "
+} else {
+    set project_filter " "
+}
+
+switch $view_status {
+    "open" {set status_filter "and ((status <> 'closed') and (status <> 'deferred')) " }
+    "deferred" {set status_filter "and ((status <> 'closed') or (status = 'deferred')) " }
+    "closed" {set status_filter "" } # shows everything
+}
+
+switch $view_created {
+   "last_24"   { set date_filter "and (posting_time > (sysdate() - 1))" } 
+   "last_week" { set date_filter "and (posting_time > (sysdate() - 7)) " } 
+   "last_month" { set date_filter "and (posting_time > (sysdate() - 30)) " }
+   "all" { set date_filter "" }
+}
+
+switch $view_type {
+    "all" { set issue_table "ticket_issues" }
+    "defects" { set issue_table "ticket_defects" }
+    "enhancements" { set issue_table "ticket_enhancements" }
+    "issues" { set issue_table "ticket_issues_issues" }
+}
+
+# Sort order of tickets by
+if {![info exists order_by]} {
+    set order_by "ticket_issues.msg_id"
+} elseif {[string match "project*" $order_by]} {
+    set order_by "project_title"
+}
+
+
+################################################################
+# GUI ticket filter controls
+
+# List of all the state vars we need to pass through these toggle switches
+set filter_vars {view_type view_assignment view_status view_created order_by user_id project_id}
+
+
+append results "<table border=0 cellspacing=0 cellpadding=0 width=100%>
+<tr>
+<th bgcolor=#ECECEC>Type</th>
+<th bgcolor=#ECECEC>Status</th>
+<th bgcolor=#ECECEC>Creation Time</th></tr>"
+
+set url "one-user.tcl"
+
+#### Assignment flags
+# Show assigned to you 
+append results "<tr>
+<td align=center>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;\["
+
+# Issue type filter
+append results [ticket_control_vars view_type all $filter_vars "ALL" "$url"]
+append results " | "
+append results [ticket_control_vars view_type defects $filter_vars "Defects" "$url"]
+append results " | "
+append results [ticket_control_vars view_type enhancements $filter_vars "Enhancements" "$url"]
+append results " | "
+append results [ticket_control_vars view_type issues $filter_vars "Issues" "$url"]
+append results "\]&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</td>\n<td align=center>\["
+
+# Show open issues
+append results [ticket_control_vars view_status open $filter_vars "active" "$url"]
+append results " | "
+# Show deferred issues
+append results [ticket_control_vars view_status deferred $filter_vars "+deferred" "$url"]
+append results " | "
+# Show closed issues
+append results [ticket_control_vars view_status closed $filter_vars "+closed" "$url"]
+
+
+#### Creation time filter
+append results "\]&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</td>\n<td align=center>\["
+
+append results [ticket_control_vars view_created last_24 $filter_vars "last 24 hrs" "$url"]
+append results " | "
+append results [ticket_control_vars view_created last_week $filter_vars "last week" "$url"]
+append results " | "
+append results [ticket_control_vars view_created last_month $filter_vars "last month" "$url"]
+append results " | "
+append results [ticket_control_vars view_created all $filter_vars "all" "$url"]
+
+append results "\]</td></tr></table><p>"
+
+###################################################################
+#
+# Now display the tickets pertaining the selected user and project
+#
+###################################################################
+
+set query "select distinct
+ ticket_issues.msg_id,
+ ticket_issues.ticket_type, 
+ ticket_issues.one_line,
+ ticket_issues.status,
+ ticket_issues.severity,
+ ticket_issues.posting_time,
+ users.email,
+ ticket_projects.title as project_title,
+ ticket_projects.project_id,
+ ticket_issues.priority, 
+ to_char(ticket_issues.modification_time, 'MM/DD/YY') as modification_time_pretty,
+ to_char(ticket_issues.posting_time, 'MM/DD/YY') as creation_time_pretty,
+ to_char(ticket_issues.close_date, 'MM/DD/YY') as close_date_pretty,
+ to_char(ticket_issues.close_date, 'MM/DD/YY') as close_date,
+ to_char(ticket_issues.deadline, 'MM/DD/YY') as deadline_pretty,
+ to_char(ticket_issues.deadline, 'MM/DD/YY') as deadline,
+ sysdate() - deadline as pastdue,
+ ticket_issue_assignments.active_p as assigned_p,
+ ticket_issues.public_p,
+ ticket_assignees(ticket_issues.msg_id) as ticket_assignees
+from $issue_table ticket_issues, ticket_projects, users, ticket_issue_assignments
+where ticket_user_can_see_project_p($logged_in_user_id, ticket_projects.project_id)='t'
+and users.user_id = ticket_issues.user_id
+and ticket_projects.project_id = ticket_issues.project_id
+$project_filter
+and ticket_issues.msg_id = ticket_issue_assignments.msg_id
+and ticket_issue_assignments.user_id= $user_id 
+$assignment_filter
+$status_filter
+$date_filter
+order by $order_by, ticket_issues.priority, ticket_issues.posting_time"
+
+set this_url "one-user.tcl"
+set display_project_p 0
+append results [ticket_summary_display]
+
+
+ns_write  "$results
+
+<ul>
+<li>Add new <a href=\"issue-new.tcl\">issue</a>
+</ul>
+[ad_footer]
+"
+
Index: web/openacs/www/new-ticket/project-cleanse-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/project-cleanse-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/project-cleanse-2.tcl	17 Apr 2001 14:05:19 -0000	1.1
@@ -0,0 +1,17 @@
+set_the_usual_form_variables
+# project_id privacy
+
+validate_integer project_id $project_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![ticket_user_can_admin_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set delete_count [database_to_tcl_string $db "select count(*) from ticket_issues where project_id= $project_id and privacy > $privacy"]
+
+ad_return_template
Index: web/openacs/www/new-ticket/project-cleanse-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/project-cleanse-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/project-cleanse-3.tcl	17 Apr 2001 14:05:19 -0000	1.1
@@ -0,0 +1,45 @@
+set_the_usual_form_variables
+# project_id privacy
+
+validate_integer project_id $project_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![ticket_user_can_admin_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set msg_id_subquery_sql "(select msg_id from ticket_issues where privacy > $privacy)"
+set msg_id_sql "msg_id in $msg_id_subquery_sql"
+
+ns_db dml $db "begin transaction"
+
+# First remove the custom field vals
+ns_db dml $db "delete from ticket_projects_field_vals where project_id=$project_id and issue_id in $msg_id_subquery_sql"
+
+ns_db dml $db "delete from ticket_issue_user_interest_map where $msg_id_sql"
+
+# Remove all the attachments
+ns_db dml $db "delete from ticket_issues_attachments where $msg_id_sql"
+
+ns_db dml $db "delete from ticket_issue_assignments where $msg_id_sql"
+
+ns_db dml $db "delete from ticket_xrefs where from_ticket in $msg_id_subquery_sql"
+ns_db dml $db "delete from ticket_xrefs where to_ticket in $msg_id_subquery_sql"
+
+ns_db dml $db "delete from ticket_issue_responses where response_to in $msg_id_subquery_sql"
+
+ns_db dml $db "delete from ticket_issue_notifications where $msg_id_sql"
+
+ns_db dml $db "delete from ticket_issues where privacy > $privacy"
+
+
+# Update all leftover fields
+ns_db dml $db "update ticket_issues set privacy= NULL"
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "project-top.tcl?[export_url_vars project_id]"
Index: web/openacs/www/new-ticket/project-cleanse.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/project-cleanse.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/project-cleanse.tcl	17 Apr 2001 14:05:19 -0000	1.1
@@ -0,0 +1,15 @@
+set_the_usual_form_variables
+# project_id
+
+validate_integer project_id $project_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![ticket_user_can_admin_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+ad_return_template
Index: web/openacs/www/new-ticket/project-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/project-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/project-edit-2.tcl	17 Apr 2001 14:05:19 -0000	1.1
@@ -0,0 +1,20 @@
+set_the_usual_form_variables
+# customer_id, title, start_date
+
+validate_integer customer_id $customer_id
+
+ns_dbformvalue [ns_conn form] start_date date start_date
+
+set user_id [ad_get_user_id]
+set db [ticket_getdbhandle]
+
+# permissions
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+
+ns_db dml $db "update ticket_projects set customer_id=$customer_id, title='$QQtitle', start_date='$start_date' where project_id=$project_id"
+
+ns_returnredirect "project-top.tcl?project_id=$project_id"
Index: web/openacs/www/new-ticket/project-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/project-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/project-edit.tcl	17 Apr 2001 14:05:19 -0000	1.1
@@ -0,0 +1,71 @@
+set_the_usual_form_variables
+# project_id
+
+validate_integer project_id $project_id
+
+set user_id [ad_get_user_id]
+set db [ticket_getdbhandle]
+
+# permissions
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+
+set selection [ns_db 1row $db  "select * from ticket_projects where project_id=$project_id"]
+set_variables_after_query
+
+set project_selection $selection
+
+ReturnHeaders
+ns_write "[ad_header "Project \#$project_id"]
+<h2>Project \#$project_id: $title</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Ticket Tracker"] [list "project-top.tcl?[export_url_vars project_id]" "One Project"] "Edit"]
+
+<hr>
+
+"
+
+set ticket_group_id [ticket_admin_group $db]
+
+set customer_select_html "<SELECT NAME=customer_id>\n"
+
+set selection [ns_db select $db "select first_names || ' ' || last_name || ' &lt;' || email || '&gt;' as name, users.user_id as customer_id
+from user_group_map, users 
+where user_group_map.user_id = users.user_id 
+and user_group_map.group_id = $ticket_group_id
+order by last_name"]
+
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append customer_select_html "<OPTION VALUE=$customer_id> $name\n"
+}
+
+append customer_select_html "</SELECT>\n"
+
+set project_form "<tr><td>Project Owner</td><td>$customer_select_html</td></tr>
+<tr><td>Project Title</td><td><INPUT type=text name=title size=30></td></tr>
+<tr><td>Start Date</td><td>[philg_dateentrywidget start_date $start_date]</td></tr>
+"
+
+set merged_form [bt_mergepiece $project_form $project_selection]
+
+ns_write "
+<FORM method=post action=\"project-edit-2.tcl\">
+<INPUT type=hidden name=project_id value=$project_id>
+<blockquote>
+<table noborder>
+$merged_form
+</table>
+</blockquote>
+<p>
+<center>
+<INPUT type=submit value=\"update project information\">
+</center>
+</FORM>
+<p>
+
+[ad_footer]"
Index: web/openacs/www/new-ticket/project-end-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/project-end-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/project-end-2.tcl	17 Apr 2001 14:05:19 -0000	1.1
@@ -0,0 +1,21 @@
+set_form_variables
+
+# project_id
+
+validate_integer project_id $project_id
+
+set user_id [ad_get_user_id]
+set db [ns_db gethandle]
+
+# permissions
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+
+ns_db dml $db "update ticket_projects 
+set end_date=SYSDATE
+where project_id=$project_id"
+
+ns_returnredirect "index.tcl"
Index: web/openacs/www/new-ticket/project-end.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/project-end.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/project-end.tcl	17 Apr 2001 14:05:19 -0000	1.1
@@ -0,0 +1,35 @@
+set_form_variables
+
+# project-id, title
+
+validate_integer project_id $project_id
+
+set user_id [ad_get_user_id]
+set db [ns_db gethandle]
+
+# permissions
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+ReturnHeaders
+
+ns_write "[ad_header "End Project"]
+
+<h2>End project</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Ticket Tracker"] [list "project-top.tcl?[export_url_vars project_id]" "One Project"] "End"]
+
+
+<hr>
+
+<form action=\"project-end-2.tcl\" method=post>
+Really end project $title?<p>
+<input type=hidden name=project_id value=$project_id>
+<center>
+<input type=submit value=\"Yes, I'm sure.  End Project\">
+</center>
+</form>
+[ad_footer]
+"
Index: web/openacs/www/new-ticket/project-fields.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/project-fields.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/project-fields.tcl	17 Apr 2001 14:05:19 -0000	1.1
@@ -0,0 +1,17 @@
+set_the_usual_form_variables
+# project_id
+
+validate_integer project_id $project_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![ticket_user_can_admin_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set list_of_fields [database_to_tcl_list_ns_set $db "select field_id, field_name, field_pretty_name, field_type from ticket_projects_fields where project_id=$project_id"]
+
+ad_return_template
Index: web/openacs/www/new-ticket/project-new-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/project-new-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/project-new-2.tcl	17 Apr 2001 14:05:19 -0000	1.1
@@ -0,0 +1,15 @@
+set_the_usual_form_variables
+# user_id, title, start_date, end_date
+set db [ticket_getdbhandle]
+
+validate_integer user_id $user_id
+
+set user_id [ad_get_user_id]
+
+ns_dbformvalue [ns_conn form] start_date date start_date
+
+set new_id [database_to_tcl_string $db "select ticket_project_id_sequence.nextval from dual"]
+
+ns_db dml $db "insert into ticket_projects (project_id, customer_id, title, start_date) VALUES ($new_id, $user_id, '$QQtitle', '$start_date')"
+
+ns_returnredirect "project-top.tcl?project_id=$new_id"
Index: web/openacs/www/new-ticket/project-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/project-new.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/project-new.tcl	17 Apr 2001 14:05:19 -0000	1.1
@@ -0,0 +1,43 @@
+# create a new project
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+ReturnHeaders
+
+ns_write "[ad_header "New Project"]
+<h2>New Project</h2>
+in <a href=\"index.tcl\">[ticket_system_name]</a>.
+<hr><p>
+
+<FORM method=post action=project-new-2.tcl>
+<table noborder>
+"
+
+set customer_select_html "<SELECT NAME=user_id>\n"
+
+set ticket_group_id [ticket_admin_group $db]
+
+set selection [ns_db select $db "select first_names || ' ' || last_name || ' &lt;' || email || '&gt;' as name, users.user_id 
+from user_group_map, users where 
+user_group_map.user_id = users.user_id 
+and user_group_map.group_id = $ticket_group_id
+order by last_name"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append customer_select_html "<OPTION VALUE=$user_id> $name\n"
+}
+
+append customer_select_html "</SELECT>\n"
+
+ns_write "
+<tr><td>Project Owner</td><td>$customer_select_html</td></tr>
+<tr><td>Project Title</td><td><INPUT type=text name=title width=30></td></tr>
+<tr><td>Start Date</td><td>[philg_dateentrywidget start_date [ns_localsqltimestamp]]</td></tr>
+</table>
+<p>
+<INPUT type=submit value=\"Register New Project\">
+</FORM>
+
+[ad_footer]"
Index: web/openacs/www/new-ticket/project-reopen.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/project-reopen.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/project-reopen.tcl	17 Apr 2001 14:05:19 -0000	1.1
@@ -0,0 +1,18 @@
+set_form_variables
+# project-id
+
+validate_integer project_id $project_id
+
+set user_id [ad_get_user_id]
+set db [ns_db gethandle]
+
+# permissions
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+ns_db dml $db "update ticket_projects set end_date=NULL 
+where project_id=$project_id"
+
+ns_returnredirect "project-top.tcl?project_id=$project_id"
Index: web/openacs/www/new-ticket/project-set-default-assignee.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/project-set-default-assignee.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/project-set-default-assignee.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,29 @@
+# Makes a user the "default assignee" for new ticket
+set_the_usual_form_variables
+#  project_id, default_assignee
+
+validate_integer project_id $project_id
+
+set user_id [ad_get_user_id]
+
+set db [ticket_getdbhandle]
+
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+
+if {[info exists default_assignee] && $default_assignee != ""} {
+    validate_integer default_assignee $default_assignee
+    ns_db dml $db "update ticket_projects set default_assignee = $default_assignee where project_id = $project_id"
+} elseif {[info exists default_assignee] && [empty_string_p $default_assignee]} {
+    ns_db dml $db "update ticket_projects set default_assignee = null where project_id = $project_id"
+} else {
+    # this should not happen unless someone resubmits a page or something.
+    # They are already assigned, so do nothing.
+}
+
+
+ns_returnredirect "project-top.tcl?[export_url_vars project_id]"
+    
Index: web/openacs/www/new-ticket/project-summary.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/project-summary.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/project-summary.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,100 @@
+# Summarize projects status
+#
+
+set db [ns_db gethandle]
+
+ReturnHeaders
+ns_write "[ad_header "Project Status"]
+<h2>Project Status Summary</h2>
+
+[ad_context_bar_ws_or_index [list "[ticket_url_stub]/index.tcl" "Ticket Tracker"]  "Project Summaries"]
+
+<hr>
+
+<blockquote>
+<table border=0>
+<tr>
+<th>Title</th>
+<th>Assigned</th>
+<th>Total </th>
+<th>Active</th>
+<th>Closed</th>
+<th>Deferred</th>
+<th>Last Mod</th>
+<th>Oldest Active</th>
+</tr>
+"
+
+set i 0
+
+set user_id [ad_get_user_id]
+
+set selection [ns_db select $db "
+select 
+  tp.project_id, 
+  project_full_name(tp.project_id) as title, 
+  count(msg_id) as total,
+  sum(case when ticket_assignees(msg_id)='' then 0 else 1 end) as assigned,
+  sum(case when status='closed' then 1 else 0 end) as closed,
+  sum(case when status='closed' then 0 else case when status='deferred' then 0 else case when status is NULL then 0 else 1 end end end) as open,
+  sum(case when status='deferred' then 1 else 0 end) as deferred,
+  max(modification_time) as lastmod,
+  min(posting_time) as oldest,
+  sum(ticket_one_if_high_priority(priority, status)) as high_pri,
+  sum(ticket_one_if_blocker(severity, status)) as blocker
+from ticket_projects tp, ticket_issues ti
+where tp.project_id = ti.project_id
+and ticket_user_can_see_project_p($user_id, tp.project_id)='t'
+group by tp.project_id, tp.title
+order by upper(title)
+"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    # show summaries of ticket stats
+    # total #
+    # open
+    # closed
+    # deferred
+    # last modified (max)
+    # 
+
+    if {($i % 2) == 0} {
+	set bgcolor "bgcolor=\#ECECEC"
+    } else {
+	set bgcolor ""
+    }
+
+
+    regsub "@.*" $assigned "" assigned
+
+    ns_write "
+<tr>
+  <td $bgcolor><a href=\"project-top.tcl?project_id=$project_id\">$title
+  <td $bgcolor align=left>$assigned&nbsp;
+  <td $bgcolor align=right>[blank_zero $total]&nbsp;
+  <td $bgcolor align=right>[blank_zero $open]&nbsp;
+  <td $bgcolor align=right>[blank_zero $closed]&nbsp;
+  <td $bgcolor align=right>[blank_zero $deferred]&nbsp;
+  <td $bgcolor align=right nowrap>$lastmod&nbsp;
+  <td $bgcolor align=right nowrap>$oldest&nbsp;
+</tr>
+"
+   incr i
+}
+
+ns_write "</table>"
+
+if {$i == 0} {
+    ns_write "no projects available for your viewing"
+}
+
+
+
+ns_write "
+</blockquote>
+
+
+[ad_footer]
+"
Index: web/openacs/www/new-ticket/project-top.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/project-top.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/project-top.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,163 @@
+# View tickets in project
+#
+# project-top.tcl  by hqm@arsdigita.com June 1999
+#
+# form vars:
+
+set_form_variables
+# form vars:
+# project_id
+# 
+# (these are all optional args which have defaults)
+#
+# filter conditions
+#
+# Assignments:
+# view_assignment    { user unassigned all }
+
+# Status
+# view_status  { open closed deferred created_by_you }
+#
+# Creation time
+# view_created { last_24 last_week last_month all}
+#
+#
+# order_by       column name to sort table by 
+
+validate_integer project_id $project_id
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+if {![ticket_user_can_see_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set ctrlvars {view_assignment view_status view_created view_type project_id}
+
+ReturnHeaders
+
+set page_title "[database_to_tcl_string $db "select title
+from ticket_projects where project_id = $project_id"] Tickets"
+set navbar "[ad_context_bar_ws_or_index [list "[ticket_url_stub]/index.tcl" "Ticket Tracker"]  "One Project"]"
+
+append page "[ad_header $page_title]
+
+<h2>$page_title</h2>
+
+$navbar
+
+<hr>
+"
+
+append page [ticket_filter_bar $db $user_id $project_id project-top.tcl]
+
+################################################################
+
+set custom_fields [database_to_tcl_list_list $db "select field_id, field_name, field_pretty_name from ticket_projects_fields where project_id=$project_id and view_in_list='t'"]
+
+set extra_sql_fields ""
+
+foreach custom_field $custom_fields {
+    append extra_sql_fields "ticket_fetch_custom_field(ticket_issues.msg_id, ticket_issues.project_id, '[DoubleApos [lindex $custom_field 1]]') as field_[lindex $custom_field 0], "
+}
+
+set query "select
+ ticket_issues.msg_id,
+ ticket_issues.ticket_type, 
+ ticket_issues.one_line,
+ ticket_issues.status,
+ ticket_issues.severity,
+ ticket_issues.posting_time,
+ users.email,
+ project_full_name(ticket_projects.project_id) as project_title,
+ ticket_projects.project_id,
+ ticket_issues.priority, 
+ to_char(ticket_issues.modification_time, 'MM/DD/YY') as modification_time_pretty,
+ to_char(ticket_issues.posting_time, 'MM/DD/YY') as creation_time_pretty,
+ to_char(ticket_issues.close_date, 'MM/DD/YY') as close_date_pretty,
+ to_char(ticket_issues.deadline, 'MM/DD/YY') as deadline_pretty,
+ case when deadline < sysdate() then 1 else -1 end as pastdue,
+ ticket_issues.public_p,
+ $extra_sql_fields
+ ticket_assignees(ticket_issues.msg_id) as ticket_assignees
+from $issue_table ticket_issues, ticket_projects, users
+where
+users.user_id = ticket_issues.user_id
+and ticket_projects.project_id = ticket_issues.project_id
+and parent_project_p($project_id, ticket_issues.project_id)='t'
+$assignment_filter
+$status_filter
+$date_filter
+order by $order_by, ticket_issues.priority, ticket_issues.posting_time"
+
+
+# This does an uplevel and expects a number of things
+set this_url project-top.tcl
+set display_project_p 0
+append page [ticket_summary_display]
+
+
+append page "<ul>
+<p>
+<li><a href=\"issue-new.tcl?project_id=$project_id\">Add a new issue.</a>
+<p>
+
+<li>Summarize by: <a href=user-summary.tcl>user</a> | <a href=by-creation-user.tcl>creator</a>
+<p>
+
+<li><a href=\"releases.tcl?[export_url_vars project_id]\">Releases</a>
+<li><a href=\"reports/index.tcl?[export_url_vars project_id]\">Reports</a><p>
+"
+
+# Look up owner of project
+set selection [ns_db 1row $db  "select title, case when start_date is null then null else start_date::date end as start_date,
+case when end_date is null then null else end_date::date end as end_date, default_assignee,
+users.first_names || ' ' || users.last_name as name from 
+ticket_projects, users
+where project_id=$project_id AND 
+users.user_id=ticket_projects.customer_id
+"]
+
+set_variables_after_query
+
+if {[ticket_user_can_admin_project_p $user_id $project_id $db]} {
+    append page "<li> <a href=\"project-fields.tcl?[export_url_vars project_id]\">Custom Fields</a>\n"
+
+    if {[ticket_privacy_enabled_p]} {
+	append page "<li> <a href=project-cleanse.tcl?[export_url_vars project_id]>Cleanse Project</a>"
+    }
+}
+
+if {![empty_string_p $end_date]} {
+    append page "<a href=\"project-reopen.tcl?project_id=$project_id\"> (reopen)</a>"
+}
+
+append page "
+<FORM method=get action=issue-view.tcl>
+<li>Search by Ticket # <INPUT TYPE=number name=msg_id size=6> <input type=submit value=search></form>
+"
+
+if {[ticket_user_can_admin_project_p $user_id $project_id $db]} {
+    set list_of_team_members [database_to_tcl_list_list $db "select user_id, email from users where ticket_user_can_edit_project_p(user_id, $project_id)='t'"]
+    lappend list_of_team_members [list "" "(no one)"]
+
+    append page "<FORM METHOD=POST action=project-set-default-assignee.tcl>
+[export_form_vars project_id]
+<li> Default Assignee: [make_html_select default_assignee $list_of_team_members $default_assignee]
+<INPUT TYPE=submit value=edit>
+</FORM>
+"
+}
+
+append page "</ul>"
+
+append page "</td></tr>
+</table>
+</blockquote>
+<p>
+[ad_footer]
+"
+ns_write $page
\ No newline at end of file
Index: web/openacs/www/new-ticket/project-view-assignments.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/project-view-assignments.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/project-view-assignments.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,151 @@
+# View assigned tickets, by user
+#
+# project-view-assignments.tcl by hqm@arsdigita.com June 1999
+# 
+set_form_variables 0
+
+# form vars:
+# 
+# filter conditions
+#
+# project_id (blank for all projects)
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+ReturnHeaders
+
+ns_write "[ad_header "[ticket_system_name] View Ticket Assignments"]
+
+<h2>[ticket_system_name]</h2>
+
+[ad_context_bar_ws_or_index  [list "[ticket_url_stub]/index.tcl" "Ticket Tracker"] "View Assignments"]
+
+<hr>
+"
+
+
+if {[info exists project_id] && ![empty_string_p $project_id]} {
+    validate_integer project_id $project_id
+
+    set project_filter "and ticket_issues.project_id = $project_id "
+} else {
+    set project_filter ""
+}
+
+
+
+set query "select 
+ ticket_issues.msg_id,
+ ticket_issues.ticket_type, 
+ ticket_issues.one_line,
+ ticket_issues.status,
+ ticket_issues.severity,
+ ticket_issues.posting_time,
+ users.email as assignee_email,
+ ticket_projects.title as project_title,
+ ticket_projects.project_id,
+ ticket_issues.priority, 
+ to_char(ticket_issues.modification_time, 'mm/dd/yy') as modification_time,
+ to_char(ticket_issues.posting_time, 'mm/dd/yy') as creation_time,
+ to_char(ticket_issues.close_date, 'mm/dd/yy') as close_date,
+ to_char(ticket_issues.deadline, 'mm/dd/yy') as deadline,
+ to_char(sysdate - deadline) as pastdue,
+ ticket_issue_assignments.user_id as assignee_user_id,
+ ticket_issues.public_p,
+ ticket_priorities.name as priority_name
+ from ticket_issues, ticket_priorities, ticket_projects, users, ticket_issue_assignments
+ where ticket_priorities.priority = ticket_issues.priority
+ and ticket_user_can_see_project_p($user_id, ticket_projects.project_id)='t'
+ and users.user_id = ticket_issue_assignments.user_id
+ and ticket_projects.project_id = ticket_issues.project_id
+ and ticket_issues.msg_id = ticket_issue_assignments.msg_id
+ and ticket_issues.status <> 'closed'
+ $project_filter
+ order by assignee_user_id, project_title, msg_id
+"
+
+set selection [ns_db select $db $query]
+
+set results ""
+append results "<table border=0>
+<tr><th align=left>User</th>
+<th align=left>ID#</th>
+<th align=left>Pri</th>
+<th align=left>Typ</th>
+<th align=left>Stat</th>
+<th align=left>Sever</th>
+<th align=left>Creat</th>
+<th align=left>Mod</th>
+<th align=left>Synopsis</th>
+<th align=left>Project</th>
+</tr>
+"
+
+set count 0
+set last_email ""
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if {$last_email != $assignee_email} {
+	append results "<tr><td colspan=10 bgcolor=#cccccc>&nbsp;</tr>"
+    }
+    set cols {}
+    regsub "@.*" $assignee_email "" aemail
+
+    # only print  user email when it changes
+    if {$last_email != $assignee_email} {
+	lappend cols $aemail
+    } else {
+	lappend cols ""
+    }
+    set last_email $assignee_email
+
+    lappend cols "<a href=\"issue-view.tcl?msg_id=$msg_id\">$msg_id</a>"
+    lappend cols "P$priority"
+    lappend cols "[string range $ticket_type 0 3]"
+    if { [string compare $status "fixed waiting approval"] == 0 } {
+	lappend cols "<font color=#00ff00>(w approv)</font>"
+    } elseif { [string compare $status "need clarification"] == 0 } {
+	lappend cols "<font color=#ff0000>nd clar</font>"
+    } else {
+	lappend cols $status
+    }
+    lappend cols "$severity"
+    lappend cols "$creation_time"
+    lappend cols "$modification_time"
+    
+    lappend cols "<a href=\"issue-view.tcl?msg_id=$msg_id\">[clean_up_html $one_line]</a>"
+
+    # show project title if we are not sorting by project
+    lappend cols "<a href=project-top.tcl?project_id=$project_id>[string range $project_title 0 12]</a>"	
+    
+    incr count
+    if {($count % 2) == 0} {
+	set bgcolor "bgcolor=\#ECECEC"
+    } else {
+	set bgcolor ""
+    }
+    
+    append results "<tr $bgcolor>"
+    foreach col $cols {
+	append results "<td>$col&nbsp;</td>\n"
+    }
+    append results "</tr>"    
+}
+
+if { $count == 0 } {
+    append results "<tr><td colspan=10 align=center>-- No issues --</td></tr>"   
+}
+
+append results "</table>\n<p>"
+
+
+append results  "
+<ul>
+<li><a href=\"issue-new.tcl\">add a new issue</a>
+</ul>"
+
+append results "[ad_footer]"
+ns_write $results
Index: web/openacs/www/new-ticket/projects-all.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/projects-all.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/projects-all.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,26 @@
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+ReturnHeaders
+
+ns_write "[ad_header "All Projects"]
+<h2>All Projects</h2>
+in <a href=\"../index.tcl\">[ticket_system_name]</a>.
+<hr><p>
+
+<ul>
+<li> <A href=\"project-new.tcl\">New Project</a>
+<p>
+"
+
+set selection [ns_db select $db "select * from ticket_projects where ticket_user_can_see_project_p($user_id, project_id)='t'"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    ns_write  "<li> <A href=\"project-top.tcl?project_id=$project_id\">$title</a>\n"
+}
+
+ns_write "</ul>
+
+[ad_footer]"
Index: web/openacs/www/new-ticket/release-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/release-delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/release-delete-2.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,24 @@
+set_the_usual_form_variables
+# release_id project_id return_url return_pretty_name
+
+validate_integer release_id $release_id
+validate_integer project_id $project_id
+
+set user_id [ad_get_user_id]
+set db [ns_db gethandle]
+
+# permissions
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+ns_db dml $db "begin transaction"
+
+ns_db dml $db "update ticket_issues set release_id=NULL where release_id=$release_id and parent_project_p(root_project_id,$project_id)='t'"
+ns_db dml $db "delete from ticket_project_releases where release_id=$release_id and project_id=project_root_project_id($project_id)"
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "releases.tcl?[export_url_vars project_id return_url return_pretty_name]"
+
Index: web/openacs/www/new-ticket/release-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/release-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/release-delete.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,63 @@
+set_the_usual_form_variables
+# release_id project_id return_url return_pretty_name
+
+validate_integer release_id $release_id
+validate_integer project_id $project_id
+
+set user_id [ad_get_user_id]
+set db [ns_db gethandle]
+
+# permissions
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+ns_db dml $db "begin transaction"
+
+# This prevents rows from being inserted after we check the count
+# of issues
+ns_db dml $db "lock table ticket_issues in exclusive mode"
+
+# Check if there are issues that point to this
+# release, and if so ask for confirmation
+if {[database_to_tcl_string $db "select count(*) from ticket_issues where root_project_id=project_root_project_id($project_id) and release_id=$release_id"] == 0} {
+
+    ns_db dml $db "delete from ticket_project_releases where release_id=$release_id and project_id=project_root_project_id($project_id)"
+
+    ns_db dml $db "end transaction"
+
+    ns_returnredirect "releases.tcl?[export_url_vars project_id release_id return_url return_pretty_name]"
+    return
+}
+
+ns_db dml $db "end transaction"
+
+set selection [ns_db 0or1row $db "select title, release from ticket_projects, ticket_project_releases where ticket_project_releases.project_id=project_root_project_id(ticket_projects.project_id) and ticket_projects.project_id=$project_id and release_id='$release_id'"]
+
+if {$selection == ""} {
+    ad_return_error "no such release!" "no such release!"
+    return
+}
+
+set_variables_after_query
+
+ns_return 200 text/html "
+[ad_header "Confirm Delete"]
+<h2>Confirm Delete</h2>
+[ad_context_bar_ws_or_index [list "[ticket_admin_url_stub]/index.tcl" "Ticket Tracker"] [list "project-top.tcl?[export_url_vars project_id]" $title] [list "releases.tcl?[export_url_vars project_id return_url return_pretty_name]" "Releases"] "One Release"]
+<hr><p>
+
+<font color=red>WARNING:</font> This release has issues associated with it. If you choose to delete
+it, the corresponding issues will no longer be assigned to a particular release.
+<p>
+
+<center>
+<FORM method=post action= release-delete-2.tcl>
+[export_form_vars release_id project_id return_url return_pretty_name]
+<INPUT TYPE=submit value=\"really delete\">
+</FORM>
+</center>
+<p>
+[ad_footer]
+"
Index: web/openacs/www/new-ticket/release-download.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/release-download.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/release-download.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,26 @@
+set_the_usual_form_variables
+# project_id release_id return_url return_pretty_name
+
+validate_integer project_id $project_id
+validate_integer release_id $release_id
+
+set user_id [ad_get_user_id]
+set db [ns_db gethandle]
+
+# permissions
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set selection [ns_db 0or1row $db "select project_full_name(ticket_projects.project_id) as title, release, build_file from ticket_projects, ticket_project_releases where ticket_project_releases.project_id=project_root_project_id(ticket_projects.project_id) and ticket_projects.project_id=$project_id and release_id='$release_id'"]
+
+if {$selection == ""} {
+    ad_return_error "no such release!" "no such release!"
+    return
+}
+
+set_variables_after_query
+
+# Send the file
+ns_returnfile 200 [ns_guesstype $build_file] [project_build_path]/$build_file
Index: web/openacs/www/new-ticket/release-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/release-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/release-edit.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,18 @@
+set_the_usual_form_variables
+# project_id release_id return_url return_pretty_name
+
+validate_integer project_id $project_id
+validate_integer release_id $release_id
+
+set user_id [ad_get_user_id]
+set db [ns_db gethandle]
+
+# permissions
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+ns_db dml $db "update ticket_project_releases set release='$QQrelease' where release_id=$release_id and project_id=project_root_project_id($project_id)"
+
+ns_returnredirect "releases.tcl?[export_url_vars project_id return_url return_pretty_name]"
Index: web/openacs/www/new-ticket/release-upload-build-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/release-upload-build-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/release-upload-build-2.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,51 @@
+# set_the_usual_form_variables
+# project_id release_id
+# build_file
+set project_id [ns_queryget project_id]
+set release_id [ns_queryget release_id]
+set build_file [ns_queryget build_file]
+set tmpfile [ns_queryget build_file.tmpfile]
+
+validate_integer project_id $project_id
+validate_integer release_id $release_id
+
+set user_id [ad_get_user_id]
+set db [ns_db gethandle]
+
+# permissions
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set selection [ns_db 0or1row $db "select project_full_name(ticket_projects.project_id) as title, release from ticket_projects, ticket_project_releases where ticket_project_releases.project_id=project_root_project_id(ticket_projects.project_id) and ticket_projects.project_id=$project_id and release_id='$release_id'"]
+
+if {$selection == ""} {
+    ad_return_error "no such release!" "no such release!"
+    return
+}
+
+set_variables_after_query
+
+# Get the filename for this project and release
+set filename [project_generate_filename $project_id $release_id $build_file]
+set path [project_build_path]
+
+# Copy the release
+ns_cp $tmpfile "$path/$filename"
+
+# update the db
+ns_db dml $db "update ticket_project_releases set build_file='$filename' where project_id=$project_id and release_id=$release_id"
+
+# Return a success page
+ReturnHeaders
+
+ns_write "[ad_header "Upload of release"]
+<h2>Upload Successful</h2>
+[ad_context_bar_ws_or_index [list "[ticket_admin_url_stub]/index.tcl" "Ticket Tracker"] [list "project-top.tcl?[export_url_vars project_id]" $title] [list "releases.tcl?[export_url_vars project_id return_url return_pretty_name]" "Releases"] "One Release"]
+<hr><p>
+
+The upload the release file was successful.
+<p>
+[ad_footer]
+"
Index: web/openacs/www/new-ticket/release-upload-build.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/release-upload-build.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/release-upload-build.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,42 @@
+set_the_usual_form_variables
+# project_id release_id return_url return_pretty_name
+
+validate_integer project_id $project_id
+validate_integer release_id $release_id
+
+set user_id [ad_get_user_id]
+set db [ns_db gethandle]
+
+# permissions
+if {![ticket_user_can_edit_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set selection [ns_db 0or1row $db "select project_full_name(ticket_projects.project_id) as title, release from ticket_projects, ticket_project_releases where ticket_project_releases.project_id=project_root_project_id(ticket_projects.project_id) and ticket_projects.project_id=$project_id and release_id='$release_id'"]
+
+if {$selection == ""} {
+    ad_return_error "no such release!" "no such release!"
+    return
+}
+
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "[ad_header "Upload Release Build of $title"]
+<h2>Upload Build</h2>
+[ad_context_bar_ws_or_index [list "[ticket_admin_url_stub]/index.tcl" "Ticket Tracker"] [list "project-top.tcl?[export_url_vars project_id]" $title] [list "releases.tcl?[export_url_vars project_id return_url return_pretty_name]" "Releases"] [list "one-release.tcl?[export_url_vars project_id release_id]" "$release"] "Upload Build"]
+<hr><p>
+
+<FORM enctype=multipart/form-data method=post ACTION=release-upload-build-2.tcl>
+[export_form_vars project_id release_id return_url return_pretty_name]
+Upload the build file:
+<INPUT TYPE=file name=build_file size=50>
+<p>
+<INPUT TYPE=submit value=upload>
+</FORM>
+<p>
+
+[ad_footer]
+"
\ No newline at end of file
Index: web/openacs/www/new-ticket/releases.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/releases.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/releases.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,64 @@
+set_the_usual_form_variables
+# project_id return_url return_pretty_name
+
+validate_integer project_id $project_id
+
+set user_id [ad_get_user_id]
+set db [ns_db gethandle]
+
+# permissions
+if {![ticket_user_can_see_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set selection [ns_db 1row $db "select project_full_name(project_id) as title from ticket_projects where project_id=$project_id"]
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "[ad_header "Releases"]
+<h2>Releases</h2>
+[ad_context_bar_ws_or_index [list "[ticket_admin_url_stub]/index.tcl" "Ticket Tracker"] [list "project-top.tcl?[export_url_vars project_id]" $title] "Releases"]
+<hr><p>
+
+<ul>
+"
+
+set selection [ns_db select $db "select release, release_id from ticket_project_releases where project_id=project_root_project_id($project_id)"]
+
+set counter 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    incr counter
+
+    ns_write "<li> <a href=one-release.tcl?[export_url_vars project_id release_id return_url return_pretty_name]>$release</a>\n"
+}
+
+if {$counter == 0} {
+    ns_write "no releases"
+}
+
+if {[ticket_user_can_edit_project_p $user_id $project_id $db]} {
+ns_write "<p>
+<FORM method=post action=new-release.tcl>
+[export_form_vars project_id return_url return_pretty_name]
+<li> New Release: <input type=text name=release size=50> <input type=submit value=add></form>
+</ul>
+
+<p>
+"
+}
+
+if {[info exists return_url]} {
+    ns_write "
+You may return to <a href=\"$return_url\">$return_pretty_name</a>.
+<p>
+"
+}
+
+ns_write "
+[ad_footer]
+"
\ No newline at end of file
Index: web/openacs/www/new-ticket/search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/search.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,97 @@
+set_the_usual_form_variables
+
+set db [ticket_getdbhandle]
+
+
+# query_string, project_id (optional), accumulate_p (optional), fuzzy_p (optional)
+
+if { ![info exists query_string] || $query_string == "" } {
+    # probably using MSIE
+    ns_return 200 text/html "[ad_header "Missing Query"]
+<h2>Missing Query</h2>
+<hr>
+Either you didn't type a query string or you're using a quality Web
+browser like Microsoft Internet Explorer 3.x (which neglects to 
+pass user input up the server).
+[ad_footer]
+"
+    return
+}
+
+set user_id [ad_get_user_id]
+
+# we ask for all the top level messages
+
+ReturnHeaders
+
+ns_write "[ad_header "Search Results"]
+<h2>Messages matching \"$query_string\"</h2>
+in the <a href=\"index.tcl\">[ticket_system_name]</a>
+<hr>
+<ul>
+"
+
+
+# Non-admin users get their search restricted to tickets which
+# belong to a common group.
+
+set admin_group_member_p [ad_administration_group_member $db "ticket" "" $user_id]
+
+set where_clause_list {" ticket_projects.project_id = ticket_issues.project_id"}
+
+# If the user is not a staff member, only show other issues which
+# were created by members of a common group.
+if {$admin_group_member_p != 1} {
+    # Get list of groups to which the user belongs
+    set groups [database_to_tcl_list $db "select group_id from user_group_map where user_id = $user_id"]
+    lappend where_clause_list "ticket_issues.group_id in ([join $groups " "])"
+} 
+
+
+#where pseudo_contains(dbms_lob.substr(indexed_stuff,4000)
+
+#if [catch {
+set selection [ns_db select $db "select msg_id, one_line, ticket_issues.project_id, ticket_projects.title from 
+ticket_issues, ticket_projects 
+where [join $where_clause_list " and "]
+and upper(dbms_lob.substr(indexed_stuff,4000)) like upper('%$query_string%')
+order by msg_id"]
+#} errmsg] {
+    
+#    ns_write "[ad_return_context_error $errmsg]
+#</ul>
+#[ad_footer]"
+    
+#    return   
+#}
+
+set counter 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+    ns_write "<li>\[$msg_id\] <a href=\"issue-view.tcl?msg_id=$msg_id\">[clean_up_html $one_line]</a>\n"
+}
+
+if { $counter == 0 } {
+    set search_items "messages"
+    ns_write "No matching items found."
+} 
+
+ns_write "
+</ul>
+[ad_footer]
+"
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/new-ticket/set-response-visibility.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/set-response-visibility.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/set-response-visibility.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,37 @@
+# Toggles the public/private flag on a response
+
+set_the_usual_form_variables
+# response_id public_p msg_id
+
+validate_integer response_id $response_id
+validate_integer msg_id $msg_id
+
+set user_id [ad_get_user_id]
+set db [ticket_getdbhandle]
+
+if {![ticket_user_can_edit_issues_p $user_id $msg_id $db]} {
+    ticket_deny_access
+    return
+}
+
+with_transaction $db {
+    ns_db dml $db "update ticket_issue_responses set public_p = '$public_p' where response_id=$response_id"
+} {
+    # something went a bit wrong during the insert
+    ns_return 200 text/html "[ad_header "Error modifying a response"]
+<h3>Ouch!!</h3>
+<hr>
+We encountered a problem modifying the response.
+Here was the bad news from the database:
+<pre>
+$errmsg
+</pre>
+[ad_footer]
+"
+    return
+}
+
+
+ns_returnredirect "issue-view.tcl?[export_url_vars msg_id]"
+
+
Index: web/openacs/www/new-ticket/ticket-search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/ticket-search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/ticket-search.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,162 @@
+set_the_usual_form_variables
+
+set user_id [ad_get_user_id]
+set db [ns_db gethandle]
+
+# creator_fname, creator_lname
+# contact_fname, contact_lname
+# ticket_id
+# ticket_type
+# creation_start, creation_end 
+# project_id, priority
+
+# Check input.
+
+validate_integer ticket_id $ticket_id
+validate_integer project_id $project_id
+
+set exception_text ""
+set exception_count 0
+
+ticket_search_combine_and_build_error_list
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# This looks at a bunch of form vars, and builds a list of search
+# clauses in search_clause_list
+ticket_search_build_where_clause_and_description
+
+if {![info exists search_description_items] || [llength $search_description_items] == 0} {
+    ad_return_complaint 1 "<li>Please specify at least some search criteria.\n"
+    return
+}
+
+
+if { [info exists assigned_fname] && [info exists assigned_lname] && (![empty_string_p $assigned_fname] || ![empty_string_p $assigned_lname]) } {
+    set assigned_user_conditions [list]
+    if {![empty_string_p $assigned_fname]} {
+	lappend assigned_user_conditions "(lower(email) like  '[string tolower [DoubleApos $assigned_fname]]%' or  lower(first_names) like '[string tolower [DoubleApos $assigned_fname]]%')"
+    } 
+    if {  ![empty_string_p $assigned_lname] } {
+	lappend assigned_user_conditions "lower(last_name) like '[string tolower [DoubleApos $assigned_lname]]%'"
+    }
+
+    lappend search_clause_list " msg_id in (select msg_id from ticket_issue_assignments ta, users where ta.user_id = users.user_id and [join $assigned_user_conditions { or }] ) "
+
+}
+
+if {[llength $search_clause_list] > 0} {
+    set search_clause "and [join $search_clause_list " and "]"
+} else {
+    set search_clause ""
+}
+
+set display_title "Ticket search"
+
+set query "select ticket_issues.*,
+ticket_projects.title as project_title, 
+users.first_names,
+users.last_name,
+to_char(posting_time, 'MM/DD/YYYY') as creation_date
+from ticket_issues, ticket_projects, users
+where
+users.user_id = ticket_issues.user_id 
+and ticket_projects.project_id = ticket_issues.project_id
+and ticket_user_can_see_project_p($user_id, ticket_projects.project_id)='t'
+$search_clause
+order by ticket_issues.project_id, msg_id"
+
+ReturnHeaders
+
+set selection [ns_db select $db $query]
+
+append pagebody "[ad_header $display_title]
+<h2>$display_title</h2>
+in <a href=\"\">[ad_system_name]</a>
+<hr>
+
+Search criteria:
+
+<ul>
+<li>[join $search_description_items "<li>"]
+</ul>
+
+<p>
+
+Search results:
+
+"
+
+set i 0
+set ppcount  0
+set msgs_displayed_already [list]
+
+set last_title ""
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { [lsearch $msgs_displayed_already msg_id] != -1 } {
+	continue
+    } else {
+	lappend msgs_displayed_already $msg_id
+    }
+    set detail_list ""
+
+    if {[string compare $project_title $last_title] != 0} {
+	if {$ppcount != 0} {
+	    append pagebody "<br>$ppcount issues"
+	    set ppcount 0
+	}
+	append pagebody "</ul><b>$project_title</b><ul>"
+    }
+
+    set last_title $project_title
+
+    set item_list_list { {"creation_date" "Creation Date:"} {"priority" "Priority:"} {"source" "Source:"} }
+
+    foreach item_list $item_list_list {
+	set variable [lindex $item_list 0]
+	set annotation [lindex $item_list 1]
+	if ![empty_string_p [set $variable]] {
+	    lappend detail_list "$annotation [set $variable]"
+	}
+    }
+    
+    append pagebody "<li>
+<a href=\"[ticket_url_stub]/issue-view.tcl?[export_url_vars msg_id]\">\#$msg_id [clean_up_html $one_line]</a>"
+   if {[string tolower $status] == "closed"} {
+       append pagebody " <font color=green>Status: closed</font> "
+   } else {
+       append pagebody " Status: $status "
+   }
+   append pagebody [join $detail_list " ; "]
+
+   incr i
+   incr ppcount
+}
+
+if {$ppcount != 0} {
+    append pagebody "<br>$ppcount issues"
+    set ppcount 0
+}
+
+if { $i == 0 } {
+    append pagebody "No tickets found.\n"
+} else {
+    append pagebody "
+</ul>
+<p>
+"
+}
+
+append pagebody "
+<p>
+<ul>
+<li><a href=\"issue-new.tcl\">Add a new ticket</a>
+</ul>
+[ad_footer]
+"
+ns_write $pagebody
Index: web/openacs/www/new-ticket/unauthorized.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/unauthorized.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/unauthorized.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,11 @@
+ReturnHeaders 
+
+ns_write "[ad_header [ad_system_name]]
+
+<h2>Access Denied</h2>
+Your user account does not have access to this functionality.
+
+<hr>
+
+[ad_footer]
+"
Index: web/openacs/www/new-ticket/unlink-xref.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/unlink-xref.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/unlink-xref.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,27 @@
+#
+# remove an entry from the  cross-reference table
+#
+# from_msg_id
+# to_msg_id 
+# target 
+
+set_form_variables
+
+validate_integer from_msg_id $from_msg_id
+validate_integer to_msg_id $to_msg_id
+
+set user_id [ad_get_user_id]
+set db [ticket_getdbhandle]
+
+# permissions
+if {![ticket_user_can_edit_issues_p $user_id [list $from_msg_id $to_msg_id] $db]} {
+    ticket_deny_access
+    return
+}
+
+ns_db dml $db "delete from ticket_xrefs where (from_ticket = $from_msg_id
+and to_ticket = $to_msg_id) or (from_ticket = $to_msg_id and to_ticket = $from_msg_id)"
+
+set msg_id $from_msg_id
+ns_returnredirect "$target?[export_url_vars msg_id]"
+
Index: web/openacs/www/new-ticket/user-summary.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/user-summary.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/user-summary.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,114 @@
+# Summarize projects status
+#
+
+set db_list [ns_db gethandle main 2]
+set db   [lindex $db_list 0]
+set db2   [lindex $db_list 1]
+set user_id [ad_get_user_id]
+
+set list_of_projects [database_to_tcl_list_list $db "select project_id,title from ticket_projects where ticket_user_can_see_project_p($user_id, project_id)='t'"]
+
+set sql "select 
+  users.user_id,
+  users.first_names || ' ' || users.last_name as name
+from users, ticket_issues ti, ticket_issue_assignments tia
+where users.user_id = tia.user_id
+and ticket_user_can_see_project_p($user_id, ti.project_id)='t'
+and ti.msg_id = tia.msg_id
+group by users.user_id,  last_name, first_names
+order by upper(last_name)"
+
+set list_of_users [database_to_tcl_list_list $db $sql]
+
+ReturnHeaders
+ns_write "[ad_header "Project Status"]
+<h2>User Status Summary</h2>
+
+[ad_context_bar_ws_or_index [list "[ticket_url_stub]/index.tcl" "Ticket Tracker"]  "User Summaries"]
+
+<hr>
+
+<blockquote>
+<table border=0>
+<tr>
+<th>User
+<th>Total 
+<th>Active
+<th>Closed
+<th>Deferred
+<th>Last Mod
+<th>Oldest Active
+</tr>
+"
+
+set i 0
+
+
+set selection [ns_db select $db "
+select 
+  users.user_id as summary_user_id, 
+  users.first_names || ' ' || users.last_name as name, 
+  count(tia.msg_id) as total,
+  sum(case when status='closed' then 1 else 0 end) as closed,
+  sum(case when status='closed' then 0 when status='deferred' then 0 when status is NULL then 0 else 1 end) as open,
+  sum(case when status= 'deferred' then 1 else 0 end) as deferred,
+  max(modification_time) as lastmod,
+  min(posting_time) as oldest,
+  sum(ticket_one_if_high_priority(priority, status)) as high_pri,
+  sum(ticket_one_if_blocker(severity, status)) as blocker
+from users, ticket_issues ti, ticket_issue_assignments tia
+where users.user_id = tia.user_id
+and ticket_user_can_see_project_p($user_id, ti.project_id)='t'
+and ti.msg_id = tia.msg_id
+group by users.user_id,  last_name, first_names
+order by upper(last_name)
+"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    # show summaries of ticket stats
+    # total #
+    # open
+    # closed
+    # deferred
+    # last modified (max)
+    # 
+
+    if {($i % 2) == 0} {
+	set bgcolor "bgcolor=\#ECECEC"
+    } else {
+	set bgcolor ""
+    }
+
+    ns_write "
+<tr>
+  <td $bgcolor><a href=\"user-top.tcl?[export_url_vars summary_user_id]\">$name
+  <td $bgcolor align=right>[blank_zero $total]&nbsp;
+  <td $bgcolor align=right>[blank_zero $open]&nbsp;
+  <td $bgcolor align=right>[blank_zero $closed]&nbsp;
+  <td $bgcolor align=right>[blank_zero $deferred]&nbsp;
+  <td $bgcolor align=right>$lastmod&nbsp;
+  <td $bgcolor align=right>$oldest&nbsp;
+</tr>
+"
+   incr i
+}
+
+ns_write "</table>
+</blockquote>
+<hr>
+<p>
+<h3>View by User Creation:</h3>
+<FORM method=GET action=by-creation-user.tcl>Project: 
+[make_html_select project_id $list_of_projects] 
+User: 
+[make_html_select user_id $list_of_users]
+<INPUT TYPE=submit value=go></FORM><p><p>
+<hr>
+<ul>
+<li>Add new <a href=\"issue-new.tcl\">issue</a>
+</ul>
+
+[ad_footer]
+"
Index: web/openacs/www/new-ticket/user-top.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/user-top.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/user-top.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,282 @@
+set_form_variables 0
+
+
+# form vars:
+# 
+# summary_user_id - user_id this page is for
+#
+# filter conditions
+#
+
+validate_integer summary_user_id $summary_user_id
+
+# Status
+# view_status  { open closed deferred created_by_you }
+#
+# Creation time
+# view_created { last_24 last_week last_month all}
+#
+#
+# order_by       column name to sort table by 
+
+set ctrlvars {view_assignment view_status view_created summary_user_id}
+
+set user_id [ad_get_user_id]
+set db [ticket_getdbhandle]
+
+set name [database_to_tcl_string $db "select first_names || ' ' || last_name 
+from users where user_id = $summary_user_id"]
+
+ReturnHeaders
+
+ns_write "[ad_header "[ticket_system_name] Home"]
+
+<h2>Summary for $name</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Ticket Tracker"] "User summary"]
+
+<hr>
+"
+
+# List of form vars used to select tickets to display
+
+# Assignment filter conditions
+#
+
+if {![info exists view_assignment]} {
+    # default to show issues assigned to $user_id
+    set view_assignment user
+}
+
+# default to only your own assigned issues
+if {![info exists view_status]} {
+    set view_status open
+}
+
+# default to all time
+if {![info exists view_created]} {
+    set view_created all
+}
+
+
+
+#  set assignment_filter "and (exists 
+#  (select msg_id from ticket_issue_assignments 
+#  where ticket_issue_assignments.msg_id = ticket_issues.msg_id
+#  and ticket_issue_assignments.user_id = $summary_user_id
+#  )) " 
+
+set assignment_filter ""
+
+
+switch $view_status {
+    "open" {set status_filter "and ((status <> 'closed') and (status <> 'deferred')) " }
+    "deferred" {set status_filter "and ((status <> 'closed') or (status = 'deferred')) " }
+    "closed" {set status_filter "" } # shows everything
+}
+
+switch $view_created {
+   "last_24"   { set date_filter "and (posting_time > (sysdate() - 1))" } 
+   "last_week" { set date_filter "and (posting_time > (sysdate() - 7)) " } 
+   "last_month" { set date_filter "and (posting_time > (sysdate() - 30)) " }
+   "all" { set date_filter "" }
+}
+
+# Sort order of tickets by
+if {![info exists order_by]} {
+    set order_by "ticket_issues.msg_id"
+} elseif {[string match "project*" $order_by]} {
+    set order_by "project_title"
+}
+
+
+################################################################
+# GUI ticket filter controls
+
+# List of all the state vars we need to pass through these toggle switches
+set filter_vars {view_assignment view_status view_created order_by summary_user_id}
+
+
+append results "<table border=0 cellspacing=0 cellpadding=0 width=100%>
+<tr>
+<th bgcolor=#ECECEC>Status</th>
+<th bgcolor=#ECECEC>Creation Time</th></tr>"
+
+
+#### Assignment flags
+# Show assigned to you 
+append results "<tr>
+<td align=center>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;\["
+
+# Show open issues
+append results [ticket_control_vars view_status open $filter_vars "active" "user-top.tcl"]
+append results " | "
+# Show deferred issues
+append results [ticket_control_vars view_status deferred $filter_vars "+deferred" "user-top.tcl"]
+append results " | "
+# Show closed issues
+append results [ticket_control_vars view_status closed $filter_vars "+closed" "user-top.tcl"]
+
+
+#### Creation time filter
+append results "\]&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</td>\n<td align=center>\["
+
+append results [ticket_control_vars view_created last_24 $filter_vars "last 24 hrs" "user-top.tcl"]
+append results " | "
+append results [ticket_control_vars view_created last_week $filter_vars "last week" "user-top.tcl"]
+append results " | "
+append results [ticket_control_vars view_created last_month $filter_vars "last month" "user-top.tcl"]
+append results " | "
+append results [ticket_control_vars view_created all $filter_vars "all" "user-top.tcl"]
+
+append results "\]</td></tr></table><p>"
+
+################################################################
+
+
+
+set last_priority "starting"
+
+set count 0
+
+append results "<table border=0>
+<tr>
+<th align=left><a href=\"user-top.tcl?order_by=[toggle_order ticket_issues.msg_id $order_by]&[eval export_url_vars $ctrlvars]\">ID#</a></th>
+<th align=left><a href=\"user-top.tcl?order_by=[toggle_order priority $order_by]&[eval export_url_vars $ctrlvars]\">Pri</a></th>
+<th align=left><a href=\"user-top.tcl?order_by=[toggle_order ticket_type $order_by]&[eval export_url_vars $ctrlvars]\">Typ</a></th>
+<th align=left><a href=\"user-top.tcl?order_by=[toggle_order email $order_by]&[eval export_url_vars $ctrlvars]\">Creator</a></th>
+<th align=left><a href=\"user-top.tcl?order_by=[toggle_order status $order_by]&[eval export_url_vars $ctrlvars]\">Stat</a></th>
+<th align=left><a href=\"user-top.tcl?order_by=[toggle_order severity $order_by]&[eval export_url_vars $ctrlvars]\">Sever</a></th>
+<th align=left><a href=\"user-top.tcl?order_by=[toggle_order posting_time $order_by]&[eval export_url_vars $ctrlvars]\">Creat</a></th>
+<th align=left><a href=\"user-top.tcl?order_by=[toggle_order modification_time $order_by]&[eval export_url_vars $ctrlvars]\">Mod</a></th>"
+
+if {$view_assignment != "user"} {
+    append results "<th align=left><a href=\"user_top.tcl?order_by=[toggle_order assigned_p $order_by]&[eval export_url_vars $ctrlvars]\">Asgn?</a></th>
+"
+}
+
+if { $view_status == "closed" } {
+    append results "<th align=left><a href=\"user-top.tcl?order_by=[toggle_order close_date $order_by]&[eval export_url_vars $ctrlvars]\">Closed</a></th>"
+} else {
+    append results "<th align=left><a href=\"user-top.tcl?order_by=[toggle_order deadline $order_by]&[eval export_url_vars $ctrlvars]\">Deadline</a></th>"
+}
+
+append results "<th align=left><a href=\"user-top.tcl?order_by=[toggle_order one_line $order_by]&[eval export_url_vars $ctrlvars]\">Synopsis</a></th>
+"
+if {![string match "project_title" $order_by]} {
+    append results "<th align=left><a href=\"user-top.tcl?order_by=[toggle_order project_id $order_by]&[eval export_url_vars $ctrlvars]\">Project</a></th>
+"    
+}
+append results "</tr>\n"
+
+set last_project_title ""
+
+set query "select distinct
+ ticket_issues.msg_id,
+ ticket_issues.ticket_type, 
+ ticket_issues.one_line,
+ ticket_issues.status,
+ ticket_issues.severity,
+ ticket_issues.posting_time,
+ users.email,
+ ticket_projects.title as project_title,
+ ticket_projects.project_id,
+ ticket_issues.priority, 
+ to_char(ticket_issues.modification_time, 'MM/DD/YY') as modification_time,
+ to_char(ticket_issues.posting_time, 'MM/DD/YY') as creation_time,
+ to_char(ticket_issues.close_date, 'MM/DD/YY') as close_date,
+ to_char(ticket_issues.deadline, 'MM/DD/YY') as deadline,
+ sysdate() - deadline as pastdue,
+ ticket_issue_assignments.active_p as assigned_p,
+ ticket_issues.public_p
+from ticket_issues, ticket_projects, users, ticket_issue_assignments
+where ticket_user_can_see_project_p($user_id, ticket_projects.project_id)='t'
+and users.user_id = ticket_issues.user_id
+and ticket_projects.project_id = ticket_issues.project_id
+and ticket_issues.msg_id = ticket_issue_assignments.msg_id
+and ticket_issue_assignments.user_id= $summary_user_id 
+$assignment_filter
+$status_filter
+$date_filter
+order by $order_by, ticket_issues.priority, ticket_issues.posting_time"
+
+set selection [ns_db select $db $query]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    set cols {}
+    lappend cols "<a href=\"issue-view.tcl?msg_id=$msg_id\">$msg_id</a>"
+    lappend cols "P$priority"
+    lappend cols "[string range $ticket_type 0 3]"
+    regsub "@.*" $email "" email
+    lappend cols "$email"
+    if { [string compare $status "fixed waiting approval"] == 0 } {
+	lappend cols "<font color=#00ff00>(w approv)</font>"
+    } elseif { [string compare $status "need clarification"] == 0 } {
+	lappend cols "<font color=#ff0000>nd clar</font>"
+    } else {
+	lappend cols $status
+    }
+    lappend cols "$severity"
+    lappend cols "$creation_time"
+    lappend cols "$modification_time"
+
+    if {$view_assignment != "user"} {
+	if {$assigned_p == "t"} {
+	    lappend cols "<img src=/graphics/checkmark.gif>"
+	} else {
+	    lappend cols " - "
+	}
+    }
+    
+    if {[info exists closed] && $view_closed == 1} {
+	lappend cols "$close_date" 
+    } else {
+	if {$pastdue > 0} {
+	    lappend cols "<font color=red>$deadline</font>"
+	} else {
+	    lappend cols "$deadline"
+	}
+    }
+    
+    lappend cols "<a href=\"issue-view.tcl?msg_id=$msg_id\">[clean_up_html $one_line]</a>"
+    
+    # show project title if we are not sorting by project
+    if {![string match "project_title" $order_by]} {
+	lappend cols "<a href=project-top.tcl?project_id=$project_id>[string range $project_title 0 12]</a>"	
+    }
+    
+    if {[string match "project_title" $order_by] && $last_project_title != $project_title} {
+	append results "<tr><th colspan=10 align=left><a href=project-top.tcl?project_id=$project_id>$project_title</a></th></tr>\n"
+	set last_project_title $project_title
+    }
+    
+    incr count
+    if {($count % 2) == 0} {
+	set bgcolor "bgcolor=\#ECECEC"
+    } else {
+	set bgcolor ""
+    }
+    
+    append results "<tr $bgcolor>"
+    foreach col $cols {
+	append results "<td>$col&nbsp;</td>\n"
+    }
+    append results "</tr>"    
+}
+
+if { $count == 0 } {
+    append results "<tr><td colspan=10 align=center>-- No issues --</td></tr>"   
+}
+
+append results "</table>\n<p>"
+
+
+ns_write  "$results
+
+<ul>
+<li>Add new <a href=\"issue-new.tcl\">issue</a>
+</ul>
+[ad_footer]
+"
+
Index: web/openacs/www/new-ticket/xref-search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/xref-search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/xref-search.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,136 @@
+set_the_usual_form_variables
+# project_id (optional)
+#
+# target -- url to return to when done
+# msg_id
+# 
+# standard ticket search form variables
+
+validate_integer msg_id $msg_id
+
+set user_id [ad_get_user_id]
+set db [ticket_getdbhandle]
+
+set selection [ns_db 1row $db "select one_line, ticket_projects.project_id as project_id, title from ticket_issues,ticket_projects where msg_id=$msg_id and ticket_issues.project_id=ticket_projects.project_id"]
+set_variables_after_query
+
+# we ask for all the top level messages
+
+ReturnHeaders
+
+ns_write "[ad_header "Search Results"]
+<h2>Tickets matching query</h2>
+[ad_context_bar_ws_or_index [list "[ticket_url_stub]/index.tcl" "Ticket Tracker"] [list "project-top.tcl?project_id=$project_id" $title] [list "issue-view.tcl?[export_url_vars msg_id]" "One Ticket"] "Cross-Reference"]
+<hr><p>
+
+Click on a link below to add that ticket as a cross-reference.
+"
+
+
+
+# Check input.
+
+set exception_text ""
+set exception_count 0
+
+ticket_search_combine_and_build_error_list
+
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# This looks at a bunch of form vars, and builds a list of search
+# clauses in search_clause_list
+ticket_search_build_where_clause_and_description
+
+
+set search_clause [join $search_clause_list " and "]
+if {![empty_string_p $search_clause]} {
+    set search_clause " and $search_clause"
+}
+
+if ![info exists search_clause_list] {
+    ad_return_complaint 1 "<li>Please specify at least some search criteria.\n"
+    return
+}
+
+
+ns_write "
+
+
+
+<p>
+Search criteria:
+
+<ul>
+<li>[join $search_description_items "<li>"]
+</ul>
+
+
+<p>
+
+Search results:
+"
+
+
+
+
+set display_title "Ticket search"
+
+set selection [ns_db select $db "select ticket_issues.one_line,
+ticket_issues.msg_id as xmsg_id,
+ticket_projects.title as project_title, 
+users.first_names,
+users.last_name,
+to_char(posting_time, 'mm/dd/yyyy') as creation_date
+from ticket_issues, ticket_projects, users where
+users.user_id = ticket_issues.user_id 
+and ticket_projects.project_id = ticket_issues.project_id
+and ticket_issues.msg_id != $msg_id
+and ticket_user_can_see_project_p($user_id, ticket_projects.project_id)='t'
+ $search_clause
+order by ticket_issues.project_id, xmsg_id"]
+
+set counter 0
+
+set last_title ""
+ns_write "<ul>"
+set pmsg_id $msg_id
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+    if {$project_title != $last_title} {
+	ns_write "</ul><b>$project_title</b><ul>"
+    }
+    set last_title $project_title
+    set msg_id $xmsg_id
+    ns_write "<li>\[ <a target=other href=\"issue-view.tcl?[export_url_vars msg_id]\">View</a> \] \[ <a href=\"add-xref-2.tcl?[export_url_vars target xmsg_id pmsg_id]\">Link</a> \]  [clean_up_html $one_line]\n"
+}
+
+ns_write "</ul>"
+
+if { $counter == 0 } {
+    set search_items "messages"
+    ns_write "No matching items found.<p>
+    <a href=\"$target?[export_url_vars target msg_id xmsg_id]\">Back to ticket #$msg_id</a>"
+}
+ns_write "
+</ul>
+[ad_footer]
+"
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/new-ticket/reports/blank.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/reports/blank.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/reports/blank.html	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,3 @@
+<HEAD><TITLE>blank</Title></HEAD>
+<BODY bgcolor=white>
+</BODY>
Index: web/openacs/www/new-ticket/reports/closed-issues.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/reports/closed-issues.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/reports/closed-issues.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,74 @@
+set_the_usual_form_variables
+# project_id
+
+validate_integer project_id $project_id
+
+if {[info exists target]} {
+    set other_target_html "target=_top"
+    set bug_target_html "target=one"
+} else {
+    set other_target_html ""
+    set bug_target_html ""
+}
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+# Check Permissions
+if {![ticket_user_can_see_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+ReturnHeaders
+
+set selection [ns_db 1row $db "select project_full_name(project_id) as title from ticket_projects where project_id=$project_id"]
+set_variables_after_query
+
+ns_write "[ad_header "Closed Issues"]
+<h2>Closed Issues</h2>
+[ad_context_bar_ws_or_index [list [ticket_admin_url_stub]/index.tcl "Ticket Tracker"] [list ../project-top.tcl?[export_url_vars project_id] "$title"] [list index.tcl?[export_url_vars project_id] "Reports"] "Closed Issues"]
+<hr><p>
+
+"
+
+set selection [ns_db select $db "
+select 
+msg_id, project_full_name(ticket_issues.project_id) as project_title, ticket_issues.project_id as project_id, 
+one_line, ticket_release_name(fixed_release_id) as release, release_id,
+first_names as fixer_first_names, last_name as fixer_last_name,
+users.email as fixer_email, fix_date, severity
+from
+ticket_issues, users
+where
+ticket_issues.close_date is not NULL and
+ticket_issues.fixed_by= users.user_id and
+parent_project_p($project_id, ticket_issues.project_id)='t' and
+ticket_issues.status='closed'
+order by release, [ticket_severity_decode_sql] desc"]
+
+ns_write "
+<table noborder>
+<tr>
+<th align=left>Issue #</th><th align=left>Project</th><th align=left>Fixed By</th><th align=left>Fix Release</th><th align=left>Summary</th>
+</tr>
+"
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    ns_write "<tr>
+<td><a $bug_target_html href=../issue-view.tcl?[export_url_vars msg_id]>$msg_id</a></td>
+<td><a $other_target_html href=../project-top.tcl?[export_url_vars project_id]>$project_title</a></td>
+<td>$fixer_first_names $fixer_last_name</td>
+<td>$release</td>
+<td>$one_line</td>
+</tr>\n"
+}
+
+ns_write "</table>
+<p>
+
+[ad_footer]
+"
\ No newline at end of file
Index: web/openacs/www/new-ticket/reports/fixed-issues.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/reports/fixed-issues.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/reports/fixed-issues.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,76 @@
+set_the_usual_form_variables
+# project_id
+
+validate_integer project_id $project_id
+
+if {[info exists target]} {
+    set other_target_html "target=_top"
+    set bug_target_html "target=one"
+} else {
+    set other_target_html ""
+    set bug_target_html ""
+}
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+# Check Permissions
+if {![ticket_user_can_see_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+ReturnHeaders
+
+set selection [ns_db 1row $db "select project_full_name(project_id) as title from ticket_projects where project_id=$project_id"]
+set_variables_after_query
+
+ns_write "[ad_header "Fixed Issues"]
+<h2>Fixed Issues</h2>
+[ad_context_bar_ws_or_index [list [ticket_admin_url_stub]/index.tcl "Ticket Tracker"] [list ../project-top.tcl?[export_url_vars project_id] "$title"] [list index.tcl?[export_url_vars project_id] "Reports"] "Fixed Issues"]
+<hr><p>
+
+"
+
+set selection [ns_db select $db "
+select 
+msg_id, project_full_name(ticket_issues.project_id) as project_title, 
+ticket_issues.project_id as project_id, 
+one_line, release_id,
+ticket_release_name(release_id) as release,
+first_names as fixer_first_names, last_name as fixer_last_name,
+users.email as fixer_email, fix_date, severity
+from
+ticket_issues, users
+where
+ticket_issues.close_date is NULL and
+ticket_issues.fixed_by= users.user_id and
+parent_project_p($project_id, ticket_issues.project_id)='t' and
+ticket_issues.status='fixed waiting approval'
+order by release, [ticket_severity_decode_sql] desc"]
+
+ns_write "
+<table noborder>
+<tr>
+<th align=left>Issue #</th><th align=left>Project</th><th align=left>Fixed By</th><th align=left>Fix Release</th><th align=left>Summary</th>
+</tr>
+"
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    ns_write "<tr>
+<td><a $bug_target_html href=../issue-view.tcl?[export_url_vars msg_id]>$msg_id</a></td>
+<td><a $other_target_html href=../project-top.tcl?[export_url_vars project_id]>$project_title</a></td>
+<td>$fixer_first_names $fixer_last_name</td>
+<td>$release</td>
+<td>$one_line</td>
+</tr>\n"
+}
+
+ns_write "</table>
+<p>
+
+[ad_footer]
+"
\ No newline at end of file
Index: web/openacs/www/new-ticket/reports/frame-report.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/reports/frame-report.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/reports/frame-report.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,17 @@
+set_the_usual_form_variables
+# report, project_id
+
+validate_integer project_id $project_id
+
+set target "one"
+
+#HACK 
+ns_returnredirect "$report?[export_url_vars project_id target]"
+return
+
+ns_return 200 text/html "
+<frameset rows=200,*>
+<frame name=list src=$report?[export_url_vars project_id target]>
+<frame name=one src=blank.html>
+</frameset>
+"
\ No newline at end of file
Index: web/openacs/www/new-ticket/reports/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/reports/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/reports/index.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,56 @@
+set_form_variables 0
+# project_id
+
+validate_integer project_id $project_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {[info exists project_id]} {
+    if {![ticket_user_can_see_project_p $user_id $project_id $db]} {
+	ticket_deny_access
+	return
+    }
+}
+
+ReturnHeaders
+
+ns_write "[ad_header "Reports"]
+<h2>Reports</h2>
+"
+
+if {![info exists project_id]} {
+    ns_write "[ad_context_bar_ws_or_index [list [ticket_admin_url_stub]/index.tcl "Ticket Tracker"] Reports]"
+} else {
+    set selection [ns_db 1row $db "select title from ticket_projects where project_id=$project_id"]
+    set_variables_after_query
+    ns_write "[ad_context_bar_ws_or_index [list [ticket_admin_url_stub]/index.tcl "Ticket Tracker"] [list ../project-top.tcl?[export_url_vars project_id] "$title"] Reports]"
+}
+
+ns_write "<hr><p>"
+
+if {[info exists project_id]} {
+    ns_write "<ul>
+<li> <a href=frame-report.tcl?report=new-issues.tcl&[export_url_vars project_id]>New Issues</a> - Currently Unassigned
+<li> <a href=frame-report.tcl?report=fixed-issues.tcl&[export_url_vars project_id]>Issues Fixed</a> but Not Yet Approved
+<li> <a href=frame-report.tcl?report=urgent-issues.tcl&[export_url_vars project_id]>Issues With Looming Deadline</a>
+<p>
+<li> <a href=frame-report.tcl?report=less-urgent-issues.tcl&[export_url_vars project_id]>Not So Urgent Issues</a>
+<li> <a href=frame-report.tcl?report=closed-issues.tcl&[export_url_vars project_id]>Closed Issues</a>
+<p>
+<li> <a href=statistics.tcl?[export_url_vars project_id]>Statistics</a>
+</ul>"
+} else {
+    ns_write "
+<form method=get action=index.tcl>
+[ticket_project_select project_id "" $db]
+<p>
+<INPUT TYPE=submit value=go>
+</form>
+"
+}
+
+ns_write "<p>
+
+[ad_footer]"
\ No newline at end of file
Index: web/openacs/www/new-ticket/reports/less-urgent-issues.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/reports/less-urgent-issues.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/reports/less-urgent-issues.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,79 @@
+set_the_usual_form_variables
+# project_id
+
+validate_integer project_id $project_id
+
+if {[info exists target]} {
+    set other_target_html "target=_top"
+    set bug_target_html "target=one"
+} else {
+    set other_target_html ""
+    set bug_target_html ""
+}
+
+set user_id [ad_get_user_id]
+
+set dbs [ns_db gethandle main 2]
+set db [lindex $dbs 0]
+set db_sub [lindex $dbs 1]
+
+# Check Permissions
+if {![ticket_user_can_see_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+ReturnHeaders
+
+set selection [ns_db 1row $db "select project_full_name(project_id) as title from ticket_projects where project_id=$project_id"]
+set_variables_after_query
+
+ns_write "[ad_header "Less Urgent Issues"]
+<h2>Less Urgent Issues</h2>
+[ad_context_bar_ws_or_index [list [ticket_admin_url_stub]/index.tcl "Ticket Tracker"] [list ../project-top.tcl?[export_url_vars project_id] "$title"] [list index.tcl?[export_url_vars project_id] "Reports"] "Less Urgent Issues"]
+<hr><p>
+
+The following are all the issues needing to be fixed soon:<p>
+
+"
+
+set selection [ns_db select $db "
+select 
+msg_id, project_full_name(ticket_issues.project_id) as project_title, ticket_issues.project_id as project_id, 
+one_line, ticket_release_name(release_id), release_id, deadline, severity
+from
+ticket_issues
+where
+ticket_issues.close_date is NULL and
+ticket_issues.fix_date is NULL and
+(deadline > (sysdate() + '3 days'::reltime) or deadline is null) and 
+parent_project_p($project_id, ticket_issues.project_id)='t' and 0 <
+(select count(*) from ticket_issue_assignments where msg_id=ticket_issues.msg_id)
+order by [ticket_severity_decode_sql] desc"]
+
+ns_write "
+<table noborder>
+<tr>
+<th align=left>Issue #</th><th align=left>Project</th><th align=left>Deadline</th><th align=left>Assigned To</th><th align=left>Summary</th>
+</tr>
+"
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    set list_of_names [database_to_tcl_list $db_sub "select first_names || ' ' || last_name as full_name from users where user_id in (select user_id from ticket_issue_assignments where msg_id=$msg_id)"]
+    
+    ns_write "<tr>
+<td><a $bug_target_html href=../issue-view.tcl?[export_url_vars msg_id]>$msg_id</a></td>
+<td><a $other_target_html href=../project-top.tcl?[export_url_vars project_id]>$project_title</a></td>
+<td>[util_AnsiDatetoPrettyDate $deadline]</td>
+<td>[join $list_of_names ","]</td>
+<td>$one_line</td>
+</tr>\n"
+}
+
+ns_write "</table>
+<p>
+
+[ad_footer]
+"
\ No newline at end of file
Index: web/openacs/www/new-ticket/reports/new-issues.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/reports/new-issues.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/reports/new-issues.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,77 @@
+set_the_usual_form_variables
+# project_id
+
+validate_integer project_id $project_id
+
+if {[info exists target]} {
+    set other_target_html "target=_top"
+    set bug_target_html "target=one"
+} else {
+    set other_target_html ""
+    set bug_target_html ""
+}
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+# Check Permissions
+if {![ticket_user_can_see_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+ReturnHeaders
+
+set selection [ns_db 1row $db "select project_full_name(project_id) as title from ticket_projects where project_id=$project_id"]
+set_variables_after_query
+
+ns_write "[ad_header "New Issues"]
+<h2>New Issues</h2>
+[ad_context_bar_ws_or_index [list [ticket_admin_url_stub]/index.tcl "Ticket Tracker"] [list ../project-top.tcl?[export_url_vars project_id] "$title"] [list index.tcl?[export_url_vars project_id] "Reports"] "New Issues"]
+<hr><p>
+"
+
+set selection [ns_db select $db "
+select 
+msg_id, project_full_name(ticket_issues.project_id) as project_title, ticket_issues.project_id as project_id, 
+one_line, ticket_release_name(ticket_issues.release_id) as release, ticket_issues.release_id as release_id,
+first_names as creator_first_names, last_name as creator_last_name,
+users.email as creator_email, severity
+from
+ticket_issues, users
+where
+ticket_issues.fix_date is NULL and
+ticket_issues.close_date is NULL and
+ticket_issues.last_modified_by= users.user_id and
+parent_project_p($project_id, ticket_issues.project_id)='t' and
+ticket_n_assigned(ticket_issues.msg_id)=0
+order by [ticket_severity_decode_sql] desc"]
+
+##POSTGRES HACK ABOVE because views too short
+
+
+ns_write "
+<table noborder>
+<tr>
+<th align=left>Issue #</th><th align=left>Project</th><th align=left>Entered By</th><th align=left>Severity</th><th align=left>Summary</th>
+</tr>
+"
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    ns_write "<tr>
+<td><a $bug_target_html href=../issue-view.tcl?[export_url_vars msg_id]>$msg_id</a></td>
+<td><a $other_target_html href=../project-top.tcl?[export_url_vars project_id]>$project_title</a></td>
+<td>$creator_first_names $creator_last_name</td>
+<td>$severity</td>
+<td>$one_line</td>
+</tr>\n"
+}
+
+ns_write "</table>
+<p>
+
+[ad_footer]
+"
\ No newline at end of file
Index: web/openacs/www/new-ticket/reports/statistics.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/reports/statistics.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/reports/statistics.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,70 @@
+set_the_usual_form_variables
+# project_id
+
+validate_integer project_id $project_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+# Check Permissions
+if {![ticket_user_can_see_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+
+}
+ReturnHeaders
+
+set selection [ns_db 1row $db "select project_full_name(project_id) as title from ticket_projects where project_id=$project_id"]
+set_variables_after_query
+
+ns_write "[ad_header "Statistics"]
+<h2>Statistics</h2>
+[ad_context_bar_ws_or_index [list [ticket_admin_url_stub]/index.tcl "Ticket Tracker"] [list ../project-top.tcl?[export_url_vars project_id] "$title"] [list index.tcl?[export_url_vars project_id] "Reports"] "Statistics"]
+<hr><p>
+
+<table cellspacing=2 cellpadding=3>
+<tr bgcolor=lightgrey>
+<th>Severity</th>
+<th>New</th>
+<th>Assigned</th>
+<th>Fixed</th>
+<th>Closed</th>
+</tr>
+"
+
+set selection [ns_db select $db "
+select severity, 
+sum(case when ticket_n_assigned(msg_id)=0 then case when status='open' then 1 else 0 end else 0 end) as n_new,
+sum(case when ticket_n_assigned(msg_id)=0 then 0 else case when fix_date is NULL then 1 else 0 end end) as n_assigned,
+sum(case when ticket_n_assigned(msg_id)=0 then 0 else case when fix_date is NULL then 0 else case when close_date is NULL then 1 else 0 end end end) as n_fixed,
+sum(case when ticket_n_assigned(msg_id)=0 then 0 else case when fix_date is NULL then 0 else case when close_date is NULL then 0 else 1 end end end) as n_closed
+from ticket_issues
+where parent_project_p($project_id, project_id)='t'
+group by severity"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    ns_write "<tr><td>$severity</td><td align=right>$n_new</td><td align=right>$n_assigned</td><td align=right>$n_fixed</td><td align=right>$n_closed</td></tr>\n"
+}
+
+ns_write "</table>"
+
+#  ns_write "
+#  <table cellspacing=2 cellpadding=3>
+#  <tr bgcolor=lightgrey>
+#  <th>Test Cycle</th>
+#  <th>New</th>
+#  <th>Assigned</th>
+#  <th>Fixed</th>
+#  <th>Closed</th>
+#  </tr>
+#  "
+
+
+ns_write "
+<p>
+
+[ad_footer]
+"
Index: web/openacs/www/new-ticket/reports/urgent-issues.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/new-ticket/reports/urgent-issues.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/new-ticket/reports/urgent-issues.tcl	17 Apr 2001 14:05:20 -0000	1.1
@@ -0,0 +1,76 @@
+set_the_usual_form_variables
+# project_id
+
+validate_integer project_id $project_id
+
+if {[info exists target]} {
+    set other_target_html "target=_top"
+    set bug_target_html "target=one"
+} else {
+    set other_target_html ""
+    set bug_target_html ""
+}
+
+set user_id [ad_get_user_id]
+
+set dbs [ns_db gethandle main 2]
+set db [lindex $dbs 0]
+set db_sub [lindex $dbs 1]
+
+# Check Permissions
+if {![ticket_user_can_see_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+ReturnHeaders
+
+set selection [ns_db 1row $db "select project_full_name(project_id) as title from ticket_projects where project_id=$project_id"]
+set_variables_after_query
+
+ns_write "[ad_header "Urgent Issues"]
+<h2>Urgent Issues</h2>
+[ad_context_bar_ws_or_index [list [ticket_admin_url_stub]/index.tcl "Ticket Tracker"] [list ../project-top.tcl?[export_url_vars project_id] "$title"] [list index.tcl?[export_url_vars project_id] "Reports"] "Urgent Issues"]
+<hr><p>
+"
+
+set selection [ns_db select $db "
+select 
+msg_id, project_full_name(ticket_issues.project_id) as project_title, ticket_issues.project_id as project_id, 
+one_line, ticket_release_name(release_id), release_id, deadline, severity
+from
+ticket_issues
+where
+ticket_issues.close_date is NULL and
+ticket_issues.fix_date is NULL and
+deadline < (sysdate() + '3 days'::reltime) and 
+parent_project_p($project_id, ticket_issues.project_id)='t' and 0 <
+(select count(*) from ticket_issue_assignments where msg_id=ticket_issues.msg_id)
+order by [ticket_severity_decode_sql] desc"]
+
+ns_write "
+<table noborder>
+<tr>
+<th align=left>Issue #</th><th align=left>Project</th><th align=left>Deadline</th><th align=left>Assigned To</th><th align=left>Summary</th>
+</tr>
+"
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    set list_of_names [database_to_tcl_list $db_sub "select first_names || ' ' || last_name as full_name from users where user_id in (select user_id from ticket_issue_assignments where msg_id=$msg_id)"]
+    
+    ns_write "<tr>
+<td><a $bug_target_html href=../issue-view.tcl?[export_url_vars msg_id]>$msg_id</a></td>
+<td><a $other_target_html href=../project-top.tcl?[export_url_vars project_id]>$project_title</a></td>
+<td>[util_AnsiDatetoPrettyDate $deadline]</td>
+<td>[join $list_of_names ","]</td>
+<td>$one_line</td>
+</tr>\n"
+}
+
+ns_write "</table>
+<p>
+
+[ad_footer]
+"
\ No newline at end of file
Index: web/openacs/www/news/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/news/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/news/index.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,141 @@
+#
+# /www/news/index.tcl
+#
+# news main page
+#
+# Author: jkoontz@arsdigita.com March 8, 2000
+#
+# index.tcl,v 3.2 2000/03/10 23:45:33 jkoontz Exp
+
+# Note: if page is accessed through /groups pages then group_id and 
+# group_vars_set are already set up in the environment by the 
+# ug_serve_section. group_vars_set contains group related variables
+# (group_id, group_name, group_short_name, group_admin_email, 
+# group_public_url, group_admin_url, group_public_root_url,
+# group_admin_root_url, group_type_url_p, group_context_bar_list and
+# group_navbar_list)
+
+set_the_usual_form_variables 0
+# possibly archive_p 
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+ad_scope_error_check
+
+if { [info exists archive_p] && $archive_p } {
+    set page_title "News Archives"
+} else {
+    set page_title "News"
+}
+
+set db_conns [ns_db gethandle [philg_server_default_pool] 2]
+set db [lindex $db_conns 0]
+set db_sub [lindex $db_conns 1]
+ad_scope_authorize $db $scope all group_member all
+
+append page_content "
+[ad_scope_header $page_title $db]
+"
+
+if { $scope=="public" } {
+    append page_content "
+    [ad_decorate_top "<h2>$page_title</h2>[ad_scope_context_bar_ws_or_index "News"]" \
+	    [ad_parameter IndexPageDecoration news]]
+    "
+} else {
+    append page_content "
+    [ad_scope_page_title $page_title $db]
+    [ad_scope_context_bar_ws_or_index "News"]
+    "
+}
+
+append page_content "
+<hr>
+[ad_scope_navbar]
+<ul>
+"
+
+if { ![info exists user_id] } { 
+    set user_id 0
+}
+if { ![info exists group_id] } {
+    set group_id 0
+}
+
+# Create a clause for returning the postings for relavent groups
+set newsgroup_clause "(newsgroup_id = [join [news_newsgroup_id_list $db $user_id $group_id] " or newsgroup_id = "])"
+
+if { [info exists archive_p] && $archive_p } {
+    set query "
+    select news_item_id, title, release_date, body, html_p
+    from news_items
+    where sysdate() > expiration_date
+    and $newsgroup_clause
+    and approval_state = 'approved'
+    order by release_date desc, creation_date desc"
+} else {
+    set query "
+    select news_item_id, title, release_date, body, html_p
+    from news_items
+    where sysdate() between release_date and expiration_date
+    and $newsgroup_clause
+    and approval_state = 'approved'
+    order by release_date desc, creation_date desc"
+}
+
+set selection [ns_db select $db $query]
+
+set counter 0 
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    incr counter 
+    append page_content "<li>[util_AnsiDatetoPrettyDate $release_date]: "
+    if { (![info exists archive_p] || $archive_p == 0) && $counter <= 3 && [string length $body] < 300 } {
+	# let's display the text right here, but only offer a link
+	# if there are comments.
+	# set n_comments [database_to_tcl_string $db_sub "select count(*) from general_comments where on_what_id = $news_item_id and on_which_table = 'news_items'"]
+	# if { $n_comments > 0 } {
+	    # just do the usual thing
+	    append page_content "<a href=\"item.tcl?[export_url_scope_vars news_item_id]\">$title</a>\n"
+	# } else {
+	#   append page_content "$title\n"
+	#}
+	append page_content "<blockquote>\n[util_maybe_convert_to_html $body $html_p]
+	</blockquote>\n"
+    } else {
+	append page_content "<a href=\"item.tcl?[export_url_scope_vars news_item_id]\">$title</a>\n"
+    }
+}
+
+if { $counter == 0 } {
+    append page_content "no items found"
+}
+
+if { [ad_parameter ApprovalPolicy news] == "open"} {
+    append page_content "<p>\n<li><a href=\"post-new.tcl?[export_url_scope_vars]\">post an item</a>\n"
+} elseif { [ad_parameter ApprovalPolicy news] == "wait"} {
+    append page_content "<p>\n<li><a href=\"post-new.tcl?[export_url_scope_vars]\">suggest an item</a>\n"
+}
+
+append page_content "
+</ul>
+
+"
+
+if { ![info exists archive_p] || $archive_p == 0 } {
+    append page_content "If you're looking for an old news article, check
+<a href=\"index.tcl?[export_url_scope_vars]&archive_p=1\">the archives</a>."
+} else {
+    append page_content "You can 
+<a href=\"index.tcl?[export_url_scope_vars]\">return to current messages</a> now."
+}
+
+
+append page_content "
+
+[ad_scope_footer]
+"
+
+ns_db releasehandle $db
+ns_db releasehandle $db_sub
+
+ns_return 200 text/html $page_content
Index: web/openacs/www/news/item.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/news/item.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/news/item.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,85 @@
+#
+# /www/news/item.tcl
+#
+# news item page
+#
+# Author: jkoontz@arsdigita.com March 8, 2000
+#
+# item.tcl,v 3.1.2.1 2000/04/03 09:15:08 carsten Exp
+
+# Note: if page is accessed through /groups pages then group_id and 
+# group_vars_set are already set up in the environment by the 
+# ug_serve_section. group_vars_set contains group related variables
+# (group_id, group_name, group_short_name, group_admin_email, 
+# group_public_url, group_admin_url, group_public_root_url,
+# group_admin_root_url, group_type_url_p, group_context_bar_list and
+# group_navbar_list)
+
+set_the_usual_form_variables
+# news_item_id
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+# maybe contact_info_only, maybe order_by
+
+validate_integer news_item_id $news_item_id
+
+ad_scope_error_check
+
+
+# If we got a parameter named news_id, and news_item_id has not been defined,
+# we copy news_id's value.
+if { [exists_and_not_null news_id] && ![exists_and_not_null news_item_id] } {
+    set news_item_id $news_id
+}
+
+
+set db [ns_db gethandle]
+set selection [ns_db 0or1row $db "
+select title, body, html_p, n.approval_state, release_date, expiration_date, creation_user, creation_date, first_names, last_name
+from news_items n, users u
+where news_item_id = $news_item_id
+and u.user_id = n.creation_user"]
+
+if { $selection == "" } {
+    ad_scope_return_error "Can't find news item" "Can't find news item $news_item_id" $db
+    return
+}
+
+set user_id [ad_scope_authorize $db $scope all all all ]
+
+set_variables_after_query
+
+append page_content "
+[ad_scope_header $title $db]
+"
+
+if { $scope=="public" } {
+    append page_content "
+    [ad_decorate_top "<h2>$title</h2> [ad_context_bar_ws_or_index [list "index.tcl?[export_url_scope_vars]" "News"] "One Item"]" [ad_parameter ItemPageDecoration news]]"
+} else {
+    append page_content "
+    [ad_scope_page_title $title $db]
+    [ad_scope_context_bar_ws_or_index [list "index.tcl?[export_url_scope_vars]" "News"] "One Item"]
+    "
+}
+
+append page_content "
+<hr>
+[ad_scope_navbar]
+
+<blockquote>
+[util_maybe_convert_to_html $body $html_p]
+</blockquote>
+
+Contributed by <a href=\"/shared/community-member.tcl?[export_url_scope_vars]&user_id=$creation_user\">$first_names $last_name</a>.
+
+[ad_general_comments_list $db $news_item_id news_items $title news]
+
+[ad_scope_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $page_content
+
+
+
Index: web/openacs/www/news/post-new-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/news/post-new-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/news/post-new-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,134 @@
+#
+# /www/news/post-new-2.tcl
+#
+# display confirmation page for new news item
+#
+# Author: jkoontz@arsdigita.com March 8, 2000
+#
+# post-new-2.tcl,v 3.1 2000/03/10 23:45:33 jkoontz Exp
+
+# Note: if page is accessed through /groups pages then group_id and 
+# group_vars_set are already set up in the environment by the 
+# ug_serve_section. group_vars_set contains group related variables
+# (group_id, group_name, group_short_name, group_admin_email, 
+# group_public_url, group_admin_url, group_public_root_url,
+# group_admin_root_url, group_type_url_p, group_context_bar_list and
+# group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+# maybe return_url, name
+# title, body, AOLserver ns_db magic vars that can be 
+# kludged together to form release_date and expiration_date
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+set user_id [ad_scope_authorize $db $scope all all all ]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register/index.tcl?[export_url_scope_vars]"
+    return
+}
+
+set creation_ip_address [ns_conn peeraddr]
+
+set exception_count 0
+set exception_text ""
+
+if [catch  {
+    ns_dbformvalue [ns_conn form] release_date date release_date
+    ns_dbformvalue [ns_conn form] expiration_date date expiration_date} errmsg] {
+    incr exception_count
+    append exception_text "<li>Please make sure your dates are valid."
+} else {
+    set expire_laterthan_future_p [database_to_tcl_string $db "select date_part('epoch','$expiration_date'::datetime  - '$release_date'::datetime)"]
+    if {$expire_laterthan_future_p <= 0} {
+	incr exception_count
+	append exception_text "<li>Please make sure the expiration date is later than the release date."
+    }
+}
+
+# now release_date and expiration_date are set
+
+if { ![info exists title] || $title == ""} {
+    incr exception_count
+    append exception_text "<li>Please enter a title."
+}
+if { ![info exists body] || $body == "" } {
+    incr exception_count
+    append exception_text "<li>Please enter the full story."
+}
+
+if {$exception_count > 0} { 
+    ad_scope_return_complaint $exception_count $exception_text $db
+    return
+}
+
+set news_item_id [database_to_tcl_string $db "select news_item_id_sequence.nextval from dual"]
+
+append page_content "
+[ad_scope_header "Confirm" $db]
+[ad_scope_page_title "Confirm" $db]
+
+your submission to [ad_site_home_link]
+
+<hr>
+
+<h3>What viewers of a summary list will see</h3>
+
+<blockquote>
+$title
+</blockquote>
+
+<h3>The full story</h3>
+
+<blockquote>
+
+"
+
+if { [info exists html_p] && $html_p == "t" } {
+    append page_content "$body
+</blockquote>
+
+Note: if the story has lost all of its paragraph breaks then you
+probably should have selected \"Plain Text\" rather than HTML.  Use
+your browser's Back button to return to the submission form.
+"
+
+} else {
+    append page_content "[util_convert_plaintext_to_html $body]
+</blockquote>
+
+Note: if the story has a bunch of visible HTML tags then you probably
+should have selected \"HTML\" rather than \"Plain Text\".  Use your
+browser's Back button to return to the submission form.  " 
+}
+
+append page_content "
+
+<h3>Dates</h3>
+
+<ul>
+<li>will be released on [util_AnsiDatetoPrettyDate $release_date]
+<li>will expire on [util_AnsiDatetoPrettyDate $expiration_date]
+</ul>
+
+<form method=post action=\"post-new-3.tcl\">
+[export_form_scope_vars news_item_id]
+[export_entire_form]
+<center>
+<input type=submit value=\"Confirm\">
+</center>
+</form>
+
+[ad_scope_footer]"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $page_content
\ No newline at end of file
Index: web/openacs/www/news/post-new-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/news/post-new-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/news/post-new-3.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,164 @@
+#
+# /www/news/post-new-3.tcl
+#
+# process the input form for the new news item
+#
+# Author: jkoontz@arsdigita.com March 8, 2000
+#
+# post-new-3.tcl,v 3.2 2000/03/10 23:45:34 jkoontz Exp
+
+# Note: if page is accessed through /groups pages then group_id and 
+# group_vars_set are already set up in the environment by the 
+# ug_serve_section. group_vars_set contains group related variables
+# (group_id, group_name, group_short_name, group_admin_email, 
+# group_public_url, group_admin_url, group_public_root_url,
+# group_admin_root_url, group_type_url_p, group_context_bar_list and
+# group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_form_variables
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+# maybe return_url, name
+# news_item_id, title, body, AOLserver ns_db magic vars that can be 
+# kludged together to form release_date and expiration_date
+
+validate_integer news_item_id $news_item_id
+
+ad_scope_error_check
+
+if { ![info exists return_url] } {
+    set return_url "index.tcl?[export_url_scope_vars]"
+}
+
+set db [ns_db gethandle]
+set user_id [ad_scope_authorize $db $scope all all all ]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register/index.tcl?[export_url_scope_vars]"
+    return
+}
+
+set creation_ip_address [ns_conn peeraddr]
+
+set exception_count 0
+set exception_text ""
+
+if [catch  {
+    ns_dbformvalue [ns_conn form] release_date date release_date
+    ns_dbformvalue [ns_conn form] expiration_date date expiration_date} errmsg] {
+    incr exception_count
+    append exception_text "<li>Please make sure your dates are valid."
+} else {
+    set expire_laterthan_future_p [database_to_tcl_string $db "select date_part('epoch','$expiration_date'::datetime  - '$release_date'::datetime)"]
+    if {$expire_laterthan_future_p <= 0} {
+	incr exception_count
+	append exception_text "<li>Please make sure the expiration date is later than the release date."
+    }
+}
+
+# now release_date and expiration_date are set
+
+if { ![info exists title] || [empty_string_p $title]} {
+    incr exception_count
+    append exception_text "<li>Please enter a title."
+}
+if { ![info exists body] || [empty_string_p $body] } {
+    incr exception_count
+    append exception_text "<li>Please enter the full story."
+}
+
+if {$exception_count > 0} { 
+    ad_scope_return_complaint $exception_count $exception_text $db
+    return
+}
+
+if { [ad_parameter ApprovalPolicy news] == "open"} {
+    set approval_state "approved"
+} else {
+    set approval_state "disapproved"
+}
+
+
+if { ![exists_and_not_null scope] } {
+    set scope "public"
+}
+
+set additional_clause ""
+if { [string match $scope "group"] && ![empty_string_p $group_id] } {
+    set additional_clause "and group_id = $group_id"
+}
+
+# Get the newsgroup_id for this board
+set newsgroup_id [database_to_tcl_string_or_null $db "select newsgroup_id 
+from newsgroups
+where scope = '$scope' $additional_clause"]
+
+# Check if there is no news group for this scope
+if { [empty_string_p $newsgroup_id] } { 
+    # Create the newsgroup for the group
+    ns_db dml $db "insert into newsgroups (newsgroup_id, scope, group_id) values (nextval('newsgroup_id_sequence'), '$scope', $group_id)"
+
+    set newsgroup_id [database_to_tcl_string_or_null $db "select newsgroup_id 
+    from newsgroups
+    where scope = '$scope' $additional_clause"]
+}
+
+# Let's use data pipeline here to handle the text for body, and the double click situation
+set form_setid [ns_getform]
+ns_set put $form_setid dp.news_items.news_item_id $news_item_id
+ns_set put $form_setid dp.news_items.newsgroup_id $newsgroup_id
+ns_set put $form_setid dp.news_items.title $title
+ns_set put $form_setid dp.news_items.body $body
+ns_set put $form_setid dp.news_items.html_p $html_p
+ns_set put $form_setid dp.news_items.approval_state $approval_state
+ns_set put $form_setid dp.news_items.approval_date.expr sysdate()
+ns_set put $form_setid dp.news_items.release_date $release_date
+ns_set put $form_setid dp.news_items.expiration_date $expiration_date
+ns_set put $form_setid dp.news_items.creation_date.expr sysdate()
+ns_set put $form_setid dp.news_items.creation_user $user_id
+ns_set put $form_setid dp.news_items.creation_ip_address $creation_ip_address
+
+with_transaction $db {
+
+    if [catch { dp_process -db $db -where_clause "news_item_id=$news_item_id" } errmsg] {
+        ns_log Error "/news/post-edit-2.tcl choked:  $errmsg"
+        ad_scope_return_error "Insert Failed" "The Database did not like what you typed.  This is probably a bug in our code.  Here's what the database said:
+<blockquote>
+<pre>
+$errmsg
+</pre>
+</blockquote>
+" $db
+        return
+    }
+} { ns_log Error "transaction failed" }
+
+# ad_dbclick_check_dml $db news news_item_id $news_item_id $return_url "
+# insert into news
+# (news_item_id, title, body, html_p, approved_p, release_date, expiration_date, creation_date, creation_user, creation_ip_address, [ad_scope_cols_sql]) 
+# values 
+# ($news_item_id, '$QQtitle', '$QQbody', '$html_p', '$approved_p', '$release_date', '$expiration_date', sysdate, $user_id, '$creation_ip_address', [ad_scope_vals_sql])
+# " 
+
+if { [ad_parameter ApprovalPolicy news] == "open"} {
+    ns_returnredirect $return_url
+} else {
+    ns_return 200 text/html "
+[ad_scope_header "Thank you" $db]
+
+<h2>Thank you</h2>
+
+for your submission to [ad_site_home_link]
+
+<hr>
+
+Your submission will be reviewed by 
+[ad_parameter SystemOwner news [ad_system_owner]].
+
+[ad_scope_footer]"
+}
+
Index: web/openacs/www/news/post-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/news/post-new.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/news/post-new.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,91 @@
+#
+# /www/news/post-new.tcl
+#
+# posts new news item
+#
+# Author: jkoontz@arsdigita.com March 8, 2000
+#
+# post-new.tcl,v 3.2 2000/03/10 23:45:34 jkoontz Exp
+
+# Note: if page is accessed through /groups pages then group_id and 
+# group_vars_set are already set up in the environment by the 
+# ug_serve_section. group_vars_set contains group related variables
+# (group_id, group_name, group_short_name, group_admin_email, 
+# group_public_url, group_admin_url, group_public_root_url,
+# group_admin_root_url, group_type_url_p, group_context_bar_list and
+# group_navbar_list)
+
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+# maybe return_url, name
+
+ad_scope_error_check
+
+set db [ns_db gethandle]
+set user_id [ad_scope_authorize $db $scope all all all ]
+
+# Get the group name
+if { ![info exists group_id] } {
+    set group_id 0
+}
+set group_name [database_to_tcl_string_or_null $db "select group_name from user_groups where group_id= '$group_id'"]
+
+if { [string match $scope "public"] } {
+    set group_name "Public"
+}
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register/index.tcl?[export_url_scope_vars]&return_url=[ns_urlencode [ns_conn url]]"
+    return
+}
+
+if { [ad_parameter ApprovalPolicy news] == "open"} {
+    set verb "Post"
+} elseif { [ad_parameter ApprovalPolicy news] == "wait"} {
+    set verb "Suggest"
+} else {
+    ns_returnredirect "index.tcl?[export_url_scope_vars]"
+    return
+}
+
+set page_content "
+[ad_scope_header "$verb News" $db]
+[ad_scope_page_title "$verb News" $db]
+
+for [ad_site_home_link]
+<hr>
+[ad_scope_navbar]
+
+<blockquote>
+For $group_name News
+</blockquote>
+
+<form method=post action=\"post-new-2.tcl\">
+[export_form_vars return_url]
+[export_form_scope_vars]
+
+<table>
+<tr><th>Title <td><input type=text size=40 name=title>
+<tr><th>Full Story <td><textarea cols=60 rows=6 wrap=soft name=body></textarea>
+<tr><th align=left>Text above is
+<td><select name=html_p><option value=f>Plain Text<option value=t>HTML</select></td>
+</tr>
+<tr><th>Release Date <td>[philg_dateentrywidget release_date [database_to_tcl_string $db "select sysdate from dual"]]
+<tr><th>Expire Date <td>[philg_dateentrywidget expiration_date [database_to_tcl_string $db "select sysdate + [ad_parameter DefaultStoryLife news 30] from dual"]]
+</table>
+<br>
+<center>
+<input type=\"submit\" value=\"Submit\">
+</center>
+</form>
+[ad_scope_footer]
+"
+ 
+ns_db releasehandle $db
+
+ns_return 200 text/html $page_content
\ No newline at end of file
Index: web/openacs/www/news/admin/comment-toggle-approval.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/news/admin/comment-toggle-approval.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/news/admin/comment-toggle-approval.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,32 @@
+#
+# /www/news/admin/comment-toggle-approval.tcl
+#
+# news item comment approval page
+#
+# Author: jkoontz@arsdigita.com March 8, 2000
+#
+# comment-toggle-approval.tcl,v 1.1.2.1 2000/03/16 23:07:21 jkoontz Exp
+
+# Note: if page is accessed through /groups pages then group_id and 
+# group_vars_set are already set up in the environment by the 
+# ug_serve_section. group_vars_set contains group related variables
+# (group_id, group_name, group_short_name, group_admin_email, 
+# group_public_url, group_admin_url, group_public_root_url,
+# group_admin_root_url, group_type_url_p, group_context_bar_list and
+# group_navbar_list)
+
+set_the_usual_form_variables
+# news_item_id, comment_id
+# maybe scope, maybe scope related variables (group_id, public)
+# maybe contact_info_only, maybe order_by
+
+validate_integer news_item_id $news_item_id
+validate_integer comment_id $comment_id
+
+ad_scope_error_check
+set db [ns_db gethandle]
+#news_admin_authorize $db $news_item_id
+
+ns_db dml $db "update general_comments set approved_p = logical_negation(approved_p) where comment_id = $comment_id"
+
+ns_returnredirect "item.tcl?[export_url_scope_vars news_item_id]"
\ No newline at end of file
Index: web/openacs/www/news/admin/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/news/admin/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/news/admin/index.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,79 @@
+#
+# /www/news/admin/index.tcl
+#
+# news main admin page
+#
+# Author: jkoontz@arsdigita.com March 8, 2000
+#
+# index.tcl,v 3.2 2000/03/10 23:45:34 jkoontz Exp
+
+# Note: if page is accessed through /groups pages then group_id and 
+# group_vars_set are already set up in the environment by the 
+# ug_serve_section. group_vars_set contains group related variables (group_id, 
+# group_name, group_short_name, group_admin_email, group_public_url, 
+# group_admin_url, group_public_root_url, group_admin_root_url, 
+# group_type_url_p, group_context_bar_list and group_navbar_list)
+
+set_the_usual_form_variables 0
+# possibly archive_p 
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+
+ad_scope_error_check
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope admin group_member none
+
+append page_content "
+[ad_scope_admin_header "News Administration" $db ]
+[ad_scope_admin_page_title "News Administration" $db]
+[ad_scope_admin_context_bar "News"]
+<hr>
+<ul>
+"
+
+if { ![info exists user_id] } { 
+    set user_id 0
+}
+if { ![info exists group_id] } {
+    set group_id 0
+}
+# Create a clause for returning the postings for relavent groups
+set newsgroup_clause "(newsgroup_id = [join [news_newsgroup_id_list $db $user_id $group_id] " or newsgroup_id = "])"
+
+set selection [ns_db select $db "
+select news_item_id, title, approval_state, release_date,
+ expired_p(expiration_date) as expired_p
+from news_items
+where $newsgroup_clause
+order by expired_p, creation_date desc"]
+
+set counter 0 
+set expired_p_headline_written_p 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    incr counter 
+    if { $expired_p == "t" && !$expired_p_headline_written_p } {
+	append page_content "<h4>Expired News Items</h4>\n"
+	set expired_p_headline_written_p 1
+    }
+    append page_content "<li>[util_AnsiDatetoPrettyDate $release_date]: <a href=\"item.tcl?[export_url_scope_vars news_item_id]\">$title</a>"
+    if { ![string match $approval_state "approved"] } {
+	append page_content "&nbsp; <font color=red>not approved</font>"
+    }
+    append page_content "\n"
+}
+
+append page_content "
+
+<P>
+
+<li><a href=\"post-new.tcl?[export_url_scope_vars]\">add an item</a>
+
+</ul>
+
+
+[ad_scope_admin_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $page_content
Index: web/openacs/www/news/admin/item.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/news/admin/item.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/news/admin/item.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,92 @@
+#
+# /www/news/admin/item.tcl
+#
+# news item page
+#
+# Author: jkoontz@arsdigita.com March 8, 2000
+#
+# item.tcl,v 3.1.2.2 2000/03/16 23:07:21 jkoontz Exp
+
+# Note: if page is accessed through /groups pages then group_id and 
+# group_vars_set are already set up in the environment by the 
+# ug_serve_section. group_vars_set contains group related variables
+# (group_id, group_name, group_short_name, group_admin_email, 
+# group_public_url, group_admin_url, group_public_root_url,
+# group_admin_root_url, group_type_url_p, group_context_bar_list and
+# group_navbar_list)
+
+set_the_usual_form_variables
+# news_item_id
+# maybe scope, maybe scope related variables (group_id, public)
+# maybe contact_info_only, maybe order_by
+
+validate_integer news_item_id $news_item_id
+
+ad_scope_error_check
+set db [ns_db gethandle]
+news_admin_authorize $db $news_item_id
+
+set return_url "[ns_conn url]?news_item_id=$news_item_id"
+
+set selection [ns_db 0or1row $db "
+select n.title, n.body, html_p, n.approval_state, n.release_date, 
+  n.expiration_date, n.creation_user, n.creation_date, first_names, last_name
+from news_items n, users u
+where news_item_id = $news_item_id
+and u.user_id = n.creation_user"]
+
+if { $selection == "" } {
+    ad_scope_return_error "Can't find news item" "Can't find news item $news_item_id" $db
+    return
+}
+
+set_variables_after_query
+
+append page_content "
+
+[ad_scope_admin_header "$title" $db ]
+[ad_scope_admin_page_title "$title" $db ]
+[ad_scope_admin_context_bar [list "index.tcl?[export_url_scope_vars]" "News"] "One Item"]
+
+<hr>
+
+<ul>
+<li>Status:  
+"
+
+if { [string match $approval_state "approved"] } {
+    append page_content "Approved (<a href=\"toggle-approved-p.tcl?[export_url_scope_vars news_item_id]\">Revoke</a>)"
+} else {
+    append page_content "<font color=red>Awaiting approval</font> (<a href=\"toggle-approved-p.tcl?[export_url_scope_vars news_item_id]\">Approve</a>)"
+}
+
+append page_content "
+<li>Release Date: [util_AnsiDatetoPrettyDate $release_date]
+<li>Expires: [util_AnsiDatetoPrettyDate $expiration_date]
+<li>Submitted by: [ad_decode $scope public "<a href=\"/admin/users/one.tcl?[export_url_scope_vars]&user_id=$creation_user\">$first_names $last_name</a>" group "<a href=\"/shared/community-member.tcl?[export_url_scope_vars]&user_id=$creation_user\">$first_names $last_name</a>" unknown]
+</ul>
+
+<h4>Body</h4>
+
+<blockquote>
+[util_maybe_convert_to_html $body $html_p]
+<br>
+<br>
+<form action=post-edit.tcl method=get>
+[export_form_scope_vars]
+<input type=hidden name=news_item_id value=\"$news_item_id\">
+<input type=submit name=submit value=\"Edit\">
+</form>
+
+</blockquote>
+
+[news_item_comments $db $news_item_id]
+
+[ad_scope_admin_footer]
+"
+
+# [ad_general_comments_list $db $news_item_id news_items $title news]
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $page_content
Index: web/openacs/www/news/admin/post-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/news/admin/post-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/news/admin/post-edit-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,73 @@
+#
+# /www/news/admin/post-edit-2.tcl
+#
+# process the edit form for the news item
+#
+# Author: jkoontz@arsdigita.com March 8, 2000
+#
+# post-edit-2.tcl,v 3.1.2.1 2000/03/17 23:20:21 nuno Exp
+
+# Note: if page is accessed through /groups pages then group_id and 
+# group_vars_set are already set up in the environment by the 
+# ug_serve_section. group_vars_set contains group related variables
+# (group_id, group_name, group_short_name, group_admin_email, 
+# group_public_url, group_admin_url, group_public_root_url,
+# group_admin_root_url, group_type_url_p, group_context_bar_list and
+# group_navbar_list)
+
+set_the_usual_form_variables
+# maybe scope, maybe scope related variables (public, group_id)
+# maybe return_url, name
+# news_item_id, title, body, html_p, AOLserver ns_db magic vars that can be 
+# kludged together to form release_date and expiration_date
+
+validate_integer news_item_id $news_item_id
+
+ad_scope_error_check
+set db [ns_db gethandle]
+set user_id [news_admin_authorize $db $news_item_id]
+
+set exception_count 0
+set exception_text ""
+
+if [catch  {
+    ns_dbformvalue [ns_conn form] release_date date release_date
+    ns_dbformvalue [ns_conn form] expiration_date date expiration_date} errmsg] {
+    incr exception_count
+    append exception_text "<li>Please make sure your dates are valid."
+} else {
+
+    set expire_laterthan_future_p [database_to_tcl_string $db "select to_date('$expiration_date', 'yyyy-mm-dd')  - to_date('$release_date', 'yyyy-mm-dd')  from dual"]
+    if {$expire_laterthan_future_p <= 0} {
+	incr exception_count
+	append exception_text "<li>Please make sure the expiration date is later than the release date."
+    }
+}
+
+# now release_date and expiration_date are set
+
+if { ![info exists title] || [empty_string_p $title] } {
+    incr exception_count
+    append exception_text "<li>Please enter a title."
+}
+
+if { ![info exists body] || [empty_string_p $body] } {
+    incr exception_count
+    append exception_text "<li>Please enter the full story."
+}
+
+if {$exception_count > 0} { 
+    ad_scope_return_complaint $exception_count $exception_text $db
+    return
+}
+
+set update_sql "update news_items
+set title='$QQtitle', body = $QQbody,
+html_p='$html_p', release_date='$release_date',
+approval_state = 'approved', approval_date = sysdate,
+approval_user = $user_id, approval_ip_address = '[DoubleApos [ns_conn peeraddr]]',
+expiration_date='$expiration_date' 
+where news_item_id = $news_item_id 
+returning body into :one"
+
+ns_returnredirect item.tcl?[export_url_scope_vars news_item_id]
Index: web/openacs/www/news/admin/post-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/news/admin/post-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/news/admin/post-edit.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,65 @@
+#
+# /www/news/admin/post-edit.tcl
+#
+# edit form for a news item
+#
+# Author: jkoontz@arsdigita.com March 8, 2000
+#
+# post-edit.tcl,v 3.1 2000/03/10 23:45:34 jkoontz Exp
+
+# Note: if page is accessed through /groups pages then group_id and 
+# group_vars_set are already set up in the environment by the 
+# ug_serve_section. group_vars_set contains group related variables
+# (group_id, group_name, group_short_name, group_admin_email, 
+# group_public_url, group_admin_url, group_public_root_url,
+# group_admin_root_url, group_type_url_p, group_context_bar_list and
+# group_navbar_list)
+
+set_the_usual_form_variables
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+# maybe return_url, name
+# news_item_id
+
+validate_integer news_item_id $news_item_id
+
+ad_scope_error_check
+set db [ns_db gethandle]
+news_admin_authorize $db $news_item_id
+
+set selection [ns_db 0or1row $db "
+select title, body, html_p,  release_date, expiration_date, html_p
+from news_items where news_items.news_item_id = $news_item_id"]
+set_variables_after_query
+
+append page_content "
+[ad_scope_admin_header "Edit $title" $db ]
+[ad_scope_admin_page_title "Edit $title" $db ]
+
+[ad_scope_admin_context_bar [list "index.tcl?[export_url_scope_vars ]" "News"] "Edit Item"]
+
+<hr>
+<form method=post action=\"post-edit-2.tcl\">
+[export_form_scope_vars]
+<table>
+<tr><th>Title <td><input type=text size=40 name=title value=\"[philg_quote_double_quotes $title]\">
+<tr><th>Full Story <td><textarea cols=60 rows=6 wrap=soft name=body>[philg_quote_double_quotes $body]</textarea>
+<tr><th align=left>Text above is
+<td><select name=html_p>
+[ad_generic_optionlist {"Plain Text" "HTML"} {"f" "t"} $html_p]
+</select></td>
+</tr>
+<tr><th>Release Date <td>[philg_dateentrywidget release_date $release_date]
+<tr><th>Expire Date <td>[philg_dateentrywidget expiration_date $expiration_date]
+</table>
+<br>
+<center>
+<input type=\"submit\" value=\"Submit\">
+</center>
+<input type=hidden name=news_item_id value=\"$news_item_id\">
+</form>
+[ad_scope_admin_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $page_content
\ No newline at end of file
Index: web/openacs/www/news/admin/post-new-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/news/admin/post-new-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/news/admin/post-new-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,134 @@
+#
+# /www/news/admin/post-new-2.tcl
+#
+# process the input form for the new news item
+#
+# Author: jkoontz@arsdigita.com March 8, 2000
+#
+# post-new-2.tcl,v 3.1 2000/03/10 23:45:34 jkoontz Exp
+
+# Note: if page is accessed through /groups pages then group_id and 
+# group_vars_set are already set up in the environment by the 
+# ug_serve_section. group_vars_set contains group related variables
+# (group_id, group_name, group_short_name, group_admin_email, 
+# group_public_url, group_admin_url, group_public_root_url,
+# group_admin_root_url, group_type_url_p, group_context_bar_list and
+# group_navbar_list)
+
+set_the_usual_form_variables
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+# maybe return_url, name
+# news_item_id, title, body, html_p, AOLserver ns_db magic vars that can be 
+# kludged together to form release_date and expiration_date
+
+validate_integer news_item_id $news_item_id
+
+ad_scope_error_check
+set db [ns_db gethandle]
+set user_id [ad_scope_authorize $db $scope admin group_admin none]
+
+if { ![info exists return_url] } {
+    set return_url "index.tcl?[export_url_scope_vars]"
+}
+
+set creation_ip_address [ns_conn peeraddr]
+
+set exception_count 0
+set exception_text ""
+
+
+if [catch  {
+    ns_dbformvalue [ns_conn form] release_date date release_date
+    ns_dbformvalue [ns_conn form] expiration_date date expiration_date} errmsg] {
+    incr exception_count
+    append exception_text "<li>Please make sure your dates are valid."
+} else {
+
+    set expire_laterthan_future_p [database_to_tcl_string $db "select to_date('$expiration_date', 'YYYY-MM-DD')  - to_date('$release_date', 'YYYY-MM-DD')  from dual"]
+    if {$expire_laterthan_future_p <= 0} {
+	incr exception_count
+	append exception_text "<li>Please make sure the expiration date is later than the release date."
+    }
+}
+
+
+if { ![info exists title] || [empty_string_p $title]} {
+    incr exception_count
+    append exception_text "<li>Please enter a title."
+}
+if { ![info exists body] || [empty_string_p $body]} {
+    incr exception_count
+    append exception_text "<li>Please enter the full story."
+}
+
+if {$exception_count > 0} { 
+    ad_scope_return_complaint $exception_count $exception_text $db
+    return
+}
+
+
+if { [ad_parameter ApprovalPolicy news] == "open"} {
+    set approval_state "approved"
+} else {
+    set approval_state "disapproved"
+}
+
+
+if { ![exists_and_not_null scope] } {
+    set scope "public"
+}
+
+set additional_clause ""
+if { [string match $scope "group"] && ![empty_string_p $group_id] } {
+    set additional_clause "and group_id = $group_id"
+}
+
+# Get the newsgroup_id for this board
+set newsgroup_id [database_to_tcl_string_or_null $db "select newsgroup_id 
+from newsgroups
+where scope = '$scope' $additional_clause"]
+
+# Check if there is no news group for this scope
+if { [empty_string_p $newsgroup_id] } { 
+    # Create the newsgroup for the group
+    ns_db dml $db "insert into newsgroups (newsgroup_id, scope, group_id) values (nextval('newsgroup_id_sequence'), '$scope', $group_id)"
+}
+
+# Let's use data pipeline here to handle the clob for body, and the double click situation
+set form_setid [ns_getform]
+ns_set put $form_setid dp.news_items.news_item_id $news_item_id
+ns_set put $form_setid dp.news_items.newsgroup_id $newsgroup_id
+ns_set put $form_setid dp.news_items.title $title
+ns_set put $form_setid dp.news_items.body.clob $body
+ns_set put $form_setid dp.news_items.html_p $html_p
+ns_set put $form_setid dp.news_items.approval_state $approval_state
+ns_set put $form_setid dp.news_items.approval_date.expr sysdate()
+ns_set put $form_setid dp.news_items.approval_ip_address $creation_ip_address
+ns_set put $form_setid dp.news_items.release_date $release_date
+ns_set put $form_setid dp.news_items.expiration_date $expiration_date
+ns_set put $form_setid dp.news_items.creation_date.expr sysdate()
+ns_set put $form_setid dp.news_items.creation_user $user_id
+ns_set put $form_setid dp.news_items.creation_ip_address $creation_ip_address
+
+with_transaction $db {
+
+    if [catch { dp_process -db $db -where_clause "news_item_id=$news_item_id" } errmsg] {
+        ns_log Error "/news/admin/post-edit-2.tcl choked:  $errmsg"
+        ad_scope_return_error "Insert Failed" "The Database did not like what you typed.  This is probably a bug in our code.  Here's what the database said:
+<blockquote>
+<pre>
+$errmsg
+</pre>
+</blockquote>
+" $db
+        return
+    }
+} { ns_log Error "transaction failed" }
+
+ns_returnredirect "index.tcl?[export_url_scope_vars]"
+
+
+
+
+
+
Index: web/openacs/www/news/admin/post-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/news/admin/post-new.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/news/admin/post-new.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,58 @@
+#
+# /www/news/admin/post-new.tcl
+#
+# input form for the new news item
+#
+# Author: jkoontz@arsdigita.com March 8, 2000
+#
+# post-new.tcl,v 3.1 2000/03/10 23:45:34 jkoontz Exp
+
+# Note: if page is accessed through /groups pages then group_id and 
+# group_vars_set are already set up in the environment by the 
+# ug_serve_section. group_vars_set contains group related variables
+# (group_id, group_name, group_short_name, group_admin_email, 
+# group_public_url, group_admin_url, group_public_root_url,
+# group_admin_root_url, group_type_url_p, group_context_bar_list and
+# group_navbar_list)
+
+set_the_usual_form_variables 0
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+# maybe return_url, name
+
+ad_scope_error_check
+set db [ns_db gethandle]
+ad_scope_authorize $db $scope admin group_admin none
+
+
+append page_content "
+[ad_scope_admin_header "Add Item" $db ]
+[ad_scope_admin_page_title "Add Item" $db ]
+
+[ad_scope_admin_context_bar [list "index.tcl?[export_url_scope_vars]" "News"] "Add Item"]
+
+<hr>
+
+<form method=post action=\"post-new-2.tcl\">
+[export_form_scope_vars]
+
+<table>
+<tr><th>Title <td><input type=text size=40 name=title>
+<tr><th>Full Story <td><textarea cols=60 rows=6 wrap=soft name=body></textarea>
+<tr><th align=left>Text above is
+<td><select name=html_p><option value=f>Plain Text<option value=t>HTML</select></td>
+</tr>
+<tr><th>Release Date <td>[philg_dateentrywidget release_date [database_to_tcl_string $db "select sysdate from dual"]]
+<tr><th>Expire Date <td>[philg_dateentrywidget expiration_date [database_to_tcl_string $db "select sysdate + [ad_parameter DefaultStoryLife news 30] from dual"]]
+</table>
+<br>
+<center>
+<input type=\"submit\" value=\"Submit\">
+</center>
+<input type=hidden name=news_item_id value=\"[database_to_tcl_string  $db "select news_item_id_sequence.nextval from dual"]\">
+</form>
+[ad_scope_admin_footer]
+"
+ 
+ns_db releasehandle $db
+
+ns_return 200 text/html $page_content
\ No newline at end of file
Index: web/openacs/www/news/admin/toggle-approved-p.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/news/admin/toggle-approved-p.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/news/admin/toggle-approved-p.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,41 @@
+#
+# /www/news/admin/toggle-approval-p.tcl
+#
+# toggle the approval status for the new item
+#
+# Author: jkoontz@arsdigita.com March 8, 2000
+#
+# toggle-approved-p.tcl,v 3.1.2.1 2000/03/16 05:16:27 jkoontz Exp
+
+# Note: if page is accessed through /groups pages then group_id and 
+# group_vars_set are already set up in the environment by the 
+# ug_serve_section. group_vars_set contains group related variables
+# (group_id, group_name, group_short_name, group_admin_email, 
+# group_public_url, group_admin_url, group_public_root_url,
+# group_admin_root_url, group_type_url_p, group_context_bar_list and
+# group_navbar_list)
+
+set_the_usual_form_variables
+# maybe scope, maybe scope related variables (user_id, group_id, on_which_group, on_what_id)
+# maybe return_url, name
+# news_item_id
+
+validate_integer news_item_id $news_item_id
+
+if { ![info exists user_id] } {
+    set user_id [ad_verify_and_get_user_id]
+}
+
+ad_scope_error_check
+set db [ns_db gethandle]
+news_admin_authorize $db $news_item_id
+
+ns_db dml $db "update news_items set approval_state = 
+case when approval_state= 'approved' then 'disapproved'::varchar else 'approved'::varchar end,
+approval_user = $user_id, approval_date = sysdate(), approval_ip_address = '[DoubleApos [ns_conn peeraddr]]' where news_item_id = $news_item_id"
+
+ns_returnredirect "item.tcl?[export_url_scope_vars news_item_id]"
+
+
+
+
Index: web/openacs/www/news-templated/graphics-prefs.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/news-templated/graphics-prefs.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/news-templated/graphics-prefs.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,63 @@
+# graphics-prefs.tcl,v 1.2.4.1 2000/02/03 09:58:47 ron Exp
+# Set the prefer_text_only_p cookie.
+
+if { [ns_conn form] != "" } {
+    set_form_variables
+    # prefer_text_only_p (optional, default is f)
+    # return_url (optional, default is referrer)
+}
+
+set headers [ns_conn headers]
+
+if { ![info exists prefer_text_only_p] || $prefer_text_only_p == "" 
+     || ![regexp {^[tf]$} $prefer_text_only_p] } {
+    # If prefer_text_only_p was not set from form or if it was incorrect,
+    # try to get it from the cookie.
+    set cookie [ns_set get $headers "Cookie"]
+    if { $cookie != "" 
+         && [regexp {prefer_text_only_p=([tf])} $cookie {} current_value] } {
+        # Cookie was set. Set prefer_text_only_p to opposite of current value.
+        if { $current_value == "t" } {
+            set prefer_text_only_p "f"
+        } else {
+            set prefer_text_only_p "t"
+        }
+    } else {
+        # Cookie wasn't set. Set default to opposite of PlainFancySiteDefault.
+	set site_default [ad_parameter PlainFancySiteDefault style]
+	if { $site_default == "fancy" } {
+	    set prefer_text_only_p "t"
+	} else {
+	    set prefer_text_only_p "f"
+	}
+    }
+}  
+
+if { ![info exists return_url] || $return_url == "" } {
+    set return_url [ns_set get $headers "Referer"]
+}
+
+# See if we are a personalized user. If so, update the personalization.
+set user_id [ad_verify_and_get_user_id]
+if { $user_id != "" } {
+    set db [ns_db gethandle]
+    # Ignore any database errors.
+    catch { 
+	if { [database_to_tcl_string $db "select count(*) from users_preferences where user_id = $user_id"] == 0 } {
+	    ns_db dml $db "insert into users_preferences (user_id, prefer_text_only_p) values ($user_id, '$prefer_text_only_p')"
+	} else {
+	    ns_db dml $db "update users_preferences set prefer_text_only_p = '$prefer_text_only_p' where user_id = $user_id" 
+	}
+    }
+    ns_db releasehandle $db
+
+    
+    util_memoize_flush "ad_style_user_preferences_from_db $user_id"
+}
+
+
+ns_returnredirect "/cookie-chain.tcl?cookie_name=prefer_text_only_p&cookie_value=$prefer_text_only_p&final_page=[ns_urlencode $return_url]&expire_state=p"
+
+
+
+
Index: web/openacs/www/news-templated/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/news-templated/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/news-templated/index.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,85 @@
+# index.tcl,v 1.2.4.1 2000/02/03 09:58:48 ron Exp
+set_form_variables 0
+
+# possibly archive_p 
+
+if { [info exists archive_p] && $archive_p } {
+    set page_title "News Archives"
+} else {
+    set page_title "News"
+}
+
+set header_image [ad_parameter IndexPageDecoration news]
+
+set context_bar [ad_context_bar_ws_or_index "News"]
+
+set db_conns [ns_db gethandle [philg_server_default_pool] 2]
+set db [lindex $db_conns 0]
+set db_sub [lindex $db_conns 1]
+
+if { [info exists archive_p] && $archive_p } {
+    set query "select * 
+from news_items
+where sysdate() > expiration_date
+and approval_state = 'approved'
+order by release_date desc, creation_date desc"
+} else {
+    set query "select * 
+from news_items
+where sysdate() between release_date and expiration_date
+and approval_state = 'approved'
+order by release_date desc, creation_date desc"
+}
+
+set selection [ns_db select $db $query]
+
+set news_items ""
+set counter 0 
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    incr counter 
+    append news_items "<li>[util_AnsiDatetoPrettyDate $release_date]: "
+    if { (![info exists archive_p] || $archive_p == 0) && $counter <= 3 && [string length $body] < 300 } {
+	# let's consider displaying the text right here, but
+	# only if there aren't any comments 
+	set n_comments [database_to_tcl_string $db_sub "select count(*) from general_comments where on_what_id = $news_item_id and on_which_table = 'news'"]
+	if { $n_comments > 0 } {
+	    # just do the usual thing
+	    append news_items "<a href=\"item.tcl?news_item_id=$news_item_id\">$title</a>\n"
+	} else {
+	    append news_items "$title\n<blockquote>\n[util_maybe_convert_to_html $body $html_p]\n"
+	    if [ad_parameter SolicitCommentsP news 1] {
+		append news_items "<br><br>\n<A HREF=\"comment-add.tcl?news_item_id=$news_item_id\">comment</a>\n"
+	    }
+	    append news_items "</blockquote>\n"
+	}
+    } else {
+	append news_items "<a href=\"item.tcl?news_item_id=$news_item_id\">$title</a>\n"
+    }
+}
+
+if { $counter == 0 } {
+    append news_items "no items found"
+}
+
+ns_db releasehandle $db
+ns_db releasehandle $db_sub
+
+
+set post_or_suggest_item ""
+
+if { [ad_parameter ApprovalPolicy news] == "open"} {
+    set post_or_suggest_item "<a href=\"post-new.tcl\">post an item</a>"
+} elseif { [ad_parameter ApprovalPolicy news] == "wait"} {
+    set post_or_suggest_item "<a href=\"post-new.tcl\">suggest an item</a>"
+}
+
+if { ![info exists archive_p] || $archive_p == 0 } {
+    set archive_sentence "If you're looking for an old news article, check
+<a href=\"index.tcl?archive_p=1\">the archives</a>."
+} else {
+    set archive_sentence "You can <a href=\"index.tcl\">return to current messages</a> now."
+}
+
+ad_return_template
Index: web/openacs/www/news-templated/item.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/news-templated/item.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/news-templated/item.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,64 @@
+# item.tcl,v 1.1.4.1 2000/02/03 09:58:50 ron Exp
+# 1998-11-18 philg item.tcl (one news item)
+
+set_the_usual_form_variables
+# news_item_id
+
+set db [ns_db gethandle]
+set selection [ns_db 0or1row $db "select title, body, html_p, n.approved_p, release_date, expiration_date, creation_user, creation_date, first_names, last_name
+from news_items n, users u
+where news_item_id = $news_item_id
+and u.user_id = n.creation_user"]
+
+if { $selection == "" } {
+    ad_return_error "Can't find news item" "Can't find news item $news_item_id"
+    return
+}
+
+set user_id [ad_get_user_id]
+
+set_variables_after_query
+
+set context_bar [ad_context_bar_ws_or_index [list "index.tcl" "News"] "One Item"]
+
+set header_image [ad_parameter ItemPageDecoration news]
+set body [util_maybe_convert_to_html $body $html_p]
+set author "<a href=\"/shared/community-member.tcl?user_id=$creation_user\">$first_names $last_name</a>"
+
+
+# see if there are any comments on this item
+set selection [ns_db select $db "select comment_id, content, comment_date, first_names || ' ' || last_name as commenter_name, users.user_id as comment_user_id, html_p as comment_html_p from
+general_comments, users
+where on_what_id= $news_item_id 
+and on_which_table = 'news'
+and general_comments.approved_p = 't'
+and general_comments.user_id = users.user_id"]
+
+set comments ""
+set first_iteration_p 1
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    if $first_iteration_p {
+	append comments "<h4>Comments</h4>\n"
+	set first_iteration_p 0
+    }
+    append comments "<blockquote>\n[util_maybe_convert_to_html $content $comment_html_p]\n"
+    # if the user posted the comment, they are allowed to edit it
+    if {$user_id == $comment_user_id} {
+        append comments "<br><br>-- you <A HREF=\"comment-edit.tcl?comment_id=$comment_id\">(edit your comment)</a>"
+    } else {
+	append comments "<br><br>-- <a href=\"/shared/community-member.tcl?user_id=$comment_user_id\">$commenter_name</a>"
+    }
+    append comments "</blockquote>"
+}
+append comments "
+<center>
+<A HREF=\"comment-add.tcl?news_item_id=$news_item_id\">Add a comment</a>
+</center>
+"
+
+
+ns_db releasehandle $db
+
+ad_return_template
Index: web/openacs/www/news-templated/language-prefs.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/news-templated/language-prefs.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/news-templated/language-prefs.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,37 @@
+# language-prefs.tcl,v 1.2.4.1 2000/02/03 09:58:51 ron Exp
+# Set the language_preference cookie.
+
+if { [ns_conn form] != "" } {
+    set_form_variables
+    # language_preference (optional, default is en)
+    # return_url (optional, default is referrer)
+}
+
+set headers [ns_conn headers]
+
+if { ![info exists language_preference] || $language_preference == "" } {
+    # If language_preference was not set from form, set it to the default.
+    set language_preference [ad_parameter LanguageSiteDefault style "en"]
+}
+
+if { ![info exists return_url] || $return_url == "" } {
+    set return_url [ns_set get $headers "Referer"]
+}
+
+# See if we are a personalized user. If so, update the personalization.
+set user_id [ad_verify_and_get_user_id]
+if { $user_id != "" } {
+    set db [ns_db gethandle]
+    # Ignore any database errors.
+    catch { ns_db dml $db "update users_preferences set language_preference = '$language_preference' where user_id = $user_id" }
+    ns_db releasehandle $db
+
+    util_memoize_flush "ad_style_user_preferences_from_db $user_id"
+}
+
+
+ns_returnredirect "/cookie-chain.tcl?cookie_name=language_preference&cookie_value=$language_preference&final_page=[ns_urlencode $return_url]&expire_state=p"
+
+
+
+
Index: web/openacs/www/news-templated/text-preference-toggle.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/news-templated/text-preference-toggle.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/news-templated/text-preference-toggle.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,7 @@
+# text-preference-toggle.tcl,v 1.1.4.1 2000/02/03 09:58:53 ron Exp
+set_the_usual_form_variables
+# prefer_text_only_p (optional; t or f)
+
+if { ![info exists prefer_text_only_p] || [empty_string_p $prefer_text_only_p] } {
+    set prefer_text_only_p f
+}
Index: web/openacs/www/notifications/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/notifications/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/notifications/index.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,8 @@
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+set notification_classes [database_to_tcl_list_ns_set $db "select notification_class_id, notification_class, class_url, notification_get_pref($user_id, notification_class_id) as notification_pref from user_notification_classes"]
+
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/notifications/prefs-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/notifications/prefs-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/notifications/prefs-edit.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,24 @@
+set_the_usual_form_variables
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+set list_of_classes [database_to_tcl_list $db "select notification_class_id from user_notification_classes"]
+
+ns_db dml $db "begin transaction"
+
+foreach class_id $list_of_classes {
+
+    set QQpref [DoubleApos [set notification_pref_$class_id]]
+
+    ns_db dml $db "update user_notification_prefs set notification_pref='$QQpref' where notification_class_id=$class_id and user_id=$user_id"
+
+    if {[db_resultrows $db] == 0} {
+	ns_db dml $db "insert into user_notification_prefs (notification_class_id, user_id, notification_pref) values ($class_id, $user_id, '$QQpref')"
+    }
+}
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "index.tcl"
Index: web/openacs/www/philosophy/index.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/philosophy/index.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/philosophy/index.adp	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,18 @@
+<%= [openacs_header Philosophy] %>
+<center><img src=/openacs_logo_large.gif></center>
+<p>
+<h2 align=center>Philosophy</h2>
+<%= [openacs_menu] %>
+<p>
+
+Building OpenACS on AOLserver/Tcl technology and Postgres while a
+large chunk of the world is building Java or Perl solutions using
+Oracle or MySQL requires some explanation. This section here brings up
+our approach to building high-performance database-backed web sites.
+
+<ul>
+<li> <a href=why-not-mysql.html>Why Not MySQL</a>
+</ul>
+
+<p>
+<%= [openacs_footer] %>
\ No newline at end of file
Index: web/openacs/www/philosophy/why-not-mysql.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/philosophy/why-not-mysql.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/philosophy/why-not-mysql.html	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,210 @@
+<HEAD><TITLE>Why Not MySQL?</TITLE></HEAD>
+<BODY bgcolor=white>
+<h2>Why Not MySQL?</h2>
+by <a href=mailto:ben@mit.edu>Ben Adida</a>, part of the <a href=/>OpenACS Project</a>.
+<hr><p>
+
+It happens almost every week, and sometimes more often: someone wants
+to know why we're not using MySQL as the RDBMS behind <a href=/>OpenACS</a>. The ACS
+Classic team (<a href=http://www.arsdigita.com>ArsDigita</a>) gets the same question over and over again on
+their <a href=http://photo.net/bboard>Discussion Forums</a>. If it's
+good enough for <a href=http://www.slashdot.org>Slashdot</a>, it must
+be good enough for OpenACS, right?
+<p>
+<b>Wrong</b>. This quick paper attempts to explain why MySQL is not just the
+wrong choice for OpenACS, but how it should never be used by any
+system that handles critical data.
+<p>
+
+<h3>The Purpose of an RDBMS</h3>
+An RDBMS exists for the purpose of providing a reliable permanent
+storage mechanism with very strict properties embodied in the ACID
+test. I will quote directly from Philip Greenspun's <a
+href=http://photo.net/wtr/aolserver/introduction-2.html>great explanation</a>
+<p>
+
+<blockquote>
+<dl>
+<dt>Atomicity
+<dd>
+
+Results of a transaction's execution are either all committed or all
+rolled back. All changes take effect, or none do. Suppose that a user
+is
+editing a comment.  A Web script tells the database to "copy the old
+comment value to an audit table and update the live table with the new
+text".  If the hard drive fills up after the copy but before the
+update,
+the audit table insertion will be rolled back.
+
+
+<dt>
+
+Consistency 
+
+
+
+<dd>
+
+
+The database is transformed from one valid state to another valid
+state. A transaction is legal only if it obeys user-defined integrity
+constraints. Illegal transactions aren't allowed and, if an integrity
+constraint can't be satisfied the transaction is rolled back. For
+example, suppose that you define a rule that postings in a discussion
+forum table must be tied to a valid user ID.  Then you hire Joe Novice
+to write some admin pages.  Joe writes a delete-user page that doesn't
+bother to check whether or not the deletion will result in an orphaned
+discussion forum posting.  Oracle will check, though, and abort any
+transaction that would result in you having a discussion forum posting
+by a deleted user.
+
+<dt>
+
+Isolation
+
+
+<dd>
+
+The results of a transaction are invisible to other transactions until
+the transaction is complete. For example, suppose you have a page to
+show new users and their photographs.  This page is coded in reliance
+on
+the publisher's directive that there will be a mugshot for every user
+and will present a broken image if there is not.  Jane Newuser is
+registering at your site at the same time that Bill Olduser is viewing
+the new user page.  The script processing Jane's registration does
+inserts into several tables: <code>users, mugshots,
+users_demographics</code>.  This may take some time if Jane's mugshot
+is
+large.  If Bill's query starts before Jane's transaction commits, Bill
+won't see Jane at all on his new-users page, even if Jane's insertion
+into some of the tables is complete.
+
+<dt>
+
+Durability 
+
+
+<dd>
+
+Once committed (completed), the results of a transaction are permanent
+and survive future system and media failures. Suppose your ecommerce
+system inserts an order from a customer into a database table and then
+instructs CyberCash to bill the customer $500.  A millisecond later,
+before your server has heard back from CyberCash, someone trips over
+the machine's power cord.  Oracle will not have forgotten about the
+new
+order.  Furthermore, if a programmer spills coffee into a disk
+drive, it will be possible to install a new disk and recover the
+transactions up to the coffee spill, showing that you tried to bill
+someone for $500 and still aren't sure what happened over at
+CyberCash.
+
+</dl>
+</blockquote>
+<p>
+ 
+If what you want is raw, fast storage, use a filesystem. If you want
+to share it among multiple boxes, use NFS. If you want simple
+reliability against simplistic failure, use mirroring. Want a SQL
+interface to it all? Use MySQL.
+<p>
+Now, if what you want is data storage that guarantees a certain number
+of invariants in your data set, that allows for complex operations on
+this data without ever violating those constraints, that isolates
+simultaneous users from each other's partial work, and that recovers
+smoothly from just about any kind of failure, then get your self a
+real RDBMS. Yes, it will be slower than the MySQL file system. Just
+like TCP is slower than UDP, while providing better service guarantees.
+
+<h3>The State and Future of MySQL</h3>
+
+Building a true RDBMS is a tough problem, probably tougher than any
+other systems issue. Most products on the market (Oracle, Sybase,
+PostgreSQL, Interbase) have been in development for years, sometimes
+more than 10 or 15.
+
+<p>
+
+MySQL claims that they have compromised on certain features to
+guarantee better performance. While this may be an interesting way to
+track non-critical data such as clickthrough tracking, compromising on
+perfect data integrity is not acceptable, even for speed, when dealing
+with critical data.
+
+<p>
+
+The OpenACS team is happy to take a closer look at MySQL as it
+matures. However, it doesn't seem that the MySQL team understands the
+concepts and importance of true ACID capabilities: The <a
+href=http://web.mysql.com/Manual_chapter/manual_TODO.html#TODO>MySQL
+Todo</a> mentions "transactions" in a long list that includes
+questions such as "do sleeping threads take CPU." Furthermore, the <a
+href=http://web.mysql.com/Manual_chapter/manual_Compatibility.html#Missing_functions>MySQL
+manual</A> claims that MySQL will soon implement "atomic operations"
+through the use of table locks, but <i>without rollback</i>. This is a
+blatant misuse of the term "atomic," which implies that either none or
+all operations will complete. A hardware or power failure in the
+middle of a set of statements will break the atomicity of the block
+if there is no rollback capability.
+
+<p>
+
+<i>Rollback is not just a convenient feature, it is a critical basis
+for solid data storage</i>.
+
+<p>
+
+There are very good reasons for using MySQL. A need for a reliable,
+ACID-compliant datastore isn't one of them.
+
+<h3>A Few More Details</h3>
+<ul>
+
+<li> <b>MySQL has no subqueries</b>. <br>
+Instead of performing one complex query that is entirely processed on
+the database end, MySQL users have to perform 2 or more serial queries
+that each must go over inter-process or network communication between
+the app and the database. This significantly reduces the speed
+advantages of MySQL.
+
+<li> <b>MySQL has no stored procedures</b>.<br> 
+If a series of DB actions need to be performed in a block, MySQL
+requires each SQL statement to be sent from the app, again in a serial
+manner, again over IPC or network.
+
+<li> <b>MySQL has no triggers or foreign key constraints</b>. <br>
+Data invariants must be maintained by application-level code, which
+requires building carefully-planned abstractions to guarantee
+integrity (for every means of accessing your DB), and even more
+unnecessary back-and-forth communication between the app and the
+database.
+
+<li> <b>MySQL only has table-level locking</b>. <br>
+Only one user can write to a table at the same time. For web usage,
+that falls under the category of "pathetic."
+
+</ul>
+
+<h3>The Bottom Line</h3> 
+
+An enterprise-level system will never compromise certain features for
+speed. The ACID properties of an RDBMS are an absolute necessity for
+any critical data. Critical web sites that run on non-ACID-compliant
+systems are asking for trouble.
+<p>
+The OpenACS project refuses to break with the important principles of
+the ACID test. We are out to build an enterprise-level Open Source web
+toolkit. <a href=http://www.postgresql.org>PostgreSQL</a> and soon <a
+href=http://www.interbase.com>InterBase</a> are appropriate RDBMS
+candidates for this project. MySQL is just a glorified filesystem with
+a SQL interface.
+<p>
+
+
+
+<p>
+<hr>
+<address>ben@mit.edu</address>
+</BODY>
\ No newline at end of file
Index: web/openacs/www/poll/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/poll/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/poll/index.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,35 @@
+# index.tcl,v 3.0 2000/02/06 03:52:36 ron Exp
+# index.tcl - main page of polls
+
+# construct list of available polls
+
+set db [ns_db gethandle]
+
+set selection [ns_db select $db "
+select poll_id, name, require_registration_p
+  from polls
+ where poll_is_active_p(start_date, end_date) = 't'
+"]
+
+
+set polls [list]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    lappend polls "<a href=\"one-poll.tcl?[export_url_vars poll_id]\">$name</a>"
+
+    lappend polls $require_registration_p
+}
+
+ns_db releasehandle $db
+
+
+set page_title "Polls"
+
+set header_image [ad_parameter IndexPageDecoration polls]
+set context_bar [ad_context_bar_ws_or_index "Polls"]
+
+ad_return_template
+
+
Index: web/openacs/www/poll/one-poll.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/poll/one-poll.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/poll/one-poll.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,52 @@
+# one-poll.tcl,v 3.0 2000/02/06 03:52:37 ron Exp
+# one-poll.tcl -- display one poll.
+
+set_the_usual_form_variables
+# expects poll_id
+
+set header_image [ad_parameter IndexPageDecoration polls]
+set context_bar [ ad_context_bar_ws_or_index [list "/poll" "Polls"] "One Poll"]
+
+
+# throw an error if this isn't an integer
+validate_integer "poll_id" $poll_id
+set info [util_memoize "poll_info_internal $poll_id"]
+
+set poll_name [lindex $info 0]
+set poll_description [lindex $info 1]
+set start_date [lindex $info 2]
+set end_date [lindex $info 3]
+set require_registration_p [lindex $info 4]
+set active_p [lindex $info 5]
+
+set page_title $poll_name
+
+if { $active_p == "f" } {
+    ad_return_template not-active
+    return
+}
+
+
+# if registration required, see if they've already voted and
+# disallow.
+# if registration isn't required, don't bother (why restrict
+# registered users from stuffing the ballot box?)
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $require_registration_p == "t" } {
+   ad_maybe_redirect_for_registration
+}
+
+
+set form_html "
+[export_form_vars poll_id]
+"
+
+# get a list with the labels and choice id's
+
+validate_integer "poll_id" $poll_id
+set choices [util_memoize "poll_labels_internal $poll_id"]
+
+ad_return_template
+
Index: web/openacs/www/poll/poll-results.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/poll/poll-results.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/poll/poll-results.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,75 @@
+# poll-results.tcl,v 3.0 2000/02/06 03:52:38 ron Exp
+# poll-results.tcl -- see the results of a poll
+
+set_form_variables
+# expects poll_id
+
+validate_integer "poll_id" $poll_id
+set info [util_memoize "poll_info_internal $poll_id"]
+
+set poll_name [lindex $info 0]
+set poll_description [lindex $info 1]
+
+set db [ns_db gethandle]
+
+
+
+set selection [ns_db select $db "
+(select pc.label, count(puc.choice_id) as n_votes
+from poll_choices pc, poll_user_choices puc
+where pc.poll_id = $poll_id
+and pc.choice_id = puc.choice_id
+group by pc.label)
+union
+(select pc.label, 0 as n_votes from poll_choices pc
+where pc.poll_id= $poll_id
+and 0=(select count(*) from poll_user_choices puc where puc.choice_id=pc.choice_id)
+group by pc.label)
+order by n_votes desc"]
+
+
+
+set total_count 0
+
+# rather than make Oracle do the percentage calculation,
+# we sum up the total_count and do the calcs ourselves.
+# otherwise we'd have to do a seperate count(*), which would suck.
+
+set intermediate_values [list]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    lappend intermediate_values [list $n_votes $label]
+    incr total_count $n_votes
+}
+
+ns_db releasehandle $db
+
+set values [list]
+
+if { $total_count > 0 } {
+    
+    foreach row $intermediate_values {
+	set n_votes "[lindex $row 0].0"
+	set label [lindex $row 1]
+	
+	# only display one digit after the decimal point
+	set percent [format "%.1f" [expr $n_votes/$total_count * 100.0]]
+	
+	if { $n_votes == 1 } {
+	    set vote_text "vote"
+	} else {
+	    set vote_text "votes"
+	}
+	
+	lappend values [list $label "" $percent]
+    }
+}
+
+
+
+set header_image [ad_parameter IndexPageDecoration polls]
+set context_bar [ad_context_bar_ws_or_index [list "/poll" "Polls"] [list "/poll/one-poll.tcl?[export_url_vars poll_id]" "One Poll"] "Results" ]
+
+ad_return_template
+
Index: web/openacs/www/poll/vote.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/poll/vote.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/poll/vote.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,87 @@
+# vote.tcl,v 3.0 2000/02/06 03:52:39 ron Exp
+# vote.tcl -- process a user's vote.
+
+# markd@arsdigita.com and philg@mit.edu
+# September 28, 1999
+
+# this will record a vote UNLESS the user is registered and has
+# already voted
+
+set_the_usual_form_variables
+#expects poll_id and choice_id
+
+# security fixes (BMA, spec'ed by aD)
+validate_integer poll_id $poll_id
+validate_integer choice_id $choice_id
+
+set header_image [ad_parameter IndexPageDecoration polls]
+set context_bar [ad_context_bar_ws_or_index [list "/poll" "Polls"] [list "/poll/one-poll.tcl?[export_url_vars poll_id]" "One Poll"] "Confirm vote" ]
+
+
+set user_id [ad_verify_and_get_user_id]
+
+# sanity-check
+
+# make sure they made a choice
+
+if { ![info exists choice_id] || [empty_string_p $choice_id] } {
+    # D'OH they didn't make a choice.
+    set context_bar [ad_context_bar_ws_or_index [list "/poll" "Polls"] [list "/poll/one-poll.tcl?[export_url_vars poll_id]" "One Poll"] "Vote" ]
+    ad_return_template novote
+    return
+}
+
+# if it's a registration-only poll, make sure again that they
+# don't vote again if they already have
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select require_registration_p, name as poll_name
+from polls
+where poll_id = $poll_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Could not find poll" "Could not find poll $poll_id; perhaps it has been deleted by the site administrator"
+    return
+}
+
+set_variables_after_query
+
+if { $user_id != 0 } {
+    set n_votes_already [database_to_tcl_string $db "select count(*) from poll_user_choices
+where poll_id = $poll_id
+and user_id = $user_id"]
+    if { $n_votes_already > 0 } {
+	ad_return_template already-voted
+	return
+    }
+}
+
+if { $user_id == 0 && $require_registration_p == "t" } {
+    # this person is not logged in but is trying to vote in a registration 
+    # required poll, the following procedure call will redirect the
+    # person and also terminate thread execution
+    ad_maybe_redirect_for_registration
+}
+
+set context_bar [ad_context_bar_ws_or_index [list "/poll" "Polls"] Thanks]
+
+if { $user_id == 0 } {
+    set user_id NULL
+}
+
+set insert_sql "insert into poll_user_choices
+(poll_id, choice_id, user_id, choice_date, ip_address)
+values
+($poll_id, $choice_id, $user_id, sysdate(), '[DoubleApos [ns_conn peeraddr]]')"
+
+
+if [catch { ns_db dml $db $insert_sql } errmsg ] {
+    ns_db releasehandle $db
+    ad_return_template dberror
+    return
+}
+
+
+ad_return_template
+
Index: web/openacs/www/portals/calendar.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/calendar.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/calendar.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,24 @@
+#
+# calendar for sloan portal
+# by aileen@mit.edu, randyg@arsdigita.com
+# Feb 2000
+#
+
+ad_page_variables {
+    date
+}
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+ns_return 200 text/html "
+[ad_header "Calendars @ [ad_system_name]"]
+<h2>Calendar</h2>
+
+[ad_context_bar_ws_or_index [list /portals/user$user_id-1.ptl "Portal"] "Calendar"]
+
+<hr>
+[edu_calendar_for_portal $db $date]
+[ad_footer]
+"
Index: web/openacs/www/portals/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/index.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,75 @@
+#
+# /portals/index.tcl
+#
+# Entry to the point to the Caltech portals - needs to be edited for the next client or for generic ACS
+#
+# by aure@arsdigita.com and dh@arsdigita.com
+#
+# Last modified: 10/8/1999
+#
+# index.tcl,v 3.2 2000/03/10 22:59:08 richardl Exp
+#
+
+set db [ns_db gethandle]
+set user_id [ad_verify_and_get_user_id]
+
+# Get generic display information
+portal_display_info
+
+# Get a list of portal groups that actually have content
+set group_select "
+    select distinct group_name, ug.group_id 
+    from   user_groups ug, portal_pages pp
+    where  group_type='portal_group'
+    and    ug.group_id = pp.group_id
+    and not group_name = 'Super Administrators'"
+set selection [ns_db select $db $group_select]
+
+set portal_extension [ad_parameter PortalExtension portals .ptl]
+
+set portal_link_list ""
+while { [ns_db getrow $db $selection ] } {
+    set_variables_after_query
+    # convert spaces to dashes and capitals to lowercase for the url
+    regsub -all { } [string tolower $group_name] {-} group_name_in_link 
+    append portal_link_list "<li><a href=$group_name_in_link-1$portal_extension>$group_name</a>\n"
+}
+ns_db releasehandle $db
+
+if { [ad_parameter AllowUserLevelPortals portals] == 1 && $user_id != 0 } {
+    append portal_link_list "<li> <a href=\"user$user_id-1$portal_extension\">Your personalized portal</a>\n"
+}
+
+# ---------------------------------------------------------
+# serve the page
+
+set page_content "[ad_header "$system_name"]
+
+<h2>$system_name</h2>
+
+[ad_context_bar_ws_or_index "Portals"]
+
+<hr>
+
+Choose a portal:
+
+<ul>
+$portal_link_list
+</ul>
+
+[ad_footer]
+"
+ns_return 200 text/html $page_content
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/portals/manage-portal-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/manage-portal-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/manage-portal-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,194 @@
+#
+# /portals/manage-portal-2.tcl
+#
+# Updates the portal table page map given all of the users changes on manage-portal.tcl's GUI
+# (USER LEVEL VERSION)
+#
+# by aure@arsdigita.com and dh@arsdigita.com
+#
+# Last modified: 10/8/1999
+#
+# manage-portal-2.tcl,v 3.1 2000/03/10 22:58:54 richardl Exp
+#
+
+ad_page_variables {left right hiddennames} 
+
+set db [ns_db gethandle]
+set user_id [ad_verify_and_get_user_id]
+
+# good list is the list of tables on this group's portal pages after update
+set good_list ""
+# page_list is the resulting page_id's of pages having tables after update
+set page_list ""
+
+ns_db dml $db "begin transaction"
+
+# loop over each side of each page left then right and update portal table page map accordingly
+
+set i 0
+foreach left_list $left {
+    # We know that left and right each have one list per page.
+    set right_list [lindex $right $i]
+    
+    incr i
+
+    # Get page_id for page $i -Dave
+    set page_id [database_to_tcl_string_or_null $db "
+        select page_id 
+        from  portal_pages
+        where user_id = $user_id
+        and   page_number = $i"]
+
+    if {[empty_string_p $page_id] } {
+	# the page is not already in the database
+	
+	if { [ llength $right_list] > 0  || [ llength $left_list ] > 0 } {
+	    # Stuff is being moved onto this new page - create an entry for it in the database
+ 
+	    set page_id [database_to_tcl_string $db "select portal_page_id_sequence.nextval from dual"]
+
+	    ns_db dml $db "
+   	        insert into portal_pages
+	        (page_id, user_id, page_number, page_name)
+	        values
+	        ($page_id, $user_id, $i, '[DoubleApos [lindex $hiddennames [expr $i-1]]]')"
+	}
+    } 
+
+    if {![empty_string_p $page_id]} {
+	# The page exists in the database
+
+	# Update the name of the pre-existing page
+	ns_db dml $db "
+	    update portal_pages
+	    set    page_name = '[DoubleApos [lindex $hiddennames [expr $i-1]]]'
+	    where  user_id = $user_id
+	    and    page_id = $page_id"
+
+	lappend page_list $page_id
+
+	# do the left side
+	set sort_key 0
+	foreach table_id $left_list {
+	     
+	    incr sort_key
+	    lappend good_list [list $page_id $table_id]
+	    
+	    # Get original_page_id for this table 
+	    set original_page_id [database_to_tcl_string_or_null $db "
+	        select p.page_id 
+	        from   portal_pages p, portal_table_page_map m
+	        where  user_id = $user_id
+	        and    table_id  = $table_id
+	        and    m.page_id = p.page_id"]
+	    
+	    if {[empty_string_p $original_page_id]} {
+		ns_db dml $db "
+		    insert into portal_table_page_map
+		    (table_id, page_id, sort_key, page_side)
+		    values
+		    ($table_id, $page_id, $sort_key, 'l')"
+	    } else {
+		# Move this table
+		ns_db dml $db "
+		    update portal_table_page_map
+		    set    page_id = $page_id,
+		           sort_key = $sort_key,
+		           page_side = 'l'
+		    where  table_id = $table_id
+		    and    page_id = $original_page_id"
+	    }
+	}
+	
+	# do the right side
+	set sort_key 0
+	foreach table_id $right_list {
+
+	    incr sort_key
+	    lappend good_list [list $page_id $table_id]
+
+	     # Get original_page_id for this table
+	    
+	     set original_page_id [database_to_tcl_string_or_null $db "
+	        select p.page_id 
+	        from portal_pages p, portal_table_page_map m
+	        where user_id = $user_id
+	        and   table_id  = $table_id
+	        and   m.page_id = p.page_id"]
+
+	    if {[empty_string_p $original_page_id]} {
+		ns_db dml $db "
+		    insert into portal_table_page_map
+		    (table_id, page_id, sort_key, page_side)
+		    values
+		    ($table_id, $page_id, $sort_key, 'r')"
+	    } else {
+		ns_db dml $db "
+		    update portal_table_page_map
+		    set    page_id = $page_id,
+		           sort_key = $sort_key,
+		           page_side = 'r'
+		    where  table_id = $table_id
+		    and    page_id = $original_page_id"
+	    }
+	}
+    }
+}    
+
+# DRB: I moved this in front of the two following delete statements for a reason.
+# Due to the fact that the bleeping education module stuffs rows into new portal
+# pages behind our backs, PG won't allow the delete because it breaks checking
+# for referential integrity.  Does this suck or what?  
+
+ns_db dml $db "end transaction"
+
+if {[empty_string_p $good_list] && ![empty_string_p $page_list] } {
+    # delete all tables
+    ns_db dml $db "delete from portal_table_page_map where page_id in ([join $page_list ,])"
+} elseif {![empty_string_p $good_list]} {
+    # delete tables that didn't appear in our list (hence they were javascript-deleted)
+    set sep ""
+    foreach table $good_list {
+        append select_clause "$sep (table_id = [lindex $table 1]
+            and page_id = [lindex $table 0])"
+        set sep " or "
+    }
+    ns_db dml $db "
+        delete from portal_table_page_map
+        where not ( $select_clause )"
+   ns_log "Notice" "[ns_pg ntuples $db]"
+}
+
+# remove orphaned pages with no tables on them
+ns_db dml $db "delete from portal_pages where page_id not in (select page_id from portal_table_page_map)"
+
+# get all the page_ids for pages with stuff
+set page_id_list [database_to_tcl_list $db "
+    select pp.page_id 
+    from   portal_pages pp
+    where  pp.user_id = $user_id
+    and    pp.page_id in (select pm.page_id from portal_table_page_map pm)   
+    order by page_number"]
+
+set new_page_number 0
+foreach page_id $page_id_list {
+    incr new_page_number
+    ns_db dml $db "
+    update portal_pages
+    set page_number = $new_page_number
+    where page_id = $page_id"
+}
+
+ns_db releasehandle $db
+
+ns_returnredirect manage-portal
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/portals/manage-portal-js.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/manage-portal-js.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/manage-portal-js.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,390 @@
+#
+# /portals/manage-portal-js.tcl
+#
+# Javascript for manage-portal.tcl
+#
+# by aure@arsdigita.com and dh@arsdigita.com
+#
+# Last modified: 10/8/1999
+#
+# manage-portal-js.tcl,v 3.1 2000/03/10 22:58:47 richardl Exp
+#
+
+set_the_usual_form_variables
+
+ns_write "
+
+// Key for functions:
+//  down = 0: move up
+//  down = 1: move down
+    
+function moveTable(direction,side,page) {
+    selectbox = side + page;
+    
+    selected_index = document.theForm\[selectbox].selectedIndex;
+    if (selected_index != -1) {
+	oldText = document.theForm\[selectbox].options\[selected_index].text;
+	oldValue = document.theForm\[selectbox].options\[selected_index].value;
+    }
+    if (selected_index != -1 && oldValue != \"null\") {
+	if (direction == \"up\") {
+	    // move table up
+	    if (selected_index > 0) {
+		// the table was in the interior of a page, so moving up means swapping with the table above
+		document.theForm\[selectbox].options\[selected_index].text = document.theForm\[selectbox].options\[selected_index-1].text;
+		document.theForm\[selectbox].options\[selected_index].value = document.theForm\[selectbox].options\[selected_index-1].value;
+		document.theForm\[selectbox].options\[selected_index-1].text = oldText;
+		document.theForm\[selectbox].options\[selected_index-1].value = oldValue;
+		document.theForm\[selectbox].selectedIndex--;
+	    } else  if (selected_index == 0 && page > 1) {
+		// the table was at the top of the page already, so we now place it at the end of the previous page 
+		newpage = page-1;
+		newselectbox = side + newpage;
+
+
+		// calculate where to move the table to (length of the current select box + 1)
+		real_length = 0
+		x = \"continue\"
+		while ( x == \"continue\" ) {
+		    if (document.theForm\[newselectbox].options\[real_length].value==\"null\") {
+			x = \"stop\"
+		    } else {
+			real_length++;
+		    }
+		}
+
+		// Moves text/value to the bottom of one page up
+		document.theForm\[newselectbox].options\[real_length].text = oldText;
+		document.theForm\[newselectbox].options\[real_length].value = oldValue;
+
+		// erase the table from the original page
+		document.theForm\[selectbox].options\[selected_index].text = \"\";
+		document.theForm\[selectbox].options\[selected_index].value = \"null\";
+		
+		// move everything in the originating page shift up
+		counter = 0
+		while (counter < $total-1) {
+		    oldText = document.theForm\[selectbox].options\[counter].text
+		    oldValue = document.theForm\[selectbox].options\[counter].value
+		    document.theForm\[selectbox].options\[counter].text = document.theForm\[selectbox].options\[counter+1].text;
+		    document.theForm\[selectbox].options\[counter].value = document.theForm\[selectbox].options\[counter+1].value;
+		    document.theForm\[selectbox].options\[counter+1].text = oldText;
+		    document.theForm\[selectbox].options\[counter+1].value = oldValue;
+		    counter++;
+		}
+		return false;
+	    }
+	} else if (direction == \"down\") {
+	    // move table down
+
+	    // calculate the index of the last element in the current page (needed to check for interior moves or moves to new pages)
+	    real_length = 0
+	    x = \"continue\"
+	    while (x == \"continue\" ) {
+		if (document.theForm\[selectbox].options\[real_length].value==\"null\") {
+		    x = \"stop\"
+		    real_length--;
+		} else {
+		    real_length++;
+		}
+	    }
+
+	    if (selected_index < real_length) {
+		// move within the page, so just swap values with the table below
+		document.theForm\[selectbox].options\[selected_index].text = document.theForm\[selectbox].options\[selected_index+1].text;
+		document.theForm\[selectbox].options\[selected_index].value = document.theForm\[selectbox].options\[selected_index+1].value;
+		document.theForm\[selectbox].options\[selected_index+1].text = oldText;
+		document.theForm\[selectbox].options\[selected_index+1].value = oldValue;
+		document.theForm\[selectbox].selectedIndex++;
+		
+	    } else if (selected_index == real_length && page < $max_page) {
+		// move table down to the next page
+		newpage = page+1;
+		newselectbox = side + newpage;
+		
+		// shuffle everyone down one (from the top) to make room for the new table which will appear at the top
+		counter = document.theForm\[newselectbox].options.length-2;
+		while (counter > -1) {
+		    oldText = document.theForm\[newselectbox].options\[counter].text
+		    oldValue = document.theForm\[newselectbox].options\[counter].value
+		    document.theForm\[newselectbox].options\[counter].text = document.theForm\[newselectbox].options\[counter+1].text;
+		    document.theForm\[newselectbox].options\[counter].value = document.theForm\[newselectbox].options\[counter+1].value;
+		    document.theForm\[newselectbox].options\[counter+1].text = oldText;
+		    document.theForm\[newselectbox].options\[counter+1].value = oldValue;
+		    counter = counter - 1;
+		}
+		
+		// move table into top place on new page
+		document.theForm\[newselectbox].options\[0].text = document.theForm\[selectbox].options\[selected_index].text;
+		document.theForm\[newselectbox].options\[0].value = document.theForm\[selectbox].options\[selected_index].value;
+
+		// erase the table from the original page
+		document.theForm\[selectbox].options\[selected_index].text = \"\";
+		document.theForm\[selectbox].options\[selected_index].value = \"null\";
+	    }
+	}
+    } else {
+	// nothing was selected 
+	alert(\"Please select a table first.\");
+    }
+    return false;
+}  
+
+function slide(side,page) {
+    // move table from one side to the other side of the page
+    selectbox = side + page;
+    if (side == \"left\") {
+	newselectbox = \"right\"+page;
+    } else {
+	newselectbox = \"left\"+page;
+    }
+    
+    selected_index = document.theForm\[selectbox].selectedIndex;
+    if (selected_index != -1) {
+	oldText = document.theForm\[selectbox].options\[selected_index].text;
+	oldValue = document.theForm\[selectbox].options\[selected_index].value;
+    } else {
+	alert(\"Please select a module first\");
+	return false;
+    }
+    
+    if ( oldValue==\"null\") {
+	alert(\"Please select a module first\");
+	return false;
+    }
+    
+    real_length = 0
+    x = \"continue\"
+    while ( x == \"continue\" ) {
+	// calculate the last entry in the destination page
+	if (document.theForm\[newselectbox].options\[real_length].value==\"null\") {
+	    x = \"stop\"
+	} else {
+	    real_length++;
+	}
+    }
+	
+    // table to the bottom of other side of page
+    document.theForm\[selectbox].options\[selected_index].text = document.theForm\[newselectbox].options\[real_length].text;
+    document.theForm\[selectbox].options\[selected_index].value = document.theForm\[newselectbox].options\[real_length].value;
+    document.theForm\[newselectbox].options\[real_length].text = oldText;
+    document.theForm\[newselectbox].options\[real_length].value = oldValue;
+	
+    // get the length of the originating page
+    real_length = 1
+    x = \"continue\"
+    while ( x == \"continue\" ) {
+	if (document.theForm\[selectbox].options\[real_length].value==\"null\") {
+	    x = \"stop\"
+	} else {
+	    real_length++;
+	}
+    }
+    // shift everything below the moved element up one in the original selectbox
+    counter = selected_index
+    while (counter < real_length) {
+	oldText = document.theForm\[selectbox].options\[counter].text
+	oldValue = document.theForm\[selectbox].options\[counter].value
+	document.theForm\[selectbox].options\[counter].text = document.theForm\[selectbox].options\[counter+1].text;
+	document.theForm\[selectbox].options\[counter].value = document.theForm\[selectbox].options\[counter+1].value;
+	document.theForm\[selectbox].options\[counter+1].text = oldText;
+	document.theForm\[selectbox].options\[counter+1].value = oldValue;
+	counter++;
+    }
+    return false;
+}
+
+
+function Delete(side, page) {
+    selectbox = side + page;
+    selected_index = document.theForm\[selectbox].selectedIndex;
+
+    if (selected_index != -1) {
+	oldText = document.theForm\[selectbox].options\[selected_index].text;
+	oldValue = document.theForm\[selectbox].options\[selected_index].value;
+    } else {
+	alert(\"Please select a module first\");
+	return false;
+    }
+
+
+    if (oldValue != \"null\") {
+	document.theForm\[selectbox].options\[selected_index].value=\"null\"; 
+	document.theForm\[selectbox].options\[selected_index].text=\"\"; 
+	
+	real_length = 0
+	x = \"continue\"
+	while ( x == \"continue\" ) {
+	    // calculate the number of ellements in the target page after the move
+	    if (document.theForm\[\"new\"].options\[real_length].value==\"null\") {
+		x = \"stop\"
+	    } else {
+		real_length++;
+	    }
+	}
+	// Moves text/value to the bottom of the unused table box
+	document.theForm\[\"new\"].options\[real_length].text = oldText;
+	document.theForm\[\"new\"].options\[real_length].value = oldValue;
+	
+    } else {
+	// nothing selected
+	alert(\"Please select a module first\");
+    }
+
+    real_length = 1
+    x = \"continue\"
+    while ( x == \"continue\" ) {
+	// calculate the number of elements in the 'from' selectbox (after the move?)
+	if (document.theForm\[selectbox].options\[real_length].value==\"null\") {
+	    x = \"stop\"
+	} else {
+	    real_length++;
+	}
+    }
+    counter = selected_index
+    // Adjusts for the blank on the old selectbox
+    while (counter < real_length) {
+	oldText = document.theForm\[selectbox].options\[counter].text
+	oldValue = document.theForm\[selectbox].options\[counter].value
+	document.theForm\[selectbox].options\[counter].text = document.theForm\[selectbox].options\[counter+1].text;
+	document.theForm\[selectbox].options\[counter].value = document.theForm\[selectbox].options\[counter+1].value;
+	document.theForm\[selectbox].options\[counter+1].text = oldText;
+	document.theForm\[selectbox].options\[counter+1].value = oldValue;
+	counter++;
+    }
+    return false;
+}
+
+
+function addTable(side, page) {
+    selectbox = side + page;
+    selected_index = document.theForm\[\"new\"].selectedIndex;
+    if (selected_index != -1) {
+	oldText = document.theForm\[\"new\"].options\[selected_index].text;
+	oldValue = document.theForm\[\"new\"].options\[selected_index].value;
+    } else {
+	alert(\"Please select a module first\");
+	return false;
+    }
+
+    if (oldValue != \"null\") {
+	 	
+	real_length = 0
+	x = \"continue\"
+	while ( x == \"continue\" ) {
+	    // calculate the number of ellements in the target page after the move
+	    if (document.theForm\[selectbox].options\[real_length].value==\"null\") {
+		x = \"stop\"
+	    } else {
+		real_length++;
+	    }
+	}
+	// Moves text/value to the bottom
+	document.theForm\[selectbox].options\[real_length].text = oldText;
+	document.theForm\[selectbox].options\[real_length].value = oldValue;
+	
+    } else {
+	// nothing selected
+	alert(\"Please select a module first\");
+    }
+
+    real_length = 1
+    x = \"continue\"
+    while ( x == \"continue\" ) {
+	// calculate the number of elements in the 'from' selectbox 
+	if (document.theForm\[\"new\"].options\[real_length].value==\"null\") {
+	    x = \"stop\"
+	} else {
+	    real_length++;
+	}
+    }
+
+    // erase the table from the original page
+    document.theForm\[\"new\"].options\[selected_index].text = \"\";
+    document.theForm\[\"new\"].options\[selected_index].value = \"null\";
+
+    counter = selected_index;
+    // Adjusts for the blank on the old selectbox
+    while (counter < real_length) {
+	oldText = document.theForm\[\"new\"].options\[counter].text
+	oldValue = document.theForm\[\"new\"].options\[counter].value
+	document.theForm\[\"new\"].options\[counter].text = document.theForm\[\"new\"].options\[counter+1].text;
+	document.theForm\[\"new\"].options\[counter].value = document.theForm\[\"new\"].options\[counter+1].value;
+	document.theForm\[\"new\"].options\[counter+1].text = oldText;
+	document.theForm\[\"new\"].options\[counter+1].value = oldValue;
+	counter++;
+    }
+    return false;
+}
+
+
+
+
+
+function doSub() {
+    // Loads the string of elements on a page into hidden variables .left and  .right
+    // These are used on the latter page for the update.
+"
+    set page_temp 1
+while {$page_temp <= $max_page} {
+	ns_write "
+    document.theForm\[\"left\"].value += '{'+doSubSide(\"left$page_temp\")+'} ';
+    document.theForm\[\"right\"].value += '{'+doSubSide(\"right$page_temp\")+'} ' ;
+    document.theForm\[\"hiddennames\"].value += '{'+document.theForm.page_name$page_temp.value+'} '"    
+	incr page_temp
+    }
+ns_write "
+    return true;
+}
+
+function doSubSide(side) {
+    val = \"\";
+    for (i=0;i<document.theForm\[side].length;i++) {
+	newval = document.theForm\[side].options\[i].value;
+	if (newval != \"null\") {
+	    if (i!=0) { val += \" \"; }   
+	    val += newval
+	}
+    } 
+    return val;
+}
+
+function spawnWindow(action, side,page) {
+
+    // This function edits a module
+    if (page > 0) {
+	selectbox = side + page;
+    } else {
+	selectbox = 'new';
+    }
+    selected_index = document.theForm\[selectbox].selectedIndex;
+
+    if (selected_index != -1) {
+	oldText = document.theForm\[\"new\"].options\[selected_index].text;
+	oldValue = document.theForm\[\"new\"].options\[selected_index].value;
+    } else {
+	alert(\"Please select a module first\");
+	return false;
+    }
+
+
+    Value = document.theForm\[selectbox].options\[selected_index].value;
+
+    if (Value != \"null\") {
+	file = action+'-table.tcl?[export_url_vars group_id]&table_id='+Value
+	window.open(file,'TableEditor','toolbar=no,location=no,directories=no,status=no,scrollbars=yes,resizable=yes,copyhistory=no,width=640,height=480')
+	return false;
+    } else {
+	alert(\"Please select a module first\");
+	return false;
+    }
+}
+
+"
+
+
+
+
+
+
+
Index: web/openacs/www/portals/manage-portal.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/manage-portal.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/manage-portal.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,228 @@
+#
+# /portals/manage-portal.tcl
+#
+# GUI that facilitates page layout (USER VERSION)
+#
+# by aure@arsdigita.com and dh@arsdigita.com
+#
+# Last modified: 10/8/1999
+#
+# manage-portal.tcl,v 3.2 2000/03/10 22:57:39 richardl Exp
+#
+
+set db [ns_db gethandle]
+
+# -------------------------------------
+# get user info
+
+set user_id [ad_verify_and_get_user_id]
+
+set user_name test
+set user_name [database_to_tcl_string $db "
+	    select first_names||' '||last_name from users where user_id=$user_id"]
+ 					    
+# Get generic display information
+portal_display_info
+
+# get number of existing pages +1
+set max_page [database_to_tcl_string $db "select max(page_number)+1 from portal_pages
+where     user_id = $user_id"]
+
+if {[empty_string_p $max_page]} {
+    set max_page 1
+}
+
+set total [database_to_tcl_string $db "select count(*) from portal_tables"]
+
+set page_content "
+<html>
+<head>
+<title>Personalize Page Layout</title>
+
+<script src=manage-portal-js?[export_url_vars max_page group_id total]></script>
+</head>
+$body_tag $font_tag
+<h2>[ad_parameter SystemName portals] Administration for $user_name</h2>
+<form action=manage-portal-2 method=get name=theForm>
+[export_form_vars user_id]
+<input type=hidden name=\"left\" value=\"\" >
+<input type=hidden name=\"right\" value=\"\">
+<input type=hidden name=\"hiddennames\" value=\"\">
+<table width=100% border=0 cellpadding=0 cellspacing=0><tr><td>This page enables you to manage current content.
+</td><td valign=bottom align=right>Click here when completed: <input type=submit value=\" FINISHED \" onClick=\"return doSub();\">
+</td></tr></table><p>"
+
+set n_longest 30
+
+set spaces ""
+
+for {set i 0} {$i <=  $n_longest} {incr i} {
+    append spaces "&nbsp;"
+}
+
+set x 0
+set extra_options ""
+while {$x <= $total} {
+    if { $x == 0 } {
+	append extra_options "<option value=\"null\">$spaces</option>\n"
+    } else {
+	append extra_options "<option value=\"null\">&nbsp;</option>\n"
+    }
+    incr x
+}
+
+for {set current_page 1} {$current_page <= $max_page} {incr current_page} {
+
+    set sql_query "
+    select    table_name, page_number, page_side, map.table_id, page_name
+    from      portal_table_page_map map, portal_tables p_t, portal_pages p_p
+    where     user_id = $user_id
+    and       map.page_id = p_p.page_id
+    and       map.table_id = p_t.table_id
+    and       page_number = $current_page
+    order by  page_side, sort_key"
+
+    set selection [ns_db select $db $sql_query]
+
+    set left_select ""
+    set right_select ""
+    set page_name ""
+
+    while { [ns_db getrow $db $selection] } {
+	set_variables_after_query
+
+	set table_name [string range [string toupper [ns_adp_parse -string $table_name]] 0 31]
+
+	if {$page_side == "l"} {
+	    append left_select "<option value=\"$table_id\">$table_name</option>\n"
+	} else {
+	    append right_select "<option value=\"$table_id\">$table_name</option>\n"
+	}
+    }
+    regsub -all { } [string tolower $user_name] {-} lower_user_name
+
+    if {$current_page != $max_page} {
+	set right_link "<td align=right>(<a target=_new href=/portals/user$user_id-$current_page[ad_parameter PortalExtension portals .ptl]>current version</a>)</td>"
+    } else {
+	set right_link "<td align=right>(a new page if needed)</td>"
+    }
+	    
+    append page_content "
+	<table width=100% bgcolor=#0000 border=0 cellpadding=0 cellspacing=1><tr><td>
+	    <table bgcolor=#cccccc cellspacing=1 cellpadding=4 width=100% border=0>
+	       <tr>
+	          <td colspan=2 bgcolor=#cccccc><table width=100% border=0 cellpadding=0 cellspacing=0><tr><td>Page #$current_page - Titled: <font face=arial,helvetica size=-1><input name=page_name$current_page type=text size=30 value=\"$page_name\"></td>$right_link</tr></table></td>
+	       </tr>
+	       <tr>
+	       <td bgcolor=#dddddd valign=top align=center><table border=0 cellpadding=1 cellspacing=0>
+	          <tr><td><table cellpadding=4>
+	          <tr>
+	             <td><a href=\"#\" onClick=\"return Delete('left',$current_page)\"><img src=pics/x width=18 height=15 border=0 alt=Delete></a></td>
+	          </tr>
+	       </table></td>
+	             <td><font face=courier size=-1><select name=\"left$current_page\" size=6>$left_select $extra_options</select></td>
+	             <td><table cellpadding=4>
+	          <tr>
+	             <td><a href=\"#\" onClick=\"return moveTable('up','left',$current_page)\"><img src=pics/up width=18 height=15 border=0 alt=\"Up\"></a></td>
+	          </tr>
+	          <tr>
+	             <td><a href=\"#\" onClick=\"return slide('left',$current_page)\"><img src=pics/right width=18 height=15 border=0 alt=\"Right\" hspace=10></a></td>
+	          </tr>
+	          <tr>
+	             <td><a href=\"#\" onClick=\"return moveTable('down','left',$current_page)\"><img src=pics/down width=18 height=15 border=0 alt=Down></a></td>
+	          </tr>
+	       </table></td>
+	    </tr></table></td>
+	        <td bgcolor=#dddddd valign=top align=center width=50%><table border=0 cellpadding=1 cellspacing=0>
+	           <tr>
+	              <td><table cellpadding=4>
+	           <tr>
+	              <td align=right><a href=\"#\" onClick=\"return moveTable('up','right',$current_page)\"><img src=pics/up width=18 height=15 border=0 alt=\"Up\"></a></td>
+	           </tr>
+	           <tr>
+	              <td><a href=\"#\" onClick=\"return slide('right',$current_page)\"><img src=pics/left width=18 height=15 border=0 alt=\"Left\" hspace=10></a></td>
+	           </tr>
+	           <tr>
+	              <td align=right><a href=\"#\" onClick=\"return moveTable('down','right',$current_page)\"><img src=pics/down alt=Down width=18 height=15 border=0></a></td>
+	           </tr>
+	        </table></td>
+	        <td><font face=courier size=-1><select name=\"right$current_page\" size=6>$right_select $extra_options</select></td>
+	        <td><table cellpadding=4>
+	           <tr>
+	              <td><a href=\"#\" onClick=\"return Delete('right',$current_page)\"><img src=pics/x width=18 height=15 border=0 alt=Delete></a></td>
+	           </tr>
+	        </table></td>
+	    </tr>
+	    </table></td>
+	    </tr>
+	    </table></td>
+	    </tr>
+	    </table><br>
+        "
+}
+
+# a list of all tables in the portals you don't already have
+set sql_query "
+select   table_name, pt.table_id 
+from     portal_tables pt
+where    pt.table_id not in (select map.table_id from portal_table_page_map map, portal_pages pp
+where pp.user_id=$user_id and map.page_id=pp.page_id)
+order by table_name" 
+set selection [ns_db select $db $sql_query]
+    
+append page_content "
+	<table width=100% bgcolor=#0000 border=0 cellpadding=0 cellspacing=1><tr><td>
+	    <table bgcolor=#cccccc cellspacing=1 cellpadding=4 width=100% border=0>
+	       <tr>
+	          <td bgcolor=#cccccc>Here are information tables that you don't currently use:</td>
+               </tr>
+               <tr><td width=100% bgcolor=#dddddd align=center><table><tr>
+<td align=right valign=top><table cellpadding=4>
+	           <tr>
+	              <td><a href=\"#\" onClick=\"return addTable('left',$max_page)\"><img src=pics/up width=18 height=15 border=0 alt=\"Up\"></a></td>
+	           </tr>
+	        </table></td>
+<td valign=top><font face=courier size=-1><select name=new size=5>"
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    set table_name [string toupper [ns_adp_parse -string $table_name]]
+
+    append page_content "<option value=$table_id>$table_name</option>\n "
+}
+append page_content "$extra_options</select></td>
+<td align=left valign=top><table cellpadding=4>
+	           <tr>
+	              <td><a href=\"#\" onClick=\"return addTable('right',$max_page)\"><img src=pics/up width=18 height=15 border=0 alt=\"Up\"></a></td>
+	           </tr>
+	        </table></td></tr></table></center></td></tr></table></td></tr></table>
+<p>
+
+<table width=100% border=0 cellpadding=0 cellspacing=0><tr><td>
+Key:<td valign=top align=right>Click here when completed: <input type=submit value=\" FINISHED \" onClick=\"return doSub();\">
+</td></tr></table>
+</form>
+
+<ul>
+<br><img src=pics/x width=18 height=15 border=0> - Delete selected item
+<br><img src=pics/up width=18 height=15 border=0> - Move item up (to previous page if it is already at the top of the current page)
+<br><img src=pics/right width=18 height=15 border=0> - Move item from the left side of the page to the right
+<br><img src=pics/left width=18 height=15 border=0> - Move item from the right side of the page to the left
+<br><img src=pics/down width=18 height=15 border=0> - Move item down (to next page if it is already at the bottom of the current page)"
+
+ns_return 200 text/html $page_content
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/portals/spacer.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/spacer.gif,v
diff -u
Binary files differ
Index: web/openacs/www/portals/stocks-personalize-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/stocks-personalize-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/stocks-personalize-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,29 @@
+# symbols, num_indices (optional) market_index<n>, where num_indices is the number of 
+# market indices we're allowing the user to choose by checkbox on the previous page
+
+set_the_usual_form_variables
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+set stocks_list [split [remove_whitespace $symbols] ","]
+
+ns_db dml $db "delete from portal_stocks where user_id=$user_id"
+
+foreach stock $stocks_list {
+    if {$stock!=""} {
+	ns_db dml $db "insert into portal_stocks (symbol, user_id) values ('$stock', $user_id)" 
+    }
+}
+
+set count 1
+
+while {$count<=$num_indices} {
+    if {[info exists market_index${count}]} {
+	ns_db dml $db "insert into portal_stocks (symbol, user_id, default_p) values ('[set market_index${count}]', $user_id, 't')"
+    }
+    incr count
+}
+
+ns_returnredirect /portals/user$user_id-1.ptl
Index: web/openacs/www/portals/stocks-personalize.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/stocks-personalize.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/stocks-personalize.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,66 @@
+# /portals/stocks-personalize.tcl
+#
+# aileen@mit.edu, randyg@arsdigita.com
+#
+# Jan 2000
+#
+# page to personalize the stock quotes table in the portal
+
+set user_id [ad_verify_and_get_user_id]
+set db [ns_db gethandle]
+
+set selection [ns_db select $db "select symbol from portal_stocks where user_id=$user_id"]
+
+ReturnHeaders
+
+set symbol_list ""
+set count 0
+
+# we're allowing 5 market indices
+set num_indices 5 
+set nasdaq_on ""
+set djia_on ""
+set snp_on ""
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    
+    if {[string compare [string toupper $symbol] IXIC]==0} {
+	set nasdaq_on "checked"
+    } elseif {[string compare [string toupper $symbol] INDU]==0} {
+	set djia_on "checked"
+    } elseif {[string compare [string toupper $symbol] SPX]==0} {
+	set snp_on "checked"
+    } else {    
+	if {$count} {
+	    append symbol_list ","
+	}
+	
+	append symbol_list [string toupper $symbol]
+    }
+    incr count
+}
+
+ns_write "
+[ad_header "Portals @ [ad_system_name]"]
+<h2>Personalize Stock Quotes</h2>
+[ad_context_bar_ws [list /portals/user$user_id-1.ptl "Portal"] "Edit Stock Quotes"]
+<hr>
+<blockquote>
+Your current list of stock symbols: (edit the list by adding/deleting comma-separated stock symbols)
+<p>
+<form method=post action=stocks-personalize-2.tcl>
+[edu_textarea symbols $symbol_list 80 5]
+<p>
+<input type=checkbox name=market_index1 $nasdaq_on value=IXIC>NASDAQ &nbsp;&nbsp;&nbsp;&nbsp;
+<input type=checkbox name=market_index2 $djia_on value=INDU>DJIA &nbsp;&nbsp;&nbsp;&nbsp;
+<input type=checkbox name=market_index3 $snp_on value=SPX>S&P 500
+<p>
+[export_form_vars num_indices]
+<input type=submit value=Edit>
+</form>
+</blockquote>
+[ad_footer]
+"
+
+	
\ No newline at end of file
Index: web/openacs/www/portals/weather-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/weather-delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/weather-delete-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,30 @@
+# /portals/weather-delete-2.tcl
+#
+# page to delete a city from the weather table
+#
+# aileen@arsdigita.com, randyg@arsdigita.com
+#
+# January, 2000
+
+ad_page_variables {
+    weather_id
+    {current_p "t"}
+    {five_day_p "t"}
+    {next_day_p "t"}
+}
+
+validate_integer weather_id $weather_id
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+if {$current_p=="f" && $five_day_p=="f" && $next_day_p=="f"} {    
+    ns_db dml $db "delete from portal_weather where weather_id=$weather_id"
+} else {
+    ns_db dml $db "update portal_weather set current_p='$current_p', five_day_p='$five_day_p', next_day_p='$next_day_p' where weather_id=$weather_id"
+}
+
+ns_returnredirect weather-personalize.tcl
+
+
Index: web/openacs/www/portals/weather-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/weather-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/weather-delete.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,43 @@
+# /portals/weather-delete.tcl
+#
+# page to delete a city from the weather table
+#
+# aileen@arsdigita.com, randyg@arsdigita.com
+#
+# January, 2000
+
+# weather_id
+
+ad_page_variables {weather_id}
+
+validate_integer weather_id $weather_id
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select * from portal_weather where weather_id=$weather_id"]
+
+set_variables_after_query
+
+ReturnHeaders 
+
+ns_write "
+[ad_header "Portals @ [ad_system_name]"]
+<h2>Delete $city, $usps_abbrev</h2>
+[ad_context_bar_ws [list /portals/user$user_id-1.ptl "Portal"] [list /portals/weather-personalize.tcl "Edit Weather"] "Delete a City"]
+<hr>
+You are currently receiving the following weather information about this city. Check the information you wish to <b>remove</b>.
+<p>
+<form method=post action=/portals/weather-delete-2.tcl>
+[ec_decode $current_p "t" "<input type=checkbox name=current_p value=f checked>Current Conditions &nbsp;&nbsp;&nbsp;&nbsp;" "<input type=hidden name=current_p value=f>"]
+[ec_decode $next_day_p "t" "<input type=checkbox name=next_day_p value=f>Next Day Forecast &nbsp;&nbsp;&nbsp;&nbsp;" "<input type=hidden name=next_day_p value=f>"]
+[ec_decode $five_day_p "t" "<input type=checkbox name=five_day_p value=f>Five Day Forecast" "<input type=hidden name=five_day_p value=f>"]
+<p>
+[export_form_vars weather_id]
+<input type=submit value=Continue>
+</form>
+[ad_footer]
+"
+
+
Index: web/openacs/www/portals/weather-personalize-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/weather-personalize-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/weather-personalize-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,86 @@
+###### THIS IS THE VERSION OF WEATHER PERSONALIZE WE SHOULD USE
+###### FOR ACS RELEASES BECAUSE IT DOES NOT USE THE ZIP_CODES TABLE
+
+# /portals/weather-personalize-2.tcl
+#
+# page to personalize cities for portal weather
+#
+# aileen@arsdigita.com, randyg@arsdigita.com
+#
+# January, 2000
+
+# weather_id city, usps_abbrev or zip_code
+# (optional) next_day_p, five_day_p, current_p 
+
+ad_page_variables {
+    weather_id
+    {next_day_p f}
+    {five_day_p f}
+    {current_p f}
+    {city ""}
+    {usps_abbrev ""}
+    {zip_code ""}
+}
+
+validate_integer weather_id $weather_id
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+set exception_count 0
+set exception_text ""
+set by_zip 0
+
+if {[empty_string_p $zip_code]} {
+    if {[empty_string_p $city] || [empty_string_p $usps_abbrev]} {
+	incr exception_count
+	append exception_text "<li>You must enter a zip code or both the city and state."
+    } 
+} else {
+    set by_zip 1
+}
+
+if {$next_day_p=="f" && $five_day_p=="f" && $current_p=="f"} {
+    incr exception_count
+    append exception_text "<li>You must select at least one information type"
+}
+
+if {$exception_count>0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+    
+#### Comment out because we can't release the module with the zip_codes table
+# if {$by_zip} {
+
+if 0 {
+    # returns a list of city and usps_abbrev based on zip_code or empty list
+    # if there's more than one city and redirects to another page for user to
+    # choose city.
+    set selection [ns_db select $db "select state_code, city_name from zip_codes where zip_code=$zip_code"]
+
+    set count 0
+    set city_state_lst [list]
+
+    while {[ns_db getrow $db $selection]} {
+	set_variables_after_query
+	
+	lappend city_state_lst [list $city_name $state_code]
+	incr count
+    }
+    
+    if {$count>1} {
+	set final_url [ns_conn url]?[export_entire_form_as_url_vars]
+	# we're feeding another page to the user because zip_code generated >1 city
+	ns_returnredirect /portals/city-select.tcl?[export_url_vars final_url city_state_lst zip_code]
+	return
+    }
+
+    set city [lindex [lindex $city_state_lst 0] 0]
+    set usps_abbrev [lindex [lindex $city_state_lst 0] 1]
+}
+
+ns_db dml $db "insert into portal_weather (weather_id, user_id, city, usps_abbrev, zip_code, five_day_p, next_day_p, current_p) values ($weather_id, $user_id, '$city', '$usps_abbrev', '$zip_code', '$five_day_p', '$next_day_p', '$current_p')"
+
+ns_returnredirect /portals/weather-personalize.tcl
Index: web/openacs/www/portals/weather-personalize.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/weather-personalize.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/weather-personalize.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,95 @@
+# /portals/weather-personalize.tcl
+#
+# page to personalize cities for portal weather
+#
+# aileen@arsdigita.com, randyg@arsdigita.com
+#
+# January, 2000
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle] 
+
+set selection [ns_db select $db "select * from portal_weather where user_id=$user_id"]
+
+ReturnHeaders
+
+ns_write "
+[ad_header "Portals @ [ad_system_name]"]
+<h2>Personalize Weather Information</h2>
+[ad_context_bar_ws [list /portals/user$user_id-1.ptl "Portal"] "Edit"]
+<hr>
+Your current list of cities:
+<p>
+"
+
+set count 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    
+    if {!$count} {
+	ns_write "
+	<table cellpadding=2>
+	<tr>
+	<th>City</th>
+	<th>State</th>
+	<th>Zip</th>
+	<th>Type</th>
+	</tr>"
+    }
+
+    set type ""
+
+    if {$current_p=="t"} {
+	append type "Current Conditions"
+    } 
+
+    if {$next_day_p=="t"} {
+	if {[string length $type]>0} {
+	    append type ", "
+	}
+
+	append type "Next Day Forecast"
+    } 
+
+    if {$five_day_p=="t"} {
+	if {[string length $type]>0} {
+	    append type ", "
+	}
+
+	append type "Five Day Forecast"
+    }     
+
+    ns_write "
+    <tr>
+    <td align=center>$city</td>
+    <td align=center>$usps_abbrev</td>
+    <td align=center>$zip_code</td>
+    <td align=center>$type</td>
+    <td align=right><a href=weather-delete.tcl?[export_url_vars weather_id]>remove</a></td>
+    </tr>"
+
+    incr count
+}
+
+if {$count} {
+    ns_write "</table>"
+} else {
+    ns_write "
+    You have not customized this portal table. Please add your cities below"
+}
+
+ns_write "
+<p><h3>Add Cities</h3>
+[AddCityWeatherWidget $db]
+[ad_footer]
+"
+
+
+
+
+
+
+
+
Index: web/openacs/www/portals/admin/add-manager-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/admin/add-manager-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/admin/add-manager-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,58 @@
+#
+# /portals/admin/add-manager-2.tcl
+#
+# insert the user as a portal manager
+#
+# by aure@arsdigita.com and dh@arsdigita.com
+#
+# Last modified: 10/8/1999
+#
+# add-manager-2.tcl,v 3.1.2.2 2000/03/17 18:08:06 aure Exp
+#
+
+ad_page_variables {
+	group_id 
+	user_id_from_search
+	first_names_from_search 
+	last_name_from_search
+ 	email_from_search
+} 
+
+validate_integer group_id $group_id
+validate_integer user_id_from_search $user_id_from_search
+
+if {![info exists group_id]} {
+    ns_returnredirect index
+    return
+}
+
+set db [ns_db gethandle]
+set user_id [ad_verify_and_get_user_id]
+portal_check_administrator_maybe_redirect $db $user_id
+
+# check if this person is already an administrator of this group
+set check_result [database_to_tcl_string $db "
+    select 
+case when ad_user_has_role_p ( $user_id_from_search, $group_id, 'administrator' )= 'f' then 0 else 1 end
+from dual"]
+
+if { $check_result == 0 } {
+    ns_db dml $db "
+        insert into user_group_map
+        (user_id, group_id, role, mapping_user, mapping_ip_address)
+        values
+        ($user_id_from_search, $group_id, 'administrator',$user_id, '[ns_conn peeraddr]') "
+}
+
+ns_returnredirect index
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/portals/admin/add-manager.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/admin/add-manager.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/admin/add-manager.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,82 @@
+#
+# /portals/admin/add-manager.tcl
+#
+# standard ACS prompt for email or name of proposed administrator 
+#
+# by aure@arsdigita.com and dh@arsdigita.com
+#
+# Last modified: 10/8/1999
+#
+# add-manager.tcl,v 3.0.4.2 2000/03/17 18:08:06 aure Exp
+#
+
+ad_page_variables {group_id}
+
+validate_integer group_id $group_id
+
+set db [ns_db gethandle]
+
+# -----------------------------------
+# verify user
+set user_id [ad_verify_and_get_user_id]
+
+set group_name [portal_group_name $db $group_id]
+portal_check_administrator_maybe_redirect $db $user_id
+# -----------------------------------
+
+# set variables for user-search.tcl  
+set custom_title "Add Portal Manager for $group_name"
+set passthrough [list group_id]
+
+# set the target for user-search.tcl in a dynamic so that this page
+# can be moved to any server
+regsub "manager" [ns_conn url] "manager-2" target
+
+# ------------------------------------
+# serve the page
+set page_content "
+[portal_admin_header $custom_title]
+
+[ad_context_bar [list /portals/ "Portals"] [list index.tcl "Administration"] "Add Manager"]
+<hr>
+
+<form action=/user-search method=post> 
+[export_form_vars target passthrough group_id custom_title]
+
+Enter either the last name or email of the proposed manager:
+<p>
+<table> 
+<tr>
+    <td align=right>Last name:</td>
+    <td><input type=text name=last_name size=25></td>
+</tr>
+<tr>
+    <td align=right>or Email:</td>
+    <td><input type=text name=email size=25></td>
+</tr>
+<tr>
+    <td></td>
+    <td><input type=submit value=\"Search\"></td>
+</tr>
+</table>
+
+</form>
+
+[portal_admin_footer]"
+
+ns_return 200 text/html $page_content 
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/portals/admin/create-table-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/admin/create-table-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/admin/create-table-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,86 @@
+#
+# /portals/admin/create-table-2.tcl
+#
+# Page that displays the new portal table and prompts the user to confirm
+#
+# by aure@arsdigita.com and dh@arsdigita.com
+#
+# Last modified: 10/8/1999
+#
+# create-table-2.tcl,v 3.0.4.1 2000/03/17 18:08:06 aure Exp
+
+# ad_page_variables {table_name adp group_id admin_url}
+set_the_usual_form_variables 0
+# table_name, adp, maybe group_id, admin_url
+
+set db [ns_db gethandle]
+
+# verify user ---------------------------------
+set user_id [ad_verify_and_get_user_id]
+if  {![info exists group_id]||[empty_string_p $group_id]} { 
+    # user is a super administrator and arrived via index.tcl->create-table.tcl    
+    set group_id ""
+    set context_bar "[ad_context_bar [list /portals/ "Portals"] [list index.tcl "Administration"] [list create-table.tcl "Create Table"] "Preview / Confirm"]"
+} else {
+    # user is not acting as a super administrator
+    set context_bar ""
+}
+
+validate_integer_or_null group_id $group_id
+
+portal_check_administrator_maybe_redirect $db $user_id $group_id
+#---------------------------------------------
+
+# get next table_id (on this page for double-click protection)
+set table_id [database_to_tcl_string $db "select portal_table_id_sequence.nextval from dual"]
+
+# set up contextbar and admin_url display if user is a super administrator
+if {![info exists admin_url]} {
+    set admin_url ""
+} else {
+    set admin_url [string trim $admin_url]
+}
+
+
+if { ![empty_string_p $admin_url] } {
+    set admin_url_display "Administration URL: <a href=\"$admin_url\">$admin_url</a><p>"
+} else {
+    set admin_url_display ""
+}
+
+# --------------------------------------
+# serve the page
+
+# parse the adp
+set shown_adp [portal_adp_parse $adp $db]
+
+# Get generic display information
+portal_display_info
+
+set page_content "
+[portal_admin_header "Preview / Confirm"]
+$context_bar
+<hr>$font_tag
+<center>
+<table><tr><td>
+
+$begin_table
+<tr>
+   $header_td [string toupper [portal_adp_parse $table_name $db]]</td>
+</tr>
+<tr>
+   $normal_td$shown_adp</td>
+</tr>
+$end_table
+</td></tr></table>
+
+<form action=create-table-3.tcl method=post>
+[export_form_vars table_name adp group_id table_id admin_url]
+
+$admin_url_display<p>
+
+<input type=submit value=Create>
+</center>
+[portal_admin_footer]"
+
+ns_return 200 text/html $page_content
Index: web/openacs/www/portals/admin/create-table-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/admin/create-table-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/admin/create-table-3.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,77 @@
+#
+# /portals/admin/create-table-3.tcl
+#
+# inserts into new table information and redirects back to originating page
+#
+# by aure@arsdigita.com and dh@arsdigita.com
+#
+# Last modified: 10/8/1999# edit-table-3.tcl
+#
+# create-table-3.tcl,v 3.0.4.1 2000/03/17 18:08:06 aure Exp
+
+set_the_usual_form_variables
+# table_name, adp, table_id, admin_url
+
+validate_integer table_id $table_id
+
+set db [ns_db gethandle]
+
+# -------------------------------------
+# verify user and set up possible context bar
+set user_id [ad_verify_and_get_user_id]
+
+if  {![info exists group_id] || [empty_string_p $group_id]} {
+    set group_id ""
+    set return_url index
+    set context_bar "[ad_context_bar [list /portals/ "Portals"] [list index.tcl "Administration"] [list create-table.tcl "Create Table"] "Error"]"
+} else {
+    set return_url "manage-portal?group_id=$group_id"
+    set context_bar ""
+}
+portal_check_administrator_maybe_redirect $db $user_id $group_id
+#-------------------------------------
+
+if {![info exists admin_url] || [empty_string_p $admin_url] } {
+    set admin_url_sql_value "NULL"
+} else {
+    set admin_url_sql_value  "'$QQadmin_url'"
+}
+
+
+# --------------------------------------- 
+# disallow table creation if table_name or adp is blank
+if {[empty_string_p [string trim $table_name]] || [empty_string_p [string trim $adp]] } {
+  
+    # get generic display info
+    portal_display_info
+
+    set page_content "
+    [portal_admin_header "Error"]
+    $context_bar
+    <hr>$font_tag
+    Neither table name nor its HTML/ADP may be blank.
+    [portal_admin_footer]"
+    ns_return 200 text/html $page_content 
+    return
+}
+
+
+#----------------------------------------
+# make sure this was not simply a double click
+set check [database_to_tcl_string_or_null $db "select 1 from portal_tables where table_id = $table_id"]
+
+if [empty_string_p $check] {
+    
+    # insert the table
+    ns_db dml $db "
+    insert into portal_tables 
+    (table_id, table_name, adp, creation_user, modified_date, admin_url)
+    values
+    ($table_id, '$QQtable_name', '[DoubleApos $adp]', $user_id, sysdate(), $admin_url_sql_value)"
+}
+
+ns_db releasehandle $db
+
+ns_returnredirect $return_url
+
+
Index: web/openacs/www/portals/admin/create-table.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/admin/create-table.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/admin/create-table.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,98 @@
+#
+# /portals/admin/create-table.tcl
+#
+# first step in creation of a portal table prompting the user for name, html, and an optional administration URL
+#
+# by aure@arsdigita.com and dh@arsdigita.com
+#
+# Last modified: 10/8/1999
+#
+# create-table.tcl,v 3.0.4.1 2000/03/17 18:08:07 aure Exp
+#
+
+# ad_page_variables {group_id ""}
+set_the_usual_form_variables 0 
+# maybe group_id
+
+set db [ns_db gethandle]
+
+# ------------------------------------------
+# verify user and set up the context bar and admin_url field
+set user_id [ad_verify_and_get_user_id]
+
+if  {![info exists group_id]} {
+    # the user came from index.tcl 
+    set group_id ""
+    set context_bar "[ad_context_bar [list /portals/ "Portals"] [list index.tcl "Administration"] "Create Table"]"
+    set admin_url_table_row "<tr><td align=right valign=top>Administration URL (optional)</td>
+    <td width=400><input type=text size=35 name=admin_url><br>
+    You may associate an administration url with this table to which ordinary managers will be redirected.  
+    I.e., they will not be able to edit the ADP.
+    </td></tr>"
+} else {
+    # user is not acting as a super administrator
+    set context_bar ""
+    set admin_url_table_row ""
+}
+
+validate_integer_or_null group_id $group_id
+
+portal_check_administrator_maybe_redirect $db $user_id $group_id
+# ------------------------------------------
+
+# done with the database
+ns_db releasehandle $db
+
+
+# ---------------------------------
+# serve the page
+
+# Get generic display information
+portal_display_info
+
+set page_content "
+[portal_admin_header "Create New Table"]
+$context_bar
+
+<hr>
+
+<form method=POST action=create-table-2>
+[export_form_vars group_id]
+
+<table>
+<tr>
+   <td valign=top align=right>Table Name:</td>
+   <td><textarea rows=2 cols=50 name=table_name></textarea></td>
+</tr>
+<tr>
+  <td valign=top align=right>
+  HTML/ADP:</td><td>
+  <textarea rows=20 cols=70 name=adp></textarea></td>
+</tr>
+$admin_url_table_row
+</table>
+
+<center>
+<p>
+<input type=submit value=Preview>
+</form>
+
+</center>
+
+<blockquote>
+
+Your HTML/ADP will be embedded within an HTML table.  You don't have
+to wrap whatever you type in a TABLE tag.  So, for example, a UL
+followed by a bunch of LI tags would render just fine.  You can rely
+on <code>\$db</code> being set (to a database connection from the main
+pool).
+
+</blockquote>
+
+[portal_admin_footer]
+"
+
+ns_return 200 text/html $page_content
+
+
+
Index: web/openacs/www/portals/admin/delete-manager-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/admin/delete-manager-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/admin/delete-manager-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,55 @@
+#
+# /portals/admin/delete-manager-2.tcl
+#
+# deletes a manager from a portal group
+#
+# by aure@arsdigita.com and dh@arsdigita.com
+#
+# Last modified: 10/8/1999
+#
+# delete-manager-2.tcl,v 3.0.4.1 2000/03/17 18:08:07 aure Exp
+#
+
+ad_page_variables {group_id admin_id}
+
+if {![info exists group_id] || ![info exists admin_id]} {
+    ns_returnredirect index
+    return
+}
+
+validate_integer group_id $group_id
+validate_integer admin_id $admin_id
+
+set db [ns_db gethandle]
+
+# ---------------------------------
+# verify user
+
+set user_id [ad_verify_and_get_user_id]
+portal_check_administrator_maybe_redirect $db $user_id
+
+# ---------------------------------
+
+# delete the manager
+ns_db dml $db "
+    delete from user_group_map
+    where  user_id = $admin_id
+    and    group_id = $group_id
+    and    role = 'administrator'"
+
+ns_returnredirect index
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/portals/admin/delete-manager.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/admin/delete-manager.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/admin/delete-manager.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,67 @@
+#
+# /portals/admin/delete-manager.tcl
+#
+# list of managers that may be delete from the list of portal managers for the group
+#
+# by aure@arsdigita.com and dh@arsdigita.com
+#
+# Last modified: 10/8/1999
+#
+# delete-manager.tcl,v 3.1.2.1 2000/03/17 18:08:07 aure Exp
+#
+
+ad_page_variables {group_id}
+
+validate_integer group_id $group_id
+
+set db [ns_db gethandle]
+
+# -------------------------------------------
+# verify user
+set user_id [ad_verify_and_get_user_id]
+
+if {![info exists group_id]} {
+    ns_returnredirect index
+    return
+}
+set group_name [portal_group_name $db $group_id]
+portal_check_administrator_maybe_redirect $db $user_id
+# ------------------------------------------
+
+set administrator_list [database_to_tcl_list_list $db "
+    select  user_id, first_names, last_name
+    from    users
+    where   ad_group_member_p ( user_id, $group_id ) = 't'
+    order by last_name"]
+
+set admin_list "Choose Manager to delete:<ul>"
+set admin_count 0
+foreach administrator $administrator_list {
+    set name "[lindex $administrator 1] [lindex $administrator 2]"
+    set person_id [lindex $administrator 0]
+    set admin_id  $person_id
+    append admin_list "\n<li><a href=delete-manager-2?[export_url_vars group_id admin_id]>$name</a>"
+    incr admin_count
+}
+
+if { $admin_count == 0 } { 
+    set admin_list "There are currently no administrators of this portal group."
+}
+
+# ------------------------------------
+# serve the page
+
+set page_content "
+[portal_admin_header "Delete Administrator of [string toupper $group_name]"]
+
+[ad_context_bar [list /portals/ "Portals"] [list index "Administration"] "Delete Manager"]
+<hr>
+
+$admin_list
+</ul>
+[portal_admin_footer]"
+
+ns_return 200 text/html $page_content
+
+
+
Index: web/openacs/www/portals/admin/delete-table-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/admin/delete-table-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/admin/delete-table-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,36 @@
+#
+# /portals/admin/delete-table-2.tcl
+#
+# deletes portal table from each portal page it appears on and from the available tables
+#
+# by aure@arsdigita.com and dh@arsdigita.com
+#
+# Last modified: 10/8/1999
+#
+# delete-table-2.tcl,v 3.0.4.1 2000/03/17 18:08:07 aure Exp
+
+#ad_page_variables {table_id}
+set_the_usual_form_variables
+# table_id
+
+validate_integer table_id $table_id
+
+set db [ns_db gethandle]
+
+# -------------------------------
+# verify the user
+set user_id [ad_verify_and_get_user_id]
+
+if  {![info exists group_id]} {
+    set group_id ""
+}
+portal_check_administrator_maybe_redirect $db $user_id $group_id
+# -------------------------------
+
+ns_db dml $db  "begin transaction"
+ns_db dml $db  "delete from portal_table_page_map where table_id = $table_id"
+ns_db dml $db  "delete from portal_tables where table_id = $table_id"
+ns_db dml $db  "end transaction"
+
+ns_returnredirect index
+
Index: web/openacs/www/portals/admin/delete-table.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/admin/delete-table.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/admin/delete-table.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,78 @@
+#
+# /portals/admin/delete-table.tcl
+#
+# Page that displays the portal table and prompts the user to confirm the delete
+#
+# by aure@arsdigita.com and dh@arsdigita.com
+#
+# Last modified: 10/8/1999
+#
+# delete-table.tcl,v 3.0.4.1 2000/03/17 18:08:07 aure Exp
+
+# ad_page_variables {table_id}
+set_the_usual_form_variables
+# table_id
+
+validate_integer table_id $table_id
+
+set db [ns_db gethandle]
+
+# ---------------------------------
+# verify the user
+set user_id [ad_verify_and_get_user_id]
+
+if  {![info exists group_id]} {
+    set group_id ""
+}
+portal_check_administrator_maybe_redirect $db $user_id $group_id
+# ---------------------------------
+
+# get table_name and adp of the proposed table to delete
+set selection [ns_db 1row $db "select table_name, adp from portal_tables where table_id=$table_id"]
+set_variables_after_query
+
+# count the number of portal pages the table is currently displayed on
+set pages_displayed_on [database_to_tcl_string $db "select count(*) from portal_table_page_map where table_id=$table_id"]
+
+if { $pages_displayed_on > 0 } {
+    set warning_text "This table is being displayed on $pages_displayed_on portal pages, are you sure you want to delete it from everywhere it appears?<p>"
+} else {
+    set warning_text "This table doesn't appear on any portal pages on this system, it looks safe to delete."
+}
+
+
+# -----------------------------------
+# serve the page
+
+# parse the adp
+set shown_adp [portal_adp_parse $adp $db]
+
+# Get generic display information
+portal_display_info
+
+set page_content "
+[portal_admin_header "Confirm Delete"]
+[ad_context_bar [list /portals/ "Portals"] [list index.tcl "Administration"] "Delete"]
+<hr>
+$warning_text
+<table><tr><td>
+
+$begin_table
+<tr>
+   $header_td [string toupper [portal_adp_parse $table_name $db]]</td>
+</tr>
+<tr>
+   $normal_td$adp</td>
+</tr>
+$end_table
+
+<form action=delete-table-2 method=post>
+[export_form_vars table_id]
+<center>
+<input type=submit value=\"Confirm Delete\">
+
+</td></tr></table>
+
+[portal_admin_footer]"
+
+ns_return 200 text/html $page_content
Index: web/openacs/www/portals/admin/edit-table-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/admin/edit-table-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/admin/edit-table-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,99 @@
+# /portals/admin/edit-table-2.tcl
+#
+# Page that displays the edited portal table and prompts the user to confirm the changes
+#
+# by aure@arsdigita.com and dh@arsdigita.com
+#
+# Last modified: 10/8/1999
+#
+# edit-table-2.tcl,v 3.0.4.1 2000/03/17 18:08:07 aure Exp
+
+#ad_page_variables {table_name adp table_id group_id admin_url}
+set_the_usual_form_variables
+# table_name, adp, table_id, group_id, admin_url
+
+validate_integer table_id $table_id
+validate_integer group_id $group_id
+
+set db [ns_db gethandle]
+
+# -----------------------------------------------
+# verify user
+set user_id [ad_verify_and_get_user_id]
+
+if  {![info exists group_id]||[empty_string_p $group_id]} {
+    # user is a super administrator and arrived via index.tcl->edit-table.tcl
+    set group_id ""
+    set context_bar "[ad_context_bar [list /portals/ "Portals"] [list index.tcl "Administration"] [list edit-table.tcl?table_id=$table_id "Edit Table"] "Preview / Confirm"]"
+    set super_p 1
+} else {
+    # we arrived from a given portal and are in pop-up
+    set context_bar ""
+    set super_p 0
+}
+
+portal_check_administrator_maybe_redirect $db $user_id $group_id
+#-------------------------------------------------
+
+# show window-will-close warning if the page is in a pop-up window
+if  {$super_p == 0} {
+    set close_window_warning "<br>(this will close this window)"
+} else {
+    set close_window_warning ""
+}
+
+# admin_url display
+if {![info exists admin_url] || [empty_string_p $admin_url]} {
+    set admin_url ""
+    set admin_url_display "<tr><td>Associated URL:</td><td>None</td></tr>"
+} else {
+    set admin_url [string trim $admin_url]
+    set admin_url_display "<tr><td>Associated URL:</td><td><a href=\"$admin_url\">$admin_url</a></td></tr>"
+}
+
+# ------------------------------------------
+# serve the page
+   
+# Get generic display information
+portal_display_info
+
+# parse adp
+set shown_adp [portal_adp_parse $adp $db]
+
+ns_return 200 text/html "
+[portal_admin_header "Preview / Confirm"]
+$context_bar
+<hr>
+<center>
+
+<table>
+<tr>
+<td valign=top>New Version:</td>
+<td>
+ <table>
+  <tr><td>$begin_table
+      <tr>$header_td [string toupper [portal_adp_parse $table_name $db]]</td></tr>
+      <tr>$normal_td$shown_adp</td></tr>
+      $end_table
+  </td></tr>
+ </table>
+</td>
+</tr>
+</table>
+<table>
+
+$admin_url_display
+
+</table>
+
+<form action=edit-table-3.tcl method=post>
+[export_form_vars table_name adp group_id table_id admin_url]
+
+<input type=submit value=\"Confirm Edit\">
+$close_window_warning
+</form>
+</center>
+[portal_admin_footer]"
+
+
+
Index: web/openacs/www/portals/admin/edit-table-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/admin/edit-table-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/admin/edit-table-3.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,100 @@
+#
+# /portals/admin/edit-table-3.tcl
+#
+# updates the database with edited table information and redirects back to originating page
+#
+# by aure@arsdigita.com and dh@arsdigita.com
+#
+# Last modified: 10/8/1999# edit-table-3.tcl
+#
+# edit-table-3.tcl,v 3.0.4.1 2000/03/17 18:08:08 aure Exp
+
+set_the_usual_form_variables
+# table_name, adp, table_id, maybe group_id, admin_url
+
+validate_integer table_id $table_id
+
+set db [ns_db gethandle]
+
+# -------------------------------------
+# verify user and set up possible context bar
+set user_id [ad_verify_and_get_user_id]
+
+if  {![info exists group_id] || [empty_string_p $group_id]} {
+    set group_id ""
+    set return_url index.tcl
+    set context_bar "[ad_context_bar [list /portals/ "Portals"] [list index.tcl "Administration"] [list edit-table.tcl?table_id=$table_id "Edit Table"] "Error"]"
+} else {
+    set context_bar ""
+}
+
+validate_integer_or_null group_id $group_id
+
+portal_check_administrator_maybe_redirect $db $user_id $group_id
+#-------------------------------------
+
+if {![info exists admin_url] || [empty_string_p $admin_url]} {
+    set admin_url_sql "admin_url = null"
+} else {
+    set admin_url_sql "admin_url = '$QQadmin_url'"
+}
+
+# --------------------------------------- 
+# disallow table creation if table_name or adp is blank
+if {[empty_string_p [string trim $table_name]] || [empty_string_p [string trim $adp]] } {
+  
+    # get generic display info
+    portal_display_info
+
+    ns_return 200 text/html "
+    [portal_admin_header "Error"]
+    $context_bar
+    <hr>$font_tag
+    Neither table name nor its HTML/ADP may be blank.
+    [portal_admin_footer]"
+    
+    return
+}
+#----------------------------------------
+
+# update table data
+ns_db dml $db "
+update portal_tables
+set table_name = '$QQtable_name',
+    adp = '$QQadp',
+    creation_user = $user_id,
+    modified_date = sysdate(),
+    $admin_url_sql
+where table_id = $table_id"
+
+# Force Memoize of pages with this table, done with foreach since the dbhandle must be released
+
+set group_list [database_to_tcl_list_list $db  "
+select page_number, group_id
+from portal_table_page_map map, portal_pages p
+where table_id=$table_id 
+and map.page_id=p.page_id
+and group_id is not null"]
+
+ns_db releasehandle $db
+
+foreach pair $group_list {
+    set page_number [lindex $pair 0]
+    set new_group_id [lindex $pair 1]
+    util_memoize_flush "portal_display_page $new_group_id $page_number group"
+    util_memoize "portal_display_page $new_group_id $page_number group"
+}
+
+# redirect user 
+if  {![empty_string_p $group_id]} {
+    ns_return 200 text/html "<script>
+    <!--
+    self.window.close()
+    //-->
+    </script>"
+} else {
+    ns_returnredirect index.tcl
+}
+
+
+
Index: web/openacs/www/portals/admin/edit-table.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/admin/edit-table.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/admin/edit-table.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,146 @@
+#
+# /portals/admin/edit-table.tcl
+#
+# Page that displays the portal table and allows an administrator to edit the contents, either
+# by allowing direct editing of the ADP or by redirecting the administrator to an associated
+# administration page
+#
+# by aure@arsdigita.com and dh@arsdigita.com
+#
+# Last modified: 10/8/1999
+#
+# edit-table.tcl,v 3.0.4.1 2000/03/17 18:08:08 aure Exp
+
+#ad_page_variables {table_id [group_id ""]}
+set_the_usual_form_variables
+# table_id, maybe group_id
+
+validate_integer table_id $table_id
+
+set db [ns_db gethandle]
+
+# ---------------------------------
+# verify user
+
+set user_id [ad_verify_and_get_user_id]
+
+if  {![info exists group_id] || [empty_string_p $group_id]} {
+    # the user came from index.tcl 
+    set group_id ""
+    set context_bar "[ad_context_bar [list /portals/ "Portals"] [list index.tcl "Administration"] "Edit Table" ]"
+    set super_p 1
+} else {
+    # user arrived from a given portal and are in pop-up window
+    set context_bar ""
+    set super_p 0
+}
+
+validate_integer_or_null group_id $group_id
+
+portal_check_administrator_maybe_redirect $db $user_id $group_id
+
+#----------------------------------
+
+
+# Get generic display information
+portal_display_info
+
+# get the current version of the portal table (table_name, adp, admin_url)
+
+set selection [ns_db 1row $db "select table_name, adp, admin_url from portal_tables where table_id = $table_id"]
+set_variables_after_query
+
+# ------------------------------------------------
+
+# If this portal table has an associated admin_url, send the ordinary
+# portal administrators to it.
+
+if {![empty_string_p $admin_url] && $super_p==0 } {
+
+    # redirect the non-superadmin to the admin_url
+    ns_returnredirect $admin_url?[export_url_vars group_id]
+    return
+
+} elseif {![empty_string_p $admin_url] && $super_p==1} {
+
+    # setup interface to allow Super Admin to edit the admin_url
+    set admin_url_description "<ul>An ordinary administrator is not allowed to edit this portal table, instead he is redirected to the associated url to perform administration tasks.</ul> <P>"
+    set admin_url_display_row "<tr><td>Associated URL:</td><td><a href=$admin_url>$admin_url</a></td></tr>"
+    set admin_url_edit_row "<tr><td>Associated URL:</td><td><input type=textare name=\"admin_url\" value=\"[philg_quote_double_quotes $admin_url]\" size=35></td></tr>"
+
+} elseif {[empty_string_p $admin_url] && $super_p==1 } {
+
+    # setup interface to allow Super Admin to create the admin_url
+    set admin_url_description "<ul>An ordinary administrator is currently allowed to edit this portal table.  If you want him to be redirected to an associated url instead, you may create one.</ul><p>" 
+    set admin_url_display_row "<tr><td>Associated URL:</td><td>None</td></tr>"
+    set admin_url_edit_row "<tr><td>Associated URL:</td><td><input type=textarea name=\"admin_url\" size=35></td></tr>"
+
+} else {
+    
+    # the user isn't a super admin and there is no admin_url
+    set admin_url_description ""
+    set admin_url_display_row ""
+    set admin_url_edit_row ""
+}
+
+# ---------------------------------------------------
+# serve the page
+
+# parse adp
+if [catch { set shown_adp [portal_adp_parse $adp $db] } errmsg] {
+    set shown_adp "Error evaluating ADP:  $errmsg"
+}
+
+set page_content "
+[portal_admin_header "Edit [portal_adp_parse $table_name $db]"]
+$context_bar
+<hr>
+
+$admin_url_description
+
+<center>
+<table><tr><td valign=top>Current Version:</td><td>
+<table><tr><td>
+$begin_table
+<tr>
+   $header_td [string toupper [portal_adp_parse $table_name $db]]</td>
+</tr>
+<tr>
+   $normal_td$shown_adp</td>
+</tr>
+$end_table
+</td></tr></table>
+</td></tr>
+
+$admin_url_display_row
+
+</table><tr><td colspan=2><hr></td></tr><table>
+<form method=POST action=edit-table-2>
+[export_form_vars table_id group_id]
+
+<tr>
+   <td valign=top>Table Name:</td>
+   <td><textarea rows=2 cols=50 wrap name=table_name>[ns_quotehtml $table_name]</textarea></td>
+</tr>
+<tr>
+<td valign=top>
+HTML/ADP:</td><td>
+<textarea rows=20 cols=70 name=adp>[ns_quotehtml $adp]</textarea></td></tr>
+$admin_url_edit_row
+<tr><td colspan=2>
+<center>
+<p>
+<input type=submit value=Preview></font>
+</td>
+</tr>
+
+</table>
+</center>
+
+</form>
+[portal_admin_footer]"
+
+ns_return 200 text/html $page_content
+
+
+
Index: web/openacs/www/portals/admin/index-manager.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/admin/index-manager.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/admin/index-manager.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,83 @@
+#
+# /portals/admin/index-manager.tcl
+#
+# Shows managers of serveral portals a list of their options
+#
+# by aure@arsdigita.com and dh@arsdigita.com
+#
+# Last modified: 10/8/1999
+#
+# index-manager.tcl,v 3.2 2000/03/12 07:39:28 aure Exp
+#
+
+set db [ns_db gethandle]
+set user_id [ad_verify_and_get_user_id]
+
+# get all the group_ids where this user_id is an administrator of a portal group
+
+set group_list_sql "select distinct group_id, group_name"
+
+#DRB: I removed a bogus order by on this clause, which PG correctly
+#bitches about.
+
+set group_list_clause "
+    from    user_groups
+    where   ad_user_has_role_p ( $user_id, group_id, 'administrator' ) = 't'
+    and     group_type = 'portal_group'"
+
+set number_of_groups [database_to_tcl_string $db "select count(*) $group_list_clause"]
+
+# if not an administrator then bounce to the regular index.tcl
+if {$number_of_groups ==0 } {
+    ns_returnredirect [ad_parameter MainPublicURL portals]
+    return
+}
+
+# if only administrator of one portal, set the group_id and redirect to the administration page
+if {$number_of_groups==1} {
+    set group_id [database_to_tcl_string $db "select user_groups.group_id $group_list_clause"]
+    ns_returnredirect manage-portal?[export_url_vars group_id]
+    return
+}
+
+# if user_id is administrator of many groups - let the person choose the page to admin
+if {$number_of_groups > 1 } {
+    set output_html "Choose the group which you want to manage:<br>"
+    set selection [ns_db select $db "$group_list_sql $group_list_clause"]
+    set group_list ""
+    while { [ns_db getrow $db $selection] } {
+	set_variables_after_query
+	append group_list "<li> <a href=manage-portal?[export_url_vars group_id ]>$group_name</a>"
+    }
+} 
+
+# done with the database
+ns_db releasehandle $db
+
+# ------------------------------------------------
+# serve the page
+
+# Get generic display information
+portal_display_info
+
+set page_content "
+[portal_admin_header "[ad_parameter SystemName portals] Management"]
+<hr>
+
+You are manager of more than one portal group, please choose one:
+<ul>
+$group_list
+</ul>
+[portal_admin_footer]"
+
+ns_return 200 text/html $page_content
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/portals/admin/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/admin/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/admin/index.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,170 @@
+#
+# /portals/admin/index.tcl
+#
+# Main index paage for the portals administration pages, which will redirect non-super-administrators
+# to index-manager.tcl
+#
+# by aure@arsdigita.com and dh@arsdigita.com
+#
+# Last modified: 10/8/1999
+#
+# index.tcl,v 3.2.2.1 2000/03/17 18:08:08 aure Exp
+#
+
+set db [ns_db gethandle]
+
+# Verify user
+set user_id [ad_verify_and_get_user_id]
+portal_check_administrator_maybe_redirect $db $user_id "" index-manager
+
+# ---------------------------------------------------------------
+
+# Get generic display information
+portal_display_info
+
+# Create a display of portals and their administrators 
+
+set group_id_list [database_to_tcl_list $db "
+    select group_id 
+    from   user_groups 
+    where  group_type = 'portal_group' 
+    order by group_name"]
+
+set portal_table ""
+
+foreach group_id $group_id_list {
+
+    # get the name of the portal group
+    set group_name [database_to_tcl_string $db "
+        select group_name from user_groups where group_id=$group_id"]
+
+    # get a list of all authorized administrators
+    set admin_list [database_to_tcl_list $db "
+        select first_names||' '||last_name as name 
+        from   users
+        where  ad_group_member_p ( user_id, $group_id ) = 't'"]
+    
+    # special case for super administrators  - they have no portal page and a super administrator
+    # may or may not be able to edit the list of super administrators
+    if {$group_name != "Super Administrators"} {
+	set link "<a href=manage-portal?[export_url_vars group_id]>$group_name</a>"
+	set add_remove_link "<a href=add-manager?[export_url_vars group_id]>Add</a> / 
+	<a href=delete-manager?[export_url_vars group_id]>Remove</a>"
+    } else {
+	set link $group_name
+	if {[ad_parameter SuperAdminCanChangeSuperAdminP portals]} {
+	    set add_remove_link "<a href=add-manager?[export_url_vars group_id]>Add</a> / 
+	    <a href=delete-manager?[export_url_vars group_id]>Remove</a>"
+	} else {
+	    set add_remove_link "&nbsp;"
+	}
+    }
+
+    append portal_table "
+    <tr>
+       $normal_td $link</td>
+       $normal_td [join $admin_list ", "] &nbsp;</td> 
+       $normal_td $add_remove_link </td>
+    </tr>"
+} 
+
+
+# ------------------------------------------------------------
+
+# show a list of all tables in the portals
+
+#set table_list [database_to_tcl_list_list $db "
+#    select   pt.table_name, pt.table_id, count(map.table_id)
+#    from     portal_tables pt, portal_table_page_map map
+#    where    pt.table_id = map.table_id(+)
+#    group by pt.table_name, pt.table_id
+#    order by pt.table_name"]
+
+set table_list [database_to_tcl_list_list $db "
+    select pt.table_name, pt.table_id, count_tables(pt.table_id)
+    from portal_tables pt
+    group by pt.table_name, pt.table_id
+    order by pt.table_name"]
+
+set counter 0
+set table_table "" 
+
+# using foreach since its possible that a table_name is an adp with db calls
+foreach table_set $table_list {
+    set table_name [lindex $table_set 0]
+    set table_id [lindex $table_set 1]
+    set count [lindex $table_set 2]
+
+    append table_table "
+        <tr>
+        $normal_td [string toupper [portal_adp_parse $table_name $db]] ($count)</td>
+        $normal_td<a href=edit-table?[export_url_vars table_id]>Edit</a> /
+        <a href=delete-table?[export_url_vars table_id]>Delete</a> / 
+        <a href=restore?[export_url_vars table_id]>Restore</a></td> 
+        </tr>"
+    incr counter
+}
+
+if { $counter == 0 } {
+    set table_table "<tr><td>There are no html tables in the database.</td></tr>" 
+}
+
+# ---------------------------------------------------------
+# serve the page
+
+set page_content  "
+[portal_admin_header "[ad_parameter SystemName portals] Administration"]
+
+[ad_context_bar [list /portals/ "Portals"] "Administration"]
+$font_tag
+<hr>
+<table>
+<tr>
+<td>
+Choose a group to manage or the edit the administration assignments. 
+<p>
+$begin_table
+<tr>
+$header_td GROUP</td>
+$header_td ADMINISTRATORS </td>
+$header_td </td>
+</tr>
+$portal_table 
+$end_table
+<p>
+<a href=create-table>Create a new table</a> or select one of the following portal elements to edit, delete or restore a previous version:
+<p>
+
+$begin_table
+<tr>
+$header_td ACTIVE TABLES (# OF APPEARANCES)</td>
+$header_td ACTIONS</td>
+</tr>
+$table_table
+$end_table
+<p>
+<a href=view-deleted>View deleted tables</a> and optionally restore them.
+
+</td>
+</tr>
+</table>
+
+[portal_admin_footer]"
+
+ns_return 200 text/html $page_content
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/portals/admin/manage-portal-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/admin/manage-portal-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/admin/manage-portal-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,212 @@
+#
+# /portals/admin/manage-portal-2.tcl
+#
+# Updates the portal table page map given all of the users changes on manage-portal.tcl's GUI
+#
+# by aure@arsdigita.com and dh@arsdigita.com
+#
+# Last modified: 10/8/1999
+#
+# manage-portal-2.tcl,v 3.0.4.1 2000/03/17 18:08:09 aure Exp
+#
+
+#ad_page_variables {left right group_id}
+set_the_usual_form_variables
+# left, right, group_id
+
+validate_integer group_id $group_id
+
+set db [ns_db gethandle]
+
+# -------------------------------------------
+# verify user
+set user_id [ad_verify_and_get_user_id]
+portal_check_administrator_maybe_redirect $db  $user_id $group_id
+# -------------------------------------------
+
+# good list is the list of table, page pairs on this group's portal pages after update
+set good_list ""
+# page_list is the resulting page_id's of pages having tables after update
+set page_list ""
+
+ns_db dml $db "begin transaction"
+
+# loop over each side of each page left then right and update portal table page map accordingly
+
+set i 0
+foreach left_list $left {
+    # We know that left and right each have one list per page.
+    set right_list [lindex $right $i]
+    
+    incr i
+
+    # Get page_id for page $i
+    set page_id [database_to_tcl_string_or_null $db "
+        select page_id 
+        from  portal_pages
+        where group_id = $group_id
+        and   page_number = $i"]
+
+    if {[empty_string_p $page_id] } {
+	# the page is not already in the database
+	
+	if { [ llength $right_list] > 0  || [ llength $left_list ] > 0 } {
+	    # Stuff is being moved onto this new page - create an entry for it in the database
+ 
+	    set page_id [database_to_tcl_string $db  "select portal_page_id_sequence.nextval from dual"]
+
+	    ns_db dml $db "
+   	        insert into portal_pages
+	        (page_id, group_id, page_number, page_name)
+	        values
+	        ($page_id, $group_id, $i, '[DoubleApos [lindex $hiddennames [expr $i-1]]]')"
+
+	}
+    } 
+
+    if {![empty_string_p $page_id]} {
+	# The page exists in the database
+
+	# Update the name of the pre-existing page
+	ns_db dml $db "
+	    update portal_pages
+	    set    page_name = '[DoubleApos [lindex $hiddennames [expr $i-1]]]'
+	    where  group_id = $group_id
+	    and    page_id = $page_id"
+
+	lappend page_list $page_id
+
+	# do the left side
+	set sort_key 0
+	foreach table_id $left_list {
+	   
+	    incr sort_key
+	    lappend good_list [list $page_id $table_id]
+	    
+	    # Get original_page_id for this table 
+	    set original_page_id [database_to_tcl_string_or_null $db "
+	        select p.page_id 
+	        from   portal_pages p, portal_table_page_map m
+	        where  group_id = $group_id
+	        and    table_id  = $table_id
+	        and    m.page_id = p.page_id"]
+	    
+	    if {[empty_string_p $original_page_id]} {
+		ns_db dml $db "
+		    insert into portal_table_page_map
+		    (table_id, page_id, sort_key, page_side)
+		    values
+		    ($table_id, $page_id, $sort_key, 'l')"
+	    } else {
+		# Move this table
+		ns_db dml $db "
+		    update portal_table_page_map
+		    set    page_id = $page_id,
+		           sort_key = $sort_key,
+		           page_side = 'l'
+	   	    where  table_id = $table_id
+		    and    page_id = $original_page_id"
+	    }
+	}
+	
+	# do the right side
+	set sort_key 0
+	foreach table_id $right_list {
+
+	    incr sort_key
+	    lappend good_list [list $page_id $table_id]
+
+	     # Get original_page_id for this table
+	    
+	    set original_page_id [database_to_tcl_string_or_null $db "
+	        select p.page_id 
+	        from portal_pages p, portal_table_page_map m
+	        where group_id = $group_id
+	        and   table_id  = $table_id
+	        and   m.page_id = p.page_id"]
+
+	    if {[empty_string_p $original_page_id]} {
+		ns_db dml $db "
+		    insert into portal_table_page_map
+		    (table_id, page_id, sort_key, page_side)
+		    values
+		    ($table_id, $page_id, $sort_key, 'r')"
+	    } else {
+		ns_db dml $db "
+		    update portal_table_page_map
+		    set    page_id = $page_id,
+		           sort_key = $sort_key,
+		           page_side = 'r'
+		    where  table_id = $table_id
+		    and    page_id = $original_page_id"
+	    }
+	}
+    }
+}    
+
+# DRB: I moved this in front of the two following delete statements for a reason.
+# Due to the fact that the bleeping education module stuffs rows into new portal
+# pages behind our backs, PG won't allow the delete because it breaks checking
+# for referential integrity.  Does this suck or what?  
+
+ns_db dml $db "end transaction"
+
+if {[empty_string_p $good_list] && ![empty_string_p $page_list] } {
+    # delete all tables
+    ns_db dml $db "delete from portal_table_page_map where page_id in ([join $page_list ,])"
+} elseif {![empty_string_p $good_list]} {
+    # delete tables that didn't appear in our list (hence they were javascript-deleted)
+    set sep ""
+    foreach table $good_list {
+        append select_clause "$sep (table_id = [lindex $table 1]
+            and page_id = [lindex $table 0])"
+        set sep " or "
+    }
+    ns_db dml $db "
+        delete from portal_table_page_map
+        where not ( $select_clause )"
+   ns_log "Notice" "[ns_pg ntuples $db]"
+}
+
+# remove orphaned pages with no tables on them
+ns_db dml $db "delete from portal_pages where page_id not in (select page_id from portal_table_page_map)"
+
+# ----------------------------------------------------------------------------------
+# get all the page_ids for pages with stuff and flush memoization for them
+
+set page_id_list [database_to_tcl_list $db "
+    select pp.page_id 
+    from   portal_pages pp
+    where  pp.group_id = $group_id
+    and    pp.page_id in (select pm.page_id from portal_table_page_map pm)   
+    order by page_number"]
+
+set new_page_number 0
+foreach page_id $page_id_list {
+    incr new_page_number
+    ns_db dml $db "
+        update portal_pages
+        set page_number = $new_page_number
+        where page_id = $page_id "
+}
+
+set page_list [database_to_tcl_list $db  "
+    select page_number 
+    from portal_pages 
+    where group_id = $group_id"] 
+
+ns_db releasehandle $db
+
+foreach page_number $page_list {
+    util_memoize_flush "portal_display_page $group_id $page_number group"
+}
+
+ns_returnredirect manage-portal?group_id=$group_id
+
+
+
+
+
+
+
+
Index: web/openacs/www/portals/admin/manage-portal.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/admin/manage-portal.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/admin/manage-portal.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,239 @@
+#
+# /portals/admin/manage-portal.tcl
+#
+# GUI that facilitates page layout
+#
+# by aure@arsdigita.com and dh@arsdigita.com
+#
+# Last modified: 10/8/1999
+#
+# manage-portal.tcl,v 3.0.4.1 2000/03/17 18:08:10 aure Exp
+#
+
+#ad_page_variables {group_id}
+set_the_usual_form_variables
+# group_id 
+
+validate_integer group_id $group_id
+
+set db [ns_db gethandle]
+
+# ---------------------------------------
+# verify user
+
+set user_id [ad_verify_and_get_user_id]
+portal_check_administrator_maybe_redirect $db $user_id $group_id 
+
+#----------------------------------------
+
+
+# set up group specific name
+set group_name [portal_group_name $db $group_id]
+
+set title "[ad_parameter SystemName portals] Administration for $group_name"
+
+
+# Get generic display information
+portal_display_info
+
+# get number of existing pages +1
+set max_page [database_to_tcl_string $db "
+    select max(page_number)+1 from portal_pages
+    where  group_id = $group_id"]
+
+if {[empty_string_p $max_page]} {
+    set max_page 1
+}
+
+set total [database_to_tcl_string $db "select count(*) from portal_tables"]
+
+set page_content "
+<html>
+<head>
+<title>Personalize Page Layout</title>
+<script src=../manage-portal-js.tcl?[export_url_vars max_page group_id total]></script>
+</head>
+$body_tag $font_tag
+<h2>[ad_parameter SystemName portals] Administration for $group_name</h2>
+<form action=manage-portal-2 method=get name=theForm>
+[export_form_vars group_id]
+<input type=hidden name=\"left\" value=\"\" >
+<input type=hidden name=\"right\" value=\"\">
+<input type=hidden name=\"hiddennames\" value=\"\">
+<table width=100% border=0 cellpadding=0 cellspacing=0><tr><td>This page enables you to manage current <br>content, you may <a href=create-table?[export_url_vars group_id]>create a new table</a>.</td><td valign=bottom align=right>Click here when completed: <input type=submit value=\" FINISHED \" onClick=\"return doSub();\">
+</td></tr></table><p>"
+
+
+set n_longest 30
+
+set spaces ""
+
+for {set i 0} {$i <=  $n_longest} {incr i} {
+    append spaces "&nbsp;"
+}
+
+set x 0
+set extra_options ""
+while {$x <= $total} {
+    if { $x == 0 } {
+	append extra_options "<option value=\"null\">$spaces</option>\n"
+    } else {
+	append extra_options "<option value=\"null\">&nbsp;</option>\n"
+    }
+    incr x
+}
+
+for {set current_page 1} {$current_page <= $max_page} {incr current_page} {
+
+    set selection [ns_db select $db  "
+    select    table_name, page_number, page_side, map.table_id, page_name
+    from      portal_table_page_map map, portal_tables p_t, portal_pages p_p
+    where     group_id = $group_id
+    and       map.page_id = p_p.page_id
+    and       map.table_id = p_t.table_id
+    and       page_number = $current_page
+    order by  page_side, sort_key"]
+
+    set left_select ""
+    set right_select ""
+    set page_name ""
+
+    while { [ns_db getrow $db $selection] } {
+	set_variables_after_query
+
+	set table_name [string range [string toupper [portal_adp_parse $table_name $db]] 0 31]
+
+	if {$page_side == "l"} {
+	    append left_select "<option value=\"$table_id\">$table_name</option>\n"
+	} else {
+	    append right_select "<option value=\"$table_id\">$table_name</option>\n"
+	}
+    }
+    regsub -all { } [string tolower $group_name] {-} lower_group_name
+
+    if {$current_page != $max_page} {
+	set right_link "<td align=right>(<a target=_new href=/portals/$lower_group_name-$current_page.ptl>current version</a>)</td>"
+    } else {
+	set right_link "<td align=right>(a new page if needed)</td>"
+    }
+	    
+    append page_content "
+	<table width=100% bgcolor=#0000 border=0 cellpadding=0 cellspacing=1><tr><td>
+	    <table bgcolor=#cccccc cellspacing=1 cellpadding=4 width=100% border=0>
+	       <tr>
+	          <td colspan=2 bgcolor=#cccccc><table width=100% border=0 cellpadding=0 cellspacing=0><tr><td>Page #$current_page - Titled: <font face=arial,helvetica size=-1><input name=page_name$current_page type=text size=30 value=\"$page_name\"></td>$right_link</tr></table></td>
+	       </tr>
+	       <tr>
+	       <td bgcolor=#dddddd valign=top align=center><table border=0 cellpadding=1 cellspacing=0>
+	          <tr><td><table cellpadding=4>
+	          <tr>
+	             <td><a href=\"#\" onClick=\"return spawnWindow('edit','left',$current_page)\"><img src=../pics/edit width=18 height=15 border=0 alt=Edit></a></td>
+	          </tr>
+	          <tr>
+	             <td><a href=\"#\" onClick=\"return Delete('left',$current_page)\"><img src=../pics/x width=18 height=15 border=0 alt=Delete></a></td>
+	          </tr>
+	       </table></td>
+	             <td><font face=courier size=-1><select name=\"left$current_page\" size=6>$left_select $extra_options</select></td>
+	             <td><table cellpadding=4>
+	          <tr>
+	             <td><a href=\"#\" onClick=\"return moveTable('up','left',$current_page)\"><img src=../pics/up width=18 height=15 border=0 alt=\"Up\"></a></td>
+	          </tr>
+	          <tr>
+	             <td><a href=\"#\" onClick=\"return slide('left',$current_page)\"><img src=../pics/right width=18 height=15 border=0 alt=\"Right\" hspace=10></a></td>
+	          </tr>
+	          <tr>
+	             <td><a href=\"#\" onClick=\"return moveTable('down','left',$current_page)\"><img src=../pics/down width=18 height=15 border=0 alt=Down></a></td>
+	          </tr>
+	       </table></td>
+	    </tr></table></td>
+	        <td bgcolor=#dddddd valign=top align=center width=50%><table border=0 cellpadding=1 cellspacing=0>
+	           <tr>
+	              <td><table cellpadding=4>
+	           <tr>
+	              <td align=right><a href=\"#\" onClick=\"return moveTable('up','right',$current_page)\"><img src=../pics/up width=18 height=15 border=0 alt=\"Up\"></a></td>
+	           </tr>
+	           <tr>
+	              <td><a href=\"#\" onClick=\"return slide('right',$current_page)\"><img src=../pics/left width=18 height=15 border=0 alt=\"Left\" hspace=10></a></td>
+	           </tr>
+	           <tr>
+	              <td align=right><a href=\"#\" onClick=\"return moveTable('down','right',$current_page)\"><img src=../pics/down alt=Down width=18 height=15 border=0></a></td>
+	           </tr>
+	        </table></td>
+	        <td><font face=courier size=-1><select name=\"right$current_page\" size=6>$right_select $extra_options</select></td>
+	        <td><table cellpadding=4>
+	           <tr>
+	              <td><a href=\"#\" onClick=\"return spawnWindow('edit','right',$current_page)\"><img src=../pics/edit width=18 height=15 border=0 alt=Edit></a></td>
+	           </tr>
+	           <tr>
+	              <td><a href=\"#\" onClick=\"return Delete('right',$current_page)\"><img src=../pics/x width=18 height=15 border=0 alt=Delete></a></td>
+	           </tr>
+	        </table></td>
+	    </tr>
+	    </table></td>
+	    </tr>
+	    </table></td>
+	    </tr>
+	    </table><br>"
+}
+
+# a list of all tables in the portals you don't already have
+set selection [ns_db select $db "
+    select   table_name, pt.table_id 
+    from     portal_tables pt
+    where    pt.table_id not in (select map.table_id from portal_table_page_map map, portal_pages pp
+                                 where  pp.group_id = $group_id and map.page_id = pp.page_id)
+    order by table_name"]
+    
+append page_content "
+	<table width=100% bgcolor=#0000 border=0 cellpadding=0 cellspacing=1><tr><td>
+	    <table bgcolor=#cccccc cellspacing=1 cellpadding=4 width=100% border=0>
+	       <tr>
+	          <td bgcolor=#cccccc>Here are information tables that you don't currently use:</td>
+               </tr>
+               <tr><td width=100% bgcolor=#dddddd align=center><table><tr>
+<td align=right valign=top><table cellpadding=4>
+	           <tr>
+	              <td><a href=\"#\" onClick=\"return addTable('left',$max_page)\"><img src=../pics/up width=18 height=15 border=0 alt=\"Up\"></a></td>
+	           </tr>
+	           <tr>
+	              <td><a href=\"#\" onClick=\"return spawnWindow('edit','',0)\"><img src=../pics/edit width=18 height=15 border=0 alt=Edit></a></td>
+	           </tr>
+	        </table></td>
+<td valign=top><font face=courier size=-1><select name=new size=5>"
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    set table_name [string toupper [portal_adp_parse $table_name $db]]
+
+    append page_content "<option value=$table_id>$table_name</option>\n "
+}
+append page_content "$extra_options</select></td>
+<td align=left valign=top><table cellpadding=4>
+	           <tr>
+	              <td><a href=\"#\" onClick=\"return addTable('right',$max_page)\"><img src=../pics/up width=18 height=15 border=0 alt=\"Up\"></a></td>
+	           </tr>
+	           <tr>
+	              <td><a href=\"#\" onClick=\"return spawnWindow('edit','',0)\"><img src=../pics/edit width=18 height=15 border=0 alt=Edit></a></td>
+	           </tr>
+	        </table></td></tr></table></center></td></tr></table></td></tr></table>
+<p>
+
+<table width=100% border=0 cellpadding=0 cellspacing=0><tr><td>
+Key:<td valign=top align=right>Click here when completed: <input type=submit value=\" FINISHED \" onClick=\"return doSub();\">
+</td></tr></table>
+</form>
+
+<ul>
+<img src=../pics/edit width=18 height=15 border=0> - Edit selected item
+<br><img src=../pics/x width=18 height=15 border=0> - Delete selected item
+<br><img src=../pics/up width=18 height=15 border=0> - Move item up (to previous page if it is already at the top of the current page)
+<br><img src=../pics/right width=18 height=15 border=0> - Move item from the left side of the page to the right
+<br><img src=../pics/left width=18 height=15 border=0> - Move item from the right side of the page to the left
+<br><img src=../pics/down width=18 height=15 border=0> - Move item down (to next page if it is already at the bottom of the current page)"
+
+ns_return 200 text/html $page_content
+
+
+
+
+
Index: web/openacs/www/portals/admin/restore-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/admin/restore-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/admin/restore-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,83 @@
+#
+# /portals/admin/restore-2.tcl
+#
+# shows the user the proposed table to restore and prompts the user to confirm the action
+#
+# by aure@arsdigita.com and dh@arsdigita.com
+#
+# Last modified: 10/8/1999
+#
+# restore-2.tcl,v 3.0.4.1 2000/03/17 18:08:11 aure Exp
+#
+
+#ad_page_variables {audit_id}
+set_the_usual_form_variables
+# audit_id
+
+validate_integer audit_id $audit_id
+
+# ------------------------------
+# verify user
+set db [ns_db gethandle]
+set user_id [ad_verify_and_get_user_id]
+
+if  {![info exists group_id]} {
+    set group_id ""
+}
+portal_check_administrator_maybe_redirect $db $user_id $group_id
+# -----------------------------
+
+# get the portal table
+set selection [ns_db 1row $db "
+    select table_id, table_name, adp, admin_url
+    from   portal_tables_audit
+    where  audit_id = $audit_id"]
+
+set_variables_after_query
+
+if {![empty_string_p $admin_url]} {
+    set admin_url_description "An ordinary administrator is not allowed to edit this portal table, instead he is redirected to the associated url <a href=$admin_url?[export_url_vars group_id]>$admin_url</a> to perform administration tasks.<P>"
+} else {
+    set admin_url_description "An ordinary administrator is currently allowed to edit this portal table.  There is no associated url." 
+}
+
+# -----------------------------
+# serve the page
+
+# parse the adp
+set shown_adp [portal_adp_parse $adp $db]
+
+# Get generic display information
+portal_display_info
+
+set page_content "
+[portal_admin_header "Review / Confirm"]
+
+[ad_context_bar [list /portals/ "Portals"] [list index.tcl "Administration" ] [list restore.tcl?table_id=$table_id "Versions"] "Review"]
+<hr>
+
+$admin_url_description
+
+You may choose 'restore' to replace the current table with this version.
+<table><tr><td>
+
+$begin_table
+<tr>
+   $header_td [string toupper [portal_adp_parse $table_name $db]]</td>
+</tr>
+<tr>
+   $normal_td$shown_adp</td>
+</tr>
+$end_table
+
+<form action=restore-3 method=post>
+[export_form_vars audit_id]
+<center>
+<input type=submit value=\"Restore\">
+
+</td></tr></table>
+
+[portal_admin_footer]
+"
+
+ns_return 200 text/html $page_content
Index: web/openacs/www/portals/admin/restore-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/admin/restore-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/admin/restore-3.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,81 @@
+#
+# /portals/admin/restore-3.tcl
+#
+# restores version of a table from the audit table into active portal_tables
+#
+# by aure@arsdigita.com and dh@arsdigita.com
+#
+# Last modified: 10/8/1999
+#
+# restore-3.tcl,v 3.0.4.1 2000/03/17 18:08:11 aure Exp
+#
+
+set_the_usual_form_variables
+# audit_id
+
+validate_integer audit_id $audit_id
+
+set db [ns_db gethandle]
+
+# -------------------------------
+# verify the user
+set user_id [ad_verify_and_get_user_id]
+
+if  {![info exists group_id]} {
+    set group_id ""
+}
+portal_check_administrator_maybe_redirect $db $user_id $group_id
+# -------------------------------
+
+set table_id [database_to_tcl_string $db "select table_id from portal_tables_audit  where audit_id = $audit_id"]
+set count [database_to_tcl_string $db "select count(*) from portal_tables where table_id=$table_id"]
+
+if {$count > 0 } {
+    # restoring an old version of a current portal table
+    set selection [ns_db 1row $db "
+        select table_name, adp, admin_url, modified_date, creation_user
+        from portal_tables_audit where audit_id = $audit_id"]
+    set_variables_after_query
+
+    ns_db dml $db "update portal_tables
+    set table_name = '[DoubleApos $table_name]',
+        adp = '[DoubleApos $adp]',
+        admin_url = '$admin_url',
+        modified_date = '$modified_date',
+        creation_user = '$creation_user'
+    where table_id = $table_id"
+} else {
+    # restoring a deleted table
+    ns_db dml $db "insert into portal_tables
+    (table_id, table_name, adp, admin_url, modified_date, creation_user)
+    select table_id, table_name, adp, admin_url, modified_date, creation_user from portal_tables_audit where audit_id = $audit_id"
+} 
+ 
+# Force Memoize of pages with this table, done with foreach since the dbhandle must be released
+
+set group_list [database_to_tcl_list_list $db  "
+    select page_number, group_id
+    from   portal_table_page_map map, portal_pages p
+    where  table_id=$table_id 
+    and    map.page_id=p.page_id
+    and    group_id is not null"]
+
+ns_db releasehandle $db
+
+foreach pair $group_list {
+    set page_number [lindex $pair 0]
+    set new_group_id [lindex $pair 1]
+    Memoize_for_Awhile_Force "portal_display_page $new_group_id $page_number group"
+}
+
+if  {![empty_string_p $group_id]} {
+    ns_return 200 text/html "<script>
+    <!--
+    self.window.close()
+    //-->
+    </script>"
+} else {
+    ns_returnredirect index.tcl
+}
+
+
Index: web/openacs/www/portals/admin/restore.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/admin/restore.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/admin/restore.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,102 @@
+#
+# /portals/admin/restore.tcl
+#
+# This presents a list of old versions of a given portal_table (table_id) from portal_tables_audit;
+# allows user to view a given version and maybe make it the active version.
+#
+# by aure@arsdigita.com and dh@arsdigita.com
+#
+# Last modified: 10/8/1999
+#
+# restore.tcl,v 3.0.4.1 2000/03/17 18:08:11 aure Exp
+#
+
+#ad_page_variables {table_id}
+set_the_usual_form_variables
+#  table_id
+
+validate_integer table_id $table_id
+
+set db [ns_db gethandle]
+
+# --------------------------------------------
+# verify the user
+set user_id [ad_verify_and_get_user_id]
+
+if  {![info exists group_id]} {
+    set group_id ""
+}
+portal_check_administrator_maybe_redirect $db $user_id $group_id
+#---------------------------------------------
+
+# get current table name
+set current_table_name [portal_adp_parse [database_to_tcl_string_or_null $db " 
+    select table_name 
+    from   portal_tables 
+    where  table_id = $table_id"] $db]
+
+if {[empty_string_p $current_table_name]} {
+    set current_table_name "deleted table"
+}
+
+# get portal_tables_audit.modified_date 
+#set selection [ns_db select $db "
+#    select to_char(modified_date,' DD/MM/YY HH:MI AM') modified_date, table_name, audit_id, first_names||' '||last_name as username
+#    from   portal_tables_audit, users
+#    where  table_id = $table_id
+#    and    creation_user = user_id (+)
+#    order by modified_date desc"]
+
+#DRB: I must be missing something obvious regarding the outer
+#join, when will there not be a user in the user table matching
+#creation_user, since we never really delete users?
+
+set selection [ns_db select $db "
+    select modified_date, table_name, audit_id, first_names||' '||last_name as username
+    from   portal_tables_audit, users
+    where  table_id = $table_id
+    and    creation_user = user_id
+    order by modified_date desc"]
+
+set modified_list ""
+set old_version_count 0
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    # modified_date, table_name, audit_id
+    append modified_list "<tr><td><font size=-1>$modified_date</font></td><td>$username &nbsp;</td><td>[portal_adp_parse $table_name $db] &nbsp;</td><td><a href=restore-2?[export_url_vars audit_id]>View</a></td></tr> \n"
+    incr old_version_count
+}
+
+if {$old_version_count == 0} {
+    set modified_list "<tr><td colspan=4>There are no old versions of this portal table.</td></tr>"
+}
+
+# done with the database
+ns_db releasehandle $db
+
+#------------------------------------------------------
+# serve the page
+
+# get system display parameters
+portal_display_info
+
+set page_content "
+[portal_admin_header "Versions of $current_table_name"]
+[ad_context_bar [list /portals/ "Portals"] [list index.tcl "Administration" ]  "Versions"]
+<hr>
+Select a table version you would like to view:
+<p>
+$begin_table
+<tr>
+$header_td MODIFIED DATE</td>
+$header_td MODIFIER</td>
+$header_td TITLE </td>
+$header_td </td>
+</tr>
+$modified_list
+$end_table
+[portal_admin_footer]"
+
+ns_return 200 text/html $page_content
+
+
Index: web/openacs/www/portals/admin/view-deleted.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/admin/view-deleted.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/portals/admin/view-deleted.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,86 @@
+#
+# /portals/admin/view-deleted.tcl
+#
+# Page that displays the names of deleted tables
+#
+# by aure@arsdigita.com and dh@arsdigita.com
+#
+# Last modified: 10/8/1999
+#
+# view-deleted.tcl,v 3.0.4.1 2000/03/17 18:08:12 aure Exp
+#
+
+set db [ns_db gethandle]
+
+# verify the user
+set user_id [ad_verify_and_get_user_id]
+portal_check_administrator_maybe_redirect $db $user_id "" index-manager
+
+# Get generic display information
+portal_display_info
+
+# -------------------------------------------------
+# show a list of all deleted tables in the portals
+set sql_query "
+    select   distinct table_id, table_name
+    from     portal_tables_audit
+    where    table_id not in (select table_id from portal_tables)
+    order by table_name"
+ 
+
+set table_list [database_to_tcl_list_list $db $sql_query]
+
+set counter 0
+set table_table "" 
+
+foreach table_pair $table_list {
+    set table_id [lindex $table_pair 0]
+    set table_name [lindex $table_pair 1]
+
+    append table_table "
+        <tr>
+        $normal_td[string toupper [portal_adp_parse $table_name $db]] &nbsp;</td>
+        <td><a href=restore?[export_url_vars table_id]>View versions</a></td> 
+        </tr>"
+    incr counter
+}
+        
+if { $counter == 0 } {
+    set table_table "<tr><td colspan=2>There are no deleted tables in the database.</td></tr>" 
+}
+
+# -------------------------------------------------
+# serve the page
+
+set page_content "
+[portal_admin_header "Deleted Tables"]
+[ad_context_bar [list /portals/ "Portals"] "Administration"]
+$font_tag
+<hr>
+<table><tr><td>
+$begin_table
+<tr>
+$header_td ACTIVE TABLES (# OF APPEARANCES)</td>
+$header_td ACTIONS</td>
+</tr>
+$table_table
+$end_table
+<p>
+
+</td></tr></table>
+
+[portal_admin_footer]"
+
+ns_return 200 text/html $page_content
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/portals/pics/down.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/pics/down.gif,v
diff -u
Binary files differ
Index: web/openacs/www/portals/pics/edit.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/pics/edit.gif,v
diff -u
Binary files differ
Index: web/openacs/www/portals/pics/h.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/pics/h.gif,v
diff -u
Binary files differ
Index: web/openacs/www/portals/pics/left.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/pics/left.gif,v
diff -u
Binary files differ
Index: web/openacs/www/portals/pics/right.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/pics/right.gif,v
diff -u
Binary files differ
Index: web/openacs/www/portals/pics/spacer.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/pics/spacer.gif,v
diff -u
Binary files differ
Index: web/openacs/www/portals/pics/up.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/pics/up.gif,v
diff -u
Binary files differ
Index: web/openacs/www/portals/pics/x.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/portals/pics/x.gif,v
diff -u
Binary files differ
Index: web/openacs/www/press/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/press/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/press/index.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,104 @@
+# /press/index.tcl
+# 
+# Author: ron@arsdigita.com, December 1999
+#
+# Gateway for the press module
+# 
+# index.tcl,v 3.0 2000/02/06 03:53:13 ron Exp
+# -----------------------------------------------------------------------------
+
+set page_title "Press"
+
+# Check for a user_id but don't force registration.  People should be
+# able to view the press coverage without being registered.
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+# Provide administrators with a link to the local admin pages
+
+if {[press_admin_any_group_p $db $user_id]} {
+    # user is an admin for at least one group and therefore 
+    # MIGHT want to administer some stuff
+    set press_admin_notice [list "admin" "Administer"]
+} else {
+    set press_admin_notice ""
+}
+
+# Grab the press coverage viewable by this person
+
+set selection [ns_db select $db "
+select press_id,
+       publication_name,
+       publication_link,
+       publication_date,
+       publication_date_desc,
+       article_title,
+       article_link,
+       article_pages,
+       abstract,
+       important_p,
+       template_adp
+from   press p, press_templates t
+where  p.template_id = t.template_id
+and    (important_p = 't' or (sysdate()-creation_date <= timespan_days([press_active_days])))
+and    (scope = 'public' or
+        (scope = 'group' and 't' = ad_group_member_p($user_id,p.group_id)))
+order by publication_date desc"]
+
+set press_count 0
+set press_list  ""
+set display_max [press_display_max]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr press_count
+
+    if { $press_count > $display_max } {
+	# throw away the rest of the cursor
+	ns_db flush $db
+	break
+    }
+
+    if {![empty_string_p $publication_date_desc]} {
+	set display_date $publication_date_desc
+    } else {
+	set display_date [util_AnsiDatetoPrettyDate $publication_date]
+    }
+
+    append press_list "
+    <p><blockquote>
+    [press_coverage \
+	    $publication_name $publication_link $display_date \
+	    $article_title $article_link $article_pages $abstract \
+	    $template_adp ]
+    </blockquote></p>"
+}
+
+ns_db releasehandle $db
+
+if {$press_count == 0} {
+    set press_list "<p>There is no press coverage currently available
+    for you to see.</p>"
+}
+
+# -----------------------------------------------------------------------------
+# Ship it out...
+
+ns_return 200 text/html "
+[ad_header "Press"]
+
+<h2>Press</h2>
+
+[ad_context_bar_ws_or_index "Press"]
+
+<hr>
+[help_upper_right_menu $press_admin_notice]
+
+$press_list
+
+[ad_footer]"
+
+
+
Index: web/openacs/www/press/admin/add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/press/admin/add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/press/admin/add-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,89 @@
+# Insert a new press item
+#
+# Author: ron@arsdigita.com, December 1999
+#
+# add-2.tcl,v 3.0.4.1 2000/03/15 20:30:50 aure Exp
+# -----------------------------------------------------------------------------
+
+ad_page_variables {
+    {scope}
+    {group_id}
+    {important_p}
+    {template_id}
+    {publication_name}
+    {publication_link}
+    {publication_date}
+    {publication_date_desc}
+    {article_title}
+    {article_link}
+    {article_pages}
+    {abstract}
+    {html_p}
+}
+
+validate_integer_or_null group_id $group_id
+validate_integer template_id $template_id
+
+# Verify that this user is a valid administrator
+
+set user_id [ad_verify_and_get_user_id]
+set db      [ns_db gethandle]
+
+if {![press_admin_p $db $user_id $group_id]} {
+    ad_return_complaint 1 "<li>Sorry but you're not authorized to add an item of this scope."
+    return
+}
+
+# Insert the new row into the database
+
+ns_db dml $db "
+insert into press
+ (press_id,
+  scope,
+  group_id,
+  template_id,
+  important_p,
+  publication_name,
+  publication_link,
+  publication_date,
+  publication_date_desc,
+  article_title,
+  article_link,
+  article_pages,
+  abstract,
+  html_p,
+  creation_date,
+  creation_user,
+  creation_ip_address)
+values
+ (nextval('press_id_sequence'),
+  '$scope',
+  [ns_dbquotevalue $group_id integer],
+   $template_id,
+  '$important_p',
+  [ns_dbquotevalue $publication_name],
+  [ns_dbquotevalue $publication_link],
+   '$publication_date',
+  [ns_dbquotevalue $publication_date_desc],
+  [ns_dbquotevalue $article_title],
+  [ns_dbquotevalue $article_link],
+  [ns_dbquotevalue $article_pages],
+  [ns_dbquotevalue $abstract],
+  '$html_p',
+   sysdate(),
+   $user_id,
+  '[ns_conn peeraddr]')"
+
+# Redirect back to the administration page
+
+ns_returnredirect ""
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/press/admin/add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/press/admin/add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/press/admin/add.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,127 @@
+#
+# /admin/press/add.tcl
+#
+# Add a new press item
+#
+# Author: ron@arsdigita.com, December 1999
+#
+# add.tcl,v 3.1.2.1 2000/03/15 20:30:33 aure Exp
+#
+
+# Verify that this user is a valid administrator
+
+set user_id [ad_verify_and_get_user_id]
+set db      [ns_db gethandle]
+
+if {![press_admin_any_group_p $db $user_id]} {
+    ad_return_complaint 1 "<li>You are not authorized to access this page"
+    return
+}
+
+# Give default values for some of the form variables
+
+set publication_link "http://"
+set article_link     "http://"
+set important_p      "t"
+set html_p           "f"
+
+# Special formatting for a required form element
+
+proc press_mark_required { varname } {
+    return "<font color=red>$varname</font>"
+}
+
+# Get sample variables for the form
+
+press_coverage_samples
+
+# -----------------------------------------------------------------------------
+# Ship it out
+
+ns_return 200 text/html "
+[ad_header "Add a Press Item"]
+
+<h2>Add a Press Item</h2>
+
+[ad_context_bar_ws [list "../" "Press"] [list "" "Admin"] "Add a Press Item"]
+
+<hr>
+
+<p>Use the following form to define your press coverage.  Note that
+some fields are [press_mark_required "required"], while others may be
+required depending on which template you choose (see the available
+press coverage templates at the bottom of this page).  When you're done
+click 'Preview' and we'll show what your press item will look like when
+it's published by the press module.
+
+<form method=post action=preview>
+<input type=hidden name=target value=add-2>
+<table>
+
+[press_entry_widget [press_mark_required "Publication"] publication_name 30 "e.g. $sample_publication_name"]
+[press_entry_widget "Link" publication_link 30 "e.g. $sample_publication_link"]
+
+<tr>
+<td align=right><b>[press_mark_required "Publication Date"]</b>:</td>
+<td>[ad_dateentrywidget publication_date ""]</td>
+</tr>
+[press_entry_widget "Date Description" publication_date_desc 30 "e.g. $sample_publication_date_desc"]
+
+<tr>
+<td>&nbsp;</td>
+</tr>
+
+[press_entry_widget [press_mark_required "Article Title"] article_title 30 "e.g. $sample_article_title"]
+[press_entry_widget "Link"  article_link  30 "e.g. $sample_article_link"]
+[press_entry_widget "Pages" article_pages 30 "e.g. $sample_article_pages"]
+
+<tr>
+<td align=right valign=top><b>Abstract</b>:</td>
+<td colspan=2>
+  <textarea name=abstract cols=60 rows=10 wrap></textarea>
+</td>
+</tr>
+
+<tr>
+  <td></td>
+  <td colspan=2>The above is formatted as: 
+      [press_radio_widget html_p f "Plain Text"]&nbsp;
+      [press_radio_widget html_p t "HTML"]
+  </td>
+</tr>
+
+[press_scope_widget    $db]
+[press_template_widget $db]
+
+<tr>
+  <td align=right valign=top><b>Importance</b>:</td>
+  <td colspan=2>
+   [press_radio_widget important_p t \
+	   "High (press item will not expire)"]&nbsp;<br>
+   [press_radio_widget important_p f \
+	   "Low (press item will expire in [press_active_days] days)"]
+  </td>
+</tr>
+
+<tr>
+<td>&nbsp;</td>
+</tr>
+
+<tr>
+  <td></td>
+  <td><input type=submit value=\"Preview\"></td>
+</tr>
+
+</table>
+</form>
+
+<hr>
+
+<p>Press coverage templates:</p>
+
+[press_template_list $db]
+
+[ad_footer]"
+
+
+
Index: web/openacs/www/press/admin/delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/press/admin/delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/press/admin/delete-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,38 @@
+# /press/admin/delete-2.tcl
+# 
+# Author: ron@arsdigita.com, December 1999
+#
+# (cleaned up by philg@mit.edu, January 7, 2000)
+#
+# Delete an existing press item
+#
+# delete-2.tcl,v 3.0.4.2 2000/03/15 20:32:42 aure Exp
+# -----------------------------------------------------------------------------
+
+ad_page_variables {press_id}
+
+validate_integer press_id $press_id
+
+set user_id  [ad_verify_and_get_user_id]
+set db       [ns_db gethandle]
+
+# Get the group restrictions for this press item
+
+set group_id [database_to_tcl_string $db "
+select group_id 
+from   press 
+where  press_id = $press_id"]
+
+# Verify that this user is authorized to do the deletion
+
+if {![press_admin_p $db $user_id $group_id]} {
+    ad_return_complaint 1 "<li>Sorry but you're not authorized to
+    delete an item of this scope." 
+    return
+}
+
+# Delete this press item and redirect to the admin page
+
+ns_db dml $db "delete from press where press_id=$press_id"
+
+ns_returnredirect ""
Index: web/openacs/www/press/admin/delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/press/admin/delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/press/admin/delete.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,84 @@
+# Delete an existing press item (confirmation page)
+# 
+# Author: ron@arsdigita.com, December 1999
+#
+# delete.tcl,v 3.0.4.1 2000/03/15 20:31:11 aure Exp
+# -----------------------------------------------------------------------------
+
+ad_page_variables {press_id}
+
+validate_integer press_id $press_id
+
+set user_id [ad_verify_and_get_user_id]
+set db      [ns_db gethandle]
+
+# initialize the data for this item
+
+set selection [ns_db 1row $db "
+select scope,
+       group_id,
+       important_p,
+       publication_name,
+       publication_link,
+       to_char(publication_date,'Month fmdd, yyyy') as display_date,
+       publication_date_desc,
+       article_title,
+       article_link,
+       article_pages,
+       abstract,
+       html_p,
+       template_adp
+from   press p, press_templates t
+where  p.press_id = $press_id
+and    p.template_id = t.template_id"]
+
+if {[empty_string_p $selection]} {
+    ad_return_error "An error occurred looking up press_id = $press_id"
+    return
+} else {
+    set_variables_after_query
+}
+
+# Verify that this user is a valid administrator
+
+if {![press_admin_p $db $user_id $group_id]} {
+    ns_returnredirect "/press/"
+    return
+}
+
+if {![empty_string_p $publication_date_desc]} {
+    set display_date $publication_date_desc
+}
+
+# -----------------------------------------------------------------------------
+
+ns_return 200 text/html "
+[ad_header Admin]
+
+<h2>Delete</h2>
+
+[ad_context_bar_ws [list "../" "Press"] [list "" "Admin"] "Delete"]
+
+<hr>
+
+<p>Please confirm that you want to <b>permanently delete</b> the
+following press item:</p> 
+
+<blockquote>
+[press_coverage \
+	$publication_name $publication_link $display_date \
+	$article_title $article_link $article_pages $abstract \
+	$template_adp]
+</blockquote>
+
+<form method=post action=delete-2>
+[export_form_vars press_id]
+<center><input type=submit value=\"Yes, I want to delete it\"></center>
+</form>
+
+[ad_footer]"
+
+
+
+
+
Index: web/openacs/www/press/admin/edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/press/admin/edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/press/admin/edit-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,58 @@
+# Update a press item
+#
+# Author: ron@arsdigita.com, December 1999
+#
+# edit-2.tcl,v 3.0.4.1 2000/03/15 20:34:18 aure Exp
+# -----------------------------------------------------------------------------
+
+ad_page_variables {
+    {press_id}
+    {scope}
+    {group_id}
+    {template_id}
+    {important_p}
+    {publication_name}
+    {publication_link}
+    {publication_date}
+    {publication_date_desc}
+    {article_title}
+    {article_link}
+    {article_pages}
+    {abstract}
+    {html_p}
+}
+
+validate_integer press_id $press_id
+validate_integer template_id $template_id
+validate_integer_or_null group_id $group_id
+
+# Verify that this user is a valid administrator
+
+set user_id [ad_verify_and_get_user_id]
+set db      [ns_db gethandle]
+
+if {![press_admin_p $db $user_id $group_id]} {
+    ad_return_complaint 1 "<li>You are not authorized to access this page"
+    return
+}
+
+ns_db dml $db "
+update press 
+set    scope                 = '$scope',
+       group_id              = [ns_dbquotevalue $group_id integer],
+       template_id           =  $template_id,
+       important_p           = '$important_p',
+       publication_date      = '$publication_date',
+       publication_name      = [ns_dbquotevalue $publication_name],
+       publication_link      = [ns_dbquotevalue $publication_link],
+       publication_date_desc = [ns_dbquotevalue $publication_date_desc],
+       article_title         = [ns_dbquotevalue $article_title],
+       article_link          = [ns_dbquotevalue $article_link],
+       article_pages         = [ns_dbquotevalue $article_pages],
+       abstract              = [ns_dbquotevalue $abstract],
+       html_p                = '$html_p'
+where  press_id              =  $press_id"
+
+# Redirect back to the admin page
+
+ns_returnredirect ""
Index: web/openacs/www/press/admin/edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/press/admin/edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/press/admin/edit.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,149 @@
+#
+# Edit a press item
+# 
+# Author: ron@arsdigita.com, December 1999
+#
+# edit.tcl,v 3.1.2.1 2000/03/15 20:33:09 aure Exp
+#
+
+ad_page_variables {press_id}
+
+validate_integer press_id $press_id
+
+set user_id [ad_verify_and_get_user_id]
+set db      [ns_db gethandle]
+
+# Initialize the form variables
+
+set selection [ns_db 1row $db "
+select scope,
+       group_id,
+       important_p,
+       publication_name,
+       publication_link,
+       to_char(publication_date,'yyyy-mm-dd') as publication_date,
+       publication_date_desc,
+       article_title,
+       article_link,
+       article_pages,
+       abstract,
+       html_p,
+       template_id
+from   press
+where  press_id = $press_id"]
+set_variables_after_query
+
+if {[empty_string_p $selection]} {
+    ad_return_error "An error occurred looking up press_id = $press_id"
+    return
+}
+
+# Verify this user is authorized to edit this press item
+
+if {![press_admin_p $db $user_id $group_id]} {
+    ad_return_complaint 1 "<li>You are not authorized to access this page"
+    return
+}
+
+if {[empty_string_p $publication_link]} {
+    set publication_link "http://"
+}
+
+if {[empty_string_p $article_link]} {
+    set article_link "http://"
+}
+
+# Special formatting for a required form element
+
+proc press_mark_required { varname } {
+    return "<font color=red>$varname</font>"
+}
+
+# Get sample variables for the form
+
+press_coverage_samples
+
+# -----------------------------------------------------------------------------
+# Ship out the form
+
+ns_return 200 text/html "
+[ad_header Admin]
+
+<h2>Edit a Press Item</h2>
+
+[ad_context_bar_ws [list "../" "Press"] [list "" "Admin"] "Edit"]
+<hr>
+
+<p>Please update the information for this press item.  Note that
+some fields are [press_mark_required "required"] for all press coverage,
+while others may be required depending on which template you choose.</p>
+
+<form method=post action=preview>
+<input type=hidden name=target value=edit-2>
+<input type=hidden name=press_id value=$press_id>
+<table>
+
+[press_entry_widget [press_mark_required "Publication"] publication_name 30 "e.g. $sample_publication_name"]
+[press_entry_widget "Link" publication_link 30 "e.g. $sample_publication_link"]
+
+<tr>
+<td align=right><b>[press_mark_required "Publication Date"]</b>:</td>
+<td>[ad_dateentrywidget publication_date $publication_date]</td>
+</tr>
+[press_entry_widget "Date Description" publication_date_desc 30 "e.g. $sample_publication_date_desc"]
+
+<tr>
+<td>&nbsp;</td>
+</tr>
+
+[press_entry_widget [press_mark_required "Article Title"] article_title 30 "e.g. $sample_article_title"]
+[press_entry_widget "Link"  article_link  30 "e.g. $sample_article_link"]
+[press_entry_widget "Pages" article_pages 30 "e.g. $sample_article_pages"]
+
+<tr>
+<td align=right valign=top><b>Abstract</b>:</td>
+<td colspan=2>
+  <textarea name=abstract cols=60 rows=10 wrap>[ns_quotehtml $abstract]</textarea>
+</td>
+</tr>
+
+<tr>
+  <td></td>
+  <td colspan=2>The above is formatted as: 
+      [press_radio_widget html_p f "Plain Text"]&nbsp;
+      [press_radio_widget html_p t "HTML"]
+  </td>
+</tr>
+
+[press_scope_widget $db $group_id]
+[press_template_widget $db $template_id]
+
+<tr>
+  <td align=right valign=top><b>Importance</b>:</td>
+  <td colspan=2>
+   [press_radio_widget important_p t \
+	   "High (press will not expire)"]&nbsp;<br>
+   [press_radio_widget important_p f \
+	   "Low (press will expire in [press_active_days] days)"]
+  </td>
+</tr>
+
+<tr>
+<td>&nbsp;</td>
+</tr>
+
+<tr>
+  <td></td>
+  <td><input type=submit value=\"Preview\"></td>
+</tr>
+
+</table>
+</form>
+
+<hr>
+
+<p>Press coverage templates:</p>
+
+[press_template_list $db]
+
+[ad_footer]"
Index: web/openacs/www/press/admin/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/press/admin/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/press/admin/index.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,118 @@
+#
+# /press/admin/index.tcl
+#
+# Author: ron@arsdigita.com, December 1999
+#
+# This offers the options to create, edit, and delete existing press
+# coverage for authorized users.
+#
+# index.tcl,v 3.1.2.1 2000/03/15 20:29:59 aure Exp
+#
+
+set user_id [ad_maybe_redirect_for_registration]
+
+set db [ns_db gethandle]
+
+# Verify that this user is a valid (site-wide or group)
+# administrator.  If so, then set up the where clause that will pull
+# out all press coverage they can maintain.
+
+if {[press_admin_any_group_p $db $user_id]} {
+    # user is an administrator for at least some group
+    # site-wide or group specific?
+    if {[ad_administrator_p $db $user_id]} {
+	set where_clause ""
+    } else {
+	set where_clause "
+	where (scope = 'public' and creation_user = $user_id)
+        or 't' = ad_group_member_admin_role_p($user_id, press.group_id)"
+    }
+} else {
+    ad_return_complaint 1 "<li>You are not authorized to access this page"
+    return
+}
+
+# Get those press items
+
+set selection [ns_db select $db "
+select press_id, 
+       scope,
+       article_title,
+       publication_name,
+       publication_date,
+       date_num_days(creation_date+timespan_days([press_active_days])-sysdate()) as days_remaining,
+       important_p
+from   press
+$where_clause
+order  by publication_date desc"]
+
+set avail_press_count 0
+set avail_press_items ""
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr avail_press_count
+
+    if {$days_remaining < 0 && $important_p == "f"} {
+	set status "<font color=red>Expired</font>"
+    } elseif {$important_p == "f"} {
+	set status "<font color=green>Active <nobr>($days_remaining days left)</nobr></font>"
+    } else {
+	set status "Permanent"
+    }
+
+    append avail_press_items "
+    <tr valign=top>
+    <td><nobr>[util_AnsiDatetoPrettyDate $publication_date]</nobr></td>
+    <td>$publication_name</td>
+    <td>$article_title</td>
+    <td align=center>$status</td>
+    <td align-center><nobr>
+      <a href=edit?press_id=$press_id>edit</a> | 
+      <a href=delete?press_id=$press_id>delete</a></nobr>
+    </td>
+    </tr>"
+}
+
+# Done with the database
+ns_db releasehandle $db
+
+if {$avail_press_count == 0} {
+    set avail_press_list "
+    <p>There is no press coverage currently in the database that you are 
+    authorized to maintain."
+} else {
+    set avail_press_list "
+    <table bgcolor=black cellpadding=0 cellspacing=1 border=0><tr><td>
+    <table bgcolor=white cellpadding=3 cellspacing=1 border=0>
+    <tr bgcolor=#dddddd>
+    <td align=center><b>Date</b></td>
+    <td align=center><b>Publication</b></td>
+    <td align=center><b>Article</b></td>
+    <td align=center><b>Status</b></td>
+    <td align=center><b>Actions</b></td>
+    </tr>
+    $avail_press_items
+    </table></td></tr></table>"
+}
+
+# -----------------------------------------------------------------------------
+# Ship it out
+
+ns_return 200 text/html "
+[ad_header "Admin"]
+
+<h2>Admin: Press</h2>
+
+[ad_context_bar_ws [list "../" "Press"] "Admin"]
+
+<hr>
+<ul>
+<li><a href=add>Add a new press item</a></li>
+</ul>
+</p>
+
+<p>$avail_press_list</p>
+
+[ad_footer]"
+
Index: web/openacs/www/press/admin/preview.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/press/admin/preview.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/press/admin/preview.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,169 @@
+# Preview a new press item
+#
+# Author: ron@arsdigita.com, December 1999
+#
+# preview.tcl,v 3.0.4.1 2000/03/15 20:34:39 aure Exp
+# -----------------------------------------------------------------------------
+
+ad_page_variables {
+    {press_id ""}
+    {group_id}
+    {template_id}
+    {important_p}
+    {publication_name "" qq}
+    {publication_link}
+    {publication_date_desc}
+    {article_title "" qq}
+    {article_link}
+    {article_pages}
+    {abstract "" qq}
+    {html_p}
+    {target}
+}
+
+validate_integer_or_null press_id $press_id
+validate_integer_or_null group_id $group_id
+validate_integer template_id $template_id
+
+# Verify that this user is a valid administrator
+
+set user_id [ad_verify_and_get_user_id]
+set db      [ns_db gethandle]
+
+if {![press_admin_any_group_p $db $user_id]} {
+    ad_return_complaint 1 "<li>You are not authorized to access this page"
+    return
+}
+
+# A little pre-processing
+
+if {$publication_link == "http://"} {
+    set publication_link ""
+}
+
+if {$article_link == "http://"} {
+    set article_link ""
+}
+
+if [empty_string_p $group_id] {
+    set scope "public"
+} else {
+    set scope "group"
+}
+
+# Grab the template so we can check additional required variables
+
+set template_adp [database_to_tcl_string $db "
+select template_adp from press_templates where template_id=$template_id"]
+
+# -----------------------------------------------------------------------------
+# Error checking for a press item
+
+set error_count 0
+set error_text ""
+
+if {[empty_string_p $publication_name]} {
+	incr error_count
+	append error_text "<li>You must provide the publication name\n"
+}
+
+if {[empty_string_p $article_title]} {
+    incr error_count
+    append error_text "<li>You must provide the article name\n"
+}
+
+if {![empty_string_p $publication_link] && ![philg_url_valid_p $publication_link]} {
+    incr error_count
+    append error_text \
+	    "<li>The publication link does not look like a valid URL\n"
+}
+
+if {![empty_string_p $article_link] && ![philg_url_valid_p $article_link]} {
+    incr error_count
+    append error_text \
+	    "<li>The article link does not look like a valid URL\n"
+}
+    
+if {[catch { ns_dbformvalue [ns_conn form] publication_date date publication_date}]} {
+    incr error_count
+    append error_text "<li>The publication date is not a valid date\n"
+} elseif {[empty_string_p $publication_date]} {
+    incr error_count
+    append error_text "<li>You must provide a publication date\n"
+}
+
+# Check for additional fields needed by the template
+
+if {[info exists template_adp]} {
+    if {[regexp abstract $template_adp]} {
+	if {[empty_string_p $abstract]} {
+	    incr error_count 
+	    append error_text "<li>Your formatting template requires an abstract\n"
+	}
+    }
+    if {[regexp article_pages $template_adp]} {
+	if {[empty_string_p $article_pages]} {
+	    incr error_count 
+	    append error_text "<li>Your formatting template requires a page reference\n"
+	}
+    }
+}
+
+if {$error_count > 0} {
+    ad_return_complaint $error_count $error_text
+    return
+}
+
+# -----------------------------------------------------------------------------
+# Done with error checking.  Now create a preview of the press item
+
+# Convert the publication date to the correct format for display
+
+if {[empty_string_p $publication_date_desc]} {
+    set display_date [database_to_tcl_string $db "
+    select to_char('$publication_date'::datetime,'Month DD, YYYY') 
+    from dual"]
+} else {
+    set display_date $publication_date_desc
+}
+
+ns_db releasehandle $db
+
+# -----------------------------------------------------------------------------
+# Ship out the preview...
+
+ns_return 200 text/html "
+[ad_header "Preview"]
+
+<h2>Preview</h2>
+[ad_context_bar_ws \
+	[list "../" "Press"] \
+	[list "" "Admin"] \
+	"Preview"]
+<hr>
+
+<p>The press item will be displayed as follows:</p>
+
+<blockquote>
+[press_coverage \
+	$publication_name $publication_link $display_date \
+	$article_title $article_link $article_pages $abstract \
+	$template_adp]
+
+<br>
+
+<form method=post action=$target>
+[export_form_vars \
+	press_id scope group_id template_id important_p \
+	publication_name publication_link publication_date publication_date_desc \
+	article_title article_link article_pages abstract html_p]
+<center><input type=submit value=Confirm></center>
+</form>
+</blockquote>
+
+[ad_footer]"
+
+
+
+
+
Index: web/openacs/www/proposals/6.916.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/proposals/6.916.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/proposals/6.916.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,49 @@
+ad_maybe_redirect_for_registration
+
+# Presents a list of proposal names, linked to more detailed reports.
+
+ReturnHeaders
+ns_write "
+[ad_header "Proposals List"]
+<h2>Proposals List</h2>
+
+<hr>
+"
+
+
+set sql_query "
+select proposal_id, title
+from proposals
+where deleted_p = 'f'
+and purpose = '6.916'
+order by upper(title)
+"
+
+set db [ns_db gethandle]
+set selection [ns_db select $db $sql_query]
+
+set counter 0
+set proposal_list "<ul>"
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+
+    append proposal_list "<li><a href=\"admin/details.tcl?[export_url_vars proposal_id title]\">$title</a>"
+}
+
+ns_db releasehandle $db
+
+append proposal_list "</ul>"
+
+if {$counter == 0} {
+    set proposal_list "<ul><li>No proposals in database.</ul>"
+}
+
+
+
+ns_write "
+$proposal_list
+
+[ad_footer]
+"
Index: web/openacs/www/proposals/index.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/proposals/index.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/proposals/index.html	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,22 @@
+<html>
+<head>
+<title>ArsDigita Proposals</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>ArsDigita Proposals</h2>
+<hr>
+
+<ul>
+<li><a href="new.adp">submit a new proposal</a>
+
+<p>
+
+<li><a href="6.916.tcl">view current 6.916 proposals</a>
+
+</ul>
+
+<hr>
+<a href="/philg/"><address>philg@mit.edu</address></a>
+</body>
+</html>
Index: web/openacs/www/proposals/new-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/proposals/new-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/proposals/new-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,200 @@
+# This is the target program for the form in room-add.tcl.
+
+set_the_usual_form_variables 0
+
+# purpose, title, user_classes, significant_new_capabilities, feature_list_complete, feature_list_ranking, dependencies, minimum_launchable_feature_set, promotion, name, email, phone1, phone2, phone3
+
+# checks to make sure title, name, and email were filled out properly.
+set exception_count 0
+set exception_text ""
+
+if {![info exists title] || [empty_string_p $title] } {
+    incr exception_count
+    append exception_text "<li>Please enter a proposal title."
+}
+
+if {![info exists name] || [empty_string_p $name] } {
+    incr exception_count
+    append exception_text "<li>Please enter a name."
+}
+
+if {![info exists email] || [empty_string_p $email]} {
+    incr exception_count
+    append exception_text "<li>Please enter an email address."
+} elseif { ![philg_email_valid_p $email] } {
+    incr exception_count
+    append exception_text "<li>Your email address doesn't look right to us.  Here are examples
+of full Internet email addresses:
+
+<ul>
+<li>joe123@aol.com
+<li>bill.baguette@isp.fr
+<li>123.456@compuserve.com
+</ul>
+"
+}
+
+if {![info exists phone1] || [empty_string_p $phone1]} {
+    if {![empty_string_p $phone2]} {
+	incr exception_count
+	append exception_text "<li>Please make sure your phone information is filled in completely."
+    } elseif {![empty_string_p $phone3]} {
+	incr exception_count
+	append exception_text "<li>Please make sure your phone information is filled in completely."
+    }
+} else {
+    if {![info exists phone2] || [empty_string_p $phone2]} {
+	incr exception_count
+	append exception_text "<li>Please make sure your phone information is filled in completely."
+    } elseif {![info exists phone3] || [empty_string_p $phone3]} {
+	incr exception_count
+	append exception_text "<li>Please make sure your phone information is filled in completely."
+    }
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+ReturnHeaders
+
+ns_write "
+[ad_header "Thank You For Submitting Your Proposal"]
+
+<font size=2 face=\"verdana, arial, helvetica\">
+<img src=\"/graphics/ad_logo_big.gif\" height=88 width=95 vspace=10> 
+<br>
+<a href=\"/index.adp\">Home</a>&nbsp;&nbsp;&gt;&nbsp;&nbsp;Proposal
+<blockquote>
+<h3>Thank You For Submitting Your Proposal</h3>
+
+"
+
+# does the actual insertion into the database table, proposals
+
+set phone "${phone1}-${phone2}-${phone3}"
+
+set db [ns_db gethandle]
+
+ns_db dml $db "begin transaction"
+
+if [catch {ns_ora clob_dml $db "
+INSERT into proposals
+(proposal_id, purpose, title, user_classes, significant_new_capabilities, feature_list_complete, feature_list_ranking, dependencies, minimum_launchable_feature_set, promotion, name, email, phone, date_submitted)
+VALUES
+($proposal_id, '$QQpurpose', '$QQtitle', empty_clob(), empty_clob(), empty_clob(), empty_clob(), empty_clob(), empty_clob(), empty_clob(), '$QQname', '$QQemail', '[DoubleApos $phone]', sysdate)
+RETURNING
+user_classes, significant_new_capabilities, feature_list_complete, feature_list_ranking, dependencies, minimum_launchable_feature_set, promotion
+INTO
+:1, :2, :3, :4, :5, :6, :7" $user_classes $significant_new_capabilities $feature_list_complete $feature_list_ranking $dependencies $minimum_launchable_feature_set $promotion} errmsg] {
+	# if it was not a double click, produce an error
+	if { [database_to_tcl_string $db "select count(proposal_id) from proposals where proposal_id = $proposal_id"] == 0 } {
+	    ad_return_error "Insert Failed" "We were unable to create your proposal record in the database.  Here's what the error looked like:
+<blockquote>
+<pre>
+$errmsg
+</pre>
+</blockquote>"
+    }
+}
+
+
+ns_db dml $db "end transaction"
+
+set date_submitted [database_to_tcl_string $db "select sysdate from dual"]
+
+ns_db releasehandle $db
+
+ns_write "
+
+
+Your proposal has been received!
+<p>
+
+<b>So what happens next?</b>
+<p>
+Someone from ArsDigita will respond to your proposal within the next few days, either to the email address or phone number you provided. 
+<p>
+
+Currently, demand is outpacing our ability to provide development services, so we are able to be extremely selective about the projects we take on. Prospects are compared using a variety of criteria, reflecting our assessment of their organization, stability, fit with aD, and commitment to the project.
+Based upon our initial evaluation, a prospective project can be:
+
+<ol>
+<li>Assigned a team leader to create a <i>project plan</i></li>
+<li>Assigned a team leader to review as a possible \"smaller\" project or MIT
+class project - <i>(Note that this is a rare outcome, since we currently
+do not have the resources to fragment teams for consulting purposes.)</i></li>
+<li>Deferred pending additional information</li>
+<li>Referred elsewhere</li>
+</ol>
+
+The decision to create a project plan is not made lightly, as such a plan 
+is labor-intensive and time-consuming. A team leader must review the information
+obtained from the client, identify and resolve any ambiguities, and review
+specifications on any outside systems or data sources. Concurrently,
+staffing must be carefully weighed so we can be certain that we can honor
+the start, development, and launch dates laid out in the plan. 
+<p>
+
+Once complete, the project plan serves as the roadmap for development and the
+long term relationship with the client. It sets out dates for start
+and launch and itemizes deliverables.
+<p>
+
+Prior to committing to create this document for the client,
+we try to re-confirm:
+
+<ul>
+<li>They have budgeted at least enough to cover our average costs</li>
+<li>They can come to a decision, sign a contract, and send a check within 5 business days of receipt</li>
+</ul>
+
+If the client cannot decide in that time period, we either re-confirm
+that they understand that the dates presented on the project plan will
+not be valid, or we (politely) inform them that we prefer to hold off creating
+the project plan until they are ready to make a decision.
+<p>
+
+<b>In the meantime...</b>
+<p>
+Feel free to send email to <cite><a href=\"mailto:sales@arsdigita.com\"><b>sales@arsdigita.com</b></a></cite> regarding the status of your proposal.
+<p>
+
+</blockquote>
+<hr><cite>&copy;1999-2000&nbsp;<a href=\"/pages/about.html\">ArsDigita Corporation</a></cite>
+</body>
+</html>
+
+"
+
+ns_sendmail sales@arsdigita.com "$email" "New proposal on intranet" "
+
+Purpose: $purpose
+
+Title: $title
+
+User classes: $user_classes
+
+Significant new capabilities; $significant_new_capabilities
+
+Complete feature list: $feature_list_complete 
+
+Feature list ranking: $feature_list_ranking 
+
+Dependencies: $dependencies
+
+Minimum launchable feature set: $minimum_launchable_feature_set
+
+Promotion: $promotion
+
+Name: $name
+
+Email: $email
+
+Phone: $phone
+
+Date: $date_submitted
+
+View this proposal at [ad_parameter SystemURL]/proposals/admin/one.tcl?[export_url_vars proposal_id]
+"
Index: web/openacs/www/proposals/new.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/proposals/new.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/proposals/new.adp	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,178 @@
+<% 
+set_the_usual_form_variables 0
+
+proc new_adp_textarea {var_name {n_rows 5}} {
+     return "<blockquote><textarea name=$var_name cols=70 rows=$n_rows wrap=soft>\n</textarea></blockquote>"
+}
+
+set db [ns_db gethandle]
+
+set proposal_id [database_to_tcl_string $db "select proposal_id_sequence.nextval from dual"]
+
+%>
+
+<html>
+<head>
+   <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
+   <title>Proposal Form for a Web Project atArsDigita</title>
+</head>
+<body bgcolor="#ffffff">
+<font size=2 face="verdana, arial, helvetica">
+
+<img src="/graphics/ad_logo_big.gif" height=88 width=95 vspace=10> 
+<br>
+<a href="/index.adp">Home</a>&nbsp;&nbsp;&gt;&nbsp;&nbsp;Proposal form
+<blockquote>
+<h3>Proposal Form for a Web Project at ArsDigita </h3>
+
+<form method=POST action="new-2.tcl">
+<%=[export_form_vars proposal_id]%>
+
+This is a proposal for 
+
+<select name=purpose>
+<%=[html_select_options [list ArsDigita 6.916] [value_if_exists purpose]]%>
+</select>
+
+<p>
+
+Proposal Title:  <input type=text size=60 name=title maxlength=100>
+
+<h3>List the classes of users</h3>
+
+Please list below all the classes of user that you expect to be
+connecting to this Web service.
+
+<%= [new_adp_textarea "user_classes"] %>
+
+<bodynote>
+
+In a community site for American owners of Honda cars, the anticipated
+user classes would be (1) Honda owners, (2) Honda dealers, and (3)
+employees of American Honda.
+
+</bodynote>
+
+<h3>Say what they will be able to do</h3>
+
+For each class of user that you identified above, please list the
+significant new capabilities that those users will have in virtue of our
+having built this site:
+
+
+<%= [new_adp_textarea "significant_new_capabilities" 15] %>
+
+<bodynote>
+See <a href="significant-new-capabilities-example.adp">this example of
+what we'd write for the Honda owners service</a>.
+
+
+</bodynote>
+
+<h3>Set forth a comprehensive feature list</h3>
+
+If you have a laundry list of features that you want that aren't
+especially innovative but would be nice to have, include them here in a
+complete list of desired site features.
+
+<%= [new_adp_textarea "feature_list_complete" 15] %>
+
+
+<bodynote>
+
+For the Honda site, we'd tack on stuff like affinity email addresses, so
+that a person could be "JoeAccordOwner@hondaowners.com" and pick up mail
+via a Web interface.
+
+</bodynote>
+
+
+<h3>Say what is most valuable and why</h3>
+
+For each important feature above, say what is valuable about the feature
+to the users, to the service operator (i.e., you) and why.  Try to list
+the features in order of most valuable first.
+
+<%= [new_adp_textarea "feature_list_ranking" 15] %>
+
+
+<h3>Identify Dependencies</h3>
+
+If your Web service requires getting data from another company or
+computer system, say something about that below.
+
+
+<%= [new_adp_textarea "dependencies" 5] %>
+
+
+<bodynote>
+
+For the Honda service that we've sketched above, we won't be able to
+launch unless we get cooperation from the folks who run the company's
+mainframe systems.
+
+</bodynote>
+
+<h3>Minimum Launchable Feature Set</h3>
+
+Any Web service tends to develop gradually over the years as the
+publisher and the users develop better ideas.  Programmers can't work
+at infinite speed.  So it is best to view the ultimate service
+development as a continuous process.  Decide in advance what the
+minimum launchable feature set is and then everyone will have a
+target.
+
+<%= [new_adp_textarea "minimum_launchable_feature_set" 5] %>
+
+
+<bodynote>
+
+For the Honda service that we've sketched above, the minimum
+launchable feature set might be "email service reminders for owners;
+owner can log in and see service history; owner can book an
+appointment for additional service; dealer gets email or FAX alerts of
+booked appointments."
+
+</bodynote>
+
+<h3>Promotion</h3>
+
+It doesn't matter how good the site is if nobody uses it.  What's your
+plan for reaching users?  Have you raised money?  Gotten powerful
+partners to agree to promote the site?  Are you relying on word of
+mouth?
+
+<%= [new_adp_textarea "promotion" 5] %>
+
+
+<bodynote>
+
+Something like "American Honda already has the Snail Mail address of
+every vehicle owner and has budgeted to mail a four-color flyer to
+every owner in the US.  In addition we'll promote the URL in posters
+to be displayed in dealer service departments."
+
+</bodynote>
+
+<h3>Contacting You</h3>
+
+<ul>
+
+<li>Your name:  <input type=text name=name size=30 maxlength=100>
+<li>Your email address:  <input type=text name=email size=20 maxlength=100>
+<li>Phone Number:  <input type=text name=phone1 size=3 maxlength=3>-<input type=text name=phone2 size=3 maxlength=3>-<input type=text name=phone3 size=4 maxlength=4>
+
+</ul>
+
+
+<center>
+<input type=submit value="Submit Proposal">
+</center>
+</form>
+
+
+
+</blockquote>
+<hr><cite>&copy;1999-2000&nbsp;<a href="/pages/about.html">ArsDigita Corporation</a></cite>
+</body>
+</html>
Index: web/openacs/www/proposals/significant-new-capabilities-example.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/proposals/significant-new-capabilities-example.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/proposals/significant-new-capabilities-example.adp	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,200 @@
+<!doctype html public "-//w3c//dtd html 4.0 transitional//en">
+<html>
+<head>
+   <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
+   <title>ArsDigita</title>
+</head>
+<body bgcolor="#ffffff">
+<font size=2 face="verdana, arial, helvetica">
+
+<img src="/graphics/ad_logo_big.gif" height=88 width=95 vspace=10> 
+<br>
+<a href="index.tcl">Home</a>&nbsp;&nbsp;&gt;&nbsp;&nbsp;<a href="new.adp">Proposal form</a>&nbsp;&nbsp;&gt;&nbsp;&nbsp;Example
+<blockquote>
+
+<h3>Example of a Capabilities Descriptions </h3>
+
+<h4>User Class 1:  Significant New Capabilities for Honda Owners</h4>
+
+Suppose that Joe Owner types "my.honda.com" into a Web browser on his
+home computer.  His authentication information is already stored in a
+persistent cookie and the system welcomes him with a screen asking "Did
+you get the oil changed on your Odyssey?  Remember the email reminder you
+got a month ago?  We can't find anything in our records to show that you
+had this work done at a Honda dealer."
+
+<p>
+
+If Joe clicks on "considering a trade-in", our system will use data
+from Honda's mainframe to find out how much Joe still owes on his
+American Honda Finance loan and whether his Odyssey is still under
+warranty.  Combining data from the Kelly Blue Book, current new Honda
+pricing, and current American Honda Finance interest rates,
+my.honda.com will show Joe a page with a thumbnail photo of every
+Honda model.  Beside each model will be the change in Joe's monthly
+payment if he traded in his Odyssey on that model and took out a
+four-year American Honda Finance loan.  At the bottom right of the
+page, Joe could click "show me the payment changes if I wanted a
+three-year loan."  The server would then produce an updated page with
+monthly payment changes reflecting a three-year loan on the new
+vehicle.
+
+<p>
+
+If Joe clicks on "I think something is wrong with my Odyssey", he'd 
+be offered a choice of 
+
+<ul>
+
+<li>view complete service history, summarized in plain English (pulled
+from the Honda mainframe)
+
+<li>talk to my local dealer about this (phone number supplied, also
+private email messages can be sent and received via the Web site (piped
+through the Web site so that we always have a record of this
+communication in the Oracle database))
+
+<li>talk to other Honda owners about this (public bboards and chat
+rooms)
+
+<li>talk to Honda about this (phone numbers and Web-based support
+options; Web-based support allows Joe to upload digital photos he might
+have taken of damaged parts)
+
+<li>schedule a service appointment with a dealer (linked directly to
+dealers' computer systems)
+
+<li>view service manuals on-line, with part numbers hyperlinked to a
+parts ordering service (parts fulfilled either from local dealer or via
+FEDEX from a Honda warehouse (with Honda at its option giving a
+commission to local dealers to avoid channel conflict))
+
+<li>view a current listing of average costs for various kinds of repairs
+to his Odyssey (parts prices and labor hours taken from Honda mainframe;
+Honda must have these data in electronic form since it needs it for warranty
+reimbursement of dealers)
+
+</ul>
+
+<p>
+
+If Joe clicks on "I want to customize/accessorize my Odyssey", he enters
+what looks like a fairly standard 1994-style Internet catalog shopping
+system.  The differences?  my.honda.com remembers (1) that Joe has a
+particular model of Odyssey and only shows the accessories that fit, and
+(2) that Joe has already purchased a certain number of accessories.  So
+this shopping system can not only show a shopping basket but also "Joe's
+Garage" where the previously purchased accessories are.  Joe can
+initiate a reorder or return from the garage.  If my.honda.com shows an
+accessory in the garage and Joe can't find it, Joe can request to track
+this package.  my.honda.com will visit the www.fedex.com Web site and
+grab the latest tracking info, then display it on the page [Note:
+this is a standard feature of the ArsDigita toolkit.]
+
+<p>
+
+Starting three months before Joe's warranty expires, my.honda.com
+starts sending email offers for an extended warranty.  These offers are
+also available on the Web site and, indeed, the warranty may be
+purchased on the Web.
+
+<p>
+
+When Joe decides to organize a Odyssey owners' family picnic, he can use
+my.honda.com to schedule the event.  Joe gives my.honda.com the street
+address and five-digit zip code of the picnic so that owners within 45
+miles of the picnic who visit my.honda.com will be offered a chance to
+attend.  Our server can be used to manage RSVPs for the event as well.
+
+<p>
+
+... and a whole bunch more stuff.  This list will grow as the project
+progresses through the years.  
+
+
+<h4>User Class 2: Significant New Capabilities for Honda dealers</h4>
+
+A dealer logs in and immediately sees
+
+<ul>
+<li>which owners have booked appointments for service
+<li>which owners have booked appointments to trade in their cars
+<li>news from American Honda
+</ul>
+
+The dealer can choose to participate in discussions with other Honda
+dealers, use a structured car/parts finder system to locate items in
+inventory at other dealers, and look up service histories for
+particular cars.
+
+
+<h4>User Class 3: Significant New Capabilities for American Honda employees</h4>
+
+Suppose that Joe Owner calls Jane Manager at Honda's office in
+Massachusetts.  He is complaining that the air conditioning system broke
+two months out of warranty.  Jane can visit her workspace at
+my.honda.com.  The server recognizes that she is a Honda employee and
+is authorized to see customer service data for customers in New England.
+She finds Joe Owner's records, presented initially as single screen with
+an integrated view of Joe's Odyssey's service history and a summary of
+all interactions between Honda and Joe in the past.  The customer
+service or interaction history is presented at the top level as issues,
+e.g., Joe asks when his warranty will run out, and actions tied to each
+issue.  For example, the actions for Joe's warranty query might be 
+
+<ol>
+
+<li>Joe submits a Web question about his warranty expiration date; the
+date calculated by the server seems wrong to him
+
+<li>Honda's email response
+
+<li>notes by a Honda telephone support staffer on Joe's followup call
+
+<li>Honda's automated email two weeks later thanking Joe for using the
+service and telling him that if he has more questions to simply respond
+to the email message or come to my.honda.com
+
+</ol>
+
+Based on interactions like this, Jane Manager can see how things have
+gone for Joe in the past and whether Honda and its dealers have
+supported him to the desired standard.  
+
+<p>
+
+After looking carefully at the my.honda.com record, Jane decides that
+Joe hasn't gotten such great service from Boston Honda.  Moreover, she
+notes that Joe has owned two Hondas in the past and has referred six
+friends from my.honda.com, one of whom subsequently purchased a car.
+While still on the phone with Joe, Jane schedules a service appointment
+for his car at his closest dealer, the A/C to be fixed at Honda's
+expense.
+
+<p>
+
+Looking at Joe's refer-a-friend record reminds Jane to check other New
+England customers.  She asks the server to show her a report of
+referrals and conversions.  There are 12 customers who've referred at
+least 20 friends, at least 4 of whom eventually bought vehicles and
+registered at my.honda.com.  Jane asks the server to send them all
+email thanking them for their loyalty and offering a free Honda
+baseball jacket.
+
+<p>
+
+In summary, my.honda.com should help Honda identify and reward its
+most loyal and profitable customers.  It should help Honda deliver
+better, more consistent, and cheaper customer service.
+
+<p>
+
+[Notes: the issue/action customer support system integrating Web, email,
+and phone interactions was developed by ArsDigita in 1998 and has been
+rolled into our standard toolkit.  We built a "find me the customers who
+referred lots of other customers" system for Levi Strauss in 1998.]
+
+</blockquote>
+<hr><cite>&copy;1999-2000&nbsp;<a href="/pages/about.html">ArsDigita Corporation</a></cite>
+</body>
+</html>
\ No newline at end of file
Index: web/openacs/www/proposals/admin/delete-or-undelete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/proposals/admin/delete-or-undelete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/proposals/admin/delete-or-undelete.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,22 @@
+# target program for details.tcl
+
+set_the_usual_form_variables
+
+# proposal_id, title, deleted_p
+
+validate_integer proposal_id $proposal_id
+
+set db [ns_db gethandle]
+
+ns_db dml $db "begin transaction"
+
+if { $deleted_p == "f" } {
+    ns_db dml $db "update proposals set deleted_p = 't' where proposal_id = $proposal_id"
+} else {
+    ns_db dml $db "update proposals set deleted_p = 'f' where proposal_id = $proposal_id"
+}
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect details.tcl?[export_url_vars proposal_id title]
+
Index: web/openacs/www/proposals/admin/details.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/proposals/admin/details.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/proposals/admin/details.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,107 @@
+ad_maybe_redirect_for_registration
+
+# Target program for /admin/reserve/reports/index.tcl
+
+set_the_usual_form_variables
+
+# import variable: proposal_id, title
+
+validate_integer proposal_id $proposal_id
+
+ReturnHeaders
+ns_write "
+[ad_header "Details Of Proposal \"$title\""]
+<h2>$title</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Proposal Administration"] "One Proposal"]
+
+<hr>
+"
+
+set sql_query "
+SELECT *
+FROM proposals
+WHERE proposal_id = $proposal_id
+"
+append reservations_table "</table>"
+
+set db [ns_db gethandle]
+
+set selection [ns_db select $db $sql_query]
+
+set counter 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+}
+
+set exception_count 0
+set exception_text ""
+
+if {$counter == 0} {
+    incr exception_count
+    append exception_text "Proposal Not In Database"
+}
+
+if {$exception_count>0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+if { $deleted_p == "f" } {
+    set delete_or_undelete_form "<form method=post action=\"delete-or-undelete.tcl\"><input type=submit value=\"Delete\">[export_form_vars proposal_id title deleted_p]</form>"
+} else {
+    set delete_or_undelete_form "<form method=post action=\"delete-or-undelete.tcl\"><input type=submit value=\"Undelete\">[export_form_vars proposal_id title deleted_p]</form>"
+}
+
+ns_write "
+<ul>
+
+<li> <b>Purpose:</b> $purpose
+
+<li> <b>Title:</b> $title
+
+<li> <b>User Classes:</b> <pre>$user_classes</pre>
+
+<li> <b>Significant New Capabilities:</b> <pre>$significant_new_capabilities</pre>
+
+<li> <b>Complete Feature List:</b> <pre>$feature_list_complete</pre>
+
+<li> <b>Feature List Ranking:</b> <pre>$feature_list_ranking</pre>
+
+<li> <b>Dependencies:</b> <pre>$dependencies</pre>
+
+<li> <b>Minimum Launchable Feature Set:</b> <pre>$minimum_launchable_feature_set</pre>
+
+<li> <b>Promotion:</b> <pre>$promotion</pre>
+
+<li> <b>Name:</b> $name
+
+<li> <b>Email:</b> <a href=\"mailto:$email\">$email</a>
+
+<li> <b>Phone:</b> $phone
+
+<li> <b>Date Submitted:</b> $date_submitted
+
+</ul>
+
+$delete_or_undelete_form
+
+[ad_general_comments_list $db $proposal_id proposals $title intranet]
+
+[ad_footer]
+
+"
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/proposals/admin/index-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/proposals/admin/index-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/proposals/admin/index-delete.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,49 @@
+ad_maybe_redirect_for_registration
+
+# Presents a list of deleted proposal names, linked to more detailed reports.
+
+ReturnHeaders
+ns_write "
+[ad_header "Deleted Proposals List"]
+<h2>Deleted Proposals List</h2>
+
+<hr>
+"
+
+set sql_query "
+select proposal_id, title
+from proposals
+where deleted_p = 't'
+order by upper(title)
+"
+
+set db [ns_db gethandle]
+set selection [ns_db select $db $sql_query]
+
+set counter 0
+set proposal_list "<ul>"
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+
+    append proposal_list "<li><a href=\"details.tcl?[export_url_vars proposal_id title]\"> <b>$title</b> </a>"
+}
+
+ns_db releasehandle $db
+
+append proposal_list "</ul>"
+
+if {$counter == 0} {
+    set proposal_list "<ul><li>No proposals in database.</ul>"
+}
+
+ns_write "
+$proposal_list
+<br>
+<a href=\"index.tcl\">View active proposals</a>
+"
+
+ns_write "
+[ad_footer]
+"
Index: web/openacs/www/proposals/admin/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/proposals/admin/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/proposals/admin/index.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,68 @@
+ad_maybe_redirect_for_registration
+
+# Presents a list of proposal names, linked to more detailed reports.
+
+ReturnHeaders
+ns_write "
+[ad_header "Proposals List"]
+<h2>Proposals List</h2>
+
+<hr>
+"
+
+
+set sql_query "
+select proposal_id, title, to_char(date_submitted,'Mon DD, YYYY') as pretty_date_submitted
+from proposals
+where deleted_p = 'f'
+order by upper(title)
+"
+
+set db [ns_db gethandle]
+set selection [ns_db select $db $sql_query]
+
+set counter 0
+set proposal_list "<ul>"
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+
+    append proposal_list "<li><a href=\"details.tcl?[export_url_vars proposal_id title]\">$title</a> ($pretty_date_submitted)"
+}
+
+append proposal_list "</ul>"
+
+if {$counter == 0} {
+    set proposal_list "<ul><li>No proposals in database.</ul>"
+}
+
+ns_write "
+$proposal_list
+<br>
+"
+
+set sql_query "
+select 1
+from proposals
+where deleted_p = 't'
+"
+set selection [ns_db select $db $sql_query]
+
+set counter 0
+
+while {[ns_db getrow $db $selection]} {
+    incr counter
+}
+
+ns_db releasehandle $db
+
+if {$counter} {
+ns_write "
+<a href=\"index-delete.tcl\">View deleted proposals</a>
+"
+}
+
+ns_write "
+[ad_footer]
+"
Index: web/openacs/www/pull-down-menus/pdm.js
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/pull-down-menus/pdm.js,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/pull-down-menus/pdm.js	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,602 @@
+// /pull-down-menus/pdm.js
+//
+// by aure@arsdigita.com, February 2000
+//
+// menu navigation system
+//
+// requires standard.js
+//
+// pdm.js,v 1.2.4.1 2000/06/16 19:13:04 ron Exp
+
+var NavBar = new Array();
+var menu_spacing = 0;
+var cell_spacing = 0;
+var cell_padding = 0;
+
+var x_offset;
+var y_offset;
+var main_menu_bg_color;
+var main_menu_hl_color;
+var main_menu_bg_img_url;
+var main_menu_hl_img_url;
+var sub_menu_bg_color;
+var sub_menu_hl_color;
+var sub_menu_bg_img_url;
+var sub_menu_hl_img_url;
+var sub_sub_menu_bg_color;
+var sub_sub_menu_hl_color;
+var sub_sub_menu_bg_img_url;
+var sub_sub_menu_hl_img_url;
+
+var element_height, element_width;
+var orientation;
+var test_main_menu_bg_color = '#FFFFFF';
+
+var last_casc1;
+var last_casc2 = '';
+
+var blank_src = '/graphics/graphing-package/transparent-dot.gif';
+var blank_img = '<img src='+ blank_src + ' width=1 height=1>';
+
+function NavBarItem(label, url, top_level_p, opened_p){
+    // text of the NavBar item
+    this.label = label;
+    // location of the where to go on click
+    this.url = url;
+    // boolean describing whether this is a top level item
+    this.TopLevelP = top_level_p;
+    // boolean describing whether the item is opened
+    this.OpenedP = opened_p;
+    // create the array of cascade items for this NavBarItem
+    this.cascade = new CascadeMenu();
+    NavBar[NavBar.length] = this;
+    return this;
+}
+
+//CascadeMenu class
+//general cascade object for 1st and 2nd level cascades
+//takes no arguments, contains array of cascadeitems
+//has addMember method which adds cascade items to members array
+function CascadeMenu(){
+    this.members = new Array();
+    this.addMember = AddMember;
+    return this;
+}
+
+function CascadeItem(label, url, has_cascade) {
+    // text of the NavBar item
+    this.label = label;
+    // location of the where to go on click
+    this.url = url;
+    // boolean of whether this item has a next level cascade
+    this.has_cascade = has_cascade;
+    // create the array of cascade items
+    if (has_cascade){
+	this.cascade = new CascadeMenu();
+    }
+}
+
+//AddMember method
+//adds members to CascadeMenu objects
+//passes arguments to CascadeItem
+function AddMember(label,url,has_cascade){
+    var my_index = this.members.length;
+    this.members[my_index] = new CascadeItem(label,url,has_cascade);
+    return this.members[my_index];
+}
+
+// MakeNavLayers function
+// writes out layers for netscape and divs for IE
+function MakeNavLayers(){
+    
+    var mainNavBar = '';
+    var main_act = '<map name="mainNavBar_map">';
+
+    var num_opened = 0;
+    var current_x_offset = 0;
+    var current_y_offset = 0;
+    var openbg_top = -1;
+    var openbg_h = 0;
+
+    if (orientation == 'horizontal') {
+	mainNavBar += '<table border=0' + 
+                      '       cellspacing=' + cell_spacing +
+	              '       cellpadding=' + cell_padding +
+                      '       width=' + (NavBar.length * element_width) + '>' +
+                      '<tr>';
+    } else {
+	mainNavBar += '<table border=0' +
+                      '       cellspacing=' + cell_spacing +
+                      '       cellpadding=' + cell_padding +
+                      '       width=' + element_width + '>';    
+    }
+
+    for(var i = 0; i < NavBar.length; i++) {
+		
+	if (NavBar[i].OpenedP){
+	    font_decoration = '<u>';
+	} else {
+	    font_decoration = '';
+	}
+
+	if (orientation == 'horizontal') {
+	    mainNavBar += '<td width=' + (element_width - 10) + '>' +
+	                  '<font class="mainmenufont"> &nbsp; ' + 
+	                  font_decoration + NavBar[i].label + 
+                          '</td>';
+	
+	} else if (NavBar[i].TopLevelP){
+	    mainNavBar += '<tr>' +
+	                  '<td height=' + element_height +
+	                  '    width='  + element_width  + 
+	                  '    nowrap>' +
+	                  '<font class="mainmenufont">&nbsp;' + 
+	                  font_decoration + NavBar[i].label + 
+	                  '</td></tr>';
+
+	    if (NavBar[i].OpenedP) {
+		if (num_opened > 0)
+		alert("Warning: more than one open top-level nav item");
+		if (num_opened == 0)
+		num_opened = 1;
+	    }
+	} else {
+	    mainNavBar += '<tr>' +
+	                  '<td height=' + element_height +
+	                  '    width='  + element_width  +
+	                  '    nowrap>' +
+	                  '<font class="mainmenufont">&nbsp;' + NavBar[i].label +
+	                  '</td></tr>';
+ 
+	    if (openbg_top == -1) openbg_top = current_y_offset;
+
+	    openbg_h += element_height;
+	}
+ 
+	//Make the imagemap area html for this element
+	main_act += MapArea(element_width,
+                            element_height,
+                            current_x_offset,
+	                    current_y_offset,
+                            NavBar[i].url,
+                            'TopOver(' + i +',' + 
+                                     (x_offset + current_x_offset) + ',' + 
+                                     (y_offset + current_y_offset) + 
+                                   ');',
+	                    '',
+			    'top');
+	
+	//build first level cascade for this nav item
+	var sub1_id = 'casc1_' + i;
+	var sub1_cont = '';
+	var sub1_act = '<map name="'+ sub1_id + '_map">';
+	
+	//loop through this item's cascade items
+	if(NavBar[i].cascade.members.length > 0){
+	    sub1_cont += '<table border=0' +
+                         '       cellpadding=' + cell_padding +
+                         '       cellspacing=' + cell_spacing +
+                         '       width=' + element_width + '>\n';
+
+	    for (var j = 0; j < NavBar[i].cascade.members.length; j++) {
+		var sub1_top = j * element_height;
+		
+		sub1_cont += '<tr>' +
+                             '<td height=' + element_height + 
+                             '    width='  + element_width  + 
+		             '    nowrap>' + 
+                             '<font class="submenufont">&nbsp;' + 
+                             NavBar[i].cascade.members[j].label + 
+                             '</font>' + 
+                             '</td>' + 
+                             '</tr>';
+		
+		//check for 2nd level cascades
+		if (NavBar[i].cascade.members[j].has_cascade) {
+		    var my_cascade = NavBar[i].cascade.members[j].cascade;
+		    var sub2_id = 'casc2_' + i + "_" + j;
+		    var sub2_cont = '';
+		    var sub2_act = '<map name="'+ sub2_id + '_map">';
+		    
+		    //loop through this item's cascade items
+		    sub2_cont += '<table border=0' + 
+                                 '       cellpadding=' + cell_padding + 
+                                 '       cellspacing=' + cell_spacing + 
+                                 '       width=' + element_width + '>\n';
+
+		    for (var k = 0; k < my_cascade.members.length; k++) {
+
+			sub2_cont += '<tr>' +
+			             '<td height=' + element_height +
+			             '    width='  + element_width  +
+			             '    nowrap>' +
+			             '<font class="subsubmenufont">&nbsp;' + 
+			             my_cascade.members[k].label +
+			             '</font>' +
+			             '</td>' +
+			             '</tr>'; 
+
+			// convenience variables
+			var sub2_top = k * element_height;
+			if (orientation == 'horizontal') {
+			    var x1 = (x_offset + current_x_offset + element_width); 
+			    var y1 = (y_offset + current_y_offset + element_height);
+			} else {
+			    var x1 = (x_offset + current_x_offset + 2 * element_width); 
+			    var y1 = (y_offset + current_y_offset);
+			}
+
+			sub2_act += MapArea(element_width,
+                                            element_height,
+                                            0,
+                                            sub2_top,
+                                            my_cascade.members[k].url,
+                                            'Cascade2Over(\'casc2_'+ k +'\',' + 
+                                                          x1 + ',' + 
+                                                          (y1 + sub1_top + sub2_top) +
+                                                        ')',
+                                            '',
+					    'sub');
+		    }
+
+		    sub2_cont += '</table>\n';
+
+		    //write out second-level cascade
+		    mkLay(sub2_id,
+		          element_width,
+                          element_height,
+                          x1,
+                          (y1 + sub1_top),
+                          3,
+                          false,
+                          sub2_cont,
+                          '',
+                          '');
+		    
+		    sub2_act += '</map>\n' +
+                                '<img src="' + blank_src + '"' + 
+                                '     width=' + element_width + 
+                                '     height='+ (sub2_top + element_height) +
+                                '     usemap="#' + sub2_id + '_map" ' +
+                                '     border=0>';
+
+		    //write out first-level cascade activation layer
+		    mkLay(sub2_id + '_act',
+		          10,
+		          10,
+                          x1,
+                          (y1 + sub1_top),
+                          4,
+		          false,
+		          sub2_act,
+		          '',
+		          '');
+
+		    //make first-level cascade bg layer
+		    mkLay2(sub2_id + '_bg',
+		          (element_width - menu_spacing),
+		          (my_cascade.members.length * element_height),
+		          x1,
+                          (y1 + sub1_top),
+                          1,
+		          false,
+		          '<body background="'+sub_sub_menu_bg_img_url+'" marginwidth=0 marginheight=0 leftmargin=0 topmargin=0>',
+	                  '<div class="subsubmenu"><img width='+(element_width - menu_spacing)+' height='+(my_cascade.members.length * element_height)+' src='+blank_src+'></div>',
+		          'bgcolor=' + sub_sub_menu_bg_color,
+                          'background-color: ' + sub_sub_menu_bg_color + ';');
+		    
+		    last_casc2 = sub2_id;
+		}
+
+		if (orientation == 'horizontal') {
+		    var x2 = (x_offset + current_x_offset); 
+		    var y2 = (y_offset + current_y_offset + element_height);
+		} else {
+		    var x2 = (x_offset + current_x_offset + element_width); 
+		    var y2 = (y_offset + current_y_offset);
+		}
+
+		//add to first-level cascade activation layer
+		sub1_act += MapArea(element_width,
+		                    element_height,
+		                    0,
+                                    sub1_top,
+		                    NavBar[i].cascade.members[j].url,
+                                    'Cascade1Over('+ j +',' + 
+                                                  x2 + ',' + 
+                                                  (y2 + sub1_top)  +',' + 
+                                                   NavBar[i].cascade.members[j].has_cascade +',' + 
+		                                   i + ')',
+		                    '',
+				    'sub');
+	    }
+	    
+	    sub1_cont += '</table>\n';
+	    
+	    //write out first-level cascade
+	    mkLay(sub1_id,
+	          element_width,
+                  element_height,
+	          x2,
+                  y2,
+	          3,
+	          false,
+	          sub1_cont,
+	          '',
+	          '');
+	    
+	    sub1_act += '</map>\n' + 
+	                '<img src="' + blank_src + '"' + 
+                        '     width=' + element_width + 
+	                '     height=' + (sub1_top + element_height) +
+                        '     usemap="#'+ sub1_id +'_map"' +
+	                '     border=0>';
+
+	    //write out first-level cascade activation layer
+	    mkLay(sub1_id + '_act',
+	          10,
+	          10,
+	          x2,
+	          y2,
+	          4,
+	          false,
+	          sub1_act,
+	          '',
+	          '');
+
+	    //make first-level cascade bg layer
+	    mkLay2(sub1_id + '_bg',
+	          (element_width - menu_spacing),
+                  (NavBar[i].cascade.members.length * element_height),
+                  x2,
+	          y2,
+	          1,
+	          false,
+                  '<body background="'+sub_menu_bg_img_url+'" marginwidth=0 marginheight=0 leftmargin=0 topmargin=0>',
+	          '<div class="submenu"><img width='+(element_width - menu_spacing)+' height='+(NavBar[i].cascade.members.length * element_height)+' src='+blank_src+'></div>',
+	          'bgcolor=' + sub_menu_bg_color,
+                  'background-color: ' + sub_menu_bg_color + ';');
+	    
+	    last_casc1 = sub1_id;
+	}
+
+	if (orientation == 'horizontal') {
+	    current_x_offset += element_width;
+	} else {
+	    current_y_offset += element_height;
+	}
+
+    }
+    
+    if (orientation == 'horizontal') {
+	var navbar_width = NavBar.length * element_width;
+	var navbar_height = element_height;
+    } else {
+	var navbar_width = element_width;
+	var navbar_height = current_y_offset;
+    }
+
+    mkLay2('nav_bg_off',
+          navbar_width,
+          navbar_height,
+          x_offset,
+          y_offset,
+          1,
+          true,
+          '<body background="'+main_menu_bg_img_url+'" marginwidth=0 marginheight=0 leftmargin=0 topmargin=0>',
+	  '<div class="mainmenu"><img width='+(element_width - menu_spacing)+' height='+(element_height)+' src='+blank_src+'></div>',
+          'bgcolor=' + main_menu_bg_color,
+          'background-color: ' + main_menu_bg_color + ';');
+
+    //make alternate bgcolor for open items if there are any
+    if (openbg_top != -1 && orientation == 'vertical') {
+	mkLay('nav_openbg',
+	      element_width,
+	      openbg_h,
+	      x_offset,
+	      (y_offset + openbg_top),
+	      2,
+	      true,
+	      blank_img,
+	      'bgcolor=' + test_main_menu_bg_color,
+	      'background-color: ' + test_main_menu_bg_color + ';');
+    }
+
+    // highlight main element
+    mkLay2('nav_highlight',
+          (element_width - menu_spacing),
+          element_height,
+          (x_offset - 1),
+          y_offset,
+          3,
+          false,
+          '<body background="'+main_menu_hl_img_url+'" marginwidth=0 marginheight=0 leftmargin=0 topmargin=0>',
+	  '<div class="mainmenuhl"><img width='+(element_width - menu_spacing)+' height='+(element_height)+' src='+blank_src+'></div>',
+          'bgcolor=' + main_menu_hl_color,
+          'background-color: ' + main_menu_hl_color + ';');
+    
+    mainNavBar += '</tr></table>';
+
+    //make nav layers
+    mkLay('nav_layers',
+          10,
+          10,
+          x_offset,
+          (y_offset - 1),
+          50,
+          true,
+          mainNavBar,
+          '',
+          '');
+    
+    main_act += '</map>\n' + 
+                '<img src="' + blank_src + '"' +
+                '     width=' + navbar_width + 
+                '     height=' + navbar_height +
+                '     usemap="#mainNavBar_map"' +  
+                '     border=0>';
+
+    mkLay('nav_act_' + i,
+          10,
+          10,
+          x_offset,
+          (y_offset - 1),
+          51,
+          true,
+          main_act,
+          '',
+          '');
+    
+    //make deactivation layer
+    mkLay('closer',
+          0,
+          0,
+          0,
+          0,
+          0,
+          false,
+          '<a href="#" onmouseover="CloseAll()">' +
+              '<img src="' + blank_src + '"' +
+              '     width=850' + 
+              '     height=800' +
+              '     border=0></a>',
+          '',
+          '');
+
+    if (orientation == 'horizontal') {
+	var x3 = x_offset;
+	var x4 = x_offset;
+    } else {
+	var x3 = (x_offset + element_width);
+	var x4 = (x_offset + 2 * element_width);
+    }
+
+    //make first-level cascade highlight layer
+    mkLay2('casc1_highlight',
+          (element_width - menu_spacing),
+          element_height,
+	  x3,
+          y_offset,
+          2,
+          false,
+          '<body background="'+sub_menu_hl_img_url+'" marginwidth=0 marginheight=0 leftmargin=0 topmargin=0>',
+	  '<div class="submenuhl"><img width='+(element_width - menu_spacing)+' height='+(element_height)+' src='+blank_src+'></div>',
+          'bgcolor=' + sub_menu_hl_color,
+	  'background-color: ' + sub_menu_hl_color + ';');
+
+    //make second-level cascade highlight layer
+    mkLay2('casc2_highlight',
+          element_width,
+          element_height,
+          x4,
+          y_offset,
+	  2,
+          false,
+          '<body background="'+sub_sub_menu_hl_img_url+'" marginwidth=0 marginheight=0 leftmargin=0 topmargin=0>',
+	  '<div class="subsubmenuhl"><img width='+(element_width - menu_spacing)+' height='+(element_height)+' src='+blank_src+'></div>',
+          'bgcolor=' + sub_sub_menu_hl_color,
+	  'background-color:' + sub_sub_menu_hl_color + ';');
+}
+
+//CloseAll
+//closes all opened explore items
+//called by giant mouseover layer activated by any rollover
+function CloseAll(){
+    visLay("nav_highlight",false);
+    visLay(last_casc1, false);
+    visLay(last_casc1 + '_bg', false);
+    visLay(last_casc1 + '_act', false);
+    visLay("casc1_highlight",false);
+    //SwitchImg(last_subarrow,subarrow_off,"document.layers['nav_layers'].");
+    
+    if (last_casc2 != ""){
+	visLay(last_casc2, false);
+	visLay(last_casc2 + '_bg', false);
+	visLay(last_casc2 + '_act', false);
+    }
+    visLay("casc2_highlight",false);
+    
+    visLay("closer",false);
+}
+
+//TopOver
+//handles toplevel mouseovers
+function TopOver(which,x,y){
+    //first turn stuff off
+    visLay(last_casc1, false);
+    visLay(last_casc1 + '_bg', false);
+    visLay(last_casc1 + '_act', false);
+    visLay("casc1_highlight",false);
+    if (last_casc2 != ""){
+	visLay(last_casc2, false);
+	visLay(last_casc2 + '_bg', false);
+	visLay(last_casc2 + '_act', false);
+    }
+    visLay("casc2_highlight",false);
+    //SwitchImg(last_subarrow,subarrow_off,"document.layers['nav_layers'].");
+    
+    //then turn stuff on
+    LayerPos('nav_highlight',x,y);
+    visLay('nav_highlight',true);
+    var my_cascade = 'casc1_' + which;
+    last_casc1 = my_cascade;
+    
+    visLay(my_cascade, true);
+    visLay(my_cascade + '_bg', true);
+    visLay(my_cascade + '_act', true);
+    //var my_subarrow = 'subarrow_' + which;
+    //last_subarrow = my_subarrow;
+    //SwitchImg(my_subarrow,subarrow_on,"document.layers['nav_layers'].");
+    visLay('closer',true);
+}
+
+//Cascade1Over
+//1st level cascade mouseovers
+function Cascade1Over(which,x,y,hasCascade,cascID){
+    //first turn stuff off
+    if (last_casc2 != ""){
+	visLay(last_casc2, false);
+	visLay(last_casc2 + '_bg', false);
+	visLay(last_casc2 + '_act', false);
+    }
+    visLay("casc2_highlight",false);
+    
+    //then turn stuff on
+    LayerPos("casc1_highlight",x,y);
+    visLay("casc1_highlight",true);
+    
+    if (hasCascade){
+	var my_cascade = 'casc2_' + cascID +"_" + which;
+	last_casc2 = my_cascade;
+	visLay(my_cascade, true);
+	visLay(my_cascade + '_bg', true);
+	visLay(my_cascade + '_act', true);
+    }
+    
+    visLay('closer',true);
+}
+
+//Cascade2Over
+//2nd level cascade mouseovers
+function Cascade2Over(which,x,y){
+    
+    LayerPos("casc2_highlight",x,y);
+    visLay("casc2_highlight",true);
+}
+
+//MapArea
+//returns individual lines of an image map
+//used to build activation layers
+function MapArea(width,height,x,y,url,over,out,level){
+
+    var my_map = '<area shape="rect" coords="';
+    my_map += x + ',' + y + ',' + (x + width) + ',' + (y + height);
+
+    if ((click_to_open_menu) && (level == 'top')) {
+	my_map += '" href="'+ url +'" onclick="'+ over +'; return false;" onmouseout="'+ out +'">\n';
+    } else {
+    	my_map += '" href="'+ url +'" onmouseover="'+ over +'" onmouseout="'+ out +'" onclick="return '+ (url != "#") +';">\n';
+    }
+    return my_map;
+}
+
Index: web/openacs/www/pull-down-menus/standard.js
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/pull-down-menus/standard.js,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/pull-down-menus/standard.js	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,95 @@
+// standard.js
+//
+// by aure@arsdigita.com
+//
+// (but mostly adaptation of anonymous code found on various sites)
+//
+// standard.js,v 1.1.6.1 2000/06/10 03:40:52 ron Exp
+
+//do browser detection here
+//placeholder for now; more robust testing to follow
+var isNN, isIE, isMac;
+var agent = navigator.userAgent;
+var isMac;
+
+if (agent.lastIndexOf('Mac')<0) isMac=false;
+else isMac=true;
+
+if (document.all){
+	if (navigator.appName.indexOf("WebTV") != -1) {
+		isWebTV = true;
+	} else {
+		isIE = true;
+	}
+} else if (document.layers){
+	isNN = true;
+	document.captureEvents(Event.MOUSEMOVE | Event.MOUSEUP | Event.RESIZE);
+    window.onresize=myResizeFunction;
+}
+
+//standard handler for dealing with
+//netscape's bad habits
+if (isNN)
+{var ws = window.innerWidth;
+ var hs = window.innerHeight;}
+
+function myResizeFunction()
+{if (isNN)
+ {if ((window.innerWidth != ws) || (window.innerHeight != hs))
+       {window.location.href=window.location.href;}
+	   }
+}
+
+//makes layers, courtesy of peterg
+function mkLay(n,w,h,x,y,z,vis,cnt,exn,exe) {
+	if (isNN) {
+		vis == 1 ? vis='show' : vis='hide';
+		document.write('<layer width='+w+' height='+h+' left='+x+' top='+y+' name="'+n+'" z-index='+z+' visibility="'+vis+'" '+exn+'>'+cnt+'</layer>');
+	} else if (isIE) {
+		vis == 1 ? vis='visible' : vis='hidden';
+		document.write('<div id="'+n+'" style="position:absolute;width:'+w+';height:'+h+';left:'+x+';top:'+y+';z-index:'+z+';visibility:'+vis+';'+exe+'" >'+cnt+'</div>');
+	}
+}
+
+//makes layers, courtesy of peterg
+function mkLay2(n,w,h,x,y,z,vis,cntn,cnte, exn,exe) {
+	if (isNN) {
+		vis == 1 ? vis='show' : vis='hide';
+		document.write('<layer width='+w+' height='+h+' left='+x+' top='+y+' name="'+n+'" z-index='+z+' visibility="'+vis+'" '+exn+'>'+cntn+'</layer>');
+	} else if (isIE) {
+		vis == 1 ? vis='visible' : vis='hidden';
+		document.write('<div id="'+n+'" style="position:absolute;width:'+w+';height:'+h+';left:'+x+';top:'+y+';z-index:'+z+';visibility:'+vis+';'+exe+'" >'+cnte+'</div>');
+	}
+}
+
+
+//cross-browser function to handle layer visibility
+function visLay(nme,vis) {
+	if (isNN) {
+		vis ? vis='show' : vis='hide';
+		document.layers[nme].visibility=vis;
+	} else if (isIE) {
+		vis ? vis='visible' : vis='hidden';
+		document.all[nme].style.visibility=vis;
+	}
+}
+
+//cross-browser layer positioning
+function LayerPos(id,x,y){
+	if (isNN){
+		if (x != null) document.layers[id].left = x;
+		if (y != null) document.layers[id].top = y;
+	} else if(isIE){
+		if (x != null) document.all[id].style.posLeft = x;
+		if (y != null) document.all[id].style.posTop = y;
+	}
+}
+
+
+function SwitchImg(which,newSrc,nnLayer){
+	var layerInfo = "";
+	if (isNN){
+		layerInfo = nnLayer;
+	}
+	eval(layerInfo + "document.images['" + which + "'].src = '" + newSrc.src + "'");
+}
Index: web/openacs/www/pull-down-menus/style.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/pull-down-menus/style.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/pull-down-menus/style.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,97 @@
+# /pull-down-menus/style.tcl
+#
+# by aure@arsdigita.com, Feb 2000
+#
+# gets the navbar style parameters from the database and
+# outputs a cascading style sheet
+
+ad_page_variables {menu_id}
+
+validate_integer menu_id $menu_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "
+    select main_menu_font_style, 
+           sub_menu_font_style, 
+           sub_sub_menu_font_style,
+           main_menu_bg_img_url, 
+           sub_menu_bg_img_url, 
+           main_menu_hl_img_url, 
+           sub_menu_hl_img_url,
+           sub_sub_menu_bg_img_url, 
+           sub_sub_menu_hl_img_url
+    from   pdm_menus
+    where  menu_id = $menu_id"]
+
+set_variables_after_query
+
+ns_return 200 text/html "
+.mainmenufont { 
+    $main_menu_font_style
+}
+.submenufont {
+    $sub_menu_font_style
+}
+
+.subsubmenufont {
+    $sub_sub_menu_font_style
+}
+
+
+.submenu {
+    background-image: url(\"$sub_menu_bg_img_url\");
+    margin-left: 0;
+    left: 0;
+    padding: 0;
+    border-width: 0;
+}
+
+
+.submenuhl {
+    background-image: url(\"$sub_menu_hl_img_url\");
+    margin-left: 0;
+    left: 0;
+    padding: 0;
+    border-width: 0;
+}
+.subsubmenu {
+    background-image: url(\"$sub_sub_menu_bg_img_url\");
+    margin-left: 0;
+    left: 0;
+    padding: 0;
+    border-width: 0;
+}
+
+
+.subsubmenuhl {
+    background-image: url(\"$sub_sub_menu_hl_img_url\");
+    margin-left: 0;
+    left: 0;
+    padding: 0;
+    border-width: 0;
+}
+
+.mainmenu {
+    background-image: url(\"$main_menu_bg_img_url\");
+    margin-left: 0;
+    left: 0;
+    padding: 0;
+    border-width: 0;
+}
+
+
+.mainmenuhl {
+    background-image: url(\"$main_menu_hl_img_url\");
+    margin-left: 0;
+    left: 0;
+    padding: 0;
+    border-width: 0;
+}
+
+
+"
+
+
+
+
Index: web/openacs/www/pvt/alerts.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/pvt/alerts.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/pvt/alerts.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,133 @@
+# alerts.tcl,v 3.2 2000/03/10 01:41:17 mbryzek Exp
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select first_names, last_name, email, url from users where user_id=$user_id"]
+set_variables_after_query
+
+if { ![empty_string_p $first_names] || ![empty_string_p $last_name] } {
+    set full_name "$first_names $last_name"
+} else {
+    set full_name "name unknown"
+}
+
+ReturnHeaders
+set page_content "
+[ad_header "$full_name's alerts in [ad_system_name]"]
+
+[ad_decorate_top "<h2>Email Alerts</h2>
+
+for $full_name in [ad_system_name]
+" [ad_parameter AlertPageDecoration pvt]]
+
+<hr>
+
+
+"
+
+set wrote_something_p 0
+
+if [ns_table exists $db "bboard_email_alerts"] {
+    set selection [ns_db select $db "select bea.valid_p, bea.frequency, bea.keywords, bt.topic, bea.oid as rowid
+    from bboard_email_alerts bea, bboard_topics bt
+    where bea.user_id = $user_id
+    and bea.topic_id = bt.topic_id
+    order by bea.frequency"]
+
+    set counter 0
+    while {[ns_db getrow $db $selection]} {
+	set_variables_after_query
+	incr counter
+	if { $valid_p == "f" } {
+	    # alert has been disabled for some reason
+	    set status "Disabled"
+	    set action "<a href=\"/bboard/alert-reenable.tcl?rowid=[ns_urlencode $rowid]\">Re-enable</a>"
+	} else {
+	    # alert is enabled
+	    set status "<font color=red>Enabled</font>"
+	    set action "<a href=\"/bboard/alert-disable.tcl?rowid=[ns_urlencode $rowid]\">Disable</a>"
+	}
+	append existing_alert_rows "<tr><td>$status</td><td>$action</td><td>$topic</td><td>$frequency</td>"
+	if { [bboard_pls_blade_installed_p] == 1 } {
+	    append existing_alert_rows "<td>\"$keywords\"</td>"
+	}
+	append existing_alert_rows "</tr>\n"
+
+    }
+
+    if  { $counter > 0 } {
+	set wrote_something_p 1
+	set keyword_header ""
+	if { [bboard_pls_blade_installed_p] == 1 } {
+	    set keyword_header "<th>Keywords</th>"
+	}
+	append page_content "<h3>Your discussion forum alerts</h3>
+
+	<blockquote>
+	<table>
+	<tr><th>Status</th><th>Action</th><th>Topic</th><th>Frequency</th>$keyword_header</tr>
+
+	$existing_alert_rows
+	</table>
+	</blockquote>
+	"
+    }
+}
+
+
+if [ns_table exists $db "classified_email_alerts"] {
+    set selection [ns_db select $db "select cea.*,cea.oid as rowid, ad.domain as domain
+    from classified_email_alerts cea, ad_domains ad
+    where user_id=$user_id
+    and cea.domain_id=ad.domain_id
+    and sysdate() <= expires
+    order by expires desc"]
+
+    set alert_rows ""
+    set counter 0
+
+    while {[ns_db getrow $db $selection]} {
+	set_variables_after_query
+	incr counter
+	if { $valid_p == "f" } {
+	    # alert has been disabled for some reason
+	    set status "Off"
+	    set action "<a href=\"/gc/alert-reenable.tcl?rowid=$rowid\">Re-enable</a>"
+	} else {
+	    # alert is enabled
+	    set status "<font color=red>On</font>"
+	    set action "<a href=\"/gc/alert-disable.tcl?rowid=$rowid\">Disable</a>"
+	}
+	append alert_rows "<tr><td>$status</td><td>$action</td><td>$domain</td>
+	<td><a href=\"/gc/alert-extend.tcl?rowid=$rowid\">$expires</a></td>
+	<td>[gc_PrettyFrequency $frequency]</td><td>$alert_type</td>"
+	if { $alert_type == "all" } {
+	    append alert_rows "<td>--</td></tr>\n"
+	} elseif { $alert_type == "keywords" } {
+	    append alert_rows "<td>$keywords</td></tr>\n"
+	} elseif { $alert_type == "category" } {
+	    append alert_rows "<td>$category</td></tr>\n"
+	}
+    }
+
+    if { $counter > 0 } {
+	set wrote_something_p 1
+	append page_content "<h3>Your [gc_system_name] alerts</h3>
+	<table border><tr><th>Status</th><th>Action</th><th>Domain</th><th>Expires</th><th>Frequency</th><th>Alert Type</th><th>type-specific info</th></tr>
+	$alert_rows
+	</table>"
+    }
+}
+
+if !$wrote_something_p {
+    ns_write "$page_content
+<p>You currently have no email alerts registered." 
+} else {
+    ns_write "$page_content"
+}
+
+ns_write "
+
+[ad_footer]
+"
Index: web/openacs/www/pvt/basic-info-update-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/pvt/basic-info-update-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/pvt/basic-info-update-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,101 @@
+# basic-info-update-2.tcl,v 3.3 2000/03/10 01:12:19 mbryzek Exp
+set_the_usual_form_variables
+
+# first_names, last_name, email, url, screen_name, bio
+# return_url (optional)
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect /register/
+    return
+}
+
+set db [ns_db gethandle]
+
+set exception_text ""
+set exception_count 0
+
+if { ![info exists first_names] || [empty_string_p $first_names] } {
+    append exception_text "<li>You need to type in a first name\n"
+    incr exception_count
+}
+
+
+if { ![info exists last_name] || [empty_string_p $last_name] } {
+    append exception_text "<li>You need to type in a last name\n"
+    incr exception_count
+}
+
+
+if {[info exists first_names] && [string first "<" $first_names] != -1} {
+    incr exception_count
+    append exception_text "<li> You can't have a &lt; in your first name because it will look like an HTML tag and confuse other users."
+}
+
+if {[info exists last_name] && [string first "<" $last_name] != -1} {
+    incr exception_count
+    append exception_text "<li> You can't have a &lt; in your last name because it will look like an HTML tag and confuse other users."
+}
+
+if { ![info exists email] || [empty_string_p $email] } {
+    append exception_text "<li>You need to type in an email address\n"
+    incr exception_count
+}
+
+if {![empty_string_p $screen_name]} {
+    # screen name was specified.
+    set sn_unique_p [database_to_tcl_string $db "
+    select count(*) from users where screen_name='$screen_name' and user_id != $user_id"]
+    if {$sn_unique_p != 0} {
+	append exception_text "<li>The screen name you have selected is already taken.\n"
+	incr exception_count
+    }
+}
+
+if { ![info exists bio] } {
+    set bio "" 
+} elseif { [string length $bio] >= 4000 } {
+    append exception_text "<li> Your biography is too long. Please limit it to 4000 characters"
+    incr exception_count
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+if { [database_to_tcl_string $db "select count(user_id) from users where upper(email) = '[string toupper $QQemail]' and user_id <> $user_id"] > 0 } {
+    ad_return_error "$email already in database" "The email address \"$email\" is already in the database.  If this is your email address, perhaps you're trying to combine two accounts?  If so, please email <a href=\"mailto:[ad_system_owner]\">[ad_system_owner]</a> with your request."
+    return
+}
+
+if { [empty_string_p $screen_name] } {
+    set screen_name_sql null
+} else {
+    set screen_name_sql "'$screen_name'"
+}
+
+    set sql "update users
+    set first_names = '$QQfirst_names',
+    last_name = '$QQlast_name',
+    email = '$QQemail',
+    url = '$QQurl',
+    screen_name=$screen_name_sql,
+    bio='$QQbio'
+    where user_id = $user_id"
+
+if [catch { ns_db dml $db $sql } errmsg] {
+    ad_return_error "Ouch!"  "The database choked on our update:
+<blockquote>
+$errmsg
+</blockquote>
+"
+} else {
+    if { [exists_and_not_null return_url] } {
+	ns_returnredirect $return_url
+    } else {
+	ns_returnredirect home.tcl
+    }
+}
+
Index: web/openacs/www/pvt/basic-info-update.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/pvt/basic-info-update.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/pvt/basic-info-update.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,49 @@
+# basic-info-update.tcl,v 3.2 2000/03/10 01:12:19 mbryzek Exp
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select first_names, last_name, email, url, screen_name, bio from users where user_id=$user_id"]
+set_variables_after_query
+
+ReturnHeaders 
+
+ns_write "
+[ad_header "Update Basic Information"]
+
+<h2>Update Basic Information</h2>
+
+in [ad_site_home_link]
+
+<hr>
+
+<form method=POST action=\"basic-info-update-2.tcl\">
+[export_form_vars return_url]
+<table>
+<tr>
+<tr>
+ <th>Name:<td><input type=text name=first_names size=20 value=\"[philg_quote_double_quotes $first_names]\"> <input type=text name=last_name size=25 value=\"[philg_quote_double_quotes $last_name]\">
+</tr>
+<tr>
+ <th>email address:<td><input type=text name=email size=30 value=\"[philg_quote_double_quotes $email]\">
+</tr>
+<tr>
+ <th>Personal URL:<td><input type=text name=url size=50 value=\"[philg_quote_double_quotes $url]\"></tr>
+</tr>
+<tr>
+ <th>screen name:<td><input type=text name=screen_name size=30 value=\"[philg_quote_double_quotes $screen_name]\">
+</tr>
+<tr>
+<th>Biography:<td><textarea name=bio rows=10 cols=50 wrap=soft>[philg_quote_double_quotes $bio]</textarea></td>
+</tr>
+</table>
+
+<br>
+<br>
+<center>
+<input type=submit value=\"Update\">
+</center>
+
+[ad_footer]
+"
Index: web/openacs/www/pvt/content-help.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/pvt/content-help.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/pvt/content-help.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,30 @@
+# content-help.tcl,v 3.0 2000/02/06 03:53:31 ron Exp
+set_the_usual_form_variables
+# section_id
+
+validate_integer section_id $section_id
+
+set user_id [ad_verify_and_get_user_id]
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "
+select section_pretty_name, help_blurb
+from content_sections
+where section_id = $section_id"]
+
+set_variables_after_query
+
+ReturnHeaders 
+ns_write "
+[ad_header "$section_pretty_name help"]
+[ad_decorate_top "<h2>$section_pretty_name help</h2>
+[ad_context_bar_ws "Help"]
+" [ad_parameter WorkspacePageDecoration pvt]]
+
+<hr>
+
+$help_blurb
+
+[ad_footer]
+"
+
Index: web/openacs/www/pvt/home.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/pvt/home.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/pvt/home.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,326 @@
+# /pvt/home.tcl
+#
+# user's workspace page
+#
+# written by lots of folks at lots of times and expected to change
+#
+# home.tcl,v 3.4 2000/03/10 01:47:43 mbryzek Exp
+
+set user_id [ad_verify_and_get_user_id]
+
+# sync up the curriculum system if necessary 
+if [ad_parameter EnabledP curriculum 0] {
+    set new_cookie [curriculum_sync]
+    if ![empty_string_p $new_cookie] {
+	ns_set put [ns_conn outputheaders] "Set-Cookie" "CurriculumProgress=$new_cookie; path=/; expires=Fri, 01-Jan-2010 01:00:00 GMT"
+    }
+}
+
+set db [ns_db gethandle]
+
+# If there are requirements to fulfill.
+if {[database_to_tcl_string $db "select user_fulfills_requirements_p($user_id) from dual"] == "f"} {
+    ns_returnredirect "fulfill-requirements.tcl"
+    return
+}
+
+# if this user is part of intranet employees, send 'em over!
+if { [ad_parameter IntranetEnabledP intranet 0] == 1 } {
+    if { [im_user_is_employee_p $db $user_id] } {
+	ns_returnredirect /intranet/index.tcl
+	return
+    }	
+    if { [im_user_is_customer_p $db $user_id] } {
+	set portal_extension [ad_parameter PortalExtension portals .ptl]
+	set group_name [ad_parameter CustomerPortalName intranet "Customer Portals"]
+	regsub -all { } [string tolower $group_name] {-} group_name_in_link 
+	ns_returnredirect "/portals/${group_name_in_link}-1$portal_extension"
+	return
+    }	
+}
+
+set selection [ns_db 0or1row $db "select 
+  first_names, 
+  last_name, 
+  email, 
+  url, 
+  portrait_upload_date,
+  portrait_client_file_name,
+  coalesce(screen_name,'&lt none set up &gt') as screen_name,
+  bio
+from users 
+where user_id=$user_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Account Unavailable" "We can't find you (user #$user_id) in the users table.  Probably your account was deleted for some reason.  You can visit <a href=\"/register/logout.tcl\">the log out page</a> and then start over."
+    return
+}
+
+set_variables_after_query
+
+if { ![empty_string_p $first_names] || ![empty_string_p $last_name] } {
+    set full_name "$first_names $last_name"
+} else {
+    set full_name "name unknown"
+}
+
+if [ad_parameter SolicitPortraitP "user-info" 0] {
+    # we have portraits for some users 
+    set portrait_chunk "<h4>Your Portrait</h4>\n"
+    if { ![empty_string_p $portrait_upload_date] } {
+	append portrait_chunk "On [util_AnsiDatetoPrettyDate $portrait_upload_date], you uploaded <a href=\"portrait/\">$portrait_client_file_name</a>."
+    } else {
+	append portrait_chunk "Show everyone else at [ad_system_name] how great looking you are:  <a href=\"portrait/upload.tcl\">upload a portrait</a>"
+    }
+} else {
+    set portrait_chunk ""
+}
+
+# [ad_decorate_top "<h2>$full_name</h2>
+# workspace at [ad_system_name]
+# " [ad_parameter WorkspacePageDecoration pvt]]
+
+
+
+set page_content "
+[ad_header "$full_name's workspace at [ad_system_name]"]
+<h2>$full_name's workspace at [ad_system_name]</h2>
+[ad_context_bar [list / Home] "Your workspace"]
+
+<hr>
+
+<ul>
+"
+
+
+if { [ad_parameter IntranetEnabledP intranet 0] == 1 } {
+    if { [im_user_is_authorized_p $db [ad_get_user_id]] } {
+	append page_content "<li><a href=\"/shared/new-stuff.tcl\">new content</a> (site-wide)\n"
+    }
+}
+
+
+append page_content "<p>\n"
+
+
+set selection [ns_db select $db "
+select section_id, section_url_stub, section_pretty_name, intro_blurb, help_blurb
+from content_sections
+where enabled_p = 't'
+and scope='public'
+order by sort_key, upper(section_pretty_name)"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    append content_section_items "<li><a href=\"$section_url_stub\">$section_pretty_name</a>\n"
+    if ![empty_string_p $intro_blurb] {
+	append content_section_items " - $intro_blurb"
+    }
+    if ![empty_string_p $help_blurb] {
+	append content_section_items "[ad_space 2]<font size=-1><a href=\"content-help.tcl?[export_url_vars section_id]\">help</a></font>"
+    }
+    append content_section_items "<br>\n"
+}
+
+if [info exists content_section_items] {
+    append page_content $content_section_items
+}
+
+set site_map [ad_parameter SiteMap content]
+
+if ![empty_string_p $site_map] {
+    append page_content "\n<p>\n<li><a href=\"$site_map\">site map</a>\n"
+}
+
+set selection [ns_db select $db "select ug.group_id, ug.group_name, ai.url as ai_url
+from  user_groups ug, administration_info ai
+where ug.group_id = ai.group_id
+and ad_group_member_p ( $user_id, ug.group_id ) = 't'"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append admin_items "<li><a href=\"$ai_url\">$group_name</a>\n"
+}
+
+if [info exists admin_items] {
+    append page_content "<p>
+
+<li>You have the following administrative roles for this site:
+<ul>
+$admin_items
+</ul>
+<P>
+"
+}
+
+set selection [ns_db select $db "select ug.group_id, ug.group_name, ug.short_name
+from user_groups ug
+where ug.group_type <> 'administration'
+and ad_group_member_p ( $user_id, ug.group_id ) = 't'"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append group_items "<li><a href=\"[ug_url]/[ad_urlencode $short_name]/\">$group_name</a>\n"
+}
+
+#  if [info exists group_items] {
+#      append page_content "<p>
+
+#  <li>You're a member of the following groups:
+#  <ul>
+#  $group_items
+#  </ul>
+#  <P>
+#  "
+#  }
+
+# if { [ad_parameter IntranetEnabledP intranet 0] == 1 } {
+#    # Right now only employees can see the intranet
+#    # append page_content "    <li><a href=\"[ad_parameter IntranetUrlStub intranet "/intranet"]\">Intranet</a><p>\n"
+#}
+
+if { [ad_parameter StaffServerP "" 0] == 1 } {
+
+    append page_content "
+    <p>
+    
+    <li><a href=\"/file-storage/\">Documentation</a>
+
+    <p>
+
+    <li><a href=\"/ticket/\">Project and bug tracking</a>
+
+    <P>
+
+    <li><a href=\"/bboard/\">Discussion forums</a>
+
+    <P>
+
+"
+
+}
+
+set hp_html ""
+
+if {[ad_parameter HomepageEnabledP users] == 1} {
+    set hp_html "
+    <h3>Homepages</h3>
+    <ul>
+    <li><a href=/homepage/index.tcl>Homepage Maintenance</a> - Maintain your personal homepage at [ad_parameter SystemName]
+    <p>
+    <li><a href=/homepage/neighborhoods.tcl>Neighborhoods</a> - Browse homepage neighborhoods at [ad_parameter SystemName]
+    <p>
+    <li><a href=/homepage/all.tcl>User Homepages</a> - List user homepages at [ad_parameter SystemName]
+    </ul>
+    "
+}
+
+append page_content "
+
+<p>
+
+<li><a href=\"/register/logout.tcl\">Log Out</a>
+
+<p>
+
+<li><a href=\"password-update.tcl\">Change my Password</a>
+
+
+</ul>
+
+$hp_html
+
+<h3>What we tell other users about you</h3>
+
+In general we identify content that you've posted by your full name.
+In an attempt to protect you from unsolicited bulk email (spam), we
+keep your email address hidden except from other registered users.
+Total privacy is technically feasible but an important element of an
+online community is that people can learn from each other.  So we try
+to make it possible for users with common interests to contact each
+other.
+
+<p>
+
+If you want to check what other users of this service are shown, visit
+<a href=\"/shared/community-member.tcl?[export_url_vars user_id]\">[ad_url]/shared/community-member.tcl?[export_url_vars user_id]</a>.
+
+<h4>Basic Information</h4>
+
+<ul>
+<li>Name:  $full_name
+<li>email address:  $email 
+<li>personal URL:  <a target=new_window href=\"$url\">$url</a>
+<li>screen name:  $screen_name
+<li>biography:  $bio
+<p>
+(<a href=\"basic-info-update.tcl\">update</a>)
+</ul>
+
+$portrait_chunk
+"
+
+#  set selection [ns_db select $db "select 
+#    c.category, 
+#    c.category_id, 
+#    decode(ui.category_id,NULL,NULL,'t') as selected_p
+#  from categories c, (select * 
+#                      from users_interests 
+#                      where user_id = $user_id 
+#                      and interest_level > 0) ui
+#  where c.enabled_p = 't' 
+#  and c.category_id = ui.category_id(+)"]
+
+#  set interest_items ""
+#  while { [ns_db getrow $db $selection] } {
+#      set_variables_after_query
+#      if { $selected_p == "t" } {
+#  	append interest_items "<input name=category_id type=checkbox value=\"$category_id\" CHECKED> $category<br>\n"
+#      } else {
+#  	append interest_items "<input name=category_id type=checkbox value=\"$category_id\"> $category<br>\n"
+#      }
+#  }
+
+#  if ![empty_string_p $interest_items] {
+#      ns_write "
+#  <h3>Your Interests (According to Us)</h3>
+
+#  <form method=POST action=\"interests-update.tcl\">
+#  <blockquote>
+#  $interest_items
+#  <br>
+#  <br>
+#  <input type=submit value=\"Update Interests\">
+#  </blockquote>
+#  </form>
+#  "
+#  }
+
+append page_content "
+
+<h3>If you're getting too much email from us</h3>
+
+Then you should either 
+
+<ul>
+<li><a href=\"alerts.tcl\">edit your alerts</a>
+
+<p>
+
+or
+
+<p>
+
+<li><a href=\"unsubscribe.tcl\">Unsubscribe</a> (for a period of vacation or permanently)
+
+</ul>
+
+
+
+[ad_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $page_content
Index: web/openacs/www/pvt/interests-update.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/pvt/interests-update.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/pvt/interests-update.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,22 @@
+# interests-update.tcl,v 3.0 2000/02/06 03:53:33 ron Exp
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+if { [ns_getform] == "" } {
+    set category_id_list [list]
+} else {
+    set category_id_list [util_GetCheckboxValues [ns_getform] category_id [list]]
+}
+
+ns_db dml $db "begin transaction"
+ns_db dml $db "delete from users_interests where user_id = $user_id"
+foreach category_id $category_id_list {
+    ns_db dml $db "insert into users_interests
+(user_id, category_id, interest_date) 
+values
+($user_id, $category_id, sysdate())"
+}
+ns_db dml $db "end transaction"
+
+ns_returnredirect "home.tcl"
Index: web/openacs/www/pvt/password-update-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/pvt/password-update-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/pvt/password-update-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,94 @@
+# password-update-2.tcl,v 3.0 2000/02/06 03:53:35 ron Exp
+set_the_usual_form_variables
+
+# password_1, password_2, password_old
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect /register/
+    return
+}
+
+set db [ns_db gethandle]
+
+set exception_text ""
+set exception_count 0
+
+set password_query "select password 
+from users 
+where user_id = $user_id
+and user_state = 'authorized'"
+
+set dbpasswd [database_to_tcl_string_or_null $db $password_query]
+
+if {[ad_parameter EncryptPasswordsInDBP "" 0]} {
+    if {[ns_crypt $password_old [ad_crypt_salt]] == $dbpasswd}  {
+	set old_pwd_match_p 1
+    } else {
+	set old_pwd_match_p 0
+    }
+} else {
+    if {$password_old == $dbpasswd}  {
+	set old_pwd_match_p 1
+    } else {
+	set old_pwd_match_p 0
+    }
+}
+
+if {!$old_pwd_match_p } {
+    append exception_text "<li>Your current password does not match what you entered in the form\n"
+    incr exception_count
+}
+
+
+if { ![info exists password_1] || [empty_string_p $password_1] } {
+    append exception_text "<li>You need to type in a password\n"
+    incr exception_count
+}
+
+if { ![info exists password_2] || [empty_string_p $password_2] } {
+    append exception_text "<li>You need to confirm the password that you typed.  (Type the same thing again.) \n"
+    incr exception_count
+}
+
+
+if { [string compare $password_2 $password_1] != 0 } {
+    append exception_text "<li>Your passwords don't match!  Presumably, you made a typo while entering one of them.\n"
+    incr exception_count
+}
+
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# If we are encrypting passwords in the database, do it now.
+if {[ad_parameter EncryptPasswordsInDBP "" 0]} { 
+    set QQpassword_1 [philg_quote_double_quotes [ns_crypt $password_1 [ad_crypt_salt]]]
+}
+
+set sql "update users set password = '$QQpassword_1' where user_id = $user_id"
+
+if [catch { ns_db dml $db $sql } errmsg] {
+    ad_return_error "Ouch!"  "The database choked on our update:
+<blockquote>
+$errmsg
+</blockquote>
+"
+} else {
+    ns_return 200 text/html "[ad_header "Password Updated"]
+
+<h2>Password Updated</h2>
+
+in [ad_site_home_link]
+
+<hr>
+
+You can return to [ad_pvt_home_link]
+
+[ad_footer]
+"
+}
+
Index: web/openacs/www/pvt/password-update.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/pvt/password-update.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/pvt/password-update.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,41 @@
+# password-update.tcl,v 3.0 2000/02/06 03:53:36 ron Exp
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select first_names, last_name, email, url from users where user_id=$user_id"]
+set_variables_after_query
+
+ReturnHeaders 
+
+ns_write "
+[ad_header "Update Password"]
+
+<h2>Update Password</h2>
+
+for $first_names $last_name in [ad_site_home_link]
+
+<hr>
+
+<form method=POST action=\"password-update-2.tcl\">
+
+<table>
+<tr>
+ <th>Current Password:<td><input type=password name=password_old size=15>
+</tr>
+<tr>
+ <th>New Password:<td><input type=password name=password_1 size=15>
+</tr>
+<tr>
+ <th>Confirm:<td><input type=password name=password_2 size=15>
+</tr>
+</table>
+
+<br>
+<br>
+<center>
+<input type=submit value=\"Update\">
+</center>
+
+[ad_footer]
+"
Index: web/openacs/www/pvt/set-on-vacation-to-null.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/pvt/set-on-vacation-to-null.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/pvt/set-on-vacation-to-null.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,40 @@
+# set-on-vacation-to-null.tcl,v 3.1 2000/03/10 01:45:04 mbryzek Exp
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+set on_vacation_until [database_to_tcl_string_or_null $db \
+	"select on_vacation_until from users where user_id = $user_id"]
+
+if { ![empty_string_p $on_vacation_until] } {
+    ns_db dml $db "begin transaction"
+
+    ns_db dml $db "delete from user_vacations 
+where user_id=$user_id 
+and to_char(end_date,'YYYY-MM-DD')='$on_vacation_until'"
+
+    ns_db dml $db "update users set on_vacation_until = NULL where user_id = $user_id"
+
+    ns_db dml $db "end transaction"
+}
+
+ns_db releasehandle $db
+
+ReturnHeaders
+
+ns_write "[ad_header "Vacation Information Updated"]
+
+<h2>Vacation Information Updated</h2>
+
+in [ad_site_home_link]
+
+<hr>
+
+You're marked as back from vacation.
+
+<p>
+
+Please return to [ad_pvt_home_link].
+
+[ad_footer]
+"
Index: web/openacs/www/pvt/set-on-vacation-until.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/pvt/set-on-vacation-until.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/pvt/set-on-vacation-until.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,43 @@
+# set-on-vacation-until.tcl,v 3.1 2000/03/10 01:45:04 mbryzek Exp
+
+if [catch { ns_dbformvalue [ns_conn form] on_vacation_until date on_vacation_until } errmsg] {
+    ad_return_error "Invalid date" "AOLserver didn't like the date that you entered."
+    return
+}
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+ns_db dml $db "begin transaction"
+
+# We update the users table to maintain compatibility with acs installations prior to user_vacations
+ns_db dml $db "update users set on_vacation_until = '$on_vacation_until' where user_id = $user_id"
+
+ns_db dml $db "insert into user_vacations
+(vacation_id, user_id, start_date, end_date, receive_email_p, vacation_type)
+values 
+(user_vacations_vacation_id_seq.nextVal, $user_id, sysdate, '$on_vacation_until', 'f', 'vacation')"
+
+ns_db dml $db "end transaction"
+
+ns_db releasehandle $db
+
+ReturnHeaders
+
+ns_write "[ad_header "Vacation Information Updated"]
+
+<h2>Vacation Information Updated</h2>
+
+in [ad_site_home_link]
+
+<hr>
+
+You won't get any email until after [util_AnsiDatetoPrettyDate $on_vacation_until].
+
+<p>
+
+Please return to [ad_pvt_home_link].
+
+[ad_footer]
+"
Index: web/openacs/www/pvt/toggle-dont-spam-me-p.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/pvt/toggle-dont-spam-me-p.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/pvt/toggle-dont-spam-me-p.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,9 @@
+# toggle-dont-spam-me-p.tcl,v 3.0 2000/02/06 03:53:40 ron Exp
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+ns_db dml $db "update users_preferences set dont_spam_me_p = logical_negation(dont_spam_me_p) where user_id = $user_id"
+
+ns_returnredirect "home.tcl"
Index: web/openacs/www/pvt/unsubscribe-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/pvt/unsubscribe-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/pvt/unsubscribe-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,19 @@
+# unsubscribe-2.tcl,v 3.0 2000/02/06 03:53:41 ron Exp
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+ns_db dml $db "update users set deleted_date=sysdate(),
+               deleting_user = $user_id, user_state = 'deleted'
+               where user_id = $user_id"
+
+ns_return 200 text/html "[ad_header "Account deleted"]
+
+<h2>Account Deleted</h2>
+
+<hr>
+
+Your account at [ad_system_name] has been marked \"deleted\".
+
+[ad_footer]
+"
Index: web/openacs/www/pvt/unsubscribe.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/pvt/unsubscribe.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/pvt/unsubscribe.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,65 @@
+# unsubscribe.tcl,v 3.0.4.1 2000/03/15 05:52:29 hqm Exp
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select on_vacation_until, on_vacation_p(on_vacation_until) as on_vacation_p 
+from users
+where user_id = $user_id"]
+set_variables_after_query
+
+ReturnHeaders
+ns_write "[ad_header "Confirm Unsubscribe"]
+
+<h2>Confirm</h2>
+
+that you'd like to unsubscribe from [ad_site_home_link]
+
+<hr>
+
+"
+
+if { $on_vacation_p == "t" } {
+    ns_write "You are current marked as being on vacation until [util_AnsiDatetoPrettyDate $on_vacation_until].  If you'd like to start receiving email alerts again, just <a href=\"set-on-vacation-to-null.tcl\">tell us that you're back</a>."
+} else {
+    ns_write "If you are interested in this community but wish to stop receiving
+email then you might want to 
+
+<ul>
+<li>tell the system that you're going on vacation until 
+<form method=get action=set-on-vacation-until.tcl>
+[philg_dateentrywidget_default_to_today on_vacation_until]
+<input type=submit value=\"Put email on hold\">
+</form>
+<p>
+"
+}
+
+set selection [ns_db 0or1row $db "select dont_spam_me_p from users_preferences where user_id = $user_id"]
+
+if { $selection != "" } {
+    set_variables_after_query
+    if { $dont_spam_me_p != "t" } {
+	ns_write "
+<li>The system is currently set to send you email notifications. Click here to  <a href=\"toggle-dont-spam-me-p.tcl\">tell the system not to send you any email notifications</a>.
+"
+    } else {
+	ns_write "
+<li>The system is currently set to <i>not</i> send you any email notifications. Click here <a href=\"toggle-dont-spam-me-p.tcl\">allow system to send you email notifications</a>.
+"	
+  }
+}
+
+ns_write "
+
+
+</ul>
+
+<p>
+
+However, if you've totally lost interest in this community or topic,
+then you can <a href=\"unsubscribe-2.tcl\">ask the server to mark your
+account as deleted</a>.
+
+[ad_footer]"
Index: web/openacs/www/pvt/portrait/erase-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/pvt/portrait/erase-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/pvt/portrait/erase-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,30 @@
+# erase-2.tcl,v 3.0 2000/02/06 03:53:43 ron Exp
+# 
+# /pvt/portrait/erase-2.tcl
+#
+# by philg@mit.edu on September 26, 1999
+#
+# erase's a user's portrait (NULLs out columns in the database)
+#
+# the key here is to null out portrait_upload_date, which is 
+# used by pages to determine portrait existence 
+# 
+
+ad_maybe_redirect_for_registration
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+ns_db dml $db "update users
+set lob = NULL,
+    portrait_comment = NULL,
+    portrait_client_file_name = NULL,
+    portrait_file_type = NULL,
+    portrait_file_extension = NULL,
+    portrait_original_width = NULL,
+    portrait_original_height = NULL,
+    portrait_upload_date = NULL
+where user_id = $user_id"
+
+ns_returnredirect "/pvt/home.tcl"
Index: web/openacs/www/pvt/portrait/erase.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/pvt/portrait/erase.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/pvt/portrait/erase.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,18 @@
+# erase.tcl,v 3.0 2000/02/06 03:53:45 ron Exp
+ns_return 200 text/html "[ad_header "Erase Portrait"]
+
+<h2>Erase Portrait</h2>
+
+[ad_context_bar_ws [list "index.tcl" "Your Portrait"] "Erase"]
+
+<hr>
+
+Are you sure that you want to erase your portrait?
+
+<center>
+<form method=GET action=\"erase-2.tcl\">
+<input type=submit value=\"Yes, I'm sure\">
+</center>
+
+[ad_footer]
+"
Index: web/openacs/www/pvt/portrait/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/pvt/portrait/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/pvt/portrait/index.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,85 @@
+# index.tcl,v 3.0 2000/02/06 03:53:46 ron Exp
+# 
+# /pvt/portrait/index.tcl
+#
+# by philg@mit.edu on September 26, 1999
+#
+# displays a user's portrait to the user him/herself
+# offers options to replace it
+
+ad_maybe_redirect_for_registration
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select 
+  first_names, 
+  last_name, 
+  portrait_upload_date,
+  portrait_comment,
+  portrait_original_width,
+  portrait_original_height,
+  portrait_client_file_name
+from users 
+where user_id=$user_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Account Unavailable" "We can't find you (user #$user_id) in the users table.  Probably your account was deleted for some reason."
+    return
+}
+
+set_variables_after_query
+
+if [empty_string_p $portrait_upload_date] {
+    ad_return_complaint 1 "<li>You shouldn't have gotten here; we don't have a portrait on file for you."
+    return
+}
+
+if { ![empty_string_p $portrait_original_width] && ![empty_string_p $portrait_original_height] } {
+    set widthheight "width=$portrait_original_width height=$portrait_original_height"
+} else {
+    set widthheight ""
+}
+
+ns_return 200 text/html "[ad_header "Portrait of $first_names $last_name"]
+
+<h2>Portrait of $first_names $last_name</h2>
+
+[ad_context_bar_ws "Your Portrait"]
+
+<hr>
+
+This is the image that we show to other users at [ad_system_name]:
+
+<br>
+<br>
+
+<center>
+<img $widthheight src=\"/shared/portrait-bits.tcl?[export_url_vars user_id]\">
+</center>
+
+Data:
+
+<ul>
+<li>Uploaded:  [util_AnsiDatetoPrettyDate $portrait_upload_date]
+<li>Original Name:  $portrait_client_file_name
+<li>Comment:  
+<blockquote>
+$portrait_comment
+</blockquote>
+</ul>
+
+Options:
+
+<ul>
+<li><a href=\"upload.tcl\">upload a replacement</a>
+
+<p>
+
+<li><a href=\"erase.tcl\">erase</a>
+
+</ul>
+
+[ad_footer]
+"
Index: web/openacs/www/pvt/portrait/upload-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/pvt/portrait/upload-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/pvt/portrait/upload-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,115 @@
+# upload-2.tcl,v 3.0 2000/02/06 03:53:47 ron Exp
+# 
+# /pvt/portrait/upload-2.tcl
+#
+# by philg@mit.edu on September 26, 1999
+#
+# adds (or replaces) a user's portrait
+# 
+
+# Fix by BMA (reported by michael@cleverly.com)
+ad_page_variables {
+    upload_file
+    {portrait_comment ""}
+    {return_url ""}
+}
+
+ad_maybe_redirect_for_registration
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+# upload_file is the only required one; portrait_comment may be empty
+# return_url (optional)
+
+if { ![info exists QQportrait_comment] || [empty_string_p $QQportrait_comment] } {
+    set complete_portrait_comment "NULL"
+} else {
+    set complete_portrait_comment "'$QQportrait_comment'"
+}
+
+
+set exception_text ""
+set exception_count 0
+
+if { ![info exists upload_file] || [empty_string_p $upload_file] } {
+    append exception_text "<li>Please specify a file to upload\n"
+    incr exception_count
+} else {
+    # this stuff only makes sense to do if we know the file exists
+    set tmp_filename [ns_queryget upload_file.tmpfile]
+
+    set file_extension [string tolower [file extension $upload_file]]
+
+    # remove the first . from the file extension
+    regsub "\." $file_extension "" file_extension
+
+    set guessed_file_type [ns_guesstype $upload_file]
+
+    set n_bytes [file size $tmp_filename]
+
+    # check to see if this is one of the favored MIME types,
+    # e.g., image/gif or image/jpeg
+    if { ![empty_string_p [ad_parameter AcceptablePortraitMIMETypes "user-info"]] && [lsearch [ad_parameter AcceptablePortraitMIMETypes "user-info"] $guessed_file_type] == -1 } {
+	incr exception_count
+	append exception_text "<li>Your image wasn't one of the acceptable MIME types:   [ad_parameter AcceptablePortraitMIMETypes "user-info"]"
+    }
+
+    # strip off the C:\directories... crud and just get the file name
+    if ![regexp {([^/\\]+)$} $upload_file match client_filename] {
+	# couldn't find a match
+	set client_filename $upload_file
+    }
+
+    if { ![empty_string_p [ad_parameter MaxPortraitBytes "user-info"]] && $n_bytes > [ad_parameter MaxPortraitBytes "user-info"] } {
+	append exception_text "<li>Your file is too large.  The publisher of [ad_system_name] has chosen to limit portraits to [util_commify_number [ad_parameter MaxPortraitBytes "user-info"]] bytes.  You can use PhotoShop or the GIMP (free) to shrink your image.\n"
+	incr exception_count
+    }
+}
+
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+set what_aolserver_told_us ""
+if { $file_extension == "jpeg" || $file_extension == "jpg" } {
+    catch { set what_aolserver_told_us [ns_jpegsize $tmp_filename] }
+} elseif { $file_extension == "gif" } {
+    catch { set what_aolserver_told_us [ns_gifsize $tmp_filename] }
+}
+
+# the AOLserver jpegsize command has some bugs where the height comes 
+# through as 1 or 2 
+if { ![empty_string_p $what_aolserver_told_us] && [lindex $what_aolserver_told_us 0] > 10 && [lindex $what_aolserver_told_us 1] > 10 } {
+    set original_width [lindex $what_aolserver_told_us 0]
+    set original_height [lindex $what_aolserver_told_us 1]
+} else {
+    set original_width ""
+    set original_height ""
+}
+
+set portrait_id [database_to_tcl_string $db "select empty_lob()"]
+
+ns_db dml $db "begin"
+ns_db dml $db "update users
+set lob = $portrait_id,
+	portrait_comment = $complete_portrait_comment,
+    portrait_client_file_name = '[DoubleApos $client_filename]',
+    portrait_file_type = '[DoubleApos $guessed_file_type]',
+    portrait_file_extension = '[DoubleApos $file_extension]',
+    portrait_original_width = [ns_dbquotevalue $original_width number],
+    portrait_original_height = [ns_dbquotevalue $original_height number],
+    portrait_upload_date = sysdate()
+where user_id = $user_id"
+
+ns_pg blob_dml_file $db $portrait_id $tmp_filename
+ns_db dml $db "end"
+
+if { [exists_and_not_null return_url] } {
+    ns_returnredirect $return_url
+} else {
+    ns_returnredirect "index.tcl"
+}
Index: web/openacs/www/pvt/portrait/upload.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/pvt/portrait/upload.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/pvt/portrait/upload.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,73 @@
+# upload.tcl,v 3.1 2000/02/20 09:52:37 ron Exp
+
+set_form_variables 0
+
+ad_maybe_redirect_for_registration
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select 
+  first_names, 
+  last_name
+from users 
+where user_id=$user_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Account Unavailable" "We can't find you (user #$user_id) in the users table.  Probably your account was deleted for some reason."
+    return
+}
+
+set_variables_after_query
+
+ns_return 200 text/html "[ad_header "Upload Portrait"]
+
+<h2>Upload Portrait</h2>
+
+[ad_context_bar_ws [list "index.tcl" "Your Portrait"] "Upload Portrait"]
+
+<hr>
+
+How would you like the world to see $first_names $last_name?
+
+<p>
+
+Upload your favorite file, a scanned JPEG or GIF, from your desktop
+computer system (note that you can't refer to an image elsewhere on
+the Internet; this image must be on your computer's hard drive).
+
+<blockquote>
+<form enctype=multipart/form-data method=POST action=\"upload-2.tcl\">
+[export_form_vars return_url]
+<table>
+<tr>
+<td valign=top align=right>Filename: </td>
+<td>
+<input type=file name=upload_file size=20><br>
+<font size=-1>Use the \"Browse...\" button to locate your file, then click \"Open\".</font>
+</td>
+</tr>
+<tr>
+<td valign=top align=right>Story Behind Photo
+<br>
+<font size=-1>(optional)</font>
+</td>
+<td><textarea rows=6 cols=50 wrap=soft name=portrait_comment>
+</textarea>
+</td>
+</tr>
+
+</table>
+<p>
+<center>
+<input type=submit value=\"Upload\">
+</center>
+</blockquote>
+</form>
+
+
+
+
+[ad_footer]
+"
Index: web/openacs/www/register/awaiting-approval.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/register/awaiting-approval.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/register/awaiting-approval.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,58 @@
+# awaiting-approval.tcl,v 3.2 2000/03/10 22:15:56 lars Exp
+set_the_usual_form_variables
+
+# user_id
+
+validate_integer user_id $user_id
+
+set db [ns_db gethandle] 
+set selection [ns_db 0or1row $db "select user_state, email
+from users where user_id = $user_id 
+and  (user_state = 'need_admin_approv' or user_state = 'need_email_verification_and_admin_approval' or user_state = 'rejected')"]
+
+if { $selection == "" } {
+    ad_return_error "Couldn't find your record" "User id $user_id is not in the awaiting approval state.  This is probably our programming bug."
+    return
+}
+
+set_variables_after_query
+
+if {![ad_parameter RegistrationRequiresApprovalP "" 0]} {
+    # we are not using the "approval" system
+    # they should not be in this state
+
+    if {$user_state == "need_admin_approv"} {
+	# we don't require email verification
+	set new_user_state "authorized"
+	ns_db dml $db "update users set user_state = 'authorized'
+where user_id = $user_id"
+        ns_returnredirect "user-login.tcl?[export_url_vars email]"
+        return
+    } else {
+	ns_db dml $db "update users set user_state = 'need_email_verification'
+where user_id = $user_id"
+        ns_returnredirect "awaiting-email-verification.tcl?[export_url_vars user_id]"
+        return
+    }
+
+    # try to login again with this new state
+}
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "[ad_header "Awaiting Approval"]
+
+<h2>Awaiting Approval</h2>
+
+<hr>
+
+Your registration request has been submitted 
+to the [ad_system_name] administrator.   It is still
+waiting approval.
+<p>
+Thank you.
+
+[ad_footer]
+"
+
+
Index: web/openacs/www/register/awaiting-email-verification.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/register/awaiting-email-verification.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/register/awaiting-email-verification.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,59 @@
+# awaiting-email-verification.tcl,v 3.1 2000/03/10 22:18:30 lars Exp
+set_the_usual_form_variables
+
+
+# user_id
+
+validate_integer user_id $user_id
+
+set db [ns_db gethandle] 
+set selection [ns_db 0or1row $db "select user_state, email, rowid from users where user_id = $user_id and user_state = 'need_email_verification' or user_state = 'need_email_verification_and_admin_approv'"]
+
+if { $selection == "" } {
+    ns_log Notice "Couldn't find $user_id in /register/awaiting-email-verification.tcl"
+
+    ad_return_error "Couldn't find your record" "User id $user_id is not found in the need email verification state."
+    return
+}
+
+set_variables_after_query
+
+if ![ad_parameter RegistrationRequiresEmailVerificationP "" 0] {
+    # we are not using the "email required verfication" system
+    # they should not be in this state
+
+    if {$user_state == "need_email_verification"} {
+	# we don't require administration approval to get to get authorized
+	set new_user_state "authorized"
+	ns_db dml $db "update users set user_state = 'authorized'
+where user_id = $user_id"
+        ns_returnredirect "user-login.tcl?[export_url_vars email]"
+        return
+    } else {
+	ns_db dml $db "update users set user_state = 'need_admin_approv'
+where user_id = $user_id"
+        ns_returnredirect "awaiting_approval.tcl?[export_url_vars user_id]"
+        return
+    }
+}
+
+ns_db releasehandle $db
+
+# we are waiting for the user to verify their email
+ns_return 200 text/html "[ad_header "Awaiting email verification"]
+
+<h2>Awaiting email verification</h2>
+
+<hr>
+
+Registration information for this service has just been
+sent to $email.
+<p>
+Please read and follow the instructions in this email.
+
+[ad_footer]
+"
+
+# the user has to come back and activate their account
+ns_sendmail  "$email" "[ad_parameter NewRegistrationEmailAddress]" "Welcome to [ad_system_name]" "To confirm your registration, please go to [ad_parameter SystemURL]/register/email-confirm.tcl?[export_url_vars rowid]"
+
Index: web/openacs/www/register/bad-password.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/register/bad-password.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/register/bad-password.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,35 @@
+# bad-password.tcl,v 3.0 2000/02/06 03:53:54 ron Exp
+set_the_usual_form_variables
+
+# user_id
+# maybe return_url (which we ignore right now)
+
+validate_integer user_id $user_id
+
+if {[ad_parameter EmailForgottenPasswordP "" 1]} {
+
+    set email_password_blurb "If you've forgotten your password, <a
+href=\"email-password.tcl?user_id=$user_id\">ask this server to email it
+to you</a>."
+} else {
+    set email_password_blurb ""
+}
+
+ns_return 200 text/html "[ad_header "Bad Password"]
+
+<h2>Bad Password</h2>
+
+in <a href=\"/index.tcl\">[ad_system_name]</a>
+
+<hr>
+
+The password you typed doesn't match what we have in the database.  If
+you think you made a typo, please back up using your browser and
+try again.
+
+<p>
+
+$email_password_blurb
+
+[ad_footer]
+"
Index: web/openacs/www/register/banned-user.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/register/banned-user.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/register/banned-user.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,34 @@
+# banned-user.tcl,v 3.1 2000/03/10 22:21:45 lars Exp
+set_the_usual_form_variables
+
+# user_id
+
+validate_integer user_id $user_id
+
+set db [ns_db gethandle] 
+set selection [ns_db 0or1row $db "select user_state from users where user_id = $user_id"]
+
+if { $selection == "" } {
+    ad_return_error "Couldn't find your record" "User id $user_id is not in the database.  This is probably our programming bug."
+    return
+}
+
+set_variables_after_query
+
+ns_db releasehandle $db
+
+if { $user_state == "banned" } {
+    ns_return 200 text/html "[ad_header "Sorry"]
+
+<h2>Sorry</h2>
+
+<hr>
+
+Sorry but it seems that you've been banned from [ad_system_name].
+
+[ad_footer]
+"
+    return
+} else {
+    ad_return_error "Problem with user authentication" "You have encountered a problem with authentication"
+}
Index: web/openacs/www/register/deleted-user.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/register/deleted-user.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/register/deleted-user.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,39 @@
+# deleted-user.tcl,v 3.1 2000/03/10 22:22:28 lars Exp
+set_the_usual_form_variables
+
+# user_id
+
+validate_integer user_id $user_id
+
+set db [ns_db gethandle] 
+set selection [ns_db 0or1row $db "select user_state from users where user_id = $user_id"]
+
+if { $selection == "" } {
+    ad_return_error "Couldn't find your record" "User id $user_id is not in the database.  This is probably our programming bug."
+    return
+}
+
+set_variables_after_query
+
+ns_db releasehandle $db
+
+if { $user_state == "deleted" } {
+# they presumably deleted themselves
+
+ns_return 200 text/html "[ad_header "Welcome Back"]
+
+<h2>Welcome Back</h2>
+
+to [ad_site_home_link]
+
+<hr>
+
+Your account is currently marked \"deleted\". If you wish, we
+can <a href=\"restore-user.tcl?user_id=$user_id\">restore your account
+to live status</a>.
+
+[ad_footer]
+"
+} else {
+    ad_return_error "Problem with authentication" "You have encountered a problem with authentication"
+}
\ No newline at end of file
Index: web/openacs/www/register/email-confirm.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/register/email-confirm.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/register/email-confirm.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,90 @@
+# email-confirm.tcl,v 1.3.4.1 2000/02/03 10:00:00 ron Exp
+set_the_usual_form_variables
+
+# oid
+
+set db [ns_db gethandle] 
+
+# we take authorized here in case the
+# person responds more than once
+
+set selection [ns_db 0or1row $db "select user_state,
+email, user_id from users 
+where oid = '[DoubleApos $oid]'
+or user_state = 'need_email_verification_and_admin_approv'
+and (user_state = 'need_admin_approv'
+     or user_state = 'authorized')"]
+
+
+if { $selection == "" } {
+    ns_db releasehandle $db
+    ad_return_error "Couldn't find your record" "Row id $oid is not in the database.  Please check your email and verifiy that you have cut and pasted the url correctly."
+    return
+}
+
+set_variables_after_query
+
+
+if {$user_state == "need_email_verification" || $user_state == "authorized"} {
+    ns_db dml $db "update users 
+set email_verified_date = [db_sysdate], user_state = 'authorized' 
+where user_id = $user_id"
+
+    set whole_page "[ad_header "Email confirmation success"]
+
+<h2>Your email is confirmed</h2>
+
+at [ad_site_home_link]
+
+<hr>
+
+Your email has been confirmed. You may now log into
+[ad_system_name].
+
+<p>
+
+<form action=\"user-login.tcl\" method=post>
+[export_form_vars email]
+<input type=submit value=\"Continue\">
+</form>
+
+<p>
+Note: If you've forgotten your password, <a
+href=\"email-password.tcl?user_id=$user_id\">ask this server to email it
+to $email</a>.
+
+[ad_footer]
+"
+
+} else {
+
+    #state is need_email_verification_and_admin_approv or rejected
+    if { $user_state == "rejected" } {
+	ns_db dml $db "update users 
+set email_verified_date = [db_sysdate] 
+where user_id = $user_id"
+     } elseif { $user_state == "need_email_verification_and_admin_approv" } {
+	ns_db dml $db "update users 
+set email_verified_date = [db_sysdate], user_state = 'need_admin_approv' 
+where user_id = $user_id"
+
+    }
+
+    set whole_page "[ad_header "Email confirmation success"]
+
+<h2>Your email is confirmed</h2>
+
+at [ad_site_home_link]
+
+<hr>
+Your email has been confirmed. You are now awaiting approval
+from the [ad_system_name] administrator.
+
+[ad_footer]"
+
+}
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $whole_page
+
Index: web/openacs/www/register/email-password.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/register/email-password.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/register/email-password.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,74 @@
+# email-password.tcl,v 3.3 2000/03/10 22:45:20 lars Exp
+set_the_usual_form_variables
+
+# user_id
+
+validate_integer user_id $user_id
+
+if {![ad_parameter EmailForgottenPasswordP "" 1]} {
+    ad_return_error "Feature disabled" "This feature is disabled on this server."
+    return    
+}
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select password, email 
+from users where user_id=$user_id
+and user_state = 'authorized'"]
+
+if { $selection == "" } {
+    ns_db releasehandle $db
+    ad_return_error "Couldn't find user $user_id" "Couldn't find user $user_id.  This is probably a bug in our code."
+    return
+}
+
+set_variables_after_query
+
+if {[ad_parameter EmailRandomPasswordWhenForgottenP "" 0] || [ad_parameter EncryptPasswordsInDBP "" 0] } {
+    #generate a random password
+    set password [ad_generate_random_string]
+    if  [ad_parameter EncryptPasswordsInDBP "" 0] {
+	# need to encrypt
+	set password_for_database [ns_crypt $password [ad_crypt_salt]]
+    } else {
+	set password_for_database $password
+    }
+    ns_db dml $db "update users set password = '[DoubleApos $password_for_database]'  where user_id= $user_id"
+}
+
+ns_db releasehandle $db
+
+
+# Send email
+if [catch { ns_sendmail $email [ad_system_owner] "Your forgotten password on [ad_system_name]" "Here's how you can log in at [ad_url]:
+
+Username:  $email
+Password:  $password
+
+"} errmsg] {
+    ad_return_error "Error sending mail" "Now we're really in trouble because we got an error trying to send you email:
+<blockquote>
+<pre>
+$errmsg
+</pre>
+</blockquote>
+"
+    return
+}
+
+ns_return 200 text/html "[ad_header "Check Your Inbox"]
+
+<h2>Check Your Inbox</h2>
+
+<hr>
+
+Please check your inbox.  Within the next few minutes, you should find
+a message from [ad_system_owner] containing your password.
+
+<p>
+
+Then come back to <a href=\"user-login.tcl?email=$email\">the login
+page</a> and use [ad_system_name].
+
+
+[ad_footer]"
Index: web/openacs/www/register/explain-persistent-cookies.adp
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/register/explain-persistent-cookies.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/register/explain-persistent-cookies.adp	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,25 @@
+<%= [ad_header "Saving email address and password"] %>
+
+<h2>Saving email address and password</h2>
+
+at <%=[ad_site_home_link]%>
+
+<hr>
+
+Our server can tell your browser to remember certain things, such as
+your email address and password.  This is convenient for you because,
+if you're the only person who uses your computer, you won't have to
+keep telling us your email address and password.
+
+<p>
+
+It would be a very bad idea to choose this option if you're using a
+shared computer in a library or school.  Any subsequent user of this
+machine would be able to masquerade as you on our service.
+
+<p>
+
+Note that you can erase your saved email address and password by
+choosing the "log out" option from your workspace.
+
+<%= [ad_footer] %>
Index: web/openacs/www/register/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/register/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/register/index.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,65 @@
+#
+# Prompt the user for email and password.
+#
+# index.tcl,v 3.2 2000/03/10 21:12:12 michael Exp
+#
+
+set_form_variables 0
+# return_url maybe
+
+set old_login_process [ad_parameter "SeparateEmailPasswordPagesP" "" "0"]
+
+if {![info exists return_url]} {
+    set return_url [ad_pvt_home]
+}
+
+ReturnHeaders
+ns_write "[ad_header "Log In"]
+
+<h2>Log In</h2>
+
+to <a href=/>[ad_system_name]</a>
+
+<hr>
+
+<FORM method=post action=user-login.tcl>
+[export_form_vars return_url]
+<table>
+<tr><td>Your email address:</td><td><INPUT type=text name=email></tr>
+"
+
+if { !$old_login_process } {
+    ns_write "<tr><td>Your password:</td><td><input type=password name=password></td></tr>\n"
+    if [ad_parameter AllowPersistentLoginP "" 1] {
+	if [ad_parameter PersistentLoginDefaultP "" 1] {
+	    set checked_option "CHECKED" 
+	} else {
+	    set checked_option "" 
+	}
+	ns_write "<tr><td colspan=2><input type=checkbox name=persistent_cookie_p value=t $checked_option> 
+	Remember this address and password?
+	(<a href=\"explain-persistent-cookies.adp\">help</a>)</td></tr>\n"
+    }
+}
+
+ns_write "
+
+<tr><td colspan=2 align=center><INPUT TYPE=submit value=\"Submit\"></td></tr>
+</table>
+
+</FORM>
+
+<p>
+
+[ad_style_bodynote "If you keep getting thrown back here, it is probably because your
+browser does not accept cookies.  We're sorry for the inconvenience
+but it really is impossible to program a system like this without
+keeping track of who is posting what.
+
+<p>
+
+In Netscape 4.0, you can enable cookies from Edit -&gt; Preferences
+-&gt; Advanced.  In Microsoft Internet Explorer 4.0, you can enable cookies from View -&gt; Internet Options -&gt; Advanced -&gt; Security."]
+
+[ad_footer]
+"
Index: web/openacs/www/register/legacy-user-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/register/legacy-user-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/register/legacy-user-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,66 @@
+# legacy-user-2.tcl,v 3.1.4.1 2000/03/17 04:33:06 jsc Exp
+set_the_usual_form_variables
+
+# user_id, password1, password2, maybe return_url
+# first_names, last_name
+
+validate_integer user_id $user_id
+
+set exception_count 0
+set exception_text ""
+
+if { ![info exists first_names] || [empty_string_p $first_names] } {
+    incr exception_count
+    append exception_text "<li>Please type in a first name.\n"
+}
+
+if { ![info exists last_name] || [empty_string_p $last_name] } {
+    incr exception_count
+    append exception_text "<li>Please type in a last name.\n"
+}
+
+if { ![info exists password1] || [empty_string_p $password1] } {
+    incr exception_count
+    append exception_text "<li>Please type the same password in both boxes.\n"
+}
+
+if { ![info exists password2] || [empty_string_p $password2] } {
+    incr exception_count
+    append exception_text "<li>Please type the same password in both boxes.\n"
+}
+
+if { [info exists password1] && [info exists password2] && ([string compare $password1 $password2] != 0) } {
+    incr exception_count
+    append exception_text "<li>The passwords you typed didn't match.  Please type the same password in both boxes.\n"
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+set db [ns_db gethandle]
+
+# for security, we are only willing to update rows where converted_p = 't'
+# this keeps people from hijacking accounts
+
+validate_integer "user_id" $user_id
+
+ns_db dml $db "update users 
+set 
+first_names= '$QQfirst_names',
+last_name= '$QQlast_name',
+password = '$QQpassword1',
+converted_p = 'f'
+where user_id = $user_id
+and converted_p = 't'"
+
+if ![info exists return_url] {
+    set return_url [ad_pvt_home]
+}
+
+ad_user_login $db $user_id
+ns_returnredirect $return_url
+#ns_returnredirect "/cookie-chain.tcl?cookie_name=[ns_urlencode ad_auth]&cookie_value=[ad_encode_id $user_id $password1]&final_page=[ns_urlencode $return_url]"
+
+
Index: web/openacs/www/register/legacy-user.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/register/legacy-user.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/register/legacy-user.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,85 @@
+# legacy-user.tcl,v 3.0 2000/02/06 03:54:03 ron Exp
+set_the_usual_form_variables
+
+# user_id, maybe return_url
+
+validate_integer user_id $user_id
+
+set db [ns_db gethandle] 
+set selection [ns_db 0or1row $db "select user_state from users where user_id = $user_id"]
+
+if { $selection == "" } {
+    ad_return_error "Couldn't find your record" "User id $user_id is not in the database.  This is probably out programming bug."
+    return
+}
+
+set_variables_after_query
+
+if { $user_state == "banned" } {
+    ns_return 200 text/html "[ad_header "Sorry"]
+
+<h2>Sorry</h2>
+
+<hr>
+
+Sorry but it seems that you've been banned from [ad_system_name].
+
+[ad_footer]
+"
+    return
+}
+
+# they presumably deleted themselves
+
+ns_return 200 text/html "[ad_header "Welcome"]
+
+<h2>Welcome</h2>
+
+to the new [ad_site_home_link]
+
+<hr>
+
+You have been added to [ad_system_name] by a third-party. Please
+enter the additional information below to fully open your account.
+
+<p>
+
+
+We need a password from you to protect your identity as you contribute
+to the Q&amp;A, discussion forums, and other community activities on this
+site:
+
+<p>
+
+<blockquote>
+<form method=POST action=\"legacy-user-2.tcl\">
+[export_form_vars user_id return_url]
+
+<table>
+<tr>
+<td>
+<table>
+<tr><th>First Name:</th><td> <input type=text name=first_names size=20></td></tr>
+<tr><th>Last Name:</th><td> <input type=text name=last_name size=20></td></tr>
+<tr><th>Password:</th><td> <input type=password name=password1 size=10></td></tr>
+<tr><th>Confirm:</th><td> <input type=password name=password2 size=10></td></tr>
+</table>
+</td>
+<td>
+
+<input type=submit value=\"Record\">
+
+</td>
+</tr>
+</table>
+
+<p>
+
+(don't obsess too much over this; if you forget it, our server will
+offer to email it to you)
+</blockquote>
+
+</form>
+
+[ad_footer]
+"
Index: web/openacs/www/register/logout.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/register/logout.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/register/logout.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,7 @@
+# logout.tcl,v 3.2 2000/03/10 22:46:15 lars Exp
+set db [ns_db gethandle]
+ad_user_logout $db
+ns_db releasehandle $db
+
+ns_returnredirect "/"
+#ns_returnredirect "/cookie-chain.tcl?cookie_name=[ns_urlencode ad_auth]&cookie_value=expired&expire_state=e&final_page=[ns_urlencode /]"
Index: web/openacs/www/register/restore-user.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/register/restore-user.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/register/restore-user.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,62 @@
+# restore-user.tcl,v 3.0 2000/02/06 03:54:05 ron Exp
+set_the_usual_form_variables
+
+# user_id
+
+validate_integer user_id $user_id
+
+set db [ns_db gethandle] 
+
+set selection [ns_db 0or1row $db "select user_state, email from users where user_id = $user_id"]
+
+# The page restores a user from the deleted state.
+# This page is sensitive to security holes because it is based on a user_id
+
+if { $selection == "" } {
+    ad_return_error "Couldn't find your record" "User id $user_id is not in the database.  This is probably out programming bug."
+    return
+}
+
+set_variables_after_query
+
+if { $user_state == "deleted" } {
+
+    # they presumably deleted themselves
+    
+    # Note that the only transition allowed if from deleted
+    # to authorized.  No other states may be restored
+
+ns_db dml $db "update users set user_state = 'authorized'  
+where user_id = $user_id"
+
+ns_return 200 text/html "[ad_header "Restored"]
+
+<h2>Your Account is Restored</h2>
+
+at [ad_site_home_link]
+
+<hr>
+
+Your account has been restored.  You can log in now using your old
+password:
+
+<p>
+
+<form action=\"user-login-2.tcl\" method=post>
+[export_form_vars user_id]
+Password:  <input type=password name=password_from_form size=20>
+<input type=submit value=\"Login\">
+</form>
+
+<p>
+
+Note: If you've forgotten your password, <a
+href=\"email-password.tcl?user_id=$user_id\">ask this server to email it
+to $email</a>.
+
+
+[ad_footer]
+"
+} else {
+    ad_return_error "Problem with authentication" "There was a problem with authenticating your account"
+}
\ No newline at end of file
Index: web/openacs/www/register/user-login-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/register/user-login-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/register/user-login-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,58 @@
+#
+# Issue the cookie and proceed.
+#
+# user-login-2.tcl,v 3.5 2000/03/10 22:50:18 lars Exp
+#
+
+ad_handle_spammers
+
+set_the_usual_form_variables
+
+# user_id, password_from_form, optionally return_url
+# optionally persistent_cookie_p
+
+validate_integer user_id $user_id
+
+if ![info exists return_url] {
+    set return_url [ad_pvt_home]
+}
+
+set db [ns_db gethandle]
+
+if { ![ad_check_password $db $user_id $password_from_form] } {
+    ns_db releasehandle $db
+    ns_returnredirect "bad-password.tcl?[export_url_vars user_id return_url]"
+    return
+}
+
+# Log the dude in!
+if { [info exists persistent_cookie_p] && $persistent_cookie_p == "t" } {
+    ad_user_login -forever t $db $user_id
+} else {
+    ad_user_login $db $user_id
+}
+
+ns_returnredirect $return_url
+
+ns_conn close
+
+# we're offline as far as the user is concerned now, but keep the
+# thread alive to update the users table
+
+# The last_visit and second_to_last_visit cookies
+# were set for this session by ad_update_last_visits when
+# the user first hit the site.
+
+# Now that we know the user_id, update the database record. 
+
+ad_update_last_visits $db $user_id
+
+if {[empty_string_p [ad_second_to_last_visit_ut]]} {
+    # The user came to the site with no cookies.
+    # We recorded a session, but no repeat session
+    # at this point.
+    
+    # The user subsequenty logged in.  We now
+    # know that this is a repeat visit.
+    ad_update_session_statistics $db 1 0
+}
Index: web/openacs/www/register/user-login.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/register/user-login.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/register/user-login.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,119 @@
+#
+# Prompt the user for his password.
+#
+# user-login.tcl,v 3.4.2.2 2000/03/15 17:24:39 jsalz Exp
+#
+
+set_the_usual_form_variables
+
+# email, return_url, password (optional)
+
+set db [ns_db gethandle]
+
+# Get the user ID
+# as of Oracle 8.1 we'll have upper(email) constrained to be unique
+# in the database (could do it now with a trigger but there is really 
+# no point since users only come in via this form)
+set selection [ns_db 0or1row $db "select user_id, user_state, converted_p from users where upper(email)=upper('$QQemail')"]
+
+if {$selection == ""} {
+    # not in the database
+    ns_db releasehandle $db
+
+    # Source user-new.tcl. We would redirect to it, but we don't want
+    # the password exposed!
+    source "[ns_url2file "/register/user-new.tcl"]"
+    return
+} 
+
+set_variables_after_query
+
+ns_db releasehandle $db
+
+switch $user_state {
+    "authorized" { # just move on } 
+    "banned" { 
+	ns_returnredirect "banned-user.tcl?user_id=$user_id" 
+	return
+    }
+    "deleted" {  
+	ns_returnredirect "deleted-user.tcl?user_id=$user_id" 
+	return
+    }
+    "need_email_verification_and_admin_approv" {
+	ns_returnredirect "awaiting-email-verification.tcl?user_id=$user_id"
+	return
+    }
+    "need_admin_approv" { 
+	ns_returnredirect "awaiting-approval.tcl?user_id=$user_id"
+	return
+    }
+    "need_email_verification" {
+	ns_returnredirect "awaiting-email-verification.tcl?user_id=$user_id"
+	return
+    }
+    "rejected" {
+	ns_returnredirect "awaiting-approval.tcl?user_id=$user_id"
+	return
+    }
+    default {
+	ns_log Warning "Problem with registration state machine on user-login.tcl"
+	ad_return_error "Problem with login" "There was a problem authenticating the account: $user_id. Most likely, the database contains users with no user_state."
+	return
+    }
+}
+
+
+if { [ad_parameter UsersTableContainsConvertedUsersP] && $converted_p == "t" } {
+    # we have a user who never actively registered; he or she was 
+    # pumped into the database following a conversion, presumably
+    # from a system keyed by email address (like photo.net circa 1995)
+    ns_returnredirect "legacy-user.tcl?[export_url_vars user_id return_url]"
+    return
+}
+
+if { [info exists password] } {
+    # Continue the login process (since we already have the password).
+    set password_from_form $password
+    source "[ns_url2file "/register/user-login-2.tcl"]"
+    return
+}
+
+set whole_page "[ad_header "Enter Password"]
+
+<h2>Enter Password</h2>
+
+for $email in <a href=\"index.tcl\">[ad_system_name]</a>
+
+<hr>
+
+<form action=\"user-login-2.tcl\" method=post>
+[export_form_vars user_id return_url]
+Password:  <input type=password name=password_from_form size=20>
+<input type=submit value=\"Login\">
+
+<p>
+
+"
+
+if [ad_parameter AllowPersistentLoginP "" 1] {
+    if [ad_parameter PersistentLoginDefaultP "" 1] {
+	set checked_option "CHECKED" 
+    } else {
+	set checked_option "" 
+    }
+    append whole_page "<input type=checkbox name=persistent_cookie_p value=t $checked_option> 
+Remember this address and password?  
+(<a href=\"explain-persistent-cookies.adp\">help</a>)"
+}
+
+
+append whole_page "
+
+</form>
+
+[ad_footer]
+"
+
+ns_return 200 text/html $whole_page
+
Index: web/openacs/www/register/user-new-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/register/user-new-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/register/user-new-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,269 @@
+# user-new-2.tcl,v 3.6.2.1 2000/03/17 14:55:01 lars Exp
+#
+# user-new-2.tcl
+#
+# actually inserts the new user into the database
+#
+
+ad_handle_spammers
+
+set_the_usual_form_variables
+
+# email password first_names last_name url, user_id, possibly return_url
+
+validate_integer user_id $user_id
+
+if ![info exists return_url] {
+    set return_url [ad_pvt_home]
+}
+
+# Error Count and List
+set exception_count 0
+set exception_text ""
+
+# Check input
+
+if {![info exists user_id] || [empty_string_p $user_id] } {
+    incr exception_count
+    append exception_text "<li>Your browser dropped the user_id variable or something is wrong with our code.\n"
+}
+
+if {![info exists email] || ![philg_email_valid_p $email]} {
+    incr exception_count
+    append exception_text "<li>The email address that you typed doesn't look right to us.  Examples of valid email addresses are 
+<ul>
+<li>Alice1234@aol.com
+<li>joe_smith@hp.com
+<li>pierre@inria.fr
+</ul>
+"
+}
+
+if {(![info exists password] || [empty_string_p $QQpassword]) && ![ad_parameter RegistrationProvidesRandomPasswordP "" 0] } {
+    incr exception_count
+    append exception_text "<li> You didn't enter a password."
+}
+
+
+if {(![info exists password_confirmation] || ![info exists password] || $password != $password_confirmation) && ![ad_parameter RegistrationProvidesRandomPasswordP "" 0] } {
+    incr exception_count
+    append exception_text "<li> Your password and password confirmation do not match."
+}
+
+
+if {![info exists first_names] || [empty_string_p $QQfirst_names]} {
+    incr exception_count
+    append exception_text "<li> You didn't enter a first name."
+}
+
+if {![info exists last_name] || [empty_string_p $QQlast_name]} {
+    incr exception_count
+    append exception_text "<li> You didn't enter a last name."
+}
+
+if {[info exists first_names] && [string first "<" $first_names] != -1} {
+    incr exception_count
+    append exception_text "<li> You can't have a &lt; in your first name because it will look like an HTML tag and confuse other users."
+}
+
+if {[info exists last_name] && [string first "<" $last_name] != -1} {
+    incr exception_count
+    append exception_text "<li> You can't have a &lt; in your last name because it will look like an HTML tag and confuse other users."
+}
+
+if { [info exists url] && [string match $url "http://"] ==  1 } {
+    # the user left the default hint for the url
+    set url ""
+    set QQurl ""
+}
+
+if {[info exists url] && ![empty_string_p $url] && ![philg_url_valid_p $url] } {
+    # there is a URL but it doesn't match our REGEXP
+    incr exception_count
+    append exception_text "<li>You URL doesn't have the correct form.  A valid URL would be something like \"http://photo.net/philg/\"."
+}
+
+# We've checked everything.
+# If we have an error, return error page, otherwise, do the insert
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+set authorized_p 0
+
+if {[ad_parameter RegistrationRequiresApprovalP "" 0] && [ad_parameter RegistrationRequiresEmailVerificationP "" 0]} {
+    set user_state "need_email_verification_and_admin_approv"
+} elseif {[ad_parameter RegistrationRequiresApprovalP "" 0]} {
+    set user_state "need_admin_approv"
+} elseif {[ad_parameter RegistrationRequiresEmailVerificationP "" 0]} {
+    set user_state "need_email_verification"
+} else {
+    set user_state "authorized"
+    set authorized_p 1
+}
+
+# Autogenerate a password
+
+if  {[ad_parameter RegistrationProvidesRandomPasswordP "" 0]} {
+    set password [ad_generate_random_string]
+    set QQpassword [DoubleApos $password]
+}
+
+# If we are encrypting passwords in the database, convert
+if  [ad_parameter EncryptPasswordsInDBP "" 0] { 
+    set QQpassword_for_database [DoubleApos [ns_crypt $password [ad_crypt_salt]]]
+} else {
+    set QQpassword_for_database $QQpassword
+}
+
+set insert_statement  "insert into users 
+(user_id,email,password,first_names,last_name,url,registration_date,registration_ip, user_state, last_visit) 
+values 
+($user_id,'$QQemail','$QQpassword_for_database','$QQfirst_names','$QQlast_name','$QQurl', sysdate(), '[ns_conn peeraddr]', '$user_state', sysdate())"
+
+
+# let's look for other required tables
+
+set insert_statements_sup ""
+
+set other_tables [ad_parameter_all_values_as_list RequiredUserTable]
+foreach table_name $other_tables {
+    lappend insert_statements_sup "insert into $table_name (user_id) values ($user_id)"
+}
+
+set double_click_p 0
+
+set db [ns_db gethandle]
+
+with_catch errmsg {
+    ns_db dml $db "begin transaction"
+    ns_db dml $db $insert_statement
+} {
+    # if it was not a double click, produce an error
+    ns_db dml $db "abort transaction"
+    if { [database_to_tcl_string $db "select count(user_id) from users where user_id = $user_id"] == 0 } {
+	ns_db releasehandle $db
+	ad_return_error "Insert Failed" "We were unable to create your user record in the database."
+	ns_log Error "Error insert new user:
+$errmsg"
+	return 
+    } else {
+	# assume this was a double click
+	set double_click_p 1
+    }
+}
+
+
+
+if { $double_click_p == 0 } {
+    with_catch errmsg {
+	foreach statement $insert_statements_sup {
+	    ns_db dml $db $statement
+	}
+	ns_db dml $db "end transaction"
+    } {
+	ns_db releasehandle $db
+	ad_return_error "Insert Failed" "We were unable to create your user record in the database.  Here's what the error looked like:
+<blockquote>
+<pre>
+$errmsg
+</pre>
+</blockquote>"
+return
+    }
+}
+
+if { $authorized_p } {
+    # user is ready to go
+
+    # we have to be careful here with the password; we put a string-trimmed
+    # version into the RDBMS so we must do the same here
+    set trimmed_password [string trim $password]
+    
+    ad_user_login $db $user_id
+    ns_returnredirect $return_url
+#    ns_returnredirect "/cookie-chain.tcl?cookie_name=[ns_urlencode ad_auth]&cookie_value=[ad_encode_id $user_id $trimmed_password]&final_page=[ns_urlencode $return_url]"
+
+} elseif { [ad_parameter RegistrationRequiresEmailVerificationP "" 0] }  { 
+
+    # this user won't be able to use the system until he has answered his email
+    # so don't give an auth cookie, but instead tell him 
+    # to read your email
+
+    ns_return 200 text/html "[ad_header "Please read your email"]
+
+<h2>Please read your email</h2>
+
+<hr>
+
+Registration information for this service has been
+sent to $email.
+<p>
+Please read and follow the instructions in this email.
+
+[ad_footer]
+"
+
+} elseif {[ad_parameter RegistrationRequiresApprovalP "" 0]} {
+
+    # this user won't be able to use the system until an admin has
+    # approved him, so don't give an auth cookie, but instead tell him 
+    # to wait
+    ns_return 200 text/html "[ad_header "Awaiting Approval"]
+
+<h2>Awaiting Approval</h2>
+
+<hr>
+
+Your registration is in the database now.  A site administrator has
+been notified of your request to use the system.  Once you're
+approved, you'll get an email message and you can return to
+[ad_site_home_link] to use the service.
+
+[ad_footer]
+"
+} 
+
+
+if {[ad_parameter NotifyAdminOfNewRegistrationsP]} {
+    # we're supposed to notify the administrator when someone new registers
+    set notification_address [ad_parameter NewRegistrationEmailAddress "" [ad_system_owner]]
+    ns_sendmail $notification_address $email "New registration at [ad_url]" "
+$first_names $last_name ($email) registered as a user of 
+[ad_url]
+"
+}
+
+
+if { !$double_click_p } {
+
+    if { [ad_parameter RegistrationRequiresEmailVerificationP "" 0] } {
+	set oid [database_to_tcl_string $db "select oid from users where user_id = $user_id"]
+    # the user has to come back and activate their account
+    ns_sendmail  "$email" "[ad_parameter NewRegistrationEmailAddress]" "Welcome to [ad_system_name]" "To confirm your registration, please go to [ad_parameter SystemURL]/register/email-confirm.tcl?[export_url_vars oid]"
+
+    } elseif { [ad_parameter RegistrationProvidesRandomPasswordP "" 0] ||  [ad_parameter EmailRegistrationConfirmationToUserP "" 0] } {
+	with_catch errmsg {
+	    ns_sendmail "$email" "[ad_parameter NewRegistrationEmailAddress]" "Thank you for visiting [ad_system_name]" "Here's how you can log in at [ad_url]:
+
+Username:  $email
+Password:  $password
+
+"
+	} {
+	    ns_returnerror "error" "$error"
+	    ns_log Warning "Error sending registration confirmation to $email in usre-new.tcl"
+	}
+    }
+}
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/register/user-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/register/user-new.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/register/user-new.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,95 @@
+# user-new.tcl,v 3.0.4.1 2000/03/15 17:24:38 jsalz Exp
+#
+# user-new.tcl
+#
+# presents a registration form to a new user
+# 
+
+set_the_usual_form_variables
+
+# email, return_url, maybe password
+
+# Hack for Postgres null email address (BMA)
+if {[empty_string_p $email]} {
+    ns_returnredirect "index.tcl"
+    return
+}
+
+if { ![info exists password] } {
+    set password ""
+}
+
+# we're going to ask this guy to register
+
+set db [ns_db gethandle]
+set user_id [database_to_tcl_string $db "select user_id_sequence.nextval from dual"]
+# we don't need it anymore so let's release it for another thread
+ns_db releasehandle $db 
+
+
+append html_text "[ad_header "Register"]
+
+<h2>Register</h2>
+
+as a user of <a href=\"index.tcl\">[ad_system_name]</a>
+
+<hr>
+
+<form method=post action=\"user-new-2.tcl\">
+[export_form_vars email return_url user_id]"
+
+
+if ![ad_parameter RegistrationProvidesRandomPasswordP "" 0] {
+
+    append html_text "<h3>Security</h3>
+
+We need a password from you to protect your identity as you contribute to the Q&A, discussion forums, and other community activities on this site.
+
+<p>
+<table>
+<tr>
+  <td>Password:</td>
+  <td><input type=password name=password value=\"$password\" size=10></td>
+</tr>
+<tr>
+  <td>Password Confirmation:</td>
+  <td><input type=password name=password_confirmation size=10></td>
+</tr>
+</table>
+<p>
+
+[ad_style_bodynote "Leading or trailing spaces will be removed by the server.  
+Don't obsess too much over your choice of password; if you forget it, our server will
+offer to email it to you."]
+"
+
+}
+
+
+append html_text "<h3>About You</h3>
+
+We know your email address already: \"$email\".  But we need your full
+name to generate certain kinds of user interface.
+
+<p>
+
+Full Name:    <input type=text name=first_names size=20> <input type=text name=last_name size=25>
+<p>
+
+If you have a Web site, we'll be able to point searchers there.
+
+<p>
+
+Personal Home Page URL:  <input type=text name=url size=50 value=\"http://\">
+
+<p>
+
+<center>
+<input type=submit value=\"Register\">
+</center>
+</form>
+
+[ad_footer]
+"
+
+ns_return 200 text/html $html_text
Index: web/openacs/www/registry/add-entry.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/registry/add-entry.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/registry/add-entry.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,44 @@
+# add-entry.tcl,v 3.0 2000/02/06 03:54:11 ron Exp
+if {[ad_read_only_p]} {
+    ad_return_read_only_maintenance_message
+    return
+}
+
+set user_id [ad_verify_and_get_user_id]
+if { $user_id == 0 } {
+    ns_returnredirect "/register/index.tcl"
+    return
+}
+
+set_the_usual_form_variables
+
+set insert_sql "insert into stolen_registry ( stolen_id, user_id, additional_contact_info, manufacturer, model, serial_number, value, posted, story ) 
+values ( stolen_registry_sequence.nextval, $user_id, '$QQadditional_contact_info', '$QQmanufacturer', '$QQmodel', '$QQserial_number', $value, sysdate, '$QQstory'  )"
+
+set db [ns_db gethandle]
+
+if [catch { ns_db dml $db $insert_sql } errmsg] {
+    ad_return_error "Ouch!" "Problem inserting your entry. <P> Here's what came back from the database:<p><pre><code>$errmsg</code></pre>
+
+Here are some common reasons:  
+
+<ul>
+<li>you didn't enter a value or the value wasn't a number
+</ul>
+
+"
+} else {
+    ns_return 200 text/html "[ad_header "Successful Entry"]
+
+<h2>Entry Successful</h2>
+
+in the <a href=index.tcl>Stolen Equipment Registry</a>
+
+<hr>
+
+Your entry has been recorded.  Thank you.
+
+[ad_footer]
+"
+}
+
Index: web/openacs/www/registry/add.html
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/registry/add.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/registry/add.html	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,51 @@
+<html>
+<head>
+
+<title>Add Entry to Stolen Registry</title>
+
+</head>
+<body bgcolor=#ffffff text=#000000>
+
+<h2>Add Entry</h2>
+
+to the <a href="index.tcl">stolen equipment registry</a> of
+<a href="http://photo.net/photo/">photo.net</a>
+
+<hr>
+
+Note that this registry is for photographic equipment only.  I know that
+it feels bad to have a bike, car, or whatever else stolen, but I don't
+want to clutter this registry with random stuff.
+
+<p>
+
+<form method=post action=add-entry.tcl>
+
+<table>
+
+<tr><th>Additional Contact Info<br>(optional)</th>
+<td><textarea name=additional_contact_info cols=40 rows=3></textarea></td></tr>
+
+
+<tr><th>Manufacturer</th><td><input type=text name=manufacturer size=30></td></tr>
+<tr><th>Model</th><td><input type=text name=model size=30></td></tr>
+<tr><th>Serial Number</th><td><input type=text name=serial_number size=30></td></tr>
+<tr><th>Approximate Value<br>(in U.S. Dollars)</th><td><input type=text name=value size=10></td></tr>
+
+<tr><th>Story<br>(anything you want to say, e.g., the circumstances of the theft, 
+identifying marks on the camera, warnings to others)<br>[HTML tags OK]</th>
+<td><textarea name=story cols=40 rows=8></textarea></td></tr>
+
+</table>
+
+<input type=submit value="Submit Entry">
+
+</form>
+
+<hr>
+
+<address>philg@mit.edu</a>
+
+
+</body>
+</html>
Index: web/openacs/www/registry/index.help
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/registry/index.help,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/registry/index.help	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,16 @@
+<%= [ad_header "About the Stolen Equipment Registry"] %>
+
+<h2>About</h2>
+
+the Stolen Equipment Registry
+
+<hr>
+
+The stolen equipment registry at photo.net is a place for crime
+victims to record serial numbers of cameras that they've had stolen.
+If you're offered used camera equipment, you can search by serial
+number to see if any items have been reported stolen by photo.net
+users.
+
+
+<%= [ad_footer] %>
Index: web/openacs/www/registry/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/registry/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/registry/index.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,67 @@
+# index.tcl,v 3.0 2000/02/06 03:54:12 ron Exp
+proc philg_capitalize { in_string } {
+    append out_string [string toupper [string range $in_string 0 0]] [string tolower [string range $in_string 1 [string length $in_string]]]
+}
+
+set db [ns_db gethandle]
+
+set selection [ns_db select $db "select initcap(upper(manufacturer)) as manufacturer,count(*) as count
+from stolen_registry
+group by upper(manufacturer)
+order by upper(manufacturer)"]
+
+ReturnHeaders
+
+ns_write "[ad_header "Stolen Equipment Registry Home"]
+
+<table>
+<tr>
+<td>
+<a href=\"http://photo.net/photo/pcd0305/pool-chairs-empty-29.tcl\"><img src=\"http://photo.net/photo/pcd0305/pool-chairs-empty-29.1.jpg\"></a>
+
+<td>
+<h2>Welcome to the Stolen Equipment Registry</h2>
+
+[ad_context_bar_ws_or_index "Registry"]
+
+</tr>
+</table>
+
+<hr>
+[help_upper_right_menu]
+
+<ul>
+
+<li><a href=\"add.html\">Add</a>
+
+<p>
+
+"
+
+set items ""
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    set pretty_manufacturer $manufacturer
+    if { $manufacturer == "" } {
+	set pretty_manufacturer "(none specified)"
+    }
+
+    append items "<li><a href=\"search-one-manufacturer.tcl?manufacturer=[ns_urlencode $manufacturer]\">$pretty_manufacturer</a> ($count)\n"
+
+}
+
+ns_write "
+$items
+</ul>
+
+or 
+
+<form method=post action=search-pls.tcl>
+Search by full text query:  <input type=text name=query_string size=40>
+</form>
+<p>
+Note: this searches through names, email addresses, stories, manufacturers, models, and 
+serial numbers.
+
+[ad_footer]
+"
Index: web/openacs/www/registry/one-case.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/registry/one-case.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/registry/one-case.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,66 @@
+# one-case.tcl,v 3.0.4.1 2000/03/17 23:16:18 tzumainn Exp
+set_form_variables
+
+# stolen_id is the only one
+
+validate_integer stolen_id $stolen_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select stolen_id,
+ additional_contact_info, manufacturer, model, serial_number,
+ value, recovered_p, recovered_by_this_service_p, posted,
+ story, s.deleted_p, u.user_id, u.email, u.first_names, u.last_name
+from stolen_registry s, users u
+where stolen_id=$stolen_id
+and u.user_id = s.user_id"]
+
+set_variables_after_query
+
+set comments_list [ad_general_comments_list $db $stolen_id stolen_registry $model registry]
+
+ns_db releasehandle $db
+
+ReturnHeaders
+
+ns_write "[ad_header "$manufacturer $model $serial_number"]
+
+<h2>$manufacturer $model</h2>
+
+serial number  $serial_number<p>
+
+recorded in the <a href=index.tcl>Stolen Equipment Registry</a>
+
+<hr>
+
+"
+
+if { $story != "" } {
+
+    ns_write "<h3>Story</h3>
+
+$story
+
+"
+
+}
+
+ns_write "<h3>Contact</h3>
+Reported on $posted by 
+<a href=\"/shared/community-member.tcl?user_id=$user_id\">$first_names $last_name</a>
+(<a href=\"mailto:$email\">$email</a>)
+"
+
+if { $additional_contact_info != "" } {
+
+    ns_write ", who may also be reached at <blockquote><pre>
+$additional_contact_info
+</pre></blockquote>"
+
+}
+
+ns_write "
+<p>
+$comments_list
+
+[ad_footer]\n"
Index: web/openacs/www/registry/search-one-manufacturer.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/registry/search-one-manufacturer.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/registry/search-one-manufacturer.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,53 @@
+# search-one-manufacturer.tcl,v 3.0 2000/02/06 03:54:15 ron Exp
+proc philg_capitalize { in_string } {
+    append out_string [string toupper [string range $in_string 0 0]] [string tolower [string range $in_string 1 [string length $in_string]]]
+}
+
+set_the_usual_form_variables
+# manufacturer
+
+set db [ns_db gethandle]
+
+if { $manufacturer == "" } {
+    set where_clause "manufacturer is null"
+} else {
+    set where_clause "upper(manufacturer) = upper('$QQmanufacturer')"
+}
+
+set selection [ns_db select $db "select stolen_id,sr.* 
+from stolen_registry sr
+where $where_clause
+order by model"]
+
+set pretty_manufacturer [philg_capitalize $manufacturer]
+
+ReturnHeaders
+
+ns_write "[ad_header "$pretty_manufacturer Entries"]
+
+<h2>$pretty_manufacturer Entries</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Registry"] "One Manufacturer"]
+
+
+<hr>
+
+<ul>\n"
+
+while {[ns_db getrow $db $selection]} {
+
+    set_variables_after_query
+    # can't use the obvious $serial_number == "" because Tcl
+    # is so stupid about numbers
+    if { ![string match "" $serial_number] } {
+	ns_write "<li>$model, serial number <a href=\"one-case.tcl?stolen_id=$stolen_id\">$serial_number</a>"
+    } else {
+	ns_write "<li>$model, <a href=\"one-case.tcl?stolen_id=$stolen_id\">no serial number provided</a>"
+    }
+
+}
+
+ns_write "</ul>
+
+[ad_footer]
+"
Index: web/openacs/www/registry/search-pls.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/registry/search-pls.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/registry/search-pls.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,74 @@
+# search-pls.tcl,v 3.0 2000/02/06 03:54:17 ron Exp
+set use_context_p 0
+
+set_the_usual_form_variables
+
+# query_string is the only one
+
+set db [ns_db gethandle]
+
+if $use_context_p {
+    regsub -all { +} $query_string "," query_string_for_ctx
+    regsub -all {,+} $query_string_for_ctx "," query_string_for_ctx
+
+    set sql "select stolen_id, manufacturer, model, serial_number
+from stolen_registry_for_context
+where contains (indexedtext, '\$([DoubleApos $query_string_for_ctx])', 10) > 0
+and deleted_p <> 't'
+and recovered_p <> 't'
+order by score(10) desc"
+
+} else {
+    # if the user put in commas, replace with spaces
+    regsub -all {,+} [string trim $QQquery_string] " " final_query_string
+    set sql "select pseudo_contains (indexedtext, '$final_query_string') as the_score, stolen_id, manufacturer, model, serial_number
+from stolen_registry_for_context
+where pseudo_contains (indexedtext, '$final_query_string') > 0
+and deleted_p <> 't'
+and recovered_p <> 't'
+order by 1 desc"
+}
+
+ReturnHeaders
+
+ns_write "[ad_header "Full Text Search Results"]
+
+<h2>Search Results</h2>
+
+for \"$query_string\" into the <a href=index.tcl>Stolen Equipment Registry</a>
+
+<hr>
+
+<ul>
+"
+
+if [catch { set selection [ns_db select $db $sql] } errmsg] {
+
+    ns_write "Ooops!  Some kind of problem with our database:  
+<blockquote>
+$errmsg
+</blockquote>
+<p>
+
+In the meantime, you can always search by manufacturer from the preceding page."
+
+} else {
+    # the PLS query actually succeeded (miracles do occur)
+    while {[ns_db getrow $db $selection]} {
+	set_variables_after_query
+	if [empty_string_p $serial_number] {
+	    set serial_number "No serial number provided"
+	}
+        ns_write "<li>$manufacturer $model, serial number <a href=\"one-case.tcl?stolen_id=$stolen_id\">$serial_number</a>"
+    }
+
+
+
+}
+
+ns_write "
+
+</ul>
+
+[ad_footer]
+"
Index: web/openacs/www/registry/search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/registry/search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/registry/search.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,49 @@
+# search.tcl,v 3.0 2000/02/06 03:54:18 ron Exp
+proc philg_capitalize { in_string } {
+    append out_string [string toupper [string range $in_string 0 0]] [string tolower [string range $in_string 1 [string length $in_string]]]
+}
+
+set db [ns_db gethandle]
+
+set selection [ns_db select $db "select initcap(upper(manufacturer)) as manufacturer,count(*) as count
+from stolen_registry
+group by upper(manufacturer)
+order by upper(manufacturer)"]
+
+ReturnHeaders
+
+ns_write "[ad_header "Search Stolen Equipment Registry"]
+
+<h2>Search</h2>
+
+the <a href=index.tcl>Stolen Equipment Registry</a>
+
+<hr>
+
+Pick a manufacturer...
+
+<ul>
+"
+
+while {[ns_db getrow $db $selection]} {
+
+    set_variables_after_query
+
+    ns_write "<li><a href=\"search-one-manufacturer.tcl?manufacturer=[ns_urlencode $manufacturer]\">$manufacturer</a> ($count)"
+
+}
+
+ns_write "</ul>\n"
+
+ns_write "
+or 
+
+<form method=post action=search-pls.tcl>
+Search by full text query:  <input type=text name=query_string size=40>
+</form>
+<p>
+Note: this searches through names, email addresses, stories, manufacturers, models, and 
+serial numbers.
+
+[ad_footer]
+"
Index: web/openacs/www/sdm/all-bafs.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/all-bafs.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/all-bafs.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,27 @@
+set_the_usual_form_variables
+# module_id
+
+validate_integer module_id $module_id
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+ReturnHeaders
+
+set selection [ns_db 1row $db "select module_name, packages.package_id as package_id, package_name from modules, packages where modules.module_id=$module_id and modules.package_id=packages.package_id"]
+set_variables_after_query
+
+ns_write "[sdm_header "All Bugs and Features"]
+<h2>All Bugs and Features</h2>
+[ad_context_bar_ws_or_index [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] [sdm_module_context_bar_item $module_id $module_name] "All Bugs and Features"]
+<hr><p>
+
+<ul>
+<li> <a href=open-bafs.tcl?[export_url_vars module_id]>Open Bugs and Features</a>
+<li> <a href=closed-bafs.tcl?[export_url_vars module_id]>Closed Bugs and Features</a>
+</ul>
+<p>
+
+[sdm_footer]
+"
\ No newline at end of file
Index: web/openacs/www/sdm/baf-assignments.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/baf-assignments.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/baf-assignments.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,51 @@
+set_the_usual_form_variables
+# baf_id
+
+validate_integer baf_id $baf_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select module_id, package_id, baf_status.baf_status as baf_status, baf_status_id, baf_type, description, entered_by, severity, insertion_date, expected_completion, completion from bugs_and_features, baf_status where bugs_and_features.baf_status=baf_status.baf_status_id and baf_id=$baf_id"]
+
+set_variables_after_query
+
+set_simple_user_information $db
+
+if {![user_can_see_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+if {$module_id != "" && $module_id!=0 } {
+    if {![user_can_see_module_p $db $user_id $module_id]} {
+	sdm_return_access_complaint
+	return
+    }
+    set_simple_module_information $db $module_id
+} else {
+    set module_name ""
+}
+
+set_simple_package_information $db $package_id
+
+if {$baf_status == "closed"} {
+    set extra_menu [list "closed-bafs.tcl?[export_url_vars package_id]" "Closed Bugs and Features"]
+} else {
+    set extra_menu [list "open-bafs.tcl?[export_url_vars package_id]" "Open Bugs and Features"]
+}
+
+set admin_p [user_can_edit_package_p $db $user_id $package_id]
+
+set selection [ns_db 1row $db "select baf_type from bugs_and_features where baf_id=$baf_id"]
+set_variables_after_query
+
+set list_of_assignments [database_to_tcl_list_list $db "
+select users.user_id as user_id, first_names || ' ' || last_name as full_name, role 
+from baf_assignments, users 
+where 
+users.user_id=baf_assignments.user_id and
+baf_assignments.baf_id=$baf_id"]
+
+ad_return_template
Index: web/openacs/www/sdm/baf-audit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/baf-audit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/baf-audit.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,39 @@
+set_the_usual_form_variables
+# baf_id
+
+validate_integer baf_id $baf_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select module_id, package_id, baf_status.baf_status as baf_status, baf_status_id, baf_type, description, entered_by, severity, insertion_date, expected_completion, completion from bugs_and_features, baf_status where bugs_and_features.baf_status=baf_status.baf_status_id and baf_id=$baf_id"]
+
+set_variables_after_query
+
+set_simple_user_information $db
+
+if {![user_can_see_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+if {$module_id != "" && $module_id!=0 } {
+    if {![user_can_see_module_p $db $user_id $module_id]} {
+	sdm_return_access_complaint
+	return
+    }
+    set_simple_module_information $db $module_id
+} else {
+    set module_name ""
+}
+
+set_simple_package_information $db $package_id
+
+if {$baf_status == "closed"} {
+    set extra_menu [list "closed-bafs.tcl?[export_url_vars package_id]" "Closed Bugs and Features"]
+} else {
+    set extra_menu [list "open-bafs.tcl?[export_url_vars package_id]" "Open Bugs and Features"]
+}
+
+set audits [database_to_tcl_list_ns_set $db "select who, what, old_value, new_value, audit_date as when, null as who from baf_audit where baf_id= $baf_id order by audit_date desc"]
+
+ad_return_template
Index: web/openacs/www/sdm/baf-comment-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/baf-comment-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/baf-comment-add.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,44 @@
+set_the_usual_form_variables
+# baf_id
+
+validate_integer baf_id $baf_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select package_id, module_id, baf_type, description, entered_by, severity, insertion_date, coalesce(expected_completion,0) as expected_completion, coalesce(completion,0) as completion from bugs_and_features where baf_id=$baf_id"]
+set_variables_after_query
+
+set_simple_user_information $db
+
+if {![user_can_see_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_package_information $db $package_id
+
+if {$module_id != "" && $module_id != 0} {
+    if {![user_can_see_module_p $db $user_id $module_id]} {
+	sdm_return_access_complaint
+	return
+    }
+    
+    set_simple_module_information $db $module_id
+}
+
+ReturnHeaders
+
+ns_write "[sdm_header "Add a comment on a $baf_type"]
+<h2>Add a Comment</h2>
+on <A href=one-baf.tcl?[export_url_vars baf_id]>$baf_type #$baf_id</a>, in <A href=one-package.tcl?[export_url_vars package_id]>$package_name</a>.
+<hr><p>
+
+<FORM METHOD=POST action=pvt/baf-comment-add-2.tcl>
+[export_form_vars baf_id]
+<TEXTAREA name=content COLS=60 ROWS=7 WRAP=soft>
+</TEXTAREA><p>
+<INPUT TYPE=submit value=add>
+</FORM>
+<p>
+
+[sdm_footer]"
\ No newline at end of file
Index: web/openacs/www/sdm/closed-bafs.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/closed-bafs.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/closed-bafs.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,125 @@
+set_the_usual_form_variables
+# module_id package_id
+
+validate_integer package_id $package_id
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+if {![user_can_see_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_package_information $db $package_id
+
+if {[info exists module_id]} {
+    validate_integer module_id $module_id
+
+    set module_name [database_to_tcl_string $db "select module_name from modules where module_id=$module_id"]
+    set menu_bar [ad_context_bar_ws_or_index [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] [sdm_module_context_bar_item $module_id $module_name] "Closed Bugs and Features"]
+    set extra_sql "and module_id=$module_id"
+} else {
+    set menu_bar [ad_context_bar_ws_or_index [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] "Closed Bugs and Features"]
+    set extra_sql ""
+}    
+
+ReturnHeaders
+
+ns_write "[sdm_header "Closed Bugs and Features"]
+<h2>Closed Bugs and Features</h2>
+$menu_bar
+<hr><p>
+
+You can check the <A href=open-bafs.tcl?[export_url_vars module_id package_id]>open bugs and features</a> for this package, instead.<p>
+
+[html_section_title "Bugs"]
+<p>
+<blockquote>
+<table noborder cellspacing=0 cellpadding=2>
+<tr>
+<th bgcolor=lightblue>Bug #</th><th bgcolor=lightblue>Rating</th><th bgcolor=lightblue># Interested</th><th bgcolor=lightblue>Severity</th><th bgcolor=lightblue>Module</th><th bgcolor=lightblue>Completion</th><th bgcolor=lightblue>Description</th>
+</tr>
+"
+
+set selection [ns_db select $db "select baf_id, severity, substr(bugs.description,0,200) as short_description, baf_module(baf_id) as module_name, completion as fix_release_id, fetch_release_name(completion) as fix_release_name, baf_rating(baf_id) as rating, baf_n_interested(baf_id) as n_interested from closed_bugs bugs where bugs.package_id=$package_id $extra_sql order by rating desc, n_interested desc"]
+
+set odd_row 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    
+    # shading
+    set odd_row [expr 1 - $odd_row]
+    if {$odd_row} {
+	set shading "bgcolor=#cccccc"
+    } else {
+	set shading ""
+    }
+
+    ns_write "<tr><td $shading><a href=one-bug.tcl?[export_url_vars baf_id]>$baf_id</a></td>
+<td align=right $shading>&nbsp;$rating</td>
+<td align=right $shading>&nbsp;$n_interested</td>
+<td $shading>$severity</td>
+<td $shading>&nbsp;$module_name</td>
+<td $shading>$fix_release_name</td>
+<td $shading>[ns_quotehtml $short_description] ...</td>
+</tr>"
+}
+
+ns_write "</table></blockquote>
+
+<p>
+&nbsp;
+<p>
+[html_section_title "Features"]
+<p>
+<blockquote>
+<table cellspacing=0 cellpadding=2>
+<tr>
+<th bgcolor=lightblue>Feature #</th><th bgcolor=lightblue>Rating</th><th bgcolor=lightblue># Interested</th><th bgcolor=lightblue>Severity</th><th bgcolor=lightblue>Completion</th><th bgcolor=lightblue>Description</th>
+</tr>
+"
+
+set selection [ns_db select $db "select 
+baf_id, severity,
+baf_module(module_id) as module_name,
+substr(features.description,0,200) as short_description, 
+completion as fix_release_id, 
+fetch_release_name(completion) as fix_release_name,
+baf_rating(baf_id) as rating,
+baf_n_interested(baf_id) as n_interested
+from 
+closed_features features
+where features.package_id=$package_id $extra_sql order by severity desc"]
+
+set odd_row 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    # shading
+    set odd_row [expr 1 - $odd_row]
+    if {$odd_row} {
+	set shading "bgcolor=#cccccc"
+    } else {
+	set shading ""
+    }
+
+    ns_write "<tr><td $shading><a href=one-feature.tcl?[export_url_vars baf_id]>$baf_id</a></td>
+<td align=right $shading>&nbsp;$rating</td>
+<td align=right $shading>&nbsp;$n_interested</td>
+<td $shading>$severity</td>
+<td $shading>$fix_release_name</td>
+<td $shading>[ns_quotehtml $short_description] ...</td>
+</tr>"
+}
+
+
+ns_write "</table></blockquote>
+
+<p>
+
+[sdm_footer]
+"
\ No newline at end of file
Index: web/openacs/www/sdm/download-package-release.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/download-package-release.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/download-package-release.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,34 @@
+
+set_the_usual_form_variables
+# release_id package_id
+
+validate_integer release_id $release_id
+validate_integer package_id $package_id
+
+# If user disagrees with license
+#  if {[info exists agree_to_license] && [string tolower $agree_to_license] != "i agree"} {
+#      ns_returnredirect "one-package-release.tcl?[export_url_vars release_id package_id]"
+#      return
+#  }
+
+# If user hasn't yet seen the license
+#  if {![info exists agree_to_license]} {
+#      ns_returnredirect "license-package.tcl?[export_url_vars release_id package_id]"
+#      return
+#  }
+
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db 
+
+if {![user_can_see_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_package_information $db $package_id
+
+set filename [database_to_tcl_string $db "select release_filename from package_releases where package_id=$package_id and release_id=$release_id"]
+
+ns_returnredirect "/sdm/download-package/$package_id/$release_id/$filename"
\ No newline at end of file
Index: web/openacs/www/sdm/entry-history-diff.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/entry-history-diff.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/entry-history-diff.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,40 @@
+set_the_usual_form_variables
+# package_id
+# possibly current_entry
+# old_release new_release
+
+validate_integer package_id $package_id
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+if {![user_can_see_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+if {![sdm_sourcecode_package_has_repository_p $db $package_id]} {
+    ad_return_complaint 1 "Package does not have a repository"
+    return
+}
+
+set_simple_package_information $db $package_id
+
+set_simple_repository_information $db $package_id
+
+if {![info exists current_entry]} {
+    ns_returnredirect "package-repository.tcl?[export_url_vars package_id]"
+    return
+}
+
+if {![sdm_sourcecode_entry_safe $current_entry $repository_name]} {
+    ns_return 200 text/html "$current_entry"
+    return
+}
+
+set cvsroot [cvs_get_cvsroot $package_id $db]
+
+set diff [cvs_file_diff [sdm_source_root] [sdm_util_strip_leading_slash [sdm_sourcecode_entry_path $current_entry]]/[sdm_sourcecode_entry_name $current_entry] $cvsroot $old_release $new_release]
+
+ad_return_template
Index: web/openacs/www/sdm/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/index.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,38 @@
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+ReturnHeaders
+
+
+ns_write "[sdm_header "[sdm_system_name]"]
+<h2>[sdm_system_name]</h2>"
+
+ns_write "[ad_context_bar_ws_or_index [sdm_system_name]]"
+
+ns_write "<hr><p>
+
+<h3> Packages</h3>
+<ul>
+"
+
+if {$user_logged_on_p && [sdm_user_can_add_packages $db $user_id]} {
+    ns_write "
+<li> <a href=new-package.tcl>create</a> a new package<p>\n
+"
+}
+
+# Get the packages that are public, that the user can administer,
+# or that the user is assigned to via some modules
+set selection [ns_db select $db "select package_id, package_name from packages where package_id IN (select package_id from package_admins where user_id=$user_id) or package_id IN (select package_id from modules where module_id in (select module_id from module_users where user_id=$user_id)) or private_p='f' order by package_name"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    ns_write "<li> <a href=one-package.tcl?[export_url_vars package_id]>$package_name</a>\n"
+}
+
+ns_write "</ul>
+
+[sdm_footer]"
Index: web/openacs/www/sdm/license-package.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/license-package.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/license-package.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,26 @@
+set_the_usual_form_variables
+# release_id package_id
+
+validate_integer release_id $release_id
+validate_integer package_id $package_id
+
+ReturnHeaders
+
+ns_write "[sdm_header "License Agreement"]
+<h2>License Agreement</h2>
+<hr><p>
+Before downloading the code, you must agree to the following license:
+<p>
+
+[sdm_code_license]
+
+<p>
+<FORM METHOD=GET ACTION=download-package-release.tcl>
+[export_form_vars release_id package_id]
+<INPUT TYPE=submit name=agree_to_license value=\"I agree\">
+<INPUT TYPE=submit name=agree_to_license value=\"I do not agree\">
+</FORM>
+
+<p>
+[sdm_footer]
+"
\ No newline at end of file
Index: web/openacs/www/sdm/new-package-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/new-package-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/new-package-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,35 @@
+## HACK
+## this is to prevent new packages for now
+## eventually this needs to be parameterized.
+#ns_return 200 text/html "feature turned off for now"
+
+#return
+
+## END HACK
+
+set_the_usual_form_variables
+# package_name, description, private_p
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![sdm_user_can_add_packages $db $user_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_user_information $db
+
+ns_db dml $db "begin transaction"
+
+set new_package_id [database_to_tcl_string $db "select package_id_sequence.nextval from dual"]
+
+ns_db dml $db "insert into packages (package_id, package_name, private_p, description) VALUES ($new_package_id, '$QQpackage_name', '$private_p', '$QQdescription')"
+
+ns_db dml $db "insert into package_admins (package_id, user_id) VALUES ($new_package_id, $user_id)"
+
+ns_db dml $db "end transaction"
+
+# go back to the main admin page
+ns_returnredirect "index.tcl"
\ No newline at end of file
Index: web/openacs/www/sdm/new-package.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/new-package.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/new-package.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,34 @@
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![sdm_user_can_add_packages $db $user_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+ns_return 200 text/html "
+[sdm_header "New Package"]
+<h2>New Package</h2>
+in <a href=index.tcl>[sdm_system_name]</a>.
+<hr><p>
+
+<FORM method=post action=new-package-2.tcl>
+<table noborder>
+<tr>
+<td>Package Name</td>
+<td><INPUT TYPE=text name=package_name size=50 maxlength=50></td></tr>
+<tr>
+<td>Visibility:</td>
+<td><INPUT TYPE=radio name=private_p value=t>Private <INPUT CHECKED TYPE=radio name=private_p value=f>Public</td></tr>
+<tr>
+<td valign=top>Description:</td>
+<td><TEXTAREA name=description rows=10 cols=60 wrap=soft></TEXTAREA></td></tr>
+</table>
+
+<INPUT TYPE=submit value=create>
+</FORM>
+
+[sdm_footer]
+"
\ No newline at end of file
Index: web/openacs/www/sdm/one-baf-comments.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/one-baf-comments.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/one-baf-comments.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,62 @@
+set_the_usual_form_variables
+# baf_id
+
+validate_integer baf_id $baf_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select package_id, module_id, baf_type, description, entered_by, severity, insertion_date, COALESCE(expected_completion,0) as expected_completion, COALESCE(completion,0) as completion from bugs_and_features where baf_id=$baf_id"]
+set_variables_after_query
+
+set_simple_user_information $db
+
+if {![user_can_see_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_package_information $db $package_id
+
+if {$module_id != "" && $module_id != 0} {
+    if {![user_can_see_module_p $db $user_id $module_id]} {
+	sdm_return_access_complaint
+	return
+    }
+    
+    set_simple_module_information $db $module_id
+}
+
+ReturnHeaders
+
+ns_write "[sdm_header "Comments on a $baf_type"]
+<h2>Comments on <A href=one-baf.tcl?[export_url_vars baf_id]>$baf_type #$baf_id</a></h2>
+in <A href=open-bafs.tcl?[export_url_vars package_id]>bugs and features</a> for <A href=one-package.tcl?[export_url_vars package_id]>$package_name</a>.
+<hr><p>
+
+<h3>Details</h3>
+<blockquote>
+[ns_quotehtml $description]
+</blockquote>
+<p>
+
+<h3>Comments</h3>
+"
+
+set selection [ns_db select $db "select first_names, last_name, comment_date, content, html_p from baf_comments, users where baf_comments.user_id=users.user_id and on_what_id=$baf_id order by comment_date"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    ns_write "<blockquote>
+[ns_quotehtml $content]
+</blockquote>
+by $first_names $last_name, on $comment_date
+<p>
+"
+}
+
+ns_write "<p>
+<a href=baf-comment-add.tcl?[export_url_vars baf_id]>add a comment</a>
+<p>
+"
+ns_write "[sdm_footer]"
Index: web/openacs/www/sdm/one-baf.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/one-baf.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/one-baf.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,311 @@
+set_the_usual_form_variables
+# baf_id
+
+validate_integer baf_id $baf_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select module_id, package_id, baf_status.baf_status as baf_status, baf_status_id, baf_type, description, entered_by, severity, insertion_date, expected_completion, completion from bugs_and_features, baf_status where bugs_and_features.baf_status=baf_status.baf_status_id and baf_id=$baf_id"]
+
+set_variables_after_query
+
+set_simple_user_information $db
+
+if {![user_can_see_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+if {$module_id != "" && $module_id!=0 } {
+    if {![user_can_see_module_p $db $user_id $module_id]} {
+	sdm_return_access_complaint
+	return
+    }
+    set_simple_module_information $db $module_id
+} else {
+    set module_name ""
+}
+
+set_simple_package_information $db $package_id
+
+set selection [ns_db 1row $db "select first_names as entered_by_first_names, last_name as entered_by_last_name from users where user_id=$entered_by"]
+set_variables_after_query
+
+# Is user admin?
+set admin_p [user_can_edit_baf_p $db $user_id $baf_id]
+
+set has_audit_p [database_to_tcl_string $db "select case when count(*)>0 then 1 else 0 end from baf_audit where baf_id=$baf_id"]
+
+set count [database_to_tcl_string $db "select count(*) from baf_comments where on_what_id=$baf_id"]
+
+if {$count > 0} {
+    if {$count > 1} {
+	set comment_word "comments"
+    } else {
+	set comment_word "comment"
+    }
+    set comments_html "<a href=one-baf-comments.tcl?[export_url_vars baf_id]>$count $comment_word</a> | "
+} else {
+    set comments_html ""
+}
+
+if {$baf_status == "closed"} {
+    set extra_menu [list "closed-bafs.tcl?[export_url_vars package_id]" "Closed Bugs and Features"]
+} else {
+    set extra_menu [list "open-bafs.tcl?[export_url_vars package_id]" "Open Bugs and Features"]
+}
+
+ReturnHeaders
+
+ns_write "[sdm_header "a $baf_type"]
+<h2>$baf_type #$baf_id</h2>
+[ad_context_bar_ws_or_index [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] $extra_menu "$baf_type #$baf_id"]
+<hr><p>
+<blockquote>
+[util_convert_plaintext_to_html $description]
+<p>
+<font size=-1>
+$comments_html <a href=baf-comment-add.tcl?[export_url_vars baf_id]>Add a Comment</a>
+</font>
+</blockquote><p>
+<center>
+<table noborder>
+<tr>
+<th bgcolor=lightgrey>Your Interests</th>
+<th bgcolor=lightgrey>$baf_type information</th>
+"
+
+ns_write "
+</tr>
+<tr>
+<td valign=top>
+<center>
+<table noborder width=80%>
+<tr><td>
+"
+
+if {![sdm_user_has_rated_baf_p $user_id $baf_id $db]} {
+    ns_write "<FORM METHOD=GET action=pvt/baf-rate.tcl>
+[export_form_vars baf_id]
+Rate this $baf_type<br>
+(1 is least important, 9 is most important): [make_html_select rating {1 2 3 4 5 6 7 8 9} 5]
+<INPUT TYPE=submit value=rate>
+</FORM><p>
+"
+} else {
+    ns_write "Rating:</td><td align=right><font size=+1><b>[sdm_baf_rating $baf_id $db]</b></font><p>"
+}
+
+ns_write "
+</td>
+</tr>
+<tr>
+<td colspan=2 align=center>
+<FORM METHOD=GET ACTION=pvt/toggle-baf-interest.tcl>
+[export_form_vars baf_id]
+"
+
+if {![sdm_baf_user_is_interested_p $baf_id $user_id $db]} {
+    ns_write "<INPUT TYPE=hidden name=interest value=1>
+<INPUT TYPE=submit value=\"I'm Interested\">"
+} else {
+    ns_write "<INPUT TYPE=hidden name=interest value=0>
+<INPUT TYPE=submit value=\"I'm not Interested\">"
+}
+
+ns_write "
+<br>
+([sdm_baf_n_interested_users $baf_id $db] interested users)
+</FORM>
+</td>
+</tr>
+</table>
+</td>
+"
+
+ns_write "
+<td valign=top>
+"
+
+if {$has_audit_p} {
+    ns_write "<div align=right>\[<a href=baf-audit.tcl?[export_url_vars baf_id]>audit</a>\]</div><br>"
+}
+
+if {!$admin_p || $baf_status_id==[sdm_closed_baf_status_id] || $baf_status_id==[sdm_reopened_baf_status_id]} {
+ns_write "
+<table>
+<tr>
+<td><i>Module</i></td>
+<td>$module_name</td>
+</tr>
+<tr>
+<td><i>Discovered</i></td>
+<td>[util_AnsiDatetoPrettyDate $insertion_date]</td>
+</tr>
+<tr>
+<td><i>Severity</i></td>
+<td>$severity</td>
+</tr>
+<tr>
+<td><i>Status</i></td>
+<td>$baf_status"
+
+# If we're the admins, but the baf is closed,
+# we can reopen it.
+if {$admin_p && $baf_status_id==[sdm_closed_baf_status_id]} {
+    ns_write " <font size=-1>(<a href=pvt/baf-reopen.tcl?[export_url_vars baf_id]>reopen</a>)</font>"
+}
+
+if {$admin_p && $baf_status_id==[sdm_reopened_baf_status_id]} {
+    set new_baf_id [database_to_tcl_string $db "select baf_id from bugs_and_features where old_baf_id=$baf_id"]
+    ns_write " <font size=-1><a href=one-baf.tcl?baf_id=$new_baf_id>reopened...</a></font>"
+}
+
+ns_write "</td>
+</tr>
+<tr>
+<td><i>Entered by</i></td>
+<td><a href=one-user.tcl?user_id=$entered_by>$entered_by_first_names $entered_by_last_name</a>
+</td>
+</tr>
+<tr>
+<td><i>Assigned to</i></td>
+<td>
+<a href=baf-assignments.tcl?[export_url_vars baf_id]>[database_to_tcl_string $db "select sdm_baf_assigned($baf_id)"]</a>
+</td>
+</tr>
+<tr>
+<td><i>Expected Completion</i></td>
+<td><a href=one-package-release.tcl?release_id=$expected_completion&package_id=$package_id>[database_to_tcl_string_or_null $db "select release_name(major_version,minor_version,patch_version,beta_version) from package_releases where release_id=[db_postgres_null_sql $expected_completion] and package_id=$package_id"]</a></td>
+</tr>
+<tr>
+<td><i>Actual Completion</i></td>
+<td><a href=one-package-release.tcl?release_id=$completion&package_id=$package_id>[database_to_tcl_string_or_null $db "select release_name(major_version,minor_version,patch_version,beta_version) from package_releases where release_id=[db_postgres_null_sql $completion] and package_id=$package_id"]</a></td>
+</tr>
+"
+
+
+if {$baf_type == "bug"} {
+    ns_write "<tr><td><i>Releases Affected</i></td>
+<td>"
+
+set selection [ns_db select $db "select release_name(major_version,minor_version,patch_version,beta_version) as release_name, release_id, package_id from package_releases where release_id in (select release_id from bug_release_map where bug_id=$baf_id)"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    ns_write "<a href=one-package-release.tcl?[export_url_vars release_id package_id]>$release_name</a> "
+}
+
+ns_write "</td></tr>"
+}
+
+} else {
+    set list_of_modules [database_to_tcl_list_list $db "select module_id, module_name from modules where package_id=$package_id"]
+    lappend list_of_modules [list "" "(No Module)"]
+## Admin
+set html_form "
+<FORM METHOD=POST action=pvt/baf-edit.tcl>
+[export_form_vars baf_id]
+<table>
+<tr>
+<td><i>Module</i></td>
+<td>[make_html_select module_id $list_of_modules $module_id]</td>
+</tr>
+<tr>
+<td><i>Type</it></td>
+<td>[make_html_select baf_type [sdm_list_of_baf_types] $baf_type]</td>
+</tr>
+<tr>
+<td><i>Discovered</i></td>
+<td>[util_AnsiDatetoPrettyDate $insertion_date]</td>
+</tr>
+<tr>
+<td><i>Severity</i></td>
+<td>[make_html_select severity [sdm_list_of_severities] $severity]</td>
+</tr>
+<tr>
+<td><i>Status</i></td>
+<td>[make_html_select baf_status [database_to_tcl_list_list $db "select baf_status_id, baf_status from baf_status"] $baf_status_id]</td>
+</tr>
+<tr>
+<td><i>Entered by</i></td>
+<td><a href=one-user.tcl?user_id=$entered_by>$entered_by_first_names $entered_by_last_name</a>
+</td>
+</tr>
+<tr>
+<td><i>Assigned to</i></td>
+<td>
+<a href=baf-assignments.tcl?[export_url_vars baf_id]>[database_to_tcl_string $db "select sdm_baf_assigned($baf_id)"]</a>
+</td>
+</tr>
+<tr>
+<td><i>Expected Completion</i></td>
+"
+
+set list_of_release_values [database_to_tcl_list_list $db "select release_id, release_name(major_version,minor_version,patch_version,beta_version) as release_name from package_releases where package_id=$package_id"]
+
+lappend list_of_release_values [list "" "(Not Yet)"]
+
+if {$completion == 0} {
+    set completion ""
+}
+
+if {$completion != ""} {
+    append html_form "
+<td><a href=one-package-release.tcl?release_id=$expected_completion&package_id=$package_id>[database_to_tcl_string_or_null $db "select release_name(major_version,minor_version,patch_version,beta_version) from package_releases where release_id=[db_postgres_null_sql $expected_completion] and package_id=$package_id"]</a></td>"
+} else {
+    append html_form "
+<td>[make_html_select expected_completion $list_of_release_values $expected_completion]</td>
+"
+}
+
+append html_form "</tr>
+<tr>
+<td><i>Actual Completion</i></td>
+<td>"
+
+if {$completion != ""} {
+append html_form "<A href=one-package-release.tcl?release_id=$completion>[database_to_tcl_string $db "select fetch_release_name($completion)"]</a>" 
+}
+
+append html_form "</td>
+</tr>
+"
+
+if {$baf_type == "bug"} {
+    append html_form "<tr><td><i>Releases Affected</i></td>
+<td>"
+
+set selection [ns_db select $db "select release_name(major_version,minor_version,patch_version,beta_version) as release_name, release_id, package_id from package_releases where release_id in (select release_id from bug_release_map where bug_id=$baf_id)"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    append html_form "<a href=one-package-release.tcl?[export_url_vars release_id package_id]>$release_name</a> "
+}
+
+}
+
+ns_write "$html_form</td>
+</tr>
+<tr>
+<td colspan=2 align=center>
+<INPUT TYPE=submit value=edit>
+</FORM>
+</td></tr>"
+
+}
+
+
+ns_write "</table></td>
+</tr>
+</table>
+</center>
+<p>
+"
+
+ns_write "<p>
+</blockquote>
+[sdm_footer]
+"
\ No newline at end of file
Index: web/openacs/www/sdm/one-bug.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/one-bug.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/one-bug.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,6 @@
+set_the_usual_form_variables
+# baf_id
+
+validate_integer baf_id $baf_id
+
+ns_returnredirect "one-baf.tcl?[export_url_vars baf_id]"
Index: web/openacs/www/sdm/one-feature.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/one-feature.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/one-feature.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,6 @@
+set_the_usual_form_variables
+# baf_id
+
+validate_integer baf_id $baf_id
+
+ns_returnredirect "one-baf.tcl?[export_url_vars baf_id]"
Index: web/openacs/www/sdm/one-file-annotate.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/one-file-annotate.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/one-file-annotate.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,36 @@
+set_the_usual_form_variables
+# package_id
+# current_entry
+
+validate_integer package_id $package_id
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+
+if {![user_can_see_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+if {![sdm_sourcecode_package_has_repository_p $db $package_id]} {
+    ad_return_complaint 1 "Package does not have a repository"
+    return
+}
+
+set_simple_package_information $db $package_id
+
+set_simple_repository_information $db $package_id
+
+if {![sdm_sourcecode_entry_safe $current_entry $repository_name]} {
+    ns_return 200 text/html "$current_entry"
+    return
+}
+
+set cvsroot [cvs_get_cvsroot $package_id $db]
+
+set annotations [cvs_file_annotate [sdm_source_root][sdm_sourcecode_entry_path $current_entry] [sdm_sourcecode_entry_name $current_entry] $cvsroot]
+
+ad_return_template
+
Index: web/openacs/www/sdm/one-module.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/one-module.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/one-module.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,76 @@
+set_the_usual_form_variables
+# module_id
+
+validate_integer module_id $module_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![user_can_see_module_p $db $user_id $module_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+ReturnHeaders
+
+set selection [ns_db 1row $db "select module_name, package_id, description, owner from modules where modules.module_id=$module_id"]
+set_variables_after_query
+
+set selection [ns_db 1row $db "select first_names, last_name, email from users where user_id=$owner"]
+set_variables_after_query
+
+set selection [ns_db 1row $db "select package_name from packages where package_id=$package_id"]
+set_variables_after_query
+
+ns_write "[sdm_header "$module_name"]
+<h2>$module_name</h2>
+[ad_context_bar_ws_or_index [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] $module_name]
+<hr><p>
+
+<blockquote>
+[ns_quotehtml $description]
+</blockquote>
+<p>
+<center>
+<table border=2 cellpadding=4>
+<tr>
+<td><strong>Maintained By</strong></td>
+<td>$first_names $last_name ($email)</td>
+</tr>
+</table></center>
+<p>"
+
+if {[user_can_edit_module_p $db $user_id $module_id]} {
+    ns_write "
+<ul>
+<li> <a href=pvt/edit-module.tcl?[export_url_vars module_id]>Edit</a> this module
+<li> <a href=pvt/module-users.tcl?[export_url_vars module_id]>Users</a> of this module
+<li> <a href=pvt/module-delete.tcl?[export_url_vars module_id]>Delete</a> this module\n"
+
+ns_write "
+</ul>
+"
+}
+
+ns_write "
+<ul>
+"
+
+set n_open_bugs [database_to_tcl_string $db "select count(*) from bugs_and_features, baf_status where baf_type='bug' and bugs_and_features.baf_status=baf_status.baf_status_id and baf_status.baf_status='open' and module_id=$module_id"]
+set n_open_features [database_to_tcl_string $db "select count(*) from bugs_and_features, baf_status where baf_type='feature' and bugs_and_features.baf_status=baf_status.baf_status_id and baf_status.baf_status='open' and module_id=$module_id"]
+
+
+ns_write "
+<li> <a href=open-bafs.tcl?[export_url_vars module_id package_id]>Open Bugs ($n_open_bugs) and Features ($n_open_features)</a> for this module
+"
+
+ns_write "</ul>
+<p>
+"
+
+
+ns_write "<p>
+
+[sdm_footer]
+"
\ No newline at end of file
Index: web/openacs/www/sdm/one-package-release.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/one-package-release.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/one-package-release.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,205 @@
+set_the_usual_form_variables
+# release_id
+
+validate_integer release_id $release_id
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+set package_id [database_to_tcl_string $db "select package_id from package_releases where release_id=$release_id"]
+
+if {![user_can_see_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_package_information $db $package_id
+
+# Check if the user is the manager for this release
+set release_manager_user_id [database_to_tcl_string $db "select manager from package_releases where package_id=$package_id and release_id=$release_id"]
+
+if {$user_id == $release_manager_user_id} {
+    set user_is_manager_p 1
+} else {
+    set user_is_manager_p 0
+}
+
+set selection [ns_db 1row $db "select release_name(major_version,minor_version,patch_version,beta_version) as release_name, general_description, release_filename, anticipated_release_date, release_date, user_id as manager_user_id, email as manager_email, first_names as manager_first_names, last_name as manager_last_name, supported_platforms from package_releases, users where package_id=$package_id and release_id=$release_id and manager=user_id"]
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "[sdm_header "A release"]
+<h2>$package_name: Release $release_name</h2>
+[ad_context_bar_ws_or_index [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] $release_name]
+<hr><p>
+"
+
+ns_write "
+<center>
+<table border=1 cellpadding=4>
+<tr>
+<td><i>Manager</i></td>
+<td><A href=one-user.tcl?user_id=$release_manager_user_id>$manager_first_names $manager_last_name</a> ($manager_email)</td>
+</tr>
+<tr>
+<td><i>Anticipated Release Date</i></td>
+<td>[util_AnsiDatetoPrettyDate $anticipated_release_date]</td>
+</tr>
+<tr>
+<td><i>Release Date</i></td>
+<td>[util_AnsiDatetoPrettyDate $release_date]</td>
+</tr>
+<tr>
+<td><i>Supported Platforms</i></td>
+<td>$supported_platforms</td>
+</tr>
+</table>
+</center>
+<p>
+<blockquote>
+$general_description
+</blockquote><p>
+"
+
+if {$release_date != "" && $release_filename!=""} {
+    ns_write "
+<center><form method=get action=download-package-release.tcl>
+[export_form_vars release_id package_id]
+<input type=submit value=download>
+</FORM>
+[database_to_tcl_string $db "select count(*) from package_release_downloads where package_id=$package_id and release_id=$release_id"] downloads<br>
+(<a href=package-release-notes.tcl?[export_url_vars package_id release_id]>Release Notes</a>)
+</center>
+<p>
+"
+}
+
+# ns_write "<p><hr width=70%><p>"
+
+# Administration Section
+if {$user_is_manager_p} {
+    ns_write "[html_section_title "Administration"]
+<ul>
+<li> <a href=pvt/package-release-notes-edit.tcl?[export_url_vars package_id release_id]>Edit Release Notes</a>
+"
+    if {$release_date == ""} {
+	ns_write "
+<FORM method=post action=pvt/package-release-anticipated-release-date.tcl>
+<li> <a href=pvt/package-release-edit.tcl?[export_url_vars release_id package_id]>edit</a> release
+<li> Set Anticipated Release Date:
+[export_form_vars release_id package_id]
+[philg_dateentrywidget anticipated_release_date [database_to_tcl_string $db "select sysdate()::date"]]
+<INPUT TYPE=submit value=set>
+</FORM>
+<li> <A href=pvt/package-release-make-live.tcl?[export_url_vars package_id release_id]>Make this release live</a>
+"
+} else {
+    set active_release_id [database_to_tcl_string $db "select current_release from packages where package_id=$package_id"]
+
+    if {$active_release_id != $release_id} {
+	ns_write "
+<li> <a href=pvt/package-release-choose-live.tcl?[export_url_vars release_id]>make this release the live one</a>.\n"
+}
+    
+    set selection [ns_db select $db "select release_id as new_release_id, release_name(major_version, minor_version, patch_version, beta_version) as new_release_name from package_releases where release_date is NOT NULL and package_id=$package_id and release_id <> $release_id"]
+
+    set release_select_html "<SELECT name=new_release_id>
+    <OPTION SELECTED VALUE=\"\"> No current release
+    "
+    
+    while {[ns_db getrow $db $selection]} {
+	set_variables_after_query
+
+	append release_select_html "<OPTION VALUE=$new_release_id> $new_release_name\n"
+    }
+
+    append release_select_html "</SELECT>"
+    
+    ns_write "
+<FORM METHOD=POST action=pvt/package-release-make-unlive.tcl>
+<li> If you want to take back this release so that it not be live anymore, you can choose to do so by picking a past release to replace this one as the live one:
+[export_form_vars package_id release_id]
+$release_select_html
+<INPUT TYPE=submit value=go>
+</FORM>
+"
+}
+ns_write "
+</ul>
+<p>
+"
+}
+
+set selection [ns_db 1row $db "select major_version,minor_version,patch_version,beta_version from package_releases where package_id=$package_id and release_id=$release_id"]
+set_variables_after_query
+
+# Get the features that were just implemented in this release.
+set selection [ns_db select $db "select baf_id, substr(description,0,100) as short_description from features, package_releases where features.completion=package_releases.release_id and package_releases.release_id=$release_id"]
+
+set flag 0
+
+while {[ns_db getrow $db $selection]} {
+    if {!$flag} {
+	ns_write "
+	<h3>Implemented Features</h3>
+	<ul>
+	"
+	set flag 1
+    }
+
+    set_variables_after_query
+
+    ns_write "<li> <A href=one-feature.tcl?[export_url_vars baf_id]>Feature #$baf_id</a>: $short_description ...\n"
+}
+
+ns_write "</ul><P>"
+
+# Get the bugs that are fixed in this release
+set selection [ns_db select $db "select baf_id, substr(description,0,100) as short_description from bugs, package_releases where bugs.completion=package_releases.release_id and package_releases.release_id=$release_id"]
+
+set flag 0
+
+while {[ns_db getrow $db $selection]} {
+    if {!$flag} {
+	ns_write "
+	<h3>Fixed Bugs</h3>
+	<ul>
+	"
+	set flag 1
+    }
+
+    set_variables_after_query
+
+    ns_write "<li> <A href=one-bug.tcl?[export_url_vars baf_id]>Bug #$baf_id</a>: $short_description ...\n"
+}
+
+ns_write "</ul><P>"
+
+
+
+set selection [ns_db select $db "select baf_id, substr(description,0,100) as short_description from bugs, package_releases, bug_release_map where bugs.baf_id=bug_release_map.bug_id and package_releases.release_id=$release_id and package_releases.package_id=$package_id and package_releases.release_id=bug_release_map.release_id"]
+
+set flag 0
+
+while {[ns_db getrow $db $selection]} {
+    if {!$flag} {
+	ns_write "
+	<h3>Known Bugs</h3>
+	<ul>
+	"
+	set flag 1
+    }
+
+    set_variables_after_query
+
+    ns_write "<li> <A href=one-bug.tcl?[export_url_vars baf_id]>Bug #$baf_id</a>: $short_description ...\n"
+}
+
+ns_write "</ul>
+
+<p>
+
+[sdm_footer]
+"
Index: web/openacs/www/sdm/one-package.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/one-package.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/one-package.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,148 @@
+set_the_usual_form_variables
+# package_id
+
+validate_integer package_id $package_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+# Check that this package can be accessed here
+if {![user_can_see_package_p $db $user_id $package_id]} {
+    ad_return_complaint "1" "the package doesn't belong to you!"
+    return
+}
+
+ReturnHeaders
+
+set selection [ns_db 1row $db "select package_name, description, current_release as release_id from packages where packages.package_id=$package_id"]
+set_variables_after_query
+
+# Postgres outer join
+if {$release_id != ""} {
+    set selection [ns_db 1row $db "select manager as owner, release_name(major_version, minor_version, patch_version, beta_version) as release_name from package_releases where release_id=$release_id"]
+    set_variables_after_query
+} else {
+    set release_name ""
+    set owner ""
+}
+
+ns_write "[sdm_header "$package_name"]
+<h2>$package_name</h2>
+[ad_context_bar_ws_or_index [sdm_home_context_bar_item] "$package_name"]
+<hr><p>"
+
+if {$owner != ""} {
+    set selection [ns_db 1row $db "select first_names, last_name, email from users where user_id=$owner"]
+    set_variables_after_query
+}
+
+ns_write "
+
+<center>
+<table noborder>
+<tr>
+<th width=50% bgcolor=lightgrey>Package Information</th>
+<th width=50% bgcolor=lightgrey>Community</th>
+</tr>
+<tr>
+<td valign=top>
+[ns_quotehtml $description]
+<p>
+</td>
+"
+
+# Community Stuff
+ns_write "
+<td rowspan=2 valign=top>
+<center>
+<FORM METHOD=GET ACTION=pvt/toggle-package-interest.tcl>
+[export_form_vars package_id]"
+
+if {![sdm_package_user_is_interested_p $package_id $user_id $db]} {
+    ns_write "<INPUT TYPE=hidden name=interest value=1>
+<INPUT TYPE=submit value=\"I'm Interested\">"
+} else {
+    ns_write "<INPUT TYPE=hidden name=interest value=0>
+<INPUT TYPE=submit value=\"I'm not Interested\">"
+}
+
+ns_write "
+<br>
+([sdm_package_n_interested_users $package_id $db] interested users)
+</FORM>
+</center>
+</td></tr>
+<tr>
+<td>
+<font size=-1> <a href=open-bafs.tcl?[export_url_vars package_id]>Bugs/Features</a>  |  <a href=package-releases.tcl?[export_url_vars package_id]>Releases</a>
+"
+
+if {$release_id != ""} {
+    ns_write " | <a href=one-package-release.tcl?[export_url_vars release_id]>Current Release is $release_name</a>"
+}
+
+ns_write "</font>
+</td>
+</tr>
+</table>
+</center>"
+
+ns_write "<p><ul>"
+
+## The SDM repository is not used for now
+if {[sdm_sourcecode_package_has_repository_p $db $package_id]} {
+    ns_write "<li> <a href=package-repository.tcl?[export_url_vars package_id]>Code Repository</a>"
+} else {
+    if {[user_can_edit_package_p $db $user_id $package_id]} {
+	ns_write "<li> <a href=pvt/package-repository-create.tcl?[export_url_vars package_id]>Create Code Repository</a>"
+    }
+}
+
+
+ns_write "
+<li> <a href=package-patches.tcl?[export_url_vars package_id]>Patches</a>
+</ul>
+"
+
+if {[user_can_edit_package_p $db $user_id $package_id]} {
+    ns_write "
+    [html_section_title "Administration"]
+ <ul>
+    <li> <a href=pvt/edit-package.tcl?[export_url_vars package_id]>Edit</a> this package.
+    <li> <a href=pvt/package-admins.tcl?[export_url_vars package_id]>Admins</a> for this package.
+    <li> <a href=pvt/package-cvs-edit.tcl?[export_url_vars package_id]>edit cvs</a> for this package.
+    </ul>
+"
+}
+
+ns_write "
+<p>
+[html_section_title "Modules"]
+<ul>
+"
+
+if {[user_can_edit_package_p $db $user_id $package_id]} {
+    ns_write "
+<li> <a href=pvt/new-module.tcl?[export_url_vars package_id]>New</a> Module.<p>
+"}
+
+ns_write "<p>"
+
+set selection [ns_db select $db "select module_id, module_name, description from modules where package_id=$package_id and user_can_see_module_p($user_id, module_id)='t' order by module_name"]
+
+ns_write "<table>"
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    ns_write "<tr><td><a href=one-module.tcl?[export_url_vars module_id]>$module_name</a></td><td>[ns_quotehtml $description]</td></tr>\n"
+}
+
+
+ns_write "</table>
+</ul>
+<p>
+[sdm_footer]
+"
+
Index: web/openacs/www/sdm/one-patch.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/one-patch.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/one-patch.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,46 @@
+set_the_usual_form_variables
+# patch_id
+
+validate_integer patch_id $patch_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+set package_id [database_to_tcl_string $db "select package_id from sdm_package_patches where patch_id=$patch_id"]
+
+if {![user_can_see_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_package_information $db $package_id
+
+set selection [ns_db 1row $db "select patch_description, fetch_release_name(package_release_id) as release_name,
+sdm_package_patch_rating(patch_id) as overall_rating, 
+patch_file, user_full_name(user_id) as submitter_name, user_full_name(action_user) as action_name, 
+submission_date, accepted_p, action_date, action_description from sdm_package_patches where patch_id=$patch_id"]
+
+set_variables_after_query
+
+set file [open [sdm_one_package_patch_file_path $package_id]/$patch_file r]
+set patch_content [read $file]
+close $file
+
+switch $accepted_p {
+    t {
+	set action "accepted on [util_AnsiDatetoPrettyDate $action_date] by $action_name<br>$action_description"
+    }
+    f {
+	set action "refused on [util_AnsiDatetoPrettyDate $action_date] by $action_name<br>$action_description"
+    }
+    default {
+	set action ""
+    }
+}
+
+set user_is_admin [user_can_edit_package_p $db $user_id $package_id]
+
+set user_rating [database_to_tcl_string_or_null $db "select numeric_rating from sdm_package_patch_ratings where patch_id= $patch_id and user_id=$user_id"]
+
+ad_return_template
Index: web/openacs/www/sdm/one-user.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/one-user.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/one-user.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,7 @@
+set_the_usual_form_variables
+# user_id
+
+validate_integer user_id $user_id
+
+ns_returnredirect "pvt/one-user.tcl?[export_url_vars user_id]"
+
Index: web/openacs/www/sdm/open-bafs.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/open-bafs.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/open-bafs.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,131 @@
+set_the_usual_form_variables
+# package_id
+
+validate_integer package_id $package_id
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+if {![user_can_see_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_package_information $db $package_id
+
+if {[info exists module_id] && $module_id!=""} {
+    set module_name [database_to_tcl_string $db "select module_name from modules where module_id=$module_id"]
+    set menu_bar [ad_context_bar_ws_or_index [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] [sdm_module_context_bar_item $module_id $module_name] "Open Bugs and Features"]
+    set extra_sql "and module_id=$module_id"
+} else {
+    set menu_bar [ad_context_bar_ws_or_index [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] "Open Bugs and Features"]
+    set extra_sql ""
+}    
+
+ReturnHeaders
+
+ns_write "[sdm_header "Open Bugs and Features"]
+<h2>Open Bugs and Features</h2>
+$menu_bar
+<hr><p>
+
+You can check the <A href=closed-bafs.tcl?[export_url_vars package_id module_id]>closed bugs and features</a> for this package, instead.<p>
+<ul>
+<li> <A href=pvt/new-bug.tcl?[export_url_vars module_id package_id]>Report a new bug</a>
+<li> <A href=pvt/new-feature.tcl?[export_url_vars module_id package_id]>Request a new feature</a>.
+</ul>
+<p>
+
+[html_section_title "Bugs"]
+<p>
+<blockquote><table noborder cellspacing=0 cellpadding=2>
+<tr>
+<th bgcolor=lightblue>Bug #</th><th bgcolor=lightblue>Rating</th><th bgcolor=lightblue># Interested</th><th bgcolor=lightblue>Severity</th><th bgcolor=lightblue>Module</th><th bgcolor=lightblue>Assigned To</th><th bgcolor=lightblue>Expected Completion</th><th bgcolor=lightblue>Description</th>
+</tr>
+"
+
+set selection [ns_db select $db "select baf_id, severity, substr(bugs.description,0,200) as short_description, baf_module(baf_id) as module_name, expected_completion as expected_fix_release_id, fetch_release_name(expected_completion) as expected_fix_release_name, baf_rating(baf_id) as rating, baf_n_interested(baf_id) as n_interested, sdm_baf_assigned(baf_id) as assigned_to from open_bugs bugs where bugs.package_id=$package_id $extra_sql order by rating desc, n_interested desc"]
+
+set odd_row 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    
+    # shading
+    set odd_row [expr 1 - $odd_row]
+    if {$odd_row} {
+	set shading "bgcolor=#cccccc"
+    } else {
+	set shading ""
+    }
+
+    ns_write "<tr><td $shading><a href=one-bug.tcl?[export_url_vars baf_id]>$baf_id</a></td>
+<td align=right $shading>&nbsp;$rating</td>
+<td align=right $shading>$n_interested</td>
+<td $shading>$severity</td>
+<td $shading>&nbsp;$module_name</td>
+<td $shading>&nbsp;$assigned_to</td>
+<td $shading>&nbsp;$expected_fix_release_name</td>
+<td $shading>[ns_quotehtml $short_description] ...</td>
+</tr>"
+}
+
+ns_write "</table></blockquote>
+
+<p>
+&nbsp;
+<p>
+[html_section_title "Features"]
+<p>
+<blockquote>
+<table cellspacing=0 cellpadding=2>
+<tr>
+<th bgcolor=lightblue>Feature #</th><th bgcolor=lightblue>Rating</th><th bgcolor=lightblue># Interested</th><th bgcolor=lightblue>Severity</th><th bgcolor=lightblue>Module</th><th bgcolor=lightblue>Assigned To</th><th bgcolor=lightblue>Expected Completion</th><th bgcolor=lightblue>Description</th>
+</tr>
+"
+
+set selection [ns_db select $db "select 
+baf_id, severity,
+baf_module(module_id) as module_name,
+substr(features.description,0,200) as short_description, 
+expected_completion as expected_fix_release_id, 
+fetch_release_name(expected_completion) as expected_fix_release_name,
+baf_rating(baf_id) as rating,
+baf_n_interested(baf_id) as n_interested,
+sdm_baf_assigned(baf_id) as assigned_to
+from 
+open_features features
+where features.package_id=$package_id $extra_sql order by severity desc"]
+
+set odd_row 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    # shading
+    set odd_row [expr 1 - $odd_row]
+    if {$odd_row} {
+	set shading "bgcolor=#cccccc"
+    } else {
+	set shading ""
+    }
+
+    ns_write "<tr><td $shading><a href=one-feature.tcl?[export_url_vars baf_id]>$baf_id</a></td>
+<td align=right $shading>&nbsp;$rating</td>
+<td align=right $shading>$n_interested</td>
+<td $shading>$severity</td>
+<td $shading>&nbsp;$module_name</td>
+<td $shading>$assigned_to</td>
+<td $shading>&nbsp;$expected_fix_release_name</td>
+<td $shading>[ns_quotehtml $short_description] ...</td>
+</tr>"
+}
+
+
+ns_write "</table></blockquote>
+
+<p>
+
+[sdm_footer]
+"
\ No newline at end of file
Index: web/openacs/www/sdm/package-patches.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/package-patches.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/package-patches.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,19 @@
+set_the_usual_form_variables
+# package_id
+
+validate_integer package_id $package_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![user_can_see_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_package_information $db $package_id
+
+set patches [database_to_tcl_list_ns_set $db "select patch_id, sdm_package_patch_rating(patch_id) as overall_rating, first_names, last_name, email, fetch_release_name(package_release_id) as release_name, submission_date, patch_description from sdm_package_patches, users where sdm_package_patches.user_id= users.user_id and sdm_package_patches.package_id=$package_id order by overall_rating desc"]
+
+ad_return_template
Index: web/openacs/www/sdm/package-release-notes.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/package-release-notes.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/package-release-notes.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,48 @@
+set_the_usual_form_variables
+# package_id release_id
+
+validate_integer package_id $package_id
+validate_integer release_id $release_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![user_can_see_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_package_information $db $package_id
+
+set selection [ns_db 1row $db "select release_name(major_version,minor_version,patch_version,beta_version) as release_name from package_releases where package_id=$package_id and release_id=$release_id"]
+set_variables_after_query
+
+set release_notes [database_to_tcl_string $db "select release_notes from package_releases where package_id=$package_id and release_id=$release_id"]
+
+ReturnHeaders
+
+ns_write "
+[sdm_header "Release Notes"]
+<h2>Release Notes</h2>
+[ad_context_bar_ws_or_index [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] [list "one-package-release.tcl?[export_url_vars package_id release_id]" "Release $release_name"] "Release Notes"]
+<hr><p>
+
+<blockquote>
+$release_notes
+</blockquote>
+"
+
+if {[user_can_edit_package_p $db $user_id $package_id]} {
+    ns_write "[html_section_title "Administration"]
+
+<blockquote>
+<ul>
+<li> <a href=pvt/package-release-notes-edit.tcl?[export_url_vars package_id release_id]>Edit</a> release notes.
+</ul>
+</blockquote>
+"
+}
+
+ns_write "<p>
+[sdm_footer]"
\ No newline at end of file
Index: web/openacs/www/sdm/package-releases.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/package-releases.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/package-releases.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,53 @@
+set_the_usual_form_variables
+# package_id
+
+validate_integer package_id $package_id
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+# check access
+if {![user_can_see_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_package_information $db $user_id
+
+ReturnHeaders
+
+ns_write "[sdm_header "Package Releases"]
+<h2>Package Releases</h2>
+[ad_context_bar_ws_or_index [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] Releases]
+<hr><p>
+
+<ul>
+"
+
+if {[user_can_edit_package_p $db $user_id $package_id]} {
+    ns_write "
+<li> <a href=pvt/package-release-new.tcl?[export_url_vars package_id]>Create</a> a new release.<p>
+"
+}
+
+set selection [ns_db select $db "select release_id, general_description, release_name(major_version,minor_version,patch_version,beta_version) as release_name, anticipated_release_date, release_date, user_id as manager_user_id, first_names as manager_first_names, last_name as manager_last_name, email as manager_email, supported_platforms from package_releases,users where package_id=$package_id and package_releases.manager=users.user_id order by 3"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    ns_write "<li>
+<strong><font size=+1><a href=one-package-release.tcl?[export_url_vars package_id release_id]>Release $release_name</a></font></strong><br>
+$general_description<br>
+<i>Manager</i>: <A href=one-user.tcl?user_id=$manager_user_id>$manager_first_names $manager_last_name</a> ($manager_email)<br>
+<i>Anticipated Release Date</i>: $anticipated_release_date<br>
+<i>Release Date</i>: $release_date<br>
+<i>Supported Platforms</i>: $supported_platforms<br>
+<p>
+"
+}
+
+ns_write "</ul>
+<p>
+[sdm_footer]"
+
Index: web/openacs/www/sdm/package-repository.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/package-repository.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/package-repository.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,159 @@
+set_the_usual_form_variables
+# package_id
+# possibly full_entry_path
+
+validate_integer package_id $package_id
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+
+if {![user_can_see_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+if {![sdm_sourcecode_package_has_repository_p $db $package_id]} {
+    ad_return_complaint 1 "Package does not have a repository"
+    return
+}
+
+set_simple_package_information $db $package_id
+
+set_simple_repository_information $db $package_id
+
+if {![info exists current_entry]} {
+    set current_entry [sdm_sourcecode_make_entry DIRECTORY {} $repository_name]
+}
+
+if {![sdm_sourcecode_entry_safe $current_entry $repository_name]} {
+    ns_return 200 text/html "$current_entry"
+    return
+}
+
+ReturnHeaders
+
+ns_write "[sdm_header "Repository: $package_name"]
+<h2>Source Repository</h2>
+[ad_context_bar_ws_or_index [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] "Source Code Repository"]
+<hr><p>
+"
+
+if {[user_can_edit_package_p $db $user_id $package_id]} {
+    ns_write "<ul>
+<li> <a href=pvt/package-repository-edit.tcl?[export_url_vars package_id]>edit repository properties</a>
+<li> <a href=pvt/package-download-source.tcl?[export_url_vars package_id]>get new source from CVS</a>
+</ul><p>"
+}
+
+ns_write "<h3>"
+
+
+
+if {[sdm_sourcecode_entry_has_parent $current_entry]} {
+    set parent_entry [sdm_sourcecode_entry_parent_entry $current_entry]
+    ns_write "<a href=package-repository.tcl?current_entry=[ns_urlencode $parent_entry]&[export_url_vars package_id]>[sdm_sourcecode_entry_path $parent_entry]/[sdm_sourcecode_entry_name $parent_entry]</a>"
+}
+
+ns_write "/[sdm_sourcecode_entry_name $current_entry]</h3>"
+
+if {[sdm_sourcecode_entry_type $current_entry] == "DIRECTORY"} {
+    
+    # ns_write "<ul>"
+    ns_write "
+    <table boder=0>
+    <tr><th>File</th><th>current</th><th>Last Updated</th><th>Author</th><th>Comments</th></tr>
+    "
+
+    set light_background "eeeeee"
+    set dark_background "cccccc"
+    set bgs [list $light_background $dark_background]
+
+    set counter 0
+
+    # list that directory
+    set list_of_entries [sdm_sourcecode_list_entries $current_entry $file_glob_patterns]
+    
+    foreach entry $list_of_entries {
+	#ns_write "<li> "
+	set counter [expr "1 - $counter"]
+	
+	ns_write "<tr bgcolor=#[lindex $bgs $counter]>"
+	set current_entry $entry
+
+	if {[sdm_sourcecode_entry_type $entry] == "DIRECTORY"} {
+	    ns_write " <td><a href=\"package-repository.tcl?[export_url_vars current_entry package_id]\">[sdm_sourcecode_entry_name $entry]</a>/</td><td>&nbsp;</td><td>&nbsp;</td><td>&nbsp;</td><td>&nbsp;</td>"
+	} else {
+	    ns_write " <td><a href=\"package-repository.tcl?[export_url_vars current_entry package_id]\">[sdm_sourcecode_entry_name $entry]</a></td>"
+
+	    set cvsroot [cvs_get_cvsroot $package_id $db]
+
+	    set history [cvs_file_get_history [sdm_source_root][sdm_sourcecode_entry_path $entry] [sdm_sourcecode_entry_name $entry] $cvsroot]
+
+	    set hist [lindex $history 0]
+	    
+	    ns_write "<td>[cvs_history_get_revision $hist]</td><td>[cvs_history_get_date $hist]</td><td>[cvs_history_get_author $hist]</td><td>[cvs_history_get_comments $hist]</td>"
+	}
+
+	ns_write "</tr>"
+
+    }
+    
+    ns_write "</table>"
+} else {
+    set cvsroot [cvs_get_cvsroot $package_id $db]
+
+    set history [cvs_file_get_history [sdm_source_root][sdm_sourcecode_entry_path $current_entry] [sdm_sourcecode_entry_name $current_entry] $cvsroot]
+
+    if {![info exists tag]} {
+	set tag [cvs_history_get_revision [lindex $history 0]]
+    }
+	
+    set version_html ""
+    set list_of_other_tags [list]
+
+    foreach hist $history {
+	if {[cvs_history_get_revision $hist] == $tag} {
+	    set current_hist $hist
+	    
+	    append version_html "<b>[cvs_history_get_revision $hist]</b> &nbsp "
+	} else {
+	    append version_html "<a href=package-repository.tcl?[export_url_vars package_id current_entry]&tag=[cvs_history_get_revision $hist]>[cvs_history_get_revision $hist]</a> &nbsp "
+	    lappend list_of_other_tags [cvs_history_get_revision $hist]
+	}
+    }
+
+    set new_release $tag
+
+    ns_write "
+<table border=0>
+<tr><td>Revision</td><td>$version_html</td></tr>
+<tr><td>Author</td><td>[cvs_history_get_author $current_hist]</td></tr>
+<tr><td valign=top>Comments</td><td>[cvs_history_get_comments $current_hist]</td></tr>
+</table>
+<p>
+
+<FORM method=get action=entry-history-diff.tcl>
+[export_form_vars current_entry new_release package_id]
+Diff this with: [make_html_select old_release $list_of_other_tags]<br>
+<INPUT TYPE=submit value=diff>
+</FORM>
+<p>
+<a href=one-file-annotate.tcl?[export_url_vars package_id current_entry]>annotate this file</a>
+<p>
+"
+
+    # This should be abstracted
+    set raw_contents [ns_quotehtml [cvs_checkout_to_string [sdm_sourcecode_entry_fullpath $current_entry] $cvsroot $tag]]
+    set colorized_contents [sdm_sourcecode_colorize [sdm_sourcecode_entry_name $current_entry] $raw_contents]
+    set colorized_contents_with_line_numbers [sdm_sourcecode_add_lines_numbers $colorized_contents]
+
+    ns_write "<blockquote><pre>
+$colorized_contents_with_line_numbers
+</pre>
+</blockquote>
+"
+}
+	
+ns_write "[sdm_footer]"
\ No newline at end of file
Index: web/openacs/www/sdm/patch-accept.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/patch-accept.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/patch-accept.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,37 @@
+set_the_usual_form_variables
+# patch_id
+
+validate_integer patch_id $patch_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select sdm_package_patches.package_id, patch_file, repository_name from sdm_package_patches, package_repositories where patch_id=$patch_id and package_repositories.package_id=sdm_package_patches.package_id"]
+set_variables_after_query
+
+# Permission checking
+if {![user_can_edit_package_p $db $user_id $package_id]} {
+    ns_returnredirect "one-patch.tcl?[export_url_vars patch_id]"
+    return
+}
+
+# Update the CVS data
+set cvs_path [cvs_get_cvsroot $package_id $db]
+cd [sdm_source_root]
+cvs_checkout $repository_name $cvs_path
+cd $repository_name
+
+# apply patch
+if {[catch {set result [exec patch -p0 < [sdm_one_package_patch_file_path $package_id]/$patch_file]} errmsg]} {
+    set result $errmsg
+}
+
+cvs_commit $repository_name $cvs_path "patch #$patch_id committed"
+
+ns_db dml $db "update sdm_package_patches set accepted_p='t', action_user=$user_id, action_date=sysdate() where patch_id=$patch_id"
+
+ad_return_template
+
+
+
Index: web/openacs/www/sdm/patch-rate-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/patch-rate-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/patch-rate-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,20 @@
+set_the_usual_form_variables
+# patch_id numeric_rating description
+
+validate_integer patch_id $patch_id
+validate_integer numeric_rating $numeric_rating
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+set package_id [database_to_tcl_string $db "select package_id from sdm_package_patches where patch_id=$patch_id"]
+
+if {![user_can_see_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+catch {ns_db dml $db "insert into sdm_package_patch_ratings (patch_id, user_id, numeric_rating, description, rating_date) values ($patch_id, $user_id, $numeric_rating, '[DoubleApos $description]', [db_sysdate])"} errmsg
+
+ns_returnredirect "one-patch.tcl?[export_url_vars patch_id]"
Index: web/openacs/www/sdm/patch-rate.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/patch-rate.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/patch-rate.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,19 @@
+set_the_usual_form_variables
+# patch_id
+
+validate_integer patch_id $patch_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+set package_id [database_to_tcl_string $db "select package_id from sdm_package_patches where patch_id=$patch_id"]
+
+if {![user_can_see_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_package_information $db $package_id
+
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/sdm/patch-ratings.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/patch-ratings.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/patch-ratings.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,22 @@
+set_the_usual_form_variables
+# patch_id
+
+validate_integer patch_id $patch_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+set package_id [database_to_tcl_string $db "select package_id from sdm_package_patches where patch_id=$patch_id"]
+
+if {![user_can_see_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_package_information $db $package_id
+
+set patch_ratings [database_to_tcl_list_ns_set $db "select numeric_rating, description, rating_date, user_id as rate_user_id, user_full_name(user_id) as rate_user_name from sdm_package_patch_ratings where patch_id=$patch_id"]
+
+ad_return_template
+
Index: web/openacs/www/sdm/patch-submit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/patch-submit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/patch-submit-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,26 @@
+set_the_usual_form_variables
+# package_id release_id patch_file patch_file.tmpfile patch_description
+
+validate_integer package_id $package_id
+validate_integer release_id $release_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![user_can_see_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set safe_patch_filename [util_make_filename_safe $patch_file]
+
+set patch_id [db_sequence_nextval $db sdm_patch_id_sequence]
+
+set full_path [sdm_one_patch_file_full_path $package_id $patch_id $safe_patch_filename]
+
+ns_cp ${patch_file.tmpfile} $full_path
+
+ns_db dml $db "insert into sdm_package_patches (patch_id, user_id, package_id, package_release_id, submission_date, patch_file, patch_description) values ($patch_id, $user_id, $package_id, $release_id, [db_sysdate], '$safe_patch_filename', '[DoubleApos $patch_description]')"
+
+ns_returnredirect "one-package.tcl?[export_url_vars package_id]"
\ No newline at end of file
Index: web/openacs/www/sdm/patch-submit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/patch-submit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/patch-submit.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,19 @@
+set_the_usual_form_variables
+# package_id
+
+validate_integer package_id $package_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![user_can_see_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_package_information $db $user_id
+
+set list_of_releases [database_to_tcl_list_list $db "select release_id, fetch_release_name(release_id) from package_releases where package_id=$package_id"]
+
+ad_return_template
Index: web/openacs/www/sdm/test.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/test.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/test.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,9 @@
+
+set stuff [cvs_file_diff "/web/acstest/sdm-source" "ofinc/www/index.adp" /home/ben/cvsroot 1.1 1.2]
+
+ReturnHeaders 
+
+ns_write "$stuff"
+
+
+
Index: web/openacs/www/sdm/pvt/admin-new-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/admin-new-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/admin-new-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,31 @@
+set_the_usual_form_variables
+# package_id
+
+validate_integer package_id $package_id
+
+set db [ns_db gethandle]
+
+set cookie_user_id [ad_verify_and_get_user_id]
+
+if {![user_can_edit_package_p $db $cookie_user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set user_ids [nmc_GetCheckboxValues [ns_getform] user_id]
+
+if {$user_ids==0} {
+    ad_return_complaint 1 "No users specified as admins!"
+    return
+}
+
+ns_db dml $db "begin transaction"
+
+foreach user_id $user_ids {
+    ns_db dml $db "insert into package_admins (package_id, user_id) values ($package_id, $user_id)"
+}
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "package-admins.tcl?[export_url_vars package_id]"
+
Index: web/openacs/www/sdm/pvt/admin-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/admin-new.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/admin-new.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,46 @@
+set_the_usual_form_variables
+# package_id
+
+validate_integer package_id $package_id
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+if {![user_can_edit_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+ReturnHeaders
+
+set selection [ns_db 1row $db "select package_name from packages where package_id=$package_id"]
+set_variables_after_query
+
+ns_write "[sdm_header "Add an Administrator"]
+<h2>Add an Administrator</h2>
+[ad_context_bar [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] [list "package-admins.tcl?[export_url_vars package_id]" Administrators] "add"]
+<hr><p>
+
+Click on one name to add only one administrator. To add multiple administrators simultaneously, check as many checkboxes as you wish, then click the \"bulk add\" button at the bottom of the page.<p>
+
+<FORM method=post action=admin-new-2.tcl>
+[export_form_vars package_id]
+<ul>
+"
+
+set selection [ns_db select $db "select user_id, first_names, last_name, email from users where user_id NOT IN (select user_id from package_admins where package_id=$package_id)"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    ns_write "<li> <INPUT TYPE=checkbox name=user_id value=$user_id> <a href=admin-new-2.tcl?[export_url_vars user_id package_id]>$last_name, $first_names</a> ($email)\n"
+}
+
+ns_write "</ul>
+
+<INPUT TYPE=submit value=\"bulk add\">
+</FORM>
+<p>
+[sdm_footer]
+"
\ No newline at end of file
Index: web/openacs/www/sdm/pvt/admin-remove.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/admin-remove.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/admin-remove.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,29 @@
+set_the_usual_form_variables
+# package_id, user_id
+
+validate_integer package_id $package_id
+validate_integer user_id $user_id
+
+set db [ns_db gethandle]
+
+set cookie_user_id [ad_verify_and_get_user_id]
+
+if {![user_can_edit_package_p $db $cookie_user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+if {$user_id == $cookie_user_id} {
+    ns_return 200 text/html "[sdm_header "whoops!"]
+<h2>Whoops!</h2>
+<hr><p>
+You're trying to delete yourself! Just so you don't get into trouble, we don't allow that.
+<p>
+[sdm_footer]
+"
+return
+}
+
+ns_db dml $db "delete from package_admins where package_id=$package_id and user_id=$user_id"
+
+ns_returnredirect "package-admins.tcl?[export_url_vars package_id]"
\ No newline at end of file
Index: web/openacs/www/sdm/pvt/baf-assignment-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/baf-assignment-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/baf-assignment-add.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,27 @@
+set_the_usual_form_variables
+# baf_id user_id_from_search role
+
+validate_integer baf_id $baf_id
+validate_integer user_id_from_search $user_id_from_search
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select packages.package_id as package_id,package_name from bugs_and_features,packages where packages.package_id=bugs_and_features.package_id and baf_id=$baf_id"]
+set_variables_after_query
+
+if {![user_can_edit_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+if {[catch {
+    ns_db dml $db "insert into baf_assignments (baf_id, user_id, role) values ($baf_id, $user_id_from_search, '$QQrole')"
+} errmsg]} {
+}
+
+# Notify people
+sdm_notify_users_baf $baf_id "[database_to_tcl_string $db "select user_full_name($user_id_from_search)"] has been assigned" $db
+
+ns_returnredirect "../baf-assignments.tcl?[export_url_vars baf_id]"
\ No newline at end of file
Index: web/openacs/www/sdm/pvt/baf-assignment-remove.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/baf-assignment-remove.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/baf-assignment-remove.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,26 @@
+set_the_usual_form_variables
+# baf_id user_id
+
+validate_integer baf_id $baf_id
+validate_integer user_id $user_id
+
+set user_id_to_remove $user_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select packages.package_id as package_id,package_name from bugs_and_features,packages where packages.package_id=bugs_and_features.package_id and baf_id=$baf_id"]
+set_variables_after_query
+
+if {![user_can_edit_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+if {[catch {
+    ns_db dml $db "delete from baf_assignments where baf_id=$baf_id and user_id=$user_id_to_remove"
+} errmsg]} {
+}
+
+ns_returnredirect "../baf-assignments.tcl?[export_url_vars baf_id]"
\ No newline at end of file
Index: web/openacs/www/sdm/pvt/baf-close.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/baf-close.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/baf-close.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,32 @@
+set_the_usual_form_variables
+# baf_id severity baf_status expected_completion
+
+validate_integer baf_id $baf_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+# just making sure
+set baf_status [sdm_closed_baf_status_id]
+
+set selection [ns_db 1row $db "select packages.package_id as package_id,package_name from bugs_and_features,packages where packages.package_id=bugs_and_features.package_id and baf_id=$baf_id"]
+set_variables_after_query
+
+if {![user_can_edit_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+if {![info exists expected_completion]} {
+    set extra_sql ", expected_completion"
+} else {
+    set extra_sql ""
+}
+
+set selection [ns_db 1row $db "select baf_type $extra_sql from bugs_and_features where baf_id=$baf_id"]
+set_variables_after_query
+
+set list_of_release_values [database_to_tcl_list_list $db "select release_id, release_name(major_version,minor_version, patch_version, beta_version) from package_releases where package_id=$package_id"]
+
+ad_return_template
Index: web/openacs/www/sdm/pvt/baf-comment-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/baf-comment-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/baf-comment-add-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,37 @@
+set_the_usual_form_variables
+# baf_id content
+
+validate_integer baf_id $baf_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select package_id, module_id, baf_type, description, entered_by, severity, insertion_date, COALESCE(expected_completion,0) as expected_completion, COALESCE(completion,0) as completion from bugs_and_features where baf_id=$baf_id"]
+set_variables_after_query
+
+set_simple_user_information $db
+
+if {![user_can_see_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+if {$module_id != "" && $module_id != 0} {
+    if {![user_can_see_module_p $db $user_id $module_id]} {
+	sdm_return_access_complaint
+	return
+    }
+}
+
+# Break the abstraction here cause Postgres is too stupid
+# to allow insertions into views
+ns_db dml $db "insert into general_comments (comment_id, one_line_item_desc, on_what_id, on_which_table, user_id, ip_address, comment_date, content) VALUES (nextval('general_comment_id_sequence'), '$baf_type comment', $baf_id, 'bugs_and_features', $user_id, '[ns_conn peeraddr]', sysdate(), '$QQcontent')"
+
+# Notify people
+sdm_notify_users_baf $baf_id "new comment added by $first_names $last_name: 
+$content
+----------------------------" $db
+
+ns_returnredirect "../one-baf-comments.tcl?[export_url_vars baf_id]"
+
+
+
Index: web/openacs/www/sdm/pvt/baf-completion.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/baf-completion.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/baf-completion.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,23 @@
+set_the_usual_form_variables
+# baf_id release_id
+
+validate_integer baf_id $baf_id
+validate_integer release_id $release_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select package_id from bugs_and_features where baf_id=$baf_id"]
+set_variables_after_query
+
+set_simple_user_information $db
+
+if {![user_can_edit_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+
+ns_db dml $db "update bugs_and_features set completion=$release_id where baf_id=$baf_id"
+
+ns_returnredirect ../one-baf.tcl?[export_url_vars baf_id]
+
Index: web/openacs/www/sdm/pvt/baf-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/baf-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/baf-edit.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,31 @@
+set_the_usual_form_variables
+# baf_id severity baf_status expected_completion completion
+
+validate_integer baf_id $baf_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select package_id from bugs_and_features where baf_id=$baf_id"]
+set_variables_after_query
+
+if {![user_can_edit_baf_p $db $user_id $baf_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+# if there is a new status and we're trying to fix or close the bug
+if {[info exists baf_status] && ![info exists completion]} {
+    if {$baf_status == [sdm_closed_baf_status_id]} {
+	ns_returnredirect "baf-close.tcl?[export_url_vars baf_id severity baf_status expected_completion]"
+	return
+    }
+}
+	
+
+set sql [util_prepare_update $db bugs_and_features baf_id $baf_id [ns_getform]]
+
+ns_db dml $db $sql
+
+ns_returnredirect ../one-baf.tcl?[export_url_vars baf_id]
\ No newline at end of file
Index: web/openacs/www/sdm/pvt/baf-expected-completion.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/baf-expected-completion.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/baf-expected-completion.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,23 @@
+set_the_usual_form_variables
+# baf_id release_id
+
+validate_integer baf_id $baf_id
+validate_integer release_id $release_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 1row $db "select package_id from bugs_and_features where baf_id=$baf_id"]
+set_variables_after_query
+
+set_simple_user_information $db
+
+if {![user_can_edit_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+
+ns_db dml $db "update bugs_and_features set expected_completion=$release_id where baf_id=$baf_id"
+
+ns_returnredirect ../one-baf.tcl?[export_url_vars baf_id]
+
Index: web/openacs/www/sdm/pvt/baf-rate.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/baf-rate.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/baf-rate.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,9 @@
+
+set_the_usual_form_variables
+# baf_id rating
+
+validate_integer baf_id $baf_id
+
+sdm_rate_baf [ad_get_user_id] $baf_id $rating [ns_db gethandle]
+
+ns_returnredirect "../one-baf.tcl?[export_url_vars baf_id]"
Index: web/openacs/www/sdm/pvt/baf-reopen.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/baf-reopen.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/baf-reopen.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,8 @@
+set_the_usual_form_variables
+# baf_id
+
+validate_integer baf_id $baf_id
+
+set old_baf_id $baf_id
+
+ns_returnredirect "new-baf.tcl?[export_url_vars old_baf_id]"
Index: web/openacs/www/sdm/pvt/edit-module-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/edit-module-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/edit-module-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,28 @@
+set_the_usual_form_variables
+# module_name module_id private_p owner description
+
+validate_integer module_id $module_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![user_can_edit_module_p $db $user_id $module_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+if {![info exists owner]} {
+    set owner $user_id_from_search
+}
+
+ns_db dml $db "update modules set 
+module_name= '$QQmodule_name',
+owner= $owner,
+private_p= '$private_p',
+description= '$QQdescription'
+where
+module_id=$module_id
+"
+
+ns_returnredirect ../one-module.tcl?[export_url_vars module_id]
\ No newline at end of file
Index: web/openacs/www/sdm/pvt/edit-module.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/edit-module.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/edit-module.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,66 @@
+set_the_usual_form_variables
+# module_id
+
+validate_integer module_id $module_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![user_can_edit_module_p $db $user_id $module_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_module_information $db $module_id
+
+set selection [ns_db 1row $db "select email, module_name, owner, private_p, description from modules,users where module_id=$module_id and modules.owner=users.user_id"]
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "[sdm_header "Edit Module"]
+<h2>Edit $module_name</h2>
+[ad_context_bar [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] [sdm_module_context_bar_item $module_id $module_name] "Edit Module"]
+<hr><p>
+"
+
+set passthrough [list module_id module_name private_p description]
+set target [sdm_url_stub]/pvt/edit-module-2.tcl
+set custom_title "Pick a User to Administer the Edited Module"
+
+set form "
+<FORM method=post action=/user-search.tcl>
+[export_form_vars module_id passthrough custom_title target]
+<table noborder>
+<tr>
+<td> Module Name</td>
+<td> <INPUT TYPE=text name=module_name size=70 maxlength=100></td>
+</tr>
+<tr>
+<td> Owner</td>
+<td>
+last name: <INPUT TYPE=text name=last_name><br>
+or email : <INPUT TYPE=text name=email>
+</td>
+</tr>
+<tr>
+<td> Visibility:</td>
+<td> <INPUT TYPE=radio name=private_p value=t>Private <INPUT TYPE=radio CHECKED name=private_p value=f>Public</td>
+</tr>
+<tr>
+<td valign=top> Description:</td>
+<td><TEXTAREA name=description COLS=70 ROWS=5 WRAP=soft></TEXTAREA></td>
+</tr>
+</table>
+<p>
+<INPUT TYPE=submit value=edit>
+</FORM>
+"
+
+ns_write "[bt_mergepiece $form $selection]
+
+<p>
+
+[sdm_footer]
+"
Index: web/openacs/www/sdm/pvt/edit-package-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/edit-package-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/edit-package-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,23 @@
+set_the_usual_form_variables
+# package_id package_name private_p description
+
+validate_integer package_id $package_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![user_can_edit_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+ns_db dml $db "update packages set 
+package_name='$QQpackage_name',
+private_p='$private_p',
+description='$QQdescription'
+where
+package_id=$package_id
+"
+
+ns_returnredirect ../one-package.tcl?[export_url_vars package_id]
Index: web/openacs/www/sdm/pvt/edit-package.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/edit-package.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/edit-package.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,49 @@
+set_the_usual_form_variables
+# package_id
+
+validate_integer package_id $package_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![user_can_edit_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+ReturnHeaders
+
+set selection [ns_db 1row $db "select package_name, private_p, description from packages where package_id=$package_id"]
+set_variables_after_query
+
+ns_write "[sdm_header "Edit Package"]
+<h2>Edit Package: $package_name</h2>
+[ad_context_bar [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] Administrators]
+<hr><p>
+"
+
+set form "
+<FORM method=post action=edit-package-2.tcl>
+[export_form_vars package_id]
+<table noborder>
+<tr>
+<td>Package Name</td>
+<td><INPUT TYPE=text name=package_name size=50 maxlength=50></td></tr>
+<tr>
+<td>Visibility:</td>
+<td><INPUT TYPE=radio name=private_p value=t>Private <INPUT CHECKED TYPE=radio name=private_p value=f>Public</td></tr>
+<tr>
+<td valign=top>Description:</td>
+<td><TEXTAREA name=description rows=10 cols=60 wrap=soft></TEXTAREA></td></tr>
+</table>
+
+<INPUT TYPE=submit value=edit>
+</FORM>
+"
+
+ns_write "[bt_mergepiece $form $selection]
+
+<p>
+[sdm_footer]
+"
\ No newline at end of file
Index: web/openacs/www/sdm/pvt/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/index.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,2 @@
+
+ns_returnredirect "../index.tcl"
\ No newline at end of file
Index: web/openacs/www/sdm/pvt/module-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/module-delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/module-delete-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,30 @@
+
+set_the_usual_form_variables
+# module_id 
+
+validate_integer module_id $module_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![user_can_edit_module_p $db $user_id $module_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_module_information $db $module_id
+
+ns_db dml $db "begin transaction"
+
+ns_db dml $db "delete from module_users where module_id=$module_id"
+ns_db dml $db "delete from module_relationships where first_module=$module_id or second_module=$module_id"
+ns_db dml $db "update bugs_and_features set module_id=NULL where module_id=$module_id"
+
+ns_db dml $db "delete from modules where module_id=$module_id"
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "../one-package.tcl?[export_url_vars package_id]"
+
+
Index: web/openacs/www/sdm/pvt/module-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/module-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/module-delete.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,19 @@
+
+set_the_usual_form_variables
+# module_id 
+
+validate_integer module_id $module_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![user_can_edit_module_p $db $user_id $module_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_module_information $db $module_id
+
+ad_return_template
+
Index: web/openacs/www/sdm/pvt/module-user-new-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/module-user-new-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/module-user-new-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,36 @@
+set_the_usual_form_variables
+# module_id
+
+validate_integer module_id $module_id
+
+set db [ns_db gethandle]
+
+set cookie_user_id [ad_get_user_id]
+
+if {![user_can_edit_module_p $db $cookie_user_id $module_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set user_ids [nmc_GetCheckboxValues [ns_getform] user_id]
+
+if {$user_ids==0} {
+    ad_return_complaint 1 "No users specified as module users!"
+    return
+}
+
+ns_db dml $db "begin transaction"
+
+foreach user_id $user_ids {
+    validate_integer user_id $user_id
+
+    if {[catch {
+	ns_db dml $db "insert into module_users (module_id, user_id) values ($module_id, $user_id)"
+    } errmsg]} {
+    }
+}
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "module-users.tcl?[export_url_vars module_id]"
+
Index: web/openacs/www/sdm/pvt/module-user-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/module-user-new.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/module-user-new.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,45 @@
+set_the_usual_form_variables
+# module_id
+
+validate_integer module_id $module_id
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+if {![user_can_edit_module_p $db $user_id $module_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+ReturnHeaders
+
+set_simple_module_information $db $module_id
+
+ns_write "[sdm_header "Add a module user"]
+<h2>Add a module user</h2>
+[ad_context_bar [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] [sdm_module_context_bar_item $module_id $module_name] [list module-users.tcl?[export_url_vars module_id] "Module Users"] add]
+<hr><p>
+
+Click on one name to add only one module user. To add multiple module users simultaneously, check as many checkboxes as you wish, then click the \"bulk add\" button at the bottom of the page.<p>
+
+<FORM method=post action=module-user-new-2.tcl>
+[export_form_vars module_id]
+<ul>
+"
+
+set selection [ns_db select $db "select user_id, first_names, last_name, email from users where user_id NOT in (select user_id from module_users where module_id=$module_id)"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    ns_write "<li> <INPUT TYPE=checkbox name=user_id value=$user_id> <a href=module-user-new-2.tcl?[export_url_vars user_id module_id]>$last_name, $first_names</a> ($email)\n"
+}
+
+ns_write "</ul>
+
+<INPUT TYPE=submit value=\"bulk add\">
+</FORM>
+<p>
+[sdm_footer]
+"
\ No newline at end of file
Index: web/openacs/www/sdm/pvt/module-user-remove.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/module-user-remove.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/module-user-remove.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,29 @@
+set_the_usual_form_variables
+# module_id, user_id
+
+validate_integer module_id $module_id
+validate_integer user_id $user_id
+
+set db [ns_db gethandle]
+
+set cookie_user_id [ad_verify_and_get_user_id]
+
+if {![user_can_edit_module_p $db $cookie_user_id $module_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+if {$user_id == $cookie_user_id} {
+    ns_return 200 text/html "[sdm_header "whoops!"]
+<h2>Whoops!</h2>
+<hr><p>
+You're trying to delete yourself! Just so you don't get into trouble, we don't allow that.
+<p>
+[sdm_footer]
+"
+return
+}
+
+ns_db dml $db "delete from module_users where module_id=$module_id and user_id=$user_id"
+
+ns_returnredirect "module-users.tcl?[export_url_vars module_id]"
Index: web/openacs/www/sdm/pvt/module-users.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/module-users.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/module-users.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,40 @@
+set_the_usual_form_variables
+# module_id
+
+validate_integer module_id $module_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![user_can_edit_module_p $db $user_id $module_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+ReturnHeaders
+
+set_simple_module_information $db $module_id
+
+ns_write "[ad_header "Module Users"]
+<h2>Module Users</h2>
+[ad_context_bar [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] [sdm_module_context_bar_item $module_id $module_name] "Module Users"]
+<hr><p>
+
+<ul>
+<li> <a href=module-user-new.tcl?[export_url_vars module_id]>add</a> a new module user.
+<p>"
+
+set selection [ns_db select $db "select user_id, first_names, last_name, email from users where user_id in (select user_id from module_users where module_id=$module_id)"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    ns_write "<li> \[ <a href=module-user-remove.tcl?[export_url_vars module_id user_id]>remove</a> \] $first_names $last_name ($email)\n"
+}
+
+ns_write "</ul>
+<p>
+
+[sdm_footer]
+"
\ No newline at end of file
Index: web/openacs/www/sdm/pvt/new-baf-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/new-baf-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/new-baf-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,60 @@
+set_the_usual_form_variables
+# baf_type module_id description package_id
+# possibly old_baf_id
+# if it's a bug: release_id
+
+validate_integer package_id $package_id
+validate_integer baf_id $baf_id
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+if {![user_can_see_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+if {[info exists module_id] && $module_id != ""} {
+    validate_integer module_id $module_id
+
+    if {![user_can_see_module_p $db $user_id $module_id]} {
+	sdm_return_access_complaint
+	return
+    }
+    set_simple_module_information $db $module_id
+} else {
+    set module_id ""
+}
+
+set_simple_package_information $db $package_id
+
+ns_db dml $db "begin transaction"
+
+if {[catch {ns_db dml $db "insert into bugs_and_features (baf_id, baf_status, baf_type, package_id, module_id, entered_by, severity, insertion_date, description) VALUES ($baf_id, get_baf_status_id('open'), '$baf_type', $package_id, [db_null_sql $module_id] , $user_id, '[sdm_default_severity]', sysdate(), '$QQdescription')"} errmsg]} {
+    # If there's an error, probably a double click, so 
+    # get out of here
+    ns_return 200 text/html "$errmsg"
+    return
+
+    ns_db dml $db "abort transaction"
+    ns_returnredirect ../open-bafs.tcl?[export_url_vars module_id package_id]
+    return
+}
+
+if {$baf_type == "bug" && [info exists release_id] && ![empty_string_p $release_id]} {
+    validate_integer release_id $release_id
+    ns_db dml $db "insert into bug_release_map (bug_id, release_id, discovery_date) VALUES ($baf_id, $release_id, sysdate())"
+}
+
+if {[info exists old_baf_id]} {
+    validate_integer old_baf_id $old_baf_id
+
+    ns_db dml $db "update bugs_and_features set old_baf_id=$old_baf_id where baf_id=$baf_id"
+    ns_db dml $db "update bugs_and_features set baf_status=get_baf_status_id('reopened') where baf_id=$old_baf_id"
+}
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "../open-bafs.tcl?[export_url_vars module_id package_id]"
+
Index: web/openacs/www/sdm/pvt/new-baf.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/new-baf.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/new-baf.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,84 @@
+set_the_usual_form_variables
+# package_id, module_id, baf_type
+# possibly old_baf_id
+
+validate_integer package_id $package_id
+
+if {![info exists module_id]} {
+    set module_id ""
+}
+
+validate_integer_or_null module_id $module_id
+
+set db [ns_db gethandle]
+
+# If we're reopening something, let's pull some data out
+if {[info exists old_baf_id]} {
+    validate_integer old_baf_id $old_baf_id
+    set selection [ns_db 1row $db "select package_id, module_id, baf_type from bugs_and_features where baf_id=$old_baf_id"]
+    set_variables_after_query
+}
+
+set_simple_user_information $db
+
+if {![user_can_see_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+if {$module_id != "" && ![user_can_see_module_p $db $user_id $module_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_package_information $db $package_id
+
+if {$module_id != ""} {
+    set_simple_module_information $db $module_id
+}
+
+ReturnHeaders
+
+ns_write "[sdm_header "Enter a new $baf_type"]
+<h2>Enter a new $baf_type</h2>
+[ad_context_bar [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] "new $baf_type"]
+<hr><p>
+"
+
+set baf_id [database_to_tcl_string $db "select baf_id_sequence.nextval from dual"]
+
+set list_of_modules [database_to_tcl_list_list $db "select module_id, module_name from modules where package_id=$package_id order by module_name"]
+
+lappend list_of_modules [list "" "(Module Unknown)"]
+
+if {$baf_type == "bug"} {
+
+    set list_of_releases [database_to_tcl_list_list $db "select release_id, release_name(major_version,minor_version,patch_version,beta_version) as release_name from package_releases where package_id=$package_id order by release_name"]
+
+    set selected_release_name [database_to_tcl_string_or_null $db "select release_id from package_releases where release_date is not null order by release_date desc limit 1"]
+
+    set list_of_inputs [list \
+	    [list release_id {Release where bug discovered} select $list_of_releases $selected_release_name] \
+	    [list module_id {Module} select $list_of_modules $module_id] \
+	    [list description {Description of bug} textarea 80 20 soft]]
+} else {
+    set list_of_inputs [list \
+	    [list module_id {Module} select $list_of_modules $module_id] \
+	    [list description {Description of feature} textarea 60 5 soft]]
+}
+
+lappend list_of_inputs [list baf_id "" hidden $baf_id]
+lappend list_of_inputs [list baf_type "" hidden $baf_type]
+lappend list_of_inputs [list package_id "" hidden $package_id]
+
+if {[info exists old_baf_id]} {
+    lappend list_of_inputs [list old_baf_id "" hidden $old_baf_id]
+}
+
+ns_write "
+[make_html_form POST new-baf-2.tcl $list_of_inputs]
+"
+
+ns_write "<p>
+
+[sdm_footer]"
\ No newline at end of file
Index: web/openacs/www/sdm/pvt/new-bug.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/new-bug.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/new-bug.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,6 @@
+set_the_usual_form_variables
+# module_id package_id
+
+set baf_type bug
+
+ns_returnredirect "new-baf.tcl?[export_url_vars module_id baf_type package_id]"
Index: web/openacs/www/sdm/pvt/new-feature.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/new-feature.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/new-feature.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,6 @@
+set_the_usual_form_variables
+# package_id module_id
+
+set baf_type feature
+
+ns_returnredirect "new-baf.tcl?[export_url_vars module_id baf_type package_id]"
Index: web/openacs/www/sdm/pvt/new-log-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/new-log-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/new-log-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,25 @@
+set_the_usual_form_variables
+# module_id log_content log_id
+
+validate_integer module_id $module_id
+validate_integer log_id $log_id
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+if {![user_can_edit_module_p $db $user_id $module_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+if {[catch {
+    ns_db dml $db "insert into module_log (log_id, module_id, user_id, log_date, log_content) VALUES ($log_id, $module_id, $user_id, sysdate, '$QQlog_content')"
+} errmsg]} {
+    ns_return 500 text/html "$errmsg"
+    return
+    # the error is most probably a double-click, so ignore it
+}
+
+ns_returnredirect "../module-log.tcl?[export_url_vars module_id]"
+
Index: web/openacs/www/sdm/pvt/new-log.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/new-log.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/new-log.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,32 @@
+set_the_usual_form_variables
+# module_id
+
+validate_integer module_id $module_id
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+if {![user_can_edit_module_p $db $user_id $module_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_module_information $db $module_id
+
+ReturnHeaders
+
+set new_log_id [database_to_tcl_string $db "select log_id_sequence.nextval from dual"]
+
+ns_write "[sdm_header "add a log entry"]
+<h2>Add a Log Entry</h2>
+[ad_context_bar [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] [sdm_module_context_bar_item $module_id $module_name] [list [sdm_url_stub]/module-log.tcl?[export_url_vars module_id] "Module Log"] "Add Entry"]
+<hr><p>
+
+[make_html_form POST new-log-2.tcl [list \
+	[list log_id "" hidden $new_log_id] \
+	[list module_id "" hidden $module_id] \
+	{log_content "Log Content" textarea 50 5 soft}]]
+
+[sdm_footer]
+"
\ No newline at end of file
Index: web/openacs/www/sdm/pvt/new-module-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/new-module-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/new-module-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,25 @@
+set_the_usual_form_variables
+# module_name, owner, private_p, description, package_id
+
+validate_integer package_id $package_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![user_can_edit_package_p $db $user_id $package_id]} {
+    ad_return_complaint "1" "You are not allowed to edit this package!"
+    return
+}
+
+if {![info exists owner]} {
+    set owner $user_id_from_search
+}
+
+validate_integer owner $owner
+
+set module_id [database_to_tcl_string $db "select module_id_sequence.nextval from dual"]
+
+ns_db dml $db "insert into modules (module_id, package_id, module_name, owner, private_p, description) VALUES ($module_id, $package_id, '$QQmodule_name', $owner, '$private_p', '$QQdescription')"
+
+ns_returnredirect "../one-module.tcl?[export_url_vars module_id]" 
Index: web/openacs/www/sdm/pvt/new-module.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/new-module.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/new-module.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,58 @@
+set_the_usual_form_variables
+# package_id
+
+validate_integer package_id $package_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![user_can_edit_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+ReturnHeaders
+
+set selection [ns_db 1row $db "select package_name from packages where package_id=$package_id"]
+set_variables_after_query
+
+set passthrough [list module_name private_p description package_id]
+set target [sdm_url_stub]/pvt/new-module-2.tcl
+set custom_title "Pick a User to Administer the New Module"
+
+ns_write "[sdm_header "New Module"]
+<h2>New Module</h2>
+[ad_context_bar [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] "New Module"]
+<hr><p>
+
+<FORM method=post action=/user-search.tcl>
+[export_form_vars passthrough target custom_title]
+[export_form_vars package_id]
+<table noborder>
+<tr>
+<td> Module Name</td>
+<td> <INPUT TYPE=text name=module_name size=70 maxlength=100></td>
+</tr>
+<tr>
+<td valign=top> Owner</td>
+<td> 
+last name: <INPUT TYPE=text name=last_name><br>
+or email : <INPUT TYPE=text name=email>
+</td>
+</tr>
+<tr>
+<td> Visibility:</td>
+<td> <INPUT TYPE=radio name=private_p value=t>Private <INPUT TYPE=radio CHECKED name=private_p value=f>Public</td>
+</tr>
+<tr>
+<td valign=top> Description:</td>
+<td><TEXTAREA name=description COLS=70 ROWS=5 WRAP=soft></TEXTAREA></td>
+</tr>
+</table>
+<p>
+<INPUT TYPE=submit value=create>
+</FORM>
+
+[sdm_footer]
+"
Index: web/openacs/www/sdm/pvt/notification-prefs-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/notification-prefs-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/notification-prefs-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,14 @@
+set_the_usual_form_variables
+# package_pref baf_pref
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+ns_db dml $db "update sdm_notification_prefs set
+package_pref='$QQpackage_pref',
+baf_pref='$QQbaf_pref'
+where
+user_id=$user_id"
+
+ns_returnredirect "notification-prefs.tcl"
Index: web/openacs/www/sdm/pvt/notification-prefs.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/notification-prefs.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/notification-prefs.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,16 @@
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select package_pref, baf_pref from sdm_notification_prefs where user_id=$user_id"]
+
+if {$selection == ""} {
+    ns_db dml $db "insert into sdm_notification_prefs (user_id) values ($user_id)"
+
+    set selection [ns_db 1row $db "select package_pref, baf_pref from sdm_notification_prefs where user_id=$user_id"]
+}
+
+set_variables_after_query
+
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/sdm/pvt/one-user.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/one-user.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/one-user.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,64 @@
+set_the_usual_form_variables
+# user_id
+
+validate_integer user_id $user_id
+
+set request_user_id $user_id
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+set selection [ns_db 1row $db "select first_names as request_first_names, last_name as request_last_name, email as request_email from users where user_id=$request_user_id"]
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "[sdm_header "$request_first_names $request_last_name"]
+<h2>$request_first_names $request_last_name</h2>
+a user of <A href=../>[sdm_system_name]</a>.
+<hr><p>
+"
+
+ns_write "<h3>Package and Releases this user manages</h3>
+<ul>
+"
+
+set selection [ns_db select $db "select package_id, package_name from packages where user_can_edit_package_p($user_id, package_id)='t'"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    ns_write "<li> admin for package <a href=../one-package.tcl?[export_url_vars package_id]>$package_name</a>\n"
+}
+
+set selection [ns_db select $db "select release_name(major_version,minor_version,patch_version, beta_version) as release_name, release_id, packages.package_id as package_id, package_name from package_releases,packages where manager=$request_user_id and package_releases.package_id=packages.package_id"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    ns_write "<li> manager of <a href=../one-package.tcl?[export_url_vars package_id]>$package_name</a>, Release <A href=../one-package-release.tcl?[export_url_vars package_id release_id]>$release_name</a>\n"
+}
+
+ns_write "</ul>"
+
+ns_write "<p>"
+
+# Bugs and Features Reported or Requested
+ns_write "<h3>Bugs Reported, Features Requested</h3>
+<ul>"
+
+set selection [ns_db select $db "select baf_id, baf_type, package_name, packages.package_id as package_id,  substr(bugs_and_features.description,0,100) as short_description from bugs_and_features, packages where bugs_and_features.package_id=packages.package_id and entered_by=$request_user_id order by baf_type"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    ns_write "<li> <a href=../one-baf.tcl?[export_url_vars baf_id]>$baf_type #$baf_id</a>: $short_description ...\n"
+}
+
+ns_write "</ul>"
+
+ns_write "<p>
+
+[sdm_footer]
+"
Index: web/openacs/www/sdm/pvt/package-admins.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/package-admins.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/package-admins.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,41 @@
+set_the_usual_form_variables
+# package_id
+
+validate_integer package_id $package_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![user_can_edit_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+ReturnHeaders
+
+set selection [ns_db 1row $db "select package_name, description from packages where package_id=$package_id"]
+set_variables_after_query
+
+ns_write "[ad_header "Package Administrators"]
+<h2>Administrators</h2>
+[ad_context_bar [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] Administrators]
+<hr><p>
+
+<ul>
+<li> <a href=admin-new.tcl?[export_url_vars package_id]>add</a> a new admin.
+<p>"
+
+set selection [ns_db select $db "select users.user_id as user_id, first_names, last_name, email from package_admins, users where package_admins.user_id=users.user_id and package_id=$package_id"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    ns_write "<li> \[ <a href=admin-remove.tcl?[export_url_vars package_id user_id]>remove</a> \] $first_names $last_name ($email)\n"
+}
+
+ns_write "</ul>
+<p>
+
+[sdm_footer]
+"
\ No newline at end of file
Index: web/openacs/www/sdm/pvt/package-cvs-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/package-cvs-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/package-cvs-edit-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,26 @@
+set_the_usual_form_variables
+# package_id cvs_server cvs_path cvs_username cvs_password
+
+validate_integer package_id $package_id
+
+set db [ns_db gethandle]
+set_simple_user_information $db
+
+if {![user_can_edit_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+if {[database_to_tcl_string $db "select count(*) from cvs_package_data where package_id=$package_id"] == 0} {
+    ns_db dml $db "insert into cvs_package_data (package_id, cvs_server, cvs_username, cvs_password, cvs_path) VALUES ($package_id, '$cvs_server', '$cvs_username', '$cvs_password', '$cvs_path')"
+} else {
+    ns_db dml $db "update cvs_package_data set
+cvs_server= '$cvs_server',
+cvs_username='$cvs_username',
+cvs_password='$cvs_password',
+cvs_path='$cvs_path'
+where
+package_id=$package_id"
+}
+
+ns_returnredirect "/sdm/one-package.tcl?[export_url_vars package_id]"
Index: web/openacs/www/sdm/pvt/package-cvs-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/package-cvs-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/package-cvs-edit.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,63 @@
+set_the_usual_form_variables
+# package_id
+
+validate_integer package_id $package_id
+
+set db [ns_db gethandle]
+set_simple_user_information $db
+
+if {![user_can_edit_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_package_information $db $package_id
+
+ReturnHeaders
+
+ns_write "[sdm_header "CVS Data For One Package"]
+<h2>CVS Data</h2>
+[ad_context_bar_ws_or_index [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] "CVS Data"]
+<hr><p>"
+
+set selection [ns_db 0or1row $db "select cvs_server, cvs_username, cvs_password, cvs_path from cvs_package_data where package_id= $package_id"]
+
+set form "
+<FORM METHOD=POST action=package-cvs-edit-2.tcl>
+<table noborder>
+<tr>
+<td>CVS Server<br>
+(empty for localhost)
+</td>
+<td><INPUT TYPE=text name=cvs_server size=50>
+</td>
+</tr>
+<tr>
+<td>CVS Username</td>
+<td><INPUT TYPE=text name=cvs_username size=50>
+</td>
+</tr>
+<tr>
+<td>CVS Password</td>
+<td><INPUT TYPE=text name=cvs_password size=50>
+</td>
+</tr>
+<tr>
+<td>CVS Path</td>
+<td><INPUT TYPE=text name=cvs_path size=50>
+</td>
+</tr>
+</table>
+[export_form_vars package_id]
+<br>
+<INPUT TYPE=submit value=edit>
+</FORM>"
+
+if {$selection != ""} {
+    ns_write "[bt_mergepiece $form $selection]"
+} else {
+    ns_write "$form"
+}
+
+ns_write "<p>
+[sdm_footer]"
\ No newline at end of file
Index: web/openacs/www/sdm/pvt/package-download-source.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/package-download-source.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/package-download-source.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,31 @@
+set_the_usual_form_variables
+# package_id
+
+validate_integer package_id $package_id
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+if {![user_can_edit_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+ReturnHeaders
+ns_write "
+[sdm_header "Loading Source"]
+<h2>Loading Source...</h2>
+<hr>
+<p>
+be patient... loading source
+<p>
+"
+
+# Load source
+sdm_load_source_package $package_id
+
+ns_write "<h3>done!</h3>
+<p>
+
+[sdm_footer]"
\ No newline at end of file
Index: web/openacs/www/sdm/pvt/package-release-anticipated-release-date.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/package-release-anticipated-release-date.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/package-release-anticipated-release-date.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,18 @@
+set_the_usual_form_variables
+# release_id package_id
+
+validate_integer release_id $release_id
+validate_integer package_id $package_id
+
+set form [ns_getform]
+
+# Get the date
+ns_dbformvalue $form anticipated_release_date date anticipated_release_date
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+ns_db dml $db "update package_releases set anticipated_release_date='$anticipated_release_date' where package_id=$package_id and release_id=$release_id and manager=$user_id and release_date is NULL"
+
+ns_returnredirect "../one-package-release.tcl?[export_url_vars release_id package_id]"
\ No newline at end of file
Index: web/openacs/www/sdm/pvt/package-release-choose-live.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/package-release-choose-live.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/package-release-choose-live.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,19 @@
+set_the_usual_form_variables
+# release_id
+
+validate_integer release_id $release_id
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+set package_id [database_to_tcl_string $db "select package_id from package_releases where release_id=$release_id"]
+
+if {![user_can_edit_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+ns_db dml $db "update packages set current_release=$release_id where package_id=$package_id"
+
+ns_returnredirect "../one-package.tcl?[export_url_vars package_id]"
Index: web/openacs/www/sdm/pvt/package-release-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/package-release-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/package-release-edit-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,41 @@
+set_the_usual_form_variables
+# package_id, release_id, user_id_from_search, supported_platforms, unsupported_platforms
+# major_version, minor_version, patch_version, general_description
+
+validate_integer package_id $package_id
+validate_integer release_id $release_id
+validate_integer user_id_from_search $user_id_from_search
+validate_integer major_version $major_version
+validate_integer minor_version $minor_version
+validate_integer patch_version $patch_version
+validate_integer beta_version $beta_version
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+if {![user_can_edit_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+if {[catch {
+    ns_db dml $db "update package_releases set
+major_version=$major_version,
+minor_version=$minor_version,
+patch_version=$patch_version,
+beta_version=$beta_version,
+supported_platforms='$QQsupported_platforms',
+manager=$user_id_from_search,
+general_description='$QQgeneral_description'
+where 
+release_id=$release_id
+and
+package_id=$package_id
+"
+} errmsg]} {
+    # We suspect that the release was already inserted,
+    # so we do nothing and expect a redirect
+}
+
+ns_returnredirect "../one-package-release.tcl?[export_url_vars package_id release_id]"
Index: web/openacs/www/sdm/pvt/package-release-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/package-release-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/package-release-edit.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,50 @@
+set_the_usual_form_variables
+# package_id release_id
+
+validate_integer package_id $package_id
+validate_integer release_id $release_id
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+if {![user_can_edit_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_package_information $db $package_id
+
+set selection [ns_db 1row $db "select release_name(major_version,minor_version,patch_version,beta_version) as release_name, major_version, minor_version, patch_version, beta_version, general_description, user_id as manager_user_id, email as email, first_names as manager_first_names, last_name as manager_last_name, supported_platforms from package_releases, users where package_id=$package_id and release_id=$release_id and manager=user_id"]
+set_variables_after_query
+
+ReturnHeaders 
+
+ns_write "[sdm_header "Edit Release"]
+<h2>Edit Release</h2>
+[ad_context_bar [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] [sdm_release_context_bar_item $release_id $release_name] "edit"]
+<hr><p>
+"
+
+set form "
+[make_html_form POST /user-search.tcl [list {target "" hidden "/sdm/pvt/package-release-edit-2.tcl"} \
+	{passthrough "" hidden {package_id release_id major_version minor_version patch_version beta_version supported_platforms general_description}} \
+	{custom_title "" hidden "Pick a Manager for your Edited Release"} \
+	[list package_id {} hidden $package_id] \
+	[list release_id {} hidden $release_id] \
+	{major_version "Major Version" text} \
+	{minor_version "Minor Version" text} \
+	{patch_version "Patch Version" text} \
+	{beta_version "Beta Version" text} \
+	{email "Manager search: by email<br>or" text} \
+	{last_name "by last name" text} \
+	{supported_platforms "Supported Platforms" text} \
+	{unsupported_platforms "Unsupported Platforms" text} \
+	{general_description "General Description" textarea 50 5 soft}
+	]]
+"
+
+ns_write "[bt_mergepiece $form $selection]
+<p>
+
+[sdm_footer]"
\ No newline at end of file
Index: web/openacs/www/sdm/pvt/package-release-make-live-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/package-release-make-live-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/package-release-make-live-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,67 @@
+set_the_usual_form_variables
+# package_id release_id release_tarfile
+
+validate_integer package_id $package_id
+validate_integer release_id $release_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+# Check if the user is the manager for this release
+set release_manager_user_id [database_to_tcl_string $db "select manager from package_releases where package_id=$package_id and release_id=$release_id"]
+
+set release_name [database_to_tcl_string $db "select release_name(major_version,minor_version,patch_version,beta_version) from package_releases where release_id=$release_id"]
+
+if {$user_id == $release_manager_user_id} {
+    set user_is_manager_p 1
+} else {
+    set user_is_manager_p 0
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_package_information $db $package_id
+
+set form [ns_getform]
+set baf_ids [nmc_GetCheckboxValues $form completed_baf_id]
+
+ns_db dml $db "begin transaction"
+
+if {$baf_ids != 0} {
+    foreach baf_id $baf_ids {
+	ns_db dml $db "update bugs_and_features set completion=$release_id where baf_id=$baf_id and package_id=$package_id"
+    }
+}
+
+# Download stuff
+# NOT anymore, cause no CVS.
+# set release_filename [sdm_load_download_package $package_id $release_id]
+
+if {[ns_queryget release_filename] != ""} {
+    set tmp_filename [ns_queryget release_filename.tmpfile]
+    set release_filename [sdm_release_filename $release_id [sdm_cleanup_filename $release_filename]]
+    
+    set full_path_filename [sdm_software_dir $package_id $release_id]/$release_filename
+    
+    sdm_software_check_dir $package_id $release_id
+    ns_cp $tmp_filename $full_path_filename
+    
+    # Now do source-code browsing from there
+    if {[sdm_sourcecode_package_has_repository_p $db $package_id]} {
+	sdm_sourcecode_load_from_file $db $package_id $full_path_filename
+    }
+    
+    ns_db dml $db "update package_releases set release_filename='$release_filename' where package_id=$package_id and release_id=$release_id"
+}
+    
+ns_db dml $db "update package_releases set release_date=sysdate() where package_id=$package_id and release_id=$release_id"
+
+ns_db dml $db "update packages set current_release=$release_id where package_id=$package_id"
+
+sdm_notify_users_package $package_id "New live release: $release_name" $db
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "../one-package-release.tcl?[export_url_vars package_id release_id]"
+
Index: web/openacs/www/sdm/pvt/package-release-make-live-cvs-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/package-release-make-live-cvs-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/package-release-make-live-cvs-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,48 @@
+set_the_usual_form_variables
+# package_id release_id release_tarfile
+
+validate_integer package_id $package_id
+validate_integer release_id $release_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+# Check if the user is the manager for this release
+set release_manager_user_id [database_to_tcl_string $db "select manager from package_releases where package_id=$package_id and release_id=$release_id"]
+
+if {$user_id == $release_manager_user_id} {
+    set user_is_manager_p 1
+} else {
+    set user_is_manager_p 0
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_package_information $db $package_id
+
+set form [ns_getform]
+set baf_ids [nmc_GetCheckboxValues $form completed_baf_id]
+
+ns_db dml $db "begin transaction"
+
+if {$baf_ids != 0} {
+    foreach baf_id $baf_ids {
+	ns_db dml $db "update bugs_and_features set completion=$release_id where baf_id=$baf_id and package_id=$package_id"
+    }
+}
+
+# Download stuff
+set release_filename [sdm_load_download_package $package_id $release_id]
+
+ns_db dml $db "update package_releases set release_filename='$release_filename' where package_id=$package_id and release_id=$release_id"
+
+
+ns_db dml $db "update package_releases set release_date=sysdate where package_id=$package_id and release_id=$release_id"
+
+ns_db dml $db "update packages set current_release=$release_id where package_id=$package_id"
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "../one-package-release.tcl?[export_url_vars package_id release_id]"
+
Index: web/openacs/www/sdm/pvt/package-release-make-live-cvs.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/package-release-make-live-cvs.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/package-release-make-live-cvs.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,65 @@
+set_the_usual_form_variables
+# package_id release_id
+
+validate_integer package_id $package_id
+validate_integer release_id $release_id
+
+set db [ns_db gethandle]
+
+set user_id [ad_get_user_id]
+
+# Check if the user is the manager for this release
+set release_manager_user_id [database_to_tcl_string $db "select manager from package_releases where package_id=$package_id and release_id=$release_id"]
+
+if {$user_id == $release_manager_user_id} {
+    set user_is_manager_p 1
+} else {
+    set user_is_manager_p 0
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_package_information $db $package_id
+
+ReturnHeaders
+
+set selection [ns_db 1row $db "select release_name(major_version,minor_version,patch_version,beta_version) as release_name, anticipated_release_date from package_releases where package_id=$package_id and release_id=$release_id"]
+set_variables_after_query
+
+ns_write "[sdm_header "Make a Release Live"]
+<h2>Make Release $release_name live!</h2>
+[ad_context_bar [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] [sdm_package_release_context_bar_item $release_id $release_name] "make live"]
+<hr><p>
+
+You are now about to make this release live. Please fill out the details below.
+<p>"
+
+ns_write "
+<FORM ENCTYPE=multipart/form-data METHOD=post action=package-release-make-live-2.tcl>
+[export_form_vars release_id package_id]
+"
+
+ns_write "
+<h3>Bugs and Features</h3>
+These are the bugs and features that were expected to be fixed or implemented in this release, and that haven't yet been marked as completed. Please check off the ones that are completed.
+
+<p>
+"
+
+set selection [ns_db select $db "select baf_id, baf_type, substr(description, 0, 100) as short_description from bugs_and_features where package_id=$package_id and expected_completion=$release_id and completion is NULL order by baf_type, priority desc"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    ns_write "<INPUT TYPE=checkbox name=completed_baf_id value=$baf_id> <a href=one-$baf_type.tcl?[export_url_vars baf_id]>$baf_type #$baf_id</a>: $short_description ...<br>"
+}
+
+ns_write "<p>
+<INPUT TYPE=submit value=\"Make Live!\">
+</FORM>
+"
+
+ns_write "
+<p>
+[sdm_footer]
+"
Index: web/openacs/www/sdm/pvt/package-release-make-live.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/package-release-make-live.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/package-release-make-live.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,66 @@
+set_the_usual_form_variables
+# package_id release_id
+
+validate_integer package_id $package_id
+validate_integer release_id $release_id
+
+set db [ns_db gethandle]
+
+set user_id [ad_get_user_id]
+
+# Check if the user is the manager for this release
+set release_manager_user_id [database_to_tcl_string $db "select manager from package_releases where package_id=$package_id and release_id=$release_id"]
+
+if {$user_id == $release_manager_user_id} {
+    set user_is_manager_p 1
+} else {
+    set user_is_manager_p 0
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_package_information $db $package_id
+
+ReturnHeaders
+
+set selection [ns_db 1row $db "select release_name(major_version,minor_version,patch_version,beta_version) as release_name, anticipated_release_date from package_releases where package_id=$package_id and release_id=$release_id"]
+set_variables_after_query
+
+ns_write "[sdm_header "Make a Release Live"]
+<h2>Make Release $release_name live!</h2>
+[ad_context_bar [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] [sdm_package_release_context_bar_item $release_id $release_name] "make live"]
+<hr><p>
+
+You are now about to make this release live. Please fill out the details below.
+<p>"
+
+ns_write "
+<FORM ENCTYPE=multipart/form-data METHOD=post action=package-release-make-live-2.tcl>
+[export_form_vars release_id package_id]
+<INPUT TYPE=file name=release_filename><p>
+"
+
+ns_write "
+<h3>Bugs and Features</h3>
+These are the bugs and features that were expected to be fixed or implemented in this release, and that haven't yet been marked as completed. Please check off the ones that are completed.
+
+<p>
+"
+
+set selection [ns_db select $db "select baf_id, baf_type, severity, substr(description, 0, 100) as short_description from open_bafs where package_id=$package_id and expected_completion=$release_id order by baf_type, severity"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    ns_write "<INPUT TYPE=checkbox name=completed_baf_id value=$baf_id> <a href=one-$baf_type.tcl?[export_url_vars baf_id]>$baf_type #$baf_id</a>: $short_description ...<br>"
+}
+
+ns_write "<p>
+<INPUT TYPE=submit value=\"Make Live!\">
+</FORM>
+"
+
+ns_write "
+<p>
+[sdm_footer]
+"
Index: web/openacs/www/sdm/pvt/package-release-make-unlive.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/package-release-make-unlive.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/package-release-make-unlive.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,41 @@
+set_the_usual_form_variables
+# package_id release_id new_release_id
+
+validate_integer package_id $package_id
+validate_integer release_id $release_id
+validate_integer_or_null new_release_id $new_release_id
+
+set user_id [ad_get_user_id]
+
+set form [ns_getform]
+
+set db [ns_db gethandle]
+
+# Check if the user is the manager for this release
+set release_manager_user_id [database_to_tcl_string $db "select manager from package_releases where package_id=$package_id and release_id=$release_id"]
+
+if {$user_id == $release_manager_user_id} {
+    set user_is_manager_p 1
+} else {
+    set user_is_manager_p 0
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_package_information $db $package_id
+
+ns_db dml $db "begin transaction"
+
+ns_db dml $db "update package_releases set release_date=NULL where package_id=$package_id and release_id=$release_id"
+
+ns_db dml $db "delete from package_release_downloads where package_id=$package_id and release_id=$release_id"
+
+if {$new_release_id != ""} {
+    ns_db dml $db "update packages set current_release=$new_release_id where package_id=$package_id"
+} else {
+    ns_db dml $db "update packages set current_release=NULL where package_id=$package_id"
+}
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "../one-package-release.tcl?[export_url_vars package_id release_id]"
Index: web/openacs/www/sdm/pvt/package-release-new-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/package-release-new-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/package-release-new-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,30 @@
+set_the_usual_form_variables
+# package_id, release_id, user_id_from_search, supported_platforms, unsupported_platforms
+# major_version, minor_version, patch_version, general_description
+
+validate_integer package_id $package_id
+validate_integer release_id $release_id
+validate_integer user_id_from_search $user_id_from_search
+validate_integer major_version $major_version
+validate_integer minor_version $minor_version
+validate_integer patch_version $patch_version
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+if {![user_can_edit_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+if {[catch {
+    ns_db dml $db "insert into package_releases (release_id, package_id, major_version, minor_version, patch_version, beta_version, supported_platforms, manager, general_description) VALUES ($release_id, $package_id, $major_version, $minor_version, $patch_version,'$beta_version', '$QQsupported_platforms', $user_id_from_search, '$QQgeneral_description')"
+} errmsg]} {
+    # We suspect that the release was already inserted,
+    # so we do nothing and expect a redirect
+    ns_return 200 text/html "$errmsg"
+    return
+}
+
+ns_returnredirect "../one-package-release.tcl?[export_url_vars package_id release_id]"
Index: web/openacs/www/sdm/pvt/package-release-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/package-release-new.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/package-release-new.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,47 @@
+set_the_usual_form_variables
+# package_id
+
+validate_integer package_id $package_id
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+if {![user_can_edit_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_package_information $db $package_id
+
+ReturnHeaders
+
+ns_write "[sdm_header "New Package Release"]
+<h2>New Release</h2>
+[ad_context_bar [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] [list ../package-releases.tcl?[export_url_vars package_id] Releases] "new"]
+<hr><p>
+"
+
+set new_package_release_id [database_to_tcl_string $db "select package_release_id_sequence.nextval from dual"]
+
+ns_write "
+[make_html_form POST /user-search.tcl [list {target "" hidden "/sdm/pvt/package-release-new-2.tcl"} \
+	{passthrough "" hidden {package_id release_id major_version minor_version patch_version beta_version supported_platforms unsupported_platforms general_description}} \
+	{custom_title "" hidden "Pick a Manager for your New Release"} \
+	[list package_id {} hidden $package_id] \
+	[list release_id {} hidden $new_package_release_id] \
+	{major_version "Major Version" text} \
+	{minor_version "Minor Version" text} \
+	{patch_version "Patch Version" text} \
+	{beta_version "Beta Version" text} \
+	{email "Manager search: by email<br>or" text} \
+	{last_name "by last name" text} \
+	{supported_platforms "Supported Platforms" text} \
+	{general_description "General Description" textarea 50 5 soft}
+	]]
+"
+
+ns_write "
+<p>
+[sdm_footer]
+"
\ No newline at end of file
Index: web/openacs/www/sdm/pvt/package-release-notes-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/package-release-notes-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/package-release-notes-edit-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,20 @@
+set_the_usual_form_variables
+# package_id release_id
+
+validate_integer package_id $package_id
+validate_integer release_id $release_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![user_can_edit_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+ns_db dml $db "update package_releases set release_notes='$QQrelease_notes' where package_id=$package_id and release_id=$release_id"
+
+ns_returnredirect "../package-release-notes.tcl?[export_url_vars package_id release_id]"
+
+
Index: web/openacs/www/sdm/pvt/package-release-notes-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/package-release-notes-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/package-release-notes-edit.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,39 @@
+set_the_usual_form_variables
+# package_id release_id
+
+validate_integer package_id $package_id
+validate_integer release_id $release_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![user_can_edit_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_package_information $db $package_id
+
+set selection [ns_db 1row $db "select release_name(major_version,minor_version, patch_version,beta_version) as release_name, release_notes from package_releases where package_id=$package_id and release_id=$release_id"]
+set_variables_after_query
+
+ns_return 200 text/html "
+[sdm_header "Release Notes"]
+<h2>Edit Release Notes</h2>
+[ad_context_bar_ws_or_index [sdm_home_context_bar_item] [sdm_package_context_bar_item $package_id $package_name] [list "one-package-release.tcl?[export_url_vars package_id release_id]" "Release $release_name"] "Edit Release Notes"]
+<hr><p>
+
+<FORM METHOD=POST action=package-release-notes-edit-2.tcl>
+[export_form_vars package_id release_id]
+<TEXTAREA COLS=80 ROWS=80 WRAP=hard name=release_notes>
+$release_notes
+</TEXTAREA>
+<p>
+<INPUT TYPE=submit value=go>
+</FORM>
+
+<p>
+
+[sdm_footer]
+"
\ No newline at end of file
Index: web/openacs/www/sdm/pvt/package-repository-create-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/package-repository-create-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/package-repository-create-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,44 @@
+set_the_usual_form_variables
+# package_id
+
+validate_integer package_id $package_id
+
+set exception_count 0
+set exception_text ""
+
+if {[string first " " $repository_name] != -1} {
+    incr exception_count
+    append exception_text "<li> There is a space in your repository name. Can't do that.\n"
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+if {![user_can_edit_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+ns_db dml $db "begin transaction"
+
+if {[catch {
+    ns_db dml $db "insert into package_repositories (package_id, repository_name, file_glob_patterns) VALUES ($package_id, '$repository_name', '$file_glob_patterns')"
+} errmsg]} {
+}
+
+if {[catch {sdm_sourcecode_create_repository $repository_name} errmsg]} {
+    ns_return 200 text/html "an error happened, you probably don't have the right directory set up for storing source code repositories. Check it and the permissions on it: $errmsg"
+
+    ns_db dml $db "abort transaction"
+    return
+}
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "../one-package.tcl?[export_url_vars package_id]"
Index: web/openacs/www/sdm/pvt/package-repository-create.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/package-repository-create.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/package-repository-create.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,45 @@
+set_the_usual_form_variables
+# package_id
+
+validate_integer package_id $package_id
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+if {![user_can_edit_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_package_information $db $package_id
+
+ns_return 200 text/html "
+[sdm_header "Create a Source Code Repository"]
+<h2>Create a Source Code Repository</h2>
+for <a href=../one-package.tcl?[export_url_vars package_id]>$package_name</a>.
+<hr><p>
+
+This will create a repository on our server where you can keep the source code for this package. This will remain somewhat separate from the meta-data of bugs and features.<p>
+
+<FORM METHOD=post action=package-repository-create-2.tcl>
+[export_form_vars package_id]
+<table border=0 cellpadding=4>
+<tr>
+<td>Repository Name (no spaces)</td>
+<td><INPUT TYPE=text name=repository_name></td>
+</tr>
+<tr>
+<td>File Regexp Patterns<br>
+(separated by spaces)</td>
+<td><INPUT TYPE=text name=file_glob_patterns>
+</td>
+</tr>
+</table>
+<p>
+<INPUT TYPE=submit value=create>
+</FORM>
+
+[sdm_footer]"
+
+
Index: web/openacs/www/sdm/pvt/package-repository-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/package-repository-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/package-repository-edit-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,45 @@
+set_the_usual_form_variables
+# package_id
+
+validate_integer package_id $package_id
+
+set exception_count 0
+set exception_text ""
+
+if {[string first " " $repository_name] != -1} {
+    incr exception_count
+    append exception_text "<li> There is a space in your repository name. Can't do that.\n"
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+if {![user_can_edit_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+ns_db dml $db "begin transaction"
+
+set old_repository_name [database_to_tcl_string $db "select repository_name from package_repositories where package_id=$package_id"]
+
+if {[catch {
+    ns_db dml $db "update package_repositories set 
+    repository_name='$repository_name',
+    file_glob_patterns='$file_glob_patterns'
+    where
+    package_id=$package_id"
+} errmsg]} {
+}
+
+sdm_sourcecode_edit_repository $old_repository_name $repository_name
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "../one-package.tcl?[export_url_vars package_id]"
Index: web/openacs/www/sdm/pvt/package-repository-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/package-repository-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/package-repository-edit.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,52 @@
+set_the_usual_form_variables
+# package_id
+
+validate_integer package_id $package_id
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+if {![user_can_edit_package_p $db $user_id $package_id]} {
+    sdm_return_access_complaint
+    return
+}
+
+set_simple_package_information $db $package_id
+
+set_simple_repository_information $db $package_id
+
+ReturnHeaders
+
+ns_write "
+[sdm_header "Edit Source Code Repository"]
+<h2>Edit Source Code Repository</h2>
+for <a href=../one-package.tcl?[export_url_vars package_id]>$package_name</a>.
+<hr><p>
+"
+
+set form "
+<FORM METHOD=post action=package-repository-edit-2.tcl>
+[export_form_vars package_id]
+<table border=0 cellpadding=4>
+<tr>
+<td>Repository Name (no spaces)</td>
+<td><INPUT TYPE=text name=repository_name></td>
+</tr>
+<tr>
+<td>File Regexp Patterns<br>
+(separated by spaces)</td>
+<td><INPUT TYPE=text name=file_glob_patterns>
+</td>
+</tr>
+</table>
+<p>
+<INPUT TYPE=submit value=edit>
+</FORM>"
+
+ns_write "[bt_mergepiece $form $selection]"
+
+ns_write "<p>
+[sdm_footer]"
+
+
Index: web/openacs/www/sdm/pvt/prefs.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/prefs.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/prefs.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,2 @@
+
+ns_returnredirect "notification-prefs.tcl"
Index: web/openacs/www/sdm/pvt/toggle-baf-interest.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/toggle-baf-interest.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/toggle-baf-interest.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,14 @@
+set_the_usual_form_variables
+# baf_id interest
+
+validate_integer baf_id $baf_id
+
+set user_id [ad_get_user_id]
+
+if {$interest} {
+    sdm_baf_user_is_interested $baf_id $user_id
+} else {
+    sdm_baf_user_is_not_interested $baf_id $user_id
+}
+
+ns_returnredirect "../one-baf.tcl?[export_url_vars baf_id]"
Index: web/openacs/www/sdm/pvt/toggle-package-interest.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/sdm/pvt/toggle-package-interest.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/sdm/pvt/toggle-package-interest.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,14 @@
+set_the_usual_form_variables
+# package_id interest
+
+validate_integer package_id $package_id
+
+set user_id [ad_get_user_id]
+
+if {$interest} {
+    sdm_package_user_is_interested $package_id $user_id
+} else {
+    sdm_package_user_is_not_interested $package_id $user_id
+}
+
+ns_returnredirect "../one-package.tcl?[export_url_vars package_id]"
Index: web/openacs/www/search/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/search/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/search/index.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,34 @@
+# index.tcl,v 3.0 2000/02/06 03:54:19 ron Exp
+# search.tcl
+# 
+# the main public search form
+# 
+# 
+
+set search_server [ad_parameter BounceQueriesTo site-wide-search ""]
+
+if { ![empty_string_p $search_server] } {
+    ns_returnredirect "$search_server/search/"
+    return
+}
+
+set db [ns_db gethandle]
+
+ns_return 200 text/html "[ad_header "Search [ad_system_name]"]
+
+<h2>Search</h2>
+
+[ad_context_bar_ws_or_index "Search"]
+
+<hr>
+
+<a href=\"/photo/pcd1253/outside-hearst-56.tcl\"><img hspace=5 vspace=5 align=right HEIGHT=198 WIDTH=132 src=\"/photo/pcd1253/outside-hearst-56.1.jpg\" ALT=\"Manhattan 1995.\"></a>
+
+<form action=search.tcl method=GET>
+[ad_site_wide_search_widget $db]
+</form>
+
+<br clear=right>
+
+[ad_footer]
+"
Index: web/openacs/www/search/query-by-example.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/search/query-by-example.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/search/query-by-example.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,115 @@
+# query-by-example.tcl,v 3.0 2000/02/06 03:54:21 ron Exp
+set_the_usual_form_variables
+# table_name, the_key, sections, subject
+
+set user_id [ad_verity_and_get_user_id]
+
+# Figure out user preference for section display.
+set search_display_preference [ad_search_display_preference]
+
+if { $search_display_preference == "by_section" } {
+    set order_clause "order by section_name, 1 desc"
+} else {
+    set order_clause "order by 1 desc"
+}
+
+## Restrict to selected sections.
+set n_sections [llength $sections]
+
+# Technically, Oracle can handle in clauses with a single value,
+# but that's just not kosher ANSI.
+if { $n_sections == 1 } {
+    set sections_clause "and sws.table_name = '[DoubleApos $sections]'"
+} else {
+    set quoted_sections [list]
+    foreach s $sections {
+	lappend quoted_sections "'[DoubleApos $s]'"
+    }
+    set sections_clause "and sws.table_name in ([join $quoted_sections ", "])"
+}
+
+
+# Get themes for this document.
+set themes [ad_search_qbe_get_themes $table_name $the_key]
+
+
+set db [ns_db gethandle]
+
+# generate about portion of the search query.
+set about_clause [list]
+
+foreach theme $themes {
+    lappend about_clause "about($theme)"
+}
+
+regsub -all {\)} $QQsubject "" subject_for_context
+
+# Throw in the subject line to increase relevance.
+set subject_query [database_to_tcl_string $db "select im_convert('$subject_for_context') from dual"]
+
+set selection [ns_db select $db "select /*+ FIRST_ROWS */ score(10) as the_score, section_name, user_url_stub, the_key, one_line_description, sws.table_name
+from site_wide_index sws, table_acs_properties m
+where sws.table_name = m.table_name
+and contains(sws.datastore, '$subject_query and [join $about_clause " and "]', 10) > 0
+$sections_clause
+$order_clause"]
+
+ReturnHeaders
+
+ns_write "[ad_header "Search Results"]
+
+<h2>Search Results</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Search"] "Results"]
+
+<hr>
+
+Themes searched for: [join $themes ", "]
+
+<ul>
+"
+
+set search_results ""
+
+set counter 0
+set last_section ""
+set max_score 0
+
+set results_base_url [ad_parameter BounceResultsTo site-wide-search ""]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+
+    if { $section_name != $last_section } {
+	set max_score $the_score
+	# Reset count for new section.
+	set counter 0
+	set last_section $section_name
+	append search_results "<h3>$section_name</h3>\n"
+    }
+    
+    if { [ad_search_results_cutoff $counter $the_score $max_score] } {
+	ns_db flush $db
+	break
+    }
+
+    set one_line "<li>$the_score: <a href=\"$results_base_url$user_url_stub$the_key\">$one_line_description</a>\n"
+    if { $n_sections > 1 && $search_display_preference == "one_list" } {
+	append search_results "$one_line <font size=-1>($section_name)</font>\n"
+    } else {
+	append search_results $one_line
+    }
+
+    append search_results "(<a href=\"query-by-example.tcl?subject=[ns_urlencode $one_line_description]&[export_url_vars table_name the_key sections]\">more like this</a>)\n"
+}
+
+
+ns_db releasehandle $db
+
+ns_write "$search_results
+</ul>
+
+
+[ad_footer]
+"
Index: web/openacs/www/search/search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/search/search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/search/search.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,141 @@
+# search.tcl,v 3.0 2000/02/06 03:54:22 ron Exp
+ad_page_variables {query_string {sections -multiple-list}}
+
+set user_id [ad_verity_and_get_user_id]
+
+set exception_text ""
+set exception_count 0
+
+if { ![info exists sections] || [llength $sections] == 0 } {
+    append exception_text "<li>You must specify at least one section of [ad_system_name] to search.\n"
+    incr exception_count
+}
+
+if { ![info exists query_string] || [empty_string_p [string trim $query_string]] } {
+    append exception_text "<li>You didn't specify a query to search for.\n"
+    incr exception_count
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# Figure out user preference for section display.
+set search_display_preference [ad_search_display_preference]
+
+if { $search_display_preference == "by_section" } {
+    set order_clause "order by section_name, 1 desc"
+} else {
+    set order_clause "order by 1 desc"
+}
+
+## Restrict to selected sections.
+set n_sections [llength $sections]
+
+# Technically, Oracle can handle in clauses with a single value,
+# but that's just not kosher ANSI.
+if { $n_sections == 1 } {
+    set sections_clause "and sws.table_name = '[DoubleApos $sections]'"
+} else {
+    set quoted_sections [list]
+    foreach s $sections {
+	lappend quoted_sections "'[DoubleApos $s]'"
+    }
+    set sections_clause "and sws.table_name in ([join $quoted_sections ", "])"
+}
+
+set db [ns_db gethandle]
+
+set final_query_string [DoubleApos [database_to_tcl_string $db "select im_convert('[string trim [DoubleApos $query_string]]') from dual"]]
+
+with_catch errmsg {
+    set selection [ns_db select $db "select /*+ FIRST_ROWS */ score(10) as the_score, section_name, user_url_stub, the_key, one_line_description, sws.table_name
+from site_wide_index sws, table_acs_properties m
+where sws.table_name = m.table_name
+and contains(sws.datastore, '$final_query_string', 10) > 0
+$sections_clause
+$order_clause"]
+} {
+    ad_return_error "Problem with interMedia" "There was a problem with interMedia 
+while processing your query. This site wide search thing is still somewhat experimental,
+so please bear with us while we work out the kinks. You may have better luck if you change
+your query a little bit."
+    return
+}
+
+set search_results ""
+
+set counter 0
+set last_section ""
+set max_score 0
+
+set results_base_url [ad_parameter BounceResultsTo site-wide-search ""]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+
+    if { $section_name != $last_section } {
+	set max_score $the_score
+	# Reset count for new section.
+	set counter 0
+	set last_section $section_name
+	append search_results "<h3>$section_name</h3>\n"
+    }
+    
+    if { [ad_search_results_cutoff $counter $the_score $max_score] } {
+	if { $search_display_preference == "by_section" } {
+	    # We may have more sections later on.
+	    continue
+	} else {
+	    # All done.
+	    ns_db flush $db
+	    break
+	}
+    }
+
+    set one_line "<li>$the_score: <a href=\"$results_base_url$user_url_stub$the_key\">$one_line_description</a>\n"
+    if { $n_sections > 1 && $search_display_preference == "one_list" } {
+	append search_results "$one_line <font size=-1>($section_name)</font>\n"
+    } else {
+	append search_results $one_line
+    }
+    
+    append search_results "<font size=-1>(<a href=\"query-by-example.tcl?subject=[ns_urlencode $one_line_description]&[export_url_vars table_name the_key sections]\">more like this</a>)</font>\n"
+}
+
+if { [empty_string_p $search_results] } {
+    set search_results "No hits found for your query."
+}
+
+set site_search_widget "<form action=\"search.tcl\" method=GET>
+[ad_site_wide_search_widget $db $query_string $sections]
+</form>
+"
+
+ad_record_query_string $query_string $db $sections $counter [ad_get_user_id]
+
+ns_db releasehandle $db
+
+
+
+ns_return 200 text/html "[ad_header "Search Results"]
+
+<h2>Search Results</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Search"] "Results"]
+
+<hr>
+
+Results for \"$query_string\":
+
+<ul>
+$search_results
+</ul>
+
+$site_search_widget
+
+[ad_footer]
+"
+
Index: web/openacs/www/search/static-page-redirect.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/search/static-page-redirect.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/search/static-page-redirect.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,18 @@
+# static-page-redirect.tcl,v 3.0 2000/02/06 03:54:24 ron Exp
+ad_page_variables {page_id}
+
+validate_integer page_id $page_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select url_stub from static_pages where page_id = $page_id"]
+
+if { $selection == "" } {
+    ad_return_error "Invalid page id given"
+    return
+}
+
+set_variables_after_query
+
+ns_returnredirect $url_stub
+
Index: web/openacs/www/shared/1pixel.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/shared/1pixel.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/shared/1pixel.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,40 @@
+# 1pixel.tcl,v 1.1.2.2 2000/02/03 10:00:24 ron Exp
+# File:        index.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Generates a 1-pixel GIF image with a certain color.
+# Inputs:      r g b
+
+ReturnHeaders "image/gif"
+
+set_the_usual_form_variables
+
+set file [open "[ns_info pageroot]/graphics/1pixel.header"]
+ns_writefp $file
+close $file
+
+if { [util_aolserver_2_p] } {
+    if { $r == 0 } { set r 1 }
+    if { $g == 0 } { set g 1 }
+    if { $b == 0 } { set b 1 }
+
+    ns_write "[format "%c%c%c" $r $g $b]"
+} else {
+    # Can't figure out how to write binary data using AOLserver 3 (it
+    # insist on UTF8-encoding it). So we write to a file, then dump
+    # the file's contents.
+
+    set file_name [ns_tmpnam]
+    ns_log "Notice" "logging to $file_name"
+    set file [open $file_name w+]
+    fconfigure $file -encoding binary
+    puts -nonewline $file "[format "%c%c%c" $r $g $b]"
+    seek $file 0
+    ns_writefp $file
+    close $file
+    ns_unlink $file_name
+}
+
+set file [open "[ns_info pageroot]/graphics/1pixel.footer"]
+ns_writefp $file
+close $file
Index: web/openacs/www/shared/community-member.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/shared/community-member.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/shared/community-member.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,128 @@
+# community-member.tcl,v 3.5 2000/03/10 03:00:03 mbryzek Exp
+#
+# /shared/community-member.tcl
+#
+# shows User A what User B has contributed to the community
+#
+
+# March 9, 2000: 
+# February 1, 2000: Added check so that if this is an IntranetEnabled acs,
+# we only only authrozied intranet users to view community members other
+# than themselves
+# March 1, 1999:  philg edited this to suppress display of links that weren't live
+# September 26, 1999:  philg added display of user-uploaded portraits
+# November 1, 1999: philg trashed 90% of the code and replaced it with
+# a call to ad_summarize_user_contributions
+
+set_form_variables
+
+# user_id
+
+validate_integer user_id $user_id
+
+set db [ns_db gethandle]
+
+if { [im_enabled_p] && [ad_parameter KeepSharedInfoPrivate intranet 0] } {
+    set current_user_id [ad_get_user_id]
+    if { $current_user_id != $user_id && ![im_user_is_authorized_p $db $current_user_id] } {
+	im_restricted_access
+    }
+}
+
+# displays the contibutions of this member to the community
+
+set selection [ns_db 0or1row $db "select first_names, last_name, email, priv_email, 
+url, banning_note, registration_date, user_state,
+portrait_upload_date, portrait_original_width, portrait_original_height, portrait_client_file_name, bio,
+portrait_thumbnail_width, portrait_thumbnail_height
+from users 
+where user_id=$user_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "No user found" "There is no community member with the user_id of $user_id"
+    ns_log Notice "Could not find user_id $user_id in community-member.tcl from [ns_conn peeraddr]"
+    return
+} else {
+    set_variables_after_query
+}
+
+if ![empty_string_p $portrait_upload_date] {
+    # there is a portrait 
+    if ![empty_string_p $portrait_thumbnail_width] {
+	# there is a thumbnail version
+	set inline_portrait_html "<a href=\"portrait.tcl?[export_url_vars user_id]\"><img src=\"portrait-thumbnail-bits.tcl?[export_url_vars user_id]\" align=right width=$portrait_thumbnail_width height=$portrait_thumbnail_height></a>"
+    } else {
+	# no thumbnail; let's see what we can do with the main image
+	if { ![empty_string_p $portrait_original_width] && $portrait_original_width < 300 } {
+	    # let's show it inline
+	    set inline_portrait_html "<a href=\"portrait.tcl?[export_url_vars user_id]\"><img src=\"portrait-bits.tcl?[export_url_vars user_id]\" align=right width=$portrait_original_width height=$portrait_original_height></a>"
+	} else {
+	    set inline_portrait_html "<table width=100%><tr><td align=right>Portrait:  <a href=\"portrait.tcl?[export_url_vars user_id]\">$portrait_client_file_name</a></td></tr></table>"
+	}
+    }
+} else {
+    set inline_portrait_html ""
+}
+
+ad_return_top_of_page "[ad_header "$first_names $last_name"]
+
+<h2>$first_names $last_name</h2> 
+
+[ad_context_bar_ws_or_index "Community member"]
+
+<hr>
+
+$inline_portrait_html
+A member of the [ad_system_name] community since [util_AnsiDatetoPrettyDate $registration_date]
+"
+
+if { $user_state == "deleted" } {
+    ns_write "<blockquote><font color=red>this user is deleted</font></blockquote>\n"
+}
+if { $user_state == "banned" } {
+    ns_write "<blockquote><font color=red>this user is deleted and
+banned from the community for the following reason:
+\"$banning_note\"</font></blockquote>\n"
+}
+
+
+if { [im_enabled_p] } {
+    ns_write [im_user_information $db $user_id]
+} else {
+
+    if { $priv_email <= [ad_privacy_threshold] } {
+	ns_write "<ul>
+<li>E-mail $first_names $last_name:
+<A HREF=\"mailto:$email\">$email</a>"
+        if ![empty_string_p $url] {
+	    ns_write "<li>Personal home page:  <a href=\"$url\">$url</a>\n"
+	}
+	ns_write "</ul>\n"
+    } else {
+	if ![empty_string_p $url] {
+	    # guy doesn't want his email address shown, but we can still put out 
+	    # the home page
+	    ns_write "<ul><li>Personal home page:  <a href=\"$url\">$url</a></ul>\n"
+	}
+    }
+}
+
+
+if { [ad_verify_and_get_user_id] == 0 } {
+    ns_write "<blockquote>
+If you were to <a href=\"/register/index.tcl?return_url=[ns_urlencode "/shared/community-member.tcl?user_id=$user_id"]\">log in</a>, you'd be able to get more information on your fellow community member.
+</blockquote>
+"
+}
+
+set the_moby_summary [ad_summarize_user_contributions $db $user_id "web_display"]
+
+ns_db releasehandle $db
+
+ns_write $the_moby_summary
+
+# don't sign it with the publisher's email address!
+
+ns_write "
+[ad_footer]
+"
Index: web/openacs/www/shared/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/shared/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/shared/index.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,4 @@
+# index.tcl,v 3.0 2000/02/06 03:54:28 ron Exp
+# user try to play with the URL and get the directory structure instead of a file
+ns_returnredirect "filenotfound"
+
Index: web/openacs/www/shared/iso-codes.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/shared/iso-codes.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/shared/iso-codes.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,41 @@
+# iso-codes.tcl,v 3.1 2000/02/29 04:38:57 jsc Exp
+ReturnHeaders 
+
+ns_write  "<html>
+<head>
+<title>Complete List of ISO Codes</title>
+</head>
+<body bgcolor=#ffffff text=#000000>
+<h2>Complete List of ISO Codes</h2>
+
+Please locate your country's code among those listed below then use
+the \"back\" button on your browser to return to the previous form.
+
+<hr>
+<table>
+<tr><th align=left>Country Name<th>ISO Code</tr>
+
+"
+
+set db [ns_db gethandle]
+
+set selection [ns_db select $db "select * from country_codes
+order by country_name"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    ns_write "<tr><td>$country_name<td align=center>$iso</tr>\n"
+
+}
+
+
+
+ns_write "
+
+</table>
+
+<hr>
+
+
+</body>
+</html>"
Index: web/openacs/www/shared/new-stuff.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/shared/new-stuff.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/shared/new-stuff.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,82 @@
+# new-stuff.tcl
+# by philg@mit.edu on July 4, 1999
+#
+# new-stuff.tcl,v 3.1.4.1 2000/03/15 18:36:23 curtisg Exp
+
+# gives the random user a comprehensive view of what's 
+# new at the site
+
+set_the_usual_form_variables 0
+
+# n_days_ago 
+
+set db [ns_db gethandle]
+
+if { [im_enabled_p] && [ad_parameter KeepSharedInfoPrivate intranet 0] } {
+    if { ![im_user_is_authorized_p $db [ad_get_user_id]] } {
+	im_restricted_access
+    }
+}
+
+if ![info exists n_days_ago] {
+    set n_days_ago 7
+}
+
+validate_integer n_days_ago $n_days_ago
+
+if { $n_days_ago == 1 } {
+    set time_description "since yesterday morning"
+} else {
+    set time_description "in last $n_days_ago days"
+}
+
+ReturnHeaders
+
+ns_write "[ad_admin_header "New Stuff $time_description"]
+
+<h2>New Stuff $time_description</h2>
+
+[ad_context_bar_ws_or_index "New Stuff"]
+
+<hr>
+
+"
+
+
+set n_days_possible [list 1 2 3 4 5 6 7 14 30]
+
+foreach n_days $n_days_possible {
+    if { $n_days == $n_days_ago } {
+	# current choice, just the item
+	lappend right_widget_items $n_days
+    } else {
+	lappend right_widget_items "<a href=\"new-stuff.tcl?n_days_ago=$n_days\">$n_days</a>"
+    }
+}
+
+set right_widget [join $right_widget_items]
+
+ns_write "<table width=100%><tr><td align=left>&nbsp;<td align=right>N days: $right_widget</a></tr></table>
+
+<p>
+
+<blockquote>
+<font size=-2 face=\"verdana, arial, helvetica\">
+
+Please wait while this program sweeps dozens of database tables
+looking for new content...
+
+</font>
+</blockquote>
+
+<p>
+
+"
+
+set since_when [database_to_tcl_string $db "select sysdate - $n_days_ago from dual"]
+
+ns_write "[ad_new_stuff $db $since_when "f" "web_display"]
+
+[ad_admin_footer]
+"
+
Index: web/openacs/www/shared/portrait-bits.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/shared/portrait-bits.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/shared/portrait-bits.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,31 @@
+# portrait-bits.tcl,v 3.2 2000/03/10 02:38:25 mbryzek Exp
+#
+# /shared/portrait-bits.tcl
+# 
+# by philg@mit.edu on September 26, 1999
+# 
+# spits out correctly MIME-typed bits for a user's portrait
+# 
+
+set_form_variables
+
+# user_id
+
+validate_integer user_id $user_id
+
+set db [ns_db gethandle]
+
+set file_type [database_to_tcl_string_or_null $db "select portrait_file_type
+from users
+where user_id = $user_id"]
+
+if [empty_string_p $file_type] {
+    ad_return_error "Couldn't find portrait" "Couldn't find a portrait for User $user_id"
+    return
+}
+
+ReturnHeaders $file_type
+
+set portrait_id [database_to_tcl_string $db "select lob from users where user_id = $user_id"]
+
+ns_pg blob_write $db $portrait_id
Index: web/openacs/www/shared/portrait-thumbnail-bits.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/shared/portrait-thumbnail-bits.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/shared/portrait-thumbnail-bits.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,42 @@
+# portrait-thumbnail-bits.tcl,v 3.1 2000/03/10 03:00:04 mbryzek Exp
+#
+# /shared/portrait-thumbnail-bits.tcl
+# 
+# by philg@mit.edu on September 26, 1999
+# 
+# spits out correctly MIME-typed bits for a user's portrait (thumbnail version)
+# 
+
+set_form_variables
+
+# user_id
+
+validate_integer user_id $user_id
+
+set db [ns_db gethandle]
+
+set column portrait_thumbnail
+
+set file_type [database_to_tcl_string_or_null $db "select portrait_file_type
+from users
+where user_id = $user_id
+and portrait_thumbnail is not null"]
+
+if { [empty_string_p $file_type] } {
+    # Try to get a regular portrait
+    set file_type [database_to_tcl_string_or_null $db "select portrait_file_type
+from users
+where user_id = $user_id"]
+    if [empty_string_p $file_type] {
+	ad_return_error "Couldn't find thumbnail or portrait" "Couldn't find a thumbnail or a portrait for User $user_id"
+	return
+    }
+    set column portrait
+}
+
+ReturnHeaders $file_type
+
+ns_ora write_blob $db "select $column
+from users
+where user_id = $user_id"
+    
Index: web/openacs/www/shared/portrait.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/shared/portrait.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/shared/portrait.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,75 @@
+# portrait.tcl,v 3.0 2000/02/06 03:54:36 ron Exp
+# 
+# /shared/portrait.tcl
+#
+# by philg@mit.edu on September 26, 1999
+#
+# displays a user's portrait to other users
+
+set_the_usual_form_variables
+
+# user_id 
+
+validate_integer user_id $user_id
+
+set db [ns_db gethandle]
+
+set selection [ns_db 0or1row $db "select 
+  first_names, 
+  last_name, 
+  portrait_upload_date,
+  portrait_comment,
+  portrait_original_width,
+  portrait_original_height,
+  portrait_client_file_name
+from users 
+where user_id=$user_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Portrait Unavailable" "We couldn't find a portrait (or this user)"
+    return
+}
+
+set_variables_after_query
+
+if [empty_string_p $portrait_upload_date] {
+    ad_return_complaint 1 "<li>You shouldn't have gotten here; we don't have a portrait on file for this person."
+    return
+}
+
+if { ![empty_string_p $portrait_original_width] && ![empty_string_p $portrait_original_height] } {
+    set widthheight "width=$portrait_original_width height=$portrait_original_height"
+} else {
+    set widthheight ""
+}
+
+ns_return 200 text/html "[ad_header "Portrait of $first_names $last_name"]
+
+<h2>Portrait of $first_names $last_name</h2>
+
+[ad_context_bar_ws_or_index [list "/shared/community-member.tcl?[export_url_vars user_id]" "One Member"] "Portrait"]
+
+<hr>
+
+<br>
+<br>
+
+<center>
+<img $widthheight src=\"/shared/portrait-bits.tcl?[export_url_vars user_id]\">
+</center>
+
+
+<br>
+<br>
+
+<ul>
+<li>Comment:  
+<blockquote>
+$portrait_comment
+</blockquote>
+<li>Uploaded:  [util_AnsiDatetoPrettyDate $portrait_upload_date]
+<li>Original Name:  $portrait_client_file_name
+</ul>
+
+[ad_footer]
+"
Index: web/openacs/www/shared/whos-online.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/shared/whos-online.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/shared/whos-online.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,60 @@
+# whos-online.tcl,v 3.0 2000/02/06 03:54:37 ron Exp
+set connected_user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+set selection [ns_db select $db "select user_id, first_names, last_name, email
+from users
+where age(sysdate(), last_visit) < '[ad_parameter LastVisitUpdateInterval "" 600] seconds'
+order by upper(last_name), upper(first_names), upper(email)"]
+
+
+set users ""
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { $connected_user_id != 0 } {
+	append users "<li><a href=\"/shared/community-member.tcl?user_id=$user_id\">$first_names $last_name</a> ($email)\n"
+    } else {
+	# random tourist, let's not show email address
+	append users "<li><a href=\"/shared/community-member.tcl?user_id=$user_id\">$first_names $last_name</a>\n"
+    }
+}
+
+ns_db releasehandle $db
+
+if ![ad_parameter EnabledP chat 0] {
+    set chat_link ""
+} else {
+    set chat_link "This page is mostly useful in conjuction with 
+<a href=\"/chat/\">[chat_system_name]</a>."
+}
+
+ns_return 200 text/html "[ad_header "Who's Online?"]
+
+[ad_decorate_top "<h2>Who's Online?</h2>
+
+[ad_context_bar_ws_or_index "Who's Online"]
+" [ad_parameter WhosOnlineDecoration]]
+
+<hr>
+
+$chat_link
+
+<ul>
+$users
+</ul>
+
+These are the registered users who have 
+requested a page from this server within the last
+[ad_parameter LastVisitUpdateInterval ""] seconds.
+
+<p>
+
+On a public Internet service, the number of casual surfers
+(unregistered) will outnumber the registered users by at least 10 to
+1.  Thus there could be many more people using this service than it
+would appear.
+
+[ad_footer]
+"
Index: web/openacs/www/survsimp/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/survsimp/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/survsimp/index.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,45 @@
+#
+# /survsimp/index.tcl
+#
+# by philg@mit.edu, February 9, 2000
+#
+# show all the (enabled) surveys that a user could take
+# 
+#index.tcl,v 1.2 2000/03/12 06:38:13 michael Exp
+#
+
+set db [ns_db gethandle]
+
+set whole_page "[ad_header "Surveys"]
+
+<h2>Surveys</h2>
+
+[ad_context_bar_ws_or_index "Surveys"]
+
+<hr>
+
+<ul>
+
+"
+
+set selection [ns_db select $db "select survey_id, name, enabled_p
+from survsimp_surveys
+where enabled_p = 't'
+order by upper(name)"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append whole_page "<li><a href=\"one.tcl?[export_url_vars survey_id]\">$name</a>\n"
+}
+
+append whole_page "
+
+</ul>
+
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $whole_page 
Index: web/openacs/www/survsimp/one-respondent.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/survsimp/one-respondent.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/survsimp/one-respondent.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,76 @@
+#
+# /survsimp/one.tcl
+#
+# by philg@mit.edu, February 9, 2000
+#
+# display the user's previous responses
+# 
+
+
+
+ad_page_variables {survey_id {return_url ""} {group_id ""}}
+
+# survey_id, maybe return_url, maybe group_id
+
+validate_integer survey_id $survey_id
+validate_integer_or_null group_id $group_id
+
+set db [ns_db gethandle]
+
+set user_id [ad_verify_and_get_user_id $db]
+
+set selection [ns_db 0or1row $db "select name, description
+from survsimp_surveys
+where survey_id = $survey_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Not Found" "Could not find survey #$survey_id"
+    return
+}
+
+set_variables_after_query 
+
+# name and description are now set 
+
+set whole_page "[ad_header $name]
+
+<h2>$name</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Surveys"] [list "one.tcl?[export_url_vars survey_id]" "One survey"] "Responses"]
+
+<hr>
+
+$description 
+
+
+<p>
+
+
+"
+
+
+
+set response_id_date_list [database_to_tcl_list_list $db "select response_id, submission_date 
+from survsimp_responses
+where user_id = $user_id
+and survey_id = $survey_id
+order by submission_date desc"]
+
+if { ![empty_string_p $response_id_date_list] } {
+    
+
+    foreach response_id_date $response_id_date_list {
+	append whole_page "<h3> Your response on [lindex $response_id_date 1]</h3> 
+[survsimp_answer_summary_display $db [lindex $response_id_date 0] 1]
+<hr width=50%>"
+    }
+}
+
+append whole_page "
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $whole_page 
Index: web/openacs/www/survsimp/one.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/survsimp/one.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/survsimp/one.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,105 @@
+#
+# /survsimp/one.tcl
+#
+# by philg@mit.edu, February 9, 2000
+#
+# display a questionnaire for one survey
+# 
+#one.tcl,v 1.5 2000/03/13 04:43:12 teadams Exp
+#
+
+
+ad_page_variables {survey_id {return_url ""} {group_id ""}}
+
+# survey_id, maybe return_url, maybe group_id
+
+validate_integer survey_id $survey_id
+validate_integer_or_null group_id $group_id
+
+set db [ns_db gethandle]
+
+set user_id [ad_verify_and_get_user_id $db]
+
+set selection [ns_db 0or1row $db "select name, description
+from survsimp_surveys
+where survey_id = $survey_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Not Found" "Could not find survey #$survey_id"
+    return
+}
+
+set_variables_after_query 
+
+# name and description are now set 
+
+set whole_page "[ad_header $name]
+
+<h2>$name</h2>
+
+ [ad_context_bar_ws_or_index [list "index.tcl" "Surveys"] "One Survey"]
+
+<hr>
+
+$description 
+
+
+<p>
+
+<blockquote>
+
+"
+
+# now we have to query Oracle to find out what the questions are and
+# how to present them; let's store up the IDs in a Tcl list so that
+# we don't need two database handles
+
+set question_ids [database_to_tcl_list $db "select question_id
+from survsimp_questions
+where survey_id = $survey_id
+and active_p = 't'
+order by sort_key"]
+
+append whole_page "
+
+<form method=POST action=\"process-response.tcl\">
+[export_form_vars survey_id return_url group_id]
+
+<ol>
+"
+
+foreach question_id $question_ids {
+    # give them a new page
+    append whole_page "<li>[survsimp_question_display $db $question_id]\n"
+}
+
+
+append whole_page "</ol>\n
+<center>
+<input type=submit value=\"Submit Response\">
+</center>
+</form>
+</blockquote>
+
+"
+
+
+# SCC: original query had: order by submission_date desc
+#      why?
+set num_responses [database_to_tcl_string $db "select count(response_id)
+from survsimp_responses
+where user_id = $user_id
+and survey_id = $survey_id"]
+
+if {$num_responses > 0 } {
+    append whole_page "<a href=one-respondent.tcl?[export_url_vars survey_id]>Your previous responses</a>"
+}
+
+append whole_page "
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $whole_page 
Index: web/openacs/www/survsimp/process-response.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/survsimp/process-response.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/survsimp/process-response.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,222 @@
+#
+# /survsimp/process-response.tcl
+#
+# by jsc@arsdigita.com, February 9, 2000
+#
+# Insert user response into database.
+#
+# process-response.tcl,v 1.3.2.4 2000/03/17 03:15:13 nuno Exp
+#
+
+set_the_usual_form_variables
+
+# response_to_question_$question_id, survey_id, maybe return_url, maybe group_id
+
+validate survey_id $survey_id
+
+set user_id [ad_verify_and_get_user_id]
+
+if {[info exists group_id] && ![empty_string_p $group_id]} {
+    validate_integer group_id $group_id
+    set scope "group"
+
+} else {
+    set scope "public"
+}
+
+set db [ns_db gethandle]
+
+if {[ad_scope_authorization_status $db $scope all group_member user $group_id ] != "authorized" && ![im_user_is_employee_p $db $user_id]} {
+    # SCC: bad logic... you are not allowed if you are (!authorized and !employee).
+    #      can everybody say demorgan? :)
+    # you are allowed to submit a report if you are in the group
+    # or if you are an employee
+    ad_return_error "Not authorized" "[ad_scope_authorization_status $db $scope all group_member user $group_id ] [im_user_is_employee_p $db $user_id] You are not authorized for this function."
+    return
+}
+
+
+set question_info_list [database_to_tcl_list_list $db "select question_id, question_text, abstract_data_type, presentation_type, required_p
+from survsimp_questions
+where survey_id = $survey_id
+and active_p = 't'
+order by sort_key"]
+
+## Validate input.
+
+set questions_with_missing_responses [list]
+set exception_count 0
+set exception_text ""
+
+
+foreach question $question_info_list { 
+    set question_id [lindex $question 0]
+    set question_text [lindex $question 1]
+    set abstract_data_type [lindex $question 2]
+    set required_p [lindex $question 4]
+
+    if { $abstract_data_type == "date" } {
+	if [catch  { ns_dbformvalue [ns_conn form] response_to_question_$question_id date response_to_question_$question_id} errmsg] {
+	    incr exception_count
+	    append exception_text "<li>Please make sure your dates are valid."
+	}
+    }
+
+    if { [exists_and_not_null response_to_question_$question_id] } {
+	set response_value [string trim [set response_to_question_$question_id]]
+    } elseif {$required_p == "t"} {
+	lappend questions_with_missing_responses $question_text
+	continue
+    } else {
+	set response_to_question_$question_id ""
+	set response_value ""
+    }
+
+    if { $abstract_data_type == "number" } {
+	if { ![regexp {^(-?[0-9]+\.)?[0-9]+$} $response_value] } {
+	    incr exception_count
+	    append exception_text "<li>The response to \"$question_text\" must be a number. Your answer was \"$response_value\".\n"
+	    continue
+	}
+    } elseif { $abstract_data_type == "integer" } {
+	if { ![regexp {^[0-9]+$} $response_value] } {
+	    incr exception_count
+	    append exception_text "<li>The response to \"$question_text\" must be an integer. Your answer was \"$response_value\".\n"
+	    continue
+	}
+    }
+}
+
+set missing_expression_count [llength $questions_with_missing_responses]
+
+if { $missing_expression_count > 0 } {
+    incr exception_count $missing_expression_count
+    append exception_text "<li>You must provide a response to all the questions. You skipped:
+<ul>
+<li>[join $questions_with_missing_responses "\n<li>"]
+</ul>
+"
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+# Do the inserts.
+
+set response_id [database_to_tcl_string $db "select survsimp_response_id_sequence.nextval from dual"]
+
+with_transaction $db {
+
+    ns_db dml $db "insert into survsimp_responses (response_id, survey_id, user_id, ip_address, group_id, scope)
+ values ($response_id, $survey_id, $user_id, '[ns_conn peeraddr]', [ns_dbquotevalue $group_id],'$scope')"
+
+    foreach question $question_info_list { 
+	set question_id [lindex $question 0]
+	set question_text [lindex $question 1]
+	set abstract_data_type [lindex $question 2]
+	set presentation_type [lindex $question 3]
+
+	set response_value [string trim [set response_to_question_$question_id]]
+
+	switch -- $abstract_data_type {
+	    "choice" {
+		if { $presentation_type == "checkbox" } {
+		    # Deal with multiple responses.
+		    set checked_responses [util_GetCheckboxValues [ns_conn form] response_to_question_$question_id [list]]
+		    foreach response_value $checked_responses {
+			if { [empty_string_p $response_value] } {
+			    set response_value "null"
+			}
+
+			ns_db dml $db "insert into survsimp_question_responses (response_id, question_id, choice_id)
+ values ($response_id, $question_id, $response_value)"
+		    }
+		} else {
+		    if { [empty_string_p $response_value] } {
+			set response_value "null"
+		    }
+
+		    ns_db dml $db "insert into survsimp_question_responses (response_id, question_id, choice_id)
+ values ($response_id, $question_id, $response_value)"
+		}
+	    }
+	    "shorttext" {
+		ns_db dml $db "insert into survsimp_question_responses (response_id, question_id, varchar_answer)
+ values ($response_id, $question_id, '[DoubleApos $response_value]')"
+	    }
+	    "boolean" {
+		if { [empty_string_p $response_value] } {
+		    set response_value "null"
+		} else {
+		    set response_value "'$response_value'"
+		}
+
+		ns_db dml $db "insert into survsimp_question_responses (response_id, question_id, boolean_answer)
+ values ($response_id, $question_id, $response_value)"
+	    }
+	    "number" -
+	    "integer" {
+                if { [empty_string_p $response_value] } {
+                    set response_value "null"
+                } 
+
+		ns_db dml $db "insert into survsimp_question_responses (response_id, question_id, number_answer)
+ values ($response_id, $question_id, $response_value)"
+	    }
+	    "text" {
+                if { [empty_string_p $response_value] } {
+                    set response_value " "
+                } 
+
+		ns_db dml $db "insert into survsimp_question_responses (response_id, question_id, clob_answer)
+ values ($response_id, $question_id, '[DoubleApos $response_value]')"
+	    }
+	    "date" {
+                if { [empty_string_p $response_value] } {
+                    set response_value "null"
+                } else {
+                    set response_value "'$response_value'"
+                }
+
+		ns_db dml $db "insert into survsimp_question_responses (response_id, question_id, date_answer)
+ values ($response_id, $question_id, $response_value)"
+	    }
+	}
+    }
+} {
+    ad_return_error "Database Error" "There was an error while trying to process your response:
+<pre>
+$errmsg
+</pre>
+"
+    return
+}
+
+
+
+set survey_name [database_to_tcl_string $db "select name from survsimp_surveys
+where survey_id = $survey_id"]
+
+ns_db releasehandle $db
+
+if {[info exists return_url] && ![empty_string_p $return_url]} {
+    ns_returnredirect $return_url
+    return
+}
+
+ns_return 200 text/html "[ad_header "Response Submitted"]
+<h2>$survey_name</h2>
+
+ [ad_context_bar_ws_or_index [list "index.tcl" "Surveys"] "One Survey"]
+
+<hr>
+
+<blockquote>
+Response submitted. Thank you.
+</blockquote>
+
+[ad_footer]
+"
Index: web/openacs/www/survsimp/admin/description-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/survsimp/admin/description-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/survsimp/admin/description-edit-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,18 @@
+#
+# /survsimp/admin/description-edit-2.tcl
+#
+# by jsc@arsdigita.com, February 16, 2000
+#
+# Carry out the edit, return user to the main survey page.
+#
+# description-edit-2.tcl,v 1.1.4.1 2000/03/13 22:31:44 jsc Exp
+
+ad_page_variables {survey_id description}
+
+validate_integer survey_id $survey_id
+
+set db [ns_db gethandle]
+
+ns_db dml $db "update survsimp_surveys set description = '$QQdescription' where survey_id = $survey_id"
+
+ns_returnredirect "one.tcl?[export_url_vars survey_id]"
\ No newline at end of file
Index: web/openacs/www/survsimp/admin/description-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/survsimp/admin/description-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/survsimp/admin/description-edit.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,52 @@
+#
+# /survsimp/admin/description-edit.tcl
+#
+# by jsc@arsdigita.com, February 16, 2000
+#
+# Edit the description on a survey.
+# 
+
+ad_page_variables {survey_id}
+
+validate_integer survey_id $survey_id
+
+set db [ns_db gethandle]
+
+set user_id [ad_get_user_id]
+survsimp_survey_admin_check $db $user_id $survey_id
+
+set selection [ns_db 1row $db "select name as survey_name, description
+from survsimp_surveys
+where survey_id = $survey_id"]
+
+set_variables_after_query
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "[ad_header "Edit Description"]
+<h2>$survey_name</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Simple Survey Admin"] [list "one.tcl?[export_url_vars survey_id]" "Administer Survey"] "Edit Description"]
+
+<hr>
+
+<blockquote>
+Edit and submit to change the description for this survey:
+<form action=\"description-edit-2.tcl\">
+[export_form_vars survey_id]
+<textarea name=description rows=10 cols=65>
+$description
+</textarea>  
+
+<P>
+
+<center>
+<input type=submit value=Update>
+</center>
+
+</blockquote>
+
+[ad_footer]
+"
+
+
Index: web/openacs/www/survsimp/admin/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/survsimp/admin/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/survsimp/admin/index.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,63 @@
+#
+# /survsimp/admin/index.tcl
+#
+# by philg@mit.edu, February 9, 2000
+#
+# navigation page for simple survey module administrator
+# 
+# index.tcl,v 1.2.2.1 2000/03/17 18:45:53 aure Exp
+#
+
+
+set page_content "[ad_header "Simple Survey System (Admin)"]
+
+<h2>Simple Survey System Administration</h2>
+
+[ad_context_bar_ws_or_index "Simple Survey Admin"]
+
+<hr>
+
+<ul>
+
+"
+
+
+set db [ns_db gethandle]
+
+# Don't need to verify since the security filter should have bounced him if there wasn't a user_id.
+set user_id [ad_get_user_id]
+if { [ad_administrator_p $db $user_id] } {
+    set user_restriction_clause ""
+} else {
+    set user_restriction_clause "where creation_user = $user_id"
+}
+
+
+set selection [ns_db select $db "select survey_id, name, enabled_p
+from survsimp_surveys $user_restriction_clause
+order by enabled_p desc, upper(name)"]
+
+set disabled_header_written_p 0
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { $enabled_p == "f" && !$disabled_header_written_p } {
+	set disabled_header_written_p 1
+	append page_content "<h4>Disabled Surveys</h4>\n"
+    }
+    append page_content "<li><a href=\"one.tcl?[export_url_vars survey_id]\">$name</a>\n"
+}
+
+append page_content "
+
+<p>
+
+<li><a href=\"survey-create.tcl\">Create a new survey</a>
+</ul>
+
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $page_content 
Index: web/openacs/www/survsimp/admin/one-respondent.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/survsimp/admin/one-respondent.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/survsimp/admin/one-respondent.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,83 @@
+#
+# /survsimp/admin/one-respondent.tcl
+#
+# by jsc@arsdigita.com, February 11, 2000
+#
+# Display the filled-out survey for a single user.
+# 
+
+ad_page_variables {user_id survey_id}
+
+validate_integer user_id $user_id
+validate_integer survey_id $survey_id
+
+set db [ns_db gethandle]
+
+survsimp_survey_admin_check $db [ad_get_user_id] $survey_id
+
+
+set selection [ns_db 0or1row $db "select name as survey_name, description
+from survsimp_surveys
+where survey_id = $survey_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Not Found" "Could not find survey #$survey_id"
+    return
+}
+
+set_variables_after_query 
+
+# survey_name and description are now set 
+
+set selection [ns_db 0or1row $db "select first_names, last_name from users where user_id = $user_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Not Found" "Could not find user #$user_id"
+    return
+}
+
+set_variables_after_query
+
+set whole_page "[ad_header "Response from $first_names $last_name"]
+
+<h2>Response from $first_names $last_name</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Simple Survey Admin"] \
+     [list "one.tcl?survey_id=$survey_id" "Administer Survey"] \
+     [list "respondents.tcl?survey_id=$survey_id" "Respondents"] \
+     "One Respondent"]
+
+<hr>
+
+Here is what <a href=\"/shared/community-member.tcl?[export_url_vars user_id]\">$first_names $last_name</a> had to say in response to $survey_name:
+
+
+<p>
+
+
+"
+
+# now we have to query Oracle to find out what the questions are and
+# how to present them
+
+set response_id_date_list [database_to_tcl_list_list $db "select response_id, submission_date 
+from survsimp_responses
+where user_id = $user_id
+and survey_id = $survey_id
+order by submission_date desc"]
+
+if { ![empty_string_p $response_id_date_list] } {
+
+    foreach response_id_date $response_id_date_list {
+	append whole_page "<h3>Response on [lindex $response_id_date 1]</h3> 
+[survsimp_answer_summary_display $db [lindex $response_id_date 0] 1 ]
+<hr width=50%>"
+    }
+}
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "$whole_page  
+
+[ad_footer]"
Index: web/openacs/www/survsimp/admin/one.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/survsimp/admin/one.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/survsimp/admin/one.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,171 @@
+#
+# /survsimp/admin/one.tcl
+#
+# by jsc@arsdigita.com, February 9, 2000
+#
+# administer a single survey (add/delete questions)
+# 
+#one.tcl,v 1.4.2.2 2000/03/16 03:04:29 nuno Exp
+#
+
+ad_page_variables {survey_id}
+
+validate_integer survey_id $survey_id
+
+set dbs [ns_db gethandle main 2]
+set db [lindex $dbs 0]
+set sub_db [lindex $dbs 1]
+
+set user_id [ad_get_user_id]
+survsimp_survey_admin_check $db $user_id $survey_id
+
+# Get the survey information.
+set selection [ns_db 1row $db "select name as survey_name, short_name, description as survey_description, first_names || ' ' || last_name as creator_name, creation_user, creation_date, 
+case when enabled_p='t' then 'Enabled' when enabled_p='f' then 'Disabled' end as survey_status
+from survsimp_surveys, users
+where survey_id = $survey_id
+and users.user_id = survsimp_surveys.creation_user"]
+
+set_variables_after_query
+
+
+#set selection [ns_db select $db "select question_id, sort_key, active_p, required_p, nvl(category, 'uncategorized') as category
+#from survsimp_questions, categories,
+#  (select * from  site_wide_category_map 
+#   where site_wide_category_map.on_which_table = 'survsimp_questions') map
+#where survey_id = $survey_id  
+#and map.category_id = categories.category_id (+)
+#and map.on_what_id (+) = survsimp_questions.question_id
+#order by sort_key"]
+
+# Not sure if second union clause is needed.
+
+# Questions summary.
+set selection [ns_db select $db "
+select 
+  q.question_id, 
+  q.sort_key, 
+  q.active_p, 
+  q.required_p, 
+  coalesce(c.category, 'uncategorized') as category
+from 
+  survsimp_questions q, 
+  categories c, 
+  survsimp_category_map map
+where 
+  survey_id = $survey_id  
+  and map.category_id = c.category_id
+  and map.on_what_id  = q.question_id
+union
+select 
+  q.question_id, 
+  q.sort_key, 
+  q.active_p, 
+  q.required_p, 
+  'uncategorized' as category
+from 
+  survsimp_questions q, 
+  survsimp_category_map map
+where 
+  survey_id = $survey_id  
+  and not exists ( select category_id from categories where map.category_id = category_id )
+  and map.on_what_id  = q.question_id
+union
+select 
+  q.question_id, 
+  q.sort_key, 
+  q.active_p, 
+  q.required_p, 
+  'uncategorized' as category
+from 
+  survsimp_questions q
+where 
+  survey_id = $survey_id  
+  and not exists ( select on_what_id from survsimp_category_map map, categories c
+                     where map.category_id = c.category_id
+                     and map.on_what_id = q.question_id )
+order by sort_key"]
+
+set questions_summary "<form><ol>\n"
+set count 0
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+
+    set question_options [list "<a href=\"question-delete.tcl?question_id=$question_id\">delete</a>" \
+			      "<a href=\"question-add.tcl?[export_url_vars survey_id]&after=$sort_key\">insert after</a>"]
+    if { $count > 0 } {
+	lappend question_options "<a href=\"question-swap.tcl?[export_url_vars survey_id sort_key]\">swap with prev</a>"
+    }
+    if {$active_p == "t"} {
+	lappend question_options "Active: <a href=\"question-active-toggle?[export_url_vars survey_id question_id active_p]\">inactivate</a>"
+	if {$required_p == "t"} {
+	    lappend question_options "Response Required: <a href=\"question-required-toggle?[export_url_vars survey_id question_id required_p]\">don't require</a>"
+	} else {
+	    lappend question_options "Response Not Required: <a href=\"question-required-toggle?[export_url_vars survey_id question_id required_p]\">require</a>"
+	}
+    } else {
+	lappend question_options "Inactive: <a href=\"question-active-toggle?[export_url_vars survey_id question_id active_p]\">activate</a>"
+    }
+
+    append questions_summary "<li>[survsimp_question_display $sub_db $question_id] 
+<br>
+<font size=-1>
+Category: $category <p>
+\[ [join $question_options " | "] \]
+</font>
+
+<p>"
+    incr count
+}
+
+if { $count == 0 } {
+    append questions_summary "<p><a href=\"question-add.tcl?survey_id=$survey_id\">Add a question</a>\n"
+}
+
+append questions_summary "</ol></form>\n"
+
+set supported_categories [database_to_tcl_list $db "select category
+from site_wide_category_map, categories
+where site_wide_category_map.category_id = categories.category_id
+and on_which_table = 'survsimp_surveys'
+and on_what_id = $survey_id"] 
+
+ns_db releasehandle $db
+
+ReturnHeaders
+ns_write "[ad_header "Administer Survey"]
+<h2>$survey_name</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Simple Survey Admin"] "Administer Survey"]
+
+<hr>
+
+
+<ul>
+<li>Created by: <a href=\"/shared/community-member.tcl?user_id=$creation_user\">$creator_name</a>
+<li>Short name: $short_name
+<li>Created: [util_AnsiDatetoPrettyDate $creation_date]
+<li>Status: $survey_status <font size=-1>(can be changed from site-wide admin pages)</font>
+<li>Description: $survey_description <font size=-1>\[ <a href=\"description-edit.tcl?[export_url_vars survey_id]\">edit</a> \]</font>
+
+<li>Question categories: [join $supported_categories "," ] 
+<form action=survey-category-add.tcl method=post>
+[export_form_vars survey_id]
+<input type=type name=category Maxlength=20>
+<input type=submit name=submit value=\"Add Category\">
+</form>
+<p>
+<li>View responses:  <a href=\"respondents.tcl?survey_id=$survey_id\">by user</a>
+|
+<a href=\"responses.tcl?survey_id=$survey_id\">summary</a>
+</ul>
+<p>
+
+
+
+$questions_summary
+
+[ad_footer]
+"
Index: web/openacs/www/survsimp/admin/question-active-toggle.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/survsimp/admin/question-active-toggle.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/survsimp/admin/question-active-toggle.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,11 @@
+ad_page_variables {survey_id question_id}
+
+validate_integer survey_id survey_id
+validate_integer question_id $question_id
+
+set db [ns_db gethandle]
+
+ns_db dml $db "update survsimp_questions set active_p = logical_negation(active_p)
+where question_id = $question_id"
+
+ns_returnredirect "one.tcl?[export_url_vars survey_id]"
Index: web/openacs/www/survsimp/admin/question-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/survsimp/admin/question-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/survsimp/admin/question-add-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,144 @@
+#
+# /survsimp/admin/question-add-2.tcl
+#
+# by jsc@arsdigita.com, February 9, 2000
+#
+# Based on the presentation type selected in previous form,
+# gives the user various options on how to lay out the question.
+# 
+
+ad_page_variables {survey_id {after ""} question_text presentation_type {required_p t} {active_p t} {category_id ""}}
+
+validate_integer survey_id $survey_id
+validate_integer_or_null category_id $category_id
+
+set db [ns_db gethandle]
+
+set user_id [ad_get_user_id]
+survsimp_survey_admin_check $db $user_id $survey_id
+
+
+set selection [ns_db 1row $db "select name, description
+from survsimp_surveys
+where survey_id = $survey_id"]
+
+set_variables_after_query
+
+
+# Display presentation options for sizing text input fields and textareas.
+set presentation_options ""
+
+switch -- $presentation_type {
+    "textbox" { 
+	set presentation_options "<select name=textbox_size>
+<option value=small>Small</option>
+<option value=medium>Medium</option>
+<option value=large>Large</option>
+</select>"
+    }
+    "textarea" {
+	set presentation_options "Rows: <input name=textarea_rows size=3>  Columns: <input name=textarea_cols size=3>"
+    }
+}
+
+set presentation_options_html ""
+if { ![empty_string_p $presentation_options] } {
+    set presentation_options_html "Presentation Options: $presentation_options\n"
+}
+
+
+# Let user enter valid responses for selections, radio buttons, and check boxes.
+
+set response_fields ""
+
+switch -- $presentation_type {
+    "radio" -
+    "select" {
+	set response_fields "Select one of the following:<p>
+
+<table border=0 width=80% align=center>
+<tr valign=top<td valign=middle align=center>
+<td>
+<input type=radio name=abstract_data_type value=\"boolean\"> True or False
+<td valign=middle>
+<b>OR</b>
+<td>
+ <input type=radio name=abstract_data_type value=\"choice\" checked> Multiple choice (enter one per line):
+<blockquote>
+<textarea name=valid_responses rows=10 cols=50></textarea>
+</blockquote>
+
+</table>
+"
+	set response_type_html ""
+    }
+
+    "checkbox" {
+	set response_fields "Valid Responses (enter one per line):
+<blockquote>
+<textarea name=valid_responses rows=10 cols=80></textarea>
+</blockquote>
+"
+	set response_type_html "<input type=hidden name=abstract_data_type value=\"choice\">"
+    }
+    "textbox" -
+    "textarea" {
+	# Fields where users enter free text responses require an abstract type.
+	set response_type_html "<p>
+Type of Response:
+<select name=\"abstract_data_type\">
+ <option value=\"shorttext\">Short Text (< 4000 characters)</option>
+ <option value=\"text\">Text</option>
+ <option value=\"boolean\">Boolean</option>
+ <option value=\"number\">Number</option>
+ <option value=\"integer\">Integer</option>
+</select>
+"
+    } 
+    "date" {
+	
+	set response_type_html "<input type=hidden name=abstract_data_type value=date>"
+    }
+}
+
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "[ad_header "Add A Question (cont.)"]
+<h2>$name</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Simple Survey Admin"] [list "one.tcl?[export_url_vars survey_id]" "Administer Survey"] "Add A Question"]
+
+<hr>
+
+<form action=\"question-add-3.tcl\" method=GET>
+[export_entire_form]
+
+Question:
+<blockquote>
+$question_text
+</blockquote>
+
+$presentation_options_html
+
+$response_type_html
+
+$response_fields
+
+<p>
+
+Response Location: <input type=radio name=presentation_alignment value=\"beside\"> Beside the question<br>
+<input type=radio name=presentation_alignment value=\"below\" checked> Below the question
+
+
+<p>
+
+<center>
+<input type=submit value=\"Submit\">
+</center>
+
+</form>
+
+[ad_footer]
+"
Index: web/openacs/www/survsimp/admin/question-add-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/survsimp/admin/question-add-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/survsimp/admin/question-add-3.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,106 @@
+#
+# /survsimp/admin/question-add-3.tcl
+#
+# by jsc@arsdigita.com, February 9, 2000
+#
+# Create the question and bounce the user back to the survey administration page.
+# 
+#question-add-3.tcl,v 1.3.2.2 2000/03/16 18:58:48 nuno Exp
+#
+
+ad_page_variables {survey_id {after ""} question_text abstract_data_type presentation_type presentation_alignment {valid_responses ""} {textbox_size ""} {textarea_cols ""} {textarea_rows ""} {active_p "t"} {required_p "t"} {category_id ""}}
+
+validate_integer survey_id $survey_id
+validate_integer_or_null category_id $category_id
+
+set exception_count 0
+set exception_text ""
+
+if { [empty_string_p $question_text] } {
+    incr exception_count
+    append exception_text "<li>You did not enter a question."
+}
+
+if { $abstract_data_type == "choice" && [empty_string_p $valid_responses] } {
+    incr exception_count
+    append exception_text "<li>You did not enter a list of valid responses/choices."
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+set db [ns_db gethandle]
+
+set user_id [ad_verify_and_get_user_id]
+
+survsimp_survey_admin_check $db $user_id $survey_id
+
+# Generate presentation_options.
+set presentation_options ""
+if { $presentation_type == "textarea" } {
+    if { [exists_and_not_null textarea_rows] } {
+	append presentation_options " rows=$textarea_rows"
+    }
+    if { [exists_and_not_null textarea_cols] } {
+	append presentation_options " cols=$textarea_cols"
+    }
+} elseif { $presentation_type == "textbox" } {
+    if { [exists_and_not_null textbox_size] } {
+	# Will be "small", "medium", or "large".
+	set presentation_options $textbox_size
+    }
+}
+
+
+
+set new_question_id [db_sequence_nextval $db survsimp_question_id_sequence]
+
+with_transaction $db {
+    if { [exists_and_not_null after] } {
+	# We're inserting between existing questions; move everybody down.
+	set sort_key [expr $after + 1]
+	ns_db dml $db "update survsimp_questions
+set sort_key = sort_key + 1
+where survey_id = $survey_id
+and sort_key > $after"
+    } else {
+	set sort_key 1
+    }
+
+    ns_db dml $db "insert into survsimp_questions (question_id, survey_id, sort_key, question_text, abstract_data_type, presentation_type, presentation_options, presentation_alignment, creation_user, creation_date,active_p, required_p)
+ values ($new_question_id, $survey_id, $sort_key, '$QQquestion_text', '$abstract_data_type', '$presentation_type', '[DoubleApos $presentation_options]', '$presentation_alignment', $user_id, [db_sysdate], '$required_p', '$active_p')"
+    
+
+    if {[info exists category_id] && ![empty_string_p $category_id]} {
+	ns_db dml $db "insert into site_wide_category_map (map_id, category_id,
+on_which_table, on_what_id, mapping_date, one_line_item_desc) 
+values ([db_sequence_nextval_sql site_wide_cat_map_id_seq], $category_id, 'survsimp_questions',
+$new_question_id, [db_sysdate], 'Survey')"
+    }
+    # For questions where the user is selecting a canned response, insert
+    # the canned responses into survsimp_question_choices by parsing the valid_responses
+    # field.
+    if { $presentation_type == "checkbox" || $presentation_type == "radio" || $presentation_type == "select" } {
+	if { $abstract_data_type == "choice" } {
+	    set responses [split $valid_responses "\n"]
+	    set count 0
+	    foreach response $responses {
+		set trimmed_response [string trim $response]
+		if { [empty_string_p $trimmed_response] } {
+		    # skip empty lines
+		    continue
+		}
+		ns_db dml $db "insert into survsimp_question_choices (choice_id, question_id, label, sort_order)
+ values ([db_sequence_nextval_sql survsimp_choice_id_sequence], $new_question_id, '[DoubleApos $trimmed_response]', $count)"
+		incr count
+	    }
+	}
+    }
+} {
+    ad_return_error "Database Error" "<pre>$errmsg</pre>"
+    return
+}
+
+ns_returnredirect "one.tcl?survey_id=$survey_id"
Index: web/openacs/www/survsimp/admin/question-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/survsimp/admin/question-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/survsimp/admin/question-add.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,94 @@
+#
+# /survsimp/admin/question-add.tcl
+#
+# by jsc@arsdigita.com, February 9, 2000
+#
+# Present form to begin adding a question to a survey.
+# Lets user enter the question and select a presentation type.
+# 
+
+ad_page_variables {survey_id {after ""}}
+
+validate_integer survey_id $survey_id
+
+set db [ns_db gethandle]
+
+set user_id [ad_get_user_id]
+survsimp_survey_admin_check $db $user_id $survey_id
+
+
+set selection [ns_db 1row $db "select name, description
+from survsimp_surveys
+where survey_id = $survey_id"]
+
+set_variables_after_query
+
+set category_option_list [db_html_select_value_options $db "select 
+site_wide_category_map.category_id, category from
+site_wide_category_map, categories
+where categories.category_id = site_wide_category_map.category_id
+and on_what_id = $survey_id
+and on_which_table = 'survsimp_surveys'"]
+
+if ![empty_string_p $category_option_list] {
+    set category_text "Category:
+<select name=\"category_id\">
+$category_option_list
+</select>"
+} else {
+    set category_text ""
+}
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "[ad_header "Add A Question"]
+<h2>$name</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Simple Survey Admin"] [list "one.tcl?[export_url_vars survey_id]" "Administer Survey"] "Add A Question"]
+
+<hr>
+
+<form action=\"question-add-2.tcl\" method=GET>
+[export_form_vars survey_id after]
+
+Question:
+<blockquote>
+<textarea name=question_text rows=5 cols=70></textarea>
+</blockquote>
+
+<p>
+
+Response Presentation:
+<select name=\"presentation_type\">
+<option value=\"textbox\">Text Field</option>
+<option value=\"textarea\">Text Area</option>
+<option value=\"select\">Selection</option>
+<option value=\"radio\">Radio Buttons</option>
+<option value=\"checkbox\">Checkbox</option>
+<option value=\"date\">Date</option>
+</select>
+<p>
+$category_text
+<p>
+Active? 
+<input type=radio value=t name=active_p checked>Yes
+<input type=radio value=f name=active_p>No
+<br>
+Required?
+<input type=radio value=t name=required_p checked>Yes
+<input type=radio value=f name=required_p>No
+
+<center>
+<input type=submit value=\"Continue\">
+</center>
+
+
+</form>
+
+[ad_footer]
+"
+
+
+
+
Index: web/openacs/www/survsimp/admin/question-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/survsimp/admin/question-delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/survsimp/admin/question-delete-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,38 @@
+#
+# /survsimp/admin/question-delete-2.tcl
+#
+# by jsc@arsdigita.com, March 13, 2000
+#
+# delete a question from a survey, along with all responses
+# 
+# question-delete-2.tcl,v 1.1.2.2 2000/03/14 23:34:36 nuno Exp
+
+ad_page_variables {question_id}
+
+validate_integer question_id $question_id
+
+set db [ns_db gethandle]
+
+set survey_id [database_to_tcl_string $db "select survey_id from survsimp_questions where question_id = $question_id"]
+
+set user_id [ad_get_user_id]
+survsimp_survey_admin_check $db $user_id $survey_id
+
+with_transaction $db {
+    ns_db dml $db "delete from survsimp_question_responses where question_id = $question_id"
+    ns_db dml $db "delete from survsimp_question_choices where question_id = $question_id"
+    ns_db dml $db "delete from survsimp_questions where question_id = $question_id"
+} { ad_return_error "Database Error" "There was an error while trying to delete the question:
+        <pre>
+        $errmsg
+        </pre>
+        <p> Please go back to the <a href=\"one.tcl?survey_id=$survey_id\">survey</a>.
+        "
+        return
+}
+
+
+ns_returnredirect "one.tcl?survey_id=$survey_id"
+
+
+
Index: web/openacs/www/survsimp/admin/question-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/survsimp/admin/question-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/survsimp/admin/question-delete.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,55 @@
+#
+# /survsimp/admin/question-delete.tcl
+#
+# by jsc@arsdigita.com, March 13, 2000
+#
+# delete a question from a survey (or ask for confirmation if there are responses)
+# 
+# question-delete.tcl,v 1.1.4.4 2000/03/14 23:28:33 nuno Exp
+
+ad_page_variables {question_id}
+
+validate_integer question_id $question_id
+
+set db [ns_db gethandle]
+
+set survey_id [database_to_tcl_string $db "select survey_id from survsimp_questions where question_id = $question_id"]
+
+set user_id [ad_get_user_id]
+survsimp_survey_admin_check $db $user_id $survey_id
+
+set n_responses [database_to_tcl_string $db "select count(*)
+from survsimp_question_responses
+where question_id = $question_id"]
+
+if { $n_responses == 0 } {
+    with_transaction $db {
+	ns_db dml $db "delete from survsimp_question_choices where question_id = $question_id"
+	ns_db dml $db "delete from survsimp_questions where question_id = $question_id"
+    } { ad_return_error "Database Error" "There was an error while trying to delete the question:
+	<pre>
+	$errmsg
+	</pre>
+	<p> Please go back using your browser.
+	"
+	return
+    }
+
+    ns_returnredirect "one.tcl?survey_id=$survey_id"
+    return
+} else {
+    ns_return 200 text/html "[ad_header "Confirm Question Deletion"]
+<h2>Really Delete?</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Simple Survey Admin"] [list "one.tcl?[export_url_vars survey_id]" "Administer Survey"] "Delete Question"]
+
+<hr>
+
+Deleting this question will also delete all $n_responses responses. Really delete?
+<p>
+<a href=\"question-delete-2.tcl?[export_url_vars question_id]\">Yes</a> / 
+<a href=\"one.tcl?[export_url_vars survey_id]\">No</a>
+
+[ad_footer]
+"
+}
\ No newline at end of file
Index: web/openacs/www/survsimp/admin/question-required-toggle.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/survsimp/admin/question-required-toggle.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/survsimp/admin/question-required-toggle.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,23 @@
+#
+# /survsimp/admin/question-required-toggle.tcl
+#
+# by jsc@arsdigita.com, February 9, 2000
+#
+# toggle required field for a question.
+# 
+# question-required-toggle.tcl,v 1.1.2.1 2000/03/13 22:31:48 jsc Exp
+#
+
+
+
+ad_page_variables {required_p survey_id question_id}
+
+validate_integer survey_id $survey_id
+validate_integer question_id $question_id
+
+set db [ns_db gethandle]
+
+ns_db dml $db "update survsimp_questions set required_p = logical_negation(required_p)
+where question_id = $question_id"
+
+ns_returnredirect "one.tcl?[export_url_vars survey_id]"
Index: web/openacs/www/survsimp/admin/question-swap.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/survsimp/admin/question-swap.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/survsimp/admin/question-swap.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,29 @@
+# Swaps two sort keys for a survey, sort_key and sort_key - 1.
+
+ad_page_variables {survey_id sort_key}
+
+validate_integer survey_id $survey_id
+
+set db [ns_db gethandle]
+
+set user_id [ad_get_user_id]
+survsimp_survey_admin_check $db $user_id $survey_id
+
+
+set next_sort_key [expr $sort_key - 1]
+
+with_catch errmsg {
+    ns_db dml $db "update survsimp_questions
+set sort_key = case when sort_key=$sort_key then $next_sort_key when sort_key=$next_sort_key then $sort_key end
+where survey_id = $survey_id
+and sort_key in ($sort_key, $next_sort_key)"
+
+    ns_returnredirect "one.tcl?[export_url_vars survey_id]"
+} {
+    ad_return_error "Database error" "A database error occured while trying
+to swap your questions. Here's the error:
+<pre>
+$errmsg
+</pre>
+"
+}
Index: web/openacs/www/survsimp/admin/respondents.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/survsimp/admin/respondents.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/survsimp/admin/respondents.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,62 @@
+#
+# /survsimp/admin/respondents.tcl
+#
+# by jsc@arsdigita.com, February 11, 2000
+#
+# List respondents to this survey.
+# 
+#respondents.tcl,v 1.3 2000/03/13 03:36:06 teadams Exp
+#
+
+
+ad_page_variables {survey_id}
+
+validate_integer survey_id $survey_id
+
+set db [ns_db gethandle]
+
+set user_id [ad_get_user_id]
+survsimp_survey_admin_check $db $user_id $survey_id
+
+
+set selection [ns_db select $db "select first_names || ' ' || last_name as name, u.user_id, email
+from users u, survsimp_responses r
+where u.user_id = r.user_id
+and survey_id = $survey_id
+group by u.user_id, email, first_names, last_name
+order by last_name"]
+
+
+set respondents ""
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    append respondents "<li><a href=\"one-respondent.tcl?[export_url_vars user_id  survey_id]\">$name ($email)</a>\n"
+}
+
+set survey_name [database_to_tcl_string $db "select name as survey_name
+from survsimp_surveys
+where survey_id = $survey_id"]
+
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "[ad_header "Respondents to Survey"]
+<h2>$survey_name</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Simple Survey Admin"] \
+     [list "one.tcl?survey_id=$survey_id" "Administer Survey"] \
+     "Respondents"]
+
+<hr>
+
+<ul>
+$respondents
+</ul>
+
+[ad_footer]
+"
+
+
Index: web/openacs/www/survsimp/admin/response-drill-down.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/survsimp/admin/response-drill-down.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/survsimp/admin/response-drill-down.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,86 @@
+#
+# /survsimp/admin/response-drill-down.tcl
+#
+# by philg@mit.edu and jsc@arsdigita.com, February 16, 2000
+#
+# Display the list of users who gave a particular answer to a
+# particular question.
+
+ad_page_variables {question_id choice_id}
+
+validate_integer question_id $question_id
+validate_integer choice_id $choice_id
+
+set db [ns_db gethandle]
+
+# get the prompt text for the question and the ID for survey of 
+# which it is part
+
+set selection [ns_db 0or1row $db "select survey_id, question_text
+from survsimp_questions
+where question_id = $question_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Survey Question Not Found" "Could not find a survey question #$question_id"
+    return
+}
+
+set_variables_after_query
+
+set selection [ns_db 0or1row $db "select label as response_text
+from survsimp_question_choices
+where choice_id = $choice_id"]
+
+if [empty_string_p $selection] {
+    ad_return_error "Response Not Found" "Could not find the response #$choice_id"
+    return
+}
+
+set_variables_after_query
+
+set user_id [ad_get_user_id]
+survsimp_survey_admin_check $db $user_id $survey_id
+
+set survey_name [database_to_tcl_string $db "select name from survsimp_surveys where survey_id = $survey_id"]
+
+
+set results ""
+
+# Get information of users who responded in particular manner to
+# choice question.
+set selection [ns_db select $db "select first_names || ' ' || last_name as responder_name, u.user_id, submission_date
+from survsimp_responses sr, users u, survsimp_question_responses qr
+where qr.response_id = sr.response_id
+and sr.user_id = u.user_id
+and qr.question_id = $question_id
+and qr.choice_id = $choice_id"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    append results "<li><a href=\"one-respondent.tcl?[export_url_vars user_id survey_id]\">$responder_name</a>\n"
+}
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "[ad_header "People who answered \"$response_text\""]
+
+<h2>Responder List</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Simple Survey Admin"] \
+     [list "one.tcl?survey_id=$survey_id" "Administer Survey"] \
+     [list "responses.tcl?survey_id=$survey_id" "Responses"] \
+     "One Response"]
+
+<hr>
+
+$survey_name responders who answered \"$response_text\"
+when asked \"$question_text\":
+
+<ul>
+$results
+</ul>
+
+[ad_footer]
+"
+
Index: web/openacs/www/survsimp/admin/responses.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/survsimp/admin/responses.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/survsimp/admin/responses.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,122 @@
+#
+# /survsimp/admin/responses.tcl
+#
+# by jsc@arsdigita.com, February 11, 2000
+#
+# View summary of all responses to one survey.
+# 
+
+ad_page_variables {survey_id}
+
+validate_integer survey_id $survey_id
+
+set dbs [ns_db gethandle main 2]
+
+set db [lindex $dbs 0]
+set sub_db [lindex $dbs 1]
+
+set user_id [ad_get_user_id]
+survsimp_survey_admin_check $db $user_id $survey_id
+
+
+set results ""
+
+set selection [ns_db select $db "select question_id, question_text, abstract_data_type
+from survsimp_questions
+where survey_id = $survey_id
+order by sort_key"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    append results "<li>$question_text
+<blockquote>
+"
+    switch -- $abstract_data_type {
+	"date" -
+	"text" -
+	"shorttext" {
+	    append results "<a href=\"view-text-responses.tcl?question_id=$question_id\">View responses</a>\n"
+	}
+	
+	"boolean" {
+	    set sub_selection [ns_db select $sub_db "select count(*) as n_responses, case when boolean_answer='t' then 'True' when boolean_answer='f' then 'False' end as boolean_answer
+from survsimp_question_responses
+where question_id = $question_id
+group by boolean_answer
+order by boolean_answer desc"]
+	    while { [ns_db getrow $sub_db $sub_selection] } {
+		set_variables_after_subquery
+		append results "$boolean_answer: $n_responses<br>\n"
+	    }
+	}
+	"integer" -
+	"number" {
+	    set sub_selection [ns_db select $sub_db "select count(*) as n_responses, number_answer
+from survsimp_question_responses
+where question_id = $question_id
+group by number_answer
+order by number_answer"]
+	    while { [ns_db getrow $sub_db $sub_selection] } {
+		set_variables_after_subquery
+		append results "$number_answer: $n_responses<br>\n"
+	    }
+	    set sub_selection [ns_db 1row $sub_db "select avg(number_answer) as mean, stddev(number_answer) as standard_deviation
+from survsimp_question_responses
+where question_id = $question_id"]
+	    set_variables_after_subquery
+	    append results "<p>Mean: $mean<br>Standard Dev: $standard_deviation<br>\n"
+	}
+	"choice" {
+	    set sub_selection [ns_db select $sub_db "select count(*) as n_responses, label, qc.choice_id
+from survsimp_question_responses qr, survsimp_question_choices qc
+where qr.choice_id = qc.choice_id
+  and qr.question_id = $question_id
+group by label, sort_order, qc.choice_id
+order by sort_order"]
+	    while { [ns_db getrow $sub_db $sub_selection] } {
+		set_variables_after_subquery
+		append results "$label: <a href=\"response-drill-down.tcl?[export_url_vars question_id choice_id]\">$n_responses</a><br>\n"
+	    }
+	}
+    }
+    append results "</blockquote>\n"
+}
+
+set survey_name [database_to_tcl_string $db "select name as survey_name
+from survsimp_surveys
+where survey_id = $survey_id"]
+
+set n_responses [database_to_tcl_string $db "select count(*)
+from survsimp_responses
+where survey_id = $survey_id"]
+
+if { $n_responses == 1 } {
+    set response_sentence "There has been 1 response."
+} else {
+    set response_sentence "There have been $n_responses responses."
+}
+
+
+
+ns_db releasehandle $db
+ns_db releasehandle $sub_db
+
+ns_return 200 text/html "[ad_header "Responses to Survey"]
+<h2>$survey_name</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Simple Survey Admin"] \
+     [list "one.tcl?survey_id=$survey_id" "Administer Survey"] \
+     "Responses"]
+
+<hr>
+
+$response_sentence
+
+<ul>
+$results
+</ul>
+
+[ad_footer]
+"
+
Index: web/openacs/www/survsimp/admin/survey-category-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/survsimp/admin/survey-category-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/survsimp/admin/survey-category-add.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,27 @@
+ad_page_variables {survey_id category}
+
+validate_integer survey_id $survey_id
+
+if {[empty_string_p $QQcategory]} {
+    ad_return_complaint 1 "You did not enter a category name."
+    return
+}
+
+set db [ns_db gethandle]
+
+ns_db dml $db "begin transaction"
+
+set category_id [db_sequence_nextval $db category_id_sequence]
+
+ns_db dml $db "insert into categories (category_id, category,category_type)
+values ($category_id, '$QQcategory', 'survsimp')"
+
+ns_db dml $db "insert into site_wide_category_map (map_id, category_id,
+on_which_table, on_what_id, mapping_date, one_line_item_desc) 
+values ([db_sequence_nextval_sql site_wide_cat_map_id_seq], $category_id, 'survsimp_surveys',
+$survey_id, [db_sysdate], 'Survey')"
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "one.tcl?[export_url_vars survey_id]"
+
Index: web/openacs/www/survsimp/admin/survey-create-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/survsimp/admin/survey-create-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/survsimp/admin/survey-create-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,60 @@
+#
+# /survsimp/admin/survey-create-2.tcl
+#
+# by philg@mit.edu, February 9, 2000
+#
+# actually does the insert
+# 
+#survey-create-2.tcl,v 1.2.2.2 2000/03/16 19:08:10 nuno Exp
+#
+
+ad_page_variables {name description short_name survey_id} 
+
+validate_integer survey_id $survey_id
+
+set db [ns_db gethandle]
+
+set exception_count 0
+set exception_text ""
+
+if { [empty_string_p $short_name] } {
+    incr exception_count
+    append exception_text "<li>You didn't enter a short name for this survey.\n"
+} else {
+    # make sure the short name isn't used somewhere else
+
+    set short_name_used_p [database_to_tcl_string $db "select
+      count(short_name) from survsimp_surveys where lower(short_name) =
+      '[string tolower $QQshort_name]'"]
+
+    if {$short_name_used_p > 0} {
+	incr exception_count
+	append exception_text "<li>This short name, $short_name, is already in use.\n"
+    }
+}
+
+if { [empty_string_p $name] } {
+    incr exception_count
+    append exception_text "<li>You didn't enter a name for this survey.\n"
+}
+
+if { [empty_string_p $description] } {
+    incr exception_count
+    append exception_text "<li>You didn't enter a description for this survey.\n"
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+set user_id [ad_verify_and_get_user_id]
+
+# make sure the short_name is unique
+
+ns_db dml $db "insert into survsimp_surveys
+(survey_id, name, short_name, description, creation_user)
+values
+($survey_id, '$QQname', '$QQshort_name', '$QQdescription', $user_id)"
+
+ns_returnredirect "question-add.tcl?survey_id=$survey_id"
Index: web/openacs/www/survsimp/admin/survey-create.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/survsimp/admin/survey-create.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/survsimp/admin/survey-create.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,52 @@
+#
+# /survsimp/admin/survey-create.tcl
+#
+# by raj@alum.mit.edu, February 9, 2000
+#
+# form for creating a survey
+# 
+
+set db [ns_db gethandle]
+
+set survey_id [db_sequence_nextval $db survsimp_survey_id_sequence]
+
+set whole_page "[ad_header "Create New Survey"]
+
+<h2>Create a New Survey</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Simple Survey Admin"] "Create Survey"]
+
+<hr>
+
+<blockquote>
+
+<form method=post action=\"survey-create-2.tcl\">
+<p>
+[export_form_vars survey_id]
+
+Survey Name:  <input type=text name=name size=30>
+<p>
+Short Name:  <input type=text name=short_name size=20 Maxlength=20>
+<p> 
+Survey Description: 
+<br>
+<textarea name=description rows=10 cols=65>
+</textarea>  
+<p>
+<center>
+<input type=submit value=\"Create\">
+</center>
+</form>
+
+</blockquote>
+
+[ad_footer]
+"
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $whole_page 
+
+
+
Index: web/openacs/www/survsimp/admin/view-text-responses.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/survsimp/admin/view-text-responses.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/survsimp/admin/view-text-responses.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,74 @@
+#
+# /survsimp/admin/view-text-responses.tcl
+#
+# by jsc@arsdigita.com, February 11, 2000
+#
+# View all the typed-in text responses for one question.
+# 
+
+ad_page_variables {question_id}
+
+validate_integer question_id $question_id
+
+set db [ns_db gethandle]
+
+set user_id [ad_get_user_id]
+set selection [ns_db 1row $db "select question_text, survey_id
+from survsimp_questions
+where question_id = $question_id"]
+set_variables_after_query
+
+survsimp_survey_admin_check $db $user_id $survey_id
+
+
+set abstract_data_type [database_to_tcl_string $db "select abstract_data_type
+from survsimp_questions q
+where question_id = $question_id"]
+
+if { $abstract_data_type == "text" } {
+    set column_name "clob_answer"
+} elseif { $abstract_data_type == "shorttext" } {
+    set column_name "varchar_answer"
+} elseif { $abstract_data_type == "date" } {
+    set column_name "date_answer"
+}
+
+set selection [ns_db select $db "select $column_name as response, u.user_id, first_names || ' ' || last_name as respondent_name, submission_date, ip_address
+from survsimp_responses r, survsimp_question_responses qr, users u
+where qr.response_id = r.response_id
+and u.user_id = r.user_id
+and qr.question_id = $question_id
+order by r.submission_date"]
+
+set results ""
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    append results "<pre>$response</pre>
+<p>
+-- <a href=\"/shared/community-member.tcl?user_id=$user_id\">$respondent_name</a> on $submission_date from $ip_address
+
+<br>
+"
+}
+
+
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "[ad_header "Responses to Question"]
+<h2>$question_text</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Simple Survey Admin"] \
+     [list "one.tcl?survey_id=$survey_id" "Administer Survey"] \
+     [list "responses.tcl?survey_id=$survey_id" "Responses to Survey"] \
+     "Responses to Question"]
+
+<hr>
+
+<blockquote>
+$results
+</blockquote>
+
+[ad_footer]
+"
Index: web/openacs/www/team/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/team/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/team/index.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,37 @@
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle] 
+# do a permission check here
+
+ReturnHeaders
+
+ns_write "
+[ad_header "Team Management"]
+<h2>Team Management</h2>
+[ad_context_bar_ws_or_index "Team Management"]
+<hr><p>
+Teams
+<ul>
+"
+
+if {[ad_administrator_p $db $user_id]} {
+    ns_write "
+    <li> <a href=new-team.tcl>Add a new team</a>
+    <p>
+    "
+}
+
+set selection [ns_db select $db "select project_id,title from open_ticket_projects where ticket_user_can_see_project_p($user_id, project_id)='t'"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    ns_write "<li> <a href=one-team.tcl?[export_url_vars project_id]>$title</a>\n"
+}
+
+ns_write "
+</ul>
+<p>
+
+[ad_footer]"
\ No newline at end of file
Index: web/openacs/www/team/member-change-role-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/team/member-change-role-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/team/member-change-role-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,23 @@
+set_the_usual_form_variables
+# role team_user_id team_id
+
+validate_integer team_user_id $team_user_id
+validate_integer team_id $team_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+set project_id [database_to_tcl_string $db "select project_id from ticket_project_teams where team_id=$team_id"]
+
+if {![ticket_user_can_admin_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+ns_db dml $db "begin transaction"
+team_user_change_role $team_id $team_user_id $role $db
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "one-team.tcl?[export_url_vars project_id]"
Index: web/openacs/www/team/member-change-role.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/team/member-change-role.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/team/member-change-role.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,27 @@
+set_the_usual_form_variables
+# team_user_id team_id
+
+validate_integer team_id $team_id
+validate_integer team_user_id $team_user_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+set project_id [database_to_tcl_string $db "select project_id from ticket_project_teams where team_id=$team_id"]
+
+if {![ticket_user_can_admin_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set selection [ns_db 1row $db "select first_names, last_name, email from users where user_id=$team_user_id"]
+set_variables_after_query
+
+set selection [ns_db 1row $db "select title from ticket_projects where project_id=$project_id"]
+set_variables_after_query
+
+set role_options [ad_db_optionlist $db "select distinct role, role from user_group_roles where group_id=$team_id"]
+ad_return_template
+
+
Index: web/openacs/www/team/new-member-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/team/new-member-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/team/new-member-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,22 @@
+set_the_usual_form_variables
+# project_id email role
+
+validate_integer project_id $project_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![ticket_user_can_admin_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set selection [ns_db 1row $db "select project_full_name(project_id) as title, team_id from ticket_project_teams where project_id=$project_id"]
+set_variables_after_query
+
+set original_email $email
+
+set all_users [database_to_tcl_list_ns_set $db "select user_id as new_user_id, first_names, last_name, email from users where lower(email) like lower('%$email%')"]
+
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/team/new-member-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/team/new-member-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/team/new-member-3.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,20 @@
+set_the_usual_form_variables
+# project_id email role
+
+validate_integer project_id $project_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![ticket_user_can_admin_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set selection [ns_db 1row $db "select project_full_name(project_id) as title, team_id from ticket_project_teams where project_id=$project_id"]
+set_variables_after_query
+
+team_add_user_by_email $db $team_id $email $role
+
+ns_returnredirect "one-team.tcl?[export_url_vars project_id]"
Index: web/openacs/www/team/new-member-4.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/team/new-member-4.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/team/new-member-4.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,21 @@
+set_the_usual_form_variables
+# project_id new_user_id role
+
+validate_integer project_id $project_id
+validate_integer new_user_id $new_user_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![ticket_user_can_admin_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set selection [ns_db 1row $db "select project_full_name(project_id) as title, team_id from ticket_project_teams where project_id=$project_id"]
+set_variables_after_query
+
+team_add_user $team_id $new_user_id $role $db
+
+ns_returnredirect "one-team.tcl?[export_url_vars project_id]"
Index: web/openacs/www/team/new-member.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/team/new-member.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/team/new-member.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,39 @@
+set_the_usual_form_variables
+# project_id
+
+validate_integer project_id $project_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![ticket_user_can_admin_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+ReturnHeaders
+
+set selection [ns_db 1row $db "select project_full_name(project_id) as title, team_id from ticket_project_teams where project_id=$project_id"]
+set_variables_after_query
+
+ns_write "[ad_header "New Member"]
+<h2>New Member</h2>
+[ad_context_bar_ws_or_index [list [team_url_stub] "Team Management"]  [list one-team.tcl?[export_url_vars project_id] $title] "New Member"]
+<hr><p>
+
+<FORM METHOD=POST action=new-member-2.tcl>
+[export_form_vars project_id]
+Email Address: <INPUT TYPE=text name=email><br>
+Role:
+<SELECT name=role>
+[ad_db_optionlist $db "select distinct role, role from user_group_roles where group_id=$team_id"]
+<option> administrator
+</SELECT>
+<p>
+<INPUT TYPE=submit value=add>
+</FORM>
+<p>
+
+[ad_footer]
+"
Index: web/openacs/www/team/new-team-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/team/new-team-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/team/new-team-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,50 @@
+set_the_usual_form_variables
+
+set user_id [ad_get_user_id]
+
+ReturnHeaders
+
+ns_write "[ad_header "Confirm"]
+<h2>Confirm</h2>
+<hr><p>
+The following team members for project $project_name:
+<p>
+Internal People:
+<ul>
+"
+
+set internal_emails [string trim $internal_emails]
+set external_emails [string trim $external_emails]
+
+set email_list [split $internal_emails "\n"]
+
+foreach email $email_list {
+    ns_write "<li>$email\n"
+}
+
+ns_write "
+</ul>
+<p>
+External People:
+<ul>
+"
+
+set email_list [split $external_emails "\n"]
+
+foreach email $email_list {
+    ns_write "<li>$email\n"
+}
+
+ns_write "
+</ul>
+<p>
+<FORM METHOD=POST action=new-team-3.tcl>
+[export_form_vars internal_emails external_emails project_name]
+<input type=checkbox name=send_email_p value=yes> Send email to users?<p>
+
+<INPUT TYPE=submit value=go>
+</FORM>
+<p>
+
+[ad_footer]
+"
Index: web/openacs/www/team/new-team-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/team/new-team-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/team/new-team-3.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,99 @@
+set_the_usual_form_variables
+# emails
+
+set user_id [ad_get_user_id]
+set db [ns_db gethandle]
+
+if {![ad_administrator_p $db $user_id]} {
+    ns_returnredirect "index.tcl"
+    return
+}
+
+set main_email [database_to_tcl_string $db "select email from users where user_id=$user_id"]
+
+ReturnHeaders
+
+ns_write "[ad_header "Creating Project"]
+<h2>Creating Project</h2>
+<hr><p>
+<ul>
+"
+
+ns_db dml $db "begin transaction"
+
+# The Project
+ns_write "
+<li> Creating the Project ..."
+
+set project_id [database_to_tcl_string $db "select ticket_project_id_sequence.nextval from dual"]
+ns_db dml $db "insert into ticket_projects (project_id, customer_id, title, start_date) values ($project_id, $user_id, '$QQproject_name', sysdate())"
+
+# Create the team
+set team_id [team_new $project_name $db]
+
+# Associate project with team
+ns_db dml $db "insert into ticket_project_teams (project_id, team_id) values ($project_id, $team_id)"
+
+ns_write "done!\n"
+
+# The users
+ns_write "<li> Users:
+<ul>"
+
+set internal_email_list [split $internal_emails "\n"]
+set external_email_list [split $external_emails "\n"]
+
+# Accumulate the todo lists to do sharing
+# set todo_lists [list]
+# set user_ids [list]
+set list_of_emails_to_send [list]
+
+# loop through all the users and create them if necessary
+
+team_add_user $team_id $user_id administrator $db
+
+# Internal Users
+foreach email $internal_email_list {
+    ns_write "<li> $email: "
+
+    team_add_user_by_email $db $team_id $email internal
+
+    # prepare the email
+    lappend list_of_emails_to_send [email_new $email $main_email "new project: $project_name" "
+You have been added to the $project_name management site.
+Please visit [ad_url].
+"]
+}
+
+# External users
+foreach email $external_email_list {
+    ns_write "<li> $email: "
+
+    team_add_user_by_email $db $team_id $email external
+
+    # prepare the email
+    lappend list_of_emails_to_send [email_new $email $main_email "new project: $project_name" "
+You have been added to the $project_name management site.
+Please visit [ad_url].
+"]
+}
+
+ns_write "</ul>
+"
+
+ns_write "<li>sending the emails ..."
+
+if {[info exists send_email_p]} {
+    email_send_list $list_of_emails_to_send
+}
+
+ns_write "done!<p>"
+
+ns_write "</ul>
+<p>
+Go to <a href=/pvt/home.tcl>your workspace</a>.
+<p>
+[ad_footer]
+"
+
+ns_db dml $db "end transaction"
Index: web/openacs/www/team/new-team.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/team/new-team.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/team/new-team.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,26 @@
+
+set user_id [ad_get_user_id]
+
+# do a permission check here
+
+ns_return 200 text/html "
+[ad_header "Create a New Project Team"]
+<h2>Create a New Project Team</h2>
+<hr><p>
+
+<FORM METHOD=POST action=new-team-2.tcl>
+Project Name: <INPUT TYPE=text name=project_name><p>
+Internal People (who can edit and assign bugs) -- Enter email addresses, one per line:
+<br>
+<TEXTAREA name=internal_emails COLS=50 ROWS=10>
+</TEXTAREA>
+<p>
+External People (who can edit and assign bugs) -- Enter email addresses, one per line:
+<br>
+<TEXTAREA name=external_emails COLS=50 ROWS=10>
+</TEXTAREA>
+<br>
+<INPUT TYPE=submit value=go>
+</FORM>
+<p>
+[ad_footer]"
\ No newline at end of file
Index: web/openacs/www/team/one-team.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/team/one-team.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/team/one-team.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,71 @@
+set_the_usual_form_variables 
+# project_id
+
+validate_integer project_id $project_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![ticket_user_can_see_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+ReturnHeaders
+
+set selection [ns_db 1row $db "select project_full_name(project_id) as title, team_id from ticket_project_teams where project_id=$project_id"]
+set_variables_after_query
+
+ns_write "[ad_header "One Team"]
+<h2>$title</h2>
+[ad_context_bar_ws_or_index [list [team_url_stub] "Team Management"]  "One Team"]
+<hr><p>
+"
+
+set admin_p [ticket_user_can_admin_project_p $user_id $project_id $db]
+
+if {$admin_p} {
+    ns_write "
+<h3>Actions</h3>
+<ul>
+<li> <a href=new-member.tcl?[export_url_vars project_id]>new member</a>
+<p>
+<li> <a href=team-delete.tcl?[export_url_vars project_id]>delete this team</a>
+</ul>
+"
+}
+
+ns_write "
+
+<h3>Members</h3>
+<ul>
+"
+
+set selection [ns_db select $db "select users.user_id as team_user_id, first_names, last_name, email, role from users, user_group_map where users.user_id=user_group_map.user_id and user_group_map.group_id=$team_id order by role, last_name"]
+
+set current_role ""
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    if {$current_role != $role} {
+	ns_write "</ul>$role:<ul>"
+	set current_role $role
+    }
+
+    ns_write "<li> "
+
+    if {$admin_p} {
+	ns_write "\[ <a href=remove-user.tcl?[export_url_vars team_id team_user_id]>remove</a> \] \[ <a href=member-change-role.tcl?[export_url_vars team_id team_user_id]>change role</a> \] "
+    }
+
+    ns_write "$last_name, $first_names (<A href=mailto:$email>$email</a>)\n"
+}
+
+ns_write "</ul>
+
+<p>
+
+[ad_footer]
+"
\ No newline at end of file
Index: web/openacs/www/team/remove-user-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/team/remove-user-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/team/remove-user-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,20 @@
+set_the_usual_form_variables
+# team_id team_user_id
+
+validate_integer team_user_id $team_user_id
+validate_integer team_id $team_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+set project_id [database_to_tcl_string $db "select project_id from ticket_project_teams where team_id=$team_id"]
+
+if {![ticket_user_can_admin_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+team_remove_user $team_id $team_user_id $db
+
+ns_returnredirect "one-team.tcl?[export_url_vars project_id]"
\ No newline at end of file
Index: web/openacs/www/team/remove-user.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/team/remove-user.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/team/remove-user.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,34 @@
+set_the_usual_form_variables
+# team_id team_user_id
+
+validate_integer team_id $team_id
+validate_integer team_user_id $team_user_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+set project_id [database_to_tcl_string $db "select project_id from ticket_project_teams where team_id=$team_id"]
+
+if {![ticket_user_can_admin_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+set selection [ns_db 1row $db "select first_names, last_name, email from users where user_id=$team_user_id"]
+set_variables_after_query
+
+ns_return 200 text/html "
+[ad_header "Are you sure?"]
+<h2>Are you sure?</h2>
+<hr><p>
+Are you sure you want to remove $first_names $last_name ($email) from the team?
+<p>
+<FORM method=post action=remove-user-2.tcl>
+[export_form_vars team_id team_user_id]
+<INPUT TYPE=submit value=\"yes, delete\">
+</FORM>
+<p>
+
+[ad_footer]
+"
Index: web/openacs/www/team/team-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/team/team-delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/team/team-delete-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,65 @@
+set_the_usual_form_variables
+# project_id
+
+validate_integer project_id $project_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+# Check permission
+if {![ticket_user_can_admin_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+# Get the group_id
+set team_id [database_to_tcl_string $db "select team_id from ticket_project_teams where project_id=$project_id"]
+set list_ids [database_to_tcl_list $db "select list_id from todo_list_user_group_map where user_group_id=$team_id"]
+
+# Delete the todo items, lists
+ns_db dml $db "begin transaction"
+
+ns_db dml $db "delete from todo_items where list_id in (select list_id from todo_list_user_group_map where user_group_id=$team_id)"
+ns_db dml $db "delete from todo_list_user_map where list_id in (select list_id from todo_list_user_group_map where user_group_id=$team_id)"
+ns_db dml $db "delete from todo_items where list_id in (select list_id from todo_list_user_group_map where user_group_id=$team_id)"
+
+ns_db dml $db "delete from todo_list_user_group_map where user_group_id=$team_id"
+ns_db dml $db "delete from todo_lists where list_id in ([join $list_ids ","])"
+
+
+# Delete the ticket-related stuff
+ns_db dml $db "delete from ticket_issue_user_interest_map where msg_id in (select msg_id from ticket_issues where project_id=$project_id)"
+ns_db dml $db "delete from ticket_issues_attachments where msg_id in (select msg_id from ticket_issues where project_id=$project_id)"
+ns_db dml $db "delete from ticket_issue_assignments where msg_id in (select msg_id from ticket_issues where project_id=$project_id)"
+ns_db dml $db "delete from ticket_xrefs where from_ticket in (select msg_id from ticket_issues where project_id=$project_id)"
+ns_db dml $db "delete from ticket_xrefs where to_ticket in (select msg_id from ticket_issues where project_id=$project_id)"
+ns_db dml $db "delete from ticket_issue_responses where response_to in (select msg_id from ticket_issues where project_id=$project_id)"
+ns_db dml $db "delete from ticket_issue_notifications where msg_id in (select msg_id from ticket_issues where project_id=$project_id)"
+ns_db dml $db "delete from ticket_projects_field_vals where project_id=$project_id"
+ns_db dml $db "delete from ticket_projects_fields where project_id=$project_id"
+ns_db dml $db "delete from ticket_issues where msg_id in (select msg_id from ticket_issues where project_id=$project_id)"
+
+
+
+# user groups stuff
+ns_db dml $db "delete from user_group_map where group_id=$team_id"
+ns_db dml $db "delete from user_group_map_queue where group_id=$team_id"
+ns_db dml $db "delete from user_group_roles where group_id=$team_id"
+ns_db dml $db "delete from user_group_actions where group_id=$team_id"
+ns_db dml $db "delete from user_group_action_role_map where group_id=$team_id"
+ns_db dml $db "delete from administration_info where group_id=$team_id"
+ns_db dml $db "delete from group_member_email_preferences where group_id=$team_id"
+ns_db dml $db "delete from group_spam_history where group_id=$team_id"
+ns_db dml $db "delete from user_group_member_fields where group_id=$team_id"
+ns_db dml $db "delete from user_group_member_field_map where group_id=$team_id"
+
+ns_db dml $db "delete from ticket_project_teams where project_id=$project_id"
+ns_db dml $db "delete from ticket_projects where project_id=$project_id"
+ns_db dml $db "delete from user_groups where group_id=$team_id"
+
+ns_db dml $db "end transaction"
+
+
+
+ns_returnredirect "index.tcl"
\ No newline at end of file
Index: web/openacs/www/team/team-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/team/team-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/team/team-delete.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,16 @@
+set_the_usual_form_variables
+# project_id
+
+validate_integer project_id $project_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+# Check permission
+if {![ticket_user_can_admin_project_p $user_id $project_id $db]} {
+    ticket_deny_access
+    return
+}
+
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/threads/add-note.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/threads/add-note.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/threads/add-note.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,35 @@
+set_the_usual_form_variables
+# thread_id, content, thread_state
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+# Security Check
+if {![threads_user_can_see_thread_p $db $user_id $thread_id]} {
+    threads_deny_access
+    return
+}
+
+if {[info exists alternate_date]} {
+    ns_dbformvalue [ns_getform] note_date date note_date
+    set date_sql "'$note_date'::datetime"
+} else {
+    set date_sql "sysdate()"
+}
+
+ns_db dml $db "begin transaction"
+
+set note_id [db_sequence_nextval $db note_id_sequence]
+
+ns_db dml $db "insert into notes
+(note_id, user_id, thread_id, note_date, content)
+values
+($note_id, $user_id, $thread_id, $date_sql, '$QQcontent')"
+
+ns_db dml $db "update threads set thread_state='$QQthread_state'
+where thread_id=$thread_id"
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "one-thread.tcl?[export_url_vars thread_id]"
\ No newline at end of file
Index: web/openacs/www/threads/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/threads/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/threads/index.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,17 @@
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+set list_of_active_threads [database_to_tcl_list_list $db "
+select thread_id, thread_name from threads where user_can_see_thread_p($user_id, thread_id)='t' and thread_state='active' order by thread_name"]
+
+set list_of_blocked_threads [database_to_tcl_list_list $db "
+select thread_id, thread_name from threads where user_can_see_thread_p($user_id, thread_id)='t' and thread_state='blocked' order by thread_name"]
+
+set list_of_suspended_threads [database_to_tcl_list_list $db "
+select thread_id, thread_name from threads where user_can_see_thread_p($user_id, thread_id)='t' and thread_state='suspended' order by thread_name"]
+
+ns_db releasehandle $db
+
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/threads/new-collaborator.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/threads/new-collaborator.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/threads/new-collaborator.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,16 @@
+set_the_usual_form_variables
+# user_id_from_search thread_id
+
+set user_id [ad_get_user_id]
+set db [ns_db gethandle]
+
+# Security Check
+if {![threads_user_can_see_thread_p $db $user_id $thread_id]} {
+    threads_deny_access
+    return
+}
+
+if {[catch {ns_db dml $db "insert into thread_user_map (thread_id,user_id) values ($thread_id, $user_id_from_search)"} errmsg]} {
+}
+
+ns_returnredirect "one-thread.tcl?[export_url_vars thread_id]"
\ No newline at end of file
Index: web/openacs/www/threads/new-thread-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/threads/new-thread-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/threads/new-thread-2.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,28 @@
+set_the_usual_form_variables
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+set thread_id [db_sequence_nextval $db "thread_id_sequence"]
+
+ns_db dml $db "begin transaction"
+
+# Insert the thread
+ns_db dml $db "
+insert into threads
+(thread_id, thread_name, start_date, priority, thread_state, description)
+values
+($thread_id, '$QQthread_name', sysdate(), $priority, 'active', '$QQdescription')"
+
+# Map the thread to the user
+ns_db dml $db "
+insert into thread_user_map
+(thread_id, user_id)
+values
+($thread_id, $user_id)
+"
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "one-thread.tcl?[export_url_vars thread_id]"
Index: web/openacs/www/threads/new-thread.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/threads/new-thread.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/threads/new-thread.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,2 @@
+
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/threads/one-thread.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/threads/one-thread.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/threads/one-thread.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,48 @@
+set_the_usual_form_variables
+# thread_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+# Security Check
+if {![threads_user_can_see_thread_p $db $user_id $thread_id]} {
+    threads_deny_access
+    return
+}
+
+set selection [ns_db 1row $db "select thread_name, description, priority, start_date, end_date, thread_state from threads where thread_id=$thread_id"]
+set_variables_after_query
+
+set list_of_collaborators [database_to_tcl_list_list $db "select user_id, first_names || ' ' || last_name as name from users where user_id in (select user_id from thread_user_map where thread_id=$thread_id) and user_id!=$user_id"]
+
+set selection [ns_db select $db "
+select note_id, notes.user_id as user_id, first_names, last_name, 
+email, note_date, content
+from notes, users
+where 
+notes.user_id= users.user_id and
+thread_id= $thread_id
+order by note_date desc
+"]
+
+set list_of_notes [list]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    set who "$first_names $last_name ($email)"
+    lappend list_of_notes [list $content $who $note_date]
+}
+
+set current_date [database_to_tcl_string $db "select sysdate()::date"]
+
+ns_db releasehandle $db
+
+
+set target [threads_url_stub]/new-collaborator.tcl
+set passthrough [list thread_id]
+set custom_title "Choose a New Collaborator"
+
+
+ad_return_template
\ No newline at end of file
Index: web/openacs/www/ticket/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/index.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,347 @@
+# Ticket tracker admin user home page
+#
+# index.tcl by hqm@arsdigita.com June 1999
+# 
+set_form_variables 0
+
+# form vars:
+# 
+# (these are all optional args which have defaults)
+#
+# filter conditions
+#
+# Assignments:
+# view_assignment    { user unassigned all }
+
+# Status
+# view_status  { open closed deferred created_by_you }
+#
+# Creation time
+# view_created { last_24 last_week last_month all}
+#
+#
+# order_by       column name to sort table by 
+
+set ctrlvars {view_assignment view_status view_created}
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+if {[ticket_user_admin_p $db]} {
+    ns_returnredirect "/ticket/admin/index.tcl"
+    return
+}
+
+
+ReturnHeaders
+
+ns_write "[ad_header "[ticket_system_name] Home"]
+
+<h2>[ticket_system_name]</h2>
+
+[ad_context_bar_ws_or_index "Ticket Tracker"]
+
+<hr>
+"
+
+# List of form vars used to select tickets to display
+
+# Assignment filter conditions
+#
+
+if {![info exists view_assignment]} {
+    # default to show issues assigned to $user_id
+    set view_assignment user
+}
+
+# default to only your own assigned issues
+if {![info exists view_status]} {
+    set view_status open
+}
+
+# default to all time
+if {![info exists view_created]} {
+    set view_created all
+}
+
+
+switch $view_assignment {
+    "user" { 
+	set assignment_filter "and (exists (select msg_id from ticket_issue_assignments 
+where ticket_issue_assignments.msg_id = ticket_issues.msg_id
+and ticket_issue_assignments.user_id = $user_id
+)) " }
+
+     "all" { set assignment_filter "" }
+}
+
+switch $view_status {
+    "open" {set status_filter "and ((status <> 'closed') and (status <> 'deferred')) " }
+    "deferred" {set status_filter "and ((status <> 'closed') or (status = 'deferred')) " }
+    "closed" {set status_filter "" } # shows everything
+}
+
+switch $view_created {
+   "last_24"   { set date_filter "and (posting_time > (sysdate - 1))" } 
+   "last_week" { set date_filter "and (posting_time > (sysdate - 7)) " } 
+   "last_month" { set date_filter "and (posting_time > (sysdate - 30)) " }
+   "all" { set date_filter "" }
+}
+
+# Sort order of tickets by
+if {![info exists order_by]} {
+    set order_by "ticket_issues.msg_id"
+} elseif {[string match "project*" $order_by]} {
+    set order_by "project_title"
+}
+
+
+################################################################
+# GUI ticket filter controls
+
+# List of all the state vars we need to pass through these toggle switches
+set filter_vars {view_assignment view_status view_created order_by}
+
+
+append results "<table border=0 cellspacing=0 cellpadding=0 width=100%>
+<tr><th bgcolor=#ECECEC>Ticket Assignment</th>
+<th bgcolor=#ECECEC>Status</th>
+<th bgcolor=#ECECEC>Creation Time</th></tr>"
+
+
+#### Assignment flags
+# Show assigned to you 
+append results "<tr><td align=center>\["
+
+append results [ticket_control_vars view_assignment user $filter_vars "mine"]
+append results " | "
+# Show all tickets 
+append results [ticket_control_vars view_assignment all $filter_vars "everyone's"]
+
+#### Status flags
+append results "\]</td>\n<td align=center>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;\["
+
+# Show open issues
+append results [ticket_control_vars view_status open $filter_vars "active"]
+append results " | "
+# Show deferred issues
+append results [ticket_control_vars view_status deferred $filter_vars "+deferred"]
+append results " | "
+# Show closed issues
+append results [ticket_control_vars view_status closed $filter_vars "+closed"]
+
+
+#### Creation time filter
+append results "\]&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</td>\n<td align=center>\["
+
+append results [ticket_control_vars view_created last_24 $filter_vars "last 24 hrs"]
+append results " | "
+append results [ticket_control_vars view_created last_week $filter_vars "last week"]
+append results " | "
+append results [ticket_control_vars view_created last_month $filter_vars "last month"]
+append results " | "
+append results [ticket_control_vars view_created all $filter_vars "all"]
+
+append results "\]</td></tr></table><p>"
+
+################################################################
+
+
+
+set last_priority "starting"
+
+set count 0
+
+append results "<table border=0>
+<tr>
+<th align=left><a href=\"index.tcl?order_by=[toggle_order ticket_issues.msg_id $order_by]&[eval export_url_vars $ctrlvars]\">ID#</a></th>
+<th align=left><a href=\"index.tcl?order_by=[toggle_order priority $order_by]&[eval export_url_vars $ctrlvars]\">Pri</a></th>
+<th align=left><a href=\"index.tcl?order_by=[toggle_order ticket_type $order_by]&[eval export_url_vars $ctrlvars]\">Typ</a></th>
+<th align=left><a href=\"index.tcl?order_by=[toggle_order email $order_by]&[eval export_url_vars $ctrlvars]\">Creator</a></th>
+<th align=left><a href=\"index.tcl?order_by=[toggle_order status $order_by]&[eval export_url_vars $ctrlvars]\">Stat</a></th>
+<th align=left><a href=\"index.tcl?order_by=[toggle_order severity $order_by]&[eval export_url_vars $ctrlvars]\">Sever</a></th>
+<th align=left><a href=\"index.tcl?order_by=[toggle_order posting_time $order_by]&[eval export_url_vars $ctrlvars]\">Creat</a></th>
+<th align=left><a href=\"index.tcl?order_by=[toggle_order modification_time $order_by]&[eval export_url_vars $ctrlvars]\">Mod</a></th>
+<th align=left><a href=\"index.tcl?order_by=[toggle_order assigned_p $order_by]&[eval export_url_vars $ctrlvars]\">Asgn?</a></th>"
+
+if { $view_status == "closed" } {
+    append results "<th align=left><a href=\"index.tcl?order_by=[toggle_order close_date $order_by]&[eval export_url_vars $ctrlvars]\">Closed</a></th>"
+} else {
+    append results "<th align=left><a href=\"index.tcl?order_by=[toggle_order deadline $order_by]&[eval export_url_vars $ctrlvars]\">Deadline</a></th>"
+}
+
+append results "<th align=left><a href=\"index.tcl?order_by=[toggle_order one_line $order_by]&[eval export_url_vars $ctrlvars]\">Subject</a></th>
+"
+if {![string match "project_title" $order_by]} {
+    append results "<th align=left><a href=\"index.tcl?order_by=[toggle_order project_id $order_by]&[eval export_url_vars $ctrlvars]\">Project</a></th>
+"    
+}
+append results "</tr>\n"
+
+set last_project_title ""
+
+set query "select 
+ ticket_issues.msg_id,
+ ticket_issues.ticket_type, 
+ ticket_issues.one_line,
+ ticket_issues.status,
+ ticket_issues.severity,
+ ticket_issues.posting_time,
+ users.email,
+ assigned_users.email as assigned_user_email,
+ ticket_projects.title as project_title,
+ ticket_projects.project_id,
+ ticket_issues.priority, 
+ to_char(ticket_issues.modification_time, 'mm/dd/yy') as modification_time,
+ to_char(ticket_issues.posting_time, 'mm/dd/yy') as creation_time,
+ to_char(ticket_issues.close_date, 'mm/dd/yy') as close_date,
+ to_char(ticket_issues.deadline, 'mm/dd/yy') as deadline,
+ to_char(sysdate - deadline) as pastdue,
+ ticket_issue_assignments.active_p as assigned_p,
+ ticket_issue_assignments.user_id as assigned_user_id,
+ ticket_issues.public_p,
+ ticket_priorities.name as priority_name
+from ticket_issues, ticket_priorities, ticket_projects, users, ticket_issue_assignments, users assigned_users
+where ticket_priorities.priority = ticket_issues.priority
+and users.user_id = ticket_issues.user_id
+and ticket_projects.project_id = ticket_issues.project_id
+and ticket_issues.msg_id = ticket_issue_assignments.msg_id(+)
+and ticket_issue_assignments.user_id = assigned_users.user_id(+)
+$assignment_filter
+$status_filter
+$date_filter
+order by $order_by, ticket_issues.priority, ticket_issues.posting_time"
+
+set selection [ns_db select $db $query]
+
+set last_msg_id ""
+set msg_ids {}
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    set cols {}
+    if {$msg_id == $last_msg_id} {
+	set assign $assigned_user_email
+	regsub "@.*" $assign "" assign
+	set cols [list "" "" "" "" "" "" "" "" "$assign" "" "" ""]
+		
+    } else {
+	set last_msg_id $msg_id
+	lappend msg_ids $msg_id
+
+	
+	lappend cols "<a href=\"issue-view.tcl?msg_id=$msg_id\">$msg_id</a>"
+	lappend cols "P$priority"
+	lappend cols "[string range $ticket_type 0 3]"
+	regsub "@.*" $email "" email
+	lappend cols "$email"
+	if { [string compare $status "fixed waiting approval"] == 0 } {
+	    lappend cols "<font color=#00ff00>(w approv)</font>"
+	} elseif { [string compare $status "need clarification"] == 0 } {
+	    lappend cols "<font color=#ff0000>nd clar</font>"
+	} else {
+	    lappend cols $status
+	}
+	lappend cols "$severity"
+	lappend cols "$creation_time"
+	lappend cols "$modification_time"
+	
+	if {$assigned_p == "t"} {
+	    set assign $assigned_user_email
+	    regsub "@.*" $assign "" assign
+	    lappend cols "$assign"
+	} else {
+	    lappend cols ""
+	}
+
+	
+	if {[info exists closed] && $view_closed == 1} {
+	    lappend cols "$close_date" 
+	} else {
+	    if {$pastdue > 0} {
+		lappend cols "<font color=red>$deadline</font>"
+	    } else {
+		lappend cols "$deadline"
+	    }
+	}
+	
+	lappend cols "<a href=\"issue-view.tcl?msg_id=$msg_id\">[clean_up_html $one_line]</a>"
+	
+	# show project title if we are not sorting by project
+	if {![string match "project_title" $order_by]} {
+	    lappend cols "<a href=project-top.tcl?project_id=$project_id>[string range $project_title 0 12]</a>"	
+	}
+	
+	if {[string match "project_title" $order_by] && $last_project_title != $project_title} {
+	    append results "<tr><th colspan=10 align=left><a href=project-top.tcl?project_id=$project_id>$project_title</a></th></tr>\n"
+	    set last_project_title $project_title
+	}
+	
+	incr count
+	if {($count % 2) == 0} {
+	    set bgcolor "bgcolor=\#ECECEC"
+	} else {
+	    set bgcolor ""
+	}
+	
+    }
+    append results "<tr $bgcolor>"
+    foreach col $cols {
+	append results "<td>$col&nbsp;</td>\n"
+    }
+    append results "</tr>"    
+}
+
+if { $count == 0 } {
+    append results "<tr><td colspan=10 align=center>-- No issues --</td></tr>"   
+}
+
+append results "</table>\n<p>"
+
+
+ns_write  "
+$results
+<ul>
+<li>Summarize by 
+    <a href=\"project-summary.tcl\">project</a> |
+    <a href=\"user-summary.tcl\">user</a>
+
+<li>View by 
+   <a href=\"index.tcl?order_by=[toggle_order project_id $order_by]&[eval export_url_vars $ctrlvars]\">project</a> |
+   <a href=\"project-view-assignments.tcl\">user</a>
+   
+<li><a href=\"issue-details.tcl?[export_url_vars msg_ids]&report_type=msgs_and_responses\">View issues above as report</a>
+
+<p>
+
+<li>Add new 
+   <a href=\"issue-new.tcl\">issue</a>
+
+<p>
+
+<li>
+<form action=ticket-search.tcl method=GET>
+Quick Search:
+<input type=text maxlength=100 name=query_string_1>
+</form>
+
+</ul>
+
+
+
+<h3>Advanced Search</h3>
+
+<blockquote>
+<form action=ticket-search.tcl method=post>
+[ticket_search_fragments]
+<p>
+<center>
+<input type=submit name=submit value=\"Search\">
+</center>
+
+</form>
+</blockquote>
+
+[ad_footer]
+"
Index: web/openacs/www/ticket/issue-details.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/issue-details.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/issue-details.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,99 @@
+# List a set of tickets in a report 
+#
+# form vars:
+# report_type = "msgs" | "msgs_and_responses"
+# msg_ids  = tcl list of msg ids
+#
+
+set_form_variables
+
+set db_list [ns_db gethandle main 2]
+set db   [lindex $db_list 0]
+set db2   [lindex $db_list 1]
+
+set user_id [ad_get_user_id]
+
+ReturnHeaders
+ns_write "[ad_header "Ticket Report"]
+<h2>Ticket Report</h2>
+
+[ad_context_bar_ws_or_index [list "/ticket/index.tcl" "Ticket Tracker"]  "Report"]
+
+<hr>
+"
+
+set i 0
+
+foreach message_id $msg_ids {
+    set selection [ns_db 1row $db "select ticket_issues.*, ticket_priorities.name, 
+ ticket_projects.title as project_title, 
+ users.first_names,
+ users.last_name
+from ticket_issues, ticket_projects, ticket_priorities, users where
+users.user_id = ticket_issues.user_id 
+and ticket_issues.priority = ticket_priorities.priority
+and ticket_projects.project_id = ticket_issues.project_id
+and msg_id = $message_id"]
+
+    set_variables_after_query
+    set msg_id $message_id
+    set detail_list ""
+
+    set item_list_list { {"posting_time" "Creation Date:"} {"priority" "Priority:"} {"source" "Source:"} {"data1" ""} {"data2" ""} }
+
+    foreach item_list $item_list_list {
+	set variable [lindex $item_list 0]
+	set annotation [lindex $item_list 1]
+	if ![empty_string_p [set $variable]] {
+	    lappend detail_list "$annotation [set $variable]"
+	}
+    }
+
+    append page "<br><b><a href=\"/ticket/issue-view.tcl?[export_url_vars msg_id]\">\#$message_id [clean_up_html $one_line]</a></b><br>"
+
+    append page "Project: <b>$project_title</b> "
+   if {[string tolower $status] == "closed"} {
+       append page " <font color=green>Status: closed</font> "
+   } else {
+       append page " Status: $status "
+   }
+
+   append page [join $detail_list ", "]
+   if {$report_type == "msgs_and_responses"} {
+       append page "<br><blockquote>$message</blockquote>"
+       set responses ""
+
+       # show responses
+       set sub_selection [ns_db select $db2 "select 
+  response_id, public_p,
+  users.first_names || ' ' || users.last_name as name,
+  to_char(posting_time, [ticket_date_format]) as posting_date,
+  ticket_issue_responses.message as followup_text
+from ticket_issue_responses, users
+where ticket_issue_responses.user_id = users.user_id
+and ticket_issue_responses.response_to = $message_id
+order by posting_time"] 
+       
+       while { [ns_db getrow $db2 $sub_selection] } {
+	   set_variables_after_subquery
+	   set text "$followup_text <br><i>Submitted by $name on $posting_date</i>"
+	   lappend responses $text
+       }
+       
+       if { ![empty_string_p $responses] } {
+	   append page "<br>Comments
+<blockquote>
+[join $responses "<p>"]
+</blockquote>
+"
+       }
+   }
+   incr i
+}
+
+
+
+ns_write "
+$page
+[ad_footer]
+"
Index: web/openacs/www/ticket/issue-new-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/issue-new-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/issue-new-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,218 @@
+set_the_usual_form_variables
+
+# project_id, one_line, notify_p, message, priority
+#
+# contact_name, contact_info, source, ticket_type 
+# email
+#
+# and any defined picklist field names
+# 
+
+set url "[ns_conn location]/ticket"
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+set formdata [ns_set copy [ns_conn form]]
+
+if {[empty_string_p [set ColValue.deadline.month]] && [empty_string_p [set ColValue.deadline.day]]} {
+    ns_set update $formdata ColValue.deadline.year ""
+}
+
+if [catch {ns_dbformvalue $formdata deadline date deadline} error] {
+    ad_return_complaint 1 "<li>Error parsing the deadline date: $error
+<br>Please specify a month, day, and four digit year for the deadline.\n"
+    return
+}
+
+# check input
+set exception_text ""
+set exception_count 0
+
+set selection [ns_db 1row $db "select email, first_names, last_name from users where user_id = $user_id"]
+
+set_variables_after_query
+
+
+set name "$first_names $last_name"
+set QQemail [DoubleApos $email]
+set QQname [DoubleApos $name]
+
+if { ![info exists project_id] || $project_id == "" } {
+    incr exception_count
+    append exception_text "<li>You somehow got here without a project specified.\n"
+}
+
+if { ![info exists one_line] || $one_line == "" } {
+    incr exception_count
+    append exception_text "<li>You must enter a subject line.\n"
+}
+
+if { ![info exists notify_p] || $notify_p == "" } {
+    incr exception_count
+    append exception_text "<li>You somehow got here without specifying notification.\n"
+}
+
+if { ![info exists message] || $message == "" } {
+    incr exception_count
+    append exception_text "<li>You have to say something about the issue.\n"
+}
+
+
+if {[info exists preformat] && $preformat == "yes"} {
+    set message_in_html "<pre>
+[clean_up_html $message]
+</pre>
+" } else {
+    set message_in_html [bboard_convert_plaintext_to_html $message]
+}
+
+if [catch { set n_previous [database_to_tcl_string $db "select count(*) from ticket_issues
+where one_line = '$QQone_line'
+and project_id = $project_id
+and dbms_lob.instr(message,'[bboard_convert_plaintext_to_html $QQmessage]') > 0"]} errmsg] {
+    ns_log Notice "failed trying to look up previous posting: $errmsg"
+} else {
+    # lookup succeeded
+    if { $n_previous > 0 } {
+	incr exception_count
+	append exception_text "<li>There are already $n_previous messages in the database with the same subject line and body.  Perhaps you already posted this?  Here are the messages:
+<ul>
+"
+        set selection [ns_db select $db "select first_names || ' ' || last_name as name, email, posting_time
+from ticket_issues, users
+where one_line = '$QQone_line'
+and project_id = $project_id
+and dbms_lob.instr(message,'[DoubleApos $message]') > 0
+and ticket_issues.user_id = users.user_id"]
+
+        while {[ns_db getrow $db $selection]} {
+	    set_variables_after_query
+	    append exception_text "<li>$posting_time by $name ($email)\n"
+	}
+	append exception_text "</ul>
+If you are sure that you also want to add this issue, 
+back up and change at least one character in the subject 
+or message area, then resubmit."
+    }
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+ReturnHeaders
+
+set project_title [database_to_tcl_string $db "select title from ticket_projects where project_id = $project_id"]
+
+ns_write "[ad_header "Inserting a New Issue"]
+
+<h2>Inserting a New Issue</h2>
+
+[ad_context_bar_ws_or_index [list "/ticket/index.tcl" "Ticket Tracker"]  "Ticket Created"]
+"
+
+ns_write "<hr>\n"
+
+# Collect up the picklist field values
+set picklist_columns {}
+set picklist_values {}
+foreach entry [ticket_picklist_data] {
+    set field_name [ticket_picklist_entry_field_name $entry]
+    set column_name [ticket_picklist_entry_column_name $entry]
+    lappend picklist_columns $column_name
+    lappend picklist_values "'[DoubleApos [set $field_name]]'"
+}
+
+# Tickets default to "open" status when created.
+set status "open"
+
+# Find if there is a default assignee
+set default_assignee [database_to_tcl_string_or_null $db "select default_assignee from
+ticket_projects 
+where project_id=$project_id"]
+
+if {[llength $picklist_columns] > 0} {
+    set custom_values ", [join $picklist_values {,}]"
+    set custom_field_names ",  [join $picklist_columns {,}]"
+} else {
+    set custom_values ""
+    set custom_field_names ""
+}
+
+with_transaction $db {
+    set new_id [database_to_tcl_string $db "select ticket_issue_id_sequence.nextval from dual"]
+    set indexed_stuff "$one_line $message $email $name $new_id"
+
+    ns_ora clob_dml $db "insert into ticket_issues
+    (msg_id,project_id,user_id, one_line,message,indexed_stuff,posting_time,priority, severity, notify_p, deadline, contact_name, contact_email, contact_info1, source, status, ticket_type, public_p, last_modified_by $custom_field_names)
+    values ($new_id,$project_id,$user_id,'$QQone_line',empty_clob(),empty_clob(),sysdate,$priority,'$severity','$notify_p', '$deadline', '$QQcontact_name', '$QQcontact_email', '$QQcontact_info', '$source', '$status', '$ticket_type', '$public_p', '$QQemail' $custom_values) 
+ returning message, indexed_stuff into :1, :2" $message_in_html $indexed_stuff
+
+    if {[info exists default_assignee] && \
+	    ![empty_string_p $default_assignee]} {
+	ns_db dml $db "insert into ticket_issue_assignments (msg_id, user_id, active_p) VALUES  ($new_id, $default_assignee, 't')"
+    }
+} {
+    # something went a bit wrong during the insert
+    ns_write "<h3>Ouch!!</h3>
+Here was the bad news from the database:
+<pre>
+$errmsg
+</pre>
+[ad_footer]
+"
+    return
+}
+
+
+ns_write "<h3>Success!!</h3>
+A new issue for project 
+<a href=\"project-top.tcl?project_id=$project_id\">$project_title</a>
+has been entered in the database:
+
+<br>
+
+#$new_id: [clean_up_html $one_line]
+
+<p>
+
+You can:<br>
+<ul>
+<li><a href=\"issue-view.tcl?msg_id=$new_id\">View issue details and make assignments</a>
+<li><a href=\"issue-new.tcl\">Add another issue</a>
+<li><a href=\"project-top.tcl?[export_url_vars project_id]\">Go to project page $project_title</a>
+<li><a href=\"index.tcl?[export_url_vars project_id]\">Return to main page</a>
+</ul>
+"
+
+#send out the email
+
+set ticket_email [ticket_reply_email_addr]
+set extra_headers [ns_set create] 
+ns_set update $extra_headers "Reply-to" $ticket_email
+
+if { $notify_p == "t" } {
+
+    set selection [ns_db select $db "select
+email as notify_email
+from users, ticket_assignments
+where project_id = $project_id 
+and users.user_id = ticket_assignments.user_id
+"]
+
+    while { [ns_db getrow $db $selection] } { 
+	set_variables_after_query
+	ns_sendmail $notify_email $email "New issue $one_line in project $project_title (TR#$new_id)" "Priority: $priority 
+Submitted By: $name 
+Description: $message
+
+Please use $url/issue-view.tcl?msg_id=$new_id to manage this issue." $extra_headers
+        ns_write "<br> Emailed $notify_email"
+   }
+}
+ns_write "
+[ad_footer]
+"
Index: web/openacs/www/ticket/issue-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/issue-new.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/issue-new.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,129 @@
+set_form_variables 0
+# maybe project_id
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+set authorized_p [ticket_customers_can_create_new_tickets]
+
+# If the user is not in the ticket admin group, and the site
+# disallows random users to create tickets, give them an error.
+if {![ticket_user_admin_p $db] && ! $authorized_p} {
+ 	ad_return_error "User not authorized to perform this operation" "Sorry but you are not authorized to create new tickets on this system."
+    return
+}
+
+set default_assignee ""
+
+
+if {[info exists project_id]} {
+    set project_title [database_to_tcl_string $db "select title 
+    from ticket_projects
+    where project_id = $project_id"]
+    set project_title "for $project_title, "
+
+
+} else {
+    set project_title ""
+    set project_id ""
+}
+
+
+# Get list of default user info
+set selection [ns_db 1row $db "select email, users.first_names || ' ' || users.last_name as pretty_name
+ from users
+ where  users.user_id = $user_id"]
+
+set_variables_after_query
+
+ReturnHeaders
+
+# ticekts from public users default to a source of external
+set source "external"
+
+append page "[ad_header "Create New Issue"]
+
+<h2>Create new issue</h2>
+
+[ad_context_bar_ws_or_index [list "/ticket/index.tcl" "Ticket Tracker"]  "Create Ticket"]
+
+<hr>
+
+<blockquote>
+<form action=\"issue-new-2.tcl\" method=post>
+[export_form_vars email source]
+
+<table border=0>"
+
+
+append page "<tr><th align=left>Subject:<td><input type=text name=one_line size=50</tr>"
+
+append page "<tr>
+<th valign=top align=left>Ticket Type:</th><td><select name=ticket_type>[ticket_html_select_ticket_type]</select>
+&nbsp;&nbsp;&nbsp;<b>Public?</b>
+<input type=radio name=public_p value=t CHECKED> Yes
+<input type=radio name=public_p value=f> No
+</td></tr>"
+
+append page "
+<tr><th align=left>Project:
+    <td><select name=project_id>
+    [ad_db_optionlist $db  "select title,
+    project_id from ticket_projects
+    order by title asc" $project_id]
+    </select>
+    </td></tr>
+"
+
+append page "
+<tr><td align=left><b>Severity:</b><td>
+<select name=severity>
+[ad_generic_optionlist [ticket_severity_types] [ticket_severity_types] normal]
+</select></td></tr>
+"
+
+
+append page "<tr><th align=left>Deadline:</th><td>[ticket_dateentrywidget_with_nulls deadline [export_var deadline [database_to_tcl_string $db "select to_char(sysdate, 'yyyy') from dual"]]]</td></tr>
+
+"
+
+
+append page "<tr><th align=left>Priority:
+    <td><select name=priority>
+[ad_db_optionlist $db  "select name, priority from ticket_priorities order by priority" 2]
+</select></tr>
+"
+
+append page "
+<tr><th align=left>Contact Name:</th><td><input type=text name=contact_name size=50 [export_form_value pretty_name]></tr>
+<tr><th align=left>Contact Email:</th><td><input type=text name=contact_email size=50  [export_form_value email]></tr>
+
+<tr><th align=left>Contact Info:</th><td><textarea rows=3 cols=40 name=contact_info></textarea></tr>
+"
+
+foreach field [ticket_picklist_field_names] { 
+    append page "<tr>[ticket_picklist_html_fragment $field]</tr>\n"
+}
+
+append page "
+<tr><th valign=top  align=left>Notify Project Members<br>(via email)</th>
+    <td valign=top><input type=radio name=notify_p value=t CHECKED> Yes
+        <input type=radio name=notify_p value=f> No</tr>
+"
+
+
+
+append page "<tr><th align=left>Message<td></tr>
+</table>
+<textarea name=message rows=10 cols=64 wrap=hard></textarea>
+<br>
+<b>Preserve fixed formatting of message?</b> <input type=checkbox checked name=preformat value=yes>
+<br>
+<center><input type=submit value=Submit></center>
+</form>
+</blockquote>
+[ad_footer]
+"
+
+ns_write $page
Index: web/openacs/www/ticket/issue-response-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/issue-response-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/issue-response-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,45 @@
+set_the_usual_form_variables
+# msg_id, message
+
+set user_id [ad_get_user_id]
+set db [ticket_getdbhandle]
+
+set exception_text ""
+set exception_count 0
+
+if {[info exists preformat] && $preformat == "yes"} {
+    set message_in_html "<pre>
+[clean_up_html $message]
+</pre>
+" } else {
+    set preformat no
+    set message_in_html [bboard_convert_plaintext_to_html $message]
+}
+
+ReturnHeaders
+
+append page "[ad_header "Preview Add Response To Ticket"]
+
+<h2>Preview New Response For Ticket #$msg_id</h2>
+
+
+<hr>
+
+Below is how your response will appear in the list of ticket responses.
+If you approve, press the Submit button below, otherwise hit back in your
+browser and try again.
+<p>
+<blockquote>
+$message_in_html
+</blockquote>
+<form action=issue-response-3.tcl method=post>
+[export_form_vars msg_id message preformat]
+<center><input type=submit value=Submit>
+</center>
+</form>
+<p>
+[ad_footer]
+"
+
+
+ns_write $page
Index: web/openacs/www/ticket/issue-response-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/issue-response-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/issue-response-3.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,95 @@
+set_the_usual_form_variables
+# msg_id, message
+
+set user_id [ad_get_user_id]
+set db [ticket_getdbhandle]
+
+set exception_text ""
+set exception_count 0
+
+if {[info exists preformat] && $preformat == "yes"} {
+    set message_in_html "<pre>
+[clean_up_html $message]
+</pre>
+" } else {
+    set message_in_html [bboard_convert_plaintext_to_html $message]
+}
+
+
+
+
+if [catch { set n_previous [database_to_tcl_string $db "select count(*) 
+from ticket_issue_responses
+where response_to = $msg_id
+and user_id = $user_id
+and dbms_lob.instr(message,'[DoubleApos $message_in_html]') > 0"]} errmsg] {
+    ns_log Notice "failed trying to look up previous posting: $errmsg"
+} else {
+    # lookup succeeded
+    if { $n_previous > 0 } {
+	incr exception_count
+	append exception_text "<li>There are already $n_previous responses from you with the same body.
+Perhaps you already posted this?
+If you are sure that you also want to add this issue, 
+back up and change at least one character in the subject 
+or message area, then resubmit."
+    }
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# Default is for customer responses to be public, but staff responses
+# to be private
+
+if {![info exists public_p]} {
+    set public_p "f"
+}
+
+if {![info exists notify_creator_p]} {
+    set notify_creator_p "f"
+}
+
+
+
+set selection [ns_db 1row $db "select one_line, title, ticket_issues.project_id, notify_p
+from ticket_issues, ticket_projects
+where ticket_issues.project_id = ticket_projects.project_id
+and msg_id = $msg_id"]
+set_variables_after_query
+
+with_transaction $db {
+    set new_response_id [database_to_tcl_string $db "select ticket_response_id_sequence.nextval from dual"]
+    ns_ora clob_dml $db "insert into ticket_issue_responses (response_id,response_to,user_id, public_p, message,posting_time) values ($new_response_id,$msg_id,$user_id, '$public_p', empty_clob(),sysdate) returning message into :1" $message_in_html
+
+    ns_db dml $db "begin ticket_update_for_response($new_response_id); end;"
+
+} {
+    # something went a bit wrong during the insert
+    ns_return 200 text/html "[ad_header "Error Adding a Response"]
+<h3>Ouch!!</h3>
+<hr>
+We encountered a problem inserting your response.
+Here was the bad news from the database:
+<pre>
+$errmsg
+</pre>
+[ad_footer]
+"
+    return
+}
+
+
+
+#send out the email
+if { $notify_p == "t" } {
+    send_ticket_change_notification $db $msg_id $message $user_id $notify_creator_p
+}
+
+
+ns_returnredirect "issue-view.tcl?msg_id=$msg_id"
+
+
+
Index: web/openacs/www/ticket/issue-response.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/issue-response.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/issue-response.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,35 @@
+set_form_variables
+# msg_id
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+set selection [ns_db 1row $db "select one_line, ticket_issues.project_id, ticket_projects.title
+from ticket_issues, ticket_projects
+where msg_id = $msg_id
+and ticket_projects.project_id = ticket_issues.project_id"]
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "[ad_header "Write a Response"]
+<h2>Write a Response</h2>
+to <a href=\"issue-view.tcl?msg_id=$msg_id\">[clean_up_html $one_line]</a>
+for project <a href=\"project-top.tcl?project_id=$project_id\">$title</a>
+in <a href=\"index.tcl\">[ticket_system_name]</a>
+<hr>
+<form action=\"issue-response-2.tcl\" method=post>
+[export_form_vars msg_id]
+Enter message in textarea below, then click submit.<br>
+<textarea name=message rows=10 cols=50 wrap=physical></textarea>
+"
+
+ns_write "<p><input type=checkbox name=public_p value=t>Make this response publicly readable?
+<p><input type=checkbox name=notify_creator_p value=t>Send email notification to this ticket's creator?
+<p>
+ <input type=checkbox name=preformat value=yes> Preserve fixed text formatting?
+<P><center><input type=submit value=Submit></center>
+</form>
+[ad_footer]
+"
Index: web/openacs/www/ticket/issue-search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/issue-search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/issue-search.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,84 @@
+set_the_usual_form_variables
+# query_string, project_id (optional)
+#
+#
+# target - 
+# passthrough -  msg_id
+
+set db [ticket_getdbhandle]
+
+if { ![info exists query_string] || $query_string == "" } {
+    # probably using MSIE
+    ns_return 200 text/html "[ad_header "Missing Query"]
+<h2>Missing Query</h2>
+<hr>
+Either you didn't type a query string or you're using a quality Web
+browser like Microsoft Internet Explorer 3.x (which neglects to 
+pass user input up the server).
+[ad_footer]
+"
+    return
+}
+
+# we ask for all the top level messages
+
+ReturnHeaders
+
+ns_write "[ad_header "Search Results"]
+<h2>Messages matching \"$query_string\"</h2>
+in the <a href=\"index.tcl\">[ticket_system_name]</a>
+<hr>
+<ul>
+"
+
+if {[info exists project_id] && ![empty_string_p $project_id]} {
+    set restrict_by_project_id_clause "ticket_issues.project_id = $project_id and "
+} else {
+    set restrict_by_project_id_clause " "
+}
+
+set selection [ns_db select $db "select msg_id xmsg_id , one_line, ticket_issues.project_id, ticket_projects.title from 
+ticket_issues, ticket_projects 
+where ticket_projects.project_id = ticket_issues.project_id and
+$restrict_by_project_id_clause
+upper(dbms_lob.substr(indexed_stuff,4000)) like upper('%$query_string%')
+order by title, xmsg_id"]
+
+set counter 0
+
+set last_title ""
+ns_write "<ul>"
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+    if {$title != $last_title} {
+	ns_write "</ul><b>$title</b><ul>"
+    }
+    set last_title $title
+	ns_write "<li><a href=\"$target?[eval "export_url_vars $passthrough"]\">\[$xmsg_id\] [clean_up_html $one_line]</a>\n"
+}
+
+ns_write "</ul>"
+
+if { $counter == 0 } {
+    set search_items "messages"
+    ns_write "No matching items found.<p>
+    <a href=\"$target?[eval "export_url_vars $passthrough"]\">"
+}
+ns_write "
+</ul>
+[ad_footer]
+"
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/ticket/issue-view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/issue-view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/issue-view.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,294 @@
+# This page is for viewing an issue as a privileged user - 
+
+# Most data fields are modifiable
+
+set_the_usual_form_variables
+
+# msg_id
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+if {[ticket_user_admin_p $db]} {
+    ns_returnredirect "/ticket/admin/issue-view.tcl?[export_url_vars msg_id ]"
+    return
+}
+
+set selection [ns_db 0or1row $db "select 
+to_char(posting_time, [ticket_date_format]) as posting_date,
+deadline, one_line, message, priority, ticket_type,  email name, status
+from ticket_issues, users
+where msg_id = $msg_id
+and users.user_id = ticket_issues.user_id"]
+
+if { $selection == "" } {
+    # message was probably deleted
+    ad_return_complaint 1 "<li>Couldn't find message $msg_id.  Probably it was deleted by the forum maintainer."
+    return
+}
+
+set_variables_after_query
+set this_one_line $one_line
+
+
+set selection [ns_db 1row $db "select 
+ title, ticket_issues.project_id, notify_p, public_p,
+ ticket_issues.group_id  as ticket_group_id,
+ ticket_issues.last_modified_by, 
+ ticket_issues.severity, 
+ ticket_issues.data1, 
+ ticket_issues.data2, 
+ ticket_issues.data3, 
+ ticket_issues.data4, 
+ ticket_issues.data5, 
+ to_char(ticket_issues.modification_time, 'Month dd, yyyy hh24:mi:ss') as modification_time,
+ ticket_issues.contact_name,
+ ticket_issues.contact_email,  ticket_issues.contact_info1,
+ to_char(close_date, [ticket_date_format]) close_date,  ticket_priorities.name  as priority_name, ticket_priorities.priority
+from ticket_projects, ticket_issues, users, ticket_priorities
+where ticket_projects.project_id = ticket_issues.project_id
+and ticket_issues.msg_id = $msg_id
+and users.user_id(+) = closed_by
+and ticket_priorities.priority = ticket_issues.priority"]
+
+set_variables_after_query
+
+if {$public_p == "t"} {
+    set public_pretty "Yes"
+} else {
+    set public_pretty "No"
+}
+
+
+append group_select_menu "<select name=ticket_group>"
+
+
+# Get list of all user groups
+set selection [ns_db select $db "select distinct group_id as group_id_x, group_name 
+from user_groups"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    if {$group_id_x == $ticket_group_id} {
+	append group_select_menu "<option selected value=\"$group_id_x\">$group_name</option>"
+    } else {
+	append group_select_menu "<option value=\"$group_id_x\">$group_name</option>"	
+    }
+} 
+
+append group_select_menu "</select>"
+
+# get current user's email, to export as the "last modified by" value
+set email [database_to_tcl_string $db "select email from users where user_id=[ad_get_user_id]"]
+
+
+#if { [empty_string_p $deadline] } {
+#    set deadline [ns_localsqltimestamp]
+#}
+
+ReturnHeaders
+
+
+append page "[ad_header [clean_up_html $one_line]]
+
+<h2>Ticket #$msg_id</h2>
+
+[ad_context_bar_ws_or_index [list "/ticket/index.tcl" "Ticket Tracker"] [list "project-top.tcl?project_id=$project_id" $title] "One Ticket"]
+
+<hr>
+
+<h2>$ticket_type \#$msg_id: [clean_up_html $one_line]</h2>
+<blockquote>
+<table border=0><tr><td bgcolor=#f0f0f0>$message</td></tr></table>
+</blockquote>
+
+<blockquote>
+<table border=0 cellspacing=3>
+<tr>
+  <th valign=top align=left>Subject:</th>
+  <td>[clean_up_html $one_line]</td>
+<tr>
+<th valign=top align=left>Ticket Type:</th><td>$ticket_type</select>
+&nbsp;&nbsp;&nbsp;<b>Public?</b> $public_pretty
+
+</tr>"
+
+# Status
+append page "
+<tr><td align=left><b>Status:</b><td> $status
+</td></tr>
+"
+
+
+# Project
+append page "
+<tr><th align=left>Project:<td>
+$title
+</td></tr>"
+
+# Severity
+append page "<tr><td align=left><b>Severity:</b><td>"
+append page "
+ $severity</td></tr>
+"
+
+# Deadline
+append page "
+<tr><td align=left><b>Deadline:</b><td> $deadline
+</tr>"
+
+# Priority
+append page "<tr><td align=left><b>Priority:</b><td>
+$priority
+</tr>
+"
+
+append page "<tr><th align=left valign=top>Contact Name</th><td><pre>$contact_name</pre></td></tr>"
+
+append page "<tr><th align=left valign=top>Contact Email</th><td><pre>$contact_email</pre></td></tr>"
+
+append page "<tr><th align=left valign=top>Contact Info</th><td><pre>[clean_up_html $contact_info1]</pre></td></tr>"
+
+
+# Show customizable picklist fields
+foreach field [ticket_picklist_field_names] { 
+    set entry [ticket_picklist_field_info $field]
+    append page "<tr><th>[ticket_picklist_entry_pretty_name $entry]</th><td>[set [ticket_picklist_entry_column_name $entry]]</td></tr>\n"
+}
+
+append page "</td></tr>
+<tr><td align=left valign=top><b>Notify project<br>members via email:</b>
+"
+
+if {$notify_p == "t" } {
+    append page "<td valign=top>Yes</td></tr>\n"
+} else {
+    append page "<td valign=top>No</td></tr>\n"
+}
+
+append page "
+<tr><td align=left><b>Submitted By:</b><td>$name on $posting_date</tr>
+<tr><td align=left><b>Last Modified By:</b><td>$last_modified_by on $modification_time</tr></tr>
+"
+
+if { $close_date != "" } {
+    append page "<tr><td align=left><b>Closed On:</b><td>$close_date</tr>\n"
+}
+
+append page "
+
+</table>
+</blockquote>
+<p>
+"
+
+
+set selection [ns_db select $db "select 
+ response_id, public_p,
+ users.first_names || ' ' || users.last_name as name,
+ to_char(posting_time, [ticket_date_format]) as posting_date,
+ message
+from ticket_issue_responses, users
+where ticket_issue_responses.user_id = users.user_id
+and ticket_issue_responses.response_to = $msg_id
+order by posting_time"] 
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    set text "<blockquote>
+    $message
+    </blockquote>
+    Submitted by $name on $posting_date, "
+
+    if {$public_p == "t"} {
+	 append text "<i>Public?</i> Yes (<a href=\"set-response-visibility.tcl?response_id=$response_id&public_p=f&msg_id=$msg_id\">toggle</a>)"
+    } else {
+	append text  "<i>Public?</i> No (<a href=\"set-response-visibility.tcl?response_id=$response_id&public_p=t&msg_id=$msg_id\">toggle</a>)"
+    }
+
+    lappend responses $text
+
+}
+
+if { [info exists responses] } {
+    append page "<b>Comments</b>
+    [join $responses "<hr width=300>"]
+    "
+}
+
+append page "<ul>"
+
+
+
+append page "
+</ul>"
+
+# List xrefs
+append page "<b>Related Issues</b>
+<br>
+"
+set selection [ns_db select $db "select to_ticket, one_line as xone_line, msg_id as xmsg_id
+from ticket_xrefs, ticket_issues
+where  to_ticket = ticket_issues.msg_id and 
+from_ticket=$msg_id 
+union
+select to_ticket, one_line xone_line, msg_id xmsg_id
+from ticket_xrefs, ticket_issues
+where  from_ticket = ticket_issues.msg_id and 
+to_ticket=$msg_id 
+"]
+
+
+# target for subroutine pages to return to this page
+set target "issue-view.tcl"
+append page "<ul>"
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append page "<li><a href=\"issue-view.tcl?msg_id=$xmsg_id\">\[$xmsg_id\] $xone_line</a>&nbsp;&nbsp; <a href=\"unlink-xref.tcl?from_msg_id=$msg_id&to_msg_id=$xmsg_id&[export_url_vars target]\">(unlink)</a>"
+}
+
+append page "</ul>"
+
+# View change log
+append page "<p>
+<ul>
+<li><a href=issue-change-log.tcl?msg_id=$msg_id>View Change History</a>
+<li><a href=\"issue-new.tcl?project_id=$project_id\">Add a new issue.</a>
+</ul>
+
+
+<p>
+<b>Assignment</b>
+<table border=1 cellpadding=10>
+<tr>
+<th>Users assigned to this issue</th>
+</tr>
+<tr valign=top><td><ul>
+"
+
+# query for the users assigned to this issue already
+set selection [ns_db select $db "select first_names, last_name, users.user_id
+from users, ticket_issue_assignments 
+where users.user_id = ticket_issue_assignments.user_id 
+AND msg_id=$msg_id"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append page "<li> $first_names $last_name\n"
+}
+
+append page "
+</td>
+</tr>
+</table>
+"
+
+
+
+append page "[ad_footer]"
+
+ns_write $page
+
+
+
Index: web/openacs/www/ticket/list-issues.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/list-issues.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/list-issues.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,128 @@
+# List a set of tickets in a report 
+#
+# form vars:
+# report_type = "Ticket Summaries" "Complete Ticket Reports"
+# msg_ids  = semicolon separated list 
+# search_items 
+#
+
+set_form_variables
+
+set db_list [ns_db gethandle main 2]
+set db   [lindex $db_list 0]
+set db2   [lindex $db_list 1]
+
+set user_id [ad_get_user_id]
+
+ReturnHeaders
+ns_write "[ad_header $report_type]
+<h2>$report_type</h2>
+
+[ad_context_bar_ws_or_index [list "/ticket/index.tcl" "Ticket Tracker"]  "Report"]
+
+<hr>
+<ul>
+"
+
+foreach item $search_items {
+    ns_write "<li>$item
+"
+}
+ns_write "
+</ul>
+
+<br>
+
+"
+
+# get multiple values of cgi var 'msg_id'
+
+set msg_id_list {}
+set form [ns_getform] 
+set form_size [ns_set size $form]
+set form_counter_i 0
+while {$form_counter_i<$form_size} {
+    set varname [ns_set key $form $form_counter_i]
+    if {$varname == "msg_ids"} {
+	lappend msg_id_list [ns_set value $form $form_counter_i]
+    }
+    incr form_counter_i
+}
+
+
+
+set selection [ns_db select $db "select ticket_issues.*, ticket_priorities.name, 
+ticket_projects.title as project_title, 
+users.first_names,
+users.last_name
+from ticket_issues, ticket_projects, ticket_priorities, users where
+users.user_id = ticket_issues.user_id 
+and ticket_issues.priority = ticket_priorities.priority
+and ticket_projects.project_id = ticket_issues.project_id
+and msg_id in ([join $msg_id_list ","])"]
+
+
+set i 0
+set msgs_displayed_already [list]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { [lsearch $msgs_displayed_already msg_id] != -1 } {
+	continue
+    } else {
+	lappend msgs_displayed_already $msg_id
+    }
+    ns_log Notice [NsSettoTclString $selection]
+    set detail_list ""
+
+    set item_list_list { {"posting_time" "Creation Date:"} {"priority" "Priority:"} {"source" "Source:"} {"data1" ""} {"data2" ""} }
+
+    foreach item_list $item_list_list {
+	set variable [lindex $item_list 0]
+	set annotation [lindex $item_list 1]
+	if ![empty_string_p [set $variable]] {
+	    lappend detail_list "$annotation [set $variable]"
+	}
+    }
+    
+    ns_write "<br><b><a href=\"/ticket/issue-view.tcl?[export_url_vars msg_id]\">\#$msg_id [clean_up_html $one_line]</a></b><br>"
+   if {[string tolower $status] == "closed"} {
+       ns_write " <font color=green>Status: closed</font> "
+   } else {
+       ns_write " Status: $status "
+   }
+   ns_write [join $detail_list " ; "]
+   if {$report_type == "Complete Ticket Reports"} {
+       ns_write "<br><b>Content:</b><blockquote>$message</blockquote>"
+       set responses ""
+
+       # show responses
+       set sub_selection [ns_db select $db2 "select 
+       response_id, public_p,
+       users.first_names || ' ' || users.last_name as name,
+       to_char(posting_time, [ticket_date_format]) as posting_date,
+       ticket_issue_responses.message as followup_text
+       from ticket_issue_responses, users
+       where ticket_issue_responses.user_id = users.user_id
+       and ticket_issue_responses.response_to = $msg_id
+       order by posting_time"] 
+       
+       while { [ns_db getrow $db2 $sub_selection] } {
+	   set_variables_after_subquery
+	   set text "$followup_text <br>
+	   <i>Submitted by $name on $posting_date</i>"
+	   lappend responses $text
+       }
+       
+       if { [info exists responses] } {
+	   ns_write "<br><b>Comments</b>
+	   <blockquote>
+	   [join $responses "<p>"]
+	   </blockquote>
+	   "
+       }
+   }
+   incr i
+}
+
+
Index: web/openacs/www/ticket/project-manage.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/project-manage.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/project-manage.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,30 @@
+# present list of projects, which can be viewed, deleted
+
+set db [ticket_getdbhandle]
+
+
+ReturnHeaders
+
+ns_write "[ad_header "Manage Projects"]
+<h2>Manage Projects</h2>
+"
+ns_write "[ad_context_bar_ws_or_index  [list "/ticket/index.tcl" "Ticket Tracker"]  "Manage Projects"]
+<hr>"
+
+set selection [ns_db select $db "select project_id, title
+from ticket_projects order by title"]
+
+ns_write "<ul>"
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    ns_write "<li> <a href=project-top.tcl?project_id=$project_id>$title</a> &nbsp;&nbsp;<a href=project-delete.tcl?project_id=$project_id>delete</a>"
+    ns_write "\n"
+}
+
+ns_write "</ul>"
+
+
+ns_write "
+[ad_footer]
+"
Index: web/openacs/www/ticket/project-summary.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/project-summary.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/project-summary.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,99 @@
+# Summarize projects status
+#
+
+set db [ns_db gethandle]
+
+ReturnHeaders
+ns_write "[ad_header "Project Status"]
+<h2>Project Status Summary</h2>
+
+[ad_context_bar_ws_or_index [list "/ticket/index.tcl" "Ticket Tracker"]  "Project Summaries"]
+
+<hr>
+
+<blockquote>
+<table border=0>
+<tr>
+<th>Title</th>
+<th>Assigned</th>
+<th>Total </th>
+<th>Active</th>
+<th>Closed</th>
+<th>Deferred</th>
+<th>Last Mod</th>
+<th>Oldest Active</th>
+<th>Pri=High</th>
+<th>Sev=Block</th>
+</tr>
+"
+
+set i 0
+
+set selection [ns_db select $db "
+select 
+  tp.project_id, 
+  tp.title, 
+  count(msg_id) as total,
+  sum(decode(status,'closed',1,0)) as closed,
+  sum(decode(status,'closed',0,'deferred',0,NULL,0,1)) as open,
+  sum(decode(status,'deferred',1,0)) as deferred,
+  max(modification_time) as lastmod,
+  min(posting_time) as oldest,
+  sum(ticket_one_if_high_priority(priority, status)) as high_pri,
+  sum(ticket_one_if_blocker(severity, status)) as blocker,
+  min(users.email) as assigned
+from ticket_projects tp, ticket_issues ti, users
+where tp.project_id = ti.project_id(+)
+and tp.default_assignee = users.user_id(+)
+group by tp.project_id, tp.title
+order by upper(title)
+"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    # show summaries of ticket stats
+    # total #
+    # open
+    # closed
+    # deferred
+    # last modified (max)
+    # 
+
+    if {($i % 2) == 0} {
+	set bgcolor "bgcolor=\#ECECEC"
+    } else {
+	set bgcolor ""
+    }
+
+
+    regsub "@.*" $assigned "" assigned
+
+    ns_write "
+<tr>
+  <td $bgcolor><a href=\"project-top.tcl?project_id=$project_id\">$title
+  <td $bgcolor align=left>$assigned&nbsp;
+  <td $bgcolor align=right>[blank_zero $total]&nbsp;
+  <td $bgcolor align=right>[blank_zero $open]&nbsp;
+  <td $bgcolor align=right>[blank_zero $closed]&nbsp;
+  <td $bgcolor align=right>[blank_zero $deferred]&nbsp;
+  <td $bgcolor align=right nowrap>$lastmod&nbsp;
+  <td $bgcolor align=right nowrap>$oldest&nbsp;
+  <td $bgcolor align=right>[blank_zero $high_pri]&nbsp;
+  <td $bgcolor align=right>[blank_zero $blocker]&nbsp;
+</tr>
+"
+   incr i
+}
+
+ns_write "</table>
+</blockquote>
+
+<ul>
+
+<li><a href=\"project-new.tcl\">add a new project</a>
+
+</ul>
+
+[ad_footer]
+"
Index: web/openacs/www/ticket/project-top.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/project-top.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/project-top.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,336 @@
+# View tickets in project
+#
+# project-top.tcl  by hqm@arsdigita.com June 1999
+#
+# form vars:
+
+set_form_variables
+# form vars:
+# project_id
+# 
+# (these are all optional args which have defaults)
+#
+# filter conditions
+#
+# Assignments:
+# view_assignment    { user unassigned all }
+
+# Status
+# view_status  { open closed deferred created_by_you }
+#
+# Creation time
+# view_created { last_24 last_week last_month all}
+#
+#
+# order_by       column name to sort table by 
+
+set ctrlvars {view_assignment view_status view_created project_id}
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+if {[ticket_user_admin_p $db]} {
+    ns_returnredirect "/ticket/admin/project-top.tcl?[export_url_vars project_id]"
+    return
+}
+
+
+ReturnHeaders
+
+set page_title "[database_to_tcl_string $db "select title
+from ticket_projects where project_id = $project_id"] Tickets"
+set navbar "[ad_context_bar_ws_or_index [list "/ticket/index.tcl" "Ticket Tracker"]  "One Project"]"
+
+append page "[ad_header $page_title]
+
+<h2>$page_title</h2>
+
+$navbar
+
+<hr>
+"
+
+# List of form vars used to select tickets to display
+
+# Assignment filter conditions
+#
+
+if {![info exists view_assignment]} {
+    # default to show issues assigned to $user_id
+    set view_assignment all
+}
+
+# default to only your own assigned issues
+if {![info exists view_status]} {
+    set view_status open
+}
+
+# default to all time
+if {![info exists view_created]} {
+    set view_created all
+}
+
+
+switch $view_assignment {
+    "user" { 
+	set assignment_filter "and (exists (select msg_id from ticket_issue_assignments 
+where ticket_issue_assignments.msg_id = ticket_issues.msg_id
+and ticket_issue_assignments.user_id = $user_id)) " }
+
+     "all" { set assignment_filter "" }
+}
+
+switch $view_status {
+    "open" {set status_filter "and ((status <> 'closed') and (status <> 'deferred')) " }
+    "deferred" {set status_filter "and ((status <> 'closed') or (status = 'deferred')) " }
+    "closed" {set status_filter "" } # shows everything
+}
+
+switch $view_created {
+   "last_24"   { set date_filter "and (posting_time > (sysdate - 1))" } 
+   "last_week" { set date_filter "and (posting_time > (sysdate - 7)) " } 
+   "last_month" { set date_filter "and (posting_time > (sysdate - 30)) " }
+   "all" { set date_filter "" }
+}
+
+# Sort order of tickets by
+if {![info exists order_by]} {
+    set order_by "ticket_issues.msg_id"
+} elseif {[string match "project*" $order_by]} {
+    set order_by "project_title"
+}
+
+
+################################################################
+# GUI ticket filter controls
+
+# List of all the state vars we need to pass through these toggle switches
+set filter_vars {view_assignment view_status view_created order_by project_id}
+
+
+append page "<table border=0 cellspacing=0 cellpadding=0 width=100%>
+<tr><th bgcolor=#ECECEC>Ticket Assignment</th>
+<th bgcolor=#ECECEC>Status</th>
+<th bgcolor=#ECECEC>Creation Time</th></tr>"
+
+
+#### Assignment flags
+# Show assigned to you 
+append page "<tr><td align=center>\["
+
+append page [ticket_control_vars view_assignment user $filter_vars "mine" "project-top.tcl"]
+append page " | "
+# Show all tickets 
+append page [ticket_control_vars view_assignment all $filter_vars "everyone's" "project-top.tcl"]
+
+#### Status flags
+append page "\]</td>\n<td align=center>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;\["
+
+# Show open issues
+append page [ticket_control_vars view_status open $filter_vars "active" "project-top.tcl"]
+append page " | "
+# Show deferred issues
+append page [ticket_control_vars view_status deferred $filter_vars "+deferred" "project-top.tcl"]
+append page " | "
+# Show closed issues
+append page [ticket_control_vars view_status closed $filter_vars "+closed" "project-top.tcl"]
+
+
+#### Creation time filter
+append page "\]&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</td>\n<td align=center>\["
+
+append page [ticket_control_vars view_created last_24 $filter_vars "last 24 hrs" "project-top.tcl"]
+append page " | "
+append page [ticket_control_vars view_created last_week $filter_vars "last week" "project-top.tcl"]
+append page " | "
+append page [ticket_control_vars view_created last_month $filter_vars "last month" "project-top.tcl"]
+append page " | "
+append page [ticket_control_vars view_created all $filter_vars "all" "project-top.tcl"]
+
+append page "\]</td></tr></table><p>"
+
+################################################################
+
+
+
+set last_priority "starting"
+
+set count 0
+
+append page "<table border=0>
+<tr>
+<th align=left><a href=\"project-top.tcl?order_by=[toggle_order ticket_issues.msg_id $order_by]&[eval export_url_vars $ctrlvars]\">ID#</a></th>
+<th align=left><a href=\"project-top.tcl?order_by=[toggle_order priority $order_by]&[eval export_url_vars $ctrlvars]\">Pri</a></th>
+<th align=left><a href=\"project-top.tcl?order_by=[toggle_order ticket_type $order_by]&[eval export_url_vars $ctrlvars]\">Typ</a></th>
+<th align=left><a href=\"project-top.tcl?order_by=[toggle_order email $order_by]&[eval export_url_vars $ctrlvars]\">Creator</a></th>
+<th align=left><a href=\"project-top.tcl?order_by=[toggle_order status $order_by]&[eval export_url_vars $ctrlvars]\">Stat</a></th>
+<th align=left><a href=\"project-top.tcl?order_by=[toggle_order severity $order_by]&[eval export_url_vars $ctrlvars]\">Sever</a></th>
+<th align=left><a href=\"project-top.tcl?order_by=[toggle_order posting_time $order_by]&[eval export_url_vars $ctrlvars]\">Creat</a></th>
+<th align=left><a href=\"project-top.tcl?order_by=[toggle_order modification_time $order_by]&[eval export_url_vars $ctrlvars]\">Mod</a></th>
+<th align=left><a href=\"project-top.tcl?order_by=[toggle_order assigned_p $order_by]&[eval export_url_vars $ctrlvars]\">Asgn</a></th>"
+
+if { $view_status == "closed" } {
+    append page "<th align=left><a href=\"project-top.tcl?order_by=[toggle_order close_date $order_by]&[eval export_url_vars $ctrlvars]\">Closed</a></th>"
+} else {
+    append page "<th align=left><a href=\"project-top.tcl?order_by=[toggle_order deadline $order_by]&[eval export_url_vars $ctrlvars]\">Deadline</a></th>"
+}
+
+append page "<th align=left><a href=\"project-top.tcl?order_by=[toggle_order one_line $order_by]&[eval export_url_vars $ctrlvars]\">Subject</a></th>
+"
+
+append page "</tr>\n"
+
+set last_project_title ""
+
+set query "select 
+ ticket_issues.msg_id,
+ ticket_issues.ticket_type, 
+ ticket_issues.one_line,
+ ticket_issues.status,
+ ticket_issues.severity,
+ ticket_issues.posting_time,
+ users.email,
+ assigned_users.email as assigned_user_email,
+ ticket_projects.title as project_title,
+ ticket_projects.project_id,
+ ticket_issues.priority, 
+ to_char(ticket_issues.modification_time, 'mm/dd/yy') as modification_time,
+ to_char(ticket_issues.posting_time, 'mm/dd/yy') as creation_time,
+ to_char(ticket_issues.close_date, 'mm/dd/yy') as close_date,
+ to_char(ticket_issues.deadline, 'mm/dd/yy') as deadline,
+ to_char(sysdate - deadline) as pastdue,
+ ticket_issue_assignments.active_p as assigned_p,
+ ticket_issue_assignments.user_id as assigned_user_id,
+ ticket_issues.public_p,
+ ticket_priorities.name as priority_name
+from ticket_issues, ticket_priorities, ticket_projects, users, ticket_issue_assignments, users assigned_users
+where ticket_priorities.priority = ticket_issues.priority
+and users.user_id = ticket_issues.user_id
+and ticket_projects.project_id = ticket_issues.project_id
+and ticket_issues.msg_id = ticket_issue_assignments.msg_id(+)
+and ticket_issue_assignments.user_id = assigned_users.user_id(+)
+and ticket_issues.project_id = $project_id
+$assignment_filter
+$status_filter
+$date_filter
+order by $order_by, ticket_issues.priority, ticket_issues.posting_time"
+
+set selection [ns_db select $db $query]
+set last_msg_id ""
+set msg_ids {}
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    set cols {}
+
+    if {$msg_id == $last_msg_id} {
+	set assign $assigned_user_email
+	regsub "@.*" $assign "" assign
+	set cols [list "" "" "" "" "" "" "" "" "$assign" "" ""]
+	
+    } else {
+	set last_msg_id $msg_id
+	lappend msg_ids $msg_id
+	
+	lappend cols "<a href=\"issue-view.tcl?msg_id=$msg_id\">$msg_id</a>"
+	lappend cols "P$priority"
+	lappend cols "[string range $ticket_type 0 5]"
+	regsub "@.*" $email "" email
+	lappend cols "$email"
+	if { [string compare $status "fixed waiting approval"] == 0 } {
+	    lappend cols "<font color=#00ff00>(w approv)</font>"
+	} elseif { [string compare $status "need clarification"] == 0 } {
+	    lappend cols "<font color=#ff0000>nd clar</font>"
+	} else {
+	    lappend cols $status
+	}
+	lappend cols "$severity"
+	lappend cols "$creation_time"
+	lappend cols "$modification_time"
+	
+	if {$assigned_p == "t"} {
+	    set assign $assigned_user_email
+	    regsub "@.*" $assign "" assign
+	    lappend cols "$assign"
+	} else {
+	    lappend cols ""
+	}
+	
+	if {[info exists closed] && $view_closed == 1} {
+	    lappend cols "$close_date" 
+	} else {
+	    if {$pastdue > 0} {
+		lappend cols "<font color=red>$deadline</font>"
+	    } else {
+		lappend cols "$deadline"
+	    }
+	}
+	
+	lappend cols "<a href=\"issue-view.tcl?msg_id=$msg_id\">[clean_up_html $one_line]</a>"
+	
+	
+	incr count
+	if {($count % 2) == 0} {
+	    set bgcolor "bgcolor=\#ECECEC"
+	} else {
+	    set bgcolor ""
+	}
+	
+    }
+    append page "<tr $bgcolor>"
+    foreach col $cols {
+	append page "<td>$col&nbsp;</td>\n"
+    }
+    append page "</tr>"    
+}
+
+if { $count == 0 } {
+    append page "<tr><td colspan=10 align=center>-- No issues --</td></tr>"   
+}
+
+append page "</table>\n<p>"
+
+append page "<ul>
+<li><a href=\"issue-details.tcl?[export_url_vars msg_ids]&report_type=msgs_and_responses\">View issues above as report</a>
+<p>
+<li><a href=\"issue-new.tcl?project_id=$project_id\">Add a new issue.</a><p>
+"
+
+append page "</ul>"
+
+# Look up owner of project
+set selection [ns_db 1row $db  "select ticket_projects.*, 
+users.first_names || ' ' || users.last_name as name from 
+ticket_projects, users
+where project_id=$project_id AND 
+users.user_id=ticket_projects.customer_id
+"]
+
+set_variables_after_query
+
+
+append page "
+<H3>Project Information</H3>
+
+<blockquote>
+<table cellpadding=3>
+<tr><th align=left>Project Owner</td><td>$name</td></tr>
+<tr><th align=left>Project Title</td><td>$title</td></tr>
+<tr><th align=left>Start Date</td><td>[util_AnsiDatetoPrettyDate $start_date]</td></tr>
+<tr><th align=left>End Date</td><td>$end_date
+"
+
+if {![empty_string_p $end_date]} {
+    append page "<a href=\"project-reopen.tcl?project_id=$project_id\"> (reopen)</a>"
+}
+
+
+
+append page "</td></tr>
+</table>
+</blockquote>
+<p>
+[ad_footer]
+"
+ns_write $page
\ No newline at end of file
Index: web/openacs/www/ticket/project-view-assignments.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/project-view-assignments.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/project-view-assignments.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,148 @@
+# View assigned tickets, by user
+#
+# project-view-assignments.tcl by hqm@arsdigita.com June 1999
+# 
+set_form_variables 0
+
+# form vars:
+# 
+# filter conditions
+#
+# project_id (blank for all projects)
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+ReturnHeaders
+
+ns_write "[ad_header "[ticket_system_name] View Ticket Assignments"]
+
+<h2>[ticket_system_name]</h2>
+
+[ad_context_bar_ws_or_index  [list "/ticket/index.tcl" "Ticket Tracker"] "View Assignments"]
+
+<hr>
+"
+
+
+if {[info exists project_id] && ![empty_string_p $project_id]} {
+    set project_filter "and ticket_issues.project_id = $project_id "
+} else {
+    set project_filter ""
+}
+
+
+
+set query "select 
+ ticket_issues.msg_id,
+ ticket_issues.ticket_type, 
+ ticket_issues.one_line,
+ ticket_issues.status,
+ ticket_issues.severity,
+ ticket_issues.posting_time,
+ users.email as assignee_email,
+ ticket_projects.title as project_title,
+ ticket_projects.project_id,
+ ticket_issues.priority, 
+ to_char(ticket_issues.modification_time, 'mm/dd/yy') as modification_time,
+ to_char(ticket_issues.posting_time, 'mm/dd/yy') as creation_time,
+ to_char(ticket_issues.close_date, 'mm/dd/yy') as close_date,
+ to_char(ticket_issues.deadline, 'mm/dd/yy') as deadline,
+ to_char(sysdate - deadline) as pastdue,
+ ticket_issue_assignments.user_id as assignee_user_id,
+ ticket_issues.public_p,
+ ticket_priorities.name as priority_name
+ from ticket_issues, ticket_priorities, ticket_projects, users, ticket_issue_assignments
+ where ticket_priorities.priority = ticket_issues.priority
+ and users.user_id = ticket_issue_assignments.user_id
+ and ticket_projects.project_id = ticket_issues.project_id
+ and ticket_issues.msg_id = ticket_issue_assignments.msg_id
+ and ticket_issues.status <> 'closed'
+ $project_filter
+ order by assignee_user_id, project_title, msg_id
+"
+
+set selection [ns_db select $db $query]
+
+set results ""
+append results "<table border=0>
+<tr><th align=left>User</th>
+<th align=left>ID#</th>
+<th align=left>Pri</th>
+<th align=left>Typ</th>
+<th align=left>Stat</th>
+<th align=left>Sever</th>
+<th align=left>Creat</th>
+<th align=left>Mod</th>
+<th align=left>Synopsis</th>
+<th align=left>Project</th>
+</tr>
+"
+
+set count 0
+set last_email ""
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if {$last_email != $assignee_email} {
+	append results "<tr><td colspan=10 bgcolor=#cccccc>&nbsp;</tr>"
+    }
+    set cols {}
+    regsub "@.*" $assignee_email "" aemail
+
+    # only print  user email when it changes
+    if {$last_email != $assignee_email} {
+	lappend cols $aemail
+    } else {
+	lappend cols ""
+    }
+    set last_email $assignee_email
+
+    lappend cols "<a href=\"issue-view.tcl?msg_id=$msg_id\">$msg_id</a>"
+    lappend cols "P$priority"
+    lappend cols "[string range $ticket_type 0 3]"
+    if { [string compare $status "fixed waiting approval"] == 0 } {
+	lappend cols "<font color=#00ff00>(w approv)</font>"
+    } elseif { [string compare $status "need clarification"] == 0 } {
+	lappend cols "<font color=#ff0000>nd clar</font>"
+    } else {
+	lappend cols $status
+    }
+    lappend cols "$severity"
+    lappend cols "$creation_time"
+    lappend cols "$modification_time"
+    
+    lappend cols "<a href=\"issue-view.tcl?msg_id=$msg_id\">[clean_up_html $one_line]</a>"
+
+    # show project title if we are not sorting by project
+    lappend cols "<a href=project-top.tcl?project_id=$project_id>[string range $project_title 0 12]</a>"	
+    
+    incr count
+    if {($count % 2) == 0} {
+	set bgcolor "bgcolor=\#ECECEC"
+    } else {
+	set bgcolor ""
+    }
+    
+    append results "<tr $bgcolor>"
+    foreach col $cols {
+	append results "<td>$col&nbsp;</td>\n"
+    }
+    append results "</tr>"    
+}
+
+if { $count == 0 } {
+    append results "<tr><td colspan=10 align=center>-- No issues --</td></tr>"   
+}
+
+append results "</table>\n<p>"
+
+
+append results  "
+<ul>
+<li><a href=\"issue-new.tcl\">add a new issue</a>
+</ul>"
+
+append results "[ad_footer]"
+ns_write $results
Index: web/openacs/www/ticket/project-view-issues.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/project-view-issues.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/project-view-issues.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,212 @@
+set_form_variables 0
+
+# optional: closed, assigned_to, created_by, unassigned, project_id, order_by deferred
+
+# assigned_to and created_by can be user IDs to filter by.
+# By default, only non-closed issues are shown; closed indicates
+# that closed issues should also be shown.
+
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+set where_clause_list [list "ticket_priorities.priority = ticket_issues.priority"]
+
+if { [info exists closed] && $closed == 1 } {
+    set view "All Issues"
+} else {
+    lappend where_clause_list "close_date is null"
+    set view "Open Issues"
+    set closed 0
+}
+
+if {[info exists deferred] && $deferred == 1} {
+    # 
+} else {
+    lappend where_clause_list "status <> 'deferred'"
+    set deferred 0
+}
+
+if { [info exists created_by] } {
+    lappend where_clause_list "ticket_issues.user_id = $user_id"
+    append view " created by you"
+}
+
+
+if { [info exists project_id] && $project_id != "" } {
+    lappend where_clause_list "ticket_issues.project_id = $project_id"
+    set project_title [database_to_tcl_string $db "select title
+from ticket_projects where project_id = $project_id"]
+    append title " in project $project_title"
+} else {
+   set project_title "View All Projects"
+}
+
+ReturnHeaders
+
+ns_write "[ad_header $project_title]
+<h2>$project_title</h2>"
+
+ns_write "[ad_context_bar_ws_or_index [list "/ticket/index.tcl" "Ticket Tracker"] $project_title]"
+
+
+ns_write "
+<hr>
+"
+
+if {![info exists order_by]} {
+    set order_by "msg_id"
+}
+
+if {[string match "project*" $order_by]} {
+    set order_by "project_title"
+}
+
+
+set selection [ns_db select $db "select 
+ticket_issues.msg_id,
+ticket_issues.ticket_type, 
+ticket_issues.one_line,
+ticket_issues.status,
+ticket_issues.severity,
+users.email,
+ticket_projects.title as project_title,
+ticket_projects.project_id,
+ticket_issues.priority, 
+to_char(ticket_issues.modification_time, 'mm/dd/yy') as modification_time,
+to_char(ticket_issues.posting_time, 'mm/dd/yy') as creation_time,
+to_char(ticket_issues.close_date, 'mm/dd/yy') as close_date,
+to_char(ticket_issues.deadline, 'mm/dd/yy') as deadline,
+to_char(sysdate - deadline) as pastdue,
+ticket_issues.public_p,
+ticket_priorities.name as priority_name 
+from ticket_issues, ticket_priorities, ticket_projects, users
+where [join $where_clause_list " and "]
+and users.user_id = ticket_issues.user_id
+and ticket_projects.project_id = ticket_issues.project_id
+order by $order_by, ticket_priorities.priority, posting_time"]
+
+set last_priority "starting"
+
+set count 0
+
+ns_write "<table border=0>
+<tr>
+<th align=left><a href=\"project-view-issues.tcl?order_by=[toggle_order msg_id $order_by]&[export_url_vars project_id closed deferred]\">ID#</a></th>
+<th align=left><a href=\"project-view-issues.tcl?order_by=[toggle_order priority $order_by]&[export_url_vars project_id closed deferred]\">Pri</a></th>
+<th align=left><a href=\"project-view-issues.tcl?order_by=[toggle_order ticket_type $order_by]&[export_url_vars project_id closed deferred]\">Typ</a></th>
+<th align=left><a href=\"project-view-issues.tcl?order_by=[toggle_order email $order_by]&[export_url_vars project_id closed deferred]\">Owner</a></th>
+<th align=left><a href=\"project-view-issues.tcl?order_by=[toggle_order status $order_by]&[export_url_vars project_id closed deferred]\">Stat</a></th>
+<th align=left><a href=\"project-view-issues.tcl?order_by=[toggle_order severity $order_by]&[export_url_vars project_id closed deferred]\">Sever</a></th>
+<th align=left><a href=\"project-view-issues.tcl?order_by=[toggle_order posting_time $order_by]&[export_url_vars project_id closed deferred]\">Creat</a></th>
+<th align=left><a href=\"project-view-issues.tcl?order_by=[toggle_order modification_time $order_by]&[export_url_vars project_id closed deferred]\">Mod</a></th>
+"
+
+if {[info exists closed] &&  $closed == 1} {
+    ns_write "<th align=left><a href=\"project-view-issues.tcl?order_by=[toggle_order close_date $order_by]&[export_url_vars project_id closed deferred]\">Closed</a></th>"
+} else {
+    ns_write "<th align=left><a href=\"project-view-issues.tcl?order_by=[toggle_order deadline $order_by]&[export_url_vars project_id closed deferred]\">Deadline</a></th>"
+}
+
+ns_write "<th align=left><a href=\"project-view-issues.tcl?order_by=[toggle_order one_line $order_by]&[export_url_vars project_id closed deferred]\">Synopsis</a></th>
+"
+if {![string match "project_title" $order_by]} {
+    ns_write "<th align=left><a href=\"project-view-issues.tcl?order_by=[toggle_order project_id $order_by]&[export_url_vars project_id closed deferred]\">Project</a></th>
+"    
+}
+ns_write "</tr>\n"
+
+set last_project_title ""
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    set cols {}
+    lappend cols "<a href=\"issue-view.tcl?msg_id=$msg_id\">$msg_id</a>"
+    lappend cols "P$priority"
+    lappend cols "[string range $ticket_type 0 3]"
+    regsub "@.*" $email "" email
+    lappend cols "$email"
+    if { [string compare $status "fixed waiting approval"] == 0 } {
+	lappend cols "<font color=#00ff00>(w approv)</font>"
+    } elseif { [string compare $status "need clarification"] == 0 } {
+	lappend cols "<font color=#ff0000>nd clar</font>"
+    } else {
+	lappend cols $status
+    }
+    lappend cols "$severity"
+    lappend cols "$creation_time"
+    lappend cols "$modification_time"
+
+    if {[info exists closed] && $closed == 1} {
+	lappend cols "$close_date" 
+    } else {
+	if {$pastdue > 0} {
+	    lappend cols "<font color=red>$deadline</font>"
+	} else {
+	    lappend cols "$deadline"
+	}
+    }
+
+    lappend cols "<a href=\"issue-view.tcl?msg_id=$msg_id\">[clean_up_html $one_line]</a>"
+
+    # show project title if we are not sorting by project
+    if {![string match "project_title" $order_by]} {
+	lappend cols "<a href=project-top.tcl?project_id=$project_id>[string range $project_title 0 12]</a>"	
+    }
+
+    if {[string match "project_title" $order_by] && $last_project_title != $project_title} {
+	ns_write "<tr><th colspan=10 align=left><a href=project-top.tcl?project_id=$project_id>$project_title</a></th></tr>\n"
+	set last_project_title $project_title
+    }
+
+    incr count
+    if {($count % 2) == 0} {
+	set bgcolor "bgcolor=\#ECECEC"
+    } else {
+	set bgcolor ""
+    }
+
+    ns_write "<tr $bgcolor>"
+    foreach col $cols {
+	ns_write "<td>$col&nbsp;</td>\n"
+    }
+    ns_write "</tr>"    
+}
+
+if { $count == 0 } {
+    ns_write "<tr><td colspan=10 align=center>-- No issues --</td></tr>"   
+}  else { 
+    ns_write "<tr><td colspan=10>$count issues found</td></tr>"
+}
+
+ns_write "</table>\n<p>"
+
+
+
+if { $closed == 0 } {
+    ns_write "<a href=\"project-view-issues.tcl?[export_url_vars assigned_to created_by unassigned deferred order_by]&closed=1\">view closed issues as well</a> 
+"
+} else {
+    ns_write "<a href=\"project-view-issues.tcl?[export_url_vars assigned_to created_by unassigned deferred order_by]\">view open issues</a>
+"
+}
+
+if { $deferred == 0 } {
+    ns_write "<br><a href=\"project-view-issues.tcl?[export_url_vars assigned_to created_by unassigned closed order_by]&deferred=1\">view deferred issues as well</a> 
+"
+} else {
+    ns_write "<br><a href=\"project-view-issues.tcl?[export_url_vars assigned_to created_by unassigned order_by]\">view only open issues</a>
+    "}
+
+
+set count 0
+
+ns_write "<p>"
+
+if {[info exists project_id]} {
+    ns_write "<A HREF=\"issue-new.tcl?project_id=$project_id\">add a new issue</a>"
+} else {
+    ns_write "<A HREF=\"issue-new.tcl\">add a new issue</a>"
+}
+
+ns_write "[ad_footer]"
Index: web/openacs/www/ticket/projects-all.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/projects-all.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/projects-all.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,26 @@
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+ReturnHeaders
+
+ns_write "[ad_header "All Projects"]
+<h2>All Projects</h2>
+in <a href=\"../index.tcl\">[ticket_system_name]</a>.
+<hr><p>
+
+<ul>
+<li> <A href=\"project-new.tcl\">New Project</a>
+<p>
+"
+
+set selection [ns_db select $db "select * from ticket_projects"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    ns_write  "<li> <A href=\"project-top.tcl?project_id=$project_id\">$title</a>\n"
+}
+
+ns_write "</ul>
+
+[ad_footer]"
Index: web/openacs/www/ticket/ticket-search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/ticket-search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/ticket-search.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,165 @@
+set_the_usual_form_variables
+
+set db [ns_db gethandle]
+
+# creator_fname, creator_lname
+# contact_fname, contact_lname
+# ticket_id
+# ticket_type
+# creation_start, creation_end 
+# project_id, priority
+
+# Check input.
+
+set exception_text ""
+set exception_count 0
+
+ticket_search_combine_and_build_error_list
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# This looks at a bunch of form vars, and builds a list of search
+# clauses in search_clause_list
+ticket_search_build_where_clause_and_description
+
+if {![info exists search_description_items] || [llength $search_description_items] == 0} {
+    ad_return_complaint 1 "<li>Please specify at least some search criteria.\n"
+    return
+}
+
+
+if { [info exists assigned_fname] && [info exists assigned_lname] && (![empty_string_p $assigned_fname] || ![empty_string_p $assigned_lname]) } {
+    set assigned_user_conditions [list]
+    if {![empty_string_p $assigned_fname]} {
+	lappend assigned_user_conditions "(lower(email) like  '[string tolower [DoubleApos $assigned_fname]]%' or  lower(first_names) like '[string tolower [DoubleApos $assigned_fname]]%')"
+    } 
+    if {  ![empty_string_p $assigned_lname] } {
+	lappend assigned_user_conditions "lower(last_name) like '[string tolower [DoubleApos $assigned_lname]]%'"
+    }
+
+    lappend search_clause_list " msg_id in (select msg_id from ticket_issue_assignments ta, users where ta.user_id = users.user_id and [join $assigned_user_conditions { or }] ) "
+
+}
+
+if {[llength $search_clause_list] > 0} {
+    set search_clause "and [join $search_clause_list " and "]"
+} else {
+    set search_clause ""
+}
+
+set display_title "Ticket search"
+
+set query "select ticket_issues.*, ticket_priorities.name, 
+ticket_projects.title as project_title, 
+users.first_names,
+users.last_name,
+to_char(posting_time, 'mm/dd/yyyy') as creation_date
+from ticket_issues, ticket_projects, ticket_priorities, users, users closer
+where
+closer.user_id(+) = ticket_issues.closed_by
+and users.user_id = ticket_issues.user_id 
+and ticket_issues.priority = ticket_priorities.priority
+and ticket_projects.project_id = ticket_issues.project_id
+$search_clause
+order by ticket_issues.project_id, msg_id"
+
+ReturnHeaders
+
+set selection [ns_db select $db $query]
+
+append pagebody "[ad_header $display_title]
+<h2>$display_title</h2>
+in <a href=\"\">[ad_system_name]</a>
+<hr>
+
+Search criteria:
+
+<ul>
+<li>[join $search_description_items "<li>"]
+</ul>
+
+<p>
+
+Search results:
+
+<form method=post action=\"list-issues.tcl\">
+
+<input type=hidden name=search_items [export_form_value search_description_items]>
+"
+
+set i 0
+set ppcount  0
+set msgs_displayed_already [list]
+
+set last_title ""
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { [lsearch $msgs_displayed_already msg_id] != -1 } {
+	continue
+    } else {
+	lappend msgs_displayed_already $msg_id
+    }
+    set detail_list ""
+
+    if {[string compare $project_title $last_title] != 0} {
+	if {$ppcount != 0} {
+	    append pagebody "<br>$ppcount issues"
+	    set ppcount 0
+	}
+	append pagebody "</ul><b>$project_title</b><ul>"
+    }
+
+    set last_title $project_title
+
+    set item_list_list { {"creation_date" "Creation Date:"} {"priority" "Priority:"} {"source" "Source:"} {"data1" ""} {"data2" ""} }
+
+    foreach item_list $item_list_list {
+	set variable [lindex $item_list 0]
+	set annotation [lindex $item_list 1]
+	if ![empty_string_p [set $variable]] {
+	    lappend detail_list "$annotation [set $variable]"
+	}
+    }
+    
+    append pagebody "<br><input type=checkbox name=msg_ids value=\"$msg_id\" checked>
+<a href=\"/ticket/admin/issue-view.tcl?[export_url_vars msg_id]\">\#$msg_id [clean_up_html $one_line]</a>"
+   if {[string tolower $status] == "closed"} {
+       append pagebody " <font color=green>Status: closed</font> "
+   } else {
+       append pagebody " Status: $status "
+   }
+   append pagebody [join $detail_list " ; "]
+
+   incr i
+   incr ppcount
+}
+
+if {$ppcount != 0} {
+    append pagebody "<br>$ppcount issues"
+    set ppcount 0
+}
+
+if { $i == 0 } {
+    append pagebody "No tickets found.\n"
+} else {
+    append pagebody "
+</ul>
+<p>
+<center>
+<input type=submit name=report_type value=\"Ticket Summaries\">
+<input type=submit name=report_type value=\"Complete Ticket Reports\">
+</center>"
+}
+
+append pagebody "</form>
+<p>
+<ul>
+<li><a href=\"issue-new.tcl\">Add a new ticket</a>
+</ul>
+[ad_footer]
+"
+ns_write $pagebody
Index: web/openacs/www/ticket/unauthorized.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/unauthorized.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/unauthorized.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,11 @@
+ReturnHeaders 
+
+ns_write "[ad_header [ad_system_name]]
+
+<h2>Access Denied</h2>
+Your user account does not have access to this functionality.
+
+<hr>
+
+[ad_footer]
+"
Index: web/openacs/www/ticket/user-summary.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/user-summary.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/user-summary.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,99 @@
+#
+# /ticket/user-summary.tcl
+# 
+# by hqm@arsdigita.com in June 1999
+#
+# summarize by user
+#
+
+set db_list [ns_db gethandle main 2]
+set db   [lindex $db_list 0]
+set db2   [lindex $db_list 1]
+
+ReturnHeaders
+ns_write "[ad_header "Summarize by User"]
+
+<h2>User Status Summary</h2>
+
+[ad_context_bar_ws_or_index [list "/ticket/index.tcl" "Ticket Tracker"]  "User Summaries"]
+
+<hr>
+
+<blockquote>
+<table border=0>
+<tr>
+<th>User
+<th>Total 
+<th>Active
+<th>Closed
+<th>Deferred
+<th>Last Mod
+<th>Oldest Active
+<th>Pri=High
+<th>Sev=Block
+</tr>
+"
+
+set i 0
+
+set selection [ns_db select $db "
+select 
+  users.user_id as summary_user_id, 
+  users.first_names || ' ' || users.last_name as name, 
+  count(tia.msg_id) as total,
+  sum(decode(status,'closed',1,0)) as closed,
+  sum(decode(status,'closed',0,'deferred',0,NULL,0,1)) as open,
+  sum(decode(status,'deferred',1,0)) as deferred,
+  max(modification_time) as lastmod,
+  min(posting_time) as oldest,
+  sum(ticket_one_if_high_priority(priority, status)) as high_pri,
+  sum(ticket_one_if_blocker(severity, status)) as blocker
+from users, ticket_issues ti, ticket_issue_assignments tia
+where users.user_id = tia.user_id
+and ti.msg_id = tia.msg_id
+group by users.user_id,  last_name, first_names
+order by upper(last_name)
+"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    # show summaries of ticket stats
+    # total #
+    # open
+    # closed
+    # deferred
+    # last modified (max)
+    # 
+
+    if {($i % 2) == 0} {
+	set bgcolor "bgcolor=\#ECECEC"
+    } else {
+	set bgcolor ""
+    }
+
+    ns_write "
+<tr>
+  <td $bgcolor><a href=\"user-top.tcl?[export_url_vars summary_user_id]\">$name
+  <td $bgcolor align=right>[blank_zero $total]&nbsp;
+  <td $bgcolor align=right>[blank_zero $open]&nbsp;
+  <td $bgcolor align=right>[blank_zero $closed]&nbsp;
+  <td $bgcolor align=right>[blank_zero $deferred]&nbsp;
+  <td $bgcolor align=right>$lastmod&nbsp;
+  <td $bgcolor align=right>$oldest&nbsp;
+  <td $bgcolor align=right>[blank_zero $high_pri]&nbsp;
+  <td $bgcolor align=right>[blank_zero $blocker]&nbsp;
+</tr>
+"
+   incr i
+}
+
+ns_write "</table>
+</blockquote>
+
+<ul>
+<li>Add new <a href=\"issue-new.tcl\">issue</a>
+</ul>
+
+[ad_footer]
+"
Index: web/openacs/www/ticket/user-top.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/user-top.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/user-top.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,279 @@
+set_form_variables 0
+
+
+# form vars:
+# 
+# summary_user_id - user_id this page is for
+#
+# filter conditions
+#
+
+# Status
+# view_status  { open closed deferred created_by_you }
+#
+# Creation time
+# view_created { last_24 last_week last_month all}
+#
+#
+# order_by       column name to sort table by 
+
+set ctrlvars {view_assignment view_status view_created summary_user_id}
+
+set db [ticket_getdbhandle]
+set user_id [ad_get_user_id]
+
+set name [database_to_tcl_string $db "select first_names || ' ' || last_name 
+from users where user_id = $summary_user_id"]
+
+ReturnHeaders
+
+ns_write "[ad_header "Summary for $name"]
+
+<h2>Summary for $name</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Ticket Tracker"] "User summary"]
+
+<hr>
+"
+
+# List of form vars used to select tickets to display
+
+# Assignment filter conditions
+#
+
+if {![info exists view_assignment]} {
+    # default to show issues assigned to $user_id
+    set view_assignment user
+}
+
+# default to only your own assigned issues
+if {![info exists view_status]} {
+    set view_status open
+}
+
+# default to all time
+if {![info exists view_created]} {
+    set view_created all
+}
+
+
+
+set assignment_filter "and (exists 
+(select msg_id from ticket_issue_assignments 
+where ticket_issue_assignments.msg_id = ticket_issues.msg_id
+and ticket_issue_assignments.user_id = $summary_user_id
+)) " 
+
+
+
+switch $view_status {
+    "open" {set status_filter "and ((status <> 'closed') and (status <> 'deferred')) " }
+    "deferred" {set status_filter "and ((status <> 'closed') or (status = 'deferred')) " }
+    "closed" {set status_filter "" } # shows everything
+}
+
+switch $view_created {
+   "last_24"   { set date_filter "and (posting_time > (sysdate - 1))" } 
+   "last_week" { set date_filter "and (posting_time > (sysdate - 7)) " } 
+   "last_month" { set date_filter "and (posting_time > (sysdate - 30)) " }
+   "all" { set date_filter "" }
+}
+
+# Sort order of tickets by
+if {![info exists order_by]} {
+    set order_by "ticket_issues.msg_id"
+} elseif {[string match "project*" $order_by]} {
+    set order_by "project_title"
+}
+
+
+################################################################
+# GUI ticket filter controls
+
+# List of all the state vars we need to pass through these toggle switches
+set filter_vars {view_assignment view_status view_created order_by summary_user_id}
+
+
+append results "<table border=0 cellspacing=0 cellpadding=0 width=100%>
+<tr>
+<th bgcolor=#ECECEC>Status</th>
+<th bgcolor=#ECECEC>Creation Time</th></tr>"
+
+
+#### Assignment flags
+# Show assigned to you 
+append results "<tr>
+<td align=center>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;\["
+
+# Show open issues
+append results [ticket_control_vars view_status open $filter_vars "active" "user-top.tcl"]
+append results " | "
+# Show deferred issues
+append results [ticket_control_vars view_status deferred $filter_vars "+deferred" "user-top.tcl"]
+append results " | "
+# Show closed issues
+append results [ticket_control_vars view_status closed $filter_vars "+closed" "user-top.tcl"]
+
+
+#### Creation time filter
+append results "\]&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</td>\n<td align=center>\["
+
+append results [ticket_control_vars view_created last_24 $filter_vars "last 24 hrs" "user-top.tcl"]
+append results " | "
+append results [ticket_control_vars view_created last_week $filter_vars "last week" "user-top.tcl"]
+append results " | "
+append results [ticket_control_vars view_created last_month $filter_vars "last month" "user-top.tcl"]
+append results " | "
+append results [ticket_control_vars view_created all $filter_vars "all" "user-top.tcl"]
+
+append results "\]</td></tr></table><p>"
+
+################################################################
+
+
+
+set last_priority "starting"
+
+set count 0
+
+append results "<table border=0>
+<tr>
+<th align=left><a href=\"user-top.tcl?order_by=[toggle_order ticket_issues.msg_id $order_by]&[eval export_url_vars $ctrlvars]\">ID#</a></th>
+<th align=left><a href=\"user-top.tcl?order_by=[toggle_order priority $order_by]&[eval export_url_vars $ctrlvars]\">Pri</a></th>
+<th align=left><a href=\"user-top.tcl?order_by=[toggle_order ticket_type $order_by]&[eval export_url_vars $ctrlvars]\">Typ</a></th>
+<th align=left><a href=\"user-top.tcl?order_by=[toggle_order email $order_by]&[eval export_url_vars $ctrlvars]\">Creator</a></th>
+<th align=left><a href=\"user-top.tcl?order_by=[toggle_order status $order_by]&[eval export_url_vars $ctrlvars]\">Stat</a></th>
+<th align=left><a href=\"user-top.tcl?order_by=[toggle_order severity $order_by]&[eval export_url_vars $ctrlvars]\">Sever</a></th>
+<th align=left><a href=\"user-top.tcl?order_by=[toggle_order posting_time $order_by]&[eval export_url_vars $ctrlvars]\">Creat</a></th>
+<th align=left><a href=\"user-top.tcl?order_by=[toggle_order modification_time $order_by]&[eval export_url_vars $ctrlvars]\">Mod</a></th>"
+
+if {$view_assignment != "user"} {
+    append results "<th align=left><a href=\"user_top.tcl?order_by=[toggle_order assigned_p $order_by]&[eval export_url_vars $ctrlvars]\">Asgn?</a></th>
+"
+}
+
+if { $view_status == "closed" } {
+    append results "<th align=left><a href=\"user-top.tcl?order_by=[toggle_order close_date $order_by]&[eval export_url_vars $ctrlvars]\">Closed</a></th>"
+} else {
+    append results "<th align=left><a href=\"user-top.tcl?order_by=[toggle_order deadline $order_by]&[eval export_url_vars $ctrlvars]\">Deadline</a></th>"
+}
+
+append results "<th align=left><a href=\"user-top.tcl?order_by=[toggle_order one_line $order_by]&[eval export_url_vars $ctrlvars]\">Synopsis</a></th>
+"
+if {![string match "project_title" $order_by]} {
+    append results "<th align=left><a href=\"user-top.tcl?order_by=[toggle_order project_id $order_by]&[eval export_url_vars $ctrlvars]\">Project</a></th>
+"    
+}
+append results "</tr>\n"
+
+set last_project_title ""
+
+set query "select distinct
+ ticket_issues.msg_id,
+ ticket_issues.ticket_type, 
+ ticket_issues.one_line,
+ ticket_issues.status,
+ ticket_issues.severity,
+ ticket_issues.posting_time,
+ users.email,
+ ticket_projects.title as project_title,
+ ticket_projects.project_id,
+ ticket_issues.priority, 
+ to_char(ticket_issues.modification_time, 'mm/dd/yy') as modification_time,
+ to_char(ticket_issues.posting_time, 'mm/dd/yy') as creation_time,
+ to_char(ticket_issues.close_date, 'mm/dd/yy') as close_date,
+ to_char(ticket_issues.deadline, 'mm/dd/yy') as deadline,
+ to_char(sysdate - deadline) as pastdue,
+ ticket_issue_assignments.active_p as assigned_p,
+ ticket_issues.public_p,
+ ticket_priorities.name as priority_name
+from ticket_issues, ticket_priorities, ticket_projects, users, ticket_issue_assignments
+where ticket_priorities.priority = ticket_issues.priority
+and users.user_id = ticket_issues.user_id
+and ticket_projects.project_id = ticket_issues.project_id
+and ticket_issues.msg_id = ticket_issue_assignments.msg_id(+)
+$assignment_filter
+$status_filter
+$date_filter
+order by $order_by, ticket_issues.priority, ticket_issues.posting_time"
+
+set selection [ns_db select $db $query]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    set cols {}
+    lappend cols "<a href=\"issue-view.tcl?msg_id=$msg_id\">$msg_id</a>"
+    lappend cols "P$priority"
+    lappend cols "[string range $ticket_type 0 3]"
+    regsub "@.*" $email "" email
+    lappend cols "$email"
+    if { [string compare $status "fixed waiting approval"] == 0 } {
+	lappend cols "<font color=#00ff00>(w approv)</font>"
+    } elseif { [string compare $status "need clarification"] == 0 } {
+	lappend cols "<font color=#ff0000>nd clar</font>"
+    } else {
+	lappend cols $status
+    }
+    lappend cols "$severity"
+    lappend cols "$creation_time"
+    lappend cols "$modification_time"
+
+    if {$view_assignment != "user"} {
+	if {$assigned_p == "t"} {
+	    lappend cols "<img src=/graphics/checkmark.gif>"
+	} else {
+	    lappend cols " - "
+	}
+    }
+    
+    if {[info exists closed] && $view_closed == 1} {
+	lappend cols "$close_date" 
+    } else {
+	if {$pastdue > 0} {
+	    lappend cols "<font color=red>$deadline</font>"
+	} else {
+	    lappend cols "$deadline"
+	}
+    }
+    
+    lappend cols "<a href=\"issue-view.tcl?msg_id=$msg_id\">[clean_up_html $one_line]</a>"
+    
+    # show project title if we are not sorting by project
+    if {![string match "project_title" $order_by]} {
+	lappend cols "<a href=project-top.tcl?project_id=$project_id>[string range $project_title 0 12]</a>"	
+    }
+    
+    if {[string match "project_title" $order_by] && $last_project_title != $project_title} {
+	append results "<tr><th colspan=10 align=left><a href=project-top.tcl?project_id=$project_id>$project_title</a></th></tr>\n"
+	set last_project_title $project_title
+    }
+    
+    incr count
+    if {($count % 2) == 0} {
+	set bgcolor "bgcolor=\#ECECEC"
+    } else {
+	set bgcolor ""
+    }
+    
+    append results "<tr $bgcolor>"
+    foreach col $cols {
+	append results "<td>$col&nbsp;</td>\n"
+    }
+    append results "</tr>"    
+}
+
+if { $count == 0 } {
+    append results "<tr><td colspan=10 align=center>-- No issues --</td></tr>"   
+}
+
+append results "</table>\n<p>"
+
+
+ns_write  "$results
+
+<ul>
+<li>Add new <a href=\"issue-new.tcl\">issue</a>
+</ul>
+[ad_footer]
+"
+
Index: web/openacs/www/ticket/admin/add-xref-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/add-xref-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/add-xref-2.tcl	17 Apr 2001 14:05:21 -0000	1.1
@@ -0,0 +1,20 @@
+#
+# Add in a cross-reference to another ticket
+# 
+# pmsg_id  - the id of the parent issue
+# xmsg_id - the id of the xreferenced isue
+#
+# target - the url we return to
+
+set_form_variables
+
+set db [ticket_getdbhandle]
+
+set msg_id $pmsg_id
+
+ns_db dml $db "insert into ticket_xrefs (from_ticket, to_ticket) 
+values ($msg_id, $xmsg_id)"
+
+
+ns_returnredirect "$target?[export_url_vars msg_id]"
+
Index: web/openacs/www/ticket/admin/add-xref-search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/add-xref-search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/add-xref-search.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,52 @@
+# Search the tickets for a given query string, and 
+# give user to add any results as cross-references to msg_id
+#
+# msg_id
+# target -- url to return control to when done
+
+set db [ticket_getdbhandle]
+
+ReturnHeaders
+set_form_variables
+
+ns_write "[ad_header "Search For Ticket To Add As Cross-Reference"]
+<h2>Cross-Reference Ticket Search</h2>
+in the <a href=\"index.tcl\">[ticket_system_name]</a>
+<p>
+You are adding a cross reference from ticket #$msg_id: [clean_up_html $one_line]
+<hr>
+Use the form below to search for tickets which you would like to
+cross reference with.
+<p>
+
+<blockquote>
+<form action=xref-search.tcl method=get>
+[ticket_search_fragments]
+<input type=submit name=submit value=submit>
+<input type=hidden name=msg_id [export_form_value msg_id]>
+<input type=hidden name=target [export_form_value target]>
+</form>
+
+"
+set query_string "%"
+ns_write "
+
+<a href=\"xref-search.tcl?[export_url_vars query_string msg_id target]\">List all tickets</a>
+
+
+</blockquote>
+[ad_footer]
+"
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/ticket/admin/add-xref.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/add-xref.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/add-xref.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,184 @@
+#
+# Add in a cross-reference to another ticket
+# 
+# xmsg_id  - the id of the xreferenced issue
+# pmsg_id - the id of the parent isue
+#
+# target - the url we return to
+
+set_form_variables
+
+set db [ticket_getdbhandle]
+
+# show a confirmation
+
+set msg_id $xmsg_id
+
+# msg_id
+#
+# This page is shown to unprivileged users - it does not
+# allow any fields to be modified.
+
+set user_id [ad_get_user_id]
+
+set selection [ns_db 0or1row $db "select 
+to_char(posting_time, [ticket_date_format]) as posting_date,
+deadline, one_line, message, priority, ticket_type, first_names || ' ' || last_name as name, status
+from ticket_issues, users
+where msg_id = $msg_id
+and users.user_id = ticket_issues.user_id"]
+
+if { $selection == "" } {
+    # message was probably deleted
+    ns_return 200 text/html "Couldn't find message $msg_id.  Probably it was deleted by the forum maintainer."
+    return
+}
+
+set_variables_after_query
+set this_one_line $one_line
+
+
+set selection [ns_db 1row $db "select 
+ title, ticket_issues.project_id, notify_p,
+ ticket_issues.data1, 
+ ticket_issues.data2, 
+ ticket_issues.data3, 
+ ticket_issues.data4, 
+ ticket_issues.data5, 
+ ticket_issues.contact_name,  ticket_issues.contact_info1,
+ to_char(close_date, [ticket_date_format]) close_date,  ticket_priorities.name  as priority_name, ticket_priorities.priority
+from ticket_projects, ticket_issues, users, ticket_priorities
+where ticket_projects.project_id = ticket_issues.project_id
+and ticket_issues.msg_id = $msg_id
+and users.user_id(+) = closed_by
+and ticket_priorities.priority = ticket_issues.priority"]
+set_variables_after_query
+
+if { [empty_string_p $deadline] } {
+    set deadline [ns_localsqltimestamp]
+}
+
+ReturnHeaders
+
+ns_write "Confirm: link to this ticket as cross-reference from ticket \#$pmsg_id <a href=\"add-xref-2.tcl?[export_url_vars xmsg_id pmsg_id target]\">Yes</a> &nbsp;|&nbsp;<a href=\"$target?msg_id=$pmsg_id\">Cancel</a>
+<p>"
+
+
+ns_write "[ad_header $one_line]
+Project: $title
+<h2>$ticket_type \#$msg_id: [clean_up_html $one_line]</h2>"
+
+ns_write "
+<table border=0 cellspacing=3>
+<tr><td align=left><b>Ticket Type:</b><td>$ticket_type</td></tr>
+<tr><td align=left><b>Priority:</b><td>$priority</td></tr>
+<tr><td align=left><b>Deadline:</b><td>$deadline</td></tr>
+<tr><th align=left>Project:<td>$project_id</td></tr>
+<tr><td align=left><b>Submitted By:</b><td>$name on $posting_date</tr>
+<tr><td align=left><b>Status:</b><td>$status</td></tr>"
+
+
+ns_write "<tr><th valign=top align=left>Contact Name:</th><td>$contact_name</td></tr>"
+
+ns_write "<tr><th valign=top align=left>Contact Info:</th><td><pre>$contact_info1</pre></td></tr>"
+
+
+
+foreach entry [ticket_picklist_data] { 
+    # Get the name of the database column associated with each
+    # picklist field
+    set column_name [ticket_picklist_entry_column_name $entry]
+    set current_value [set $column_name]
+    set pretty_name  [ticket_picklist_entry_pretty_name $entry]
+    ns_write "<tr><th align=left>$pretty_name:</th><td>$current_value</td></tr>\n"
+}
+
+if { $close_date != "" } {
+    ns_write "<tr><td align=left><b>Closed On:</b><td>$close_date</tr>\n"
+}
+
+ns_write "
+
+<tr><td colspan=2><hr></tr>
+<tr><th valign=top align=left>Message:</th><td align=left>$message
+</td></tr>
+</table>"
+
+# List xrefs
+ns_write "<b>Related Issues</b>
+<br>
+"
+set selection [ns_db select $db "select to_ticket, one_line xone_line, msg_id xmsg_id
+ from ticket_xrefs, ticket_issues
+where  to_ticket = ticket_issues.msg_id and 
+from_ticket=$msg_id"]
+
+ns_write "<ul>"
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    ns_write "<li>\[$xmsg_id\] $xone_line"
+}
+
+
+
+
+ns_write "
+<h3>Assignment</h3>
+<table border=1 cellpadding=10>
+<tr>
+<th>Users assigned to this issue</th>
+</tr>
+
+"
+# list assignments
+ns_write "<tr valign=top><td><ul>
+"
+
+set selection [ns_db select $db "select first_names, last_name, users.user_id
+from users, ticket_issue_assignments where 
+users.user_id=ticket_issue_assignments.user_id 
+and msg_id=$msg_id"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    ns_write "<li>  $first_names $last_name\n"
+}
+
+ns_write  "</ul>
+</td></tr></table>
+</ul>\n"
+
+# List responses 
+set selection [ns_db select $db "select 
+ response_id, public_p,
+ users.first_names || ' ' || users.last_name as name,
+ to_char(posting_time, [ticket_date_format]) as posting_date,
+ message
+from ticket_issue_responses, users
+where ticket_issue_responses.user_id = users.user_id
+and ticket_issue_responses.response_to = $msg_id"] 
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if {$public_p == "t"} {
+	lappend responses "<blockquote>
+	$message
+	</blockquote>
+	Submitted by $name on $posting_date
+	"
+    }
+}
+
+
+if { [info exists responses] } {
+    ns_write "<h3>Comments</h3>
+[join $responses "<hr width=300>"]
+"
+}
+
+
+ns_write "[ad_footer]"
+
+
+
+
Index: web/openacs/www/ticket/admin/deadline-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/deadline-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/deadline-edit.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,14 @@
+set_the_usual_form_variables
+
+set db [ticket_getdbhandle]
+
+# msg_id, deadline
+
+ns_dbformvalue [ns_conn form] deadline date deadline
+
+update_last_modified_info $db $msg_id
+
+ns_db dml $db "update ticket_issues set deadline = '$deadline' where
+msg_id = $msg_id"
+
+ns_returnredirect "issue-view.tcl?[export_url_vars msg_id]"
Index: web/openacs/www/ticket/admin/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/index.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,373 @@
+# Ticket tracker admin user home page
+#
+# index.tcl by hqm@arsdigita.com June 1999
+# 
+set_form_variables 0
+
+# form vars:
+# 
+# (these are all optional args which have defaults)
+#
+# filter conditions
+#
+# Assignments:
+# view_assignment    { user unassigned all }
+
+# Status
+# view_status  { open closed deferred created_by_you }
+#
+# Creation time
+# view_created { last_24 last_week last_month all}
+#
+#
+# order_by       column name to sort table by 
+
+set ctrlvars {view_assignment view_status view_created}
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+ReturnHeaders
+
+ns_write "[ad_header "[ticket_system_name] Home"]
+
+<h2>[ticket_system_name]</h2>
+
+[ad_context_bar_ws_or_index "Ticket Tracker"]
+
+<hr>
+"
+
+# List of form vars used to select tickets to display
+
+# Assignment filter conditions
+#
+
+if {![info exists view_assignment]} {
+    # default to show issues assigned to $user_id
+    set view_assignment user
+}
+
+# default to only your own assigned issues
+if {![info exists view_status]} {
+    set view_status open
+}
+
+# default to all time
+if {![info exists view_created]} {
+    set view_created all
+}
+
+
+switch $view_assignment {
+    "user" { 
+	set assignment_filter "and (exists (select msg_id from ticket_issue_assignments 
+where ticket_issue_assignments.msg_id = ticket_issues.msg_id
+and ticket_issue_assignments.user_id = $user_id
+)) " }
+
+     "all" { set assignment_filter "" }
+}
+
+switch $view_status {
+    "open" {set status_filter "and ((status <> 'closed') and (status <> 'deferred')) " }
+    "deferred" {set status_filter "and ((status <> 'closed') or (status = 'deferred')) " }
+    "closed" {set status_filter "" } # shows everything
+}
+
+switch $view_created {
+   "last_24"   { set date_filter "and (posting_time > (sysdate - 1))" } 
+   "last_week" { set date_filter "and (posting_time > (sysdate - 7)) " } 
+   "last_month" { set date_filter "and (posting_time > (sysdate - 30)) " }
+   "all" { set date_filter "" }
+}
+
+
+# Sort order of tickets by
+if {![info exists order_by]} {
+    set order_by "ticket_issues.msg_id"
+    set sql_order_clause $order_by
+} elseif {[string match "project*" $order_by]} {
+    set sql_order_clause "project_title"
+} elseif {[string compare "severity" $order_by] == 0} {
+    set sql_order_clause "decode(severity[severity_decode_list])"
+} elseif {[string compare "severity desc" $order_by] == 0} {
+    set sql_order_clause "decode(severity[severity_decode_list]) desc"
+} elseif {[string match "assigned_p desc" $order_by]} {
+    set sql_order_clause "upper(assigned_user_email)"
+} elseif {[string match "assigned_p" $order_by]} {
+    set sql_order_clause "upper(assigned_user_email) desc"
+} else {
+    set sql_order_clause $order_by
+}
+
+
+################################################################
+# GUI ticket filter controls
+
+# List of all the state vars we need to pass through these toggle switches
+set filter_vars {view_assignment view_status view_created order_by}
+
+
+append results "<table border=0 cellspacing=0 cellpadding=0 width=100%>
+<tr><th bgcolor=#ECECEC>Ticket Assignment</th>
+<th bgcolor=#ECECEC>Status</th>
+<th bgcolor=#ECECEC>Creation Time</th></tr>"
+
+
+#### Assignment flags
+# Show assigned to you 
+append results "<tr><td align=center>\["
+
+append results [ticket_control_vars view_assignment user $filter_vars "mine"]
+append results " | "
+# Show all tickets 
+append results [ticket_control_vars view_assignment all $filter_vars "everyone's"]
+
+#### Status flags
+append results "\]</td>\n<td align=center>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;\["
+
+# Show open issues
+append results [ticket_control_vars view_status open $filter_vars "active"]
+append results " | "
+# Show deferred issues
+append results [ticket_control_vars view_status deferred $filter_vars "+deferred"]
+append results " | "
+# Show closed issues
+append results [ticket_control_vars view_status closed $filter_vars "+closed"]
+
+
+#### Creation time filter
+append results "\]&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</td>\n<td align=center>\["
+
+append results [ticket_control_vars view_created last_24 $filter_vars "last 24 hrs"]
+append results " | "
+append results [ticket_control_vars view_created last_week $filter_vars "last week"]
+append results " | "
+append results [ticket_control_vars view_created last_month $filter_vars "last month"]
+append results " | "
+append results [ticket_control_vars view_created all $filter_vars "all"]
+
+append results "\]</td></tr></table><p>"
+
+################################################################
+
+
+
+set last_priority "starting"
+
+set count 0
+
+append results "<table border=0>
+<tr>
+<th align=left><a href=\"index.tcl?order_by=[toggle_order ticket_issues.msg_id $order_by]&[eval export_url_vars $ctrlvars]\">ID#</a></th>
+<th align=left><a href=\"index.tcl?order_by=[toggle_order priority $order_by]&[eval export_url_vars $ctrlvars]\">Pri</a></th>
+<th align=left><a href=\"index.tcl?order_by=[toggle_order ticket_type $order_by]&[eval export_url_vars $ctrlvars]\">Typ</a></th>
+<th align=left><a href=\"index.tcl?order_by=[toggle_order email $order_by]&[eval export_url_vars $ctrlvars]\">Creator</a></th>
+<th align=left><a href=\"index.tcl?order_by=[toggle_order status $order_by]&[eval export_url_vars $ctrlvars]\">Stat</a></th>
+<th align=left><a href=\"index.tcl?order_by=[toggle_order severity $order_by]&[eval export_url_vars $ctrlvars]\">Sever</a></th>
+<th align=left><a href=\"index.tcl?order_by=[toggle_order posting_time $order_by]&[eval export_url_vars $ctrlvars]\">Creat</a></th>
+<th align=left><a href=\"index.tcl?order_by=[toggle_order modification_time $order_by]&[eval export_url_vars $ctrlvars]\">Mod</a></th>
+<th align=left><a href=\"index.tcl?order_by=[toggle_order assigned_p $order_by]&[eval export_url_vars $ctrlvars]\">Asgn?</a></th>"
+
+if { $view_status == "closed" } {
+    append results "<th align=left><a href=\"index.tcl?order_by=[toggle_order close_date $order_by]&[eval export_url_vars $ctrlvars]\">Closed</a></th>"
+} else {
+    append results "<th align=left><a href=\"index.tcl?order_by=[toggle_order deadline $order_by]&[eval export_url_vars $ctrlvars]\">Deadline</a></th>"
+}
+
+append results "<th align=left><a href=\"index.tcl?order_by=[toggle_order one_line $order_by]&[eval export_url_vars $ctrlvars]\">Subject</a></th>
+"
+if {![string match "project_title" $order_by]} {
+    append results "<th align=left><a href=\"index.tcl?order_by=[toggle_order project_id $order_by]&[eval export_url_vars $ctrlvars]\">Project</a></th>
+"    
+}
+append results "</tr>\n"
+
+set last_project_title ""
+
+set query "select 
+ ticket_issues.msg_id,
+ ticket_issues.ticket_type, 
+ ticket_issues.one_line,
+ ticket_issues.status,
+ ticket_issues.severity,
+ ticket_issues.posting_time,
+ users.email,
+ assigned_users.email as assigned_user_email,
+ ticket_projects.title as project_title,
+ ticket_projects.project_id,
+ ticket_issues.priority, 
+ to_char(ticket_issues.modification_time, 'mm/dd/yy') as modification_time_pretty,
+ to_char(ticket_issues.posting_time, 'mm/dd/yy') as creation_time_pretty,
+ to_char(ticket_issues.close_date, 'mm/dd/yy') as close_date_pretty,
+ to_char(ticket_issues.deadline, 'mm/dd/yy') as deadline_pretty,
+ to_char(sysdate - deadline) as pastdue,
+ ticket_issue_assignments.active_p as assigned_p,
+ ticket_issue_assignments.user_id as assigned_user_id,
+ ticket_issues.public_p,
+ ticket_priorities.name as priority_name
+from ticket_issues, ticket_priorities, ticket_projects, users, ticket_issue_assignments, users assigned_users
+where ticket_priorities.priority = ticket_issues.priority
+and users.user_id = ticket_issues.user_id
+and ticket_projects.project_id = ticket_issues.project_id
+and ticket_issues.msg_id = ticket_issue_assignments.msg_id(+)
+and ticket_issue_assignments.user_id = assigned_users.user_id(+)
+$assignment_filter
+$status_filter
+$date_filter
+order by $sql_order_clause, ticket_issues.priority, ticket_issues.posting_time"
+
+set selection [ns_db select $db $query]
+
+set last_msg_id ""
+set msg_ids {}
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    set cols {}
+    if {$msg_id == $last_msg_id} {
+	set assign $assigned_user_email
+	regsub "@.*" $assign "" assign
+	set cols [list "" "" "" "" "" "" "" "" "$assign" "" "" ""]
+		
+    } else {
+	set last_msg_id $msg_id
+	lappend msg_ids $msg_id
+	
+	lappend cols "<a href=\"issue-view.tcl?msg_id=$msg_id\">$msg_id</a>"
+	lappend cols "P$priority"
+	lappend cols "[string range $ticket_type 0 3]"
+	regsub "@.*" $email "" email
+	lappend cols "$email"
+	if { [string compare $status "fixed waiting approval"] == 0 } {
+	    lappend cols "<font color=#00ff00>(w approv)</font>"
+	} elseif { [string compare $status "need clarification"] == 0 } {
+	    lappend cols "<font color=#ff0000>nd clar</font>"
+	} else {
+	    lappend cols $status
+	}
+	lappend cols "$severity"
+	lappend cols "$creation_time_pretty"
+	lappend cols "$modification_time_pretty"
+	
+	if {$assigned_p == "t"} {
+	    set assign $assigned_user_email
+	    regsub "@.*" $assign "" assign
+	    lappend cols "$assign"
+	} else {
+	    lappend cols ""
+	}
+
+	
+	if {[info exists closed] && $view_closed == 1} {
+	    lappend cols "$close_date_pretty" 
+	} else {
+	    if {$pastdue > 0} {
+		lappend cols "<font color=red>$deadline_pretty</font>"
+	    } else {
+		lappend cols "$deadline_pretty"
+	    }
+	}
+	
+	lappend cols "<a href=\"issue-view.tcl?msg_id=$msg_id\">[clean_up_html $one_line]</a>"
+	
+	# show project title if we are not sorting by project
+	if {![string match "project_title" $order_by]} {
+	    lappend cols "<a href=project-top.tcl?project_id=$project_id>[string range $project_title 0 12]</a>"	
+	}
+	
+	if {[string match "project_title" $order_by] && $last_project_title != $project_title} {
+	    append results "<tr><th colspan=10 align=left><a href=project-top.tcl?project_id=$project_id>$project_title</a></th></tr>\n"
+	    set last_project_title $project_title
+	}
+	
+	incr count
+	if {($count % 2) == 0} {
+	    set bgcolor "bgcolor=\#ECECEC"
+	} else {
+	    set bgcolor ""
+	}
+	
+    }
+    append results "<tr $bgcolor>"
+    foreach col $cols {
+	append results "<td>$col&nbsp;</td>\n"
+    }
+    append results "</tr>"    
+}
+
+if { $count == 0 } {
+    append results "<tr><td colspan=10 align=center>-- No issues --</td></tr>"   
+}
+
+append results "</table>\n<p>"
+
+
+# added to keep the script from breaking when there are no tickets to display.
+if { ![info exists project_id] } {
+    set project_id ""
+}
+
+
+
+
+ns_write  "
+$results
+<ul>
+<li>Summarize by 
+    <a href=\"project-summary.tcl\">project</a> |
+    <a href=\"user-summary.tcl\">user</a>
+
+<li>View by 
+   <a href=\"index.tcl?order_by=[toggle_order project_id $order_by]&[eval export_url_vars $ctrlvars]\">project</a> |
+   <a href=\"project-view-assignments.tcl\">user</a>
+   
+<li><a href=\"issue-details.tcl?[export_url_vars msg_ids]&report_type=msgs_and_responses\">View issues above as full report</a>
+<li><a href=\"issue-details.tcl?[export_url_vars msg_ids]&report_type=msgs\">View issues above as summary</a>
+
+<p>
+
+<li>Add new 
+   <a href=\"project-new.tcl\">project</a> |
+   <a href=\"issue-new.tcl\">issue</a>
+
+<p>
+
+<li>
+<form action=ticket-search.tcl method=GET>
+Quick Search:
+<input type=text maxlength=100 name=query_string_1>
+</form>
+
+<li><form action=project-top.tcl method=get>
+View Project: <select name=project_id>
+    [ad_db_optionlist $db  "select title,
+    project_id from ticket_projects
+    order by title asc" $project_id]
+    </select>
+<input type=submit value=Go>
+</form>
+
+
+
+</ul>
+
+
+
+<h3>Advanced Search</h3>
+
+<blockquote>
+<form action=ticket-search.tcl method=post>
+[ticket_search_fragments]
+<p>
+<center>
+<input type=submit name=submit value=\"Search\">
+</center>
+
+</form>
+</blockquote>
+
+[ad_footer]
+"
Index: web/openacs/www/ticket/admin/issue-assign-user.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/issue-assign-user.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/issue-assign-user.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,20 @@
+set_the_usual_form_variables
+
+# msg_id, assignee_id, project_id
+
+set db [ticket_getdbhandle]
+
+if {![info exists assignee_id] || [empty_string_p $assignee_id]} {
+    ad_return_complaint 1 "<li>You did not specify a user to assign to this ticket.\n"
+    return
+}
+
+
+if {[database_to_tcl_string $db  "select count(*) from ticket_issue_assignments where user_id=$assignee_id and msg_id=$msg_id"] > 0} {
+    # do nothing, ticket is already assigned (this should not happen unless
+    # someone resubmits a page by accident
+} else {
+    ns_db dml $db "insert into ticket_issue_assignments (msg_id, user_id, active_p) VALUES  ($msg_id, $assignee_id, 't')"
+}
+
+ns_returnredirect "issue-view.tcl?msg_id=$msg_id"
Index: web/openacs/www/ticket/admin/issue-change-log.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/issue-change-log.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/issue-change-log.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,69 @@
+# This page is for viewing issue change history as a privileged user - 
+# 
+# form vars: msg_id, one_line
+#
+#
+# Most data fields are modifiable
+
+set_form_variables
+
+set db [ticket_getdbhandle]
+
+ReturnHeaders
+
+set selection [ns_db 1row  $db "select ticket_type, one_line, ticket_issues.project_id, ticket_projects.title from ticket_issues, ticket_projects 
+where msg_id = $msg_id
+and ticket_issues.project_id = ticket_projects.project_id"]
+set_variables_after_query
+
+ns_write "[ad_header [clean_up_html $one_line]]"
+
+ns_write "[ad_context_bar_ws_or_index [list "/ticket/admin/index.tcl" "Ticket Tracker"] [list "project-top.tcl?project_id=$project_id" $title] [list "issue-view.tcl?msg_id=$msg_id" "Ticket \#$msg_id"] "View Change History"]
+
+<hr>
+<h2>$ticket_type \#$msg_id: [clean_up_html $one_line]</h2>
+"
+
+
+
+set selection [ns_db select $db "select 
+who, what, old_value, new_value , to_char (modification_date, 'yyyy-mm-dd hh24:MM:SS
+') as modification_date
+from  ticket_changes 
+where msg_id = $msg_id"]
+
+ns_write "
+<table border=1>
+<tr>
+<th>Who</th>
+<th>What</th>
+<th>Old Value</th>
+<th>New Value</th>
+<th>When</th>
+</tr>
+"
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    ns_write "<tr>
+<td>$who</td>
+<td>$what</td>
+<td>$old_value</td>
+<td>$new_value</td>
+<td>$modification_date</td>
+</tr>"
+} 
+
+ns_write "</table>"
+
+ns_write "
+<p>
+<a href=issue-view.tcl?msg_id=$msg_id>View issue</a>
+<p>
+"
+
+ns_write "
+[ad_footer]"
+
+
+
Index: web/openacs/www/ticket/admin/issue-change-priority-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/issue-change-priority-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/issue-change-priority-2.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,93 @@
+# User is modifying the priority of this ticket.
+# An explanatory comment is in message
+
+set_the_usual_form_variables
+# msg_id, message, priorty, public_p
+
+set user_id [ad_get_user_id]
+set db [ticket_getdbhandle]
+
+# responses from admins are defaultly private
+if {![info exists public_p]} { 
+    set public_p "f"
+}
+
+set exception_text ""
+set exception_count 0
+
+
+if {![info exists public_p]} {
+    set public_p "f"
+}
+
+if {![info exists notify_creator_p]} {
+    set notify_creator_p "f"
+}
+
+if [catch { set n_previous [database_to_tcl_string $db "select count(*)
+from ticket_issue_responses
+where response_to = $msg_id
+and user_id = $user_id
+and dbms_lob.instr(message,'[bboard_convert_plaintext_to_html $message]') > 0"]} errmsg] {
+    ns_log Notice "failed trying to look up previous posting: $errmsg"
+} else {
+    # lookup succeeded
+    if { $n_previous > 0 } {
+	incr exception_count
+	append exception_text "<li>There are already $n_previous responses from you with the same body.
+Perhaps you already posted this?
+If you are sure that you also want to add this issue, 
+back up and change at least one character in the subject 
+or message area, then resubmit."
+    }
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# gets around clob driver problem with and empty string
+if [empty_string_p $message] {
+    set message " "
+}
+
+set selection [ns_db 1row $db "select one_line, title, 
+ticket_issues.project_id, notify_p
+from ticket_issues, ticket_projects
+where ticket_issues.project_id = ticket_projects.project_id
+and msg_id = $msg_id"]
+set_variables_after_query
+
+set message_in_html [bboard_convert_plaintext_to_html $message]
+
+with_transaction $db {
+
+    update_last_modified_info $db $msg_id
+
+    ns_db dml $db "update ticket_issues 
+set priority = $priority where msg_id = $msg_id"
+    ns_ora clob_dml $db "insert into ticket_issue_responses (response_id,response_to,user_id,message,posting_time, public_p) values (ticket_response_id_sequence.nextval,$msg_id,$user_id,empty_clob(),sysdate, '$public_p') returning message into :1" $message_in_html
+
+    # send notifcation email
+    if { $notify_p == "t" } {
+	send_ticket_change_notification $db $msg_id $message $user_id $notify_creator_p
+    }
+
+} {
+    # something went a bit wrong during the insert
+    ns_return 200 text/html "[ad_header "Error Modifying Issue"]
+<h3>Ouch!!</h3>
+<hr>
+We encountered a problem modifying your issue.
+Here was the bad news from the database:
+<pre>
+$errmsg
+</pre>
+[ad_footer]
+"
+    return
+}
+
+
+ns_returnredirect "issue-view.tcl?msg_id=$msg_id"
\ No newline at end of file
Index: web/openacs/www/ticket/admin/issue-change-priority.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/issue-change-priority.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/issue-change-priority.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,35 @@
+set_form_variables
+# msg_id, priority
+
+set db [ticket_getdbhandle]
+
+set selection [ns_db 1row $db "select one_line, 
+ticket_issues.project_id, ticket_projects.title
+from ticket_issues, ticket_projects
+where msg_id = $msg_id
+and ticket_projects.project_id = ticket_issues.project_id"]
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "[ad_header "Change Priority"]
+<h2>Change Priority</h2>
+<a href=\"issue-view.tcl?msg_id=$msg_id\">[clean_up_html $one_line]</a>
+for project <a href=\"project-top.tcl?project_id=$project_id\">$title</a>
+in <a href=\"index.tcl\">[ticket_system_name]</a>
+<hr>
+Please say why you are changing the priority of this issue.
+<form action=\"issue-change-priority-2.tcl\" method=get>
+[export_form_vars msg_id priority]
+<textarea name=message rows=10 cols=70 wrap=physical></textarea>
+"
+# admins have the option of making a response public or private.
+ns_write "<p><input type=checkbox name=public_p value=t>Make this response publicly readable?
+    <p><input type=checkbox name=notify_creator_p value=t>Send email notification to this ticket's creator?<p>"
+
+ns_write "
+
+<center><input type=submit value=Submit></center>
+</form>
+[ad_footer]
+"
Index: web/openacs/www/ticket/admin/issue-changed-status-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/issue-changed-status-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/issue-changed-status-2.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,96 @@
+# User is changing status this ticket.
+# An explanatory comment is in message
+
+set_the_usual_form_variables
+# msg_id, message, status
+# notify_creator_p
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+set exception_text ""
+set exception_count 0
+
+
+if {![empty_string_p [string trim $message]]} {
+    if [catch { set n_previous [database_to_tcl_string $db "select count(*)
+from ticket_issue_responses
+where response_to = $msg_id
+and user_id = $user_id
+and dbms_lob.instr(message,'[bboard_convert_plaintext_to_html $message]') > 0"]} errmsg] {
+       ns_log Notice "failed trying to look up previous posting: $errmsg"
+    } else {
+    # lookup succeeded
+	if { $n_previous > 0 } {
+	    incr exception_count
+	    append exception_text "<li>There are already $n_previous responses from you with the same body.
+Perhaps you already posted this?
+If you are sure that you also want to add this issue, 
+back up and change at least one character in the subject 
+or message area, then resubmit."
+    }
+  }
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# gets around clob driver problem with and empty string
+if [empty_string_p $message] {
+    set message " "
+}
+
+set selection [ns_db 1row $db "select one_line, title, 
+ticket_issues.project_id, notify_p
+from ticket_issues, ticket_projects
+where ticket_issues.project_id = ticket_projects.project_id
+and msg_id = $msg_id"]
+set_variables_after_query
+
+set message_in_html [bboard_convert_plaintext_to_html $message]
+
+if {![info exists notify_creator_p]} {
+    set notify_creator_p "f"
+}
+
+with_transaction $db {
+    
+    update_last_modified_info $db $msg_id 
+
+    if {[string compare $status "closed"] == 0} {
+
+	ns_db dml $db "update ticket_issues 
+	set modification_time = sysdate, close_date = sysdate, closed_by = $user_id, status='closed'  where msg_id = $msg_id"
+    } else {
+	ns_db dml $db "update ticket_issues 
+	set status='$status', modification_time = sysdate where msg_id = $msg_id"
+    }
+
+    if {![empty_string_p [string trim $message]]} {
+	ns_ora clob_dml $db "insert into ticket_issue_responses (response_id,response_to,user_id,message,posting_time) values (ticket_response_id_sequence.nextval,$msg_id,$user_id,empty_clob(),sysdate) returning message into :1" $message_in_html
+    }
+
+    # send notifcation email
+    if { $notify_p == "t" } {
+	    send_ticket_change_notification $db $msg_id $message $user_id $notify_creator_p
+    }
+} {
+    # something went a bit wrong during the insert
+    ns_return 200 text/html "[ad_header "Error Closing Issue"]
+<h3>Ouch!!</h3>
+<hr>
+We encountered a problem closing your issue.
+Here was the bad news from the database:
+<pre>
+$errmsg
+</pre>
+[ad_footer]
+"
+    return
+}
+
+
+ns_returnredirect "issue-view.tcl?msg_id=$msg_id"
\ No newline at end of file
Index: web/openacs/www/ticket/admin/issue-changed-status.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/issue-changed-status.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/issue-changed-status.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,32 @@
+# Ask for a comment from user when status is being modified
+set_form_variables
+# msg_id, status
+
+set db [ticket_getdbhandle]
+
+set selection [ns_db 1row $db "select one_line, 
+ticket_issues.project_id, ticket_projects.title
+from ticket_issues, ticket_projects
+where msg_id = $msg_id
+and ticket_projects.project_id = ticket_issues.project_id"]
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "[ad_header "Changing Issue Status To $status"]
+<h2>Change Issue Status To $status</h2>
+<a href=\"issue-view.tcl?msg_id=$msg_id\">[clean_up_html $one_line]</a>
+for project <a href=\"project-top.tcl?project_id=$project_id\">$title</a>
+in <a href=\"index.tcl\">[ticket_system_name]</a>
+<hr>
+Please say why you are changing the status of this issue to $status.
+<form action=\"issue-changed-status-2.tcl\" method=get>
+[export_form_vars msg_id status]
+<textarea name=message rows=10 cols=70 wrap=physical></textarea>
+<p><input type=checkbox name=public_p checked value=t>Make this response publicly readable?
+<p><input type=checkbox name=notify_creator_p value=t>Send email notification to this ticket's creator?
+<p><input type=checkbox name=preformat value=yes> Preserve fixed text formatting?
+<center><input type=submit value=Submit></center>
+</form>
+[ad_footer]
+"
Index: web/openacs/www/ticket/admin/issue-close-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/issue-close-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/issue-close-2.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,83 @@
+# User is closing this ticket.
+# An explanatory comment is in message
+
+set_the_usual_form_variables
+# msg_id, message
+# notify_creator_p
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+set exception_text ""
+set exception_count 0
+
+if [catch { set n_previous [database_to_tcl_string $db "select count(*)
+from ticket_issue_responses
+where response_to = $msg_id
+and user_id = $user_id
+and dbms_lob.instr(message,'[bboard_convert_plaintext_to_html $message]') > 0"]} errmsg] {
+    ns_log Notice "failed trying to look up previous posting: $errmsg"
+} else {
+    # lookup succeeded
+    if { $n_previous > 0 } {
+	incr exception_count
+	append exception_text "<li>There are already $n_previous responses from you with the same body.
+Perhaps you already posted this?
+If you are sure that you also want to add this issue, 
+back up and change at least one character in the subject 
+or message area, then resubmit."
+    }
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# gets around clob driver problem with and empty string
+if [empty_string_p $message] {
+    set message " "
+}
+
+set selection [ns_db 1row $db "select one_line, title, 
+ticket_issues.project_id, notify_p
+from ticket_issues, ticket_projects
+where ticket_issues.project_id = ticket_projects.project_id
+and msg_id = $msg_id"]
+set_variables_after_query
+
+set message_in_html [bboard_convert_plaintext_to_html $message]
+
+if {![info exists notify_creator_p]} {
+    set notify_creator_p "f"
+}
+
+with_transaction $db {
+
+    update_last_modified_info $db $msg_id 
+
+    ns_db dml $db "update ticket_issues 
+    set close_date = sysdate, closed_by = $user_id, status='closed'  where msg_id = $msg_id"
+    ns_ora clob_dml $db "insert into ticket_issue_responses (response_id,response_to,user_id,message,posting_time) values (ticket_response_id_sequence.nextval,$msg_id,$user_id,empty_clob(),sysdate) returning message into :1" $message_in_html
+    # send notifcation email
+    if { $notify_p == "t" } {
+	send_ticket_change_notification $db $msg_id $message $user_id $notify_creator_p
+    }
+} {
+    # something went a bit wrong during the insert
+    ns_return 200 text/html "[ad_header "Error Closing Issue"]
+<h3>Ouch!!</h3>
+<hr>
+We encountered a problem closing your issue.
+Here was the bad news from the database:
+<pre>
+$errmsg
+</pre>
+[ad_footer]
+"
+    return
+}
+
+
+ns_returnredirect "index.tcl"
\ No newline at end of file
Index: web/openacs/www/ticket/admin/issue-close.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/issue-close.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/issue-close.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,30 @@
+set_form_variables
+# msg_id
+
+set db [ticket_getdbhandle]
+
+set selection [ns_db 1row $db "select one_line, 
+ticket_issues.project_id, ticket_projects.title
+from ticket_issues, ticket_projects
+where msg_id = $msg_id
+and ticket_projects.project_id = ticket_issues.project_id"]
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "[ad_header "Close Issue"]
+<h2>Close Issue</h2>
+<a href=\"issue-view.tcl?msg_id=$msg_id\">[clean_up_html $one_line]</a>
+for project <a href=\"project-top.tcl?project_id=$project_id\">$title</a>
+in <a href=\"index.tcl\">[ticket_system_name]</a>
+<hr>
+Please say why you are closing this issue.
+<form action=\"issue-close-2.tcl\" method=get>
+[export_form_vars msg_id]
+<textarea name=message rows=10 cols=70 wrap=physical></textarea>
+<p><input type=checkbox name=public_p value=t>Make this response publicly readable?
+<p><input type=checkbox name=notify_creator_p value=t>Send email notification to this ticket's creator?
+<center><input type=submit value=Submit></center>
+</form>
+[ad_footer]
+"
Index: web/openacs/www/ticket/admin/issue-deassign-user.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/issue-deassign-user.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/issue-deassign-user.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,15 @@
+set_the_usual_form_variables
+# msg_id, assignee_id
+
+set db [ticket_getdbhandle]
+
+if {![info exists assignee_id] || [empty_string_p $assignee_id]} {
+    ad_return_complaint 1 "<li>You did not specify a user to deassign from this ticket.\n"
+    return
+}
+
+  
+ns_db dml $db "delete from ticket_issue_assignments 
+WHERE user_id=$assignee_id AND msg_id=$msg_id"
+
+ns_returnredirect "issue-view.tcl?msg_id=$msg_id"
Index: web/openacs/www/ticket/admin/issue-details.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/issue-details.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/issue-details.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,107 @@
+# List a set of tickets in a report 
+#
+# form vars:
+# report_type = "msgs" | "msgs_and_responses" 
+# msg_ids  = tcl list of msg ids
+#
+
+set_form_variables
+
+set db_list [ns_db gethandle main 2]
+set db   [lindex $db_list 0]
+set db2   [lindex $db_list 1]
+
+set user_id [ad_get_user_id]
+
+ReturnHeaders
+ns_write "[ad_header "Ticket Report"]
+<h2>Ticket Report</h2>
+
+[ad_context_bar_ws_or_index [list "/ticket/admin/index.tcl" "Ticket Tracker"]  "Report"]
+
+<hr>
+"
+
+set i 0
+
+foreach message_id $msg_ids {
+    set selection [ns_db 1row $db "select ticket_issues.*, ticket_priorities.name, 
+ ticket_projects.title as project_title, 
+ users.first_names,
+ users.last_name
+from ticket_issues, ticket_projects, ticket_priorities, users where
+users.user_id = ticket_issues.user_id 
+and ticket_issues.priority = ticket_priorities.priority
+and ticket_projects.project_id = ticket_issues.project_id
+and msg_id = $message_id"]
+
+    set_variables_after_query
+    set msg_id $message_id
+    set detail_list ""
+
+    set item_list_list { {"posting_time" "Creation Date:"} {"severity" "Severity:"}  }
+
+    foreach item_list $item_list_list {
+	set variable [lindex $item_list 0]
+	set annotation [lindex $item_list 1]
+	if ![empty_string_p [set $variable]] {
+	    lappend detail_list "$annotation <b>[set $variable]</b>"
+	}
+    }
+
+    # list assignments
+    set assigned_to [database_to_tcl_list $db "select users.email from users, ticket_issue_assignments tia
+where tia.msg_id = $message_id
+and users.user_id = tia.user_id"]
+
+    lappend detail_list  "<br>Assigned to: [join $assigned_to ", "]"
+
+    append page "<br><b><a href=\"/ticket/admin/issue-view.tcl?[export_url_vars msg_id]\">\#$message_id [clean_up_html $one_line]</a></b><br>"
+
+    append page "Project: <b>$project_title</b> "
+   if {[string tolower $status] == "closed"} {
+       append page " <font color=green>Status: <b>closed</b></font> "
+   } else {
+       append page " Status: <b>$status</b> "
+   }
+
+   append page [join $detail_list ", "]
+   if {$report_type == "msgs_and_responses"} {
+       append page "<br><blockquote>$message</blockquote>"
+       set responses ""
+
+       # show responses
+       set sub_selection [ns_db select $db2 "select 
+  response_id, public_p,
+  users.first_names || ' ' || users.last_name as name,
+  to_char(posting_time, [ticket_date_format]) as posting_date,
+  ticket_issue_responses.message as followup_text
+from ticket_issue_responses, users
+where ticket_issue_responses.user_id = users.user_id
+and ticket_issue_responses.response_to = $message_id
+order by posting_time"] 
+       
+       while { [ns_db getrow $db2 $sub_selection] } {
+	   set_variables_after_subquery
+	   set text "$followup_text <br><i>Submitted by $name on $posting_date</i>"
+	   lappend responses $text
+       }
+       
+       if { ![empty_string_p $responses] } {
+	   append page "<br>Comments
+<blockquote>
+[join $responses "<p>"]
+</blockquote>
+"
+       }
+   }
+   append page "<br>"
+   incr i
+}
+
+
+
+ns_write "
+$page
+[ad_footer]
+"
Index: web/openacs/www/ticket/admin/issue-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/issue-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/issue-edit.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,52 @@
+set_the_usual_form_variables
+
+# msg_id, deadline, priority, status, project_id, one_line, ticket_type
+# public_p, data1, data2, data3, email
+#
+# contact_name, contact_email, contact_info
+# prev_priority prev_status 
+
+set db [ticket_getdbhandle]
+
+
+set formdata [ns_set copy [ns_conn form]]
+
+if {[empty_string_p [set ColValue.deadline.month]] && [empty_string_p [set ColValue.deadline.day]]} {
+    ns_set update $formdata ColValue.deadline.year ""
+}
+
+if [catch {ns_dbformvalue $formdata deadline date deadline} error] {
+    ad_return_complaint 1 "<li>Error parsing the deadline date: $error
+<br>Please specify a month, day, and four digit year for the deadline.\n"
+    return
+}
+
+update_last_modified_info $db $msg_id 
+
+ns_db dml $db "update ticket_issues set deadline = '$deadline', 
+priority = '$priority', one_line = '$QQone_line',
+severity = '$severity',
+status='$QQstatus', project_id=$project_id ,
+ticket_type='$QQticket_type', 
+contact_name='$QQcontact_name',
+contact_email='$QQcontact_email',
+contact_info1='$QQcontact_info',
+public_p = '$public_p'
+where
+msg_id = $msg_id"
+
+foreach field [ticket_picklist_field_names] {
+    if {[info exists $field]} {
+	set entry [ticket_picklist_field_info $field]
+	set column_name [ticket_picklist_entry_column_name $entry]
+	ns_db dml $db "update ticket_issues set $column_name = '[DoubleApos [set $field]]' 
+	where
+	msg_id = $msg_id"
+    }
+}
+
+if { [string compare $prev_status $status] != 0} {
+    ns_returnredirect "issue-changed-status.tcl?[export_url_vars msg_id status]"
+} else {
+    ns_returnredirect "issue-view.tcl?[export_url_vars msg_id]"
+}
Index: web/openacs/www/ticket/admin/issue-fix-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/issue-fix-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/issue-fix-2.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,83 @@
+# User is moving  this ticket to "fixed waiting approval" status.
+# An explanatory comment is in message
+
+set_the_usual_form_variables
+
+# msg_id, message
+# notify_creator_p
+
+set user_id [ad_get_user_id]
+set db [ticket_getdbhandle]
+
+set exception_text ""
+set exception_count 0
+
+if [catch { set n_previous [database_to_tcl_string $db "select count(*)
+from ticket_issue_responses
+where response_to = $msg_id
+and user_id = $user_id
+and dbms_lob.instr(message,'[bboard_convert_plaintext_to_html $message]') > 0"]} errmsg] {
+    ns_log Notice "failed trying to look up previous posting: $errmsg"
+} else {
+    # lookup succeeded
+    if { $n_previous > 0 } {
+	incr exception_count
+	append exception_text "<li>There are already $n_previous responses from you with the same body.
+Perhaps you already posted this?
+If you are sure that you also want to add this issue, 
+back up and change at least one character in the subject 
+or message area, then resubmit."
+    }
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# gets around clob driver problem with and empty string
+if [empty_string_p $message] {
+    set message " "
+}
+
+set selection [ns_db 1row $db "select one_line, title, 
+ticket_issues.project_id, notify_p
+from ticket_issues, ticket_projects
+where ticket_issues.project_id = ticket_projects.project_id
+and msg_id = $msg_id"]
+set_variables_after_query
+
+set message_in_html [bboard_convert_plaintext_to_html $message]
+
+if {![info exists notify_creator_p]} {
+    set notify_creator_p "f"
+}
+
+with_transaction $db {
+
+    update_last_modified_info $db $msg_id 
+
+    ns_db dml $db "update ticket_issues 
+    set status='fixed waiting approval' where msg_id = $msg_id"
+    ns_ora clob_dml $db "insert into ticket_issue_responses (response_id,response_to,user_id,message,posting_time) values (ticket_response_id_sequence.nextval,$msg_id,$user_id,empty_clob(),sysdate) returning message into :1" $message_in_html
+    # send notifcation email
+    if { $notify_p == "t" } {
+	send_ticket_change_notification $db $msg_id $message $user_id $notify_creator_p
+    }
+} {
+    # something went a bit wrong during the insert
+    ns_return 200 text/html "[ad_header "Error Changing Issue Status"]
+<h3>Ouch!!</h3>
+<hr>
+We encountered a problem processing your entry.
+Here was the bad news from the database:
+<pre>
+$errmsg
+</pre>
+[ad_footer]
+"
+    return
+}
+
+
+ns_returnredirect "project-top.tcl?project_id=$project_id"
\ No newline at end of file
Index: web/openacs/www/ticket/admin/issue-fix.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/issue-fix.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/issue-fix.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,30 @@
+set_form_variables
+# msg_id
+
+set db [ticket_getdbhandle]
+
+set selection [ns_db 1row $db "select one_line, 
+ticket_issues.project_id, ticket_projects.title
+from ticket_issues, ticket_projects
+where msg_id = $msg_id
+and ticket_projects.project_id = ticket_issues.project_id"]
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "[ad_header "Fix Issue"]
+<h2>Fix Issue</h2>
+<a href=\"issue-view.tcl?msg_id=$msg_id\">[clean_up_html $one_line]</a>
+for project <a href=\"project-top.tcl?project_id=$project_id\">$title</a>
+in <a href=\"index.tcl\">[ticket_system_name]</a>
+<hr>
+Please say why are changing the status of this issue.
+<form action=\"issue-fix-2.tcl\" method=get>
+[export_form_vars msg_id]
+<textarea name=message rows=10 cols=70 wrap=physical></textarea>
+<p><input type=checkbox name=public_p value=t>Make this response publicly readable?
+<p><input type=checkbox name=notify_creator_p value=t>Send email notification to this ticket's creator?
+<center><input type=submit value=Submit></center>
+</form>
+[ad_footer]
+"
Index: web/openacs/www/ticket/admin/issue-new-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/issue-new-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/issue-new-2.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,218 @@
+set_the_usual_form_variables
+
+# project_id, one_line, notify_p, message, priority
+#
+# contact_name, contact_info, source, ticket_type
+# email
+#
+# and any defined picklist field names
+# 
+
+set url "[ns_conn location]/ticket/admin"
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+set formdata [ns_set copy [ns_conn form]]
+
+if {[empty_string_p [set ColValue.deadline.month]] && [empty_string_p [set ColValue.deadline.day]]} {
+    ns_set update $formdata ColValue.deadline.year ""
+}
+
+if [catch {ns_dbformvalue $formdata deadline date deadline} error] {
+    ad_return_complaint 1 "<li>Error parsing the deadline date: $error
+<br>Please specify a month, day, and four digit year for the deadline.\n"
+    return
+}
+
+# check input
+set exception_text ""
+set exception_count 0
+
+set selection [ns_db 1row $db "select email, first_names, last_name from users where user_id = $user_id"]
+
+set_variables_after_query
+
+
+set name "$first_names $last_name"
+set QQemail [DoubleApos $email]
+set QQname [DoubleApos $name]
+
+if { ![info exists project_id] || $project_id == "" } {
+    incr exception_count
+    append exception_text "<li>You somehow got here without a project specified.\n"
+}
+
+if { ![info exists one_line] || $one_line == "" } {
+    incr exception_count
+    append exception_text "<li>You must enter a subject line.\n"
+}
+
+if { ![info exists notify_p] || $notify_p == "" } {
+    incr exception_count
+    append exception_text "<li>You somehow got here without specifying notification.\n"
+}
+
+if { ![info exists message] || $message == "" } {
+    incr exception_count
+    append exception_text "<li>You have to say something about the issue.\n"
+}
+
+
+if {[info exists preformat] && $preformat == "yes"} {
+    set message_in_html "<pre>
+[clean_up_html $message]
+</pre>
+" } else {
+    set message_in_html [bboard_convert_plaintext_to_html $message]
+}
+
+if [catch { set n_previous [database_to_tcl_string $db "select count(*) from ticket_issues
+where one_line = '$QQone_line'
+and project_id = $project_id
+and dbms_lob.instr(message,'[bboard_convert_plaintext_to_html $QQmessage]') > 0"]} errmsg] {
+    ns_log Notice "failed trying to look up previous posting: $errmsg"
+} else {
+    # lookup succeeded
+    if { $n_previous > 0 } {
+	incr exception_count
+	append exception_text "<li>There are already $n_previous messages in the database with the same subject line and body.  Perhaps you already posted this?  Here are the messages:
+<ul>
+"
+        set selection [ns_db select $db "select first_names || ' ' || last_name as name, email, posting_time
+from ticket_issues, users
+where one_line = '$QQone_line'
+and project_id = $project_id
+and dbms_lob.instr(message,'[DoubleApos $message]') > 0
+and ticket_issues.user_id = users.user_id"]
+
+        while {[ns_db getrow $db $selection]} {
+	    set_variables_after_query
+	    append exception_text "<li>$posting_time by $name ($email)\n"
+	}
+	append exception_text "</ul>
+If you are sure that you also want to add this issue, 
+back up and change at least one character in the subject 
+or message area, then resubmit."
+    }
+}
+
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+ReturnHeaders
+
+set project_title [database_to_tcl_string $db "select title from ticket_projects where project_id = $project_id"]
+
+ns_write "[ad_header "Inserting a New Issue"]
+
+<h2>Inserting a New Issue</h2>
+
+[ad_context_bar_ws_or_index [list "/ticket/admin/index.tcl" "Ticket Tracker"]  "Ticket Created"]
+"
+
+ns_write "<hr>\n"
+
+# Collect up the picklist field values
+set picklist_columns {}
+set picklist_values {}
+foreach entry [ticket_picklist_data] {
+    set field_name [ticket_picklist_entry_field_name $entry]
+    set column_name [ticket_picklist_entry_column_name $entry]
+    lappend picklist_columns $column_name
+    lappend picklist_values "'[DoubleApos [set $field_name]]'"
+}
+
+# Tickets default to "open" status when created.
+set status "open"
+
+# Find if there is a default assignee
+set default_assignee [database_to_tcl_string_or_null $db "select default_assignee from
+ticket_projects 
+where project_id=$project_id"]
+
+if {[llength $picklist_columns] > 0} {
+    set custom_values ", [join $picklist_values {,}]"
+    set custom_field_names ",  [join $picklist_columns {,}]"
+} else {
+    set custom_values ""
+    set custom_field_names ""
+}
+
+with_transaction $db {
+    set new_id [database_to_tcl_string $db "select ticket_issue_id_sequence.nextval from dual"]
+    set indexed_stuff "$one_line $message $email $name $new_id"
+
+    ns_ora clob_dml $db "insert into ticket_issues
+    (msg_id,project_id,user_id,one_line,message,indexed_stuff,posting_time,priority, severity, notify_p, deadline, contact_name, contact_email, contact_info1, source, status, ticket_type, public_p, last_modified_by $custom_field_names)
+    values ($new_id,$project_id,$user_id,'$QQone_line',empty_clob(),empty_clob(),sysdate,$priority,'$severity','$notify_p', '$deadline', '$QQcontact_name', '$QQcontact_email', '$QQcontact_info', '$source', '$status', '$ticket_type', '$public_p', '$QQemail' $custom_values) 
+ returning message, indexed_stuff into :1, :2" $message_in_html $indexed_stuff
+
+    if {[info exists default_assignee] && \
+	    ![empty_string_p $default_assignee]} {
+	ns_db dml $db "insert into ticket_issue_assignments (msg_id, user_id, active_p) VALUES  ($new_id, $default_assignee, 't')"
+    }
+} {
+    # something went a bit wrong during the insert
+    ns_write "<h3>Ouch!!</h3>
+Here was the bad news from the database:
+<pre>
+$errmsg
+</pre>
+[ad_footer]
+"
+    return
+}
+
+
+ns_write "<h3>Success!!</h3>
+A new issue for project 
+<a href=\"project-top.tcl?project_id=$project_id\">$project_title</a>
+has been entered in the database:
+
+<br>
+
+#$new_id: [clean_up_html $one_line]
+
+<p>
+
+You can:<br>
+<ul>
+<li><a href=\"issue-view.tcl?msg_id=$new_id\">View issue details and make assignments</a>
+<li><a href=\"issue-new.tcl\">Add another issue</a>
+<li><a href=\"project-top.tcl?[export_url_vars project_id]\">Go to project page $project_title</a>
+<li><a href=\"index.tcl?[export_url_vars project_id]\">Return to main page</a>
+</ul>
+"
+
+#send out the email
+
+set ticket_email [ticket_reply_email_addr]
+set extra_headers [ns_set create] 
+ns_set update $extra_headers "Reply-to" $ticket_email
+
+if { $notify_p == "t" } {
+
+    set selection [ns_db select $db "select
+email as notify_email
+from users, ticket_assignments
+where project_id = $project_id 
+and users.user_id = ticket_assignments.user_id
+"]
+
+    while { [ns_db getrow $db $selection] } { 
+	set_variables_after_query
+	ns_sendmail $notify_email $email "New issue $one_line in project $project_title (TR#$new_id)" "Priority: $priority 
+Submitted By: $name 
+Description: $message
+
+Please use $url/issue-view.tcl?msg_id=$new_id to manage this issue." $extra_headers
+        ns_write "<br> Emailed $notify_email"
+   }
+}
+ns_write "
+[ad_footer]
+"
Index: web/openacs/www/ticket/admin/issue-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/issue-new.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/issue-new.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,124 @@
+set_form_variables 0
+# maybe project_id
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+set default_assignee ""
+
+
+if {[info exists project_id]} {
+    set project_title [database_to_tcl_string $db "select title 
+    from ticket_projects
+    where project_id = $project_id"]
+    set project_title "for $project_title, "
+
+
+} else {
+    set project_title ""
+    set project_id ""
+}
+
+
+# Get list of default user info
+set selection [ns_db 1row $db "select email, users.first_names || ' ' || users.last_name as pretty_name
+ from users
+ where  users.user_id = $user_id"]
+
+set_variables_after_query
+
+# Admin users get to choose project. 
+# Normal users are assigned automatially to "Tech Support" project
+
+ReturnHeaders
+
+append page "[ad_header "Create New Issue"]
+
+<h2>Create new issue</h2>
+
+[ad_context_bar_ws_or_index [list "/ticket/admin/index.tcl" "Ticket Tracker"]  "Create Ticket"]
+
+<hr>
+
+<blockquote>
+<form action=\"issue-new-2.tcl\" method=post>
+[export_form_vars email]
+
+<table border=0>"
+
+
+append page "<tr><th align=left>Subject:<td><input type=text name=one_line size=50</tr>"
+
+append page "<tr>
+<th valign=top align=left>Ticket Type:</th><td><select name=ticket_type>[ticket_html_select_ticket_type]</select>
+&nbsp;&nbsp;&nbsp;<b>Public?</b>
+<input type=radio name=public_p value=t CHECKED> Yes
+<input type=radio name=public_p value=f> No
+</td></tr>"
+
+append page "
+<tr><th align=left>Project:
+    <td><select name=project_id>
+    [ad_db_optionlist $db  "select title,
+    project_id from ticket_projects
+    order by title asc" $project_id]
+    </select>
+    </td></tr>
+"
+
+append page "
+<tr><td align=left><b>Severity:</b><td>
+<select name=severity>
+[ad_generic_optionlist [ticket_severity_types] [ticket_severity_types] normal]
+</select></td></tr>
+"
+
+
+append page "<tr><th align=left>Deadline:</th><td>[ticket_dateentrywidget_with_nulls deadline [export_var deadline [database_to_tcl_string $db "select to_char(sysdate, 'yyyy') from dual"]]]</td></tr>
+
+"
+
+
+append page "<tr><th align=left>Priority:
+    <td><select name=priority>
+[ad_db_optionlist $db  "select name, priority from ticket_priorities order by priority" 2]
+</select></tr>
+"
+
+append page "
+<tr><th align=left>Contact Name:</th><td><input type=text name=contact_name size=50 [export_form_value pretty_name]></tr>
+<tr><th align=left>Contact Email:</th><td><input type=text name=contact_email size=50  [export_form_value email]></tr>
+
+<tr><th align=left>Contact Info:</th><td><textarea rows=3 cols=40 name=contact_info></textarea></tr>
+"
+
+foreach field [ticket_picklist_field_names] { 
+    append page "<tr>[ticket_picklist_html_fragment $field]</tr>\n"
+}
+
+append page "<tr><th align=left>Ticket Source:</th><td><select name=source><option>external</option>
+<option selected>internal</option>
+</select></td></tr>
+"
+append page "
+<tr><th valign=top  align=left>Notify Project Members<br>(via email)</th>
+    <td valign=top><input type=radio name=notify_p value=t CHECKED> Yes
+        <input type=radio name=notify_p value=f> No</tr>
+"
+
+
+
+append page "<tr><th align=left>Message<td></tr>
+</table>
+<textarea name=message rows=10 cols=64 wrap=hard></textarea>
+<br>
+<b>Preserve fixed formatting of message?</b> <input type=checkbox checked name=preformat value=yes>
+<br>
+<center><input type=submit value=Submit></center>
+</form>
+</blockquote>
+[ad_footer]
+"
+
+ns_write $page
Index: web/openacs/www/ticket/admin/issue-reopen-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/issue-reopen-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/issue-reopen-2.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,70 @@
+set_the_usual_form_variables
+# msg_id, message
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+set exception_text ""
+set exception_count 0
+
+if [catch { set n_previous [database_to_tcl_string $db "select count(*)
+from ticket_issue_responses
+where response_to = $msg_id
+and user_id = $user_id
+and dbms_lob.instr(message,'[bboard_convert_plaintext_to_html $message]') > 0"]} errmsg] {
+    ns_log Notice "failed trying to look up previous posting: $errmsg"
+} else {
+    # lookup succeeded
+    if { $n_previous > 0 } {
+	incr exception_count
+	append exception_text "<li>There are already $n_previous responses from you with the same body.
+Perhaps you already posted this?
+If you are sure that you also want to add this issue, 
+back up and change at least one character in the subject 
+or message area, then resubmit."
+    }
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# gets around clob driver problem with and empty string
+if [empty_string_p $message] {
+    set message " "
+}
+
+set selection [ns_db 1row $db "select one_line, title, ticket_issues.project_id
+from ticket_issues, ticket_projects
+where ticket_issues.project_id = ticket_projects.project_id
+and msg_id = $msg_id"]
+set_variables_after_query
+
+set message_in_html [bboard_convert_plaintext_to_html $message]
+
+with_transaction $db {
+
+    update_last_modified_info $db $msg_id 
+
+    ns_db dml $db "update ticket_issues 
+set close_date = null, closed_by = null, status='open' where msg_id = $msg_id"
+    ns_ora clob_dml $db "insert into ticket_issue_responses (response_id,response_to,user_id,message,posting_time) values (ticket_response_id_sequence.nextval,$msg_id,$user_id,empty_clob(),sysdate) returning message into :1" $message_in_html
+} {
+    # something went a bit wrong during the insert
+    ns_return 200 text/html "[ad_header "Error Reopening Issue"]
+<h3>Ouch!!</h3>
+<hr>
+We encountered a problem reopening your issue.
+Here was the bad news from the database:
+<pre>
+$errmsg
+</pre>
+[ad_footer]
+"
+    return
+}
+
+
+ns_returnredirect "issue-view.tcl?msg_id=$msg_id"
\ No newline at end of file
Index: web/openacs/www/ticket/admin/issue-reopen.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/issue-reopen.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/issue-reopen.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,31 @@
+set_form_variables
+# msg_id
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+
+set selection [ns_db 1row $db "select one_line, 
+ticket_issues.project_id, ticket_projects.title
+from ticket_issues, ticket_projects
+where msg_id = $msg_id
+and ticket_projects.project_id = ticket_issues.project_id"]
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "[ad_header "Reopen Issue"]
+<h2>Reopen Issue</h2>
+<a href=\"issue-view.tcl?msg_id=$msg_id\">[clean_up_html $one_line]</a>
+for project <a href=\"project-top.tcl?project_id=$project_id\">$title</a>
+in <a href=\"index.tcl\">[ticket_system_name]</a>
+<hr>
+Please say why you are reopening this closed issue.
+<form action=\"issue-reopen-2.tcl\" method=get>
+[export_form_vars msg_id]
+<textarea name=message rows=10 cols=70 wrap=physical></textarea>
+<center><input type=submit value=Submit></center>
+</form>
+[ad_footer]
+"
Index: web/openacs/www/ticket/admin/issue-response-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/issue-response-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/issue-response-2.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,45 @@
+set_the_usual_form_variables
+# msg_id, message, public_p
+
+set user_id [ad_get_user_id]
+set db [ticket_getdbhandle]
+
+set exception_text ""
+set exception_count 0
+
+if {[info exists preformat] && $preformat == "yes"} {
+    set message_in_html "<pre>
+[clean_up_html $message]
+</pre>
+" } else {
+    set message_in_html [bboard_convert_plaintext_to_html $message]
+    set preformat no
+}
+
+ReturnHeaders
+
+append page "[ad_header "Preview Add Response To Ticket"]
+
+<h2>Preview New Response For Ticket #$msg_id</h2>
+
+
+<hr>
+
+Below is how your response will appear in the list of ticket responses.
+If you approve, press the Submit button below, otherwise hit back in your
+browser and try again.
+<p>
+<blockquote>
+$message_in_html
+</blockquote>
+<form action=issue-response-3.tcl method=post>
+[export_form_vars msg_id message preformat public_p]
+<center><input type=submit value=Submit>
+</center>
+</form>
+<p>
+[ad_footer]
+"
+
+
+ns_write $page
Index: web/openacs/www/ticket/admin/issue-response-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/issue-response-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/issue-response-3.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,92 @@
+set_the_usual_form_variables
+# msg_id, message, public_p
+
+set user_id [ad_get_user_id]
+set db [ticket_getdbhandle]
+
+set exception_text ""
+set exception_count 0
+
+if {[info exists preformat] && $preformat == "yes"} {
+    set message_in_html "<pre>
+[clean_up_html $message]
+</pre>
+" } else {
+    set message_in_html [bboard_convert_plaintext_to_html $message]
+}
+
+
+if [catch { set n_previous [database_to_tcl_string $db "select count(*) 
+from ticket_issue_responses
+where response_to = $msg_id
+and user_id = $user_id
+and dbms_lob.instr(message,'[DoubleApos $message_in_html]') > 0"]} errmsg] {
+    ns_log Notice "failed trying to look up previous posting: $errmsg"
+} else {
+    # lookup succeeded
+    if { $n_previous > 0 } {
+	incr exception_count
+	append exception_text "<li>There are already $n_previous responses from you with the same body.
+Perhaps you already posted this?
+If you are sure that you also want to add this issue, 
+back up and change at least one character in the subject 
+or message area, then resubmit."
+    }
+}
+
+if {$exception_count > 0} {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# Default is for customer responses to be public, but staff responses
+# to be private
+
+if {![info exists public_p]} {
+    set public_p "f"
+}
+
+if {![info exists notify_creator_p]} {
+    set notify_creator_p "f"
+}
+
+
+
+set selection [ns_db 1row $db "select one_line, title, ticket_issues.project_id, notify_p
+from ticket_issues, ticket_projects
+where ticket_issues.project_id = ticket_projects.project_id
+and msg_id = $msg_id"]
+set_variables_after_query
+
+with_transaction $db {
+    set new_response_id [database_to_tcl_string $db "select ticket_response_id_sequence.nextval from dual"]
+    ns_ora clob_dml $db "insert into ticket_issue_responses (response_id,response_to,user_id, public_p, message,posting_time) values ($new_response_id,$msg_id,$user_id, '$public_p', empty_clob(),sysdate) returning message into :1" $message_in_html
+
+    ns_db dml $db "begin ticket_update_for_response($new_response_id); end;"
+} {
+    # something went a bit wrong during the insert
+    ns_return 200 text/html "[ad_header "Error Adding a Response"]
+<h3>Ouch!!</h3>
+<hr>
+We encountered a problem inserting your response.
+Here was the bad news from the database:
+<pre>
+$errmsg
+</pre>
+[ad_footer]
+"
+    return
+}
+
+
+
+#send out the email
+if { $notify_p == "t" } {
+    send_ticket_change_notification $db $msg_id $message $user_id $notify_creator_p
+}
+
+
+ns_returnredirect "issue-view.tcl?msg_id=$msg_id"
+
+
+
Index: web/openacs/www/ticket/admin/issue-response.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/issue-response.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/issue-response.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,35 @@
+set_form_variables
+# msg_id
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+set selection [ns_db 1row $db "select one_line, ticket_issues.project_id, ticket_projects.title
+from ticket_issues, ticket_projects
+where msg_id = $msg_id
+and ticket_projects.project_id = ticket_issues.project_id"]
+set_variables_after_query
+
+ReturnHeaders
+
+ns_write "[ad_header "Write a Response"]
+<h2>Write a Response</h2>
+to <a href=\"issue-view.tcl?msg_id=$msg_id\">[clean_up_html $one_line]</a>
+for project <a href=\"project-top.tcl?project_id=$project_id\">$title</a>
+in <a href=\"index.tcl\">[ticket_system_name]</a>
+<hr>
+<form action=\"issue-response-2.tcl\" method=post>
+[export_form_vars msg_id]
+Enter message in textarea below, then click submit.<br>
+<textarea name=message rows=10 cols=50 wrap=physical></textarea>
+"
+
+ns_write "<p><input type=checkbox name=public_p value=t>Make this response publicly readable?
+<p><input type=checkbox name=notify_creator_p value=t>Send email notification to this ticket's creator?
+<p>
+ <input type=checkbox name=preformat value=yes> Preserve fixed text formatting?
+<P><center><input type=submit value=Submit></center>
+</form>
+[ad_footer]
+"
Index: web/openacs/www/ticket/admin/issue-search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/issue-search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/issue-search.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,84 @@
+set_the_usual_form_variables
+# query_string, project_id (optional)
+#
+#
+# target - 
+# passthrough -  msg_id
+
+set db [ticket_getdbhandle]
+
+if { ![info exists query_string] || $query_string == "" } {
+    # probably using MSIE
+    ns_return 200 text/html "[ad_header "Missing Query"]
+<h2>Missing Query</h2>
+<hr>
+Either you didn't type a query string or you're using a quality Web
+browser like Microsoft Internet Explorer 3.x (which neglects to 
+pass user input up the server).
+[ad_footer]
+"
+    return
+}
+
+# we ask for all the top level messages
+
+ReturnHeaders
+
+ns_write "[ad_header "Search Results"]
+<h2>Messages matching \"$query_string\"</h2>
+in the <a href=\"index.tcl\">[ticket_system_name]</a>
+<hr>
+<ul>
+"
+
+if {[info exists project_id] && ![empty_string_p $project_id]} {
+    set restrict_by_project_id_clause "ticket_issues.project_id = $project_id and "
+} else {
+    set restrict_by_project_id_clause " "
+}
+
+set selection [ns_db select $db "select msg_id xmsg_id , one_line, ticket_issues.project_id, ticket_projects.title from 
+ticket_issues, ticket_projects 
+where ticket_projects.project_id = ticket_issues.project_id and
+$restrict_by_project_id_clause
+upper(dbms_lob.substr(indexed_stuff,4000)) like upper('%$query_string%')
+order by title, xmsg_id"]
+
+set counter 0
+
+set last_title ""
+ns_write "<ul>"
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+    if {$title != $last_title} {
+	ns_write "</ul><b>$title</b><ul>"
+    }
+    set last_title $title
+	ns_write "<li><a href=\"$target?[eval "export_url_vars $passthrough"]\">\[$xmsg_id\] [clean_up_html $one_line]</a>\n"
+}
+
+ns_write "</ul>"
+
+if { $counter == 0 } {
+    set search_items "messages"
+    ns_write "No matching items found.<p>
+    <a href=\"$target?[eval "export_url_vars $passthrough"]\">"
+}
+ns_write "
+</ul>
+[ad_footer]
+"
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/ticket/admin/issue-view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/issue-view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/issue-view.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,377 @@
+# This page is for viewing an issue as a privileged user - 
+
+# Most data fields are modifiable
+
+set_the_usual_form_variables
+
+# msg_id
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+set selection [ns_db 0or1row $db "select 
+to_char(posting_time, [ticket_date_format]) as posting_date,
+deadline, one_line, message, priority, ticket_type,  email name, status
+from ticket_issues, users
+where msg_id = $msg_id
+and users.user_id = ticket_issues.user_id"]
+
+if { $selection == "" } {
+    # message was probably deleted
+    ad_return_complaint 1 "<li>Couldn't find message $msg_id.  Probably it was deleted by the forum maintainer."
+    return
+}
+
+set_variables_after_query
+set this_one_line $one_line
+
+
+set selection [ns_db 1row $db "select 
+ title, ticket_issues.project_id, notify_p, public_p,
+ ticket_issues.last_modified_by, 
+ ticket_issues.severity, 
+ ticket_issues.data1, 
+ ticket_issues.data2, 
+ ticket_issues.data3, 
+ ticket_issues.data4, 
+ ticket_issues.data5, 
+ to_char(ticket_issues.modification_time, 'Month dd, yyyy hh24:mi:ss') as modification_time,
+ ticket_issues.contact_name,
+ ticket_issues.contact_email,  ticket_issues.contact_info1,
+ to_char(close_date, [ticket_date_format]) close_date,  ticket_priorities.name  as priority_name, ticket_priorities.priority
+from ticket_projects, ticket_issues, users, ticket_priorities
+where ticket_projects.project_id = ticket_issues.project_id
+and ticket_issues.msg_id = $msg_id
+and users.user_id(+) = closed_by
+and ticket_priorities.priority = ticket_issues.priority"]
+
+set_variables_after_query
+
+
+# get current user's email, to export as the "last modified by" value
+set email [database_to_tcl_string $db "select email from users where user_id=[ad_get_user_id]"]
+
+
+#if { [empty_string_p $deadline] } {
+#    set deadline [ns_localsqltimestamp]
+#}
+
+if { $public_p == "t" } {
+    set PUBLIC_Y_CHECKED checked
+    set PUBLIC_N_CHECKED ""
+} else {
+    set PUBLIC_N_CHECKED checked
+    set PUBLIC_Y_CHECKED ""
+}
+
+ReturnHeaders
+
+if {[info exists deadline] && [empty_string_p $deadline]} {
+    unset deadline
+}
+
+append page "[ad_header [clean_up_html $one_line]]
+
+<h2>Ticket #$msg_id</h2>
+
+[ad_context_bar_ws_or_index [list "/ticket/admin/index.tcl" "Ticket Tracker"] [list "project-top.tcl?project_id=$project_id" $title] "One Ticket"]
+
+<hr>
+
+<h2>$ticket_type \#$msg_id: [clean_up_html $one_line]</h2>
+<blockquote>
+<table border=0><tr><td bgcolor=#f0f0f0>$message</td></tr></table>
+</blockquote>
+
+<form action=issue-edit.tcl method=post>
+<input type=hidden name=prev_status [export_form_value status]>
+[export_form_vars email msg_id]
+
+<blockquote>
+<table border=0 cellspacing=3>
+<tr>
+  <th valign=top align=left>Subject:</th>
+  <td><input size=64 maxsize=200 type=text name=one_line [export_form_value one_line]></td>
+<tr>
+<th valign=top align=left>Ticket Type:</th><td><select name=ticket_type>[ticket_html_select_ticket_type $ticket_type]</select>
+&nbsp;&nbsp;&nbsp;<b>Public?</b>
+<input type=radio name=public_p value=t $PUBLIC_Y_CHECKED> Yes
+<input type=radio name=public_p value=f $PUBLIC_N_CHECKED> No
+</tr>"
+
+# Status
+append page "
+<tr><td align=left><b>Status:</b><td>"
+
+if {[string compare $status "closed"] == 0} {
+    append page "Closed (<a href=\"issue-reopen.tcl?msg_id=$msg_id\">Reopen this issue</a>)\n [export_form_vars status]" 
+} else {
+    append page "<select name=status>
+[ad_generic_optionlist [ticket_status_types] [ticket_status_types] $status]
+</select>
+"
+}
+
+# Project
+append page "</td></tr>
+<tr><th align=left>Project:<td><select name=project_id>
+[ad_db_optionlist $db  "select title,
+project_id from ticket_projects
+order by title asc" $project_id]
+</select>
+</td></tr>"
+
+# Severity
+append page "<tr><td align=left><b>Severity:</b><td>"
+append page "<select name=severity>
+[ad_generic_optionlist [ticket_severity_types] [ticket_severity_types] $severity]
+</select></td></tr>
+"
+
+# Deadline
+append page "
+<tr><td align=left><b>Deadline:</b><td>[ticket_dateentrywidget_with_nulls deadline [export_var deadline  [database_to_tcl_string $db "select to_char(sysdate, 'yyyy') from dual"]]]
+</tr>"
+
+# Priority
+append page "<tr><td align=left><b>Priority:</b><td><select name=priority>
+[ad_db_optionlist $db  "select name, priority from ticket_priorities order by priority" $priority]
+</select>
+<input type=hidden name=prev_priority [export_form_value priority]>
+</tr>"
+
+
+
+append page "<input type=hidden name=prev_severity [export_form_value severity]>"
+
+append page "<tr><th align=left>Contact Name</th><td><input type=text name=contact_name [export_form_value contact_name] size=50></tr>"
+
+append page "<tr><th align=left>Contact Email</th><td><input type=text name=contact_email [export_form_value contact_email] size=50></tr>"
+
+append page "<tr><th align=left>Contact Info</th><td><textarea rows=3 cols=40 name=contact_info>$contact_info1</textarea></tr>"
+
+
+# Show customizable picklist fields
+foreach field [ticket_picklist_field_names] { 
+    set entry [ticket_picklist_field_info $field]
+    append page "<tr>[ticket_picklist_html_fragment $field [set [ticket_picklist_entry_column_name $entry]]]</tr>\n"
+}
+
+append page "</td></tr>
+<tr><td align=left valign=top><b>Notify project<br>members via email:</b>
+"
+
+if {$notify_p == "t" } {
+    append page "<td valign=top>Yes (<a href=\"notification-set.tcl?msg_id=$msg_id&notify=f&return_url=[ns_urlencode "issue-view.tcl?msg_id=$msg_id"]\">toggle</a>)</tr>\n"
+} else {
+    append page "<td valign=top>No (<a href=\"notification-set.tcl?msg_id=$msg_id&notify=t&return_url=[ns_urlencode "issue-view.tcl?msg_id=$msg_id"]\">toggle</a>)</tr>\n"
+}
+
+append page "
+<tr><td align=left><b>Submitted By:</b><td>$name on $posting_date</tr>
+<tr><td align=left><b>Last Modified By:</b><td>$last_modified_by on $modification_time</tr></tr>
+"
+
+append page "<tr><td colspan=2 align=center>
+<input type=submit name=submit value=\"Update\">
+</td></tr>
+
+</form>
+"
+
+if { $close_date != "" } {
+    append page "<tr><td align=left><b>Closed On:</b><td>$close_date</tr>\n"
+}
+
+append page "
+
+</table>
+</blockquote>
+<p>
+"
+
+
+set selection [ns_db select $db "select 
+ response_id, public_p,
+ users.first_names || ' ' || users.last_name as name,
+ to_char(posting_time, [ticket_date_format]) as posting_date,
+ message
+from ticket_issue_responses, users
+where ticket_issue_responses.user_id = users.user_id
+and ticket_issue_responses.response_to = $msg_id
+order by posting_time"] 
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    set text "<blockquote>
+    $message
+    </blockquote>
+    Submitted by $name on $posting_date, "
+
+    if {$public_p == "t"} {
+	 append text "<i>Public?</i> Yes (<a href=\"set-response-visibility.tcl?response_id=$response_id&public_p=f&msg_id=$msg_id\">toggle</a>)"
+    } else {
+	append text  "<i>Public?</i> No (<a href=\"set-response-visibility.tcl?response_id=$response_id&public_p=t&msg_id=$msg_id\">toggle</a>)"
+    }
+
+    lappend responses $text
+
+}
+
+if { [info exists responses] } {
+    append page "<b>Comments</b>
+    [join $responses "<hr width=300>"]
+    "
+}
+
+append page "<ul>"
+
+if { $close_date == "" } {
+    append page "<li><a href=\"issue-response.tcl?msg_id=$msg_id\">Add comment to \"[clean_up_html $one_line]\"</a>
+<li><a href=\"issue-close.tcl?[export_url_vars msg_id ticket_type]\">Close this issue</a>
+<li><a href=\"issue-fix.tcl?[export_url_vars msg_id ticket_type]\">Fix this issue</a>
+
+"
+} 
+
+
+append page "
+</ul>"
+
+# List xrefs
+append page "<b>Related Issues</b>
+<br>
+"
+set selection [ns_db select $db "select to_ticket, one_line as xone_line, msg_id as xmsg_id
+from ticket_xrefs, ticket_issues
+where  to_ticket = ticket_issues.msg_id and 
+from_ticket=$msg_id 
+union
+select to_ticket, one_line xone_line, msg_id xmsg_id
+from ticket_xrefs, ticket_issues
+where  from_ticket = ticket_issues.msg_id and 
+to_ticket=$msg_id 
+"]
+
+
+# target for subroutine pages to return to this page
+set target "issue-view.tcl"
+append page "<ul>"
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append page "<li><a href=\"issue-view.tcl?msg_id=$xmsg_id\">\[$xmsg_id\] $xone_line</a>&nbsp;&nbsp; <a href=\"unlink-xref.tcl?from_msg_id=$msg_id&to_msg_id=$xmsg_id&[export_url_vars target]\">(unlink)</a>"
+}
+
+append page "<p><li><a href=\"add-xref-search.tcl?[export_url_vars target msg_id one_line]\">Add a cross-reference</a>"
+
+append page "</ul>"
+
+# View change log
+append page "<p>
+<ul>
+<li><a href=issue-change-log.tcl?msg_id=$msg_id>View Change History</a>
+<li><a href=\"issue-new.tcl?project_id=$project_id\">Add a new issue.</a>
+</ul>
+
+
+<p>
+<b>Assignment</b>
+<table border=1 cellpadding=10>
+<tr>
+<th>Users assigned to this issue</th>
+<th>Candidates for assignment</th>
+</tr>
+<tr valign=top><td><ul>
+"
+
+# query for the users assigned to this issue already
+set selection [ns_db select $db "select first_names, last_name, email, users.user_id
+from users, ticket_issue_assignments 
+where users.user_id = ticket_issue_assignments.user_id 
+AND msg_id=$msg_id"]
+
+append page "
+<form method=get action=issue-deassign-user.tcl>
+[export_form_vars msg_id project_id]
+
+<select name=assignee_id>"
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append page "<option value=$user_id>$last_name, $first_names ($email)</option>
+"
+}
+
+
+append page "</select>
+<input type=submit value=\"Deassign User\">
+</form>"
+
+
+append page  "</ul>
+<br>
+</td>
+
+<td>
+"
+
+# query for the users on the relevant project 
+# but not assigned to this issue already
+
+set ticket_group [ticket_admin_group $db]
+
+set selection [ns_db select $db "select users.user_id, first_names, last_name, email
+from ticket_assignments, users_active users 
+where ticket_assignments.user_id = users.user_id 
+and ticket_assignments.project_id = $project_id
+and ticket_assignments.user_id NOT IN 
+    (SELECT ticket_issue_assignments.user_id 
+     from ticket_issue_assignments, ticket_issues
+     where ticket_issues.msg_id=$msg_id
+     and ticket_issue_assignments.msg_id = ticket_issues.msg_id)
+union
+select users.user_id, first_names, last_name, email
+from user_group_map, users_active users where 
+user_group_map.user_id = users.user_id 
+and user_group_map.group_id = $ticket_group
+and users.user_id NOT IN 
+    (SELECT ticket_issue_assignments.user_id 
+     from ticket_issue_assignments, ticket_issues
+     where ticket_issues.msg_id=$msg_id
+     and ticket_issue_assignments.msg_id = ticket_issues.msg_id)
+order by last_name
+"]
+
+append page "
+<form method=get action=issue-assign-user.tcl>
+[export_form_vars msg_id project_id]
+
+<select name=assignee_id>"
+
+while {[ns_db getrow $db $selection]}  {
+    set_variables_after_query
+    append page "<option value=$user_id>$last_name, $first_names ($email)</option>
+"
+}
+
+append page "</select>
+<input type=submit value=\"Assign User\">
+</form>
+
+</ul>
+<p>
+</form>
+</td>
+</tr>
+</table>
+"
+
+
+
+append page "[ad_footer]"
+
+ns_write $page
+
+
+
Index: web/openacs/www/ticket/admin/list-issues.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/list-issues.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/list-issues.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,128 @@
+# List a set of tickets in a report 
+#
+# form vars:
+# report_type = "Ticket Summaries" "Complete Ticket Reports"
+# msg_ids  = semicolon separated list 
+# search_items 
+#
+
+set_form_variables
+
+set db_list [ns_db gethandle main 2]
+set db   [lindex $db_list 0]
+set db2   [lindex $db_list 1]
+
+set user_id [ad_get_user_id]
+
+ReturnHeaders
+ns_write "[ad_header $report_type]
+<h2>$report_type</h2>
+
+[ad_context_bar_ws_or_index [list "/ticket/admin/index.tcl" "Ticket Tracker"]  "Report"]
+
+<hr>
+<ul>
+"
+
+foreach item $search_items {
+    ns_write "<li>$item
+"
+}
+ns_write "
+</ul>
+
+<br>
+
+"
+
+# get multiple values of cgi var 'msg_id'
+
+set msg_id_list {}
+set form [ns_getform] 
+set form_size [ns_set size $form]
+set form_counter_i 0
+while {$form_counter_i<$form_size} {
+    set varname [ns_set key $form $form_counter_i]
+    if {$varname == "msg_ids"} {
+	lappend msg_id_list [ns_set value $form $form_counter_i]
+    }
+    incr form_counter_i
+}
+
+
+
+set selection [ns_db select $db "select ticket_issues.*, ticket_priorities.name, 
+ticket_projects.title as project_title, 
+users.first_names,
+users.last_name
+from ticket_issues, ticket_projects, ticket_priorities, users where
+users.user_id = ticket_issues.user_id 
+and ticket_issues.priority = ticket_priorities.priority
+and ticket_projects.project_id = ticket_issues.project_id
+and msg_id in ([join $msg_id_list ","])"]
+
+
+set i 0
+set msgs_displayed_already [list]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { [lsearch $msgs_displayed_already msg_id] != -1 } {
+	continue
+    } else {
+	lappend msgs_displayed_already $msg_id
+    }
+    ns_log Notice [NsSettoTclString $selection]
+    set detail_list ""
+
+    set item_list_list { {"posting_time" "Creation Date:"} {"priority" "Priority:"} {"source" "Source:"} {"data1" ""} {"data2" ""} }
+
+    foreach item_list $item_list_list {
+	set variable [lindex $item_list 0]
+	set annotation [lindex $item_list 1]
+	if ![empty_string_p [set $variable]] {
+	    lappend detail_list "$annotation [set $variable]"
+	}
+    }
+    
+    ns_write "<br><b><a href=\"/ticket/admin/issue-view.tcl?[export_url_vars msg_id]\">\#$msg_id [clean_up_html $one_line]</a></b><br>"
+   if {[string tolower $status] == "closed"} {
+       ns_write " <font color=green>Status: closed</font> "
+   } else {
+       ns_write " Status: $status "
+   }
+   ns_write [join $detail_list " ; "]
+   if {$report_type == "Complete Ticket Reports"} {
+       ns_write "<br><b>Content:</b><blockquote>$message</blockquote>"
+       set responses ""
+
+       # show responses
+       set sub_selection [ns_db select $db2 "select 
+       response_id, public_p,
+       users.first_names || ' ' || users.last_name as name,
+       to_char(posting_time, [ticket_date_format]) as posting_date,
+       ticket_issue_responses.message as followup_text
+       from ticket_issue_responses, users
+       where ticket_issue_responses.user_id = users.user_id
+       and ticket_issue_responses.response_to = $msg_id
+       order by posting_time"] 
+       
+       while { [ns_db getrow $db2 $sub_selection] } {
+	   set_variables_after_subquery
+	   set text "$followup_text <br>
+	   <i>Submitted by $name on $posting_date</i>"
+	   lappend responses $text
+       }
+       
+       if { [info exists responses] } {
+	   ns_write "<br><b>Comments</b>
+	   <blockquote>
+	   [join $responses "<p>"]
+	   </blockquote>
+	   "
+       }
+   }
+   incr i
+}
+
+
Index: web/openacs/www/ticket/admin/notification-set.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/notification-set.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/notification-set.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,42 @@
+set_the_usual_form_variables
+# msg_id, notify
+# maybe return_url
+
+set db [ticket_getdbhandle]
+
+
+if { $notify == "f" } {
+    set sql "update ticket_issues set notify_p = 'f' where msg_id = $msg_id"
+} else {
+    set sql "update ticket_issues set notify_p = 't' where msg_id = $msg_id"
+}
+
+if { [catch {ns_db dml $db $sql} errmsg] } {
+    ns_return 200 text/html "[ad_header "Setting Notification Failed"]
+<h2>Setting Notification Failed</h2>
+Send email to [ad_system_owner].
+Here was the message:
+<pre>
+$errmsg
+</pre>
+Which resulted from the following SQL:
+<code>
+$sql
+</code>
+[ad_footer]
+"
+} elseif { [info exists return_url] } {
+    ns_returnredirect $return_url
+} elseif { $notify == "t" } {
+    ns_return 200 text/html "[ad_header "Setting Notification Succeeded"]
+<h2>Setting Notification Succeeded</h2>
+Project members will get notification messages for this issue.
+[ad_footer]
+"
+} else {
+    ns_return 200 text/html "[ad_header "Setting Notification Succeeded"]
+<h2>Setting Notification Succeeded</h2>
+Project members will no longer get notification messages for this issue.
+[ad_footer]
+"
+}
Index: web/openacs/www/ticket/admin/project-assign-default-user.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/project-assign-default-user.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/project-assign-default-user.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,24 @@
+# Makes a user the "default assignee" for new ticket
+set_form_variables
+#  project_id, assignee_id
+
+set db [ticket_getdbhandle]
+
+
+if {[info exists assignee_id] && $assignee_id != "none"} {
+    ns_db dml $db "update ticket_projects set default_assignee = $assignee_id where project_id = $project_id"
+
+    # assign user to the project, if not already assigned
+    if {[database_to_tcl_string $db  "select count(*) from ticket_assignments where user_id=$assignee_id and project_id=$project_id"] < 1} {
+	ns_db dml $db "insert into ticket_assignments (assignment_id, project_id, user_id, active_p) VALUES  (ticket_assignment_id_sequence.nextval, $project_id, $assignee_id, 't')"
+    }
+} elseif {[info exists assignee_id] && [string compare $assignee_id "none"] == 0} {
+    ns_db dml $db "update ticket_projects set default_assignee = null where project_id = $project_id"
+} else {
+    # this should not happen unless someone resubmits a page or something.
+    # They are already assigned, so do nothing.
+}
+
+
+ns_returnredirect "project-top.tcl?project_id=$project_id"
+    
Index: web/openacs/www/ticket/admin/project-assign-user.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/project-assign-user.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/project-assign-user.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,15 @@
+set_the_usual_form_variables
+# project_id, assignee_id
+
+set db [ticket_getdbhandle]
+
+if {![info exists assignee_id] || [empty_string_p $assignee_id]} {
+    ad_return_complaint 1 "<li>You did not specify a user to assign to this project.\n"
+    return
+}
+
+
+ns_db dml $db "insert into ticket_assignments (assignment_id, project_id, user_id, active_p) VALUES  (ticket_assignment_id_sequence.nextval, $project_id, $assignee_id, 't')"
+
+ns_returnredirect "project-top.tcl?project_id=$project_id"
+    
\ No newline at end of file
Index: web/openacs/www/ticket/admin/project-deassign-user.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/project-deassign-user.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/project-deassign-user.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,9 @@
+set_the_usual_form_variables
+# project_id, assignee_id
+
+set db [ticket_getdbhandle]
+
+ns_db dml $db "delete from ticket_assignments 
+WHERE user_id=$assignee_id AND project_id=$project_id"
+
+ns_returnredirect "project-top.tcl?project_id=$project_id"
\ No newline at end of file
Index: web/openacs/www/ticket/admin/project-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/project-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/project-edit-2.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,11 @@
+set_the_usual_form_variables
+# customer_id, title, start_date
+
+ns_dbformvalue [ns_conn form] start_date date start_date
+
+set db [ticket_getdbhandle]
+
+
+ns_db dml $db "update ticket_projects set customer_id=$customer_id, title='$QQtitle', start_date='$start_date' where project_id=$project_id"
+
+ns_returnredirect "project-top.tcl?project_id=$project_id"
Index: web/openacs/www/ticket/admin/project-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/project-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/project-edit.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,61 @@
+set_the_usual_form_variables
+# project_id
+
+set db [ticket_getdbhandle]
+
+set selection [ns_db 1row $db  "select * from ticket_projects where project_id=$project_id"]
+set_variables_after_query
+
+set project_selection $selection
+
+ReturnHeaders
+ns_write "[ad_header "Project \#$project_id"]
+<h2>Project \#$project_id: $title</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Ticket Tracker"] [list "project-top.tcl?[export_url_vars project_id]" "One Project"] "Edit"]
+
+<hr>
+
+"
+
+set ticket_group_id [ticket_admin_group $db]
+
+set customer_select_html "<SELECT NAME=customer_id>\n"
+
+set selection [ns_db select $db "select first_names || ' ' || last_name || ' &lt;' || email || '&gt;' as name, users.user_id as customer_id
+from user_group_map, users 
+where user_group_map.user_id = users.user_id 
+and user_group_map.group_id = $ticket_group_id
+order by last_name"]
+
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append customer_select_html "<OPTION VALUE=$customer_id> $name\n"
+}
+
+append customer_select_html "</SELECT>\n"
+
+set project_form "<tr><td>Project Owner</td><td>$customer_select_html</td></tr>
+<tr><td>Project Title</td><td><INPUT type=text name=title size=30></td></tr>
+<tr><td>Start Date</td><td>[philg_dateentrywidget start_date $start_date]</td></tr>
+"
+
+set merged_form [bt_mergepiece $project_form $project_selection]
+
+ns_write "
+<FORM method=post action=\"project-edit-2.tcl\">
+<INPUT type=hidden name=project_id value=$project_id>
+<blockquote>
+<table noborder>
+$merged_form
+</table>
+</blockquote>
+<p>
+<center>
+<INPUT type=submit value=\"update project information\">
+</center>
+</FORM>
+<p>
+
+[ad_footer]"
Index: web/openacs/www/ticket/admin/project-end-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/project-end-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/project-end-2.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,11 @@
+set_form_variables
+
+# project_id
+
+set db [ns_db gethandle]
+
+ns_db dml $db "update ticket_projects 
+set end_date=SYSDATE
+where project_id=$project_id"
+
+ns_returnredirect "index.tcl"
Index: web/openacs/www/ticket/admin/project-end.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/project-end.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/project-end.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,26 @@
+set_form_variables
+
+# project-id, title
+
+set db [ns_db gethandle]
+
+ReturnHeaders
+
+ns_write "[ad_header "End Project"]
+
+<h2>End project</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Ticket Tracker"] [list "project-top.tcl?[export_url_vars project_id]" "One Project"] "End"]
+
+
+<hr>
+
+<form action=\"project-end-2.tcl\" method=post>
+Really end project $title?<p>
+<input type=hidden name=project_id value=$project_id>
+<center>
+<input type=submit value=\"Yes, I'm sure.  End Project\">
+</center>
+</form>
+[ad_footer]
+"
Index: web/openacs/www/ticket/admin/project-manage.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/project-manage.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/project-manage.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,30 @@
+# present list of projects, which can be viewed, deleted
+
+set db [ticket_getdbhandle]
+
+
+ReturnHeaders
+
+ns_write "[ad_header "Manage Projects"]
+<h2>Manage Projects</h2>
+"
+ns_write "[ad_context_bar_ws_or_index  [list "/ticket/admin/index.tcl" "Ticket Tracker"]  "Manage Projects"]
+<hr>"
+
+set selection [ns_db select $db "select project_id, title
+from ticket_projects order by title"]
+
+ns_write "<ul>"
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    ns_write "<li> <a href=project-top.tcl?project_id=$project_id>$title</a> &nbsp;&nbsp;<a href=project-delete.tcl?project_id=$project_id>delete</a>"
+    ns_write "\n"
+}
+
+ns_write "</ul>"
+
+
+ns_write "
+[ad_footer]
+"
Index: web/openacs/www/ticket/admin/project-new-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/project-new-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/project-new-2.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,13 @@
+set_the_usual_form_variables
+# user_id, title, start_date, end_date
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+ns_dbformvalue [ns_conn form] start_date date start_date
+
+set new_id [database_to_tcl_string $db "select ticket_project_id_sequence.nextval from dual"]
+
+ns_db dml $db "insert into ticket_projects (project_id, customer_id, title, start_date) VALUES ($new_id, $user_id, '$QQtitle', '$start_date')"
+
+ns_returnredirect "project-top.tcl?project_id=$new_id"
Index: web/openacs/www/ticket/admin/project-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/project-new.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/project-new.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,43 @@
+# create a new project
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+ReturnHeaders
+
+ns_write "[ad_header "New Project"]
+<h2>New Project</h2>
+in <a href=\"index.tcl\">[ticket_system_name]</a>.
+<hr><p>
+
+<FORM method=post action=project-new-2.tcl>
+<table noborder>
+"
+
+set customer_select_html "<SELECT NAME=user_id>\n"
+
+set ticket_group_id [ticket_admin_group $db]
+
+set selection [ns_db select $db "select first_names || ' ' || last_name || ' &lt;' || email || '&gt;' as name, users.user_id 
+from user_group_map, users where 
+user_group_map.user_id = users.user_id 
+and user_group_map.group_id = $ticket_group_id
+order by last_name"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append customer_select_html "<OPTION VALUE=$user_id> $name\n"
+}
+
+append customer_select_html "</SELECT>\n"
+
+ns_write "
+<tr><td>Project Owner</td><td>$customer_select_html</td></tr>
+<tr><td>Project Title</td><td><INPUT type=text name=title width=30></td></tr>
+<tr><td>Start Date</td><td>[philg_dateentrywidget start_date [ns_localsqltimestamp]]</td></tr>
+</table>
+<p>
+<INPUT type=submit value=\"Register New Project\">
+</FORM>
+
+[ad_footer]"
Index: web/openacs/www/ticket/admin/project-reopen.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/project-reopen.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/project-reopen.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,10 @@
+set_form_variables
+# project-id
+
+set db [ns_db gethandle]
+
+
+ns_db dml $db "update ticket_projects set end_date=NULL 
+where project_id=$project_id"
+
+ns_returnredirect "project-top.tcl?project_id=$project_id"
Index: web/openacs/www/ticket/admin/project-summary.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/project-summary.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/project-summary.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,101 @@
+# Summarize projects status
+#
+
+set db_list [ns_db gethandle main 2]
+set db   [lindex $db_list 0]
+set db2   [lindex $db_list 1]
+
+ReturnHeaders
+ns_write "[ad_header "Project Status"]
+<h2>Project Status Summary</h2>
+
+[ad_context_bar_ws_or_index [list "/ticket/admin/index.tcl" "Ticket Tracker"]  "Project Summaries"]
+
+<hr>
+
+<blockquote>
+<table border=0>
+<tr>
+<th>Title</th>
+<th>Assigned</th>
+<th>Total </th>
+<th>Active</th>
+<th>Closed</th>
+<th>Deferred</th>
+<th>Last Mod</th>
+<th>Oldest Active</th>
+<th>Pri=High</th>
+<th>Sev=Block</th>
+</tr>
+"
+
+set i 0
+
+set selection [ns_db select $db "
+select 
+  tp.project_id, 
+  tp.title, 
+  count(msg_id) as total,
+  sum(decode(status,'closed',1,0)) as closed,
+  sum(decode(status,'closed',0,'deferred',0,NULL,0,1)) as open,
+  sum(decode(status,'deferred',1,0)) as deferred,
+  max(modification_time) as lastmod,
+  min(posting_time) as oldest,
+  sum(ticket_one_if_high_priority(priority, status)) as high_pri,
+  sum(ticket_one_if_blocker(severity, status)) as blocker,
+  min(users.email) as assigned
+from ticket_projects tp, ticket_issues ti, users
+where tp.project_id = ti.project_id(+)
+and tp.default_assignee = users.user_id(+)
+group by tp.project_id, tp.title
+order by upper(title)
+"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    # show summaries of ticket stats
+    # total #
+    # open
+    # closed
+    # deferred
+    # last modified (max)
+    # 
+
+    if {($i % 2) == 0} {
+	set bgcolor "bgcolor=\#ECECEC"
+    } else {
+	set bgcolor ""
+    }
+
+
+    regsub "@.*" $assigned "" assigned
+
+    ns_write "
+<tr>
+  <td $bgcolor><a href=\"project-top.tcl?project_id=$project_id\">$title
+  <td $bgcolor align=left>$assigned&nbsp;
+  <td $bgcolor align=right>[blank_zero $total]&nbsp;
+  <td $bgcolor align=right>[blank_zero $open]&nbsp;
+  <td $bgcolor align=right>[blank_zero $closed]&nbsp;
+  <td $bgcolor align=right>[blank_zero $deferred]&nbsp;
+  <td $bgcolor align=right nowrap>$lastmod&nbsp;
+  <td $bgcolor align=right nowrap>$oldest&nbsp;
+  <td $bgcolor align=right>[blank_zero $high_pri]&nbsp;
+  <td $bgcolor align=right>[blank_zero $blocker]&nbsp;
+</tr>
+"
+   incr i
+}
+
+ns_write "</table>
+</blockquote>
+
+<ul>
+
+<li><a href=\"project-new.tcl\">add a new project</a>
+
+</ul>
+
+[ad_footer]
+"
Index: web/openacs/www/ticket/admin/project-top.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/project-top.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/project-top.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,475 @@
+# View tickets in project
+#
+# project-top.tcl  by hqm@arsdigita.com June 1999
+#
+# form vars:
+
+set_form_variables
+# form vars:
+# project_id
+# 
+# (these are all optional args which have defaults)
+#
+# filter conditions
+#
+# Assignments:
+# view_assignment    { user unassigned all }
+
+# Status
+# view_status  { open closed deferred created_by_you }
+#
+# Creation time
+# view_created { last_24 last_week last_month all}
+#
+#
+# order_by       column name to sort table by 
+
+set ctrlvars {view_assignment view_status view_created project_id}
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+ReturnHeaders
+
+set page_title "[database_to_tcl_string $db "select title
+from ticket_projects where project_id = $project_id"] Tickets"
+set navbar "[ad_context_bar_ws_or_index [list "/ticket/admin/index.tcl" "Ticket Tracker"]  "One Project"]"
+
+append page "[ad_header $page_title]
+
+<h2>$page_title</h2>
+
+$navbar
+
+<hr>
+"
+
+# List of form vars used to select tickets to display
+
+# Assignment filter conditions
+#
+
+if {![info exists view_assignment]} {
+    # default to show issues assigned to $user_id
+    set view_assignment all
+}
+
+# default to only your own assigned issues
+if {![info exists view_status]} {
+    set view_status open
+}
+
+# default to all time
+if {![info exists view_created]} {
+    set view_created all
+}
+
+
+switch $view_assignment {
+    "user" { 
+	set assignment_filter "and (exists (select msg_id from ticket_issue_assignments 
+where ticket_issue_assignments.msg_id = ticket_issues.msg_id
+and ticket_issue_assignments.user_id = $user_id)) " }
+
+     "all" { set assignment_filter "" }
+}
+
+switch $view_status {
+    "open" {set status_filter "and ((status <> 'closed') and (status <> 'deferred')) " }
+    "deferred" {set status_filter "and ((status <> 'closed') or (status = 'deferred')) " }
+    "closed" {set status_filter "" } # shows everything
+}
+
+switch $view_created {
+   "last_24"   { set date_filter "and (posting_time > (sysdate - 1))" } 
+   "last_week" { set date_filter "and (posting_time > (sysdate - 7)) " } 
+   "last_month" { set date_filter "and (posting_time > (sysdate - 30)) " }
+   "all" { set date_filter "" }
+}
+
+# Sort order of tickets by
+if {![info exists order_by]} {
+    set order_by "ticket_issues.msg_id"
+    set sql_order_clause $order_by
+} elseif {[string match "project*" $order_by]} {
+    set sql_order_clause "project_title"
+} elseif {[string compare "severity" $order_by] == 0} {
+    set sql_order_clause "decode(severity[severity_decode_list])"
+} elseif {[string compare "severity desc" $order_by] == 0} {
+    set sql_order_clause "decode(severity[severity_decode_list]) desc"
+} elseif {[string match "assigned_p desc" $order_by]} {
+    set sql_order_clause "upper(assigned_user_email)"
+} elseif {[string match "assigned_p" $order_by]} {
+    set sql_order_clause "upper(assigned_user_email) desc"
+} else {
+    set sql_order_clause $order_by
+}
+
+
+################################################################
+# GUI ticket filter controls
+
+# List of all the state vars we need to pass through these toggle switches
+set filter_vars {view_assignment view_status view_created order_by project_id}
+
+
+append page "<table border=0 cellspacing=0 cellpadding=0 width=100%>
+<tr><th bgcolor=#ECECEC>Ticket Assignment</th>
+<th bgcolor=#ECECEC>Status</th>
+<th bgcolor=#ECECEC>Creation Time</th></tr>"
+
+
+#### Assignment flags
+# Show assigned to you 
+append page "<tr><td align=center>\["
+
+append page [ticket_control_vars view_assignment user $filter_vars "mine" "project-top.tcl"]
+append page " | "
+# Show all tickets 
+append page [ticket_control_vars view_assignment all $filter_vars "everyone's" "project-top.tcl"]
+
+#### Status flags
+append page "\]</td>\n<td align=center>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;\["
+
+# Show open issues
+append page [ticket_control_vars view_status open $filter_vars "active" "project-top.tcl"]
+append page " | "
+# Show deferred issues
+append page [ticket_control_vars view_status deferred $filter_vars "+deferred" "project-top.tcl"]
+append page " | "
+# Show closed issues
+append page [ticket_control_vars view_status closed $filter_vars "+closed" "project-top.tcl"]
+
+
+#### Creation time filter
+append page "\]&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</td>\n<td align=center>\["
+
+append page [ticket_control_vars view_created last_24 $filter_vars "last 24 hrs" "project-top.tcl"]
+append page " | "
+append page [ticket_control_vars view_created last_week $filter_vars "last week" "project-top.tcl"]
+append page " | "
+append page [ticket_control_vars view_created last_month $filter_vars "last month" "project-top.tcl"]
+append page " | "
+append page [ticket_control_vars view_created all $filter_vars "all" "project-top.tcl"]
+
+append page "\]</td></tr></table><p>"
+
+################################################################
+
+
+
+set last_priority "starting"
+
+set count 0
+
+append page "<table border=0>
+<tr>
+<th align=left><a href=\"project-top.tcl?order_by=[toggle_order ticket_issues.msg_id $order_by]&[eval export_url_vars $ctrlvars]\">ID#</a></th>
+<th align=left><a href=\"project-top.tcl?order_by=[toggle_order priority $order_by]&[eval export_url_vars $ctrlvars]\">Pri</a></th>
+<th align=left><a href=\"project-top.tcl?order_by=[toggle_order ticket_type $order_by]&[eval export_url_vars $ctrlvars]\">Typ</a></th>
+<th align=left><a href=\"project-top.tcl?order_by=[toggle_order email $order_by]&[eval export_url_vars $ctrlvars]\">Creator</a></th>
+<th align=left><a href=\"project-top.tcl?order_by=[toggle_order status $order_by]&[eval export_url_vars $ctrlvars]\">Stat</a></th>
+<th align=left><a href=\"project-top.tcl?order_by=[toggle_order severity $order_by]&[eval export_url_vars $ctrlvars]\">Sever</a></th>
+<th align=left><a href=\"project-top.tcl?order_by=[toggle_order posting_time $order_by]&[eval export_url_vars $ctrlvars]\">Creat</a></th>
+<th align=left><a href=\"project-top.tcl?order_by=[toggle_order modification_time $order_by]&[eval export_url_vars $ctrlvars]\">Mod</a></th>
+<th align=left><a href=\"project-top.tcl?order_by=[toggle_order assigned_p $order_by]&[eval export_url_vars $ctrlvars]\">Asgn</a></th>"
+
+if { $view_status == "closed" } {
+    append page "<th align=left><a href=\"project-top.tcl?order_by=[toggle_order close_date $order_by]&[eval export_url_vars $ctrlvars]\">Closed</a></th>"
+} else {
+    append page "<th align=left><a href=\"project-top.tcl?order_by=[toggle_order deadline $order_by]&[eval export_url_vars $ctrlvars]\">Deadline</a></th>"
+}
+
+append page "<th align=left><a href=\"project-top.tcl?order_by=[toggle_order one_line $order_by]&[eval export_url_vars $ctrlvars]\">Subject</a></th>
+"
+
+append page "</tr>\n"
+
+set last_project_title ""
+
+set query "select 
+ ticket_issues.msg_id,
+ ticket_issues.ticket_type, 
+ ticket_issues.one_line,
+ ticket_issues.status,
+ ticket_issues.severity,
+ ticket_issues.posting_time,
+ users.email,
+ assigned_users.email as assigned_user_email,
+ ticket_projects.title as project_title,
+ ticket_projects.project_id,
+ ticket_issues.priority, 
+ to_char(ticket_issues.modification_time, 'mm/dd/yy') as modification_time_pretty,
+ to_char(ticket_issues.posting_time, 'mm/dd/yy') as creation_time_pretty,
+ to_char(ticket_issues.close_date, 'mm/dd/yy') as close_date_pretty,
+ to_char(ticket_issues.deadline, 'mm/dd/yy') as deadline_pretty,
+ to_char(sysdate - deadline) as pastdue,
+ ticket_issue_assignments.active_p as assigned_p,
+ ticket_issue_assignments.user_id as assigned_user_id,
+ ticket_issues.public_p,
+ ticket_priorities.name as priority_name
+from ticket_issues, ticket_priorities, ticket_projects, users, ticket_issue_assignments, users assigned_users
+where ticket_priorities.priority = ticket_issues.priority
+and users.user_id = ticket_issues.user_id
+and ticket_projects.project_id = ticket_issues.project_id
+and ticket_issues.msg_id = ticket_issue_assignments.msg_id(+)
+and ticket_issue_assignments.user_id = assigned_users.user_id(+)
+and ticket_issues.project_id = $project_id
+$assignment_filter
+$status_filter
+$date_filter
+order by $sql_order_clause, ticket_issues.priority, ticket_issues.posting_time"
+
+set selection [ns_db select $db $query]
+set last_msg_id ""
+set msg_ids {}
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    set cols {}
+
+    if {$msg_id == $last_msg_id} {
+	set assign $assigned_user_email
+	regsub "@.*" $assign "" assign
+	set cols [list "" "" "" "" "" "" "" "" "$assign" "" ""]
+	
+    } else {
+	set last_msg_id $msg_id
+	lappend msg_ids $msg_id
+	
+	lappend cols "<a href=\"issue-view.tcl?msg_id=$msg_id\">$msg_id</a>"
+	lappend cols "P$priority"
+	lappend cols "[string range $ticket_type 0 5]"
+	regsub "@.*" $email "" email
+	lappend cols "$email"
+	if { [string compare $status "fixed waiting approval"] == 0 } {
+	    lappend cols "<font color=#00ff00>(w approv)</font>"
+	} elseif { [string compare $status "need clarification"] == 0 } {
+	    lappend cols "<font color=#ff0000>nd clar</font>"
+	} else {
+	    lappend cols $status
+	}
+	lappend cols "$severity"
+	lappend cols "$creation_time_pretty"
+	lappend cols "$modification_time_pretty"
+	
+	if {$assigned_p == "t"} {
+	    set assign $assigned_user_email
+	    regsub "@.*" $assign "" assign
+	    lappend cols "$assign"
+	} else {
+	    lappend cols ""
+	}
+	
+	if {[info exists closed] && $view_closed == 1} {
+	    lappend cols "$close_date_pretty" 
+	} else {
+	    if {$pastdue > 0} {
+		lappend cols "<font color=red>$deadline_pretty</font>"
+	    } else {
+		lappend cols "$deadline_pretty"
+	    }
+	}
+	
+	lappend cols "<a href=\"issue-view.tcl?msg_id=$msg_id\">[clean_up_html $one_line]</a>"
+	
+	
+	incr count
+	if {($count % 2) == 0} {
+	    set bgcolor "bgcolor=\#ECECEC"
+	} else {
+	    set bgcolor ""
+	}
+	
+    }
+    append page "<tr $bgcolor>"
+    foreach col $cols {
+	append page "<td>$col&nbsp;</td>\n"
+    }
+    append page "</tr>"    
+}
+
+if { $count == 0 } {
+    append page "<tr><td colspan=10 align=center>-- No issues --</td></tr>"   
+}
+
+append page "</table>\n<p>"
+
+append page "<ul>
+<li><a href=\"issue-details.tcl?[export_url_vars msg_ids]&report_type=msgs_and_responses\">View issues above as full report</a>
+<li><a href=\"issue-details.tcl?[export_url_vars msg_ids]&report_type=msgs\">View issues above as summary</a>
+<p>
+<li><a href=\"issue-new.tcl?project_id=$project_id\">Add a new issue.</a><p>
+"
+
+append page "</ul>"
+
+# Look up owner of project
+set selection [ns_db 1row $db  "select ticket_projects.*, 
+users.first_names || ' ' || users.last_name as name from 
+ticket_projects, users
+where project_id=$project_id AND 
+users.user_id=ticket_projects.customer_id
+"]
+
+set_variables_after_query
+
+
+append page "
+<H3>Project Information</H3>
+
+<blockquote>
+<table cellpadding=3>
+<tr><th align=left>Project Owner</td><td>$name</td></tr>
+<tr><th align=left>Project Title</td><td>$title</td></tr>
+<tr><th align=left>Start Date</td><td>[util_AnsiDatetoPrettyDate $start_date]</td></tr>
+<tr><th align=left>End Date</td><td>$end_date
+"
+
+if {![empty_string_p $end_date]} {
+    append page "<a href=\"project-reopen.tcl?project_id=$project_id\"> (reopen)</a>"
+}
+
+
+
+append page "</td></tr>"
+
+append page "
+</table>
+<br>
+(<a href=\"project-edit.tcl?project_id=$project_id\">edit</a>)
+</blockquote>
+
+<p>
+"
+
+if {$end_date == "" } {
+    append page "<a href=\"project-end.tcl?project_id=$project_id&title=$title\">End Project</a><br>"
+} else {
+    append page "<a href=\"project-reopen.tcl?project_id=$project_id\">ReOpen Project</a><br>"
+}
+
+append page "
+<H3>Assignment</H3>
+"
+
+# Find if there is a default assignee
+set default_assignee [database_to_tcl_string_or_null $db "select default_assignee from
+ticket_projects 
+where project_id=$project_id"]
+
+set group_id [ticket_admin_group $db]
+
+# List all users, for the default_assignee menu
+set selection [ns_db select $db "select users.user_id, first_names, last_name, email
+from user_group_map, users_active users where 
+user_group_map.user_id = users.user_id 
+and user_group_map.group_id = $group_id
+order by last_name"]
+
+set nusers 0
+set assigned_users ""
+set default_user "None"
+while {[ns_db getrow $db $selection]} { 
+    set_variables_after_query
+    append assigned_users "<option value=$user_id>$first_names $last_name &lt;$email&gt;\n"
+    # Get pretty name of default user, if exists
+    if {$user_id == $default_assignee} {
+	set default_user "$first_names $last_name &lt;$email&gt;"
+    }
+    incr nusers
+}
+
+if {[empty_string_p $default_assignee]}  {
+    append page "No default user assigned to tickets.<p>"
+} else { 
+    append page "Default user assigned to tickets: $default_user<p>"
+}
+
+append page "<form action=\"project-assign-default-user.tcl\">
+[export_form_vars project_id]
+<select name=assignee_id size=[min $nusers 5]>
+<option value=none>-- None --</option>
+$assigned_users
+</select>
+<p>
+<input type=submit value=\"Set Default User\">
+</form>
+"
+
+
+
+
+
+
+append page "
+<table border=1 cellpadding=10>
+<tr>
+<th>[ticket_system_name] users assigned to this project</th>
+<th>[ticket_system_name] users not assigned to this project</th>
+</tr>
+<tr valign=top><td><ul>"
+
+# Select users assigned to this project
+set selection [ns_db select $db "select * 
+from users_active users, ticket_assignments where 
+users.user_id=ticket_assignments.user_id 
+and project_id=$project_id"]
+
+set nusers 0
+set assigned_users ""
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    append assigned_users "<option value=$user_id>$first_names $last_name &lt;$email&gt;\n"
+    incr nusers
+}
+
+if {[info exists assigned_users]} {
+    append page "<form action=\"project-deassign-user.tcl\">
+[export_form_vars project_id]
+<select name=assignee_id size=[min $nusers 10]>
+$assigned_users
+</select>
+<p><input type=submit value=\"Deassign\">
+</form>
+"
+}
+
+append page "
+</td>
+<td>
+"
+
+# Select users assigned to this project but not assigned to this ticket
+set nusers 0
+set selection [ns_db select $db "select users.user_id, first_names, last_name, email
+from user_group_map, users_active users where 
+user_group_map.user_id = users.user_id 
+and user_group_map.group_id = $group_id
+and user_group_map.user_id NOT IN 
+(SELECT user_id from ticket_assignments where project_id=$project_id)
+"]
+
+while {[ns_db getrow $db $selection]}  {
+    set_variables_after_query
+    append unassigned_users "<option value=$user_id>$first_names $last_name &lt;$email&gt;</option>\n"
+    incr nusers
+}
+
+if {[info exists unassigned_users]} { 
+    append page "<form action=\"project-assign-user.tcl\">
+[export_form_vars project_id]
+<select name=assignee_id size=[min $nusers 10]>
+$unassigned_users
+</select>
+<p><input type=submit value=\"Assign\">
+</form>"
+}
+append page "</td></tr></table>
+</ul>
+Users assigned to this system will get email alerts and 
+can be assigned individual issues.
+[ad_footer]
+"
+ns_write $page
\ No newline at end of file
Index: web/openacs/www/ticket/admin/project-view-assignments.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/project-view-assignments.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/project-view-assignments.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,148 @@
+# View assigned tickets, by user
+#
+# project-view-assignments.tcl by hqm@arsdigita.com June 1999
+# 
+set_form_variables 0
+
+# form vars:
+# 
+# filter conditions
+#
+# project_id (blank for all projects)
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+ReturnHeaders
+
+ns_write "[ad_header "[ticket_system_name] View Ticket Assignments"]
+
+<h2>[ticket_system_name]</h2>
+
+[ad_context_bar_ws_or_index  [list "/ticket/admin/index.tcl" "Ticket Tracker"] "View Assignments"]
+
+<hr>
+"
+
+
+if {[info exists project_id] && ![empty_string_p $project_id]} {
+    set project_filter "and ticket_issues.project_id = $project_id "
+} else {
+    set project_filter ""
+}
+
+
+
+set query "select 
+ ticket_issues.msg_id,
+ ticket_issues.ticket_type, 
+ ticket_issues.one_line,
+ ticket_issues.status,
+ ticket_issues.severity,
+ ticket_issues.posting_time,
+ users.email as assignee_email,
+ ticket_projects.title as project_title,
+ ticket_projects.project_id,
+ ticket_issues.priority, 
+ to_char(ticket_issues.modification_time, 'mm/dd/yy') as modification_time,
+ to_char(ticket_issues.posting_time, 'mm/dd/yy') as creation_time,
+ to_char(ticket_issues.close_date, 'mm/dd/yy') as close_date,
+ to_char(ticket_issues.deadline, 'mm/dd/yy') as deadline,
+ to_char(sysdate - deadline) as pastdue,
+ ticket_issue_assignments.user_id as assignee_user_id,
+ ticket_issues.public_p,
+ ticket_priorities.name as priority_name
+ from ticket_issues, ticket_priorities, ticket_projects, users, ticket_issue_assignments
+ where ticket_priorities.priority = ticket_issues.priority
+ and users.user_id = ticket_issue_assignments.user_id
+ and ticket_projects.project_id = ticket_issues.project_id
+ and ticket_issues.msg_id = ticket_issue_assignments.msg_id
+ and ticket_issues.status <> 'closed'
+ $project_filter
+ order by assignee_user_id, project_title, msg_id
+"
+
+set selection [ns_db select $db $query]
+
+set results ""
+append results "<table border=0>
+<tr><th align=left>User</th>
+<th align=left>ID#</th>
+<th align=left>Pri</th>
+<th align=left>Typ</th>
+<th align=left>Stat</th>
+<th align=left>Sever</th>
+<th align=left>Creat</th>
+<th align=left>Mod</th>
+<th align=left>Synopsis</th>
+<th align=left>Project</th>
+</tr>
+"
+
+set count 0
+set last_email ""
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if {$last_email != $assignee_email} {
+	append results "<tr><td colspan=10 bgcolor=#cccccc>&nbsp;</tr>"
+    }
+    set cols {}
+    regsub "@.*" $assignee_email "" aemail
+
+    # only print  user email when it changes
+    if {$last_email != $assignee_email} {
+	lappend cols $aemail
+    } else {
+	lappend cols ""
+    }
+    set last_email $assignee_email
+
+    lappend cols "<a href=\"issue-view.tcl?msg_id=$msg_id\">$msg_id</a>"
+    lappend cols "P$priority"
+    lappend cols "[string range $ticket_type 0 3]"
+    if { [string compare $status "fixed waiting approval"] == 0 } {
+	lappend cols "<font color=#00ff00>(w approv)</font>"
+    } elseif { [string compare $status "need clarification"] == 0 } {
+	lappend cols "<font color=#ff0000>nd clar</font>"
+    } else {
+	lappend cols $status
+    }
+    lappend cols "$severity"
+    lappend cols "$creation_time"
+    lappend cols "$modification_time"
+    
+    lappend cols "<a href=\"issue-view.tcl?msg_id=$msg_id\">[clean_up_html $one_line]</a>"
+
+    # show project title if we are not sorting by project
+    lappend cols "<a href=project-top.tcl?project_id=$project_id>[string range $project_title 0 12]</a>"	
+    
+    incr count
+    if {($count % 2) == 0} {
+	set bgcolor "bgcolor=\#ECECEC"
+    } else {
+	set bgcolor ""
+    }
+    
+    append results "<tr $bgcolor>"
+    foreach col $cols {
+	append results "<td>$col&nbsp;</td>\n"
+    }
+    append results "</tr>"    
+}
+
+if { $count == 0 } {
+    append results "<tr><td colspan=10 align=center>-- No issues --</td></tr>"   
+}
+
+append results "</table>\n<p>"
+
+
+append results  "
+<ul>
+<li><a href=\"issue-new.tcl\">add a new issue</a>
+</ul>"
+
+append results "[ad_footer]"
+ns_write $results
Index: web/openacs/www/ticket/admin/project-view-issues.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/project-view-issues.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/project-view-issues.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,212 @@
+set_form_variables 0
+
+# optional: closed, assigned_to, created_by, unassigned, project_id, order_by deferred
+
+# assigned_to and created_by can be user IDs to filter by.
+# By default, only non-closed issues are shown; closed indicates
+# that closed issues should also be shown.
+
+
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+set where_clause_list [list "ticket_priorities.priority = ticket_issues.priority"]
+
+if { [info exists closed] && $closed == 1 } {
+    set view "All Issues"
+} else {
+    lappend where_clause_list "close_date is null"
+    set view "Open Issues"
+    set closed 0
+}
+
+if {[info exists deferred] && $deferred == 1} {
+    # 
+} else {
+    lappend where_clause_list "status <> 'deferred'"
+    set deferred 0
+}
+
+if { [info exists created_by] } {
+    lappend where_clause_list "ticket_issues.user_id = $user_id"
+    append view " created by you"
+}
+
+
+if { [info exists project_id] && $project_id != "" } {
+    lappend where_clause_list "ticket_issues.project_id = $project_id"
+    set project_title [database_to_tcl_string $db "select title
+from ticket_projects where project_id = $project_id"]
+    append title " in project $project_title"
+} else {
+   set project_title "View All Projects"
+}
+
+ReturnHeaders
+
+ns_write "[ad_header $project_title]
+<h2>$project_title</h2>"
+
+ns_write "[ad_context_bar_ws_or_index [list "/ticket/admin/index.tcl" "Ticket Tracker"] $project_title]"
+
+
+ns_write "
+<hr>
+"
+
+if {![info exists order_by]} {
+    set order_by "msg_id"
+}
+
+if {[string match "project*" $order_by]} {
+    set order_by "project_title"
+}
+
+
+set selection [ns_db select $db "select 
+ticket_issues.msg_id,
+ticket_issues.ticket_type, 
+ticket_issues.one_line,
+ticket_issues.status,
+ticket_issues.severity,
+users.email,
+ticket_projects.title as project_title,
+ticket_projects.project_id,
+ticket_issues.priority, 
+to_char(ticket_issues.modification_time, 'mm/dd/yy') as modification_time,
+to_char(ticket_issues.posting_time, 'mm/dd/yy') as creation_time,
+to_char(ticket_issues.close_date, 'mm/dd/yy') as close_date,
+to_char(ticket_issues.deadline, 'mm/dd/yy') as deadline,
+to_char(sysdate - deadline) as pastdue,
+ticket_issues.public_p,
+ticket_priorities.name as priority_name 
+from ticket_issues, ticket_priorities, ticket_projects, users
+where [join $where_clause_list " and "]
+and users.user_id = ticket_issues.user_id
+and ticket_projects.project_id = ticket_issues.project_id
+order by $order_by, ticket_priorities.priority, posting_time"]
+
+set last_priority "starting"
+
+set count 0
+
+ns_write "<table border=0>
+<tr>
+<th align=left><a href=\"project-view-issues.tcl?order_by=[toggle_order msg_id $order_by]&[export_url_vars project_id closed deferred]\">ID#</a></th>
+<th align=left><a href=\"project-view-issues.tcl?order_by=[toggle_order priority $order_by]&[export_url_vars project_id closed deferred]\">Pri</a></th>
+<th align=left><a href=\"project-view-issues.tcl?order_by=[toggle_order ticket_type $order_by]&[export_url_vars project_id closed deferred]\">Typ</a></th>
+<th align=left><a href=\"project-view-issues.tcl?order_by=[toggle_order email $order_by]&[export_url_vars project_id closed deferred]\">Owner</a></th>
+<th align=left><a href=\"project-view-issues.tcl?order_by=[toggle_order status $order_by]&[export_url_vars project_id closed deferred]\">Stat</a></th>
+<th align=left><a href=\"project-view-issues.tcl?order_by=[toggle_order severity $order_by]&[export_url_vars project_id closed deferred]\">Sever</a></th>
+<th align=left><a href=\"project-view-issues.tcl?order_by=[toggle_order posting_time $order_by]&[export_url_vars project_id closed deferred]\">Creat</a></th>
+<th align=left><a href=\"project-view-issues.tcl?order_by=[toggle_order modification_time $order_by]&[export_url_vars project_id closed deferred]\">Mod</a></th>
+"
+
+if {[info exists closed] &&  $closed == 1} {
+    ns_write "<th align=left><a href=\"project-view-issues.tcl?order_by=[toggle_order close_date $order_by]&[export_url_vars project_id closed deferred]\">Closed</a></th>"
+} else {
+    ns_write "<th align=left><a href=\"project-view-issues.tcl?order_by=[toggle_order deadline $order_by]&[export_url_vars project_id closed deferred]\">Deadline</a></th>"
+}
+
+ns_write "<th align=left><a href=\"project-view-issues.tcl?order_by=[toggle_order one_line $order_by]&[export_url_vars project_id closed deferred]\">Synopsis</a></th>
+"
+if {![string match "project_title" $order_by]} {
+    ns_write "<th align=left><a href=\"project-view-issues.tcl?order_by=[toggle_order project_id $order_by]&[export_url_vars project_id closed deferred]\">Project</a></th>
+"    
+}
+ns_write "</tr>\n"
+
+set last_project_title ""
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    set cols {}
+    lappend cols "<a href=\"issue-view.tcl?msg_id=$msg_id\">$msg_id</a>"
+    lappend cols "P$priority"
+    lappend cols "[string range $ticket_type 0 3]"
+    regsub "@.*" $email "" email
+    lappend cols "$email"
+    if { [string compare $status "fixed waiting approval"] == 0 } {
+	lappend cols "<font color=#00ff00>(w approv)</font>"
+    } elseif { [string compare $status "need clarification"] == 0 } {
+	lappend cols "<font color=#ff0000>nd clar</font>"
+    } else {
+	lappend cols $status
+    }
+    lappend cols "$severity"
+    lappend cols "$creation_time"
+    lappend cols "$modification_time"
+
+    if {[info exists closed] && $closed == 1} {
+	lappend cols "$close_date" 
+    } else {
+	if {$pastdue > 0} {
+	    lappend cols "<font color=red>$deadline</font>"
+	} else {
+	    lappend cols "$deadline"
+	}
+    }
+
+    lappend cols "<a href=\"issue-view.tcl?msg_id=$msg_id\">[clean_up_html $one_line]</a>"
+
+    # show project title if we are not sorting by project
+    if {![string match "project_title" $order_by]} {
+	lappend cols "<a href=project-top.tcl?project_id=$project_id>[string range $project_title 0 12]</a>"	
+    }
+
+    if {[string match "project_title" $order_by] && $last_project_title != $project_title} {
+	ns_write "<tr><th colspan=10 align=left><a href=project-top.tcl?project_id=$project_id>$project_title</a></th></tr>\n"
+	set last_project_title $project_title
+    }
+
+    incr count
+    if {($count % 2) == 0} {
+	set bgcolor "bgcolor=\#ECECEC"
+    } else {
+	set bgcolor ""
+    }
+
+    ns_write "<tr $bgcolor>"
+    foreach col $cols {
+	ns_write "<td>$col&nbsp;</td>\n"
+    }
+    ns_write "</tr>"    
+}
+
+if { $count == 0 } {
+    ns_write "<tr><td colspan=10 align=center>-- No issues --</td></tr>"   
+}  else { 
+    ns_write "<tr><td colspan=10>$count issues found</td></tr>"
+}
+
+ns_write "</table>\n<p>"
+
+
+
+if { $closed == 0 } {
+    ns_write "<a href=\"project-view-issues.tcl?[export_url_vars assigned_to created_by unassigned deferred order_by]&closed=1\">view closed issues as well</a> 
+"
+} else {
+    ns_write "<a href=\"project-view-issues.tcl?[export_url_vars assigned_to created_by unassigned deferred order_by]\">view open issues</a>
+"
+}
+
+if { $deferred == 0 } {
+    ns_write "<br><a href=\"project-view-issues.tcl?[export_url_vars assigned_to created_by unassigned closed order_by]&deferred=1\">view deferred issues as well</a> 
+"
+} else {
+    ns_write "<br><a href=\"project-view-issues.tcl?[export_url_vars assigned_to created_by unassigned order_by]\">view only open issues</a>
+    "}
+
+
+set count 0
+
+ns_write "<p>"
+
+if {[info exists project_id]} {
+    ns_write "<A HREF=\"issue-new.tcl?project_id=$project_id\">add a new issue</a>"
+} else {
+    ns_write "<A HREF=\"issue-new.tcl\">add a new issue</a>"
+}
+
+ns_write "[ad_footer]"
Index: web/openacs/www/ticket/admin/projects-all.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/projects-all.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/projects-all.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,26 @@
+set db [ticket_getdbhandle]
+
+set user_id [ad_get_user_id]
+
+ReturnHeaders
+
+ns_write "[ad_header "All Projects"]
+<h2>All Projects</h2>
+in <a href=\"../index.tcl\">[ticket_system_name]</a>.
+<hr><p>
+
+<ul>
+<li> <A href=\"project-new.tcl\">New Project</a>
+<p>
+"
+
+set selection [ns_db select $db "select * from ticket_projects"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    ns_write  "<li> <A href=\"project-top.tcl?project_id=$project_id\">$title</a>\n"
+}
+
+ns_write "</ul>
+
+[ad_footer]"
Index: web/openacs/www/ticket/admin/search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/search.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,97 @@
+set_the_usual_form_variables
+
+set db [ticket_getdbhandle]
+
+
+# query_string, project_id (optional), accumulate_p (optional), fuzzy_p (optional)
+
+if { ![info exists query_string] || $query_string == "" } {
+    # probably using MSIE
+    ns_return 200 text/html "[ad_header "Missing Query"]
+<h2>Missing Query</h2>
+<hr>
+Either you didn't type a query string or you're using a quality Web
+browser like Microsoft Internet Explorer 3.x (which neglects to 
+pass user input up the server).
+[ad_footer]
+"
+    return
+}
+
+set user_id [ad_get_user_id]
+
+# we ask for all the top level messages
+
+ReturnHeaders
+
+ns_write "[ad_header "Search Results"]
+<h2>Messages matching \"$query_string\"</h2>
+in the <a href=\"index.tcl\">[ticket_system_name]</a>
+<hr>
+<ul>
+"
+
+
+# Non-admin users get their search restricted to tickets which
+# belong to a common group.
+
+set admin_group_member_p [ad_administration_group_member $db "ticket" "" $user_id]
+
+set where_clause_list {" ticket_projects.project_id = ticket_issues.project_id"}
+
+# If the user is not a staff member, only show other issues which
+# were created by members of a common group.
+if {$admin_group_member_p != 1} {
+    # Get list of groups to which the user belongs
+    set groups [database_to_tcl_list $db "select group_id from user_group_map where user_id = $user_id"]
+    lappend where_clause_list "ticket_issues.group_id in ([join $groups " "])"
+} 
+
+
+#where pseudo_contains(dbms_lob.substr(indexed_stuff,4000)
+
+#if [catch {
+set selection [ns_db select $db "select msg_id, one_line, ticket_issues.project_id, ticket_projects.title from 
+ticket_issues, ticket_projects 
+where [join $where_clause_list " and "]
+and upper(dbms_lob.substr(indexed_stuff,4000)) like upper('%$query_string%')
+order by msg_id"]
+#} errmsg] {
+    
+#    ns_write "[ad_return_context_error $errmsg]
+#</ul>
+#[ad_footer]"
+    
+#    return   
+#}
+
+set counter 0
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    incr counter
+    ns_write "<li>\[$msg_id\] <a href=\"issue-view.tcl?msg_id=$msg_id\">[clean_up_html $one_line]</a>\n"
+}
+
+if { $counter == 0 } {
+    set search_items "messages"
+    ns_write "No matching items found."
+} 
+
+ns_write "
+</ul>
+[ad_footer]
+"
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/ticket/admin/set-response-visibility.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/set-response-visibility.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/set-response-visibility.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,29 @@
+# Toggles the public/private flag on a response
+
+set_the_usual_form_variables
+# response_id public_p msg_id
+
+set db [ticket_getdbhandle]
+
+
+with_transaction $db {
+    ns_db dml $db "update ticket_issue_responses set public_p = '$public_p' where response_id=$response_id"
+} {
+    # something went a bit wrong during the insert
+    ns_return 200 text/html "[ad_header "Error modifying a response"]
+<h3>Ouch!!</h3>
+<hr>
+We encountered a problem modifying the response.
+Here was the bad news from the database:
+<pre>
+$errmsg
+</pre>
+[ad_footer]
+"
+    return
+}
+
+
+ns_returnredirect "issue-view.tcl?[export_url_vars msg_id]"
+
+
Index: web/openacs/www/ticket/admin/ticket-search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/ticket-search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/ticket-search.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,165 @@
+set_the_usual_form_variables
+
+set db [ns_db gethandle]
+
+# creator_fname, creator_lname
+# contact_fname, contact_lname
+# ticket_id
+# ticket_type
+# creation_start, creation_end 
+# project_id, priority
+
+# Check input.
+
+set exception_text ""
+set exception_count 0
+
+ticket_search_combine_and_build_error_list
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# This looks at a bunch of form vars, and builds a list of search
+# clauses in search_clause_list
+ticket_search_build_where_clause_and_description
+
+if {![info exists search_description_items] || [llength $search_description_items] == 0} {
+    ad_return_complaint 1 "<li>Please specify at least some search criteria.\n"
+    return
+}
+
+
+if { [info exists assigned_fname] && [info exists assigned_lname] && (![empty_string_p $assigned_fname] || ![empty_string_p $assigned_lname]) } {
+    set assigned_user_conditions [list]
+    if {![empty_string_p $assigned_fname]} {
+	lappend assigned_user_conditions "(lower(email) like  '[string tolower [DoubleApos $assigned_fname]]%' or  lower(first_names) like '[string tolower [DoubleApos $assigned_fname]]%')"
+    } 
+    if {  ![empty_string_p $assigned_lname] } {
+	lappend assigned_user_conditions "lower(last_name) like '[string tolower [DoubleApos $assigned_lname]]%'"
+    }
+
+    lappend search_clause_list " msg_id in (select msg_id from ticket_issue_assignments ta, users where ta.user_id = users.user_id and [join $assigned_user_conditions { or }] ) "
+
+}
+
+if {[llength $search_clause_list] > 0} {
+    set search_clause "and [join $search_clause_list " and "]"
+} else {
+    set search_clause ""
+}
+
+set display_title "Ticket search"
+
+set query "select ticket_issues.*, ticket_priorities.name, 
+ticket_projects.title as project_title, 
+users.first_names,
+users.last_name,
+to_char(posting_time, 'mm/dd/yyyy') as creation_date
+from ticket_issues, ticket_projects, ticket_priorities, users, users closer
+where
+closer.user_id(+) = ticket_issues.closed_by
+and users.user_id = ticket_issues.user_id 
+and ticket_issues.priority = ticket_priorities.priority
+and ticket_projects.project_id = ticket_issues.project_id
+$search_clause
+order by ticket_issues.project_id, msg_id"
+
+ReturnHeaders
+
+set selection [ns_db select $db $query]
+
+append pagebody "[ad_header $display_title]
+<h2>$display_title</h2>
+in <a href=\"\">[ad_system_name]</a>
+<hr>
+
+Search criteria:
+
+<ul>
+<li>[join $search_description_items "<li>"]
+</ul>
+
+<p>
+
+Search results:
+
+<form method=post action=\"list-issues.tcl\">
+
+<input type=hidden name=search_items [export_form_value search_description_items]>
+"
+
+set i 0
+set ppcount  0
+set msgs_displayed_already [list]
+
+set last_title ""
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    if { [lsearch $msgs_displayed_already msg_id] != -1 } {
+	continue
+    } else {
+	lappend msgs_displayed_already $msg_id
+    }
+    set detail_list ""
+
+    if {[string compare $project_title $last_title] != 0} {
+	if {$ppcount != 0} {
+	    append pagebody "<br>$ppcount issues"
+	    set ppcount 0
+	}
+	append pagebody "</ul><b>$project_title</b><ul>"
+    }
+
+    set last_title $project_title
+
+    set item_list_list { {"creation_date" "Creation Date:"} {"priority" "Priority:"} {"source" "Source:"} {"data1" ""} {"data2" ""} }
+
+    foreach item_list $item_list_list {
+	set variable [lindex $item_list 0]
+	set annotation [lindex $item_list 1]
+	if ![empty_string_p [set $variable]] {
+	    lappend detail_list "$annotation [set $variable]"
+	}
+    }
+    
+    append pagebody "<br><input type=checkbox name=msg_ids value=\"$msg_id\" checked>
+<a href=\"/ticket/admin/issue-view.tcl?[export_url_vars msg_id]\">\#$msg_id [clean_up_html $one_line]</a>"
+   if {[string tolower $status] == "closed"} {
+       append pagebody " <font color=green>Status: closed</font> "
+   } else {
+       append pagebody " Status: $status "
+   }
+   append pagebody [join $detail_list " ; "]
+
+   incr i
+   incr ppcount
+}
+
+if {$ppcount != 0} {
+    append pagebody "<br>$ppcount issues"
+    set ppcount 0
+}
+
+if { $i == 0 } {
+    append pagebody "No tickets found.\n"
+} else {
+    append pagebody "
+</ul>
+<p>
+<center>
+<input type=submit name=report_type value=\"Ticket Summaries\">
+<input type=submit name=report_type value=\"Complete Ticket Reports\">
+</center>"
+}
+
+append pagebody "</form>
+<p>
+<ul>
+<li><a href=\"issue-new.tcl\">Add a new ticket</a>
+</ul>
+[ad_footer]
+"
+ns_write $pagebody
Index: web/openacs/www/ticket/admin/unauthorized.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/unauthorized.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/unauthorized.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,11 @@
+ReturnHeaders 
+
+ns_write "[ad_header [ad_system_name]]
+
+<h2>Access Denied</h2>
+Your user account does not have access to this functionality.
+
+<hr>
+
+[ad_footer]
+"
Index: web/openacs/www/ticket/admin/unlink-xref.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/unlink-xref.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/unlink-xref.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,18 @@
+#
+# remove an entry from the  cross-reference table
+#
+# from_msg_id
+# to_msg_id 
+# target 
+
+set_form_variables
+
+
+set db [ticket_getdbhandle]
+
+ns_db dml $db "delete from ticket_xrefs where from_ticket = $from_msg_id
+and to_ticket = $to_msg_id"
+
+set msg_id $from_msg_id
+ns_returnredirect "$target?[export_url_vars msg_id]"
+
Index: web/openacs/www/ticket/admin/user-new-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/user-new-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/user-new-2.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,10 @@
+set_the_usual_form_variables
+
+set db [ticket_getdbhandle]
+
+# user_id_from_search
+ns_db dml $db "insert into ticket_users (user_id) select  $user_id_from_search from DUAL where 0 = (select count(user_id) from ticket_users where user_id=$user_id_from_search)"
+
+ns_returnredirect "index.tcl"
+
+
Index: web/openacs/www/ticket/admin/user-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/user-new.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/user-new.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,20 @@
+
+set db [ticket_getdbhandle]
+
+
+ns_return 200 text/html "[ad_header "New User"]
+<h2>New User</h2>
+in <a href=\"index.tcl\">[ticket_system_name] administration</a>.
+<hr><p>
+<form action=\"/user-search.tcl\" method=get>
+<input type=hidden name=target value=\"/ticket/admin/user-new-2.tcl\">
+Search for a [ad_system_name] user to add the [ticket_system_name] by 
+<p>
+<table border=0>
+<tr><td>Email address:<td><input type=text name=email size=40></tr>
+<tr><td colspan=2>or by</tr>
+<tr><td>Last name:<td><input type=text name=last_name size=40></tr>
+</table>
+ <input type=submit value=\"Search for user\">
+<p>
+[ad_footer]"
\ No newline at end of file
Index: web/openacs/www/ticket/admin/user-summary.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/user-summary.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/user-summary.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,100 @@
+#
+# /ticket/admin/user-summary.tcl
+# 
+# by hqm@arsdigita.com
+#
+
+# Summarize ticket system usage by user
+#
+
+set db_list [ns_db gethandle main 2]
+set db   [lindex $db_list 0]
+set db2   [lindex $db_list 1]
+
+ReturnHeaders
+ns_write "[ad_header "Summary by User"]
+
+<h2>User Status Summary</h2>
+
+[ad_context_bar_ws_or_index [list "/ticket/admin/index.tcl" "Ticket Tracker"]  "User Summaries"]
+
+<hr>
+
+<blockquote>
+<table border=0>
+<tr>
+<th>User
+<th>Total 
+<th>Active
+<th>Closed
+<th>Deferred
+<th>Last Mod
+<th>Oldest Active
+<th>Pri=High
+<th>Sev=Block
+</tr>
+"
+
+set i 0
+
+set selection [ns_db select $db "
+select 
+  users.user_id as summary_user_id, 
+  users.first_names || ' ' || users.last_name as name, 
+  count(tia.msg_id) as total,
+  sum(decode(status,'closed',1,0)) as closed,
+  sum(decode(status,'closed',0,'deferred',0,NULL,0,1)) as open,
+  sum(decode(status,'deferred',1,0)) as deferred,
+  max(modification_time) as lastmod,
+  min(posting_time) as oldest,
+  sum(ticket_one_if_high_priority(priority, status)) as high_pri,
+  sum(ticket_one_if_blocker(severity, status)) as blocker
+from users, ticket_issues ti, ticket_issue_assignments tia
+where users.user_id = tia.user_id
+and ti.msg_id = tia.msg_id
+group by users.user_id,  last_name, first_names
+order by upper(last_name)
+"]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+
+    # show summaries of ticket stats
+    # total #
+    # open
+    # closed
+    # deferred
+    # last modified (max)
+    # 
+
+    if {($i % 2) == 0} {
+	set bgcolor "bgcolor=\#ECECEC"
+    } else {
+	set bgcolor ""
+    }
+
+    ns_write "
+<tr>
+  <td $bgcolor><a href=\"user-top.tcl?[export_url_vars summary_user_id]\">$name
+  <td $bgcolor align=right>[blank_zero $total]&nbsp;
+  <td $bgcolor align=right>[blank_zero $open]&nbsp;
+  <td $bgcolor align=right>[blank_zero $closed]&nbsp;
+  <td $bgcolor align=right>[blank_zero $deferred]&nbsp;
+  <td $bgcolor align=right>$lastmod&nbsp;
+  <td $bgcolor align=right>$oldest&nbsp;
+  <td $bgcolor align=right>[blank_zero $high_pri]&nbsp;
+  <td $bgcolor align=right>[blank_zero $blocker]&nbsp;
+</tr>
+"
+   incr i
+}
+
+ns_write "</table>
+</blockquote>
+
+<ul>
+<li>Add new <a href=\"issue-new.tcl\">issue</a>
+</ul>
+
+[ad_footer]
+"
Index: web/openacs/www/ticket/admin/user-top.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/user-top.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/user-top.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,287 @@
+#
+# /ticket/admin/user-top.tcl 
+#
+# by hqm@arsdigita.com in June 1999
+#
+# show tickets for one user
+#
+
+set_form_variables 0
+
+
+# form vars:
+# 
+# summary_user_id - user_id this page is for
+#
+# filter conditions
+#
+
+# Status
+# view_status  { open closed deferred created_by_you }
+#
+# Creation time
+# view_created { last_24 last_week last_month all}
+#
+#
+# order_by       column name to sort table by 
+
+set ctrlvars {view_assignment view_status view_created summary_user_id}
+
+set db [ticket_getdbhandle]
+set user_id [ad_get_user_id]
+
+set name [database_to_tcl_string $db "select first_names || ' ' || last_name 
+from users where user_id = $summary_user_id"]
+
+ReturnHeaders
+
+ns_write "[ad_header "[ticket_system_name] summary for $name"]
+
+<h2>Summary for $name</h2>
+
+[ad_context_bar_ws_or_index [list "index.tcl" "Ticket Tracker"] "User summary"]
+
+<hr>
+"
+
+# List of form vars used to select tickets to display
+
+# Assignment filter conditions
+#
+
+if {![info exists view_assignment]} {
+    # default to show issues assigned to $user_id
+    set view_assignment user
+}
+
+# default to only your own assigned issues
+if {![info exists view_status]} {
+    set view_status open
+}
+
+# default to all time
+if {![info exists view_created]} {
+    set view_created all
+}
+
+
+
+set assignment_filter "and (exists 
+(select msg_id from ticket_issue_assignments 
+where ticket_issue_assignments.msg_id = ticket_issues.msg_id
+and ticket_issue_assignments.user_id = $summary_user_id
+)) " 
+
+
+
+switch $view_status {
+    "open" {set status_filter "and ((status <> 'closed') and (status <> 'deferred')) " }
+    "deferred" {set status_filter "and ((status <> 'closed') or (status = 'deferred')) " }
+    "closed" {set status_filter "" } # shows everything
+}
+
+switch $view_created {
+   "last_24"   { set date_filter "and (posting_time > (sysdate - 1))" } 
+   "last_week" { set date_filter "and (posting_time > (sysdate - 7)) " } 
+   "last_month" { set date_filter "and (posting_time > (sysdate - 30)) " }
+   "all" { set date_filter "" }
+}
+
+# Sort order of tickets by
+if {![info exists order_by]} {
+    set order_by "ticket_issues.msg_id"
+} elseif {[string match "project*" $order_by]} {
+    set order_by "project_title"
+}
+
+
+################################################################
+# GUI ticket filter controls
+
+# List of all the state vars we need to pass through these toggle switches
+set filter_vars {view_assignment view_status view_created order_by summary_user_id}
+
+
+append results "<table border=0 cellspacing=0 cellpadding=0 width=100%>
+<tr>
+<th bgcolor=#ECECEC>Status</th>
+<th bgcolor=#ECECEC>Creation Time</th></tr>"
+
+
+#### Assignment flags
+# Show assigned to you 
+append results "<tr>
+<td align=center>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;\["
+
+# Show open issues
+append results [ticket_control_vars view_status open $filter_vars "active" "user-top.tcl"]
+append results " | "
+# Show deferred issues
+append results [ticket_control_vars view_status deferred $filter_vars "+deferred" "user-top.tcl"]
+append results " | "
+# Show closed issues
+append results [ticket_control_vars view_status closed $filter_vars "+closed" "user-top.tcl"]
+
+
+#### Creation time filter
+append results "\]&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</td>\n<td align=center>\["
+
+append results [ticket_control_vars view_created last_24 $filter_vars "last 24 hrs" "user-top.tcl"]
+append results " | "
+append results [ticket_control_vars view_created last_week $filter_vars "last week" "user-top.tcl"]
+append results " | "
+append results [ticket_control_vars view_created last_month $filter_vars "last month" "user-top.tcl"]
+append results " | "
+append results [ticket_control_vars view_created all $filter_vars "all" "user-top.tcl"]
+
+append results "\]</td></tr></table><p>"
+
+################################################################
+
+
+
+set last_priority "starting"
+
+set count 0
+
+append results "<table border=0>
+<tr>
+<th align=left><a href=\"user-top.tcl?order_by=[toggle_order ticket_issues.msg_id $order_by]&[eval export_url_vars $ctrlvars]\">ID#</a></th>
+<th align=left><a href=\"user-top.tcl?order_by=[toggle_order priority $order_by]&[eval export_url_vars $ctrlvars]\">Pri</a></th>
+<th align=left><a href=\"user-top.tcl?order_by=[toggle_order ticket_type $order_by]&[eval export_url_vars $ctrlvars]\">Typ</a></th>
+<th align=left><a href=\"user-top.tcl?order_by=[toggle_order email $order_by]&[eval export_url_vars $ctrlvars]\">Creator</a></th>
+<th align=left><a href=\"user-top.tcl?order_by=[toggle_order status $order_by]&[eval export_url_vars $ctrlvars]\">Stat</a></th>
+<th align=left><a href=\"user-top.tcl?order_by=[toggle_order severity $order_by]&[eval export_url_vars $ctrlvars]\">Sever</a></th>
+<th align=left><a href=\"user-top.tcl?order_by=[toggle_order posting_time $order_by]&[eval export_url_vars $ctrlvars]\">Creat</a></th>
+<th align=left><a href=\"user-top.tcl?order_by=[toggle_order modification_time $order_by]&[eval export_url_vars $ctrlvars]\">Mod</a></th>"
+
+if {$view_assignment != "user"} {
+    append results "<th align=left><a href=\"user_top.tcl?order_by=[toggle_order assigned_p $order_by]&[eval export_url_vars $ctrlvars]\">Asgn?</a></th>
+"
+}
+
+if { $view_status == "closed" } {
+    append results "<th align=left><a href=\"user-top.tcl?order_by=[toggle_order close_date $order_by]&[eval export_url_vars $ctrlvars]\">Closed</a></th>"
+} else {
+    append results "<th align=left><a href=\"user-top.tcl?order_by=[toggle_order deadline $order_by]&[eval export_url_vars $ctrlvars]\">Deadline</a></th>"
+}
+
+append results "<th align=left><a href=\"user-top.tcl?order_by=[toggle_order one_line $order_by]&[eval export_url_vars $ctrlvars]\">Synopsis</a></th>
+"
+if {![string match "project_title" $order_by]} {
+    append results "<th align=left><a href=\"user-top.tcl?order_by=[toggle_order project_id $order_by]&[eval export_url_vars $ctrlvars]\">Project</a></th>
+"    
+}
+append results "</tr>\n"
+
+set last_project_title ""
+
+set query "select distinct
+ ticket_issues.msg_id,
+ ticket_issues.ticket_type, 
+ ticket_issues.one_line,
+ ticket_issues.status,
+ ticket_issues.severity,
+ ticket_issues.posting_time,
+ users.email,
+ ticket_projects.title as project_title,
+ ticket_projects.project_id,
+ ticket_issues.priority, 
+ to_char(ticket_issues.modification_time, 'mm/dd/yy') as modification_time,
+ to_char(ticket_issues.posting_time, 'mm/dd/yy') as creation_time,
+ to_char(ticket_issues.close_date, 'mm/dd/yy') as close_date,
+ to_char(ticket_issues.deadline, 'mm/dd/yy') as deadline,
+ to_char(sysdate - deadline) as pastdue,
+ ticket_issue_assignments.active_p as assigned_p,
+ ticket_issues.public_p,
+ ticket_priorities.name as priority_name
+from ticket_issues, ticket_priorities, ticket_projects, users, ticket_issue_assignments
+where ticket_priorities.priority = ticket_issues.priority
+and users.user_id = ticket_issues.user_id
+and ticket_projects.project_id = ticket_issues.project_id
+and ticket_issues.msg_id = ticket_issue_assignments.msg_id(+)
+$assignment_filter
+$status_filter
+$date_filter
+order by $order_by, ticket_issues.priority, ticket_issues.posting_time"
+
+set selection [ns_db select $db $query]
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    set cols {}
+    lappend cols "<a href=\"issue-view.tcl?msg_id=$msg_id\">$msg_id</a>"
+    lappend cols "P$priority"
+    lappend cols "[string range $ticket_type 0 3]"
+    regsub "@.*" $email "" email
+    lappend cols "$email"
+    if { [string compare $status "fixed waiting approval"] == 0 } {
+	lappend cols "<font color=#00ff00>(w approv)</font>"
+    } elseif { [string compare $status "need clarification"] == 0 } {
+	lappend cols "<font color=#ff0000>nd clar</font>"
+    } else {
+	lappend cols $status
+    }
+    lappend cols "$severity"
+    lappend cols "$creation_time"
+    lappend cols "$modification_time"
+
+    if {$view_assignment != "user"} {
+	if {$assigned_p == "t"} {
+	    lappend cols "<img src=/graphics/checkmark.gif>"
+	} else {
+	    lappend cols " - "
+	}
+    }
+    
+    if {[info exists closed] && $view_closed == 1} {
+	lappend cols "$close_date" 
+    } else {
+	if {$pastdue > 0} {
+	    lappend cols "<font color=red>$deadline</font>"
+	} else {
+	    lappend cols "$deadline"
+	}
+    }
+    
+    lappend cols "<a href=\"issue-view.tcl?msg_id=$msg_id\">[clean_up_html $one_line]</a>"
+    
+    # show project title if we are not sorting by project
+    if {![string match "project_title" $order_by]} {
+	lappend cols "<a href=project-top.tcl?project_id=$project_id>[string range $project_title 0 12]</a>"	
+    }
+    
+    if {[string match "project_title" $order_by] && $last_project_title != $project_title} {
+	append results "<tr><th colspan=10 align=left><a href=project-top.tcl?project_id=$project_id>$project_title</a></th></tr>\n"
+	set last_project_title $project_title
+    }
+    
+    incr count
+    if {($count % 2) == 0} {
+	set bgcolor "bgcolor=\#ECECEC"
+    } else {
+	set bgcolor ""
+    }
+    
+    append results "<tr $bgcolor>"
+    foreach col $cols {
+	append results "<td>$col&nbsp;</td>\n"
+    }
+    append results "</tr>"    
+}
+
+if { $count == 0 } {
+    append results "<tr><td colspan=10 align=center>-- No issues --</td></tr>"   
+}
+
+append results "</table>\n<p>"
+
+
+ns_write  "$results
+
+<ul>
+<li>Add new <a href=\"issue-new.tcl\">issue</a>
+</ul>
+[ad_footer]
+"
+
Index: web/openacs/www/ticket/admin/xref-search.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/ticket/admin/xref-search.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/ticket/admin/xref-search.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,129 @@
+set_the_usual_form_variables
+# project_id (optional)
+#
+# target -- url to return to when done
+# msg_id
+# 
+# standard ticket search form variables
+
+
+set db [ticket_getdbhandle]
+
+# we ask for all the top level messages
+
+ReturnHeaders
+
+ns_write "[ad_header "Search Results"]
+<h2>Tickets matching query</h2>
+[ad_context_bar_ws_or_index [list "/ticket/admin/index.tcl" "Ticket Tracker"]  "Search Results"]
+
+
+Click on a link below to add that ticket as a cross-reference.
+<p>
+<ul>
+"
+
+
+
+# Check input.
+
+set exception_text ""
+set exception_count 0
+
+ticket_search_combine_and_build_error_list
+
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# This looks at a bunch of form vars, and builds a list of search
+# clauses in search_clause_list
+ticket_search_build_where_clause_and_description
+
+
+set search_clause [join $search_clause_list " and "]
+
+if ![info exists search_clause_list] {
+    ad_return_complaint 1 "<li>Please specify at least some search criteria.\n"
+    return
+}
+
+
+ns_write "
+
+
+
+<hr>
+
+Search criteria:
+
+<ul>
+<li>[join $search_description_items "<li>"]
+</ul>
+
+
+<p>
+
+Search results:
+"
+
+
+
+
+set display_title "Ticket search"
+
+set selection [ns_db select $db "select ticket_issues.one_line,
+ticket_issues.msg_id xmsg_id,
+ticket_priorities.name, 
+ticket_projects.title as project_title, 
+users.first_names,
+users.last_name,
+to_char(posting_time, 'mm/dd/yyyy') as creation_date
+from ticket_issues, ticket_projects, ticket_priorities, users where
+users.user_id = ticket_issues.user_id 
+and ticket_issues.priority = ticket_priorities.priority
+and ticket_projects.project_id = ticket_issues.project_id
+and $search_clause
+order by ticket_issues.project_id, msg_id"]
+
+set counter 0
+
+set last_title ""
+ns_write "<ul>"
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+    set pmsg_id $msg_id
+    incr counter
+    if {$project_title != $last_title} {
+	ns_write "</ul><b>$project_title</b><ul>"
+    }
+    set last_title $project_title
+    ns_write "<li><a href=\"add-xref.tcl?[export_url_vars target xmsg_id pmsg_id]\">\[$xmsg_id\] [clean_up_html $one_line]</a>\n"
+}
+
+ns_write "</ul>"
+
+if { $counter == 0 } {
+    set search_items "messages"
+    ns_write "No matching items found.<p>
+    <a href=\"$target?[export_url_vars target msg_id xmsg_id]\">Back to ticket #$msg_id</a>"
+}
+ns_write "
+</ul>
+[ad_footer]
+"
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/todo/checked.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/checked.gif,v
diff -u
Binary files differ
Index: web/openacs/www/todo/defs.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/defs.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/defs.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,464 @@
+
+proc todo_system_name {} {
+    return "To-Do List Manager"
+}
+
+proc todo_url_stub {} {
+    return "/todo"
+}
+
+proc todo_administrator {} {
+    return "ben@mit.edu"
+}
+
+proc todo_header {title} {
+    set return_url [ns_conn url]?[ns_conn query]
+    
+    set return_string "[ad_header $title]"
+
+    # Check if items to delete
+    set db [ns_db gethandle subquery]
+    set count_check [database_to_tcl_string $db "select count(*) from deleted_todo_items where [ad_get_user_id]=(select user_id from todo_lists where list_id=deleted_todo_items.list_id)"]
+    ns_db releasehandle $db
+
+    if {$count_check > 0} {
+	set extra_right_link "<a href=deleted-items.tcl>deleted items</a>"
+    } else {
+	set extra_right_link ""
+    }
+
+
+    if {[ns_conn url] != "/todo/preferences.tcl"} {
+	append return_string "
+    <table align=right noborder>
+    <tr><td><a href=/todo/preferences.tcl?[export_url_vars return_url]>edit preferences</a><br>
+$extra_right_link</td></tr>
+    </table>"
+    }
+
+    return $return_string
+}
+
+proc todo_footer {} {
+    return "[ad_footer]"
+}
+
+#
+# Simple user information management
+##
+proc set_simple_user_information {db} {
+    uplevel {
+	set user_id [ad_verify_and_get_user_id]
+
+	set user_logged_on_p 0
+
+	if {$user_id > 0} {
+	    set selection [ns_db 1row $db "select first_names, last_name, email from users where user_id=$user_id"]
+	    set_variables_after_query
+	    set user_logged_on_p 1
+	}
+    }
+}
+
+
+ns_share -init {set ad_todo_security_filters_installed 0} ad_todo_security_filters_installed
+
+if {!$ad_todo_security_filters_installed} {
+    set ad_todo_security_filters_installed 1
+    # Bounce people out of the /sdm/pvt directory if they're not logged in
+    ns_register_filter preauth GET /todo/* ad_verify_identity
+    ns_register_filter preauth POST /todo/* ad_verify_identity
+}
+
+
+proc user_can_access_list_p {db user_id list_id} {
+    set check [database_to_tcl_string $db "select user_can_access_list_p($user_id,$list_id) from dual"]
+
+    if {$check == "t"} {
+	return 1
+    } else {
+	return 0
+    }
+}
+
+proc todo_return_access_complaint {} {
+    ns_return 500 text/html "[todo_header "Access Violation"]
+    <h2>Access Violation</h2>
+    <hr><p>
+    You are not allowed to view this information, either because you are not logged on, or if you are, because this information is private and you are not authorized.
+    <p>
+    [todo_footer]
+"
+}
+
+proc todo_set_user_preferences {db user_id} {
+    uplevel {
+	set selection [ns_db 0or1row $db "select old_item_expire, COALESCE(time_offset,0) as time_offset, COALESCE(personal_midnight,0) as personal_midnight, sort_by, notification_interval, separate_completed_items_p from todo_user_preferences where user_id=$user_id"]
+
+	if {$selection == "" } {
+	    ns_db dml $db "insert into todo_user_preferences (user_id) VALUES ($user_id)"
+	    todo_set_user_preferences $db $user_id
+	}
+
+	set_variables_after_query
+
+	# Why was this here? (BMA)
+	# set sort_by [subst $sort_by]
+    }
+}
+
+proc todo_daily_sweep {} {
+    set db [ns_db gethandle]
+
+    # The -0.01 is for slight inconsistencies in times that the proc runs
+    set user_ids [database_to_tcl_list $db "select user_id from todo_user_preferences where notification_interval>0 and (sysdate()>=(last_notification+notification_interval-0.01) or last_notification is NULL)"]
+
+    foreach user_id $user_ids {
+	ns_log Notice "doing email for user_id $user_id"
+
+	set notification_interval [database_to_tcl_string $db "select notification_interval from todo_user_preferences where user_id=$user_id"]
+
+	set selection [ns_db select $db "select list_name, item_id, first_names as assigned_by_first_names, todo_lists.list_id as list_id, completion_date, pretty_relative_date(todo_items.due_date, 0) as pretty_relative_due_date, todo_days_from_pretty(pretty_relative_date(todo_items.due_date,0)) as n_days, substr(item_details,0,60) as short_item_details, item_details, priority from todo_items, todo_lists, users where todo_items.assigned_by=users.user_id(+) and todo_items.list_id= todo_lists.list_id and (same_day_p(todo_items.due_date,sysdate(), 0)='t' or todo_items.due_date<(sysdate()+$notification_interval)) and todo_lists.user_id=$user_id and (completion_date is NULL)"]
+
+	set things_to_do_text ""
+
+	while {[ns_db getrow $db $selection]} {
+	    set_variables_after_query
+
+	    append things_to_do_text "- ($priority) $pretty_relative_due_date, for $list_name: $item_details\n"
+	}
+
+	set email [database_to_tcl_string $db "select email from users where user_id=$user_id"]
+	
+	if {[catch {
+	    if {[string length $things_to_do_text] > 0} {
+		ns_log Notice "sending the email"
+		ns_sendmail "$email" "badida@scient.com" "Things to do" "
+		In the next $notification_interval day(s), you have the following things to do
+\n
+$things_to_do_text
+\n\n
+-ToDo Manager"
+}
+} errmsg]} {
+    ns_log Notice "error: $errmsg"
+} else {
+    ns_db dml $db "update todo_user_preferences set last_notification=sysdate() where user_id=$user_id"
+}
+}
+
+ns_db releasehandle $db
+
+}
+
+
+
+## A procedure to output things consistently
+## for list of todos
+proc todo_one_item_form {submit_tag} {
+    set db [ns_db gethandle subquery]
+
+    set list_of_dates [database_to_tcl_list_list $db "select days,pretty_date from relative_date_pretty_text where days>=0 or days is NULL order by days"]
+
+    set string "
+<tr>
+<td>[make_html_select priority {1 2 3 4 5}]</td>
+<td>[make_html_select n_days $list_of_dates]</td>
+<td><INPUT TYPE=text name=item_details size=50></td>
+<td><INPUT TYPE=submit value=$submit_tag></td>
+</tr>
+"
+
+ns_db releasehandle $db
+
+return $string
+
+}
+
+# The list of headers for the front page
+proc todo_delete_list_of_headers {} {
+    return {
+	{priority Priority}
+	{list_name List}
+	{short_details Details}
+	{deletion_date {Deletion Date}}
+    }
+}
+
+proc todo_general_list_of_headers {} {
+    return {
+	{priority Priority}
+	{list_name List}
+	{item_details Details}
+	{assigned_by_first_names {Assigned by}}
+    }
+}
+
+proc todo_general_plugin_list_of_headers {} {
+    return {
+	{priority Priority}
+	{category Category}
+	{item_details Details}
+	{assigned_by {Assigned by}}
+    }
+}
+
+# List of specific stuff
+proc todo_specific_list_of_headers {} {
+    return {
+	{priority Priority}
+	{pretty_relative_due_date {Due Date}}
+	{item_details Details}
+	{assigned_by_first_names {Assigned by}}
+    }
+}
+
+proc todo_plugin_list_of_headers {} {
+    return {
+	{priority Priority}
+	{due_date {Due Date}}
+	{item_details Details}
+	{assigned_by {Assigned By}}
+    }
+}
+
+## The table headers
+proc todo_list_html_header {list_of_headers} {
+    set return_html "<tr>\n"
+    foreach header $list_of_headers {
+	append return_html "<th align=left>[lindex $header 1]</th>"
+    }
+    append return_html "<th>Actions</th></tr>\n"
+    
+    return $return_html
+}
+
+# The list_of_headers is a list of list
+# with first the sql name, second the pretty name.
+proc todo_list_html {db sql current_url list_of_headers {extra_rows {}} {item_id_to_edit {}} {view_open_items ""}} {
+
+    if {[string first "?" $current_url] == -1} {
+	set current_url "$current_url?"
+    }
+
+    set return_url "$current_url"
+
+    ## Build the header stuff
+    #
+    set return_header ""
+    set always_header ""
+
+    if {$view_open_items != ""} {
+	append always_header "<table noborder cellpadding=3><tr>"
+	if {$view_open_items == "t"} {
+	    regsub " todo_items " $sql " open_todo_items todo_items " sql
+
+	    append always_header "<th bgcolor=#dddddd>Open</th><th bgcolor=#bbbbbb><a href=${current_url}&view_open_items=f>Closed</a></th>"
+	} else {
+	    regsub " todo_items " $sql " closed_todo_items todo_items " sql
+	    
+	    append always_header "<th bgcolor=#bbbbbb><a href=${current_url}&view_open_items=t>Open</a></th><th bgcolor=#dddddd>Closed</th>"
+	}
+	append always_header "</tr></table>\n"
+    } else {
+	# Fix so we only see the undeleted ones
+	regsub " todo_items " $sql " viewable_todo_items todo_items " sql
+    }
+
+    append return_header "<table noborder>\n<tr>\n"
+    foreach header $list_of_headers {
+	append return_header "<th align=left>[lindex $header 1]</th>"
+    }
+    append return_header "<th>Actions</th></tr>\n"
+
+    set return_string ""
+
+    ## Do the query
+    #
+    set selection [ns_db select $db $sql]
+    
+    while {[ns_db getrow $db $selection]} {
+	set_variables_after_query
+
+	if {$item_id_to_edit == $item_id} {
+	    append return_string "<FORM METHOD=POST action=item-edit.tcl>
+	    [export_form_vars item_id return_url]
+	    [bt_mergepiece [todo_one_item_form "edit"] $selection]
+	    </FORM>\n"
+	    continue
+	}
+	
+	set one_row "<tr>\n"
+	
+	# In case it's completed
+	if {$completion_date == ""} {
+	    set pre_item ""
+	    set post_item ""
+	    set actions_html "<td><a href=item-completed.tcl?[export_url_vars item_id return_url]><img align=middle height=15 border=0 src=unchecked.gif></a>  <a href=${current_url}&item_id_to_edit=$item_id>edit</a></td>"
+	} else {
+	    set pre_item "<strike>"
+	    set post_item "</strike>"
+	    set actions_html "<td><nobr><a href=item-uncompleted.tcl?[export_url_vars item_id return_url]><img align=middle height=15 border=0 src=checked.gif></a> <a href=item-delete.tcl?[export_url_vars item_id]><img align=middle height=15 border=0 src=delete.gif></a></nobr></td>"
+	}
+
+	# If item is deleted, totally change the action
+	if {[info exists deletion_date] && $deletion_date!=""} {
+	    set return_url $current_url
+	    set actions_html "<td><a href=item-undelete.tcl?[export_url_vars item_id return_url]>undelete</a></td>"
+	}
+	
+	foreach header $list_of_headers {
+	    # Special case for list name
+	    if {[lindex $header 0] == "list_name"} {
+		append one_row "<td>$pre_item<a href=one-list.tcl?[export_url_vars list_id]>$list_name</a>$post_item</td>"
+		continue
+	    }
+
+	    # Special case for item details
+	    if {[lindex $header 0] == "item_details"} {
+		if {[string length $item_details] > 100} {
+		    append one_row "<td>$pre_item [string range $item_details 0 100]... (<a target=detail_window href=one-item.tcl?[export_url_vars item_id]>more</a>) $post_item</td>"
+		    continue
+		}
+	    }
+
+	    if {[lindex $header 0] == "priority"} {
+		append one_row "<td>$pre_item<strong>($priority)</strong>$post_item</td>"
+		continue
+	    }
+	    
+	    append one_row "<td>$pre_item[set [lindex $header 0]]$post_item</td>"
+	}
+	
+	append one_row "$actions_html</tr>\n"
+
+	append return_string $one_row
+    }
+    
+    if {$item_id_to_edit == ""} {
+	append return_string "$extra_rows"
+    } 
+
+    if {$return_string == ""} {
+	return "$always_header\n no items"
+    } else {
+	set return_string "$always_header\n $return_header\n$return_string"
+    }
+
+    append return_string "</table>"
+
+    if {$item_id_to_edit != ""} {
+	append return_string "<a href=$current_url>cancel edit</a>\n"
+    }
+    
+    return $return_string
+}
+
+
+# A procedure to send email if necessary
+proc todo_email {db item_id event} {
+    set assigner_user_id [database_to_tcl_string $db "select assigned_by from todo_items where item_id=$item_id"]
+    set assignee_user_id [database_to_tcl_string $db "select user_id from todo_lists where list_id= (select list_id from todo_items where item_id=$item_id)"]
+
+    # No notification if you did something yourself
+
+    if {$assigner_user_id == ""} {
+	return
+    }
+    if {$assignee_user_id == $assigner_user_id} {
+	return
+    }
+
+    set selection [ns_db 1row $db "select item_details as details, due_date from todo_items where item_id= $item_id"]
+    set_variables_after_query
+
+    # Here we want to set the 
+    # from_email, from_first_names, from_last_name
+    # to_email, to_first_names, to_last_name
+    if {$event == "assigned"} {
+	set from_user_id $assigner_user_id
+	set to_user_id $assignee_user_id
+
+	set subject "new todo item"
+	set action "has assigned you"
+    }
+
+    if {$event == "completed"} {
+	set from_user_id $assignee_user_id
+	set to_user_id $assigner_user_id
+
+	set subject "item you assigned is completed"
+	set action "has completed"
+    }
+
+    if {$event == "uncompleted"} {
+	set from_user_id $assignee_user_id
+	set to_user_id $assigner_user_id
+
+	set subject "item you assigned is NO LONGER completed"
+	set action "has NOT completed"
+    }
+
+    set selection [ns_db 1row $db "select email as from_email, first_names as from_first_names, last_name as from_last_name from users where user_id=$from_user_id"]
+    set_variables_after_query
+
+    set selection [ns_db 1row $db "select email as to_email, first_names as to_first_names, last_name as to_last_name from users where user_id=$to_user_id"]
+    set_variables_after_query
+
+    # Send the email
+    ns_sendmail $to_email $from_email "$subject" "
+$from_first_names $from_last_name $action item #$item_id:
+
+$details
+"
+}
+
+
+## A proc to get the view_open_items var
+proc todo_view_open_items {separate_completed_items_p} {
+    if {$separate_completed_items_p == "f"} {
+	return ""
+    }
+
+    set view_open_items [ns_queryget "view_open_items"]
+
+    if {$view_open_items == ""} {
+	set view_open_items "t"
+    }
+
+    return $view_open_items
+}
+
+#
+# A procedure to really delete old deleted items.
+#
+proc todo_delete_old_items {} {
+    set db [ns_db gethandle subquery]
+    
+    ns_db dml $db "delete from deleted_todo_items where (deletion_date+timespan(2*3600*24))<sysdate()"
+
+    ns_db releasehandle $db
+}
+
+# More things
+proc todo_n_days_from_pretty {due_date} {
+    return [util_memoize "todo_n_days_from_pretty_no_memoize \"$due_date\""]
+}
+
+proc todo_n_days_from_pretty_no_memoize {due_date} {
+    set db [ns_db gethandle subquery]
+    set result [database_to_tcl_string $db "select todo_days_from_pretty('$due_date') from dual"]
+    ns_db releasehandle $db
+
+    return $result
+}
+
+ns_share -init {set ad_todo_procs_scheduled 0} ad_todo_procs_scheduled
+
+if {!$ad_todo_procs_scheduled} {
+    set ad_todo_procs_scheduled 1
+    # Schedule this every day at 7am EST
+    ns_schedule_daily 7 0 todo_daily_sweep
+    ns_schedule_daily 8 0 todo_delete_old_items
+}
+
Index: web/openacs/www/todo/delete-permission.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/delete-permission.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/delete-permission.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,22 @@
+set_the_usual_form_variables
+# user_id, list_id
+
+validate_integer user_id $user_id
+validate_integer list_id $list_id
+
+set other_user_id $user_id
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+set check [database_to_tcl_string $db "select count(*) from todo_lists where user_id=$user_id and list_id=$list_id"]
+
+if {$check} {
+    ns_db dml $db "delete from todo_list_user_map where user_id=$other_user_id and list_id=$list_id"
+}
+
+set plugin "todo"
+set category_id $list_id
+
+ns_returnredirect "one-plugin-list.tcl?[export_url_vars plugin category_id]"
Index: web/openacs/www/todo/delete.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/delete.gif,v
diff -u
Binary files differ
Index: web/openacs/www/todo/deleted-items.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/deleted-items.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/deleted-items.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,24 @@
+
+set db [ns_db gethandle]
+
+# set basic info
+set_simple_user_information $db
+todo_set_user_preferences $db $user_id
+
+ReturnHeaders
+
+ns_write "[todo_header "Deleted Items"]
+<h2>Deleted Items</h2>
+in your <a href=/todo>workspace</a>.
+<hr><p>
+The following items were deleted from your to-do lists. They can easily be recovered soon after you delete them, but they are eventually completely deleted. If they appear below, they can be recovered.
+<p>
+"
+
+set sql "select item_id, todo_lists.list_id as list_id, list_name, priority, deleted_todo_items.creation_date as creation_date, pretty_relative_date(deleted_todo_items.due_date,$personal_midnight) as pretty_relative_due_date, deletion_date, todo_days_from_pretty(pretty_relative_date(deleted_todo_items.due_date,$personal_midnight)) as n_days, completion_date, substr(item_details, 0,80) as short_details, item_details from deleted_todo_items, todo_lists where deleted_todo_items.list_id= todo_lists.list_id and user_id=$user_id"
+
+ns_write "[todo_list_html $db $sql deleted-items.tcl [todo_delete_list_of_headers]]"
+
+ns_write "<p>
+
+[todo_footer]"
Index: web/openacs/www/todo/index.help
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/index.help,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/index.help	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,51 @@
+<%= [todo_help_header "Todo Help"] %>
+
+<h3>Todo: The Basic Idea</h3>
+
+Todo is simply a task manager that allows you to organize your random
+tasks. Todo also integrates with other modules (the Ticket Tracker,
+and the Software Development Manager) to allow you to access
+everything you're assigned to do in one convenient spot.
+
+<p>
+
+<h3>Todo: Lists</h3>
+
+Todo lists can be created manually from the front page. These are
+simply task lists that are not tied to any other module of the ACS,
+and which can be shared with other users at will. You can click down
+to a list-specific page from the front page, which will show you all
+the tasks assigned to you in that list.
+
+<p>
+
+Some Todo lists are automatically generated from other modules. These
+lists cannot be explicitly created: they automatically appear when
+actions are taken in other modules. For example, being assigned to a
+bug in the SDM will automatically add a list in the Todo  Manager that
+corresponds to that SDM package and includes the bugs that need to be
+fixed.
+
+<h3>Todo: Life-Cycle of items</h3>
+
+A todo item is either:
+<ul>
+<li> <b>Open</b>: the task is open for completion
+<li> <b>Closed</b>: the task has been checked off, and appears in
+strike-through style. It will remain visible to the user for a period
+of time defined in the ToDo Preferences, available from every page of
+the ToDo module in the upper right-hand corner.
+<li> <b>Deleted</b>: the task has been marked deleted. This can only
+be done once a task has been marked closed (just to prevent from
+inadvertently deleting a task). Tasks remain in the "deleted" state
+for a couple of days, at which point they are automatically purged
+from the system. When deleted, they do not appear in the user's normal
+views, but can still be retrieved by selecting "deleted tasks" from
+the upper right-hand corner of every page. This link appears only when
+there exists at least one deleted task.
+</ul>
+
+
+<p>
+
+<%= [todo_footer] %>
\ No newline at end of file
Index: web/openacs/www/todo/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/index.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,115 @@
+set_form_variables 0
+
+ReturnHeaders
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+todo_set_user_preferences $db $user_id
+
+if {![info exists item_id_to_edit]} {
+    set item_id_to_edit ""
+}
+
+validate_integer_or_null item_id_to_edit $item_id_to_edit
+
+ns_write "[todo_header "[todo_system_name]"]
+<h2>[todo_system_name]</h2>
+[ad_context_bar_ws_or_index [todo_system_name]]
+<hr><p>
+
+<ul>
+<li> <a href=new-list.tcl>Create</a> a new to-do list.<p>
+</ul>
+<p>
+<center><table border=0 cellpadding=3>
+<tr bgcolor=lightgrey><th width=50%>Lists You Own</th><th>Lists You Share</th></tr>
+<tr>
+<td valign=top>
+<font size=-1><ul>"
+
+foreach plugin_category [todo_get_personal_plugins_and_categories $db $user_id] {
+    set plugin [lindex $plugin_category 0]
+    set category_id [lindex $plugin_category 1]
+    set category [lindex $plugin_category 2]
+    ns_write "<li> <a href=one-plugin-list.tcl?[export_url_vars plugin category category_id]>$plugin:$category</a>\n"
+}
+
+ns_write "</ul></font></td><td valign=top>
+<ul><font size=-1>"
+
+set list_of_other_categories [todo_get_other_plugins_and_categories $db $user_id]
+
+if {[llength $list_of_other_categories] > 5} {
+    ns_write "You have [llength $list_of_other_categories] shared lists,<br>
+    which is too many to display on this screen.<p> 
+    Please follow through to your <a href=todo-shared-lists.tcl>shared list page</a>."
+} else {
+    foreach plugin_category $list_of_other_categories {
+	set plugin [lindex $plugin_category 0]
+	set category_id [lindex $plugin_category 1]
+	set category [lindex $plugin_category 2]
+	ns_write "<li> <a href=one-plugin-list.tcl?[export_url_vars plugin category category_id]>$plugin:$category</a>\n"
+    }
+}
+
+
+ns_write "</font></ul>
+</td></tr>
+</table></center>
+<p>"
+
+set overdue_html [todo_plugin_get_html_by_sql $db [todo_all_plugins_sql $db $user_id "\$due_date < sysdate() and same_day_p(\$due_date, sysdate(), $personal_midnight)='f'" index.tcl $old_item_expire "" "open"] index.tcl [todo_general_plugin_list_of_headers] $item_id_to_edit]
+
+set today_html [todo_plugin_get_html_by_sql $db [todo_all_plugins_sql $db $user_id "same_day_p(\$due_date, sysdate(), $personal_midnight)='t'" index.tcl $old_item_expire "" [todo_view_open_items $separate_completed_items_p]] index.tcl [todo_general_plugin_list_of_headers] $item_id_to_edit]
+
+set tomorrow_html [todo_plugin_get_html_by_sql $db [todo_all_plugins_sql $db $user_id "same_day_p(\$due_date, sysdate() + timespan_days(1), $personal_midnight)='t'" index.tcl $old_item_expire "" [todo_view_open_items $separate_completed_items_p]] index.tcl [todo_general_plugin_list_of_headers] $item_id_to_edit]
+
+if {$overdue_html != ""} {
+ns_write "
+<h3>Overdue</h3>
+<table>
+[todo_list_html_header [todo_general_plugin_list_of_headers]]
+$overdue_html
+</table>
+"
+}
+
+set tabs "[todo_openclosed_tabs [todo_view_open_items $separate_completed_items_p]]"
+
+if {$tabs != ""} {
+    append tabs "<br>"
+}
+
+ns_write "<h3>Today's Things To Do</h3>"
+
+if {$today_html != "" } {
+ns_write "
+$tabs
+<table>
+[todo_list_html_header [todo_general_plugin_list_of_headers]]
+$today_html
+</table>
+"
+} else {
+    ns_write "no items"
+}
+
+ns_write "<h3>Tomorrow's Things To Do</h3>"
+
+if {$tomorrow_html != ""} {
+ns_write "
+$tabs
+<table>
+[todo_list_html_header [todo_general_plugin_list_of_headers]]
+$tomorrow_html
+</table>
+"
+} else {
+    ns_write "no items"
+}
+
+ns_write "<p>
+[todo_footer]
+"
Index: web/openacs/www/todo/item-completed.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/item-completed.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/item-completed.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,22 @@
+set_the_usual_form_variables
+# item_id
+# maybe return_url
+
+validate_integer item_id $item_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+ns_db dml $db "update todo_items set completion_date=sysdate() where item_id=$item_id and user_can_access_list_p($user_id, list_id)='t'"
+
+set list_id [database_to_tcl_string $db "select list_id from todo_items where item_id=$item_id"]
+
+if {![info exists return_url]} {
+    set return_url "one-list.tcl?[export_url_vars list_id]"
+}
+
+# Send email if necessary
+todo_email $db $item_id "completed"
+
+ns_returnredirect "$return_url"
Index: web/openacs/www/todo/item-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/item-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/item-delete.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,21 @@
+set_the_usual_form_variables
+# item_id
+
+validate_integer item_id $item_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+set list_id [database_to_tcl_string $db "select list_id from todo_items where item_id=$item_id"]
+
+ns_db dml $db "update todo_items 
+set deletion_date=sysdate()
+where item_id=$item_id and user_can_access_list_p($user_id, list_id)='t'"
+
+if {![info exists return_url]} {
+    set return_url "one-list.tcl?[export_url_vars list_id]"
+}
+
+ns_returnredirect "$return_url"
+
Index: web/openacs/www/todo/item-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/item-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/item-edit.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,52 @@
+set_the_usual_form_variables
+# item_id priority due_date item_details
+# or maybe n_days
+# possibly return_url
+
+validate_integer item_id $item_id
+
+if {![info exists n_days]} {
+    # get the due date out of there
+    ns_dbformvalue [ns_getform] due_date date due_date
+} else {
+    validate_integer n_day $n_days
+}
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+set list_id [database_to_tcl_string $db "select list_id from todo_items where item_id=$item_id"]
+
+if {![user_can_access_list_p $db $user_id $list_id]} {
+    todo_return_access_complaint
+    return
+}
+
+if {[info exists n_days]} {
+    if {$n_days != ""} {
+	set due_date_sql "sysdate()+timespan_days($n_days)"
+    } else {
+	set due_date_sql "NULL"
+    }
+} else {
+    set due_date_sql "'$due_date'"
+}
+
+if {[catch {
+    ns_db dml $db "update todo_items set
+priority=$priority,
+due_date=$due_date_sql,
+item_details='$QQitem_details'
+where 
+item_id=$item_id"
+} errmsg]} {
+    #
+    # do nothing
+}
+
+if {![info exists return_url]} {
+    set return_url one-list.tcl?[export_url_vars list_id]
+}
+
+ns_returnredirect $return_url
\ No newline at end of file
Index: web/openacs/www/todo/item-uncompleted.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/item-uncompleted.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/item-uncompleted.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,21 @@
+set_the_usual_form_variables
+# item_id
+
+validate_integer item_id $item_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+ns_db dml $db "update todo_items set completion_date=NULL where item_id=$item_id and user_can_access_list_p($user_id, list_id)='t'"
+
+set list_id [database_to_tcl_string $db "select list_id from todo_items where item_id=$item_id"]
+
+if {![info exists return_url]} {
+    set return_url "one-list.tcl?[export_url_vars list_id]"
+}
+
+# Send email if necessary
+todo_email $db $item_id "uncompleted"
+
+ns_returnredirect "$return_url"
Index: web/openacs/www/todo/item-undelete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/item-undelete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/item-undelete.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,12 @@
+set_the_usual_form_variables
+# item_id return_url
+
+validate_integer item_id $item_id
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+ns_db dml $db "update todo_items set deletion_date=null where item_id=$item_id and user_can_access_list_p($user_id, list_id)='t'"
+
+ns_returnredirect "$return_url"
Index: web/openacs/www/todo/list-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/list-delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/list-delete-2.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,24 @@
+set_the_usual_form_variables
+# list_id
+
+validate_integer list_id $list_id
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+if {$user_id != [database_to_tcl_string $db "select user_id from todo_lists where list_id=$list_id"]} {
+    todo_return_access_complaint
+    return
+}
+
+ns_db dml $db "begin transaction"
+
+ns_db dml $db "delete from todo_list_user_map where list_id=$list_id"
+ns_db dml $db "delete from todo_list_user_group_map where list_id=$list_id"
+ns_db dml $db "delete from todo_items where list_id=$list_id"
+ns_db dml $db "delete from todo_lists where list_id=$list_id"
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "index.tcl"
Index: web/openacs/www/todo/list-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/list-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/list-delete.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,26 @@
+set_the_usual_form_variables
+# list_id
+
+validate_integer list_id $list_id
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+if {$user_id != [database_to_tcl_string $db "select user_id from todo_lists where list_id=$list_id"]} {
+    todo_return_access_complaint
+    return
+}
+
+set selection [ns_db 1row $db "select list_name from todo_lists where list_id=$list_id"]
+set_variables_after_query
+
+ns_return 200 text/html "[todo_header "Verification"]
+<h2>Deletion Verification</h2>
+<hr><p>
+
+You've chosen to delete your $list_name to-do list.<br>
+If you would really like to do this, you can <a href=list-delete-2.tcl?[export_url_vars list_id]>confirm</a> this operation.<p>
+
+[todo_footer]
+"
\ No newline at end of file
Index: web/openacs/www/todo/move-overdue-to-today.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/move-overdue-to-today.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/move-overdue-to-today.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,13 @@
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+todo_set_user_preferences $db $user_id
+
+ns_db dml $db "
+update todo_items set due_date=sysdate()
+where
+item_id in (select item_id from todo_items where same_day_p(due_date, sysdate(), $personal_midnight)='f' and due_date<sysdate() and $user_id=(select user_id from todo_lists where list_id=todo_items.list_id) and (completion_date is NULL))"
+
+ns_returnredirect "index.tcl"
Index: web/openacs/www/todo/new-item-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/new-item-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/new-item-2.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,48 @@
+set_the_usual_form_variables
+# list_id priority due_date item_details
+# or maybe n_days
+
+validate_integer list_id $list_id
+
+if {![info exists n_days]} {
+    # get the due date out of there
+    ns_dbformvalue [ns_getform] due_date date due_date
+} else {
+    validate_integer n_days $n_days
+}
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {![info exists item_id]} {
+    set item_id [database_to_tcl_string $db "select todo_item_id_sequence.nextval from dual"]
+}
+
+if {![user_can_access_list_p $db $user_id $list_id]} {
+    todo_return_access_complaint
+    return
+}
+
+if {[info exists n_days]} {
+    if {$n_days != ""} {
+	set due_date_sql "sysdate()+$n_days"
+    } else {
+	set due_date_sql "NULL"
+    }
+} else {
+    set due_date_sql "'$due_date'"
+}
+
+
+if {[catch {
+    ns_db dml $db "insert into todo_items (item_id, list_id, priority, creation_date, due_date, item_details, assigned_by) VALUES ($item_id, $list_id, $priority, sysdate(), $due_date_sql, '$QQitem_details', $user_id)"
+} errmsg]} {
+    #
+    # do nothing
+} else {
+    # Email if necessary
+    todo_email $db $item_id "assigned"
+}
+
+ns_returnredirect "one-list.tcl?[export_url_vars list_id]"
\ No newline at end of file
Index: web/openacs/www/todo/new-item.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/new-item.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/new-item.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,52 @@
+set_the_usual_form_variables
+# list_id
+
+validate_integer list_id $list_id
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db 
+
+if {![user_can_access_list_p $db $user_id $list_id]} {
+    todo_return_access_complaint
+    return
+}
+
+ReturnHeaders
+
+set selection [ns_db 1row $db "select list_id, list_name from todo_lists where list_id=$list_id"]
+set_variables_after_query
+
+ns_write "[todo_header "New Item"]
+<h2>New Item</h2>
+in <a href=one-list.tcl?[export_url_vars list_id]>$list_name</a>.
+<hr><p>
+"
+
+set item_id [database_to_tcl_string $db "select todo_item_id_sequence.nextval from dual"]
+
+set form "
+<FORM METHOD=POST action=new-item-2.tcl>
+[export_form_vars list_id item_id]
+<table noborder>
+<tr>
+<td valign=top>Item</td>
+<td><TEXTAREA name=item_details COLS=60 ROWS=15 WRAP=soft></TEXTAREA></td>
+</tr>
+<tr>
+<td>Priority</td>
+<td>[make_html_select priority {1 2 3 4 5}]</td>
+</tr>
+<tr>
+<td>Due Date</td>
+<td>[philg_dateentrywidget due_date [database_to_tcl_string $db "select sysdate()::date"]]</td>
+</tr>
+</table>
+<INPUT TYPE=submit value=create>
+</FORM>"
+
+ns_write "$form"
+
+ns_write "<p>
+[todo_footer]
+"
\ No newline at end of file
Index: web/openacs/www/todo/new-list-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/new-list-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/new-list-2.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,21 @@
+set_the_usual_form_variables
+# list_id, list_name, list_details, due_date
+
+validate_integer list_id $list_id
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+if {[catch {
+    ns_db dml $db "insert into todo_lists (list_id, user_id, list_name, list_details, creation_date) VALUES ($list_id, $user_id, '$QQlist_name', '$QQlist_details', sysdate())"
+} errmsg]} {
+    # do nothing,
+    # it was surely an insert problem with dual list_id keys
+    # ns_return 200 text/html "error: $errmsg"
+    # return
+}
+
+ns_returnredirect "index.tcl"
+
+
Index: web/openacs/www/todo/new-list.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/new-list.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/new-list.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,38 @@
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+ReturnHeaders
+
+ns_write "[todo_header "create a new list"]
+<h2>Create a New To-Do List</h2>
+in your <a href=index.tcl>[todo_system_name] workspace</a>.
+<hr><p>
+"
+
+set list_id [database_to_tcl_string $db "select todo_list_id_sequence.nextval from dual"]
+
+set form "
+<FORM METHOD=POST ACTION=new-list-2.tcl>
+[export_form_vars list_id]
+<table noborder>
+<tr>
+<td>List Name</td>
+<td><INPUT TYPE=text name=list_name size=50></td>
+</tr>
+<tr>
+<td valign=top>Details</td>
+<td><TEXTAREA name=list_details COLS=50 ROWS=5 wrap=soft></TEXTAREA><td>
+</tr>
+</table>
+<INPUT TYPE=submit value=create>
+</FORM>
+"
+
+ns_write "$form"
+
+ns_write "<p>
+
+[todo_footer]
+"
\ No newline at end of file
Index: web/openacs/www/todo/new-permission-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/new-permission-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/new-permission-2.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,23 @@
+set_the_usual_form_variables
+# list_id, user_id_from_search
+
+validate_integer list_id $list_id
+validate_integer user_id_from_search $user_id_from_search
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+set check [database_to_tcl_string $db "select count(*) from todo_lists where list_id=$list_id and user_id=$user_id"]
+
+if {!$check} {
+    todo_return_access_complaint
+    return
+}
+
+ns_db dml $db "insert into todo_list_user_map (list_id, user_id) VALUES ($list_id, $user_id_from_search)"
+
+
+
+ns_returnredirect "one-list.tcl?[export_url_vars list_id]"
+
Index: web/openacs/www/todo/new-permission.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/new-permission.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/new-permission.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,49 @@
+set_the_usual_form_variables
+# list_id
+
+validate_integer list_id $list_id
+
+ReturnHeaders
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+todo_set_user_preferences $db $user_id
+
+set selection [ns_db 1row $db "select list_name from todo_lists where list_id=$list_id"]
+set_variables_after_query
+
+ns_write "[todo_header "Adding a Collaborator"]
+<h2>Adding a Collaborator</h2>
+to <a href=one-list.tcl?[export_url_vars list_id]>$list_name</a>.
+<hr><p>
+
+You are about to allow a user to add todo items to your list. You can revoke this permission later.
+<p>
+"
+
+set passthrough {list_id automatic_approval}
+
+ns_write "
+<FORM METHOD=POST action=/user-search.tcl>
+[export_form_vars list_id]
+<INPUT TYPE=hidden name=target VALUE=/todo/new-permission-2.tcl>
+<INPUT TYPE=hidden name=custom_title VALUE=\"Pick a User to Grant Permissions To\">
+<INPUT TYPE=hidden name=passthrough value=\"$passthrough\">
+<table noborder>
+
+<tr>
+<td>User to grant to (search by email):</td>
+<td><INPUT TYPE=text name=email></td>
+</tr>
+</table>
+<p>
+<INPUT TYPE=submit value=grant>
+</FORM>
+"
+
+ns_write "<p>
+[todo_footer]
+"
+
Index: web/openacs/www/todo/one-item.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/one-item.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/one-item.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,44 @@
+set_the_usual_form_variables
+# item_id
+
+validate_integer item_id $item_id
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db 
+
+set list_id [database_to_tcl_string $db "select list_id from todo_items where item_id=$item_id"]
+
+if {![user_can_access_list_p $db $user_id $list_id]} {
+    todo_return_access_complaint
+    return
+}
+
+set selection [ns_db 1row $db "select priority, creation_date, due_date, completion_date, item_details, assigned_by as assigned_by_user_id from todo_items where item_id=$item_id"]
+set_variables_after_query
+
+set assigned_by [database_to_tcl_string_or_null $db "select first_names || ' ' || last_name from users where user_id=[db_postgres_null_sql $assigned_by_user_id]"]
+
+ReturnHeaders
+
+ns_write "[todo_header "Item Details"]
+<h2>Item Details</h2>
+<hr><p>
+<table noborder>
+<tr>
+<th align=left>Assigned By:</th>
+<td>$assigned_by</td>
+</tr>
+<tr>
+<th align=left>Due:</th>
+<td>[util_AnsiDatetoPrettyDate $due_date]</td>
+</tr>
+<tr>
+<th align=left>Details:</th>
+<td>$item_details</td>
+</tr>
+</table>
+<p>
+
+[todo_footer]
+"
\ No newline at end of file
Index: web/openacs/www/todo/one-list.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/one-list.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/one-list.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,106 @@
+set_the_usual_form_variables
+# list_id
+# possibly item_id_to_edit
+
+validate_integer list_id $list_id
+
+## Push things back to the plug-in system
+ns_returnredirect "one-plugin-list.tcl?plugin=todo&category_id=$list_id"
+return
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+# Check access
+if {![user_can_access_list_p $db $user_id $list_id]} {
+    todo_return_access_complaint
+    return
+}
+
+proc one_item_form {submit_tag} {
+    return "
+<tr>
+<td>[make_html_select priority {1 2 3 4 5}]</td>
+<td>[make_html_select n_days {{{} {no due date}} {0 Today} {1 Tomorrow} {7 {in a week}} {15 {in two weeks}} {30 {in a month}}}]</td>
+<td><INPUT TYPE=text name=item_details size=50></td>
+<td><INPUT TYPE=submit value=$submit_tag></td>
+</tr>
+"
+}
+
+ReturnHeaders
+
+set selection [ns_db 1row $db "select list_name, list_details, due_date from todo_lists where list_id=$list_id"]
+set_variables_after_query
+
+ns_write "[todo_header "One list: $list_name"]
+<h2>$list_name</h2>
+one of the to-do lists in your <a href=index.tcl>workspace</a>.
+<hr><p>
+"
+
+todo_set_user_preferences $db $user_id
+
+set sql "select item_id, first_names as assigned_by_first_names, list_id, priority, creation_date, pretty_relative_date(due_date,$personal_midnight) as pretty_relative_due_date, todo_days_from_pretty(pretty_relative_date(due_date,$personal_midnight)) as n_days, completion_date, substr(item_details,0,80) as short_details, item_details from todo_items , users where (todo_items.assigned_by=users.user_id or (todo_items.assigned_by is null and users.user_id=$user_id)) and list_id=$list_id and (completion_date is NULL OR (completion_date+$old_item_expire)::datetime>=sysdate()) $sort_by"
+
+set extra_rows "<FORM METHOD=POST action=new-item-2.tcl>
+[export_form_vars list_id]
+[todo_one_item_form add]
+</FORM>"
+
+if {![info exists item_id_to_edit]} {
+    set item_id_to_edit ""
+}
+
+validate_integer_or_null item_id_to_edit $item_id_to_edit
+
+ns_write "[todo_list_html $db $sql one-list.tcl?list_id=$list_id [todo_specific_list_of_headers] $extra_rows $item_id_to_edit [todo_view_open_items $separate_completed_items_p]]"
+
+ns_write "<p>
+You can also <a href=new-item.tcl?[export_url_vars list_id]>add a detailed item</a>.<p>"
+
+# ownership check
+set check [database_to_tcl_string $db "select count(*) from todo_lists where user_id=$user_id and list_id=$list_id"]
+
+if {$check} {
+ns_write "<p> 
+Collaboration:
+<ul>
+<li> <a href=new-permission.tcl?[export_url_vars list_id]>Add a collaborator</a>.
+<p>
+"
+
+set selection [ns_db select $db "select user_id, first_names, last_name from users where user_id in (select user_id from todo_list_user_map where list_id=$list_id)"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    ns_write "<li> \[ <A href=delete-permission.tcl?[export_url_vars list_id user_id]>remove</a> \] $first_names $last_name\n"
+}
+
+ns_write "<p>"
+
+set selection [ns_db select $db "select group_name, group_id from user_groups where group_id in (select user_group_id from todo_list_user_group_map where list_id=$list_id)"]
+
+while {[ns_db getrow $db $selection]} {
+    set_variables_after_query
+
+    ns_write "<li> Group: $group_name\n"
+}
+
+ns_write "</ul>
+<p>
+You may choose to <a href=list-delete.tcl?[export_url_vars list_id]>delete</a> this list.<p>
+"
+} else {
+    set selection [ns_db 1row $db "select first_names, last_name, email from users where user_id=(select user_id from todo_lists where list_id=$list_id)"]
+    set_variables_after_query
+
+    ns_write "<p>This list belongs to $first_names $last_name ($email).<p>"
+}
+
+ns_write "
+
+[todo_footer]"
+
Index: web/openacs/www/todo/one-plugin-list.help
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/one-plugin-list.help,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/one-plugin-list.help	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,24 @@
+<%= [todo_help_header "Help for One List"] %>
+
+This page gives you access to one todo list. Depending on the type of
+todo list that this is, you can:
+<ul>
+<li> <b>add an item</b>: if the one-line form is present at the bottom of the
+list, you can add an item directly. If the line isn't present, this is
+an automatically-generated list that can only be edited from the
+originating module (usually the Ticket Tracker or the SDM).
+<li> <b>edit an item</b>: if the edit link appears, you can perform a direct
+edit of the item. Otherwise, you should follow through using the
+details link.
+<li> <b>complete an item</b>: the empty checkbox allows you to mark the item
+completed. Certain task lists (the automatically-generated ones) will
+then lead you to provide further information on the completion of the
+item.
+<li> <b>delete an item</b>: if an item is marked completed, you may be able
+to delete it. This places the item in a "deleted" state where it does
+not appear on your normal task lists, but can be accessed for a
+certain period of time from the "deleted items" link in the upper
+right-hand corner of each todo page.
+</ul>
+
+<%= [todo_footer] %>
\ No newline at end of file
Index: web/openacs/www/todo/one-plugin-list.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/one-plugin-list.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/one-plugin-list.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,50 @@
+set_the_usual_form_variables
+# plugin category_id category
+# possibly item_id_to_edit
+
+validate_integer category_id $category_id
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+if {![info exists category]} {
+    set category [todo_plugin_get_category_name $db $user_id $plugin $category_id]
+}
+
+ReturnHeaders
+
+ns_write "[todo_header "One list: $plugin:$category"]
+<h2>$plugin:$category</h2>
+one of the to-do lists in your <a href=index.tcl>workspace</a>.
+<hr><p>
+"
+
+todo_set_user_preferences $db $user_id
+
+if {![info exists item_id_to_edit]} {
+    set item_id_to_edit ""
+}
+
+validate_integer_or_null item_id_to_edit $item_id_to_edit
+
+ns_write "
+[todo_openclosed_tabs [todo_view_open_items $separate_completed_items_p]]<br>
+<table noborder>
+[todo_list_html_header [todo_plugin_list_of_headers]]
+[todo_plugin_get_html $db $user_id $plugin $category_id "" one-plugin-list.tcl?[export_url_vars plugin category_id category] [todo_plugin_list_of_headers] $item_id_to_edit [todo_view_open_items $separate_completed_items_p] $old_item_expire $sort_by 1]
+</table>"
+
+set category_footer_proc [todo_get_plugin_value $plugin CATEGORY_FOOTER_HTML]
+
+if {$category_footer_proc != ""} {
+    ns_write "[$category_footer_proc $db $user_id $category_id]"
+} else {
+    ns_write "<p>
+This list is generated from another module that is plugged into the todo manager. Some direct actions may not be possible and may require you to dig down into the specific module by clicking on the \"details\" option."
+}
+
+ns_write "
+
+[todo_footer]"
+
Index: web/openacs/www/todo/plugin-item-completed.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/plugin-item-completed.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/plugin-item-completed.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,22 @@
+set_the_usual_form_variables
+# plugin category_id todo_id return_url
+
+validate_integer category_id $category_id
+validate_integer todo_id $todo_id
+
+# Before we do anything, see if we're allowed to call this
+if {![todo_get_plugin_value $plugin MARK_COMPLETED_ALLOWED_P]} {
+    todo_return_access_complaint
+    return
+}
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+# Call the plugin's method
+if {[[todo_get_plugin_value $plugin MARK_COMPLETED] $db $user_id $todo_id]} {
+    return
+}
+
+ns_returnredirect $return_url
Index: web/openacs/www/todo/plugin-item-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/plugin-item-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/plugin-item-delete.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,26 @@
+set_the_usual_form_variables
+# plugin category_id todo_id
+# possibly return_url
+
+validate_integer category_id $category_id
+validate_integer todo_id $todo_id
+
+if {![info exists return_url]} {
+    set return_url "one-plugin-list.tcl?[export_url_vars plugin category_id]"
+}
+
+if {![todo_get_plugin_value $plugin ITEM_CHANGE_ALLOWED_P]} {
+    todo_return_access_complaint
+    return
+}
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+# Apply the plugin edit!
+if {[[todo_get_plugin_value $plugin ITEM_DELETE] $db $user_id $category_id $todo_id]} {
+    return
+}
+
+ns_returnredirect $return_url
Index: web/openacs/www/todo/plugin-item-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/plugin-item-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/plugin-item-edit.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,25 @@
+set_the_usual_form_variables
+# todo_id plugin return_url due_date priority item_details
+
+validate_integer todo_id $todo_id
+
+if {![todo_get_plugin_value $plugin ITEM_CHANGE_ALLOWED_P]} {
+    todo_return_access_complaint
+    return
+}
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+set sql_due_date "sysdate() + timespan_days($n_days)"
+
+# Apply the plugin edit!
+if {[[todo_get_plugin_value $plugin ITEM_CHANGE] $db $user_id $todo_id $sql_due_date $priority $item_details]} {
+    return
+}
+
+# Get item_id_to_edit out of the return_url
+regsub {&item_id_to_edit=[^&]*} $return_url "" return_url
+
+ns_returnredirect $return_url
Index: web/openacs/www/todo/plugin-item-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/plugin-item-new.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/plugin-item-new.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,22 @@
+set_the_usual_form_variables
+# plugin category_id priority due_date item_details
+
+validate_integer category_id $category_id
+
+if {![todo_get_plugin_value $plugin ITEM_ADD_ALLOWED_P]} {
+    todo_return_access_complaint
+    return
+}
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+set sql_due_date "sysdate() + timespan_days($n_days)"
+
+# Apply the plugin edit!
+if {[[todo_get_plugin_value $plugin ITEM_ADD] $db $user_id $category_id $sql_due_date $priority $item_details]} {
+    return
+}
+
+ns_returnredirect "one-plugin-list.tcl?[export_url_vars plugin category_id]"
Index: web/openacs/www/todo/plugin-item-uncompleted.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/plugin-item-uncompleted.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/plugin-item-uncompleted.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,21 @@
+set_the_usual_form_variables
+# plugin category todo_id return_url
+
+validate_integer todo_id $todo_id
+
+# Before we do anything, see if we're allowed to call this
+if {![todo_get_plugin_value $plugin MARK_COMPLETED_ALLOWED_P]} {
+    todo_return_access_complaint
+    return
+}
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+# Call the plugin's method
+if {[[todo_get_plugin_value $plugin MARK_UNCOMPLETED] $db $user_id $todo_id]} {
+    return
+}
+
+ns_returnredirect $return_url
Index: web/openacs/www/todo/preferences-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/preferences-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/preferences-edit.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,22 @@
+set_the_usual_form_variables
+# old_item_expire sort_by notification_interval separate_completed_items_p
+validate_integer old_item_expire $old_item_expire
+
+set user_id [ad_get_user_id]
+
+set db [ns_db gethandle]
+
+ns_db dml $db "update todo_user_preferences set
+old_item_expire= $old_item_expire,
+sort_by= '$sort_by',
+notification_interval= $notification_interval,
+personal_midnight= $personal_midnight,
+separate_completed_items_p= '$separate_completed_items_p'
+where
+user_id=$user_id"
+
+if {![info exists return_url]} {
+    set return_url "index.tcl"
+}
+
+ns_returnredirect "$return_url"
Index: web/openacs/www/todo/preferences.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/preferences.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/preferences.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,86 @@
+set_form_variables 0
+# maybe return_url
+
+ReturnHeaders
+
+set db [ns_db gethandle]
+
+set_simple_user_information $db
+
+ns_write "[todo_header "Preferences for $first_names $last_name"]
+<h2>Preferences</h2>
+for <a href=index.tcl>$first_names $last_name</a>.
+<hr><p>
+"
+
+todo_set_user_preferences $db $user_id
+
+set form "
+<FORM METHOD=POST ACTION=preferences-edit.tcl>
+[export_form_vars return_url]
+<table noborder>
+<tr>
+<td>Expiration for Completed Items<br>
+(this is the number of days after which an item
+that is completed will not show up at all)
+</td>
+<td>[make_html_select old_item_expire {{0 immediately} {1 {one day}} {7 {one week}} {15 {two weeks}} {30 {one month}}}]</td>
+</tr>
+<tr>
+<td>
+Sort by<br>
+(this is the way that items are sorted
+when you view them)
+</td>
+<td>
+[make_html_select sort_by [list \
+	[list "order by raw_due_date,priority" "due date, then priority"] \
+	[list "order by priority,raw_due_date" "priority, then due date"] \
+	]]
+</td>
+</tr>
+<tr>
+<td>
+Notification Interval<br>
+(this is the interval of time at
+which you wish to receive email about
+items you need to complete)
+</td>
+<td>
+[make_html_select notification_interval {
+    {0 {never}}
+    {1 {every day}}
+    {7 {every week}}
+    {15 {every two weeks}}
+    {30 {every month}}
+}]
+</td>
+</tr>
+<tr>
+<td>Your Personal Midnight<br>
+(i.e. when do you go to bed?)</td>
+<td>
+[make_html_select personal_midnight {
+    {0 {midnight}}
+    {1 {1am}}
+    {2 {2am}}
+    {3 {3am}}
+    {4 {4am}}
+    {5 {5am}}
+    {6 {6am}}
+}]
+</td>
+</tr>
+<tr>
+<td>Separate Open and Closed Items?</td>
+<td>[make_html_select separate_completed_items_p {{t {Yes}} {f {No}}}]</td>
+</tr></table>
+<p>
+<INPUT TYPE=submit value=edit>
+"
+
+ns_write "[bt_mergepiece $form $selection]<p>
+
+[todo_footer]
+"
+
Index: web/openacs/www/todo/sweep.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/sweep.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/sweep.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,4 @@
+
+ReturnHeaders
+
+todo_daily_sweep
\ No newline at end of file
Index: web/openacs/www/todo/todo-shared-lists.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/todo-shared-lists.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/todo/todo-shared-lists.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,33 @@
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+append page "
+[todo_header "Your Shared Lists"]
+<h2>Your Shared Lists</h2>
+in your <a href=index.tcl>workspace</a>.
+<hr><p>
+
+<ul>
+"
+
+set list_of_other_categories [todo_get_other_plugins_and_categories $db $user_id]
+
+foreach plugin_category $list_of_other_categories {
+    set plugin [lindex $plugin_category 0]
+    set category_id [lindex $plugin_category 1]
+    set category [lindex $plugin_category 2]
+
+    append page "<li> <a href=one-plugin-list.tcl?[export_url_vars plugin category category_id]>$plugin: $category</a>\n"
+}
+
+append page "
+</ul>
+<p>
+[todo_footer]
+"
+
+ns_db releasehandle $db
+
+ns_return 200 text/html $page
Index: web/openacs/www/todo/unchecked.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/todo/unchecked.gif,v
diff -u
Binary files differ
Index: web/openacs/www/tools/form-custom.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/tools/form-custom.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/tools/form-custom.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,65 @@
+# form-custom.tcl,v 3.0 2000/02/06 03:54:42 ron Exp
+#
+# Takes the data generated from ad_table_sort_form function 
+# and inserts into the user_custom table
+#
+# on succes it does an ns_returnredirect to return_url
+#
+# davis@arsdigita.com 20000105
+
+set internals {item item_group return_url item_original delete_the_set}
+ad_page_variables {item item_group return_url {item_original {}} {delete_the_set 0}}
+
+set db [ns_db gethandle]
+set user_id [ad_verify_and_get_user_id] 
+ad_maybe_redirect_for_registration    
+set item_type {slider_custom}
+set value_type {keyval}
+
+if {$delete_the_set && ![empty_string_p $item]} {
+    util_dbq {item item_type value_type item_group}
+    if {[catch {ns_db dml $db "delete user_custom
+          where user_id = $user_id and item = $DBQitem and item_group = $DBQitem_group
+            and item_type = $DBQitem_type"} errmsg]} {
+        ad_return_complaint 1 "<li>I was unable to delete the defaults.  The database said <pre>$errmsg</pre>\n"
+        return
+    }
+    ns_returnredirect "$return_url"
+    return
+}
+
+        
+   
+if {[empty_string_p $item]} {
+    ad_return_complaint 1 "<li>You did not specify a name for this default set."
+    return
+}
+
+set form [ns_getform]
+for {set i 0} { $i < [ns_set size $form]} {incr i} {
+    if {[lsearch $internals [ns_set key $form $i]] < 0} { 
+        lappend data [list [ns_set key $form $i] [ns_set value $form $i]]
+    }
+}
+
+
+if {[empty_string_p $data]} {
+    ad_return_complaint 1 "<li>You did not specify any default data."
+    return
+}
+
+util_dbq {item item_original item_type value_type item_group}
+with_transaction $db {
+    ns_db dml $db "delete user_custom
+      where user_id = $user_id and item = $DBQitem_original and item_group = $DBQitem_group
+        and item_type = $DBQitem_type"
+
+    ns_ora clob_dml $db "insert into user_custom (user_id, item, item_group, item_type, value_type, value)
+      values ($user_id, $DBQitem, $DBQitem_group, $DBQitem_type, 'list', empty_clob())
+      returning value into :1" $data
+} {
+    ad_return_complaint 1 "<li>I was unable to insert your defaults. The database said <pre>$errmsg</pre>\n"
+    return
+}
+
+ns_returnredirect "$return_url"
Index: web/openacs/www/tools/sort-custom.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/tools/sort-custom.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/tools/sort-custom.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,73 @@
+# sort-custom.tcl,v 3.0 2000/02/06 03:54:43 ron Exp
+#
+# Takes the data generated from ad_table_sort_form function 
+# and inserts into the user_custom table
+#
+# on succes it does an ns_returnredirect to return_url&$item_group=$item
+#
+# davis@arsdigita.com 20000105
+
+ad_page_variables {item item_group return_url {delete_the_sort 0} {col -multiple-list} {dir -multiple-list} {item_original {}}}
+
+set db [ns_db gethandle]
+set user_id [ad_verify_and_get_user_id] 
+ad_maybe_redirect_for_registration    
+set item_type {table_sort}
+set value_type {list}
+
+if {$delete_the_sort && ![empty_string_p $item]} {
+    util_dbq {item item_type value_type item_group}
+    if {[catch {ns_db dml $db "delete user_custom
+          where user_id = $user_id and item = $DBQitem and item_group = $DBQitem_group
+            and item_type = $DBQitem_type"} errmsg]} {
+        ad_return_complaint 1 "<li>I was unable to delete the sort.  The database said <pre>$errmsg</pre>\n"
+        return
+    }
+    ns_returnredirect "$return_url"
+    return
+}
+
+        
+   
+if {[empty_string_p $item]} {
+    ad_return_complaint 1 "<li>You did not specify a name for this sort"
+    return
+}
+
+
+set col_clean {}
+set direction(asc) {}
+set direction(desc) {*}
+
+# Strip the blank columns...
+set i 0 
+foreach c $col {
+    if {![empty_string_p $c]} {
+        lappend col_clean "$c$direction([lindex $dir $i])"
+    }
+    incr i
+}
+
+if {[empty_string_p $col_clean]} {
+    ad_return_complaint 1 "<li>You did not specify any columns to sort by"
+    return
+}
+
+set col_clean [join $col_clean ","]
+
+util_dbq {item item_original item_type value_type item_group}
+with_transaction $db {
+    ns_db dml $db "delete user_custom
+      where user_id = $user_id and item = $DBQitem_original and item_group = $DBQitem_group
+        and item_type = $DBQitem_type"
+
+    ns_ora clob_dml $db "insert into user_custom (user_id, item, item_group, item_type, value_type, value)
+      values ($user_id, $DBQitem, $DBQitem_group, $DBQitem_type, 'list', empty_clob())
+      returning value into :1" $col_clean
+} {
+    ad_return_complaint 1 "<li>I was unable to insert your table customizations.  The database said <pre>$errmsg</pre>\n"
+    return
+}
+
+ns_returnredirect "$return_url&$item_group=[ns_urlencode $item]"
+
Index: web/openacs/www/tools/spell.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/tools/spell.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/tools/spell.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,287 @@
+# spell.tcl,v 3.0 2000/02/06 03:54:45 ron Exp
+# Jan 6, 2000  (OUMI) 
+#    added html_p argument, set to 1 if $var_to_spellcheck contains html tags 
+#    and you don't want to spell check the HTML tags.  Also fixed a bug in
+#    the exporting of $processed_text.
+
+# spell.tcl 
+
+# Written by Jin Choi (jsc@arsdigita.com), with additions by Eve Andersson
+# (eveander@arsdigita.com). Added to the ACS July 5, 1999.
+
+# See http://photo.net/doc/tools.html for more information and usage
+# example.
+
+# Arguments: merge_p, var_to_spellcheck, target_url, error_0, error_1...
+#            html_p
+#
+# To use, call with var_to_spellcheck, target_url, and whatever form
+# variable you specified as var_to_spellcheck. You can also specify
+# html_p (set to 't') if the variable to spellcheck contains HTML tags
+# and you don't want the tags to get spell checked.
+#
+# merge_p and the error variables are internal arguments.
+
+# This script runs in two modes.
+
+# If merge_p is not set or is 0, we display the form variable specified by
+# VAR_TO_SPELLCHECK with any misspellings
+# as reported by ispell replaced by either a text field (if it ispell
+# marked it as a "miss") or by a drop down box (if ispell marked it a
+# "near miss"), and target ourself with the text to merge, the number
+# of errors, and each error as error_0, error_1, ... error_n.
+
+# If merge_p is true, we take the results of the above form, merge the
+# corrections back into the text, and pass everything on to TARGET_URL.
+
+# In either case, we re-export any form variable we don't use.
+
+
+proc spell_sorted_list_with_unique_elements {the_list} {
+
+    set sorted_list [lsort $the_list]
+    set new_list [list]
+
+    set old_element "XXinitial_conditionXX"
+    foreach list_element $sorted_list {
+	if { $list_element != $old_element } {
+	    lappend new_list $list_element
+	}
+	set old_element $list_element
+    }
+
+    return $new_list
+}
+
+
+set form [ns_conn form]
+set var_to_spellcheck [ns_set get $form var_to_spellcheck]
+set text [ns_set get $form $var_to_spellcheck]
+set html_p [ns_set get $form html_p]
+set merge_p [ns_set get $form merge_p]
+ns_set delkey $form $var_to_spellcheck
+ns_set delkey $form merge_p
+
+if { $merge_p == "" || $merge_p == 0 } {
+
+    # if $html_p then substitute out all HTML tags
+    set text_to_spell_check $text
+    if {[string compare $html_p "t"] == 0} {
+	regsub -all {<[^<]*>} $text_to_spell_check "" text_to_spell_check
+    }
+
+    set tmpfile [ns_mktemp "/tmp/webspellXXXXXX"]
+    set f [open $tmpfile w]
+    puts $f $text_to_spell_check
+    close $f
+    
+    set lines [split $text "\n"]
+    
+    set dictionaryfile "[ns_info pageroot]/tools/ispell-words"
+
+    # The webspell wrapper is necessary because ispell requires
+    # the HOME environment set, and setting env(HOME) doesn't appear
+    # to work from AOLserver.
+    set spelling_program "[ns_info pageroot]/tools/webspell"
+
+    set ispell_proc [open "|$spelling_program $tmpfile $dictionaryfile" r]
+
+    # read will occasionally error out with "interrupted system call",
+    # so retry a few times in the hopes that it will go away.
+    set try 0
+    set max_retry 10
+    while {[catch {set ispell_text [read -nonewline $ispell_proc]} errmsg]
+	   && $try < $max_retry} {
+	incr try
+	ns_log Notice "spell.tcl had a problem: $errmsg"
+    }
+    close $ispell_proc
+    ns_unlink $tmpfile
+
+    if { $try == $max_retry } {
+	ns_return 200 text/html "[ad_header "Spell Checker Error"]
+<h2>Spell Checker Error</h2>
+<hr>
+The spell checker was unable to process your document.  Please hit \"Reload\" to try again  If this message occurs again, please contact <a href=\"mailto:[ad_system_owner]\">[ad_system_owner]</a>.
+[ad_footer]"
+        return
+    }
+    
+    set ispell_lines [split $ispell_text "\n"]
+    # Remove the version line.
+    if { [llength $ispell_lines] > 0 } {
+	set ispell_lines [lreplace $ispell_lines 0 0]
+    }
+    
+    set error_num 0
+    set errors [list]
+    
+    set processed_text ""
+    
+    set line [lindex $lines 0]
+    
+    foreach ispell_line $ispell_lines {
+	switch -glob -- $ispell_line {
+	    "#*" {
+		regexp "^\# (\[^ \]+) (\[0-9\]+)" $ispell_line dummy word pos
+		regsub $word $line "\#$error_num\#" line
+		lappend errors [list miss $error_num $word]
+		incr error_num
+	    }
+	    "&*" {
+		regexp {^& ([^ ]+) ([0-9]+) ([0-9]+): (.*)$} $ispell_line dummy word n_options pos options
+		regsub $word $line "\#$error_num\#" line
+		lappend errors [list nearmiss $error_num $word $options]
+		incr error_num
+	    }
+	    "" {
+		append processed_text "$line\n"
+		if { [llength $lines] > 0 } {
+		    set lines [lreplace $lines 0 0]
+		    set line [lindex $lines 0]
+		}
+	    }
+	}
+    }
+    
+    
+    if { $error_num == 0 } {
+	# then there were no errors, so we just want to skip the user to the next screen
+	set merge_p 1
+	set error_free_p 1
+    } else {
+	
+	set formtext $processed_text
+	foreach err $errors {
+	    set errtype [lindex $err 0]
+	    set errnum [lindex $err 1]
+	    set errword [lindex $err 2]
+	    set wordlen [string length $errword]
+	    
+	    if { $errtype == "miss" } {
+		regsub "\#$errnum\#" $formtext "<input type=text name=error_$errnum value=\"$errword\" size=$wordlen>" formtext
+	    } elseif { $errtype == "nearmiss" } {
+		set erroptions [lindex $err 3]
+		regsub -all ", " $erroptions "," erroptions
+		set options [split $erroptions ","]
+		set select_text "<select name=error_$errnum>\n<option value=\"$errword\">$errword</option>\n"
+		foreach option $options {
+		    append select_text "<option value=\"$option\">$option</option>\n"
+		}
+		append select_text "</select>\n"
+		regsub "\#$errnum\#" $formtext $select_text formtext
+	    }
+	    
+	}
+	
+	# regsub -all {"} $processed_text {\&quot;} processed_text
+	# a regsub isn't enough for exporting $processed_text in
+	# a hidden variable.
+	set processed_text [philg_quote_double_quotes $processed_text]
+
+        ReturnHeaders
+	ns_write "[ad_header "Spell Checker"]
+	<h2>Spell Checker</h2>
+	<hr>
+	The spell checker has found one or more words in your document which could not be found in our dictionary.
+	<p>
+	If the spell checker has any suggestions for the misspelled word, it will present the suggestions in a
+	drop-down list.  If not, it provides a text field for you to enter your own correction.  If a drop-down
+	list does not include the spelling you wish to have, then push \"Back\" and make the change to your
+	original document.
+	<center>
+	<hr width=75%>
+	<b>Please make changes below:</b>
+	</center>
+	<p>
+	<form action=spell.tcl method=post>
+	<input type=hidden name=merge_p value=1>
+	<input type=hidden name=merge_text value=\"$processed_text\">
+	<input type=hidden name=num_errors value=$error_num>
+	[export_entire_form]
+	"
+	
+	regsub -all "\r\n" $formtext "<br>" formtext_to_display
+	ns_write "
+	$formtext_to_display
+	<p>
+	<center>
+	<input type=submit value=\"Submit\">
+	</form>
+	</center>
+	<hr width=75%>
+	If you like, you can add any words that the spell checker caught to the spelling dictionary.  This will
+	prevent the spell checker from catching them in the future.
+	<p>
+	<ul>
+	"
+	
+	set just_the_errwords [list]
+	foreach err $errors {
+	    lappend just_the_errwords [lindex $err 2]
+	}
+
+	foreach errword [spell_sorted_list_with_unique_elements $just_the_errwords] {
+	    ns_write "<form method=post action=spelling-dictionary-add-to.tcl>[export_form_vars errword]<li><input type=submit value=\"Add\"> $errword</form><p>"
+	}
+	ns_write "</ul>
+	<p>
+	[ad_footer]"
+	
+    }
+    
+} 
+
+
+# an "if" instead of an "elseif" because the above clause may set merge_p to 1
+if { $merge_p != "" && $merge_p } {
+    set target_url [ns_set get $form target_url]
+    ns_set delkey $form target_url
+
+    if { ![info exists error_free_p] } {
+	set merge_text [ns_set get $form merge_text]
+    } else {
+	set merge_text $processed_text
+    }
+    set num_errors [ns_set get $form num_errors]
+    ns_set delkey $form merge_text
+    ns_set delkey $form num_errors
+    ns_set delkey $form var_to_spellcheck
+
+    for {set i 0} {$i < $num_errors} {incr i} {
+	regsub "\#$i\#" $merge_text [ns_set get $form "error_$i"] merge_text
+	ns_set delkey $form "error_$i"
+    }
+
+#    set merge_text [ns_urlencode $merge_text]
+
+#    ns_returnredirect "$target_url?$var_to_spellcheck=$merge_text&[export_url_vars $form]"
+
+    ReturnHeaders
+
+    ns_write "[ad_header "Spell Checker"]
+    <h2>Spell Checker</h2>
+    <hr>
+    "
+
+    if { [info exists error_free_p] } {
+	ns_write "Your document contains 0 spelling errors.  "
+    } else {
+	ns_write "Here is the final document with any spelling corrections included.  "
+    }
+
+    ns_write "Please confirm that you are satisfied 
+    with it.  If not, push your browser's \"Back\" button to go back and make changes.
+    <form method=post action=\"$target_url\">
+    [export_entire_form]
+    [philg_hidden_input $var_to_spellcheck $merge_text]
+    <center>
+    <input type=submit value=\"Confirm\">
+    </center>
+    <hr width=75%>
+    <pre>$merge_text</pre>
+    <p>
+    [ad_footer]
+    "
+    return
+}
Index: web/openacs/www/tools/spelling-dictionary-add-to.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/tools/spelling-dictionary-add-to.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/tools/spelling-dictionary-add-to.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,28 @@
+# spelling-dictionary-add-to.tcl,v 3.0 2000/02/06 03:54:46 ron Exp
+set_the_usual_form_variables
+#errword
+
+set db [ns_db gethandle]
+
+if [catch {ns_db dml $db "insert into ispell_words (ispell_word) values ('$QQerrword')"}] {
+    ad_return_error "Unable to add word" "We were unable to add $errword to the dictionary.  It is probably because somebody else tried to add the same word at the same time to the dictionary (words in the dictionary must be unique)."
+    return
+}
+
+# Now that Oracle has handled the transaction control of adding words to the dictionary, bash the
+# ispell-words file.  Jin has promised me (eveander) that ispell-words won't become corrupted because,
+# since one chunk is only to be added to the file at a time, it is impossible for the chunks to
+# become interspersed. 
+
+set ispell_file [open "[ns_info pageroot]/tools/ispell-words" a]
+
+# ispell-words will be of the form: one word per line, with a newline at the end (since -nonewline is not specified)
+puts $ispell_file "$errword"
+
+ReturnHeaders
+ns_write "[ad_header "$errword added"]
+<h2>$errword has been added to the spelling dictionary</h2>
+<hr>
+Please push \"Back\" to continue with the spell checker.
+[ad_footer]
+"
Index: web/openacs/www/tools/table-custom.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/tools/table-custom.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/tools/table-custom.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,65 @@
+# table-custom.tcl,v 3.0 2000/02/06 03:54:47 ron Exp
+# Takes the data generated from ad_table_form function 
+# and inserts into the user_custom table
+#
+# on succes it does an ns_returnredirect to return_url&$item_group=$item
+#
+# davis@arsdigita.com 20000105
+
+ad_page_variables {item item_group return_url {delete_the_view 0} {col -multiple-list} {item_original {}}}
+
+set db [ns_db gethandle]
+set user_id [ad_verify_and_get_user_id] 
+ad_maybe_redirect_for_registration    
+
+set item_type {table_view}
+set value_type {list}
+
+if {$delete_the_view && ![empty_string_p $item]} {
+    util_dbq {item item_type value_type item_group}
+    if {[catch {ns_db dml $db "delete user_custom
+          where user_id = $user_id and item = $DBQitem and item_group = $DBQitem_group
+            and item_type = $DBQitem_type"} errmsg]} {
+        ad_return_complaint 1 "<li>I was unable to delete the view.  The database said <pre>$errmsg</pre>\n"
+        return
+    }
+    ns_returnredirect "$return_url"
+    return
+}
+
+        
+if {[empty_string_p $item]} {
+    ad_return_complaint 1 "<li>You did not specify a name for this table view"
+    return
+}
+
+set col_clean [list]
+
+# Strip the blank columns...
+foreach c $col {
+    if {![empty_string_p $c]} {
+        lappend col_clean $c
+    }
+}
+
+if {[empty_string_p $col_clean]} {
+    ad_return_complaint 1 "<li>You did not specify any columns to display"
+    return
+}
+
+util_dbq {item item_original item_type value_type item_group}
+with_transaction $db {
+    ns_db dml $db "delete user_custom
+      where user_id = $user_id and item = $DBQitem_original and item_group = $DBQitem_group
+        and item_type = $DBQitem_type"
+
+    ns_ora clob_dml $db "insert into user_custom (user_id, item, item_group, item_type, value_type, value)
+      values ($user_id, $DBQitem, $DBQitem_group, $DBQitem_type, 'list', empty_clob())
+      returning value into :1" $col_clean
+} {
+    ad_return_complaint 1 "<li>I was unable to insert your table customizations.  The database said <pre>$errmsg</pre>\n"
+    return
+}
+
+ns_returnredirect "$return_url&$item_group=[ns_urlencode $item]"
+
Index: web/openacs/www/tools/webspell
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/tools/webspell,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/tools/webspell	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,9 @@
+#!/bin/sh
+
+# Wrapper for ispell that sets the HOME environment variable.
+# Can't seem to do this from AOLserver Tcl.
+# Takes two arguments: file to spellcheck, dictionary file.
+
+HOME=/home/nsadmin
+export HOME
+exec /usr/local/bin/ispell -a -p $2 < $1
Index: web/openacs/www/users/warning.txt
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/users/warning.txt,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/users/warning.txt	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,2 @@
+This is a reserved directory. There is a registered proc to dynamically serve content that starts with users/* 
+- mobin
\ No newline at end of file
Index: web/openacs/www/webmail/author-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/author-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/author-delete.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,44 @@
+# /webmail/author-delete.tcl
+# by jsc@arsdigita.com (2000-02-28)
+
+# Mark as deleted all messages by given author.
+
+ad_page_variables {{author -multiple-list} last_n_days}
+
+validate_integer last_n_days $last_n_days
+
+if { [llength $author] == 0 } {
+    ad_return_error "No authors marked for deletion" "You must specify at least one author to delete by."
+    return
+}
+
+set user_id [ad_verify_and_get_user_id]
+set mailbox_id [ad_get_client_property -browser t "webmail" "mailbox_id"]
+set db [ns_db gethandle]
+
+# Check to see if this user actually owns this mailbox.
+set mailbox_access_allowed_p [database_to_tcl_string $db "select count(*)
+from wm_mailboxes
+where mailbox_id = $mailbox_id
+  and creation_user = $user_id"]
+
+if { !$mailbox_access_allowed_p } {
+    ad_return_error "Permission Denied" "You do not have permission to access this mailbox."
+    ns_log Notice "WEBMAIL WARNING: user $user_id attempted to access mailbox $mailbox_id"
+    return
+}
+
+set author_clause [list]
+foreach a $author {
+    lappend author_clause "'[DoubleApos $a]'"
+}
+
+ns_db dml $db "update wm_message_mailbox_map
+set deleted_p = 't'
+ where msg_id in (select msg_id
+                  from wm_headers
+                  where lower_name = 'from'
+                    and value in ([join $author_clause ", "]))
+   and mailbox_id = $mailbox_id"
+
+ad_returnredirect "summary.tcl?[export_url_vars last_n_days]"
Index: web/openacs/www/webmail/expunge.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/expunge.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/expunge.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,40 @@
+# /webmail/expunge.tcl
+# by jsc@arsdigita.com (2000-02-23)
+
+# Delete all messages and associated rows from various tables that have been
+# marked for deletion in a single mailbox.
+
+ad_page_variables mailbox_id
+
+validate_integer mailbox_id $mailbox_id
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+if { [database_to_tcl_string $db "select count(*)
+from wm_mailboxes
+where mailbox_id = $mailbox_id
+  and creation_user = $user_id"] == 0 } {
+    ad_return_error "Permission Denied" "You do not have permission to expunge this folder."
+    ns_log Notice "WEBMAIL WARNING: user $user_id attempted to expunge mailbox $mailbox_id"
+    return
+}
+
+
+with_catch errmsg {
+    ns_db dml $db "delete from wm_message_lobs
+ where msg_id in (select msg_id from wm_message_mailbox_map
+                 where mailbox_id = $mailbox_id
+                 and deleted_p = 't')"
+
+} {
+    ad_return_error "Expunge Failed" "Unable to delete messages:
+<pre>
+$errmsg
+</pre>
+"
+    return
+}
+
+ns_returnredirect "index.tcl?[export_url_vars mailbox_id]"
Index: web/openacs/www/webmail/filter-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/filter-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/filter-add.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,17 @@
+# /webmail/filter-add.tcl
+# by jsc@arsdigita.com (2000-02-23)
+
+# Add a filter to the list of current filters.
+
+
+ad_page_variables {filter_type filter_term}
+
+set filters [ad_get_client_property -browser t "webmail" "filters"]
+set new_filter [list $filter_type $filter_term]
+
+if { [lsearch -exact $filters $new_filter] == -1 } {
+    lappend filters $new_filter
+    ad_set_client_property -browser t "webmail" "filters" $filters
+}
+
+ns_returnredirect "index.tcl"
Index: web/openacs/www/webmail/filter-delete-all.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/filter-delete-all.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/filter-delete-all.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,9 @@
+# /webmail/filter-delete-all.tcl
+# by jsc@arsdigita.com (2000-02-23)
+
+# Clear all the filters in effect.
+
+ad_set_client_property -browser t "webmail" "filters" ""
+
+ns_returnredirect "index.tcl"
+
Index: web/openacs/www/webmail/filter-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/filter-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/filter-delete.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,23 @@
+# /webmail/filter-delete.tcl
+# by jsc@arsdigita.com (2000-02-23)
+
+# Remove a filter from the list of active filters.
+
+ad_page_variables {filter}
+
+set filters [ad_get_client_property -browser t "webmail" "filters"]
+set to_be_removed $filter
+
+set new_filters [list]
+foreach filter $filters {
+    if { $filter == $to_be_removed } {
+	continue
+    } else {
+	lappend new_filters $filter
+    }
+}
+
+ad_set_client_property -browser t "webmail" "filters" $new_filters
+
+ns_returnredirect "index.tcl"
+
Index: web/openacs/www/webmail/folder-create-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/folder-create-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/folder-create-2.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,35 @@
+# /webmail/folder-create-2.tcl
+# by jsc@arsdigita.com (2000-02-23)
+
+# Create a new mailbox and return to specified target, or index.tcl.
+# Passes along mailbox_id to the target.
+
+ad_page_variables {folder_name target}
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode "/webmail/"]"
+    return
+}
+
+set db [ns_db gethandle]
+
+with_transaction $db {
+    set mailbox_id [database_to_tcl_string $db "select nextval('wm_mailbox_id_sequence') from dual"]
+    ns_db dml $db "insert into wm_mailboxes (mailbox_id, name, creation_user, creation_date)
+ values ($mailbox_id, '$QQfolder_name', $user_id, sysdate())"
+} {
+    ad_return_error "Folder Creation Failed" "An error occured while trying to create your folder:
+<pre>
+$errmsg
+</pre>
+"
+    return
+}
+
+if { [regexp {\?} $target] } {
+    ns_returnredirect "$target&[export_url_vars mailbox_id]"
+} else {
+    ns_returnredirect "$target?[export_url_vars mailbox_id]"
+}
Index: web/openacs/www/webmail/folder-create.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/folder-create.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/folder-create.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,24 @@
+# /webmail/folder-create.tcl
+# by jsc@arsdigita.com (2000-02-23)
+
+# Present form to create a new folder.
+
+ad_page_variables target
+
+ns_return 200 text/html "[ad_header "Create New Folder"]
+<h2>Create New Folder</h2>
+
+ [ad_context_bar_ws [list "index.tcl" "WebMail"] "Create New Folder"]
+
+<hr>
+
+<form action=\"folder-create-2.tcl\" method=POST>
+ [export_form_vars target]
+
+Folder Name: <input type=text size=50 name=folder_name><br>
+
+</form>
+
+ [ad_footer]
+"
+
Index: web/openacs/www/webmail/folder-move-to.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/folder-move-to.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/folder-move-to.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,21 @@
+# /webmail/folder-move-to.tcl
+# by jsc@arsdigita.com (2000-02-23)
+
+# Set the current folder to mailbox_id and return to index.
+
+ad_page_variables {mailbox_id {return_url "index.tcl"}}
+
+if { $mailbox_id == "@NEW" } {
+    # Create new mailbox.
+    ns_returnredirect "folder-create.tcl?target=[ns_urlencode $return_url]"
+    return
+}
+
+validate_integer mailbox_id $mailbox_id
+
+set cached_mailbox_id [ad_get_client_property -browser t "webmail" "mailbox_id"]
+if { $cached_mailbox_id != $mailbox_id } {
+    ad_set_client_property -browser t "webmail" "mailbox_id" $mailbox_id
+}
+
+ns_returnredirect $return_url
Index: web/openacs/www/webmail/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/index.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,653 @@
+# /webmail/index.tcl
+# by jsc@arsdigita.com (2000-02-23)
+
+# Displays a list of messages in a mailbox. Gives UI for selecting, deleting,
+# reordering, and filtering.
+
+
+set_form_variables 0
+# sort_by, mailbox_id (optional)
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode "/webmail/"]"
+    return
+}
+
+set db [ns_db gethandle]
+
+set filters [ad_get_client_property -browser t "webmail" "filters"]
+# If mailbox_id was specified, then store it as a session property if it is
+# different from what we already have.
+
+set cached_mailbox_id [ad_get_client_property -browser t "webmail" "mailbox_id"]
+if { ![exists_and_not_null mailbox_id] } {
+    set mailbox_id $cached_mailbox_id
+} else {
+    if { $cached_mailbox_id != $mailbox_id } {
+	ad_set_client_property -browser t "webmail" "mailbox_id" $mailbox_id  
+    }
+}
+
+
+
+proc select_default_mailbox { db user_id } {
+    upvar mailbox_id mailbox_id
+    upvar mailbox_name mailbox_name
+
+    set mailbox_id [database_to_tcl_string_or_null $db "select mailbox_id
+from wm_mailboxes
+where creation_user = $user_id
+and name = 'INBOX'"]
+    if { $mailbox_id == "" } {
+	ad_return_warning "No Account" "You have not been set up with an email account
+on this system. Please contact the system administrator to hook you up and try again."
+	return -code return
+    }
+    ad_set_client_property -browser t "webmail" "mailbox_id" $mailbox_id
+    set mailbox_name "INBOX"
+}
+
+if { [empty_string_p $mailbox_id] } {
+    select_default_mailbox $db $user_id
+} else {
+    # Check to see if this user actually owns this mailbox.
+    set selection [ns_db 0or1row $db "select name as mailbox_name
+from wm_mailboxes
+where mailbox_id = $mailbox_id
+  and creation_user = $user_id"]
+    if { $selection == "" } {
+	# ad_return_error "Permission Denied" "You do not have permission to access this mailbox."
+
+	ns_log Notice "WEBMAIL WARNING: user $user_id attempted to access mailbox $mailbox_id"
+	select_default_mailbox $db $user_id
+    } else {
+	set_variables_after_query
+    }
+}
+
+
+# If sort_by was specified, change the value that we have cached for it.
+set cached_sort_by [ad_get_client_property -browser t "webmail" "sort_by"]
+if { ![exists_and_not_null sort_by] } {
+    set sort_by $cached_sort_by
+    if { [empty_string_p $sort_by] } {
+	set sort_by "date_value"
+    }
+} else {
+    if { $cached_sort_by != $sort_by } {
+	ad_set_client_property -browser t "webmail" "sort_by" $sort_by
+    }
+}
+
+
+# Format an element differently for read or deleted messages.
+proc wm_format_for_seen_or_deleted { seen_p deleted_p str } {
+    if [empty_string_p $str] {
+	set result "<i>(empty)</i>"
+    } else {
+	set result $str
+    }
+    if { $seen_p == "f" } {
+	set result "<b>$result</b>"
+    }
+    if { $deleted_p == "t" } {
+	set result "<font color=\"\#505050\">$result</font>"
+    }
+    return $result
+}
+
+
+# Return a list of extra tables to add to the query for certain filters.
+proc wm_query_extra_tables { filters } {
+    # Keep track of already added tables, so we don't add it more than
+    # once.
+    set filter_seen() ""
+    set extra_tables ""
+
+    foreach filter $filters {
+	set filter_name [lindex $filter 0]
+
+	if [info exists filter_seen($filter_name)] {
+	    continue
+	}
+
+	switch -- $filter_name {
+	    "body" {
+		append extra_tables ", wm_attachments a"
+	    }
+	}
+	set filter_seen($filter_name) 1
+    }
+    return $extra_tables
+}
+
+proc wm_cond_filter { lst str1 str2 } {
+
+    if { [llength $lst] == 0 } { return $str1 }
+
+    set lst "([join $lst |])"
+    if { ![regexp $lst $str1]  } {
+        return $str1
+    } else {
+        return $str2
+    }
+}
+
+proc cond_lappend { lst str } {
+
+    
+    if { $str != "" } {
+
+        upvar $lst x
+        lappend x $str
+    }
+}
+
+# Return a where clause restricting a query based on the given filter specifications.
+proc wm_filter_clause { db filters exclude_lst } {
+    set ctx_key 1
+
+    set clauses [list]
+    foreach filter $filters {
+	set filter_name [lindex $filter 0]
+	set filter_value [DoubleApos [lindex $filter 1]]
+
+	switch -- $filter_name {
+	    "last-n-days" {
+		cond_lappend clauses [wm_cond_filter $exclude_lst "date_table.time_value > (sysdate() - to_date('$filter_value', 'YYYY-MM-DD HH24:MI:SS'))" " not exists (select 1 from wm_headers where m.msg_id = msg_id and (sysdate() - to_date('$filter_value', 'YYYY-MM-DD HH24:MI:SS'))"]
+	    }
+
+	    "sent-after" {
+		cond_lappend clauses [wm_cond_filter $exclude_lst "date_table.time_value > to_date('$filter_value', 'YYYY-MM-DD HH24:MI:SS')" " not exists (select 1 from wm_headers where m.msg_id = msg_id and time_value > to_date('$filter_value', 'YYYY-MM-DD HH24:MI:SS'))"]
+	    }
+	    "sent-before" {
+		cond_lappend clauses [wm_cond_filter $exclude_lst "date_table.time_value < to_date('$filter_value', 'YYYY-MM-DD HH24:MI:SS')" " not exists (select 1 from wm_headers where m.msg_id = msg_id and time_value < to_date('$filter_value', 'YYYY-MM-DD HH24:MI:SS'))"]
+	    }
+	    "sent-on" {
+		cond_lappend clauses [wm_cond_filter $exclude_lst "trunc(date_table.time_value) = '$filter_value'" " not exists (select 1 from wm_headers where m.msg_id = msg_id and trunc(time_value) = '$filter_value')"]
+	    }
+	    "author" {
+		cond_lappend clauses [wm_cond_filter $exclude_lst "from_table.value like '%$filter_value%'" " not exists (select 1 from wm_headers where m.msg_id = msg_id and value like '%$filter_value%')"]
+	    }
+	    "subject" {
+		cond_lappend clauses [wm_cond_filter $exclude_lst "subject_table.value like '%$filter_value%'" " not exists (select 1 from wm_headers where m.msg_id = msg_id and value like '%$filter_value%')"]
+	    }
+	    "read" {
+		lappend clauses "seen_p = 't'"
+	    }
+	    "unread" {
+		lappend clauses "seen_p = 'f'"
+	    }
+	    "deleted" {
+		lappend clauses "deleted_p = 't'"
+	    }
+	    "undeleted" {
+		lappend clauses "deleted_p = 'f'"
+	    }
+	    "recipient" {
+		lappend clauses "exists (select 1 from wm_recipients where (email like '%$filter_value%' or name like '%$filter_value%') and wm_recipients.msg_id = m.msg_id)"
+	    }
+	    "any-header" {
+		lappend clauses "exists (select 1 from wm_headers where value like '%$filter_value%' and msg_id = mum.msg_id)"
+	    }
+	    "body" {
+		set query_string [DoubleApos [database_to_tcl_string $db "select im_convert('[string trim $filter_value]') from dual"]]
+		lappend clauses "a.msg_id = m.msg_id and (contains(m.body, '$query_string', $ctx_key) > 0 or contains(a.data, '$query_string', [expr $ctx_key + 1]) > 0)"
+		incr ctx_key 2
+	    }
+	}
+    }
+    if { [llength $clauses] > 0 } {
+	return " and [join $clauses " and "]"
+    } else {
+	return ""
+    }
+}
+
+
+# Returns some HTML displaying the filters currently active, and provide links
+# to clear them.
+proc wm_filter_info { current_filters } {
+    set results ""
+    foreach filter $current_filters {
+	set filter_name [lindex $filter 0]
+	set filter_value [lindex $filter 1]
+
+	append results "<li>[philg_quote_double_quotes "$filter_name: $filter_value"] <font size=-1><a href=\"filter-delete.tcl?[export_url_vars filter]\">clear</a></font>\n"
+    }
+    if { ![empty_string_p $results] } {
+	set results "<ul>
+$results<br>
+<font size=-1><a href=\"filter-delete-all.tcl\">clear all</a></font>
+</ul>
+"
+    }
+    return $results
+}
+
+# Accumulates message IDs into a page-local global variable.
+global current_messages
+set current_messages ""
+global message_count
+set message_count 0
+
+# This procedure gets called for each row of the sortable table.
+proc accumulate_msg_id { msg_id seen_p deleted_p } {
+    global current_messages
+    global message_count
+
+    lappend current_messages [list $msg_id $seen_p $deleted_p]
+    incr message_count
+    return ""
+}
+
+# set sql "
+# select m.msg_id, 
+#        from_table.value as from_value, 
+#        subject_table.value as subject_value, 
+#        date_table.time_value as date_value, 
+#        to_char(date_table.time_value, 'YYYY-MM-DD HH24:MI') as pretty_date_value, 
+#        mmm.seen_p, 
+#        mmm.deleted_p
+#   from wm_messages m, 
+#        wm_headers from_table, 
+#        wm_headers subject_table, 
+#        wm_headers date_table, 
+#        wm_message_mailbox_map mmm[wm_query_extra_tables $filters]
+#  where mmm.mailbox_id = $mailbox_id
+#    and m.msg_id = mmm.msg_id
+#    and m.msg_id = from_table.msg_id(+)
+#    and from_table.lower_name(+) = 'from'
+#    and m.msg_id = subject_table.msg_id(+)
+#    and subject_table.lower_name(+) = 'subject'
+#    and m.msg_id = date_table.msg_id(+)
+#    and date_table.lower_name(+) = 'date'
+#        [wm_filter_clause $db $filters]"
+
+
+set sql "
+select m.msg_id, 
+       from_table.value as from_value, 
+       subject_table.value as subject_value, 
+       date_table.time_value as date_value, 
+       to_char(date_table.time_value, 'YYYY-MM-DD HH24:MI') as pretty_date_value, 
+       mmm.seen_p, 
+       mmm.deleted_p
+  from wm_messages m, 
+       wm_headers from_table, 
+       wm_headers subject_table, 
+       wm_headers date_table, 
+       wm_message_mailbox_map mmm[wm_query_extra_tables $filters]
+ where mmm.mailbox_id = $mailbox_id
+   and m.msg_id = mmm.msg_id
+   and m.msg_id = from_table.msg_id
+   and from_table.lower_name = 'from'
+   and m.msg_id = subject_table.msg_id
+   and subject_table.lower_name = 'subject'
+   and m.msg_id = date_table.msg_id
+   and date_table.lower_name = 'date'
+       [wm_filter_clause $db $filters [list]]
+union
+select m.msg_id, 
+       from_table.value as from_value, 
+       subject_table.value as subject_value, 
+       null::timestamp as date_value, 
+       null::varchar as pretty_date_value, 
+       mmm.seen_p, 
+       mmm.deleted_p
+  from wm_messages m, 
+       wm_headers from_table, 
+       wm_headers subject_table, 
+       wm_message_mailbox_map mmm[wm_query_extra_tables $filters]
+ where mmm.mailbox_id = $mailbox_id
+   and m.msg_id = mmm.msg_id
+   and m.msg_id = from_table.msg_id
+   and from_table.lower_name = 'from'
+   and m.msg_id = subject_table.msg_id
+   and subject_table.lower_name = 'subject'
+   and not exists (select 1 from wm_headers 
+                   where msg_id = m.msg_id
+                   and lower_name = 'date')
+       [wm_filter_clause $db $filters [list date]]
+union
+select m.msg_id, 
+       from_table.value as from_value, 
+       null::varchar as subject_value, 
+       date_table.time_value as date_value, 
+       to_char(date_table.time_value, 'YYYY-MM-DD HH24:MI') as pretty_date_value, 
+       mmm.seen_p, 
+       mmm.deleted_p
+  from wm_messages m, 
+       wm_headers from_table, 
+       wm_headers date_table, 
+       wm_message_mailbox_map mmm[wm_query_extra_tables $filters]
+ where mmm.mailbox_id = $mailbox_id
+   and m.msg_id = mmm.msg_id
+   and m.msg_id = from_table.msg_id
+   and from_table.lower_name = 'from'
+   and not exists (select 1 from wm_headers 
+                   where msg_id = m.msg_id
+                   and lower_name = 'subject')
+   and m.msg_id = date_table.msg_id
+   and date_table.lower_name = 'date'
+       [wm_filter_clause $db $filters [list subject]]
+union
+select m.msg_id, 
+       from_table.value as from_value, 
+       null::varchar as subject_value, 
+       null::timestamp as date_value, 
+       null::varchar as pretty_date_value, 
+       mmm.seen_p, 
+       mmm.deleted_p
+  from wm_messages m, 
+       wm_headers from_table, 
+       wm_message_mailbox_map mmm[wm_query_extra_tables $filters]
+ where mmm.mailbox_id = $mailbox_id
+   and m.msg_id = mmm.msg_id
+   and m.msg_id = from_table.msg_id
+   and from_table.lower_name = 'from'
+   and not exists (select 1 from wm_headers 
+                   where msg_id = m.msg_id
+                   and lower_name = 'subject')
+   and not exists (select 1 from wm_headers 
+                   where msg_id = m.msg_id
+                   and lower_name = 'date')
+       [wm_filter_clause $db $filters [list date subject]]
+
+
+union
+select m.msg_id, 
+       null::varchar as from_value, 
+       subject_table.value as subject_value, 
+       date_table.time_value as date_value, 
+       to_char(date_table.time_value, 'YYYY-MM-DD HH24:MI') as pretty_date_value, 
+       mmm.seen_p, 
+       mmm.deleted_p
+  from wm_messages m, 
+       wm_headers subject_table, 
+       wm_headers date_table, 
+       wm_message_mailbox_map mmm[wm_query_extra_tables $filters]
+ where mmm.mailbox_id = $mailbox_id
+   and m.msg_id = mmm.msg_id
+   and not exists (select 1 from wm_headers 
+                   where msg_id = m.msg_id 
+                   and lower_name = 'from')
+   and m.msg_id = subject_table.msg_id
+   and subject_table.lower_name = 'subject'
+   and m.msg_id = date_table.msg_id
+   and date_table.lower_name = 'date'
+       [wm_filter_clause $db $filters [list from]]
+union
+select m.msg_id, 
+       null::varchar as from_value, 
+       subject_table.value as subject_value, 
+       null::timestamp as date_value, 
+       null::varchar as pretty_date_value, 
+       mmm.seen_p, 
+       mmm.deleted_p
+  from wm_messages m, 
+       wm_headers subject_table, 
+       wm_message_mailbox_map mmm[wm_query_extra_tables $filters]
+ where mmm.mailbox_id = $mailbox_id
+   and m.msg_id = mmm.msg_id
+   and not exists (select 1 from wm_headers 
+                   where msg_id = m.msg_id 
+                   and lower_name = 'from')
+   and m.msg_id = subject_table.msg_id
+   and subject_table.lower_name = 'subject'
+   and not exists (select 1 from wm_headers 
+                   where msg_id = m.msg_id
+                   and lower_name = 'date')
+       [wm_filter_clause $db $filters [list date from]]
+union
+select m.msg_id, 
+       null::varchar as from_value, 
+       null::varchar as subject_value, 
+       date_table.time_value as date_value, 
+       to_char(date_table.time_value, 'YYYY-MM-DD HH24:MI') as pretty_date_value, 
+       mmm.seen_p, 
+       mmm.deleted_p
+  from wm_messages m, 
+       wm_headers date_table, 
+       wm_message_mailbox_map mmm[wm_query_extra_tables $filters]
+ where mmm.mailbox_id = $mailbox_id
+   and m.msg_id = mmm.msg_id
+   and not exists (select 1 from wm_headers 
+                   where msg_id = m.msg_id 
+                   and lower_name = 'from')
+   and not exists (select 1 from wm_headers 
+                   where msg_id = m.msg_id
+                   and lower_name = 'subject')
+   and m.msg_id = date_table.msg_id
+   and date_table.lower_name = 'date'
+       [wm_filter_clause $db $filters [list from subject]]
+union
+select m.msg_id, 
+       null::varchar as from_value, 
+       null::varchar as subject_value, 
+       null::timestamp as date_value, 
+       null::varchar as pretty_date_value, 
+       mmm.seen_p, 
+       mmm.deleted_p
+  from wm_messages m, 
+       wm_message_mailbox_map mmm[wm_query_extra_tables $filters]
+ where mmm.mailbox_id = $mailbox_id
+   and m.msg_id = mmm.msg_id
+   and not exists (select 1 from wm_headers 
+                   where msg_id = m.msg_id 
+                   and lower_name = 'from')
+   and not exists (select 1 from wm_headers 
+                   where msg_id = m.msg_id
+                   and lower_name = 'subject')
+   and not exists (select 1 from wm_headers 
+                   where msg_id = m.msg_id
+                   and lower_name = 'date')
+       [wm_filter_clause $db $filters [list date from subject]]
+"
+
+
+# Use the sortable_table proc defined in 00-ad-utilities.tcl to generate the HTML
+# for the list of messages.
+with_catch errmsg {
+    set message_headers [sortable_table $db $sql \
+			 [list \
+			      [list "" "" {[accumulate_msg_id $msg_id $seen_p $deleted_p]<input type=checkbox name=msg_ids value=$msg_id>}] \
+			      [list "from_value" "Sender" "<a href=\"message.tcl?\[export_url_vars msg_id\]\">\[wm_format_for_seen_or_deleted \$seen_p \$deleted_p \"\[philg_quote_double_quotes \$from_value\]\"\]</a>"] \
+			      [list "subject_value" "Subject" {[wm_format_for_seen_or_deleted $seen_p $deleted_p [ad_decode $subject_value "" "&nbsp;" $subject_value]]}] \
+			      [list "seen_p" "U" {[ad_decode $seen_p "f" "<img src=\"/graphics/checkmark.gif\">" "&nbsp;"]}] \
+			      [list "deleted_p" "D" {[ad_decode $deleted_p "t" "<img src=\"/graphics/checkmark.gif\">" "&nbsp;"]}] \
+			      [list "date_value" "Date" {[wm_format_for_seen_or_deleted $seen_p $deleted_p $pretty_date_value]}]] \
+			 [ns_conn form] \
+			 sort_by \
+			 $sort_by \
+			 50 \
+			 "width=100% cellspacing=0 cellpadding=0" \
+			 [list "\#f0f0f0" "\#ffffff"] \
+			 "" \
+			 "" \
+			 "size=-1"]
+} {
+    ad_return_error "WebMail Error" "An error occured while trying to fetch your messages.
+Most likely, you entered an invalid filter specification. You can use the links below
+to modify your filter settings:
+ [wm_filter_info $filters]
+<p>
+The error message received was:
+<pre>
+$errmsg
+</pre>
+"
+    return
+}
+
+# Save off our accumulated message IDs so that message.tcl can use
+# them for next/prev navigation.
+
+ad_set_client_property -persistent f "webmail" "current_messages" $current_messages
+
+
+# Options for folder selection.
+set folder_select_options [db_html_select_value_options $db "select mailbox_id, name
+from wm_mailboxes
+where creation_user = $user_id" $mailbox_id]
+
+
+# How many messages we have, and how many of those are unread.
+set n_messages [database_to_tcl_string $db "select count(*)
+from wm_message_mailbox_map
+where mailbox_id = $mailbox_id"]
+
+set n_unread_messages [database_to_tcl_string $db "select count(*)
+from wm_message_mailbox_map 
+where mailbox_id = $mailbox_id
+  and seen_p = 'f'"]
+
+ns_db releasehandle $db
+
+set possible_days [list 1 2 7 30 0]
+foreach day $possible_days {
+    set day_display [ad_decode $day 0 "all" $day]
+    lappend days_url_list "<a href=\"summary?last_n_days=$day\">$day_display</a>"
+}
+set day_selection_list "<font size=-1>\[ [join $days_url_list " | "] \]</font>"
+
+set orig_mailbox_id $mailbox_id
+
+ns_return 200 text/html "[ad_header "WebMail"]
+
+<script language=JavaScript>
+<!--
+ function SetChecked(val) {
+dml=document.messageList;
+len = dml.elements.length;
+var i=0;
+ for( i=0 ; i<len ; i++) {
+ if (dml.elements\[i\].name=='msg_ids') {
+dml.elements\[i\].checked=val;
+}
+}
+}
+
+// Necessary for the refile selected buttons. There are two selection widgets
+// with the same name in this form. If they are not synched up before the form
+// is submitted, only the value of the first one will be used.
+ function SynchMoves(primary) {
+dml=document.messageList;
+if(primary==2) dml.mailbox_id.selectedIndex=dml.mailbox_id2.selectedIndex;
+else dml.mailbox_id2.selectedIndex=dml.mailbox_id.selectedIndex;
+}
+// -->
+</script>
+
+<h2>$mailbox_name</h2>
+
+ [ad_context_bar_ws "WebMail"]
+
+<hr>
+<table border=0 width=100%>
+<tr><td align=right>$day_selection_list</td></tr>
+</table>
+
+ [ad_decode $n_messages 1 "1 message" "$n_messages messages"],
+ [ad_decode $n_unread_messages 1 "1 unread" "$n_unread_messages unread"]
+
+<table border=0 width=100%>
+
+<tr valign=top>
+<td><form action=\"folder-move-to.tcl\">
+<font size=-1>
+<select name=mailbox_id>
+$folder_select_options
+<option value=\"@NEW\">New Folder</option>
+</select>
+<input type=submit value=\"Go\">
+</font>
+</form>
+</td>
+
+<td align=right><a href=\"expunge.tcl?[export_url_vars mailbox_id]\">Expunge Deleted Messages</a><br>
+<a href=\"message-send.tcl\">Send Mail</a>
+</td>
+</tr>
+</table>
+
+<table border=0 width=100%>
+<tr valign=top><td><form action=\"filter-add.tcl\" method=POST>
+Filters: 
+<font size=-1>
+<select name=filter_type>
+<option value=\"author\">Author</option>
+<option value=\"recipient\">Recipient</option>
+<option value=\"subject\">Subject</option>
+<option value=\"sent-after\">Sent After</option>
+<option value=\"sent-before\">Sent Before</option>
+<option value=\"sent-on\">Sent On</option>
+<option value=\"read\">Read</option>
+<option value=\"unread\">Unread</option>
+<option value=\"deleted\">Deleted</option>
+<option value=\"undeleted\">Not Deleted</option>
+<option value=\"any-header\">Any Header</option>
+<option value=\"body\">Body</option>
+</select>
+
+<input type=text name=filter_term size=10>
+
+<input type=submit value=\"Add Filter\">
+</font>
+</form>
+
+[wm_filter_info $filters]
+
+</td>
+
+<td align=right>
+<form name=messageList action=\"process-selected-messages.tcl\" method=POST>
+<font size=-1>
+Selected Msgs: <input type=submit name=action value=\"Delete\">
+<input type=submit name=action value=\"Undelete\">
+<input type=submit name=action value=\"Refile\">
+<select name=mailbox_id [ad_decode [expr $message_count > 20] 1 "onChange=\"SynchMoves(1)\"" ""]>
+$folder_select_options
+<option value=\"@NEW\">New Folder</option>
+</select>
+</font>
+</td>
+</tr>
+</table>
+
+
+<p>
+
+[ad_decode $message_count 0 "No messages." "
+<font size=-1>
+<a href=\"javascript:SetChecked(1)\">Check All</a> - 
+<a href=\"javascript:SetChecked(0)\">Clear All</a>
+</font>
+
+$message_headers
+
+<font size=-1>
+<a href=\"javascript:SetChecked(1)\">Check All</a> - 
+<a href=\"javascript:SetChecked(0)\">Clear All</a>
+"]
+
+<p>
+
+[ad_decode [expr $message_count > 20] 1 "<input type=submit name=action value=\"Delete\">
+<input type=submit name=action value=\"Undelete\">
+<input type=submit name=action value=\"Refile\">
+<select name=mailbox_id2 onChange=\"SynchMoves(2)\">
+$folder_select_options
+<option value=\"@NEW\">New Folder</option>
+</select>
+</font>
+</form>
+
+<a href=\"expunge.tcl?[export_url_vars mailbox_id]\">Expunge Deleted Messages</a><p>
+<a href=\"message-send.tcl\">Send Mail</a>
+" ""]
+
+[ad_footer]
+"
Index: web/openacs/www/webmail/message-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/message-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/message-delete.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,68 @@
+# /webmail/message-delete.tcl
+# by jsc@arsdigita.com (2000-02-23)
+
+# Delete a single message, move to next unread, undeleted message or
+# back to index if none exist.
+
+ad_page_variables msg_id
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+validate_integer msg_id $msg_id
+
+with_catch errmsg {
+    ns_db dml $db "update wm_message_mailbox_map
+set deleted_p = 't'
+ where msg_id = $msg_id
+  and mailbox_id in (select mailbox_id from wm_mailboxes where creation_user = $user_id)"
+} {
+    ad_return_error "Deletion Failed" "Deletion of messages failed:
+<pre>
+$errmsg
+</pre>
+"
+    return
+}
+
+
+# Figure out where we're supposed to go from here.
+set current_messages [ad_get_client_property "webmail" "current_messages"]
+
+set go_to_next_message_p 0
+set next_msg_id 0
+
+# Skip to next unseen, undeleted message,
+# next message if no next unseen message,
+# or back to the folder if none of the above.
+ 
+foreach message $current_messages {
+    set current_msg_id [lindex $message 0]
+    set seen_p [lindex $message 1]
+    set deleted_p [lindex $message 2]
+
+    if { $msg_id == $current_msg_id } {
+	set go_to_next_message_p 1
+	continue
+    }
+
+    if { $go_to_next_message_p } {
+        if { $seen_p == "f" && $deleted_p == "f" } {
+	    ad_returnredirect "message.tcl?msg_id=$current_msg_id"
+	    return
+	}
+
+	if { $deleted_p == "f" && $next_msg_id == 0 } {
+	    # Store msg_id of next read, undeleted message if we don't find any
+	    # unread messages.
+	    set next_msg_id $current_msg_id
+	}
+    }
+}
+
+if { $next_msg_id != 0 } {
+    ns_returnredirect "message.tcl?msg_id=$next_msg_id"
+} else {
+    ns_returnredirect "index.tcl"
+}
Index: web/openacs/www/webmail/message-refile.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/message-refile.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/message-refile.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,67 @@
+# /webmail/message-refile.tcl
+# by jsc@arsdigita.com (2000-02-23)
+
+# Refile a single message and display next unread, undeleted message
+# or index if none exist.
+
+ad_page_variables {msg_id mailbox_id}
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+validate_integer msg_id $msg_id
+validate_integer mailbox_id $mailbox_id
+
+with_catch errmsg {
+    ns_db dml $db "update wm_message_mailbox_map
+set mailbox_id = $mailbox_id
+ where msg_id = $msg_id
+  and mailbox_id in (select mailbox_id from wm_mailboxes where creation_user = $user_id)"
+} {
+    ad_return_error "Refiling Failed" "Deletion of messages failed:
+<pre>
+$errmsg
+</pre>
+"
+    return
+}
+
+
+# Figure out where we're supposed to go from here.
+set current_messages [ad_get_client_property "webmail" "current_messages"]
+
+set go_to_next_message_p 0
+set next_msg_id 0
+
+# Skip to next unseen, undeleted message, or back to the folder if no such message.
+foreach message $current_messages {
+    set current_msg_id [lindex $message 0]
+    set seen_p [lindex $message 1]
+    set deleted_p [lindex $message 2]
+
+    if { $msg_id == $current_msg_id } {
+	set go_to_next_message_p 1
+	continue
+    }
+
+    if { $go_to_next_message_p } {
+	if { $seen_p == "f" && $deleted_p == "f" } {
+	    ad_returnredirect "message.tcl?msg_id=$current_msg_id"
+	    return
+	}
+
+	if { $deleted_p == "f" && $next_msg_id == 0 } {
+	    # Store msg_id of next read, undeleted message if we don't find any
+	    # unread messages.
+	    set next_msg_id $current_msg_id
+	}
+
+    }
+}
+
+if { $next_msg_id != 0 } {
+    ns_returnredirect "message.tcl?msg_id=$next_msg_id"
+} else {
+    ns_returnredirect "index.tcl"
+}
Index: web/openacs/www/webmail/message-send-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/message-send-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/message-send-2.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,208 @@
+# /webmail/message-send-2.tcl
+# by jsc@arsdigita.com (2000-02-23)
+
+# Present message for review and give form to attach files.
+
+
+ad_page_variables {outgoing_msg_id {response_to_msg_id ""} {to ""} {cc ""} {subject ""} {from ""} {body ""}}
+
+set user_id [ad_verify_and_get_user_id]
+set db [ns_db gethandle]
+
+
+validate_integer outgoing_msg_id $outgoing_msg_id
+
+set header_sort_key 0
+
+with_transaction $db {
+    # Insert body or retrieve saved body.
+    if { [empty_string_p $to] && [empty_string_p $cc] && [empty_string_p $subject] && [empty_string_p $from] && [empty_string_p $body] } {
+	# We are attaching messages to an already inserted message.
+	# Retrieve the saved message as cleaned_body.
+
+	set selection [ns_db 0or1row $db "select body as cleaned_body, creation_user
+from wm_outgoing_messages
+where outgoing_msg_id = $outgoing_msg_id"]
+
+	if { $selection == "" } {
+	    ad_return_error "No Such Message" "The specified message being composed no longer exists. You took too long to send it and it got cleaned up."
+	    return
+	}
+	set_variables_after_query
+	
+	if { $creation_user != $user_id } {
+	    ad_return_error "Permission Denied" "You do not have permission to access the specified message."
+	    return
+	}
+    } else {
+	# We got a body; we are inserting for the first time, or the user went back and
+	# resubmitted the form.
+	set creation_user [database_to_tcl_string_or_null $db "select creation_user
+from wm_outgoing_messages
+where outgoing_msg_id = $outgoing_msg_id"]
+	
+	if { $creation_user == "" } {
+	    # No previous message.
+	    set cleaned_body [wrap_string [DoubleApos $body]]
+	    
+	    ns_db dml $db "insert into wm_outgoing_messages (outgoing_msg_id, body, creation_user)
+ values ($outgoing_msg_id, '$cleaned_body', $user_id)" 
+	} elseif { $creation_user == $user_id } {
+	    # Reinserted message.
+	    set cleaned_body [wrap_string [DoubleApos $body]]
+	    
+	    ns_db dml $db "update wm_outgoing_messages set body = '$cleaned_body'" 
+	} else {
+	    ad_return_error "Permission Denied" "You do not have permission to update the message you are trying to compose."
+	    return
+	}
+    }
+
+    # Process headers if not already done.
+    if { [database_to_tcl_string $db "select count(*)
+from wm_outgoing_headers
+ where outgoing_msg_id = $outgoing_msg_id"] == 0 } {
+
+	if { [empty_string_p $to] && [empty_string_p $cc] } {
+	    ad_return_error "No Recipients" "You did not specify any recipients for your message."
+	    return
+	}
+
+	# Validate the from field.
+	if { [database_to_tcl_string $db "select count(*)
+from wm_email_user_map eum, wm_domains d
+where user_id = $user_id
+  and eum.domain = d.short_name
+  and email_user_name || '@' || full_domain_name = '$QQfrom'"] == 0 } {
+	    ad_return_error "Permission Denied" "You cannot send email as \"$from\"."
+	    return
+	}
+
+	# Insert standard headers.
+	foreach field_spec [list [list To $to] [list Cc $cc] [list Subject $subject] [list From $from]] {
+	    set name [lindex $field_spec 0]
+	    set value [lindex $field_spec 1]
+	    if { ![empty_string_p $value] } {
+		ns_db dml $db "insert into wm_outgoing_headers (outgoing_msg_id, name, value, sort_order)
+ values ($outgoing_msg_id, '[DoubleApos $name]', '[DoubleApos $value]', $header_sort_key)"
+		incr header_sort_key
+	    }
+	}
+	
+	# Figure out References field.
+	if { ![empty_string_p $response_to_msg_id] } {
+	    validate_integer response_to_msg_id $response_to_msg_id
+	    
+	    if { ![wm_check_permissions $db $response_to_msg_id $user_id] } {
+		ad_return_error "Permission Denied" "You do not have permission to access this message to respond to it."
+		return
+	    }
+	    
+	    set old_references [database_to_tcl_string_or_null $db "select value
+from wm_headers
+where msg_id = $response_to_msg_id
+  and lower_name = 'references'"]
+	    
+	    set old_message_id [database_to_tcl_string $db "select message_id
+from wm_messages
+where msg_id = $response_to_msg_id"]
+	    
+	    set references [string trim "$old_references $old_message_id"]
+	    if { ![empty_string_p $references] } {
+		ns_db dml $db "insert into wm_outgoing_headers (outgoing_msg_id, name, value, sort_order)
+ values ($outgoing_msg_id, 'References', '[DoubleApos $references]', $header_sort_key)"
+		incr header_sort_key
+	    }
+	}
+    }
+
+    if { ![empty_string_p $response_to_msg_id] } {
+	set context_bar [ad_context_bar_ws \
+			     [list "index.tcl" "WebMail"] \
+			     [list "message.tcl?msg_id=$response_to_msg_id" "One Message"] \
+			     "Response"]
+	set title "Response"
+    } else {
+	set context_bar [ad_context_bar_ws [list "index.tcl" "WebMail"] "Compose Mail"]
+	set title "Compose Mail"
+    }
+} {
+    ad_return_error "Error Composing Message" "An error occured while composing your message:
+<pre>
+$errmsg
+</pre>"
+    return
+}
+
+
+
+# Format message body.
+set selection [ns_db select $db "select name || ': ' || value as field
+from wm_outgoing_headers
+where outgoing_msg_id = $outgoing_msg_id
+order by sort_order"]
+
+set msg ""
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    
+    append msg "$field\n"
+}
+append msg "\n$cleaned_body"
+
+
+# Format attachments.
+
+set selection [ns_db select $db "select filename, content_type
+from wm_outgoing_message_parts
+where outgoing_msg_id = $outgoing_msg_id
+order by sort_order"]
+set attachments "<ul>\n"
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append attachments "<li>$filename ($content_type)\n"
+}
+append attachments "</ul>"
+
+
+ns_db releasehandle $db
+
+
+ns_return 200 text/html "[ad_header $title]
+<h2>$title</h2>
+
+$context_bar
+
+<hr>
+
+<form enctype=multipart/form-data action=\"message-send-add-attachment.tcl\" method=POST>
+ [export_form_vars outgoing_msg_id response_to_msg_id]
+Attachments:
+$attachments
+<p>
+
+<font size=-1><input type=file name=upload_file><br><input type=submit value=\"Attach File\"></font> 
+</form>
+
+<p>
+<p>
+
+<center>
+<form action=\"message-send-3.tcl\" action=POST>
+[export_form_vars outgoing_msg_id response_to_msg_id]
+<input type=submit value=\"Send Message\">
+</form>
+</center>
+
+
+<blockquote>
+<pre>
+$msg
+</pre>
+</blockquote>
+
+
+
+[ad_footer]
+"
+
Index: web/openacs/www/webmail/message-send-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/message-send-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/message-send-3.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,66 @@
+# /webmail/message-send-3.tcl
+# by jsc@arsdigita.com (2000-03-01)
+
+# Send the email.
+
+ad_page_variables {{response_to_msg_id ""} outgoing_msg_id}
+
+
+set user_id [ad_verify_and_get_user_id]
+set db [ns_db gethandle]
+
+validate_integer outgoing_msg_id $outgoing_msg_id
+set author_id [database_to_tcl_string_or_null $db "select creation_user
+from wm_outgoing_messages
+where outgoing_msg_id = $outgoing_msg_id"]
+
+if { $author_id == "" } {
+    ad_return_error "No Such Message" "The specified message does not exist. You may already have sent it,
+or waited too long to send it."
+    return
+} elseif { $author_id != $user_id } {
+    ad_return_error "Permission Denied" "You do not have permission to send this message."
+    return
+}
+
+with_transaction $db {
+
+    set tmpfile [ns_mktemp "[ns_info pageroot]/webmail/tmp/.wm_msgXXXXXX"]
+
+    # nsjava available at http://nsjava.sourceforge.net
+    ns_java MessageComposer::compose_message $outgoing_msg_id $tmpfile
+
+    set from [database_to_tcl_string $db "select value
+from wm_outgoing_headers
+where name = 'From'
+and outgoing_msg_id = $outgoing_msg_id"]
+
+    # aD's version stuffed mime encoded message into db from java.  It then
+    # pulled it in here and sent it via qmail.  I've changed it so that java 
+    # put's the mime-encoded message into a tmpfile and then reads it in here.
+    # I'm doing this because it doesn't buy me anything to stuff the message
+    # into the db and pull it right back out again and delete it from the db.
+    set fis [open $tmpfile r]
+    set composed_message [read $fis]
+    close $fis
+    ns_unlink -nocomplain $tmpfile
+
+    regsub -all "\r" $composed_message "" cleaned_message
+
+    qmail_send_complete_message $from $cleaned_message
+    ns_db dml $db "delete from wm_outgoing_messages where outgoing_msg_id = $outgoing_msg_id"
+} {
+    ad_return_error "Database Error" "An error occured while we attempted to compose your message:
+<pre>
+$errmsg
+</pre>"
+    return
+}
+
+if { ![empty_string_p $response_to_msg_id] } {
+    ns_returnredirect "message.tcl?msg_id=$response_to_msg_id"
+} else {
+    ns_returnredirect "index.tcl"
+}
+
+
Index: web/openacs/www/webmail/message-send-add-attachment.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/message-send-add-attachment.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/message-send-add-attachment.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,53 @@
+# /webmail/message-send-add-attachment.tcl
+# by jsc@arsdigita.com (2000-03-01)
+
+# Attach file to outgoing message.
+
+ad_page_variables {upload_file outgoing_msg_id {response_to_msg_id ""}}
+
+set user_id [ad_verify_and_get_user_id]
+set db [ns_db gethandle]
+
+
+# Check permissions.
+validate_integer outgoing_msg_id $outgoing_msg_id
+
+set creation_user [database_to_tcl_string_or_null $db "select creation_user
+from wm_outgoing_messages
+where outgoing_msg_id = $outgoing_msg_id"]
+
+if { $creation_user == "" } {
+    ad_return_error "No Such Message" "The message you are attempting to attach a file to is no longer valid."
+    return
+} elseif { $creation_user != $user_id } {
+    ad_return_error "Permission Denied" "You do not have permission to attach a file to this message."
+    return
+}
+
+if { [empty_string_p $upload_file] } {
+    ad_return_error "No File Selected" "You must specify a file to attach."
+    return
+}
+
+set tmp_filename [ns_queryget upload_file.tmpfile]
+set content_type [ns_guesstype $upload_file]
+
+if { [empty_string_p $content_type] } {
+    set content_type "application/octet-stream"
+}
+
+with_transaction $db {
+
+    set lob_id [database_to_tcl_string $db "select empty_lob()"]
+
+    ns_db dml $db "insert into wm_outgoing_message_parts (outgoing_msg_id, lob, filename, content_type, sort_order)
+values ($outgoing_msg_id, $lob_id, '[file tail $QQupload_file]', '$content_type', nextval('wm_outgoing_parts_sequence'))"
+
+    ns_pg blob_dml_file $db $lob_id $tmp_filename
+
+} {}
+
+ns_returnredirect "message-send-2.tcl?[export_url_vars outgoing_msg_id response_to_msg_id]"
+
+
+
Index: web/openacs/www/webmail/message-send.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/message-send.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/message-send.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,133 @@
+# /webmail/message-send.tcl
+# by jsc@arsdigita.com (2000-02-23)
+
+# Present form to send message, populating certain fields if this is a response.
+
+ad_page_variables {{response_to_msg_id ""} {respond_to_all 0}}
+
+# If response_to_msg_id is supplied, this is a response to the given msg_id.
+# If respond_to_all is set to a true value, all recipients will be Cc'ed.
+
+set msg_body ""
+set subject ""
+set page_title "Send Mail"
+
+set user_id [ad_verify_and_get_user_id]
+set db [ns_db gethandle]
+
+set cc ""
+
+if { ![empty_string_p $response_to_msg_id] } {
+
+    validate_integer response_to_msg_id $response_to_msg_id
+
+    if { ![wm_check_permissions $db $response_to_msg_id $user_id] } {
+	ad_return_error "Permission Denied" "You do not have permission to access this message to respond to it."
+	return
+    }
+
+    # DanW - beware  hidden blob hack
+    set msg_body_id [database_to_tcl_string $db "select body
+from wm_messages
+where msg_id = $response_to_msg_id"]
+
+    # function returns the lob as a tcl string - new driver support added.
+    set msg_body [database_lob_to_tcl_string $db $msg_body_id]
+
+    set subject [database_to_tcl_string_or_null $db "select value
+from wm_headers
+where msg_id = $response_to_msg_id
+  and lower_name = 'subject'"]
+
+    if { ![empty_string_p $subject] } {
+	set page_title "Response to \"$subject\""
+
+	if { ![regexp -nocase {^re:} $subject] } {
+	    set subject "Re: $subject"
+	}
+    } else {
+	set page_title "Response"
+    }
+
+    set to [database_to_tcl_string_or_null $db "select wm_response_address($response_to_msg_id) from dual"]
+
+    if $respond_to_all {
+	set cc [join [database_to_tcl_list $db "select email from wm_recipients where msg_id = $response_to_msg_id"] ", "]
+    }
+    set context_bar [ad_context_bar_ws \
+			 [list "index.tcl" "WebMail"] \
+			 [list "message.tcl?msg_id=$response_to_msg_id" "One Message"] \
+			 "Response"]
+} else {
+    set context_bar [ad_context_bar_ws [list "index.tcl" "WebMail"] "Send Mail"]
+    set to ""
+}
+
+
+set from_options [database_to_tcl_list $db "select email_user_name || '@' || full_domain_name as from_address
+from wm_email_user_map eum, wm_domains d
+where user_id = $user_id
+  and eum.domain = d.short_name
+order by 1"]
+
+if { [llength $from_options] > 1 } {
+    set from_field "<select name=from>\n"
+    foreach option $from_options {
+	append from_field "<option>$option</option>\n"
+    }
+    append from_field "</select>"
+} else {
+    set from [lindex $from_options 0]
+    set from_field "$from\n[export_form_vars from]\n"
+}
+
+set outgoing_msg_id [database_to_tcl_string $db "select nextval('wm_outgoing_msg_id_sequence') from dual"]
+
+ns_db releasehandle $db
+
+ns_return 200 text/html "[ad_header $page_title]
+<h2>$page_title</h2>
+
+$context_bar
+
+<hr>
+
+<form action=\"message-send-2.tcl\" method=POST>
+ [export_form_vars response_to_msg_id outgoing_msg_id]
+
+<blockquote>
+
+<table border=0 width=90%>
+<tr><td align=right>To: </td>
+<td><input type=text name=to size=40 value=\"[philg_quote_double_quotes $to]\"></td>
+</tr>
+
+<tr><td align=right>From: </td>
+<td>$from_field</td>
+</tr>
+
+<tr><td align=right>Cc: </td>
+<td><input type=text name=cc size=40 value=\"[philg_quote_double_quotes $cc]\"></td>
+</tr>
+
+<tr><td align=right>Subject: </td>
+<td><input type=text name=subject size=80 value=\"[philg_quote_double_quotes $subject]\"></td>
+</tr>
+
+</table>
+
+<textarea wrap=virtual name=body rows=20 cols=80>[wm_quote_message $to $msg_body]</textarea>
+
+</blockquote>
+
+<center>
+<input type=submit value=\"Preview Message\">
+</center>
+
+</form>
+
+[ad_footer]
+"
+
+
+
Index: web/openacs/www/webmail/message.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/message.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/message.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,255 @@
+# /webmail/message.tcl
+# by jsc@arsdigita.com (2000-02-23)
+
+# Displays a single message.
+
+
+ad_page_variables {msg_id {header_display_style "short"} {body_display_style "parsed"}}
+# header_display_style can be "short" or "all"
+# body_display_style can be "parsed" or "unparsed"
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+# See if user has permission to read this message, and at the same time get
+# the mailbox_id of this message.
+set selection [ns_db 0or1row $db "select m.mailbox_id, m.name as mailbox_name, mmm.deleted_p
+from wm_message_mailbox_map mmm, wm_mailboxes m
+where mmm.msg_id = $msg_id
+  and mmm.mailbox_id = m.mailbox_id
+  and m.creation_user = $user_id"]
+
+if { [empty_string_p $selection] } {
+    ad_return_error "No Such Message" "The specified message could not be found.
+Either you do not have permission to read this message, or it has been deleted."
+    return
+} else {
+    set_variables_after_query
+}
+
+
+set mime_message_p 0
+set msg_body ""
+set msg_body_id [database_to_tcl_string $db "select mime_text
+from wm_messages
+where msg_id = $msg_id"]
+
+if {$msg_body_id != ""} {
+    ns_log Debug "mime_text = $msg_body_id"
+    set msg_body [database_lob_to_tcl_string $db $msg_body_id]
+
+    if { $msg_body != "" } {
+        set mime_message_p 1
+    }
+}
+
+
+if { $body_display_style == "parsed" } {
+    if { $msg_body != "" } {
+	set quoted_msg_body [philg_quote_double_quotes $msg_body]
+	regsub -all "##wm_image: (\[^\n\]+)" $quoted_msg_body "<img src=\"parts/$msg_id/\\1\">" final_msg_body
+	regsub -all "##wm_part: (\[^\n\]+)" $final_msg_body "<b>Attachment:</b> <a href=\"parts/$msg_id/\\1\">\\1</a>" final_msg_body
+    }
+}
+ns_log Debug "msg_body = $msg_body"
+
+if { $body_display_style == "unparsed" || $msg_body == "" } {
+    set msg_body_id [database_to_tcl_string $db "select body
+from wm_messages
+where msg_id = $msg_id"]
+    set msg_body [database_lob_to_tcl_string $db $msg_body_id]
+
+    if { [database_to_tcl_string $db "select count(*) 
+from wm_headers
+where msg_id = $msg_id
+  and lower_name = 'content-type'
+  and value like 'text/html%'"] > 0 } {
+	set final_msg_body $msg_body
+    } else {
+	set final_msg_body [philg_quote_double_quotes $msg_body]
+    }
+}
+
+ns_log Debug "final_msg_body = $final_msg_body"
+
+if { $header_display_style == "short" } {
+    set change_header_display_link "<font size=-1><a href=\"message.tcl?msg_id=$msg_id&header_display_style=all\">Show all headers</a></font>"
+} else {
+    set change_header_display_link "<font size=-1><a href=\"message.tcl?msg_id=$msg_id&header_display_style=short\">Hide headers</a></font>"
+}
+
+if $mime_message_p {
+    if { $body_display_style == "parsed" } {
+	set change_body_display_link "<font size=-1><a href=\"message.tcl?[export_url_vars msg_id header_display_style]&body_display_style=unparsed\">Show unparsed message</a></font>"
+    } else {
+	set change_body_display_link "<font size=-1><a href=\"message.tcl?[export_url_vars msg_id header_display_style]&body_display_style=parsed\">Show decoded message</a></font>"
+    }
+} else {
+    set change_body_display_link ""
+}
+
+
+
+
+set msg_headers [wm_header_display $db $msg_id $header_display_style $user_id]
+
+
+set current_messages [ad_get_client_property "webmail" "current_messages"]
+
+set folder_select_options [db_html_select_value_options $db "select mailbox_id, name
+from wm_mailboxes
+where creation_user = $user_id
+and mailbox_id <> $mailbox_id"]
+
+if { [empty_string_p $folder_select_options] } {
+    set folder_refile_widget ""
+} else {
+    set folder_refile_widget "<form action=\"message-refile.tcl\" method=POST>
+[export_form_vars msg_id]
+<input type=submit value=\"Refile\">
+<select name=mailbox_id>
+<option value=\"\">Select Folder</option>
+$folder_select_options
+</select>
+</form>
+"
+}
+
+
+ns_db dml $db "update wm_message_mailbox_map
+set seen_p = 't'
+where msg_id = $msg_id"
+
+ns_db releasehandle $db
+
+# Returns HTML to provide navigation links for previous unread, previous,
+# next, and next unread messages. If the next message is unread, only provides
+# next unread link. Same for previous and previous unread.
+
+proc wm_message_navigation_links { current_msg_id current_messages } {
+    set prev_unread ""
+    set prev ""
+    set next_unread ""
+    set next ""
+    set looking_for_next_message_p 0
+    set looking_for_next_unread_message_p 0
+
+    set last_unread ""
+    set last ""
+    
+    foreach message $current_messages {
+	set msg_id [lindex $message 0]
+	set seen_p [lindex $message 1]
+	set deleted_p [lindex $message 2]
+
+	if { $msg_id == $current_msg_id } {
+	    set prev_unread $last_unread
+	    set prev $last
+	    set looking_for_next_message_p 1
+	    continue
+	}
+
+	if { $deleted_p == "t" } {
+	    continue
+	}
+
+	if { $looking_for_next_unread_message_p } {
+	    if { $seen_p == "t" } {
+		continue
+	    } else {
+		set next_unread $msg_id
+		break
+	    }
+	}
+
+	if { $looking_for_next_message_p } {
+	    set next $msg_id
+
+	    if { $seen_p == "t" } {
+		set looking_for_next_unread_message_p 1
+		continue
+	    } else {
+		set next_unread $msg_id
+		break
+	    }
+	}
+	
+	
+	if { $seen_p == "f" } {
+	    set last_unread $msg_id
+	}
+	set last $msg_id
+    }
+
+    set nav_links [list]
+
+    if { $prev_unread != "" } {
+	lappend nav_links "<a href=\"message.tcl?msg_id=$prev_unread\">Previous Unread</a>"
+    } else {
+	lappend nav_links "<font color=\"lightgray\">Previous Unread</font>"
+    }
+
+    if { $prev != "" } {
+	lappend nav_links "<a href=\"message.tcl?msg_id=$prev\">Previous</a>"
+    } else {
+	lappend nav_links "<font color=\"lightgray\">Previous</font>"
+    }
+
+    if { $next != "" } {
+	lappend nav_links "<a href=\"message.tcl?msg_id=$next\">Next</a>"
+    } else {
+	lappend nav_links "<font color=\"lightgray\">Next</font>"
+    }
+
+    if { $next_unread != "" } {
+	lappend nav_links "<a href=\"message.tcl?msg_id=$next_unread\">Next Unread</a>"
+    } else {
+	lappend nav_links "<font color=\"lightgray\">Next Unread</font>"
+    }
+    return [join $nav_links " - "]
+}
+
+
+
+ns_return 200 text/html "[ad_header "One Message"]
+<h2>$mailbox_name</h2>
+
+[ad_context_bar_ws [list "index.tcl?[export_url_vars mailbox_id]" "WebMail ($mailbox_name)"] "One Message"]
+
+<hr>
+
+[wm_message_navigation_links $msg_id $current_messages]
+<p>
+<a href=\"message-send.tcl?response_to_msg_id=$msg_id\">Reply</a> -
+<a href=\"message-send.tcl?response_to_msg_id=$msg_id&respond_to_all=1\">Reply All</a>
+
+
+$folder_refile_widget
+
+[ad_decode $deleted_p "f" "<form action=\"message-delete.tcl\" method=POST>
+[export_form_vars msg_id]
+<input type=submit value=\"Delete\">
+</form>" ""]
+
+<blockquote>
+$msg_headers
+$change_header_display_link
+<p>
+$change_body_display_link
+<pre>
+$final_msg_body
+</pre>
+</blockquote>
+
+$folder_refile_widget
+
+[ad_decode $deleted_p "f" "<form action=\"message-delete.tcl\" method=POST>
+[export_form_vars msg_id]
+<input type=submit value=\"Delete\">
+</form>" ""]
+
+
+
+[ad_footer]
+"
Index: web/openacs/www/webmail/process-selected-messages.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/process-selected-messages.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/process-selected-messages.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,60 @@
+# /webmail/process-selected-messages.tcl
+# by jsc@arsdigita.com (2000-02-23)
+
+# Delete or refile messages selected messages.
+
+ad_page_variables {{msg_ids -multiple-list} action mailbox_id}
+
+if { $msg_ids == "" } {
+    # nothing selected
+    ns_returnredirect "index.tcl"
+    return
+}
+
+if { ![regexp {^[{} 0-9]+$} $msg_ids] } {
+     ad_return_complaint 1 "<li>Please don't try to hack the system."
+     return
+ }
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+switch -- $action {
+    "Delete" -
+    "Undelete" {
+	if { $action == "Delete" } {
+	    set deleted_p_value "t"
+	} else {
+	    set deleted_p_value "f"
+	}
+	with_catch errmsg {
+	    ns_db dml $db "update wm_message_mailbox_map
+set deleted_p = '$deleted_p_value'
+ where msg_id in ([join $msg_ids ", "])
+  and mailbox_id in (select mailbox_id from wm_mailboxes where creation_user = $user_id)"
+	} {
+	    ad_return_error "Deletion Failed" "Deletion of messages failed:
+<pre>
+$errmsg
+</pre>
+"
+	    return
+	}
+    }
+    "Refile" {
+	# See if user owns destination mailbox.
+	ad_set_client_property -persistent f "webmail" "selected_messages" $msg_ids
+	if { $mailbox_id == "@NEW" } {
+	    ns_returnredirect "folder-create.tcl?target=[ns_urlencode "refile-selected.tcl"]"
+	    return
+	} else {
+	    validate_integer mailbox_id $mailbox_id
+	    ns_returnredirect "refile-selected.tcl?[export_url_vars mailbox_id]"
+	    return
+	}
+    }
+}
+
+ns_returnredirect "index.tcl"
+
+
Index: web/openacs/www/webmail/refile-selected.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/refile-selected.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/refile-selected.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,41 @@
+# /webmail/refile-selected.tcl
+# by jsc@arsdigita.com (2000-02-23)
+
+# Perform bulk refiling of selected messages.
+
+ad_page_variables {mailbox_id}
+
+validate_integer mailbox_id $mailbox_id
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+
+set msg_ids [ad_get_client_property "webmail" "selected_messages"]
+
+
+if { [database_to_tcl_string $db "select count(*)
+from wm_mailboxes
+where mailbox_id = $mailbox_id
+  and creation_user = $user_id"] == 0 } {
+    ad_return_error "Permission Denied" "You do not have permission to refile to this mailbox."
+    ns_log Notice "WEBMAIL WARNING: user $user_id attempted to refile messages to mailbox $mailbox_id"
+    return
+}
+
+with_catch errmsg {
+    ns_db dml $db "update wm_message_mailbox_map
+set mailbox_id = $mailbox_id
+ where msg_id in ([join $msg_ids ", "])
+  and mailbox_id in (select mailbox_id from wm_mailboxes where creation_user = $user_id)"
+} {
+    ad_return_error "Refiling Failed" "Refiling of messages failed:
+<pre>
+$errmsg
+</pre>
+"
+    return
+}
+
+ns_returnredirect "index.tcl"
+
Index: web/openacs/www/webmail/summary.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/summary.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/summary.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,212 @@
+# /webmail/summary.tcl
+# by jsc@arsdigita.com (2000-02-28)
+
+# Display a summary of activity for the current mailbox.
+
+
+ad_page_variables {{last_n_days 0}}
+# 0 indicates all messages.
+
+validate_integer last_n_days $last_n_days
+
+set user_id [ad_verify_and_get_user_id]
+
+if { $user_id == 0 } {
+    ad_returnredirect "/register/index.tcl?return_url=[ns_urlencode "/webmail/summary.tcl"]"
+    return
+}
+
+set db [ns_db gethandle]
+
+set mailbox_id [ad_get_client_property -browser t "webmail" "mailbox_id"]
+
+if { [empty_string_p $mailbox_id] } {
+    # Select the default mailbox.
+    set mailbox_id [database_to_tcl_string_or_null $db "select mailbox_id
+from wm_mailboxes
+where creation_user = $user_id
+and name = 'INBOX'"]
+    if { $mailbox_id == "" } {
+	ad_return_warning "No Account" "You have not been set up with an email account
+on this system. Please contact the system administrator to hook you up and try again."
+	return
+    }
+    ad_set_client_property -browser t "webmail" "mailbox_id" $mailbox_id
+    set mailbox_name "INBOX"
+} else {
+    # Check to see if this user actually owns this mailbox.
+    set selection [ns_db 0or1row $db "select name as mailbox_name
+from wm_mailboxes
+where mailbox_id = $mailbox_id
+  and creation_user = $user_id"]
+    if { $selection == "" } {
+	ad_return_error "Permission Denied" "You do not have permission to access this mailbox."
+	ns_log Notice "WEBMAIL WARNING: user $user_id attempted to access mailbox $mailbox_id"
+	return
+    } else {
+	set_variables_after_query
+    }
+}
+
+
+# Options for folder selection.
+set folder_select_options [db_html_select_value_options $db "select mailbox_id, name
+from wm_mailboxes
+where creation_user = $user_id" $mailbox_id]
+
+# Last days selection.
+
+set days_url_list [list]
+
+set possible_days [list 1 2 7 30 0]
+foreach day $possible_days {
+    set day_display [ad_decode $day 0 "all" $day]
+
+    if { $day == $last_n_days } {
+	lappend days_url_list $day_display
+    } else {
+	lappend days_url_list "<a href=\"summary?last_n_days=$day\">$day_display</a>"
+    }
+}
+set day_selection_list "<font size=-1>\[ [join $days_url_list " | "] \]</font>"
+
+
+# Number of messages unread/deleted/total
+if { $last_n_days == 0 } {
+    set count_query "select sum((case when seen_p = 'f' then 1 else 0 end)) as n_unread, sum((case when deleted_p = 't' then 1 else 0 end)) as n_deleted, sum(1) as n_total
+from wm_message_mailbox_map
+where mailbox_id = $mailbox_id"
+} else {
+    set count_query "select sum((case when seen_p = 'f' then 1 else 0 end)) as n_unread, sum((case when deleted_p = 't' then 1 else 0 end)) as n_deleted, sum(1) as n_total
+from wm_message_mailbox_map mmm, wm_headers h
+where  mailbox_id = $mailbox_id
+and mmm.msg_id = h.msg_id
+and h.lower_name = 'date'
+and h.time_value > sysdate() - $last_n_days"
+}
+
+set selection [ns_db 1row $db $count_query]
+set_variables_after_query
+
+# Author summary
+if { $last_n_days == 0 } {
+    set selection [ns_db select $db "select value as author, count(*) as n_messages
+from wm_headers h, wm_message_mailbox_map mmm
+where lower_name = 'from'
+  and h.msg_id = mmm.msg_id
+  and mmm.mailbox_id = $mailbox_id
+  and mmm.deleted_p = 'f'
+group by value
+order by 2 desc, value"]
+} else {
+    set selection [ns_db select $db "select h1.value as author, count(*) as n_messages
+from wm_headers h1, wm_headers h2, wm_message_mailbox_map mmm
+where h1.lower_name = 'from'
+  and h2.lower_name = 'date'
+  and h1.msg_id = h2.msg_id
+  and h2.time_value > sysdate() - $last_n_days
+  and h1.msg_id = mmm.msg_id
+  and mmm.mailbox_id = $mailbox_id
+  and mmm.deleted_p = 'f'
+group by h1.value
+order by 2 desc, h1.value"]
+}
+
+set author_summary ""
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append author_summary "<input type=checkbox name=\"author\" value=\"[philg_quote_double_quotes $author]\"> $n_messages: <a href=\"filter-add?filter_type=author&filter_term=[ns_urlencode $author]\">[philg_quote_double_quotes $author]</a></font><br>\n"
+}
+
+# Recipient Summary
+if { $last_n_days == 0 } {
+    set selection [ns_db select $db "select email, count(*) as n_messages
+from wm_recipients r, wm_message_mailbox_map mmm
+where r.msg_id = mmm.msg_id
+  and mmm.mailbox_id = $mailbox_id
+  and mmm.deleted_p = 'f'
+group by email
+order by 2 desc, email"]
+} else {
+    set selection [ns_db select $db "select email, count(*) as n_messages
+from wm_recipients r, wm_headers h, wm_message_mailbox_map mmm
+where h.lower_name = 'date'
+  and r.msg_id = h.msg_id
+  and h.time_value > sysdate() - $last_n_days
+  and r.msg_id = mmm.msg_id
+  and mmm.mailbox_id = $mailbox_id
+  and mmm.deleted_p = 'f'
+group by email
+order by 2 desc, email"]
+}
+
+set recipient_summary ""
+
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    append recipient_summary "<li>$n_messages: <a href=\"filter-add?filter_type=recipient&filter_term=[ns_urlencode $email]\">[philg_quote_double_quotes $email]</a>\n"
+}
+
+
+ns_db releasehandle $db
+
+if { $last_n_days == 0 } {
+    set title "$mailbox_name Summary: All Messages"
+} elseif { $last_n_days == 1 } {
+    set title "$mailbox_name Summary: Last 24 Hours"
+} else {
+    set title "$mailbox_name Summary: Last $last_n_days Days"
+}
+
+
+ns_return 200 text/html "[ad_header $title]
+
+<h2>$title</h2>
+
+ [ad_context_bar_ws [list "index.tcl" "WebMail"] "Summary"]
+
+<hr>
+<table width=100%>
+<tr><td align=right>$day_selection_list</td></tr>
+</table>
+
+<form action=\"folder-move-to\">
+[export_form_vars last_n_days]
+<input type=hidden name=return_url value=\"summary.tcl\">
+[export_form_vars last_n_days]
+<font size=-1>
+<select name=mailbox_id>
+$folder_select_options
+</select>
+<input type=submit value=\"Go\">
+</font>
+</form>
+
+<blockquote>
+<table border=0>
+<tr><td>Unread: <td align=right>$n_unread</tr>
+<tr><td>Deleted: <td align=right>$n_deleted</tr>
+<tr><td>Total: <td align=right>$n_total</tr>
+</table>
+</blockquote>
+
+<h3>Authors</h3>
+<blockquote>
+<form action=author-delete method=POST>
+[export_form_vars last_n_days]
+<input type=submit value=\"Delete Marked Messages\">
+<p>
+$author_summary
+</form>
+</blockquote>
+
+<h3>Recipients</h3>
+
+<ul>
+$recipient_summary
+</ul>
+
+
+[ad_footer]
+"
Index: web/openacs/www/webmail/java/Makefile
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/java/Makefile,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/java/Makefile	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,46 @@
+
+
+
+FIND		= find
+IDL2JAVA	= idltojava -fno-cpp -fno-tie
+JAR		= jar
+JAVA		= java
+JAVAC		= javac -g
+JAVADOC		= javadoc
+RM		= rm -f
+TOUCH		= touch
+
+# This defines how to compile a java class
+.java.class:
+	$(JAVAC) $<
+
+.SUFFIXES:	.class .java .c
+
+OBJ = 	acspg/BLOB.class \
+	acspg/CLOB.class \
+	acspg/BlobDataSource.class \
+	acspg/ClobDataSource.class \
+	acspg/AttachmentsIter.class \
+	acspg/HeadersIter.class \
+	acspg/Pg_Query.class \
+	acspg/ClobOutputStream.class \
+	MessageComposer.class \
+	MessageParser.class 
+
+all: $(OBJ)
+
+# This rule removes any temporary and compiled files from the source tree.
+clean:
+	$(FIND) . -name "*~" -exec $(RM) {} \;
+	$(FIND) . -name "*.class" -exec $(RM) {} \;
+
+acspg/BLOB.class:    		acspg/BLOB.java 
+acspg/CLOB.class:    		acspg/CLOB.java 
+acspg/BlobDataSource.class:    	acspg/BlobDataSource.java 
+acspg/ClobDataSource.class:    	acspg/ClobDataSource.java 
+acspg/AttachmentsIter.class:    acspg/AttachmentsIter.java 
+acspg/HeadersIter.class:    	acspg/HeadersIter.java 
+acspg/Pg_Query.class:    	acspg/Pg_Query.java 
+acspg/ClobOutputStream.class:   acspg/ClobOutputStream.java 
+MessageComposer.class:    	MessageComposer.java 
+MessageParser.class:    	MessageParser.java
Index: web/openacs/www/webmail/java/MessageComposer.java
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/java/MessageComposer.java,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/java/MessageComposer.java	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,173 @@
+// MessageComposer.sqlj
+// part of the webmail ACS module
+// written by Jin Choi <jsc@arsdigita.com>
+// 2000-03-01
+// ported to openacs by Dan Wickstrom <danw@rtp.ericsson.se>
+// 2000-06-18
+
+
+// This class implements some static methods for composing MIME messages.
+
+
+
+import java.sql.*;
+import java.io.*;
+import javax.mail.*;
+import javax.mail.internet.*;
+import java.util.*;
+import javax.activation.*;
+import acspg.*;
+import nsjava.*;
+
+
+public class MessageComposer {
+    
+    private   static boolean    runningOutsideOracleP = false;
+    private          Pg_Query   st;	
+    private   static NsLog      log;
+    protected static Session    s = null;
+
+    
+    public MessageComposer(String args[]) 
+        throws ClassNotFoundException, FileNotFoundException, IOException, 
+               SQLException, Throwable
+    {
+        int    id      = (new Integer(args[0])).intValue();
+        String tmpfile = args[1];
+
+	try {
+
+	    log.write("Debug","Connected.");
+            st = new Pg_Query("subquery");
+
+	    composeMimeMessage(id,tmpfile);
+            st.releasehandle();
+	    
+	} catch (Exception e) { 
+	    log.write("Debug", "Error running the example: " + e.getMessage());
+	    e.printStackTrace();
+	}
+    }
+
+
+    public void composeMimeMessage(int msgId, String tmpfile)
+	throws MessagingException, IOException, SQLException, Throwable
+    {
+	Vector parts    = new Vector(); // vector of data handlers
+	CLOB   bodyText = null;
+        String str;
+
+        str = this.st.databaseToJavaString("select body from wm_outgoing_messages where outgoing_msg_id = " + msgId);
+
+        bodyText = new CLOB(str);
+	
+	if (bodyText != null && bodyText.length() > 0) {
+	    ClobDataSource cds = new ClobDataSource(bodyText, "text/plain", null);
+	    parts.addElement(new DataHandler(cds));
+	}
+        log.write("Debug", "adding attachments");
+		
+	AttachmentsIter attIter = new AttachmentsIter(st,"select lob, content_type, filename from wm_outgoing_message_parts where outgoing_msg_id = " + msgId + " order by sort_order");
+        log.write("Debug", "adding attachments datasource");
+
+	while (attIter.next(st)) {
+	    BlobDataSource bds = new BlobDataSource(attIter.data(st), attIter.content_type(), attIter.filename());
+	    parts.addElement(new DataHandler(bds));
+	}
+	attIter.close();
+        log.write("Debug", "attachments added");
+	
+	// Create new MimeMessage.
+	if (s == null) {
+	    Properties props = new Properties();
+	    s = Session.getDefaultInstance(props, null);
+            log.write("Debug", "obtained session props");
+	}
+	
+	MimeMessage msg = new MimeMessage(s);
+
+	// Add the headers.
+        log.write("Debug", "db handle prior to headersiter: " + st.getPointer());
+	HeadersIter hIter = new HeadersIter(st,"select name, value from wm_outgoing_headers where outgoing_msg_id = " + msgId + " order by sort_order");
+	while (hIter.next(st)) {
+            log.write("Debug", "writing header");
+	    msg.addHeader(hIter.name(), hIter.value());
+	}
+	hIter.close();
+
+	// Add the attachments.
+        log.write("Debug", "adding parts");
+	addParts(msg, parts);
+
+	// Synchronize the headers to reflect the contents.
+        log.write("Debug", "saving changes");
+	msg.saveChanges();
+
+        OutputStream os = new FileOutputStream(tmpfile);
+
+        // move the message into the blob
+        log.write("Debug", "writing to tmpfile:" + tmpfile);
+        msg.writeTo(os);
+    }
+
+    protected void addParts(MimeMessage msg, Vector parts)
+	throws MessagingException, IOException 
+    {
+	
+	if (parts.size() == 0) {
+	    // This should never happen.
+	    return;
+	}
+
+	if (parts.size() > 1) {
+	    MimeMultipart msgMultiPart = new MimeMultipart();
+	    Enumeration e = parts.elements();
+	
+	    while (e.hasMoreElements()) {
+		DataHandler dh = (DataHandler) e.nextElement();
+		String filename = dh.getName();
+		MimeBodyPart bp = new MimeBodyPart();
+		bp.setDataHandler(dh);
+		if (filename != null) {
+		    bp.setFileName(dh.getName());
+		}
+		msgMultiPart.addBodyPart(bp);
+	    }
+	    msg.setContent(msgMultiPart);
+	} else {
+	    // There is only one element.
+	    DataHandler dh = (DataHandler) parts.elementAt(0);
+	    String filename = dh.getName();
+	    if (filename != null) {
+		msg.setFileName(dh.getName());
+	    }
+	    msg.setDataHandler(dh);
+	}
+    }
+
+    public static void instructions()
+    {
+        log.write("Debug", "\nThis example tests the basic webmail message parsing\n");
+        log.write("Debug", "Useage:\n java MessageComposer jdbc:postgresql:database user password msg_id tmpfile [debug]\n\nThe debug field can be anything. It's presence will enable DriverManager's\ndebug trace. Unless you want to see screens of items, don't put anything in\nhere.");
+        //        System.exit(1);
+    }
+
+    public static void compose_message(String args[]) throws  Throwable
+    {
+        log = new NsLog();
+        log.write("Debug", "openacs test of webmail port\n");
+    
+        if(args.length<2) {
+            instructions();
+            return;
+        }
+        
+        // Now run the message composer
+        try {
+            MessageComposer composer = new MessageComposer(args);
+        } catch(Exception ex) {
+            log.write("Debug", "Exception caught.\n"+ex);
+            ex.printStackTrace();
+        }
+    }
+}
Index: web/openacs/www/webmail/java/MessageParser.java
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/java/MessageParser.java,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/java/MessageParser.java	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,518 @@
+// MessageParser.sqlj
+// part of the webmail ACS module
+// written by Jin Choi <jsc@arsdigita.com>
+// 2000-03-01
+// ported to openacs by Dan Wickstrom <danw@rtp.ericsson.se>
+// 2000-06-18
+
+// This class provides some static methods for parsing RFC822 messages
+// into a Postgresql database.
+
+
+import java.sql.*;
+import java.io.*;
+import javax.mail.*;
+import javax.mail.internet.*;
+import java.util.*;
+import java.text.DateFormat;
+import java.text.ParseException;
+import acspg.*;
+import nsjava.*;
+
+
+public class MessageParser {
+    
+    private   static boolean    runningOutsideOracleP = false;
+    protected static Session    s = null;
+    private   static NsLog      log;
+    private          Pg_Query   st;	
+
+    
+    public MessageParser (String qdir) throws ClassNotFoundException, FileNotFoundException, IOException, SQLException, MessagingException 
+    {
+
+	try {
+
+	    log.write("Notice", "Connected.");
+            st = new Pg_Query("subquery");
+
+	    // Set the flag to tell the system not to delete any messages
+	    // after parsing.
+	    runningOutsideOracleP = false;
+	    
+	    processQueue(qdir);
+
+	    log.write("Notice", "Parse succeeded.");
+            st.releasehandle();
+
+	} catch (Exception e) { 
+            st.releasehandle();
+	    log.write("Error", "Error running the example: " + e.getMessage());
+	    e.printStackTrace();
+	}
+    }
+    
+
+    // Process all files in a directory.
+    public  void processQueue(String queueDirectory) 
+	throws SQLException, ParseException, IOException, 
+               FileNotFoundException, MessagingException {
+	
+	// Go through all the files in the queue and attempt to parse them.
+	File qdir = new File(queueDirectory);
+	
+	String[] filenamesToProcess = qdir.list();
+	for (int i = 0; i < filenamesToProcess.length; i++) {
+
+	    File currentFile = new File(qdir, filenamesToProcess[i]);
+	    log.write("Debug", "Processing " + currentFile.getAbsolutePath());
+	    if (currentFile.isFile() == false) {
+		log.write("Debug", "Not a file!");
+		continue;
+	    }
+
+	    try {
+
+                // need to make sure that not holding a lock for parsing all
+                // of the files is o.k.  I think it was only done to act as 
+                // a kind of a mutex for detecting if the parse routine was 
+                // already running.  I've moved the locking into tcl code, so 
+                // that only one parse job can run at a time.
+                st.executeUpdate("begin transaction");
+		parseMessageFromFile(currentFile);
+		if (runningOutsideOracleP == false) {
+
+                    st.executeUpdate("commit");
+		    currentFile.delete();
+		}
+                else {
+                    st.executeUpdate("rollback transaction");
+                }
+
+	    } catch (Exception e) {
+
+                st.executeUpdate("rollback transaction");
+                recordParseError(currentFile, e);
+	    }
+	}
+    }
+
+    protected void recordParseError(File currentFile, Exception e)
+	throws SQLException {
+
+        // We don't want to quit for parse errors.
+        Integer n_already_reported = new Integer(0);
+        String filename = currentFile.getAbsolutePath();
+
+        n_already_reported = new Integer(st.databaseToJavaString("select count(*) from wm_parse_errors where filename = '" + filename + "';"));
+
+        if (n_already_reported.intValue() == 0) {
+            String errmsg = stackTrace(e);
+
+            st.executeUpdate("insert into wm_parse_errors (filename, error_message, first_parse_attempt) values ('" + filename + "','" + errmsg + "', sysdate())");
+        }
+
+    }
+
+    // Process a single file.
+    public  void parseMessageFromFile(String filename) 
+	throws MessagingException, SQLException, FileNotFoundException, IOException, ParseException {
+	parseMessageFromFile(new File(filename));
+    }	
+
+    public  void parseMessageFromFile(File file) 
+	throws MessagingException, SQLException, FileNotFoundException, IOException, ParseException
+    {
+	// Open the file.
+	BufferedInputStream is = new BufferedInputStream(new FileInputStream(file));
+
+	// Get the headers as an enumeration of Header objects.
+	InternetHeaders ih      = new InternetHeaders(is);
+	Enumeration     headers = ih.getAllHeaders();
+
+	// Create new record in wm_messages and grab the CLOB to stuff with the body.
+	Integer msgId;
+        Integer lob_id;
+
+	log.write("Debug", "Inserting into wm_messages...");
+
+        msgId  = new Integer(st.databaseToJavaString("select nextval('wm_msg_id_sequence') from dual"));
+        lob_id = new Integer(st.databaseToJavaString("select empty_lob()"));
+        st.executeUpdate("insert into wm_message_lobs (msg_id,lob) values(" + msgId.intValue() + "," + lob_id.intValue() + ")");
+        st.executeUpdate("insert into wm_messages (msg_id,body) values(" + msgId.intValue() + "," + lob_id.intValue() + ")");        
+        BLOB body = new BLOB(lob_id,st);
+        	
+        // the blob handles inserting the string into the db.
+        is = new BufferedInputStream(new FileInputStream(file));
+	copyInputStreamToBlob(is, body);
+
+        log.write("Debug", "writing to the database");
+        body.writeToDatabase();
+
+	log.write("Debug", "done");
+
+	// Insert the headers into wm_headers.
+	insertHeaders(msgId.intValue(), headers);
+
+
+	String contentType = ih.getHeader("Content-Type", null);
+
+        if (contentType != null) {
+
+	    contentType = contentType.toLowerCase();
+	    if (true) {
+                //if (contentType.indexOf("text") == -1) {
+
+		// Reopen the file to pass to parseMIME.
+		is = new BufferedInputStream(new FileInputStream(file));
+		
+		// If message is a MIME message and is not plain text, save
+		// text to wm_messages.mime_text and save attachments to directory.
+		parseMIME(msgId.intValue(), is);
+	    }
+	}
+
+	// "Deliver" the message by inserting into wm_message_mailbox_map.
+        log.write("Debug", "delivering the message");
+	deliverMessage(msgId.intValue(), ih.getHeader("Delivered-To", null));
+    }
+
+    private  void insertHeaders(int msgId, Enumeration headers)
+	throws SQLException, ParseException {
+	int sortOrder = 0;
+	boolean receivedSeenP = false;
+	
+	while (headers.hasMoreElements()) {
+
+	    Header h = (Header) headers.nextElement();
+	    String name = h.getName(); 
+	    String lowerName = name.toLowerCase();
+	    String value = h.getValue();
+	    
+	    if ((lowerName.equals("from") || lowerName.equals("return-path")) && value.length() > 0) {
+
+		try {
+		    // Stuff email_value and name_value fields.
+		    InternetAddress[] addresses = InternetAddress.parse(value);
+		    String email = addresses[0].getAddress();
+		    String fullName = addresses[0].getPersonal();
+		    
+                    st.executeUpdate("INSERT INTO wm_headers (msg_id, name, lower_name, value, email_value, name_value, sort_order) VALUES (" + msgId + ",'" + name + "','" + lowerName + "','" + value + "','" + email + "','" + fullName + "'," + sortOrder + ")");
+		} catch (AddressException ae) {
+		    // Couldn't parse it as an address; just store the value.
+                    st.executeUpdate("INSERT INTO wm_headers (msg_id, name, lower_name, value, sort_order) VALUES (" + msgId + ",'" + name + "','" + lowerName + "','" + value + "'," + sortOrder + ")");
+		}
+
+	    } else if (lowerName.equals("date") && value.length() > 0) {
+		// Stuff date values into date_value field.
+		try {
+		    Timestamp d = parseDate(value);
+                    st.executeUpdate("INSERT INTO wm_headers (msg_id, name, lower_name, value, time_value, sort_order) VALUES (" + msgId + ",'" + name + "','" + lowerName + "','" + value + "','" + d + "'," + sortOrder + ")");
+		} catch (Exception pe) {
+                    st.executeUpdate("INSERT INTO wm_headers (msg_id, name, lower_name, value, sort_order) VALUES (" + msgId + ",'" + name + "','" + lowerName + "','" + value + "','" + sortOrder + ")");
+		}
+	    } else if (lowerName.equals("received") && !receivedSeenP) {
+		// Only parse the first Received header, the one qmail tacked on.
+		// Others will often be nastily formatted.
+		receivedSeenP = true;
+		String timestamp = value.substring(value.lastIndexOf(";") + 1);
+
+		try {
+		    Timestamp d = parseDate(timestamp);
+                    st.executeUpdate("INSERT INTO wm_headers (msg_id, name, lower_name, value, time_value, sort_order) VALUES (" + msgId + ",'" + name + "','" + lowerName + "','" + value + "','" + d + "'," + sortOrder + ")");
+		} catch (Exception pe) {
+		}
+	    } else {
+		if (lowerName.equals("message-id") && value.length() > 0) {
+                    st.executeUpdate("UPDATE wm_messages SET message_id = '" + value + "' WHERE msg_id = " + msgId); 
+		}
+
+		// Random headers (most likely the "To" field) may be >4000 
+                // bytes.  Truncate if so.
+		String insertValue = value;
+		if (value.length() > 4000) {
+		    insertValue = value.substring(0, 4000);
+		}
+                st.executeUpdate("INSERT INTO wm_headers (msg_id, name, lower_name, value, sort_order) VALUES (" + msgId + ",'" + name + "','" +  lowerName + "','" + insertValue + "'," +  sortOrder + ")");
+
+	    }
+
+	    // If this is a recipient field, then parse it and insert it into recipients.
+	    if (lowerName.equals("to") || lowerName.equals("cc")) {
+		try {
+		    InternetAddress[] recipients = InternetAddress.parse(value);
+		    
+		    for (int i = 0; i < recipients.length; i++) {
+			InternetAddress recipient = recipients[i];
+			String email = recipient.getAddress();
+			String fullName = recipient.getPersonal();
+                        st.executeUpdate("INSERT INTO wm_recipients (msg_id, header, email, name) VALUES (" + msgId + ",'" +  name + "','" + email + "','" +  fullName + "')");
+		    }
+		} catch (Exception e) {
+		    // do nothing
+		}
+	    }
+
+	    sortOrder++;
+	}
+
+    }
+
+    // Map recipient to ACS user and insert row for that user's INBOX.
+    private  void deliverMessage(int msgId, String lastDeliveredTo)
+	throws SQLException {
+	
+	if (lastDeliveredTo != null) {
+
+            st.executeUpdate("insert into wm_message_mailbox_map (msg_id, mailbox_id) " + 
+                             "select " + msgId + ", mailbox_id " + 
+                               "from wm_email_user_map eum, wm_domains d, wm_mailboxes m " +
+                              "where d.short_name = eum.domain " + 
+                                "and m.name = 'INBOX' " + 
+                                "and m.creation_user = eum.user_id " + 
+                                "and 'webmail-' || eum.domain || '-' || email_user_name || '@' || d.full_domain_name = '" + lastDeliveredTo + "'");
+	}
+    }
+
+
+    // Utility procedure to write an InputStream to a CLOB.
+    protected  void copyInputStreamToClob(InputStream is, CLOB to) 
+	throws IOException, SQLException {
+	OutputStream os = to.getAsciiOutputStream();
+	int chunk = to.getChunkSize();
+	byte[] copyBuffer = new byte[chunk];
+
+	int bytesRead = 0;
+
+	log.write("Debug", "Entering copyInputStreamToClob");
+
+	while ((bytesRead = is.read(copyBuffer)) > 0) {
+	    os.write(copyBuffer, 0, bytesRead);
+	    log.write("Debug", "wrote " + bytesRead + " bytes");
+	}
+        log.write("Debug", "done copying");
+	os.flush();
+	os.close();
+	is.close();
+        log.write("Debug", "exiting copyInputStreamToClob");
+    }
+
+    // Same, for BLOBs.
+    public  void copyInputStreamToBlob(InputStream is, BLOB to) 
+	throws IOException, SQLException {
+	OutputStream os         = to.getBinaryOutputStream();
+	int          chunk      = to.getChunkSize();
+	byte[]       copyBuffer = new byte[chunk];
+	int          bytesRead;
+
+	log.write("Debug", "Entering copyInputStreamToBlob");
+	while ((bytesRead = is.read(copyBuffer)) > 0) {
+	    os.write(copyBuffer, 0, bytesRead);
+	}
+	os.flush();
+	os.close();
+	is.close();
+    }
+
+
+    // Utility procedure for parsing timestamps. Java date parsing
+    // wayyyy sucks; this is the simplest method that seems to work
+    // most of the time.
+    public  Timestamp parseDate(String s)
+	throws ParseException {
+	// This DateFormat stuff doesn't work so great.
+	// DateFormat df = DateFormat.getDateTimeInstance(DateFormat.MEDIUM,
+	//					       DateFormat.FULL);
+	log.write("Debug", "Attempting to parse date: " + s);
+	return new java.sql.Timestamp(Timestamp.parse(s));
+    }
+
+
+    // Parses a MIME message, inserts text into wm_messages.mime_text, and unpacks
+    // attachments into wm_attachments.
+    public  void parseMIME(int msgId, InputStream is) 
+	throws MessagingException, SQLException, IOException
+    {
+
+	// Parse the message.
+	if (s == null) {
+	    Properties props = new Properties();
+	    s = Session.getDefaultInstance(props, null);
+	}
+	MimeMessage msg = new MimeMessage(s, is);
+	is.close();
+
+	log.write("Debug", "Message type is " + msg.getContentType());
+
+	// Buffer we're going to store up text bits in.
+	StringBuffer text = new StringBuffer();
+
+	// Wrap partNumber in an array so we can pass by reference.
+	int[] partNumber = new int[1];
+	partNumber[0] = 0;
+
+        try {
+            dumpPart(msgId, msg, text, partNumber);
+        } catch (Exception e) {
+	    // If dumpPart fails, then just treat the message as text.
+	    return;
+        }
+	    
+	String textStr = text.toString();
+        //        System.out.println("text = " + textStr);
+
+	//System.out.println("Parsed MIME text is:\n" + textStr);
+	
+	if (textStr.length() > 0) {
+            
+	    BLOB mimeText = null;
+	    ByteArrayInputStream sbis = new ByteArrayInputStream(textStr.getBytes());
+            Integer lob_id = new Integer(st.databaseToJavaString("select empty_lob()"));
+            mimeText = new BLOB(lob_id,st);
+            log.write("Debug", "lob id = " + lob_id + ", msg id = " + msgId);
+            st.executeUpdate("insert into wm_message_lobs (lob,msg_id) values(" + lob_id + "," + msgId + ")");
+            st.executeUpdate("update wm_messages set mime_text = " + lob_id + " where msg_id = " + msgId);
+	    copyInputStreamToBlob(sbis, mimeText);
+            mimeText.writeToDatabase();
+	}
+    }
+
+    // Writes text representation of part to text buffer and saves
+    // attachment data to wm_attachments. partNumber is for creating
+    // unique identifiers if filename is not specified in the part.
+
+    protected  void dumpPart(int msgId, Part p, StringBuffer text, int[] partNumber)
+	throws MessagingException, SQLException, IOException
+    {
+	
+	Object o = p.getContent();
+
+	log.write("Debug", "Part is " + o.getClass().getName());
+
+	if (o instanceof java.lang.String) {
+            //System.out.println("the string = " + o);
+	    text.append(o);
+	    return;
+	}
+
+	if (o instanceof javax.mail.Multipart) {
+	    Multipart mp = (Multipart) o;
+	    int count = mp.getCount();
+	    for (int i = 0; i < count; i++) {
+		dumpPart(msgId, mp.getBodyPart(i), text, partNumber);
+	    }
+	    return;
+	}
+	
+	if (o instanceof javax.mail.internet.MimeMessage) {
+	    MimeMessage msg = (MimeMessage) o;
+	    text.append('\n');
+	    Enumeration e = msg.getAllHeaderLines();
+	    while (e.hasMoreElements()) {
+		String line = (String) e.nextElement();
+		text.append(line);
+		text.append('\n');
+	    }
+	    dumpPart(msgId, msg, text, partNumber);
+	    return;
+	}
+
+	if (o instanceof java.io.InputStream ) {
+	    InputStream is = (InputStream) o;
+	    
+	    String filename = null;
+	    try {
+		filename = p.getFileName();
+	    } catch (MessagingException mex) {
+		// System.out.println(mex.getMessage());
+	    }
+            log.write("Debug", "filename = " + filename);
+	    
+	    if (filename == null || filename.length() == 0) {
+		filename = "" + partNumber[0]++;
+	    }
+	    
+	    // Write out place holders for links.
+	    if (p.isMimeType("image/*")) {
+		text.append("##wm_image: " + filename + "\n");
+	    } else {
+		text.append("##wm_part: " + filename + "\n");
+	    }
+	    
+	    String contentType = p.getContentType();
+	    // use only primary type and sub type
+	    int firstSemicolonLocation = contentType.indexOf(";");
+	    if (firstSemicolonLocation != -1) {
+		contentType = contentType.substring(0, firstSemicolonLocation);
+	    }
+	    
+            try {
+                st.executeUpdate("insert into wm_attachments (msg_id, filename, content_type, lob) values (" + msgId + ",'" + filename + "','" + contentType + "', empty_lob())");
+                Integer data = new Integer(st.databaseToJavaString("select lob from wm_attachments where msg_id = " + msgId + " and filename = '" + filename + "'"));
+                
+                BLOB b = new BLOB(data,st);
+                copyInputStreamToBlob(is, b);
+                b.writeToDatabase();      
+                try {
+                    b.finalize();
+                } catch (Throwable t) {
+                    throw new SQLException("temp file cleanup error: " + t.getMessage());
+                }
+
+            } catch (SQLException e) {
+		if (e.getErrorCode() == 1) { // Unique constraint violated.
+		    // Most likely, filename was same as another filename 
+                    // in the message.  Append number to it and try again.
+		    filename += " (" + partNumber[0]++ + ")";
+                    st.executeUpdate("insert into wm_attachments (msg_id, filename, content_type, lob) values (" + msgId + ",'" + filename + "','" + contentType + "', empty_lob())");
+                    Integer data = new Integer(st.databaseToJavaString("select lob from wm_attachments where msg_id = " + msgId + " and filename = '" + filename + "'"));
+                
+                    BLOB b = new BLOB(data,st);
+                    copyInputStreamToBlob(is, b);
+                    b.writeToDatabase();      
+                    try {
+                        b.finalize();
+                    } catch (Throwable t) {
+                        throw new SQLException("temp file cleanup error: " + t.getMessage());
+                    }
+
+		} else {
+		    throw(e);
+		}
+
+            }
+	}
+    }
+
+    // Utility method to return stack trace from an Exception.
+    public String stackTrace(Exception e) {
+	CharArrayWriter caw = new CharArrayWriter();
+	PrintWriter pw = new PrintWriter(caw);
+	e.printStackTrace(pw);
+	pw.flush();
+	return caw.toString();
+    }
+    public static void instructions()
+    {
+        log.write("Debug", "\nThis example tests the basic webmail message parsing\n");
+        log.write("Debug", "Useage:\n java MessageParser jdbc:postgresql:database user password [debug]\n\nThe debug field can be anything. It's presence will enable DriverManager's\ndebug trace. Unless you want to see screens of items, don't put anything in\nhere.");
+        System.exit(1);
+    }
+
+    public static void process_queue(String args[])
+    {
+        String queueDir = args[0] + "/new";
+
+        log = new NsLog();
+        log.write("Debug", "openacs test of webmail port\n");
+        
+        // Now run the parser
+        try {
+            MessageParser parser = new MessageParser(queueDir);
+            log.write("Debug", "done parsing in process_queue");
+        } catch(Exception ex) {
+            log.write("Error", "Exception caught.\n"+ex);
+            ex.printStackTrace();
+        }
+    }
+}
Index: web/openacs/www/webmail/java/connect.properties
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/java/connect.properties,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/java/connect.properties	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,12 @@
+# Example connect.properties file for debugging outside of Oracle.
+
+# Users should uncomment one of the following URLs or add their own. 
+#sqlj.url=jdbc:oracle:thin:@localhost:1521:orcl
+#sqlj.url=jdbc:oracle:oci8:@
+#sqlj.url=jdbc:oracle:oci7:@
+ 
+sqlj.url=jdbc:oracle:oci8:@
+
+# User name and password here 
+sqlj.user=webmailuser
+sqlj.password=xxx
Index: web/openacs/www/webmail/java/export-msg.pl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/java/export-msg.pl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/java/export-msg.pl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,44 @@
+#!/usr/local/bin/perl
+
+# Useful little script to dump a message to a file for debugging.
+
+use DBI;
+use DBD::Oracle;
+use strict;
+
+
+if (scalar(@ARGV) != 1) {
+  die "Usage: $0 msg_id\n";
+}
+
+my $msg_id = $ARGV[0];
+
+my $dbh = DBI->connect("dbi:Oracle:", 'wmail/wmailsucks', '') || die $DBI::errstr;
+
+$dbh->{RaiseError} = 1;
+$dbh->{LongReadLen} = 10000000;
+my $sth = $dbh->prepare("select name || ': ' || value 
+from wm_headers
+where msg_id = $msg_id");
+
+$sth->execute;
+
+while (my @row = $sth->fetchrow()) {
+  print "$row[0]\n";
+}
+print "\n";
+
+$sth->finish;
+
+$sth = $dbh->prepare("select body
+from wm_messages
+where msg_id = $msg_id");
+
+$sth->execute;
+
+my @row = $sth->fetchrow();
+
+print $row[0];
+
+$sth->finish;
+$dbh->disconnect;
Index: web/openacs/www/webmail/java/acspg/AsciiOutputStream.java
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/java/acspg/AsciiOutputStream.java,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/java/acspg/AsciiOutputStream.java	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,136 @@
+/*
+ * @(#)FilterOutputStream.java	1.16 98/07/01
+ *
+ * Copyright 1995-1998 by Sun Microsystems, Inc.,
+ * 901 San Antonio Road, Palo Alto, California, 94303, U.S.A.
+ * All rights reserved.
+ * 
+ * This software is the confidential and proprietary information
+ * of Sun Microsystems, Inc. ("Confidential Information").  You
+ * shall not disclose such Confidential Information and shall use
+ * it only in accordance with the terms of the license agreement
+ * you entered into with Sun.
+ */
+
+package acspg;
+import java.io.*;
+
+
+public
+class AsciiOutputStream extends OutputStream {
+    /**
+     * The underlying output stream. 
+     *
+     * @since   JDK1.0
+     */
+    protected OutputStream out;
+
+    /**
+     * Creates an output stream filter built on top of the specified 
+     * underlying output stream. 
+     *
+     * @param   out   the underlying output stream.
+     * @since   JDK1.0
+     */
+    public AsciiOutputStream(OutputStream out) {
+	this.out = out;
+    }
+
+    /**
+     * Writes the specified <code>byte</code> to this output stream. 
+     * <p>
+     * The <code>write</code> method of <code>FilterOutputStream</code> 
+     * calls the <code>write</code> method of its underlying output stream. 
+     *
+     * @param      b   the <code>byte</code>.
+     * @exception  IOException  if an I/O error occurs.
+     * @since      JDK1.0
+     */
+    public void write(int b) throws IOException {
+	out.write(b);
+    }
+
+    /**
+     * Writes <code>b.length</code> bytes to this output stream. 
+     * <p>
+     * The <code>write</code> method of <code>FilterOutputStream</code> 
+     * calls its <code>write</code> method of three arguments with the 
+     * arguments <code>b</code>, <code>0</code>, and 
+     * <code>b.length</code>. 
+     * <p>
+     * Note that this method does not call the one-argument 
+     * <code>write</code> method of its underlying stream with the single 
+     * argument <code>b</code>. 
+     *
+     * @param      b   the data to be written.
+     * @exception  IOException  if an I/O error occurs.
+     * @see        java.io.FilterOutputStream#write(byte[], int, int)
+     * @since      JDK1.0
+     */
+    public void write(byte b[]) throws IOException {
+	write(b, 0, b.length);
+    }
+
+    /**
+     * Writes <code>len</code> bytes from the specified 
+     * <code>byte</code> array starting at offset <code>off</code> to 
+     * this output stream. 
+     * <p>
+     * The <code>write</code> method of <code>FilterOutputStream</code> 
+     * calls the <code>write</code> method of one argument on each 
+     * <code>byte</code> to output. 
+     * <p>
+     * Note that this method does not call the <code>write</code> method 
+     * of its underlying input stream with the same arguments. Subclasses 
+     * of <code>FilterOutputStream</code> should provide a more efficient 
+     * implementation of this method. 
+     *
+     * @param      b     the data.
+     * @param      off   the start offset in the data.
+     * @param      len   the number of bytes to write.
+     * @exception  IOException  if an I/O error occurs.
+     * @see        java.io.FilterOutputStream#write(int)
+     * @since      JDK1.0
+     */
+    public void write(byte b[], int off, int len) throws IOException {
+	for (int i = 0 ; i < len ; i++) {
+	    out.write(b[off + i]);
+	}
+    }
+
+    /**
+     * Flushes this output stream and forces any buffered output bytes 
+     * to be written out to the stream. 
+     * <p>
+     * The <code>flush</code> method of <code>FilterOutputStream</code> 
+     * calls the <code>flush</code> method of its underlying output stream.
+     *
+     * @exception  IOException  if an I/O error occurs.
+     * @see        java.io.FilterOutputStream#out
+     * @since      JDK1.0
+     */
+    public void flush() throws IOException {
+	out.flush();
+    }
+
+    /**
+     * Closes this output stream and releases any system resources 
+     * associated with the stream. 
+     * <p>
+     * The <code>close</code> method of <code>FilterOutputStream</code> 
+     * calls its <code>flush</code> method, and then calls the 
+     * <code>close</code> method of its underlying output stream. 
+     *
+     * @exception  IOException  if an I/O error occurs.
+     * @see        java.io.FilterOutputStream#flush()
+     * @see        java.io.FilterOutputStream#out
+     * @since      JDK1.0
+     */
+    public void close() throws IOException {
+	try {
+	  flush();
+	} catch (IOException ignored) {
+	}
+	out.close();
+    }
+}
Index: web/openacs/www/webmail/java/acspg/AttachmentsIter.java
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/java/acspg/AttachmentsIter.java,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/java/acspg/AttachmentsIter.java	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,68 @@
+package acspg;
+
+import java.sql.*;
+import java.io.*;
+import javax.mail.*;
+import javax.mail.internet.*;
+import java.util.*;
+import javax.activation.*;
+import nsjava.*;
+
+
+public class AttachmentsIter {
+
+    NsSet     rs;
+    Integer   col_data;
+    Integer   col_ct;
+    Integer   col_fn;
+    Integer   data;
+    String    content_type;
+    String    filename;
+
+    public AttachmentsIter(Pg_Query st, String query) throws SQLException {
+
+        this.rs    = st.select(query);
+
+        if(this.rs != null) {
+            this.col_data = this.rs.find("lob");
+            this.col_ct   = this.rs.find("content_type");
+            this.col_fn   = this.rs.find("filename");
+        }
+    }
+
+    public boolean next(Pg_Query st) throws SQLException 
+    {
+        if(this.rs != null) {
+            if(st.getrow(this.rs) == true) {
+                this.data         = new Integer(this.rs.value(this.col_data));
+                this.content_type = this.rs.value(this.col_ct);
+                this.filename     = this.rs.value(this.col_fn);
+                return true;
+            }
+        }
+
+        return false;
+    }
+
+    public BLOB data(Pg_Query st) throws SQLException, IOException {
+
+        BLOB b = new BLOB(this.data.intValue(),st);
+        b.readFromDatabase();
+        return b;
+    }
+
+    public String content_type() {
+
+        return this.content_type;
+    }
+
+    public String filename() {
+
+        return this.filename;
+    }
+
+    public void close() throws SQLException {
+
+        this.rs.free();
+    }
+}
Index: web/openacs/www/webmail/java/acspg/BLOB.java
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/java/acspg/BLOB.java,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/java/acspg/BLOB.java	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,132 @@
+
+
+package acspg;
+
+import java.sql.*;
+import java.io.*;
+import java.util.*;
+import java.lang.*;
+import nsjava.*;
+
+public class BLOB extends Object {
+
+    final private int       chunk_size = 1024;
+    final private String    tmpdir     = "/tmp";
+    private       File      data       = null;
+    private       int       lob_id;
+    private       Pg_Query  st;
+
+    public BLOB(Integer lob_id, Pg_Query st) throws SQLException {
+        this.init(lob_id.intValue(),st);
+    }
+
+    public BLOB(int lob_id, Pg_Query st) throws SQLException {
+        this.init(lob_id,st);
+    }
+
+    public BLOB(Integer lob_id, Pg_Query st, File f) 
+        throws FileNotFoundException, IOException, SQLException
+    {
+        this.init(lob_id.intValue(),st,f);
+    }
+
+    public BLOB(int lob_id, Pg_Query st, File f)
+        throws FileNotFoundException, IOException, SQLException
+    {
+        this.init(lob_id,st,f);
+    }
+
+    public void finalize() throws Throwable {
+        if(this.data != null) {
+            if(this.data.exists()) {
+                this.data.delete();
+            }
+        }
+    }
+
+    private void init(int lob_id, Pg_Query st) throws SQLException {
+        this.lob_id = lob_id;
+        this.st     = st;
+        this.data   = new File(tmpdir,newTmpName());
+     }
+
+    private void init(int lob_id, Pg_Query st, File f) 
+        throws FileNotFoundException, IOException, SQLException
+    {
+
+        this.init(lob_id,st);
+        this.data = null;
+        this.data = new File(tmpdir,newTmpName());
+        this.initDataStore(f);
+    }
+
+    private void initDataStore(File f) 
+        throws FileNotFoundException, IOException 
+    {
+        FileInputStream  fis        = new FileInputStream(f);
+        FileOutputStream fos        = new FileOutputStream(this.data);
+        byte[]           copybuffer = new byte[1024];
+        int              byteRead;
+
+        while((byteRead = fis.read(copybuffer,0,1024)) > 0) {
+            fos.write(copybuffer,0,byteRead);
+        }
+
+        fis.close();
+        fos.close();
+    }
+
+    private String newTmpName() throws SQLException {
+        final String tmpname = ".pg_java_blob";
+        String i = this.st.databaseToJavaString("select nextval('wm_unique_file_id')");
+
+        return tmpname + i;
+    }
+
+    public InputStream getBinaryStream() throws SQLException 
+    {
+        if(data == null) 
+            throw new SQLException("data is null");
+        try {
+            FileInputStream buf = new FileInputStream(this.data);
+            return buf;
+        } catch (Exception e) {
+            throw new SQLException("SQL Exception caught: " + e.getMessage());
+        }
+    }
+
+    public OutputStream getBinaryOutputStream() 
+        throws SQLException, IOException {
+        if(data == null) 
+            this.data = new File(tmpdir,newTmpName());
+        return new FileOutputStream(this.data);
+    }
+
+    public long length() {
+        if(this.data == null) return 0;
+        return this.data.length();
+    }
+
+    public int getChunkSize() {
+        return this.chunk_size;
+    }
+
+    public void writeToDatabase() 
+        throws SQLException, IOException
+    {
+        NsLog log = new NsLog();
+        Integer id = new Integer(this.lob_id);
+        String filename = this.data.getAbsolutePath();
+
+        log.write("Debug", "lob_id = " + id.toString() + " filename = " + filename);
+        this.st.blob_dml_file(id.toString(), filename);
+    }
+
+    public void readFromDatabase() throws SQLException, IOException 
+    {
+
+        this.st.blob_select_file(this.lob_id, this.data.getAbsolutePath());
+    }
+}
+
+
Index: web/openacs/www/webmail/java/acspg/BlobDataSource.java
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/java/acspg/BlobDataSource.java,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/java/acspg/BlobDataSource.java	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,51 @@
+// BlobDataSource.java
+// part of the webmail ACS module
+// written by Jin Choi <jsc@arsdigita.com>
+// 2000-03-01
+
+// This class provides a wrapper for BLOBs so that we can
+// stuff them into Messages.
+
+package acspg;
+
+import javax.activation.*;
+import java.sql.*;
+import java.io.*;
+
+public class BlobDataSource implements DataSource {
+    protected BLOB blob;
+    protected String contentType;
+    protected String name;
+
+    public BlobDataSource(BLOB blob, String contentType, String name) {
+	this.blob = blob;
+	this.contentType = contentType;
+	this.name = name;
+    }
+
+    public InputStream getInputStream()
+	throws IOException {
+	try {
+	    return blob.getBinaryStream();
+	} catch (Exception e) {
+	    throw new IOException("SQL Exception caught: " + e.getMessage());
+	}
+    }
+
+    public OutputStream getOutputStream()
+	throws IOException {
+	try {
+	    return blob.getBinaryOutputStream();
+	} catch (Exception e) {
+	    throw new IOException("SQL Exception caught: " + e.getMessage());
+	}
+    }
+    
+    public String getContentType() {
+	return contentType;
+    }
+
+    public String getName() {
+	return name;
+    }
+};
Index: web/openacs/www/webmail/java/acspg/CLOB.java
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/java/acspg/CLOB.java,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/java/acspg/CLOB.java	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,59 @@
+
+
+package acspg;
+
+import javax.activation.*;
+import java.sql.*;
+import java.io.*;
+import acspg.*;
+
+public class CLOB {
+
+    private String str = null;
+    private String istr = null;
+    private Pg_Query query = null;
+
+    public CLOB() {
+        this.str = null;
+    }
+
+    public CLOB(String str) {
+        this.str = str;
+    }
+
+    public InputStream getAsciiStream() throws SQLException {
+        try {
+            ByteArrayInputStream buf = new ByteArrayInputStream(this.str.getBytes());
+            return buf;
+        } catch (Exception e) {
+            throw new SQLException("SQL Exception caught: " + e.getMessage());
+        }
+    }
+
+    public OutputStream getAsciiOutputStream() throws SQLException {
+        try {
+            ClobOutputStream buf = new ClobOutputStream(this.str,this.istr,this.query);
+            return buf;
+        } catch (IOException e) {
+            throw new SQLException("SQL Exception caught: " + e.getMessage());
+        }
+    }
+
+    public int length() {
+
+        return this.str.length();
+    }
+
+    public int getChunkSize() {
+        return 1024;
+    }
+
+    public void setInsertString(String istr) {
+        this.istr = istr;
+    }
+
+    public void setQueryObject(Pg_Query q) {
+        this.query = q;
+    }
+
+}
Index: web/openacs/www/webmail/java/acspg/ClobDataSource.java
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/java/acspg/ClobDataSource.java,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/java/acspg/ClobDataSource.java	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,48 @@
+// ClobDataSource.java
+// part of the webmail ACS module
+// written by Jin Choi <jsc@arsdigita.com>
+// 2000-03-01
+
+// This class provides a wrapper for CLOBs so that we can
+// stuff them into Messages.
+
+package acspg;
+
+import javax.activation.*;
+import java.sql.*;
+import java.io.*;
+import acspg.*;
+
+public class ClobDataSource implements DataSource {
+    protected CLOB   clob;
+    protected String contentType;
+    protected String name;
+
+    public ClobDataSource(CLOB clob, String contentType, String name) {
+	this.clob = clob;
+	this.contentType = contentType;
+	this.name = name;
+    }
+
+    public InputStream getInputStream()
+	throws IOException {
+	try {
+	    return clob.getAsciiStream();
+	} catch (Exception e) {
+	    throw new IOException("SQL Exception caught: " + e.getMessage());
+	}
+    }
+
+    public OutputStream getOutputStream()
+	throws IOException {
+        throw new IOException("cannot do this");
+    }
+    
+    public String getContentType() {
+	return contentType;
+    }
+
+    public String getName() {
+	return name;
+    }
+};
Index: web/openacs/www/webmail/java/acspg/ClobOutputStream.java
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/java/acspg/ClobOutputStream.java,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/java/acspg/ClobOutputStream.java	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,66 @@
+package acspg;
+
+import javax.activation.*;
+import java.sql.*;
+import java.io.*;
+
+
+public class ClobOutputStream extends ByteArrayOutputStream {
+
+    String isql = null;
+    Pg_Query query = null;
+
+
+    public ClobOutputStream(String str, String isql, Pg_Query q) 
+        throws IOException {
+
+        super();
+        if(str != null) 
+            this.write(str.getBytes());
+        this.isql = isql; 
+        this.query = q;
+    }
+
+    public ClobOutputStream(int i, String str, String isql, Pg_Query q) 
+        throws IOException {
+
+        super(i);
+        if(str != null) 
+            this.write(str.getBytes());
+        this.isql = isql;        
+        this.query = q;
+    }
+
+
+    public void close() 
+        throws IOException {
+
+        try {
+
+            int i    = this.isql.indexOf("%s");
+            String q = this.isql.substring(0,i) + "'" + escapeSql(this.toString()) + "'" + this.isql.substring(i+2);
+            System.out.println("Query: " + q);
+            this.query.executeUpdate(q);
+
+        } catch (Exception e) {
+            System.out.println("err: " + e.getMessage());
+            throw new IOException("Insert failed: " + e.getMessage());
+        }
+    }
+
+    public String escapeSql(String q) {
+
+        int len         = q.length();
+        StringBuffer sb = new StringBuffer();
+        char c;
+
+        for(int i = 0; i < len; i++) {
+
+            c = q.charAt(i);
+            if(c == '\'') sb.append("\'\'");
+            else          sb.append(c);
+        }
+        
+        return sb.toString();
+    }
+}
Index: web/openacs/www/webmail/java/acspg/HeadersIter.java
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/java/acspg/HeadersIter.java,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/java/acspg/HeadersIter.java	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,64 @@
+package acspg;
+
+import java.sql.*;
+import java.io.*;
+import javax.mail.*;
+import javax.mail.internet.*;
+import java.util.*;
+import javax.activation.*;
+import nsjava.*;
+
+public class HeadersIter {
+
+    String    query;
+    NsSet     rs;
+    NsLog     log;
+    Pg_Query  st;
+    Integer   col_name;
+    Integer   col_value;
+    String    name;
+    String    value;
+
+    public HeadersIter(Pg_Query st, String query) throws SQLException {
+
+        this.log   = new NsLog();
+        this.rs    = st.select(query);
+
+        if(this.rs != null) {
+            this.col_name  = this.rs.find("name");
+            this.col_value = this.rs.find("value");
+        }
+        log.write("Debug", "name = " + this.col_name);
+        log.write("Debug", "value = " + this.col_value);
+    }
+
+    public boolean next(Pg_Query st) throws SQLException 
+    {
+        if(this.rs != null) {
+            if(st.getrow(this.rs) == true) {
+                this.name  = this.rs.value(this.col_name);
+                this.value = this.rs.value(this.col_value);
+                return true;
+            }
+        }
+
+        return false;
+    }
+
+    public String name() {
+
+        return this.name;
+    }
+
+    public String value() {
+
+        return this.value;
+    }
+
+    public void close() throws SQLException {
+
+        this.rs.free();
+    }
+}
+
+
Index: web/openacs/www/webmail/java/acspg/Pg_Query.java
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/webmail/java/acspg/Pg_Query.java,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/webmail/java/acspg/Pg_Query.java	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,50 @@
+package acspg;
+
+import java.sql.*;
+import java.io.*;
+import javax.mail.*;
+import javax.mail.internet.*;
+import java.util.*;
+import javax.activation.*;
+import nsjava.*;
+
+
+public class Pg_Query extends NsPg {
+
+
+    public Pg_Query() throws SQLException {
+
+        super();
+    }
+
+    public Pg_Query(String poolname) throws SQLException {
+
+        super(poolname);
+    }
+
+    public String databaseToJavaString(String q) throws SQLException {
+
+        String r = null;
+        NsLog log = new NsLog();
+        NsSet  selection;
+
+        log.write("Debug", "q = " + q);
+        selection = this.select(q);
+
+        if(selection != null) {
+            if(this.getrow(selection)) {
+                r = selection.value(0);
+            }
+            else {
+                selection.free();
+            }
+        }
+
+        return r;
+    }
+
+    public void executeUpdate(String sql) throws SQLException
+    {
+        this.dml(sql);
+    }
+}
Index: web/openacs/www/wp/bulk-copy-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/bulk-copy-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/bulk-copy-2.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,62 @@
+# bulk-copy-2.tcl,v 3.0 2000/02/06 03:54:48 ron Exp
+# File:        bulk-copy-2.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Prompts the user to select slides from a presentation to use for bulk copy.
+# Inputs:      presentation_id (the destination presentation)
+#              source_presentation_id
+
+set_the_usual_form_variables
+
+validate_integer presentation_id $presentation_id
+validate_integer source_presentation_id $source_presentation_id
+
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+wp_check_authorization $db $presentation_id $user_id "write"
+wp_check_authorization $db $source_presentation_id $user_id "read"
+
+set selection [ns_db 1row $db "select * from wp_presentations where presentation_id = $presentation_id"]
+set_variables_after_query
+
+set source_title [database_to_tcl_string $db "select title from wp_presentations where presentation_id = $source_presentation_id"]
+
+ReturnHeaders
+ns_write "[wp_header_form "action=bulk-copy-3.tcl" \
+           [list "" "WimpyPoint"] [list "index.tcl?show_user=" "Your Presentations"] \
+           [list "presentation-top.tcl?presentation_id=$presentation_id" "$title"] "Bulk Copy"]
+
+[export_form_vars presentation_id source_presentation_id]
+
+Which slides would you like to copy from $source_title into $title? The new slides
+will be added at the end of $title (you can always adjust the order later).
+<p>
+
+<center>
+<table border=2 cellpadding=10>
+<tr><td><table cellspacing=0 cellpadding=0>
+"
+
+set out ""
+wp_select $db "
+    select slide_id, title
+    from   wp_slides
+    where  presentation_id = $source_presentation_id
+    and    max_checkpoint is null
+    order by sort_key
+" {
+    append out "<tr><td><input type=checkbox name=slide_id value=$slide_id>&nbsp;&nbsp;</td><td><a href=\"[wp_presentation_url]/$presentation_id/$slide_id.wimpy\" target=_blank>$title</a></td></tr>\n"
+} else {
+    append out "<tr><td colspan=2>There are no slides to copy.</td></tr>"
+}
+
+ns_write "$out
+<tr><td colspan=2 align=center><hr><input type=submit value=\"Insert Checked Slides\"></td></tr>
+</table>
+</td></tr></table>
+
+</center>
+<p>
+[wp_footer]
+"
+
Index: web/openacs/www/wp/bulk-copy-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/bulk-copy-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/bulk-copy-3.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,82 @@
+# bulk-copy-3.tcl,v 3.0.4.1 2000/03/18 01:10:53 jsalz Exp
+# File:        bulk-copy-3.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Performs a bulk copy of slides.
+# Inputs:      presentation_id (target), source_presentation_id
+#              slide_id (multiple values)
+
+set_the_usual_form_variables
+
+validate_integer presentation_id $presentation_id
+validate_integer source_presentation_id $source_presentation_id
+
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+wp_check_authorization $db $presentation_id $user_id "write"
+wp_check_authorization $db $source_presentation_id $user_id "read"
+
+set slide_id_list [util_GetCheckboxValues [ns_getform] slide_id]
+
+if { ![info exists slide_id] || $slide_id_list == 0 } {
+    ad_return_complaint 1 [list "Please check at least one slide."]
+    return
+}
+
+set selection [ns_db 1row $db "select * from wp_presentations where presentation_id = $presentation_id"]
+set_variables_after_query
+
+ReturnHeaders
+ns_write "[wp_header_form "action=bulk-copy-3.tcl" \
+           [list "" "WimpyPoint"] [list "index.tcl?show_user=" "Your Presentations"] \
+           [list "presentation-top.tcl?presentation_id=$presentation_id" "$title"] \
+           [list "bulk-copy.tcl?presentation_id=$presentation_id" "Bulk Copy"] "Copying Slides"]
+
+<ul>
+"
+
+wp_check_numeric $presentation_id
+wp_check_numeric $source_presentation_id
+
+ns_db dml $db "begin transaction"
+
+
+foreach slide_id $slide_id_list {
+    validate_integer slide_id $slide_id
+
+	set sort_key [expr [database_to_tcl_string $db "
+		select max(sort_key) from wp_slides
+		where presentation_id = $presentation_id"] + 1.0]
+
+    # Do one at a time so we can display <li>s to indicate progress.
+    set next_id [wp_nextval $db "wp_ids"]
+
+    ns_write "<li>[database_to_tcl_string $db "select title from wp_slides where presentation_id = $source_presentation_id and slide_id = $slide_id"]...</li>\n"
+    ns_db dml $db "
+        insert into wp_slides(slide_id, presentation_id, min_checkpoint, sort_key, title,
+                              preamble, bullet_items, postamble, modification_date, style)
+        select $next_id, $presentation_id, (select max(checkpoint) from wp_checkpoints where presentation_id = $presentation_id), $sort_key, title,
+               preamble, bullet_items, postamble,
+               sysdate(), style
+        from   wp_slides
+        where  presentation_id = $source_presentation_id
+        and    slide_id = [wp_check_numeric $slide_id]
+    "
+    ns_db dml $db "
+        insert into wp_attachments(attach_id, slide_id, lob, file_size, file_name, mime_type, display)
+        select nextval('wp_ids'), $next_id, lob, file_size, file_name, mime_type, display
+        from   wp_attachments
+        where  slide_id = [wp_check_numeric $slide_id]
+    "
+    set sort_key [expr { $sort_key + 1.0 }]
+}
+
+ns_db dml $db "end transaction"
+
+ns_write "<li>Finished.
+
+<p><a href=\"presentation-top.tcl?presentation_id=$presentation_id\">Return to $title</a>
+
+</ul>
+[wp_footer]
+"
Index: web/openacs/www/wp/bulk-copy-top.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/bulk-copy-top.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/bulk-copy-top.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,27 @@
+# bulk-copy-top.tcl,v 3.0 2000/02/06 03:54:50 ron Exp
+# File:        bulk-copy.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Displays a prompt for bulk copying. It's white-on-black to be
+#              a little more obvious.
+# Inputs:      presentation_id
+
+set_the_usual_form_variables
+
+validate_integer presentation_id $presentation_id
+
+ReturnHeaders
+ns_write "
+<html>
+<head>
+<title>Bulk Copy</title>
+</head>
+<body bgcolor=black text=white link=white vlink=white alink=gray>
+<center>
+<font size=+1>
+<br>
+<b>Please select a presentation below to copy slides from,
+<br>or <a href=\"presentation-top.tcl?presentation_id=$presentation_id\" target=\"_parent\">cancel and return to your presentation</a>.</b>
+</body>
+</html>
+"
Index: web/openacs/www/wp/bulk-copy.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/bulk-copy.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/bulk-copy.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,32 @@
+# bulk-copy.tcl,v 3.0 2000/02/06 03:54:52 ron Exp
+# File:        bulk-copy.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Displays a frameset allowing the user to pick a presentation to
+#              bulk-copy slides from.
+# Inputs:      presentation_id
+#              user_id (optional)
+
+set_the_usual_form_variables
+
+validate_integer presentation_id $presentation_id
+
+if { [info exists user_id] } {
+    validate_integer user_id $user_id
+    set bottom_src "index.tcl?bulk_copy=$presentation_id&show_user=&show_age=14"
+} else {
+    set bottom_src "index.tcl?bulk_copy=$presentation_id&show_user=all&show_age=14"
+}
+
+ReturnHeaders
+ns_write "
+<html>
+<head>
+<title>Bulk Copy</title>
+</head>
+<frameset rows=\"125,*\" border=0>
+<frame src=\"bulk-copy-top.tcl?presentation_id=$presentation_id\" scrolling=no>
+<frame src=\"$bottom_src\">
+</frameset>
+</html>
+"
Index: web/openacs/www/wp/bulk-image-upload-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/bulk-image-upload-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/bulk-image-upload-2.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,164 @@
+# File:        bulk-image-upload-2.tcl
+# Date:        03 Mar 2000
+# Author:      Nuno Santos <nuno@arsdigita.com>
+# Description: Adds slides/images to presentation (from an uploaded set of zipped GIFs, PNGs and/or JPGs).
+# Inputs:      attachment (file), presentation_id
+
+ad_page_variables {
+    presentation_id
+    attachment
+}
+
+wp_check_numeric $presentation_id
+
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+
+wp_check_authorization $db $presentation_id $user_id "write"
+
+set tmp_filename [ns_queryget attachment.tmpfile]
+set n_bytes [file size $tmp_filename]
+
+set exception_count 0
+set exception_text ""
+
+if { $n_bytes == 0 } {
+    append exception_text "<li>You haven't uploaded a file.\n"
+    incr exception_count
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+
+# unpack the ZIP file into a directory of its own.
+set dir [file dirname $tmp_filename]
+cd $dir
+set temp_dir [ns_mktemp "$presentation_id-XXXXXX"]
+if [catch { ns_mkdir $temp_dir } errmsg ] {
+    ad_return_error "Can't create directory" "The directory 
+        for unzipping this image archive could not be created.
+        <br> Hit back in your browser and refresh the previous page 
+        in order to upload another archive. 
+        <p> Here is the exact error message: <pre>$errmsg</pre></li>"
+
+    return
+}
+
+cd $temp_dir
+append dir "/$temp_dir"
+
+set unzip [ad_parameter "PathToUnzip" "wp" "/usr/bin/unzip"]
+
+# unzip -C -j zipfile *.gif *.jpg *.png -d directory
+# only extract GIFs, PNGs and JPGs (-C=case-insensitive) into directory; don't create subdirs (-j);
+# ignore "caution: filename not matched" unzip message (if one of the formats is not present in the archive)
+if {[catch { exec $unzip -C -j $tmp_filename *.gif *.jpg *.png -d $dir } errmsg] 
+    && ![regexp {caution: filename not matched} $errmsg]} {
+    ad_return_error "Can't unzip file" "The file you uploaded could not be unzipped.
+        The most likely reason for this is that the file is not a valid ZIP format file.
+        <br>Hit back in your browser, create a proper ZIP file and try uploading again.
+        <p>Here is the exact error message: <pre>$errmsg</pre></li>"
+
+    # cleanup
+    cd ..
+    exec rm -fr $temp_dir
+
+    return
+}
+
+
+set title [database_to_tcl_string $db "select title from wp_presentations where presentation_id = $presentation_id"]
+
+set html_page "[wp_header_form "action=bulk-copy-3.tcl" \
+                [list "" "WimpyPoint"] [list "index.tcl?show_user=" "Your Presentations"] \
+                [list "presentation-top.tcl?presentation_id=$presentation_id" "$title"] \
+                [list "bulk-image-upload.tcl?presentation_id=$presentation_id" "Upload Image Archive"] "Uploading Slides"]
+
+Creating slides...
+<ul>
+"
+
+set sort_key [database_to_tcl_string $db "select nvl(max(sort_key), 0)
+                                          from wp_slides
+                                          where presentation_id = $presentation_id"]
+set checkpoint [database_to_tcl_string $db "select max(checkpoint) 
+                                            from wp_checkpoints 
+                                            where presentation_id = $presentation_id"]
+
+ns_db dml $db "begin transaction"
+
+# create slides from the image files (valid extensions: gif, jpg, png; case insensitive)
+set image_files [glob -nocomplain {*.{[Gg][Ii][Ff],[Jj][Pp][Gg],[Pp][Nn][Gg]}}]
+foreach image $image_files {
+    incr sort_key
+
+    set image_bytes [file size $image]
+
+    # slide title = filename (without extension)
+    set extension_length [string length [file extension $image]]
+    set slide_title [string range $image 0 [expr [string length $image] - $extension_length - 1]]
+    set slide_id [wp_nextval $db "wp_ids"]
+
+    append html_page "<li> $slide_title... \n"
+
+    # create the slide
+    ns_db dml $db "
+        insert into wp_slides
+        (slide_id, presentation_id, modification_date, sort_key, 
+         min_checkpoint, title, preamble, bullet_items, postamble, original_slide_id)
+        values
+        ($slide_id, $presentation_id, sysdate, $sort_key, 
+         $checkpoint, '[DoubleApos $slide_title]', empty_clob(), empty_clob(), empty_clob(), null)"
+
+    set guessed_file_type [ns_guesstype $image]
+
+    # uploaded images always go after the preamble, centered
+    set display "after-preamble"
+
+    # attach the image to the slide
+    ns_ora blob_dml_file $db "
+        insert into wp_attachments
+        (attach_id, slide_id, attachment, file_size, file_name, mime_type, display)
+        values
+        (wp_ids.nextval, $slide_id, empty_blob(), $image_bytes, '[DoubleApos $image]', '$guessed_file_type', '$display')
+        returning attachment into :1" $image
+
+    ns_unlink $image
+}
+
+ns_db dml $db "end transaction"
+
+ns_db releasehandle $db
+
+
+append html_page "<li>Finished.
+<p><a href=\"presentation-top.tcl?presentation_id=$presentation_id\">Return to $title</a>
+</ul>
+[wp_footer]
+"
+
+ns_return 200 "text/html" $html_page
+
+
+# cleanup
+cd ..
+exec rm -fr $temp_dir
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: web/openacs/www/wp/bulk-image-upload.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/bulk-image-upload.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/bulk-image-upload.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,49 @@
+# File:        bulk-image-upload.tcl
+# Date:        03 Mar 2000
+# Author:      Nuno Santos <nuno@arsdigita.com>
+# Description: Allows the user to bulk upload a presentation (from a set of zipped GIF, PNG and/or JPG files)
+# Inputs:      presentation_id
+
+set_the_usual_form_variables
+
+wp_check_numeric $presentation_id
+
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+wp_check_authorization $db $presentation_id $user_id "write"
+
+set title [database_to_tcl_string $db "select title from wp_presentations where presentation_id = $presentation_id"]
+
+ns_db releasehandle $db
+
+ns_return 200 "text/html" "
+[wp_header_form "enctype=multipart/form-data action=\"bulk-image-upload-2.tcl?[export_url_vars presentation_id]\" method=post"  \
+  [list "" "WimpyPoint"] \
+  [list "index.tcl?show_user=" "Your Presentations"] \
+  [list "presentation-top.tcl?presentation_id=$presentation_id" "$title"] "Upload Image Archive"]
+[export_form_vars presentation_id]
+
+To upload an archive of images, save your images as GIFs, JPGs or PNGs
+(only these file formats are recognized and unpacked), pack them into a ZIP file and then upload the ZIP file. 
+<p>Each image will be converted into a single WimpyPoint slide, with the title set to the image filename. 
+<br>The new slides will be added at the end of $title.
+You can always adjust the order of the slides, edit their titles and add further text later.
+
+<center><p>
+<table border=2 cellpadding=10>
+<tr><td>
+    <center>
+      <br><b>Select the ZIP file to upload:</b>
+      <p><input type=file size=30 name=attachment>
+      <p><input type=submit value=\"Upload the image archive\">
+    </center>
+    </td>
+    </tr>
+</table>
+</p></center>
+
+[wp_footer]
+"
+
+
+
Index: web/openacs/www/wp/css-view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/css-view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/css-view.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,30 @@
+# css-view.tcl,v 3.0 2000/02/06 03:54:53 ron Exp
+# File:        style-view.tcl
+# Date:        13 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Shows the CSS code for a style.
+# Inputs:      style_id (if editing)
+
+set_the_usual_form_variables 0
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+
+validate_integer style_id $style_id
+
+wp_check_style_authorization $db $style_id $user_id
+
+set selection [ns_db 1row $db "select * from wp_styles where style_id = $style_id"]
+set_variables_after_query
+
+ReturnHeaders "text/plain"
+ns_write $css
+
+#ReturnHeaders
+#ns_write "[wp_header_form "name=f action=style-edit-2.tcl method=post enctype=multipart/form-data" \
+#           [list "" "WimpyPoint"] [list "style-list.tcl" "Your Styles"] [list "style-view.tcl?style_id=$style_id" $name] "View CSS"]
+#[export_form_vars style_id]
+#
+#<blockquote><pre>[ns_quotehtml $css]</pre></blockquote>
+#
+#[wp_footer]
+#"
\ No newline at end of file
Index: web/openacs/www/wp/go.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/go.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/go.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,41 @@
+# go.tcl,v 3.0.4.1 2000/03/15 15:44:47 jsalz Exp
+# File:        go.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Redirects the user to a view- or edit-presentation screen. Used so we
+#              don't have to send long URLs like
+#
+#                http://lcsweb114.lcs.mit.edu/wimpy/presentation-top.tcl?presentation_id=131
+#
+#              which are likely to be mangled by mail clients.
+# Inputs:      presentation_id as query string (e.g., go.tcl?131)
+
+set_the_usual_form_variables
+
+validate_integer presentation_id $presentation_id
+
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+
+set sample_url [join [lreplace [ns_conn urlv] end end "go.tcl?131"] "/"]
+
+set query [ns_conn query]
+
+# Try to grok the query string. Display a nice error message if it isn't grokable.
+if { ![regexp {([0-9]+)} $query all invitation_id req_secret] } {
+    ad_return_error "Mangled Link" "We're sorry, but the link you received in your invitation
+E-mail must have been mangled by your mail client. It was supposed to end with a number, for example:
+
+<blockquote><pre>[ns_conn location]/$sample_url</pre></blockquote>
+
+<p>Your best bet is probably to try to just try to <a href=\"\">find the presentation yourself</a>.
+"
+    return
+}
+
+set auth [wp_check_authorization $db $query $user_id "read"]
+if { $auth == "read" } {
+    ns_returnredirect "[wp_presentation_url]/$query/"
+} else {
+    ns_returnredirect "presentation-top.tcl?presentation_id=$query"
+}
Index: web/openacs/www/wp/index.help
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/index.help,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/index.help	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,139 @@
+<%= [wp_help_header "About WimpyPoint"] %>
+
+<h3><a name="big-picture">WimpyPoint: The Basic Idea</a></h3>
+
+WimpyPoint is a replacement for desktop bloatware such
+as <a href="http://www.webho.com/WealthClock">Microsoft</a>
+PowerPoint.  You can build a slide presentation in
+WimpyPoint from any Web browser anywhere in the world.
+WimpyPoint will hold onto your presentation in a
+professional maintained and backed up relational database management
+system (Oracle 8).  You can forget your laptop.  You can drop your
+laptop.  You will still be able to give your presentation anywhere in
+the world that you can find a Web browser.
+
+<P>
+
+More interestingly, WimpyPoint lets you work with
+colleagues.  From your desk at MIT, you can authorize a friend at
+Stanford to edit your presentation, the two of you can work together
+until you're satisfied, and then you can both go into a conference
+room at Hewlett-Packard Laboratories and give your talk from our
+server.  
+
+<P>
+
+(Naturally this assumes that our machine is up and running and the
+various Internet backbones are operating properly.  We strive for
+maximum reliability but nobody can achieve 100% uptime for any
+Internet service.  If your career absolutely positively depends on a
+presentation, we recommend using the Print button on your Web browser
+to make a hardcopy of your slides.
+<i>A useful (free) tool for printing a WimpyPoint presentation is 
+<a href="http://clickthrough.photo.net/ct/philg/wtr/thebook/index.html?send_to=http://www.hp.com/pond/wps/index.html">Hewlett-Packard
+Web PrintSmart</a></i>).
+
+<P>
+
+More questions? See
+<a href="http://photo.net/wtr/thebook/">Philip and Alex's
+Guide to Web Publishing</a>.
+
+<h3>WimpyPoint Main Page</h3>
+
+Welcome to WimpyPoint! From this screen, WimpyPoint's index page, you
+can locate a presentation to view or edit. There
+are a lot of presentations in WimpyPoint (<%
+set db [ns_db gethandle]
+ns_puts [database_to_tcl_string $db "select count(*) from wp_presentations"]
+ns_db releasehandle $db
+%> at last count), you probably don't want to see a list of all of them -
+the sliders at the top of the
+screen let you select
+
+<ul>
+  <li>whether you want to see presentations created in the past week,
+two weeks, or month, or all presentations since the beginning of time
+(i.e., early 1998).
+  <li>whether you want to see only your own presentations (presentations which you have created
+or are <a href="#collaboration">collaborating on</a>), or presentations created by anyone at all. This slider only
+shows up if have an account on <%= [ad_system_name] %> and are logged in.
+</ul>
+
+To show a presentation, click its title. To edit a presentation (assuming
+that you created it or are a collaborator), click the <i>edit</i> link
+next to its listing.
+
+<p>You can follow the links under <i>Options</i> to
+<ul>
+  <li>create a new presentation (available only if you're logged in),
+  <li>list WimpyPoint users, so that you can see a list of all presentations
+created by a particular person,
+  <li>search for a string or concept in an existing presentation, or
+  <li>view/create/edit <a href="#styles">styles</a> which can be used to
+prettify presentations.
+</ul>
+
+<h3>Some Basic WimpyPoint Concepts</h3>
+
+<h4><a name="collaboration">Collaboration</a></h4>
+
+We don't want to let people edit other people's presentations willy-nilly
+(lest you walk into an important meeting only to find your work replaced by a
+<a href="http://photo.net/photo/pcd4229/alex-rope-13.4.jpg">dirty picture</a>),
+but we certainly want to let users work with other collaboratively (that's the
+whole point, right?). WimpyPoint allows authors to specify exactly who is
+allowed to view and work on their presentations (for more info,
+check out the help screens later once you've started working on your own
+presentation).
+
+<h4><a name="styles">Styles</a></h4>
+
+Black on white with red/blue/purple links and a 12-point serif font looks OK, but
+it gets boring after a while (and may not suit some people's needs). For
+this reason, we let you select styles to use when viewing presentations.
+(You can change the style used to view a presentation by clicking the
+<i>Change Style</i> link in the lower-right corner on a presentation's
+table of contents.)
+Styles can change pages' background and color scheme, and even more if
+you know how to write <a href="http://www.w3.org/Style/CSS/">CSS (Cascading Style Sheets)</a>
+code.
+
+<p>If you're a registered user of <%= [ad_system_name] %>, you can even
+upload your own styles - follow the <i>Edit one of your styles</i> link on the main page.)
+
+<h3>Credits</h3>
+
+WimpyPoint was originally designed and programmed by <a
+href="http://photo.net/philg/">Philip Greenspun</a> and <a
+href="http://www.coordination.com/krish/">Krish Menon</a>,
+using the
+<a href="http://www.arsdigita.com">ArsDigita</a> suite of tools and
+infrastructure.
+It was substantially rewritten and integrated into ACS by
+<a href="mailto:jsalz@mit.edu">Jon Salz</a>
+as a term project for MIT's <a href="http://6916.lcs.mit.edu">6.916: 
+Software Engineering of Innovative Web Services</a> class.
+</a>
+
+<p>
+
+WimpyPoint is a free service made possible by traditional
+Internet good citizenship.
+
+<p>
+
+WimpyPoint is implemented in <a
+href="http://photo.net/wtr/thebook/server.html#naviserver">AOLserver Tcl
+scripts</a> that talk to an <a
+href="http://www.oracle.com">Oracle 8 relational database
+management system</a>.
+
+<p>
+
+The rationale for building WimpyPoint is set forth in
+Chapter 1 of <a href="http://photo.net/wtr/thebook/">Philip and Alex's
+Guide to Web Publishing</a>, the later chapters of which explain the
+lessons we've learned from building about 70 services like this.
+
+<%=[wp_footer]%>
Index: web/openacs/www/wp/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/index.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,170 @@
+# index.tcl,v 3.1 2000/03/01 19:41:50 jsalz Exp
+# File:        index.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: If the user has not yet logged in, invites him/her to do so.
+#              Gives the user the option to view presentations in different
+#              ways.
+# Inputs:      bulk_copy (if we're doing a bulk copy)
+#              show_user, show_age
+
+set_the_usual_form_variables 0
+set user_id [ad_verify_and_get_user_id]
+
+# Remember slider settings for this page, using the wp_index_sliders cookie.
+set gen_slider_cookie 0
+if { ![regexp {wp_index_sliders=([0-9a-z]*),([0-9a-z]*)} [ns_set get [ns_conn headers] Cookie] all old_show_user old_show_age] } {
+    set old_show_user [expr { $user_id == 0 ? "all" : "" }]
+    set old_show_age 14
+}
+if [info exists show_user] {
+    set gen_slider_cookie 1
+} else {
+    set show_user $old_show_user
+}
+if [info exists show_age] {
+    set gen_slider_cookie 1
+} else {
+    set show_age $old_show_age
+}
+
+if { $gen_slider_cookie } {
+    set cookie "Set-Cookie: wp_index_sliders=$show_user,$show_age; Path=/\n";
+} else {
+    set cookie ""
+}
+
+if { [util_aolserver_2_p] } {
+    set warning "<font color=red><b>Warning: WimpyPoint periodically crashes AOLserver 2 when viewing slides (every third page view or so).<br>Use this at your own risk!</b></font><p>"
+} else {
+    set warning ""
+}
+
+ns_write "HTTP/1.0 200 OK
+Content-Type: text/html
+$cookie
+[wp_header_form "action=users.tcl" "WimpyPoint"]
+[export_form_vars bulk_copy show_user show_age]
+
+$warning
+
+<table width=90%>
+<tr>
+<td>[wp_slider show_age $show_age { { 7 "Last Week" } { 14 "Last Two Weeks" } { 31 "Last Month" } { "" "All" } }]</td>
+"
+
+if { $show_age != "" } {
+    set age_condition "and age(sysdate(), wp.creation_date) <= '[wp_check_numeric $show_age] days'"
+} else {
+    set age_condition ""
+}
+if { $show_user == "all" || $user_id == 0 } {
+    set user_condition ""
+    set whose "Everyone's"
+} else {
+    set user_condition "and wp_access(presentation_id, $user_id, 'write', public_p, creation_user, group_id) is not null"
+    set whose "Your"
+}
+
+set out ""
+if { $user_id != 0 } {
+    append out "<td align=right>[wp_slider show_user $show_user { { "" "Yours" } { "all" "Everyone's" } }]</td>\n"
+}
+append out "</tr>
+</table>
+
+<h3>$whose Presentations</h3>
+<ul>
+"
+
+set db [ns_db gethandle]
+
+wp_select $db "
+    select u.last_name, u.first_names, u.email, presentation_id, title,
+           creation_date, creation_user,
+           wp_access(presentation_id, $user_id, 'read', public_p, creation_user, group_id) as my_access
+    from users u, wp_presentations wp
+    where u.user_id = wp.creation_user $age_condition $user_condition
+    order by wp.creation_date desc
+" {
+    if { $my_access == "" } {
+	continue
+    }
+
+    
+    if { [info exists bulk_copy] } {
+	set main_href "bulk-copy-2.tcl?presentation_id=$bulk_copy&source_presentation_id=$presentation_id"
+	set user_href "one-user.tcl?user_id=$creation_user&bulk_copy=$bulk_copy"
+    } else {
+	set main_href "[wp_presentation_url]/$presentation_id/"
+	set user_href "/shared/community-member.tcl?user_id=$creation_user"
+    }
+
+    append out "<li><a href=\"$main_href\" target=_parent>[ns_striphtml $title]</a> created "
+    if { $creation_user != $user_id } {
+	append out "by <a href=\"$user_href\">$first_names $last_name</a> "
+    }
+    append out "on [util_AnsiDatetoPrettyDate $creation_date]"
+    if { $my_access != "read" && ![info exists bulk_copy] } {
+	append out " \[ <a href=\"presentation-top.tcl?presentation_id=$presentation_id\">edit</a> \]"
+    }
+    append out "\n"	
+} else {
+    if { $show_age == 7 } {
+	set age_str " created in the last week"
+    } elseif { $show_age == 14 } {
+	set age_str " created in the last two weeks"
+    } elseif { $show_age == 31 } {
+	set age_str " created in the last month"
+    } elseif { $show_age == "" } {
+	set age_str ""
+    } else {
+	set age_str " created in the last $show_age days"
+    }
+
+    if { $show_user == "" } {
+	append out "<li>You have no presentations$age_str.
+<a href=\"presentation-edit.tcl\">Create a new presentation</a>.\n"
+    } else {
+	append out "<li>There are no presentations$age_str.\n"
+    }
+}
+
+
+append out "</ul>
+<h3>Options</h3>
+<ul>\n"
+if { [info exists bulk_copy] } {
+    set bulk_copy_query "&bulk_copy=$bulk_copy"
+} else {
+    set bulk_copy_query ""
+}
+
+if { $user_id == 0 } {
+    # If the user hasn't logged in, prompt him/her to do so.
+    append out "<li>To create or edit presentations, please <a href=\"/register/?return_url=[ns_urlencode [ns_conn url]]\">log in</a>.\n"
+} else {
+    if { ![info exists bulk_copy] } {
+	append out "<li><a href=\"presentation-edit.tcl\">Create a new presentation</a>."
+    }
+}
+append out "
+<li>Show a list of <a href=\"users.tcl?[export_ns_set_vars]\">all WimpyPoint users</a>.
+<li>Show a list of WimpyPoint users with last names beginning with
+<input name=starts_with size=5>. <input type=submit value=Go>
+</form><form action=search.tcl>
+<!--li>Search through all slides for: <input size=30 name=search> <input type=submit value=\"Search\"-->
+"
+
+if { $user_id != 0 && ![info exists bulk_copy] } {
+    append out "<li>Edit one of <a href=\"style-list.tcl\">your styles</a>.\n"
+}
+
+append out "</ul>\n"
+
+ns_write "$out
+
+[wp_footer]
+
+"
+
Index: web/openacs/www/wp/invite-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/invite-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/invite-2.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,129 @@
+# invite-2.tcl,v 3.0 2000/02/06 03:54:57 ron Exp
+# File:        invite-2.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Sends an invitation E-mail.
+# Inputs:      presentation_id, role, name, email, message
+
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+
+set_the_usual_form_variables
+
+validate_integer presentation_id $presentation_id
+
+wp_check_authorization $db $presentation_id $user_id "admin"
+
+set selection [ns_db 1row $db "select * from wp_presentations where presentation_id = $presentation_id"]
+set_variables_after_query
+
+set exception_count 0
+set exception_text ""
+
+if { ![info exists name] || $name == "" } {
+    append exception_text "<li>Please provide the name of the user you're inviting.\n"
+    incr exception_count
+}
+if { [string length $name] > 200 } {
+    append exception_text "<li>The name is too long.\n"
+}
+if { ![info exists email] || $email == "" || ![regexp {^.+@.+$} $email] } {
+    append exception_text "<li>Please provide the E-mail address of the user you're inviting.\n"
+    incr exception_count
+}
+if { [string length $email] > 200 } {
+    append exception_text "<li>The E-mail address is too long.\n"
+}
+if { [database_to_tcl_string $db "
+    select count(*)
+    from wp_user_access_ticket
+    where presentation_id = [wp_check_numeric $presentation_id]
+    and role = '$QQrole'
+    and email = '$QQemail'
+"] != 0 } {
+    append exception_text "<li>This person has already been invited to [wp_role_predicate $role $title].\n"
+    incr exception_count
+}
+
+set selection [ns_db 0or1row $db "select first_names, last_name, user_id req_user_id from users where email = '$QQemail'"]
+if { $selection != "" } {
+    set_variables_after_query
+    append exception_text "<li>$first_names $last_name ($email) already has an account on [ad_system_name].
+<a href=\"presentation-acl-add-2.tcl?presentation_id=$presentation_id&role=$role&user_id_from_search=[ns_urlencode $user_id]&first_names_from_search=[ns_urlencode $first_names]&last_name_from_search=[ns_urlencode $last_name]\">Follow this link to invite $first_names $last_name</a>.\n"
+    incr exception_count
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# Generate a random 8-digit number as the secret code.
+set secret [expr 10000000 + [randomRange 90000000]]
+
+ns_db dml $db "begin transaction"
+
+# Make sure the insertion works before sending the E-mail. But do it all
+# within a transaction, so if the E-mail fails we cancel the ticket.
+set invitation_id [wp_nextval $db "wp_ids"]
+ns_db dml $db "
+    insert into wp_user_access_ticket(invitation_id, presentation_id, role, name, email, secret, invite_date, invite_user)
+    values ($invitation_id, $presentation_id, '$QQrole', '$QQname', '$QQemail', '$secret', sysdate, $user_id)
+"
+
+set selection [ns_db 1row $db "select first_names || ' ' || last_name my_name, email my_email from users where user_id = $user_id"]
+set_variables_after_query
+
+# Can the user just view the presentation (read), or work on it (write/admin)?
+if { $role == "read" } {
+    set predicate "view"
+} else {
+    set predicate "work on"
+}
+
+# Use a short URL, so it doesn't get mangled or wrapped.
+#
+#   http://lcsweb114.lcs.mit.edu/wimpy/join.tcl?131_92775918
+#   (56 characters)
+#
+# instead of
+#
+#   http://lcsweb114.lcs.mit.edu/wimpy/join.tcl?presentation_id=131&secret=92775918
+#   (79 characters)
+
+set url [join [lreplace [ns_conn urlv] end end "join.tcl?${invitation_id}_$secret"] "/"]
+
+set message [wrap_string "Hello! I have invited you to $predicate the WimpyPoint presentation named
+
+  $title
+
+on [ad_system_name]. To do so, you'll need to register for an account on [ad_system_name]. The process is very simple (and doesn't require you to provide any personal information). Just follow this link:
+
+  [ns_conn location]/$url
+
+$message" 75]
+
+ns_sendmail "$name <$email>" "$my_name <$my_email>" "WimpyPoint Invitation: $title" $message "" "$my_name <$my_email>"
+
+ns_db dml $db "end transaction"
+
+ReturnHeaders
+ns_write "[wp_header_form "action=invite-2.tcl method=post" \
+           [list "" "WimpyPoint"] [list "index.tcl?show_user=" "Your Presentations"] \
+           [list "presentation-top.tcl?presentation_id=$presentation_id" "$title"] \
+           [list "presentation-acl.tcl?presentation_id=$presentation_id" "Authorization"] \
+           [list "invite.tcl?presentation_id=$presentation_id&action=$role" "Invite User"] "E-Mail Sent"]
+
+$name ($email) has been invited to $predicate the presentation $title. The following E-mail was sent:
+
+<blockquote><pre>From: [ns_quotehtml "$my_name <$my_email>"]
+To: [ns_quotehtml "$name <$email>"]
+
+$message</pre></blockquote>
+
+<p><a href=\"presentation-acl.tcl?presentation_id=$presentation_id\">Return to $title</a>
+
+</p>
+[wp_footer]
+"
+
Index: web/openacs/www/wp/invite.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/invite.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/invite.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,40 @@
+# invite.tcl,v 3.1 2000/03/11 17:45:14 jsalz Exp
+# File:        presentation-acl-add.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Allows an administrator to invite someone to read/write/admin a presentation.
+# Inputs:      presentation_id, role
+
+set_the_usual_form_variables
+
+validate_integer presentation_id $presentation_id
+
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+wp_check_authorization $db $presentation_id $user_id "admin"
+
+set selection [ns_db 1row $db "select * from wp_presentations where presentation_id = $presentation_id"]
+set_variables_after_query
+
+ReturnHeaders
+ns_write "[wp_header_form "action=invite-2.tcl method=post" \
+           [list "" "WimpyPoint"] [list "index.tcl?show_user=" "Your Presentations"] \
+           [list "presentation-top.tcl?presentation_id=$presentation_id" "$title"] \
+           [list "presentation-acl.tcl?presentation_id=$presentation_id" "Authorization"] "Invite User"]
+
+[export_form_vars presentation_id role]
+
+<p>
+<table border=2 cellpadding=10><tr><td>
+<table>
+  <tr><td colspan=2>Please provide the name and E-mail address of the person whom you want to invite to
+[wp_role_predicate $role], and we'll send an E-mail inviting him or her to do so, and describing how
+to register with [ad_system_name]. The E-mail will appear to come from you, and you'll receive a copy.</P><hr></td></tr>
+  <tr><th align=right>Name:&nbsp;</th><td><input name=name size=40></td></tr>
+  <tr><th align=right>E-mail:&nbsp;</th><td><input name=email size=40></td></tr>
+  <tr valign=top><th align=right><br>Message:&nbsp;</th><td><textarea name=message rows=6 cols=40></textarea><br><i>If you like, you can provide a brief message to include in the invitation E-mail.</i></td></tr>
+  <tr><td colspan=2 align=center><hr><input type=submit value=\"Send Invitation E-Mail\"></td></tr>
+</table></td></tr></table></p>
+
+[wp_footer]
+"
Index: web/openacs/www/wp/join.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/join.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/join.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,133 @@
+# join.tcl,v 3.0 2000/02/06 03:55:00 ron Exp
+# File:        join.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Redeems a wp_user_access_ticket.
+# Inputs:      query string of the form "presentation_id,secret", e.g., 131,92775918
+
+set_the_usual_form_variables
+
+set db [ns_db gethandle]
+set user_id [ad_verify_and_get_user_id]
+
+set sample_url [join [lreplace [ns_conn urlv] end end "join.tcl?131_92775918"] "/"]
+
+set query [ns_conn query]
+
+# Try to grok the query string. Display a nice error message if it isn't grokable.
+if { ![regexp {^([0-9]+)_([0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9])$} $query all invitation_id req_secret] } {
+    ad_return_error "Mangled Link" "We're sorry, but the link you received in your invitation
+E-mail must have been mangled by your mail client. It was supposed to end with two numbers separated by an underscore (_).
+The second number should have been eight digits long. For example:
+
+<blockquote><pre>[ns_conn location]/$sample_url</pre></blockquote>
+
+<p>Your best bet is probably to try to piece together the URL by hand, or to go ahead and
+<a href=\"/register/\">register as a user</a> and then ask the person who sent you
+the E-mail to invite you again."
+    return
+}
+
+set selection [ns_db 0or1row $db "
+    select t.*, p.*
+    from wp_user_access_ticket t, wp_presentations p
+    where t.invitation_id = $invitation_id
+    and p.presentation_id = t.presentation_id
+"]
+
+if { $selection == "" } {
+    ad_return_error "Invitation Invalid" "This invitation link is invalid. This could be because
+your mail client mangled the link, or the invitation
+has been revoked.
+
+<p>Your best bet is probably to try to go ahead and
+<a href=\"/register/\">register as a user</a> and then ask the person who sent you
+the E-mail to invite you again."
+
+    return
+}
+
+set_variables_after_query
+
+if { $role != "read" } {
+    # The user is being granted write access - teleport them to the authoring screen.
+    set dest_link "presentation-top.tcl?presentation_id=$presentation_id"
+} else {
+    # Read access only - just show the presentation.
+    set dest_link "[wp_presentation_url]/$presentation_id/"
+}
+
+if { $secret == "" } {
+    ad_return_error "Already Redeemed" "This invitation has already been redeemed! You probably
+already have access to the presentation.
+
+<p><a href=\"$dest_link\">Go to $title</a>
+"
+    return
+}
+
+if { $secret != $req_secret } {
+    ad_return_error "Invitation Invalid" "This invitation link is invalid. This could be because
+your mail client mangled the link, or the invitation
+has been revoked.
+
+<p>Your best bet is probably to try to go ahead and
+<a href=\"/register/\">register as a user</a> and then ask the person who sent you
+the E-mail to invite you again."
+
+    return
+}
+
+if { $user_id != 0 } {
+    # Someone currently logged on to ACS is redeeming a ticket. Could be because
+    #
+    # (a) The person being invited already had an ACS account but the user who
+    #     invited him/her just couldn't find it, or
+    # (b) The person being invited has just signed up for an account.
+
+    if { $creation_user == $user_id } {
+	ad_return_error "Silly!" "You weren't supposed to click on the link in your invitation E-mail - that was intended for
+the person you were inviting!"
+        return
+    }
+
+    ns_db dml $db "begin transaction"
+    if { [wp_access $db $presentation_id $user_id $role] != "" } {
+	set message "You are already allowed to [wp_short_role_predicate $role $title]."
+    } else {
+	ns_db dml $db "
+            insert into user_group_map(group_id, user_id, role, mapping_user, mapping_ip_address)
+            values($group_id, $user_id, '$role', $user_id, '[ns_conn peeraddr]')
+        "
+	set message "You are now allowed to [wp_short_role_predicate $role $title]."
+    }
+    # Set secret to null to remember that the ticket is already redeemed.
+    ns_db dml $db "update wp_user_access_ticket set secret = null where invitation_id = $invitation_id"
+    ns_db dml $db "end transaction"
+
+    ReturnHeaders
+    ns_write "[wp_header [list "" "WimpyPoint"] "Welcome!"]
+
+<p>$message
+
+<p><a href=\"$dest_link\">Go to $title</a>
+
+</p>
+[wp_footer]
+"
+} else {
+    # Send the user to register, and have him/her sent back here when done (in which
+    # case the top branch of this if statement is taken and the user is granted access.
+
+    ReturnHeaders
+    ns_write "[wp_header [list "" "WimpyPoint"] "Welcome!"]
+
+<p>Welcome to WimpyPoint! Please <a href=\"/register/?return_url=[ns_urlencode "[ns_conn url]?[ns_conn query]"]\">follow this link</a>
+to register for an account on [ad_system_name] (or log in if you already have an account). As soon as that's done,
+you'll be able to [wp_short_role_predicate $role $title].
+
+</p>
+
+[wp_footer]
+"
+}
\ No newline at end of file
Index: web/openacs/www/wp/one-user.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/one-user.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/one-user.tcl	17 Apr 2001 14:05:22 -0000	1.1
@@ -0,0 +1,98 @@
+# one-user.tcl,v 3.0 2000/02/06 03:55:02 ron Exp
+# File:        one-user.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Shows a list of presentations by a particular user.
+# Inputs:      user_id
+#              bulk_copy (if we're selecting a presentation for bulk copy)
+
+set_the_usual_form_variables
+
+validate_integer user_id $user_id
+
+# Rename the user_id input to avoid confusion.
+set req_user_id $user_id
+
+set user_id [ad_verify_and_get_user_id]
+
+set db [ns_db gethandle]
+set selection [ns_db 1row $db "select first_names, last_name, email from users where user_id = $req_user_id"]
+set_variables_after_query
+
+if { $user_id == $req_user_id } {
+    # Be Englishically correct.
+    set noun "You"
+    set verb "have"
+    set possessive "Your"
+    set possessive_lc "your"
+} else {
+    set noun "$first_names $last_name"
+    set verb "has"
+    set possessive "<a href=\"/shared/community-member.tcl?user_id=$req_user_id\">$noun</a>'s"
+    set possessive_lc $possessive
+}
+
+ReturnHeaders
+ns_write "[wp_header [list "./?[export_ns_set_vars url user_id]" "WimpyPoint"] "$possessive Presentations"]
+<ul>
+"
+
+set out ""
+set written_collaboration_headline_p 0
+wp_select $db "
+    select title, presentation_id, creation_user, creation_date, public_p,
+           creation_user = $req_user_id as creator_p,
+           users.first_names, users.last_name,
+           wp_access(presentation_id, $user_id, 'read', public_p, creation_user, group_id) as my_access           
+    from   wp_presentations wp, users
+    where  users.user_id = creation_user
+           and wp_access(presentation_id, $req_user_id, 'write', public_p, creation_user, group_id) is not null
+    order by creator_p desc, wp.creation_date desc, upper(wp.title)
+" {
+    if { $my_access == "" } {
+	continue
+    }
+
+    if { !$written_collaboration_headline_p && $creator_p == "f" } {
+	set written_collaboration_headline_p 1
+	append out "<h4>Presentations Created by Others</h4>\n"
+    }
+
+    # If bulk copying, clicking the title proceeds to the next step in the bulk-copy operation.
+    if { [info exists bulk_copy] } {
+	set link "href=\"bulk-copy-2.tcl?presentation_id=$bulk_copy&source_presentation_id=$presentation_id\" target=_parent"
+    } else {
+	set link "href=\"[wp_presentation_url]/$presentation_id/\""
+    }
+    append out "<li><a $link>$title</a>, created [util_AnsiDatetoPrettyDate $creation_date]\n"
+    if { $my_access != "read" && ![info exists bulk_copy] } {
+	# User has write access - let him/her edit (only available if not bulk copying)
+	append out " \[ <a href=\"presentation-top.tcl?presentation_id=$presentation_id\">Edit</a> \]\n"
+    }
+    if { $creator_p == "f" } {
+	if { [info exists bulk_copy] } {
+	    set href "one-user.tcl?user_id=$creation_user&bulk_copy=$bulk_copy"
+	} else {
+	    set href "/shared/community-member.tcl?user_id=$user_id"
+	}
+	append out "(created by <a href=\"$href\">$first_names $last_name</a>)\n"
+    }
+    if { $public_p == "f" } {
+	append out "(private)\n"
+    }
+}
+
+if { $out == "" } {
+    append out "<li>$noun $verb no presentations."
+}
+
+if { $user_id == $req_user_id && ![info exists bulk_copy] } {
+    append out "<p><li><a href=\"presentation-edit.tcl\">Create a new presentation</a>.\n"
+}
+
+ns_db releasehandle $db
+ns_write "$out
+<li>Search through $possessive_lc presentations for: <input size=30 name=search> <input type=submit value=\"Search\">
+</ul>
+
+[wp_footer]"
Index: web/openacs/www/wp/outline-adjust-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/outline-adjust-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/outline-adjust-2.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,37 @@
+# outline-adjust-2.tcl,v 3.0 2000/02/06 03:55:03 ron Exp
+# File:        outline-adjust-2.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Saves changes made to the outline.
+# Inputs:      presentation_id, context_break_after, include_in_outline
+
+set_the_usual_form_variables
+
+validate_integer presentation_id $presentation_id
+
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+wp_check_authorization $db $presentation_id $user_id "write"
+
+set context_break_after [util_GetCheckboxValues [ns_getform] context_break_after -1]
+set include_in_outline [util_GetCheckboxValues [ns_getform] include_in_outline -1]
+
+foreach i $context_break_after {
+    wp_check_numeric $i
+}
+foreach i $include_in_outline {
+    wp_check_numeric $i
+}
+
+# All in one DML! Yeah, baby!
+
+# DRB: it's easy in Postgres, with real booleans...
+
+ns_db dml $db "
+    update wp_slides
+    set context_break_after_p = slide_id in ([join $context_break_after ","]),
+        include_in_outline_p = slide_id in ([join $include_in_outline ","])
+    where presentation_id = $presentation_id
+"
+
+ns_returnredirect "presentation-top.tcl?presentation_id=$presentation_id"
Index: web/openacs/www/wp/outline-adjust.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/outline-adjust.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/outline-adjust.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,83 @@
+# outline-adjust.tcl,v 3.0 2000/02/06 03:55:04 ron Exp
+# File:        outline-adjust.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Allows the user to adjust outline/context-break information.
+# Inputs:
+
+set_the_usual_form_variables
+
+validate_integer presentation_id $presentation_id
+
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+wp_check_authorization $db $presentation_id $user_id "write"
+
+set selection [ns_db 1row $db "select * from wp_presentations where presentation_id = $presentation_id"]
+set_variables_after_query
+
+ReturnHeaders
+ns_write "[wp_header_form "action=outline-adjust-2.tcl" \
+           [list "" "WimpyPoint"] [list "index.tcl?show_user=" "Your Presentations"] \
+           [list "presentation-top.tcl?presentation_id=$presentation_id" "$title"] "Adjust Outline"]
+
+[export_form_vars presentation_id]
+
+If you add a context break after a slide, pressing the next button on
+that slide will take you to an outline slide with the key slide
+highlighted.  Note that this context break only works for you (and
+any collaborators), and not for the general public.
+This is on the theory that the public pages are for casual readers
+browsing this site when you're not around whereas the private pages
+are what you use when you're giving a talk.  Unless you work for the
+US Department of Defense, we recommend no more than two or three
+context breaks per lecture.
+
+<p>
+<center>
+<table border=2 cellpadding=10><tr><td>
+<table cellspacing=0 cellpadding=0>
+<tr valign=bottom>
+<th align=left><font size=+1>Slide Title</th>
+<td>&nbsp;&nbsp;</td>
+<th nowrap>Include<br>in Outline</th>
+<td>&nbsp;&nbsp;</td>
+<th nowrap>Context Break<br>After</th>
+</tr>
+<tr><td colspan=5><hr></td></tr>
+"
+
+set last_slide_id ""
+
+set out ""
+set selection [ns_db select $db "
+    select slide_id, title, include_in_outline_p, context_break_after_p
+    from wp_slides 
+    where presentation_id = $presentation_id
+    and max_checkpoint is null
+    order by sort_key
+"]
+set more_rows [ns_db getrow $db $selection]
+while { $more_rows } {
+    set_variables_after_query
+    set more_rows [ns_db getrow $db $selection]
+
+    append out "<tr>
+<td>$title</td>
+<td></td>
+<td align=center><input type=checkbox name=include_in_outline value=$slide_id [wp_only_if { $include_in_outline_p == "t" } "checked"]></td>
+<td></td>
+[wp_only_if { $more_rows } "<td align=center><input type=checkbox name=context_break_after value=$slide_id [wp_only_if { $context_break_after_p == "t" } "checked"]></td>"]
+</tr>
+"
+}
+
+ns_write "$out
+<tr><td colspan=5 align=center><hr><input type=submit value=\"Save Changes\"></td></tr>
+</table>
+</td></tr></table>
+<p>
+
+</center>
+[wp_footer]
+"
\ No newline at end of file
Index: web/openacs/www/wp/override-style.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/override-style.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/override-style.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,78 @@
+# override-style.tcl,v 3.0 2000/02/06 03:55:06 ron Exp
+# File:        index.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Allows the user to select a style to use to view presentations.
+# Inputs:      override_style_id
+#              override_style_temp (is the switch temporary?)
+
+set_the_usual_form_variables 0
+
+validate_integer override_style_id $override_style_id
+
+if { [info exists override_style_id] && [regexp {^-?[0-9]*$} $override_style_id] } {
+    set override_style_temp [expr { [info exists override_style_temp] && $override_style_temp == 1 }]
+    set cookie "Set-Cookie: wp_override_style=$override_style_id,$override_style_temp; Path=/"
+    if { !$override_style_temp } {
+	append cookie "; Expires=Fri, 01-Jan-2010 01:00:00 GMT"
+    }
+    append cookie "\n"
+    set on_load "onLoad=\"opener.location.reload()\""
+} else {
+    if { ![regexp {wp_override_style=(-?[0-9]*),([01])} [ns_set get [ns_conn headers] Cookie] all override_style_id override_style_temp] } {
+	set override_style_id ""
+	set override_style_temp 1
+    }
+    set cookie ""
+    set on_load ""
+}
+
+set user_id [ad_verify_and_get_user_id]
+
+
+ns_write "HTTP/1.0 200 OK
+Content-type: text/html
+$cookie
+<html>
+<head><title>Select a Style</title></head>
+<body bgcolor=white $on_load>
+<form>
+<h2>Select a Style</h2><hr>
+
+"
+
+set db [ns_db gethandle]
+
+set out "<p><center>When displaying presentations, use the style<br>
+<select name=override_style_id>
+<option value=\"\"[wp_only_if { $override_style_id == "" } " selected"]>suggested by the author
+"
+
+wp_select $db "
+    select style_id, name
+    from wp_styles
+    where public_p = 't'
+    or owner is null
+    or owner = $user_id
+    order by lower(name)
+" {
+    append out "<option value=$style_id"
+    if { $style_id == $override_style_id } {
+	append out " selected"
+    }
+    append out ">$name\n"
+}
+
+ns_write "$out
+</select><input type=submit value=\"Save Preference\">
+
+<p>
+
+<table cellspacing=0 cellpadding=0>
+<tr><td><input type=radio name=override_style_temp value=1 [wp_only_if $override_style_temp "checked"]>&nbsp;</td><td>Save my preference only until I close my browser.</td></tr>
+<tr><td><input type=radio name=override_style_temp value=0 [wp_only_if { !$override_style_temp } "checked"]>&nbsp;</td><td>Save my preference permanently.</td></tr>
+</table>
+
+</center></p>
+[wp_footer]
+"
Index: web/openacs/www/wp/presentation-acl-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/presentation-acl-add-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/presentation-acl-add-2.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,56 @@
+# presentation-acl-add-2.tcl,v 3.0 2000/02/06 03:55:07 ron Exp
+# File:        presentation-acl-add-2.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Adds a user to an ACL (after confirming).
+# Inputs:      presentation_id, role, user_id_from_search, first_names_from_search, last_name_from_search
+
+set_the_usual_form_variables
+
+validate_integer presentation_id $presentation_id
+validate_integer user_id_from_search $user_id_from_search
+
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+wp_check_authorization $db $presentation_id $user_id "admin"
+
+set selection [ns_db 1row $db "select * from wp_presentations where presentation_id = $presentation_id"]
+set_variables_after_query
+
+# Don't let the administrator add an equivalent or lower access level than was previously there.
+if { [wp_access $db $presentation_id [wp_check_numeric $user_id_from_search] $role] != "" } {
+    ad_return_error "User Already Had That Privilege" "
+That user can already [wp_role_predicate $role]. Maybe you want to
+<a href=\"presentation-acl.tcl?presentation_id=$presentation_id\">try again</a>.
+"
+    return
+}
+
+ReturnHeaders
+ns_write "[wp_header_form "action=presentation-acl-add-3.tcl" \
+           [list "" "WimpyPoint"] [list "index.tcl?show_user=" "Your Presentations"] \
+           [list "presentation-top.tcl?presentation_id=$presentation_id" "$title"] \
+           [list "presentation-acl.tcl?presentation_id=$presentation_id" "Authorization"] "Confirm Add User"]
+
+[export_form_vars presentation_id user_id_from_search first_names_from_search last_name_from_search role]
+
+<p>Are you sure you want to give $first_names_from_search $last_name_from_search permission to [wp_role_predicate $role $title]?
+
+<blockquote>
+<table cellspacing=0 cellpadding=0><tr valign=baseline>
+<td><input name=email type=checkbox select>&nbsp;</td>
+<td>Send an E-mail message to $first_names_from_search with a link to the presentation.<br>Include
+the following message (optional):
+<br>
+<textarea name=message rows=5 cols=40></textarea>
+</td></tr></table>
+</blockquote>
+
+<p><center>
+<input type=button value=\"No, I want to cancel.\" onClick=\"location.href='presentation-acl.tcl?presentation_id=$presentation_id'\">
+<spacer type=horizontal size=50>
+<input type=submit value=\"Yes, proceed.\">
+</p></center>
+
+[wp_footer]
+"
Index: web/openacs/www/wp/presentation-acl-add-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/presentation-acl-add-3.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/presentation-acl-add-3.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,84 @@
+# presentation-acl-add-3.tcl,v 3.0 2000/02/06 03:55:08 ron Exp
+# File:        presentation-acl-add-3.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Adds a user to an ACL.
+# Inputs:      presentation_id, role, user_id_from_search, first_names_from_search, last_name_from_search
+#              email (maybe), message
+
+set_the_usual_form_variables
+
+validate_integer presentation_id $presentation_id
+validate_integer user_id_from_search $user_id_from_search
+
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+wp_check_authorization $db $presentation_id $user_id "admin"
+
+set selection [ns_db 1row $db "select * from wp_presentations where presentation_id = $presentation_id"]
+set_variables_after_query
+
+set my_email [database_to_tcl_string $db "select email from users where user_id = $user_id"]
+set dest_email [database_to_tcl_string $db "select email from users where user_id = $user_id_from_search"]
+
+ns_db dml $db "begin transaction"
+
+# Delete and insert, rather than updating, since we don't know if there's already a row in the table.
+ns_db dml $db "delete from user_group_map where group_id = $group_id and user_id = [wp_check_numeric $user_id_from_search]"
+ns_db dml $db "
+    insert into user_group_map(group_id, user_id, role, mapping_user, mapping_ip_address)
+    values($group_id, $user_id_from_search, '$QQrole', $user_id, '[ns_conn peeraddr]')
+"
+
+if { $role == "read" } {
+    set predicate "view"
+} else {
+    set predicate "work on"
+}
+
+# Send an E-mail message notifying the user.
+if { [info exists email] && $email != "" } {
+    set url [join [lreplace [ns_conn urlv] end end "go.tcl?$presentation_id"] "/"]
+
+    set message [wrap_string "Hello! I have invited you to $predicate the WimpyPoint presentation named
+
+  $title
+
+on [ad_system_name]. To do so, just follow this link:
+
+  [ns_conn location]/$url
+
+$message" 75]
+
+    ns_sendmail "$dest_email" "$my_email" "WimpyPoint Invitation: $title" $message "" "$my_email"
+}
+
+ns_db dml $db "end transaction"
+
+ReturnHeaders
+ns_write "[wp_header_form "action=presentation-acl-add-3.tcl" \
+           [list "" "WimpyPoint"] [list "index.tcl?show_user=" "Your Presentations"] \
+           [list "presentation-top.tcl?presentation_id=$presentation_id" "$title"] \
+           [list "presentation-acl.tcl?presentation_id=$presentation_id" "Authorization"] "User Added"]
+
+$first_names_from_search $last_name_from_search ($dest_email) has been given permission to
+[wp_role_predicate $role $title].
+
+"
+
+if { [info exists email] && $email != "" } {
+    ns_write "The following E-mail was sent: 
+
+<blockquote><pre>From: [ns_quotehtml "$my_email"]
+To: [ns_quotehtml "$dest_email"]
+
+$message</pre></blockquote>
+"
+}
+
+ns_write "
+<p><a href=\"presentation-acl.tcl?presentation_id=$presentation_id\">Return to $title</a>
+
+</p>
+[wp_footer]
+"
Index: web/openacs/www/wp/presentation-acl-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/presentation-acl-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/presentation-acl-add.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,46 @@
+# presentation-acl-add.tcl,v 3.0 2000/02/06 03:55:09 ron Exp
+# File:        presentation-acl-add.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Allows an administrator to add a member to an ACL list.
+# Inputs:      presentation_id, role
+
+set_the_usual_form_variables
+
+validate_integer presentation_id $presentation_id
+
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+wp_check_authorization $db $presentation_id $user_id "admin"
+
+set selection [ns_db 1row $db "select * from wp_presentations where presentation_id = $presentation_id"]
+set_variables_after_query
+
+ns_return 200 "text/html" "[wp_header_form "action=/user-search.tcl" \
+           [list "" "WimpyPoint"] [list "index.tcl?show_user=" "Your Presentations"] \
+           [list "presentation-top.tcl?presentation_id=$presentation_id" "$title"] \
+           [list "presentation-acl.tcl?presentation_id=$presentation_id" "Authorization"] "Add User"]
+
+<input type=hidden name=target value=\"/[ns_quotehtml [join [lreplace [ns_conn urlv] end end "presentation-acl-add-2.tcl"] "/"]]\">
+<input type=hidden name=passthrough value=\"presentation_id role\">
+[export_form_vars presentation_id role]
+
+<center>
+
+<p><table border=2 cellpadding=10 width=60%><tr><td>
+<table cellspacing=0 cellpadding=0>
+<tr><td colspan=2>Please enter part of the E-mail address or last name of the user
+you wish to give permission to [wp_role_predicate $role $title].<p>If you can't find the person you're looking for,
+he or she probably hasn't yet registered on [ad_system_name], but you can <a href=\"invite.tcl?[export_ns_set_vars]\">invite him or her to
+[wp_only_if { $role == "read" } "view" "work on"] your presentation</a>.</p>
+<hr></td></tr>
+<tr><th align=right>Last Name:&nbsp;</th><td><input name=last_name size=30></td></tr>
+<tr><th align=right><i>or</i> E-mail:&nbsp;</th><td><input name=email size=30></td></tr>
+<tr><td colspan=2 align=center>
+<hr>
+<input type=submit value=Search>
+</td></tr>
+</table></td></tr></table></p></center>
+
+[wp_footer]
+"
Index: web/openacs/www/wp/presentation-acl-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/presentation-acl-delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/presentation-acl-delete-2.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,22 @@
+# presentation-acl-delete-2.tcl,v 3.0 2000/02/06 03:55:10 ron Exp
+# File:        presentation-acl-delete-2.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Removes a user's ACL.
+# Inputs:      presentation_id, req_user_id
+
+set_the_usual_form_variables
+
+validate_integer presentation_id $presentation_id
+validate_integer req_user_id $req_user_id
+
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+wp_check_authorization $db $presentation_id $user_id "admin"
+
+set selection [ns_db 1row $db "select * from wp_presentations where presentation_id = $presentation_id"]
+set_variables_after_query
+
+ns_db dml $db "delete from user_group_map where group_id = $group_id and user_id = [wp_check_numeric $req_user_id]"
+
+ns_returnredirect "presentation-acl.tcl?presentation_id=$presentation_id"
Index: web/openacs/www/wp/presentation-acl-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/presentation-acl-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/presentation-acl-delete.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,42 @@
+# presentation-acl-delete.tcl,v 3.0 2000/02/06 03:55:11 ron Exp
+# File:        presentation-acl-delete.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Deletes a user's ACL entry (after confirming).
+# Inputs:      presentation_id, user_id
+
+set_the_usual_form_variables
+
+validate_integer presentation_id $presentation_id
+validate_integer user_id $user_id
+
+set req_user_id $user_id
+
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+wp_check_authorization $db $presentation_id $user_id "admin"
+
+set selection [ns_db 1row $db "select * from wp_presentations where presentation_id = $presentation_id"]
+set_variables_after_query
+
+set name [database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id = [wp_check_numeric $req_user_id]"]
+
+ReturnHeaders
+ns_write "[wp_header_form "action=presentation-acl-delete-2.tcl" \
+           [list "" "WimpyPoint"] [list "index.tcl?show_user=" "Your Presentations"] \
+           [list "presentation-top.tcl?presentation_id=$presentation_id" "$title"] \
+           [list "presentation-acl.tcl?presentation_id=$presentation_id" "Authorization"] "Confirm Delete User"]
+
+[export_form_vars presentation_id req_user_id]
+
+<p>Are you sure you want to strip $name's access to $title?
+[wp_only_if { $public_p == "t" } "The presentation is public, so the user will still be able to view it."]
+
+<p><center>
+<input type=button value=\"No, I want to cancel.\" onClick=\"location.href='presentation-acl.tcl?presentation_id=$presentation_id'\">
+<spacer type=horizontal size=50>
+<input type=submit value=\"Yes, proceed.\">
+</p></center>
+
+[wp_footer]
+"
Index: web/openacs/www/wp/presentation-acl.help
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/presentation-acl.help,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/presentation-acl.help	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,29 @@
+<%= [wp_help_header "Authorization"] %>
+
+In WimpyPoint, users can have one of three levels of access to a presentation:
+
+<ul>
+  <li><b>View-only</b> - these users can view the presentation but
+can't make changes to it. If the presentation is public, all users
+can automatically view the presentaiton.
+  <li><b>Collaborator</b> - these users can view and make changes
+to the presentation (e.g., edit and delete slides, change the
+presentation's title, etc.). They can't delete the presentation or
+freeze the slide set, however.
+  <li><b>Owner</b> - these users can do whatever they want to the presentation
+(view or make changes to it, delete the entire presentation, freeze
+the slide set, etc.). Owners can also give other users permission
+to view the presentation, or to make other users collaborators or owners.
+</ul>
+
+This page allows you to grant users permission to view, collaborate on,
+or own the presentation. It displays a box for each of these privileges
+(omitting the view-only box if the presentation is public).
+To invite a person to view, collaborate on, or own the presentation,
+click the <i>Add One</i> button in one of the boxes. (Note that you
+can even add a person who hasn't registered with <%= [ad_system_name] %>.)
+You'll have the option to send the person whom you invite an E-mail
+containing a link which he or she can use to go directly to the
+presentation.
+
+<%=[wp_footer]%>
Index: web/openacs/www/wp/presentation-acl.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/presentation-acl.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/presentation-acl.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,115 @@
+# presentation-acl.tcl,v 3.0 2000/02/06 03:55:13 ron Exp
+# File:        presentation-acl.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Allows an administrator to edit ACL lists.
+# Inputs:      presentation_id, role
+
+set_the_usual_form_variables
+
+validate_integer presentation_id $presentation_id
+
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+wp_check_authorization $db $presentation_id $user_id "write"
+
+set selection [ns_db 1row $db "select * from wp_presentations where presentation_id = $presentation_id"]
+set_variables_after_query
+
+ReturnHeaders
+ns_write "[wp_header_form "name=f" \
+           [list "" "WimpyPoint"] [list "index.tcl?show_user=" "Your Presentations"] \
+           [list "presentation-top.tcl?presentation_id=$presentation_id" "$title"] "Authorization"]
+
+"
+
+set out ""
+
+if { $public_p == "t" } {
+    append out "The presentation is public, so anyone is allowed to view it.
+You can <nobr><a href=\"presentation-public.tcl?presentation_id=$presentation_id&public_p=f\">make the presentation
+private</a></nobr> if you want only certain users to be able to view it.
+<p>"
+}
+
+append out "
+<p>
+<table cellpadding=0 cellspacing=0>
+"
+
+foreach role { read write admin } {
+    if { $role == "read" && $public_p == "t" } {
+	# Don't bother showing the read list if the presentation is public.
+	continue
+    }
+
+    append out "<tr valign=top><td align=right width=30%><br>The following users may [wp_role_predicate $role]:"
+    if { $role == "read" } {
+	append out "<p>(or you can <a href=\"presentation-public.tcl?presentation_id=$presentation_id&public_p=t\">make the presentation
+public</a> so everyone can view it)"
+    }
+    append out "</td><td>&nbsp;</td><td>
+<table border=2 cellpadding=10><tr><td align=center><table cellspacing=0 cellpadding=0>\n"
+
+    set counter 0
+
+    if { $role == "admin" } {
+	incr counter
+	append out "<tr><td><a href=\"/shared/community-member.tcl?user_id=$creation_user\">[database_to_tcl_string $db "select first_names || ' ' || last_name from users where user_id = $creation_user"]</a></td>
+<td>&nbsp;&nbsp;&nbsp;</td><td>(creator)</td></tr>\n"
+    }
+
+    wp_select $db "
+        select first_names, last_name, u.user_id as req_user_id
+        from users u, user_group_map m
+        where u.user_id = m.user_id
+        and m.group_id = $group_id
+        and m.role = '$role'
+        order by last_name, first_names
+    " {
+        append out "<tr><td><a href=\"/shared/community-member.tcl?user_id=$req_user_id\">$first_names $last_name</a></td><td>&nbsp;&nbsp;&nbsp;</td>"
+	if { $user_id == $req_user_id } {
+	    append out "<td>(you)</td>"
+	} else {
+	    append out "<td>\[ <a href=\"presentation-acl-delete.tcl?presentation_id=$presentation_id&user_id=$req_user_id\">remove</a> \]</td>"
+	}
+	append out "</tr>\n"
+	incr counter
+    }
+    set counter2 0
+    wp_select $db "
+        select t.invitation_id, t.name, t.email, t.invite_date, u.first_names, u.last_name, u.user_id
+        from   wp_user_access_ticket t, users u
+        where  t.presentation_id = $presentation_id
+        and    t.role = '$role'
+        and    t.secret is not null
+        and    t.invite_user = u.user_id
+        order by invite_date
+    " {
+	if { $counter != 0 && $counter2 == 0 } {
+	    append out "<tr><td colspan=3><hr></td></tr>"
+	}
+
+	append out "<tr><td><a href=\"mailto:$email\">$name</a></td><td>&nbsp;&nbsp;&nbsp;</td><td><a href=\"uninvite.tcl?presentation_id=$presentation_id&invitation_id=$invitation_id\">remove</a></td></tr>
+<tr><td colspan=4>&nbsp;&nbsp;&nbsp;<nobr>(invited by <a href=\"/shared/community-member.tcl?user_id=$req_user_id\">$first_names $last_name</a></nobr> <nobr>on [util_IllustraDatetoPrettyDate $invite_date])</nobr></td></tr>
+"
+        incr counter
+        incr counter2
+    }
+
+    if { $counter == 0 } {
+	append out "<tr><td><i>No users.</i></td></tr>"
+    }
+    append out "</table><hr>
+<input type=button value=\"Add One\" onClick=\"location.href='presentation-acl-add.tcl?presentation_id=$presentation_id&role=$role'\">
+</td></tr></table></td></tr>"
+
+    if { $role != "admin" } {
+	append out "<tr><td>&nbsp;</td></tr>"
+    }
+}
+
+ns_write "$out</td></tr></table></p>
+
+[wp_footer]
+"
Index: web/openacs/www/wp/presentation-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/presentation-delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/presentation-delete-2.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,40 @@
+# presentation-delete-2.tcl,v 3.0 2000/02/06 03:55:14 ron Exp
+# File:        presentation-delete-2.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Deletes a presentation.
+# Inputs:      presentation_id, password
+
+set_the_usual_form_variables
+
+validate_integer presentation_id $presentation_id
+
+set db [ns_db gethandle]
+
+set user_id [ad_maybe_redirect_for_registration]
+wp_check_authorization $db $presentation_id $user_id "admin"
+
+if { $password != [database_to_tcl_string $db "select password from users where user_id = $user_id"] } {
+    ad_return_complaint 1 "<li>The password you entered is incorrect.\n"
+    return
+}
+
+ns_db dml $db "begin transaction"
+
+ns_db dml $db "delete from wp_presentations where presentation_id = $presentation_id"
+ns_db dml $db "delete from user_groups where group_type = 'wp' and group_name = 'WimpyPoint Presentation $title'"
+
+ns_db dml $db "end transaction"
+
+ReturnHeaders
+ns_write "[wp_header_form "name=f" \
+           [list "" "WimpyPoint"] [list "index.tcl?show_user=" "Your Presentations"] "Presentation Deleted"]
+
+The presentation has been deleted.
+
+<p><a href=\"\">Return to your presentations</a>
+</p>
+
+[wp_footer]
+"
+
Index: web/openacs/www/wp/presentation-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/presentation-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/presentation-delete.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,37 @@
+# presentation-delete.tcl,v 3.0 2000/02/06 03:55:16 ron Exp
+# File:        presentation-delete.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Confirms the deletion of a presentation, requiring the user to enter
+#              his password.
+# Inputs:      presentation_id
+
+set_the_usual_form_variables
+
+validate_integer presentation_id $presentation_id
+
+set db [ns_db gethandle]
+
+set user_id [ad_maybe_redirect_for_registration]
+wp_check_authorization $db $presentation_id $user_id "admin"
+
+set selection [ns_db 1row $db "select * from wp_presentations where presentation_id = $presentation_id"]
+set_variables_after_query
+
+ReturnHeaders
+ns_write "[wp_header_form "method=post action=presentation-delete-2.tcl" \
+           [list "" "WimpyPoint"] [list "index.tcl?show_user=" "Your Presentations"] \
+           [list "presentation-top.tcl?presentation_id=$presentation_id" "$title"] "Delete Presentation"]
+[export_form_vars presentation_id title]
+
+Do you really want to delete $title?
+All [database_to_tcl_string $db "select count(*) from wp_slides where presentation_id = $presentation_id"] slides will be permanently deleted.
+
+<p>If you're really sure, please reenter your password.
+
+<p><b>Password:</b> <input type=password size=20 name=password> <input type=submit value=\"Delete Presentation\">
+
+</p>
+[wp_footer]
+"
+
Index: web/openacs/www/wp/presentation-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/presentation-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/presentation-edit-2.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,98 @@
+# presentation-edit-2.tcl,v 3.0 2000/02/06 03:55:17 ron Exp
+# File:        presentation-edit-2.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Create or apply changes to a presentation.
+# Inputs:      presentation_id (if editing)
+#              title, page_signature, copyright_notice, show_modified_p, public_p, style
+
+set_the_usual_form_variables
+
+set user_id [ad_maybe_redirect_for_registration]
+
+validate_integer presentation_id $presentation_id
+
+set exception_count 0
+set exception_text ""
+
+if { ![info exists title] || $title == "" } {
+    append exception_text "<li>Your title was blank.  We need a title to generate the user interface."
+    incr exception_count
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# We're OK to insert.
+
+set db [ns_db gethandle]
+
+if { ![info exists creating] } {
+    set condition "presentation_id = $presentation_id"
+    wp_check_authorization $db $presentation_id $user_id "write"
+} else {
+    if { [database_to_tcl_string $db "
+        select count(*) from wp_presentations where presentation_id = $presentation_id
+    "] } {
+	# Double-click!
+	if { $style == "upload" } {
+	    # User requested to upload a style - send to the style editor.
+	    ns_returnredirect "style-edit.tcl?presentation_id=$presentation_id"
+	} else {
+	    ns_returnredirect "presentation-top.tcl?presentation_id=$presentation_id"
+	}
+	return
+    }
+
+    set condition ""
+    set group_id [database_to_tcl_string $db "select user_group_sequence.nextval from dual"]
+}
+
+if { $style == "upload" } {
+    # User requested to upload a style.
+    set upload 1
+    set style "null"
+} else {
+    set upload 0
+}
+if { $style == -1 || $style == "" } {
+    # Default style.
+    set style "null"
+}
+if { $style != "null" } {
+    wp_check_numeric $style
+}
+
+set names [list presentation_id title copyright_notice page_signature creation_date creation_user style public_p audience background]
+set values [list $presentation_id "'$QQtitle'" "'$QQcopyright_notice'" "'$QQpage_signature'" sysdate() $user_id $style "'$QQpublic_p'" "'$QQaudience'" "'$QQbackground'"]
+
+if { $condition == "" } {
+    ad_user_group_add $db "wp" "WimpyPoint Presentation $title" "t" "f" "closed" "f" "" $group_id
+#    ns_db dml $db "
+#        insert into user_groups(group_id, group_type, group_name, creation_user, creation_ip_address,
+#                                approved_p, active_p, existence_public_p, new_member_policy, multi_role_p, group_admin_permissions_p)
+#        values($group_id, 'wp', $presentation_id, $user_id, '[ns_conn peeraddr]',
+#               't', 't', 'f', 'closed', 't', 't')
+#    "
+    lappend names "group_id"
+    lappend values $group_id
+}
+
+wp_try_dml_or_break $db [wp_prepare_dml "wp_presentations" $names $values $condition]
+
+if { $condition == "" } {
+    # We're inserting - create the first checkpoint.
+    ns_db dml $db "insert into wp_checkpoints(presentation_id, checkpoint) values($presentation_id, 0)"
+}
+
+ns_db dml $db "end transaction"
+
+if { $upload } {
+    # User requested to upload a style - send to the style editor.
+    ns_returnredirect "style-edit.tcl?presentation_id=$presentation_id"
+} else {
+    ns_returnredirect "presentation-top.tcl?presentation_id=$presentation_id"
+}
+
Index: web/openacs/www/wp/presentation-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/presentation-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/presentation-edit.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,186 @@
+# presentation-edit.tcl,v 3.0 2000/02/06 03:55:18 ron Exp
+# File:        presentation-edit.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Allows the user to create or edit a presentation.
+# Inputs:      presentation_id (if editing)
+
+set_the_usual_form_variables 0
+
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+
+if { [info exists presentation_id] } {
+    validate_integer presentation_id $presentation_id
+
+    # Editing an existing presentation - check auth and grab info from the database.
+    wp_check_authorization $db $presentation_id $user_id "write"
+    set selection [ns_db 1row $db "select * from wp_presentations where presentation_id = $presentation_id"]
+    set_variables_after_query
+
+    set header [list "presentation-top.tcl?presentation_id=$presentation_id" $title]
+
+    set role "Edit"
+
+    # Give the user access to any style owned by any other collaborator.
+    set or_styles "or owner in (select user_id from user_group_map
+                                      where group_id = $group_id
+                                      and   role in ('write','admin'))"
+    if { $style != "" } {
+	# Make sure the user has access to the currently set style.
+	append or_styles " or style_id = $style"
+    }
+} else {
+    # Creating a new presentation - set some defaults.
+    foreach var { title description page_signature copyright_notice audience background } {
+	set $var ""
+    }
+    set show_modified_p "f"
+    set public_p "t"
+    set style -1
+
+    set header ""
+
+    set role "Create"
+
+    set or_styles ""
+
+    set presentation_id [wp_nextval $db "wp_ids"]
+    set creating "t"
+}
+
+# Generate the list of styles. If the owner is the current user or null, or the
+# style is public, the user can see it.
+set styles ""
+wp_select $db "
+    select style_id, name
+    from   wp_styles
+    where  owner = $user_id
+    or     owner is null
+    or     public_p = 't'
+    $or_styles
+" {
+    append styles "<option value=$style_id"
+    if { $style == $style_id } {
+	append styles " selected"
+    }
+    append styles ">$name\n"
+}
+
+ReturnHeaders
+ns_write "[wp_header_form "name=f action=presentation-edit-2.tcl method=post" \
+           [list "" "WimpyPoint"] [list "index.tcl?show_user=" "Your Presentations"] \
+           $header "$role Presentation"]
+[export_form_vars presentation_id creating]
+
+<table>
+  <tr>
+    <td></td><td>
+Give this presentation a title.  Pick a title that you've never used
+before, otherwise you won't be able to tell this new presentation from 
+old ones.  Also, keep the title reasonably short so that if you choose
+a style where the overall presentation title is presented on each slide,
+it won't take up too much space.
+    </td>
+  </tr>
+  <tr>
+    <th nowrap align=right>Title:</th>
+    <td><input type=text name=title size=50 value=\"[philg_quote_double_quotes $title]\"></td>
+  </tr>
+  <tr>
+    <td></td><td>
+If you want a signature at the bottom of each slide, then enter it here:
+    </td>
+  </tr>
+  <tr>
+    <th nowrap align=right>Page Signature:</th>
+    <td><input type=text name=page_signature size=50 value=\"[philg_quote_double_quotes $page_signature]\"></td>
+  </tr>
+  <tr>
+    <td></td><td>
+(Personally, I like to have my email address, hyperlinked to my home
+page; remember that HTML is OK here and you can have up to 200 characters.)
+
+<p>If you want a copyright notice somewhere on each slide, enter it here:
+    </td>
+  </tr>
+  <tr>
+    <th nowrap align=right>Copyright Notice:</th>
+    <td><input type=text name=copyright_notice size=50 value=\"[philg_quote_double_quotes $copyright_notice]\"></td>
+  </tr>
+  <tr>
+    <td></td><td>
+WimpyPoint keeps track of the last modification time
+of each slide.  If you'd like that displayed on each slide, you can
+say so here:
+    </td>
+  </tr>
+  <tr>
+    <th nowrap align=right>Show Modification Date?</th>
+    <td>
+<input type=radio name=show_modified_p value=t [wp_only_if { $show_modified_p == "t" } "checked"]> Yes
+<input type=radio name=show_modified_p value=f [wp_only_if { $show_modified_p == "f" } "checked"]> No
+    </td>
+  </tr>
+  <tr>
+    <td></td><td>
+If you want to hide this presentation from everyone except yourself
+and any collaborators that you add, you should say so.  Eventually
+you'll probably want to change this and make the presentation public,
+unless you are only using WimpyPoint to generate .html
+pages and/or hardcopy slides that you will show privately.
+    </td>
+  </tr>
+  <tr>
+    <th nowrap align=right>Available to Public?</th>
+    <td>
+<input type=radio name=public_p value=t [wp_only_if { $public_p == "t" } "checked"]> Yes
+<input type=radio name=public_p value=f [wp_only_if { $public_p == "f" } "checked"]> No
+    </td>
+  </tr>
+  <tr>
+    <td></td><td>
+Suggestion: if you have truly secret information for a presentation,
+you'd be best off keeping it on your desktop machine.  We try to keep
+our database secure but remember that your packets are being sent in
+the clear.
+
+<p>Want to make your presentation pretty? Select a style to give your presentation
+some pizzazz. If you select \"I'll provide my own,\" once you submit this form
+you'll be given the opportunity to create a style, selecting your own color
+scheme, background image, etc.
+(You can access your personal style repository by clicking the link
+entitled <i>Edit one of your styles</i> from WimpyPoint's main page.)
+    </td>
+  </tr>
+  <tr>
+    <th nowrap align=right>Style:</th>
+    <td><select name=style>
+$styles
+<option value=\"upload\">I'll provide my own
+</select>
+    </td>
+  </tr>
+  <tr>
+    <td></td><td>
+<p>Finally, if you're planning on making the presentation public, you might want to let the
+world know whom you gave the presentation to and for what purpose.
+    </td>
+  </tr>
+  <tr valign=top>
+    <th nowrap align=right><br>Audience:</th>
+    <td><textarea name=audience rows=4 cols=50 wrap=virtual>[philg_quote_double_quotes $audience]</textarea></td>
+  </tr>
+  <tr valign=top>
+    <th nowrap align=right><br>Background:</th>
+    <td><textarea name=background rows=4 cols=50 wrap=virtual>[philg_quote_double_quotes $audience]</textarea></td>
+  </tr>
+</table>
+
+<center>
+<input type=submit value=\"Save Presentation\">
+</center>
+</p>
+
+[wp_footer]
+"
\ No newline at end of file
Index: web/openacs/www/wp/presentation-freeze-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/presentation-freeze-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/presentation-freeze-2.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,23 @@
+# presentation-freeze-2.tcl,v 3.0 2000/02/06 03:55:20 ron Exp
+# File:        presentation-freeze-2.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Freezes the current slide set.
+# Inputs:      presentation_id, description
+
+set_the_usual_form_variables
+
+validate_integer presentation_id $presentation_id
+
+set db [ns_db gethandle]
+
+set user_id [ad_maybe_redirect_for_registration]
+wp_check_authorization $db $presentation_id $user_id "admin"
+
+set selection [ns_db 1row $db "select * from wp_presentations where presentation_id = $presentation_id"]
+set_variables_after_query
+
+# Do it all in PL/SQL.
+ns_db 1row $db "select wp_set_checkpoint($presentation_id, '$QQdescription')"
+
+ns_returnredirect "presentation-top.tcl?presentation_id=$presentation_id"
Index: web/openacs/www/wp/presentation-freeze.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/presentation-freeze.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/presentation-freeze.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,40 @@
+# presentation-freeze.tcl,v 3.0 2000/02/06 03:55:21 ron Exp
+# File:        presentation-freeze.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Freezes the current slide set.
+# Inputs:      presentation_id
+
+set_the_usual_form_variables
+
+validate_integer presentation_id $presentation_id
+
+set db [ns_db gethandle]
+
+set user_id [ad_maybe_redirect_for_registration]
+wp_check_authorization $db $presentation_id $user_id "admin"
+
+set selection [ns_db 1row $db "select * from wp_presentations where presentation_id = $presentation_id"]
+set_variables_after_query
+
+ReturnHeaders
+ns_write "[wp_header_form "method=post action=presentation-freeze-2.tcl" \
+           [list "" "WimpyPoint"] [list "index.tcl?show_user=" "Your Presentations"] \
+           [list "presentation-top.tcl?presentation_id=$presentation_id" "$title"] "Freeze Presentation"]
+[export_form_vars presentation_id]
+
+<p>This feature allows you to permanently preserve the current set of slides in your presentation.
+It's especially useful before you invite someone to work on your presentation - if he or she
+messes things up, you can always revert to a previous version.
+
+<p>You may enter one line which describes the current state of the presentation
+(e.g., \"rough draft\" or \"before modifications by Ben Bitdiddler\").
+
+<p><center><b>Description:</b> <input type=text name=description maxlength=100 size=40>
+
+<p><input type=submit value=\"Freeze Presentation\">
+
+</p></center>
+[wp_footer]
+"
+
Index: web/openacs/www/wp/presentation-public.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/presentation-public.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/presentation-public.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,17 @@
+# presentation-public.tcl,v 3.0 2000/02/06 03:55:23 ron Exp
+# File:        presentation-public.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Makes a presentation (non-)public.
+# Inputs:      presentation_id, public_p
+
+set_the_usual_form_variables
+
+validate_integer presentation_id $presentation_id
+
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+wp_check_authorization $db $presentation_id $user_id "admin"
+
+ns_db dml $db "update wp_presentations set public_p='$QQpublic_p' where presentation_id = $presentation_id"
+ns_returnredirect "presentation-acl.tcl?presentation_id=$presentation_id"
Index: web/openacs/www/wp/presentation-revert-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/presentation-revert-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/presentation-revert-2.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,19 @@
+# presentation-revert-2.tcl,v 3.0 2000/02/06 03:55:24 ron Exp
+# File:        presentation-revert-2.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Reverts a presentation to a previous version.
+# Inputs:      presentation_id, checkpoint
+
+set_the_usual_form_variables
+
+validate_integer presentation_id $presentation_id
+
+set db [ns_db gethandle]
+
+set user_id [ad_maybe_redirect_for_registration]
+wp_check_authorization $db $presentation_id $user_id "admin"
+
+ns_db 1row $db "select wp_revert_to_checkpoint($presentation_id, [wp_check_numeric $checkpoint])"
+
+ns_returnredirect "presentation-top.tcl?presentation_id=$presentation_id"
Index: web/openacs/www/wp/presentation-revert.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/presentation-revert.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/presentation-revert.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,45 @@
+# presentation-revert.tcl,v 3.0 2000/02/06 03:55:25 ron Exp
+# File:        presentation-revert.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Reverts a presentation to a previous version, after confirming.
+# Inputs:      presentation_id, checkpoint
+
+set_the_usual_form_variables
+
+validate_integer presentation_id $presentation_id
+
+set db [ns_db gethandle]
+
+set user_id [ad_maybe_redirect_for_registration]
+wp_check_authorization $db $presentation_id $user_id "admin"
+
+set selection [ns_db 1row $db "select * from wp_presentations where presentation_id = $presentation_id"]
+set_variables_after_query
+
+set selection [ns_db 1row $db "
+    select description, to_char(checkpoint_date, 'Month DD, YYYY, HH:MI A.M.') as checkpoint_date
+    from wp_checkpoints
+    where checkpoint = [wp_check_numeric $checkpoint]
+    and presentation_id = $presentation_id
+"]
+set_variables_after_query
+
+ReturnHeaders
+ns_write "[wp_header_form "action=presentation-revert-2.tcl" \
+           [list "" "WimpyPoint"] [list "index.tcl?show_user=" "Your Presentations"] \
+           [list "presentation-top.tcl?presentation_id=$presentation_id" "$title"] "Revert Presentation"]
+[export_form_vars presentation_id checkpoint]
+
+<p>Do you really want to revert $title to the version entitled &quot;$description,&quot; made
+at $checkpoint_date? You will permanently lose any change made to your presentation since then.
+
+<p><center>
+<input type=button value=\"No, I want to cancel.\" onClick=\"location.href='presentation-top.tcl?presentation_id=$presentation_id'\">
+<spacer type=horizontal size=50>
+<input type=submit value=\"Yes, proceed.\">
+</p></center>
+
+[wp_footer]
+"
+
Index: web/openacs/www/wp/presentation-top.help
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/presentation-top.help,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/presentation-top.help	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,60 @@
+<%= [wp_help_header "Editing Presentations"] %>
+
+This is the main page of WimpyPoint's authoring interface - from
+here you can access a wide variety of features to edit your presentation
+(or view the finished product).
+
+<h3>The Slide List</h3>
+To preview a slide as it will look in the finished presentation, click its title.
+To edit or delete the slide, follow the corresponding link to the right of the
+title. To add an image to your slide, or to upload a file which you want linked
+from the slide (called an &quot;attachment&quot;), follow the <i>attach</i> link.
+
+<p>You can insert a new slide at any point in the presentation by following the
+<i>Insert</i> link pointing between the appropriate two slides, or add a new slide
+at the end by following the <i>Add</i> link.
+
+<p>For a screen allowing you to arbitrarily reorder your slides, follow the link
+entitled <i>Change order of slides</i>.
+
+<h3>Options</h3>
+To view the presentation, follow one of the <i>Show presentation</i>
+links. Click <i>done</i> in the upper-right corner of the presentation's
+table of contents to return to the editing screen.
+<i>Show presentation, viewing comments from collaborators and "edit" links</i>
+differs from <i>Show presentation</i> in that it
+
+<ul>
+  <li>displays collaborators' comments on slides and allows you to add your own comments, providing
+feedback to others working on the presentation with you.
+  <li>displays links in the upper-right corner of slides allowing you to edit or delete slides.
+</ul>
+
+To change the presentation settings which specified when the presentation
+was created (e.g., the presentation's title, whether it is public, etc.), click <i>Edit presentation properties</i>.
+To set which slides appear in the presentation's table of contents, and when context breaks
+are displayed, click <i>Adjust outline and context breaks</i>.
+
+<p>If you're having a bad day, devoid of creative thought, you might just want to
+blatantly steal slides instead of creating them: click on one of the <i>Bulk-copy slides</i> links.
+
+<p>If you want to hose your presentation, click <i>Delete this presentation</i>. Be careful, though:
+once you delete a presentation there's no way at all to get it back! (This option is only available
+to a presentation's owner.)
+
+<h3>Viewers/Collaborators</h3>
+
+This section lists the users allowed to view or edit the presentation. If you own a presentation,
+you can add or remove people from this list by following the
+<i>Change people who can view/edit this presentation</i> link at the bottom.
+
+<h3>Versioning</h3>
+
+Versioning allows you to permanently preserve the current set of slides in your presentation. It's especially useful before you
+invite someone to work on your presentation - if he or she messes things up, you can always revert to a previous version.
+If you own a presentation, you can <i>Freeze the slide set</i>, i.e., preserve its current state.
+Once the slide set has been frozen, you can view a frozen version of the presentation by selecting it
+from the pull-down menu and clicking one of the <i>Show</i> buttons. If you want to roll back all
+changes to the slides, you can select an old version and click <i>Revert</i>.
+
+<%=[wp_footer]%>
Index: web/openacs/www/wp/presentation-top.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/presentation-top.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/presentation-top.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,192 @@
+# presentation-top.tcl,v 3.1.2.1 2000/03/16 23:17:10 jsalz Exp
+# File:        presentation-top.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Top level for editing a presentation.
+# Inputs:      presentation_id
+#              new_slide_id - ID of a slide just created, to call special attention to it.
+
+set_the_usual_form_variables
+if { ![info exists new_slide_id] } {
+    set new_slide_id -1
+} else {
+    validate_integer new_slide_id $new_slide_id
+}
+
+set db [ns_db gethandle]
+
+set user_id [ad_maybe_redirect_for_registration]
+set auth [wp_check_authorization $db $presentation_id $user_id "write"]
+
+set selection [ns_db 1row $db "select * from wp_presentations where presentation_id = $presentation_id"]
+set_variables_after_query
+
+ReturnHeaders
+ns_write [wp_header [list "" "WimpyPoint"] [list "index.tcl?show_user=" "Your Presentations"] "$title"]
+
+ns_write "
+<h3>The Slides</h3>
+"
+
+set out "<table cellspacing=0 cellpadding=0>"
+set counter 0
+set last_sort_key 0
+
+set selection [ns_db select $db "
+    select slide_id, title, sort_key
+    from wp_slides 
+    where presentation_id = $presentation_id
+    and max_checkpoint is null
+    order by sort_key
+"]
+while { [ns_db getrow $db $selection] } {
+    set_variables_after_query
+    incr counter
+
+    # If a slide was just added, make it bold to provide some visual feedback.
+    if { $slide_id == $new_slide_id } {
+	set bold_if_new "<b>"
+    } else {
+	set bold_if_new ""
+    }
+    append out "
+<tr valign=top>
+  <td align=right nowrap><spacer type=vertical size=4>$bold_if_new$counter.&nbsp;</td>
+  <td><spacer type=vertical size=4>$bold_if_new<a href=\"[wp_presentation_edit_url]/$presentation_id/$slide_id.wimpy\">$title</a></td>
+  <td>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</td>
+  <td nowrap><spacer type=vertical size=4>&nbsp;\[ <a href=\"slide-edit.tcl?slide_id=$slide_id\">edit</a> | <a href=\"slide-delete.tcl?slide_id=$slide_id\">delete</a> | <a href=\"slide-attach.tcl?slide_id=$slide_id\">attach</a> \]</td>
+  <td>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</td>
+  <td nowrap><font size=-1>&nbsp;&nbsp;<img src=\"pics/arrow.gif\" align=top> <a href=\"slide-edit.tcl?presentation_id=$presentation_id&sort_key=$sort_key\">Insert</a></td>
+</tr>
+"
+    set last_sort_key $sort_key
+}
+
+if { $counter == 0 } {
+    # No slides yet.
+    set out "<ul><li><a href=\"slide-edit.tcl?presentation_id=$presentation_id&sort_key=1\">Create the first slide</a></ul>\n"
+} else {
+    append out "
+<tr valign=top><td></td>
+  <td><spacer type=vertical size=4><a href=\"reorder-slides.tcl?presentation_id=$presentation_id\">Change order of slides</a></td>
+  <td>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</td>
+  <td></td>
+  <td>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</td>
+  <td><font size=-1>&nbsp;&nbsp;<img src=\"pics/arrow.gif\" align=top> <a href=\"slide-edit.tcl?presentation_id=$presentation_id&sort_key=[expr $last_sort_key + 1]\">Add</a></td></tr>\n"
+    append out "</table>"
+}
+
+# Generate a <select> list of all checkpoints. The greatest checkpoint represents the current
+# state of the presentation, and so shouldn't be listed here.
+set previous_versions "<p><li>Previous versions of this presentation:<br>
+<select name=version>
+"
+set counter 0
+wp_select $db "
+    select checkpoint, description, TO_CHAR(checkpoint_date, 'Mon. DD, YYYY, HH:MI A.M.') as checkpoint_date
+    from wp_checkpoints
+    where presentation_id = $presentation_id
+    order by checkpoint desc
+" {
+    if { $counter != 0 } {
+	# Skip the latest checkpoint
+	append previous_versions "<option value=\"$checkpoint\">$description ($checkpoint_date)\n"
+    }
+    incr counter
+}
+if { $counter <= 1 } {
+    # Just one checkpoint - don't display the menu.
+    set previous_versions ""
+} else {
+    append previous_versions "</select><br>
+<input type=button value=\"Show\" onClick=\"with (form.version) location.href='[wp_presentation_url]/$presentation_id-v'+options\[selectedIndex\].value+'/'\">
+<input type=button value=\"Show w/Comments\" onClick=\"with (form.version) location.href='[wp_presentation_edit_url]/$presentation_id-v'+options\[selectedIndex\].value+'/'\">
+"
+    if { $auth == "admin" } {
+	append previous_versions "<input type=button value=\"Revert to This Version\" onClick=\"with (form.version) location.href='presentation-revert.tcl?presentation_id=$presentation_id&checkpoint='+options\[selectedIndex\].value\">"
+    }
+}
+
+append out "
+</table>
+
+<h3>Options</h3>
+
+<ul>
+
+<li><a href=\"[wp_presentation_url]/$presentation_id/\">Show presentation</a>
+<li><a href=\"[wp_presentation_edit_url]/$presentation_id/\">Show presentation, viewing comments from collaborators and &quot;edit&quot; links</a>
+
+<p>
+
+<li><a href=\"presentation-edit.tcl?presentation_id=$presentation_id\">Edit presentation properties</a>
+<li><a href=\"outline-adjust.tcl?presentation_id=$presentation_id\">Adjust outline and context breaks</a><p>
+
+<li>Bulk copy slides from
+<a href=\"bulk-copy.tcl?presentation_id=$presentation_id&user_id=$user_id\">one of your presentations</a> or
+<a href=\"bulk-copy.tcl?presentation_id=$presentation_id\">another user's presentation</a>
+
+[wp_only_if {[ad_parameter "AllowBulkUploadP" "wp" 1] && [file exists [ad_parameter "PathToUnzip" "wp" "/usr/bin/unzip"]]} "
+<li><a href=\"bulk-image-upload.tcl?presentation_id=$presentation_id\">Upload an archive of images</a>
+"]
+
+[wp_only_if { $auth == "admin" } "
+<p>
+<li><a href=\"presentation-delete.tcl?presentation_id=$presentation_id\">Delete this presentation</a>
+"]
+
+</ul>
+
+<h3>Viewers / Collaborators</h3>
+
+<ul>
+"
+
+if { $public_p == "t" } {
+    append out "<li>Everyone can view the presentation, since it is public.\n"
+    set role_condition "and role in ('write','admin')"
+} else {
+    set role_condition ""
+}
+
+wp_select $db "
+    select u.first_names, u.last_name, u.user_id as his_user_id, m.role
+    from users u, user_group_map m
+    where m.group_id = $group_id
+    and   m.user_id = u.user_id $role_condition
+    order by m.role <> 'read', lower(u.last_name), lower(u.first_names)
+" {
+    append out "<li><a href=\"/shared/community-member.tcl?user_id=$his_user_id\">$first_names $last_name</a> "
+    if { $role == "read" } {
+	append out " (read-only)\n"
+    }
+} else {
+    if { $public_p == "f" } {
+	append out "<li>None.\n"
+    }
+}
+if { $auth == "admin" } {
+    append out "<li><a href=\"presentation-acl.tcl?presentation_id=$presentation_id\">Change people who can view/edit this presentation</a>\n"
+}
+append out "</ul>\n"
+
+if { $auth == "admin" || $previous_versions != "" } {
+    append out "<h3>Versioning</h3>
+<ul>
+$previous_versions
+<li><a href=\"presentation-freeze.tcl?presentation_id=$presentation_id\">Freeze the current slide set</a> (create a new version)
+</ul>
+"
+}
+
+ns_db releasehandle $db
+
+ns_write "$out
+
+[wp_only_if { ![empty_string_p $audience] } "<h3>Audience</h3>\n$audience</p>\n"]
+[wp_only_if { ![empty_string_p $background] } "<h3>Background</h3>\n$background</p>\n"]
+
+[wp_footer]
+"
+
+
Index: web/openacs/www/wp/presentations-by-date.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/presentations-by-date.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/presentations-by-date.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,51 @@
+# presentations-by-date.tcl,v 3.0 2000/02/06 03:55:28 ron Exp
+# File:        presentations-by-date.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Shows a list of public presentations, sorted in reverse by date.
+# Inputs:      bulk_copy (optional)
+
+set_the_usual_form_variables 0
+
+ReturnHeaders
+ns_write "[wp_header [list "?[export_ns_set_vars]" "WimpyPoint"] "Presentations by Date"]
+
+Here are the public presentations, sorted by creation date.
+
+<ul>
+"
+
+set out ""
+set db [ns_db gethandle]
+wp_select $db "
+    select u.user_id, u.last_name, u.first_names,  u.email, wp.presentation_id, wp.title as presentation_title, wp.creation_date,
+    count(wp_slide_id_count(wp.presentation_id)) as n_slides
+    from users u, wp_presentations wp
+    where u.user_id = wp.creation_user
+    and wp.public_p = 't'
+    group by u.user_id, u.last_name, u.first_names, u.email, wp.presentation_id, wp.title, wp.creation_date
+    having n_slides > 1
+    order by wp.creation_date desc
+" {
+    if { $n_slides == 0 } {
+	set slide_info "no slides"
+    } elseif { $n_slides == 1 } {
+	set slide_info "one slide"
+    } else {
+	set slide_info "$n_slides slides"
+    }
+    if { [info exists bulk_copy] } {
+	append out "<li><a href=\"bulk-copy-2.tcl?presentation_id=$bulk_copy&source_presentation_id=$presentation_id\" target=_parent>[ns_striphtml $presentation_title]</a> 
+created by <a href=\"one-user.tcl?user_id=$user_id&bulk_copy=$bulk_copy\">$first_names $last_name</a> on [util_AnsiDatetoPrettyDate $creation_date]; $slide_info\n"
+    } else {
+	append out "<li><a href=\"[wp_presentation_url]/$presentation_id/\">[ns_striphtml $presentation_title]</a> 
+created by <a href=\"/shared/community-member.tcl?user_id=$user_id\">$first_names $last_name</a> on [util_AnsiDatetoPrettyDate $creation_date]; $slide_info\n"
+    }
+}
+ns_db releasehandle $db
+
+ns_write "$out
+</ul>
+[wp_footer]
+"
+
Index: web/openacs/www/wp/reorder-slides-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/reorder-slides-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/reorder-slides-2.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,30 @@
+# reorder-slides-2.tcl,v 3.0 2000/02/06 03:55:29 ron Exp
+# File:        reorder-slides-2.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Saves changes made to slide order.
+# Inputs:      presentation_id, slide_id
+
+set_the_usual_form_variables
+
+validate_integer presentation_id $presentation_id
+
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+wp_check_authorization $db $presentation_id $user_id "write"
+
+# Just iterate over the values for slide_id in order and set their respective
+# sort_keys to 1, 2, 3, ...
+set counter 0
+foreach slide [util_GetCheckboxValues [ns_getform] slide_id] {
+    incr counter
+    ns_db dml $db "
+        update wp_slides
+        set    sort_key = $counter
+        where  slide_id = $slide
+        and    presentation_id = $presentation_id
+    "
+}
+
+ns_returnredirect "presentation-top.tcl?presentation_id=$presentation_id"
+
Index: web/openacs/www/wp/reorder-slides.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/reorder-slides.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/reorder-slides.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,106 @@
+# reorder-slides.tcl,v 3.0 2000/02/06 03:55:30 ron Exp
+# File:        reorder-slides.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Allows an author to change the order of slides.
+# Inputs:      presentation_id
+
+set_the_usual_form_variables
+
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+wp_check_authorization $db $presentation_id $user_id "write"
+
+set selection [ns_db 1row $db "select * from wp_presentations where presentation_id = $presentation_id"]
+set_variables_after_query
+
+ReturnHeaders
+ns_write "[wp_header_form "name=f" \
+           [list "" "WimpyPoint"] [list "index.tcl?show_user=" "Your Presentations"] \
+           [list "presentation-top.tcl?presentation_id=$presentation_id" "$title"] "Reorder Slides"]
+
+To move a slide in your presentation, select its title and click the Up or Down arrow.
+When you're done, click <i>Save Changes</i>.
+
+<script language=javascript>
+
+function up() {
+    with (document.f.slides) {
+        if (selectedIndex > 0) {
+            var sel = selectedIndex;
+            var selectedText = options\[sel\].text;
+            var selectedValue = options\[sel\].value;
+            options\[sel\].text = options\[sel-1\].text;
+            options\[sel\].value = options\[sel-1\].value;
+            options\[sel-1\].text = selectedText;
+            options\[sel-1\].value = selectedValue;
+            --selectedIndex;
+        }
+    }
+}
+
+function down() {
+    with (document.f.slides) {
+        if (selectedIndex < length - 1) {
+            var sel = selectedIndex;
+            var selectedText = options\[sel\].text;
+            var selectedValue = options\[sel\].value;
+            options\[sel\].text = options\[sel+1\].text;
+            options\[sel\].value = options\[sel+1\].value;
+            options\[sel+1\].text = selectedText;
+            options\[sel+1\].value = selectedValue;
+            ++selectedIndex;
+        }
+    }
+}
+
+function done() {
+    var query = '';
+
+    with (document.f.slides) {
+        var i;
+        for (i = 0; i < length; ++i)
+            query += '&slide_id=' + options\[i\].value;
+    }
+
+    location.href = 'reorder-slides-2.tcl?presentation_id=$presentation_id' + query;
+}
+</script>
+
+<center>
+
+<p>
+<table>
+<tr><td rowspan=2>
+<select name=slides size=10>
+"
+
+set counter 0
+
+wp_select $db "
+    select slide_id, title
+    from wp_slides 
+    where presentation_id = $presentation_id
+    and max_checkpoint is null
+    order by sort_key
+" {
+    incr counter
+    append out "<option value=$slide_id>$counter. $title\n"
+}
+
+ns_write "$out
+</select>
+</td>
+<td align=center valign=middle><a href=\"javascript:up()\"><img src=\"pics/up.gif\" border=0></a></td>
+</tr>
+<tr>
+<td align=center valign=middle><a href=\"javascript:down()\"><img src=\"pics/down.gif\" border=0></a></td>
+</tr>
+
+<tr><td align=center><input type=button value=\"Save Changes\" onClick=\"done()\"></td></tr>
+
+</table>
+</center>
+
+[wp_footer]
+"
Index: web/openacs/www/wp/slide-attach-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/slide-attach-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/slide-attach-2.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,63 @@
+# slide-attach-2.tcl,v 3.0 2000/02/06 03:55:31 ron Exp
+# File:        slide-attach-2.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Adds an attachment.
+# Inputs:      slide_id, attachment (file), inline_image_p, display
+
+ad_page_variables {
+    slide_id
+    attachment
+    inline_image_p
+    display
+}
+
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+
+set selection [ns_db 1row $db "select * from wp_slides where slide_id = $slide_id"]
+set_variables_after_query
+wp_check_authorization $db $presentation_id $user_id "write"
+
+set tmp_filename [ns_queryget attachment.tmpfile]
+set guessed_file_type [ns_guesstype $attachment]
+set n_bytes [file size $tmp_filename]
+
+# strip off the C:\directories... crud and just get the file name
+if ![regexp {([^/\\]+)$} $attachment match client_filename] {
+    set client_filename $attachment
+}
+
+set exception_count 0
+set exception_text ""
+
+if { $n_bytes == 0 } {
+    append exception_text "<li>You haven't uploaded a file.\n"
+    incr exception_count
+}
+
+if { ![empty_string_p [ad_parameter MaxAttachmentSize "comments"]] && $n_bytes > [ad_parameter MaxAttachmentSize "comments"] } {
+    append exception_text "<li>Your file is too large.  The publisher of [ad_system_name] has chosen to limit attachments to [util_commify_number [ad_parameter MaxAttachmentSize "comments"]] bytes.\n"
+    incr exception_count
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+if { $inline_image_p == "f" } {
+    set QQdisplay ""
+}
+
+set attachment_id [database_to_tcl_string $db "select empty_lob()"]
+
+ns_db dml $db "begin"
+ns_db dml $db "
+    insert into wp_attachments(attach_id, slide_id, lob, file_size, file_name, mime_type, display)
+    values(nextval('wp_ids'), $slide_id, $attachment_id, $n_bytes, '[DoubleApos $client_filename]', '$guessed_file_type', [db_postgres_null_sql $QQdisplay])"
+
+ns_pg blob_dml_file $db $attachment_id $tmp_filename
+ns_db dml $db "end"
+
+ns_returnredirect "slide-attach.tcl?slide_id=$slide_id"
Index: web/openacs/www/wp/slide-attach-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/slide-attach-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/slide-attach-delete.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,18 @@
+# slide-attach-delete.tcl,v 3.0 2000/02/06 03:55:32 ron Exp
+# File:        slide-attach-delete.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Deletes an attachment.
+# Inputs:      slide_id, attach_id
+
+set_the_usual_form_variables
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+
+set selection [ns_db 1row $db "select * from wp_slides where slide_id = $slide_id"]
+set_variables_after_query
+wp_check_authorization $db $presentation_id $user_id "write"
+
+ns_db dml $db "delete from wp_attachments where attach_id = $attach_id and slide_id = $slide_id"
+
+ns_returnredirect "slide-attach.tcl?slide_id=$slide_id"
Index: web/openacs/www/wp/slide-attach-move.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/slide-attach-move.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/slide-attach-move.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,27 @@
+# slide-attach-move.tcl,v 3.0 2000/02/06 03:55:33 ron Exp
+# File:        slide-attach-move.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Changes the display mode for an attachment.
+# Inputs:      attach_id, display
+
+set_the_usual_form_variables
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+
+set selection [ns_db 1row $db "
+    select s.presentation_id, s.slide_id
+    from   wp_slides s, wp_attachments a
+    where  a.attach_id = [wp_check_numeric $attach_id]
+    and    s.slide_id = a.slide_id
+"]
+set_variables_after_query
+wp_check_authorization $db $presentation_id $user_id "write"
+
+ns_db dml $db "
+    update wp_attachments
+    set display = '$QQdisplay'
+    where attach_id = $attach_id
+"
+
+ns_returnredirect "slide-attach.tcl?slide_id=$slide_id"
Index: web/openacs/www/wp/slide-attach.help
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/slide-attach.help,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/slide-attach.help	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,18 @@
+<%= [wp_help_header "Attaching Images and Files"] %>
+
+This page allows you to attach images to a slide in your presentation,
+or upload a file (an "attachment") to be linked from the slide.
+
+<p>The top of the box displays a list of all images and attachments
+(if any) currently associated with the slide, along with their
+respective sizes and an indication of where they are displayed (these
+options correspond to the options in the bottom half of the box).
+
+<p>To add an image or attachment, click the <i>Browse...</i> button
+and select the file containing the image or attachment. Choose how you
+want the file displayed (if it's not an image, you'll want to select
+<i>Display a link the viewer can use to download the file</i>),
+and click <i>Add the Attachment</i>. Once you do this, you can click
+<i>Preview the Slide</i> to see how the slide will look.
+
+<%=[wp_footer]%>
Index: web/openacs/www/wp/slide-attach.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/slide-attach.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/slide-attach.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,111 @@
+# slide-attach.tcl,v 3.0 2000/02/06 03:55:34 ron Exp
+# File:        slide-attach.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Allows the user to add and delete attachments.
+# Inputs:      slide_id
+
+set_the_usual_form_variables
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+
+set selection [ns_db 1row $db "select * from wp_slides where slide_id = $slide_id"]
+set_variables_after_query
+wp_check_authorization $db $presentation_id $user_id "write"
+
+ReturnHeaders
+ns_write "
+[wp_header_form "enctype=multipart/form-data action=slide-attach-2.tcl method=post" [list "" "WimpyPoint"] \
+  [list "index.tcl?show_user=" "Your Presentations"] \
+  [list "presentation-top.tcl?presentation_id=$presentation_id" [database_to_tcl_string $db "select title from wp_presentations where presentation_id = $presentation_id"]] "Attachments to $title"]
+[export_form_vars slide_id]
+
+<center><p>
+<table border=2 cellpadding=10><tr><td>
+<table cellspacing=0 cellpadding=0>
+<tr>
+  <th align=left nowrap>File Name</th><td>&nbsp;&nbsp;&nbsp;</td>
+  <th align=right nowrap>File Size</th><td>&nbsp;&nbsp;&nbsp;</td>
+  <th nowrap>Display</th>
+</tr>
+<tr><td colspan=7><hr></td></tr>
+
+"
+
+set display_options {
+    { "top" "at the very top (aligned center)" "Top" }
+    { "preamble" "next to the preamble (aligned right)" "Preamble" }
+    { "after-preamble" "after the preamble (aligned center)" "After Preamble" }
+    { "bullets" "next to the bullets (aligned right)" "Bullets" }
+    { "after-bullets" "after the bullets (aligned center)" "After Bullets" }
+    { "postamble" "next to the postamble (aligned right)" "Postamble" }
+    { "bottom" "at the very bottom (aligned center)" "Bottom" }
+}
+
+# Generates <option>s for a <select> list of $display_options. If $prompt == 1,
+# uses the long description, or if $prompt == 2, uses the short description.
+proc wp_attach_display_options { selected prompt } {
+    upvar display_options display_options
+    set out ""
+    foreach opt $display_options {
+	append out "<option value=[lindex $opt 0] [wp_only_if { [lindex $opt 0] == $selected } "selected"]>[lindex $opt $prompt]\n"
+    }
+    if { $prompt == 2 } {
+	append out "<option value=\"\" [wp_only_if { $selected == "" } "selected"]>Linked\n"
+    }
+    return $out
+}
+
+# Generate the list of all attached images.
+set out ""
+wp_select $db "
+    select attach_id, file_name, file_size, display
+    from   wp_attachments
+    where  slide_id = $slide_id
+    order by lower(file_name)
+" {
+    append out "
+<tr>
+  <td><a href=\"[wp_attach_url]/$attach_id/$file_name\">$file_name</a></td><td></td>
+  <td align=right>[format "%.1f" [expr { $file_size / 1024.0 }]]K</td><td></td>
+  <td align=center nowrap><select onChange=\"location.href='slide-attach-move.tcl?attach_id=$attach_id&display='+options\[selectedIndex\].value\">
+[wp_attach_display_options $display 2]
+</select>
+</td><td></td>
+  <td>\[ <a href=\"slide-attach-delete.tcl?slide_id=$slide_id&attach_id=$attach_id\">delete</a> \]</td>
+</tr>
+"
+} else {
+    append out "<tr><td colspan=7 align=center><i>There are no attachments currently associated with this slide.</i></td></tr>\n"
+}
+
+ns_write "$out
+
+  <tr valign=top><td colspan=7>
+    <center>
+      <br><a href=\"[wp_presentation_url]/$presentation_id/$slide_id.wimpy\" target=\"_blank\">Preview the Slide</a>
+    </center>
+    </p>
+    <hr>
+    <center>
+      <br><b>Add an Image or Attachment:</b>
+      <p><input type=file size=30 name=attachment>
+    </center>
+    <p><input type=radio name=inline_image_p value=t checked> Display as an image
+<select name=display>
+[wp_attach_display_options "preamble" 1]
+</select>
+      <br><input type=radio name=inline_image_p value=f> Display a link the viewer can use to download the file
+      <center>
+      <p><input type=submit value=\"Add the Attachment\">
+    </td>
+    </tr></table>
+  </td></tr>
+</table>
+</td></tr></table>
+</p></center>
+
+[wp_footer]
+"
+
+
Index: web/openacs/www/wp/slide-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/slide-delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/slide-delete-2.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,35 @@
+# slide-delete-2.tcl,v 3.0 2000/02/06 03:55:36 ron Exp
+# File:        slide-delete-2.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Deletes a slide.
+# Inputs:      slide_id
+
+set_the_usual_form_variables
+
+# everything for an old slide
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+
+set presentation_id [database_to_tcl_string $db "select presentation_id from wp_slides where slide_id = [wp_check_numeric $slide_id]"]
+wp_check_authorization $db $presentation_id $user_id "write"
+
+ns_db dml $db "begin transaction"
+
+# Remove it from the current view by setting its checkpoint value.
+ns_db dml $db "
+    update wp_slides
+    set    max_checkpoint = (select max(checkpoint) from wp_checkpoints where presentation_id = $presentation_id)
+    where  slide_id = $slide_id
+    and    max_checkpoint is null
+"
+# If it's not remaining in any view, just delete it.
+ns_db dml $db "
+    delete from wp_slides
+    where  slide_id = $slide_id
+    and    max_checkpoint = min_checkpoint
+"
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "presentation-top.tcl?presentation_id=$presentation_id"
Index: web/openacs/www/wp/slide-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/slide-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/slide-delete.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,50 @@
+# slide-delete.tcl,v 3.0 2000/02/06 03:55:37 ron Exp
+# File:        slide-delete.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Confirms that the user wants to delete the slide.
+# Inputs:      slide_id
+
+set_the_usual_form_variables
+
+# everything for an old slide
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+
+# Get the slide and presentation information to display a confirmation message.
+set selection [ns_db 1row $db "
+    select s.*, p.title as presentation_title
+    from wp_slides s, wp_presentations p
+    where s.slide_id = [wp_check_numeric $slide_id]
+    and s.presentation_id = p.presentation_id
+"]
+set_variables_after_query
+wp_check_authorization $db $presentation_id $user_id "write"
+
+ReturnHeaders
+ns_write "
+[wp_header_form "" [list "" "WimpyPoint"] [list "index.tcl?show_user=" "Your Presentations"] \
+  [list "presentation-top.tcl?presentation_id=$presentation_id" $presentation_title] "Delete a Slide"]
+
+Are you sure that you want to delete this slide?
+
+<ul>
+<li>Title:  $title
+<li>Contents:  
+
+$preamble
+
+[expr { $bullet_items != "" ? "<ul>\n<li>[join $bullet_items "<li>\n"]\n</ul>" : "</p>" }]
+
+$postamble
+
+$preamble
+</ul>
+
+<input type=button value=\"Yes, delete the slide.\" onClick=\"location.href='slide-delete-2.tcl?slide_id=$slide_id'\">
+<input type=button value=\"No, I want to go back.\" onClick=\"history.back()\">
+
+</p>
+[wp_footer]
+"
+
Index: web/openacs/www/wp/slide-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/slide-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/slide-edit-2.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,119 @@
+# slide-edit-2.tcl,v 3.1.2.1 2000/03/15 16:00:47 jsalz Exp
+# File:        slide-edit-2.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Creates or saves changes to a slide.
+# Inputs:      presentation_id, slide_id, sort_key, title, preamble, bullet_count bullet1..$bullet_count, postamble, attach
+
+set_the_usual_form_variables
+
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+if { ![info exists creating] } {
+    wp_check_numeric $slide_id
+    set presentation_id [database_to_tcl_string $db "select presentation_id from wp_slides where slide_id = $slide_id"]
+    set original_slide_id [database_to_tcl_string $db "select coalesce(original_slide_id, slide_id) from wp_slides where slide_id = $slide_id"]
+} else {
+    set condition ""
+    set original_slide_id "null"
+}
+wp_check_authorization $db $presentation_id $user_id "write"
+
+# Turn those individual bullets into a list. Limit to 1000 bullets (to
+# prevent some absurd DoS attack)
+set bullet_items [list]
+for { set i 1 } { $i <= $bullet_count && $i <= 1000 } { incr i } {
+    if { [set "bullet$i"] != "" } {
+	lappend bullet_items [set "bullet$i"]
+    }
+}
+
+# Look for problems with user input.
+set exception_count 0
+set exception_text ""
+
+if { ![info exists title] || $title == "" } {
+    append exception_text "<li>Your title was blank.  We need a title to generate the user interface."
+    incr exception_count
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+ns_db dml $db "begin transaction"
+
+# Has a checkpoint been set since the last update, i.e.,
+# min_checkpoint is not the latest checkpoint and max_checkpoint is null?
+if { [info exists slide_id] && [database_to_tcl_string $db "
+    select count(*) from wp_slides
+    where slide_id = $slide_id
+    and min_checkpoint < (select max(checkpoint) from wp_checkpoints where presentation_id = $presentation_id)
+    and max_checkpoint is null
+"] != 0 } {
+    # Yes - need to "close off" that slide. Set its max_checkpoint to the current checkpoint,
+    # and start a new slide.
+    ns_db dml $db "
+        update wp_slides
+        set max_checkpoint = (select max(checkpoint) from wp_checkpoints where presentation_id = $presentation_id)
+        where slide_id = $slide_id
+    "
+
+    set old_slide_id $slide_id
+    set slide_id [wp_nextval $db "wp_ids"]
+    set creating 1
+}
+
+if { ![info exists creating] } {
+    set condition "slide_id = $slide_id"
+} else {
+    set condition ""
+    if { [database_to_tcl_string $db "select count(*) from wp_slides where slide_id = $slide_id"] } {
+	ns_returnredirect "presentation-top.tcl?presentation_id=$presentation_id&new_slide_id=$slide_id"
+	return
+    }
+}
+
+# We're OK... do the insert.
+
+set names [list slide_id presentation_id modification_date sort_key min_checkpoint \
+                title preamble bullet_items postamble original_slide_id]
+set values [list $slide_id [wp_check_numeric $presentation_id] "sysdate()" [wp_check_numeric $sort_key] \
+    "(select max(checkpoint) from wp_checkpoints where presentation_id = $presentation_id)" \
+    "'$QQtitle'" "'[DoubleApos $preamble]'" "'[DoubleApos $bullet_items]'" "'[DoubleApos $postamble]'" $original_slide_id]
+
+# Increase the sort key of all slides to come after this one, to "make room"
+# in the sorting order.
+
+# DRB: the numeric cast is a bug workaround for PG7.0, the conversion rules
+# are being worked on.
+
+ns_db dml $db "
+    update wp_slides
+    set sort_key = sort_key + 1
+    where presentation_id = $presentation_id
+and sort_key >= ${sort_key}::numeric
+    and max_checkpoint is null
+"
+
+wp_try_dml_or_break $db [wp_prepare_dml "wp_slides" $names $values $condition] \
+    [list]
+
+if { [info exists old_slide_id] } {
+    # Copy attachments over to the new version of the slide.
+    ns_db dml $db "
+        insert into wp_attachments(attach_id, slide_id, attachment, file_size, file_name, mime_type, display)
+            select wp_ids.nextval, $slide_id, attachment, file_size, file_name, mime_type, display
+            from   wp_attachments
+            where  slide_id = $old_slide_id
+    "
+}
+
+ns_db dml $db "end transaction"
+
+if { [info exists attach] } {
+    ns_returnredirect "slide-attach.tcl?slide_id=$slide_id"
+} else {
+    ns_returnredirect "presentation-top.tcl?presentation_id=$presentation_id&new_slide_id=$slide_id"
+}
Index: web/openacs/www/wp/slide-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/slide-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/slide-edit.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,127 @@
+# slide-edit.tcl,v 3.1 2000/02/25 16:45:04 jsalz Exp
+# File:        slide-edit.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Allows the user to create or edit a slide.
+# Inputs:      presentation_id (if creating)
+#              slide_id (to edit) or sort_key (to create)
+
+set_the_usual_form_variables
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+
+if { [info exists slide_id] } {
+    # Editing an existing slide.
+    set selection [ns_db 1row $db "select * from wp_slides where slide_id = [wp_check_numeric $slide_id]"]
+    set_variables_after_query
+
+    set role "Edit"
+} else {
+    # Creating a new slide.
+    foreach var { title preamble bullet_items postamble } {
+	set $var ""
+    }
+    set slide_id [wp_nextval $db "wp_ids"]
+    set creating "t"
+
+    set role "Create"
+}
+wp_check_authorization $db $presentation_id $user_id "write"
+
+# Display n + 3 (but always at least 5) bullet item slots, where n = the number
+# of bullet items currently on the slide.
+set bullet_count [expr [llength $bullet_items] + 3]
+if { $bullet_count < 5 } {
+    set bullet_count 5
+}
+set bullet_items_html "[export_form_vars bullet_count]"
+for { set i 0 } { $i < $bullet_count } { incr i } {
+    set value [lindex $bullet_items $i]
+    append bullet_items_html "<li>"
+    if { [string length $value] > 60 } {
+	set rows [expr { [string length $value] / 45 }]
+	if { $rows < 3 } {
+	    set rows 3
+	} elseif { $rows > 8 } {
+	    set rows 8
+	}
+	append bullet_items_html "<textarea wrap=soft rows=$rows cols=60 name=bullet[expr $i + 1]>[philg_quote_double_quotes $value]</textarea>"
+    } else {
+	append bullet_items_html "<input type=text size=60 name=bullet[expr $i + 1] value=\"[philg_quote_double_quotes $value]\">"
+    }
+    append bullet_items_html "&nbsp;"
+    if { $i == 0 } {
+	append bullet_items_html "<img src=\"pics/1white.gif\" width=18 height=15\">"
+    } else {
+	append bullet_items_html "<a href=\"javascript:swapWithNext($i)\"><img src=\"pics/up.gif\" width=18 height=15 border=0></a>"
+    }
+    if { $i == $bullet_count - 1 } {
+	append bullet_items_html "<img src=\"pics/1white.gif\" width=18 height=15\">"
+    } else {
+	append bullet_items_html "<a href=\"javascript:swapWithNext([expr $i + 1])\"><img src=\"pics/down.gif\" width=18 height=15 border=0></a>"
+    }
+    append bullet_items_html "\n"
+}
+
+ReturnHeaders
+ns_write "
+[wp_header_form "name=f action=slide-edit-2.tcl method=post" [list "" "WimpyPoint"] [list "index.tcl?show_user=" "Your Presentations"] \
+  [list "presentation-top.tcl?presentation_id=$presentation_id" [database_to_tcl_string $db "select title from wp_presentations where presentation_id = $presentation_id"]] "$role a Slide"]
+
+[export_form_vars presentation_id slide_id sort_key creating]
+
+<script language=javascript>
+function swapWithNext(index)
+{
+  var val = document.f\['bullet' + index\].value;
+  document.f\['bullet' + index\].value = document.f\['bullet' + (index+1)\].value;
+  document.f\['bullet' + (index+1)\].value = val;
+}
+</script>
+
+<table>
+  <tr>
+    <th align=right nowrap>Slide Title:&nbsp;</th>
+    <td><input type=text name=title value=\"[philg_quote_double_quotes $title]\" size=50></td>
+  </tr>
+  <tr valign=top>
+    <th align=right nowrap><br>Preamble:</th>
+    <td>
+      <textarea rows=6 cols=70 name=preamble wrap=virtual>[philg_quote_double_quotes $preamble]</textarea><br>
+      <i>(optional random text that goes above the bullet list)</i>
+    </td>
+  </tr>
+  <tr valign=baseline>
+    <th align=right nowrap>Bullet Items:</th>
+    <td>
+      <ul>
+        $bullet_items_html
+        <br><i>You can add additional bullets later.</i>
+      </ul>
+    </td>
+  </tr>
+  <tr valign=top>
+    <th align=right nowrap><br>Postamble:</th>
+    <td>
+      <textarea rows=6 cols=70 name=postamble wrap=virtual>[philg_quote_double_quotes $postamble]</textarea><br>
+      <i>(optional random text that goes after the bullet list)</i>
+    </td>
+  </tr>
+</table>
+
+<p><center>
+<input type=submit value=\"Save Slide\">
+<spacer type=horizontal size=50>
+<input type=submit name=attach value=\"[wp_only_if { $role == "edit" } "Save Slide and "]View/Upload Attachments\">
+</center>
+
+<p>
+Note: if you're too lazy to type and too unimaginative (like me) to
+come up with new ideas you might want to
+<a href=\"bulk-copy.tcl?presentation_id=$presentation_id\">copy a slide from 
+another presentation</a>.
+
+[wp_footer]
+"
+
+
Index: web/openacs/www/wp/style-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/style-delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/style-delete-2.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,19 @@
+# style-delete-2.tcl,v 3.0 2000/02/06 03:55:42 ron Exp
+# File:        slide-delete-2.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Deletes the style.
+# Inputs:      style_id
+
+set_the_usual_form_variables
+
+# everything for an old slide
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+
+wp_check_style_authorization $db $style_id $user_id
+
+ns_db dml $db "delete from wp_styles where style_id = $style_id"
+
+ns_returnredirect "style-list.tcl"
+
Index: web/openacs/www/wp/style-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/style-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/style-delete.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,43 @@
+# style-delete.tcl,v 3.0 2000/02/06 03:55:43 ron Exp
+# File:        slide-delete.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Confirms that the user wants to delete the style.
+# Inputs:      style_id
+
+set_the_usual_form_variables
+
+# everything for an old slide
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+
+# Get the style information to display a confirmation message.
+set selection [ns_db 1row $db "select * from wp_styles where style_id = [wp_check_numeric $style_id]"]
+set_variables_after_query
+wp_check_style_authorization $db $style_id $user_id
+
+set num_images [database_to_tcl_string $db "select count(*) from wp_style_images where style_id = $style_id"]
+if { $num_images == 0 } {
+    set images_str ""
+} elseif { $num_images == 1 } {
+    set images_str "and the associated image"
+} else {
+    set images_str ", including $num_images associated images"
+}
+
+ReturnHeaders
+ns_write "
+[wp_header_form "action=style-delete-2.tcl" [list "" "WimpyPoint"] [list "style-list.tcl" "Your Styles"] "Delete $name"]
+[export_form_vars style_id]
+
+Are you sure that you want to delete the style $name$images_str?
+
+<p><center>
+<input type=button value=\"No, I want to cancel.\" onClick=\"location.href='style-list.tcl'\">
+<spacer type=horizontal size=50>
+<input type=submit value=\"Yes, proceed.\">
+</p></center>
+
+[wp_footer]
+"
+
Index: web/openacs/www/wp/style-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/style-edit-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/style-edit-2.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,55 @@
+# style-edit-2.tcl,v 3.0 2000/02/06 03:55:44 ron Exp
+# File:        style-new-2.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Create or apply changes to a style.
+# Inputs:      style_id (if editing), css (file), presentation_id
+
+set user_id [ad_maybe_redirect_for_registration]
+
+set_the_usual_form_variables
+
+set exception_count 0
+set exception_text ""
+
+if { ![info exists name] || $name == "" } {
+    append exception_text "<li>Please specify a name for your style."
+    incr exception_count
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# We're OK to insert or update.
+
+set db [ns_db gethandle]
+
+if { [info exists style_id] } {
+    set condition "style_id = $style_id"
+
+    # If editing, make sure we can write to the style.
+    wp_check_style_authorization $db $style_id $user_id
+} else {
+    set condition ""
+    set style_id [wp_nextval $db "wp_ids"]
+}
+
+ad_process_color_widgets text_color background_color link_color alink_color vlink_color
+
+set names [list style_id name owner css text_color background_color background_image link_color alink_color vlink_color]
+set values [list $style_id "'$QQname'" $user_id "[db_postgres_null_sql $QQcss]" \
+                 "[db_postgres_null_sql $text_color]" "[db_postgres_null_sql $background_color]" "[db_postgres_null_sql $background_image]" "[db_postgres_null_sql $link_color]" "[db_postgres_null_sql $alink_color]" "[db_postgres_null_sql $vlink_color]"]
+
+ns_db dml $db "begin transaction"
+wp_try_dml_or_break $db [wp_prepare_dml "wp_styles" $names $values $condition]
+if { [info exists presentation_id] } {
+    # We reached here through the "I'll upload my own" menu item in presentation-edit.tcl.
+    # Set the presentation's style, now that we've created it.
+    wp_check_authorization $db $presentation_id $user_id
+    ns_db dml $db "update wp_presentations set style = $style_id where presentation_id = $presentation_id"
+}
+ns_db dml $db "end transaction"
+
+ns_returnredirect "style-view.tcl?style_id=$style_id"
Index: web/openacs/www/wp/style-edit.help
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/style-edit.help,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/style-edit.help	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,21 @@
+<%= [wp_help_header "Editing Styles"] %>
+
+Colors are specified using the usual red/green/blue scheme (familiar
+to anyone who's used Photoshop or written HTML code). Each component
+is a number from 0 to 255; the first component is red, the second is green, and the third is blue.
+If you prefer, you can just select a color from the pull-down menu which is
+close to the one that you envision, and then try mucking around with the
+resultant numbers.
+
+<p>You can select any of the images you've uploaded to use as the
+background for your slides.
+
+<h3>For Advanced Users</h3>
+
+<p>If you know <a href="http://www.w3.org/Style/CSS/">CSS (Cascading Style Sheets)</a>,
+you can key in (or cut and paste) some CSS code to be linked to your slides. (The
+colors and background image supplied on the top half of this page are incorporated
+only as attributes to the &lt;BODY&gt; tag, so any CSS settings you provide will
+override them for CSS-aware browsers.)
+
+<%=[wp_footer]%>
Index: web/openacs/www/wp/style-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/style-edit.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/style-edit.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,120 @@
+# style-edit.tcl,v 3.0 2000/02/06 03:55:45 ron Exp
+# File:        style-edit.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Allows the user to create or edit a style.
+# Inputs:      style_id (if editing)
+#              presentation_id, if we should set a presentation to have this style
+
+set_the_usual_form_variables 0
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+
+if { [info exists style_id] } {
+    # Editing an existing style. Make sure we own it, and then retrieve info from the
+    # database.
+    wp_check_style_authorization $db $style_id $user_id
+
+    set selection [ns_db 1row $db "select * from wp_styles where style_id = $style_id"]
+    set_variables_after_query
+
+    set header [list "style-view.tcl?style_id=$style_id" $name]
+
+    set role "Edit"
+} else {
+    # Creating a new style. Set fields to defaults.
+    set show_modified_p "f"
+    set public_p "t"
+    set style -1
+    foreach var { name description header text_color background_color background_image link_color alink_color vlink_color css } {
+	set $var ""
+    }
+
+    set role "Create"
+}
+
+set colors { Chartreuse Mauve Teal Oyster Cordova Burgundy Spruce }
+set elements { Polka-Dots Hearts {Maple Leaves} Peacocks Bunnies }
+
+if { [info exists style_id] } {
+    set items [database_to_tcl_list $db "
+        select file_name
+        from wp_style_images
+        where style_id = $style_id
+        order by file_name
+    "]
+} else {
+    set items ""
+}
+
+if { $items == "" } {
+    set background_images "<i>There are not yet any uploaded images to use as the background.</i>
+<input type=hidden name=background_image value=\"\">
+"
+} else {
+    set values $items
+
+    lappend items "none"
+    lappend values ""
+
+    set background_images "<select name=background_image>
+[ad_generic_optionlist $items $values $background_image]</select>\n"
+}
+
+set values [list]
+
+ReturnHeaders
+ns_write "[wp_header_form "name=f action=style-edit-2.tcl method=post enctype=multipart/form-data" \
+           [list "" "WimpyPoint"] [list "style-list.tcl" "Your Styles"] $header "$role Style"]
+[export_form_vars style_id presentation_id]
+
+<script language=javascript>
+[ad_color_widget_js]
+</script>
+
+<p><center>
+<table border=2 cellpadding=10><tr><td>
+
+<table cellspacing=0 cellpadding=0>
+  <tr valign=baseline>
+    <th nowrap align=right>Name:&nbsp;</th>
+    <td><input type=text name=name size=50 value=\"[philg_quote_double_quotes $name]\"><br>
+<i>A descriptive name, like \"[lindex $colors [randomRange [llength $colors]]] on [lindex $colors [randomRange [llength $colors]]] with [lindex $elements [randomRange [llength $elements]]]\".
+  </tr>
+  <tr>
+    <th nowrap align=right>Text Color:&nbsp;</th>
+    <td>[ad_color_widget text_color $text_color 1]</td>
+  </tr>
+  <tr>
+    <th nowrap align=right>Background Color:&nbsp;</th>
+    <td>[ad_color_widget background_color $background_color 1]</td>
+  </tr>
+  <tr>
+    <th nowrap align=right>Background Image:&nbsp;</th>
+    <td>$background_images</td>
+  </tr>
+  <tr>
+    <th nowrap align=right>Link Color:&nbsp;</th>
+    <td>[ad_color_widget link_color $link_color 1]</td>
+  </tr>
+  <tr>
+    <th nowrap align=right>Visited Link Color:&nbsp;</th>
+    <td>[ad_color_widget vlink_color $vlink_color 1]</td>
+  </tr>
+  <tr>
+    <th nowrap align=right>Active Link Color:&nbsp;</th>
+    <td>[ad_color_widget alink_color $alink_color 1]</td>
+  </tr>
+  <tr>
+    <th nowrap align=right valign=top><br>CSS Source:&nbsp;</th>
+    <td><textarea name=css rows=15 cols=60>[philg_quote_double_quotes $css]</textarea></td>
+  </tr>
+  <tr><td colspan=2 align=center><hr><input type=submit value=\"Save Style\"></td></tr>
+</table>
+
+</td></tr></table>
+
+</center></p>
+
+[wp_footer]
+"
\ No newline at end of file
Index: web/openacs/www/wp/style-image-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/style-image-add.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/style-image-add.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,66 @@
+# style-image-add.tcl,v 3.0 2000/02/06 03:55:46 ron Exp
+# File:        style-image-add.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Add an image.
+# Inputs:      style_id, image
+
+ad_page_variables {
+    style_id
+    image
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+
+set exception_count 0
+set exception_text ""
+
+set tmp_filename [ns_queryget image.tmpfile]
+set guessed_file_type [ns_guesstype $image]
+set n_bytes [file size $tmp_filename]
+
+# strip off the C:\directories... crud and just get the file name
+if ![regexp {([^/\\]+)$} $image match client_filename] {
+    set client_filename $image
+}
+
+set exception_count 0
+set exception_text ""
+
+if { $n_bytes == 0 && ![info exists style_id] } {
+    append exception_text "<li>You haven't uploaded a file.\n"
+    incr exception_count
+}
+
+if { ![empty_string_p [ad_parameter MaxAttachmentSize "comments"]] && $n_bytes > [ad_parameter MaxAttachmentSize "comments"] } {
+    append exception_text "<li>Your file is too large.  The publisher of [ad_system_name] has chosen to limit attachments to [util_commify_number [ad_parameter MaxAttachmentSize "comments"]] bytes.\n"
+    incr exception_count
+}
+
+if { $exception_count > 0 } {
+    ad_return_complaint $exception_count $exception_text
+    return
+}
+
+# We're OK to insert. We'll always do a delete, then an insert, in case we're overwriting
+# an existing image with the same name.
+
+set db [ns_db gethandle]
+
+wp_check_style_authorization $db $style_id $user_id
+
+ns_db dml $db "begin transaction"
+
+set image_id [database_to_tcl_string $db "select empty_lob()"]
+
+ns_db dml $db "delete from wp_style_images where style_id = $style_id and file_name = '[DoubleApos $client_filename]'"
+
+ns_db dml $db "
+    insert into wp_style_images(style_id, lob, file_size, file_name, mime_type)
+    values($style_id, $image_id, $n_bytes, '[DoubleApos $client_filename]', '$guessed_file_type')"
+
+ns_pg blob_dml_file $db $image_id $tmp_filename
+
+ns_db dml $db "end transaction"
+
+ns_returnredirect "style-view.tcl?style_id=$style_id"
Index: web/openacs/www/wp/style-image-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/style-image-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/style-image-delete.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,18 @@
+# style-image-delete.tcl,v 3.0 2000/02/06 03:55:47 ron Exp
+# File:        style-image-delete.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Add an image.
+# Inputs:      style_id, file_name
+
+set user_id [ad_maybe_redirect_for_registration]
+
+set_the_usual_form_variables
+
+set db [ns_db gethandle]
+
+wp_check_style_authorization $db $style_id $user_id
+
+ns_db dml $db "delete from wp_style_images where style_id = $style_id and file_name = '$QQfile_name'"
+
+ns_returnredirect "style-view.tcl?style_id=$style_id"
Index: web/openacs/www/wp/style-list.help
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/style-list.help,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/style-list.help	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,20 @@
+<%= [wp_help_header "Styles"] %>
+
+Styles allow you to prettify your presentations, displaying them
+differently from the standard black-on-white with red/blue/purple
+links. This page allows you to view or edit your personal style repository,
+allowing you to change pages' background and color scheme, and even more if
+you know how to write <a href="http://www.w3.org/Style/CSS/">CSS (Cascading Style Sheets)</a>
+code.
+
+<p>To edit one of your styles, click its title.
+
+<h3>Using Styles</h3>
+You can associate a style with a presentation you're editing by clicking
+<i>Edit presentation properties</i> link on the main presentation-editing screen,
+and selecting an item from the <i>Style</i> pull-down menu.
+While you're viewing a presentation, you can change the style
+by clicking the <i>Change Style</i> link in the lower-right corner on the presentation's
+table of contents.
+
+<%=[wp_footer]%>
Index: web/openacs/www/wp/style-list.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/style-list.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/style-list.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,65 @@
+# style-list.tcl,v 3.0 2000/02/06 03:55:48 ron Exp
+# File:        style-list.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Shows all styles.
+# Inputs:      None.
+
+set_the_usual_form_variables 0
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+
+ReturnHeaders
+ns_write "[wp_header_form "name=f action=style-image-add.tcl method=post enctype=multipart/form-data" \
+           [list "" "WimpyPoint"] "Your Styles"]
+
+<p><center>
+
+<table border=2 cellpadding=10><tr><td>
+<table cellspacing=0 cellpadding=0>
+<tr>
+<th align=left>Style</th><td>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</td>
+<th align=right>#&nbsp;Images</th><td>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</td>
+<th align=right>Total Size</th><td>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</td>
+</tr>
+<tr><td colspan=7><hr></td></tr>
+"
+
+set db2 [ns_db gethandle subquery]
+
+set out ""
+wp_select $db "
+    select s.style_id, s.name,
+    count(wp_style_image_file_size(s.style_id)) as images,
+    sum(wp_style_image_file_size(s.style_id)) as total_size
+    from wp_styles s
+    where s.owner = $user_id
+    group by s.style_id, s.name
+    order by lower(s.name)
+" {
+    append out "<tr><td><a href=\"style-view.tcl?style_id=$style_id\">$name</a></td><td></td>
+<td align=right>$images</td><td></td>
+"
+    if { $total_size != "" } {
+        append out "<td align=right>[format "%.1f" [expr $total_size / 1024.0]]K</td>"
+    } else {
+	append out "<td align=right>-</td>"
+    }
+    append out "<td></td><td>\[ <a href=\"style-delete.tcl?style_id=$style_id\">delete</a> \]</td></tr>\n"
+} else {
+    append out "<tr><td align=center colspan=7><i>You haven't created any styles.</i></td></tr>"
+}
+
+ns_db releasehandle $db2
+
+ns_write "$out
+
+<tr><td colspan=7 align=center><hr><b><a href=\"style-edit.tcl\">Create a new style</a></b></td></tr>
+
+</table>
+</td></tr></table>
+
+</center></p>
+
+[wp_footer]
+"
Index: web/openacs/www/wp/style-view.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/style-view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/style-view.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,109 @@
+# style-view.tcl,v 3.2 2000/03/10 20:43:58 jsalz Exp
+# File:        style-view.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Allows the user to view a style.
+# Inputs:      style_id (if editing)
+
+set_the_usual_form_variables 0
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+
+wp_check_style_authorization $db $style_id $user_id
+
+set selection [ns_db 1row $db "select * from wp_styles where style_id = $style_id"]
+set_variables_after_query
+
+if { $background_color == "" } {
+    set bgcolor_str ""
+} else {
+    set bgcolor_str "bgcolor=[ad_color_to_hex $background_color]"
+}
+if { $background_image == "" } {
+    set bgimage_str ""
+} else {
+    set bgimage_str "style=\"background-image: url([wp_style_url]/$style_id/$background_image)\""
+}
+
+foreach property { text_color link_color alink_color vlink_color } {
+    if { [set $property] == "" } {
+	set "${property}_font" ""
+	set "${property}_font_end" ""
+    } else {
+	set "${property}_font" "<font color=[ad_color_to_hex [set $property]]>"
+	set "${property}_font_end" "</font>"
+    }
+}
+
+ReturnHeaders
+ns_write "[wp_header_form "name=f action=style-image-add.tcl method=post enctype=multipart/form-data" \
+           [list "" "WimpyPoint"] [list "style-list.tcl?user_id=$user_id" "Your Styles"] $name]
+[export_form_vars style_id]
+
+<p><center>
+<table border=2 cellpadding=10><tr><td>
+
+<table cellspacing=0 cellpadding=0>
+  <tr valign=baseline>
+    <th nowrap align=right>Name:&nbsp;</th>
+    <td colspan=5>$name</td>
+  </tr>
+  <tr valign=top>
+    <th nowrap align=right><br>Color Scheme:&nbsp;</th>
+    <td colspan=5>
+      <table border=2 $bgcolor_str cellpadding=10>
+        <tr><td $bgimage_str>
+          ${text_color_font}Plain Text$text_color_font_end<br>
+          ${link_color_font}<u>Linked Text</u>$link_color_font_end<br>
+          ${alink_color_font}<u>Linked Text (Visited)</u>$alink_color_font_end<br>
+          ${vlink_color_font}<u>Linked Text (Active)</u>$vlink_color_font_end
+        </td></tr>
+      </table>
+    </td>
+  <tr>
+    <th nowrap align=right>CSS Code:&nbsp;</th>
+      <td colspan=5>[expr { [regexp {[^ \n\r\t]} $css] ? "<a href=\"css-view.tcl?style_id=$style_id\">view</a>" : "none" }]</td>
+  </tr>
+  <tr>
+    <td align=center colspan=5><br><input type=button onClick=\"location.href='style-edit.tcl?style_id=$style_id'\" value=\"Edit Style\"><hr></td>
+  </tr>
+"
+
+set counter 0
+set out ""
+wp_select $db "
+    select file_size, file_name
+    from   wp_style_images
+    where  style_id = $style_id
+    order by file_name
+" {
+    incr counter
+    append out "<tr><th>"
+    if { $counter == 1 } {
+	append out "Images:&nbsp;"
+    }
+    append out "</th><td><a href=\"[wp_style_url]/$style_id/$file_name\">$file_name</a></td><td>&nbsp;</td>
+<td align=right>[format "%.1f" [expr $file_size / 1024.0]]K&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</td>
+<td align=right><a href=\"style-image-delete.tcl?style_id=$style_id&file_name=[ns_urlencode $file_name]\">delete</a></td>
+</tr>
+"
+} else {
+    append out "<tr><th align=right>Images:&nbsp;</th><td>(none)</td></tr>\n"
+}
+
+ns_write "$out
+  <tr>
+    <td colspan=5 align=center>
+      <br><br><b>Add an image:</b><br>
+      <input name=image type=file size=30><br>
+      <p><input type=submit value=\"Save Image\">
+    </td>
+  </tr>
+</table>
+
+</td></tr></table>
+
+</center></p>
+
+[wp_footer]
+"
\ No newline at end of file
Index: web/openacs/www/wp/uninvite-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/uninvite-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/uninvite-2.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,19 @@
+# uninvite-2.tcl,v 3.0 2000/02/06 03:55:50 ron Exp
+# File:        uninvite.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Deletes a wp_user_access_ticket.
+# Inputs:      presentation_id, invitation_id
+
+set_the_usual_form_variables
+
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+wp_check_authorization $db $presentation_id $user_id "admin"
+
+set selection [ns_db 1row $db "select * from wp_presentations where presentation_id = $presentation_id"]
+set_variables_after_query
+
+ns_db dml $db "delete from wp_user_access_ticket where presentation_id = $presentation_id and invitation_id = [wp_check_numeric $invitation_id]"
+
+ns_returnredirect "presentation-acl.tcl?presentation_id=$presentation_id"
Index: web/openacs/www/wp/uninvite.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/uninvite.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/uninvite.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,42 @@
+# uninvite.tcl,v 3.0 2000/02/06 03:55:51 ron Exp
+# File:        uninvite.tcl
+# Date:        28 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Deletes a wp_user_access_ticket (after confirming).
+# Inputs:      presentation_id, invitation_id
+
+set_the_usual_form_variables
+
+set db [ns_db gethandle]
+set user_id [ad_maybe_redirect_for_registration]
+wp_check_authorization $db $presentation_id $user_id "admin"
+
+set selection [ns_db 1row $db "select * from wp_presentations where presentation_id = $presentation_id"]
+set_variables_after_query
+
+set selection [ns_db 1row $db "
+    select name, role
+    from   wp_user_access_ticket
+    where  invitation_id = [wp_check_numeric $invitation_id]
+    and    presentation_id = $presentation_id
+"]
+set_variables_after_query
+
+ReturnHeaders
+ns_write "[wp_header_form "action=uninvite-2.tcl" \
+           [list "" "WimpyPoint"] [list "index.tcl?show_user=" "Your Presentations"] \
+           [list "presentation-top.tcl?presentation_id=$presentation_id" "$title"] \
+           [list "presentation-acl.tcl?presentation_id=$presentation_id" "Authorization"] "Confirm Delete User"]
+
+[export_form_vars presentation_id invitation_id]
+
+<p>Are you sure you want to revoke $name's invitation to [wp_role_predicate $role $title]?
+
+<p><center>
+<input type=button value=\"No, I want to cancel.\" onClick=\"location.href='presentation-acl.tcl?presentation_id=$presentation_id'\">
+<spacer type=horizontal size=50>
+<input type=submit value=\"Yes, proceed.\">
+</p></center>
+
+[wp_footer]
+"
Index: web/openacs/www/wp/users.tcl
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/users.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ web/openacs/www/wp/users.tcl	17 Apr 2001 14:05:23 -0000	1.1
@@ -0,0 +1,83 @@
+# users.tcl,v 3.1 2000/03/10 20:43:18 jsalz Exp
+# File:        users.tcl
+# Date:        18 Nov 1999
+# Author:      Jon Salz <jsalz@mit.edu>
+# Description: Displays a list of all users and the number of presentations they have.
+# Inputs:      starts_with (optional)
+
+set_the_usual_form_variables 0
+
+if { [info exists starts_with] } {
+    set pretty_starts_with "[string toupper [string range $starts_with 0 0]][string tolower [string range $starts_with 1 end]]"
+    set title "Authors ($pretty_starts_with)"
+    set condition "and lower(last_name) like '[string tolower $QQstarts_with]%'"
+} else {
+    set title "All Authors"
+    set condition ""
+}
+
+ReturnHeaders
+ns_write "[wp_header [list "?[export_ns_set_vars url starts_with]" "WimpyPoint"] $title]
+
+Select an author from this list of users who have created presentations
+(number of slides created shown in parentheses):
+
+<ul> "
+
+set out ""
+
+set seen_real_user_p 0
+set written_fake_user_heading_p 0
+
+set db [ns_db gethandle]
+
+#was:
+#    select wp_real_user_p(count(ws.slide_id)) as real_user_p, u.user_id, u.last_name, u.first_names, u.email, count(ws.slide_id) as n_slides
+#    from users u, wp_presentations wp, wp_slides ws
+#    where u.user_id = wp.creation_user(+)
+#    and ws.max_checkpoint is null
+#    and wp.presentation_id = ws.presentation_id(+) $condition
+#    group by u.user_id, u.last_name, u.first_names, u.email
+#    having count(ws.slide_id) > 0
+#    order by 1 desc, upper(u.last_name), upper(u.first_names)
+
+#DRB: Fix outer join for Postgres later...
+#BMA: added the merge of ACS 3.2
+
+wp_select $db "
+    select u.user_id, u.last_name, u.first_names, u.email, wp_num_public_slides_owned(u.user_id) + wp_num_public_slides_collaborated(u.user_id) as n_slides, wp_real_user_p(wp_num_public_slides_owned(u.user_id) + wp_num_public_slides_collaborated(u.user_id)) real_user_p
+    from users u
+    order by 6 desc, upper(u.last_name), upper(u.first_names)
+" {
+    if { !$seen_real_user_p && $real_user_p == "t" } {
+	set seen_real_user_p 1
+    }
+    if { $real_user_p == "f" && $seen_real_user_p && !$written_fake_user_heading_p } {
+	set written_fake_user_heading_p 1
+	append out "<h4>users with only a handful of slides</h4>\n"
+    }
+    if { [info exists bulk_copy] } {
+	set href "one-user.tcl?user_id=$user_id&bulk_copy=$bulk_copy"
+    } else {
+	set href "one-user.tcl?user_id=$user_id"
+    }
+    append out "<li><a href=\"$href\">$last_name, $first_names</a>,  $email ($n_slides)\n"
+} else {
+    append out "<li>There are no authors"
+    if { [info exists starts_with] } {
+	append out " with last names starting with $pretty_starts_with"
+    }
+    append out ".\n"
+}
+
+ns_write "$out
+</ul>
+
+Note: this is not a complete list of the users.
+Users who are collaborators on
+presentations owned by others are excluded.  Users who have created
+only private presentations are excluded.
+
+[wp_footer]
+"
+
Index: web/openacs/www/wp/pics/1white.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/pics/1white.gif,v
diff -u
Binary files differ
Index: web/openacs/www/wp/pics/arrow.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/pics/arrow.gif,v
diff -u
Binary files differ
Index: web/openacs/www/wp/pics/down.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/pics/down.gif,v
diff -u
Binary files differ
Index: web/openacs/www/wp/pics/up.gif
===================================================================
RCS file: /usr/local/cvsroot/web/openacs/www/wp/pics/up.gif,v
diff -u
Binary files differ